code.grnet.gr Git - ganeti-local/blob - test/hs/Test/Ganeti/TestCommon.hs

   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   , maxVcpuRatio
  31   , maxSpindleRatio
  32   , maxNodes
  33   , maxOpCodes
  34   , (==?)
  35   , (/=?)
  36   , failTest
  37   , passTest
  38   , pythonCmd
  39   , runPython
  40   , checkPythonResult
  41   , DNSChar(..)
  42   , genName
  43   , genFQDN
  44   , genMaybe
  45   , genTags
  46   , genFields
  47   , genUniquesList
  48   , SmallRatio(..)
  49   , genSetHelper
  50   , genSet
  51   , genIp4AddrStr
  52   , genIp4Addr
  53   , genIp4NetWithNetmask
  54   , genIp4Net
  55   , genIp6Addr
  56   , genIp6Net
  57   , netmask2NumHosts
  58   , testSerialisation
  59   , resultProp
  60   , readTestData
  61   , genSample
  62   ) where
  63
  64 import Control.Applicative
  65 import Control.Exception (catchJust)
  66 import Control.Monad
  67 import Data.List
  68 import qualified Data.Set as Set
  69 import System.Environment (getEnv)
  70 import System.Exit (ExitCode(..))
  71 import System.IO.Error (isDoesNotExistError)
  72 import System.Process (readProcessWithExitCode)
  73 import qualified Test.HUnit as HUnit
  74 import Test.QuickCheck
  75 import Test.QuickCheck.Monadic
  76 import qualified Text.JSON as J
  77 import Numeric
  78
  79 import qualified Ganeti.BasicTypes as BasicTypes
  80 import Ganeti.Types
  81
  82 -- * Constants
  83
  84 -- | Maximum memory (1TiB, somewhat random value).
  85 maxMem :: Int
  86 maxMem = 1024 * 1024
  87
  88 -- | Maximum disk (8TiB, somewhat random value).
  89 maxDsk :: Int
  90 maxDsk = 1024 * 1024 * 8
  91
  92 -- | Max CPUs (1024, somewhat random value).
  93 maxCpu :: Int
  94 maxCpu = 1024
  95
  96 -- | Max vcpu ratio (random value).
  97 maxVcpuRatio :: Double
  98 maxVcpuRatio = 1024.0
  99
 100 -- | Max spindle ratio (random value).
 101 maxSpindleRatio :: Double
 102 maxSpindleRatio = 1024.0
 103
 104 -- | Max nodes, used just to limit arbitrary instances for smaller
 105 -- opcode definitions (e.g. list of nodes in OpTestDelay).
 106 maxNodes :: Int
 107 maxNodes = 32
 108
 109 -- | Max opcodes or jobs in a submit job and submit many jobs.
 110 maxOpCodes :: Int
 111 maxOpCodes = 16
 112
 113 -- * Helper functions
 114
 115 -- | Checks for equality with proper annotation. The first argument is
 116 -- the computed value, the second one the expected value.
 117 (==?) :: (Show a, Eq a) => a -> a -> Property
 118 (==?) x y = printTestCase
 119             ("Expected equality, but got mismatch\nexpected: " ++
 120              show y ++ "\n but got: " ++ show x) (x == y)
 121 infix 3 ==?
 122
 123 -- | Checks for inequality with proper annotation. The first argument
 124 -- is the computed value, the second one the expected (not equal)
 125 -- value.
 126 (/=?) :: (Show a, Eq a) => a -> a -> Property
 127 (/=?) x y = printTestCase
 128             ("Expected inequality, but got equality: '" ++
 129              show x ++ "'.") (x /= y)
 130 infix 3 /=?
 131
 132 -- | Show a message and fail the test.
 133 failTest :: String -> Property
 134 failTest msg = printTestCase msg False
 135
 136 -- | A 'True' property.
 137 passTest :: Property
 138 passTest = property True
 139
 140 -- | Return the python binary to use. If the PYTHON environment
 141 -- variable is defined, use its value, otherwise use just \"python\".
 142 pythonCmd :: IO String
 143 pythonCmd = catchJust (guard . isDoesNotExistError)
 144             (getEnv "PYTHON") (const (return "python"))
 145
 146 -- | Run Python with an expression, returning the exit code, standard
 147 -- output and error.
 148 runPython :: String -> String -> IO (ExitCode, String, String)
 149 runPython expr stdin = do
 150   py_binary <- pythonCmd
 151   readProcessWithExitCode py_binary ["-c", expr] stdin
 152
 153 -- | Check python exit code, and fail via HUnit assertions if
 154 -- non-zero. Otherwise, return the standard output.
 155 checkPythonResult :: (ExitCode, String, String) -> IO String
 156 checkPythonResult (py_code, py_stdout, py_stderr) = do
 157   HUnit.assertEqual ("python exited with error: " ++ py_stderr)
 158        ExitSuccess py_code
 159   return py_stdout
 160
 161 -- * Arbitrary instances
 162
 163 -- | Defines a DNS name.
 164 newtype DNSChar = DNSChar { dnsGetChar::Char }
 165
 166 instance Arbitrary DNSChar where
 167   arbitrary = liftM DNSChar $ elements (['a'..'z'] ++ ['0'..'9'] ++ "_-")
 168
 169 instance Show DNSChar where
 170   show = show . dnsGetChar
 171
 172 -- | Generates a single name component.
 173 genName :: Gen String
 174 genName = do
 175   n <- choose (1, 16)
 176   dn <- vector n
 177   return (map dnsGetChar dn)
 178
 179 -- | Generates an entire FQDN.
 180 genFQDN :: Gen String
 181 genFQDN = do
 182   ncomps <- choose (1, 4)
 183   names <- vectorOf ncomps genName
 184   return $ intercalate "." names
 185
 186 -- | Combinator that generates a 'Maybe' using a sub-combinator.
 187 genMaybe :: Gen a -> Gen (Maybe a)
 188 genMaybe subgen = frequency [ (1, pure Nothing), (3, Just <$> subgen) ]
 189
 190 -- | Defines a tag type.
 191 newtype TagChar = TagChar { tagGetChar :: Char }
 192
 193 -- | All valid tag chars. This doesn't need to match _exactly_
 194 -- Ganeti's own tag regex, just enough for it to be close.
 195 tagChar :: String
 196 tagChar = ['a'..'z'] ++ ['A'..'Z'] ++ ['0'..'9'] ++ ".+*/:@-"
 197
 198 instance Arbitrary TagChar where
 199   arbitrary = liftM TagChar $ elements tagChar
 200
 201 -- | Generates a tag
 202 genTag :: Gen [TagChar]
 203 genTag = do
 204   -- the correct value would be C.maxTagLen, but that's way too
 205   -- verbose in unittests, and at the moment I don't see any possible
 206   -- bugs with longer tags and the way we use tags in htools
 207   n <- choose (1, 10)
 208   vector n
 209
 210 -- | Generates a list of tags (correctly upper bounded).
 211 genTags :: Gen [String]
 212 genTags = do
 213   -- the correct value would be C.maxTagsPerObj, but per the comment
 214   -- in genTag, we don't use tags enough in htools to warrant testing
 215   -- such big values
 216   n <- choose (0, 10::Int)
 217   tags <- mapM (const genTag) [1..n]
 218   return $ map (map tagGetChar) tags
 219
 220 -- | Generates a fields list. This uses the same character set as a
 221 -- DNS name (just for simplicity).
 222 genFields :: Gen [String]
 223 genFields = do
 224   n <- choose (1, 32)
 225   vectorOf n genName
 226
 227 -- | Generates a list of a given size with non-duplicate elements.
 228 genUniquesList :: (Eq a, Arbitrary a, Ord a) => Int -> Gen a -> Gen [a]
 229 genUniquesList cnt generator = do
 230   set <- foldM (\set _ -> do
 231                   newelem <- generator `suchThat` (`Set.notMember` set)
 232                   return (Set.insert newelem set)) Set.empty [1..cnt]
 233   return $ Set.toList set
 234
 235 newtype SmallRatio = SmallRatio Double deriving Show
 236 instance Arbitrary SmallRatio where
 237   arbitrary = liftM SmallRatio $ choose (0, 1)
 238
 239 -- | Helper for 'genSet', declared separately due to type constraints.
 240 genSetHelper :: (Ord a) => [a] -> Maybe Int -> Gen (Set.Set a)
 241 genSetHelper candidates size = do
 242   size' <- case size of
 243              Nothing -> choose (0, length candidates)
 244              Just s | s > length candidates ->
 245                         error $ "Invalid size " ++ show s ++ ", maximum is " ++
 246                                 show (length candidates)
 247                     | otherwise -> return s
 248   foldM (\set _ -> do
 249            newelem <- elements candidates `suchThat` (`Set.notMember` set)
 250            return (Set.insert newelem set)) Set.empty [1..size']
 251
 252 -- | Generates a set of arbitrary elements.
 253 genSet :: (Ord a, Bounded a, Enum a) => Maybe Int -> Gen (Set.Set a)
 254 genSet = genSetHelper [minBound..maxBound]
 255
 256 -- | Generate an arbitrary IPv4 address in textual form (non empty).
 257 genIp4Addr :: Gen NonEmptyString
 258 genIp4Addr = genIp4AddrStr >>= mkNonEmpty
 259
 260 -- | Generate an arbitrary IPv4 address in textual form.
 261 genIp4AddrStr :: Gen String
 262 genIp4AddrStr = do
 263   a <- choose (1::Int, 255)
 264   b <- choose (0::Int, 255)
 265   c <- choose (0::Int, 255)
 266   d <- choose (0::Int, 255)
 267   return $ intercalate "." (map show [a, b, c, d])
 268
 269 -- | Generates an arbitrary IPv4 address with a given netmask in textual form.
 270 genIp4NetWithNetmask :: Int -> Gen NonEmptyString
 271 genIp4NetWithNetmask netmask = do
 272   ip <- genIp4AddrStr
 273   mkNonEmpty $ ip ++ "/" ++ show netmask
 274
 275 -- | Generate an arbitrary IPv4 network in textual form.
 276 genIp4Net :: Gen NonEmptyString
 277 genIp4Net = do
 278   netmask <- choose (8::Int, 30)
 279   genIp4NetWithNetmask netmask
 280
 281 -- | Helper function to compute the number of hosts in a network
 282 -- given the netmask. (For IPv4 only.)
 283 netmask2NumHosts :: Int -> Int
 284 netmask2NumHosts n = 2^(32-n)
 285
 286 -- | Generates an arbitrary IPv6 network address in textual form.
 287 -- The generated address is not simpflified, e. g. an address like
 288 -- "2607:f0d0:1002:0051:0000:0000:0000:0004" does not become
 289 -- "2607:f0d0:1002:51::4"
 290 genIp6Addr :: Gen String
 291 genIp6Addr = do
 292   rawIp <- vectorOf 8 $ choose (0::Integer, 65535)
 293   return $ intercalate ":" (map (`showHex` "") rawIp)
 294
 295 -- | Generates an arbitrary IPv6 network in textual form.
 296 genIp6Net :: Gen String
 297 genIp6Net = do
 298   netmask <- choose (8::Int, 126)
 299   ip <- genIp6Addr
 300   return $ ip ++ "/" ++ show netmask
 301
 302 -- * Helper functions
 303
 304 -- | Checks for serialisation idempotence.
 305 testSerialisation :: (Eq a, Show a, J.JSON a) => a -> Property
 306 testSerialisation a =
 307   case J.readJSON (J.showJSON a) of
 308     J.Error msg -> failTest $ "Failed to deserialise: " ++ msg
 309     J.Ok a' -> a ==? a'
 310
 311 -- | Result to PropertyM IO.
 312 resultProp :: (Show a) => BasicTypes.GenericResult a b -> PropertyM IO b
 313 resultProp (BasicTypes.Bad err) = stop . failTest $ show err
 314 resultProp (BasicTypes.Ok  val) = return val
 315
 316 -- | Return the source directory of Ganeti.
 317 getSourceDir :: IO FilePath
 318 getSourceDir = catchJust (guard . isDoesNotExistError)
 319             (getEnv "TOP_SRCDIR")
 320             (const (return "."))
 321
 322 -- | Returns the path of a file in the test data directory, given its name.
 323 testDataFilename :: String -> String -> IO FilePath
 324 testDataFilename datadir name = do
 325         src <- getSourceDir
 326         return $ src ++ datadir ++ name
 327
 328 -- | Returns the content of the specified haskell test data file.
 329 readTestData :: String -> IO String
 330 readTestData filename = do
 331     name <- testDataFilename "/test/data/" filename
 332     readFile name
 333
 334 -- | Generate arbitrary values in the IO monad. This is a simple
 335 -- wrapper over 'sample''.
 336 genSample :: Gen a -> IO a
 337 genSample gen = do
 338   values <- sample' gen
 339   case values of
 340     [] -> error "sample' returned an empty list of values??"
 341     x:_ -> return x