Parse node group networks

Extend the Group by the network ids it is connected to. Adapt
the IAlloc backend such that the networks are parsed correctly.
This also required the adaption of test data.

Signed-off-by: Thomas Thrainer <thomasth@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 65cbf3d..823e0c9 100644 (file)
--- a/src/Ganeti/HTools/Backend/IAlloc.hs
+++ b/src/Ganeti/HTools/Backend/IAlloc.hs
@@ -133,9 +133,10 @@ parseGroup u a = do
   let extract x = tryFromObj ("invalid data for group '" ++ u ++ "'") a x
   name <- extract "name"
   apol <- extract "alloc_policy"
+  nets <- extract "networks"
   ipol <- extract "ipolicy"
   tags <- extract "tags"
-  return (u, Group.create name u apol ipol tags)
+  return (u, Group.create name u apol nets ipol tags)
 
 -- | Top-level parser.
 --

diff --git a/src/Ganeti/HTools/Backend/Luxi.hs b/src/Ganeti/HTools/Backend/Luxi.hs
index 5a1246a..04db3e2 100644 (file)
--- a/src/Ganeti/HTools/Backend/Luxi.hs
+++ b/src/Ganeti/HTools/Backend/Luxi.hs
@@ -234,7 +234,8 @@ parseGroup [uuid, name, apol, ipol, tags] = do
   xapol <- convert "alloc_policy" apol
   xipol <- convert "ipolicy" ipol
   xtags <- convert "tags" tags
-  return (xuuid, Group.create xname xuuid xapol xipol xtags)
+  -- TODO: parse networks to which this group is connected
+  return (xuuid, Group.create xname xuuid xapol [] xipol xtags)
 
 parseGroup v = fail ("Invalid group query result: " ++ show v)
 

diff --git a/src/Ganeti/HTools/Backend/Rapi.hs b/src/Ganeti/HTools/Backend/Rapi.hs
index ffc6dc2..e6d8c4c 100644 (file)
--- a/src/Ganeti/HTools/Backend/Rapi.hs
+++ b/src/Ganeti/HTools/Backend/Rapi.hs
@@ -179,7 +179,8 @@ parseGroup a = do
   apol <- extract "alloc_policy"
   ipol <- extract "ipolicy"
   tags <- extract "tags"
-  return (uuid, Group.create name uuid apol ipol tags)
+  -- TODO: parse networks to which this group is connected
+  return (uuid, Group.create name uuid apol [] ipol tags)
 
 -- | Parse cluster data from the info resource.
 parseCluster :: JSObject JSValue -> Result ([String], IPolicy, String)

diff --git a/src/Ganeti/HTools/Backend/Simu.hs b/src/Ganeti/HTools/Backend/Simu.hs
index 1725e57..a9b31d4 100644 (file)
--- a/src/Ganeti/HTools/Backend/Simu.hs
+++ b/src/Ganeti/HTools/Backend/Simu.hs
@@ -84,8 +84,9 @@ createGroup grpIndex spec = do
                       (fromIntegral disk) disk
                       (fromIntegral cpu) False spindles grpIndex
                   ) [1..ncount]
+      -- TODO: parse networks to which this group is connected
       grp = Group.create (printf "group-%02d" grpIndex)
-            (printf "fake-uuid-%02d" grpIndex) apol defIPolicy []
+            (printf "fake-uuid-%02d" grpIndex) apol [] defIPolicy []
   return (Group.setIdx grp grpIndex, nodes)
 
 -- | Builds the cluster data from node\/instance files.

diff --git a/src/Ganeti/HTools/Backend/Text.hs b/src/Ganeti/HTools/Backend/Text.hs
index 2370eb7..96a5290 100644 (file)
--- a/src/Ganeti/HTools/Backend/Text.hs
+++ b/src/Ganeti/HTools/Backend/Text.hs
@@ -185,7 +185,8 @@ loadGroup :: (Monad m) => [String]
 loadGroup [name, gid, apol, tags] = do
   xapol <- allocPolicyFromRaw apol
   let xtags = commaSplit tags
-  return (gid, Group.create name gid xapol defIPolicy xtags)
+  -- TODO: parse networks to which this group is connected
+  return (gid, Group.create name gid xapol [] defIPolicy xtags)
 
 loadGroup s = fail $ "Invalid/incomplete group data: '" ++ show s ++ "'"
 

diff --git a/src/Ganeti/HTools/Group.hs b/src/Ganeti/HTools/Group.hs
index acef35f..47e9bab 100644 (file)
--- a/src/Ganeti/HTools/Group.hs
+++ b/src/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
+  , networks    :: [T.NetworkID] -- ^ The networks connected to this group
   , iPolicy     :: T.IPolicy     -- ^ The instance policy for this group
   , allTags     :: [String]      -- ^ The tags for this group
   } deriving (Show, Eq)
@@ -67,11 +68,18 @@ type List = Container.Container Group
 -- * Initialization functions
 
 -- | Create a new group.
