From: PHO <pho@cielonegro.org>
Date: Sat, 6 Jun 2009 05:31:11 +0000 (+0900)
Subject: Code cleanup
X-Git-Url: https://git.cielonegro.org/gitweb.cgi?a=commitdiff_plain;h=1abf9ad51c79257c0bce8e134fdd48a2ff0ef373;p=blackboard-dns.git

Code cleanup
---

diff --git a/DDNS/Client/MakeReq.hs b/DDNS/Client/MakeReq.hs
index b9baa49..5714044 100644
--- 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 aedeadd..c1e8540 100644
--- 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 510d415..44120eb 100644
--- 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 cfc4826..6bcfeff 100644
--- 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 9c32824..b1b5687 100644
--- 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 aca51e9..e5d4af5 100644
--- 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