TestCommon.hs 15.2 KB
Newer Older
1
2
3
4
5
6
{-| Unittest helpers for ganeti-htools.

-}

{-

7
Copyright (C) 2009, 2010, 2011, 2012, 2013 Google Inc.
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25

This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.

This program is distributed in the hope that it will be useful, but
WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
General Public License for more details.

You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
02110-1301, USA.

-}

26
27
28
29
module Test.Ganeti.TestCommon
  ( maxMem
  , maxDsk
  , maxCpu
30
  , maxSpindles
31
32
33
34
35
36
37
38
39
40
41
42
43
44
  , maxVcpuRatio
  , maxSpindleRatio
  , maxNodes
  , maxOpCodes
  , (==?)
  , (/=?)
  , failTest
  , passTest
  , pythonCmd
  , runPython
  , checkPythonResult
  , DNSChar(..)
  , genName
  , genFQDN
45
  , genUUID
46
  , genMaybe
Petr Pudlak's avatar
Petr Pudlak committed
47
  , genSublist
48
49
50
51
  , genTags
  , genFields
  , genUniquesList
  , SmallRatio(..)
Iustin Pop's avatar
Iustin Pop committed
52
  , genSetHelper
53
  , genSet
54
  , genListSet
55
  , genAndRestArguments
56
57
  , genIPv4Address
  , genIPv4Network
58
59
  , genIp6Addr
  , genIp6Net
60
61
  , genOpCodesTagName
  , genLuxiTagName
62
63
  , netmask2NumHosts
  , testSerialisation
64
  , testArraySerialisation
65
  , testDeserialisationFail
66
67
68
  , resultProp
  , readTestData
  , genSample
69
  , testParser
70
  , genPropParser
71
  , genNonNegative
72
  , relativeError
Jose A. Lopes's avatar
Jose A. Lopes committed
73
  , getTempFileName
74
  ) where
75
76

import Control.Applicative
77
78
import Control.Exception (catchJust)
import Control.Monad
79
import Data.Attoparsec.Text (Parser, parseOnly)
80
import Data.List
81
import qualified Data.Map as M
82
import Data.Text (pack)
83
import Data.Word
84
import qualified Data.Set as Set
Jose A. Lopes's avatar
Jose A. Lopes committed
85
import System.Directory (getTemporaryDirectory, removeFile)
86
87
import System.Environment (getEnv)
import System.Exit (ExitCode(..))
Jose A. Lopes's avatar
Jose A. Lopes committed
88
import System.IO (hClose, openTempFile)
89
90
import System.IO.Error (isDoesNotExistError)
import System.Process (readProcessWithExitCode)
91
92
93
94
import qualified Test.HUnit as HUnit
import Test.QuickCheck
import Test.QuickCheck.Monadic
import qualified Text.JSON as J
95
import Numeric
96

97
import qualified Ganeti.BasicTypes as BasicTypes
98
import Ganeti.JSON (ArrayObject(..))
99
import Ganeti.Types
100

101
102
103
104
105
106
107
108
109
110
111
112
113
114
-- * Constants

-- | Maximum memory (1TiB, somewhat random value).
maxMem :: Int
maxMem = 1024 * 1024

-- | Maximum disk (8TiB, somewhat random value).
maxDsk :: Int
maxDsk = 1024 * 1024 * 8

-- | Max CPUs (1024, somewhat random value).
maxCpu :: Int
maxCpu = 1024

115
116
117
118
-- | Max spindles (1024, somewhat random value).
maxSpindles :: Int
maxSpindles = 1024

119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
-- | Max vcpu ratio (random value).
maxVcpuRatio :: Double
maxVcpuRatio = 1024.0

-- | Max spindle ratio (random value).
maxSpindleRatio :: Double
maxSpindleRatio = 1024.0

-- | Max nodes, used just to limit arbitrary instances for smaller
-- opcode definitions (e.g. list of nodes in OpTestDelay).
maxNodes :: Int
maxNodes = 32

-- | Max opcodes or jobs in a submit job and submit many jobs.
maxOpCodes :: Int
maxOpCodes = 16

