Statistics
| Branch: | Tag: | Revision:

root / htest / Test / Ganeti / OpCodes.hs @ 1dbceab9

History | View | Annotate | Download (19.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 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 qualified Test.HUnit as HUnit
35
import Test.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 qualified Ganeti.Constants as C
51
import qualified Ganeti.OpCodes as OpCodes
52
import Ganeti.Types
53
import Ganeti.OpParams
54
import Ganeti.JSON
55

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

    
58
-- * Arbitrary instances
59

    
60
instance Arbitrary OpCodes.TagObject where
61
  arbitrary = oneof [ OpCodes.TagInstance <$> genFQDN
62
                    , OpCodes.TagNode     <$> genFQDN
63
                    , OpCodes.TagGroup    <$> genFQDN
64
                    , pure OpCodes.TagCluster
65
                    ]
66

    
67
$(genArbitrary ''OpCodes.ReplaceDisksMode)
68

    
69
$(genArbitrary ''DiskAccess)
70

    
71
instance Arbitrary OpCodes.DiskIndex where
72
  arbitrary = choose (0, C.maxDisks - 1) >>= OpCodes.mkDiskIndex
73

    
74
instance Arbitrary INicParams where
75
  arbitrary = INicParams <$> genMaybe genNameNE <*> genMaybe genName <*>
76
              genMaybe genNameNE <*> genMaybe genNameNE
77

    
78
instance Arbitrary IDiskParams where
79
  arbitrary = IDiskParams <$> arbitrary <*> arbitrary <*>
80
              genMaybe genNameNE <*> genMaybe genNameNE <*>
81
              genMaybe genNameNE
82

    
83
instance Arbitrary RecreateDisksInfo where
84
  arbitrary = oneof [ pure RecreateDisksAll
85
                    , RecreateDisksIndices <$> arbitrary
86
                    , RecreateDisksParams <$> arbitrary
87
                    ]
88

    
89
instance Arbitrary DdmOldChanges where
90
  arbitrary = oneof [ DdmOldIndex <$> arbitrary
91
                    , DdmOldMod   <$> arbitrary
92
                    ]
93

    
94
instance (Arbitrary a) => Arbitrary (SetParamsMods a) where
95
  arbitrary = oneof [ pure SetParamsEmpty
96
                    , SetParamsDeprecated <$> arbitrary
97
                    , SetParamsNew        <$> arbitrary
98
                    ]
99

    
100
instance Arbitrary ExportTarget where
101
  arbitrary = oneof [ ExportTargetLocal <$> genNodeNameNE
102
                    , ExportTargetRemote <$> pure []
103
                    ]
104

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

    
340
-- * Helper functions
341

    
342
-- | Empty JSObject.
343
emptyJSObject :: J.JSObject J.JSValue
344
emptyJSObject = J.toJSObject []
345

    
346
-- | Empty maybe unchecked dictionary.
347
emptyMUD :: Gen (Maybe (J.JSObject J.JSValue))
348
emptyMUD = genMaybe $ pure emptyJSObject
349

    
350
-- | Generates an empty container.
351
genEmptyContainer :: (Ord a) => Gen (GenericContainer a b)
352
genEmptyContainer = pure . GenericContainer $ Map.fromList []
353

    
354
-- | Generates list of disk indices.
355
genDiskIndices :: Gen [DiskIndex]
356
genDiskIndices = do
357
  cnt <- choose (0, C.maxDisks)
358
  genUniquesList cnt
359

    
360
-- | Generates a list of node names.
361
genNodeNames :: Gen [String]
362
genNodeNames = resize maxNodes (listOf genFQDN)
363

    
364
-- | Generates a list of node names in non-empty string type.
365
genNodeNamesNE :: Gen [NonEmptyString]
366
genNodeNamesNE = genNodeNames >>= mapM mkNonEmpty
367

    
368
-- | Gets a node name in non-empty type.
369
genNodeNameNE :: Gen NonEmptyString
370
genNodeNameNE = genFQDN >>= mkNonEmpty
371

    
372
-- | Gets a name (non-fqdn) in non-empty type.
373
genNameNE :: Gen NonEmptyString
374
genNameNE = genName >>= mkNonEmpty
375

    
376
-- | Gets a list of names (non-fqdn) in non-empty type.
377
genNamesNE :: Gen [NonEmptyString]
378
genNamesNE = resize maxNodes (listOf genNameNE)
379

    
380
-- | Returns a list of non-empty fields.
381
genFieldsNE :: Gen [NonEmptyString]
382
genFieldsNE = genFields >>= mapM mkNonEmpty
383

    
384
-- | Generate an arbitrary IPv4 address in textual form.
385
genIp4Addr :: Gen NonEmptyString
386
genIp4Addr = do
387
  a <- choose (1::Int, 255)
388
  b <- choose (0::Int, 255)
389
  c <- choose (0::Int, 255)
390
  d <- choose (0::Int, 255)
391
  mkNonEmpty $ intercalate "." (map show [a, b, c, d])
392

    
393
-- | Generate an arbitrary IPv4 network address in textual form.
394
genIp4Net :: Gen NonEmptyString
395
genIp4Net = do
396
  netmask <- choose (8::Int, 30)
397
  ip <- genIp4Addr
398
  mkNonEmpty $ fromNonEmpty ip ++ "/" ++ show netmask
399

    
400
-- | Generate a 3-byte MAC prefix.
401
genMacPrefix :: Gen NonEmptyString
402
genMacPrefix = do
403
  octets <- vectorOf 3 $ choose (0::Int, 255)
404
  mkNonEmpty . intercalate ":" $ map (printf "%02x") octets
405

    
406
-- * Test cases
407

    
408
-- | Check that opcode serialization is idempotent.
409
prop_serialization :: OpCodes.OpCode -> Property
410
prop_serialization = testSerialisation
411

    
412
-- | Check that Python and Haskell defined the same opcode list.
413
case_AllDefined :: HUnit.Assertion
414
case_AllDefined = do
415
  let py_ops = sort C.opcodesOpIds
416
      hs_ops = sort OpCodes.allOpIDs
417
      extra_py = py_ops \\ hs_ops
418
      extra_hs = hs_ops \\ py_ops
419
  HUnit.assertBool ("Missing OpCodes from the Haskell code:\n" ++
420
                    unlines extra_py) (null extra_py)
421
  HUnit.assertBool ("Extra OpCodes in the Haskell code code:\n" ++
422
                    unlines extra_hs) (null extra_hs)
423

    
424
-- | Custom HUnit test case that forks a Python process and checks
425
-- correspondence between Haskell-generated OpCodes and their Python
426
-- decoded, validated and re-encoded version.
427
--
428
-- Note that we have a strange beast here: since launching Python is
429
-- expensive, we don't do this via a usual QuickProperty, since that's
430
-- slow (I've tested it, and it's indeed quite slow). Rather, we use a
431
-- single HUnit assertion, and in it we manually use QuickCheck to
432
-- generate 500 opcodes times the number of defined opcodes, which
433
-- then we pass in bulk to Python. The drawbacks to this method are
434
-- two fold: we cannot control the number of generated opcodes, since
435
-- HUnit assertions don't get access to the test options, and for the
436
-- same reason we can't run a repeatable seed. We should probably find
437
-- a better way to do this, for example by having a
438
-- separately-launched Python process (if not running the tests would
439
-- be skipped).
440
case_py_compat :: HUnit.Assertion
441
case_py_compat = do
442
  let num_opcodes = length OpCodes.allOpIDs * 100
443
  sample_opcodes <- sample' (vectorOf num_opcodes
444
                             (arbitrary::Gen OpCodes.OpCode))
