Small syntax improvement

[ganeti-local] / Ganeti / HTools / Rapi.hs

diff --git a/Ganeti/HTools/Rapi.hs b/Ganeti/HTools/Rapi.hs
index e504981..786bfe1 100644 (file)
--- a/Ganeti/HTools/Rapi.hs
+++ b/Ganeti/HTools/Rapi.hs
@@ -13,69 +13,62 @@ import Network.Curl.Types ()
 import Network.Curl.Code
 import Data.Either ()
 import Data.Maybe
+import Data.List
 import Control.Monad
 import Text.JSON (JSObject, JSValue)
 import Text.Printf (printf)
 import Ganeti.HTools.Utils
 
-
--- Some constants
-
--- | The fixed drbd overhead per disk (only used with 1.2's sdx_size)
-drbdOverhead = 128
-
-getUrl :: String -> IO (Result String)
+-- | Read an URL via curl and return the body if successful
+getUrl :: (Monad m) => String -> IO (m String)
 getUrl url = do
   (code, body) <- curlGetString url [CurlSSLVerifyPeer False,
                                      CurlSSLVerifyHost 0]
   return (case code of
-            CurlOK -> Ok body
-            _ -> Bad $ printf "Curl error for '%s', error %s"
+            CurlOK -> return body
+            _ -> fail $ printf "Curl error for '%s', error %s"
                  url (show code))
 
+-- | Append the default port if not passed in
+formatHost :: String -> String
+formatHost master =
+    if elem ':' master then  master
+    else "https://" ++ master ++ ":5080"
+
 getInstances :: String -> IO (Result String)
 getInstances master = do
-  let url2 = printf "https://%s:5080/2/instances?bulk=1" master
+  let url2 = printf "%s/2/instances?bulk=1" (formatHost master)
   body <- getUrl url2
-  return $ (body >>= \x -> do
-              arr <- loadJSArray x
-              ilist <- mapM parseInstance arr
-              return $ unlines ilist)
+  return $ (do x <- body
+               arr <- loadJSArray x
+               ilist <- mapM parseInstance arr
+               return $ unlines ilist)
 
 getNodes :: String -> IO (Result String)
 getNodes master = do
-  let url2 = printf "https://%s:5080/2/nodes?bulk=1" master
+  let url2 = printf "%s/2/nodes?bulk=1" (formatHost master)
   body <- getUrl url2
-  return $ (body >>= \x -> do
-             arr <- loadJSArray x
-             nlist <- mapM parseNode arr
-             return $ unlines nlist)
+  return $ (do x <- body
+               arr <- loadJSArray x
+               nlist <- mapM parseNode arr
+               return $ unlines nlist)
 
 parseInstance :: JSObject JSValue -> Result String
 parseInstance a =
     let name = getStringElement "name" a
-        disk = case getIntElement "disk_usage" a of
-                 Bad _ -> let log_sz = liftM2 (+)
-                                       (getIntElement "sda_size" a)
-                                       (getIntElement "sdb_size" a)
-                          in liftM2 (+) log_sz (Ok $ drbdOverhead * 2)
-                 x@(Ok _) -> x
-        bep = fromObj "beparams" a
+        disk = getIntElement "disk_usage" a
+        mem = getObjectElement "beparams" a >>= getIntElement "memory"
         pnode = getStringElement "pnode" a
-        snode = (liftM head $ getListElement "snodes" a)
-                >>= readEitherString
-        mem = case bep of
-                Bad _ -> getIntElement "admin_ram" a
-                Ok o -> getIntElement "memory" o
+        snode = (liftM head $ getListElement "snodes" a) >>= readEitherString
         running = getStringElement "status" a
     in
       name |+ (show `liftM` mem) |+
               (show `liftM` disk) |+
               running |+ pnode |+ snode
 
-boolToYN :: Bool -> Result String
-boolToYN True = Ok "Y"
-boolToYN _ = Ok "N"
+boolToYN :: (Monad m) => Bool -> m String
+boolToYN True = return "Y"
+boolToYN _ = return "N"
 
 parseNode :: JSObject JSValue -> Result String
 parseNode a =