Revision 0b288282 htest/Test/Ganeti/Objects.hs
b/htest/Test/Ganeti/Objects.hs  

30  30 
( testObjects 
31  31 
, Node(..) 
32  32 
, genEmptyCluster 
33 
, genValidNetwork 

34 
, genNetworkType 

35 
, genBitStringMaxLen 

33  36 
) where 
34  37  
35  38 
import Test.QuickCheck 
39 
import qualified Test.HUnit as HUnit 

36  40  
37  41 
import Control.Applicative 
42 
import Control.Monad 

43 
import Data.Char 

38  44 
import qualified Data.Map as Map 
39  45 
import qualified Data.Set as Set 
46 
import qualified Text.JSON as J 

40  47  
41  48 
import Test.Ganeti.Query.Language (genJSValue) 
42  49 
import Test.Ganeti.TestHelper 
...  ...  
44  51 
import Test.Ganeti.Types () 
45  52  
46  53 
import qualified Ganeti.Constants as C 
54 
import Ganeti.Network 

47  55 
import Ganeti.Objects as Objects 
48  56 
import Ganeti.JSON 
57 
import Ganeti.Types 

49  58  
50  59 
{# ANN module "HLint: ignore Use camelCase" #} 
51  60  
...  ...  
164  173 
$(genArbitrary ''Cluster) 
165  174  
166  175 
instance Arbitrary Network where 
167 
arbitrary = Network <$> 

168 
 name 

169 
arbitrary 

170 
 network_type 

171 
<*> arbitrary 

172 
 mac_prefix 

173 
<*> arbitrary 

174 
 family 

175 
<*> arbitrary 

176 
 network 

177 
<*> arbitrary 

178 
 network6 

179 
<*> arbitrary 

180 
 gateway 

181 
<*> arbitrary 

182 
 gateway6 

183 
<*> arbitrary 

184 
 size 

185 
<*> genMaybe genJSValue 

186 
 reservations 

187 
<*> arbitrary 

188 
 external reservations 

189 
<*> arbitrary 

190 
 serial 

191 
<*> arbitrary 

192 
 tags 

193 
<*> (Set.fromList <$> genTags) 

176 
arbitrary = genValidNetwork 

177  
178 
  Generates a network instance with minimum netmasks of /24. Generating 

179 
 bigger networks slows down the tests, because long bit strings are generated 

180 
 for the reservations. 

181 
genValidNetwork :: Gen Objects.Network 

182 
genValidNetwork = do 

183 
 generate netmask for the IPv4 network 

184 
netmask < choose (24::Int, 30) 

185 
name < genName >>= mkNonEmpty 

186 
network_type < genMaybe genNetworkType 

187 
mac_prefix < genMaybe genName 

188 
fam < arbitrary 

189 
net < genIp4NetWithNetmask netmask 

190 
net6 < genMaybe genIp6Net 

191 
gateway < genMaybe genIp4AddrStr 

192 
gateway6 < genMaybe genIp6Addr 

193 
size < genMaybe genJSValue 

194 
res < liftM Just (genBitString $ netmask2NumHosts netmask) 

195 
ext_res < liftM Just (genBitString $ netmask2NumHosts netmask) 

196 
let n = Network name network_type mac_prefix fam net net6 gateway 

197 
gateway6 size res ext_res 0 Set.empty 

198 
return n 

199  
200 
  Generates an arbitrary network type. 

201 
genNetworkType :: Gen NetworkType 

202 
genNetworkType = elements [ PrivateNetwork, PublicNetwork ] 

203  
204 
  Generate an arbitrary string consisting of '0' and '1' of the given length. 

205 
genBitString :: Int > Gen String 

206 
genBitString len = vectorOf len (elements "01") 

207  
208 
  Generate an arbitrary string consisting of '0' and '1' of the maximum given 

209 
 length. 

210 
genBitStringMaxLen :: Int > Gen String 

211 
genBitStringMaxLen maxLen = choose (0, maxLen) >>= genBitString 

194  212  
195  213 
  Generator for config data with an empty cluster (no instances), 
196  214 
 with N defined nodes. 
...  ...  
261  279 
prop_Config_serialisation = 
262  280 
forAll (choose (0, maxNodes `div` 4) >>= genEmptyCluster) testSerialisation 
263  281  
282 
  Custom HUnit test to check the correspondence between Haskellgenerated 

283 
 networks and their Python decoded, validated and reencoded version. 

284 
 For the technical background of this unit test, check the documentation 

285 
 of "case_py_compat_types" of htest/Test/Ganeti/Opcodes.hs 

286 
case_py_compat_networks :: HUnit.Assertion 

287 
case_py_compat_networks = do 

288 
let num_networks = 500::Int 

289 
sample_networks < sample' (vectorOf num_networks genValidNetwork) 

290 
let networks = head sample_networks 

291 
networks_with_properties = map getNetworkProperties networks 

292 
serialized = J.encode networks 

293 
 check for nonASCII fields, usually due to 'arbitrary :: String' 

294 
mapM_ (\net > when (any (not . isAscii) (J.encode net)) . 

295 
HUnit.assertFailure $ 

296 
"Network has nonASCII fields: " ++ show net 

297 
) networks 

298 
py_stdout < 

299 
runPython "from ganeti import network\n\ 

300 
\from ganeti import objects\n\ 

301 
\from ganeti import serializer\n\ 

302 
\import sys\n\ 

303 
\net_data = serializer.Load(sys.stdin.read())\n\ 

304 
\decoded = [objects.Network.FromDict(n) for n in net_data]\n\ 

305 
\encoded = []\n\ 

306 
\for net in decoded:\n\ 

307 
\ a = network.AddressPool(net)\n\ 

308 
\ encoded.append((a.GetFreeCount(), a.GetReservedCount(), \\\n\ 

309 
\ net.ToDict()))\n\ 

310 
\print serializer.Dump(encoded)" serialized 

311 
>>= checkPythonResult 

312 
let deserialised = J.decode py_stdout::J.Result [(Int, Int, Network)] 

313 
decoded < case deserialised of 

314 
J.Ok ops > return ops 

315 
J.Error msg > 

316 
HUnit.assertFailure ("Unable to decode networks: " ++ msg) 

317 
 this already raised an expection, but we need it 

318 
 for proper types 

319 
>> fail "Unable to decode networks" 

320 
HUnit.assertEqual "Mismatch in number of returned networks" 

321 
(length decoded) (length networks_with_properties) 

322 
mapM_ (uncurry (HUnit.assertEqual "Different result after encoding/decoding") 

323 
) $ zip decoded networks_with_properties 

324  
325 
  Creates a tuple of the given network combined with some of its properties 

326 
 to be compared against the same properties generated by the python code. 

327 
getNetworkProperties :: Network > (Int, Int, Network) 

328 
getNetworkProperties net = 

329 
let maybePool = createAddressPool net 

330 
in case maybePool of 

331 
(Just pool) > (getFreeCount pool, getReservedCount pool, net) 

332 
Nothing > (1, 1, net) 

333  
264  334 
testSuite "Objects" 
265  335 
[ 'prop_fillDict 
266  336 
, 'prop_Disk_serialisation 
...  ...  
268  338 
, 'prop_Network_serialisation 
269  339 
, 'prop_Node_serialisation 
270  340 
, 'prop_Config_serialisation 
341 
, 'case_py_compat_networks 

271  342 
] 
Also available in: Unified diff