445
  let opcodes = head sample_opcodes
446
      serialized = J.encode opcodes
447
  -- check for non-ASCII fields, usually due to 'arbitrary :: String'
448
  mapM_ (\op -> when (any (not . isAscii) (J.encode op)) .
449
                HUnit.assertFailure $
450
                  "OpCode has non-ASCII fields: " ++ show op
451
        ) opcodes
452
  py_stdout <-
453
     runPython "from ganeti import opcodes\n\
454
               \import sys\n\
455
               \from ganeti import serializer\n\
456
               \op_data = serializer.Load(sys.stdin.read())\n\
457
               \decoded = [opcodes.OpCode.LoadOpCode(o) for o in op_data]\n\
458
               \for op in decoded:\n\
459
               \  op.Validate(True)\n\
460
               \encoded = [op.__getstate__() for op in decoded]\n\
461
               \print serializer.Dump(encoded)" serialized
462
     >>= checkPythonResult
463
  let deserialised = J.decode py_stdout::J.Result [OpCodes.OpCode]
464
  decoded <- case deserialised of
465
               J.Ok ops -> return ops
466
               J.Error msg ->
467
                 HUnit.assertFailure ("Unable to decode opcodes: " ++ msg)
468
                 -- this already raised an expection, but we need it
469
                 -- for proper types
470
                 >> fail "Unable to decode opcodes"
471
  HUnit.assertEqual "Mismatch in number of returned opcodes"
472
    (length opcodes) (length decoded)
473
  mapM_ (uncurry (HUnit.assertEqual "Different result after encoding/decoding")
474
        ) $ zip opcodes decoded
475

    
476
testSuite "OpCodes"
477
            [ 'prop_serialization
478
            , 'case_AllDefined
479
            , 'case_py_compat
480
            ]