-create :: String -> T.GroupID -> T.AllocPolicy -> T.IPolicy -> [String] -> Group
-create name_init id_init apol_init ipol_init tags_init =
+create :: String        -- ^ The node name
+       -> T.GroupID     -- ^ The UUID of the group
+       -> T.AllocPolicy -- ^ The allocation policy for this group
+       -> [T.NetworkID] -- ^ The networks connected to this group
+       -> T.IPolicy     -- ^ The instance policy for this group
+       -> [String]      -- ^ The tags for this group
+       -> Group
+create name_init id_init apol_init nets_init ipol_init tags_init =
   Group { name        = name_init
         , uuid        = id_init
         , allocPolicy = apol_init
+        , networks    = nets_init
         , iPolicy     = ipol_init
         , allTags     = tags_init
         , idx         = -1

diff --git a/src/Ganeti/HTools/Types.hs b/src/Ganeti/HTools/Types.hs
index e9e9bad..21d7ee1 100644 (file)
--- a/src/Ganeti/HTools/Types.hs
+++ b/src/Ganeti/HTools/Types.hs
@@ -37,6 +37,7 @@ module Ganeti.HTools.Types
   , AllocPolicy(..)
   , allocPolicyFromRaw
   , allocPolicyToRaw
+  , NetworkID
   , InstanceStatus(..)
   , instanceStatusFromRaw
   , instanceStatusToRaw
@@ -157,6 +158,9 @@ data AllocInfo = AllocInfo
 -- | Currently used, possibly to allocate, unallocable.
 type AllocStats = (AllocInfo, AllocInfo, AllocInfo)
 
+-- | The network UUID type.
+type NetworkID = String
+
 -- | Instance specification type.
 $(THH.buildObject "ISpec" "iSpec"
   [ THH.renameField "MemorySize" $ THH.simpleField C.ispecMemSize    [t| Int |]

diff --git a/test/data/htools/hail-alloc-drbd.json b/test/data/htools/hail-alloc-drbd.json
index 57e20c3..868933e 100644 (file)
--- a/test/data/htools/hail-alloc-drbd.json
+++ b/test/data/htools/hail-alloc-drbd.json
@@ -46,6 +46,7 @@
         ],
         "spindle-ratio": 32.0
       },
+      "networks": [],
       "alloc_policy": "preferred",
       "tags": [],
       "name": "default"

diff --git a/test/data/htools/hail-alloc-invalid-twodisks.json b/test/data/htools/hail-alloc-invalid-twodisks.json
index 4f233c7..3914a5d 100644 (file)
--- a/test/data/htools/hail-alloc-invalid-twodisks.json
+++ b/test/data/htools/hail-alloc-invalid-twodisks.json
@@ -48,6 +48,7 @@
         "vcpu-ratio": 4.0
       },
       "name": "default",
+      "networks": [],
       "tags": []
     }
   },

diff --git a/test/data/htools/hail-alloc-twodisks.json b/test/data/htools/hail-alloc-twodisks.json
index b4e7280..e4614a7 100644 (file)
--- a/test/data/htools/hail-alloc-twodisks.json
+++ b/test/data/htools/hail-alloc-twodisks.json
@@ -48,6 +48,7 @@
         "vcpu-ratio": 4.0
       },
       "name": "default",
+      "networks": [],
       "tags": []
     }
   },

diff --git a/test/data/htools/hail-change-group.json b/test/data/htools/hail-change-group.json
index 8cca142..84aa631 100644 (file)
--- a/test/data/htools/hail-change-group.json
+++ b/test/data/htools/hail-change-group.json
@@ -47,6 +47,7 @@
         "spindle-ratio": 32.0
       },
       "alloc_policy": "preferred",
+      "networks": [],
       "tags": [],
       "name": "default"
     },
@@ -93,6 +94,7 @@
         "spindle-ratio": 32.0
       },
       "alloc_policy": "preferred",
+      "networks": [],
       "tags": [],
       "name": "empty"
     }

diff --git a/test/data/htools/hail-node-evac.json b/test/data/htools/hail-node-evac.json
index 8fed477..31c7928 100644 (file)
--- a/test/data/htools/hail-node-evac.json
+++ b/test/data/htools/hail-node-evac.json
@@ -47,6 +47,7 @@
         "spindle-ratio": 32.0
       },
       "alloc_policy": "preferred",
+      "networks": [],
       "tags": [],
       "name": "default"
     }

diff --git a/test/data/htools/hail-reloc-drbd.json b/test/data/htools/hail-reloc-drbd.json
index 944700e..b745660 100644 (file)
--- a/test/data/htools/hail-reloc-drbd.json
+++ b/test/data/htools/hail-reloc-drbd.json
@@ -47,6 +47,7 @@
         "spindle-ratio": 32.0
       },
       "alloc_policy": "preferred",
+      "networks": [],
       "tags": [],
       "name": "default"
     }

diff --git a/test/hs/Test/Ganeti/TestHTools.hs b/test/hs/Test/Ganeti/TestHTools.hs
index 961d7cd..b51df04 100644 (file)
--- a/test/hs/Test/Ganeti/TestHTools.hs
+++ b/test/hs/Test/Ganeti/TestHTools.hs
@@ -86,7 +86,7 @@ nullIPolicy = Types.IPolicy
 defGroup :: Group.Group
 defGroup = flip Group.setIdx 0 $
              Group.create "default" Types.defaultGroupID Types.AllocPreferred
-                  nullIPolicy []
+                  [] nullIPolicy []
 
 -- | Default group, as a (singleton) 'Group.List'.
 defGroupList :: Group.List