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 <[email protected]> --- src/Ganeti/HTools/Backend/IAlloc.hs | 3 ++- src/Ganeti/HTools/Backend/Luxi.hs | 2 +- src/Ganeti/HTools/Backend/Rapi.hs | 2 +- src/Ganeti/HTools/Backend/Simu.hs | 2 +- src/Ganeti/HTools/Backend/Text.hs | 2 +- src/Ganeti/HTools/Group.hs | 12 ++++++++++-- src/Ganeti/HTools/Types.hs | 4 ++++ test/data/htools/hail-alloc-drbd.json | 1 + test/data/htools/hail-alloc-invalid-twodisks.json | 1 + test/data/htools/hail-alloc-twodisks.json | 1 + test/data/htools/hail-change-group.json | 2 ++ test/data/htools/hail-node-evac.json | 1 + test/data/htools/hail-reloc-drbd.json | 1 + test/hs/Test/Ganeti/TestHTools.hs | 2 +- 14 files changed, 28 insertions(+), 8 deletions(-) diff --git a/src/Ganeti/HTools/Backend/IAlloc.hs b/src/Ganeti/HTools/Backend/IAlloc.hs index 65cbf3d..823e0c9 100644 --- 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..b36376f 100644 --- a/src/Ganeti/HTools/Backend/Luxi.hs +++ b/src/Ganeti/HTools/Backend/Luxi.hs @@ -234,7 +234,7 @@ 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) + 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..aa8ab1b 100644 --- a/src/Ganeti/HTools/Backend/Rapi.hs +++ b/src/Ganeti/HTools/Backend/Rapi.hs @@ -179,7 +179,7 @@ parseGroup a = do apol <- extract "alloc_policy" ipol <- extract "ipolicy" tags <- extract "tags" - return (uuid, Group.create name uuid apol ipol tags) + 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..f32e403 100644 --- a/src/Ganeti/HTools/Backend/Simu.hs +++ b/src/Ganeti/HTools/Backend/Simu.hs @@ -85,7 +85,7 @@ createGroup grpIndex spec = do (fromIntegral cpu) False spindles grpIndex ) [1..ncount] 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..17674a7 100644 --- a/src/Ganeti/HTools/Backend/Text.hs +++ b/src/Ganeti/HTools/Backend/Text.hs @@ -185,7 +185,7 @@ 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) + 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..576ac39 100644 --- 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 + -> T.GroupID + -> T.AllocPolicy + -> [T.NetworkID] + -> T.IPolicy + -> [String] + -> 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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 -- 1.8.2.1
