htools: add some unittests for Types.hs
[ganeti-local] / htools / Ganeti / HTools / QC.hs
index e5fe929..a033026 100644 (file)
@@ -1,4 +1,4 @@
-{-| Unittests for ganeti-htools
+{-| Unittests for ganeti-htools.
 
 -}
 
@@ -34,10 +34,10 @@ module Ganeti.HTools.QC
     , testJobs
     , testCluster
     , testLoader
+    , testTypes
     ) where
 
 import Test.QuickCheck
-import Test.QuickCheck.Batch
 import Data.List (findIndex, intercalate, nub, isPrefixOf)
 import Data.Maybe
 import Control.Monad
@@ -64,18 +64,22 @@ import qualified Ganeti.HTools.Text as Text
 import qualified Ganeti.HTools.Types as Types
 import qualified Ganeti.HTools.Utils as Utils
 import qualified Ganeti.HTools.Version
+import qualified Ganeti.Constants as C
+
+run :: Testable prop => prop -> Args -> IO Result
+run = flip quickCheckWithResult
 
 -- * Constants
 
--- | Maximum memory (1TiB, somewhat random value)
+-- | Maximum memory (1TiB, somewhat random value).
 maxMem :: Int
 maxMem = 1024 * 1024
 
--- | Maximum disk (8TiB, somewhat random value)
+-- | Maximum disk (8TiB, somewhat random value).
 maxDsk :: Int
 maxDsk = 1024 * 1024 * 8
 
--- | Max CPUs (1024, somewhat random value)
+-- | Max CPUs (1024, somewhat random value).
 maxCpu :: Int
 maxCpu = 1024
 
@@ -92,23 +96,23 @@ defGroupAssoc = Data.Map.singleton (Group.uuid defGroup) (Group.idx defGroup)
 
 -- * Helper functions
 
--- | Simple checker for whether OpResult is fail or pass
+-- | Simple checker for whether OpResult is fail or pass.
 isFailure :: Types.OpResult a -> Bool
 isFailure (Types.OpFail _) = True
 isFailure _ = False
 
--- | Update an instance to be smaller than a node
+-- | Update an instance to be smaller than a node.
 setInstanceSmallerThanNode node inst =
     inst { Instance.mem = Node.availMem node `div` 2
          , Instance.dsk = Node.availDisk node `div` 2
          , Instance.vcpus = Node.availCpu node `div` 2
          }
 
--- | Create an instance given its spec
+-- | Create an instance given its spec.
 createInstance mem dsk vcpus =
     Instance.create "inst-unnamed" mem dsk vcpus "running" [] True (-1) (-1)
 
--- | Create a small cluster by repeating a node spec
+-- | Create a small cluster by repeating a node spec.
 makeSmallCluster :: Node.Node -> Int -> Node.List
 makeSmallCluster node count =
     let fn = Node.buildPeers node Container.empty
@@ -116,17 +120,17 @@ makeSmallCluster node count =
         (_, nlst) = Loader.assignIndices namelst
     in nlst
 
--- | Checks if a node is "big" enough
+-- | Checks if a node is "big" enough.
 isNodeBig :: Node.Node -> Int -> Bool
 isNodeBig node size = Node.availDisk node > size * Types.unitDsk
                       && Node.availMem node > size * Types.unitMem
                       && Node.availCpu node > size * Types.unitCpu
 
-canBalance :: Cluster.Table -> Bool -> Bool -> Bool
-canBalance tbl dm evac = isJust $ Cluster.tryBalance tbl dm evac 0 0
+canBalance :: Cluster.Table -> Bool -> Bool -> Bool -> Bool
+canBalance tbl dm im evac = isJust $ Cluster.tryBalance tbl dm im evac 0 0
 
 -- | Assigns a new fresh instance to a cluster; this is not
