forAll genOnlineNode $ \node ->
forAll (choose (5, 20)) $ \count ->
forAll (genInstanceSmallerThanNode node) $ \inst ->
- forAll (arbitrary `suchThat` (isFailure .
+ forAll (arbitrary `suchThat` (isBad .
Instance.instMatchesPolicy inst)) $ \ipol ->
let rqn = Instance.requiredNodes $ Instance.diskTemplate inst
node' = Node.setPolicy ipol node
import Test.Ganeti.TestHTools
import Test.Ganeti.HTools.Instance (genInstanceSmallerThanNode)
+import Ganeti.BasicTypes
import qualified Ganeti.HTools.Container as Container
import qualified Ganeti.HTools.Instance as Instance
import qualified Ganeti.HTools.Node as Node
Instance.mem inst >= Node.fMem node && not (Node.failN1 node) &&
not (Instance.isOffline inst) ==>
case Node.addPri node inst'' of
- Types.OpFail Types.FailMem -> True
+ Bad Types.FailMem -> True
_ -> False
where inst' = setInstanceSmallerThanNode node inst
inst'' = inst' { Instance.mem = Instance.mem inst }
inst'' = inst' { Instance.dsk = Instance.dsk inst
, Instance.diskTemplate = dt }
in case Node.addPri node inst'' of
- Types.OpFail Types.FailDisk -> True
+ Bad Types.FailDisk -> True
_ -> False
-- | Check that adding a primary instance with too many VCPUs fails
let inst' = setInstanceSmallerThanNode node inst
inst'' = inst' { Instance.vcpus = Node.availCpu node + extra }
in case Node.addPri node inst'' of
- Types.OpFail Types.FailCPU -> passTest
+ Bad Types.FailCPU -> passTest
v -> failTest $ "Expected OpFail FailCPU, but got " ++ show v
-- | Check that an instance add with too high memory or disk will be
not (Instance.isOffline inst)) ||
Instance.dsk inst >= Node.fDsk node) &&
not (Node.failN1 node) ==>
- isFailure (Node.addSec node inst pdx)
+ isBad (Node.addSec node inst pdx)
-- | Check that an offline instance with reasonable disk size but
-- extra mem/cpu can always be added.
, Instance.mem = Node.availMem node + extra_mem
, Instance.vcpus = Node.availCpu node + extra_cpu }
in case Node.addPri node inst' of
- Types.OpGood _ -> passTest
+ Ok _ -> passTest
v -> failTest $ "Expected OpGood, but got: " ++ show v
-- | Check that an offline instance with reasonable disk size but
, Instance.vcpus = Node.availCpu node + extra_cpu
, Instance.diskTemplate = Types.DTDrbd8 }
in case Node.addSec node inst' pdx of
- Types.OpGood _ -> passTest
+ Ok _ -> passTest
v -> failTest $ "Expected OpGood/OpGood, but got: " ++ show v
-- | Checks for memory reservation changes.
node_del_ab = liftM (`Node.removeSec` inst_ab) node_add_ab
node_del_nb = liftM (`Node.removeSec` inst_nb) node_add_nb
in case (node_add_ab, node_add_nb, node_del_ab, node_del_nb) of
- (Types.OpGood a_ab, Types.OpGood a_nb,
- Types.OpGood d_ab, Types.OpGood d_nb) ->
+ (Ok a_ab, Ok a_nb,
+ Ok d_ab, Ok d_nb) ->
printTestCase "Consistency checks failed" $
Node.rMem a_ab > orig_rmem &&
Node.rMem a_ab - orig_rmem == Instance.mem inst_ab &&
forAll genOnlineNode $ \node ->
forAll (genInstanceSmallerThanNode node) $ \inst ->
case Node.addPri node inst of
- Types.OpGood node' -> Node.removePri node' inst ==? node
+ Ok node' -> Node.removePri node' inst ==? node
_ -> failTest "Can't add instance"
prop_addSec_idempotent :: Property
inst' = Instance.setPri inst pdx
inst'' = inst' { Instance.diskTemplate = Types.DTDrbd8 }
in case Node.addSec node inst'' pdx of
- Types.OpGood node' -> Node.removeSec node' inst'' ==? node
+ Ok node' -> Node.removeSec node' inst'' ==? node
_ -> failTest "Can't add instance"
testSuite "HTools/Node"
-{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE TemplateHaskell, FlexibleInstances, TypeSynonymInstances #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
{-| Unittests for ganeti-htools.
, Types.DiskTemplate(..)
, Types.FailMode(..)
, Types.EvacMode(..)
- , Types.OpResult(..)
, Types.ISpec(..)
, Types.IPolicy(..)
, nullIPolicy
instance Arbitrary a => Arbitrary (Types.OpResult a) where
arbitrary = arbitrary >>= \c ->
if c
- then Types.OpGood <$> arbitrary
- else Types.OpFail <$> arbitrary
+ then Ok <$> arbitrary
+ else Bad <$> arbitrary
instance Arbitrary Types.ISpec where
arbitrary = do
prop_EvacMode_serialisation :: Types.EvacMode -> Property
prop_EvacMode_serialisation = testSerialisation
-prop_opToResult :: Types.OpResult Int -> Bool
+prop_opToResult :: Types.OpResult Int -> Property
prop_opToResult op =
case op of
- Types.OpFail _ -> isBad r
- Types.OpGood v -> case r of
- Bad _ -> False
- Ok v' -> v == v'
+ Bad _ -> printTestCase ("expected bad but got " ++ show r) $ isBad r
+ Ok v -> case r of
+ Bad msg -> failTest ("expected Ok but got Bad " ++ msg)
+ Ok v' -> v ==? v'
where r = Types.opToResult op
prop_eitherToResult :: Either String Int -> Bool
defGroupAssoc :: Map.Map String Types.Gdx
defGroupAssoc = Map.singleton (Group.uuid defGroup) (Group.idx defGroup)
--- | Simple checker for whether OpResult is fail or pass.
-isFailure :: Types.OpResult a -> Bool
-isFailure (Types.OpFail _) = True
-isFailure _ = False
-
-- | Create an instance given its spec.
createInstance :: Int -> Int -> Int -> Instance.Instance
createInstance mem dsk vcpus =
let Table ini_nl ini_il _ ini_plc = ini_tbl
tmp_resu = applyMove ini_nl target move
in case tmp_resu of
- OpFail _ -> cur_tbl
- OpGood (upd_nl, new_inst, pri_idx, sec_idx) ->
+ Bad _ -> cur_tbl
+ Ok (upd_nl, new_inst, pri_idx, sec_idx) ->
let tgt_idx = Instance.idx target
upd_cvar = compCV upd_nl
upd_il = Container.add tgt_idx new_inst ini_il
-- | Update current Allocation solution and failure stats with new
-- elements.
concatAllocs :: AllocSolution -> OpResult Node.AllocElement -> AllocSolution
-concatAllocs as (OpFail reason) = as { asFailures = reason : asFailures as }
+concatAllocs as (Bad reason) = as { asFailures = reason : asFailures as }
-concatAllocs as (OpGood ns) =
+concatAllocs as (Ok ns) =
let -- Choose the old or new solution, based on the cluster score
cntok = asAllocs as
osols = asSolution as
-> EvacInnerState -- ^ New best solution
evacOneNodeInner nl inst gdx op_fn accu ndx =
case applyMove nl inst (op_fn ndx) of
- OpFail fm -> let fail_msg = "Node " ++ Container.nameOf nl ndx ++
- " failed: " ++ show fm
- in either (const $ Left fail_msg) (const accu) accu
- OpGood (nl', inst', _, _) ->
+ Bad fm -> let fail_msg = "Node " ++ Container.nameOf nl ndx ++
+ " failed: " ++ show fm
+ in either (const $ Left fail_msg) (const accu) accu
+ Ok (nl', inst', _, _) ->
let nodes = Container.elems nl'
-- The fromJust below is ugly (it can fail nastily), but
-- at this point we should have any internal mismatches,
T.RSpec { T.rspecCpu = c, T.rspecMem = m, T.rspecDsk = d }
-- | Checks if an instance is smaller than a given spec. Returns
--- OpGood for a correct spec, otherwise OpFail one of the possible
+-- OpGood for a correct spec, otherwise Bad one of the possible
-- failure modes.
instBelowISpec :: Instance -> T.ISpec -> T.OpResult ()
instBelowISpec inst ispec
- | mem inst > T.iSpecMemorySize ispec = T.OpFail T.FailMem
- | dsk inst > T.iSpecDiskSize ispec = T.OpFail T.FailDisk
- | vcpus inst > T.iSpecCpuCount ispec = T.OpFail T.FailCPU
- | otherwise = T.OpGood ()
+ | mem inst > T.iSpecMemorySize ispec = Bad T.FailMem
+ | dsk inst > T.iSpecDiskSize ispec = Bad T.FailDisk
+ | vcpus inst > T.iSpecCpuCount ispec = Bad T.FailCPU
+ | otherwise = Ok ()
-- | Checks if an instance is bigger than a given spec.
instAboveISpec :: Instance -> T.ISpec -> T.OpResult ()
instAboveISpec inst ispec
- | mem inst < T.iSpecMemorySize ispec = T.OpFail T.FailMem
- | dsk inst < T.iSpecDiskSize ispec = T.OpFail T.FailDisk
- | vcpus inst < T.iSpecCpuCount ispec = T.OpFail T.FailCPU
- | otherwise = T.OpGood ()
+ | mem inst < T.iSpecMemorySize ispec = Bad T.FailMem
+ | dsk inst < T.iSpecDiskSize ispec = Bad T.FailDisk
+ | vcpus inst < T.iSpecCpuCount ispec = Bad T.FailCPU
+ | otherwise = Ok ()
-- | Checks if an instance matches a policy.
instMatchesPolicy :: Instance -> T.IPolicy -> T.OpResult ()
instAboveISpec inst (T.iPolicyMinSpec ipol)
instBelowISpec inst (T.iPolicyMaxSpec ipol)
if diskTemplate inst `elem` T.iPolicyDiskTemplates ipol
- then T.OpGood ()
- else T.OpFail T.FailDisk
+ then Ok ()
+ else Bad T.FailDisk
-- | Checks whether the instance uses a secondary node.
--
import qualified Ganeti.HTools.Instance as Instance
import qualified Ganeti.HTools.PeerMap as P
+import Ganeti.BasicTypes
import qualified Ganeti.HTools.Types as T
-- * Type declarations
old_tags = pTags t
strict = not force
in case () of
- _ | new_mem <= 0 -> T.OpFail T.FailMem
- | uses_disk && new_dsk <= 0 -> T.OpFail T.FailDisk
- | uses_disk && mDsk t > new_dp && strict -> T.OpFail T.FailDisk
+ _ | new_mem <= 0 -> Bad T.FailMem
+ | uses_disk && new_dsk <= 0 -> Bad T.FailDisk
+ | uses_disk && mDsk t > new_dp && strict -> Bad T.FailDisk
| uses_disk && new_spindles > hiSpindles t
- && strict -> T.OpFail T.FailDisk
- | new_failn1 && not (failN1 t) && strict -> T.OpFail T.FailMem
- | l_cpu >= 0 && l_cpu < new_pcpu && strict -> T.OpFail T.FailCPU
- | rejectAddTags old_tags inst_tags -> T.OpFail T.FailTags
+ && strict -> Bad T.FailDisk
+ | new_failn1 && not (failN1 t) && strict -> Bad T.FailMem
+ | l_cpu >= 0 && l_cpu < new_pcpu && strict -> Bad T.FailCPU
+ | rejectAddTags old_tags inst_tags -> Bad T.FailTags
| otherwise ->
let new_plist = iname:pList t
new_mp = fromIntegral new_mem / tMem t
, pTags = addTags old_tags inst_tags
, instSpindles = new_spindles
}
- in T.OpGood r
+ in Ok r
-- | Adds a secondary instance (basic version).
addSec :: Node -> Instance.Instance -> T.Ndx -> T.OpResult Node
T.dskWeight (Instance.util inst) }
strict = not force
in case () of
- _ | not (Instance.hasSecondary inst) -> T.OpFail T.FailDisk
- | new_dsk <= 0 -> T.OpFail T.FailDisk
- | mDsk t > new_dp && strict -> T.OpFail T.FailDisk
- | new_spindles > hiSpindles t && strict -> T.OpFail T.FailDisk
- | secondary_needed_mem >= old_mem && strict -> T.OpFail T.FailMem
- | new_failn1 && not (failN1 t) && strict -> T.OpFail T.FailMem
+ _ | not (Instance.hasSecondary inst) -> Bad T.FailDisk
+ | new_dsk <= 0 -> Bad T.FailDisk
+ | mDsk t > new_dp && strict -> Bad T.FailDisk
+ | new_spindles > hiSpindles t && strict -> Bad T.FailDisk
+ | secondary_needed_mem >= old_mem && strict -> Bad T.FailMem
+ | new_failn1 && not (failN1 t) && strict -> Bad T.FailMem
| otherwise ->
let new_slist = iname:sList t
r = t { sList = new_slist, fDsk = new_dsk
, pRem = new_prem, utilLoad = new_load
, instSpindles = new_spindles
}
- in T.OpGood r
+ in Ok r
-- * Stats functions
, Element(..)
, FailMode(..)
, FailStats
- , OpResult(..)
+ , OpResult
, opToResult
, EvacMode(..)
, ISpec(..)
-- The failure values for this monad track the specific allocation
-- failures, so this is not a general error-monad (compare with the
-- 'Result' data type). One downside is that this type cannot encode a
--- generic failure mode, hence 'fail' for this monad is not defined
--- and will cause an exception.
-data OpResult a = OpFail FailMode -- ^ Failed operation
- | OpGood a -- ^ Success operation
- deriving (Show, Read)
+-- generic failure mode, hence our way to build a FailMode from string
+-- will instead raise an exception.
+type OpResult = GenericResult FailMode
-instance Monad OpResult where
- (OpGood x) >>= fn = fn x
- (OpFail y) >>= _ = OpFail y
- return = OpGood
+-- | 'FromString' instance for 'FailMode' designed to catch unintended
+-- use as a general monad.
+instance FromString FailMode where
+ mkFromString v = error $ "Programming error: OpResult used as generic monad"
+ ++ v
-- | Conversion from 'OpResult' to 'Result'.
opToResult :: OpResult a -> Result a
-opToResult (OpFail f) = Bad $ show f
-opToResult (OpGood v) = Ok v
+opToResult (Bad f) = Bad $ show f
+opToResult (Ok v) = Ok v
-- | A generic class for items that have updateable names and indices.
class Element a where
projects / ganeti-local / commitdiff