Statistics
| Branch: | Tag: | Revision:

root / test / hs / Test / Ganeti / HTools / Types.hs @ 09d8b0fc

History | View | Annotate | Download (7.1 kB)

1
{-# LANGUAGE TemplateHaskell, FlexibleInstances, TypeSynonymInstances #-}
2
{-# OPTIONS_GHC -fno-warn-orphans #-}
3

    
4
{-| Unittests for ganeti-htools.
5

    
6
-}
7

    
8
{-
9

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

    
12
This program is free software; you can redistribute it and/or modify
13
it under the terms of the GNU General Public License as published by
14
the Free Software Foundation; either version 2 of the License, or
15
(at your option) any later version.
16

    
17
This program is distributed in the hope that it will be useful, but
18
WITHOUT ANY WARRANTY; without even the implied warranty of
19
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
20
General Public License for more details.
21

    
22
You should have received a copy of the GNU General Public License
23
along with this program; if not, write to the Free Software
24
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
25
02110-1301, USA.
26

    
27
-}
28

    
29
module Test.Ganeti.HTools.Types
30
  ( testHTools_Types
31
  , Types.AllocPolicy(..)
32
  , Types.DiskTemplate(..)
33
  , Types.FailMode(..)
34
  , Types.EvacMode(..)
35
  , Types.ISpec(..)
36
  , Types.IPolicy(..)
37
  , nullIPolicy
38
  ) where
39

    
40
import Test.QuickCheck hiding (Result)
41
import Test.HUnit
42

    
43
import Control.Applicative
44
import Data.List (sort)
45
import Control.Monad (replicateM)
46

    
47
import Test.Ganeti.TestHelper
48
import Test.Ganeti.TestCommon
49
import Test.Ganeti.TestHTools
50
import Test.Ganeti.Types (allDiskTemplates)
51

    
52
import Ganeti.BasicTypes
53
import qualified Ganeti.Constants as C
54
import qualified Ganeti.HTools.Types as Types
55

    
56
{-# ANN module "HLint: ignore Use camelCase" #-}
57

    
58
-- * Helpers
59

    
60
-- * Arbitrary instance
61

    
62
$(genArbitrary ''Types.FailMode)
63

    
64
$(genArbitrary ''Types.EvacMode)
65

    
66
instance Arbitrary a => Arbitrary (Types.OpResult a) where
67
  arbitrary = arbitrary >>= \c ->
68
              if c
69
                then Ok  <$> arbitrary
70
                else Bad <$> arbitrary
71

    
72
instance Arbitrary Types.ISpec where
73
  arbitrary = do
74
    mem_s <- arbitrary::Gen (NonNegative Int)
75
    dsk_c <- arbitrary::Gen (NonNegative Int)
76
    dsk_s <- arbitrary::Gen (NonNegative Int)
77
    cpu_c <- arbitrary::Gen (NonNegative Int)
78
    nic_c <- arbitrary::Gen (NonNegative Int)
79
    su    <- arbitrary::Gen (NonNegative Int)
80
    return Types.ISpec { Types.iSpecMemorySize = fromIntegral mem_s
81
                       , Types.iSpecCpuCount   = fromIntegral cpu_c
82
                       , Types.iSpecDiskSize   = fromIntegral dsk_s
83
                       , Types.iSpecDiskCount  = fromIntegral dsk_c
84
                       , Types.iSpecNicCount   = fromIntegral nic_c
85
                       , Types.iSpecSpindleUse = fromIntegral su
86
                       }
87

    
88
-- | Generates an ispec bigger than the given one.
89
genBiggerISpec :: Types.ISpec -> Gen Types.ISpec
90
genBiggerISpec imin = do
91
  mem_s <- choose (Types.iSpecMemorySize imin, maxBound)
92
  dsk_c <- choose (Types.iSpecDiskCount imin, maxBound)
93
  dsk_s <- choose (Types.iSpecDiskSize imin, maxBound)
94
  cpu_c <- choose (Types.iSpecCpuCount imin, maxBound)
95
  nic_c <- choose (Types.iSpecNicCount imin, maxBound)
96
  su    <- choose (Types.iSpecSpindleUse imin, maxBound)
97
  return Types.ISpec { Types.iSpecMemorySize = fromIntegral mem_s
98
                     , Types.iSpecCpuCount   = fromIntegral cpu_c
99
                     , Types.iSpecDiskSize   = fromIntegral dsk_s
100
                     , Types.iSpecDiskCount  = fromIntegral dsk_c
101
                     , Types.iSpecNicCount   = fromIntegral nic_c
102
                     , Types.iSpecSpindleUse = fromIntegral su
103
                     }
104

    
105
genMinMaxISpecs :: Gen Types.MinMaxISpecs
106
genMinMaxISpecs = do
107
  imin <- arbitrary
108
  imax <- genBiggerISpec imin
109
  return Types.MinMaxISpecs { Types.minMaxISpecsMinSpec = imin
110
                             , Types.minMaxISpecsMaxSpec = imax
111
                             }
112

    
113
instance Arbitrary Types.MinMaxISpecs where
114
  arbitrary = genMinMaxISpecs
115

    
116
genMinMaxStdISpecs :: Gen (Types.MinMaxISpecs, Types.ISpec)
117
genMinMaxStdISpecs = do
118
  imin <- arbitrary
119
  istd <- genBiggerISpec imin
120
  imax <- genBiggerISpec istd
121
  return (Types.MinMaxISpecs { Types.minMaxISpecsMinSpec = imin
122
                             , Types.minMaxISpecsMaxSpec = imax
123
                             },
124
          istd)
125

    
126
genIPolicySpecs :: Gen ([Types.MinMaxISpecs], Types.ISpec)
127
genIPolicySpecs = do
128
  num_mm <- choose (1, 6) -- 6 is just an arbitrary limit
129
  std_compl <- choose (1, num_mm)
130
  mm_head <- replicateM (std_compl - 1) genMinMaxISpecs
131
  (mm_middle, istd) <- genMinMaxStdISpecs
132
  mm_tail <- replicateM (num_mm - std_compl) genMinMaxISpecs
133
  return (mm_head ++ (mm_middle : mm_tail), istd)
134

    
135

    
136
instance Arbitrary Types.IPolicy where
137
  arbitrary = do
138
    (iminmax, istd) <- genIPolicySpecs
139
    num_tmpl <- choose (0, length allDiskTemplates)
140
    dts  <- genUniquesList num_tmpl arbitrary
141
    vcpu_ratio <- choose (1.0, maxVcpuRatio)
142
    spindle_ratio <- choose (1.0, maxSpindleRatio)
143
    return Types.IPolicy { Types.iPolicyMinMaxISpecs = iminmax
144
                         , Types.iPolicyStdSpec = istd
145
                         , Types.iPolicyDiskTemplates = dts
146
                         , Types.iPolicyVcpuRatio = vcpu_ratio
147
                         , Types.iPolicySpindleRatio = spindle_ratio
148
                         }
149

    
150
-- * Test cases
151

    
152
prop_ISpec_serialisation :: Types.ISpec -> Property
153
prop_ISpec_serialisation = testSerialisation
154

    
155
prop_IPolicy_serialisation :: Types.IPolicy -> Property
156
prop_IPolicy_serialisation = testSerialisation
157

    
158
prop_EvacMode_serialisation :: Types.EvacMode -> Property
159
prop_EvacMode_serialisation = testSerialisation
160

    
161
prop_opToResult :: Types.OpResult Int -> Property
162
prop_opToResult op =
163
  case op of
164
    Bad _ -> printTestCase ("expected bad but got " ++ show r) $ isBad r
165
    Ok v  -> case r of
166
               Bad msg -> failTest ("expected Ok but got Bad " ++ msg)
167
               Ok v' -> v ==? v'
168
  where r = Types.opToResult op
169

    
170
prop_eitherToResult :: Either String Int -> Bool
171
prop_eitherToResult ei =
172
  case ei of
173
    Left _ -> isBad r
174
    Right v -> case r of
175
                 Bad _ -> False
176
                 Ok v' -> v == v'
177
    where r = eitherToResult ei
178

    
179
-- | Test 'AutoRepairType' ordering is as expected and consistent with Python
180
-- codebase.
181
case_AutoRepairType_sort :: Assertion
182
case_AutoRepairType_sort = do
183
  let expected = [ Types.ArFixStorage
184
                 , Types.ArMigrate
185
                 , Types.ArFailover
186
                 , Types.ArReinstall
187
                 ]
188
      all_hs_raw = map Types.autoRepairTypeToRaw [minBound..maxBound]
189
  assertEqual "Haskell order" expected [minBound..maxBound]
190
  assertEqual "consistent with Python" C.autoRepairAllTypes all_hs_raw
191

    
192
-- | Test 'AutoRepairResult' type is equivalent with Python codebase.
193
case_AutoRepairResult_pyequiv :: Assertion
194
case_AutoRepairResult_pyequiv = do
195
  let all_py_results = sort C.autoRepairAllResults
196
      all_hs_results = sort $
197
                       map Types.autoRepairResultToRaw [minBound..maxBound]
198
  assertEqual "for AutoRepairResult equivalence" all_py_results all_hs_results
199

    
200
testSuite "HTools/Types"
201
            [ 'prop_ISpec_serialisation
202
            , 'prop_IPolicy_serialisation
203
            , 'prop_EvacMode_serialisation
204
            , 'prop_opToResult
205
            , 'prop_eitherToResult
206
            , 'case_AutoRepairType_sort
207
            , 'case_AutoRepairResult_pyequiv
208
            ]