--- allocation, so no resource checks are done
+-- allocation, so no resource checks are done.
 assignInstance :: Node.List -> Instance.List -> Instance.Instance ->
                   Types.Idx -> Types.Idx ->
                   (Node.List, Instance.List)
@@ -146,11 +150,9 @@ assignInstance nl il inst pdx sdx =
 
 -- * Arbitrary instances
 
--- copied from the introduction to quickcheck
-instance Arbitrary Char where
-    arbitrary = choose ('\32', '\128')
-
+-- | Defines a DNS name.
 newtype DNSChar = DNSChar { dnsGetChar::Char }
+
 instance Arbitrary DNSChar where
     arbitrary = do
       x <- elements (['a'..'z'] ++ ['0'..'9'] ++ "_-")
@@ -177,31 +179,52 @@ instance Arbitrary Instance.Instance where
       name <- getFQDN
       mem <- choose (0, maxMem)
       dsk <- choose (0, maxDsk)
-      run_st <- elements ["ERROR_up", "ERROR_down", "ADMIN_down"
-                         , "ERROR_nodedown", "ERROR_nodeoffline"
-                         , "running"
-                         , "no_such_status1", "no_such_status2"]
+      run_st <- elements [ C.inststErrorup
+                         , C.inststErrordown
+                         , C.inststAdmindown
+                         , C.inststNodedown
+                         , C.inststNodeoffline
+                         , C.inststRunning
+                         , "no_such_status1"
+                         , "no_such_status2"]
       pn <- arbitrary
       sn <- arbitrary
       vcpus <- choose (0, maxCpu)
       return $ Instance.create name mem dsk vcpus run_st [] True pn sn
 
+-- | Generas an arbitrary node based on sizing information.
+genNode :: Maybe Int -- ^ Minimum node size in terms of units
+        -> Maybe Int -- ^ Maximum node size (when Nothing, bounded
+                     -- just by the max... constants)
+        -> Gen Node.Node
+genNode min_multiplier max_multiplier = do
+  let (base_mem, base_dsk, base_cpu) =
+          case min_multiplier of
+            Just mm -> (mm * Types.unitMem,
+                        mm * Types.unitDsk,
+                        mm * Types.unitCpu)
+            Nothing -> (0, 0, 0)
+      (top_mem, top_dsk, top_cpu)  =
+          case max_multiplier of
+            Just mm -> (mm * Types.unitMem,
+                        mm * Types.unitDsk,
+                        mm * Types.unitCpu)
+            Nothing -> (maxMem, maxDsk, maxCpu)
+  name  <- getFQDN
+  mem_t <- choose (base_mem, top_mem)
+  mem_f <- choose (base_mem, mem_t)
+  mem_n <- choose (0, mem_t - mem_f)
+  dsk_t <- choose (base_dsk, top_dsk)
+  dsk_f <- choose (base_dsk, dsk_t)
+  cpu_t <- choose (base_cpu, top_cpu)
+  offl  <- arbitrary
+  let n = Node.create name (fromIntegral mem_t) mem_n mem_f
+          (fromIntegral dsk_t) dsk_f (fromIntegral cpu_t) offl 0
+  return $ Node.buildPeers n Container.empty
+
 -- and a random node
 instance Arbitrary Node.Node where
-    arbitrary = do
-      name <- getFQDN
-      mem_t <- choose (0, maxMem)
-      mem_f <- choose (0, mem_t)
-      mem_n <- choose (0, mem_t - mem_f)
-      dsk_t <- choose (0, maxDsk)
-      dsk_f <- choose (0, dsk_t)
-      cpu_t <- choose (0, maxCpu)
-      offl <- arbitrary
-      let n = Node.create name (fromIntegral mem_t) mem_n mem_f
-              (fromIntegral dsk_t) dsk_f (fromIntegral cpu_t) offl
-              0
-          n' = Node.buildPeers n Container.empty
-      return n'
+    arbitrary = genNode Nothing Nothing
 
 -- replace disks
 instance Arbitrary OpCodes.ReplaceDisksMode where
