Instance.hs 9 KB
Newer Older
1
2
3
4
5
6
7
8
9
{-# LANGUAGE TemplateHaskell #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}

{-| Unittests for ganeti-htools.

-}

{-

10
Copyright (C) 2009, 2010, 2011, 2012, 2013 Google Inc.
Klaus Aehlig's avatar
Klaus Aehlig committed
11
All rights reserved.
12

Klaus Aehlig's avatar
Klaus Aehlig committed
13
14
15
Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions are
met:
16

Klaus Aehlig's avatar
Klaus Aehlig committed
17
18
1. Redistributions of source code must retain the above copyright notice,
this list of conditions and the following disclaimer.
19

Klaus Aehlig's avatar
Klaus Aehlig committed
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
2. Redistributions in binary form must reproduce the above copyright
notice, this list of conditions and the following disclaimer in the
documentation and/or other materials provided with the distribution.

THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR
CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
35
36
37
38

-}

module Test.Ganeti.HTools.Instance
Iustin Pop's avatar
Iustin Pop committed
39
  ( testHTools_Instance
40
  , genInstanceSmallerThanNode
41
  , genInstanceMaybeBiggerThanNode
42
  , genInstanceOnNodeList
43
  , genInstanceList
44
45
46
  , Instance.Instance(..)
  ) where

Klaus Aehlig's avatar
Klaus Aehlig committed
47
import Control.Applicative ((<$>))
48
import Control.Monad (liftM)
49
import Test.QuickCheck hiding (Result)
50

51
import Test.Ganeti.TestHTools (nullISpec)
52
53
54
55
import Test.Ganeti.TestHelper
import Test.Ganeti.TestCommon
import Test.Ganeti.HTools.Types ()

56
import Ganeti.BasicTypes
57
58
import qualified Ganeti.HTools.Instance as Instance
import qualified Ganeti.HTools.Node as Node
59
import qualified Ganeti.HTools.Container as Container
60
import qualified Ganeti.HTools.Loader as Loader
61
62
63
64
import qualified Ganeti.HTools.Types as Types

-- * Arbitrary instances

65
66
67
68
69
70
-- | Generates a random instance with maximum and minimum disk/mem/cpu values.
genInstanceWithin :: Int -> Int -> Int -> Int
                  -> Int -> Int -> Int -> Maybe Int
                  -> Gen Instance.Instance
genInstanceWithin min_mem min_dsk min_cpu min_spin
                  max_mem max_dsk max_cpu max_spin = do
71
  name <- genFQDN
72
73
  mem <- choose (min_mem, max_mem)
  dsk <- choose (min_dsk, max_dsk)
74
75
76
  run_st <- arbitrary
  pn <- arbitrary
  sn <- arbitrary
77
  vcpus <- choose (min_cpu, max_cpu)
78
  dt <- arbitrary
79
80
81
  spindles <- case max_spin of
    Nothing -> genMaybe $ choose (min_spin, maxSpindles)
    Just ls -> liftM Just $ choose (min_spin, ls)
82
83
84
  let disk = Instance.Disk dsk spindles
  return $ Instance.create
    name mem dsk [disk] vcpus run_st [] True pn sn dt 1 []
85

86
87
88
89
90
-- | Generate an instance with maximum disk/mem/cpu values.
genInstanceSmallerThan :: Int -> Int -> Int -> Maybe Int
                       -> Gen Instance.Instance
genInstanceSmallerThan = genInstanceWithin 0 0 0 0

91
92
93
94
95
96
-- | Generates an instance smaller than a node.
genInstanceSmallerThanNode :: Node.Node -> Gen Instance.Instance
genInstanceSmallerThanNode node =
  genInstanceSmallerThan (Node.availMem node `div` 2)
                         (Node.availDisk node `div` 2)
                         (Node.availCpu node `div` 2)
97
98
99
                         (if Node.exclStorage node
                          then Just $ Node.fSpindles node `div` 2
                          else Nothing)
100

101
-- | Generates an instance possibly bigger than a node.
102
103
-- In any case, that instance will be bigger than the node's ipolicy's lower
-- bound.
104
105
genInstanceMaybeBiggerThanNode :: Node.Node -> Gen Instance.Instance
genInstanceMaybeBiggerThanNode node =
106
107
108
109
110
111
112
113
114
115
  let minISpec = runListHead nullISpec Types.minMaxISpecsMinSpec
                 . Types.iPolicyMinMaxISpecs $ Node.iPolicy node
  in genInstanceWithin (Types.iSpecMemorySize minISpec)
                       (Types.iSpecDiskSize minISpec)
                       (Types.iSpecCpuCount minISpec)
                       (Types.iSpecSpindleUse minISpec)
                       (Node.availMem  node + Types.unitMem * 2)
                       (Node.availDisk node + Types.unitDsk * 3)
                       (Node.availCpu  node + Types.unitCpu * 4)
                       (if Node.exclStorage node
116
117
118
                          then Just $ Node.fSpindles node +
                               Types.unitSpindle * 5
                          else Nothing)
119

120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
-- | Generates an instance with nodes on a node list.
-- The following rules are respected:
-- 1. The instance is never bigger than its primary node
-- 2. If possible the instance has different pnode and snode
-- 3. Else disk templates which require secondary nodes are disabled
genInstanceOnNodeList :: Node.List -> Gen Instance.Instance
genInstanceOnNodeList nl = do
  let nsize = Container.size nl
  pnode <- choose (0, nsize-1)
  let (snodefilter, dtfilter) =
        if nsize >= 2
          then ((/= pnode), const True)
          else (const True, not . Instance.hasSecondary)
  snode <- choose (0, nsize-1) `suchThat` snodefilter
  i <- genInstanceSmallerThanNode (Container.find pnode nl) `suchThat` dtfilter
  return $ i { Instance.pNode = pnode, Instance.sNode = snode }

137
138
139
140
-- | Generates an instance list given an instance generator.
genInstanceList :: Gen Instance.Instance -> Gen Instance.List
genInstanceList igen = fmap (snd . Loader.assignIndices) names_instances
    where names_instances =
Klaus Aehlig's avatar
Klaus Aehlig committed
141
            map (\n -> (Instance.name n, n)) <$> listOf igen
142

143
144
-- let's generate a random instance
instance Arbitrary Instance.Instance where
145
  arbitrary = genInstanceSmallerThan maxMem maxDsk maxCpu Nothing
146
147
148
149
150

-- * Test cases

-- Simple instance tests, we only have setter/getters

151
152
prop_creat :: Instance.Instance -> Property
prop_creat inst =
153
154
  Instance.name inst ==? Instance.alias inst

155
156
prop_setIdx :: Instance.Instance -> Types.Idx -> Property
prop_setIdx inst idx =
157
158
  Instance.idx (Instance.setIdx inst idx) ==? idx

159
160
prop_setName :: Instance.Instance -> String -> Bool
prop_setName inst name =
161
162
163
164
  Instance.name newinst == name &&
  Instance.alias newinst == name
    where newinst = Instance.setName inst name

165
166
prop_setAlias :: Instance.Instance -> String -> Bool
prop_setAlias inst name =
167
168
169
170
  Instance.name newinst == Instance.name inst &&
  Instance.alias newinst == name
    where newinst = Instance.setAlias inst name

171
172
prop_setPri :: Instance.Instance -> Types.Ndx -> Property
prop_setPri inst pdx =
173
174
  Instance.pNode (Instance.setPri inst pdx) ==? pdx

175
176
prop_setSec :: Instance.Instance -> Types.Ndx -> Property
prop_setSec inst sdx =
177
178
  Instance.sNode (Instance.setSec inst sdx) ==? sdx

179
180
prop_setBoth :: Instance.Instance -> Types.Ndx -> Types.Ndx -> Bool
prop_setBoth inst pdx sdx =
181
182
183
  Instance.pNode si == pdx && Instance.sNode si == sdx
    where si = Instance.setBoth inst pdx sdx

184
185
prop_shrinkMG :: Instance.Instance -> Property
prop_shrinkMG inst =
186
187
  Instance.mem inst >= 2 * Types.unitMem ==>
    case Instance.shrinkByType inst Types.FailMem of
188
189
      Ok inst' -> Instance.mem inst' ==? Instance.mem inst - Types.unitMem
      Bad msg -> failTest msg
190

191
192
prop_shrinkMF :: Instance.Instance -> Property
prop_shrinkMF inst =
193
194
  forAll (choose (0, 2 * Types.unitMem - 1)) $ \mem ->
    let inst' = inst { Instance.mem = mem}
195
    in isBad $ Instance.shrinkByType inst' Types.FailMem
196

197
198
prop_shrinkCG :: Instance.Instance -> Property
prop_shrinkCG inst =
199
200
  Instance.vcpus inst >= 2 * Types.unitCpu ==>
    case Instance.shrinkByType inst Types.FailCPU of
201
202
      Ok inst' -> Instance.vcpus inst' ==? Instance.vcpus inst - Types.unitCpu
      Bad msg -> failTest msg
203

204
205
prop_shrinkCF :: Instance.Instance -> Property
prop_shrinkCF inst =
206
207
  forAll (choose (0, 2 * Types.unitCpu - 1)) $ \vcpus ->
    let inst' = inst { Instance.vcpus = vcpus }
208
    in isBad $ Instance.shrinkByType inst' Types.FailCPU
209

210
211
prop_shrinkDG :: Instance.Instance -> Property
prop_shrinkDG inst =
212
213
  Instance.dsk inst >= 2 * Types.unitDsk ==>
    case Instance.shrinkByType inst Types.FailDisk of
214
215
      Ok inst' -> Instance.dsk inst' ==? Instance.dsk inst - Types.unitDsk
      Bad msg -> failTest msg
216

217
218
prop_shrinkDF :: Instance.Instance -> Property
prop_shrinkDF inst =
219
  forAll (choose (0, 2 * Types.unitDsk - 1)) $ \dsk ->
220
221
    let inst' = inst { Instance.dsk = dsk
                     , Instance.disks = [Instance.Disk dsk Nothing] }
222
    in isBad $ Instance.shrinkByType inst' Types.FailDisk
223

224
225
prop_setMovable :: Instance.Instance -> Bool -> Property
prop_setMovable inst m =
226
227
228
  Instance.movable inst' ==? m
    where inst' = Instance.setMovable inst m

Iustin Pop's avatar
Iustin Pop committed
229
testSuite "HTools/Instance"
230
231
232
233
234
235
236
237
238
239
240
241
242
243
            [ 'prop_creat
            , 'prop_setIdx
            , 'prop_setName
            , 'prop_setAlias
            , 'prop_setPri
            , 'prop_setSec
            , 'prop_setBoth
            , 'prop_shrinkMG
            , 'prop_shrinkMF
            , 'prop_shrinkCG
            , 'prop_shrinkCF
            , 'prop_shrinkDG
            , 'prop_shrinkDF
            , 'prop_setMovable
244
            ]