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
import Test.Ganeti.TestCommon
import Test.Ganeti.Common
import Ganeti.BasicTypes
import Ganeti.HTools.CLI as CLI
import qualified Ganeti.HTools.Program as Program
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 descr dsk mem cpu =
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.
prop_parseISpecFail :: String -> Property
......@@ -58,7 +59,7 @@ prop_parseISpecFail descr =
forAll (replicateM nelems arbitrary) $ \values ->
let str = intercalate "," $ map show (values::[Int])
in case parseISpecString descr str of
Types.Ok v -> failTest $ "Expected failure, got " ++ show v
Ok v -> failTest $ "Expected failure, got " ++ show v
_ -> passTest
-- | Test a few string arguments.
......
......@@ -28,7 +28,7 @@ Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
module Test.Ganeti.HTools.Cluster (testHTools_Cluster) where
import Test.QuickCheck
import Test.QuickCheck hiding (Result)
import qualified Data.IntMap as IntMap
import Data.Maybe
......@@ -40,6 +40,7 @@ import Test.Ganeti.HTools.Instance ( genInstanceSmallerThanNode
, genInstanceSmallerThan )
import Test.Ganeti.HTools.Node (genOnlineNode, genNode)
import Ganeti.BasicTypes
import qualified Ganeti.HTools.Cluster as Cluster
import qualified Ganeti.HTools.Container as Container
import qualified Ganeti.HTools.Group as Group
......@@ -135,8 +136,8 @@ prop_Alloc_sane inst =
reqnodes = Instance.requiredNodes $ Instance.diskTemplate inst
in case Cluster.genAllocNodes defGroupList nl reqnodes True >>=
Cluster.tryAlloc nl il inst' of
Types.Bad msg -> failTest msg
Types.Ok as ->
Bad msg -> failTest msg
Ok as ->
case Cluster.asSolution as of
Nothing -> failTest "Failed to allocate, empty solution"
Just (xnl, xi, _, cv) ->
......@@ -159,8 +160,8 @@ prop_IterateAlloc_sane inst =
allocnodes = Cluster.genAllocNodes defGroupList nl reqnodes True
in case allocnodes >>= \allocnodes' ->
Cluster.iterateAlloc nl il (Just limit) inst' allocnodes' [] [] of
Types.Bad msg -> failTest msg
Types.Ok (_, xnl, xil, _, _) ->
Bad msg -> failTest msg
Ok (_, xnl, xil, _, _) ->
let old_score = Cluster.compCV xnl
tbl = Cluster.Table xnl xil old_score []
in case Cluster.tryBalance tbl True True False 0 1e-4 of
......@@ -200,8 +201,8 @@ prop_CanTieredAlloc =
allocnodes = Cluster.genAllocNodes defGroupList nl rqnodes True
in case allocnodes >>= \allocnodes' ->
Cluster.tieredAlloc nl il (Just 5) inst allocnodes' [] [] of
Types.Bad msg -> failTest $ "Failed to tiered alloc: " ++ msg
Types.Ok (_, nl', il', ixes, cstats) ->
Bad msg -> failTest $ "Failed to tiered alloc: " ++ msg
Ok (_, nl', il', ixes, cstats) ->
let (ai_alloc, ai_pool, ai_unav) =
Cluster.computeAllocationDelta
(Cluster.totalResources nl)
......@@ -221,19 +222,19 @@ prop_CanTieredAlloc =
-- | Helper function to create a cluster with the given range of nodes
-- and allocate an instance on it.
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 =
let nl = makeSmallCluster node count
reqnodes = Instance.requiredNodes $ Instance.diskTemplate inst
in case Cluster.genAllocNodes defGroupList nl reqnodes True >>=
Cluster.tryAlloc nl Container.empty inst of
Types.Bad _ -> Types.Bad "Can't allocate"
Types.Ok as ->
Bad msg -> Bad $ "Can't allocate: " ++ msg
Ok as ->
case Cluster.asSolution as of
Nothing -> Types.Bad "Empty solution?"
Nothing -> Bad "Empty solution?"
Just (xnl, xi, _, _) ->
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,
-- we can also relocate it.
......@@ -243,25 +244,25 @@ prop_AllocRelocate =
forAll (genOnlineNode `suchThat` isNodeBig 4) $ \node ->
forAll (genInstanceSmallerThanNode node `suchThat` isMirrored) $ \inst ->
case genClusterAlloc count node inst of
Types.Bad msg -> failTest msg
Types.Ok (nl, il, inst') ->
Bad msg -> failTest msg
Ok (nl, il, inst') ->
case IAlloc.processRelocate defGroupList nl il
(Instance.idx inst) 1
[(if Instance.diskTemplate inst' == Types.DTDrbd8
then Instance.sNode
else Instance.pNode) inst'] of
Types.Ok _ -> passTest
Types.Bad msg -> failTest $ "Failed to relocate: " ++ msg
Ok _ -> passTest
Bad msg -> failTest $ "Failed to relocate: " ++ msg
-- | Helper property checker for the result of a nodeEvac or
-- changeGroup operation.
check_EvacMode :: Group.Group -> Instance.Instance
-> Types.Result (Node.List, Instance.List, Cluster.EvacSolution)
-> Result (Node.List, Instance.List, Cluster.EvacSolution)
-> Property
check_EvacMode grp inst result =
case result of
Types.Bad msg -> failTest $ "Couldn't evacuate/change group:" ++ msg
Types.Ok (_, _, es) ->
Bad msg -> failTest $ "Couldn't evacuate/change group:" ++ msg
Ok (_, _, es) ->
let moved = Cluster.esMoved es
failed = Cluster.esFailed es
opcodes = not . null $ Cluster.esOpCodes es
......@@ -285,8 +286,8 @@ prop_AllocEvacuate =
forAll (genOnlineNode `suchThat` isNodeBig 4) $ \node ->
forAll (genInstanceSmallerThanNode node `suchThat` isMirrored) $ \inst ->
case genClusterAlloc count node inst of
Types.Bad msg -> failTest msg
Types.Ok (nl, il, inst') ->
Bad msg -> failTest msg
Ok (nl, il, inst') ->
conjoin . map (\mode -> check_EvacMode defGroup inst' $
Cluster.tryNodeEvac defGroupList nl il mode
[Instance.idx inst']) .
......@@ -302,8 +303,8 @@ prop_AllocChangeGroup =
forAll (genOnlineNode `suchThat` isNodeBig 4) $ \node ->
forAll (genInstanceSmallerThanNode node `suchThat` isMirrored) $ \inst ->
case genClusterAlloc count node inst of
Types.Bad msg -> failTest msg
Types.Ok (nl, il, inst') ->
Bad msg -> failTest msg
Ok (nl, il, inst') ->
-- we need to add a second node group and nodes to the cluster
let nl2 = Container.elems $ makeSmallCluster node count
grp2 = Group.setIdx defGroup (Group.idx defGroup + 1)
......@@ -330,9 +331,9 @@ prop_AllocBalance =
i_templ = createInstance Types.unitMem Types.unitDsk Types.unitCpu
in case allocnodes >>= \allocnodes' ->
Cluster.iterateAlloc nl' il (Just 5) i_templ allocnodes' [] [] of
Types.Bad msg -> failTest $ "Failed to allocate: " ++ msg
Types.Ok (_, _, _, [], _) -> failTest "Failed to allocate: no instances"
Types.Ok (_, xnl, il', _, _) ->
Bad msg -> failTest $ "Failed to allocate: " ++ msg
Ok (_, _, _, [], _) -> failTest "Failed to allocate: no instances"
Ok (_, xnl, il', _, _) ->
let ynl = Container.add (Node.idx hnode) hnode xnl
cv = Cluster.compCV ynl
tbl = Cluster.Table ynl il' cv []
......@@ -373,8 +374,8 @@ canAllocOn :: Node.List -> Int -> Instance.Instance -> Maybe String
canAllocOn nl reqnodes inst =
case Cluster.genAllocNodes defGroupList nl reqnodes True >>=
Cluster.tryAlloc nl Container.empty inst of
Types.Bad msg -> Just $ "Can't allocate: " ++ msg
Types.Ok as ->
Bad msg -> Just $ "Can't allocate: " ++ msg
Ok as ->
case Cluster.asSolution as of
Nothing -> Just $ "No allocation solution; failures: " ++
show (Cluster.collapseFailures $ Cluster.asFailures as)
......
......@@ -33,12 +33,13 @@ module Test.Ganeti.HTools.Instance
, Instance.Instance(..)
) where
import Test.QuickCheck
import Test.QuickCheck hiding (Result)
import Test.Ganeti.TestHelper
import Test.Ganeti.TestCommon
import Test.Ganeti.HTools.Types ()
import Ganeti.BasicTypes
import qualified Ganeti.HTools.Instance as Instance
import qualified Ganeti.HTools.Node as Node
import qualified Ganeti.HTools.Types as Types
......@@ -110,42 +111,40 @@ prop_shrinkMG :: Instance.Instance -> Property
prop_shrinkMG inst =
Instance.mem inst >= 2 * Types.unitMem ==>
case Instance.shrinkByType inst Types.FailMem of
Types.Ok inst' -> Instance.mem inst' == Instance.mem inst - Types.unitMem
_ -> False
Ok inst' -> Instance.mem inst' ==? Instance.mem inst - Types.unitMem
Bad msg -> failTest msg
prop_shrinkMF :: Instance.Instance -> Property
prop_shrinkMF inst =
forAll (choose (0, 2 * Types.unitMem - 1)) $ \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 inst =
Instance.vcpus inst >= 2 * Types.unitCpu ==>
case Instance.shrinkByType inst Types.FailCPU of
Types.Ok inst' ->
Instance.vcpus inst' == Instance.vcpus inst - Types.unitCpu
_ -> False
Ok inst' -> Instance.vcpus inst' ==? Instance.vcpus inst - Types.unitCpu
Bad msg -> failTest msg
prop_shrinkCF :: Instance.Instance -> Property
prop_shrinkCF inst =
forAll (choose (0, 2 * Types.unitCpu - 1)) $ \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 inst =
Instance.dsk inst >= 2 * Types.unitDsk ==>
case Instance.shrinkByType inst Types.FailDisk of
Types.Ok inst' ->
Instance.dsk inst' == Instance.dsk inst - Types.unitDsk
_ -> False
Ok inst' -> Instance.dsk inst' ==? Instance.dsk inst - Types.unitDsk
Bad msg -> failTest msg
prop_shrinkDF :: Instance.Instance -> Property
prop_shrinkDF inst =
forAll (choose (0, 2 * Types.unitDsk - 1)) $ \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 inst m =
......
......@@ -42,7 +42,6 @@ import qualified Ganeti.BasicTypes as BasicTypes
import qualified Ganeti.HTools.Container as Container
import qualified Ganeti.HTools.Loader as Loader
import qualified Ganeti.HTools.Node as Node
import qualified Ganeti.HTools.Types as Types
prop_lookupNode :: [(String, Int)] -> String -> String -> Property
prop_lookupNode ktn inst node =
......@@ -76,8 +75,8 @@ prop_mergeData ns =
let na = Container.fromList $ map (\n -> (Node.idx n, n)) ns
in case Loader.mergeData [] [] [] []
(Loader.emptyCluster {Loader.cdNodes = na}) of
Types.Bad _ -> False
Types.Ok (Loader.ClusterData _ nl il _ _) ->
BasicTypes.Bad _ -> False
BasicTypes.Ok (Loader.ClusterData _ nl il _ _) ->
let nodes = Container.elems nl
instances = Container.elems il
in (sum . map (length . Node.pList)) nodes == 0 &&
......
......@@ -28,7 +28,7 @@ Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
module Test.Ganeti.HTools.Simu (testHTools_Simu) where
import Test.QuickCheck
import Test.QuickCheck hiding (Result)
import Control.Monad
import qualified Data.IntMap as IntMap
......@@ -37,6 +37,7 @@ import Text.Printf (printf)
import Test.Ganeti.TestHelper
import Test.Ganeti.TestCommon
import Ganeti.BasicTypes
import qualified Ganeti.Constants as C
import qualified Ganeti.HTools.Container as Container
import qualified Ganeti.HTools.Group as Group
......@@ -75,8 +76,8 @@ prop_Load =
fromIntegral m, fromIntegral d))
specs :: [(Double, Double, Double, Int, Int)]
in case Simu.parseData strspecs of
Types.Bad msg -> failTest $ "Failed to load specs: " ++ msg
Types.Ok (Loader.ClusterData gl nl il tags ipol) ->
Bad msg -> failTest $ "Failed to load specs: " ++ msg
Ok (Loader.ClusterData gl nl il tags ipol) ->
let nodes = map snd $ IntMap.toAscList nl
nidx = map Node.idx nodes
mdc_out = map (\n -> (Node.tMem n, Node.tDsk n, Node.tCpu n,
......
......@@ -40,6 +40,7 @@ import Test.Ganeti.TestHTools
import Test.Ganeti.HTools.Instance (genInstanceSmallerThanNode)
import Test.Ganeti.HTools.Node (genNode, genOnlineNode)
import Ganeti.BasicTypes
import qualified Ganeti.HTools.Cluster as Cluster
import qualified Ganeti.HTools.Container as Container
import qualified Ganeti.HTools.Group as Group
......@@ -79,9 +80,9 @@ prop_Load_Instance name mem dsk vcpus status
[name, mem_s, dsk_s, vcpus_s, status_s,
sbal, pnode, pnode, tags]
in case inst of
Types.Bad msg -> failTest $ "Failed to load instance: " ++ msg
Types.Ok (_, i) -> printTestCase "Mismatch in some field while\
\ loading the instance" $
Bad msg -> failTest $ "Failed to load instance: " ++ msg
Ok (_, i) -> printTestCase "Mismatch in some field while\
\ loading the instance" $
Instance.name i == name &&
Instance.vcpus i == vcpus &&
Instance.mem i == mem &&
......@@ -91,15 +92,15 @@ prop_Load_Instance name mem dsk vcpus status
else sdx) &&
Instance.autoBalance i == autobal &&
Instance.spindleUse i == su &&
Types.isBad fail1
isBad fail1
prop_Load_InstanceFail :: [(String, Int)] -> [String] -> Property
prop_Load_InstanceFail ktn fields =
length fields /= 10 && length fields /= 11 ==>
case Text.loadInst nl fields of
Types.Ok _ -> failTest "Managed to load instance from invalid data"
Types.Bad msg -> printTestCase ("Unrecognised error message: " ++ msg) $
"Invalid/incomplete instance data: '" `isPrefixOf` msg
Ok _ -> failTest "Managed to load instance from invalid data"
Bad msg -> printTestCase ("Unrecognised error message: " ++ msg) $
"Invalid/incomplete instance data: '" `isPrefixOf` msg
where nl = Map.fromList ktn
prop_Load_Node :: String -> Int -> Int -> Int -> Int -> Int
......@@ -153,15 +154,15 @@ prop_ISpecIdempotent :: Types.ISpec -> Property
prop_ISpecIdempotent ispec =
case Text.loadISpec "dummy" . Utils.sepSplit ',' .
Text.serializeISpec $ ispec of
Types.Bad msg -> failTest $ "Failed to load ispec: " ++ msg
Types.Ok ispec' -> ispec ==? ispec'
Bad msg -> failTest $ "Failed to load ispec: " ++ msg
Ok ispec' -> ispec ==? ispec'
prop_IPolicyIdempotent :: Types.IPolicy -> Property
prop_IPolicyIdempotent ipol =
case Text.loadIPolicy . Utils.sepSplit '|' $
Text.serializeIPolicy owner ipol of
Types.Bad msg -> failTest $ "Failed to load ispec: " ++ msg
Types.Ok res -> (owner, ipol) ==? res
Bad msg -> failTest $ "Failed to load ispec: " ++ msg
Ok res -> (owner, ipol) ==? res
where owner = "dummy"
-- | This property, while being in the text tests, does more than just
......@@ -183,16 +184,16 @@ prop_CreateSerialise =
in case Cluster.genAllocNodes defGroupList nl reqnodes True >>= \allocn ->
Cluster.iterateAlloc nl Container.empty (Just maxiter) inst allocn [] []
of
Types.Bad msg -> failTest $ "Failed to allocate: " ++ msg
Types.Ok (_, _, _, [], _) -> printTestCase
"Failed to allocate: no allocations" False
Types.Ok (_, nl', il', _, _) ->
Bad msg -> failTest $ "Failed to allocate: " ++ msg
Ok (_, _, _, [], _) -> printTestCase
"Failed to allocate: no allocations" False
Ok (_, nl', il', _, _) ->
let cdata = Loader.ClusterData defGroupList nl' il' ctags
Types.defIPolicy
saved = Text.serializeCluster cdata
in case Text.parseData saved >>= Loader.mergeData [] [] [] [] of
Types.Bad msg -> failTest $ "Failed to load/merge: " ++ msg
Types.Ok (Loader.ClusterData gl2 nl2 il2 ctags2 cpol2) ->
Bad msg -> failTest $ "Failed to load/merge: " ++ msg
Ok (Loader.ClusterData gl2 nl2 il2 ctags2 cpol2) ->
ctags ==? ctags2 .&&.
Types.defIPolicy ==? cpol2 .&&.
il' ==? il2 .&&.
......
......@@ -38,7 +38,7 @@ module Test.Ganeti.HTools.Types
, nullIPolicy
) where
import Test.QuickCheck
import Test.QuickCheck hiding (Result)
import Control.Applicative
......@@ -46,6 +46,7 @@ import Test.Ganeti.TestHelper
import Test.Ganeti.TestCommon
import Test.Ganeti.TestHTools
import Ganeti.BasicTypes
import qualified Ganeti.HTools.Types as Types
-- * Helpers
......@@ -140,20 +141,20 @@ prop_EvacMode_serialisation = testSerialisation
prop_opToResult :: Types.OpResult Int -> Bool
prop_opToResult op =
case op of
Types.OpFail _ -> Types.isBad r
Types.OpFail _ -> isBad r
Types.OpGood v -> case r of
Types.Bad _ -> False
Types.Ok v' -> v == v'
Bad _ -> False
Ok v' -> v == v'
where r = Types.opToResult op
prop_eitherToResult :: Either String Int -> Bool
prop_eitherToResult ei =
case ei of
Left _ -> Types.isBad r
Left _ -> isBad r
Right v -> case r of
Types.Bad _ -> False
Types.Ok v' -> v == v'
where r = Types.eitherToResult ei
Bad _ -> False
Ok v' -> v == v'
where r = eitherToResult ei
testSuite "HTools/Types"
[ 'prop_AllocPolicy_serialisation
......
......@@ -28,7 +28,7 @@ Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
module Test.Ganeti.Utils (testUtils) where
import Test.QuickCheck
import Test.QuickCheck hiding (Result)
import Test.HUnit
import Data.List
......@@ -37,8 +37,8 @@ import qualified Text.JSON as J
import Test.Ganeti.TestHelper
import Test.Ganeti.TestCommon
import Ganeti.BasicTypes
import qualified Ganeti.JSON as JSON
import qualified Ganeti.HTools.Types as Types
import Ganeti.Utils
-- | Helper to generate a small string that doesn't contain commas.
......@@ -107,16 +107,18 @@ prop_select_undefv lst1 (NonEmpty lst2) =
prop_parseUnit :: NonNegative Int -> Property
prop_parseUnit (NonNegative n) =
parseUnit (show n) ==? Types.Ok n .&&.
parseUnit (show n ++ "m") ==? Types.Ok n .&&.
parseUnit (show n ++ "M") ==? Types.Ok (truncate n_mb::Int) .&&.
parseUnit (show n ++ "g") ==? Types.Ok (n*1024) .&&.
parseUnit (show n ++ "G") ==? Types.Ok (truncate n_gb::Int) .&&.
parseUnit (show n ++ "t") ==? Types.Ok (n*1048576) .&&.
parseUnit (show n ++ "T") ==? Types.Ok (truncate n_tb::Int) .&&.
printTestCase "Internal error/overflow?"
(n_mb >=0 && n_gb >= 0 && n_tb >= 0) .&&.
property (Types.isBad (parseUnit (show n ++ "x")::Types.Result Int))
conjoin
[ parseUnit (show n) ==? (Ok n::Result Int)
, parseUnit (show n ++ "m") ==? (Ok n::Result Int)
, parseUnit (show n ++ "M") ==? (Ok (truncate n_mb)::Result Int)
, parseUnit (show n ++ "g") ==? (Ok (n*1024)::Result Int)
, parseUnit (show n ++ "G") ==? (Ok (truncate n_gb)::Result Int)
, parseUnit (show n ++ "t") ==? (Ok (n*1048576)::Result Int)
, parseUnit (show n ++ "T") ==? (Ok (truncate n_tb)::Result Int)
, printTestCase "Internal error/overflow?"
(n_mb >=0 && n_gb >= 0 && n_tb >= 0)
, property (isBad (parseUnit (show n ++ "x")::Result Int))
]
where n_mb = (fromIntegral n::Rational) * 1000 * 1000 / 1024 / 1024
n_gb = n_mb * 1000
n_tb = n_gb * 1000
......
......@@ -81,6 +81,7 @@ import Data.Maybe (fromJust, isNothing)
import Data.Ord (comparing)
import Text.Printf (printf)
import Ganeti.BasicTypes
import qualified Ganeti.HTools.Container as Container
import qualified Ganeti.HTools.Instance as Instance
import qualified Ganeti.HTools.Node as Node
......
......@@ -49,6 +49,7 @@ import qualified Ganeti.HTools.IAlloc as IAlloc
import Ganeti.HTools.Loader (mergeData, checkData, ClusterData(..)
, commonSuffix)
import Ganeti.BasicTypes
import Ganeti.HTools.Types
import Ganeti.HTools.CLI
import Ganeti.Utils (sepSplit, tryRead, exitIfBad, exitWhen)
......
......@@ -39,6 +39,7 @@ import Text.JSON (JSObject, JSValue(JSArray),
import System.Exit
import System.IO
import Ganeti.BasicTypes
import qualified Ganeti.HTools.Cluster as Cluster
import qualified Ganeti.HTools.Container as Container
import qualified Ganeti.HTools.Group as Group
......
......@@ -57,6 +57,7 @@ module Ganeti.HTools.Instance
, mirrorType
) where
import Ganeti.BasicTypes
import qualified Ganeti.HTools.Types as T
import qualified Ganeti.HTools.Container as Container
......@@ -233,20 +234,20 @@ setMovable t m = t { movable = m }
-- | Try to shrink the instance based on the reason why we can't
-- allocate it.
shrinkByType :: Instance -> T.FailMode -> T.Result Instance
shrinkByType :: Instance -> T.FailMode -> Result Instance
shrinkByType inst T.FailMem = let v = mem inst - T.unitMem
in if v < T.unitMem
then T.Bad "out of memory"
else T.Ok inst { mem = v }
then Bad "out of memory"
else Ok inst { mem = v }
shrinkByType inst T.FailDisk = let v = dsk inst - T.unitDsk
in if v < T.unitDsk
then T.Bad "out of disk"
else T.Ok inst { dsk = v }
then Bad "out of disk"
else Ok inst { dsk = v }
shrinkByType inst T.FailCPU = let v = vcpus inst - T.unitCpu
in if v < T.unitCpu
then T.Bad "out of vcpus"
else T.Ok inst { vcpus = v }
shrinkByType _ f = T.Bad $ "Unhandled failure mode " ++ show f
then Bad "out of vcpus"
else Ok inst { vcpus = v }
shrinkByType _ f = Bad $ "Unhandled failure mode " ++ show f
-- | Return the spec of an instance.
specOf :: Instance -> T.RSpec
......
......@@ -32,6 +32,7 @@ import qualified Control.Exception as E
import Text.JSON.Types
import qualified Text.JSON
import Ganeti.BasicTypes
import qualified Ganeti.Luxi as L
import qualified Ganeti.Query.Language as Qlang
import Ganeti.HTools.Loader
......
......@@ -49,6 +49,7 @@ import qualified Ganeti.HTools.Group as Group
import qualified Ganeti.HTools.Node as Node
import qualified Ganeti.HTools.Instance as Instance
import Ganeti.BasicTypes
import Ganeti.Common
import Ganeti.HTools.CLI
import Ganeti.HTools.ExtLoader
......
......@@ -37,6 +37,7 @@ import System.FilePath
import Text.Printf (printf)
import Ganeti.BasicTypes
import qualified Ganeti.HTools.Container as Container
import qualified Ganeti.HTools.Cluster as Cluster
import qualified Ganeti.HTools.Node as Node
......@@ -49,7 +50,6 @@ import Ganeti.HTools.Text (serializeCluster)
import Ganeti.Common
import Ganeti.HTools.CLI
import Ganeti.HTools.Types
-- | Options list and functions.
options :: [OptType]
......
......@@ -44,6 +44,7 @@ import qualified Ganeti.HTools.Cluster as Cluster
import qualified Ganeti.HTools.Node as Node
import qualified Ganeti.HTools.Instance as Instance
import Ganeti.BasicTypes
import Ganeti.Common
import Ganeti.HTools.Types
import Ganeti.HTools.CLI
......
......@@ -44,6 +44,7 @@ import Text.JSON.Types (JSValue(..))
import Text.Printf (printf)
import System.FilePath
import Ganeti.BasicTypes
import Ganeti.HTools.Loader
import Ganeti.HTools.Types
import Ganeti.JSON
......
......@@ -33,6 +33,7 @@ module Ganeti.HTools.Simu
import Control.Monad (mplus, zipWithM)
import Text.Printf (printf)
import Ganeti.BasicTypes
import Ganeti.Utils
import Ganeti.HTools.Types
import Ganeti.HTools.Loader
......
......@@ -47,6 +47,7 @@ import Data.List