TestCommon.hs 13.1 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
47
48
49
50
  , genMaybe
  , genTags
  , genFields
  , genUniquesList
  , SmallRatio(..)
Iustin Pop's avatar
Iustin Pop committed
51
  , genSetHelper
52
  , genSet
53
  , genListSet
54
55
  , genIPv4Address
  , genIPv4Network
56
57
  , genIp6Addr
  , genIp6Net
58
59
  , genOpCodesTagName
  , genLuxiTagName
60
61
62
63
64
  , netmask2NumHosts
  , testSerialisation
  , resultProp
  , readTestData
  , genSample
65
  , testParser
66
  , genPropParser
67
  , genNonNegative
68
  , relativeError
Jose A. Lopes's avatar
Jose A. Lopes committed
69
  , getTempFileName
70
  ) where
71
72

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

92
import qualified Ganeti.BasicTypes as BasicTypes
93
import Ganeti.Types
94

95
96
97
98
99
100
101
102
103
104
105
106
107
108
-- * 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

109
110
111
112
-- | Max spindles (1024, somewhat random value).
maxSpindles :: Int
maxSpindles = 1024

113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
-- | 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

132
133
-- | Checks for equality with proper annotation. The first argument is
-- the computed value, the second one the expected value.
134
135
(==?) :: (Show a, Eq a) => a -> a -> Property
(==?) x y = printTestCase
136
            ("Expected equality, but got mismatch\nexpected: " ++
137
             show y ++ "\n but got: " ++ show x) (x == y)
138
139
infix 3 ==?

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

149
150
151
152
-- | Show a message and fail the test.
failTest :: String -> Property
failTest msg = printTestCase msg False

Iustin Pop's avatar
Iustin Pop committed
153
154
155
156
-- | A 'True' property.
passTest :: Property
passTest = property True

157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
-- | 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
177
178
179
180
181
182
183

-- * Arbitrary instances

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

instance Arbitrary DNSChar where
Iustin Pop's avatar
Iustin Pop committed
184
  arbitrary = liftM DNSChar $ elements (['a'..'z'] ++ ['0'..'9'] ++ "_-")
185
186
187
188
189

instance Show DNSChar where
  show = show . dnsGetChar

-- | Generates a single name component.
190
191
genName :: Gen String
genName = do
192
  n <- choose (1, 16)
193
194
195
196
  dn <- vector n
  return (map dnsGetChar dn)

-- | Generates an entire FQDN.
197
198
genFQDN :: Gen String
genFQDN = do
199
  ncomps <- choose (1, 4)
200
  names <- vectorOf ncomps genName
201
202
  return $ intercalate "." names

203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
-- | 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

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

-- | 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
230
tagChar :: String
Iustin Pop's avatar
Iustin Pop committed
231
232
233
tagChar = ['a'..'z'] ++ ['A'..'Z'] ++ ['0'..'9'] ++ ".+*/:@-"

instance Arbitrary TagChar where
Iustin Pop's avatar
Iustin Pop committed
234
  arbitrary = liftM TagChar $ elements tagChar
Iustin Pop's avatar
Iustin Pop committed
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253

-- | 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
254
255
256

-- | Generates a fields list. This uses the same character set as a
-- DNS name (just for simplicity).
257
258
genFields :: Gen [String]
genFields = do
259
  n <- choose (1, 32)
260
  vectorOf n genName
261
262

-- | Generates a list of a given size with non-duplicate elements.
263
264
265
266
267
268
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
269
270
271

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

274
275
276
277
278
279
280
281
282
283
284
285
286
-- | 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']

287
-- | Generates a 'Set' of arbitrary elements.
288
289
290
genSet :: (Ord a, Bounded a, Enum a) => Maybe Int -> Gen (Set.Set a)
genSet = genSetHelper [minBound..maxBound]

291
292
293
294
295
-- | 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

296
-- | Generate an arbitrary IPv4 address in textual form.
297
298
genIPv4 :: Gen String
genIPv4 = do
299
300
301
302
  a <- choose (1::Int, 255)
  b <- choose (0::Int, 255)
  c <- choose (0::Int, 255)
  d <- choose (0::Int, 255)
303
  return . intercalate "." $ map show [a, b, c, d]
304

305
306
genIPv4Address :: Gen IPv4Address
genIPv4Address = mkIPv4Address =<< genIPv4
307
308

-- | Generate an arbitrary IPv4 network in textual form.
309
310
311
genIPv4AddrRange :: Gen String
genIPv4AddrRange = do
  ip <- genIPv4
312
  netmask <- choose (8::Int, 30)
313
314
315
316
  return $ ip ++ "/" ++ show netmask

genIPv4Network :: Gen IPv4Network
genIPv4Network = mkIPv4Network =<< genIPv4AddrRange
317
318
319

-- | Helper function to compute the number of hosts in a network
-- given the netmask. (For IPv4 only.)
320
netmask2NumHosts :: Word8 -> Int
321
netmask2NumHosts n = 2^(32-n)
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338

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

339
340
-- | Generates a valid, arbitrary tag name with respect to the given
-- 'TagKind' for opcodes.
Jose A. Lopes's avatar
Jose A. Lopes committed
341
genOpCodesTagName :: TagKind -> Gen (Maybe String)
342
genOpCodesTagName TagKindCluster = return Nothing
Jose A. Lopes's avatar
Jose A. Lopes committed
343
genOpCodesTagName _ = Just <$> genFQDN
344
345
346
347
348
349
350

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

351
352
-- * Helper functions

353
354
355
356
357
358
-- | 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'
359
360

-- | Result to PropertyM IO.
Iustin Pop's avatar
Iustin Pop committed
361
362
resultProp :: (Show a) => BasicTypes.GenericResult a b -> PropertyM IO b
resultProp (BasicTypes.Bad err) = stop . failTest $ show err
363
resultProp (BasicTypes.Ok  val) = return val
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379

-- | 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
380
    name <- testDataFilename "/test/data/" filename
381
    readFile name
382
383
384
385
386
387
388
389
390

-- | 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
391
392
393
394
395
396
397
398

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

400
401
402
403
404
405
406
-- | 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

407
408
409
410
-- | Generate an arbitrary non negative integer number
genNonNegative :: Gen Int
genNonNegative =
  fmap fromIntegral (arbitrary::Gen (Test.QuickCheck.NonNegative Int))
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426

-- | 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
427
428
429
430
431
432
433
434
435

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