Commit 262a08a2 authored by Iustin Pop's avatar Iustin Pop
Browse files

Change the module import hierarchy

This patch makes the Types module a base module, and Node/Instance ones
import it, from the previous (opposite) situation. This will allow in
the future to use newtypes for the index and name types.
parent a097adcc
......@@ -28,6 +28,8 @@ import qualified Ganeti.HTools.Version as Version(version)
import qualified Ganeti.HTools.Rapi as Rapi
import qualified Ganeti.HTools.Text as Text
import qualified Ganeti.HTools.Loader as Loader
import qualified Ganeti.HTools.Instance as Instance
import qualified Ganeti.HTools.Node as Node
import Ganeti.HTools.Types
......@@ -98,7 +100,7 @@ shTemplate =
-- | External tool data loader from a variety of sources
loadExternalData :: (EToolOptions a) =>
a
-> IO (NodeList, InstanceList, String)
-> IO (Node.List, Instance.List, String)
loadExternalData opts = do
(env_node, env_inst) <- parseEnv ()
let nodef = if nodeSet opts then nodeFile opts
......
......@@ -8,9 +8,7 @@ goes into the "Main" module for the individual binaries.
module Ganeti.HTools.Cluster
(
-- * Types
NodeList
, InstanceList
, NameList
NameList
, Placement
, Solution(..)
, Table(..)
......@@ -70,7 +68,7 @@ solutionDelta sol = case sol of
_ -> -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)
......@@ -81,7 +79,7 @@ data IMove = Failover -- ^ Failover the instance (f)
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
......@@ -103,8 +101,8 @@ verifyN1 :: [Node.Node] -> [Node.Node]
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
......@@ -116,7 +114,7 @@ addInstance nl idata pri 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
......@@ -128,7 +126,7 @@ removeInstance nl 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.
......@@ -148,7 +146,7 @@ It first removes the relocated instances after which it places them on
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),
......@@ -200,7 +198,7 @@ bad instance list is the list of primary and secondary instances of
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
......@@ -218,7 +216,7 @@ nodes, since the cluster is known to be not healthy; only the check
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)
......@@ -230,7 +228,7 @@ checkRemoval nl victims =
-- | Computes the removals list for a given depth
computeRemovals :: NodeList
computeRemovals :: Node.List
-> [Instance.Instance]
-> Int
-> [Maybe Removal]
......@@ -281,7 +279,7 @@ tooHighDelta sol new_delta max_delta =
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
......@@ -334,8 +332,8 @@ checkPlacement nl victims current current_delta prev_sol max_delta =
) 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, Int, Int)
-- Failover (f)
applyMove nl inst Failover =
let old_pdx = Instance.pnode inst
......@@ -410,16 +408,16 @@ applyMove nl inst (FailoverAndReplace new_sdx) =
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)
allocateOnSingle :: NodeList -> Instance.Instance -> Node.Node
-> (Maybe NodeList, Instance.Instance)
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 :: NodeList -> Instance.Instance -> Node.Node -> Node.Node
-> (Maybe NodeList, Instance.Instance)
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
......@@ -543,7 +541,7 @@ This is a wrapper over both computeRemovals and
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
......@@ -604,8 +602,8 @@ computeMoves i a b c d =
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
......@@ -617,10 +615,10 @@ printSolutionLine nl il nmlen imlen plc pos =
(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
......@@ -640,20 +638,20 @@ formatCmds cmd_strs =
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
......@@ -667,7 +665,7 @@ printNodes nl =
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
......@@ -689,12 +687,12 @@ compDetailedCV 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"
......
......@@ -25,10 +25,16 @@ module Ganeti.HTools.Container
-- * Conversion
, elems
, keys
-- * Element functions
, nameOf
, maxNameLen
, findByName
) where
import qualified Data.IntMap as IntMap
import qualified Ganeti.HTools.Types as T
type Key = IntMap.Key
type Container = IntMap.IntMap
......@@ -79,3 +85,25 @@ fold = IntMap.fold
-- | Add or update two elements of the map.
addTwo :: Key -> a -> Key -> a -> Container a -> Container a
addTwo k1 v1 k2 v2 c = add k1 v1 $ add k2 v2 c
-- | Compute the name of an element in a container
nameOf :: (T.Element a) => Container a -> Key -> String
nameOf c k = T.nameOf $ find k c
-- | Compute the maximum name length in an Element Container
maxNameLen :: (T.Element a) => Container a -> Int
maxNameLen = maximum . map (length . T.nameOf) . elems
-- | Find an element by name in a Container; this is a very slow function
findByName :: (T.Element a, Monad m) =>
Container a -> String -> m Key
findByName c n =
let all_elems = elems c
result = filter ((== n) . T.nameOf) all_elems
nems = length result
in
if nems /= 1 then
fail $ "Wrong number of elems (" ++ (show nems) ++
") found with name " ++ n
else
return $ T.idxOf $ head result
......@@ -17,6 +17,7 @@ import Text.JSON (JSObject, JSValue(JSBool, JSString, JSArray),
makeObj, encodeStrict, decodeStrict,
fromJSObject, toJSString)
--import Text.Printf (printf)
import qualified Ganeti.HTools.Container as Container
import qualified Ganeti.HTools.Node as Node
import qualified Ganeti.HTools.Instance as Instance
import Ganeti.HTools.Loader
......@@ -28,7 +29,7 @@ data RqType
| Relocate Int Int [Int]
deriving (Show)
data Request = Request RqType NodeList InstanceList String
data Request = Request RqType Node.List Instance.List String
deriving (Show)
parseBaseInstance :: String
......@@ -110,7 +111,7 @@ parseData body = do
ridx <- lookupNode kti rname rname
ex_nodes <- fromObj "relocate_from" request
let ex_nodes' = map (stripSuffix $ length csf) ex_nodes
ex_idex <- mapM (findByName map_n) ex_nodes'
ex_idex <- mapM (Container.findByName map_n) ex_nodes'
return $ Relocate ridx req_nodes ex_idex
other -> fail $ ("Invalid request type '" ++ other ++ "'")
return $ Request rqtype map_n map_i csf
......
......@@ -6,6 +6,9 @@ intelligence is in the "Node" and "Cluster" modules.
-}
module Ganeti.HTools.Instance where
import qualified Ganeti.HTools.Types as T
import qualified Ganeti.HTools.Container as Container
data Instance = Instance { name :: String -- ^ the instance name
, mem :: Int -- ^ memory of the instance
, dsk :: Int -- ^ disk size of instance
......@@ -18,9 +21,18 @@ data Instance = Instance { name :: String -- ^ the instance name
-- book-keeping
} deriving (Show)
instance T.Element Instance where
nameOf = name
idxOf = idx
setName = setName
setIdx = setIdx
-- | A simple name for the int, instance association list
type AssocList = [(Int, Instance)]
-- | A simple name for an instance map
type List = Container.Container Instance
create :: String -> Int -> Int -> String -> Int -> Int -> Instance
create name_init mem_init dsk_init run_init pn sn =
Instance {
......@@ -65,4 +77,4 @@ setIdx t i = t { idx = i }
-- | Changes the name
-- This is used only during the building of the data structures.
setName t s = t {name = s}
setName t s = t { name = s }
......@@ -81,7 +81,7 @@ stripSuffix sflen name = take ((length name) - sflen) name
mergeData :: (Node.AssocList,
Instance.AssocList) -- ^ Data from either Text.loadData
-- or Rapi.loadData
-> Result (NodeList, InstanceList, String)
-> Result (Node.List, Instance.List, String)
mergeData (nl, il) = do
let
nl2 = fixNodes nl il
......@@ -92,13 +92,13 @@ mergeData (nl, il) = do
inst_names = map Instance.name $ Container.elems il3
common_suffix = longestDomain (node_names ++ inst_names)
csl = length common_suffix
snl = Container.map (\n -> setName n (stripSuffix csl $ name n)) nl3
sil = Container.map (\i -> setName i (stripSuffix csl $ name i)) il3
snl = Container.map (\n -> setName n (stripSuffix csl $ nameOf n)) nl3
sil = Container.map (\i -> setName i (stripSuffix csl $ nameOf i)) il3
return (snl, sil, common_suffix)
-- | Check cluster data for consistency
checkData :: NodeList -> InstanceList
-> ([String], NodeList)
checkData :: Node.List -> Instance.List
-> ([String], Node.List)
checkData nl il =
Container.mapAccum
(\ msgs node ->
......@@ -125,7 +125,7 @@ checkData nl il =
) [] nl
-- | Compute the amount of memory used by primary instances on a node.
nodeImem :: Node.Node -> InstanceList -> Int
nodeImem :: Node.Node -> Instance.List -> Int
nodeImem node il =
let rfind = flip Container.find $ il
in sum . map Instance.mem .
......@@ -133,7 +133,7 @@ nodeImem node il =
-- | Compute the amount of disk used by instances on a node (either primary
-- or secondary).
nodeIdsk :: Node.Node -> InstanceList -> Int
nodeIdsk :: Node.Node -> Instance.List -> Int
nodeIdsk node il =
let rfind = flip Container.find $ il
in sum . map Instance.dsk .
......
......@@ -5,10 +5,10 @@
-}
module Ganeti.HTools.Node
(
Node(failN1, name, idx, t_mem, n_mem, f_mem, t_dsk, f_dsk,
( Node(failN1, name, idx, t_mem, n_mem, f_mem, t_dsk, f_dsk,
p_mem, p_dsk, p_rem,
plist, slist, offline)
, List
-- * Constructor
, create
-- ** Finalization after data loading
......@@ -39,6 +39,8 @@ import qualified Ganeti.HTools.Container as Container
import qualified Ganeti.HTools.Instance as Instance
import qualified Ganeti.HTools.PeerMap as PeerMap
import qualified Ganeti.HTools.Types as T
data Node = Node { name :: String -- ^ the node name
, t_mem :: Double -- ^ total memory (MiB)
, n_mem :: Int -- ^ node memory (MiB)
......@@ -61,9 +63,18 @@ data Node = Node { name :: String -- ^ the node name
-- score computations
} deriving (Show)
instance T.Element Node where
nameOf = name
idxOf = idx
setName = setName
setIdx = setIdx
-- | A simple name for the int, node association list
type AssocList = [(Int, Node)]
-- | A simple name for a node map
type List = Container.Container Node
-- | Constant node index for a non-moveable instance
noSecondary :: Int
noSecondary = -1
......
......@@ -5,30 +5,19 @@
module Ganeti.HTools.Types
where
import qualified Ganeti.HTools.Container as Container
import qualified Ganeti.HTools.Instance as Instance
import qualified Ganeti.HTools.Node as Node
type NodeList = Container.Container Node.Node
type InstanceList = Container.Container Instance.Instance
-- | The type used to hold idx-to-name mappings
type NameList = [(Int, String)]
-- | The type used to hold name-to-idx mappings
type NameAssoc = [(String, Int)]
type IdxNode = [(Int, Node.Node)]
type IdxInstance = [(Int, Instance.Instance)]
{-
{-|
This is similar to the JSON library Result type - *very* similar, but
we want to use it in multiple places, so we abstract it into a
mini-library here
-}
data Result a
= Bad String
| Ok a
......@@ -40,45 +29,9 @@ instance Monad Result where
return = Ok
fail = Bad
-- | A generic class for nodes and instances
-- | A generic class for items that have names and indices
class Element a where
name :: a -> String
idx :: a -> Int
nameOf :: a -> String
idxOf :: a -> Int
setName :: a -> String -> a
setIdx :: a -> Int -> a
-- Let's make nodes elements of the cluster
instance Element Node.Node where
name = Node.name
idx = Node.idx
setName = Node.setName
setIdx = Node.setIdx
-- And instances too
instance Element Instance.Instance where
name = Instance.name
idx = Instance.idx
setName = Instance.setName
setIdx = Instance.setIdx
-- | Compute the name of an element in a container
cNameOf :: (Element a) => Container.Container a -> Container.Key -> String
cNameOf c k = name $ Container.find k c
-- | Compute the maximum name length in an Element Container
cMaxNamelen :: (Element a) => Container.Container a -> Int
cMaxNamelen = maximum . map (length . name) . Container.elems
-- | Find an element by name in a Container; this is a very slow function
findByName :: (Element a, Monad m) =>
Container.Container a -> String -> m Container.Key
findByName c n =
let all_elems = Container.elems c
result = filter ((== n) . name) all_elems
nems = length result
in
if nems /= 1 then
fail $ "Wrong number of elems (" ++ (show nems) ++
") found with name " ++ n
else
return $ idx $ head result
......@@ -51,17 +51,17 @@ options =
"show help"
]
-- | Compute online nodes from a NodeList
getOnline :: NodeList -> [Node.Node]
-- | Compute online nodes from a Node.List
getOnline :: Node.List -> [Node.Node]
getOnline = filter (not . Node.offline) . Container.elems
-- | Try to allocate an instance on the cluster
tryAlloc :: (Monad m) =>
NodeList
-> InstanceList
Node.List
-> Instance.List
-> Instance.Instance
-> Int
-> m [(Maybe NodeList, [Node.Node])]
-> m [(Maybe Node.List, [Node.Node])]
tryAlloc nl _ inst 2 =
let all_nodes = getOnline nl
all_pairs = liftM2 (,) all_nodes all_nodes
......@@ -83,17 +83,17 @@ tryAlloc _ _ _ reqn = fail $ "Unsupported number of alllocation \
-- | Try to allocate an instance on the cluster
tryReloc :: (Monad m) =>
NodeList
-> InstanceList
Node.List
-> Instance.List
-> Int
-> Int
-> [Int]
-> m [(Maybe NodeList, [Node.Node])]
-> m [(Maybe Node.List, [Node.Node])]
tryReloc nl il xid 1 ex_idx =
let all_nodes = getOnline nl
inst = Container.find xid il
ex_idx' = (Instance.pnode inst):ex_idx
valid_nodes = filter (not . flip elem ex_idx' . idx) all_nodes
valid_nodes = filter (not . flip elem ex_idx' . idxOf) all_nodes
valid_idxes = map Node.idx valid_nodes
sols1 = map (\x -> let (mnl, _, _, _) =
Cluster.applyMove nl inst
......@@ -106,8 +106,8 @@ tryReloc _ _ _ reqn _ = fail $ "Unsupported number of relocation \
\destinations required (" ++ (show reqn) ++
"), only one supported"
filterFails :: (Monad m) => [(Maybe NodeList, [Node.Node])]
-> m [(NodeList, [Node.Node])]
filterFails :: (Monad m) => [(Maybe Node.List, [Node.Node])]
-> m [(Node.List, [Node.Node])]
filterFails sols =
if null sols then fail "No nodes onto which to allocate at all"
else let sols' = filter (isJust . fst) sols
......@@ -116,7 +116,7 @@ filterFails sols =
else
return $ map (\(x, y) -> (fromJust x, y)) sols'
processResults :: (Monad m) => [(NodeList, [Node.Node])]
processResults :: (Monad m) => [(Node.List, [Node.Node])]
-> m (String, [Node.Node])
processResults sols =
let sols' = map (\(nl', ns) -> (Cluster.compCV nl', ns)) sols
......@@ -156,7 +156,7 @@ main = do
let sols = new_nodes >>= filterFails >>= processResults
let (ok, info, rn) = case sols of
Ok (info, sn) -> (True, "Request successful: " ++ info,
map ((++ csf) . name) sn)
map ((++ csf) . Node.name) sn)
Bad s -> (False, "Request failed: " ++ s, [])
resp = formatResponse ok info rn
putStrLn resp
......@@ -21,7 +21,6 @@ import qualified Ganeti.HTools.Node as Node
import qualified Ganeti.HTools.CLI as CLI
import Ganeti.HTools.Utils
import Ganeti.HTools.Types
-- | Command line options structure.
data Options = Options
......@@ -245,8 +244,8 @@ main = do
printf "Initial score: %.8f\n" ini_cv)
unless oneline $ putStrLn "Trying to minimize the CV..."
let imlen = cMaxNamelen il
nmlen = cMaxNamelen nl
let imlen = Container.maxNameLen il
nmlen = Container.maxNameLen nl
(fin_tbl, cmd_strs) <- iterateDepth ini_tbl (optMaxLength opts)
nmlen imlen [] oneline min_cv
......
......@@ -16,9 +16,9 @@ import Text.Printf (printf)
import qualified Ganeti.HTools.Container as Container
import qualified Ganeti.HTools.Instance as Instance
import qualified Ganeti.HTools.Node as Node
import qualified Ganeti.HTools.Cluster as Cluster
import qualified Ganeti.HTools.CLI as CLI
import Ganeti.HTools.Types
-- | Command line options structure.
data Options = Options
......@@ -71,7 +71,7 @@ defaultOptions = Options
we find a valid solution or we exceed the maximum depth.
-}
iterateDepth :: NodeList
iterateDepth :: Node.List
-> [Instance.Instance]
-> Int
-> Int
......
......@@ -73,7 +73,7 @@ options =
]
-- | Generate node file data from node objects
serializeNodes :: Cluster.NodeList -> String -> String
serializeNodes :: Node.List -> String -> String
serializeNodes nl csf =
let nodes = Container.elems nl