Commit 01e52493 authored by Iustin Pop's avatar Iustin Pop
Browse files

Cleanup HTools.Types/BasicTypes imports



Before we reorganised the source tree, the 'Result' type was exported
from HTools/Types.hs. This changed during the reorg, but at that time
we didn't change the exports; instead, we kept re-exporting it from
the old module for compatibility.

In light of future changes to the Result type, let's stop this
re-export and cleanup the imports of the other modules.

One test is slightly rewritten with explicit types declaration (part
of the values already needed one, let's make it explicit).
Signed-off-by: default avatarIustin Pop <iustin@google.com>
Reviewed-by: default avatarMichael Hanselmann <hansmi@google.com>
parent 300e5450
...@@ -39,6 +39,7 @@ import Test.Ganeti.TestHelper ...@@ -39,6 +39,7 @@ import Test.Ganeti.TestHelper
import Test.Ganeti.TestCommon import Test.Ganeti.TestCommon
import Test.Ganeti.Common import Test.Ganeti.Common
import Ganeti.BasicTypes
import Ganeti.HTools.CLI as CLI import Ganeti.HTools.CLI as CLI
import qualified Ganeti.HTools.Program as Program import qualified Ganeti.HTools.Program as Program
import qualified Ganeti.HTools.Types as Types import qualified Ganeti.HTools.Types as Types
...@@ -49,7 +50,7 @@ import qualified Ganeti.HTools.Types as Types ...@@ -49,7 +50,7 @@ import qualified Ganeti.HTools.Types as Types
prop_parseISpec :: String -> Int -> Int -> Int -> Property prop_parseISpec :: String -> Int -> Int -> Int -> Property
prop_parseISpec descr dsk mem cpu = prop_parseISpec descr dsk mem cpu =
let str = printf "%d,%d,%d" dsk mem cpu::String let str = printf "%d,%d,%d" dsk mem cpu::String
in parseISpecString descr str ==? Types.Ok (Types.RSpec cpu mem dsk) in parseISpecString descr str ==? Ok (Types.RSpec cpu mem dsk)
-- | Test parsing failure due to wrong section count. -- | Test parsing failure due to wrong section count.
prop_parseISpecFail :: String -> Property prop_parseISpecFail :: String -> Property
...@@ -58,7 +59,7 @@ prop_parseISpecFail descr = ...@@ -58,7 +59,7 @@ prop_parseISpecFail descr =
forAll (replicateM nelems arbitrary) $ \values -> forAll (replicateM nelems arbitrary) $ \values ->
let str = intercalate "," $ map show (values::[Int]) let str = intercalate "," $ map show (values::[Int])
in case parseISpecString descr str of in case parseISpecString descr str of
Types.Ok v -> failTest $ "Expected failure, got " ++ show v Ok v -> failTest $ "Expected failure, got " ++ show v
_ -> passTest _ -> passTest
-- | Test a few string arguments. -- | Test a few string arguments.
......
...@@ -28,7 +28,7 @@ Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA ...@@ -28,7 +28,7 @@ Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
module Test.Ganeti.HTools.Cluster (testHTools_Cluster) where module Test.Ganeti.HTools.Cluster (testHTools_Cluster) where
import Test.QuickCheck import Test.QuickCheck hiding (Result)
import qualified Data.IntMap as IntMap import qualified Data.IntMap as IntMap
import Data.Maybe import Data.Maybe
...@@ -40,6 +40,7 @@ import Test.Ganeti.HTools.Instance ( genInstanceSmallerThanNode ...@@ -40,6 +40,7 @@ import Test.Ganeti.HTools.Instance ( genInstanceSmallerThanNode
, genInstanceSmallerThan ) , genInstanceSmallerThan )
import Test.Ganeti.HTools.Node (genOnlineNode, genNode) import Test.Ganeti.HTools.Node (genOnlineNode, genNode)
import Ganeti.BasicTypes
import qualified Ganeti.HTools.Cluster as Cluster import qualified Ganeti.HTools.Cluster as Cluster
import qualified Ganeti.HTools.Container as Container import qualified Ganeti.HTools.Container as Container
import qualified Ganeti.HTools.Group as Group import qualified Ganeti.HTools.Group as Group
...@@ -135,8 +136,8 @@ prop_Alloc_sane inst = ...@@ -135,8 +136,8 @@ prop_Alloc_sane inst =
reqnodes = Instance.requiredNodes $ Instance.diskTemplate inst reqnodes = Instance.requiredNodes $ Instance.diskTemplate inst
in case Cluster.genAllocNodes defGroupList nl reqnodes True >>= in case Cluster.genAllocNodes defGroupList nl reqnodes True >>=
Cluster.tryAlloc nl il inst' of Cluster.tryAlloc nl il inst' of
Types.Bad msg -> failTest msg Bad msg -> failTest msg
Types.Ok as -> Ok as ->
case Cluster.asSolution as of case Cluster.asSolution as of
Nothing -> failTest "Failed to allocate, empty solution" Nothing -> failTest "Failed to allocate, empty solution"
Just (xnl, xi, _, cv) -> Just (xnl, xi, _, cv) ->
...@@ -159,8 +160,8 @@ prop_IterateAlloc_sane inst = ...@@ -159,8 +160,8 @@ prop_IterateAlloc_sane inst =
allocnodes = Cluster.genAllocNodes defGroupList nl reqnodes True allocnodes = Cluster.genAllocNodes defGroupList nl reqnodes True
in case allocnodes >>= \allocnodes' -> in case allocnodes >>= \allocnodes' ->
Cluster.iterateAlloc nl il (Just limit) inst' allocnodes' [] [] of Cluster.iterateAlloc nl il (Just limit) inst' allocnodes' [] [] of
Types.Bad msg -> failTest msg Bad msg -> failTest msg
Types.Ok (_, xnl, xil, _, _) -> Ok (_, xnl, xil, _, _) ->
let old_score = Cluster.compCV xnl let old_score = Cluster.compCV xnl
tbl = Cluster.Table xnl xil old_score [] tbl = Cluster.Table xnl xil old_score []
in case Cluster.tryBalance tbl True True False 0 1e-4 of in case Cluster.tryBalance tbl True True False 0 1e-4 of
...@@ -200,8 +201,8 @@ prop_CanTieredAlloc = ...@@ -200,8 +201,8 @@ prop_CanTieredAlloc =
allocnodes = Cluster.genAllocNodes defGroupList nl rqnodes True allocnodes = Cluster.genAllocNodes defGroupList nl rqnodes True
in case allocnodes >>= \allocnodes' -> in case allocnodes >>= \allocnodes' ->
Cluster.tieredAlloc nl il (Just 5) inst allocnodes' [] [] of Cluster.tieredAlloc nl il (Just 5) inst allocnodes' [] [] of
Types.Bad msg -> failTest $ "Failed to tiered alloc: " ++ msg Bad msg -> failTest $ "Failed to tiered alloc: " ++ msg
Types.Ok (_, nl', il', ixes, cstats) -> Ok (_, nl', il', ixes, cstats) ->
let (ai_alloc, ai_pool, ai_unav) = let (ai_alloc, ai_pool, ai_unav) =
Cluster.computeAllocationDelta Cluster.computeAllocationDelta
(Cluster.totalResources nl) (Cluster.totalResources nl)
...@@ -221,19 +222,19 @@ prop_CanTieredAlloc = ...@@ -221,19 +222,19 @@ prop_CanTieredAlloc =
-- | Helper function to create a cluster with the given range of nodes -- | Helper function to create a cluster with the given range of nodes
-- and allocate an instance on it. -- and allocate an instance on it.
genClusterAlloc :: Int -> Node.Node -> Instance.Instance genClusterAlloc :: Int -> Node.Node -> Instance.Instance
-> Types.Result (Node.List, Instance.List, Instance.Instance) -> Result (Node.List, Instance.List, Instance.Instance)
genClusterAlloc count node inst = genClusterAlloc count node inst =
let nl = makeSmallCluster node count let nl = makeSmallCluster node count
reqnodes = Instance.requiredNodes $ Instance.diskTemplate inst reqnodes = Instance.requiredNodes $ Instance.diskTemplate inst
in case Cluster.genAllocNodes defGroupList nl reqnodes True >>= in case Cluster.genAllocNodes defGroupList nl reqnodes True >>=
Cluster.tryAlloc nl Container.empty inst of Cluster.tryAlloc nl Container.empty inst of
Types.Bad _ -> Types.Bad "Can't allocate" Bad msg -> Bad $ "Can't allocate: " ++ msg
Types.Ok as -> Ok as ->
case Cluster.asSolution as of case Cluster.asSolution as of
Nothing -> Types.Bad "Empty solution?" Nothing -> Bad "Empty solution?"
Just (xnl, xi, _, _) -> Just (xnl, xi, _, _) ->
let xil = Container.add (Instance.idx xi) xi Container.empty let xil = Container.add (Instance.idx xi) xi Container.empty
in Types.Ok (xnl, xil, xi) in Ok (xnl, xil, xi)
-- | Checks that on a 4-8 node cluster, once we allocate an instance, -- | Checks that on a 4-8 node cluster, once we allocate an instance,
-- we can also relocate it. -- we can also relocate it.
...@@ -243,25 +244,25 @@ prop_AllocRelocate = ...@@ -243,25 +244,25 @@ prop_AllocRelocate =
forAll (genOnlineNode `suchThat` isNodeBig 4) $ \node -> forAll (genOnlineNode `suchThat` isNodeBig 4) $ \node ->
forAll (genInstanceSmallerThanNode node `suchThat` isMirrored) $ \inst -> forAll (genInstanceSmallerThanNode node `suchThat` isMirrored) $ \inst ->
case genClusterAlloc count node inst of case genClusterAlloc count node inst of
Types.Bad msg -> failTest msg Bad msg -> failTest msg
Types.Ok (nl, il, inst') -> Ok (nl, il, inst') ->
case IAlloc.processRelocate defGroupList nl il case IAlloc.processRelocate defGroupList nl il
(Instance.idx inst) 1 (Instance.idx inst) 1
[(if Instance.diskTemplate inst' == Types.DTDrbd8 [(if Instance.diskTemplate inst' == Types.DTDrbd8
then Instance.sNode then Instance.sNode
else Instance.pNode) inst'] of else Instance.pNode) inst'] of
Types.Ok _ -> passTest Ok _ -> passTest
Types.Bad msg -> failTest $ "Failed to relocate: " ++ msg Bad msg -> failTest $ "Failed to relocate: " ++ msg
-- | Helper property checker for the result of a nodeEvac or -- | Helper property checker for the result of a nodeEvac or
-- changeGroup operation. -- changeGroup operation.
check_EvacMode :: Group.Group -> Instance.Instance check_EvacMode :: Group.Group -> Instance.Instance
-> Types.Result (Node.List, Instance.List, Cluster.EvacSolution) -> Result (Node.List, Instance.List, Cluster.EvacSolution)
-> Property -> Property
check_EvacMode grp inst result = check_EvacMode grp inst result =
case result of case result of
Types.Bad msg -> failTest $ "Couldn't evacuate/change group:" ++ msg Bad msg -> failTest $ "Couldn't evacuate/change group:" ++ msg
Types.Ok (_, _, es) -> Ok (_, _, es) ->
let moved = Cluster.esMoved es let moved = Cluster.esMoved es
failed = Cluster.esFailed es failed = Cluster.esFailed es
opcodes = not . null $ Cluster.esOpCodes es opcodes = not . null $ Cluster.esOpCodes es
...@@ -285,8 +286,8 @@ prop_AllocEvacuate = ...@@ -285,8 +286,8 @@ prop_AllocEvacuate =
forAll (genOnlineNode `suchThat` isNodeBig 4) $ \node -> forAll (genOnlineNode `suchThat` isNodeBig 4) $ \node ->
forAll (genInstanceSmallerThanNode node `suchThat` isMirrored) $ \inst -> forAll (genInstanceSmallerThanNode node `suchThat` isMirrored) $ \inst ->
case genClusterAlloc count node inst of case genClusterAlloc count node inst of
Types.Bad msg -> failTest msg Bad msg -> failTest msg
Types.Ok (nl, il, inst') -> Ok (nl, il, inst') ->
conjoin . map (\mode -> check_EvacMode defGroup inst' $ conjoin . map (\mode -> check_EvacMode defGroup inst' $
Cluster.tryNodeEvac defGroupList nl il mode Cluster.tryNodeEvac defGroupList nl il mode
[Instance.idx inst']) . [Instance.idx inst']) .
...@@ -302,8 +303,8 @@ prop_AllocChangeGroup = ...@@ -302,8 +303,8 @@ prop_AllocChangeGroup =
forAll (genOnlineNode `suchThat` isNodeBig 4) $ \node -> forAll (genOnlineNode `suchThat` isNodeBig 4) $ \node ->
forAll (genInstanceSmallerThanNode node `suchThat` isMirrored) $ \inst -> forAll (genInstanceSmallerThanNode node `suchThat` isMirrored) $ \inst ->
case genClusterAlloc count node inst of case genClusterAlloc count node inst of
Types.Bad msg -> failTest msg Bad msg -> failTest msg
Types.Ok (nl, il, inst') -> Ok (nl, il, inst') ->
-- we need to add a second node group and nodes to the cluster -- we need to add a second node group and nodes to the cluster
let nl2 = Container.elems $ makeSmallCluster node count let nl2 = Container.elems $ makeSmallCluster node count
grp2 = Group.setIdx defGroup (Group.idx defGroup + 1) grp2 = Group.setIdx defGroup (Group.idx defGroup + 1)
...@@ -330,9 +331,9 @@ prop_AllocBalance = ...@@ -330,9 +331,9 @@ prop_AllocBalance =
i_templ = createInstance Types.unitMem Types.unitDsk Types.unitCpu i_templ = createInstance Types.unitMem Types.unitDsk Types.unitCpu
in case allocnodes >>= \allocnodes' -> in case allocnodes >>= \allocnodes' ->
Cluster.iterateAlloc nl' il (Just 5) i_templ allocnodes' [] [] of Cluster.iterateAlloc nl' il (Just 5) i_templ allocnodes' [] [] of
Types.Bad msg -> failTest $ "Failed to allocate: " ++ msg Bad msg -> failTest $ "Failed to allocate: " ++ msg
Types.Ok (_, _, _, [], _) -> failTest "Failed to allocate: no instances" Ok (_, _, _, [], _) -> failTest "Failed to allocate: no instances"
Types.Ok (_, xnl, il', _, _) -> Ok (_, xnl, il', _, _) ->
let ynl = Container.add (Node.idx hnode) hnode xnl let ynl = Container.add (Node.idx hnode) hnode xnl
cv = Cluster.compCV ynl cv = Cluster.compCV ynl
tbl = Cluster.Table ynl il' cv [] tbl = Cluster.Table ynl il' cv []
...@@ -373,8 +374,8 @@ canAllocOn :: Node.List -> Int -> Instance.Instance -> Maybe String ...@@ -373,8 +374,8 @@ canAllocOn :: Node.List -> Int -> Instance.Instance -> Maybe String
canAllocOn nl reqnodes inst = canAllocOn nl reqnodes inst =
case Cluster.genAllocNodes defGroupList nl reqnodes True >>= case Cluster.genAllocNodes defGroupList nl reqnodes True >>=
Cluster.tryAlloc nl Container.empty inst of Cluster.tryAlloc nl Container.empty inst of
Types.Bad msg -> Just $ "Can't allocate: " ++ msg Bad msg -> Just $ "Can't allocate: " ++ msg
Types.Ok as -> Ok as ->
case Cluster.asSolution as of case Cluster.asSolution as of
Nothing -> Just $ "No allocation solution; failures: " ++ Nothing -> Just $ "No allocation solution; failures: " ++
show (Cluster.collapseFailures $ Cluster.asFailures as) show (Cluster.collapseFailures $ Cluster.asFailures as)
......
...@@ -33,12 +33,13 @@ module Test.Ganeti.HTools.Instance ...@@ -33,12 +33,13 @@ module Test.Ganeti.HTools.Instance
, Instance.Instance(..) , Instance.Instance(..)
) where ) where
import Test.QuickCheck import Test.QuickCheck hiding (Result)
import Test.Ganeti.TestHelper import Test.Ganeti.TestHelper
import Test.Ganeti.TestCommon import Test.Ganeti.TestCommon
import Test.Ganeti.HTools.Types () import Test.Ganeti.HTools.Types ()
import Ganeti.BasicTypes
import qualified Ganeti.HTools.Instance as Instance import qualified Ganeti.HTools.Instance as Instance
import qualified Ganeti.HTools.Node as Node import qualified Ganeti.HTools.Node as Node
import qualified Ganeti.HTools.Types as Types import qualified Ganeti.HTools.Types as Types
...@@ -110,42 +111,40 @@ prop_shrinkMG :: Instance.Instance -> Property ...@@ -110,42 +111,40 @@ prop_shrinkMG :: Instance.Instance -> Property
prop_shrinkMG inst = prop_shrinkMG inst =
Instance.mem inst >= 2 * Types.unitMem ==> Instance.mem inst >= 2 * Types.unitMem ==>
case Instance.shrinkByType inst Types.FailMem of case Instance.shrinkByType inst Types.FailMem of
Types.Ok inst' -> Instance.mem inst' == Instance.mem inst - Types.unitMem Ok inst' -> Instance.mem inst' ==? Instance.mem inst - Types.unitMem
_ -> False Bad msg -> failTest msg
prop_shrinkMF :: Instance.Instance -> Property prop_shrinkMF :: Instance.Instance -> Property
prop_shrinkMF inst = prop_shrinkMF inst =
forAll (choose (0, 2 * Types.unitMem - 1)) $ \mem -> forAll (choose (0, 2 * Types.unitMem - 1)) $ \mem ->
let inst' = inst { Instance.mem = mem} let inst' = inst { Instance.mem = mem}
in Types.isBad $ Instance.shrinkByType inst' Types.FailMem in isBad $ Instance.shrinkByType inst' Types.FailMem
prop_shrinkCG :: Instance.Instance -> Property prop_shrinkCG :: Instance.Instance -> Property
prop_shrinkCG inst = prop_shrinkCG inst =
Instance.vcpus inst >= 2 * Types.unitCpu ==> Instance.vcpus inst >= 2 * Types.unitCpu ==>
case Instance.shrinkByType inst Types.FailCPU of case Instance.shrinkByType inst Types.FailCPU of
Types.Ok inst' -> Ok inst' -> Instance.vcpus inst' ==? Instance.vcpus inst - Types.unitCpu
Instance.vcpus inst' == Instance.vcpus inst - Types.unitCpu Bad msg -> failTest msg
_ -> False
prop_shrinkCF :: Instance.Instance -> Property prop_shrinkCF :: Instance.Instance -> Property
prop_shrinkCF inst = prop_shrinkCF inst =
forAll (choose (0, 2 * Types.unitCpu - 1)) $ \vcpus -> forAll (choose (0, 2 * Types.unitCpu - 1)) $ \vcpus ->
let inst' = inst { Instance.vcpus = vcpus } let inst' = inst { Instance.vcpus = vcpus }
in Types.isBad $ Instance.shrinkByType inst' Types.FailCPU in isBad $ Instance.shrinkByType inst' Types.FailCPU
prop_shrinkDG :: Instance.Instance -> Property prop_shrinkDG :: Instance.Instance -> Property
prop_shrinkDG inst = prop_shrinkDG inst =
Instance.dsk inst >= 2 * Types.unitDsk ==> Instance.dsk inst >= 2 * Types.unitDsk ==>
case Instance.shrinkByType inst Types.FailDisk of case Instance.shrinkByType inst Types.FailDisk of
Types.Ok inst' -> Ok inst' -> Instance.dsk inst' ==? Instance.dsk inst - Types.unitDsk
Instance.dsk inst' == Instance.dsk inst - Types.unitDsk Bad msg -> failTest msg
_ -> False
prop_shrinkDF :: Instance.Instance -> Property prop_shrinkDF :: Instance.Instance -> Property
prop_shrinkDF inst = prop_shrinkDF inst =
forAll (choose (0, 2 * Types.unitDsk - 1)) $ \dsk -> forAll (choose (0, 2 * Types.unitDsk - 1)) $ \dsk ->
let inst' = inst { Instance.dsk = dsk } let inst' = inst { Instance.dsk = dsk }
in Types.isBad $ Instance.shrinkByType inst' Types.FailDisk in isBad $ Instance.shrinkByType inst' Types.FailDisk
prop_setMovable :: Instance.Instance -> Bool -> Property prop_setMovable :: Instance.Instance -> Bool -> Property
prop_setMovable inst m = prop_setMovable inst m =
......
...@@ -42,7 +42,6 @@ import qualified Ganeti.BasicTypes as BasicTypes ...@@ -42,7 +42,6 @@ import qualified Ganeti.BasicTypes as BasicTypes
import qualified Ganeti.HTools.Container as Container import qualified Ganeti.HTools.Container as Container
import qualified Ganeti.HTools.Loader as Loader import qualified Ganeti.HTools.Loader as Loader
import qualified Ganeti.HTools.Node as Node import qualified Ganeti.HTools.Node as Node
import qualified Ganeti.HTools.Types as Types
prop_lookupNode :: [(String, Int)] -> String -> String -> Property prop_lookupNode :: [(String, Int)] -> String -> String -> Property
prop_lookupNode ktn inst node = prop_lookupNode ktn inst node =
...@@ -76,8 +75,8 @@ prop_mergeData ns = ...@@ -76,8 +75,8 @@ prop_mergeData ns =
let na = Container.fromList $ map (\n -> (Node.idx n, n)) ns let na = Container.fromList $ map (\n -> (Node.idx n, n)) ns
in case Loader.mergeData [] [] [] [] in case Loader.mergeData [] [] [] []
(Loader.emptyCluster {Loader.cdNodes = na}) of (Loader.emptyCluster {Loader.cdNodes = na}) of
Types.Bad _ -> False BasicTypes.Bad _ -> False
Types.Ok (Loader.ClusterData _ nl il _ _) -> BasicTypes.Ok (Loader.ClusterData _ nl il _ _) ->
let nodes = Container.elems nl let nodes = Container.elems nl
instances = Container.elems il instances = Container.elems il
in (sum . map (length . Node.pList)) nodes == 0 && in (sum . map (length . Node.pList)) nodes == 0 &&
......
...@@ -28,7 +28,7 @@ Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA ...@@ -28,7 +28,7 @@ Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
module Test.Ganeti.HTools.Simu (testHTools_Simu) where module Test.Ganeti.HTools.Simu (testHTools_Simu) where
import Test.QuickCheck import Test.QuickCheck hiding (Result)
import Control.Monad import Control.Monad
import qualified Data.IntMap as IntMap import qualified Data.IntMap as IntMap
...@@ -37,6 +37,7 @@ import Text.Printf (printf) ...@@ -37,6 +37,7 @@ import Text.Printf (printf)
import Test.Ganeti.TestHelper import Test.Ganeti.TestHelper
import Test.Ganeti.TestCommon import Test.Ganeti.TestCommon
import Ganeti.BasicTypes
import qualified Ganeti.Constants as C import qualified Ganeti.Constants as C
import qualified Ganeti.HTools.Container as Container import qualified Ganeti.HTools.Container as Container
import qualified Ganeti.HTools.Group as Group import qualified Ganeti.HTools.Group as Group
...@@ -75,8 +76,8 @@ prop_Load = ...@@ -75,8 +76,8 @@ prop_Load =
fromIntegral m, fromIntegral d)) fromIntegral m, fromIntegral d))
specs :: [(Double, Double, Double, Int, Int)] specs :: [(Double, Double, Double, Int, Int)]
in case Simu.parseData strspecs of in case Simu.parseData strspecs of
Types.Bad msg -> failTest $ "Failed to load specs: " ++ msg Bad msg -> failTest $ "Failed to load specs: " ++ msg
Types.Ok (Loader.ClusterData gl nl il tags ipol) -> Ok (Loader.ClusterData gl nl il tags ipol) ->
let nodes = map snd $ IntMap.toAscList nl let nodes = map snd $ IntMap.toAscList nl
nidx = map Node.idx nodes nidx = map Node.idx nodes
mdc_out = map (\n -> (Node.tMem n, Node.tDsk n, Node.tCpu n, mdc_out = map (\n -> (Node.tMem n, Node.tDsk n, Node.tCpu n,
......
...@@ -40,6 +40,7 @@ import Test.Ganeti.TestHTools ...@@ -40,6 +40,7 @@ import Test.Ganeti.TestHTools
import Test.Ganeti.HTools.Instance (genInstanceSmallerThanNode) import Test.Ganeti.HTools.Instance (genInstanceSmallerThanNode)
import Test.Ganeti.HTools.Node (genNode, genOnlineNode) import Test.Ganeti.HTools.Node (genNode, genOnlineNode)
import Ganeti.BasicTypes
import qualified Ganeti.HTools.Cluster as Cluster import qualified Ganeti.HTools.Cluster as Cluster
import qualified Ganeti.HTools.Container as Container import qualified Ganeti.HTools.Container as Container
import qualified Ganeti.HTools.Group as Group import qualified Ganeti.HTools.Group as Group
...@@ -79,9 +80,9 @@ prop_Load_Instance name mem dsk vcpus status ...@@ -79,9 +80,9 @@ prop_Load_Instance name mem dsk vcpus status
[name, mem_s, dsk_s, vcpus_s, status_s, [name, mem_s, dsk_s, vcpus_s, status_s,
sbal, pnode, pnode, tags] sbal, pnode, pnode, tags]
in case inst of in case inst of
Types.Bad msg -> failTest $ "Failed to load instance: " ++ msg Bad msg -> failTest $ "Failed to load instance: " ++ msg
Types.Ok (_, i) -> printTestCase "Mismatch in some field while\ Ok (_, i) -> printTestCase "Mismatch in some field while\
\ loading the instance" $ \ loading the instance" $
Instance.name i == name && Instance.name i == name &&
Instance.vcpus i == vcpus && Instance.vcpus i == vcpus &&
Instance.mem i == mem && Instance.mem i == mem &&
...@@ -91,15 +92,15 @@ prop_Load_Instance name mem dsk vcpus status ...@@ -91,15 +92,15 @@ prop_Load_Instance name mem dsk vcpus status
else sdx) && else sdx) &&
Instance.autoBalance i == autobal && Instance.autoBalance i == autobal &&
Instance.spindleUse i == su && Instance.spindleUse i == su &&
Types.isBad fail1 isBad fail1
prop_Load_InstanceFail :: [(String, Int)] -> [String] -> Property prop_Load_InstanceFail :: [(String, Int)] -> [String] -> Property
prop_Load_InstanceFail ktn fields = prop_Load_InstanceFail ktn fields =
length fields /= 10 && length fields /= 11 ==> length fields /= 10 && length fields /= 11 ==>
case Text.loadInst nl fields of case Text.loadInst nl fields of
Types.Ok _ -> failTest "Managed to load instance from invalid data" Ok _ -> failTest "Managed to load instance from invalid data"
Types.Bad msg -> printTestCase ("Unrecognised error message: " ++ msg) $ Bad msg -> printTestCase ("Unrecognised error message: " ++ msg) $
"Invalid/incomplete instance data: '" `isPrefixOf` msg "Invalid/incomplete instance data: '" `isPrefixOf` msg
where nl = Map.fromList ktn where nl = Map.fromList ktn
prop_Load_Node :: String -> Int -> Int -> Int -> Int -> Int prop_Load_Node :: String -> Int -> Int -> Int -> Int -> Int
...@@ -153,15 +154,15 @@ prop_ISpecIdempotent :: Types.ISpec -> Property ...@@ -153,15 +154,15 @@ prop_ISpecIdempotent :: Types.ISpec -> Property
prop_ISpecIdempotent ispec = prop_ISpecIdempotent ispec =
case Text.loadISpec "dummy" . Utils.sepSplit ',' . case Text.loadISpec "dummy" . Utils.sepSplit ',' .
Text.serializeISpec $ ispec of Text.serializeISpec $ ispec of
Types.Bad msg -> failTest $ "Failed to load ispec: " ++ msg Bad msg -> failTest $ "Failed to load ispec: " ++ msg
Types.Ok ispec' -> ispec ==? ispec' Ok ispec' -> ispec ==? ispec'
prop_IPolicyIdempotent :: Types.IPolicy -> Property prop_IPolicyIdempotent :: Types.IPolicy -> Property
prop_IPolicyIdempotent ipol = prop_IPolicyIdempotent ipol =
case Text.loadIPolicy . Utils.sepSplit '|' $ case Text.loadIPolicy . Utils.sepSplit '|' $
Text.serializeIPolicy owner ipol of Text.serializeIPolicy owner ipol of
Types.Bad msg -> failTest $ "Failed to load ispec: " ++ msg Bad msg -> failTest $ "Failed to load ispec: " ++ msg
Types.Ok res -> (owner, ipol) ==? res Ok res -> (owner, ipol) ==? res
where owner = "dummy" where owner = "dummy"
-- | This property, while being in the text tests, does more than just -- | This property, while being in the text tests, does more than just
...@@ -183,16 +184,16 @@ prop_CreateSerialise = ...@@ -183,16 +184,16 @@ prop_CreateSerialise =
in case Cluster.genAllocNodes defGroupList nl reqnodes True >>= \allocn -> in case Cluster.genAllocNodes defGroupList nl reqnodes True >>= \allocn ->
Cluster.iterateAlloc nl Container.empty (Just maxiter) inst allocn [] [] Cluster.iterateAlloc nl Container.empty (Just maxiter) inst allocn [] []
of of
Types.Bad msg -> failTest $ "Failed to allocate: " ++ msg Bad msg -> failTest $ "Failed to allocate: " ++ msg
Types.Ok (_, _, _, [], _) -> printTestCase Ok (_, _, _, [], _) -> printTestCase
"Failed to allocate: no allocations" False "Failed to allocate: no allocations" False
Types.Ok (_, nl', il', _, _) -> Ok (_, nl', il', _, _) ->
let cdata = Loader.ClusterData defGroupList nl' il' ctags let cdata = Loader.ClusterData defGroupList nl' il' ctags
Types.defIPolicy Types.defIPolicy
saved = Text.serializeCluster cdata saved = Text.serializeCluster cdata
in case Text.parseData saved >>= Loader.mergeData [] [] [] [] of in case Text.parseData saved >>= Loader.mergeData [] [] [] [] of
Types.Bad msg -> failTest $ "Failed to load/merge: " ++ msg Bad msg -> failTest $ "Failed to load/merge: " ++ msg
Types.Ok (Loader.ClusterData gl2 nl2 il2 ctags2 cpol2) -> Ok (Loader.ClusterData gl2 nl2 il2 ctags2 cpol2) ->
ctags ==? ctags2 .&&. ctags ==? ctags2 .&&.
Types.defIPolicy ==? cpol2 .&&. Types.defIPolicy ==? cpol2 .&&.
il' ==? il2 .&&. il' ==? il2 .&&.
......
...@@ -38,7 +38,7 @@ module Test.Ganeti.HTools.Types ...@@ -38,7 +38,7 @@ module Test.Ganeti.HTools.Types
, nullIPolicy , nullIPolicy
) where ) where
import Test.QuickCheck import Test.QuickCheck hiding (Result)
import Control.Applicative import Control.Applicative
...@@ -46,6 +46,7 @@ import Test.Ganeti.TestHelper ...@@ -46,6 +46,7 @@ import Test.Ganeti.TestHelper
import Test.Ganeti.TestCommon import Test.Ganeti.TestCommon
import Test.Ganeti.TestHTools import Test.Ganeti.TestHTools
import Ganeti.BasicTypes
import qualified Ganeti.HTools.Types as Types import qualified Ganeti.HTools.Types as Types
-- * Helpers -- * Helpers
...@@ -140,20 +141,20 @@ prop_EvacMode_serialisation = testSerialisation ...@@ -140,20 +141,20 @@ prop_EvacMode_serialisation = testSerialisation
prop_opToResult :: Types.OpResult Int -> Bool prop_opToResult :: Types.OpResult Int -> Bool
prop_opToResult op = prop_opToResult op =
case op of case op of
Types.OpFail _ -> Types.isBad r Types.OpFail _ -> isBad r
Types.OpGood v -> case r of Types.OpGood v -> case r of
Types.Bad _ -> False Bad _ -> False