@@ -237,33 +260,52 @@ instance Arbitrary Jobs.OpStatus where
 instance Arbitrary Jobs.JobStatus where
   arbitrary = elements [minBound..maxBound]
 
+newtype SmallRatio = SmallRatio Double deriving Show
+instance Arbitrary SmallRatio where
+    arbitrary = do
+      v <- choose (0, 1)
+      return $ SmallRatio v
+
+instance Arbitrary Types.AllocPolicy where
+  arbitrary = elements [minBound..maxBound]
+
+instance Arbitrary Types.DiskTemplate where
+  arbitrary = elements [minBound..maxBound]
+
 -- * Actual tests
 
--- If the list is not just an empty element, and if the elements do
--- not contain commas, then join+split should be idepotent
-prop_Utils_commaJoinSplit lst = lst /= [""] &&
-                                all (not . elem ',') lst ==>
-                                Utils.sepSplit ',' (Utils.commaJoin lst) == lst
--- Split and join should always be idempotent
+-- ** Utils tests
+
+-- | If the list is not just an empty element, and if the elements do
+-- not contain commas, then join+split should be idempotent.
+prop_Utils_commaJoinSplit =
+    forAll (arbitrary `suchThat`
+            (\l -> l /= [""] && all (not . elem ',') l )) $ \lst ->
+    Utils.sepSplit ',' (Utils.commaJoin lst) == lst
+
+-- | Split and join should always be idempotent.
 prop_Utils_commaSplitJoin s = Utils.commaJoin (Utils.sepSplit ',' s) == s
 
 -- | fromObjWithDefault, we test using the Maybe monad and an integer
--- value
+-- value.
 prop_Utils_fromObjWithDefault def_value random_key =
     -- a missing key will be returned with the default
     Utils.fromObjWithDefault [] random_key def_value == Just def_value &&
     -- a found key will be returned as is, not with default
     Utils.fromObjWithDefault [(random_key, J.showJSON def_value)]
          random_key (def_value+1) == Just def_value
-        where _types = (def_value :: Integer)
+        where _types = def_value :: Integer
 
+-- | Test list for the Utils module.
 testUtils =
   [ run prop_Utils_commaJoinSplit
   , run prop_Utils_commaSplitJoin
   , run prop_Utils_fromObjWithDefault
   ]
 
