, completeZoneName
, getZone
+ , putZone
)
where
import Control.Monad
import Control.Monad.Trans
import Data.List
-import Database.HaskellDB
+import Database.HaskellDB as DB
import qualified DDNS.DB.Zones as Zones
import Network.DNS.Message
import System.Console.Haskeline
, soaExpirationLimit = fromIntegral $ r!Zones.expire
, soaMinimumTTL = fromIntegral $ r!Zones.minTTL
}
- _ -> return Nothing
\ No newline at end of file
+ _ -> return Nothing
+
+putZone :: Database -> DomainName -> SOAFields -> IO ()
+putZone db name soa
+ = transaction db $
+ do old <- getZone db name
+ case old of
+ Just old'
+ -> if soaSerialNumber old' == soaSerialNumber soa - 1 then
+ -- Succeeded at optimistic locking
+ updateZone
+ else
+ fail "putZone: detected a conflict. please retry it."
+ Nothing
+ -> insertZone
+ where
+ updateZone
+ = DB.update db Zones.zones
+ (\ r -> r!Zones.zone .==. constant (show name))
+ (\ _ -> Zones.ns << constant (show $ soaMasterNameServer soa) #
+ Zones.owner << constant (show $ soaResponsibleMailbox soa) #
+ Zones.serial << constant (fromIntegral $ soaSerialNumber soa) #
+ Zones.refresh << constant (fromIntegral $ soaRefreshInterval soa) #
+ Zones.retry << constant (fromIntegral $ soaRetryInterval soa) #
+ Zones.expire << constant (fromIntegral $ soaExpirationLimit soa) #
+ Zones.minTTL << constant (fromIntegral $ soaMinimumTTL soa) )
+
+ insertZone
+ = DB.insert db Zones.zones
+ ( Zones.zone <<- show name #
+ Zones.ns <<- show (soaMasterNameServer soa) #
+ Zones.owner <<- show (soaResponsibleMailbox soa) #
+ Zones.serial <<- fromIntegral (soaSerialNumber soa) #
+ Zones.refresh <<- fromIntegral (soaRefreshInterval soa) #
+ Zones.retry <<- fromIntegral (soaRetryInterval soa) #
+ Zones.expire <<- fromIntegral (soaExpirationLimit soa) #
+ Zones.minTTL <<- fromIntegral (soaMinimumTTL soa) )