code.grnet.gr Git - ganeti-local/blob - htest/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 Test.HUnit as HUnit
  33 import Test.QuickCheck
  34 import Test.QuickCheck.Monadic
  35 import qualified Text.JSON as J
  36 import System.Environment (getEnv)
  37 import System.Exit (ExitCode(..))
  38 import System.IO.Error (isDoesNotExistError)
  39 import System.Process (readProcessWithExitCode)
  40
  41 import qualified Ganeti.BasicTypes as BasicTypes
  42
  43 -- * Constants
  44
  45 -- | Maximum memory (1TiB, somewhat random value).
  46 maxMem :: Int
  47 maxMem = 1024 * 1024
  48
  49 -- | Maximum disk (8TiB, somewhat random value).
  50 maxDsk :: Int
  51 maxDsk = 1024 * 1024 * 8
  52
  53 -- | Max CPUs (1024, somewhat random value).
  54 maxCpu :: Int
  55 maxCpu = 1024
  56
  57 -- | Max vcpu ratio (random value).
  58 maxVcpuRatio :: Double
  59 maxVcpuRatio = 1024.0
  60
  61 -- | Max spindle ratio (random value).
  62 maxSpindleRatio :: Double
  63 maxSpindleRatio = 1024.0
  64
  65 -- | Max nodes, used just to limit arbitrary instances for smaller
  66 -- opcode definitions (e.g. list of nodes in OpTestDelay).
  67 maxNodes :: Int
  68 maxNodes = 32
  69
  70 -- | Max opcodes or jobs in a submit job and submit many jobs.
  71 maxOpCodes :: Int
  72 maxOpCodes = 16
  73
  74 -- * Helper functions
  75
  76 -- | Checks for equality with proper annotation.
  77 (==?) :: (Show a, Eq a) => a -> a -> Property
  78 (==?) x y = printTestCase
  79             ("Expected equality, but '" ++
  80              show x ++ "' /= '" ++ show y ++ "'") (x == y)
  81 infix 3 ==?
  82
  83 -- | Show a message and fail the test.
  84 failTest :: String -> Property
  85 failTest msg = printTestCase msg False
  86
  87 -- | A 'True' property.
  88 passTest :: Property
  89 passTest = property True
  90
  91 -- | Return the python binary to use. If the PYTHON environment
  92 -- variable is defined, use its value, otherwise use just \"python\".
  93 pythonCmd :: IO String
  94 pythonCmd = catchJust (guard . isDoesNotExistError)
  95             (getEnv "PYTHON") (const (return "python"))
  96
  97 -- | Run Python with an expression, returning the exit code, standard
  98 -- output and error.
  99 runPython :: String -> String -> IO (ExitCode, String, String)
 100 runPython expr stdin = do
 101   py_binary <- pythonCmd
 102   readProcessWithExitCode py_binary ["-c", expr] stdin
 103
 104 -- | Check python exit code, and fail via HUnit assertions if
 105 -- non-zero. Otherwise, return the standard output.
 106 checkPythonResult :: (ExitCode, String, String) -> IO String
 107 checkPythonResult (py_code, py_stdout, py_stderr) = do
 108   HUnit.assertEqual ("python exited with error: " ++ py_stderr)
 109        ExitSuccess py_code
 110   return py_stdout
 111
 112 -- * Arbitrary instances
 113
 114 -- | Defines a DNS name.
 115 newtype DNSChar = DNSChar { dnsGetChar::Char }
 116
 117 instance Arbitrary DNSChar where
 118   arbitrary = do
 119     x <- elements (['a'..'z'] ++ ['0'..'9'] ++ "_-")
 120     return (DNSChar x)
 121
 122 instance Show DNSChar where
 123   show = show . dnsGetChar
 124
 125 -- | Generates a single name component.
 126 getName :: Gen String
 127 getName = do
 128   n <- choose (1, 64)
 129   dn <- vector n
 130   return (map dnsGetChar dn)
 131
 132 -- | Generates an entire FQDN.
 133 getFQDN :: Gen String
 134 getFQDN = do
 135   ncomps <- choose (1, 4)
 136   names <- vectorOf ncomps getName
 137   return $ intercalate "." names
 138
 139 -- | Combinator that generates a 'Maybe' using a sub-combinator.
 140 getMaybe :: Gen a -> Gen (Maybe a)
 141 getMaybe subgen = do
 142   bool <- arbitrary
 143   if bool
 144     then Just <$> subgen
 145     else return Nothing
 146
 147 -- | Defines a tag type.
 148 newtype TagChar = TagChar { tagGetChar :: Char }
 149
 150 -- | All valid tag chars. This doesn't need to match _exactly_
 151 -- Ganeti's own tag regex, just enough for it to be close.
 152 tagChar :: String
 153 tagChar = ['a'..'z'] ++ ['A'..'Z'] ++ ['0'..'9'] ++ ".+*/:@-"
 154
 155 instance Arbitrary TagChar where
 156   arbitrary = do
 157     c <- elements tagChar
 158     return (TagChar c)
 159
 160 -- | Generates a tag
 161 genTag :: Gen [TagChar]
 162 genTag = do
 163   -- the correct value would be C.maxTagLen, but that's way too
 164   -- verbose in unittests, and at the moment I don't see any possible
 165   -- bugs with longer tags and the way we use tags in htools
 166   n <- choose (1, 10)
 167   vector n
 168
 169 -- | Generates a list of tags (correctly upper bounded).
 170 genTags :: Gen [String]
 171 genTags = do
 172   -- the correct value would be C.maxTagsPerObj, but per the comment
 173   -- in genTag, we don't use tags enough in htools to warrant testing
 174   -- such big values
 175   n <- choose (0, 10::Int)
 176   tags <- mapM (const genTag) [1..n]
 177   return $ map (map tagGetChar) tags
 178
 179 -- | Generates a fields list. This uses the same character set as a
 180 -- DNS name (just for simplicity).
 181 getFields :: Gen [String]
 182 getFields = do
 183   n <- choose (1, 32)
 184   vectorOf n getName
 185
 186 -- | Generates a list of a given size with non-duplicate elements.
 187 genUniquesList :: (Eq a, Arbitrary a) => Int -> Gen [a]
 188 genUniquesList cnt =
 189   foldM (\lst _ -> do
 190            newelem <- arbitrary `suchThat` (`notElem` lst)
 191            return (newelem:lst)) [] [1..cnt]
 192
 193 newtype SmallRatio = SmallRatio Double deriving Show
 194 instance Arbitrary SmallRatio where
 195   arbitrary = do
 196     v <- choose (0, 1)
 197     return $ SmallRatio v
 198
 199 -- | Checks for serialisation idempotence.
 200 testSerialisation :: (Eq a, Show a, J.JSON a) => a -> Property
 201 testSerialisation a =
 202   case J.readJSON (J.showJSON a) of
 203     J.Error msg -> failTest $ "Failed to deserialise: " ++ msg
 204     J.Ok a' -> a ==? a'
 205
 206 -- | Result to PropertyM IO.
 207 resultProp :: BasicTypes.Result a -> PropertyM IO a
 208 resultProp (BasicTypes.Bad msg) = stop $ failTest msg
 209 resultProp (BasicTypes.Ok  val) = return val