Statistics
| Branch: | Tag: | Revision:

root / htest / Test / Ganeti / OpCodes.hs @ dc4b5c42

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

    
339
-- * Helper functions
340

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

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

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

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

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

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

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

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

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

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

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

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

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

    
405
-- * Test cases
406

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

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

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

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