--- | Make sure add is idempotent
+-- ** PeerMap tests
+
+-- | Make sure add is idempotent.
 prop_PeerMap_addIdempotent pmap key em =
     fn puniq == fn (fn puniq)
     where _types = (pmap::PeerMap.PeerMap,
@@ -271,33 +313,34 @@ prop_PeerMap_addIdempotent pmap key em =
           fn = PeerMap.add key em
           puniq = PeerMap.accumArray const pmap
 
--- | Make sure remove is idempotent
+-- | Make sure remove is idempotent.
 prop_PeerMap_removeIdempotent pmap key =
     fn puniq == fn (fn puniq)
     where _types = (pmap::PeerMap.PeerMap, key::PeerMap.Key)
           fn = PeerMap.remove key
           puniq = PeerMap.accumArray const pmap
 
--- | Make sure a missing item returns 0
+-- | Make sure a missing item returns 0.
 prop_PeerMap_findMissing pmap key =
     PeerMap.find key (PeerMap.remove key puniq) == 0
     where _types = (pmap::PeerMap.PeerMap, key::PeerMap.Key)
           puniq = PeerMap.accumArray const pmap
 
--- | Make sure an added item is found
+-- | Make sure an added item is found.
 prop_PeerMap_addFind pmap key em =
     PeerMap.find key (PeerMap.add key em puniq) == em
     where _types = (pmap::PeerMap.PeerMap,
                     key::PeerMap.Key, em::PeerMap.Elem)
           puniq = PeerMap.accumArray const pmap
 
--- | Manual check that maxElem returns the maximum indeed, or 0 for null
+-- | Manual check that maxElem returns the maximum indeed, or 0 for null.
 prop_PeerMap_maxElem pmap =
     PeerMap.maxElem puniq == if null puniq then 0
                              else (maximum . snd . unzip) puniq
     where _types = pmap::PeerMap.PeerMap
           puniq = PeerMap.accumArray const pmap
 
+-- | List of tests for the PeerMap module.
 testPeerMap =
     [ run prop_PeerMap_addIdempotent
     , run prop_PeerMap_removeIdempotent
@@ -306,7 +349,7 @@ testPeerMap =
     , run prop_PeerMap_findMissing
     ]
 
--- Container tests
+-- ** Container tests
 
 prop_Container_addTwo cdata i1 i2 =
     fn i1 i2 cont == fn i2 i1 cont &&
@@ -321,9 +364,9 @@ prop_Container_nameOf node =
       fnode = head (Container.elems nl)
   in Container.nameOf nl (Node.idx fnode) == Node.name fnode
 
--- We test that in a cluster, given a random node, we can find it by
+-- | We test that in a cluster, given a random node, we can find it by
 -- its name and alias, as long as all names and aliases are unique,
--- and that we fail to find a non-existing name
+-- and that we fail to find a non-existing name.
 prop_Container_findByName node othername =
   forAll (choose (1, 20)) $ \ cnt ->
   forAll (choose (0, cnt - 1)) $ \ fidx ->
@@ -349,6 +392,8 @@ testContainer =
     , run prop_Container_findByName
     ]
 
+-- ** Instance tests
+
 -- Simple instance tests, we only have setter/getters
 
 prop_Instance_creat inst =
@@ -383,11 +428,10 @@ prop_Instance_setBoth inst pdx sdx =
     where _types = (inst::Instance.Instance, pdx::Types.Ndx, sdx::Types.Ndx)
           si = Instance.setBoth inst pdx sdx
 
-prop_Instance_runStatus_True inst =
-    let run_st = Instance.running inst
-        run_tx = Instance.runSt inst
-    in
-      run_tx `elem` Instance.runningStates ==> run_st
+prop_Instance_runStatus_True =
+    forAll (arbitrary `suchThat`
+            ((`elem` Instance.runningStates) . Instance.runSt))
+    Instance.running
 
 prop_Instance_runStatus_False inst =
     let run_st = Instance.running inst
@@ -403,8 +447,9 @@ prop_Instance_shrinkMG inst =
           _ -> False
 
 prop_Instance_shrinkMF inst =
-    Instance.mem inst < 2 * Types.unitMem ==>
-        Types.isBad $ Instance.shrinkByType inst Types.FailMem
+    forAll (choose (0, 2 * Types.unitMem - 1)) $ \mem ->
+    let inst' = inst { Instance.mem = mem}
+    in Types.isBad $ Instance.shrinkByType inst' Types.FailMem
 
 prop_Instance_shrinkCG inst =
     Instance.vcpus inst >= 2 * Types.unitCpu ==>
@@ -414,8 +459,9 @@ prop_Instance_shrinkCG inst =
           _ -> False
 
 prop_Instance_shrinkCF inst =
-    Instance.vcpus inst < 2 * Types.unitCpu ==>
-        Types.isBad $ Instance.shrinkByType inst Types.FailCPU
+    forAll (choose (0, 2 * Types.unitCpu - 1)) $ \vcpus ->
+    let inst' = inst { Instance.vcpus = vcpus }
+    in Types.isBad $ Instance.shrinkByType inst' Types.FailCPU
 
 prop_Instance_shrinkDG inst =
     Instance.dsk inst >= 2 * Types.unitDsk ==>
@@ -425,8 +471,9 @@ prop_Instance_shrinkDG inst =
           _ -> False
 
 prop_Instance_shrinkDF inst =
