Make the disks parameter available to the constructor

In that way, tools building on Instance will benefit from the corrected
verification semantics of the instance policy on disk space.

Signed-off-by: Klaus Aehlig <aehlig@google.com>
Reviewed-by: Guido Trotter <ultrotter@google.com>

diff --git a/src/Ganeti/HTools/Backend/IAlloc.hs b/src/Ganeti/HTools/Backend/IAlloc.hs
index d1d1436..65cbf3d 100644 (file)
--- a/src/Ganeti/HTools/Backend/IAlloc.hs
+++ b/src/Ganeti/HTools/Backend/IAlloc.hs
@@ -65,14 +65,17 @@ parseBaseInstance :: String
                   -> JSRecord
                   -> Result (String, Instance.Instance)
 parseBaseInstance n a = do
-  let extract x = tryFromObj ("invalid data for instance '" ++ n ++ "'") a x
+  let errorMessage = "invalid data for instance '" ++ n ++ "'"
+  let extract x = tryFromObj errorMessage a x
   disk  <- extract "disk_space_total"
+  disks <- extract "disks" >>= toArray >>= asObjectList >>=
+           mapM (flip (tryFromObj errorMessage) "size" . fromJSObject)
   mem   <- extract "memory"
   vcpus <- extract "vcpus"
   tags  <- extract "tags"
   dt    <- extract "disk_template"
   su    <- extract "spindle_use"
-  return (n, Instance.create n mem disk vcpus Running tags True 0 0 dt su)
+  return (n, Instance.create n mem disk disks vcpus Running tags True 0 0 dt su)
 
 -- | Parses an instance as found in the cluster instance list.
 parseInstance :: NameAssoc -- ^ The node name-to-index association list

