1 {-# LANGUAGE TemplateHaskell #-}
2 {-# OPTIONS_GHC -fno-warn-orphans #-}
4 {-| Unittests for ganeti-htools.
10 Copyright (C) 2009, 2010, 2011, 2012, 2013 Google Inc.
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.
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.
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
29 module Test.Ganeti.OpCodes
34 import Test.HUnit as HUnit
35 import Test.QuickCheck as QuickCheck
37 import Control.Applicative
41 import qualified Data.Map as Map
42 import qualified Text.JSON as J
43 import Text.Printf (printf)
45 import Test.Ganeti.TestHelper
46 import Test.Ganeti.TestCommon
47 import Test.Ganeti.Types ()
48 import Test.Ganeti.Query.Language
50 import Ganeti.BasicTypes
51 import qualified Ganeti.Constants as C
52 import qualified Ganeti.OpCodes as OpCodes
54 import Ganeti.OpParams
57 {-# ANN module "HLint: ignore Use camelCase" #-}
59 -- * Arbitrary instances
61 instance Arbitrary OpCodes.TagObject where
62 arbitrary = oneof [ OpCodes.TagInstance <$> genFQDN
63 , OpCodes.TagNode <$> genFQDN
64 , OpCodes.TagGroup <$> genFQDN
65 , pure OpCodes.TagCluster
68 $(genArbitrary ''OpCodes.ReplaceDisksMode)
70 $(genArbitrary ''DiskAccess)
72 instance Arbitrary OpCodes.DiskIndex where
73 arbitrary = choose (0, C.maxDisks - 1) >>= OpCodes.mkDiskIndex
75 instance Arbitrary INicParams where
76 arbitrary = INicParams <$> genMaybe genNameNE <*> genMaybe genName <*>
77 genMaybe genNameNE <*> genMaybe genNameNE <*> genMaybe genNameNE
79 instance Arbitrary IDiskParams where
80 arbitrary = IDiskParams <$> arbitrary <*> arbitrary <*>
81 genMaybe genNameNE <*> genMaybe genNameNE <*>
82 genMaybe genNameNE <*> genMaybe genNameNE
84 instance Arbitrary RecreateDisksInfo where
85 arbitrary = oneof [ pure RecreateDisksAll
86 , RecreateDisksIndices <$> arbitrary
87 , RecreateDisksParams <$> arbitrary
90 instance Arbitrary DdmOldChanges where
91 arbitrary = oneof [ DdmOldIndex <$> arbitrary
92 , DdmOldMod <$> arbitrary
95 instance (Arbitrary a) => Arbitrary (SetParamsMods a) where
96 arbitrary = oneof [ pure SetParamsEmpty
97 , SetParamsDeprecated <$> arbitrary
98 , SetParamsNew <$> arbitrary
101 instance Arbitrary ExportTarget where
102 arbitrary = oneof [ ExportTargetLocal <$> genNodeNameNE
103 , ExportTargetRemote <$> pure []
106 instance Arbitrary OpCodes.OpCode where
108 op_id <- elements OpCodes.allOpIDs
111 OpCodes.OpTestDelay <$> arbitrary <*> arbitrary <*>
112 genNodeNamesNE <*> arbitrary
113 "OP_INSTANCE_REPLACE_DISKS" ->
114 OpCodes.OpInstanceReplaceDisks <$> genFQDN <*> arbitrary <*>
115 arbitrary <*> arbitrary <*> genDiskIndices <*>
116 genMaybe genNodeNameNE <*> genMaybe genNameNE
117 "OP_INSTANCE_FAILOVER" ->
118 OpCodes.OpInstanceFailover <$> genFQDN <*> arbitrary <*> arbitrary <*>
119 genMaybe genNodeNameNE <*> arbitrary <*> genMaybe genNameNE
120 "OP_INSTANCE_MIGRATE" ->
121 OpCodes.OpInstanceMigrate <$> genFQDN <*> arbitrary <*> arbitrary <*>
122 genMaybe genNodeNameNE <*> arbitrary <*>
123 arbitrary <*> arbitrary <*> genMaybe genNameNE <*> arbitrary
125 OpCodes.OpTagsGet <$> arbitrary <*> arbitrary
127 OpCodes.OpTagsSearch <$> genNameNE
129 OpCodes.OpTagsSet <$> arbitrary <*> genTags
131 OpCodes.OpTagsSet <$> arbitrary <*> genTags
132 "OP_CLUSTER_POST_INIT" -> pure OpCodes.OpClusterPostInit
133 "OP_CLUSTER_DESTROY" -> pure OpCodes.OpClusterDestroy
134 "OP_CLUSTER_QUERY" -> pure OpCodes.OpClusterQuery
135 "OP_CLUSTER_VERIFY" ->
136 OpCodes.OpClusterVerify <$> arbitrary <*> arbitrary <*>
137 genSet Nothing <*> genSet Nothing <*> arbitrary <*>
139 "OP_CLUSTER_VERIFY_CONFIG" ->
140 OpCodes.OpClusterVerifyConfig <$> arbitrary <*> arbitrary <*>
141 genSet Nothing <*> arbitrary
142 "OP_CLUSTER_VERIFY_GROUP" ->
143 OpCodes.OpClusterVerifyGroup <$> genNameNE <*> arbitrary <*>
144 arbitrary <*> genSet Nothing <*> genSet Nothing <*> arbitrary
145 "OP_CLUSTER_VERIFY_DISKS" -> pure OpCodes.OpClusterVerifyDisks
146 "OP_GROUP_VERIFY_DISKS" ->
147 OpCodes.OpGroupVerifyDisks <$> genNameNE
148 "OP_CLUSTER_REPAIR_DISK_SIZES" ->
149 OpCodes.OpClusterRepairDiskSizes <$> genNodeNamesNE
150 "OP_CLUSTER_CONFIG_QUERY" ->
151 OpCodes.OpClusterConfigQuery <$> genFieldsNE
152 "OP_CLUSTER_RENAME" ->
153 OpCodes.OpClusterRename <$> genNameNE
154 "OP_CLUSTER_SET_PARAMS" ->
155 OpCodes.OpClusterSetParams <$> arbitrary <*> emptyMUD <*> emptyMUD <*>
156 arbitrary <*> genMaybe (listOf1 arbitrary >>= mkNonEmpty) <*>
157 genMaybe genEmptyContainer <*> emptyMUD <*>
158 genMaybe genEmptyContainer <*> genMaybe genEmptyContainer <*>
159 genMaybe genEmptyContainer <*> genMaybe arbitrary <*>
160 arbitrary <*> arbitrary <*> arbitrary <*>
161 arbitrary <*> arbitrary <*> arbitrary <*>
162 emptyMUD <*> emptyMUD <*> arbitrary <*>
163 arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*>
164 arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary
165 "OP_CLUSTER_REDIST_CONF" -> pure OpCodes.OpClusterRedistConf
166 "OP_CLUSTER_ACTIVATE_MASTER_IP" ->
167 pure OpCodes.OpClusterActivateMasterIp
168 "OP_CLUSTER_DEACTIVATE_MASTER_IP" ->
169 pure OpCodes.OpClusterDeactivateMasterIp
171 OpCodes.OpQuery <$> arbitrary <*> arbitrary <*> arbitrary <*> genFilter
173 OpCodes.OpQueryFields <$> arbitrary <*> arbitrary
175 OpCodes.OpOobCommand <$> genNodeNamesNE <*> arbitrary <*>
176 arbitrary <*> arbitrary <*> (arbitrary `suchThat` (>0))
177 "OP_NODE_REMOVE" -> OpCodes.OpNodeRemove <$> genNodeNameNE
179 OpCodes.OpNodeAdd <$> genNodeNameNE <*> emptyMUD <*> emptyMUD <*>
180 genMaybe genName <*> genMaybe genNameNE <*> arbitrary <*>
181 genMaybe genNameNE <*> arbitrary <*> arbitrary <*> emptyMUD
183 OpCodes.OpNodeQuery <$> genFieldsNE <*> genNamesNE <*> arbitrary
184 "OP_NODE_QUERYVOLS" ->
185 OpCodes.OpNodeQueryvols <$> arbitrary <*> genNodeNamesNE
186 "OP_NODE_QUERY_STORAGE" ->
187 OpCodes.OpNodeQueryStorage <$> arbitrary <*> arbitrary <*>
188 genNodeNamesNE <*> genNameNE
189 "OP_NODE_MODIFY_STORAGE" ->
190 OpCodes.OpNodeModifyStorage <$> genNodeNameNE <*> arbitrary <*>
191 genNameNE <*> pure emptyJSObject
192 "OP_REPAIR_NODE_STORAGE" ->
193 OpCodes.OpRepairNodeStorage <$> genNodeNameNE <*> arbitrary <*>
194 genNameNE <*> arbitrary
195 "OP_NODE_SET_PARAMS" ->
196 OpCodes.OpNodeSetParams <$> genNodeNameNE <*> arbitrary <*>
197 emptyMUD <*> emptyMUD <*> arbitrary <*> arbitrary <*> arbitrary <*>
198 arbitrary <*> arbitrary <*> arbitrary <*> genMaybe genNameNE <*>
199 emptyMUD <*> arbitrary
200 "OP_NODE_POWERCYCLE" ->
201 OpCodes.OpNodePowercycle <$> genNodeNameNE <*> arbitrary
203 OpCodes.OpNodeMigrate <$> genNodeNameNE <*> arbitrary <*>
204 arbitrary <*> genMaybe genNodeNameNE <*> arbitrary <*>
205 arbitrary <*> genMaybe genNameNE
206 "OP_NODE_EVACUATE" ->
207 OpCodes.OpNodeEvacuate <$> arbitrary <*> genNodeNameNE <*>
208 genMaybe genNodeNameNE <*> genMaybe genNameNE <*> arbitrary
209 "OP_INSTANCE_CREATE" ->
210 OpCodes.OpInstanceCreate <$> genFQDN <*> arbitrary <*>
211 arbitrary <*> arbitrary <*> arbitrary <*> pure emptyJSObject <*>
212 arbitrary <*> arbitrary <*> arbitrary <*> genMaybe genNameNE <*>
213 pure emptyJSObject <*> arbitrary <*> genMaybe genNameNE <*>
214 arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*>
215 arbitrary <*> arbitrary <*> pure emptyJSObject <*>
216 genMaybe genNameNE <*>
217 genMaybe genNodeNameNE <*> genMaybe genNodeNameNE <*>
218 genMaybe (pure []) <*> genMaybe genNodeNameNE <*>
219 arbitrary <*> genMaybe genNodeNameNE <*>
220 genMaybe genNodeNameNE <*> genMaybe genNameNE <*>
221 arbitrary <*> arbitrary <*> (genTags >>= mapM mkNonEmpty)
222 "OP_INSTANCE_MULTI_ALLOC" ->
223 OpCodes.OpInstanceMultiAlloc <$> genMaybe genNameNE <*> pure [] <*>
225 "OP_INSTANCE_REINSTALL" ->
226 OpCodes.OpInstanceReinstall <$> genFQDN <*> arbitrary <*>
227 genMaybe genNameNE <*> genMaybe (pure emptyJSObject)
228 "OP_INSTANCE_REMOVE" ->
229 OpCodes.OpInstanceRemove <$> genFQDN <*> arbitrary <*> arbitrary
230 "OP_INSTANCE_RENAME" ->
231 OpCodes.OpInstanceRename <$> genFQDN <*> genNodeNameNE <*>
232 arbitrary <*> arbitrary
233 "OP_INSTANCE_STARTUP" ->
234 OpCodes.OpInstanceStartup <$> genFQDN <*> arbitrary <*> arbitrary <*>
235 pure emptyJSObject <*> pure emptyJSObject <*>
236 arbitrary <*> arbitrary
237 "OP_INSTANCE_SHUTDOWN" ->
238 OpCodes.OpInstanceShutdown <$> genFQDN <*> arbitrary <*> arbitrary <*>
239 arbitrary <*> arbitrary
240 "OP_INSTANCE_REBOOT" ->
241 OpCodes.OpInstanceReboot <$> genFQDN <*> arbitrary <*>
242 arbitrary <*> arbitrary
243 "OP_INSTANCE_MOVE" ->
244 OpCodes.OpInstanceMove <$> genFQDN <*> arbitrary <*> arbitrary <*>
245 genNodeNameNE <*> arbitrary
246 "OP_INSTANCE_CONSOLE" -> OpCodes.OpInstanceConsole <$> genFQDN
247 "OP_INSTANCE_ACTIVATE_DISKS" ->
248 OpCodes.OpInstanceActivateDisks <$> genFQDN <*>
249 arbitrary <*> arbitrary
250 "OP_INSTANCE_DEACTIVATE_DISKS" ->
251 OpCodes.OpInstanceDeactivateDisks <$> genFQDN <*> arbitrary
252 "OP_INSTANCE_RECREATE_DISKS" ->
253 OpCodes.OpInstanceRecreateDisks <$> genFQDN <*> arbitrary <*>
254 genNodeNamesNE <*> genMaybe genNameNE
255 "OP_INSTANCE_QUERY" ->
256 OpCodes.OpInstanceQuery <$> genFieldsNE <*> genNamesNE <*> arbitrary
257 "OP_INSTANCE_QUERY_DATA" ->
258 OpCodes.OpInstanceQueryData <$> arbitrary <*>
259 genNodeNamesNE <*> arbitrary
260 "OP_INSTANCE_SET_PARAMS" ->
261 OpCodes.OpInstanceSetParams <$> genFQDN <*> arbitrary <*>
262 arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*>
263 pure emptyJSObject <*> arbitrary <*> pure emptyJSObject <*>
264 arbitrary <*> genMaybe genNodeNameNE <*> genMaybe genNodeNameNE <*>
265 genMaybe genNameNE <*> pure emptyJSObject <*> arbitrary <*>
266 arbitrary <*> arbitrary
267 "OP_INSTANCE_GROW_DISK" ->
268 OpCodes.OpInstanceGrowDisk <$> genFQDN <*> arbitrary <*>
269 arbitrary <*> arbitrary <*> arbitrary
270 "OP_INSTANCE_CHANGE_GROUP" ->
271 OpCodes.OpInstanceChangeGroup <$> genFQDN <*> arbitrary <*>
272 genMaybe genNameNE <*> genMaybe (resize maxNodes (listOf genNameNE))
274 OpCodes.OpGroupAdd <$> genNameNE <*> arbitrary <*>
275 emptyMUD <*> genMaybe genEmptyContainer <*>
276 emptyMUD <*> emptyMUD <*> emptyMUD
277 "OP_GROUP_ASSIGN_NODES" ->
278 OpCodes.OpGroupAssignNodes <$> genNameNE <*> arbitrary <*>
281 OpCodes.OpGroupQuery <$> genFieldsNE <*> genNamesNE
282 "OP_GROUP_SET_PARAMS" ->
283 OpCodes.OpGroupSetParams <$> genNameNE <*> arbitrary <*>
284 emptyMUD <*> genMaybe genEmptyContainer <*>
285 emptyMUD <*> emptyMUD <*> emptyMUD
287 OpCodes.OpGroupRemove <$> genNameNE
289 OpCodes.OpGroupRename <$> genNameNE <*> genNameNE
290 "OP_GROUP_EVACUATE" ->
291 OpCodes.OpGroupEvacuate <$> genNameNE <*> arbitrary <*>
292 genMaybe genNameNE <*> genMaybe genNamesNE
294 OpCodes.OpOsDiagnose <$> genFieldsNE <*> genNamesNE
295 "OP_EXT_STORAGE_DIAGNOSE" ->
296 OpCodes.OpOsDiagnose <$> genFieldsNE <*> genNamesNE
298 OpCodes.OpBackupQuery <$> arbitrary <*> genNodeNamesNE
299 "OP_BACKUP_PREPARE" ->
300 OpCodes.OpBackupPrepare <$> genFQDN <*> arbitrary
301 "OP_BACKUP_EXPORT" ->
302 OpCodes.OpBackupExport <$> genFQDN <*> arbitrary <*>
303 arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*>
304 arbitrary <*> genMaybe (pure []) <*> genMaybe genNameNE
305 "OP_BACKUP_REMOVE" ->
306 OpCodes.OpBackupRemove <$> genFQDN
307 "OP_TEST_ALLOCATOR" ->
308 OpCodes.OpTestAllocator <$> arbitrary <*> arbitrary <*>
309 genNameNE <*> pure [] <*> pure [] <*>
310 arbitrary <*> genMaybe genNameNE <*>
311 (genTags >>= mapM mkNonEmpty) <*>
312 arbitrary <*> arbitrary <*> genMaybe genNameNE <*>
313 arbitrary <*> genMaybe genNodeNamesNE <*> arbitrary <*>
314 genMaybe genNamesNE <*> arbitrary <*> arbitrary
316 OpCodes.OpTestJqueue <$> arbitrary <*> arbitrary <*>
317 resize 20 (listOf genFQDN) <*> arbitrary
319 OpCodes.OpTestDummy <$> pure J.JSNull <*> pure J.JSNull <*>
320 pure J.JSNull <*> pure J.JSNull
322 OpCodes.OpNetworkAdd <$> genNameNE <*> genIp4Net <*>
323 genMaybe genIp4Addr <*> pure Nothing <*> pure Nothing <*>
324 genMaybe genMacPrefix <*> genMaybe (listOf genIp4Addr) <*>
325 arbitrary <*> (genTags >>= mapM mkNonEmpty)
326 "OP_NETWORK_REMOVE" ->
327 OpCodes.OpNetworkRemove <$> genNameNE <*> arbitrary
328 "OP_NETWORK_SET_PARAMS" ->
329 OpCodes.OpNetworkSetParams <$> genNameNE <*>
330 genMaybe genIp4Addr <*> pure Nothing <*> pure Nothing <*>
331 genMaybe genMacPrefix <*> genMaybe (listOf genIp4Addr) <*>
332 genMaybe (listOf genIp4Addr)
333 "OP_NETWORK_CONNECT" ->
334 OpCodes.OpNetworkConnect <$> genNameNE <*> genNameNE <*>
335 arbitrary <*> genNameNE <*> arbitrary
336 "OP_NETWORK_DISCONNECT" ->
337 OpCodes.OpNetworkDisconnect <$> genNameNE <*> genNameNE
338 "OP_NETWORK_QUERY" ->
339 OpCodes.OpNetworkQuery <$> genFieldsNE <*> genNamesNE <*> arbitrary
340 "OP_RESTRICTED_COMMAND" ->
341 OpCodes.OpRestrictedCommand <$> arbitrary <*> genNodeNamesNE <*>
343 _ -> fail $ "Undefined arbitrary for opcode " ++ op_id
345 -- | Generates one element of a reason trail
346 genReasonElem :: Gen ReasonElem
347 genReasonElem = (,,) <$> genFQDN <*> genFQDN <*> arbitrary
349 -- | Generates a reason trail
350 genReasonTrail :: Gen ReasonTrail
352 size <- choose (0, 10)
353 vectorOf size genReasonElem
355 instance Arbitrary OpCodes.CommonOpParams where
356 arbitrary = OpCodes.CommonOpParams <$> arbitrary <*> arbitrary <*>
357 arbitrary <*> resize 5 arbitrary <*> genMaybe genName <*>
360 -- * Helper functions
363 emptyJSObject :: J.JSObject J.JSValue
364 emptyJSObject = J.toJSObject []
366 -- | Empty maybe unchecked dictionary.
367 emptyMUD :: Gen (Maybe (J.JSObject J.JSValue))
368 emptyMUD = genMaybe $ pure emptyJSObject
370 -- | Generates an empty container.
371 genEmptyContainer :: (Ord a) => Gen (GenericContainer a b)
372 genEmptyContainer = pure . GenericContainer $ Map.fromList []
374 -- | Generates list of disk indices.
375 genDiskIndices :: Gen [DiskIndex]
377 cnt <- choose (0, C.maxDisks)
378 genUniquesList cnt arbitrary
380 -- | Generates a list of node names.
381 genNodeNames :: Gen [String]
382 genNodeNames = resize maxNodes (listOf genFQDN)
384 -- | Generates a list of node names in non-empty string type.
385 genNodeNamesNE :: Gen [NonEmptyString]
386 genNodeNamesNE = genNodeNames >>= mapM mkNonEmpty
388 -- | Gets a node name in non-empty type.
389 genNodeNameNE :: Gen NonEmptyString
390 genNodeNameNE = genFQDN >>= mkNonEmpty
392 -- | Gets a name (non-fqdn) in non-empty type.
393 genNameNE :: Gen NonEmptyString
394 genNameNE = genName >>= mkNonEmpty
396 -- | Gets a list of names (non-fqdn) in non-empty type.
397 genNamesNE :: Gen [NonEmptyString]
398 genNamesNE = resize maxNodes (listOf genNameNE)
400 -- | Returns a list of non-empty fields.
401 genFieldsNE :: Gen [NonEmptyString]
402 genFieldsNE = genFields >>= mapM mkNonEmpty
404 -- | Generate a 3-byte MAC prefix.
405 genMacPrefix :: Gen NonEmptyString
407 octets <- vectorOf 3 $ choose (0::Int, 255)
408 mkNonEmpty . intercalate ":" $ map (printf "%02x") octets
410 -- | Arbitrary instance for MetaOpCode, defined here due to TH ordering.
411 $(genArbitrary ''OpCodes.MetaOpCode)
413 -- | Small helper to check for a failed JSON deserialisation
414 isJsonError :: J.Result a -> Bool
415 isJsonError (J.Error _) = True
416 isJsonError _ = False
420 -- | Check that opcode serialization is idempotent.
421 prop_serialization :: OpCodes.OpCode -> Property
422 prop_serialization = testSerialisation
424 -- | Check that Python and Haskell defined the same opcode list.
425 case_AllDefined :: HUnit.Assertion
427 let py_ops = sort C.opcodesOpIds
428 hs_ops = sort OpCodes.allOpIDs
429 extra_py = py_ops \\ hs_ops
430 extra_hs = hs_ops \\ py_ops
431 HUnit.assertBool ("Missing OpCodes from the Haskell code:\n" ++
432 unlines extra_py) (null extra_py)
433 HUnit.assertBool ("Extra OpCodes in the Haskell code code:\n" ++
434 unlines extra_hs) (null extra_hs)
436 -- | Custom HUnit test case that forks a Python process and checks
437 -- correspondence between Haskell-generated OpCodes and their Python
438 -- decoded, validated and re-encoded version.
440 -- Note that we have a strange beast here: since launching Python is
441 -- expensive, we don't do this via a usual QuickProperty, since that's
442 -- slow (I've tested it, and it's indeed quite slow). Rather, we use a
443 -- single HUnit assertion, and in it we manually use QuickCheck to
444 -- generate 500 opcodes times the number of defined opcodes, which
445 -- then we pass in bulk to Python. The drawbacks to this method are
446 -- two fold: we cannot control the number of generated opcodes, since
447 -- HUnit assertions don't get access to the test options, and for the
448 -- same reason we can't run a repeatable seed. We should probably find
449 -- a better way to do this, for example by having a
450 -- separately-launched Python process (if not running the tests would
452 case_py_compat_types :: HUnit.Assertion
453 case_py_compat_types = do
454 let num_opcodes = length OpCodes.allOpIDs * 100
455 opcodes <- genSample (vectorOf num_opcodes
456 (arbitrary::Gen OpCodes.MetaOpCode))
457 let with_sum = map (\o -> (OpCodes.opSummary $
458 OpCodes.metaOpCode o, o)) opcodes
459 serialized = J.encode opcodes
460 -- check for non-ASCII fields, usually due to 'arbitrary :: String'
461 mapM_ (\op -> when (any (not . isAscii) (J.encode op)) .
462 HUnit.assertFailure $
463 "OpCode has non-ASCII fields: " ++ show op
466 runPython "from ganeti import opcodes\n\
468 \from ganeti import serializer\n\
469 \op_data = serializer.Load(sys.stdin.read())\n\
470 \decoded = [opcodes.OpCode.LoadOpCode(o) for o in op_data]\n\
471 \for op in decoded:\n\
472 \ op.Validate(True)\n\
473 \encoded = [(op.Summary(), op.__getstate__())\n\
474 \ for op in decoded]\n\
475 \print serializer.Dump(encoded)" serialized
476 >>= checkPythonResult
478 J.decode py_stdout::J.Result [(String, OpCodes.MetaOpCode)]
479 decoded <- case deserialised of
480 J.Ok ops -> return ops
482 HUnit.assertFailure ("Unable to decode opcodes: " ++ msg)
483 -- this already raised an expection, but we need it
485 >> fail "Unable to decode opcodes"
486 HUnit.assertEqual "Mismatch in number of returned opcodes"
487 (length decoded) (length with_sum)
488 mapM_ (uncurry (HUnit.assertEqual "Different result after encoding/decoding")
489 ) $ zip decoded with_sum
491 -- | Custom HUnit test case that forks a Python process and checks
492 -- correspondence between Haskell OpCodes fields and their Python
494 case_py_compat_fields :: HUnit.Assertion
495 case_py_compat_fields = do
496 let hs_fields = sort $ map (\op_id -> (op_id, OpCodes.allOpFields op_id))
499 runPython "from ganeti import opcodes\n\
501 \from ganeti import serializer\n\
502 \fields = [(k, sorted([p[0] for p in v.OP_PARAMS]))\n\
503 \ for k, v in opcodes.OP_MAPPING.items()]\n\
504 \print serializer.Dump(fields)" ""
505 >>= checkPythonResult
506 let deserialised = J.decode py_stdout::J.Result [(String, [String])]
507 py_fields <- case deserialised of
508 J.Ok v -> return $ sort v
510 HUnit.assertFailure ("Unable to decode op fields: " ++ msg)
511 -- this already raised an expection, but we need it
513 >> fail "Unable to decode op fields"
514 HUnit.assertEqual "Mismatch in number of returned opcodes"
515 (length hs_fields) (length py_fields)
516 HUnit.assertEqual "Mismatch in defined OP_IDs"
517 (map fst hs_fields) (map fst py_fields)
518 mapM_ (\((py_id, py_flds), (hs_id, hs_flds)) -> do
519 HUnit.assertEqual "Mismatch in OP_ID" py_id hs_id
520 HUnit.assertEqual ("Mismatch in fields for " ++ hs_id)
522 ) $ zip py_fields hs_fields
524 -- | Checks that setOpComment works correctly.
525 prop_setOpComment :: OpCodes.MetaOpCode -> String -> Property
526 prop_setOpComment op comment =
527 let (OpCodes.MetaOpCode common _) = OpCodes.setOpComment comment op
528 in OpCodes.opComment common ==? Just comment
530 -- | Tests wrong tag object building (cluster takes only jsnull, the
531 -- other take a string, so we test the opposites).
532 case_TagObject_fail :: Assertion
533 case_TagObject_fail =
534 mapM_ (\(t, j) -> assertEqual (show t ++ "/" ++ J.encode j) Nothing $
536 [ (TagTypeCluster, J.showJSON "abc")
537 , (TagTypeInstance, J.JSNull)
538 , (TagTypeNode, J.JSNull)
539 , (TagTypeGroup, J.JSNull)
542 -- | Tests wrong (negative) disk index.
543 prop_mkDiskIndex_fail :: QuickCheck.Positive Int -> Property
544 prop_mkDiskIndex_fail (Positive i) =
545 case mkDiskIndex (negate i) of
546 Bad msg -> printTestCase "error message " $
547 "Invalid value" `isPrefixOf` msg
548 Ok v -> failTest $ "Succeeded to build disk index '" ++ show v ++
549 "' from negative value " ++ show (negate i)
551 -- | Tests a few invalid 'readRecreateDisks' cases.
552 case_readRecreateDisks_fail :: Assertion
553 case_readRecreateDisks_fail = do
555 isJsonError (J.readJSON J.JSNull::J.Result RecreateDisksInfo)
556 assertBool "string" $
557 isJsonError (J.readJSON (J.showJSON "abc")::J.Result RecreateDisksInfo)
559 -- | Tests a few invalid 'readDdmOldChanges' cases.
560 case_readDdmOldChanges_fail :: Assertion
561 case_readDdmOldChanges_fail = do
563 isJsonError (J.readJSON J.JSNull::J.Result DdmOldChanges)
564 assertBool "string" $
565 isJsonError (J.readJSON (J.showJSON "abc")::J.Result DdmOldChanges)
567 -- | Tests a few invalid 'readExportTarget' cases.
568 case_readExportTarget_fail :: Assertion
569 case_readExportTarget_fail = do
571 isJsonError (J.readJSON J.JSNull::J.Result ExportTarget)
573 isJsonError (J.readJSON (J.showJSON (5::Int))::J.Result ExportTarget)
576 [ 'prop_serialization
578 , 'case_py_compat_types
579 , 'case_py_compat_fields
581 , 'case_TagObject_fail
582 , 'prop_mkDiskIndex_fail
583 , 'case_readRecreateDisks_fail
584 , 'case_readDdmOldChanges_fail
585 , 'case_readExportTarget_fail