code.grnet.gr Git - ganeti-local/blob - Ganeti/HTools/QC.hs

   1 {-| Unittests for ganeti-htools
   2
   3 -}
   4
   5 {-
   6
   7 Copyright (C) 2009 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 Ganeti.HTools.QC
  27     ( test_PeerMap
  28     , test_Container
  29     , test_Instance
  30     , test_Node
  31     , test_Text
  32     , test_Cluster
  33     ) where
  34
  35 import Test.QuickCheck
  36 import Test.QuickCheck.Batch
  37 import Data.Maybe
  38 import qualified Ganeti.HTools.CLI as CLI
  39 import qualified Ganeti.HTools.Cluster as Cluster
  40 import qualified Ganeti.HTools.Container as Container
  41 import qualified Ganeti.HTools.IAlloc as IAlloc
  42 import qualified Ganeti.HTools.Instance as Instance
  43 import qualified Ganeti.HTools.Loader as Loader
  44 import qualified Ganeti.HTools.Node as Node
  45 import qualified Ganeti.HTools.PeerMap as PeerMap
  46 import qualified Ganeti.HTools.Text as Text
  47 import qualified Ganeti.HTools.Types as Types
  48 import qualified Ganeti.HTools.Utils as Utils
  49
  50 -- | Simple checker for whether OpResult is fail or pass
  51 isFailure :: Types.OpResult a -> Bool
  52 isFailure (Types.OpFail _) = True
  53 isFailure _ = False
  54
  55 -- copied from the introduction to quickcheck
  56 instance Arbitrary Char where
  57     arbitrary = choose ('\32', '\128')
  58
  59 -- let's generate a random instance
  60 instance Arbitrary Instance.Instance where
  61     arbitrary = do
  62       name <- arbitrary
  63       mem <- choose(0, 100)
  64       dsk <- choose(0, 100)
  65       run_st <- elements ["ERROR_up", "ERROR_down", "ADMIN_down"
  66                          , "ERROR_nodedown", "ERROR_nodeoffline"
  67                          , "running"
  68                          , "no_such_status1", "no_such_status2"]
  69       pn <- arbitrary
  70       sn <- arbitrary
  71       vcpus <- arbitrary
  72       return $ Instance.create name mem dsk vcpus run_st pn sn
  73
  74 -- and a random node
  75 instance Arbitrary Node.Node where
  76     arbitrary = do
  77       name <- arbitrary
  78       mem_t <- arbitrary
  79       mem_f <- choose (0, mem_t)
  80       mem_n <- choose (0, mem_t - mem_f)
  81       dsk_t <- arbitrary
  82       dsk_f <- choose (0, dsk_t)
  83       cpu_t <- arbitrary
  84       offl <- arbitrary
  85       let n = Node.create name (fromIntegral mem_t) mem_n mem_f
  86               (fromIntegral dsk_t) dsk_f cpu_t offl
  87           n' = Node.buildPeers n Container.empty
  88       return n'
  89
  90 -- | Make sure add is idempotent
  91 prop_PeerMap_addIdempotent pmap key em =
  92     fn puniq == fn (fn puniq)
  93     where _types = (pmap::PeerMap.PeerMap,
  94                     key::PeerMap.Key, em::PeerMap.Elem)
  95           fn = PeerMap.add key em
  96           puniq = PeerMap.accumArray const pmap
  97
  98 -- | Make sure remove is idempotent
  99 prop_PeerMap_removeIdempotent pmap key =
 100     fn puniq == fn (fn puniq)
 101     where _types = (pmap::PeerMap.PeerMap, key::PeerMap.Key)
 102           fn = PeerMap.remove key
 103           puniq = PeerMap.accumArray const pmap
 104
 105 -- | Make sure a missing item returns 0
 106 prop_PeerMap_findMissing pmap key =
 107     PeerMap.find key (PeerMap.remove key puniq) == 0
 108     where _types = (pmap::PeerMap.PeerMap, key::PeerMap.Key)
 109           puniq = PeerMap.accumArray const pmap
 110
 111 -- | Make sure an added item is found
 112 prop_PeerMap_addFind pmap key em =
 113     PeerMap.find key (PeerMap.add key em puniq) == em
 114     where _types = (pmap::PeerMap.PeerMap,
 115                     key::PeerMap.Key, em::PeerMap.Elem)
 116           puniq = PeerMap.accumArray const pmap
 117
 118 -- | Manual check that maxElem returns the maximum indeed, or 0 for null
 119 prop_PeerMap_maxElem pmap =
 120     PeerMap.maxElem puniq == if null puniq then 0
 121                              else (maximum . snd . unzip) puniq
 122     where _types = pmap::PeerMap.PeerMap
 123           puniq = PeerMap.accumArray const pmap
 124
 125 test_PeerMap =
 126     [ run prop_PeerMap_addIdempotent
 127     , run prop_PeerMap_removeIdempotent
 128     , run prop_PeerMap_maxElem
 129     , run prop_PeerMap_addFind
 130     , run prop_PeerMap_findMissing
 131     ]
 132
 133 -- Container tests
 134
 135 prop_Container_addTwo cdata i1 i2 =
 136     fn i1 i2 cont == fn i2 i1 cont &&
 137        fn i1 i2 cont == fn i1 i2 (fn i1 i2 cont)
 138     where _types = (cdata::[Int],
 139                     i1::Int, i2::Int)
 140           cont = foldl (\c x -> Container.add x x c) Container.empty cdata
 141           fn x1 x2 = Container.addTwo x1 x1 x2 x2
 142
 143 test_Container =
 144     [ run prop_Container_addTwo ]
 145
 146 -- Simple instance tests, we only have setter/getters
 147
 148 prop_Instance_setIdx inst idx =
 149     Instance.idx (Instance.setIdx inst idx) == idx
 150     where _types = (inst::Instance.Instance, idx::Types.Idx)
 151
 152 prop_Instance_setName inst name =
 153     Instance.name (Instance.setName inst name) == name
 154     where _types = (inst::Instance.Instance, name::String)
 155
 156 prop_Instance_setPri inst pdx =
 157     Instance.pnode (Instance.setPri inst pdx) == pdx
 158     where _types = (inst::Instance.Instance, pdx::Types.Ndx)
 159
 160 prop_Instance_setSec inst sdx =
 161     Instance.snode (Instance.setSec inst sdx) == sdx
 162     where _types = (inst::Instance.Instance, sdx::Types.Ndx)
 163
 164 prop_Instance_setBoth inst pdx sdx =
 165     Instance.pnode si == pdx && Instance.snode si == sdx
 166     where _types = (inst::Instance.Instance, pdx::Types.Ndx, sdx::Types.Ndx)
 167           si = Instance.setBoth inst pdx sdx
 168
 169 prop_Instance_runStatus_True inst =
 170     let run_st = Instance.running inst
 171         run_tx = Instance.run_st inst
 172     in
 173       run_tx == "running" || run_tx == "ERROR_up" ==> run_st == True
 174
 175 prop_Instance_runStatus_False inst =
 176     let run_st = Instance.running inst
 177         run_tx = Instance.run_st inst
 178     in
 179       run_tx /= "running" && run_tx /= "ERROR_up" ==> run_st == False
 180
 181 test_Instance =
 182     [ run prop_Instance_setIdx
 183     , run prop_Instance_setName
 184     , run prop_Instance_setPri
 185     , run prop_Instance_setSec
 186     , run prop_Instance_setBoth
 187     , run prop_Instance_runStatus_True
 188     , run prop_Instance_runStatus_False
 189     ]
 190
 191 -- Instance text loader tests
 192
 193 prop_Text_Load_Instance name mem dsk vcpus status pnode snode pdx sdx =
 194     let vcpus_s = show vcpus
 195         dsk_s = show dsk
 196         mem_s = show mem
 197         rsnode = snode ++ "a" -- non-empty secondary node
 198         rsdx = if pdx == sdx
 199                then sdx + 1
 200                else sdx
 201         ndx = [(pnode, pdx), (rsnode, rsdx)]
 202         inst = Text.loadInst ndx
 203                (name:mem_s:dsk_s:vcpus_s:status:pnode:rsnode:[])::
 204                Maybe (String, Instance.Instance)
 205         _types = ( name::String, mem::Int, dsk::Int
 206                  , vcpus::Int, status::String
 207                  , pnode::String, snode::String
 208                  , pdx::Types.Ndx, sdx::Types.Ndx)
 209     in
 210       case inst of
 211         Nothing -> False
 212         Just (_, i) ->
 213             (Instance.name i == name &&
 214              Instance.vcpus i == vcpus &&
 215              Instance.mem i == mem &&
 216              Instance.pnode i == pdx &&
 217              Instance.snode i == rsdx)
 218
 219 test_Text =
 220     [ run prop_Text_Load_Instance
 221     ]
 222
 223 -- Node tests
 224
 225 -- | Check that an instance add with too high memory or disk will be rejected
 226 prop_Node_addPri node inst = (Instance.mem inst >= Node.f_mem node ||
 227                               Instance.dsk inst >= Node.f_dsk node) &&
 228                              not (Node.failN1 node)
 229                              ==>
 230                              isFailure (Node.addPri node inst)
 231     where _types = (node::Node.Node, inst::Instance.Instance)
 232
 233
 234 -- | Check that an instance add with too high memory or disk will be rejected
 235 prop_Node_addSec node inst pdx =
 236     (Instance.mem inst >= (Node.f_mem node - Node.r_mem node) ||
 237      Instance.dsk inst >= Node.f_dsk node) &&
 238     not (Node.failN1 node)
 239     ==> isFailure (Node.addSec node inst pdx)
 240         where _types = (node::Node.Node, inst::Instance.Instance, pdx::Int)
 241
 242 test_Node =
 243     [ run prop_Node_addPri
 244     , run prop_Node_addSec
 245     ]
 246
 247
 248 -- Cluster tests
 249
 250 -- | Check that the cluster score is close to zero for a homogeneous cluster
 251 prop_Score_Zero node count =
 252     ((not $ Node.offline node) && (not $ Node.failN1 node) && (count > 0) &&
 253      (Node.t_dsk node > 0) && (Node.t_mem node > 0)) ==>
 254     let fn = Node.buildPeers node Container.empty
 255         nlst = (zip [1..] $ replicate count fn)::[(Types.Ndx, Node.Node)]
 256         nl = Container.fromAssocList nlst
 257         score = Cluster.compCV nl
 258     -- we can't say == 0 here as the floating point errors accumulate;
 259     -- this should be much lower than the default score in CLI.hs
 260     in score <= 1e-15
 261
 262 test_Cluster =
 263     [ run prop_Score_Zero
 264     ]