Statistics
| Branch: | Tag: | Revision:

root / test / hs / Test / Ganeti / TestCommon.hs @ 560ef132

History | View | Annotate | Download (13.8 kB)

1
{-| Unittest helpers for ganeti-htools.
2

    
3
-}
4

    
5
{-
6

    
7
Copyright (C) 2009, 2010, 2011, 2012, 2013 Google Inc.
8

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

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

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

    
24
-}
25

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

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

    
94
import qualified Ganeti.BasicTypes as BasicTypes
95
import Ganeti.Types
96

    
97
-- * Constants
98

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

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

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

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

    
115
-- | Max vcpu ratio (random value).
116
maxVcpuRatio :: Double
117
maxVcpuRatio = 1024.0
118

    
119
-- | Max spindle ratio (random value).
120
maxSpindleRatio :: Double
121
maxSpindleRatio = 1024.0
122

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

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

    
132
-- * Helper functions
133

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

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

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

    
155
-- | A 'True' property.
156
passTest :: Property
157
passTest = property True
158

    
159
-- | Return the python binary to use. If the PYTHON environment
160
-- variable is defined, use its value, otherwise use just \"python\".
161
pythonCmd :: IO String
162
pythonCmd = catchJust (guard . isDoesNotExistError)
163
            (getEnv "PYTHON") (const (return "python"))
164

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

    
172
-- | Check python exit code, and fail via HUnit assertions if
173
-- non-zero. Otherwise, return the standard output.
174
checkPythonResult :: (ExitCode, String, String) -> IO String
175
checkPythonResult (py_code, py_stdout, py_stderr) = do
176
  HUnit.assertEqual ("python exited with error: " ++ py_stderr)
177
       ExitSuccess py_code
178
  return py_stdout
179

    
180
-- * Arbitrary instances
181

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

    
185
instance Arbitrary DNSChar where
186
  arbitrary = liftM DNSChar $ elements (['a'..'z'] ++ ['0'..'9'] ++ "_-")
187

    
188
instance Show DNSChar where
189
  show = show . dnsGetChar
190

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

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

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

    
223
-- | Combinator that generates a 'Maybe' using a sub-combinator.
224
genMaybe :: Gen a -> Gen (Maybe a)
225
genMaybe subgen = frequency [ (1, pure Nothing), (3, Just <$> subgen) ]
226

    
227
-- | Defines a tag type.
228
newtype TagChar = TagChar { tagGetChar :: Char }
229

    
230
-- | All valid tag chars. This doesn't need to match _exactly_
231
-- Ganeti's own tag regex, just enough for it to be close.
232
tagChar :: String
233
tagChar = ['a'..'z'] ++ ['A'..'Z'] ++ ['0'..'9'] ++ ".+*/:@-"
234

    
235
instance Arbitrary TagChar where
236
  arbitrary = liftM TagChar $ elements tagChar
237

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

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

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

    
264
-- | Generates a list of a given size with non-duplicate elements.
265
genUniquesList :: (Eq a, Arbitrary a, Ord a) => Int -> Gen a -> Gen [a]
266
genUniquesList cnt generator = do
267
  set <- foldM (\set _ -> do
268
                  newelem <- generator `suchThat` (`Set.notMember` set)
269
                  return (Set.insert newelem set)) Set.empty [1..cnt]
270
  return $ Set.toList set
271

    
272
newtype SmallRatio = SmallRatio Double deriving Show
273
instance Arbitrary SmallRatio where
274
  arbitrary = liftM SmallRatio $ choose (0, 1)
275

    
276
-- | Helper for 'genSet', declared separately due to type constraints.
277
genSetHelper :: (Ord a) => [a] -> Maybe Int -> Gen (Set.Set a)
278
genSetHelper candidates size = do
279
  size' <- case size of
280
             Nothing -> choose (0, length candidates)
281
             Just s | s > length candidates ->
282
                        error $ "Invalid size " ++ show s ++ ", maximum is " ++
283
                                show (length candidates)
284
                    | otherwise -> return s
