module Ganeti.HTools.Cluster
(
-- * Types
- NodeList
- , InstanceList
- , NameList
+ NameList
, Placement
, Solution(..)
, Table(..)
, compCV
, printStats
-- * IAllocator functions
- , allocateOn
+ , allocateOnSingle
+ , allocateOnPair
) where
import Data.List
type Score = Double
-- | The description of an instance placement.
-type Placement = (Int, Int, Int, Score)
+type Placement = (Idx, Ndx, Ndx, Score)
{- | A cluster solution described as the solution delta and the list
of placements.
_ -> -1
-- | A removal set.
-data Removal = Removal NodeList [Instance.Instance]
+data Removal = Removal Node.List [Instance.Instance]
-- | An instance move definition
data IMove = Failover -- ^ Failover the instance (f)
- | ReplacePrimary Int -- ^ Replace primary (f, r:np, f)
- | ReplaceSecondary Int -- ^ Replace secondary (r:ns)
- | ReplaceAndFailover Int -- ^ Replace secondary, failover (r:np, f)
- | FailoverAndReplace Int -- ^ Failover, replace secondary (f, r:ns)
+ | ReplacePrimary Ndx -- ^ Replace primary (f, r:np, f)
+ | ReplaceSecondary Ndx -- ^ Replace secondary (r:ns)
+ | ReplaceAndFailover Ndx -- ^ Replace secondary, failover (r:np, f)
+ | FailoverAndReplace Ndx -- ^ Failover, replace secondary (f, r:ns)
deriving (Show)
-- | The complete state for the balancing solution
-data Table = Table NodeList InstanceList Score [Placement]
+data Table = Table Node.List Instance.List Score [Placement]
deriving (Show)
-- General functions
verifyN1 nl = filter Node.failN1 nl
{-| Add an instance and return the new node and instance maps. -}
-addInstance :: NodeList -> Instance.Instance ->
- Node.Node -> Node.Node -> Maybe NodeList
+addInstance :: Node.List -> Instance.Instance ->
+ Node.Node -> Node.Node -> Maybe Node.List
addInstance nl idata pri sec =
let pdx = Node.idx pri
sdx = Node.idx sec
return new_nl
-- | Remove an instance and return the new node and instance maps.
-removeInstance :: NodeList -> Instance.Instance -> NodeList
+removeInstance :: Node.List -> Instance.Instance -> Node.List
removeInstance nl idata =
let pnode = Instance.pnode idata
snode = Instance.snode idata
new_nl
-- | Remove an instance and return the new node map.
-removeInstances :: NodeList -> [Instance.Instance] -> NodeList
+removeInstances :: Node.List -> [Instance.Instance] -> Node.List
removeInstances = foldl' removeInstance
-- | Compute the total free disk and memory in the cluster.
their new nodes.
-}
-applySolution :: NodeList -> InstanceList -> [Placement] -> NodeList
+applySolution :: Node.List -> Instance.List -> [Placement] -> Node.List
applySolution nl il sol =
let odxes = map (\ (a, b, c, _) -> (Container.find a il,
Node.idx (Container.find b nl),
those nodes.
-}
-computeBadItems :: NodeList -> InstanceList ->
+computeBadItems :: Node.List -> Instance.List ->
([Node.Node], [Instance.Instance])
computeBadItems nl il =
let bad_nodes = verifyN1 $ filter (not . Node.offline) $ Container.elems nl
placement can make this shortcut.
-}
-checkRemoval :: NodeList -> [Instance.Instance] -> Maybe Removal
+checkRemoval :: Node.List -> [Instance.Instance] -> Maybe Removal
checkRemoval nl victims =
let nx = removeInstances nl victims
failN1 = verifyN1Check (Container.elems nx)
-- | Computes the removals list for a given depth
-computeRemovals :: NodeList
+computeRemovals :: Node.List
-> [Instance.Instance]
-> Int
-> [Maybe Removal]
-- Second phase functions
-- | Single-node relocation cost
-nodeDelta :: Int -> Int -> Int -> Int
+nodeDelta :: Ndx -> Ndx -> Ndx -> Int
nodeDelta i p s =
if i == p || i == s then
0
solution by recursing until all target instances are placed.
-}
-checkPlacement :: NodeList -- ^ The current node list
+checkPlacement :: Node.List -- ^ The current node list
-> [Instance.Instance] -- ^ List of instances still to place
-> [Placement] -- ^ Partial solution until now
-> Int -- ^ The delta of the partial solution
) prev_sol nodes
-- | Apply a move
-applyMove :: NodeList -> Instance.Instance
- -> IMove -> (Maybe NodeList, Instance.Instance, Int, Int)
+applyMove :: Node.List -> Instance.Instance
+ -> IMove -> (Maybe Node.List, Instance.Instance, Ndx, Ndx)
-- Failover (f)
applyMove nl inst Failover =
let old_pdx = Instance.pnode inst
Container.addTwo old_sdx new_p old_pdx int_p nl
in (new_nl, Instance.setBoth inst old_sdx new_sdx, old_sdx, new_sdx)
-allocateOn nl inst new_pdx new_sdx =
- let
- tgt_p = Container.find new_pdx nl
- tgt_s = Container.find new_sdx nl
+allocateOnSingle :: Node.List -> Instance.Instance -> Node.Node
+ -> (Maybe Node.List, Instance.Instance)
+allocateOnSingle nl inst p =
+ let new_pdx = Node.idx p
+ new_nl = Node.addPri p inst >>= \new_p ->
+ return $ Container.add new_pdx new_p nl
+ in (new_nl, Instance.setBoth inst new_pdx Node.noSecondary)
+
+allocateOnPair :: Node.List -> Instance.Instance -> Node.Node -> Node.Node
+ -> (Maybe Node.List, Instance.Instance)
+allocateOnPair nl inst tgt_p tgt_s =
+ let new_pdx = Node.idx tgt_p
+ new_sdx = Node.idx tgt_s
new_nl = do -- Maybe monad
new_p <- Node.addPri tgt_p inst
new_s <- Node.addSec tgt_s inst new_pdx
-- | Given the status of the current secondary as a valid new node
-- and the current candidate target node,
-- generate the possible moves for a instance.
-possibleMoves :: Bool -> Int -> [IMove]
+possibleMoves :: Bool -> Ndx -> [IMove]
possibleMoves True tdx =
[ReplaceSecondary tdx,
ReplaceAndFailover tdx,
ReplaceAndFailover tdx]
-- | Compute the best move for a given instance.
-checkInstanceMove :: [Int] -- Allowed target node indices
+checkInstanceMove :: [Ndx] -- Allowed target node indices
-> Table -- Original table
-> Instance.Instance -- Instance to move
-> Table -- Best new table for this instance
foldl' (checkSingleStep ini_tbl target) aft_failover all_moves
-- | Compute the best next move.
-checkMove :: [Int] -- ^ Allowed target node indices
+checkMove :: [Ndx] -- ^ Allowed target node indices
-> Table -- ^ The current solution
-> [Instance.Instance] -- ^ List of instances still to move
-> Table -- ^ The new solution
solutionFromRemovals. In case we have no solution, we return Nothing.
-}
-computeSolution :: NodeList -- ^ The original node data
+computeSolution :: Node.List -- ^ The original node data
-> [Instance.Instance] -- ^ The list of /bad/ instances
-> Int -- ^ The /depth/ of removals
-> Int -- ^ Maximum number of removals to process
printf "replace-disks -n %s %s" d i])
{-| Converts a placement to string format -}
-printSolutionLine :: NodeList
- -> InstanceList
+printSolutionLine :: Node.List
+ -> Instance.List
-> Int
-> Int
-> Placement
(i, p, s, c) = plc
inst = Container.find i il
inam = Instance.name inst
- npri = cNameOf nl p
- nsec = cNameOf nl s
- opri = cNameOf nl $ Instance.pnode inst
- osec = cNameOf nl $ Instance.snode inst
+ npri = Container.nameOf nl p
+ nsec = Container.nameOf nl s
+ opri = Container.nameOf nl $ Instance.pnode inst
+ osec = Container.nameOf nl $ Instance.snode inst
(moves, cmds) = computeMoves inam opri osec npri nsec
ostr = (printf "%s:%s" opri osec)::String
nstr = (printf "%s:%s" npri nsec)::String
zip [1..] cmd_strs
{-| Converts a solution to string format -}
-printSolution :: NodeList
- -> InstanceList
+printSolution :: Node.List
+ -> Instance.List
-> [Placement]
-> ([String], [[String]])
printSolution nl il sol =
let
- nmlen = cMaxNamelen nl
- imlen = cMaxNamelen il
+ nmlen = Container.maxNameLen nl
+ imlen = Container.maxNameLen il
in
unzip $ map (uncurry $ printSolutionLine nl il nmlen imlen) $
zip sol [1..]
-- | Print the node list.
-printNodes :: NodeList -> String
+printNodes :: Node.List -> String
printNodes nl =
let snl = sortBy (compare `on` Node.idx) (Container.elems nl)
m_name = maximum . map (length . Node.name) $ snl
in unlines $ (header:map helper snl)
-- | Compute the mem and disk covariance.
-compDetailedCV :: NodeList -> (Double, Double, Double, Double, Double)
+compDetailedCV :: Node.List -> (Double, Double, Double, Double, Double)
compDetailedCV nl =
let
all_nodes = Container.elems nl
in (mem_cv, dsk_cv, n1_score, res_cv, off_score)
-- | Compute the 'total' variance.
-compCV :: NodeList -> Double
+compCV :: Node.List -> Double
compCV nl =
let (mem_cv, dsk_cv, n1_score, res_cv, off_score) = compDetailedCV nl
in mem_cv + dsk_cv + n1_score + res_cv + off_score
-printStats :: NodeList -> String
+printStats :: Node.List -> String
printStats nl =
let (mem_cv, dsk_cv, n1_score, res_cv, off_score) = compDetailedCV nl
in printf "f_mem=%.8f, r_mem=%.8f, f_dsk=%.8f, n1=%.3f, uf=%.3f"
projects / ganeti-local / blobdiff