Statistics
| Branch: | Tag: | Revision:

root / test / hs / Test / Ganeti / OpCodes.hs @ df58ca1c

History | View | Annotate | Download (25.8 kB)

1
{-# LANGUAGE TemplateHaskell #-}
2
{-# OPTIONS_GHC -fno-warn-orphans #-}
3

    
4
{-| Unittests for ganeti-htools.
5

    
6
-}
7

    
8
{-
9

    
10
Copyright (C) 2009, 2010, 2011, 2012, 2013 Google Inc.
11

    
12
This program is free software; you can redistribute it and/or modify
13
it under the terms of the GNU General Public License as published by
14
the Free Software Foundation; either version 2 of the License, or
15
(at your option) any later version.
16

    
17
This program is distributed in the hope that it will be useful, but
18
WITHOUT ANY WARRANTY; without even the implied warranty of
19
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
20
General Public License for more details.
21

    
22
You should have received a copy of the GNU General Public License
23
along with this program; if not, write to the Free Software
24
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
25
02110-1301, USA.
26

    
27
-}
28

    
29
module Test.Ganeti.OpCodes
30
  ( testOpCodes
31
  , OpCodes.OpCode(..)
32
  ) where
33

    
34
import Test.HUnit as HUnit
35
import Test.QuickCheck as QuickCheck
36

    
37
import Control.Applicative
38
import Control.Monad
39
import Data.Char
40
import Data.List
41
import qualified Data.Map as Map
42
import qualified Text.JSON as J
43
import Text.Printf (printf)
44

    
45
import Test.Ganeti.TestHelper
46
import Test.Ganeti.TestCommon
47
import Test.Ganeti.Types ()
48
import Test.Ganeti.Query.Language ()
49

    
50
import Ganeti.BasicTypes
51
import qualified Ganeti.Constants as C
52
import qualified Ganeti.OpCodes as OpCodes
53
import Ganeti.Types
54
import Ganeti.OpParams
55
import Ganeti.JSON
56

    
57
{-# ANN module "HLint: ignore Use camelCase" #-}
58

    
59
-- * Arbitrary instances
60

    
61
instance (Ord k, Arbitrary k, Arbitrary a) => Arbitrary (Map.Map k a) where
62
  arbitrary = Map.fromList <$> arbitrary
63

    
64
arbitraryOpTagsGet :: Gen OpCodes.OpCode
65
arbitraryOpTagsGet = do
66
  kind <- arbitrary
67
  OpCodes.OpTagsSet kind <$> arbitrary <*> genOpCodesTagName kind
68

    
69
arbitraryOpTagsSet :: Gen OpCodes.OpCode
70
arbitraryOpTagsSet = do
71
  kind <- arbitrary
72
  OpCodes.OpTagsSet kind <$> genTags <*> genOpCodesTagName kind
73

    
74
arbitraryOpTagsDel :: Gen OpCodes.OpCode
75
arbitraryOpTagsDel = do
76
  kind <- arbitrary
77
  OpCodes.OpTagsDel kind <$> genTags <*> genOpCodesTagName kind
78

    
79
$(genArbitrary ''OpCodes.ReplaceDisksMode)
80

    
81
$(genArbitrary ''DiskAccess)
82

    
83
instance Arbitrary OpCodes.DiskIndex where
84
  arbitrary = choose (0, C.maxDisks - 1) >>= OpCodes.mkDiskIndex
85

    
86
instance Arbitrary INicParams where
87
  arbitrary = INicParams <$> genMaybe genNameNE <*> genMaybe genName <*>
88
              genMaybe genNameNE <*> genMaybe genNameNE <*>
89
              genMaybe genNameNE <*> genMaybe genNameNE <*>
90
              genMaybe genNameNE
91

    
92
instance Arbitrary IDiskParams where
93
  arbitrary = IDiskParams <$> arbitrary <*> arbitrary <*>
94
              genMaybe genNameNE <*> genMaybe genNameNE <*>
95
              genMaybe genNameNE <*> genMaybe genNameNE
96

    
97
instance Arbitrary RecreateDisksInfo where
98
  arbitrary = oneof [ pure RecreateDisksAll
99
                    , RecreateDisksIndices <$> arbitrary
100
                    , RecreateDisksParams <$> arbitrary
101
                    ]
102

    
103
instance Arbitrary DdmOldChanges where
104
  arbitrary = oneof [ DdmOldIndex <$> arbitrary
105
                    , DdmOldMod   <$> arbitrary
106
                    ]
107

    
108
instance (Arbitrary a) => Arbitrary (SetParamsMods a) where
109
  arbitrary = oneof [ pure SetParamsEmpty
110
                    , SetParamsDeprecated <$> arbitrary
111
                    , SetParamsNew        <$> arbitrary
112
                    ]
113

    
114
instance Arbitrary ExportTarget where
115
  arbitrary = oneof [ ExportTargetLocal <$> genNodeNameNE
116
                    , ExportTargetRemote <$> pure []
117
                    ]
118

    
119
instance Arbitrary OpCodes.OpCode where
120
  arbitrary = do
121
    op_id <- elements OpCodes.allOpIDs
122
    case op_id of
123
      "OP_TEST_DELAY" ->
124
        OpCodes.OpTestDelay <$> arbitrary <*> arbitrary <*>
125
          genNodeNamesNE <*> return Nothing <*> arbitrary
126
      "OP_INSTANCE_REPLACE_DISKS" ->
127
        OpCodes.OpInstanceReplaceDisks <$> genFQDN <*> return Nothing <*>
128
          arbitrary <*> arbitrary <*> arbitrary <*> genDiskIndices <*>
129
          genMaybe genNodeNameNE <*> return Nothing <*> genMaybe genNameNE
130
      "OP_INSTANCE_FAILOVER" ->
131
        OpCodes.OpInstanceFailover <$> genFQDN <*> return Nothing <*>
132
        arbitrary <*> arbitrary <*> genMaybe genNodeNameNE <*>
133
        return Nothing <*> arbitrary <*> arbitrary <*> genMaybe genNameNE
134
      "OP_INSTANCE_MIGRATE" ->
135
        OpCodes.OpInstanceMigrate <$> genFQDN <*> return Nothing <*>
136
          arbitrary <*> arbitrary <*> genMaybe genNodeNameNE <*>
137
          return Nothing <*> arbitrary <*> arbitrary <*> arbitrary <*>
138
          genMaybe genNameNE <*> arbitrary
139
      "OP_TAGS_GET" ->
140
        arbitraryOpTagsGet
141
      "OP_TAGS_SEARCH" ->
142
        OpCodes.OpTagsSearch <$> genNameNE
143
      "OP_TAGS_SET" ->
144
        arbitraryOpTagsSet
145
      "OP_TAGS_DEL" ->
146
        arbitraryOpTagsDel
147
      "OP_CLUSTER_POST_INIT" -> pure OpCodes.OpClusterPostInit
148
      "OP_CLUSTER_DESTROY" -> pure OpCodes.OpClusterDestroy
149
      "OP_CLUSTER_QUERY" -> pure OpCodes.OpClusterQuery
150
      "OP_CLUSTER_VERIFY" ->
151
        OpCodes.OpClusterVerify <$> arbitrary <*> arbitrary <*>
152
          genListSet Nothing <*> genListSet Nothing <*> arbitrary <*>
153
          genMaybe genNameNE
154
      "OP_CLUSTER_VERIFY_CONFIG" ->
155
        OpCodes.OpClusterVerifyConfig <$> arbitrary <*> arbitrary <*>
156
          genListSet Nothing <*> arbitrary
157
      "OP_CLUSTER_VERIFY_GROUP" ->
158
        OpCodes.OpClusterVerifyGroup <$> genNameNE <*> arbitrary <*>
159
          arbitrary <*> genListSet Nothing <*> genListSet Nothing <*> arbitrary
160
      "OP_CLUSTER_VERIFY_DISKS" -> pure OpCodes.OpClusterVerifyDisks
161
      "OP_GROUP_VERIFY_DISKS" ->
162
        OpCodes.OpGroupVerifyDisks <$> genNameNE
163
      "OP_CLUSTER_REPAIR_DISK_SIZES" ->
164
        OpCodes.OpClusterRepairDiskSizes <$> genNodeNamesNE
165
      "OP_CLUSTER_CONFIG_QUERY" ->
166
        OpCodes.OpClusterConfigQuery <$> genFieldsNE
167
      "OP_CLUSTER_RENAME" ->
168
        OpCodes.OpClusterRename <$> genNameNE
169
      "OP_CLUSTER_SET_PARAMS" ->
170
        OpCodes.OpClusterSetParams <$> arbitrary <*> emptyMUD <*> emptyMUD <*>
171
          arbitrary <*> genMaybe arbitrary <*>
172
          genMaybe genEmptyContainer <*> emptyMUD <*>
173
          genMaybe genEmptyContainer <*> genMaybe genEmptyContainer <*>
174
          genMaybe genEmptyContainer <*> genMaybe arbitrary <*>
175
          arbitrary <*> arbitrary <*> arbitrary <*>
176
          arbitrary <*> arbitrary <*> arbitrary <*>
177
          emptyMUD <*> emptyMUD <*> arbitrary <*>
178
          arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*>
179
          arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*>
180
          genMaybe genName <*>
181
          genMaybe genName
182
      "OP_CLUSTER_REDIST_CONF" -> pure OpCodes.OpClusterRedistConf
183
      "OP_CLUSTER_ACTIVATE_MASTER_IP" ->
184
        pure OpCodes.OpClusterActivateMasterIp
185
      "OP_CLUSTER_DEACTIVATE_MASTER_IP" ->
186
        pure OpCodes.OpClusterDeactivateMasterIp
187
      "OP_QUERY" ->
188
        OpCodes.OpQuery <$> arbitrary <*> arbitrary <*> arbitrary <*>
189
        pure Nothing
190
      "OP_QUERY_FIELDS" ->
191
        OpCodes.OpQueryFields <$> arbitrary <*> arbitrary
192
      "OP_OOB_COMMAND" ->
193
        OpCodes.OpOobCommand <$> genNodeNamesNE <*> return Nothing <*>
194
          arbitrary <*> arbitrary <*> arbitrary <*>
195
          (arbitrary `suchThat` (>0))
196
      "OP_NODE_REMOVE" ->
197
        OpCodes.OpNodeRemove <$> genNodeNameNE <*> return Nothing
198
      "OP_NODE_ADD" ->
199
        OpCodes.OpNodeAdd <$> genNodeNameNE <*> emptyMUD <*> emptyMUD <*>
200
          genMaybe genNameNE <*> genMaybe genNameNE <*> arbitrary <*>
201
          genMaybe genNameNE <*> arbitrary <*> arbitrary <*> emptyMUD
202
      "OP_NODE_QUERY" ->
203
        OpCodes.OpNodeQuery <$> genFieldsNE <*> genNamesNE <*> arbitrary
204
      "OP_NODE_QUERYVOLS" ->
205
        OpCodes.OpNodeQueryvols <$> arbitrary <*> genNodeNamesNE
206
      "OP_NODE_QUERY_STORAGE" ->
207
        OpCodes.OpNodeQueryStorage <$> arbitrary <*> arbitrary <*>
208
          genNodeNamesNE <*> genMaybe genNameNE
209
      "OP_NODE_MODIFY_STORAGE" ->
210
        OpCodes.OpNodeModifyStorage <$> genNodeNameNE <*> return Nothing <*>
211
          arbitrary <*> genMaybe genNameNE <*> pure emptyJSObject
212
      "OP_REPAIR_NODE_STORAGE" ->
213
        OpCodes.OpRepairNodeStorage <$> genNodeNameNE <*> return Nothing <*>
214
          arbitrary <*> genMaybe genNameNE <*> arbitrary
215
      "OP_NODE_SET_PARAMS" ->
216
        OpCodes.OpNodeSetParams <$> genNodeNameNE <*> return Nothing <*>
217
          arbitrary <*> emptyMUD <*> emptyMUD <*> arbitrary <*> arbitrary <*>
218
          arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*>
219
          genMaybe genNameNE <*> emptyMUD <*> arbitrary
220
      "OP_NODE_POWERCYCLE" ->
221
        OpCodes.OpNodePowercycle <$> genNodeNameNE <*> return Nothing <*>
222
          arbitrary
223
      "OP_NODE_MIGRATE" ->
224
        OpCodes.OpNodeMigrate <$> genNodeNameNE <*> return Nothing <*>
225
          arbitrary <*> arbitrary <*> genMaybe genNodeNameNE <*>
226
          return Nothing <*> arbitrary <*> arbitrary <*> genMaybe genNameNE
227
      "OP_NODE_EVACUATE" ->
228
        OpCodes.OpNodeEvacuate <$> arbitrary <*> genNodeNameNE <*>
229
          return Nothing <*> genMaybe genNodeNameNE <*> return Nothing <*>
230
          genMaybe genNameNE <*> arbitrary
231
      "OP_INSTANCE_CREATE" ->
232
        OpCodes.OpInstanceCreate <$> genFQDN <*> arbitrary <*>
233
          arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*>
234
          pure emptyJSObject <*> arbitrary <*> arbitrary <*> arbitrary <*>
235
          genMaybe genNameNE <*> pure emptyJSObject <*> arbitrary <*>
236
          genMaybe genNameNE <*> arbitrary <*> arbitrary <*> arbitrary <*>
237
          arbitrary <*> arbitrary <*> arbitrary <*> pure emptyJSObject <*>
238
          genMaybe genNameNE <*> genMaybe genNodeNameNE <*> return Nothing <*>
239
          genMaybe genNodeNameNE <*> return Nothing <*> genMaybe (pure []) <*>
240
          genMaybe genNodeNameNE <*> arbitrary <*> genMaybe genNodeNameNE <*>
241
          return Nothing <*> genMaybe genNodeNameNE <*> genMaybe genNameNE <*>
242
          arbitrary <*> (genTags >>= mapM mkNonEmpty)
243
      "OP_INSTANCE_MULTI_ALLOC" ->
244
        OpCodes.OpInstanceMultiAlloc <$> arbitrary <*> genMaybe genNameNE <*>
245
        pure []
246
      "OP_INSTANCE_REINSTALL" ->
247
        OpCodes.OpInstanceReinstall <$> genFQDN <*> return Nothing <*>
248
          arbitrary <*> genMaybe genNameNE <*> genMaybe (pure emptyJSObject)
249
      "OP_INSTANCE_REMOVE" ->
250
        OpCodes.OpInstanceRemove <$> genFQDN <*> return Nothing <*>
251
          arbitrary <*> arbitrary
252
      "OP_INSTANCE_RENAME" ->
253
        OpCodes.OpInstanceRename <$> genFQDN <*> return Nothing <*>
254
          genNodeNameNE <*> arbitrary <*> arbitrary
255
      "OP_INSTANCE_STARTUP" ->
256
        OpCodes.OpInstanceStartup <$> genFQDN <*> return Nothing <*>
257
          arbitrary <*> arbitrary <*> pure emptyJSObject <*>
258
          pure emptyJSObject <*> arbitrary <*> arbitrary
259
      "OP_INSTANCE_SHUTDOWN" ->
260
        OpCodes.OpInstanceShutdown <$> genFQDN <*> return Nothing <*>
261
          arbitrary <*> arbitrary <*> arbitrary <*> arbitrary
262
      "OP_INSTANCE_REBOOT" ->
263
        OpCodes.OpInstanceReboot <$> genFQDN <*> return Nothing <*>
264
          arbitrary <*> arbitrary <*> arbitrary
265
      "OP_INSTANCE_MOVE" ->
266
        OpCodes.OpInstanceMove <$> genFQDN <*> return Nothing <*>
267
          arbitrary <*> arbitrary <*> genNodeNameNE <*> return Nothing <*>
268
          arbitrary
269
      "OP_INSTANCE_CONSOLE" -> OpCodes.OpInstanceConsole <$> genFQDN <*>
270
          return Nothing
271
      "OP_INSTANCE_ACTIVATE_DISKS" ->
272
        OpCodes.OpInstanceActivateDisks <$> genFQDN <*> return Nothing <*>
273
          arbitrary <*> arbitrary
274
      "OP_INSTANCE_DEACTIVATE_DISKS" ->
275
        OpCodes.OpInstanceDeactivateDisks <$> genFQDN <*> return Nothing <*>
276
          arbitrary
277
      "OP_INSTANCE_RECREATE_DISKS" ->
278
        OpCodes.OpInstanceRecreateDisks <$> genFQDN <*> return Nothing <*>
279
          arbitrary <*> genNodeNamesNE <*> return Nothing <*>
280
          genMaybe genNameNE
281
      "OP_INSTANCE_QUERY" ->
282
        OpCodes.OpInstanceQuery <$> genFieldsNE <*> arbitrary <*> genNamesNE
283
      "OP_INSTANCE_QUERY_DATA" ->
284
        OpCodes.OpInstanceQueryData <$> arbitrary <*>
285
          genNodeNamesNE <*> arbitrary
286
      "OP_INSTANCE_SET_PARAMS" ->
287
        OpCodes.OpInstanceSetParams <$> genFQDN <*> return Nothing <*>
288
          arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*>
289
          arbitrary <*> pure emptyJSObject <*> arbitrary <*>
290
          pure emptyJSObject <*> arbitrary <*> genMaybe genNodeNameNE <*>
291
          return Nothing <*> genMaybe genNodeNameNE <*> return Nothing <*>
292
          genMaybe genNameNE <*> pure emptyJSObject <*> arbitrary <*>
293
          arbitrary <*> arbitrary <*> arbitrary
294
      "OP_INSTANCE_GROW_DISK" ->
295
        OpCodes.OpInstanceGrowDisk <$> genFQDN <*> return Nothing <*>
296
          arbitrary <*> arbitrary <*> arbitrary <*> arbitrary
297
      "OP_INSTANCE_CHANGE_GROUP" ->
298
        OpCodes.OpInstanceChangeGroup <$> genFQDN <*> return Nothing <*>
299
          arbitrary <*> genMaybe genNameNE <*>
300
          genMaybe (resize maxNodes (listOf genNameNE))
301
      "OP_GROUP_ADD" ->
302
        OpCodes.OpGroupAdd <$> genNameNE <*> arbitrary <*>
303
          emptyMUD <*> genMaybe genEmptyContainer <*>
304
          emptyMUD <*> emptyMUD <*> emptyMUD
305
      "OP_GROUP_ASSIGN_NODES" ->
306
        OpCodes.OpGroupAssignNodes <$> genNameNE <*> arbitrary <*>
307
          genNodeNamesNE <*> return Nothing
308
      "OP_GROUP_QUERY" ->
309
        OpCodes.OpGroupQuery <$> genFieldsNE <*> genNamesNE
310
      "OP_GROUP_SET_PARAMS" ->
311
        OpCodes.OpGroupSetParams <$> genNameNE <*> arbitrary <*>
312
          emptyMUD <*> genMaybe genEmptyContainer <*>
313
          emptyMUD <*> emptyMUD <*> emptyMUD
314
      "OP_GROUP_REMOVE" ->
315
        OpCodes.OpGroupRemove <$> genNameNE
316
      "OP_GROUP_RENAME" ->
317
        OpCodes.OpGroupRename <$> genNameNE <*> genNameNE
318
      "OP_GROUP_EVACUATE" ->
319
        OpCodes.OpGroupEvacuate <$> genNameNE <*> arbitrary <*>
320
          genMaybe genNameNE <*> genMaybe genNamesNE
321
      "OP_OS_DIAGNOSE" ->
322
        OpCodes.OpOsDiagnose <$> genFieldsNE <*> genNamesNE
323
      "OP_EXT_STORAGE_DIAGNOSE" ->
324
        OpCodes.OpOsDiagnose <$> genFieldsNE <*> genNamesNE
325
      "OP_BACKUP_QUERY" ->
326
        OpCodes.OpBackupQuery <$> arbitrary <*> genNodeNamesNE
327
      "OP_BACKUP_PREPARE" ->
328
        OpCodes.OpBackupPrepare <$> genFQDN <*> return Nothing <*> arbitrary
329
      "OP_BACKUP_EXPORT" ->
330
        OpCodes.OpBackupExport <$> genFQDN <*> return Nothing <*>
331
          arbitrary <*> arbitrary <*> return Nothing <*> arbitrary <*>
332
          arbitrary <*> arbitrary <*> arbitrary <*> genMaybe (pure []) <*>
333
          genMaybe genNameNE
334
      "OP_BACKUP_REMOVE" ->
335
        OpCodes.OpBackupRemove <$> genFQDN <*> return Nothing
336
      "OP_TEST_ALLOCATOR" ->
337
        OpCodes.OpTestAllocator <$> arbitrary <*> arbitrary <*>
338
          genNameNE <*> genMaybe (pure []) <*> genMaybe (pure []) <*>
339
          arbitrary <*> genMaybe genNameNE <*>
340
          (genTags >>= mapM mkNonEmpty) <*>
341
          arbitrary <*> arbitrary <*> genMaybe genNameNE <*>
342
          arbitrary <*> genMaybe genNodeNamesNE <*> arbitrary <*>
343
          genMaybe genNamesNE <*> arbitrary <*> arbitrary
344
      "OP_TEST_JQUEUE" ->
345
        OpCodes.OpTestJqueue <$> arbitrary <*> arbitrary <*>
346
          resize 20 (listOf genFQDN) <*> arbitrary
347
      "OP_TEST_DUMMY" ->
348
        OpCodes.OpTestDummy <$> pure J.JSNull <*> pure J.JSNull <*>
349
          pure J.JSNull <*> pure J.JSNull
350
      "OP_NETWORK_ADD" ->
351
        OpCodes.OpNetworkAdd <$> genNameNE <*> genIPv4Network <*>
352
          genMaybe genIPv4Address <*> pure Nothing <*> pure Nothing <*>
353
          genMaybe genMacPrefix <*> genMaybe (listOf genIPv4Address) <*>
354
          arbitrary <*> (genTags >>= mapM mkNonEmpty)
355
      "OP_NETWORK_REMOVE" ->
356
        OpCodes.OpNetworkRemove <$> genNameNE <*> arbitrary
357
      "OP_NETWORK_SET_PARAMS" ->
358
        OpCodes.OpNetworkSetParams <$> genNameNE <*>
359
          genMaybe genIPv4Address <*> pure Nothing <*> pure Nothing <*>
360
          genMaybe genMacPrefix <*> genMaybe (listOf genIPv4Address) <*>
361
          genMaybe (listOf genIPv4Address)
362
      "OP_NETWORK_CONNECT" ->
363
        OpCodes.OpNetworkConnect <$> genNameNE <*> genNameNE <*>
364
          arbitrary <*> genNameNE <*> arbitrary
365
      "OP_NETWORK_DISCONNECT" ->
366
        OpCodes.OpNetworkDisconnect <$> genNameNE <*> genNameNE
367
      "OP_NETWORK_QUERY" ->
368
        OpCodes.OpNetworkQuery <$> genFieldsNE <*> arbitrary <*> genNamesNE
369
      "OP_RESTRICTED_COMMAND" ->
370
        OpCodes.OpRestrictedCommand <$> arbitrary <*> genNodeNamesNE <*>
371
          return Nothing <*> genNameNE
372
      _ -> fail $ "Undefined arbitrary for opcode " ++ op_id
373

    
374
-- | Generates one element of a reason trail
375
genReasonElem :: Gen ReasonElem
376
genReasonElem = (,,) <$> genFQDN <*> genFQDN <*> arbitrary
377

    
378
-- | Generates a reason trail
379
genReasonTrail :: Gen ReasonTrail
380
genReasonTrail = do
381
  size <- choose (0, 10)
382
  vectorOf size genReasonElem
383

    
384
instance Arbitrary OpCodes.CommonOpParams where
385
  arbitrary = OpCodes.CommonOpParams <$> arbitrary <*> arbitrary <*>
386
                arbitrary <*> resize 5 arbitrary <*> genMaybe genName <*>
387
                genReasonTrail
388

    
389
-- * Helper functions
390

    
391
-- | Empty JSObject.
392
emptyJSObject :: J.JSObject J.JSValue
393
emptyJSObject = J.toJSObject []
394

    
395
-- | Empty maybe unchecked dictionary.
396
emptyMUD :: Gen (Maybe (J.JSObject J.JSValue))
397
emptyMUD = genMaybe $ pure emptyJSObject
398

    
399
-- | Generates an empty container.
400
genEmptyContainer :: (Ord a) => Gen (GenericContainer a b)
401
genEmptyContainer = pure . GenericContainer $ Map.fromList []
402

    
403
-- | Generates list of disk indices.
404
genDiskIndices :: Gen [DiskIndex]
405
genDiskIndices = do
406
  cnt <- choose (0, C.maxDisks)
407
  genUniquesList cnt arbitrary
408

    
409
-- | Generates a list of node names.
410
genNodeNames :: Gen [String]
411
genNodeNames = resize maxNodes (listOf genFQDN)
412

    
413
-- | Generates a list of node names in non-empty string type.
414
genNodeNamesNE :: Gen [NonEmptyString]
415
genNodeNamesNE = genNodeNames >>= mapM mkNonEmpty
416

    
417
-- | Gets a node name in non-empty type.
418
genNodeNameNE :: Gen NonEmptyString
419
genNodeNameNE = genFQDN >>= mkNonEmpty
420

    
421
-- | Gets a name (non-fqdn) in non-empty type.
422
genNameNE :: Gen NonEmptyString
423
genNameNE = genName >>= mkNonEmpty
424

    
425
-- | Gets a list of names (non-fqdn) in non-empty type.
426
genNamesNE :: Gen [NonEmptyString]
427
genNamesNE = resize maxNodes (listOf genNameNE)
428

    
429
-- | Returns a list of non-empty fields.
430
genFieldsNE :: Gen [NonEmptyString]
431
genFieldsNE = genFields >>= mapM mkNonEmpty
432

    
433
-- | Generate a 3-byte MAC prefix.
434
genMacPrefix :: Gen NonEmptyString
435
genMacPrefix = do
436
  octets <- vectorOf 3 $ choose (0::Int, 255)
437
  mkNonEmpty . intercalate ":" $ map (printf "%02x") octets
438

    
439
-- | Arbitrary instance for MetaOpCode, defined here due to TH ordering.
440
$(genArbitrary ''OpCodes.MetaOpCode)
441

    
442
-- | Small helper to check for a failed JSON deserialisation
443
isJsonError :: J.Result a -> Bool
444
isJsonError (J.Error _) = True
445
isJsonError _           = False
446

    
447
-- * Test cases
448

    
449
-- | Check that opcode serialization is idempotent.
450
prop_serialization :: OpCodes.OpCode -> Property
451
prop_serialization = testSerialisation
452

    
453
-- | Check that Python and Haskell defined the same opcode list.
454
case_AllDefined :: HUnit.Assertion
455
case_AllDefined = do
456
  py_stdout <-
457
     runPython "from ganeti import opcodes\n\
458
               \from ganeti import serializer\n\
459
               \import sys\n\
460
               \print serializer.Dump([opid for opid in opcodes.OP_MAPPING])\n"
461
               ""
462
     >>= checkPythonResult
463
  py_ops <- case J.decode py_stdout::J.Result [String] of
464
               J.Ok ops -> return ops
465
               J.Error msg ->
466
                 HUnit.assertFailure ("Unable to decode opcode names: " ++ msg)
467
                 -- this already raised an expection, but we need it
468
                 -- for proper types
469
                 >> fail "Unable to decode opcode names"
470
  let hs_ops = sort OpCodes.allOpIDs
471
      extra_py = py_ops \\ hs_ops
472
      extra_hs = hs_ops \\ py_ops
473
  HUnit.assertBool ("Missing OpCodes from the Haskell code:\n" ++
474
                    unlines extra_py) (null extra_py)
475
  HUnit.assertBool ("Extra OpCodes in the Haskell code code:\n" ++
476
                    unlines extra_hs) (null extra_hs)
477

    
478
-- | Custom HUnit test case that forks a Python process and checks
479
-- correspondence between Haskell-generated OpCodes and their Python
480
-- decoded, validated and re-encoded version.
481
--
482
-- Note that we have a strange beast here: since launching Python is
483
-- expensive, we don't do this via a usual QuickProperty, since that's
484
-- slow (I've tested it, and it's indeed quite slow). Rather, we use a
485
-- single HUnit assertion, and in it we manually use QuickCheck to
486
-- generate 500 opcodes times the number of defined opcodes, which
487
-- then we pass in bulk to Python. The drawbacks to this method are
488
-- two fold: we cannot control the number of generated opcodes, since
489
-- HUnit assertions don't get access to the test options, and for the
490
-- same reason we can't run a repeatable seed. We should probably find
491
-- a better way to do this, for example by having a
492
-- separately-launched Python process (if not running the tests would
493
-- be skipped).
494
case_py_compat_types :: HUnit.Assertion
495
case_py_compat_types = do
496
  let num_opcodes = length OpCodes.allOpIDs * 100
497
  opcodes <- genSample (vectorOf num_opcodes
498
                                   (arbitrary::Gen OpCodes.MetaOpCode))
499
  let with_sum = map (\o -> (OpCodes.opSummary $
500
                             OpCodes.metaOpCode o, o)) opcodes
501
      serialized = J.encode opcodes
502
  -- check for non-ASCII fields, usually due to 'arbitrary :: String'
503
  mapM_ (\op -> when (any (not . isAscii) (J.encode op)) .
504
                HUnit.assertFailure $
505
                  "OpCode has non-ASCII fields: " ++ show op
506
        ) opcodes
507
  py_stdout <-
508
     runPython "from ganeti import opcodes\n\
509
               \from ganeti import serializer\n\
510
               \import sys\n\
511
               \op_data = serializer.Load(sys.stdin.read())\n\
512
               \decoded = [opcodes.OpCode.LoadOpCode(o) for o in op_data]\n\
513
               \for op in decoded:\n\
514
               \  op.Validate(True)\n\
515
               \encoded = [(op.Summary(), op.__getstate__())\n\
516
               \           for op in decoded]\n\
517
               \print serializer.Dump(encoded)" serialized
518
     >>= checkPythonResult
519
  let deserialised =
520
        J.decode py_stdout::J.Result [(String, OpCodes.MetaOpCode)]
521
  decoded <- case deserialised of
522
               J.Ok ops -> return ops
523
               J.Error msg ->
524
                 HUnit.assertFailure ("Unable to decode opcodes: " ++ msg)
525
                 -- this already raised an expection, but we need it
526
                 -- for proper types
527
                 >> fail "Unable to decode opcodes"
528
  HUnit.assertEqual "Mismatch in number of returned opcodes"
529
    (length decoded) (length with_sum)
530
  mapM_ (uncurry (HUnit.assertEqual "Different result after encoding/decoding")
531
        ) $ zip decoded with_sum
532

    
533
-- | Custom HUnit test case that forks a Python process and checks
534
-- correspondence between Haskell OpCodes fields and their Python
535
-- equivalent.
536
case_py_compat_fields :: HUnit.Assertion
537
case_py_compat_fields = do
538
  let hs_fields = sort $ map (\op_id -> (op_id, OpCodes.allOpFields op_id))
539
                         OpCodes.allOpIDs
540
  py_stdout <-
541
     runPython "from ganeti import opcodes\n\
542
               \import sys\n\
543
               \from ganeti import serializer\n\
544
               \fields = [(k, sorted([p[0] for p in v.OP_PARAMS]))\n\
545
               \           for k, v in opcodes.OP_MAPPING.items()]\n\
546
               \print serializer.Dump(fields)" ""
547
     >>= checkPythonResult
548
  let deserialised = J.decode py_stdout::J.Result [(String, [String])]
549
  py_fields <- case deserialised of
550
                 J.Ok v -> return $ sort v
551
                 J.Error msg ->
552
                   HUnit.assertFailure ("Unable to decode op fields: " ++ msg)
553
                   -- this already raised an expection, but we need it
554
                   -- for proper types
555
                   >> fail "Unable to decode op fields"
556
  HUnit.assertEqual "Mismatch in number of returned opcodes"
557
    (length hs_fields) (length py_fields)
558
  HUnit.assertEqual "Mismatch in defined OP_IDs"
559
    (map fst hs_fields) (map fst py_fields)
560
  mapM_ (\((py_id, py_flds), (hs_id, hs_flds)) -> do
561
           HUnit.assertEqual "Mismatch in OP_ID" py_id hs_id
562
           HUnit.assertEqual ("Mismatch in fields for " ++ hs_id)
563
             py_flds hs_flds
564
        ) $ zip py_fields hs_fields
565

    
566
-- | Checks that setOpComment works correctly.
567
prop_setOpComment :: OpCodes.MetaOpCode -> String -> Property
568
prop_setOpComment op comment =
569
  let (OpCodes.MetaOpCode common _) = OpCodes.setOpComment comment op
570
  in OpCodes.opComment common ==? Just comment
571

    
572
-- | Tests wrong (negative) disk index.
573
prop_mkDiskIndex_fail :: QuickCheck.Positive Int -> Property
574
prop_mkDiskIndex_fail (Positive i) =
575
  case mkDiskIndex (negate i) of
576
    Bad msg -> printTestCase "error message " $
577
               "Invalid value" `isPrefixOf` msg
578
    Ok v -> failTest $ "Succeeded to build disk index '" ++ show v ++
579
                       "' from negative value " ++ show (negate i)
580

    
581
-- | Tests a few invalid 'readRecreateDisks' cases.
582
case_readRecreateDisks_fail :: Assertion
583
case_readRecreateDisks_fail = do
584
  assertBool "null" $
585
    isJsonError (J.readJSON J.JSNull::J.Result RecreateDisksInfo)
586
  assertBool "string" $
587
    isJsonError (J.readJSON (J.showJSON "abc")::J.Result RecreateDisksInfo)
588

    
589
-- | Tests a few invalid 'readDdmOldChanges' cases.
590
case_readDdmOldChanges_fail :: Assertion
591
case_readDdmOldChanges_fail = do
592
  assertBool "null" $
593
    isJsonError (J.readJSON J.JSNull::J.Result DdmOldChanges)
594
  assertBool "string" $
595
    isJsonError (J.readJSON (J.showJSON "abc")::J.Result DdmOldChanges)
596

    
597
-- | Tests a few invalid 'readExportTarget' cases.
598
case_readExportTarget_fail :: Assertion
599
case_readExportTarget_fail = do
600
  assertBool "null" $
601
    isJsonError (J.readJSON J.JSNull::J.Result ExportTarget)
602
  assertBool "int" $
603
    isJsonError (J.readJSON (J.showJSON (5::Int))::J.Result ExportTarget)
604

    
605
testSuite "OpCodes"
606
            [ 'prop_serialization
607
            , 'case_AllDefined
608
            , 'case_py_compat_types
609
            , 'case_py_compat_fields
610
            , 'prop_setOpComment
611
            , 'prop_mkDiskIndex_fail
612
            , 'case_readRecreateDisks_fail
613
            , 'case_readDdmOldChanges_fail
614
            , 'case_readExportTarget_fail
615
            ]