X-Git-Url: https://code.grnet.gr/git/ganeti-local/blobdiff_plain/aff363a42d670f1b3100a98aab6f17b49f644179..e4c5beaf3ee5cf16fd40573e3afe9a708b58bb4f:/Ganeti/HTools/Rapi.hs diff --git a/Ganeti/HTools/Rapi.hs b/Ganeti/HTools/Rapi.hs index 5373293..58540e1 100644 --- a/Ganeti/HTools/Rapi.hs +++ b/Ganeti/HTools/Rapi.hs @@ -4,100 +4,95 @@ 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)) -getInstances :: String -> IO (Either String String) -getInstances master = do - let url2 = printf "https://%s:5080/2/instances?bulk=1" master - body <- getUrl url2 - let inst = body `combineEithers` - loadJSArray `combineEithers` - (parseEitherList parseInstance) - return inst +-- | 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 (Either String String) -getNodes master = do - let url2 = printf "https://%s:5080/2/nodes?bulk=1" master - body <- getUrl url2 - let inst = body `combineEithers` - loadJSArray `combineEithers` - (parseEitherList parseNode) - return inst +getNodes :: String -> Result [(String, Node.Node)] +getNodes body = do + arr <- loadJSArray body + nlist <- mapM parseNode arr + return nlist -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 +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 :: Bool -> Either String String -boolToYN True = Right "Y" -boolToYN _ = Right "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 -> Either String 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 $ - (case offline of - Right True -> Right "0|0|0|0|0|Y" - _ -> - concatEitherElems (show `applyEither1` mtotal) $ - concatEitherElems (show `applyEither1` mnode) $ - concatEitherElems (show `applyEither1` mfree) $ - concatEitherElems (show `applyEither1` dtotal) $ - concatEitherElems (show `applyEither1` dfree) - ((applyEither2 (||) offline drained) `combineEithers` 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)