-- * Helper functions

138
139
-- | Checks for equality with proper annotation. The first argument is
-- the computed value, the second one the expected value.
140
141
(==?) :: (Show a, Eq a) => a -> a -> Property
(==?) x y = printTestCase
142
            ("Expected equality, but got mismatch\nexpected: " ++
143
             show y ++ "\n but got: " ++ show x) (x == y)
144
145
infix 3 ==?

146
147
148
-- | Checks for inequality with proper annotation. The first argument
-- is the computed value, the second one the expected (not equal)
-- value.
149
150
151
152
153
154
(/=?) :: (Show a, Eq a) => a -> a -> Property
(/=?) x y = printTestCase
            ("Expected inequality, but got equality: '" ++
             show x ++ "'.") (x /= y)
infix 3 /=?

155
156
157
158
-- | Show a message and fail the test.
failTest :: String -> Property
failTest msg = printTestCase msg False

Iustin Pop's avatar
Iustin Pop committed
159
160
161
162
-- | A 'True' property.
passTest :: Property
passTest = property True

163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
-- | Return the python binary to use. If the PYTHON environment
-- variable is defined, use its value, otherwise use just \"python\".
pythonCmd :: IO String
pythonCmd = catchJust (guard . isDoesNotExistError)
            (getEnv "PYTHON") (const (return "python"))

-- | Run Python with an expression, returning the exit code, standard
-- output and error.
runPython :: String -> String -> IO (ExitCode, String, String)
runPython expr stdin = do
  py_binary <- pythonCmd
  readProcessWithExitCode py_binary ["-c", expr] stdin

-- | Check python exit code, and fail via HUnit assertions if
-- non-zero. Otherwise, return the standard output.
checkPythonResult :: (ExitCode, String, String) -> IO String
checkPythonResult (py_code, py_stdout, py_stderr) = do
  HUnit.assertEqual ("python exited with error: " ++ py_stderr)
       ExitSuccess py_code
  return py_stdout
183
184
185
186
187
188
189

-- * Arbitrary instances

-- | Defines a DNS name.
newtype DNSChar = DNSChar { dnsGetChar::Char }

instance Arbitrary DNSChar where
Iustin Pop's avatar
Iustin Pop committed
190
  arbitrary = liftM DNSChar $ elements (['a'..'z'] ++ ['0'..'9'] ++ "_-")
191
192
193
194
195

instance Show DNSChar where
  show = show . dnsGetChar

-- | Generates a single name component.
196
197
genName :: Gen String
genName = do
198
  n <- choose (1, 16)
199
200
201
202
  dn <- vector n
  return (map dnsGetChar dn)

-- | Generates an entire FQDN.
203
204
genFQDN :: Gen String
genFQDN = do
205
  ncomps <- choose (1, 4)
206
  names <- vectorOf ncomps genName
207
208
  return $ intercalate "." names

209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
-- | Generates a UUID-like string.
--
-- Only to be used for QuickCheck testing. For obtaining actual UUIDs use
-- the newUUID function in Ganeti.Utils
genUUID :: Gen String
genUUID = do
  c1 <- vector 6
  c2 <- vector 4
  c3 <- vector 4
  c4 <- vector 4
  c5 <- vector 4
  c6 <- vector 4
  c7 <- vector 6
  return $ map dnsGetChar c1 ++ "-" ++ map dnsGetChar c2 ++ "-" ++
    map dnsGetChar c3 ++ "-" ++ map dnsGetChar c4 ++ "-" ++
    map dnsGetChar c5 ++ "-" ++ map dnsGetChar c6 ++ "-" ++
    map dnsGetChar c7

227
-- | Combinator that generates a 'Maybe' using a sub-combinator.
228
genMaybe :: Gen a -> Gen (Maybe a)
Guido Trotter's avatar
Guido Trotter committed
229
genMaybe subgen = frequency [ (1, pure Nothing), (3, Just <$> subgen) ]
Iustin Pop's avatar
Iustin Pop committed
230

