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