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

Remove custom OpResult type/monad



Since we now have the GeneralResult as a multi-purpose monad, we can
remove the custom OpResult monad, and just use 'GeneralResult
FailMode' as our type. This allows removal of a few bits of
specialised infrastructure, relying instead on the generic one.

The restriction on using OpResult as a general monad remains as
before.
Signed-off-by: default avatarIustin Pop <iustin@google.com>
Reviewed-by: default avatarMichael Hanselmann <hansmi@google.com>
parent a4b247f0
......@@ -391,7 +391,7 @@ prop_AllocPolicy =
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
......
......@@ -45,6 +45,7 @@ import Test.Ganeti.TestCommon
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
......@@ -126,7 +127,7 @@ prop_addPriFM node inst =
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 }
......@@ -141,7 +142,7 @@ prop_addPriFD node 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
......@@ -154,7 +155,7 @@ prop_addPriFC =
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
......@@ -165,7 +166,7 @@ prop_addSec node inst pdx =
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.
......@@ -177,7 +178,7 @@ prop_addOfflinePri (NonNegative extra_mem) (NonNegative extra_cpu) =
, 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
......@@ -192,7 +193,7 @@ prop_addOfflineSec (NonNegative extra_mem) (NonNegative extra_cpu) pdx =
, 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.
......@@ -215,8 +216,8 @@ prop_rMem inst =
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 &&
......@@ -275,7 +276,7 @@ prop_addPri_idempotent =
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
......@@ -286,7 +287,7 @@ prop_addSec_idempotent =
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.
......@@ -32,7 +32,6 @@ module Test.Ganeti.HTools.Types
, Types.DiskTemplate(..)
, Types.FailMode(..)
, Types.EvacMode(..)
, Types.OpResult(..)
, Types.ISpec(..)
, Types.IPolicy(..)
, nullIPolicy
......@@ -68,8 +67,8 @@ $(genArbitrary ''Types.EvacMode)
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
......@@ -138,13 +137,13 @@ prop_IPolicy_serialisation = testSerialisation
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
......
......@@ -84,11 +84,6 @@ defGroupList = Container.fromList [(Group.idx defGroup, defGroup)]
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 =
......
......@@ -517,8 +517,8 @@ checkSingleStep ini_tbl target cur_tbl move =
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
......@@ -665,9 +665,9 @@ bestAllocElement a@(Just (_, _, _, ascore)) b@(Just (_, _, _, bscore)) =
-- | 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
......@@ -1039,10 +1039,10 @@ evacOneNodeInner :: Node.List -- ^ Cluster node list
-> 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,
......
......@@ -257,22 +257,22 @@ specOf Instance { mem = m, dsk = d, vcpus = c } =
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 ()
......@@ -280,8 +280,8 @@ instMatchesPolicy inst ipol = do
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.
--
......
......@@ -82,6 +82,7 @@ import qualified Ganeti.HTools.Container as Container
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
......@@ -444,14 +445,14 @@ addPriEx force t inst =
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
......@@ -462,7 +463,7 @@ addPriEx force t inst =
, 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
......@@ -490,12 +491,12 @@ addSecEx force t inst pdx =
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
......@@ -504,7 +505,7 @@ addSecEx force t inst pdx =
, pRem = new_prem, utilLoad = new_load
, instSpindles = new_spindles
}
in T.OpGood r
in Ok r
-- * Stats functions
......
......@@ -65,7 +65,7 @@ module Ganeti.HTools.Types
, Element(..)
, FailMode(..)
, FailStats
, OpResult(..)
, OpResult
, opToResult
, EvacMode(..)
, ISpec(..)
......@@ -344,21 +344,20 @@ type FailStats = [(FailMode, Int)]
-- 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
......
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