{-
-Copyright (C) 2009, 2010, 2011 Google Inc.
+Copyright (C) 2009, 2010, 2011, 2012 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
import qualified Text.JSON
import qualified Ganeti.Luxi as L
+import qualified Ganeti.Query.Language as Qlang
import Ganeti.HTools.Loader
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 Ganeti.HTools.Utils (fromJVal, annotateResult, tryFromObj, asJSObject,
- fromObj)
+import Ganeti.JSON
{-# ANN module "HLint: ignore Eta reduce" #-}
fromJValWithStatus :: (Text.JSON.JSON a, Monad m) => (JSValue, JSValue) -> m a
fromJValWithStatus (st, v) = do
st' <- fromJVal st
- L.checkRS st' v >>= fromJVal
+ Qlang.checkRS st' v >>= fromJVal
-- | Annotate errors when converting values with owner/attribute for
-- better debugging.
-- | The input data for node query.
queryNodesMsg :: L.LuxiOp
queryNodesMsg =
- L.Query L.QRNode ["name", "mtotal", "mnode", "mfree", "dtotal", "dfree",
- "ctotal", "offline", "drained", "vm_capable",
- "group.uuid"] ()
+ L.Query Qlang.QRNode ["name", "mtotal", "mnode", "mfree", "dtotal", "dfree",
+ "ctotal", "offline", "drained", "vm_capable",
+ "ndp/spindle_count", "group.uuid"] Qlang.EmptyFilter
-- | The input data for instance query.
queryInstancesMsg :: L.LuxiOp
queryInstancesMsg =
- L.Query L.QRInstance ["name", "disk_usage", "be/memory", "be/vcpus",
- "status", "pnode", "snodes", "tags", "oper_ram",
- "be/auto_balance", "disk_template"] ()
+ L.Query Qlang.QRInstance ["name", "disk_usage", "be/memory", "be/vcpus",
+ "status", "pnode", "snodes", "tags", "oper_ram",
+ "be/auto_balance", "disk_template",
+ "be/spindle_use"] Qlang.EmptyFilter
-- | The input data for cluster query.
queryClusterInfoMsg :: L.LuxiOp
-- | The input data for node group query.
queryGroupsMsg :: L.LuxiOp
queryGroupsMsg =
- L.Query L.QRGroup ["uuid", "name", "alloc_policy"] ()
+ L.Query Qlang.QRGroup ["uuid", "name", "alloc_policy", "ipolicy"]
+ Qlang.EmptyFilter
-- | Wraper over 'callMethod' doing node query.
queryNodes :: L.Client -> IO (Result JSValue)
-> Result (String, Instance.Instance)
parseInstance ktn [ name, disk, mem, vcpus
, status, pnode, snodes, tags, oram
- , auto_balance, disk_template ] = do
+ , auto_balance, disk_template, su ] = do
xname <- annotateResult "Parsing new instance" (fromJValWithStatus name)
let convert a = genericConvert "Instance" xname a
xdisk <- convert "disk_usage" disk
xtags <- convert "tags" tags
xauto_balance <- convert "auto_balance" auto_balance
xdt <- convert "disk_template" disk_template
+ xsu <- convert "be/spindle_use" su
let inst = Instance.create xname xmem xdisk xvcpus
- xrunning xtags xauto_balance xpnode snode xdt
+ xrunning xtags xauto_balance xpnode snode xdt xsu
return (xname, inst)
parseInstance _ v = fail ("Invalid instance query result: " ++ show v)
-- | Construct a node from a JSON object.
parseNode :: NameAssoc -> [(JSValue, JSValue)] -> Result (String, Node.Node)
parseNode ktg [ name, mtotal, mnode, mfree, dtotal, dfree
- , ctotal, offline, drained, vm_capable, g_uuid ]
+ , ctotal, offline, drained, vm_capable, spindles, g_uuid ]
= do
xname <- annotateResult "Parsing new node" (fromJValWithStatus name)
let convert a = genericConvert "Node" xname a
xoffline <- convert "offline" offline
xdrained <- convert "drained" drained
xvm_capable <- convert "vm_capable" vm_capable
+ xspindles <- convert "spindles" spindles
xgdx <- convert "group.uuid" g_uuid >>= lookupGroup ktg xname
node <- if xoffline || xdrained || not xvm_capable
- then return $ Node.create xname 0 0 0 0 0 0 True xgdx
+ then return $ Node.create xname 0 0 0 0 0 0 True xspindles xgdx
else do
xmtotal <- convert "mtotal" mtotal
xmnode <- convert "mnode" mnode
xdfree <- convert "dfree" dfree
xctotal <- convert "ctotal" ctotal
return $ Node.create xname xmtotal xmnode xmfree
- xdtotal xdfree xctotal False xgdx
+ xdtotal xdfree xctotal False xspindles xgdx
return (xname, node)
parseNode _ v = fail ("Invalid node query result: " ++ show v)
-- | Parses the cluster tags.
-getClusterTags :: JSValue -> Result [String]
-getClusterTags v = do
+getClusterData :: JSValue -> Result ([String], IPolicy)
+getClusterData (JSObject obj) = do
let errmsg = "Parsing cluster info"
- obj <- annotateResult errmsg $ asJSObject v
- tryFromObj errmsg (fromJSObject obj) "tags"
+ obj' = fromJSObject obj
+ ctags <- tryFromObj errmsg obj' "tags"
+ cpol <- tryFromObj errmsg obj' "ipolicy"
+ return (ctags, cpol)
+
+getClusterData _ = Bad "Cannot parse cluster info, not a JSON record"
-- | Parses the cluster groups.
getGroups :: JSValue -> Result [(String, Group.Group)]
-- | Parses a given group information.
parseGroup :: [(JSValue, JSValue)] -> Result (String, Group.Group)
-parseGroup [uuid, name, apol] = do
+parseGroup [uuid, name, apol, ipol] = do
xname <- annotateResult "Parsing new group" (fromJValWithStatus name)
let convert a = genericConvert "Group" xname a
xuuid <- convert "uuid" uuid
xapol <- convert "alloc_policy" apol
- return (xuuid, Group.create xname xuuid xapol)
+ xipol <- convert "ipolicy" ipol
+ return (xuuid, Group.create xname xuuid xapol xipol)
parseGroup v = fail ("Invalid group query result: " ++ show v)
let (node_names, node_idx) = assignIndices node_data
inst_data <- instances >>= getInstances node_names
let (_, inst_idx) = assignIndices inst_data
- ctags <- cinfo >>= getClusterTags
- return (ClusterData group_idx node_idx inst_idx ctags)
+ (ctags, cpol) <- cinfo >>= getClusterData
+ return (ClusterData group_idx node_idx inst_idx ctags cpol)
-- | Top level function for data loading.
loadData :: String -- ^ Unix socket to use as source
projects / ganeti-local / blobdiff