{-
-Copyright (C) 2009 Google Inc.
+Copyright (C) 2009, 2010 Google Inc.
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
module Ganeti.HTools.Luxi
(
loadData
+ , parseData
) where
-import Data.List
import qualified Control.Exception as E
-import Control.Monad
import Text.JSON.Types
import qualified Ganeti.Luxi as L
import Ganeti.HTools.Types
import qualified Ganeti.HTools.Node as Node
import qualified Ganeti.HTools.Instance as Instance
-import Ganeti.HTools.Utils (fromJVal, annotateResult)
+import Ganeti.HTools.Utils (fromJVal, annotateResult, tryFromObj, asJSObject)
-- * Utility functions
-- * Data querying functionality
-- | The input data for node query.
-queryNodesMsg :: JSValue
+queryNodesMsg :: L.LuxiOp
queryNodesMsg =
- let nnames = JSArray []
- fnames = ["name",
- "mtotal", "mnode", "mfree",
- "dtotal", "dfree",
- "ctotal",
- "offline", "drained"]
- fields = JSArray $ map (JSString . toJSString) fnames
- use_locking = JSBool False
- in JSArray [nnames, fields, use_locking]
+ L.QueryNodes [] ["name", "mtotal", "mnode", "mfree", "dtotal", "dfree",
+ "ctotal", "offline", "drained", "vm_capable",
+ "group.uuid"] False
-- | The input data for instance query.
-queryInstancesMsg :: JSValue
+queryInstancesMsg :: L.LuxiOp
queryInstancesMsg =
- let nnames = JSArray []
- fnames = ["name",
- "disk_usage", "be/memory", "be/vcpus",
- "status", "pnode", "snodes"]
- fields = JSArray $ map (JSString . toJSString) fnames
- use_locking = JSBool False
- in JSArray [nnames, fields, use_locking]
+ L.QueryInstances [] ["name", "disk_usage", "be/memory", "be/vcpus",
+ "status", "pnode", "snodes", "tags", "oper_ram"] False
+
+-- | The input data for cluster query
+queryClusterInfoMsg :: L.LuxiOp
+queryClusterInfoMsg = L.QueryClusterInfo
-- | Wraper over callMethod doing node query.
queryNodes :: L.Client -> IO (Result JSValue)
-queryNodes = L.callMethod L.QueryNodes queryNodesMsg
+queryNodes = L.callMethod queryNodesMsg
-- | Wraper over callMethod doing instance query.
queryInstances :: L.Client -> IO (Result JSValue)
-queryInstances = L.callMethod L.QueryInstances queryInstancesMsg
+queryInstances = L.callMethod queryInstancesMsg
+
+queryClusterInfo :: L.Client -> IO (Result JSValue)
+queryClusterInfo = L.callMethod queryClusterInfoMsg
-- | Parse a instance list in JSON format.
getInstances :: NameAssoc
getInstances ktn arr = toArray arr >>= mapM (parseInstance ktn)
-- | Construct an instance from a JSON object.
-parseInstance :: [(String, Ndx)]
+parseInstance :: NameAssoc
-> JSValue
-> Result (String, Instance.Instance)
-parseInstance ktn (JSArray (name:disk:mem:vcpus:status:pnode:snodes:[])) = do
+parseInstance ktn (JSArray [ name, disk, mem, vcpus
+ , status, pnode, snodes, tags, oram ]) = do
xname <- annotateResult "Parsing new instance" (fromJVal name)
let convert v = annotateResult ("Instance '" ++ xname ++ "'") (fromJVal v)
xdisk <- convert disk
- xmem <- convert mem
+ xmem <- (case oram of
+ JSRational _ _ -> convert oram
+ _ -> convert mem)
xvcpus <- convert vcpus
xpnode <- convert pnode >>= lookupNode ktn xname
xsnodes <- convert snodes::Result [JSString]
snode <- (if null xsnodes then return Node.noSecondary
else lookupNode ktn xname (fromJSString $ head xsnodes))
xrunning <- convert status
- let inst = Instance.create xname xmem xdisk xvcpus xrunning xpnode snode
+ xtags <- convert tags
+ let inst = Instance.create xname xmem xdisk xvcpus
+ xrunning xtags xpnode snode
return (xname, inst)
parseInstance _ v = fail ("Invalid instance query result: " ++ show v)
-- | Construct a node from a JSON object.
parseNode :: JSValue -> Result (String, Node.Node)
-parseNode (JSArray
- (name:mtotal:mnode:mfree:dtotal:dfree:ctotal:offline:drained:[]))
+parseNode (JSArray [ name, mtotal, mnode, mfree, dtotal, dfree
+ , ctotal, offline, drained, vm_capable, g_uuid ])
= do
xname <- annotateResult "Parsing new node" (fromJVal name)
let convert v = annotateResult ("Node '" ++ xname ++ "'") (fromJVal v)
xoffline <- convert offline
- node <- (if xoffline
- then return $ Node.create xname 0 0 0 0 0 0 True
+ xdrained <- convert drained
+ xvm_capable <- convert vm_capable
+ xguuid <- convert g_uuid
+ node <- (if xoffline || xdrained || not xvm_capable
+ then return $ Node.create xname 0 0 0 0 0 0 True xguuid
else do
- xdrained <- convert drained
xmtotal <- convert mtotal
xmnode <- convert mnode
xmfree <- convert mfree
xdfree <- convert dfree
xctotal <- convert ctotal
return $ Node.create xname xmtotal xmnode xmfree
- xdtotal xdfree xctotal (xoffline || xdrained))
+ xdtotal xdfree xctotal False xguuid)
return (xname, node)
parseNode v = fail ("Invalid node query result: " ++ show v)
+getClusterTags :: JSValue -> Result [String]
+getClusterTags v = do
+ let errmsg = "Parsing cluster info"
+ obj <- annotateResult errmsg $ asJSObject v
+ tryFromObj errmsg (fromJSObject obj) "tags"
+
-- * Main loader functionality
-- | Builds the cluster data from an URL.
-loadData :: String -- ^ Unix socket to use as source
- -> IO (Result (Node.AssocList, Instance.AssocList))
-loadData master =
+readData :: String -- ^ Unix socket to use as source
+ -> IO (Result JSValue, Result JSValue, Result JSValue)
+readData master =
E.bracket
(L.getClient master)
L.closeClient
(\s -> do
nodes <- queryNodes s
instances <- queryInstances s
- return $ do -- Result monad
- node_data <- nodes >>= getNodes
- let (node_names, node_idx) = assignIndices node_data
- inst_data <- instances >>= getInstances node_names
- let (_, inst_idx) = assignIndices inst_data
- return (node_idx, inst_idx)
+ cinfo <- queryClusterInfo s
+ return (nodes, instances, cinfo)
)
+
+parseData :: (Result JSValue, Result JSValue, Result JSValue)
+ -> Result (Node.List, Instance.List, [String])
+parseData (nodes, instances, cinfo) = do
+ node_data <- nodes >>= getNodes
+ let (node_names, node_idx) = assignIndices node_data
+ inst_data <- instances >>= getInstances node_names
+ let (_, inst_idx) = assignIndices inst_data
+ ctags <- cinfo >>= getClusterTags
+ return (node_idx, inst_idx, ctags)
+
+-- | Top level function for data loading
+loadData :: String -- ^ Unix socket to use as source
+ -> IO (Result (Node.List, Instance.List, [String]))
+loadData master = readData master >>= return . parseData