X-Git-Url: https://code.grnet.gr/git/ganeti-local/blobdiff_plain/9ba5c28f70085d8cd2c853156857881802e69c0f..585d442011204bb0b5b57dc30e4d17adc6bf1e8f:/Ganeti/HTools/Rapi.hs

diff --git a/Ganeti/HTools/Rapi.hs b/Ganeti/HTools/Rapi.hs
index c6db593..786bfe1 100644
--- a/Ganeti/HTools/Rapi.hs
+++ b/Ganeti/HTools/Rapi.hs
@@ -13,94 +13,79 @@ import Network.Curl.Types ()
 import Network.Curl.Code
 import Data.Either ()
 import Data.Maybe
+import Data.List
 import Control.Monad
-import Text.JSON
+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 (Either String 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 -> Right body
-            _ -> Left $ printf "Curl error for '%s', error %s"
+            CurlOK -> return body
+            _ -> fail $ printf "Curl error for '%s', error %s"
                  url (show code))
 
-tryRapi :: String -> String -> IO (Either String String)
-tryRapi url1 url2 =
-    do
-      body1 <- getUrl url1
-      (case body1 of
-         Left _ -> getUrl url2
-         Right _ -> return body1)
+-- | 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 (Either String String)
-getInstances master =
-    let
-        url2 = printf "https://%s:5080/2/instances?bulk=1" master
-        url1 = printf "http://%s:5080/instances?bulk=1" master
-    in do
-      body <- tryRapi url1 url2
-      let inst = body `combineEithers`
-                 loadJSArray `combineEithers`
-                 (parseEitherList parseInstance)
-      return inst
+getInstances :: String -> IO (Result String)
+getInstances master = do
+  let url2 = printf "%s/2/instances?bulk=1" (formatHost master)
+  body <- getUrl url2
+  return $ (do x <- body
+               arr <- loadJSArray x
+               ilist <- mapM parseInstance arr
+               return $ unlines ilist)
 
-getNodes :: String -> IO (Either String String)
-getNodes master =
-    let
-        url2 = printf "https://%s:5080/2/nodes?bulk=1" master
-        url1 = printf "http://%s:5080/nodes?bulk=1" master
-    in do
-      body <- tryRapi url1 url2
-      let inst = body `combineEithers`
-                 loadJSArray `combineEithers`
-                 (parseEitherList parseNode)
-      return inst
+getNodes :: String -> IO (Result String)
+getNodes master = do
+  let url2 = printf "%s/2/nodes?bulk=1" (formatHost master)
+  body <- getUrl url2
+  return $ (do x <- body
+               arr <- loadJSArray x
+               nlist <- mapM parseNode arr
+               return $ unlines nlist)
 
-parseInstance :: JSObject JSValue -> Either String String
+parseInstance :: JSObject JSValue -> Result String
 parseInstance a =
     let name = getStringElement "name" a
-        disk = case getIntElement "disk_usage" a of
-                 Left _ -> let log_sz = applyEither2 (+)
-                                        (getIntElement "sda_size" a)
-                                        (getIntElement "sdb_size" a)
-                           in applyEither2 (+) log_sz
-                                  (Right $ drbdOverhead * 2)
-                 Right x -> Right x
-        bep = fromObj "beparams" a
+        disk = getIntElement "disk_usage" a
+        mem = getObjectElement "beparams" a >>= getIntElement "memory"
         pnode = getStringElement "pnode" a
-        snode = (eitherListHead $ getListElement "snodes" a)
-                `combineEithers` readEitherString
-        mem = case bep of
-                Left _ -> getIntElement "admin_ram" a
-                Right o -> getIntElement "memory" o
+        snode = (liftM head $ getListElement "snodes" a) >>= readEitherString
         running = getStringElement "status" a
     in
-      concatEitherElems name $
-                  concatEitherElems (show `applyEither1` mem) $
-                  concatEitherElems (show `applyEither1` disk) $
-                  concatEitherElems running $
-                  concatEitherElems pnode snode
+      name |+ (show `liftM` mem) |+
+              (show `liftM` disk) |+
+              running |+ pnode |+ snode
+
+boolToYN :: (Monad m) => Bool -> m String
+boolToYN True = return "Y"
+boolToYN _ = return "N"
 
-parseNode :: JSObject JSValue -> Either String String
+parseNode :: JSObject JSValue -> Result String
 parseNode a =
     let name = getStringElement "name" a
+        offline = getBoolElement "offline" a
+        drained = getBoolElement "drained" a
         mtotal = getIntElement "mtotal" a
         mnode = getIntElement "mnode" a
         mfree = getIntElement "mfree" a
         dtotal = getIntElement "dtotal" a
         dfree = getIntElement "dfree" a
-    in concatEitherElems name $
-       concatEitherElems (show `applyEither1` mtotal) $
-       concatEitherElems (show `applyEither1` mnode) $
-       concatEitherElems (show `applyEither1` mfree) $
-       concatEitherElems (show `applyEither1` dtotal)
-                             (show `applyEither1` dfree)
+    in name |+
+       (case offline of
+          Ok True -> Ok "0|0|0|0|0|Y"
+          _ ->
+              (show `liftM` mtotal) |+ (show `liftM` mnode) |+
+              (show `liftM` mfree) |+ (show `liftM` dtotal) |+
+              (show `liftM` dfree) |+
+              ((liftM2 (||) offline drained) >>= boolToYN)
+       )