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
-
-
--- 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 (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))
-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 = 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
- 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
- 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 name 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 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 -> 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_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)