Petr Pudlak's avatar
Petr Pudlak committed
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
-- | Generates a sublist of a given list, keeping the ordering.
-- The generated elements are always a subset of the list.
--
-- In order to better support corner cases, the size of the sublist is
-- chosen to have the uniform distribution.
genSublist :: [a] -> Gen [a]
genSublist xs = choose (0, l) >>= g xs l
  where
    l = length xs
    g _      _ 0 = return []
    g []     _ _ = return []
    g ys     n k | k == n = return ys
    g (y:ys) n k = frequency [ (k,     liftM (y :) (g ys (n - 1) (k - 1)))
                             , (n - k, g ys (n - 1) k)
                             ]

Iustin Pop's avatar
Iustin Pop committed
247
248
249
250
251
-- | Defines a tag type.
newtype TagChar = TagChar { tagGetChar :: Char }

-- | All valid tag chars. This doesn't need to match _exactly_
-- Ganeti's own tag regex, just enough for it to be close.
Iustin Pop's avatar
Iustin Pop committed
252
tagChar :: String
Iustin Pop's avatar
Iustin Pop committed
253
254
255
tagChar = ['a'..'z'] ++ ['A'..'Z'] ++ ['0'..'9'] ++ ".+*/:@-"

instance Arbitrary TagChar where
Iustin Pop's avatar
Iustin Pop committed
256
  arbitrary = liftM TagChar $ elements tagChar
Iustin Pop's avatar
Iustin Pop committed
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275

-- | Generates a tag
genTag :: Gen [TagChar]
genTag = do
  -- the correct value would be C.maxTagLen, but that's way too
  -- verbose in unittests, and at the moment I don't see any possible
  -- bugs with longer tags and the way we use tags in htools
  n <- choose (1, 10)
  vector n

-- | Generates a list of tags (correctly upper bounded).
genTags :: Gen [String]
genTags = do
  -- the correct value would be C.maxTagsPerObj, but per the comment
  -- in genTag, we don't use tags enough in htools to warrant testing
  -- such big values
  n <- choose (0, 10::Int)
  tags <- mapM (const genTag) [1..n]
  return $ map (map tagGetChar) tags
276
277
278

-- | Generates a fields list. This uses the same character set as a
-- DNS name (just for simplicity).
279
280
genFields :: Gen [String]
genFields = do
281
  n <- choose (1, 32)
282
  vectorOf n genName
283
284

-- | Generates a list of a given size with non-duplicate elements.
285
286
287
288
289
290
genUniquesList :: (Eq a, Arbitrary a, Ord a) => Int -> Gen a -> Gen [a]
genUniquesList cnt generator = do
  set <- foldM (\set _ -> do
                  newelem <- generator `suchThat` (`Set.notMember` set)
                  return (Set.insert newelem set)) Set.empty [1..cnt]
  return $ Set.toList set
291
292
293

newtype SmallRatio = SmallRatio Double deriving Show
instance Arbitrary SmallRatio where
Iustin Pop's avatar
Iustin Pop committed
294
  arbitrary = liftM SmallRatio $ choose (0, 1)
295

