X-Git-Url: https://code.grnet.gr/git/ganeti-local/blobdiff_plain/190ce47cbc5195bf0df8ca707463eaf3ab492836..e4c5beaf3ee5cf16fd40573e3afe9a708b58bb4f:/Ganeti/HTools/Rapi.hs diff --git a/Ganeti/HTools/Rapi.hs b/Ganeti/HTools/Rapi.hs index da1a9b5..58540e1 100644 --- a/Ganeti/HTools/Rapi.hs +++ b/Ganeti/HTools/Rapi.hs @@ -4,177 +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 () +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 --- Some constants - --- | The fixed drbd overhead per disk (only used with 1.2's sdx_size) -drbdOverhead = 128 - -{-- Our cheap monad-like stuff. - -Thi is needed since Either e a is already a monad instance somewhere -in the standard libraries (Control.Monad.Error) and we don't need that -entire thing. - --} -combine :: (Either String a) -> (a -> Either String b) -> (Either String b) -combine (Left s) _ = Left s -combine (Right s) f = f s - -ensureList :: [Either String a] -> Either String [a] -ensureList lst = - foldr (\elem accu -> - case (elem, accu) of - (Left x, _) -> Left x - (_, Left x) -> Left x -- should never happen - (Right e, Right a) -> Right (e:a) - ) - (Right []) lst - -listHead :: Either String [a] -> Either String a -listHead lst = - case lst of - Left x -> Left x - Right (x:_) -> Right x - Right [] -> Left "List empty" - -loadJSArray :: String -> Either String [JSObject JSValue] -loadJSArray s = resultToEither $ decodeStrict s - -fromObj :: JSON a => String -> JSObject JSValue -> Either String a -fromObj k o = - case lookup k (fromJSObject o) of - Nothing -> Left $ printf "key '%s' not found" k - Just val -> resultToEither $ readJSON val - -getStringElement :: String -> JSObject JSValue -> Either String String -getStringElement = fromObj - -getIntElement :: String -> JSObject JSValue -> Either String Int -getIntElement = fromObj - -getListElement :: String -> JSObject JSValue - -> Either String [JSValue] -getListElement = fromObj - -readString :: JSValue -> Either String String -readString v = - case v of - JSString s -> Right $ fromJSString s - _ -> Left "Wrong JSON type" - -concatElems :: Either String String - -> Either String String - -> Either String String -concatElems = apply2 (\x y -> x ++ "|" ++ y) - -apply1 :: (a -> b) -> Either String a -> Either String b -apply1 fn a = - case a of - Left x -> Left x - Right y -> Right $ fn y - -apply2 :: (a -> b -> c) - -> Either String a - -> Either String b - -> Either String c -apply2 fn a b = - case (a, b) of - (Right x, Right y) -> Right $ fn x y - (Left x, _) -> Left x - (_, Left y) -> Left y - -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) - -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 `combine` loadJSArray `combine` (parseList parseInstance) - return inst - -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 `combine` loadJSArray `combine` (parseList parseNode) - return inst - -parseList :: (JSObject JSValue -> Either String String) - -> [JSObject JSValue] - ->Either String String -parseList fn idata = - let ml = ensureList $ map fn idata - in ml `combine` (Right . unlines) - -parseInstance :: JSObject JSValue -> Either String String -parseInstance a = - let name = getStringElement "name" a - disk = case getIntElement "disk_usage" a of - Left _ -> let log_sz = apply2 (+) - (getIntElement "sda_size" a) - (getIntElement "sdb_size" a) - in apply2 (+) log_sz (Right $ drbdOverhead * 2) - Right x -> Right x - bep = fromObj "beparams" a - pnode = getStringElement "pnode" a - snode = (listHead $ getListElement "snodes" a) `combine` readString - mem = case bep of - Left _ -> getIntElement "admin_ram" a - Right o -> getIntElement "memory" o - running = getStringElement "status" a - in - concatElems name $ - concatElems (show `apply1` mem) $ - concatElems (show `apply1` disk) $ - concatElems running $ - concatElems pnode snode - -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 concatElems name $ - concatElems (show `apply1` mtotal) $ - concatElems (show `apply1` mnode) $ - concatElems (show `apply1` mfree) $ - concatElems (show `apply1` dtotal) (show `apply1` dfree) +-- | 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 -> Result [(String, Node.Node)] +getNodes body = do + arr <- loadJSArray body + nlist <- mapM parseNode arr + return nlist + +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) + +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) + +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)