X-Git-Url: https://code.grnet.gr/git/ganeti-local/blobdiff_plain/c352b0a9c78e2bd6e2def4fc090e3533c2cb5191..b20cbf06e76dec772a22a14cfb23250c2fba0063:/htools/Ganeti/HTools/Rapi.hs diff --git a/htools/Ganeti/HTools/Rapi.hs b/htools/Ganeti/HTools/Rapi.hs index c2d79ce..ce310ed 100644 --- a/htools/Ganeti/HTools/Rapi.hs +++ b/htools/Ganeti/HTools/Rapi.hs @@ -37,7 +37,7 @@ import Network.Curl import Network.Curl.Types () #endif import Control.Monad -import Text.JSON (JSObject, JSValue, fromJSObject, decodeStrict) +import Text.JSON (JSObject, fromJSObject, decodeStrict) import Text.JSON.Types (JSValue(..)) import Text.Printf (printf) @@ -47,6 +47,7 @@ import Ganeti.HTools.Types import qualified Ganeti.HTools.Group as Group import qualified Ganeti.HTools.Node as Node import qualified Ganeti.HTools.Instance as Instance +import qualified Ganeti.Constants as C -- | Read an URL via curl and return the body if successful. getUrl :: (Monad m) => String -> IO (m String) @@ -56,7 +57,7 @@ getUrl _ = return $ fail "RAPI/curl backend disabled at compile time" #else --- | The curl options we use +-- | The curl options we use. curlOpts :: [CurlOption] curlOpts = [ CurlSSLVerifyPeer False , CurlSSLVerifyHost 0 @@ -76,7 +77,7 @@ getUrl url = do formatHost :: String -> String formatHost master = if ':' `elem` master then master - else "https://" ++ master ++ ":5080" + else "https://" ++ master ++ ":" ++ show C.defaultRapiPort -- | Parse a instance list in JSON format. getInstances :: NameAssoc @@ -96,18 +97,13 @@ getGroups :: String -> Result [(String, Group.Group)] getGroups body = loadJSArray "Parsing group data" body >>= mapM (parseGroup . fromJSObject) -getFakeGroups :: Result [(String, Group.Group)] -getFakeGroups = - return [(defaultGroupID, - Group.create "default" defaultGroupID AllocPreferred)] - -- | Construct an instance from a JSON object. parseInstance :: NameAssoc - -> [(String, JSValue)] + -> JSRecord -> Result (String, Instance.Instance) parseInstance ktn a = do name <- tryFromObj "Parsing new instance" a "name" - let owner_name = "Instance '" ++ name ++ "'" + let owner_name = "Instance '" ++ name ++ "', error while parsing data" let extract s x = tryFromObj owner_name x s disk <- extract "disk_usage" a beparams <- liftM fromJSObject (extract "beparams" a) @@ -122,14 +118,17 @@ parseInstance ktn a = do else readEitherString (head snodes) >>= lookupNode ktn name) running <- extract "status" a tags <- extract "tags" a - let inst = Instance.create name mem disk vcpus running tags True pnode snode + auto_balance <- extract "auto_balance" beparams + dt <- extract "disk_template" a + let inst = Instance.create name mem disk vcpus running tags + auto_balance pnode snode dt return (name, inst) -- | Construct a node from a JSON object. -parseNode :: NameAssoc -> [(String, JSValue)] -> Result (String, Node.Node) +parseNode :: NameAssoc -> JSRecord -> Result (String, Node.Node) parseNode ktg a = do name <- tryFromObj "Parsing new node" a "name" - let desc = "Node '" ++ name ++ "'" + let desc = "Node '" ++ name ++ "', error while parsing data" extract s = tryFromObj desc a s offline <- extract "offline" drained <- extract "drained" @@ -151,7 +150,7 @@ parseNode ktg a = do return (name, node) -- | Construct a group from a JSON object. -parseGroup :: [(String, JSValue)] -> Result (String, Group.Group) +parseGroup :: JSRecord -> Result (String, Group.Group) parseGroup a = do name <- tryFromObj "Parsing new group" a "name" let extract s = tryFromObj ("Group '" ++ name ++ "'") a s @@ -170,16 +169,11 @@ readData master = do tags_body <- getUrl $ printf "%s/2/tags" url return (group_body, node_body, inst_body, tags_body) --- | Builds the cluster data from the raw Rapi content +-- | Builds the cluster data from the raw Rapi content. parseData :: (Result String, Result String, Result String, Result String) -> Result ClusterData parseData (group_body, node_body, inst_body, tags_body) = do - group_data <- - -- TODO: handle different ganeti versions properly, not via "all - -- errors mean Ganeti 2.3" - case group_body of - Bad _ -> getFakeGroups - Ok v -> getGroups v + group_data <- group_body >>= getGroups let (group_names, group_idx) = assignIndices group_data node_data <- node_body >>= getNodes group_names let (node_names, node_idx) = assignIndices node_data @@ -188,7 +182,7 @@ parseData (group_body, node_body, inst_body, tags_body) = do tags_data <- tags_body >>= (fromJResult "Parsing tags data" . decodeStrict) return (ClusterData group_idx node_idx inst_idx tags_data) --- | Top level function for data loading +-- | Top level function for data loading. loadData :: String -- ^ Cluster or URL to use as source -> IO (Result ClusterData) loadData = fmap parseData . readData