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 |
]
|