-- | Usage info
usageHelp :: (CLIOptions a) => String -> [OptDescr (a -> a)] -> String
-usageHelp progname options =
+usageHelp progname =
usageInfo (printf "%s %s\nUsage: %s [OPTION...]"
- progname Version.version progname) options
+ progname Version.version progname)
-- | Command line parser, using the 'options' structure.
parseOpts :: (CLIOptions b) =>
unless (null fix_msgs || silent opts) $ do
putStrLn "Warning: cluster has inconsistent data:"
- putStrLn . unlines . map (\s -> printf " - %s" s) $ fix_msgs
+ putStrLn . unlines . map (printf " - %s") $ fix_msgs
return (fixed_nl, il, csf)
-- | Verifies the N+1 status and return the affected nodes.
verifyN1 :: [Node.Node] -> [Node.Node]
-verifyN1 nl = filter Node.failN1 nl
+verifyN1 = filter Node.failN1
{-| Computes the pair of bad nodes and instances.
([Node.Node], [Instance.Instance])
computeBadItems nl il =
let bad_nodes = verifyN1 $ getOnline nl
- bad_instances = map (\idx -> Container.find idx il) $
- sort $ nub $ concat $
- map (\ n -> (Node.slist n) ++ (Node.plist n)) bad_nodes
+ bad_instances = map (\idx -> Container.find idx il) .
+ sort . nub $
+ concatMap (\ n -> Node.slist n ++ Node.plist n) bad_nodes
in
(bad_nodes, bad_instances)
cs_amem = x_amem, cs_acpu = x_acpu, cs_adsk = x_adsk,
cs_mmem = x_mmem, cs_mdsk = x_mdsk, cs_mcpu = x_mcpu }
= cs
- inc_amem = (Node.f_mem node) - (Node.r_mem node)
+ inc_amem = Node.f_mem node - Node.r_mem node
inc_amem' = if inc_amem > 0 then inc_amem else 0
inc_adsk = Node.availDisk node
- in CStats { cs_fmem = x_fmem + (Node.f_mem node)
- , cs_fdsk = x_fdsk + (Node.f_dsk node)
+ in CStats { cs_fmem = x_fmem + Node.f_mem node
+ , cs_fdsk = x_fdsk + Node.f_dsk node
, cs_amem = x_amem + inc_amem'
, cs_adsk = x_adsk + inc_adsk
, cs_acpu = x_acpu
mem_cv = varianceCoeff mem_l
dsk_cv = varianceCoeff dsk_l
n1_l = length $ filter Node.failN1 nodes
- n1_score = ((fromIntegral n1_l) /
- (fromIntegral $ length nodes))::Double
+ n1_score = fromIntegral n1_l /
+ fromIntegral (length nodes)::Double
res_l = map Node.p_rem nodes
res_cv = varianceCoeff res_l
offline_inst = sum . map (\n -> (length . Node.plist $ n) +
(length . Node.slist $ n)) $ offline
online_inst = sum . map (\n -> (length . Node.plist $ n) +
(length . Node.slist $ n)) $ nodes
- off_score = ((fromIntegral offline_inst) /
- (fromIntegral $ online_inst + offline_inst))::Double
+ off_score = fromIntegral offline_inst /
+ fromIntegral (online_inst + offline_inst)::Double
cpu_l = map Node.p_cpu nodes
cpu_cv = varianceCoeff cpu_l
in (mem_cv, dsk_cv, n1_score, res_cv, off_score, cpu_cv)
let tmp_s' = Node.removePri tmp_s inst
new_p <- Node.addPri tgt_n inst
new_s <- Node.addSec tmp_s' inst new_pdx
- return $ Container.add new_pdx new_p $
+ return . Container.add new_pdx new_p $
Container.addTwo old_pdx int_p old_sdx new_s nl
in (new_nl, Instance.setPri inst new_pdx, new_pdx, old_sdx)
new_nl = do -- Maybe monad
new_p <- Node.addPri tgt_n inst
new_s <- Node.addSec int_p inst new_pdx
- return $ Container.add new_pdx new_p $
+ return . Container.add new_pdx new_p $
Container.addTwo old_pdx new_s old_sdx int_s nl
in (new_nl, Instance.setBoth inst new_pdx old_pdx, new_pdx, old_pdx)
new_nl = do -- Maybe monad
new_p <- Node.addPri int_s inst
new_s <- Node.addSec tgt_n inst old_sdx
- return $ Container.add new_sdx new_s $
+ return . Container.add new_sdx new_s $
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)
in return sols
tryAlloc _ _ _ reqn = fail $ "Unsupported number of alllocation \
- \destinations required (" ++ (show reqn) ++
+ \destinations required (" ++ show reqn ++
"), only two supported"
-- | Try to allocate an instance on the cluster.
tryReloc nl il xid 1 ex_idx =
let all_nodes = getOnline nl
inst = Container.find xid il
- ex_idx' = (Instance.pnode inst):ex_idx
+ ex_idx' = Instance.pnode inst:ex_idx
valid_nodes = filter (not . flip elem ex_idx' . Node.idx) all_nodes
valid_idxes = map Node.idx valid_nodes
sols1 = map (\x -> let (mnl, i, _, _) =
in return sols1
tryReloc _ _ _ reqn _ = fail $ "Unsupported number of relocation \
- \destinations required (" ++ (show reqn) ++
+ \destinations required (" ++ show reqn ++
"), only one supported"
-- * Formatting functions
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
+ ostr = printf "%s:%s" opri osec::String
+ nstr = printf "%s:%s" npri nsec::String
in
(printf " %3d. %-*s %-*s => %-*s %.8f a=%s"
pos imlen inam pmlen ostr
-- | Given a list of commands, prefix them with @gnt-instance@ and
-- also beautify the display a little.
formatCmds :: [[String]] -> String
-formatCmds cmd_strs =
- unlines $
- concat $ map (\(a, b) ->
- (printf "echo step %d" (a::Int)):
- (printf "check"):
- (map ("gnt-instance " ++) b)) $
- zip [1..] cmd_strs
+formatCmds =
+ unlines .
+ concatMap (\(a, b) ->
+ printf "echo step %d" (a::Int):
+ printf "check":
+ map ("gnt-instance " ++) b
+ ) .
+ zip [1..]
-- | Converts a solution to string format.
printSolution :: Node.List
nmlen = Container.maxNameLen nl
imlen = Container.maxNameLen il
in
- unzip $ map (uncurry $ printSolutionLine nl il nmlen imlen) $
- zip sol [1..]
+ unzip $ zipWith (printSolutionLine nl il nmlen imlen) sol [1..]
-- | Print the node list.
printNodes :: Node.List -> String
let snl = sortBy (compare `on` Node.idx) (Container.elems nl)
m_name = maximum . map (length . Node.name) $ snl
helper = Node.list m_name
- header = (printf
- "%2s %-*s %5s %5s %5s %5s %5s %5s %5s %5s %4s %4s \
- \%3s %3s %6s %6s %5s"
- " F" m_name "Name"
- "t_mem" "n_mem" "i_mem" "x_mem" "f_mem" "r_mem"
- "t_dsk" "f_dsk" "pcpu" "vcpu"
- "pri" "sec" "p_fmem" "p_fdsk" "r_cpu")::String
- in unlines $ (header:map helper snl)
+ header = printf
+ "%2s %-*s %5s %5s %5s %5s %5s %5s %5s %5s %4s %4s \
+ \%3s %3s %6s %6s %5s"
+ " F" m_name "Name"
+ "t_mem" "n_mem" "i_mem" "x_mem" "f_mem" "r_mem"
+ "t_dsk" "f_dsk" "pcpu" "vcpu"
+ "pri" "sec" "p_fmem" "p_fdsk" "r_cpu"::String
+ in unlines (header:map helper snl)
-- | Shows statistics for a given node list.
printStats :: Node.List -> String
-- | Add or update one element to the map.
add :: Key -> a -> Container a -> Container a
-add k v c = IntMap.insert k v c
+add = IntMap.insert
-- | Remove an element from the map.
remove :: Key -> Container a -> Container a
-- | 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
+addTwo k1 v1 k2 v2 = add k1 v1 . add k2 v2
-- | Compute the name of an element in a container.
nameOf :: (T.Element a) => Container a -> Key -> String
nems = length result
in
if nems /= 1 then
- fail $ "Wrong number of elems (" ++ (show nems) ++
+ fail $ "Wrong number of elems (" ++ show nems ++
") found with name " ++ n
else
return $ T.idxOf $ head result
mem <- fromObj "memory" a
vcpus <- fromObj "vcpus" a
let running = "running"
- return $ (n, Instance.create n mem disk vcpus running 0 0)
+ return (n, Instance.create n mem disk vcpus running 0 0)
-- | Parses an instance as found in the cluster instance list.
parseInstance :: NameAssoc -- ^ The node name-to-index association list
pidx <- lookupNode ktn n pnode
let snodes = tail nodes
sidx <- (if null snodes then return Node.noSecondary
- else (readEitherString $ head snodes) >>= lookupNode ktn n)
+ else readEitherString (head snodes) >>= lookupNode ktn n)
return (n, Instance.setBoth (snd base) pidx sidx)
-- | Parses a node as found in the cluster node list.
let name = n
offline <- fromObj "offline" a
drained <- fromObj "drained" a
- node <- (case offline of
- True -> return $ Node.create name 0 0 0 0 0 0 True
- _ -> do
- mtotal <- fromObj "total_memory" a
- mnode <- fromObj "reserved_memory" a
- mfree <- fromObj "free_memory" a
- dtotal <- fromObj "total_disk" a
- dfree <- fromObj "free_disk" a
- ctotal <- fromObj "total_cpus" a
- return $ Node.create n mtotal mnode mfree
- dtotal dfree ctotal (offline || drained))
+ node <- (if offline
+ then return $ Node.create name 0 0 0 0 0 0 True
+ else do
+ mtotal <- fromObj "total_memory" a
+ mnode <- fromObj "reserved_memory" a
+ mfree <- fromObj "free_memory" a
+ dtotal <- fromObj "total_disk" a
+ dfree <- fromObj "free_disk" a
+ ctotal <- fromObj "total_cpus" a
+ return $ Node.create n mtotal mnode mfree
+ dtotal dfree ctotal (offline || drained))
return (name, node)
-- | Top-level parser.
-- existing node parsing
nlist <- fromObj "nodes" obj
let ndata = fromJSObject nlist
- nobj <- (mapM (\(x,y) -> asJSObject y >>= parseNode x)) ndata
+ nobj <- mapM (\(x,y) -> asJSObject y >>= parseNode x) ndata
let (ktn, nl) = assignIndices nobj
-- existing instance parsing
ilist <- fromObj "instances" obj
let idata = fromJSObject ilist
- iobj <- (mapM (\(x,y) -> asJSObject y >>= parseInstance ktn x)) idata
+ iobj <- mapM (\(x,y) -> asJSObject y >>= parseInstance ktn x) idata
let (kti, il) = assignIndices iobj
(map_n, map_i, csf) <- mergeData (nl, il)
req_nodes <- fromObj "required_nodes" request
let ex_nodes' = map (stripSuffix $ length csf) ex_nodes
ex_idex <- mapM (Container.findByName map_n) ex_nodes'
return $ Relocate ridx req_nodes ex_idex
- other -> fail $ ("Invalid request type '" ++ other ++ "'")
+ other -> fail ("Invalid request type '" ++ other ++ "'")
return $ Request rqtype map_n map_i csf
-- | Formats the response into a valid IAllocator response message.
fixNodes :: [(Ndx, Node.Node)]
-> [(Idx, Instance.Instance)]
-> [(Ndx, Node.Node)]
-fixNodes nl il =
+fixNodes =
foldl' (\accu (idx, inst) ->
let
pdx = Instance.pnode inst
in ac4
else
ac2
- ) nl il
+ )
-- | Compute the longest common suffix of a list of strings that
-- | starts with a dot.
-- | Remove tail suffix from a string.
stripSuffix :: Int -> String -> String
-stripSuffix sflen name = take ((length name) - sflen) name
+stripSuffix sflen name = take (length name - sflen) name
-- | Initializer function that loads the data from a node and instance
-- list and massages it into the correct format.
Container.mapAccum
(\ msgs node ->
let nname = Node.name node
- nilst = map (flip Container.find $ il) (Node.plist node)
+ nilst = map (flip Container.find il) (Node.plist node)
dilst = filter (not . Instance.running) nilst
adj_mem = sum . map Instance.mem $ dilst
- delta_mem = (truncate $ Node.t_mem node)
- - (Node.n_mem node)
- - (Node.f_mem node)
- - (nodeImem node il)
+ delta_mem = truncate (Node.t_mem node)
+ - Node.n_mem node
+ - Node.f_mem node
+ - nodeImem node il
+ adj_mem
- delta_dsk = (truncate $ Node.t_dsk node)
- - (Node.f_dsk node)
- - (nodeIdsk node il)
+ delta_dsk = truncate (Node.t_dsk node)
+ - Node.f_dsk node
+ - nodeIdsk node il
newn = Node.setFmem (Node.setXmem node delta_mem)
(Node.f_mem node - adj_mem)
- umsg1 = (if delta_mem > 512 || delta_dsk > 1024
- then [printf "node %s is missing %d MB ram \
- \and %d GB disk"
- nname delta_mem (delta_dsk `div` 1024)]
- else [])::[String]
+ umsg1 = [printf "node %s is missing %d MB ram \
+ \and %d GB disk"
+ nname delta_mem (delta_dsk `div` 1024) |
+ delta_mem > 512 || delta_dsk > 1024]::[String]
in (msgs ++ umsg1, newn)
) [] nl
-- | Compute the amount of memory used by primary instances on a node.
nodeImem :: Node.Node -> Instance.List -> Int
nodeImem node il =
- let rfind = flip Container.find $ il
- in sum . map Instance.mem .
- map rfind $ Node.plist node
+ let rfind = flip Container.find il
+ in sum . map (Instance.mem . rfind)
+ $ Node.plist node
-- | Compute the amount of disk used by instances on a node (either primary
-- or secondary).
nodeIdsk :: Node.Node -> Instance.List -> Int
nodeIdsk node il =
- let rfind = flip Container.find $ il
- in sum . map Instance.dsk .
- map rfind $ (Node.plist node) ++ (Node.slist node)
+ let rfind = flip Container.find il
+ in sum . map (Instance.dsk . rfind)
+ $ Node.plist node ++ Node.slist node
idx = -1,
peers = PeerMap.empty,
r_mem = 0,
- p_mem = (fromIntegral mem_f_init) / mem_t_init,
- p_dsk = (fromIntegral dsk_f_init) / dsk_t_init,
+ p_mem = fromIntegral mem_f_init / mem_t_init,
+ p_dsk = fromIntegral dsk_f_init / dsk_t_init,
p_rem = 0,
p_cpu = 0,
offline = offline_init,
setMdsk t val = t { m_dsk = val,
lo_dsk = if val == noLimit
then noLimitInt
- else floor (val * (t_dsk t)) }
+ else floor (val * t_dsk t) }
-- | Sets the max cpu usage ratio
setMcpu :: Node -> Double -> Node
-setMcpu t val = t { m_cpu = val, hi_cpu = floor (val * (t_cpu t)) }
+setMcpu t val = t { m_cpu = val, hi_cpu = floor (val * t_cpu t) }
-- | Computes the maximum reserved memory for peers from a peer map.
computeMaxRes :: PeerMap.PeerMap -> PeerMap.Elem
-computeMaxRes new_peers = PeerMap.maxElem new_peers
+computeMaxRes = PeerMap.maxElem
-- | Builds the peer map for a given node.
buildPeers :: Node -> Instance.List -> Node
(slist t)
pmap = PeerMap.accumArray (+) mdata
new_rmem = computeMaxRes pmap
- new_failN1 = (f_mem t) <= new_rmem
- new_prem = (fromIntegral new_rmem) / (t_mem t)
+ new_failN1 = f_mem t <= new_rmem
+ new_prem = fromIntegral new_rmem / t_mem t
in t {peers=pmap, failN1 = new_failN1, r_mem = new_rmem, p_rem = new_prem}
-- | Assigns an instance to a node as primary without other updates.
setPri :: Node -> T.Idx -> Node
-setPri t idx = t { plist = idx:(plist t) }
+setPri t idx = t { plist = idx:plist t }
-- | Assigns an instance to a node as secondary without other updates.
setSec :: Node -> T.Idx -> Node
-setSec t idx = t { slist = idx:(slist t) }
+setSec t idx = t { slist = idx:slist t }
-- | Add primary cpus to a node
addCpus :: Node -> Int -> Node
addCpus t count =
- let new_count = (u_cpu t) + count
- in t { u_cpu = new_count, p_cpu = (fromIntegral new_count) / (t_cpu t) }
+ let new_count = u_cpu t + count
+ in t { u_cpu = new_count, p_cpu = fromIntegral new_count / t_cpu t }
-- * Update functions
-- | Sets the free memory.
setFmem :: Node -> Int -> Node
setFmem t new_mem =
- let new_n1 = new_mem <= (r_mem t)
- new_mp = (fromIntegral new_mem) / (t_mem t)
+ let new_n1 = new_mem <= r_mem t
+ new_mp = fromIntegral new_mem / t_mem t
in
t { f_mem = new_mem, failN1 = new_n1, p_mem = new_mp }
new_plist = delete iname (plist t)
new_mem = f_mem t + Instance.mem inst
new_dsk = f_dsk t + Instance.dsk inst
- new_mp = (fromIntegral new_mem) / (t_mem t)
- new_dp = (fromIntegral new_dsk) / (t_dsk t)
- new_failn1 = new_mem <= (r_mem t)
- new_ucpu = (u_cpu t) - (Instance.vcpus inst)
- new_rcpu = (fromIntegral new_ucpu) / (t_cpu t)
+ new_mp = fromIntegral new_mem / t_mem t
+ new_dp = fromIntegral new_dsk / t_dsk t
+ new_failn1 = new_mem <= r_mem t
+ new_ucpu = u_cpu t - Instance.vcpus inst
+ new_rcpu = fromIntegral new_ucpu / t_cpu t
in t {plist = new_plist, f_mem = new_mem, f_dsk = new_dsk,
failN1 = new_failn1, p_mem = new_mp, p_dsk = new_dp,
u_cpu = new_ucpu, p_cpu = new_rcpu}
new_dsk = f_dsk t + Instance.dsk inst
old_peers = peers t
old_peem = PeerMap.find pnode old_peers
- new_peem = old_peem - (Instance.mem inst)
+ new_peem = old_peem - Instance.mem inst
new_peers = PeerMap.add pnode new_peem old_peers
old_rmem = r_mem t
new_rmem = if old_peem < old_rmem then
old_rmem
else
computeMaxRes new_peers
- new_prem = (fromIntegral new_rmem) / (t_mem t)
- new_failn1 = (f_mem t) <= new_rmem
- new_dp = (fromIntegral new_dsk) / (t_dsk t)
+ new_prem = fromIntegral new_rmem / t_mem t
+ new_failn1 = f_mem t <= new_rmem
+ new_dp = fromIntegral new_dsk / t_dsk t
in t {slist = new_slist, f_dsk = new_dsk, peers = new_peers,
failN1 = new_failn1, r_mem = new_rmem, p_dsk = new_dp,
p_rem = new_prem}
let iname = Instance.idx inst
new_mem = f_mem t - Instance.mem inst
new_dsk = f_dsk t - Instance.dsk inst
- new_failn1 = new_mem <= (r_mem t)
- new_ucpu = (u_cpu t) + (Instance.vcpus inst)
- new_pcpu = (fromIntegral new_ucpu) / (t_cpu t)
- new_dp = (fromIntegral new_dsk) / (t_dsk t)
+ new_failn1 = new_mem <= r_mem t
+ new_ucpu = u_cpu t + Instance.vcpus inst
+ new_pcpu = fromIntegral new_ucpu / t_cpu t
+ new_dp = fromIntegral new_dsk / t_dsk t
l_cpu = m_cpu t
in if new_mem <= 0 then T.OpFail T.FailMem
else if new_dsk <= 0 || m_dsk t > new_dp then T.OpFail T.FailDisk
- else if (new_failn1 && not (failN1 t)) then T.OpFail T.FailMem
+ else if new_failn1 && not (failN1 t) then T.OpFail T.FailMem
else if l_cpu >= 0 && l_cpu < new_pcpu then T.OpFail T.FailCPU
else
- let new_plist = iname:(plist t)
- new_mp = (fromIntegral new_mem) / (t_mem t)
+ let new_plist = iname:plist t
+ new_mp = fromIntegral new_mem / t_mem t
r = t { plist = new_plist, f_mem = new_mem, f_dsk = new_dsk,
failN1 = new_failn1, p_mem = new_mp, p_dsk = new_dp,
u_cpu = new_ucpu, p_cpu = new_pcpu }
new_peem = PeerMap.find pdx old_peers + Instance.mem inst
new_peers = PeerMap.add pdx new_peem old_peers
new_rmem = max (r_mem t) new_peem
- new_prem = (fromIntegral new_rmem) / (t_mem t)
+ new_prem = fromIntegral new_rmem / t_mem t
new_failn1 = old_mem <= new_rmem
- new_dp = (fromIntegral new_dsk) / (t_dsk t)
+ new_dp = fromIntegral new_dsk / t_dsk t
in if new_dsk <= 0 || m_dsk t > new_dp then T.OpFail T.FailDisk
- else if (new_failn1 && not (failN1 t)) then T.OpFail T.FailMem
- else let new_slist = iname:(slist t)
+ else if new_failn1 && not (failN1 t) then T.OpFail T.FailMem
+ else let new_slist = iname:slist t
r = t { slist = new_slist, f_dsk = new_dsk,
peers = new_peers, failN1 = new_failn1,
r_mem = new_rmem, p_dsk = new_dp,
nmem = n_mem t
xmem = x_mem t
fmem = f_mem t
- imem = (truncate tmem) - nmem - xmem - fmem
+ imem = truncate tmem - nmem - xmem - fmem
in
if off
then printf " - %-*s %57s %3d %3d"
\ %4.0f %4d %3d %3d %6.4f %6.4f %5.2f"
(if off then '-' else if fn then '*' else ' ')
mname (name t) tmem nmem imem xmem fmem (r_mem t)
- ((t_dsk t) / 1024) ((f_dsk t) `div` 1024)
+ (t_dsk t / 1024) (f_dsk t `div` 1024)
(t_cpu t) (u_cpu t)
pl sl mp dp cp
-- | Returns either the value for a key or zero if not found
find :: Key -> PeerMap -> Elem
-find k c = fromMaybe 0 $ lookup k c
+find k = fromMaybe 0 . lookup k
-- | Add an element to a peermap, overwriting the previous value
add :: Key -> Elem -> PeerMap -> PeerMap
-add k v c = addWith (flip const) k v c
+add = addWith (flip const)
-- | Remove an element from a peermap
remove :: Key -> PeerMap -> PeerMap
remove k c = case c of
[] -> []
(x@(x', _)):xs -> if k == x' then xs
- else x:(remove k xs)
+ else x:remove k xs
-- | Find the maximum element.
--
-- | Check that an instance add with too high memory or disk will be rejected
prop_Node_addPri node inst = (Instance.mem inst >= Node.f_mem node ||
Instance.dsk inst >= Node.f_dsk node) &&
- (not $ Node.failN1 node)
+ not (Node.failN1 node)
==>
isNothing(Node.addPri node inst)
where _types = (node::Node.Node, inst::Instance.Instance)
prop_Node_addSec node inst pdx =
(Instance.mem inst >= (Node.f_mem node - Node.r_mem node) ||
Instance.dsk inst >= Node.f_dsk node) &&
- (not $ Node.failN1 node)
+ not (Node.failN1 node)
==> isNothing(Node.addSec node inst pdx)
where _types = (node::Node.Node, inst::Instance.Instance, pdx::Int)
getInstances :: NameAssoc
-> String
-> Result [(String, Instance.Instance)]
-getInstances ktn body = do
- arr <- loadJSArray body
- ilist <- mapM (parseInstance ktn) arr
- return ilist
+getInstances ktn body = loadJSArray body >>= mapM (parseInstance ktn)
-- | Parse a node list in JSON format.
getNodes :: String -> Result [(String, Node.Node)]
-getNodes body = do
- arr <- loadJSArray body
- nlist <- mapM parseNode arr
- return nlist
+getNodes body = loadJSArray body >>= mapM parseNode
-- | Construct an instance from a JSON object.
parseInstance :: [(String, Ndx)]
parseNode a = do
name <- fromObj "name" a
offline <- fromObj "offline" a
- node <- (case offline of
- True -> return $ Node.create name 0 0 0 0 0 0 True
- _ -> do
- drained <- fromObj "drained" a
- mtotal <- fromObj "mtotal" a
- mnode <- fromObj "mnode" a
- mfree <- fromObj "mfree" a
- dtotal <- fromObj "dtotal" a
- dfree <- fromObj "dfree" a
- ctotal <- fromObj "ctotal" a
- return $ Node.create name mtotal mnode mfree
- dtotal dfree ctotal (offline || drained))
+ node <- (if offline
+ then return $ Node.create name 0 0 0 0 0 0 True
+ else do
+ drained <- fromObj "drained" a
+ mtotal <- fromObj "mtotal" a
+ mnode <- fromObj "mnode" a
+ mfree <- fromObj "mfree" a
+ dtotal <- fromObj "dtotal" a
+ dfree <- fromObj "dfree" a
+ ctotal <- fromObj "ctotal" a
+ return $ Node.create name mtotal mnode mfree
+ dtotal dfree ctotal (offline || drained))
return (name, node)
-- | Builds the cluster data from an URL.
-- | Safe 'read' function returning data encapsulated in a Result.
tryRead :: (Monad m, Read a) => String -> String -> m a
-tryRead name s = parseChoices name s $ readsPrec 0 s
+tryRead name s = parseChoices name s $ reads s
-- | Load a node from a field list.
loadNode :: (Monad m) => [String] -> m (String, Node.Node)
vtc <- tryRead name tc
return $ Node.create name vtm vnm vfm vtd vfd vtc False
return (name, new_node)
-loadNode s = fail $ "Invalid/incomplete node data: '" ++ (show s) ++ "'"
+loadNode s = fail $ "Invalid/incomplete node data: '" ++ show s ++ "'"
-- | Load an instance from a field list.
loadInst :: (Monad m) =>
" has same primary and secondary node - " ++ pnode
let newinst = Instance.create name vmem vdsk vvcpus status pidx sidx
return (name, newinst)
-loadInst _ s = fail $ "Invalid/incomplete instance data: '" ++ (show s) ++ "'"
+loadInst _ s = fail $ "Invalid/incomplete instance data: '" ++ show s ++ "'"
-- | Convert newline and delimiter-separated text.
--
sepSplit sep s
| x == "" && xs == [] = []
| xs == [] = [x]
- | ys == [] = x:"":[]
- | otherwise = x:(sepSplit sep ys)
+ | ys == [] = [x,""]
+ | otherwise = x:sepSplit sep ys
where (x, xs) = break (== sep) s
ys = drop 1 xs
-- | Mean value of a list.
meanValue :: Floating a => [a] -> a
-meanValue lst = (sum lst) / (fromIntegral $ length lst)
+meanValue lst = sum lst / fromIntegral (length lst)
-- | Squaring function
square :: (Num a) => a -> a
stdDev :: Floating a => [a] -> a
stdDev lst =
let mv = meanValue lst
- av = sum $ map square $ map (\e -> e - mv) lst
- bv = sqrt (av / (fromIntegral $ length lst))
+ av = sum $ map (square . (\e -> e - mv)) lst
+ bv = sqrt (av / fromIntegral (length lst))
in bv
-- | Coefficient of variation.
varianceCoeff :: Floating a => [a] -> a
-varianceCoeff lst = (stdDev lst) / (fromIntegral $ length lst)
+varianceCoeff lst = stdDev lst / fromIntegral (length lst)
-- * JSON-related functions
-- | Converts a JSON message into an array of JSON objects.
loadJSArray :: (Monad m) => String -> m [J.JSObject J.JSValue]
-loadJSArray s = fromJResult $ J.decodeStrict s
+loadJSArray = fromJResult . J.decodeStrict
-- | Reads a the value of a key in a JSON object.
fromObj :: (J.JSON a, Monad m) => String -> J.JSObject J.JSValue -> m a
-- | Coneverts a list of JSON values into a list of JSON objects.
asObjectList :: (Monad m) => [J.JSValue] -> m [J.JSObject J.JSValue]
-asObjectList = sequence . map asJSObject
+asObjectList = mapM asJSObject
-> m [(Node.List, [Node.Node])]
filterFails sols =
if null sols then fail "No nodes onto which to allocate at all"
- else let sols' = concat . map (\ (onl, _, nn) ->
- case onl of
- OpFail _ -> []
- OpGood gnl -> [(gnl, nn)]
- ) $ sols
+ else let sols' = concatMap (\ (onl, _, nn) ->
+ case onl of
+ OpFail _ -> []
+ OpGood gnl -> [(gnl, nn)]
+ ) sols
in
- if null sols' then
- fail "No valid allocation solutions"
- else
- return sols'
+ if null sols'
+ then fail "No valid allocation solutions"
+ else return sols'
processResults :: (Monad m) => [(Node.List, [Node.Node])]
-> m (String, [Node.Node])
sols'' = sortBy (compare `on` fst) sols'
(best, w) = head sols''
(worst, l) = last sols''
- info = (printf "Valid results: %d, best score: %.8f for node(s) %s, \
- \worst score: %.8f for node(s) %s" (length sols'')
- best (intercalate "/" . map Node.name $ w)
- worst (intercalate "/" . map Node.name $ l))::String
+ info = printf "Valid results: %d, best score: %.8f for node(s) %s, \
+ \worst score: %.8f for node(s) %s" (length sols'')
+ best (intercalate "/" . map Node.name $ w)
+ worst (intercalate "/" . map Node.name $ l)::String
in return (info, w)
-- | Process a request and return new node lists
instFile = optInstf
instSet = optInstSet
masterName = optMaster
- silent a = (optVerbose a) == 0
+ silent a = optVerbose a == 0
-- | Default values for the command line options.
defaultOptions :: Options
(ReqArg (\ m opts -> opts { optMaster = m }) "ADDRESS")
"collect data via RAPI at the given ADDRESS"
, Option ['l'] ["max-length"]
- (ReqArg (\ i opts -> opts { optMaxLength = (read i)::Int }) "N")
+ (ReqArg (\ i opts -> opts { optMaxLength = read i::Int }) "N")
"cap the solution at this many moves (useful for very unbalanced \
\clusters)"
, Option ['v'] ["verbose"]
- (NoArg (\ opts -> opts { optVerbose = (optVerbose opts) + 1 }))
+ (NoArg (\ opts -> opts { optVerbose = optVerbose opts + 1 }))
"increase the verbosity level"
, Option ['q'] ["quiet"]
- (NoArg (\ opts -> opts { optVerbose = (optVerbose opts) - 1 }))
+ (NoArg (\ opts -> opts { optVerbose = optVerbose opts - 1 }))
"decrease the verbosity level"
, Option ['O'] ["offline"]
(ReqArg (\ n opts -> opts { optOffline = n:optOffline opts }) "NODE")
formatOneline :: Double -> Int -> Double -> String
formatOneline ini_cv plc_len fin_cv =
printf "%.8f %d %.8f %8.3f" ini_cv plc_len fin_cv
- (if fin_cv == 0 then 1 else (ini_cv / fin_cv))
+ (if fin_cv == 0 then 1 else ini_cv / fin_cv)
-- | Main function.
main :: IO ()
let offline_names = optOffline opts
all_nodes = Container.elems fixed_nl
all_names = map Node.name all_nodes
- offline_wrong = filter (\n -> not $ elem n all_names) offline_names
+ offline_wrong = filter (flip notElem all_names) offline_names
offline_indices = map Node.idx $
filter (\n -> elem (Node.name n) offline_names)
all_nodes
(Container.size nl)
(Container.size il)
- when (length csf > 0 && not oneline && verbose > 1) $ do
- printf "Note: Stripping common suffix of '%s' from names\n" csf
+ when (length csf > 0 && not oneline && verbose > 1) $
+ printf "Note: Stripping common suffix of '%s' from names\n" csf
let (bad_nodes, bad_instances) = Cluster.computeBadItems nl il
unless (oneline || verbose == 0) $ printf
"Initial check done: %d bad nodes, %d bad instances.\n"
(length bad_nodes) (length bad_instances)
- when (length bad_nodes > 0) $ do
+ when (length bad_nodes > 0) $
putStrLn "Cluster is not N+1 happy, continuing but no guarantee \
\that the cluster will end N+1 happy."
nmlen imlen [] oneline min_cv
let (Cluster.Table fin_nl _ fin_cv fin_plc) = fin_tbl
ord_plc = reverse fin_plc
- sol_msg = (if null fin_plc
- then printf "No solution found\n"
- else (if verbose > 2
- then printf "Final coefficients: overall %.8f, %s\n"
- fin_cv (Cluster.printStats fin_nl)
- else printf "Cluster score improved from %.8f to %.8f\n"
- ini_cv fin_cv
- ))::String
+ sol_msg = if null fin_plc
+ then printf "No solution found\n"
+ else if verbose > 2
+ then printf "Final coefficients: overall %.8f, %s\n"
+ fin_cv (Cluster.printStats fin_nl)
+ else printf "Cluster score improved from %.8f to %.8f\n"
+ ini_cv fin_cv
+ ::String
unless oneline $ putStr sol_msg
(ReqArg (\ d opts -> opts { optOutPath = d }) "PATH")
"directory in which to write output files"
, Option ['v'] ["verbose"]
- (NoArg (\ opts -> opts { optVerbose = (optVerbose opts) + 1 }))
+ (NoArg (\ opts -> opts { optVerbose = optVerbose opts + 1 }))
"increase the verbosity level"
, Option [] ["no-headers"]
(NoArg (\ opts -> opts { optNoHeader = True }))
serializeInstance csf nl inst =
let
iname = Instance.name inst ++ csf
- pnode = (Container.nameOf nl $ Instance.pnode inst) ++ csf
+ pnode = Container.nameOf nl (Instance.pnode inst) ++ csf
sidx = Instance.snode inst
snode = (if sidx == Node.noSecondary
then ""
- else (Container.nameOf nl sidx) ++ csf)
+ else Container.nameOf nl sidx ++ csf)
in
printf "%s|%d|%d|%d|%s|%s|%s"
iname (Instance.mem inst) (Instance.dsk inst)
let (nl, il, csf) = x
(_, fix_nl) = Loader.checkData nl il
putStrLn $ printCluster fix_nl il
- when (optShowNodes opts) $ do
- putStr $ Cluster.printNodes fix_nl
+ when (optShowNodes opts) $
+ putStr $ Cluster.printNodes fix_nl
let ndata = serializeNodes csf nl
idata = serializeInstances csf nl il
- oname = odir </> (fixSlash name)
+ oname = odir </> fixSlash name
writeFile (oname <.> "nodes") ndata
writeFile (oname <.> "instances") idata)
) clusters
instFile = optInstf
instSet = optInstSet
masterName = optMaster
- silent a = (optVerbose a) == 0
+ silent a = optVerbose a == 0
-- | Default values for the command line options.
defaultOptions :: Options
(ReqArg (\ m opts -> opts { optMaster = m }) "ADDRESS")
"collect data via RAPI at the given ADDRESS"
, Option ['v'] ["verbose"]
- (NoArg (\ opts -> opts { optVerbose = (optVerbose opts) + 1 }))
+ (NoArg (\ opts -> opts { optVerbose = optVerbose opts + 1 }))
"increase the verbosity level"
, Option ['q'] ["quiet"]
- (NoArg (\ opts -> opts { optVerbose = (optVerbose opts) - 1 }))
+ (NoArg (\ opts -> opts { optVerbose = optVerbose opts - 1 }))
"decrease the verbosity level"
, Option ['O'] ["offline"]
(ReqArg (\ n opts -> opts { optOffline = n:optOffline opts }) "NODE")
-> ([(FailMode, Int)], Node.List, [Instance.Instance])
iterateDepth nl il newinst nreq ixes =
let depth = length ixes
- newname = (printf "new-%d" depth)::String
- newidx = (length $ Container.elems il) + depth
+ newname = printf "new-%d" depth::String
+ newidx = length (Container.elems il) + depth
newi2 = Instance.setIdx (Instance.setName newinst newname) newidx
- sols = (Cluster.tryAlloc nl il newi2 nreq)::
+ sols = Cluster.tryAlloc nl il newi2 nreq::
OpResult Cluster.AllocSolution
in case sols of
OpFail _ -> ([], nl, ixes)
printStats kind cs = do
printf "%s free RAM: %d\n" kind (Cluster.cs_fmem cs)
printf "%s allocatable RAM: %d\n" kind (Cluster.cs_amem cs)
- printf "%s reserved RAM: %d\n" kind ((Cluster.cs_fmem cs) -
- (Cluster.cs_amem cs))
+ printf "%s reserved RAM: %d\n" kind (Cluster.cs_fmem cs -
+ Cluster.cs_amem cs)
printf "%s free disk: %d\n" kind (Cluster.cs_fdsk cs)
printf "%s allocatable disk: %d\n" kind (Cluster.cs_adsk cs)
- printf "%s reserved disk: %d\n" kind ((Cluster.cs_fdsk cs) -
- (Cluster.cs_adsk cs))
+ printf "%s reserved disk: %d\n" kind (Cluster.cs_fdsk cs -
+ Cluster.cs_adsk cs)
printf "%s max node allocatable RAM: %d\n" kind (Cluster.cs_mmem cs)
printf "%s max node allocatable disk: %d\n" kind (Cluster.cs_mdsk cs)
let offline_names = optOffline opts
all_nodes = Container.elems fixed_nl
all_names = map Node.name all_nodes
- offline_wrong = filter (\n -> not $ elem n all_names) offline_names
+ offline_wrong = filter (flip notElem all_names) offline_names
offline_indices = map Node.idx $
filter (\n -> elem (Node.name n) offline_names)
all_nodes
nl = Container.map (flip Node.setMdsk m_dsk . flip Node.setMcpu m_cpu)
nm
- when (length csf > 0 && verbose > 1) $ do
- printf "Note: Stripping common suffix of '%s' from names\n" csf
+ when (length csf > 0 && verbose > 1) $
+ printf "Note: Stripping common suffix of '%s' from names\n" csf
let bad_nodes = fst $ Cluster.computeBadItems nl il
when (length bad_nodes > 0) $ do
printf "Final score: %.8f\n" (Cluster.compCV fin_nl)
printf "Final instances: %d\n" (num_instances + allocs)
printStats "Final" fin_stats
- printf "Usage: %.5f\n" (((fromIntegral num_instances)::Double) /
- (fromIntegral fin_instances))
+ printf "Usage: %.5f\n" ((fromIntegral num_instances::Double) /
+ fromIntegral fin_instances)
printf "Allocations: %d\n" allocs
putStr (unlines . map (\(x, y) -> printf "%s: %d" (show x) y) $ sreason)
printf "Most likely fail reason: %s\n" (show . fst . head $ sreason)
- when (verbose > 1) $ do
+ when (verbose > 1) $
putStr . unlines . map (\i -> printf "Inst: %*s %-*s %-*s"
ix_namelen (Instance.name i)
nmlen (Container.nameOf fin_nl $ Instance.pnode i)
projects / ganeti-local / commitdiff