Make IAlloc.loadData return maps
[ganeti-local] / Ganeti / HTools / Rapi.hs
index c6db593..ac0ff44 100644 (file)
 
 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
+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
+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
 
-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 :: NameAssoc
+             -> String
+             -> Result [(String, Instance.Instance)]
+getInstances ktn body = do
+  arr <- loadJSArray body
+  ilist <- mapM (parseInstance ktn) arr
+  return ilist
 
-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
+getNodes :: String -> Result [(String, Node.Node)]
+getNodes body = do
+  arr <- loadJSArray body
+  nlist <- mapM parseNode arr
+  return nlist
 
-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
+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 name mem disk running pnode snode
+  return (name, inst)
 
-parseInstance :: JSObject JSValue -> Either String 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
-        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
-        running = getStringElement "status" a
-    in
-      concatEitherElems name $
-                  concatEitherElems (show `applyEither1` mem) $
-                  concatEitherElems (show `applyEither1` disk) $
-                  concatEitherElems running $
-                  concatEitherElems pnode snode
+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 name 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 name mtotal mnode mfree
+                        dtotal dfree (offline || drained))
+    return (name, node)
 
-parseNode :: JSObject JSValue -> Either String String
-parseNode a =
-    let name = getStringElement "name" 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)
+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_data
+    inst_data <- inst_body >>= getInstances node_names
+    let (inst_names, inst_idx) = assignIndices inst_data
+    return (node_names, node_idx, inst_names, inst_idx)