diff --git a/src/Ganeti/HTools/Backend/Luxi.hs b/src/Ganeti/HTools/Backend/Luxi.hs
index febb0ab..eca265e 100644 (file)
--- a/src/Ganeti/HTools/Backend/Luxi.hs
+++ b/src/Ganeti/HTools/Backend/Luxi.hs
@@ -172,7 +172,7 @@ parseInstance ktn [ name, disk, mem, vcpus
   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
+  let inst = Instance.create xname xmem xdisk [xdisk] xvcpus
              xrunning xtags xauto_balance xpnode snode xdt xsu
   return (xname, inst)
 

diff --git a/src/Ganeti/HTools/Backend/Rapi.hs b/src/Ganeti/HTools/Backend/Rapi.hs
index eaf061c..387d6e2 100644 (file)
--- a/src/Ganeti/HTools/Backend/Rapi.hs
+++ b/src/Ganeti/HTools/Backend/Rapi.hs
@@ -130,6 +130,7 @@ parseInstance ktn a = do
   let owner_name = "Instance '" ++ name ++ "', error while parsing data"
   let extract s x = tryFromObj owner_name x s
   disk <- extract "disk_usage" a
+  disks <- extract "disk.sizes" a
   beparams <- liftM fromJSObject (extract "beparams" a)
   omem <- extract "oper_ram" a
   mem <- case omem of
@@ -146,7 +147,7 @@ parseInstance ktn a = do
   auto_balance <- extract "auto_balance" beparams
   dt <- extract "disk_template" a
   su <- extract "spindle_use" beparams
-  let inst = Instance.create name mem disk vcpus running tags
+  let inst = Instance.create name mem disk disks vcpus running tags
              auto_balance pnode snode dt su
   return (name, inst)
 

diff --git a/src/Ganeti/HTools/Backend/Text.hs b/src/Ganeti/HTools/Backend/Text.hs
index cb3719c..31fc23a 100644 (file)
--- a/src/Ganeti/HTools/Backend/Text.hs
+++ b/src/Ganeti/HTools/Backend/Text.hs
@@ -230,7 +230,7 @@ loadInst ktn [ name, mem, dsk, vcpus, status, auto_bal, pnode, snode
   when (sidx == pidx) . fail $ "Instance " ++ name ++
            " has same primary and secondary node - " ++ pnode
   let vtags = commaSplit tags
-      newinst = Instance.create name vmem vdsk vvcpus vstatus vtags
+      newinst = Instance.create name vmem vdsk [vdsk] vvcpus vstatus vtags
                 auto_balance pidx sidx disk_template spindle_use
   return (name, newinst)
 

diff --git a/src/Ganeti/HTools/Instance.hs b/src/Ganeti/HTools/Instance.hs
index 6dd6c6b..cfda115 100644 (file)
--- a/src/Ganeti/HTools/Instance.hs
+++ b/src/Ganeti/HTools/Instance.hs
@@ -163,16 +163,16 @@ type List = Container.Container Instance
 --
 -- Some parameters are not initialized by function, and must be set
 -- later (via 'setIdx' for example).
-create :: String -> Int -> Int -> Int -> T.InstanceStatus
+create :: String -> Int -> Int -> [Int] -> Int -> T.InstanceStatus
        -> [String] -> Bool -> T.Ndx -> T.Ndx -> T.DiskTemplate -> Int
        -> Instance
-create name_init mem_init dsk_init vcpus_init run_init tags_init
+create name_init mem_init dsk_init disks_init vcpus_init run_init tags_init
        auto_balance_init pn sn dt su =
   Instance { name = name_init
            , alias = name_init
            , mem = mem_init
            , dsk = dsk_init
-           , disks = [dsk_init]
+           , disks = disks_init
            , vcpus = vcpus_init
            , runSt = run_init
            , pNode = pn

diff --git a/src/Ganeti/HTools/Program/Hspace.hs b/src/Ganeti/HTools/Program/Hspace.hs
index 02c81bf..46d69f0 100644 (file)
--- a/src/Ganeti/HTools/Program/Hspace.hs
+++ b/src/Ganeti/HTools/Program/Hspace.hs
@@ -390,9 +390,12 @@ runAllocation cdata stop_allocation actual_result spec dt mode opts = do
   return (sortReasons reasons, new_nl, length new_ixes, tieredSpecMap new_ixes)
 
 -- | Create an instance from a given spec.
+-- For values not implied by the resorce specification (like distribution of
+-- of the disk space to individual disks), sensible defaults are guessed (e.g.,
+-- having a single disk).
 instFromSpec :: RSpec -> DiskTemplate -> Int -> Instance.Instance
 instFromSpec spx =
-  Instance.create "new" (rspecMem spx) (rspecDsk spx)
+  Instance.create "new" (rspecMem spx) (rspecDsk spx) [rspecDsk spx]
     (rspecCpu spx) Running [] True (-1) (-1)
 
 -- | Main function.

diff --git a/test/hs/Test/Ganeti/HTools/Instance.hs b/test/hs/Test/Ganeti/HTools/Instance.hs
index 0f71c26..ca8f682 100644 (file)
--- a/test/hs/Test/Ganeti/HTools/Instance.hs
+++ b/test/hs/Test/Ganeti/HTools/Instance.hs
@@ -62,7 +62,7 @@ genInstanceSmallerThan lim_mem lim_dsk lim_cpu = do
   sn <- arbitrary
   vcpus <- choose (0, lim_cpu)
   dt <- arbitrary
-  return $ Instance.create name mem dsk vcpus run_st [] True pn sn dt 1
+  return $ Instance.create name mem dsk [dsk] vcpus run_st [] True pn sn dt 1
 
 -- | Generates an instance smaller than a node.
 genInstanceSmallerThanNode :: Node.Node -> Gen Instance.Instance

diff --git a/test/hs/Test/Ganeti/TestHTools.hs b/test/hs/Test/Ganeti/TestHTools.hs
index b27c34c..4a9272a 100644 (file)
--- a/test/hs/Test/Ganeti/TestHTools.hs
+++ b/test/hs/Test/Ganeti/TestHTools.hs
@@ -96,8 +96,8 @@ defGroupAssoc = Map.singleton (Group.uuid defGroup) (Group.idx defGroup)
 -- | Create an instance given its spec.
 createInstance :: Int -> Int -> Int -> Instance.Instance
 createInstance mem dsk vcpus =
-  Instance.create "inst-unnamed" mem dsk vcpus Types.Running [] True (-1) (-1)
-    Types.DTDrbd8 1
+  Instance.create "inst-unnamed" mem dsk [dsk] vcpus Types.Running [] True (-1)
+    (-1) Types.DTDrbd8 1
 
 -- | Create a small cluster by repeating a node spec.
 makeSmallCluster :: Node.Node -> Int -> Node.List