diff --git a/htools/Ganeti/HTools/Cluster.hs b/htools/Ganeti/HTools/Cluster.hs index 5d325dc2f8605ba71e4a54dfb8216baf8b875b69..6edf854bf388b5196203d514cb6973201ac678d6 100644 --- a/htools/Ganeti/HTools/Cluster.hs +++ b/htools/Ganeti/HTools/Cluster.hs @@ -35,6 +35,7 @@ module Ganeti.HTools.Cluster , CStats(..) , AllocResult , AllocMethod + , AllocSolutionList -- * Generic functions , totalResources , computeAllocationDelta @@ -64,6 +65,7 @@ module Ganeti.HTools.Cluster , tryNodeEvac , tryChangeGroup , collapseFailures + , allocList -- * Allocation functions , iterateAlloc , tieredAlloc @@ -112,6 +114,9 @@ data EvacSolution = EvacSolution type AllocResult = (FailStats, Node.List, Instance.List, [Instance.Instance], [CStats]) +-- | Type alias for easier handling. +type AllocSolutionList = [(Instance.Instance, AllocSolution)] + -- | A type denoting the valid allocation mode/pairs. -- -- For a one-node allocation, this will be a @Left ['Ndx']@, whereas @@ -844,6 +849,36 @@ tryMGAlloc mggl mgnl mgil inst cnt = do selmsg = "Selected group: " ++ group_name return $ solution { asLog = selmsg:all_msgs } +-- | Calculate the new instance list after allocation solution. +updateIl :: Instance.List -- ^ The original instance list + -> Maybe Node.AllocElement -- ^ The result of the allocation attempt + -> Instance.List -- ^ The updated instance list +updateIl il Nothing = il +updateIl il (Just (_, xi, _, _)) = Container.add (Container.size il) xi il + +-- | Extract the the new node list from the allocation solution. +extractNl :: Node.List -- ^ The original node list + -> Maybe Node.AllocElement -- ^ The result of the allocation attempt + -> Node.List -- ^ The new node list +extractNl nl Nothing = nl +extractNl _ (Just (xnl, _, _, _)) = xnl + +-- | Try to allocate a list of instances on a multi-group cluster. +allocList :: Group.List -- ^ The group list + -> Node.List -- ^ The node list + -> Instance.List -- ^ The instance list + -> [(Instance.Instance, Int)] -- ^ The instance to allocate + -> AllocSolutionList -- ^ Possible solution list + -> Result (Node.List, Instance.List, + AllocSolutionList) -- ^ The final solution list +allocList _ nl il [] result = Ok (nl, il, result) +allocList gl nl il ((xi, xicnt):xies) result = do + ares <- tryMGAlloc gl nl il xi xicnt + let sol = asSolution ares + nl' = extractNl nl sol + il' = updateIl il sol + allocList gl nl' il' xies ((xi, ares):result) + -- | Function which fails if the requested mode is change secondary. -- -- This is useful since except DRBD, no other disk template can