module Ganeti.HTools.Rapi
(
loadData
) where
import Network.Curl
import Network.Curl.Types ()
import Control.Monad
import Text.JSON (JSObject, JSValue, fromJSObject, decodeStrict)
import Text.JSON.Types (JSValue(..))
import Text.Printf (printf)
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 :: (Monad m) => String -> IO (m String)
getUrl url = do
(code, body) <- curlGetString url [CurlSSLVerifyPeer False,
CurlSSLVerifyHost 0,
CurlTimeout (fromIntegral queryTimeout),
CurlConnectTimeout
(fromIntegral connTimeout)]
return (case code of
CurlOK -> return body
_ -> fail $ printf "Curl error for '%s', error %s"
url (show code))
formatHost :: String -> String
formatHost master =
if ':' `elem` master then master
else "https://" ++ master ++ ":5080"
getInstances :: NameAssoc
-> String
-> Result [(String, Instance.Instance)]
getInstances ktn body =
loadJSArray "Parsing instance data" body >>=
mapM (parseInstance ktn . fromJSObject)
getNodes :: String -> Result [(String, Node.Node)]
getNodes body = loadJSArray "Parsing node data" body >>=
mapM (parseNode . fromJSObject)
parseInstance :: [(String, Ndx)]
-> [(String, JSValue)]
-> Result (String, Instance.Instance)
parseInstance ktn a = do
name <- tryFromObj "Parsing new instance" a "name"
let owner_name = "Instance '" ++ name ++ "'"
let extract s x = tryFromObj owner_name x s
disk <- extract "disk_usage" a
beparams <- liftM fromJSObject (extract "beparams" a)
omem <- extract "oper_ram" a
mem <- (case omem of
JSRational _ _ -> annotateResult owner_name (fromJVal omem)
_ -> extract "memory" beparams)
vcpus <- extract "vcpus" beparams
pnode <- extract "pnode" a >>= lookupNode ktn name
snodes <- extract "snodes" a
snode <- (if null snodes then return Node.noSecondary
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 pnode snode
return (name, inst)
parseNode :: [(String, JSValue)] -> Result (String, Node.Node)
parseNode a = do
name <- tryFromObj "Parsing new node" a "name"
let extract s = tryFromObj ("Node '" ++ name ++ "'") a s
offline <- extract "offline"
drained <- extract "drained"
node <- (if offline || drained
then return $ Node.create name 0 0 0 0 0 0 True
else do
mtotal <- extract "mtotal"
mnode <- extract "mnode"
mfree <- extract "mfree"
dtotal <- extract "dtotal"
dfree <- extract "dfree"
ctotal <- extract "ctotal"
return $ Node.create name mtotal mnode mfree
dtotal dfree ctotal False)
return (name, node)
loadData :: String
-> IO (Result (Node.AssocList, Instance.AssocList, [String]))
loadData master = do
let url = formatHost master
node_body <- getUrl $ printf "%s/2/nodes?bulk=1" url
inst_body <- getUrl $ printf "%s/2/instances?bulk=1" url
tags_body <- getUrl $ printf "%s/2/tags" url
return $ do
node_data <- node_body >>= getNodes
let (node_names, node_idx) = assignIndices node_data
inst_data <- inst_body >>= getInstances node_names
let (_, inst_idx) = assignIndices inst_data
tags_data <- tags_body >>= (fromJResult "Parsing tags data" . decodeStrict)
return (node_idx, inst_idx, tags_data)