Code cleanup

diff --git a/DDNS/Client/MakeReq.hs b/DDNS/Client/MakeReq.hs
index b9baa49c5b7eb31e99fd0cc5fb4a31c1f3b64a6c..57140441c6e8596b4b990c4b78830f98c518eee9 100644 (file)
--- a/DDNS/Client/MakeReq.hs
+++ b/DDNS/Client/MakeReq.hs
@@ -18,10 +18,9 @@ makeReq :: IO ()
 makeReq
     = do fqdn <- runInputT defaultSettings $
                  do defaultFqdn <- liftM uNodeName $ liftIO uname
-                    fqdn        <- getInputLine ("What's your FQDN? (default: " ++ defaultFqdn ++ "): ")
-                    case trim fqdn of
-                      Just s -> return s
-                      _      -> return defaultFqdn
+                    getInputLineWithDefault
+                        ("What's your FQDN? (default: " ++ defaultFqdn ++ "): ")
+                        defaultFqdn
 
          putStrLn "Generating RSA keypair..."
          key <- generateRSAKey 1024 3 Nothing

diff --git a/DDNS/Server.hs b/DDNS/Server.hs
index aedeadd1889ab6d5649c666f8ec1d90438b78593..c1e85407ac6c7e84429f861becead021f5ad6db2 100644 (file)
--- a/DDNS/Server.hs
+++ b/DDNS/Server.hs
@@ -38,10 +38,9 @@ ensureWeHaveKeypair lsdir
            else
              do fqdn <- runInputT defaultSettings $
                         do defaultFqdn <- liftM uNodeName $ liftIO uname
-                           fqdn        <- getInputLine ("What's your FQDN? (default: " ++ defaultFqdn ++ "): ")
-                           case trim fqdn of
-                             Just s -> return s
-                             _      -> return defaultFqdn
+                           getInputLineWithDefault
+                               ("What's your FQDN? (default: " ++ defaultFqdn ++ "): ")
+                               defaultFqdn
 
                 putStrLn "Generating RSA keypair..."
                 key <- generateRSAKey 1024 3 Nothing

diff --git a/DDNS/Server/EditZone.hs b/DDNS/Server/EditZone.hs
index 510d41540d9194fddd4fadda7626a166ae5a88d4..44120ebaca7168248752e38defeae6496ea896a4 100644 (file)
--- a/DDNS/Server/EditZone.hs
+++ b/DDNS/Server/EditZone.hs
@@ -4,7 +4,6 @@ module DDNS.Server.EditZone
     where
 
 import           Control.Monad
-import           Control.Monad.Trans
 import           DDNS.Utils
 import           DDNS.Zone
 import           Database.HaskellDB
@@ -12,11 +11,8 @@ import           System.Console.Haskeline
 
 editZone :: Database -> IO ()
 editZone db
-    = runInputT (setComplete (completeZoneName db) defaultSettings) $
-      do zoneNameStr <- getInputLine "Which zone do you want to edit (or create?): "
-         case trim zoneNameStr of
-           Just zoneNameStr'
-               -> liftIO $
-                  do --let zone = read zoneNameStr'
-                     fail zoneNameStr'
-           _   -> return ()
+    = do zone <- runInputT (setComplete (completeZoneName db) defaultSettings) $
+                 do name <- getInputLine' "Which zone do you want to edit (or create?): "
+                    return $ read name
+         soa <- getZone db zone
+         print soa

diff --git a/DDNS/Server/SignReq.hs b/DDNS/Server/SignReq.hs
index cfc4826708a52a463e73ae23213833a571491395..6bcfeffbc8ab45279d71fe0a8576804bfe89db39 100644 (file)
--- a/DDNS/Server/SignReq.hs
+++ b/DDNS/Server/SignReq.hs
@@ -20,11 +20,8 @@ import           System.IO
 signReq :: KeyPair k => k -> X509 -> IO ()
 signReq sKey sCert
     = runInputT (setComplete completeFilename defaultSettings) $
