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