TestCommon.hs 9.61 KB
Newer Older
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
{-| Unittest helpers for ganeti-htools.

-}

{-

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

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.

-}

module Test.Ganeti.TestCommon where

import Control.Applicative
29
30
import Control.Exception (catchJust)
import Control.Monad
31
import Data.List
32
import qualified Data.Set as Set
33
34
35
36
import System.Environment (getEnv)
import System.Exit (ExitCode(..))
import System.IO.Error (isDoesNotExistError)
import System.Process (readProcessWithExitCode)
37
38
39
40
import qualified Test.HUnit as HUnit
import Test.QuickCheck
import Test.QuickCheck.Monadic
import qualified Text.JSON as J
41
import Numeric
42

43
import qualified Ganeti.BasicTypes as BasicTypes
44
import Ganeti.Types
45

46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
-- * 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

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

79
80
-- | Checks for equality with proper annotation. The first argument is
-- the computed value, the second one the expected value.
81
82
(==?) :: (Show a, Eq a) => a -> a -> Property
(==?) x y = printTestCase
83
            ("Expected equality, but got mismatch\nexpected: " ++
84
             show y ++ "\n but got: " ++ show x) (x == y)
85
86
infix 3 ==?

87
88
89
-- | Checks for inequality with proper annotation. The first argument
-- is the computed value, the second one the expected (not equal)
-- value.
90
91
92
93
94
95
(/=?) :: (Show a, Eq a) => a -> a -> Property
(/=?) x y = printTestCase
            ("Expected inequality, but got equality: '" ++
             show x ++ "'.") (x /= y)
infix 3 /=?

96
97
98
99
-- | Show a message and fail the test.
failTest :: String -> Property
failTest msg = printTestCase msg False

Iustin Pop's avatar
Iustin Pop committed
100
101
102
103
-- | A 'True' property.
passTest :: Property
passTest = property True

104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
-- | 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
124
125
126
127
128
129
130

-- * Arbitrary instances

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

instance Arbitrary DNSChar where
Iustin Pop's avatar
Iustin Pop committed
131
  arbitrary = liftM DNSChar $ elements (['a'..'z'] ++ ['0'..'9'] ++ "_-")
132
133
134
135
136

instance Show DNSChar where
  show = show . dnsGetChar

-- | Generates a single name component.
137
138
genName :: Gen String
genName = do
139
  n <- choose (1, 16)
140
141
142
143
  dn <- vector n
  return (map dnsGetChar dn)

-- | Generates an entire FQDN.
144
145
genFQDN :: Gen String
genFQDN = do
146
  ncomps <- choose (1, 4)
147
  names <- vectorOf ncomps genName
148
149
150
  return $ intercalate "." names

-- | Combinator that generates a 'Maybe' using a sub-combinator.
151
genMaybe :: Gen a -> Gen (Maybe a)
Guido Trotter's avatar
Guido Trotter committed
152
genMaybe subgen = frequency [ (1, pure Nothing), (3, Just <$> subgen) ]
Iustin Pop's avatar
Iustin Pop committed
153
154
155
156
157
158

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

instance Arbitrary TagChar where
Iustin Pop's avatar
Iustin Pop committed
163
  arbitrary = liftM TagChar $ elements tagChar
Iustin Pop's avatar
Iustin Pop committed
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182

-- | 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
183
184
185

-- | Generates a fields list. This uses the same character set as a
-- DNS name (just for simplicity).
186
187
genFields :: Gen [String]
genFields = do
188
  n <- choose (1, 32)
189
  vectorOf n genName
190
191

-- | Generates a list of a given size with non-duplicate elements.
192
193
194
195
196
197
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
198
199
200

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

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

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

220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
-- | Generate an arbitrary IPv4 address in textual form (non empty).
genIp4Addr :: Gen NonEmptyString
genIp4Addr = genIp4AddrStr >>= mkNonEmpty

-- | Generate an arbitrary IPv4 address in textual form.
genIp4AddrStr :: Gen String
genIp4AddrStr = do
  a <- choose (1::Int, 255)
  b <- choose (0::Int, 255)
  c <- choose (0::Int, 255)
  d <- choose (0::Int, 255)
  return $ intercalate "." (map show [a, b, c, d])

-- | Generates an arbitrary IPv4 address with a given netmask in textual form.
genIp4NetWithNetmask :: Int -> Gen NonEmptyString
genIp4NetWithNetmask netmask = do
  ip <- genIp4AddrStr
  mkNonEmpty $ ip ++ "/" ++ show netmask

-- | Generate an arbitrary IPv4 network in textual form.
genIp4Net :: Gen NonEmptyString
genIp4Net = do
  netmask <- choose (8::Int, 30)
  genIp4NetWithNetmask netmask

-- | Helper function to compute the number of hosts in a network
-- given the netmask. (For IPv4 only.)
netmask2NumHosts :: Int -> Int
248
netmask2NumHosts n = 2^(32-n)
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265

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

266
267
-- * Helper functions

268
269
270
271
272
273
-- | 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'
274
275

-- | Result to PropertyM IO.
Iustin Pop's avatar
Iustin Pop committed
276
277
resultProp :: (Show a) => BasicTypes.GenericResult a b -> PropertyM IO b
resultProp (BasicTypes.Bad err) = stop . failTest $ show err
278
resultProp (BasicTypes.Ok  val) = return val
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302

-- | 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 python test data file.
readPythonTestData :: String -> IO String
readPythonTestData filename = do
    name <- testDataFilename "/test/data/" filename
    readFile name

-- | Returns the content of the specified haskell test data file.
readTestData :: String -> IO String
readTestData filename = do
    name <- testDataFilename "/htest/data/" filename
    readFile name