root / htest / Test / Ganeti / Objects.hs @ a30a6178
History | View | Annotate | Download (14.1 kB)
1 | 9924d61e | Iustin Pop | {-# LANGUAGE TemplateHaskell, TypeSynonymInstances, FlexibleInstances #-} |
---|---|---|---|
2 | e5a29b6c | Iustin Pop | {-# OPTIONS_GHC -fno-warn-orphans #-} |
3 | e5a29b6c | Iustin Pop | |
4 | e5a29b6c | Iustin Pop | {-| Unittests for ganeti-htools. |
5 | e5a29b6c | Iustin Pop | |
6 | e5a29b6c | Iustin Pop | -} |
7 | e5a29b6c | Iustin Pop | |
8 | e5a29b6c | Iustin Pop | {- |
9 | e5a29b6c | Iustin Pop | |
10 | e5a29b6c | Iustin Pop | Copyright (C) 2009, 2010, 2011, 2012 Google Inc. |
11 | e5a29b6c | Iustin Pop | |
12 | e5a29b6c | Iustin Pop | This program is free software; you can redistribute it and/or modify |
13 | e5a29b6c | Iustin Pop | it under the terms of the GNU General Public License as published by |
14 | e5a29b6c | Iustin Pop | the Free Software Foundation; either version 2 of the License, or |
15 | e5a29b6c | Iustin Pop | (at your option) any later version. |
16 | e5a29b6c | Iustin Pop | |
17 | e5a29b6c | Iustin Pop | This program is distributed in the hope that it will be useful, but |
18 | e5a29b6c | Iustin Pop | WITHOUT ANY WARRANTY; without even the implied warranty of |
19 | e5a29b6c | Iustin Pop | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU |
20 | e5a29b6c | Iustin Pop | General Public License for more details. |
21 | e5a29b6c | Iustin Pop | |
22 | e5a29b6c | Iustin Pop | You should have received a copy of the GNU General Public License |
23 | e5a29b6c | Iustin Pop | along with this program; if not, write to the Free Software |
24 | e5a29b6c | Iustin Pop | Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA |
25 | e5a29b6c | Iustin Pop | 02110-1301, USA. |
26 | e5a29b6c | Iustin Pop | |
27 | e5a29b6c | Iustin Pop | -} |
28 | e5a29b6c | Iustin Pop | |
29 | 305e174c | Iustin Pop | module Test.Ganeti.Objects |
30 | 305e174c | Iustin Pop | ( testObjects |
31 | 8d2b6a12 | Iustin Pop | , Node(..) |
32 | 9924d61e | Iustin Pop | , genEmptyCluster |
33 | 0b288282 | Helga Velroyen | , genValidNetwork |
34 | 0b288282 | Helga Velroyen | , genNetworkType |
35 | 0b288282 | Helga Velroyen | , genBitStringMaxLen |
36 | 305e174c | Iustin Pop | ) where |
37 | e5a29b6c | Iustin Pop | |
38 | 8d2b6a12 | Iustin Pop | import Test.QuickCheck |
39 | 0b288282 | Helga Velroyen | import qualified Test.HUnit as HUnit |
40 | 8d2b6a12 | Iustin Pop | |
41 | 305e174c | Iustin Pop | import Control.Applicative |
42 | 0b288282 | Helga Velroyen | import Control.Monad |
43 | 0b288282 | Helga Velroyen | import Data.Char |
44 | e5a29b6c | Iustin Pop | import qualified Data.Map as Map |
45 | 305e174c | Iustin Pop | import qualified Data.Set as Set |
46 | 0b288282 | Helga Velroyen | import qualified Text.JSON as J |
47 | e5a29b6c | Iustin Pop | |
48 | 76a0266e | Helga Velroyen | import Test.Ganeti.Query.Language (genJSValue) |
49 | e5a29b6c | Iustin Pop | import Test.Ganeti.TestHelper |
50 | 305e174c | Iustin Pop | import Test.Ganeti.TestCommon |
51 | 5e9deac0 | Iustin Pop | import Test.Ganeti.Types () |
52 | 9924d61e | Iustin Pop | |
53 | 9924d61e | Iustin Pop | import qualified Ganeti.Constants as C |
54 | 0b288282 | Helga Velroyen | import Ganeti.Network |
55 | 8d2b6a12 | Iustin Pop | import Ganeti.Objects as Objects |
56 | ce93b4a0 | Iustin Pop | import Ganeti.JSON |
57 | 0b288282 | Helga Velroyen | import Ganeti.Types |
58 | 8d2b6a12 | Iustin Pop | |
59 | 5b11f8db | Iustin Pop | {-# ANN module "HLint: ignore Use camelCase" #-} |
60 | 5b11f8db | Iustin Pop | |
61 | 8d2b6a12 | Iustin Pop | -- * Arbitrary instances |
62 | e5a29b6c | Iustin Pop | |
63 | 7022db83 | Iustin Pop | $(genArbitrary ''PartialNDParams) |
64 | 305e174c | Iustin Pop | |
65 | 8d2b6a12 | Iustin Pop | instance Arbitrary Node where |
66 | 5006418e | Iustin Pop | arbitrary = Node <$> genFQDN <*> genFQDN <*> genFQDN |
67 | 5006418e | Iustin Pop | <*> arbitrary <*> arbitrary <*> arbitrary <*> genFQDN |
68 | 305e174c | Iustin Pop | <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary |
69 | 5006418e | Iustin Pop | <*> arbitrary <*> arbitrary <*> genFQDN <*> arbitrary |
70 | 305e174c | Iustin Pop | <*> (Set.fromList <$> genTags) |
71 | 305e174c | Iustin Pop | |
72 | 7022db83 | Iustin Pop | $(genArbitrary ''BlockDriver) |
73 | 8d2b6a12 | Iustin Pop | |
74 | 7022db83 | Iustin Pop | $(genArbitrary ''DiskMode) |
75 | 8d2b6a12 | Iustin Pop | |
76 | 8d2b6a12 | Iustin Pop | instance Arbitrary DiskLogicalId where |
77 | 8d2b6a12 | Iustin Pop | arbitrary = oneof [ LIDPlain <$> arbitrary <*> arbitrary |
78 | 5006418e | Iustin Pop | , LIDDrbd8 <$> genFQDN <*> genFQDN <*> arbitrary |
79 | 8d2b6a12 | Iustin Pop | <*> arbitrary <*> arbitrary <*> arbitrary |
80 | 8d2b6a12 | Iustin Pop | , LIDFile <$> arbitrary <*> arbitrary |
81 | 8d2b6a12 | Iustin Pop | , LIDBlockDev <$> arbitrary <*> arbitrary |
82 | 8d2b6a12 | Iustin Pop | , LIDRados <$> arbitrary <*> arbitrary |
83 | 8d2b6a12 | Iustin Pop | ] |
84 | 8d2b6a12 | Iustin Pop | |
85 | 8d2b6a12 | Iustin Pop | -- | 'Disk' 'arbitrary' instance. Since we don't test disk hierarchy |
86 | 8d2b6a12 | Iustin Pop | -- properties, we only generate disks with no children (FIXME), as |
87 | 8d2b6a12 | Iustin Pop | -- generating recursive datastructures is a bit more work. |
88 | 8d2b6a12 | Iustin Pop | instance Arbitrary Disk where |
89 | 5b11f8db | Iustin Pop | arbitrary = Disk <$> arbitrary <*> pure [] <*> arbitrary |
90 | 8d2b6a12 | Iustin Pop | <*> arbitrary <*> arbitrary |
91 | 8d2b6a12 | Iustin Pop | |
92 | 7022db83 | Iustin Pop | -- FIXME: we should generate proper values, >=0, etc., but this is |
93 | 7022db83 | Iustin Pop | -- hard for partial ones, where all must be wrapped in a 'Maybe' |
94 | 7022db83 | Iustin Pop | $(genArbitrary ''PartialBeParams) |
95 | ce93b4a0 | Iustin Pop | |
96 | 7022db83 | Iustin Pop | $(genArbitrary ''AdminState) |
97 | ce93b4a0 | Iustin Pop | |
98 | 7022db83 | Iustin Pop | $(genArbitrary ''PartialNicParams) |
99 | ce93b4a0 | Iustin Pop | |
100 | 7022db83 | Iustin Pop | $(genArbitrary ''PartialNic) |
101 | ce93b4a0 | Iustin Pop | |
102 | ce93b4a0 | Iustin Pop | instance Arbitrary Instance where |
103 | ce93b4a0 | Iustin Pop | arbitrary = |
104 | ce93b4a0 | Iustin Pop | Instance |
105 | 5006418e | Iustin Pop | <$> genFQDN <*> genFQDN <*> genFQDN -- OS name, but... |
106 | ce93b4a0 | Iustin Pop | <*> arbitrary |
107 | ce93b4a0 | Iustin Pop | -- FIXME: add non-empty hvparams when they're a proper type |
108 | edc1acde | Iustin Pop | <*> pure (GenericContainer Map.empty) <*> arbitrary |
109 | ce93b4a0 | Iustin Pop | -- ... and for OSParams |
110 | edc1acde | Iustin Pop | <*> pure (GenericContainer Map.empty) <*> arbitrary <*> arbitrary |
111 | ce93b4a0 | Iustin Pop | <*> arbitrary <*> arbitrary <*> arbitrary |
112 | ce93b4a0 | Iustin Pop | -- ts |
113 | ce93b4a0 | Iustin Pop | <*> arbitrary <*> arbitrary |
114 | ce93b4a0 | Iustin Pop | -- uuid |
115 | ce93b4a0 | Iustin Pop | <*> arbitrary |
116 | ce93b4a0 | Iustin Pop | -- serial |
117 | ce93b4a0 | Iustin Pop | <*> arbitrary |
118 | ce93b4a0 | Iustin Pop | -- tags |
119 | ce93b4a0 | Iustin Pop | <*> (Set.fromList <$> genTags) |
120 | ce93b4a0 | Iustin Pop | |
121 | 9924d61e | Iustin Pop | -- | FIXME: This generates completely random data, without normal |
122 | 9924d61e | Iustin Pop | -- validation rules. |
123 | 9924d61e | Iustin Pop | $(genArbitrary ''PartialISpecParams) |
124 | 9924d61e | Iustin Pop | |
125 | 9924d61e | Iustin Pop | -- | FIXME: This generates completely random data, without normal |
126 | 9924d61e | Iustin Pop | -- validation rules. |
127 | 9924d61e | Iustin Pop | $(genArbitrary ''PartialIPolicy) |
128 | 9924d61e | Iustin Pop | |
129 | 9924d61e | Iustin Pop | $(genArbitrary ''FilledISpecParams) |
130 | 9924d61e | Iustin Pop | $(genArbitrary ''FilledIPolicy) |
131 | 9924d61e | Iustin Pop | $(genArbitrary ''IpFamily) |
132 | 9924d61e | Iustin Pop | $(genArbitrary ''FilledNDParams) |
133 | 9924d61e | Iustin Pop | $(genArbitrary ''FilledNicParams) |
134 | 9924d61e | Iustin Pop | $(genArbitrary ''FilledBeParams) |
135 | 9924d61e | Iustin Pop | |
136 | 9924d61e | Iustin Pop | -- | No real arbitrary instance for 'ClusterHvParams' yet. |
137 | 9924d61e | Iustin Pop | instance Arbitrary ClusterHvParams where |
138 | edc1acde | Iustin Pop | arbitrary = return $ GenericContainer Map.empty |
139 | 9924d61e | Iustin Pop | |
140 | 9924d61e | Iustin Pop | -- | No real arbitrary instance for 'OsHvParams' yet. |
141 | 9924d61e | Iustin Pop | instance Arbitrary OsHvParams where |
142 | edc1acde | Iustin Pop | arbitrary = return $ GenericContainer Map.empty |
143 | 9924d61e | Iustin Pop | |
144 | 9924d61e | Iustin Pop | instance Arbitrary ClusterNicParams where |
145 | edc1acde | Iustin Pop | arbitrary = (GenericContainer . Map.singleton C.ppDefault) <$> arbitrary |
146 | 9924d61e | Iustin Pop | |
147 | 9924d61e | Iustin Pop | instance Arbitrary OsParams where |
148 | edc1acde | Iustin Pop | arbitrary = (GenericContainer . Map.fromList) <$> arbitrary |
149 | 9924d61e | Iustin Pop | |
150 | 9924d61e | Iustin Pop | instance Arbitrary ClusterOsParams where |
151 | edc1acde | Iustin Pop | arbitrary = (GenericContainer . Map.fromList) <$> arbitrary |
152 | 9924d61e | Iustin Pop | |
153 | 9924d61e | Iustin Pop | instance Arbitrary ClusterBeParams where |
154 | edc1acde | Iustin Pop | arbitrary = (GenericContainer . Map.fromList) <$> arbitrary |
155 | 9924d61e | Iustin Pop | |
156 | 9924d61e | Iustin Pop | instance Arbitrary TagSet where |
157 | 9924d61e | Iustin Pop | arbitrary = Set.fromList <$> genTags |
158 | 9924d61e | Iustin Pop | |
159 | 9924d61e | Iustin Pop | $(genArbitrary ''Cluster) |
160 | 9924d61e | Iustin Pop | |
161 | 76a0266e | Helga Velroyen | instance Arbitrary Network where |
162 | 0b288282 | Helga Velroyen | arbitrary = genValidNetwork |
163 | 0b288282 | Helga Velroyen | |
164 | 0b288282 | Helga Velroyen | -- | Generates a network instance with minimum netmasks of /24. Generating |
165 | 0b288282 | Helga Velroyen | -- bigger networks slows down the tests, because long bit strings are generated |
166 | 0b288282 | Helga Velroyen | -- for the reservations. |
167 | 0b288282 | Helga Velroyen | genValidNetwork :: Gen Objects.Network |
168 | 0b288282 | Helga Velroyen | genValidNetwork = do |
169 | 0b288282 | Helga Velroyen | -- generate netmask for the IPv4 network |
170 | 0b288282 | Helga Velroyen | netmask <- choose (24::Int, 30) |
171 | 0b288282 | Helga Velroyen | name <- genName >>= mkNonEmpty |
172 | 0b288282 | Helga Velroyen | network_type <- genMaybe genNetworkType |
173 | 0b288282 | Helga Velroyen | mac_prefix <- genMaybe genName |
174 | a30a6178 | Helga Velroyen | net_family <- arbitrary |
175 | 0b288282 | Helga Velroyen | net <- genIp4NetWithNetmask netmask |
176 | 0b288282 | Helga Velroyen | net6 <- genMaybe genIp6Net |
177 | 0b288282 | Helga Velroyen | gateway <- genMaybe genIp4AddrStr |
178 | 0b288282 | Helga Velroyen | gateway6 <- genMaybe genIp6Addr |
179 | 0b288282 | Helga Velroyen | size <- genMaybe genJSValue |
180 | 0b288282 | Helga Velroyen | res <- liftM Just (genBitString $ netmask2NumHosts netmask) |
181 | 0b288282 | Helga Velroyen | ext_res <- liftM Just (genBitString $ netmask2NumHosts netmask) |
182 | a30a6178 | Helga Velroyen | let n = Network name network_type mac_prefix net_family net net6 gateway |
183 | 0b288282 | Helga Velroyen | gateway6 size res ext_res 0 Set.empty |
184 | 0b288282 | Helga Velroyen | return n |
185 | 0b288282 | Helga Velroyen | |
186 | 0b288282 | Helga Velroyen | -- | Generates an arbitrary network type. |
187 | 0b288282 | Helga Velroyen | genNetworkType :: Gen NetworkType |
188 | 0b288282 | Helga Velroyen | genNetworkType = elements [ PrivateNetwork, PublicNetwork ] |
189 | 0b288282 | Helga Velroyen | |
190 | 0b288282 | Helga Velroyen | -- | Generate an arbitrary string consisting of '0' and '1' of the given length. |
191 | 0b288282 | Helga Velroyen | genBitString :: Int -> Gen String |
192 | 0b288282 | Helga Velroyen | genBitString len = vectorOf len (elements "01") |
193 | 0b288282 | Helga Velroyen | |
194 | 0b288282 | Helga Velroyen | -- | Generate an arbitrary string consisting of '0' and '1' of the maximum given |
195 | 0b288282 | Helga Velroyen | -- length. |
196 | 0b288282 | Helga Velroyen | genBitStringMaxLen :: Int -> Gen String |
197 | 0b288282 | Helga Velroyen | genBitStringMaxLen maxLen = choose (0, maxLen) >>= genBitString |
198 | 76a0266e | Helga Velroyen | |
199 | 9924d61e | Iustin Pop | -- | Generator for config data with an empty cluster (no instances), |
200 | 9924d61e | Iustin Pop | -- with N defined nodes. |
201 | 9924d61e | Iustin Pop | genEmptyCluster :: Int -> Gen ConfigData |
202 | 9924d61e | Iustin Pop | genEmptyCluster ncount = do |
203 | 9924d61e | Iustin Pop | nodes <- vector ncount |
204 | 9924d61e | Iustin Pop | version <- arbitrary |
205 | 9924d61e | Iustin Pop | let guuid = "00" |
206 | 5f4fdf93 | Iustin Pop | nodes' = zipWith (\n idx -> |
207 | 5f4fdf93 | Iustin Pop | let newname = nodeName n ++ "-" ++ show idx |
208 | 5f4fdf93 | Iustin Pop | in (newname, n { nodeGroup = guuid, |
209 | 5f4fdf93 | Iustin Pop | nodeName = newname})) |
210 | b9bdc10e | Iustin Pop | nodes [(1::Int)..] |
211 | 5f4fdf93 | Iustin Pop | nodemap = Map.fromList nodes' |
212 | 5f4fdf93 | Iustin Pop | contnodes = if Map.size nodemap /= ncount |
213 | 5f4fdf93 | Iustin Pop | then error ("Inconsistent node map, duplicates in" ++ |
214 | 5f4fdf93 | Iustin Pop | " node name list? Names: " ++ |
215 | 5f4fdf93 | Iustin Pop | show (map fst nodes')) |
216 | 5f4fdf93 | Iustin Pop | else GenericContainer nodemap |
217 | edc1acde | Iustin Pop | continsts = GenericContainer Map.empty |
218 | 9924d61e | Iustin Pop | grp <- arbitrary |
219 | edc1acde | Iustin Pop | let contgroups = GenericContainer $ Map.singleton guuid grp |
220 | 9924d61e | Iustin Pop | serial <- arbitrary |
221 | c3a8e06d | Iustin Pop | cluster <- resize 8 arbitrary |
222 | 9924d61e | Iustin Pop | let c = ConfigData version cluster contnodes contgroups continsts serial |
223 | 9924d61e | Iustin Pop | return c |
224 | 9924d61e | Iustin Pop | |
225 | 8d2b6a12 | Iustin Pop | -- * Test properties |
226 | 8d2b6a12 | Iustin Pop | |
227 | e5a29b6c | Iustin Pop | -- | Tests that fillDict behaves correctly |
228 | 20bc5360 | Iustin Pop | prop_fillDict :: [(Int, Int)] -> [(Int, Int)] -> Property |
229 | 20bc5360 | Iustin Pop | prop_fillDict defaults custom = |
230 | e5a29b6c | Iustin Pop | let d_map = Map.fromList defaults |
231 | e5a29b6c | Iustin Pop | d_keys = map fst defaults |
232 | e5a29b6c | Iustin Pop | c_map = Map.fromList custom |
233 | e5a29b6c | Iustin Pop | c_keys = map fst custom |
234 | 942a9a6a | Iustin Pop | in conjoin [ printTestCase "Empty custom filling" |
235 | 942a9a6a | Iustin Pop | (fillDict d_map Map.empty [] == d_map) |
236 | 942a9a6a | Iustin Pop | , printTestCase "Empty defaults filling" |
237 | 942a9a6a | Iustin Pop | (fillDict Map.empty c_map [] == c_map) |
238 | 942a9a6a | Iustin Pop | , printTestCase "Delete all keys" |
239 | 942a9a6a | Iustin Pop | (fillDict d_map c_map (d_keys++c_keys) == Map.empty) |
240 | 942a9a6a | Iustin Pop | ] |
241 | 8d2b6a12 | Iustin Pop | |
242 | 8d2b6a12 | Iustin Pop | -- | Test that the serialisation of 'DiskLogicalId', which is |
243 | 8d2b6a12 | Iustin Pop | -- implemented manually, is idempotent. Since we don't have a |
244 | 8d2b6a12 | Iustin Pop | -- standalone JSON instance for DiskLogicalId (it's a data type that |
245 | 8d2b6a12 | Iustin Pop | -- expands over two fields in a JSObject), we test this by actially |
246 | 8d2b6a12 | Iustin Pop | -- testing entire Disk serialisations. So this tests two things at |
247 | 8d2b6a12 | Iustin Pop | -- once, basically. |
248 | 8d2b6a12 | Iustin Pop | prop_Disk_serialisation :: Disk -> Property |
249 | 63b068c1 | Iustin Pop | prop_Disk_serialisation = testSerialisation |
250 | 8d2b6a12 | Iustin Pop | |
251 | 8d2b6a12 | Iustin Pop | -- | Check that node serialisation is idempotent. |
252 | 8d2b6a12 | Iustin Pop | prop_Node_serialisation :: Node -> Property |
253 | 63b068c1 | Iustin Pop | prop_Node_serialisation = testSerialisation |
254 | e5a29b6c | Iustin Pop | |
255 | ce93b4a0 | Iustin Pop | -- | Check that instance serialisation is idempotent. |
256 | ce93b4a0 | Iustin Pop | prop_Inst_serialisation :: Instance -> Property |
257 | ce93b4a0 | Iustin Pop | prop_Inst_serialisation = testSerialisation |
258 | ce93b4a0 | Iustin Pop | |
259 | 76a0266e | Helga Velroyen | -- | Check that network serialisation is idempotent. |
260 | 76a0266e | Helga Velroyen | prop_Network_serialisation :: Network -> Property |
261 | 76a0266e | Helga Velroyen | prop_Network_serialisation = testSerialisation |
262 | 76a0266e | Helga Velroyen | |
263 | 9924d61e | Iustin Pop | -- | Check config serialisation. |
264 | 9924d61e | Iustin Pop | prop_Config_serialisation :: Property |
265 | 9924d61e | Iustin Pop | prop_Config_serialisation = |
266 | c3a8e06d | Iustin Pop | forAll (choose (0, maxNodes `div` 4) >>= genEmptyCluster) testSerialisation |
267 | 9924d61e | Iustin Pop | |
268 | 0b288282 | Helga Velroyen | -- | Custom HUnit test to check the correspondence between Haskell-generated |
269 | 0b288282 | Helga Velroyen | -- networks and their Python decoded, validated and re-encoded version. |
270 | 0b288282 | Helga Velroyen | -- For the technical background of this unit test, check the documentation |
271 | 0b288282 | Helga Velroyen | -- of "case_py_compat_types" of htest/Test/Ganeti/Opcodes.hs |
272 | 0b288282 | Helga Velroyen | case_py_compat_networks :: HUnit.Assertion |
273 | 0b288282 | Helga Velroyen | case_py_compat_networks = do |
274 | 0b288282 | Helga Velroyen | let num_networks = 500::Int |
275 | 0b288282 | Helga Velroyen | sample_networks <- sample' (vectorOf num_networks genValidNetwork) |
276 | 0b288282 | Helga Velroyen | let networks = head sample_networks |
277 | 0b288282 | Helga Velroyen | networks_with_properties = map getNetworkProperties networks |
278 | 0b288282 | Helga Velroyen | serialized = J.encode networks |
279 | 0b288282 | Helga Velroyen | -- check for non-ASCII fields, usually due to 'arbitrary :: String' |
280 | 0b288282 | Helga Velroyen | mapM_ (\net -> when (any (not . isAscii) (J.encode net)) . |
281 | 0b288282 | Helga Velroyen | HUnit.assertFailure $ |
282 | 0b288282 | Helga Velroyen | "Network has non-ASCII fields: " ++ show net |
283 | 0b288282 | Helga Velroyen | ) networks |
284 | 0b288282 | Helga Velroyen | py_stdout <- |
285 | 0b288282 | Helga Velroyen | runPython "from ganeti import network\n\ |
286 | 0b288282 | Helga Velroyen | \from ganeti import objects\n\ |
287 | 0b288282 | Helga Velroyen | \from ganeti import serializer\n\ |
288 | 0b288282 | Helga Velroyen | \import sys\n\ |
289 | 0b288282 | Helga Velroyen | \net_data = serializer.Load(sys.stdin.read())\n\ |
290 | 0b288282 | Helga Velroyen | \decoded = [objects.Network.FromDict(n) for n in net_data]\n\ |
291 | 0b288282 | Helga Velroyen | \encoded = []\n\ |
292 | 0b288282 | Helga Velroyen | \for net in decoded:\n\ |
293 | 0b288282 | Helga Velroyen | \ a = network.AddressPool(net)\n\ |
294 | 0b288282 | Helga Velroyen | \ encoded.append((a.GetFreeCount(), a.GetReservedCount(), \\\n\ |
295 | 0b288282 | Helga Velroyen | \ net.ToDict()))\n\ |
296 | 0b288282 | Helga Velroyen | \print serializer.Dump(encoded)" serialized |
297 | 0b288282 | Helga Velroyen | >>= checkPythonResult |
298 | 0b288282 | Helga Velroyen | let deserialised = J.decode py_stdout::J.Result [(Int, Int, Network)] |
299 | 0b288282 | Helga Velroyen | decoded <- case deserialised of |
300 | 0b288282 | Helga Velroyen | J.Ok ops -> return ops |
301 | 0b288282 | Helga Velroyen | J.Error msg -> |
302 | 0b288282 | Helga Velroyen | HUnit.assertFailure ("Unable to decode networks: " ++ msg) |
303 | 0b288282 | Helga Velroyen | -- this already raised an expection, but we need it |
304 | 0b288282 | Helga Velroyen | -- for proper types |
305 | 0b288282 | Helga Velroyen | >> fail "Unable to decode networks" |
306 | 0b288282 | Helga Velroyen | HUnit.assertEqual "Mismatch in number of returned networks" |
307 | 0b288282 | Helga Velroyen | (length decoded) (length networks_with_properties) |
308 | 0b288282 | Helga Velroyen | mapM_ (uncurry (HUnit.assertEqual "Different result after encoding/decoding") |
309 | 0b288282 | Helga Velroyen | ) $ zip decoded networks_with_properties |
310 | 0b288282 | Helga Velroyen | |
311 | 0b288282 | Helga Velroyen | -- | Creates a tuple of the given network combined with some of its properties |
312 | 0b288282 | Helga Velroyen | -- to be compared against the same properties generated by the python code. |
313 | 0b288282 | Helga Velroyen | getNetworkProperties :: Network -> (Int, Int, Network) |
314 | 0b288282 | Helga Velroyen | getNetworkProperties net = |
315 | 0b288282 | Helga Velroyen | let maybePool = createAddressPool net |
316 | 0b288282 | Helga Velroyen | in case maybePool of |
317 | 0b288282 | Helga Velroyen | (Just pool) -> (getFreeCount pool, getReservedCount pool, net) |
318 | 0b288282 | Helga Velroyen | Nothing -> (-1, -1, net) |
319 | 0b288282 | Helga Velroyen | |
320 | 5b48df93 | Helga Velroyen | -- | Tests the compatibility between Haskell-serialized node groups and their |
321 | 5b48df93 | Helga Velroyen | -- python-decoded and encoded version. |
322 | 5b48df93 | Helga Velroyen | case_py_compat_nodegroups :: HUnit.Assertion |
323 | 5b48df93 | Helga Velroyen | case_py_compat_nodegroups = do |
324 | 5b48df93 | Helga Velroyen | let num_groups = 500::Int |
325 | 5b48df93 | Helga Velroyen | sample_groups <- sample' (vectorOf num_groups genNodeGroup) |
326 | 5b48df93 | Helga Velroyen | let groups = head sample_groups |
327 | 5b48df93 | Helga Velroyen | serialized = J.encode groups |
328 | 5b48df93 | Helga Velroyen | -- check for non-ASCII fields, usually due to 'arbitrary :: String' |
329 | 5b48df93 | Helga Velroyen | mapM_ (\group -> when (any (not . isAscii) (J.encode group)) . |
330 | 5b48df93 | Helga Velroyen | HUnit.assertFailure $ |
331 | 5b48df93 | Helga Velroyen | "Node group has non-ASCII fields: " ++ show group |
332 | 5b48df93 | Helga Velroyen | ) groups |
333 | 5b48df93 | Helga Velroyen | py_stdout <- |
334 | 5b48df93 | Helga Velroyen | runPython "from ganeti import objects\n\ |
335 | 5b48df93 | Helga Velroyen | \from ganeti import serializer\n\ |
336 | 5b48df93 | Helga Velroyen | \import sys\n\ |
337 | 5b48df93 | Helga Velroyen | \group_data = serializer.Load(sys.stdin.read())\n\ |
338 | 5b48df93 | Helga Velroyen | \decoded = [objects.NodeGroup.FromDict(g) for g in group_data]\n\ |
339 | 5b48df93 | Helga Velroyen | \encoded = [g.ToDict() for g in decoded]\n\ |
340 | 5b48df93 | Helga Velroyen | \print serializer.Dump(encoded)" serialized |
341 | 5b48df93 | Helga Velroyen | >>= checkPythonResult |
342 | 5b48df93 | Helga Velroyen | let deserialised = J.decode py_stdout::J.Result [NodeGroup] |
343 | 5b48df93 | Helga Velroyen | decoded <- case deserialised of |
344 | 5b48df93 | Helga Velroyen | J.Ok ops -> return ops |
345 | 5b48df93 | Helga Velroyen | J.Error msg -> |
346 | 5b48df93 | Helga Velroyen | HUnit.assertFailure ("Unable to decode node groups: " ++ msg) |
347 | 5b48df93 | Helga Velroyen | -- this already raised an expection, but we need it |
348 | 5b48df93 | Helga Velroyen | -- for proper types |
349 | 5b48df93 | Helga Velroyen | >> fail "Unable to decode node groups" |
350 | 5b48df93 | Helga Velroyen | HUnit.assertEqual "Mismatch in number of returned node groups" |
351 | 5b48df93 | Helga Velroyen | (length decoded) (length groups) |
352 | 5b48df93 | Helga Velroyen | mapM_ (uncurry (HUnit.assertEqual "Different result after encoding/decoding") |
353 | 5b48df93 | Helga Velroyen | ) $ zip decoded groups |
354 | 5b48df93 | Helga Velroyen | |
355 | 5b48df93 | Helga Velroyen | -- | Generates a node group with up to 3 networks. |
356 | 5b48df93 | Helga Velroyen | -- | FIXME: This generates still somewhat completely random data, without normal |
357 | 5b48df93 | Helga Velroyen | -- validation rules. |
358 | 5b48df93 | Helga Velroyen | genNodeGroup :: Gen NodeGroup |
359 | 5b48df93 | Helga Velroyen | genNodeGroup = do |
360 | 5b48df93 | Helga Velroyen | name <- genFQDN |
361 | 5b48df93 | Helga Velroyen | members <- pure [] |
362 | 5b48df93 | Helga Velroyen | ndparams <- arbitrary |
363 | 5b48df93 | Helga Velroyen | alloc_policy <- arbitrary |
364 | 5b48df93 | Helga Velroyen | ipolicy <- arbitrary |
365 | 5b48df93 | Helga Velroyen | diskparams <- pure (GenericContainer Map.empty) |
366 | 5b48df93 | Helga Velroyen | num_networks <- choose (0, 3) |
367 | 5b48df93 | Helga Velroyen | networks <- vectorOf num_networks genValidNetwork |
368 | 5b48df93 | Helga Velroyen | -- timestamp fields |
369 | 5b48df93 | Helga Velroyen | ctime <- arbitrary |
370 | 5b48df93 | Helga Velroyen | mtime <- arbitrary |
371 | 5b48df93 | Helga Velroyen | uuid <- arbitrary |
372 | 5b48df93 | Helga Velroyen | serial <- arbitrary |
373 | 5b48df93 | Helga Velroyen | tags <- Set.fromList <$> genTags |
374 | 5b48df93 | Helga Velroyen | let group = NodeGroup name members ndparams alloc_policy ipolicy diskparams |
375 | 5b48df93 | Helga Velroyen | networks ctime mtime uuid serial tags |
376 | 5b48df93 | Helga Velroyen | return group |
377 | 5b48df93 | Helga Velroyen | |
378 | 5b48df93 | Helga Velroyen | instance Arbitrary NodeGroup where |
379 | 5b48df93 | Helga Velroyen | arbitrary = genNodeGroup |
380 | 5b48df93 | Helga Velroyen | |
381 | e5a29b6c | Iustin Pop | testSuite "Objects" |
382 | 20bc5360 | Iustin Pop | [ 'prop_fillDict |
383 | 8d2b6a12 | Iustin Pop | , 'prop_Disk_serialisation |
384 | ce93b4a0 | Iustin Pop | , 'prop_Inst_serialisation |
385 | 76a0266e | Helga Velroyen | , 'prop_Network_serialisation |
386 | 8d2b6a12 | Iustin Pop | , 'prop_Node_serialisation |
387 | 44be51aa | Iustin Pop | , 'prop_Config_serialisation |
388 | 0b288282 | Helga Velroyen | , 'case_py_compat_networks |
389 | 5b48df93 | Helga Velroyen | , 'case_py_compat_nodegroups |
390 | 9924d61e | Iustin Pop | ] |