-    Instance.dsk inst < 2 * Types.unitDsk ==>
-        Types.isBad $ Instance.shrinkByType inst Types.FailDisk
+    forAll (choose (0, 2 * Types.unitDsk - 1)) $ \dsk ->
+    let inst' = inst { Instance.dsk = dsk }
+    in Types.isBad $ Instance.shrinkByType inst' Types.FailDisk
 
 prop_Instance_setMovable inst m =
     Instance.movable inst' == m
@@ -451,19 +498,20 @@ testInstance =
     , run prop_Instance_setMovable
     ]
 
+-- ** Text backend tests
+
 -- Instance text loader tests
 
-prop_Text_Load_Instance name mem dsk vcpus status pnode snode pdx sdx autobal =
-    not (null pnode) && pdx >= 0 && sdx >= 0 ==>
+prop_Text_Load_Instance name mem dsk vcpus status
+                        (NonEmpty pnode) snode
+                        (NonNegative pdx) (NonNegative sdx) autobal =
+    pnode /= snode && pdx /= sdx ==>
     let vcpus_s = show vcpus
         dsk_s = show dsk
         mem_s = show mem
-        rsdx = if pdx == sdx
-               then sdx + 1
-               else sdx
         ndx = if null snode
               then [(pnode, pdx)]
-              else [(pnode, pdx), (snode, rsdx)]
+              else [(pnode, pdx), (snode, sdx)]
         nl = Data.Map.fromList ndx
         tags = ""
         sbal = if autobal then "Y" else "N"
@@ -475,28 +523,27 @@ prop_Text_Load_Instance name mem dsk vcpus status pnode snode pdx sdx autobal =
                 sbal, pnode, pnode, tags]:: Maybe (String, Instance.Instance)
         _types = ( name::String, mem::Int, dsk::Int
                  , vcpus::Int, status::String
-                 , pnode::String, snode::String
-                 , pdx::Types.Ndx, sdx::Types.Ndx
+                 , snode::String
                  , autobal::Bool)
     in
       case inst of
         Nothing -> False
         Just (_, i) ->
-            (Instance.name i == name &&
-             Instance.vcpus i == vcpus &&
-             Instance.mem i == mem &&
-             Instance.pNode i == pdx &&
-             Instance.sNode i == (if null snode
-                                  then Node.noSecondary
-                                  else rsdx) &&
-             Instance.auto_balance i == autobal &&
-             isNothing fail1)
+            Instance.name i == name &&
+            Instance.vcpus i == vcpus &&
+            Instance.mem i == mem &&
+            Instance.pNode i == pdx &&
+            Instance.sNode i == (if null snode
+                                 then Node.noSecondary
+                                 else sdx) &&
+            Instance.autoBalance i == autobal &&
+            isNothing fail1
 
 prop_Text_Load_InstanceFail ktn fields =
     length fields /= 9 ==>
     case Text.loadInst nl fields of
-      Right _ -> False
-      Left msg -> isPrefixOf "Invalid/incomplete instance data: '" msg
+      Types.Ok _ -> False
+      Types.Bad msg -> "Invalid/incomplete instance data: '" `isPrefixOf` msg
     where nl = Data.Map.fromList ktn
 
 prop_Text_Load_Node name tm nm fm td fd tc fo =
@@ -547,7 +594,7 @@ testText =
     , run prop_Text_NodeLSIdempotent
     ]
 
--- Node tests
+-- ** Node tests
 
 prop_Node_setAlias node name =
     Node.name newnode == Node.name node &&
@@ -567,7 +614,8 @@ prop_Node_setMcpu node mc =
     Node.mCpu newnode == mc
     where newnode = Node.setMcpu node mc
 
--- | Check that an instance add with too high memory or disk will be rejected
+-- | Check that an instance add with too high memory or disk will be
+-- rejected.
 prop_Node_addPriFM node inst = Instance.mem inst >= Node.fMem node &&
                                not (Node.failN1 node)
                                ==>
