DDNS/Zone.hs

   1 module DDNS.Zone
   2     ( listZones
   3     , completeZoneName
   4
   5     , getZone
   6     )
   7     where
   8
   9 import           Control.Monad
  10 import           Control.Monad.Trans
  11 import           Data.List
  12 import           Database.HaskellDB
  13 import qualified DDNS.DB.Zones as Zones
  14 import           Network.DNS.Message
  15 import           System.Console.Haskeline
  16
  17
  18 listZones :: Database -> IO [DomainName]
  19 listZones db
  20     = do rows <- query db $ do t <- table Zones.zones
  21                                project (Zones.zone << t!Zones.zone)
  22          return $ map (read . (!Zones.zone)) rows
  23
  24 completeZoneName :: MonadIO m => Database -> CompletionFunc m
  25 completeZoneName db
  26     = completeWord Nothing "" $ \ prefix ->
  27       do zones <- liftM (map show) $ liftIO $ listZones db
  28          return $ produceCands zones prefix
  29     where
  30       produceCands :: [String] -> String -> [Completion]
  31       produceCands zones prefix
  32           = let cands = filter (prefix `isPrefixOf`) zones
  33                 comps = map mkComp cands
  34             in
  35               comps
  36
  37       mkComp :: String -> Completion
  38       mkComp zn
  39           = Completion {
  40               replacement = zn
  41             , display     = zn
  42             , isFinished  = True
  43             }
  44
  45 getZone :: Database -> DomainName -> IO (Maybe SOAFields)
  46 getZone db name
  47     = do rows <- query db $
  48                  do t <- table Zones.zones
  49                     restrict (t!Zones.zone .==. constant (show name))
  50                     return t
  51          case rows of
  52            [r] -> return $ Just SOAFields {
  53                      soaMasterNameServer   = read $ r!Zones.ns
  54                    , soaResponsibleMailbox = read $ r!Zones.owner
  55                    , soaSerialNumber       = fromIntegral $ r!Zones.serial
  56                    , soaRefreshInterval    = fromIntegral $ r!Zones.refresh
  57                    , soaRetryInterval      = fromIntegral $ r!Zones.retry
  58                    , soaExpirationLimit    = fromIntegral $ r!Zones.expire
  59                    , soaMinimumTTL         = fromIntegral $ r!Zones.minTTL
  60                    }
  61            _   -> return Nothing