285
  foldM (\set _ -> do
286
           newelem <- elements candidates `suchThat` (`Set.notMember` set)
287
           return (Set.insert newelem set)) Set.empty [1..size']
288

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

    
293
-- | Generates a 'Set' of arbitrary elements wrapped in a 'ListSet'
294
genListSet :: (Ord a, Bounded a, Enum a) => Maybe Int
295
              -> Gen (BasicTypes.ListSet a)
296
genListSet is = BasicTypes.ListSet <$> genSet is
297

    
298
-- | Generate an arbitrary element of and AndRestArguments field.
299
genAndRestArguments :: Gen (M.Map String J.JSValue)
300
genAndRestArguments = do
301
  n <- choose (0::Int, 10)
302
  let oneParam _ = do
303
                      name <- choose (15 ::Int, 25)
304
                                >>= flip vectorOf (elements tagChar)
305
                      intvalue <- arbitrary
306
                      value <- oneof [ J.JSString . J.toJSString <$> genName
307
                                     , return $ J.showJSON (intvalue :: Int)
308
                                     ]
309
                      return (name, value)
310
  M.fromList `liftM` mapM oneParam [1..n]
311

    
312
-- | Generate an arbitrary IPv4 address in textual form.
313
genIPv4 :: Gen String
314
genIPv4 = do
315
  a <- choose (1::Int, 255)
316
  b <- choose (0::Int, 255)
317
  c <- choose (0::Int, 255)
318
  d <- choose (0::Int, 255)
319
  return . intercalate "." $ map show [a, b, c, d]
320

    
321
genIPv4Address :: Gen IPv4Address
322
genIPv4Address = mkIPv4Address =<< genIPv4
323

    
324
-- | Generate an arbitrary IPv4 network in textual form.
325
genIPv4AddrRange :: Gen String
326
genIPv4AddrRange = do
327
  ip <- genIPv4
328
  netmask <- choose (8::Int, 30)
329
  return $ ip ++ "/" ++ show netmask
330

    
331
genIPv4Network :: Gen IPv4Network
332
genIPv4Network = mkIPv4Network =<< genIPv4AddrRange
333

    
334
-- | Helper function to compute the number of hosts in a network
335
-- given the netmask. (For IPv4 only.)
336
netmask2NumHosts :: Word8 -> Int
337
netmask2NumHosts n = 2^(32-n)
338

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

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

    
355
-- | Generates a valid, arbitrary tag name with respect to the given
356
-- 'TagKind' for opcodes.
357
genOpCodesTagName :: TagKind -> Gen (Maybe String)
358
genOpCodesTagName TagKindCluster = return Nothing
359
genOpCodesTagName _ = Just <$> genFQDN
360

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

    
367
-- * Helper functions
368

    
369
-- | Checks for serialisation idempotence.
370
testSerialisation :: (Eq a, Show a, J.JSON a) => a -> Property
371
testSerialisation a =
372
  case J.readJSON (J.showJSON a) of
373
    J.Error msg -> failTest $ "Failed to deserialise: " ++ msg
374
    J.Ok a' -> a ==? a'
375

    
376
-- | Result to PropertyM IO.
377
resultProp :: (Show a) => BasicTypes.GenericResult a b -> PropertyM IO b
378
resultProp (BasicTypes.Bad err) = stop . failTest $ show err
379
resultProp (BasicTypes.Ok  val) = return val
380

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

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

    
393
-- | Returns the content of the specified haskell test data file.
394
readTestData :: String -> IO String
395
readTestData filename = do
396
    name <- testDataFilename "/test/data/" filename
397
    readFile name
398

    
399
-- | Generate arbitrary values in the IO monad. This is a simple
400
-- wrapper over 'sample''.
401
genSample :: Gen a -> IO a
402
genSample gen = do
403
  values <- sample' gen
404
  case values of
405
    [] -> error "sample' returned an empty list of values??"
406
    x:_ -> return x
407

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

    
416
-- | Generate a property test for parsers.
417
genPropParser :: (Show a, Eq a) => Parser a -> String -> a -> Property
418
genPropParser parser s expected =
419
  case parseOnly parser $ pack s of
420
    Left msg -> failTest $ "Parsing failed: " ++ msg
421
    Right obtained -> expected ==? obtained
422

    
423
-- | Generate an arbitrary non negative integer number
424
genNonNegative :: Gen Int
425
genNonNegative =
426
  fmap fromIntegral (arbitrary::Gen (Test.QuickCheck.NonNegative Int))
427

    
428
-- | Computes the relative error of two 'Double' numbers.
429
--
430
-- This is the \"relative error\" algorithm in
431
-- http:\/\/randomascii.wordpress.com\/2012\/02\/25\/
432
-- comparing-floating-point-numbers-2012-edition (URL split due to too
433
-- long line).
434
relativeError :: Double -> Double -> Double
435
relativeError d1 d2 =
436
  let delta = abs $ d1 - d2
437
      a1 = abs d1
438
      a2 = abs d2
439
      greatest = max a1 a2
440
  in if delta == 0
441
       then 0
442
       else delta / greatest
443

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