Revision f56013fd

b/htest/Test/Ganeti/OpCodes.hs
31 31
  , OpCodes.OpCode(..)
32 32
  ) where
33 33

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

  
37 37
import Control.Applicative
38 38
import Control.Monad
......
47 47
import Test.Ganeti.Types ()
48 48
import Test.Ganeti.Query.Language
49 49

  
50
import Ganeti.BasicTypes
50 51
import qualified Ganeti.Constants as C
51 52
import qualified Ganeti.OpCodes as OpCodes
52 53
import Ganeti.Types
......
395 396
-- | Arbitrary instance for MetaOpCode, defined here due to TH ordering.
396 397
$(genArbitrary ''OpCodes.MetaOpCode)
397 398

  
399
-- | Small helper to check for a failed JSON deserialisation
400
isJsonError :: J.Result a -> Bool
401
isJsonError (J.Error _) = True
402
isJsonError _           = False
403

  
398 404
-- * Test cases
399 405

  
400 406
-- | Check that opcode serialization is idempotent.
......
508 514
  let (OpCodes.MetaOpCode common _) = OpCodes.setOpComment comment op
509 515
  in OpCodes.opComment common ==? Just comment
510 516

  
517
-- | Tests wrong tag object building (cluster takes only jsnull, the
518
-- other take a string, so we test the opposites).
519
case_TagObject_fail :: Assertion
520
case_TagObject_fail =
521
  mapM_ (\(t, j) -> assertEqual (show t ++ "/" ++ J.encode j) Nothing $
522
                    tagObjectFrom t j)
523
    [ (TagTypeCluster,  J.showJSON "abc")
524
    , (TagTypeInstance, J.JSNull)
525
    , (TagTypeNode,     J.JSNull)
526
    , (TagTypeGroup,    J.JSNull)
527
    ]
528

  
529
-- | Tests wrong (negative) disk index.
530
prop_mkDiskIndex_fail :: QuickCheck.Positive Int -> Property
531
prop_mkDiskIndex_fail (Positive i) =
532
  case mkDiskIndex (negate i) of
533
    Bad msg -> printTestCase "error message " $
534
               "Invalid value" `isPrefixOf` msg
535
    Ok v -> failTest $ "Succeeded to build disk index '" ++ show v ++
536
                       "' from negative value " ++ show (negate i)
537

  
538
-- | Tests a few invalid 'readRecreateDisks' cases.
539
case_readRecreateDisks_fail :: Assertion
540
case_readRecreateDisks_fail = do
541
  assertBool "null" $
542
    isJsonError (J.readJSON J.JSNull::J.Result RecreateDisksInfo)
543
  assertBool "string" $
544
    isJsonError (J.readJSON (J.showJSON "abc")::J.Result RecreateDisksInfo)
545

  
546
-- | Tests a few invalid 'readDdmOldChanges' cases.
547
case_readDdmOldChanges_fail :: Assertion
548
case_readDdmOldChanges_fail = do
549
  assertBool "null" $
550
    isJsonError (J.readJSON J.JSNull::J.Result DdmOldChanges)
551
  assertBool "string" $
552
    isJsonError (J.readJSON (J.showJSON "abc")::J.Result DdmOldChanges)
553

  
554
-- | Tests a few invalid 'readExportTarget' cases.
555
case_readExportTarget_fail :: Assertion
556
case_readExportTarget_fail = do
557
  assertBool "null" $
558
    isJsonError (J.readJSON J.JSNull::J.Result ExportTarget)
559
  assertBool "int" $
560
    isJsonError (J.readJSON (J.showJSON (5::Int))::J.Result ExportTarget)
561

  
511 562
testSuite "OpCodes"
512 563
            [ 'prop_serialization
513 564
            , 'case_AllDefined
514 565
            , 'case_py_compat_types
515 566
            , 'case_py_compat_fields
516 567
            , 'prop_setOpComment
568
            , 'case_TagObject_fail
569
            , 'prop_mkDiskIndex_fail
570
            , 'case_readRecreateDisks_fail
571
            , 'case_readDdmOldChanges_fail
572
            , 'case_readExportTarget_fail
517 573
            ]
b/htools/Ganeti/OpParams.hs
432 432
    _ -> case readJSON v::Text.JSON.Result [(DiskIndex, IDiskParams)] of
433 433
           Text.JSON.Ok params -> liftM RecreateDisksParams (mkNonEmpty params)
434 434
           _ -> fail $ "Can't parse disk information as either list of disk"
435
                ++ " indices or list of disk parameters; value recevied:"
435
                ++ " indices or list of disk parameters; value received:"
436 436
                ++ show (pp_value v)
437 437

  
438 438
instance JSON RecreateDisksInfo where

Also available in: Unified diff