X-Git-Url: https://code.grnet.gr/git/ganeti-local/blobdiff_plain/ba00ad4d6922b04bbe68f60d1a505d4ca7185f84..e4c5beaf3ee5cf16fd40573e3afe9a708b58bb4f:/Ganeti/HTools/Rapi.hs

diff --git a/Ganeti/HTools/Rapi.hs b/Ganeti/HTools/Rapi.hs
index 88b5fe3..58540e1 100644
--- a/Ganeti/HTools/Rapi.hs
+++ b/Ganeti/HTools/Rapi.hs
@@ -4,19 +4,22 @@
 
 module Ganeti.HTools.Rapi
     (
-      getNodes
-    , getInstances
+      loadData
     ) where
 
 import Network.Curl
 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
+import Ganeti.HTools.Loader
+import Ganeti.HTools.Types
+import qualified Ganeti.HTools.Node as Node
+import qualified Ganeti.HTools.Instance as Instance
 
 -- | Read an URL via curl and return the body if successful
 getUrl :: (Monad m) => String -> IO (m String)
@@ -28,57 +31,68 @@ getUrl url = do
             _ -> fail $ printf "Curl error for '%s', error %s"
                  url (show code))
 
-getInstances :: String -> IO (Result String)
-getInstances master = do
-  let url2 = printf "https://%s:5080/2/instances?bulk=1" master
-  body <- getUrl url2
-  return $ (body >>= \x -> do
-              arr <- loadJSArray x
-              ilist <- mapM parseInstance arr
-              return $ unlines ilist)
+-- | Append the default port if not passed in
+formatHost :: String -> String
+formatHost master =
+    if elem ':' master then  master
+    else "https://" ++ master ++ ":5080"
+
+getInstances :: NameAssoc
+             -> String
+             -> Result [(String, Instance.Instance)]
+getInstances ktn body = do
+  arr <- loadJSArray body
+  ilist <- mapM (parseInstance ktn) arr
+  return ilist
 
-getNodes :: String -> IO (Result String)
-getNodes master = do
-  let url2 = printf "https://%s:5080/2/nodes?bulk=1" master
-  body <- getUrl url2
-  return $ (body >>= \x -> do
-             arr <- loadJSArray x
-             nlist <- mapM parseNode arr
-             return $ unlines nlist)
+getNodes :: String -> Result [(String, Node.Node)]
+getNodes body = do
+  arr <- loadJSArray body
+  nlist <- mapM parseNode arr
+  return nlist
 
-parseInstance :: JSObject JSValue -> Result String
-parseInstance a =
-    let name = getStringElement "name" a
-        disk = getIntElement "disk_usage" a
-        mem = getObjectElement "beparams" a >>= getIntElement "memory"
-        pnode = getStringElement "pnode" a
-        snode = (liftM head $ getListElement "snodes" a) >>= readEitherString
-        running = getStringElement "status" a
-    in
-      name |+ (show `liftM` mem) |+
-              (show `liftM` disk) |+
-              running |+ pnode |+ snode
+parseInstance :: [(String, Int)]
+              -> JSObject JSValue
+              -> Result (String, Instance.Instance)
+parseInstance ktn a = do
+  name <- fromObj "name" a
+  disk <- fromObj "disk_usage" a
+  mem <- fromObj "beparams" a >>= fromObj "memory"
+  pnode <- fromObj "pnode" a >>= lookupNode ktn name
+  snodes <- fromObj "snodes" a
+  snode <- (if null snodes then return Node.noSecondary
+            else readEitherString (head snodes) >>= lookupNode ktn name)
+  running <- fromObj "status" a
+  let inst = Instance.create mem disk running pnode snode
+  return (name, inst)
 
-boolToYN :: (Monad m) => Bool -> m String
-boolToYN True = return "Y"
-boolToYN _ = return "N"
+parseNode :: JSObject JSValue -> Result (String, Node.Node)
+parseNode a = do
+    name <- fromObj "name" a
+    offline <- fromObj "offline" a
+    node <- (case offline of
+               True -> return $ Node.create 0 0 0 0 0 True
+               _ -> do
+                 drained <- fromObj "drained" a
+                 mtotal <- fromObj "mtotal" a
+                 mnode <- fromObj "mnode" a
+                 mfree <- fromObj "mfree" a
+                 dtotal <- fromObj "dtotal" a
+                 dfree <- fromObj "dfree" a
+                 return $ Node.create mtotal mnode mfree
+                        dtotal dfree (offline || drained))
+    return (name, node)
 
-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 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)
-       )
+loadData :: String -- ^ Cluster/URL to use as source
+         -> IO (Result (NameAssoc, Node.AssocList,
+                        NameAssoc, Instance.AssocList))
+loadData master = do -- IO monad
+  let url = formatHost master
+  node_body <- getUrl $ printf "%s/2/nodes?bulk=1" url
+  inst_body <- getUrl $ printf "%s/2/instances?bulk=1" url
+  return $ do -- Result monad
+    node_data <- node_body >>= getNodes
+    let (node_names, node_idx) = assignIndices Node.setIdx node_data
+    inst_data <- inst_body >>= getInstances node_names
+    let (inst_names, inst_idx) = assignIndices Instance.setIdx inst_data
+    return (node_names, node_idx, inst_names, inst_idx)