Enhance the RAPI backend to accept file:// URLs

[ganeti-local] / htools / Ganeti / HTools / Luxi.hs

diff --git a/htools/Ganeti/HTools/Luxi.hs b/htools/Ganeti/HTools/Luxi.hs
index 38bb266..44d90b8 100644 (file)
--- a/htools/Ganeti/HTools/Luxi.hs
+++ b/htools/Ganeti/HTools/Luxi.hs
@@ -4,7 +4,7 @@
 
 {-
 
-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
@@ -38,8 +38,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 Ganeti.HTools.Utils (fromJVal, tryFromObj, asJSObject,
-                            fromObj)
+import Ganeti.HTools.JSON
 
 {-# ANN module "HLint: ignore Eta reduce" #-}
 
@@ -100,14 +99,15 @@ queryNodesMsg :: L.LuxiOp
 queryNodesMsg =
   L.Query L.QRNode ["name", "mtotal", "mnode", "mfree", "dtotal", "dfree",
                     "ctotal", "offline", "drained", "vm_capable",
-                    "group.uuid"] ()
+                    "ndp/spindle_count", "group.uuid"] ()
 
 -- | 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"] ()
+                        "be/auto_balance", "disk_template",
+                        "be/spindle_use"] ()
 
 -- | The input data for cluster query.
 queryClusterInfoMsg :: L.LuxiOp
@@ -116,7 +116,7 @@ queryClusterInfoMsg = L.QueryClusterInfo
 -- | The input data for node group query.
 queryGroupsMsg :: L.LuxiOp
 queryGroupsMsg =
-  L.Query L.QRGroup ["uuid", "name", "alloc_policy"] ()
+  L.Query L.QRGroup ["uuid", "name", "alloc_policy", "ipolicy"] ()
 
 -- | Wraper over 'callMethod' doing node query.
 queryNodes :: L.Client -> IO (Result JSValue)
@@ -146,7 +146,7 @@ parseInstance :: NameAssoc
               -> 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
@@ -163,8 +163,9 @@ parseInstance ktn [ name, disk, mem, vcpus
   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)
@@ -176,16 +177,17 @@ getNodes ktg arr = extractArray arr >>= mapM (parseNode ktg)
 -- | 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
@@ -194,17 +196,21 @@ parseNode ktg [ name, mtotal, mnode, mfree, dtotal, dfree
               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)]
@@ -212,12 +218,13 @@ getGroups jsv = extractArray jsv >>= mapM parseGroup
 
 -- | 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)
 
@@ -249,8 +256,8 @@ parseData (groups, nodes, instances, cinfo) = do
   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