X-Git-Url: https://code.grnet.gr/git/ganeti-local/blobdiff_plain/9ba5c28f70085d8cd2c853156857881802e69c0f..497e30a1b9417b47b20a785551615e40ffac30a6:/Ganeti/HTools/Rapi.hs?ds=sidebyside diff --git a/Ganeti/HTools/Rapi.hs b/Ganeti/HTools/Rapi.hs index c6db593..ac0ff44 100644 --- a/Ganeti/HTools/Rapi.hs +++ b/Ganeti/HTools/Rapi.hs @@ -4,103 +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)) -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)