Revision 8d2b6a12 htest/Test/Ganeti/Objects.hs
b/htest/Test/Ganeti/Objects.hs  

28  28  
29  29 
module Test.Ganeti.Objects 
30  30 
( testObjects 
31 
, Objects.Hypervisor(..)


32 
, Objects.Node(..)


31 
, Hypervisor(..) 

32 
, Node(..) 

33  33 
) where 
34  34  
35 
import Test.QuickCheck 

36  
35  37 
import Control.Applicative 
36  38 
import qualified Data.Map as Map 
37  39 
import qualified Data.Set as Set 
38 
import Test.QuickCheck


40 
import qualified Text.JSON as J


39  41  
40  42 
import Test.Ganeti.TestHelper 
41  43 
import Test.Ganeti.TestCommon 
42 
import qualified Ganeti.Objects as Objects 

44 
import Ganeti.Objects as Objects 

45  
46 
 * Arbitrary instances 

43  47  
44 
instance Arbitrary Objects.Hypervisor where


48 
instance Arbitrary Hypervisor where 

45  49 
arbitrary = elements [minBound..maxBound] 
46  50  
47 
instance Arbitrary Objects.PartialNDParams where


48 
arbitrary = Objects.PartialNDParams <$> arbitrary <*> arbitrary


51 
instance Arbitrary PartialNDParams where 

52 
arbitrary = PartialNDParams <$> arbitrary <*> arbitrary 

49  53  
50 
instance Arbitrary Objects.Node where


51 
arbitrary = Objects.Node <$> getFQDN <*> getFQDN <*> getFQDN


54 
instance Arbitrary Node where 

55 
arbitrary = Node <$> getFQDN <*> getFQDN <*> getFQDN 

52  56 
<*> arbitrary <*> arbitrary <*> arbitrary <*> getFQDN 
53  57 
<*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary 
54  58 
<*> arbitrary <*> arbitrary <*> getFQDN <*> arbitrary 
55  59 
<*> (Set.fromList <$> genTags) 
56  60  
61 
instance Arbitrary FileDriver where 

62 
arbitrary = elements [minBound..maxBound] 

63  
64 
instance Arbitrary BlockDriver where 

65 
arbitrary = elements [minBound..maxBound] 

66  
67 
instance Arbitrary DiskMode where 

68 
arbitrary = elements [minBound..maxBound] 

69  
70 
instance Arbitrary DiskLogicalId where 

71 
arbitrary = oneof [ LIDPlain <$> arbitrary <*> arbitrary 

72 
, LIDDrbd8 <$> getFQDN <*> getFQDN <*> arbitrary 

73 
<*> arbitrary <*> arbitrary <*> arbitrary 

74 
, LIDFile <$> arbitrary <*> arbitrary 

75 
, LIDBlockDev <$> arbitrary <*> arbitrary 

76 
, LIDRados <$> arbitrary <*> arbitrary 

77 
] 

78  
79 
  'Disk' 'arbitrary' instance. Since we don't test disk hierarchy 

80 
 properties, we only generate disks with no children (FIXME), as 

81 
 generating recursive datastructures is a bit more work. 

82 
instance Arbitrary Disk where 

83 
arbitrary = Disk <$> arbitrary <*> (pure []) <*> arbitrary 

84 
<*> arbitrary <*> arbitrary 

85  
86 
 * Test properties 

87  
57  88 
  Tests that fillDict behaves correctly 
58  89 
prop_fillDict :: [(Int, Int)] > [(Int, Int)] > Property 
59  90 
prop_fillDict defaults custom = 
...  ...  
62  93 
c_map = Map.fromList custom 
63  94 
c_keys = map fst custom 
64  95 
in printTestCase "Empty custom filling" 
65 
(Objects.fillDict d_map Map.empty [] == d_map) .&&.


96 
(fillDict d_map Map.empty [] == d_map) .&&. 

66  97 
printTestCase "Empty defaults filling" 
67 
(Objects.fillDict Map.empty c_map [] == c_map) .&&.


98 
(fillDict Map.empty c_map [] == c_map) .&&. 

68  99 
printTestCase "Delete all keys" 
69 
(Objects.fillDict d_map c_map (d_keys++c_keys) == Map.empty) 

100 
(fillDict d_map c_map (d_keys++c_keys) == Map.empty) 

101  
102 
  Test that the serialisation of 'DiskLogicalId', which is 

103 
 implemented manually, is idempotent. Since we don't have a 

104 
 standalone JSON instance for DiskLogicalId (it's a data type that 

105 
 expands over two fields in a JSObject), we test this by actially 

106 
 testing entire Disk serialisations. So this tests two things at 

107 
 once, basically. 

108 
prop_Disk_serialisation :: Disk > Property 

109 
prop_Disk_serialisation disk = 

110 
J.readJSON (J.showJSON disk) ==? J.Ok disk 

111  
112 
  Check that node serialisation is idempotent. 

113 
prop_Node_serialisation :: Node > Property 

114 
prop_Node_serialisation node = 

115 
J.readJSON (J.showJSON node) ==? J.Ok node 

70  116  
71  117 
testSuite "Objects" 
72  118 
[ 'prop_fillDict 
119 
, 'prop_Disk_serialisation 

120 
, 'prop_Node_serialisation 

73  121 
] 
Also available in: Unified diff