Add ipolicy attribute to group objects

This is straightforward; as before, so far the text and simu backends
have no way to use a non-default ipolicy.

Furthermore, we do some unit-test preparation for future changes
(these seem a no-op for now, but they are needed for later patches).

Signed-off-by: Iustin Pop <iustin@google.com>
Reviewed-by: René Nussbaumer <rn@google.com>

diff --git a/htools/Ganeti/HTools/Group.hs b/htools/Ganeti/HTools/Group.hs
index 3206236..8eb7e4f 100644 (file)
--- a/htools/Ganeti/HTools/Group.hs
+++ b/htools/Ganeti/HTools/Group.hs
@@ -45,6 +45,7 @@ data Group = Group
   , uuid        :: T.GroupID     -- ^ The UUID of the group
   , idx         :: T.Gdx         -- ^ Internal index for book-keeping
   , allocPolicy :: T.AllocPolicy -- ^ The allocation policy for this group
+  , iPolicy     :: T.IPolicy     -- ^ The instance policy for this group
   } deriving (Show, Read, Eq)
 
 -- Note: we use the name as the alias, and the UUID as the official
@@ -65,11 +66,12 @@ type List = Container.Container Group
 -- * Initialization functions
 
 -- | Create a new group.
-create :: String -> T.GroupID -> T.AllocPolicy -> Group
-create name_init id_init apol_init =
+create :: String -> T.GroupID -> T.AllocPolicy -> T.IPolicy -> Group
+create name_init id_init apol_init ipol_init =
   Group { name        = name_init
         , uuid        = id_init
         , allocPolicy = apol_init
+        , iPolicy     = ipol_init
         , idx         = -1
         }
 

diff --git a/htools/Ganeti/HTools/IAlloc.hs b/htools/Ganeti/HTools/IAlloc.hs
index cbec6a9..aa8a39c 100644 (file)
--- a/htools/Ganeti/HTools/IAlloc.hs
+++ b/htools/Ganeti/HTools/IAlloc.hs
@@ -125,7 +125,8 @@ parseGroup u a = do
   let extract x = tryFromObj ("invalid data for group '" ++ u ++ "'") a x
   name <- extract "name"
   apol <- extract "alloc_policy"
-  return (u, Group.create name u apol)
+  ipol <- extract "ipolicy"
+  return (u, Group.create name u apol ipol)
 
 -- | Top-level parser.
 --

diff --git a/htools/Ganeti/HTools/Luxi.hs b/htools/Ganeti/HTools/Luxi.hs
index 74dd984..cd80996 100644 (file)
--- a/htools/Ganeti/HTools/Luxi.hs
+++ b/htools/Ganeti/HTools/Luxi.hs
@@ -115,7 +115,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)
@@ -215,12 +215,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)
 

diff --git a/htools/Ganeti/HTools/QC.hs b/htools/Ganeti/HTools/QC.hs
index f80ebd7..36dd9ea 100644 (file)
--- a/htools/Ganeti/HTools/QC.hs
+++ b/htools/Ganeti/HTools/QC.hs
@@ -90,9 +90,34 @@ maxDsk = 1024 * 1024 * 8
 maxCpu :: Int
 maxCpu = 1024
 
+-- | Null iPolicy, and by null we mean very liberal.
+nullIPolicy = Types.IPolicy
+  { Types.iPolicyMinSpec = Types.ISpec { Types.iSpecMemorySize = 0
+                                       , Types.iSpecCpuCount   = 0
+                                       , Types.iSpecDiskSize   = 0
+                                       , Types.iSpecDiskCount  = 0
+                                       , Types.iSpecNicCount   = 0
+                                       }
+  , Types.iPolicyMaxSpec = Types.ISpec { Types.iSpecMemorySize = maxBound
+                                       , Types.iSpecCpuCount   = maxBound
+                                       , Types.iSpecDiskSize   = maxBound
+                                       , Types.iSpecDiskCount  = C.maxDisks
+                                       , Types.iSpecNicCount   = C.maxNics
+                                       }
+  , Types.iPolicyStdSpec = Types.ISpec { Types.iSpecMemorySize = Types.unitMem
+                                       , Types.iSpecCpuCount   = Types.unitCpu
+                                       , Types.iSpecDiskSize   = Types.unitDsk
+                                       , Types.iSpecDiskCount  = 1
+                                       , Types.iSpecNicCount   = 1
+                                       }
+  , Types.iPolicyDiskTemplates = [Types.DTDrbd8, Types.DTPlain]
+  }
+
+
 defGroup :: Group.Group
 defGroup = flip Group.setIdx 0 $
              Group.create "default" Types.defaultGroupID Types.AllocPreferred