@@ -588,17 +636,17 @@ prop_Node_addPriFD node inst = Instance.dsk inst >= Node.fDsk node &&
           inst' = setInstanceSmallerThanNode node inst
           inst'' = inst' { Instance.dsk = Instance.dsk inst }
 
-prop_Node_addPriFC node inst = Instance.vcpus inst > Node.availCpu node &&
-                               not (Node.failN1 node)
-                               ==>
-                               case Node.addPri node inst'' of
-                                 Types.OpFail Types.FailCPU -> True
-                                 _ -> False
+prop_Node_addPriFC node inst (Positive extra) =
+    not (Node.failN1 node) ==>
+        case Node.addPri node inst'' of
+          Types.OpFail Types.FailCPU -> True
+          _ -> False
     where _types = (node::Node.Node, inst::Instance.Instance)
           inst' = setInstanceSmallerThanNode node inst
-          inst'' = inst' { Instance.vcpus = Instance.vcpus inst }
+          inst'' = inst' { Instance.vcpus = Node.availCpu node + extra }
 
--- | Check that an instance add with too high memory or disk will be rejected
+-- | Check that an instance add with too high memory or disk will be
+-- rejected.
 prop_Node_addSec node inst pdx =
     (Instance.mem inst >= (Node.fMem node - Node.rMem node) ||
      Instance.dsk inst >= Node.fDsk node) &&
@@ -606,13 +654,39 @@ prop_Node_addSec node inst pdx =
     ==> isFailure (Node.addSec node inst pdx)
         where _types = (node::Node.Node, inst::Instance.Instance, pdx::Int)
 
-newtype SmallRatio = SmallRatio Double deriving Show
-instance Arbitrary SmallRatio where
-    arbitrary = do
-      v <- choose (0, 1)
-      return $ SmallRatio v
-
--- | Check mdsk setting
+-- | Checks for memory reservation changes.
+prop_Node_rMem inst =
+    forAll (arbitrary `suchThat` ((> 0) . Node.fMem)) $ \node ->
+    -- ab = auto_balance, nb = non-auto_balance
+    -- we use -1 as the primary node of the instance
+    let inst' = inst { Instance.pNode = -1, Instance.autoBalance = True }
+        inst_ab = setInstanceSmallerThanNode node inst'
+        inst_nb = inst_ab { Instance.autoBalance = False }
+        -- now we have the two instances, identical except the
+        -- autoBalance attribute
+        orig_rmem = Node.rMem node
+        inst_idx = Instance.idx inst_ab
+        node_add_ab = Node.addSec node inst_ab (-1)
+        node_add_nb = Node.addSec node inst_nb (-1)
+        node_del_ab = liftM (flip Node.removeSec inst_ab) node_add_ab
+        node_del_nb = liftM (flip 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) ->
+             printTestCase "Consistency checks failed" $
+             Node.rMem a_ab >  orig_rmem &&
+             Node.rMem a_ab - orig_rmem == Instance.mem inst_ab &&
+             Node.rMem a_nb == orig_rmem &&
+             Node.rMem d_ab == orig_rmem &&
+             Node.rMem d_nb == orig_rmem &&
+             -- this is not related to rMem, but as good a place to
+             -- test as any
+             inst_idx `elem` Node.sList a_ab &&
+             not (inst_idx `elem` Node.sList d_ab)
+         x -> printTestCase ("Failed to add/remove instances: " ++ show x)
+              False
+
+-- | Check mdsk setting.
 prop_Node_setMdsk node mx =
     Node.loDsk node' >= 0 &&
     fromIntegral (Node.loDsk node') <= Node.tDsk node &&
@@ -646,7 +720,7 @@ prop_Node_computeGroups nodes =
   in length nodes == sum (map (length . snd) ng) &&
      all (\(guuid, ns) -> all ((== guuid) . Node.group) ns) ng &&
      length (nub onlyuuid) == length onlyuuid &&
-     if null nodes then True else not (null ng)
+     (null nodes || not (null ng))
 
 testNode =
     [ run prop_Node_setAlias
@@ -657,6 +731,7 @@ testNode =
     , run prop_Node_addPriFD
     , run prop_Node_addPriFC
     , run prop_Node_addSec
+    , run prop_Node_rMem
     , run prop_Node_setMdsk
     , run prop_Node_tagMaps_idempotent
     , run prop_Node_tagMaps_reject
@@ -665,10 +740,12 @@ testNode =
     ]
 
 
--- Cluster tests
+-- ** Cluster tests
 
--- | Check that the cluster score is close to zero for a homogeneous cluster
-prop_Score_Zero node count =
+-- | Check that the cluster score is close to zero for a homogeneous
+-- cluster.
+prop_Score_Zero node =
+    forAll (choose (1, 1024)) $ \count ->
     (not (Node.offline node) && not (Node.failN1 node) && (count > 0) &&
      (Node.tDsk node > 0) && (Node.tMem node > 0)) ==>
     let fn = Node.buildPeers node Container.empty
@@ -677,11 +754,12 @@ prop_Score_Zero node count =
         score = Cluster.compCV nl
     -- we can't say == 0 here as the floating point errors accumulate;
     -- this should be much lower than the default score in CLI.hs
-    in score <= 1e-15
+    in score <= 1e-12
 
--- | Check that cluster stats are sane
-prop_CStats_sane node count =
-    (not (Node.offline node) && not (Node.failN1 node) && (count > 0) &&
+-- | Check that cluster stats are sane.
+prop_CStats_sane node =
+    forAll (choose (1, 1024)) $ \count ->
+    (not (Node.offline node) && not (Node.failN1 node) &&
      (Node.availDisk node > 0) && (Node.availMem node > 0)) ==>
     let fn = Node.buildPeers node Container.empty
         nlst = zip [1..] $ replicate count fn::[(Types.Ndx, Node.Node)]
@@ -691,7 +769,7 @@ prop_CStats_sane node count =
        Cluster.csAdsk cstats <= Cluster.csFdsk cstats
 
 -- | Check that one instance is allocated correctly, without
--- rebalances needed
+-- rebalances needed.
 prop_ClusterAlloc_sane node inst =
     forAll (choose (5, 20)) $ \count ->
     not (Node.offline node)
@@ -711,12 +789,12 @@ prop_ClusterAlloc_sane node inst =
                (xnl, xi, _, cv):[] ->
                    let il' = Container.add (Instance.idx xi) xi il
                        tbl = Cluster.Table xnl il' cv []
-                   in not (canBalance tbl True False)
+                   in not (canBalance tbl True True False)
                _ -> False
 
 -- | Checks that on a 2-5 node cluster, we can allocate a random
 -- instance spec via tiered allocation (whatever the original instance
--- spec), on either one or two nodes
+-- spec), on either one or two nodes.
 prop_ClusterCanTieredAlloc node inst =
     forAll (choose (2, 5)) $ \count ->
     forAll (choose (1, 2)) $ \rqnodes ->
@@ -735,7 +813,7 @@ prop_ClusterCanTieredAlloc node inst =
                                       length ixes == length cstats
 
 -- | Checks that on a 4-8 node cluster, once we allocate an instance,
--- we can also evacuate it
+-- we can also evacuate it.
 prop_ClusterAllocEvac node inst =
     forAll (choose (4, 8)) $ \count ->
     not (Node.offline node)
@@ -760,14 +838,11 @@ prop_ClusterAllocEvac node inst =
                _ -> False
 
 -- | Check that allocating multiple instances on a cluster, then
--- adding an empty node, results in a valid rebalance
-prop_ClusterAllocBalance node =
+-- adding an empty node, results in a valid rebalance.
+prop_ClusterAllocBalance =
+    forAll (genNode (Just 5) (Just 128)) $ \node ->
     forAll (choose (3, 5)) $ \count ->
-    not (Node.offline node)
-            && not (Node.failN1 node)
-            && isNodeBig node 4
-            && not (isNodeBig node 8)
-            ==>
+    not (Node.offline node) && not (Node.failN1 node) ==>
     let nl = makeSmallCluster node count
         (hnode, nl') = IntMap.deleteFindMax nl
         il = Container.empty
@@ -780,9 +855,9 @@ prop_ClusterAllocBalance node =
                    let ynl = Container.add (Node.idx hnode) hnode xnl
                        cv = Cluster.compCV ynl
                        tbl = Cluster.Table ynl il' cv []
-                   in canBalance tbl True False
+                   in canBalance tbl True True False
 
--- | Checks consistency
+-- | Checks consistency.
 prop_ClusterCheckConsistency node inst =
   let nl = makeSmallCluster node 3
       [node1, node2, node3] = Container.elems nl
@@ -796,7 +871,7 @@ prop_ClusterCheckConsistency node inst =
      null (ccheck [(0, inst2)]) &&
      (not . null $ ccheck [(0, inst3)])
 
--- For now, we only test that we don't lose instances during the split
+-- | For now, we only test that we don't lose instances during the split.
 prop_ClusterSplitCluster node inst =
   forAll (choose (0, 100)) $ \icnt ->
   let nl = makeSmallCluster node 2
@@ -818,8 +893,9 @@ testCluster =
     , run prop_ClusterSplitCluster
     ]
 
--- | Check that opcode serialization is idempotent
+-- ** OpCodes tests
 
+-- | Check that opcode serialization is idempotent.
 prop_OpCodes_serialization op =
   case J.readJSON (J.showJSON op) of
     J.Error _ -> False
@@ -830,7 +906,9 @@ testOpCodes =
   [ run prop_OpCodes_serialization
   ]
 
--- | Check that (queued) job\/opcode status serialization is idempotent
+-- ** Jobs tests
+
+-- | Check that (queued) job\/opcode status serialization is idempotent.
 prop_OpStatus_serialization os =
   case J.readJSON (J.showJSON os) of
     J.Error _ -> False
@@ -848,7 +926,7 @@ testJobs =
   , run prop_JobStatus_serialization
   ]
 
--- | Loader tests
+-- ** Loader tests
 
 prop_Loader_lookupNode ktn inst node =
   Loader.lookupNode nl inst node == Data.Map.lookup node nl
@@ -866,12 +944,11 @@ prop_Loader_assignIndices nodes =
    else True)
   where (nassoc, kt) = Loader.assignIndices (map (\n -> (Node.name n, n)) nodes)
 
-
 -- | Checks that the number of primary instances recorded on the nodes
--- is zero
+-- is zero.
 prop_Loader_mergeData 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
     Types.Bad _ -> False
     Types.Ok (Loader.ClusterData _ nl il _) ->
@@ -886,3 +963,22 @@ testLoader =
   , run prop_Loader_assignIndices
   , run prop_Loader_mergeData
   ]
+
+-- ** Types tests
+
+prop_AllocPolicy_serialisation apol =
+    case Types.apolFromString (Types.apolToString apol) of
+      Types.Ok p -> printTestCase ("invalid deserialisation " ++ show p) $
+                    p == apol
+      Types.Bad s -> printTestCase ("failed to deserialise: " ++ s) False
+
+prop_DiskTemplate_serialisation dt =
+    case Types.dtFromString (Types.dtToString dt) of
+      Types.Ok p -> printTestCase ("invalid deserialisation " ++ show p) $
+                    p == dt
+      Types.Bad s -> printTestCase ("failed to deserialise: " ++ s) False
+
+testTypes =
+    [ run prop_AllocPolicy_serialisation
+    , run prop_DiskTemplate_serialisation
+    ]