-      do file <- getInputLine "Which X.509 request do you want to sign?: "
-         case trim file of
-           Just file'
-               -> liftIO $
-                  do req <- readX509Req =<< readFile file'
+      do file <- getInputLine' "Which X.509 request do you want to sign?: "
+         liftIO $ do req <- readX509Req =<< readFile file
                      key <- Req.getPublicKey req
                      vst <- verifyX509Req req key
                      unless (vst == VerifySuccess)
@@ -36,11 +33,10 @@ signReq sKey sCert
                      setNotAfter     cert =<< liftM (addUTCTime (20 * 365 * 24 * 60 * 60)) getCurrentTime
                      signX509        cert sKey Nothing
 
-                     let certFile = file' `replaceExtension` ".cert"
+                     let certFile = file `replaceExtension` ".cert"
                      withFile certFile WriteMode $ \ h ->
                          writeX509 cert >>= hPutStr h
                      putStrLn ("Wrote " ++ certFile)
 
                      Just (_, fqdn) <- liftM (find ((== "CN") . fst)) $ X509.getSubjectName cert False
                      putStrLn ("Now send " ++ certFile ++ " back to " ++ fqdn ++ ".")
-           _   -> return ()

diff --git a/DDNS/Utils.hs b/DDNS/Utils.hs
index 9c32824c0828722226b0c89e68ecb29984a0f0f1..b1b5687b674dece01e91071cbbfecf9c19e2481b 100644 (file)
--- a/DDNS/Utils.hs
+++ b/DDNS/Utils.hs
@@ -1,8 +1,13 @@
 module DDNS.Utils
     ( trim
+    , getInputLine'
+    , getInputLineWithDefault
     )
     where
 
+import           System.Console.Haskeline
+
+
 trim :: Maybe String -> Maybe String
 trim Nothing   = Nothing
 trim (Just xs) = case trimTail $ trimHead xs of
@@ -14,3 +19,17 @@ trim (Just xs) = case trimTail $ trimHead xs of
       trimHead ys       = ys
 
       trimTail = reverse . trimHead . reverse
+
+getInputLine' :: MonadException m => String -> InputT m String
+getInputLine' prompt
+    = do ret <- getInputLine prompt
+         case trim ret of
+           Just ret' -> return ret'
+           Nothing   -> fail "No input"
+
+getInputLineWithDefault :: MonadException m => String -> String -> InputT m String
+getInputLineWithDefault prompt defaultStr
+    = do ret <- getInputLine prompt
+         case trim ret of
+           Just ret' -> return ret'
+           Nothing   -> return defaultStr

diff --git a/DDNS/Zone.hs b/DDNS/Zone.hs
index aca51e9b4c8b7cfafe69ae90801e5d81b9a49ab4..e5d4af519a3ef2ed485f958324366f1d1a76f839 100644 (file)
--- a/DDNS/Zone.hs
+++ b/DDNS/Zone.hs
@@ -1,6 +1,8 @@
 module DDNS.Zone
     ( listZones
     , completeZoneName
+
+    , getZone
     )
     where
 
@@ -39,3 +41,21 @@ completeZoneName db
             , display     = zn
             , isFinished  = True
             }
+
+getZone :: Database -> DomainName -> IO (Maybe SOAFields)
+getZone db name
+    = do rows <- query db $
+                 do t <- table Zones.zones
+                    restrict (t!Zones.zone .==. constant (show name))
+                    return t
+         case rows of
+           [r] -> return $ Just SOAFields {
+                     soaMasterNameServer   = read $ r!Zones.ns
+                   , soaResponsibleMailbox = read $ r!Zones.owner
+                   , soaSerialNumber       = fromIntegral $ r!Zones.serial
+                   , soaRefreshInterval    = fromIntegral $ r!Zones.refresh
+                   , soaRetryInterval      = fromIntegral $ r!Zones.retry
+                   , soaExpirationLimit    = fromIntegral $ r!Zones.expire
+                   , soaMinimumTTL         = fromIntegral $ r!Zones.minTTL
+                   }
+           _   -> return Nothing
\ No newline at end of file