296
297
298
299
300
301
302
303
304
305
306
307
308
-- | Helper for 'genSet', declared separately due to type constraints.
genSetHelper :: (Ord a) => [a] -> Maybe Int -> Gen (Set.Set a)
genSetHelper candidates size = do
  size' <- case size of
             Nothing -> choose (0, length candidates)
             Just s | s > length candidates ->
                        error $ "Invalid size " ++ show s ++ ", maximum is " ++
                                show (length candidates)
                    | otherwise -> return s
  foldM (\set _ -> do
           newelem <- elements candidates `suchThat` (`Set.notMember` set)
           return (Set.insert newelem set)) Set.empty [1..size']

309
-- | Generates a 'Set' of arbitrary elements.
310
311
312
genSet :: (Ord a, Bounded a, Enum a) => Maybe Int -> Gen (Set.Set a)
genSet = genSetHelper [minBound..maxBound]

313
314
315
316
317
-- | Generates a 'Set' of arbitrary elements wrapped in a 'ListSet'
genListSet :: (Ord a, Bounded a, Enum a) => Maybe Int
              -> Gen (BasicTypes.ListSet a)
genListSet is = BasicTypes.ListSet <$> genSet is

318
319
320
321
322
323
324
325
326
327
328
329
330
331
-- | Generate an arbitrary element of and AndRestArguments field.
genAndRestArguments :: Gen (M.Map String J.JSValue)
genAndRestArguments = do
  n <- choose (0::Int, 10)
  let oneParam _ = do
                      name <- choose (15 ::Int, 25)
                                >>= flip vectorOf (elements tagChar)
                      intvalue <- arbitrary
                      value <- oneof [ J.JSString . J.toJSString <$> genName
                                     , return $ J.showJSON (intvalue :: Int)
                                     ]
                      return (name, value)
  M.fromList `liftM` mapM oneParam [1..n]

332
-- | Generate an arbitrary IPv4 address in textual form.
333
334
genIPv4 :: Gen String
genIPv4 = do
335
336
337
338
  a <- choose (1::Int, 255)
  b <- choose (0::Int, 255)
  c <- choose (0::Int, 255)
  d <- choose (0::Int, 255)
339
  return . intercalate "." $ map show [a, b, c, d]
340

341
342
genIPv4Address :: Gen IPv4Address
genIPv4Address = mkIPv4Address =<< genIPv4
343
344

-- | Generate an arbitrary IPv4 network in textual form.
345
346
347
genIPv4AddrRange :: Gen String
genIPv4AddrRange = do
  ip <- genIPv4
348
  netmask <- choose (8::Int, 30)
349
350
351
352
  return $ ip ++ "/" ++ show netmask

genIPv4Network :: Gen IPv4Network
genIPv4Network = mkIPv4Network =<< genIPv4AddrRange
353
354
355

-- | Helper function to compute the number of hosts in a network
-- given the netmask. (For IPv4 only.)
356
netmask2NumHosts :: Word8 -> Int
357
netmask2NumHosts n = 2^(32-n)
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374

-- | Generates an arbitrary IPv6 network address in textual form.
-- The generated address is not simpflified, e. g. an address like
-- "2607:f0d0:1002:0051:0000:0000:0000:0004" does not become
-- "2607:f0d0:1002:51::4"
genIp6Addr :: Gen String
genIp6Addr = do
  rawIp <- vectorOf 8 $ choose (0::Integer, 65535)
  return $ intercalate ":" (map (`showHex` "") rawIp)

-- | Generates an arbitrary IPv6 network in textual form.
genIp6Net :: Gen String
genIp6Net = do
  netmask <- choose (8::Int, 126)
  ip <- genIp6Addr
  return $ ip ++ "/" ++ show netmask

375
376
-- | Generates a valid, arbitrary tag name with respect to the given
-- 'TagKind' for opcodes.
Jose A. Lopes's avatar
Jose A. Lopes committed
377
genOpCodesTagName :: TagKind -> Gen (Maybe String)
378
genOpCodesTagName TagKindCluster = return Nothing
Jose A. Lopes's avatar
Jose A. Lopes committed
379
genOpCodesTagName _ = Just <$> genFQDN
380
381
382
383
384
385
386

-- | Generates a valid, arbitrary tag name with respect to the given
-- 'TagKind' for Luxi.
genLuxiTagName :: TagKind -> Gen String
genLuxiTagName TagKindCluster = return ""
genLuxiTagName _ = genFQDN

387
388
-- * Helper functions

389
390
391
392
393
394
-- | Checks for serialisation idempotence.
testSerialisation :: (Eq a, Show a, J.JSON a) => a -> Property
testSerialisation a =
  case J.readJSON (J.showJSON a) of
    J.Error msg -> failTest $ "Failed to deserialise: " ++ msg
    J.Ok a' -> a ==? a'
395

396
397
398
399
400
401
402
-- | Checks for array serialisation idempotence.
testArraySerialisation :: (Eq a, Show a, ArrayObject a) => a -> Property
testArraySerialisation a =
  case fromJSArray (toJSArray a) of
    J.Error msg -> failTest $ "Failed to deserialise: " ++ msg
    J.Ok a' -> a ==? a'

403
404
405
406
407
408
409
410
411
412
-- | Checks if the deserializer doesn't accept forbidden values.
-- The first argument is ignored, it just enforces the correct type.
testDeserialisationFail :: (Eq a, Show a, J.JSON a)
                        => a -> J.JSValue -> Property
testDeserialisationFail a val =
  case liftM (`asTypeOf` a) $ J.readJSON val of
    J.Error _ -> passTest
    J.Ok x    -> failTest $ "Parsed invalid value " ++ show val ++
                            " to: " ++ show x

413
-- | Result to PropertyM IO.
Iustin Pop's avatar
Iustin Pop committed
414
415
resultProp :: (Show a) => BasicTypes.GenericResult a b -> PropertyM IO b
resultProp (BasicTypes.Bad err) = stop . failTest $ show err
416
resultProp (BasicTypes.Ok  val) = return val
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432

-- | Return the source directory of Ganeti.
getSourceDir :: IO FilePath
getSourceDir = catchJust (guard . isDoesNotExistError)
            (getEnv "TOP_SRCDIR")
            (const (return "."))

-- | Returns the path of a file in the test data directory, given its name.
testDataFilename :: String -> String -> IO FilePath
testDataFilename datadir name = do
        src <- getSourceDir
        return $ src ++ datadir ++ name

-- | Returns the content of the specified haskell test data file.
readTestData :: String -> IO String
readTestData filename = do
433
    name <- testDataFilename "/test/data/" filename
434
    readFile name
435
436
437
438
439
440
441
442
443

-- | Generate arbitrary values in the IO monad. This is a simple
-- wrapper over 'sample''.
genSample :: Gen a -> IO a
genSample gen = do
  values <- sample' gen
  case values of
    [] -> error "sample' returned an empty list of values??"
    x:_ -> return x
444
445
446
447
448
449
450
451

-- | Function for testing whether a file is parsed correctly.
testParser :: (Show a, Eq a) => Parser a -> String -> a -> HUnit.Assertion
testParser parser fileName expectedContent = do
  fileContent <- readTestData fileName
  case parseOnly parser $ pack fileContent of
    Left msg -> HUnit.assertFailure $ "Parsing failed: " ++ msg
    Right obtained -> HUnit.assertEqual fileName expectedContent obtained
452

453
454
455
456
457
458
459
-- | Generate a property test for parsers.
genPropParser :: (Show a, Eq a) => Parser a -> String -> a -> Property
genPropParser parser s expected =
  case parseOnly parser $ pack s of
    Left msg -> failTest $ "Parsing failed: " ++ msg
    Right obtained -> expected ==? obtained

460
461
462
463
-- | Generate an arbitrary non negative integer number
genNonNegative :: Gen Int
genNonNegative =
  fmap fromIntegral (arbitrary::Gen (Test.QuickCheck.NonNegative Int))
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479

-- | Computes the relative error of two 'Double' numbers.
--
-- This is the \"relative error\" algorithm in
-- http:\/\/randomascii.wordpress.com\/2012\/02\/25\/
-- comparing-floating-point-numbers-2012-edition (URL split due to too
-- long line).
relativeError :: Double -> Double -> Double
relativeError d1 d2 =
  let delta = abs $ d1 - d2
      a1 = abs d1
      a2 = abs d2
      greatest = max a1 a2
  in if delta == 0
       then 0
       else delta / greatest
Jose A. Lopes's avatar
Jose A. Lopes committed
480
481
482
483
484
485
486
487
488

-- | Helper to a get a temporary file name.
getTempFileName :: String -> IO FilePath
getTempFileName filename = do
  tempdir <- getTemporaryDirectory
  (fpath, handle) <- openTempFile tempdir filename
  _ <- hClose handle
  removeFile fpath
  return fpath