Statistics
| Branch: | Tag: | Revision:

root / test / hs / Test / Ganeti / TestCommon.hs @ 1c0f9d12

History | View | Annotate | Download (9.4 kB)

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

    
3
-}
4

    
5
{-
6

    
7
Copyright (C) 2009, 2010, 2011, 2012 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 where
27

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

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

    
46
-- * Constants
47

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

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

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

    
60
-- | Max vcpu ratio (random value).
61
maxVcpuRatio :: Double
62
maxVcpuRatio = 1024.0
63

    
64
-- | Max spindle ratio (random value).
65
maxSpindleRatio :: Double
66
maxSpindleRatio = 1024.0
67

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

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

    
77
-- * Helper functions
78

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

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

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

    
100
-- | A 'True' property.
101
passTest :: Property
102
passTest = property True
103

    
104
-- | Return the python binary to use. If the PYTHON environment
105
-- variable is defined, use its value, otherwise use just \"python\".
106
pythonCmd :: IO String
107
pythonCmd = catchJust (guard . isDoesNotExistError)
108
            (getEnv "PYTHON") (const (return "python"))
109

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

    
117
-- | Check python exit code, and fail via HUnit assertions if
118
-- non-zero. Otherwise, return the standard output.
119
checkPythonResult :: (ExitCode, String, String) -> IO String
120
checkPythonResult (py_code, py_stdout, py_stderr) = do
121
  HUnit.assertEqual ("python exited with error: " ++ py_stderr)
122
       ExitSuccess py_code
123
  return py_stdout
124

    
125
-- * Arbitrary instances
126

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

    
130
instance Arbitrary DNSChar where
131
  arbitrary = liftM DNSChar $ elements (['a'..'z'] ++ ['0'..'9'] ++ "_-")
132

    
133
instance Show DNSChar where
134
  show = show . dnsGetChar
135

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

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

    
150
-- | Combinator that generates a 'Maybe' using a sub-combinator.
151
genMaybe :: Gen a -> Gen (Maybe a)
152
genMaybe subgen = frequency [ (1, pure Nothing), (3, Just <$> subgen) ]
153

    
154
-- | Defines a tag type.
155
newtype TagChar = TagChar { tagGetChar :: Char }
156

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

    
162
instance Arbitrary TagChar where
163
  arbitrary = liftM TagChar $ elements tagChar
164

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

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

    
184
-- | Generates a fields list. This uses the same character set as a
185
-- DNS name (just for simplicity).
186
genFields :: Gen [String]
187
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
genUniquesList :: (Eq a, Arbitrary a, Ord a) => Int -> Gen a -> Gen [a]
193
genUniquesList cnt generator = do
194
  set <- foldM (\set _ -> do
195
                  newelem <- generator `suchThat` (`Set.notMember` set)
196
                  return (Set.insert newelem set)) Set.empty [1..cnt]
197
  return $ Set.toList set
198

    
199
newtype SmallRatio = SmallRatio Double deriving Show
200
instance Arbitrary SmallRatio where
201
  arbitrary = liftM SmallRatio $ choose (0, 1)
202

    
203
-- | Helper for 'genSet', declared separately due to type constraints.
204
genSetHelper :: (Ord a) => [a] -> Maybe Int -> Gen (Set.Set a)
205
genSetHelper candidates size = do
206
  size' <- case size of
207
             Nothing -> choose (0, length candidates)
208
             Just s | s > length candidates ->
209
                        error $ "Invalid size " ++ show s ++ ", maximum is " ++
210
                                show (length candidates)
211
                    | otherwise -> return s
212
  foldM (\set _ -> do
213
           newelem <- elements candidates `suchThat` (`Set.notMember` set)
214
           return (Set.insert newelem set)) Set.empty [1..size']
215

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

    
220
-- | Generate an arbitrary IPv4 address in textual form (non empty).
221
genIp4Addr :: Gen NonEmptyString
222
genIp4Addr = genIp4AddrStr >>= mkNonEmpty
223

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

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

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

    
245
-- | Helper function to compute the number of hosts in a network
246
-- given the netmask. (For IPv4 only.)
247
netmask2NumHosts :: Int -> Int
248
netmask2NumHosts n = 2^(32-n)
249

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

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

    
266
-- * Helper functions
267

    
268
-- | Checks for serialisation idempotence.
269
testSerialisation :: (Eq a, Show a, J.JSON a) => a -> Property
270
testSerialisation a =
271
  case J.readJSON (J.showJSON a) of
272
    J.Error msg -> failTest $ "Failed to deserialise: " ++ msg
273
    J.Ok a' -> a ==? a'
274

    
275
-- | Result to PropertyM IO.
276
resultProp :: (Show a) => BasicTypes.GenericResult a b -> PropertyM IO b
277
resultProp (BasicTypes.Bad err) = stop . failTest $ show err
278
resultProp (BasicTypes.Ok  val) = return val
279

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

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

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