+                  nullIPolicy
 
 defGroupList :: Group.List
 defGroupList = Container.fromList [(Group.idx defGroup, defGroup)]
@@ -934,12 +959,14 @@ prop_ClusterAllocBalance =
       i_templ = createInstance Types.unitMem Types.unitDsk Types.unitCpu
   in case allocnodes >>= \allocnodes' ->
     Cluster.iterateAlloc nl' il (Just 5) i_templ allocnodes' [] [] of
-       Types.Bad _ -> False
+       Types.Bad _ -> printTestCase "Failed to allocate" False
+       Types.Ok (_, _, _, [], _) -> printTestCase "Failed to allocate" False
        Types.Ok (_, xnl, il', _, _) ->
          let ynl = Container.add (Node.idx hnode) hnode xnl
              cv = Cluster.compCV ynl
              tbl = Cluster.Table ynl il' cv []
-         in canBalance tbl True True False
+         in printTestCase "Failed to rebalance" $
+            canBalance tbl True True False
 
 -- | Checks consistency.
 prop_ClusterCheckConsistency node inst =

diff --git a/htools/Ganeti/HTools/Rapi.hs b/htools/Ganeti/HTools/Rapi.hs
index eff6d1f..9eb5c0a 100644 (file)
--- a/htools/Ganeti/HTools/Rapi.hs
+++ b/htools/Ganeti/HTools/Rapi.hs
@@ -159,7 +159,8 @@ parseGroup a = do
   let extract s = tryFromObj ("Group '" ++ name ++ "'") a s
   uuid <- extract "uuid"
   apol <- extract "alloc_policy"
-  return (uuid, Group.create name uuid apol)
+  ipol <- extract "ipolicy"
+  return (uuid, Group.create name uuid apol ipol)
 
 -- | Parse cluster data from the info resource.
 parseCluster :: JSObject JSValue -> Result ([String], IPolicy)

diff --git a/htools/Ganeti/HTools/Simu.hs b/htools/Ganeti/HTools/Simu.hs
index 42f4625..68755ea 100644 (file)
--- a/htools/Ganeti/HTools/Simu.hs
+++ b/htools/Ganeti/HTools/Simu.hs
@@ -77,7 +77,7 @@ createGroup grpIndex spec = do
                            (fromIntegral cpu) False grpIndex
                   ) [1..ncount]
       grp = Group.create (printf "group-%02d" grpIndex)
-            (printf "fake-uuid-%02d" grpIndex) apol
+            (printf "fake-uuid-%02d" grpIndex) apol defIPolicy
   return (Group.setIdx grp grpIndex, nodes)
 
 -- | Builds the cluster data from node\/instance files.

diff --git a/htools/Ganeti/HTools/Text.hs b/htools/Ganeti/HTools/Text.hs
index 9a08c2e..00b52a9 100644 (file)
--- a/htools/Ganeti/HTools/Text.hs
+++ b/htools/Ganeti/HTools/Text.hs
@@ -119,7 +119,7 @@ loadGroup :: (Monad m) => [String]
                                      -- UUID and group object
 loadGroup [name, gid, apol] = do
   xapol <- allocPolicyFromRaw apol
-  return (gid, Group.create name gid xapol)
+  return (gid, Group.create name gid xapol defIPolicy)
 
 loadGroup s = fail $ "Invalid/incomplete group data: '" ++ show s ++ "'"