Revision 9924d61e htest/Test/Ganeti/Objects.hs

b/htest/Test/Ganeti/Objects.hs
1
{-# LANGUAGE TemplateHaskell #-}
1
{-# LANGUAGE TemplateHaskell, TypeSynonymInstances, FlexibleInstances #-}
2 2
{-# OPTIONS_GHC -fno-warn-orphans #-}
3 3

  
4 4
{-| Unittests for ganeti-htools.
......
28 28

  
29 29
module Test.Ganeti.Objects
30 30
  ( testObjects
31
  , testSlowObjects
31 32
  , Hypervisor(..)
32 33
  , Node(..)
34
  , genEmptyCluster
33 35
  ) where
34 36

  
35 37
import Test.QuickCheck
......
40 42

  
41 43
import Test.Ganeti.TestHelper
42 44
import Test.Ganeti.TestCommon
45

  
46
import qualified Ganeti.Constants as C
43 47
import Ganeti.Objects as Objects
44 48
import Ganeti.JSON
45 49

  
......
111 115
      -- tags
112 116
      <*> (Set.fromList <$> genTags)
113 117

  
118
-- | FIXME: This generates completely random data, without normal
119
-- validation rules.
120
$(genArbitrary ''PartialISpecParams)
121

  
122
-- | FIXME: This generates completely random data, without normal
123
-- validation rules.
124
$(genArbitrary ''PartialIPolicy)
125

  
126
-- | FIXME: This generates completely random data, without normal
127
-- validation rules.
128
instance Arbitrary NodeGroup where
129
  arbitrary = NodeGroup <$> getFQDN <*> pure [] <*> arbitrary <*> arbitrary
130
                        <*> arbitrary <*> (pure $ Container Map.empty)
131
                        -- ts
132
                        <*> arbitrary <*> arbitrary
133
                        -- uuid
134
                        <*> arbitrary
135
                        -- serial
136
                        <*> arbitrary
137
                        -- tags
138
                        <*> (Set.fromList <$> genTags)
139

  
140
$(genArbitrary ''AllocPolicy)
141
$(genArbitrary ''FilledISpecParams)
142
$(genArbitrary ''FilledIPolicy)
143
$(genArbitrary ''IpFamily)
144
$(genArbitrary ''FilledNDParams)
145
$(genArbitrary ''FilledNicParams)
146
$(genArbitrary ''FilledBeParams)
147

  
148
-- | No real arbitrary instance for 'ClusterHvParams' yet.
149
instance Arbitrary ClusterHvParams where
150
  arbitrary = return $ Container Map.empty
151

  
152
-- | No real arbitrary instance for 'OsHvParams' yet.
153
instance Arbitrary OsHvParams where
154
  arbitrary = return $ Container Map.empty
155

  
156
instance Arbitrary ClusterNicParams where
157
  arbitrary = (Container . Map.singleton C.ppDefault) <$> arbitrary
158

  
159
instance Arbitrary OsParams where
160
  arbitrary = (Container . Map.fromList) <$> arbitrary
161

  
162
instance Arbitrary ClusterOsParams where
163
  arbitrary = (Container . Map.fromList) <$> arbitrary
164

  
165
instance Arbitrary ClusterBeParams where
166
  arbitrary = (Container . Map.fromList) <$> arbitrary
167

  
168
instance Arbitrary TagSet where
169
  arbitrary = Set.fromList <$> genTags
170

  
171
$(genArbitrary ''Cluster)
172

  
173
-- | Generator for config data with an empty cluster (no instances),
174
-- with N defined nodes.
175
genEmptyCluster :: Int -> Gen ConfigData
176
genEmptyCluster ncount = do
177
  nodes <- vector ncount
178
  version <- arbitrary
179
  let guuid = "00"
180
      nodes' = map (\n -> n { nodeGroup = guuid }) nodes
181
      contnodes = Container . Map.fromList $ map (\n -> (nodeName n, n)) nodes'
182
      continsts = Container $ Map.empty
183
  grp <- arbitrary
184
  let contgroups = Container $ Map.singleton guuid grp
185
  serial <- arbitrary
186
  cluster <- arbitrary
187
  let c = ConfigData version cluster contnodes contgroups continsts serial
188
  return c
189

  
114 190
-- * Test properties
115 191

  
116 192
-- | Tests that fillDict behaves correctly
......
144 220
prop_Inst_serialisation :: Instance -> Property
145 221
prop_Inst_serialisation = testSerialisation
146 222

  
223
-- | Check config serialisation.
224
prop_Config_serialisation :: Property
225
prop_Config_serialisation =
226
  forAll (choose (0, maxNodes) >>= genEmptyCluster) testSerialisation
227

  
147 228
testSuite "Objects"
148 229
  [ 'prop_fillDict
149 230
  , 'prop_Disk_serialisation
150 231
  , 'prop_Inst_serialisation
151 232
  , 'prop_Node_serialisation
152 233
  ]
234

  
235
testSuite "SlowObjects"
236
  [ 'prop_Config_serialisation
237
  ]

Also available in: Unified diff