Commit f2280553 authored by Iustin Pop's avatar Iustin Pop
Browse files

Introduce a new type for allocation results

Currently the allocation/move operations workflow return ‘Maybe a’,
which is very convenient but loses all details about the failure mode.

This patch introduces a new data type which encodes the specific failure
mode. It is not yet used correctly (e.g. all node operations result in
FailN1), but the workflow is updated. Most of the changes are in the
hail/hspace tools, the library code required only trivial adjustments.
parent 266aea94
......@@ -57,7 +57,6 @@ module Ganeti.HTools.Cluster
) where
import Data.List
import Data.Maybe (isNothing, fromJust)
import Text.Printf (printf)
import Data.Function
import Control.Monad
......@@ -77,7 +76,7 @@ type Score = Double
type Placement = (Idx, Ndx, Ndx, Score)
-- | Allocation\/relocation solution.
type AllocSolution = [(Maybe Node.List, Instance.Instance, [Node.Node])]
type AllocSolution = [(OpResult Node.List, Instance.Instance, [Node.Node])]
-- | An instance move definition
data IMove = Failover -- ^ Failover the instance (f)
......@@ -203,7 +202,7 @@ compareTables a@(Table _ _ a_cv _) b@(Table _ _ b_cv _ ) =
-- | Applies an instance move to a given node list and instance.
applyMove :: Node.List -> Instance.Instance
-> IMove -> (Maybe Node.List, Instance.Instance, Ndx, Ndx)
-> IMove -> (OpResult Node.List, Instance.Instance, Ndx, Ndx)
-- Failover (f)
applyMove nl inst Failover =
let old_pdx = Instance.pnode inst
......@@ -284,7 +283,7 @@ applyMove nl inst (FailoverAndReplace new_sdx) =
-- | Tries to allocate an instance on one given node.
allocateOnSingle :: Node.List -> Instance.Instance -> Node.Node
-> (Maybe Node.List, Instance.Instance)
-> (OpResult Node.List, Instance.Instance)
allocateOnSingle nl inst p =
let new_pdx = Node.idx p
new_nl = Node.addPri p inst >>= \new_p ->
......@@ -293,7 +292,7 @@ allocateOnSingle nl inst p =
-- | Tries to allocate an instance on a given pair of nodes.
allocateOnPair :: Node.List -> Instance.Instance -> Node.Node -> Node.Node
-> (Maybe Node.List, Instance.Instance)
-> (OpResult Node.List, Instance.Instance)
allocateOnPair nl inst tgt_p tgt_s =
let new_pdx = Node.idx tgt_p
new_sdx = Node.idx tgt_s
......@@ -315,16 +314,16 @@ checkSingleStep ini_tbl target cur_tbl move =
Table ini_nl ini_il _ ini_plc = ini_tbl
(tmp_nl, new_inst, pri_idx, sec_idx) = applyMove ini_nl target move
in
if isNothing tmp_nl then cur_tbl
else
let tgt_idx = Instance.idx target
upd_nl = fromJust tmp_nl
upd_cvar = compCV upd_nl
upd_il = Container.add tgt_idx new_inst ini_il
upd_plc = (tgt_idx, pri_idx, sec_idx, upd_cvar):ini_plc
upd_tbl = Table upd_nl upd_il upd_cvar upd_plc
in
compareTables cur_tbl upd_tbl
case tmp_nl of
OpFail _ -> cur_tbl
OpGood upd_nl ->
let tgt_idx = Instance.idx target
upd_cvar = compCV upd_nl
upd_il = Container.add tgt_idx new_inst ini_il
upd_plc = (tgt_idx, pri_idx, sec_idx, upd_cvar):ini_plc
upd_tbl = Table upd_nl upd_il upd_cvar upd_plc
in
compareTables cur_tbl upd_tbl
-- | Given the status of the current secondary as a valid new node
-- and the current candidate target node,
......
......@@ -294,7 +294,7 @@ removeSec t inst =
p_rem = new_prem}
-- | Adds a primary instance.
addPri :: Node -> Instance.Instance -> Maybe Node
addPri :: Node -> Instance.Instance -> T.OpResult Node
addPri t inst =
let iname = Instance.idx inst
new_mem = f_mem t - Instance.mem inst
......@@ -307,17 +307,17 @@ addPri t inst =
if (failHealth new_mem new_dsk) || (new_failn1 && not (failN1 t)) ||
(failLimits t new_dp new_pcpu)
then
Nothing
T.OpFail T.FailN1
else
let new_plist = iname:(plist t)
new_mp = (fromIntegral new_mem) / (t_mem t)
in
Just 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}
T.OpGood 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}
-- | Adds a secondary instance.
addSec :: Node -> Instance.Instance -> T.Ndx -> Maybe Node
addSec :: Node -> Instance.Instance -> T.Ndx -> T.OpResult Node
addSec t inst pdx =
let iname = Instance.idx inst
old_peers = peers t
......@@ -332,14 +332,14 @@ addSec t inst pdx =
in if (failHealth old_mem new_dsk) || (new_failn1 && not (failN1 t)) ||
(failLimits t new_dp noLimit)
then
Nothing
T.OpFail T.FailN1
else
let new_slist = iname:(slist t)
in
Just 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}
T.OpGood 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}
-- * Stats functions
......
......@@ -29,6 +29,8 @@ module Ganeti.HTools.Types
, NameAssoc
, Result(..)
, Element(..)
, FailMode(..)
, OpResult(..)
) where
-- | The instance index type.
......@@ -58,6 +60,21 @@ instance Monad Result where
return = Ok
fail = Bad
-- | Reason for an operation's falure
data FailMode = FailMem -- ^ Failed due to not enough RAM
| FailDisk -- ^ Failed due to not enough disk
| FailCPU -- ^ Failed due to not enough CPU capacity
| FailN1 -- ^ Failed due to not passing N1 checks
-- | Either-like data-type customized for our failure modes
data OpResult a = OpFail FailMode -- ^ Failed operation
| OpGood a -- ^ Success operation
instance Monad OpResult where
(OpGood x) >>= fn = fn x
(OpFail y) >>= _ = OpFail y
return = OpGood
-- | A generic class for items that have updateable names and indices.
class Element a where
-- | Returns the name of the element
......
......@@ -27,7 +27,6 @@ module Main (main) where
import Data.List
import Data.Function
import Data.Maybe (isJust, fromJust)
import Monad
import System
import System.IO
......@@ -43,7 +42,6 @@ import qualified Ganeti.HTools.CLI as CLI
import Ganeti.HTools.IAlloc
import Ganeti.HTools.Types
import Ganeti.HTools.Loader (RqType(..), Request(..))
import Ganeti.HTools.Utils
-- | Command line options structure.
data Options = Options
......@@ -74,15 +72,21 @@ options =
]
filterFails :: (Monad m) => [(Maybe Node.List, Instance.Instance, [Node.Node])]
filterFails :: (Monad m) => [(OpResult Node.List,
Instance.Instance, [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 . fst3) sols
in if null sols' then
fail "No valid allocation solutions"
else
return $ map (\(x, _, y) -> (fromJust x, y)) sols'
else let sols' = concat . map (\ (onl, _, nn) ->
case onl of
OpFail _ -> []
OpGood gnl -> [(gnl, nn)]
) $ sols
in
if null sols' then
fail "No valid allocation solutions"
else
return sols'
processResults :: (Monad m) => [(Node.List, [Node.Node])]
-> m (String, [Node.Node])
......@@ -98,9 +102,8 @@ processResults sols =
in return (info, w)
-- | Process a request and return new node lists
processRequest ::
Request
-> Result [(Maybe Node.List, Instance.Instance, [Node.Node])]
processRequest :: Request
-> Result [(OpResult Node.List, Instance.Instance, [Node.Node])]
processRequest request =
let Request rqtype nl il _ = request
in case rqtype of
......
......@@ -27,7 +27,6 @@ module Main (main) where
import Data.List
import Data.Function
import Data.Maybe (isJust, fromJust, isNothing)
import Monad
import System
import System.IO
......@@ -43,6 +42,7 @@ import qualified Ganeti.HTools.Instance as Instance
import qualified Ganeti.HTools.CLI as CLI
import Ganeti.HTools.Utils
import Ganeti.HTools.Types
-- | Command line options structure.
data Options = Options
......@@ -148,21 +148,25 @@ options =
]
filterFails :: Cluster.AllocSolution
-> Maybe [(Node.List, Instance.Instance, [Node.Node])]
-> OpResult [(Node.List, Instance.Instance, [Node.Node])]
filterFails sols =
if null sols then Nothing -- No nodes onto which to allocate at all
else let sols' = filter (isJust . fst3) sols
in if null sols' then
Nothing -- No valid allocation solutions
else
return $ map (\(x, y, z) -> (fromJust x, y, z)) sols'
processResults :: (Monad m) => [(Node.List, Instance.Instance, [Node.Node])]
-> m (Node.List, Instance.Instance, [Node.Node])
let sols' = concat . map (\ (onl, i, nn) ->
case onl of
OpFail _ -> []
OpGood gnl -> [(gnl, i, nn)]
) $ sols
in
if null sols' then
OpFail FailN1
else
return sols'
processResults :: [(Node.List, Instance.Instance, [Node.Node])]
-> (Node.List, Instance.Instance, [Node.Node])
processResults sols =
let sols' = map (\e@(nl', _, _) -> (Cluster.compCV nl', e)) sols
sols'' = sortBy (compare `on` fst) sols'
in return $ snd $ head sols''
in snd $ head sols''
iterateDepth :: Node.List
-> Instance.List
......@@ -176,16 +180,18 @@ iterateDepth nl il newinst nreq ixes =
newidx = (length $ Container.elems il) + depth
newi2 = Instance.setIdx (Instance.setName newinst newname) newidx
sols = (Cluster.tryAlloc nl il newi2 nreq)::
Maybe Cluster.AllocSolution
OpResult Cluster.AllocSolution
orig = (nl, ixes)
in
if isNothing sols then orig
else let sols' = fromJust sols
sols'' = filterFails sols'
in if isNothing sols'' then orig
else let (xnl, xi, _) = fromJust $ processResults $
fromJust sols''
in iterateDepth xnl il newinst nreq (xi:ixes)
in case sols of
OpFail _ -> orig
OpGood sols' ->
let
sols'' = filterFails sols'
in case sols'' of
OpFail _ -> orig
OpGood sols''' ->
let (xnl, xi, _) = processResults sols'''
in iterateDepth xnl il newinst nreq (xi:ixes)
printStats :: String -> Cluster.CStats -> IO ()
printStats kind cs = do
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment