Statistics
| Branch: | Tag: | Revision:

root / htools / Ganeti / HTools / QC.hs @ 61bbbed7

History | View | Annotate | Download (40.6 kB)

1 23fe06c2 Iustin Pop
{-# LANGUAGE TemplateHaskell #-}
2 23fe06c2 Iustin Pop
3 525bfb36 Iustin Pop
{-| Unittests for ganeti-htools.
4 e2fa2baf Iustin Pop
5 e2fa2baf Iustin Pop
-}
6 e2fa2baf Iustin Pop
7 e2fa2baf Iustin Pop
{-
8 e2fa2baf Iustin Pop
9 1bc47d38 Iustin Pop
Copyright (C) 2009, 2010, 2011 Google Inc.
10 e2fa2baf Iustin Pop
11 e2fa2baf Iustin Pop
This program is free software; you can redistribute it and/or modify
12 e2fa2baf Iustin Pop
it under the terms of the GNU General Public License as published by
13 e2fa2baf Iustin Pop
the Free Software Foundation; either version 2 of the License, or
14 e2fa2baf Iustin Pop
(at your option) any later version.
15 e2fa2baf Iustin Pop
16 e2fa2baf Iustin Pop
This program is distributed in the hope that it will be useful, but
17 e2fa2baf Iustin Pop
WITHOUT ANY WARRANTY; without even the implied warranty of
18 e2fa2baf Iustin Pop
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
19 e2fa2baf Iustin Pop
General Public License for more details.
20 e2fa2baf Iustin Pop
21 e2fa2baf Iustin Pop
You should have received a copy of the GNU General Public License
22 e2fa2baf Iustin Pop
along with this program; if not, write to the Free Software
23 e2fa2baf Iustin Pop
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
24 e2fa2baf Iustin Pop
02110-1301, USA.
25 e2fa2baf Iustin Pop
26 e2fa2baf Iustin Pop
-}
27 e2fa2baf Iustin Pop
28 15f4c8ca Iustin Pop
module Ganeti.HTools.QC
29 691dcd2a Iustin Pop
    ( testUtils
30 691dcd2a Iustin Pop
    , testPeerMap
31 c15f7183 Iustin Pop
    , testContainer
32 c15f7183 Iustin Pop
    , testInstance
33 c15f7183 Iustin Pop
    , testNode
34 c15f7183 Iustin Pop
    , testText
35 88f25dd0 Iustin Pop
    , testOpCodes
36 db079755 Iustin Pop
    , testJobs
37 c15f7183 Iustin Pop
    , testCluster
38 c088674b Iustin Pop
    , testLoader
39 3c002a13 Iustin Pop
    , testTypes
40 7dd5ee6c Iustin Pop
    ) where
41 15f4c8ca Iustin Pop
42 15f4c8ca Iustin Pop
import Test.QuickCheck
43 bc782180 Iustin Pop
import Data.List (findIndex, intercalate, nub, isPrefixOf)
44 15f4c8ca Iustin Pop
import Data.Maybe
45 88f25dd0 Iustin Pop
import Control.Monad
46 88f25dd0 Iustin Pop
import qualified Text.JSON as J
47 8fcf251f Iustin Pop
import qualified Data.Map
48 3fea6959 Iustin Pop
import qualified Data.IntMap as IntMap
49 88f25dd0 Iustin Pop
import qualified Ganeti.OpCodes as OpCodes
50 db079755 Iustin Pop
import qualified Ganeti.Jobs as Jobs
51 223dbe53 Iustin Pop
import qualified Ganeti.Luxi
52 15f4c8ca Iustin Pop
import qualified Ganeti.HTools.CLI as CLI
53 15f4c8ca Iustin Pop
import qualified Ganeti.HTools.Cluster as Cluster
54 15f4c8ca Iustin Pop
import qualified Ganeti.HTools.Container as Container
55 223dbe53 Iustin Pop
import qualified Ganeti.HTools.ExtLoader
56 15f4c8ca Iustin Pop
import qualified Ganeti.HTools.IAlloc as IAlloc
57 15f4c8ca Iustin Pop
import qualified Ganeti.HTools.Instance as Instance
58 15f4c8ca Iustin Pop
import qualified Ganeti.HTools.Loader as Loader
59 223dbe53 Iustin Pop
import qualified Ganeti.HTools.Luxi
60 15f4c8ca Iustin Pop
import qualified Ganeti.HTools.Node as Node
61 10ef6b4e Iustin Pop
import qualified Ganeti.HTools.Group as Group
62 15f4c8ca Iustin Pop
import qualified Ganeti.HTools.PeerMap as PeerMap
63 c478f837 Iustin Pop
import qualified Ganeti.HTools.Rapi
64 223dbe53 Iustin Pop
import qualified Ganeti.HTools.Simu
65 15f4c8ca Iustin Pop
import qualified Ganeti.HTools.Text as Text
66 15f4c8ca Iustin Pop
import qualified Ganeti.HTools.Types as Types
67 15f4c8ca Iustin Pop
import qualified Ganeti.HTools.Utils as Utils
68 223dbe53 Iustin Pop
import qualified Ganeti.HTools.Version
69 e82271f8 Iustin Pop
import qualified Ganeti.Constants as C
70 15f4c8ca Iustin Pop
71 33b9d92d Iustin Pop
import qualified Ganeti.HTools.Program.Hail
72 33b9d92d Iustin Pop
import qualified Ganeti.HTools.Program.Hbal
73 33b9d92d Iustin Pop
import qualified Ganeti.HTools.Program.Hscan
74 33b9d92d Iustin Pop
import qualified Ganeti.HTools.Program.Hspace
75 33b9d92d Iustin Pop
76 23fe06c2 Iustin Pop
import Ganeti.HTools.QCHelper (testSuite)
77 8e4f6d56 Iustin Pop
78 3fea6959 Iustin Pop
-- * Constants
79 3fea6959 Iustin Pop
80 525bfb36 Iustin Pop
-- | Maximum memory (1TiB, somewhat random value).
81 8fcf251f Iustin Pop
maxMem :: Int
82 8fcf251f Iustin Pop
maxMem = 1024 * 1024
83 8fcf251f Iustin Pop
84 525bfb36 Iustin Pop
-- | Maximum disk (8TiB, somewhat random value).
85 8fcf251f Iustin Pop
maxDsk :: Int
86 49f9627a Iustin Pop
maxDsk = 1024 * 1024 * 8
87 8fcf251f Iustin Pop
88 525bfb36 Iustin Pop
-- | Max CPUs (1024, somewhat random value).
89 8fcf251f Iustin Pop
maxCpu :: Int
90 8fcf251f Iustin Pop
maxCpu = 1024
91 8fcf251f Iustin Pop
92 10ef6b4e Iustin Pop
defGroup :: Group.Group
93 10ef6b4e Iustin Pop
defGroup = flip Group.setIdx 0 $
94 10ef6b4e Iustin Pop
               Group.create "default" Utils.defaultGroupID
95 10ef6b4e Iustin Pop
                    Types.AllocPreferred
96 10ef6b4e Iustin Pop
97 10ef6b4e Iustin Pop
defGroupList :: Group.List
98 cb0c77ff Iustin Pop
defGroupList = Container.fromList [(Group.idx defGroup, defGroup)]
99 10ef6b4e Iustin Pop
100 10ef6b4e Iustin Pop
defGroupAssoc :: Data.Map.Map String Types.Gdx
101 10ef6b4e Iustin Pop
defGroupAssoc = Data.Map.singleton (Group.uuid defGroup) (Group.idx defGroup)
102 10ef6b4e Iustin Pop
103 3fea6959 Iustin Pop
-- * Helper functions
104 3fea6959 Iustin Pop
105 525bfb36 Iustin Pop
-- | Simple checker for whether OpResult is fail or pass.
106 79a72ce7 Iustin Pop
isFailure :: Types.OpResult a -> Bool
107 79a72ce7 Iustin Pop
isFailure (Types.OpFail _) = True
108 79a72ce7 Iustin Pop
isFailure _ = False
109 79a72ce7 Iustin Pop
110 72bb6b4e Iustin Pop
-- | Checks for equality with proper annotation.
111 72bb6b4e Iustin Pop
(==?) :: (Show a, Eq a) => a -> a -> Property
112 72bb6b4e Iustin Pop
(==?) x y = printTestCase
113 72bb6b4e Iustin Pop
            ("Expected equality, but '" ++
114 72bb6b4e Iustin Pop
             show x ++ "' /= '" ++ show y ++ "'") (x == y)
115 72bb6b4e Iustin Pop
infix 3 ==?
116 72bb6b4e Iustin Pop
117 525bfb36 Iustin Pop
-- | Update an instance to be smaller than a node.
118 3fea6959 Iustin Pop
setInstanceSmallerThanNode node inst =
119 4a007641 Iustin Pop
    inst { Instance.mem = Node.availMem node `div` 2
120 4a007641 Iustin Pop
         , Instance.dsk = Node.availDisk node `div` 2
121 4a007641 Iustin Pop
         , Instance.vcpus = Node.availCpu node `div` 2
122 3fea6959 Iustin Pop
         }
123 3fea6959 Iustin Pop
124 525bfb36 Iustin Pop
-- | Create an instance given its spec.
125 3fea6959 Iustin Pop
createInstance mem dsk vcpus =
126 7dd14211 Agata Murawska
    Instance.create "inst-unnamed" mem dsk vcpus Types.Running [] True (-1) (-1)
127 d25643d1 Iustin Pop
                    Types.DTDrbd8
128 3fea6959 Iustin Pop
129 525bfb36 Iustin Pop
-- | Create a small cluster by repeating a node spec.
130 3fea6959 Iustin Pop
makeSmallCluster :: Node.Node -> Int -> Node.List
131 3fea6959 Iustin Pop
makeSmallCluster node count =
132 3fea6959 Iustin Pop
    let fn = Node.buildPeers node Container.empty
133 3fea6959 Iustin Pop
        namelst = map (\n -> (Node.name n, n)) (replicate count fn)
134 3fea6959 Iustin Pop
        (_, nlst) = Loader.assignIndices namelst
135 99b63608 Iustin Pop
    in nlst
136 3fea6959 Iustin Pop
137 525bfb36 Iustin Pop
-- | Checks if a node is "big" enough.
138 3fea6959 Iustin Pop
isNodeBig :: Node.Node -> Int -> Bool
139 3fea6959 Iustin Pop
isNodeBig node size = Node.availDisk node > size * Types.unitDsk
140 3fea6959 Iustin Pop
                      && Node.availMem node > size * Types.unitMem
141 3fea6959 Iustin Pop
                      && Node.availCpu node > size * Types.unitCpu
142 3fea6959 Iustin Pop
143 e08424a8 Guido Trotter
canBalance :: Cluster.Table -> Bool -> Bool -> Bool -> Bool
144 e08424a8 Guido Trotter
canBalance tbl dm im evac = isJust $ Cluster.tryBalance tbl dm im evac 0 0
145 3fea6959 Iustin Pop
146 f4161783 Iustin Pop
-- | Assigns a new fresh instance to a cluster; this is not
147 525bfb36 Iustin Pop
-- allocation, so no resource checks are done.
148 f4161783 Iustin Pop
assignInstance :: Node.List -> Instance.List -> Instance.Instance ->
149 f4161783 Iustin Pop
                  Types.Idx -> Types.Idx ->
150 f4161783 Iustin Pop
                  (Node.List, Instance.List)
151 f4161783 Iustin Pop
assignInstance nl il inst pdx sdx =
152 f4161783 Iustin Pop
  let pnode = Container.find pdx nl
153 f4161783 Iustin Pop
      snode = Container.find sdx nl
154 f4161783 Iustin Pop
      maxiidx = if Container.null il
155 f4161783 Iustin Pop
                then 0
156 f4161783 Iustin Pop
                else fst (Container.findMax il) + 1
157 f4161783 Iustin Pop
      inst' = inst { Instance.idx = maxiidx,
158 f4161783 Iustin Pop
                     Instance.pNode = pdx, Instance.sNode = sdx }
159 f4161783 Iustin Pop
      pnode' = Node.setPri pnode inst'
160 f4161783 Iustin Pop
      snode' = Node.setSec snode inst'
161 f4161783 Iustin Pop
      nl' = Container.addTwo pdx pnode' sdx snode' nl
162 f4161783 Iustin Pop
      il' = Container.add maxiidx inst' il
163 f4161783 Iustin Pop
  in (nl', il')
164 f4161783 Iustin Pop
165 3fea6959 Iustin Pop
-- * Arbitrary instances
166 3fea6959 Iustin Pop
167 525bfb36 Iustin Pop
-- | Defines a DNS name.
168 a070c426 Iustin Pop
newtype DNSChar = DNSChar { dnsGetChar::Char }
169 525bfb36 Iustin Pop
170 a070c426 Iustin Pop
instance Arbitrary DNSChar where
171 a070c426 Iustin Pop
    arbitrary = do
172 a070c426 Iustin Pop
      x <- elements (['a'..'z'] ++ ['0'..'9'] ++ "_-")
173 a070c426 Iustin Pop
      return (DNSChar x)
174 a070c426 Iustin Pop
175 a070c426 Iustin Pop
getName :: Gen String
176 a070c426 Iustin Pop
getName = do
177 a070c426 Iustin Pop
  n <- choose (1, 64)
178 a070c426 Iustin Pop
  dn <- vector n::Gen [DNSChar]
179 a070c426 Iustin Pop
  return (map dnsGetChar dn)
180 a070c426 Iustin Pop
181 a070c426 Iustin Pop
182 a070c426 Iustin Pop
getFQDN :: Gen String
183 a070c426 Iustin Pop
getFQDN = do
184 a070c426 Iustin Pop
  felem <- getName
185 a070c426 Iustin Pop
  ncomps <- choose (1, 4)
186 a070c426 Iustin Pop
  frest <- vector ncomps::Gen [[DNSChar]]
187 a070c426 Iustin Pop
  let frest' = map (map dnsGetChar) frest
188 a070c426 Iustin Pop
  return (felem ++ "." ++ intercalate "." frest')
189 a070c426 Iustin Pop
190 7dd14211 Agata Murawska
instance Arbitrary Types.InstanceStatus where
191 7dd14211 Agata Murawska
    arbitrary = elements [ Types.AdminDown
192 7dd14211 Agata Murawska
                         , Types.AdminOffline
193 7dd14211 Agata Murawska
                         , Types.ErrorDown
194 7dd14211 Agata Murawska
                         , Types.ErrorUp
195 7dd14211 Agata Murawska
                         , Types.NodeDown
196 7dd14211 Agata Murawska
                         , Types.NodeOffline
197 7dd14211 Agata Murawska
                         , Types.Running
198 7dd14211 Agata Murawska
                         , Types.WrongNode]
199 7dd14211 Agata Murawska
200 15f4c8ca Iustin Pop
-- let's generate a random instance
201 15f4c8ca Iustin Pop
instance Arbitrary Instance.Instance where
202 15f4c8ca Iustin Pop
    arbitrary = do
203 a070c426 Iustin Pop
      name <- getFQDN
204 8fcf251f Iustin Pop
      mem <- choose (0, maxMem)
205 8fcf251f Iustin Pop
      dsk <- choose (0, maxDsk)
206 7dd14211 Agata Murawska
      run_st <- arbitrary
207 15f4c8ca Iustin Pop
      pn <- arbitrary
208 15f4c8ca Iustin Pop
      sn <- arbitrary
209 8fcf251f Iustin Pop
      vcpus <- choose (0, maxCpu)
210 c352b0a9 Iustin Pop
      return $ Instance.create name mem dsk vcpus run_st [] True pn sn
211 d25643d1 Iustin Pop
                               Types.DTDrbd8
212 15f4c8ca Iustin Pop
213 525bfb36 Iustin Pop
-- | Generas an arbitrary node based on sizing information.
214 525bfb36 Iustin Pop
genNode :: Maybe Int -- ^ Minimum node size in terms of units
215 525bfb36 Iustin Pop
        -> Maybe Int -- ^ Maximum node size (when Nothing, bounded
216 525bfb36 Iustin Pop
                     -- just by the max... constants)
217 525bfb36 Iustin Pop
        -> Gen Node.Node
218 00c75986 Iustin Pop
genNode min_multiplier max_multiplier = do
219 00c75986 Iustin Pop
  let (base_mem, base_dsk, base_cpu) =
220 00c75986 Iustin Pop
          case min_multiplier of
221 00c75986 Iustin Pop
            Just mm -> (mm * Types.unitMem,
222 00c75986 Iustin Pop
                        mm * Types.unitDsk,
223 00c75986 Iustin Pop
                        mm * Types.unitCpu)
224 00c75986 Iustin Pop
            Nothing -> (0, 0, 0)
225 00c75986 Iustin Pop
      (top_mem, top_dsk, top_cpu)  =
226 00c75986 Iustin Pop
          case max_multiplier of
227 00c75986 Iustin Pop
            Just mm -> (mm * Types.unitMem,
228 00c75986 Iustin Pop
                        mm * Types.unitDsk,
229 00c75986 Iustin Pop
                        mm * Types.unitCpu)
230 00c75986 Iustin Pop
            Nothing -> (maxMem, maxDsk, maxCpu)
231 00c75986 Iustin Pop
  name  <- getFQDN
232 00c75986 Iustin Pop
  mem_t <- choose (base_mem, top_mem)
233 00c75986 Iustin Pop
  mem_f <- choose (base_mem, mem_t)
234 00c75986 Iustin Pop
  mem_n <- choose (0, mem_t - mem_f)
235 00c75986 Iustin Pop
  dsk_t <- choose (base_dsk, top_dsk)
236 00c75986 Iustin Pop
  dsk_f <- choose (base_dsk, dsk_t)
237 00c75986 Iustin Pop
  cpu_t <- choose (base_cpu, top_cpu)
238 00c75986 Iustin Pop
  offl  <- arbitrary
239 00c75986 Iustin Pop
  let n = Node.create name (fromIntegral mem_t) mem_n mem_f
240 00c75986 Iustin Pop
          (fromIntegral dsk_t) dsk_f (fromIntegral cpu_t) offl 0
241 00c75986 Iustin Pop
  return $ Node.buildPeers n Container.empty
242 00c75986 Iustin Pop
243 15f4c8ca Iustin Pop
-- and a random node
244 15f4c8ca Iustin Pop
instance Arbitrary Node.Node where
245 00c75986 Iustin Pop
    arbitrary = genNode Nothing Nothing
246 15f4c8ca Iustin Pop
247 88f25dd0 Iustin Pop
-- replace disks
248 88f25dd0 Iustin Pop
instance Arbitrary OpCodes.ReplaceDisksMode where
249 88f25dd0 Iustin Pop
  arbitrary = elements [ OpCodes.ReplaceOnPrimary
250 88f25dd0 Iustin Pop
                       , OpCodes.ReplaceOnSecondary
251 88f25dd0 Iustin Pop
                       , OpCodes.ReplaceNewSecondary
252 88f25dd0 Iustin Pop
                       , OpCodes.ReplaceAuto
253 88f25dd0 Iustin Pop
                       ]
254 88f25dd0 Iustin Pop
255 88f25dd0 Iustin Pop
instance Arbitrary OpCodes.OpCode where
256 88f25dd0 Iustin Pop
  arbitrary = do
257 88f25dd0 Iustin Pop
    op_id <- elements [ "OP_TEST_DELAY"
258 88f25dd0 Iustin Pop
                      , "OP_INSTANCE_REPLACE_DISKS"
259 88f25dd0 Iustin Pop
                      , "OP_INSTANCE_FAILOVER"
260 88f25dd0 Iustin Pop
                      , "OP_INSTANCE_MIGRATE"
261 88f25dd0 Iustin Pop
                      ]
262 88f25dd0 Iustin Pop
    (case op_id of
263 88f25dd0 Iustin Pop
        "OP_TEST_DELAY" ->
264 88f25dd0 Iustin Pop
          liftM3 OpCodes.OpTestDelay arbitrary arbitrary arbitrary
265 88f25dd0 Iustin Pop
        "OP_INSTANCE_REPLACE_DISKS" ->
266 10028866 René Nussbaumer
          liftM5 OpCodes.OpInstanceReplaceDisks arbitrary arbitrary
267 88f25dd0 Iustin Pop
          arbitrary arbitrary arbitrary
268 88f25dd0 Iustin Pop
        "OP_INSTANCE_FAILOVER" ->
269 bbe9758d Iustin Pop
          liftM3 OpCodes.OpInstanceFailover arbitrary arbitrary
270 bbe9758d Iustin Pop
                 arbitrary
271 88f25dd0 Iustin Pop
        "OP_INSTANCE_MIGRATE" ->
272 bbe9758d Iustin Pop
          liftM5 OpCodes.OpInstanceMigrate arbitrary arbitrary
273 bbe9758d Iustin Pop
                 arbitrary arbitrary
274 8d66f58a René Nussbaumer
          arbitrary
275 88f25dd0 Iustin Pop
        _ -> fail "Wrong opcode")
276 88f25dd0 Iustin Pop
277 db079755 Iustin Pop
instance Arbitrary Jobs.OpStatus where
278 db079755 Iustin Pop
  arbitrary = elements [minBound..maxBound]
279 db079755 Iustin Pop
280 db079755 Iustin Pop
instance Arbitrary Jobs.JobStatus where
281 db079755 Iustin Pop
  arbitrary = elements [minBound..maxBound]
282 db079755 Iustin Pop
283 525bfb36 Iustin Pop
newtype SmallRatio = SmallRatio Double deriving Show
284 525bfb36 Iustin Pop
instance Arbitrary SmallRatio where
285 525bfb36 Iustin Pop
    arbitrary = do
286 525bfb36 Iustin Pop
      v <- choose (0, 1)
287 525bfb36 Iustin Pop
      return $ SmallRatio v
288 525bfb36 Iustin Pop
289 3c002a13 Iustin Pop
instance Arbitrary Types.AllocPolicy where
290 3c002a13 Iustin Pop
  arbitrary = elements [minBound..maxBound]
291 3c002a13 Iustin Pop
292 3c002a13 Iustin Pop
instance Arbitrary Types.DiskTemplate where
293 3c002a13 Iustin Pop
  arbitrary = elements [minBound..maxBound]
294 3c002a13 Iustin Pop
295 0047d4e2 Iustin Pop
instance Arbitrary Types.FailMode where
296 0047d4e2 Iustin Pop
    arbitrary = elements [minBound..maxBound]
297 0047d4e2 Iustin Pop
298 0047d4e2 Iustin Pop
instance Arbitrary a => Arbitrary (Types.OpResult a) where
299 0047d4e2 Iustin Pop
    arbitrary = arbitrary >>= \c ->
300 0047d4e2 Iustin Pop
                case c of
301 0047d4e2 Iustin Pop
                  False -> liftM Types.OpFail arbitrary
302 0047d4e2 Iustin Pop
                  True -> liftM Types.OpGood arbitrary
303 0047d4e2 Iustin Pop
304 3fea6959 Iustin Pop
-- * Actual tests
305 8fcf251f Iustin Pop
306 525bfb36 Iustin Pop
-- ** Utils tests
307 525bfb36 Iustin Pop
308 525bfb36 Iustin Pop
-- | If the list is not just an empty element, and if the elements do
309 525bfb36 Iustin Pop
-- not contain commas, then join+split should be idempotent.
310 a1cd7c1e Iustin Pop
prop_Utils_commaJoinSplit =
311 a1cd7c1e Iustin Pop
    forAll (arbitrary `suchThat`
312 a1cd7c1e Iustin Pop
            (\l -> l /= [""] && all (not . elem ',') l )) $ \lst ->
313 72bb6b4e Iustin Pop
    Utils.sepSplit ',' (Utils.commaJoin lst) ==? lst
314 a1cd7c1e Iustin Pop
315 525bfb36 Iustin Pop
-- | Split and join should always be idempotent.
316 72bb6b4e Iustin Pop
prop_Utils_commaSplitJoin s =
317 72bb6b4e Iustin Pop
    Utils.commaJoin (Utils.sepSplit ',' s) ==? s
318 691dcd2a Iustin Pop
319 a810ad21 Iustin Pop
-- | fromObjWithDefault, we test using the Maybe monad and an integer
320 525bfb36 Iustin Pop
-- value.
321 a810ad21 Iustin Pop
prop_Utils_fromObjWithDefault def_value random_key =
322 a810ad21 Iustin Pop
    -- a missing key will be returned with the default
323 a810ad21 Iustin Pop
    Utils.fromObjWithDefault [] random_key def_value == Just def_value &&
324 a810ad21 Iustin Pop
    -- a found key will be returned as is, not with default
325 a810ad21 Iustin Pop
    Utils.fromObjWithDefault [(random_key, J.showJSON def_value)]
326 a810ad21 Iustin Pop
         random_key (def_value+1) == Just def_value
327 cc532bdd Iustin Pop
        where _types = def_value :: Integer
328 a810ad21 Iustin Pop
329 bfe6c954 Guido Trotter
-- | Test that functional if' behaves like the syntactic sugar if.
330 72bb6b4e Iustin Pop
prop_Utils_if'if :: Bool -> Int -> Int -> Gen Prop
331 72bb6b4e Iustin Pop
prop_Utils_if'if cnd a b =
332 72bb6b4e Iustin Pop
    Utils.if' cnd a b ==? if cnd then a else b
333 bfe6c954 Guido Trotter
334 22fac87d Guido Trotter
-- | Test basic select functionality
335 72bb6b4e Iustin Pop
prop_Utils_select :: Int      -- ^ Default result
336 72bb6b4e Iustin Pop
                  -> [Int]    -- ^ List of False values
337 72bb6b4e Iustin Pop
                  -> [Int]    -- ^ List of True values
338 72bb6b4e Iustin Pop
                  -> Gen Prop -- ^ Test result
339 22fac87d Guido Trotter
prop_Utils_select def lst1 lst2 =
340 72bb6b4e Iustin Pop
  Utils.select def cndlist ==? expectedresult
341 22fac87d Guido Trotter
  where expectedresult = Utils.if' (null lst2) def (head lst2)
342 bfe6c954 Guido Trotter
        flist = map (\e -> (False, e)) lst1
343 bfe6c954 Guido Trotter
        tlist = map (\e -> (True, e)) lst2
344 22fac87d Guido Trotter
        cndlist = flist ++ tlist
345 22fac87d Guido Trotter
346 22fac87d Guido Trotter
-- | Test basic select functionality with undefined default
347 72bb6b4e Iustin Pop
prop_Utils_select_undefd :: [Int]            -- ^ List of False values
348 22fac87d Guido Trotter
                         -> NonEmptyList Int -- ^ List of True values
349 72bb6b4e Iustin Pop
                         -> Gen Prop         -- ^ Test result
350 22fac87d Guido Trotter
prop_Utils_select_undefd lst1 (NonEmpty lst2) =
351 72bb6b4e Iustin Pop
  Utils.select undefined cndlist ==? head lst2
352 22fac87d Guido Trotter
  where flist = map (\e -> (False, e)) lst1
353 22fac87d Guido Trotter
        tlist = map (\e -> (True, e)) lst2
354 22fac87d Guido Trotter
        cndlist = flist ++ tlist
355 22fac87d Guido Trotter
356 22fac87d Guido Trotter
-- | Test basic select functionality with undefined list values
357 72bb6b4e Iustin Pop
prop_Utils_select_undefv :: [Int]            -- ^ List of False values
358 22fac87d Guido Trotter
                         -> NonEmptyList Int -- ^ List of True values
359 72bb6b4e Iustin Pop
                         -> Gen Prop         -- ^ Test result
360 22fac87d Guido Trotter
prop_Utils_select_undefv lst1 (NonEmpty lst2) =
361 72bb6b4e Iustin Pop
  Utils.select undefined cndlist ==? head lst2
362 22fac87d Guido Trotter
  where flist = map (\e -> (False, e)) lst1
363 22fac87d Guido Trotter
        tlist = map (\e -> (True, e)) lst2
364 22fac87d Guido Trotter
        cndlist = flist ++ tlist ++ [undefined]
365 bfe6c954 Guido Trotter
366 1cb92fac Iustin Pop
prop_Utils_parseUnit (NonNegative n) =
367 1cb92fac Iustin Pop
    Utils.parseUnit (show n) == Types.Ok n &&
368 1cb92fac Iustin Pop
    Utils.parseUnit (show n ++ "m") == Types.Ok n &&
369 1cb92fac Iustin Pop
    (case Utils.parseUnit (show n ++ "M") of
370 1cb92fac Iustin Pop
      Types.Ok m -> if n > 0
371 1cb92fac Iustin Pop
                    then m < n  -- for positive values, X MB is less than X MiB
372 1cb92fac Iustin Pop
                    else m == 0 -- but for 0, 0 MB == 0 MiB
373 1cb92fac Iustin Pop
      Types.Bad _ -> False) &&
374 1cb92fac Iustin Pop
    Utils.parseUnit (show n ++ "g") == Types.Ok (n*1024) &&
375 1cb92fac Iustin Pop
    Utils.parseUnit (show n ++ "t") == Types.Ok (n*1048576) &&
376 1cb92fac Iustin Pop
    Types.isBad (Utils.parseUnit (show n ++ "x")::Types.Result Int)
377 1b0a6356 Iustin Pop
    where _types = n::Int
378 1cb92fac Iustin Pop
379 525bfb36 Iustin Pop
-- | Test list for the Utils module.
380 23fe06c2 Iustin Pop
testSuite "Utils"
381 23fe06c2 Iustin Pop
              [ 'prop_Utils_commaJoinSplit
382 23fe06c2 Iustin Pop
              , 'prop_Utils_commaSplitJoin
383 23fe06c2 Iustin Pop
              , 'prop_Utils_fromObjWithDefault
384 23fe06c2 Iustin Pop
              , 'prop_Utils_if'if
385 23fe06c2 Iustin Pop
              , 'prop_Utils_select
386 23fe06c2 Iustin Pop
              , 'prop_Utils_select_undefd
387 23fe06c2 Iustin Pop
              , 'prop_Utils_select_undefv
388 23fe06c2 Iustin Pop
              , 'prop_Utils_parseUnit
389 23fe06c2 Iustin Pop
              ]
390 691dcd2a Iustin Pop
391 525bfb36 Iustin Pop
-- ** PeerMap tests
392 525bfb36 Iustin Pop
393 525bfb36 Iustin Pop
-- | Make sure add is idempotent.
394 fbb95f28 Iustin Pop
prop_PeerMap_addIdempotent pmap key em =
395 72bb6b4e Iustin Pop
    fn puniq ==? fn (fn puniq)
396 7bc82927 Iustin Pop
    where _types = (pmap::PeerMap.PeerMap,
397 fbb95f28 Iustin Pop
                    key::PeerMap.Key, em::PeerMap.Elem)
398 fbb95f28 Iustin Pop
          fn = PeerMap.add key em
399 7bc82927 Iustin Pop
          puniq = PeerMap.accumArray const pmap
400 15f4c8ca Iustin Pop
401 525bfb36 Iustin Pop
-- | Make sure remove is idempotent.
402 15f4c8ca Iustin Pop
prop_PeerMap_removeIdempotent pmap key =
403 72bb6b4e Iustin Pop
    fn puniq ==? fn (fn puniq)
404 7bc82927 Iustin Pop
    where _types = (pmap::PeerMap.PeerMap, key::PeerMap.Key)
405 7bc82927 Iustin Pop
          fn = PeerMap.remove key
406 15f4c8ca Iustin Pop
          puniq = PeerMap.accumArray const pmap
407 15f4c8ca Iustin Pop
408 525bfb36 Iustin Pop
-- | Make sure a missing item returns 0.
409 15f4c8ca Iustin Pop
prop_PeerMap_findMissing pmap key =
410 72bb6b4e Iustin Pop
    PeerMap.find key (PeerMap.remove key puniq) ==? 0
411 7bc82927 Iustin Pop
    where _types = (pmap::PeerMap.PeerMap, key::PeerMap.Key)
412 15f4c8ca Iustin Pop
          puniq = PeerMap.accumArray const pmap
413 15f4c8ca Iustin Pop
414 525bfb36 Iustin Pop
-- | Make sure an added item is found.
415 fbb95f28 Iustin Pop
prop_PeerMap_addFind pmap key em =
416 72bb6b4e Iustin Pop
    PeerMap.find key (PeerMap.add key em puniq) ==? em
417 7bc82927 Iustin Pop
    where _types = (pmap::PeerMap.PeerMap,
418 fbb95f28 Iustin Pop
                    key::PeerMap.Key, em::PeerMap.Elem)
419 7bc82927 Iustin Pop
          puniq = PeerMap.accumArray const pmap
420 15f4c8ca Iustin Pop
421 525bfb36 Iustin Pop
-- | Manual check that maxElem returns the maximum indeed, or 0 for null.
422 15f4c8ca Iustin Pop
prop_PeerMap_maxElem pmap =
423 72bb6b4e Iustin Pop
    PeerMap.maxElem puniq ==? if null puniq then 0
424 72bb6b4e Iustin Pop
                              else (maximum . snd . unzip) puniq
425 7bc82927 Iustin Pop
    where _types = pmap::PeerMap.PeerMap
426 15f4c8ca Iustin Pop
          puniq = PeerMap.accumArray const pmap
427 15f4c8ca Iustin Pop
428 525bfb36 Iustin Pop
-- | List of tests for the PeerMap module.
429 23fe06c2 Iustin Pop
testSuite "PeerMap"
430 23fe06c2 Iustin Pop
              [ 'prop_PeerMap_addIdempotent
431 23fe06c2 Iustin Pop
              , 'prop_PeerMap_removeIdempotent
432 23fe06c2 Iustin Pop
              , 'prop_PeerMap_maxElem
433 23fe06c2 Iustin Pop
              , 'prop_PeerMap_addFind
434 23fe06c2 Iustin Pop
              , 'prop_PeerMap_findMissing
435 23fe06c2 Iustin Pop
              ]
436 7dd5ee6c Iustin Pop
437 525bfb36 Iustin Pop
-- ** Container tests
438 095d7ac0 Iustin Pop
439 095d7ac0 Iustin Pop
prop_Container_addTwo cdata i1 i2 =
440 095d7ac0 Iustin Pop
    fn i1 i2 cont == fn i2 i1 cont &&
441 095d7ac0 Iustin Pop
       fn i1 i2 cont == fn i1 i2 (fn i1 i2 cont)
442 095d7ac0 Iustin Pop
    where _types = (cdata::[Int],
443 095d7ac0 Iustin Pop
                    i1::Int, i2::Int)
444 095d7ac0 Iustin Pop
          cont = foldl (\c x -> Container.add x x c) Container.empty cdata
445 095d7ac0 Iustin Pop
          fn x1 x2 = Container.addTwo x1 x1 x2 x2
446 095d7ac0 Iustin Pop
447 5ef78537 Iustin Pop
prop_Container_nameOf node =
448 5ef78537 Iustin Pop
  let nl = makeSmallCluster node 1
449 5ef78537 Iustin Pop
      fnode = head (Container.elems nl)
450 72bb6b4e Iustin Pop
  in Container.nameOf nl (Node.idx fnode) ==? Node.name fnode
451 5ef78537 Iustin Pop
452 525bfb36 Iustin Pop
-- | We test that in a cluster, given a random node, we can find it by
453 5ef78537 Iustin Pop
-- its name and alias, as long as all names and aliases are unique,
454 525bfb36 Iustin Pop
-- and that we fail to find a non-existing name.
455 5ef78537 Iustin Pop
prop_Container_findByName node othername =
456 5ef78537 Iustin Pop
  forAll (choose (1, 20)) $ \ cnt ->
457 5ef78537 Iustin Pop
  forAll (choose (0, cnt - 1)) $ \ fidx ->
458 5ef78537 Iustin Pop
  forAll (vector cnt) $ \ names ->
459 5ef78537 Iustin Pop
  (length . nub) (map fst names ++ map snd names) ==
460 5ef78537 Iustin Pop
  length names * 2 &&
461 5ef78537 Iustin Pop
  not (othername `elem` (map fst names ++ map snd names)) ==>
462 5ef78537 Iustin Pop
  let nl = makeSmallCluster node cnt
463 5ef78537 Iustin Pop
      nodes = Container.elems nl
464 5ef78537 Iustin Pop
      nodes' = map (\((name, alias), nn) -> (Node.idx nn,
465 5ef78537 Iustin Pop
                                             nn { Node.name = name,
466 5ef78537 Iustin Pop
                                                  Node.alias = alias }))
467 5ef78537 Iustin Pop
               $ zip names nodes
468 cb0c77ff Iustin Pop
      nl' = Container.fromList nodes'
469 5ef78537 Iustin Pop
      target = snd (nodes' !! fidx)
470 5ef78537 Iustin Pop
  in Container.findByName nl' (Node.name target) == Just target &&
471 5ef78537 Iustin Pop
     Container.findByName nl' (Node.alias target) == Just target &&
472 5ef78537 Iustin Pop
     Container.findByName nl' othername == Nothing
473 5ef78537 Iustin Pop
474 23fe06c2 Iustin Pop
testSuite "Container"
475 23fe06c2 Iustin Pop
              [ 'prop_Container_addTwo
476 23fe06c2 Iustin Pop
              , 'prop_Container_nameOf
477 23fe06c2 Iustin Pop
              , 'prop_Container_findByName
478 23fe06c2 Iustin Pop
              ]
479 095d7ac0 Iustin Pop
480 525bfb36 Iustin Pop
-- ** Instance tests
481 525bfb36 Iustin Pop
482 7bc82927 Iustin Pop
-- Simple instance tests, we only have setter/getters
483 7bc82927 Iustin Pop
484 39d11971 Iustin Pop
prop_Instance_creat inst =
485 72bb6b4e Iustin Pop
    Instance.name inst ==? Instance.alias inst
486 39d11971 Iustin Pop
487 7bc82927 Iustin Pop
prop_Instance_setIdx inst idx =
488 72bb6b4e Iustin Pop
    Instance.idx (Instance.setIdx inst idx) ==? idx
489 7bc82927 Iustin Pop
    where _types = (inst::Instance.Instance, idx::Types.Idx)
490 7bc82927 Iustin Pop
491 7bc82927 Iustin Pop
prop_Instance_setName inst name =
492 39d11971 Iustin Pop
    Instance.name newinst == name &&
493 39d11971 Iustin Pop
    Instance.alias newinst == name
494 39d11971 Iustin Pop
    where _types = (inst::Instance.Instance, name::String)
495 39d11971 Iustin Pop
          newinst = Instance.setName inst name
496 39d11971 Iustin Pop
497 39d11971 Iustin Pop
prop_Instance_setAlias inst name =
498 39d11971 Iustin Pop
    Instance.name newinst == Instance.name inst &&
499 39d11971 Iustin Pop
    Instance.alias newinst == name
500 7bc82927 Iustin Pop
    where _types = (inst::Instance.Instance, name::String)
501 39d11971 Iustin Pop
          newinst = Instance.setAlias inst name
502 7bc82927 Iustin Pop
503 7bc82927 Iustin Pop
prop_Instance_setPri inst pdx =
504 72bb6b4e Iustin Pop
    Instance.pNode (Instance.setPri inst pdx) ==? pdx
505 7bc82927 Iustin Pop
    where _types = (inst::Instance.Instance, pdx::Types.Ndx)
506 7bc82927 Iustin Pop
507 7bc82927 Iustin Pop
prop_Instance_setSec inst sdx =
508 72bb6b4e Iustin Pop
    Instance.sNode (Instance.setSec inst sdx) ==? sdx
509 7bc82927 Iustin Pop
    where _types = (inst::Instance.Instance, sdx::Types.Ndx)
510 7bc82927 Iustin Pop
511 7bc82927 Iustin Pop
prop_Instance_setBoth inst pdx sdx =
512 2060348b Iustin Pop
    Instance.pNode si == pdx && Instance.sNode si == sdx
513 7bc82927 Iustin Pop
    where _types = (inst::Instance.Instance, pdx::Types.Ndx, sdx::Types.Ndx)
514 7bc82927 Iustin Pop
          si = Instance.setBoth inst pdx sdx
515 7bc82927 Iustin Pop
516 8fcf251f Iustin Pop
prop_Instance_shrinkMG inst =
517 8fcf251f Iustin Pop
    Instance.mem inst >= 2 * Types.unitMem ==>
518 8fcf251f Iustin Pop
        case Instance.shrinkByType inst Types.FailMem of
519 8fcf251f Iustin Pop
          Types.Ok inst' ->
520 8fcf251f Iustin Pop
              Instance.mem inst' == Instance.mem inst - Types.unitMem
521 8fcf251f Iustin Pop
          _ -> False
522 8fcf251f Iustin Pop
523 8fcf251f Iustin Pop
prop_Instance_shrinkMF inst =
524 41085bd3 Iustin Pop
    forAll (choose (0, 2 * Types.unitMem - 1)) $ \mem ->
525 41085bd3 Iustin Pop
    let inst' = inst { Instance.mem = mem}
526 41085bd3 Iustin Pop
    in Types.isBad $ Instance.shrinkByType inst' Types.FailMem
527 8fcf251f Iustin Pop
528 8fcf251f Iustin Pop
prop_Instance_shrinkCG inst =
529 8fcf251f Iustin Pop
    Instance.vcpus inst >= 2 * Types.unitCpu ==>
530 8fcf251f Iustin Pop
        case Instance.shrinkByType inst Types.FailCPU of
531 8fcf251f Iustin Pop
          Types.Ok inst' ->
532 8fcf251f Iustin Pop
              Instance.vcpus inst' == Instance.vcpus inst - Types.unitCpu
533 8fcf251f Iustin Pop
          _ -> False
534 8fcf251f Iustin Pop
535 8fcf251f Iustin Pop
prop_Instance_shrinkCF inst =
536 41085bd3 Iustin Pop
    forAll (choose (0, 2 * Types.unitCpu - 1)) $ \vcpus ->
537 41085bd3 Iustin Pop
    let inst' = inst { Instance.vcpus = vcpus }
538 41085bd3 Iustin Pop
    in Types.isBad $ Instance.shrinkByType inst' Types.FailCPU
539 8fcf251f Iustin Pop
540 8fcf251f Iustin Pop
prop_Instance_shrinkDG inst =
541 8fcf251f Iustin Pop
    Instance.dsk inst >= 2 * Types.unitDsk ==>
542 8fcf251f Iustin Pop
        case Instance.shrinkByType inst Types.FailDisk of
543 8fcf251f Iustin Pop
          Types.Ok inst' ->
544 8fcf251f Iustin Pop
              Instance.dsk inst' == Instance.dsk inst - Types.unitDsk
545 8fcf251f Iustin Pop
          _ -> False
546 8fcf251f Iustin Pop
547 8fcf251f Iustin Pop
prop_Instance_shrinkDF inst =
548 41085bd3 Iustin Pop
    forAll (choose (0, 2 * Types.unitDsk - 1)) $ \dsk ->
549 41085bd3 Iustin Pop
    let inst' = inst { Instance.dsk = dsk }
550 41085bd3 Iustin Pop
    in Types.isBad $ Instance.shrinkByType inst' Types.FailDisk
551 8fcf251f Iustin Pop
552 8fcf251f Iustin Pop
prop_Instance_setMovable inst m =
553 72bb6b4e Iustin Pop
    Instance.movable inst' ==? m
554 4a007641 Iustin Pop
    where inst' = Instance.setMovable inst m
555 8fcf251f Iustin Pop
556 23fe06c2 Iustin Pop
testSuite "Instance"
557 23fe06c2 Iustin Pop
              [ 'prop_Instance_creat
558 23fe06c2 Iustin Pop
              , 'prop_Instance_setIdx
559 23fe06c2 Iustin Pop
              , 'prop_Instance_setName
560 23fe06c2 Iustin Pop
              , 'prop_Instance_setAlias
561 23fe06c2 Iustin Pop
              , 'prop_Instance_setPri
562 23fe06c2 Iustin Pop
              , 'prop_Instance_setSec
563 23fe06c2 Iustin Pop
              , 'prop_Instance_setBoth
564 23fe06c2 Iustin Pop
              , 'prop_Instance_shrinkMG
565 23fe06c2 Iustin Pop
              , 'prop_Instance_shrinkMF
566 23fe06c2 Iustin Pop
              , 'prop_Instance_shrinkCG
567 23fe06c2 Iustin Pop
              , 'prop_Instance_shrinkCF
568 23fe06c2 Iustin Pop
              , 'prop_Instance_shrinkDG
569 23fe06c2 Iustin Pop
              , 'prop_Instance_shrinkDF
570 23fe06c2 Iustin Pop
              , 'prop_Instance_setMovable
571 23fe06c2 Iustin Pop
              ]
572 1ae7a904 Iustin Pop
573 525bfb36 Iustin Pop
-- ** Text backend tests
574 525bfb36 Iustin Pop
575 1ae7a904 Iustin Pop
-- Instance text loader tests
576 1ae7a904 Iustin Pop
577 a1cd7c1e Iustin Pop
prop_Text_Load_Instance name mem dsk vcpus status
578 a1cd7c1e Iustin Pop
                        (NonEmpty pnode) snode
579 6429e8d8 Iustin Pop
                        (NonNegative pdx) (NonNegative sdx) autobal dt =
580 309e7c9a Iustin Pop
    pnode /= snode && pdx /= sdx ==>
581 1ae7a904 Iustin Pop
    let vcpus_s = show vcpus
582 1ae7a904 Iustin Pop
        dsk_s = show dsk
583 1ae7a904 Iustin Pop
        mem_s = show mem
584 7dd14211 Agata Murawska
        status_s = Types.instanceStatusToRaw status
585 39d11971 Iustin Pop
        ndx = if null snode
586 39d11971 Iustin Pop
              then [(pnode, pdx)]
587 309e7c9a Iustin Pop
              else [(pnode, pdx), (snode, sdx)]
588 99b63608 Iustin Pop
        nl = Data.Map.fromList ndx
589 434c15d5 Iustin Pop
        tags = ""
590 bc782180 Iustin Pop
        sbal = if autobal then "Y" else "N"
591 5f828ce4 Agata Murawska
        sdt = Types.diskTemplateToRaw dt
592 99b63608 Iustin Pop
        inst = Text.loadInst nl
593 7dd14211 Agata Murawska
               [name, mem_s, dsk_s, vcpus_s, status_s,
594 6429e8d8 Iustin Pop
                sbal, pnode, snode, sdt, tags]
595 99b63608 Iustin Pop
        fail1 = Text.loadInst nl
596 7dd14211 Agata Murawska
               [name, mem_s, dsk_s, vcpus_s, status_s,
597 6429e8d8 Iustin Pop
                sbal, pnode, pnode, tags]
598 1ae7a904 Iustin Pop
        _types = ( name::String, mem::Int, dsk::Int
599 7dd14211 Agata Murawska
                 , vcpus::Int, status::Types.InstanceStatus
600 a1cd7c1e Iustin Pop
                 , snode::String
601 bc782180 Iustin Pop
                 , autobal::Bool)
602 1ae7a904 Iustin Pop
    in
603 1ae7a904 Iustin Pop
      case inst of
604 6429e8d8 Iustin Pop
        Types.Bad msg -> printTestCase ("Failed to load instance: " ++ msg)
605 6429e8d8 Iustin Pop
                         False
606 1b0a6356 Iustin Pop
        Types.Ok (_, i) -> printTestCase "Mismatch in some field while\
607 1b0a6356 Iustin Pop
                                         \ loading the instance" $
608 cc532bdd Iustin Pop
            Instance.name i == name &&
609 cc532bdd Iustin Pop
            Instance.vcpus i == vcpus &&
610 cc532bdd Iustin Pop
            Instance.mem i == mem &&
611 cc532bdd Iustin Pop
            Instance.pNode i == pdx &&
612 cc532bdd Iustin Pop
            Instance.sNode i == (if null snode
613 cc532bdd Iustin Pop
                                 then Node.noSecondary
614 309e7c9a Iustin Pop
                                 else sdx) &&
615 0e09422b Iustin Pop
            Instance.autoBalance i == autobal &&
616 6429e8d8 Iustin Pop
            Types.isBad fail1
617 39d11971 Iustin Pop
618 39d11971 Iustin Pop
prop_Text_Load_InstanceFail ktn fields =
619 6429e8d8 Iustin Pop
    length fields /= 10 ==>
620 bc782180 Iustin Pop
    case Text.loadInst nl fields of
621 6429e8d8 Iustin Pop
      Types.Ok _ -> printTestCase "Managed to load instance from invalid\
622 6429e8d8 Iustin Pop
                                  \ data" False
623 6429e8d8 Iustin Pop
      Types.Bad msg -> printTestCase ("Unrecognised error message: " ++ msg) $
624 6429e8d8 Iustin Pop
                       "Invalid/incomplete instance data: '" `isPrefixOf` msg
625 99b63608 Iustin Pop
    where nl = Data.Map.fromList ktn
626 39d11971 Iustin Pop
627 39d11971 Iustin Pop
prop_Text_Load_Node name tm nm fm td fd tc fo =
628 39d11971 Iustin Pop
    let conv v = if v < 0
629 39d11971 Iustin Pop
                    then "?"
630 39d11971 Iustin Pop
                    else show v
631 39d11971 Iustin Pop
        tm_s = conv tm
632 39d11971 Iustin Pop
        nm_s = conv nm
633 39d11971 Iustin Pop
        fm_s = conv fm
634 39d11971 Iustin Pop
        td_s = conv td
635 39d11971 Iustin Pop
        fd_s = conv fd
636 39d11971 Iustin Pop
        tc_s = conv tc
637 39d11971 Iustin Pop
        fo_s = if fo
638 39d11971 Iustin Pop
               then "Y"
639 39d11971 Iustin Pop
               else "N"
640 39d11971 Iustin Pop
        any_broken = any (< 0) [tm, nm, fm, td, fd, tc]
641 10ef6b4e Iustin Pop
        gid = Group.uuid defGroup
642 10ef6b4e Iustin Pop
    in case Text.loadNode defGroupAssoc
643 10ef6b4e Iustin Pop
           [name, tm_s, nm_s, fm_s, td_s, fd_s, tc_s, fo_s, gid] of
644 39d11971 Iustin Pop
         Nothing -> False
645 39d11971 Iustin Pop
         Just (name', node) ->
646 39d11971 Iustin Pop
             if fo || any_broken
647 39d11971 Iustin Pop
             then Node.offline node
648 4a007641 Iustin Pop
             else Node.name node == name' && name' == name &&
649 4a007641 Iustin Pop
                  Node.alias node == name &&
650 4a007641 Iustin Pop
                  Node.tMem node == fromIntegral tm &&
651 4a007641 Iustin Pop
                  Node.nMem node == nm &&
652 4a007641 Iustin Pop
                  Node.fMem node == fm &&
653 4a007641 Iustin Pop
                  Node.tDsk node == fromIntegral td &&
654 4a007641 Iustin Pop
                  Node.fDsk node == fd &&
655 4a007641 Iustin Pop
                  Node.tCpu node == fromIntegral tc
656 39d11971 Iustin Pop
657 39d11971 Iustin Pop
prop_Text_Load_NodeFail fields =
658 10ef6b4e Iustin Pop
    length fields /= 8 ==> isNothing $ Text.loadNode Data.Map.empty fields
659 1ae7a904 Iustin Pop
660 50811e2c Iustin Pop
prop_Text_NodeLSIdempotent node =
661 10ef6b4e Iustin Pop
    (Text.loadNode defGroupAssoc.
662 10ef6b4e Iustin Pop
         Utils.sepSplit '|' . Text.serializeNode defGroupList) n ==
663 50811e2c Iustin Pop
    Just (Node.name n, n)
664 50811e2c Iustin Pop
    -- override failN1 to what loadNode returns by default
665 50811e2c Iustin Pop
    where n = node { Node.failN1 = True, Node.offline = False }
666 50811e2c Iustin Pop
667 23fe06c2 Iustin Pop
testSuite "Text"
668 23fe06c2 Iustin Pop
              [ 'prop_Text_Load_Instance
669 23fe06c2 Iustin Pop
              , 'prop_Text_Load_InstanceFail
670 23fe06c2 Iustin Pop
              , 'prop_Text_Load_Node
671 23fe06c2 Iustin Pop
              , 'prop_Text_Load_NodeFail
672 23fe06c2 Iustin Pop
              , 'prop_Text_NodeLSIdempotent
673 23fe06c2 Iustin Pop
              ]
674 7dd5ee6c Iustin Pop
675 525bfb36 Iustin Pop
-- ** Node tests
676 7dd5ee6c Iustin Pop
677 82ea2874 Iustin Pop
prop_Node_setAlias node name =
678 82ea2874 Iustin Pop
    Node.name newnode == Node.name node &&
679 82ea2874 Iustin Pop
    Node.alias newnode == name
680 82ea2874 Iustin Pop
    where _types = (node::Node.Node, name::String)
681 82ea2874 Iustin Pop
          newnode = Node.setAlias node name
682 82ea2874 Iustin Pop
683 82ea2874 Iustin Pop
prop_Node_setOffline node status =
684 72bb6b4e Iustin Pop
    Node.offline newnode ==? status
685 82ea2874 Iustin Pop
    where newnode = Node.setOffline node status
686 82ea2874 Iustin Pop
687 82ea2874 Iustin Pop
prop_Node_setXmem node xm =
688 72bb6b4e Iustin Pop
    Node.xMem newnode ==? xm
689 82ea2874 Iustin Pop
    where newnode = Node.setXmem node xm
690 82ea2874 Iustin Pop
691 82ea2874 Iustin Pop
prop_Node_setMcpu node mc =
692 72bb6b4e Iustin Pop
    Node.mCpu newnode ==? mc
693 82ea2874 Iustin Pop
    where newnode = Node.setMcpu node mc
694 82ea2874 Iustin Pop
695 525bfb36 Iustin Pop
-- | Check that an instance add with too high memory or disk will be
696 525bfb36 Iustin Pop
-- rejected.
697 8fcf251f Iustin Pop
prop_Node_addPriFM node inst = Instance.mem inst >= Node.fMem node &&
698 61bbbed7 Agata Murawska
                               not (Node.failN1 node) &&
699 61bbbed7 Agata Murawska
                               not (Instance.instanceOffline inst)
700 8fcf251f Iustin Pop
                               ==>
701 8fcf251f Iustin Pop
                               case Node.addPri node inst'' of
702 8fcf251f Iustin Pop
                                 Types.OpFail Types.FailMem -> True
703 8fcf251f Iustin Pop
                                 _ -> False
704 15f4c8ca Iustin Pop
    where _types = (node::Node.Node, inst::Instance.Instance)
705 8fcf251f Iustin Pop
          inst' = setInstanceSmallerThanNode node inst
706 8fcf251f Iustin Pop
          inst'' = inst' { Instance.mem = Instance.mem inst }
707 8fcf251f Iustin Pop
708 8fcf251f Iustin Pop
prop_Node_addPriFD node inst = Instance.dsk inst >= Node.fDsk node &&
709 8fcf251f Iustin Pop
                               not (Node.failN1 node)
710 8fcf251f Iustin Pop
                               ==>
711 8fcf251f Iustin Pop
                               case Node.addPri node inst'' of
712 8fcf251f Iustin Pop
                                 Types.OpFail Types.FailDisk -> True
713 8fcf251f Iustin Pop
                                 _ -> False
714 8fcf251f Iustin Pop
    where _types = (node::Node.Node, inst::Instance.Instance)
715 8fcf251f Iustin Pop
          inst' = setInstanceSmallerThanNode node inst
716 8fcf251f Iustin Pop
          inst'' = inst' { Instance.dsk = Instance.dsk inst }
717 8fcf251f Iustin Pop
718 41085bd3 Iustin Pop
prop_Node_addPriFC node inst (Positive extra) =
719 61bbbed7 Agata Murawska
    not (Node.failN1 node) &&
720 61bbbed7 Agata Murawska
    not (Instance.instanceOffline inst) ==>
721 41085bd3 Iustin Pop
        case Node.addPri node inst'' of
722 41085bd3 Iustin Pop
          Types.OpFail Types.FailCPU -> True
723 41085bd3 Iustin Pop
          _ -> False
724 8fcf251f Iustin Pop
    where _types = (node::Node.Node, inst::Instance.Instance)
725 8fcf251f Iustin Pop
          inst' = setInstanceSmallerThanNode node inst
726 41085bd3 Iustin Pop
          inst'' = inst' { Instance.vcpus = Node.availCpu node + extra }
727 7bc82927 Iustin Pop
728 525bfb36 Iustin Pop
-- | Check that an instance add with too high memory or disk will be
729 525bfb36 Iustin Pop
-- rejected.
730 15f4c8ca Iustin Pop
prop_Node_addSec node inst pdx =
731 61bbbed7 Agata Murawska
    ((Instance.mem inst >= (Node.fMem node - Node.rMem node) &&
732 61bbbed7 Agata Murawska
      not (Instance.instanceOffline inst)) ||
733 2060348b Iustin Pop
     Instance.dsk inst >= Node.fDsk node) &&
734 9f6dcdea Iustin Pop
    not (Node.failN1 node)
735 79a72ce7 Iustin Pop
    ==> isFailure (Node.addSec node inst pdx)
736 15f4c8ca Iustin Pop
        where _types = (node::Node.Node, inst::Instance.Instance, pdx::Int)
737 7dd5ee6c Iustin Pop
738 61bbbed7 Agata Murawska
-- | Check that an offline instance with reasonable disk size can always
739 61bbbed7 Agata Murawska
-- be added.
740 61bbbed7 Agata Murawska
prop_Node_addPriOffline node =
741 61bbbed7 Agata Murawska
    forAll (arbitrary `suchThat`
742 61bbbed7 Agata Murawska
            (\ x ->  (Instance.dsk x  < Node.fDsk node) &&
743 61bbbed7 Agata Murawska
                      Instance.instanceOffline x)) $ \inst ->
744 61bbbed7 Agata Murawska
    case Node.addPri node inst of
745 61bbbed7 Agata Murawska
      Types.OpGood _ -> True
746 61bbbed7 Agata Murawska
      _ -> False
747 61bbbed7 Agata Murawska
748 61bbbed7 Agata Murawska
prop_Node_addSecOffline node pdx =
749 61bbbed7 Agata Murawska
    forAll (arbitrary `suchThat`
750 61bbbed7 Agata Murawska
            (\ x ->  (Instance.dsk x  < Node.fDsk node) &&
751 61bbbed7 Agata Murawska
                      Instance.instanceOffline x)) $ \inst ->
752 61bbbed7 Agata Murawska
    case Node.addSec node inst pdx of
753 61bbbed7 Agata Murawska
      Types.OpGood _ -> True
754 61bbbed7 Agata Murawska
      _ -> False
755 61bbbed7 Agata Murawska
756 525bfb36 Iustin Pop
-- | Checks for memory reservation changes.
757 752635d3 Iustin Pop
prop_Node_rMem inst =
758 61bbbed7 Agata Murawska
    not (Instance.instanceOffline inst) ==>
759 3158250d Iustin Pop
    forAll (arbitrary `suchThat` ((> Types.unitMem) . Node.fMem)) $ \node ->
760 9cbc1edb Iustin Pop
    -- ab = auto_balance, nb = non-auto_balance
761 9cbc1edb Iustin Pop
    -- we use -1 as the primary node of the instance
762 0e09422b Iustin Pop
    let inst' = inst { Instance.pNode = -1, Instance.autoBalance = True }
763 9cbc1edb Iustin Pop
        inst_ab = setInstanceSmallerThanNode node inst'
764 0e09422b Iustin Pop
        inst_nb = inst_ab { Instance.autoBalance = False }
765 9cbc1edb Iustin Pop
        -- now we have the two instances, identical except the
766 0e09422b Iustin Pop
        -- autoBalance attribute
767 9cbc1edb Iustin Pop
        orig_rmem = Node.rMem node
768 9cbc1edb Iustin Pop
        inst_idx = Instance.idx inst_ab
769 9cbc1edb Iustin Pop
        node_add_ab = Node.addSec node inst_ab (-1)
770 9cbc1edb Iustin Pop
        node_add_nb = Node.addSec node inst_nb (-1)
771 1b0a6356 Iustin Pop
        node_del_ab = liftM (`Node.removeSec` inst_ab) node_add_ab
772 1b0a6356 Iustin Pop
        node_del_nb = liftM (`Node.removeSec` inst_nb) node_add_nb
773 9cbc1edb Iustin Pop
    in case (node_add_ab, node_add_nb, node_del_ab, node_del_nb) of
774 9cbc1edb Iustin Pop
         (Types.OpGood a_ab, Types.OpGood a_nb,
775 9cbc1edb Iustin Pop
          Types.OpGood d_ab, Types.OpGood d_nb) ->
776 752635d3 Iustin Pop
             printTestCase "Consistency checks failed" $
777 9cbc1edb Iustin Pop
             Node.rMem a_ab >  orig_rmem &&
778 9cbc1edb Iustin Pop
             Node.rMem a_ab - orig_rmem == Instance.mem inst_ab &&
779 9cbc1edb Iustin Pop
             Node.rMem a_nb == orig_rmem &&
780 9cbc1edb Iustin Pop
             Node.rMem d_ab == orig_rmem &&
781 9cbc1edb Iustin Pop
             Node.rMem d_nb == orig_rmem &&
782 9cbc1edb Iustin Pop
             -- this is not related to rMem, but as good a place to
783 9cbc1edb Iustin Pop
             -- test as any
784 9cbc1edb Iustin Pop
             inst_idx `elem` Node.sList a_ab &&
785 9cbc1edb Iustin Pop
             not (inst_idx `elem` Node.sList d_ab)
786 752635d3 Iustin Pop
         x -> printTestCase ("Failed to add/remove instances: " ++ show x)
787 752635d3 Iustin Pop
              False
788 9cbc1edb Iustin Pop
789 525bfb36 Iustin Pop
-- | Check mdsk setting.
790 8fcf251f Iustin Pop
prop_Node_setMdsk node mx =
791 8fcf251f Iustin Pop
    Node.loDsk node' >= 0 &&
792 8fcf251f Iustin Pop
    fromIntegral (Node.loDsk node') <= Node.tDsk node &&
793 8fcf251f Iustin Pop
    Node.availDisk node' >= 0 &&
794 8fcf251f Iustin Pop
    Node.availDisk node' <= Node.fDsk node' &&
795 82ea2874 Iustin Pop
    fromIntegral (Node.availDisk node') <= Node.tDsk node' &&
796 82ea2874 Iustin Pop
    Node.mDsk node' == mx'
797 8fcf251f Iustin Pop
    where _types = (node::Node.Node, mx::SmallRatio)
798 8fcf251f Iustin Pop
          node' = Node.setMdsk node mx'
799 8fcf251f Iustin Pop
          SmallRatio mx' = mx
800 8fcf251f Iustin Pop
801 8fcf251f Iustin Pop
-- Check tag maps
802 8fcf251f Iustin Pop
prop_Node_tagMaps_idempotent tags =
803 72bb6b4e Iustin Pop
    Node.delTags (Node.addTags m tags) tags ==? m
804 4a007641 Iustin Pop
    where m = Data.Map.empty
805 8fcf251f Iustin Pop
806 8fcf251f Iustin Pop
prop_Node_tagMaps_reject tags =
807 8fcf251f Iustin Pop
    not (null tags) ==>
808 72bb6b4e Iustin Pop
    all (\t -> Node.rejectAddTags m [t]) tags
809 4a007641 Iustin Pop
    where m = Node.addTags Data.Map.empty tags
810 8fcf251f Iustin Pop
811 82ea2874 Iustin Pop
prop_Node_showField node =
812 82ea2874 Iustin Pop
  forAll (elements Node.defaultFields) $ \ field ->
813 82ea2874 Iustin Pop
  fst (Node.showHeader field) /= Types.unknownField &&
814 82ea2874 Iustin Pop
  Node.showField node field /= Types.unknownField
815 82ea2874 Iustin Pop
816 d8bcd0a8 Iustin Pop
prop_Node_computeGroups nodes =
817 d8bcd0a8 Iustin Pop
  let ng = Node.computeGroups nodes
818 d8bcd0a8 Iustin Pop
      onlyuuid = map fst ng
819 d8bcd0a8 Iustin Pop
  in length nodes == sum (map (length . snd) ng) &&
820 d8bcd0a8 Iustin Pop
     all (\(guuid, ns) -> all ((== guuid) . Node.group) ns) ng &&
821 d8bcd0a8 Iustin Pop
     length (nub onlyuuid) == length onlyuuid &&
822 cc532bdd Iustin Pop
     (null nodes || not (null ng))
823 d8bcd0a8 Iustin Pop
824 23fe06c2 Iustin Pop
testSuite "Node"
825 23fe06c2 Iustin Pop
              [ 'prop_Node_setAlias
826 23fe06c2 Iustin Pop
              , 'prop_Node_setOffline
827 23fe06c2 Iustin Pop
              , 'prop_Node_setMcpu
828 23fe06c2 Iustin Pop
              , 'prop_Node_setXmem
829 23fe06c2 Iustin Pop
              , 'prop_Node_addPriFM
830 23fe06c2 Iustin Pop
              , 'prop_Node_addPriFD
831 23fe06c2 Iustin Pop
              , 'prop_Node_addPriFC
832 23fe06c2 Iustin Pop
              , 'prop_Node_addSec
833 61bbbed7 Agata Murawska
              , 'prop_Node_addPriOffline
834 61bbbed7 Agata Murawska
              , 'prop_Node_addSecOffline
835 23fe06c2 Iustin Pop
              , 'prop_Node_rMem
836 23fe06c2 Iustin Pop
              , 'prop_Node_setMdsk
837 23fe06c2 Iustin Pop
              , 'prop_Node_tagMaps_idempotent
838 23fe06c2 Iustin Pop
              , 'prop_Node_tagMaps_reject
839 23fe06c2 Iustin Pop
              , 'prop_Node_showField
840 23fe06c2 Iustin Pop
              , 'prop_Node_computeGroups
841 23fe06c2 Iustin Pop
              ]
842 cf35a869 Iustin Pop
843 525bfb36 Iustin Pop
-- ** Cluster tests
844 cf35a869 Iustin Pop
845 525bfb36 Iustin Pop
-- | Check that the cluster score is close to zero for a homogeneous
846 525bfb36 Iustin Pop
-- cluster.
847 8e4f6d56 Iustin Pop
prop_Score_Zero node =
848 8e4f6d56 Iustin Pop
    forAll (choose (1, 1024)) $ \count ->
849 3a3c1eb4 Iustin Pop
    (not (Node.offline node) && not (Node.failN1 node) && (count > 0) &&
850 2060348b Iustin Pop
     (Node.tDsk node > 0) && (Node.tMem node > 0)) ==>
851 cf35a869 Iustin Pop
    let fn = Node.buildPeers node Container.empty
852 9bb5721c Iustin Pop
        nlst = replicate count fn
853 9bb5721c Iustin Pop
        score = Cluster.compCVNodes nlst
854 cf35a869 Iustin Pop
    -- we can't say == 0 here as the floating point errors accumulate;
855 cf35a869 Iustin Pop
    -- this should be much lower than the default score in CLI.hs
856 8e4f6d56 Iustin Pop
    in score <= 1e-12
857 cf35a869 Iustin Pop
858 525bfb36 Iustin Pop
-- | Check that cluster stats are sane.
859 8e4f6d56 Iustin Pop
prop_CStats_sane node =
860 8e4f6d56 Iustin Pop
    forAll (choose (1, 1024)) $ \count ->
861 8e4f6d56 Iustin Pop
    (not (Node.offline node) && not (Node.failN1 node) &&
862 3fea6959 Iustin Pop
     (Node.availDisk node > 0) && (Node.availMem node > 0)) ==>
863 8fcf251f Iustin Pop
    let fn = Node.buildPeers node Container.empty
864 8fcf251f Iustin Pop
        nlst = zip [1..] $ replicate count fn::[(Types.Ndx, Node.Node)]
865 cb0c77ff Iustin Pop
        nl = Container.fromList nlst
866 8fcf251f Iustin Pop
        cstats = Cluster.totalResources nl
867 8fcf251f Iustin Pop
    in Cluster.csAdsk cstats >= 0 &&
868 8fcf251f Iustin Pop
       Cluster.csAdsk cstats <= Cluster.csFdsk cstats
869 8fcf251f Iustin Pop
870 3fea6959 Iustin Pop
-- | Check that one instance is allocated correctly, without
871 525bfb36 Iustin Pop
-- rebalances needed.
872 3fea6959 Iustin Pop
prop_ClusterAlloc_sane node inst =
873 3fea6959 Iustin Pop
    forAll (choose (5, 20)) $ \count ->
874 3fea6959 Iustin Pop
    not (Node.offline node)
875 3fea6959 Iustin Pop
            && not (Node.failN1 node)
876 3fea6959 Iustin Pop
            && Node.availDisk node > 0
877 3fea6959 Iustin Pop
            && Node.availMem node > 0
878 3fea6959 Iustin Pop
            ==>
879 3fea6959 Iustin Pop
    let nl = makeSmallCluster node count
880 3fea6959 Iustin Pop
        il = Container.empty
881 3fea6959 Iustin Pop
        inst' = setInstanceSmallerThanNode node inst
882 6d0bc5ca Iustin Pop
    in case Cluster.genAllocNodes defGroupList nl 2 True >>=
883 6d0bc5ca Iustin Pop
       Cluster.tryAlloc nl il inst' of
884 3fea6959 Iustin Pop
         Types.Bad _ -> False
885 85d0ddc3 Iustin Pop
         Types.Ok as ->
886 129734d3 Iustin Pop
             case Cluster.asSolution as of
887 129734d3 Iustin Pop
               Nothing -> False
888 129734d3 Iustin Pop
               Just (xnl, xi, _, cv) ->
889 7d3f4253 Iustin Pop
                   let il' = Container.add (Instance.idx xi) xi il
890 3fea6959 Iustin Pop
                       tbl = Cluster.Table xnl il' cv []
891 e08424a8 Guido Trotter
                   in not (canBalance tbl True True False)
892 3fea6959 Iustin Pop
893 3fea6959 Iustin Pop
-- | Checks that on a 2-5 node cluster, we can allocate a random
894 3fea6959 Iustin Pop
-- instance spec via tiered allocation (whatever the original instance
895 525bfb36 Iustin Pop
-- spec), on either one or two nodes.
896 3fea6959 Iustin Pop
prop_ClusterCanTieredAlloc node inst =
897 3fea6959 Iustin Pop
    forAll (choose (2, 5)) $ \count ->
898 3fea6959 Iustin Pop
    forAll (choose (1, 2)) $ \rqnodes ->
899 3fea6959 Iustin Pop
    not (Node.offline node)
900 3fea6959 Iustin Pop
            && not (Node.failN1 node)
901 3fea6959 Iustin Pop
            && isNodeBig node 4
902 3fea6959 Iustin Pop
            ==>
903 3fea6959 Iustin Pop
    let nl = makeSmallCluster node count
904 3fea6959 Iustin Pop
        il = Container.empty
905 6d0bc5ca Iustin Pop
        allocnodes = Cluster.genAllocNodes defGroupList nl rqnodes True
906 41b5c85a Iustin Pop
    in case allocnodes >>= \allocnodes' ->
907 8f48f67d Iustin Pop
        Cluster.tieredAlloc nl il (Just 1) inst allocnodes' [] [] of
908 3fea6959 Iustin Pop
         Types.Bad _ -> False
909 d5ccec02 Iustin Pop
         Types.Ok (_, _, il', ixes, cstats) -> not (null ixes) &&
910 d5ccec02 Iustin Pop
                                      IntMap.size il' == length ixes &&
911 d5ccec02 Iustin Pop
                                      length ixes == length cstats
912 3fea6959 Iustin Pop
913 3fea6959 Iustin Pop
-- | Checks that on a 4-8 node cluster, once we allocate an instance,
914 525bfb36 Iustin Pop
-- we can also evacuate it.
915 3fea6959 Iustin Pop
prop_ClusterAllocEvac node inst =
916 3fea6959 Iustin Pop
    forAll (choose (4, 8)) $ \count ->
917 3fea6959 Iustin Pop
    not (Node.offline node)
918 3fea6959 Iustin Pop
            && not (Node.failN1 node)
919 3fea6959 Iustin Pop
            && isNodeBig node 4
920 3fea6959 Iustin Pop
            ==>
921 3fea6959 Iustin Pop
    let nl = makeSmallCluster node count
922 3fea6959 Iustin Pop
        il = Container.empty
923 3fea6959 Iustin Pop
        inst' = setInstanceSmallerThanNode node inst
924 6d0bc5ca Iustin Pop
    in case Cluster.genAllocNodes defGroupList nl 2 True >>=
925 6d0bc5ca Iustin Pop
       Cluster.tryAlloc nl il inst' of
926 3fea6959 Iustin Pop
         Types.Bad _ -> False
927 85d0ddc3 Iustin Pop
         Types.Ok as ->
928 129734d3 Iustin Pop
             case Cluster.asSolution as of
929 129734d3 Iustin Pop
               Nothing -> False
930 129734d3 Iustin Pop
               Just (xnl, xi, _, _) ->
931 3fea6959 Iustin Pop
                   let sdx = Instance.sNode xi
932 3fea6959 Iustin Pop
                       il' = Container.add (Instance.idx xi) xi il
933 6804faa0 Iustin Pop
                   in case IAlloc.processRelocate defGroupList xnl il'
934 6804faa0 Iustin Pop
                          (Instance.idx xi) 1 [sdx] of
935 6804faa0 Iustin Pop
                        Types.Ok _ -> True
936 3fea6959 Iustin Pop
                        _ -> False
937 3fea6959 Iustin Pop
938 3fea6959 Iustin Pop
-- | Check that allocating multiple instances on a cluster, then
939 525bfb36 Iustin Pop
-- adding an empty node, results in a valid rebalance.
940 00c75986 Iustin Pop
prop_ClusterAllocBalance =
941 00c75986 Iustin Pop
    forAll (genNode (Just 5) (Just 128)) $ \node ->
942 3fea6959 Iustin Pop
    forAll (choose (3, 5)) $ \count ->
943 00c75986 Iustin Pop
    not (Node.offline node) && not (Node.failN1 node) ==>
944 3fea6959 Iustin Pop
    let nl = makeSmallCluster node count
945 3fea6959 Iustin Pop
        (hnode, nl') = IntMap.deleteFindMax nl
946 3fea6959 Iustin Pop
        il = Container.empty
947 6d0bc5ca Iustin Pop
        allocnodes = Cluster.genAllocNodes defGroupList nl' 2 True
948 3fea6959 Iustin Pop
        i_templ = createInstance Types.unitMem Types.unitDsk Types.unitCpu
949 41b5c85a Iustin Pop
    in case allocnodes >>= \allocnodes' ->
950 8f48f67d Iustin Pop
        Cluster.iterateAlloc nl' il (Just 5) i_templ allocnodes' [] [] of
951 3fea6959 Iustin Pop
         Types.Bad _ -> False
952 d5ccec02 Iustin Pop
         Types.Ok (_, xnl, il', _, _) ->
953 3fea6959 Iustin Pop
                   let ynl = Container.add (Node.idx hnode) hnode xnl
954 3fea6959 Iustin Pop
                       cv = Cluster.compCV ynl
955 3fea6959 Iustin Pop
                       tbl = Cluster.Table ynl il' cv []
956 e08424a8 Guido Trotter
                   in canBalance tbl True True False
957 3fea6959 Iustin Pop
958 525bfb36 Iustin Pop
-- | Checks consistency.
959 32b8d9c0 Iustin Pop
prop_ClusterCheckConsistency node inst =
960 32b8d9c0 Iustin Pop
  let nl = makeSmallCluster node 3
961 32b8d9c0 Iustin Pop
      [node1, node2, node3] = Container.elems nl
962 10ef6b4e Iustin Pop
      node3' = node3 { Node.group = 1 }
963 32b8d9c0 Iustin Pop
      nl' = Container.add (Node.idx node3') node3' nl
964 32b8d9c0 Iustin Pop
      inst1 = Instance.setBoth inst (Node.idx node1) (Node.idx node2)
965 32b8d9c0 Iustin Pop
      inst2 = Instance.setBoth inst (Node.idx node1) Node.noSecondary
966 32b8d9c0 Iustin Pop
      inst3 = Instance.setBoth inst (Node.idx node1) (Node.idx node3)
967 cb0c77ff Iustin Pop
      ccheck = Cluster.findSplitInstances nl' . Container.fromList
968 32b8d9c0 Iustin Pop
  in null (ccheck [(0, inst1)]) &&
969 32b8d9c0 Iustin Pop
     null (ccheck [(0, inst2)]) &&
970 32b8d9c0 Iustin Pop
     (not . null $ ccheck [(0, inst3)])
971 32b8d9c0 Iustin Pop
972 525bfb36 Iustin Pop
-- | For now, we only test that we don't lose instances during the split.
973 f4161783 Iustin Pop
prop_ClusterSplitCluster node inst =
974 f4161783 Iustin Pop
  forAll (choose (0, 100)) $ \icnt ->
975 f4161783 Iustin Pop
  let nl = makeSmallCluster node 2
976 f4161783 Iustin Pop
      (nl', il') = foldl (\(ns, is) _ -> assignInstance ns is inst 0 1)
977 f4161783 Iustin Pop
                   (nl, Container.empty) [1..icnt]
978 f4161783 Iustin Pop
      gni = Cluster.splitCluster nl' il'
979 f4161783 Iustin Pop
  in sum (map (Container.size . snd . snd) gni) == icnt &&
980 f4161783 Iustin Pop
     all (\(guuid, (nl'', _)) -> all ((== guuid) . Node.group)
981 f4161783 Iustin Pop
                                 (Container.elems nl'')) gni
982 32b8d9c0 Iustin Pop
983 23fe06c2 Iustin Pop
testSuite "Cluster"
984 23fe06c2 Iustin Pop
              [ 'prop_Score_Zero
985 23fe06c2 Iustin Pop
              , 'prop_CStats_sane
986 23fe06c2 Iustin Pop
              , 'prop_ClusterAlloc_sane
987 23fe06c2 Iustin Pop
              , 'prop_ClusterCanTieredAlloc
988 23fe06c2 Iustin Pop
              , 'prop_ClusterAllocEvac
989 23fe06c2 Iustin Pop
              , 'prop_ClusterAllocBalance
990 23fe06c2 Iustin Pop
              , 'prop_ClusterCheckConsistency
991 23fe06c2 Iustin Pop
              , 'prop_ClusterSplitCluster
992 23fe06c2 Iustin Pop
              ]
993 88f25dd0 Iustin Pop
994 525bfb36 Iustin Pop
-- ** OpCodes tests
995 88f25dd0 Iustin Pop
996 525bfb36 Iustin Pop
-- | Check that opcode serialization is idempotent.
997 88f25dd0 Iustin Pop
prop_OpCodes_serialization op =
998 88f25dd0 Iustin Pop
  case J.readJSON (J.showJSON op) of
999 72bb6b4e Iustin Pop
    J.Error e -> printTestCase ("Cannot deserialise: " ++ e) False
1000 72bb6b4e Iustin Pop
    J.Ok op' -> op ==? op'
1001 4a007641 Iustin Pop
  where _types = op::OpCodes.OpCode
1002 88f25dd0 Iustin Pop
1003 23fe06c2 Iustin Pop
testSuite "OpCodes"
1004 23fe06c2 Iustin Pop
              [ 'prop_OpCodes_serialization ]
1005 c088674b Iustin Pop
1006 525bfb36 Iustin Pop
-- ** Jobs tests
1007 525bfb36 Iustin Pop
1008 525bfb36 Iustin Pop
-- | Check that (queued) job\/opcode status serialization is idempotent.
1009 db079755 Iustin Pop
prop_OpStatus_serialization os =
1010 db079755 Iustin Pop
  case J.readJSON (J.showJSON os) of
1011 72bb6b4e Iustin Pop
    J.Error e -> printTestCase ("Cannot deserialise: " ++ e) False
1012 72bb6b4e Iustin Pop
    J.Ok os' -> os ==? os'
1013 db079755 Iustin Pop
  where _types = os::Jobs.OpStatus
1014 db079755 Iustin Pop
1015 db079755 Iustin Pop
prop_JobStatus_serialization js =
1016 db079755 Iustin Pop
  case J.readJSON (J.showJSON js) of
1017 72bb6b4e Iustin Pop
    J.Error e -> printTestCase ("Cannot deserialise: " ++ e) False
1018 72bb6b4e Iustin Pop
    J.Ok js' -> js ==? js'
1019 db079755 Iustin Pop
  where _types = js::Jobs.JobStatus
1020 db079755 Iustin Pop
1021 23fe06c2 Iustin Pop
testSuite "Jobs"
1022 23fe06c2 Iustin Pop
              [ 'prop_OpStatus_serialization
1023 23fe06c2 Iustin Pop
              , 'prop_JobStatus_serialization
1024 23fe06c2 Iustin Pop
              ]
1025 db079755 Iustin Pop
1026 525bfb36 Iustin Pop
-- ** Loader tests
1027 c088674b Iustin Pop
1028 c088674b Iustin Pop
prop_Loader_lookupNode ktn inst node =
1029 72bb6b4e Iustin Pop
  Loader.lookupNode nl inst node ==? Data.Map.lookup node nl
1030 99b63608 Iustin Pop
  where nl = Data.Map.fromList ktn
1031 c088674b Iustin Pop
1032 c088674b Iustin Pop
prop_Loader_lookupInstance kti inst =
1033 72bb6b4e Iustin Pop
  Loader.lookupInstance il inst ==? Data.Map.lookup inst il
1034 99b63608 Iustin Pop
  where il = Data.Map.fromList kti
1035 99b63608 Iustin Pop
1036 99b63608 Iustin Pop
prop_Loader_assignIndices nodes =
1037 99b63608 Iustin Pop
  Data.Map.size nassoc == length nodes &&
1038 99b63608 Iustin Pop
  Container.size kt == length nodes &&
1039 99b63608 Iustin Pop
  (if not (null nodes)
1040 99b63608 Iustin Pop
   then maximum (IntMap.keys kt) == length nodes - 1
1041 c088674b Iustin Pop
   else True)
1042 99b63608 Iustin Pop
  where (nassoc, kt) = Loader.assignIndices (map (\n -> (Node.name n, n)) nodes)
1043 c088674b Iustin Pop
1044 c088674b Iustin Pop
-- | Checks that the number of primary instances recorded on the nodes
1045 525bfb36 Iustin Pop
-- is zero.
1046 c088674b Iustin Pop
prop_Loader_mergeData ns =
1047 cb0c77ff Iustin Pop
  let na = Container.fromList $ map (\n -> (Node.idx n, n)) ns
1048 2d1708e0 Guido Trotter
  in case Loader.mergeData [] [] [] []
1049 f4f6eb0b Iustin Pop
         (Loader.emptyCluster {Loader.cdNodes = na}) of
1050 c088674b Iustin Pop
    Types.Bad _ -> False
1051 017a0c3d Iustin Pop
    Types.Ok (Loader.ClusterData _ nl il _) ->
1052 c088674b Iustin Pop
      let nodes = Container.elems nl
1053 c088674b Iustin Pop
          instances = Container.elems il
1054 c088674b Iustin Pop
      in (sum . map (length . Node.pList)) nodes == 0 &&
1055 4a007641 Iustin Pop
         null instances
1056 c088674b Iustin Pop
1057 efe98965 Guido Trotter
-- | Check that compareNameComponent on equal strings works.
1058 efe98965 Guido Trotter
prop_Loader_compareNameComponent_equal :: String -> Bool
1059 efe98965 Guido Trotter
prop_Loader_compareNameComponent_equal s =
1060 efe98965 Guido Trotter
  Loader.compareNameComponent s s ==
1061 efe98965 Guido Trotter
    Loader.LookupResult Loader.ExactMatch s
1062 efe98965 Guido Trotter
1063 efe98965 Guido Trotter
-- | Check that compareNameComponent on prefix strings works.
1064 efe98965 Guido Trotter
prop_Loader_compareNameComponent_prefix :: NonEmptyList Char -> String -> Bool
1065 efe98965 Guido Trotter
prop_Loader_compareNameComponent_prefix (NonEmpty s1) s2 =
1066 efe98965 Guido Trotter
  Loader.compareNameComponent (s1 ++ "." ++ s2) s1 ==
1067 efe98965 Guido Trotter
    Loader.LookupResult Loader.PartialMatch s1
1068 efe98965 Guido Trotter
1069 23fe06c2 Iustin Pop
testSuite "Loader"
1070 23fe06c2 Iustin Pop
              [ 'prop_Loader_lookupNode
1071 23fe06c2 Iustin Pop
              , 'prop_Loader_lookupInstance
1072 23fe06c2 Iustin Pop
              , 'prop_Loader_assignIndices
1073 23fe06c2 Iustin Pop
              , 'prop_Loader_mergeData
1074 23fe06c2 Iustin Pop
              , 'prop_Loader_compareNameComponent_equal
1075 23fe06c2 Iustin Pop
              , 'prop_Loader_compareNameComponent_prefix
1076 23fe06c2 Iustin Pop
              ]
1077 3c002a13 Iustin Pop
1078 3c002a13 Iustin Pop
-- ** Types tests
1079 3c002a13 Iustin Pop
1080 0047d4e2 Iustin Pop
prop_Types_AllocPolicy_serialisation apol =
1081 0047d4e2 Iustin Pop
    case J.readJSON (J.showJSON apol) of
1082 0047d4e2 Iustin Pop
      J.Ok p -> printTestCase ("invalid deserialisation " ++ show p) $
1083 0047d4e2 Iustin Pop
                p == apol
1084 0047d4e2 Iustin Pop
      J.Error s -> printTestCase ("failed to deserialise: " ++ s) False
1085 0047d4e2 Iustin Pop
    where _types = apol::Types.AllocPolicy
1086 0047d4e2 Iustin Pop
1087 0047d4e2 Iustin Pop
prop_Types_DiskTemplate_serialisation dt =
1088 0047d4e2 Iustin Pop
    case J.readJSON (J.showJSON dt) of
1089 0047d4e2 Iustin Pop
      J.Ok p -> printTestCase ("invalid deserialisation " ++ show p) $
1090 0047d4e2 Iustin Pop
                p == dt
1091 0047d4e2 Iustin Pop
      J.Error s -> printTestCase ("failed to deserialise: " ++ s)
1092 0047d4e2 Iustin Pop
                   False
1093 0047d4e2 Iustin Pop
    where _types = dt::Types.DiskTemplate
1094 0047d4e2 Iustin Pop
1095 0047d4e2 Iustin Pop
prop_Types_opToResult op =
1096 0047d4e2 Iustin Pop
    case op of
1097 0047d4e2 Iustin Pop
      Types.OpFail _ -> Types.isBad r
1098 0047d4e2 Iustin Pop
      Types.OpGood v -> case r of
1099 0047d4e2 Iustin Pop
                          Types.Bad _ -> False
1100 0047d4e2 Iustin Pop
                          Types.Ok v' -> v == v'
1101 0047d4e2 Iustin Pop
    where r = Types.opToResult op
1102 0047d4e2 Iustin Pop
          _types = op::Types.OpResult Int
1103 0047d4e2 Iustin Pop
1104 0047d4e2 Iustin Pop
prop_Types_eitherToResult ei =
1105 0047d4e2 Iustin Pop
    case ei of
1106 0047d4e2 Iustin Pop
      Left _ -> Types.isBad r
1107 0047d4e2 Iustin Pop
      Right v -> case r of
1108 0047d4e2 Iustin Pop
                   Types.Bad _ -> False
1109 0047d4e2 Iustin Pop
                   Types.Ok v' -> v == v'
1110 0047d4e2 Iustin Pop
    where r = Types.eitherToResult ei
1111 0047d4e2 Iustin Pop
          _types = ei::Either String Int
1112 3c002a13 Iustin Pop
1113 23fe06c2 Iustin Pop
testSuite "Types"
1114 23fe06c2 Iustin Pop
              [ 'prop_Types_AllocPolicy_serialisation
1115 23fe06c2 Iustin Pop
              , 'prop_Types_DiskTemplate_serialisation
1116 23fe06c2 Iustin Pop
              , 'prop_Types_opToResult
1117 23fe06c2 Iustin Pop
              , 'prop_Types_eitherToResult
1118 23fe06c2 Iustin Pop
              ]