code.grnet.gr Git - ganeti-local/blob - htest/Test/Ganeti/HTools/Text.hs

   1 {-# LANGUAGE TemplateHaskell #-}
   2 {-# OPTIONS_GHC -fno-warn-orphans #-}
   3
   4 {-| Unittests for ganeti-htools.
   5
   6 -}
   7
   8 {-
   9
  10 Copyright (C) 2009, 2010, 2011, 2012 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.Text (testHTools_Text) where
  30
  31 import Test.QuickCheck
  32
  33 import qualified Data.Map as Map
  34 import Data.List
  35 import Data.Maybe
  36
  37 import Test.Ganeti.TestHelper
  38 import Test.Ganeti.TestCommon
  39 import Test.Ganeti.TestHTools
  40 import Test.Ganeti.HTools.Instance (genInstanceSmallerThanNode)
  41 import Test.Ganeti.HTools.Node (genNode, genOnlineNode)
  42
  43 import Ganeti.BasicTypes
  44 import qualified Ganeti.HTools.Cluster as Cluster
  45 import qualified Ganeti.HTools.Container as Container
  46 import qualified Ganeti.HTools.Group as Group
  47 import qualified Ganeti.HTools.Instance as Instance
  48 import qualified Ganeti.HTools.Loader as Loader
  49 import qualified Ganeti.HTools.Node as Node
  50 import qualified Ganeti.HTools.Text as Text
  51 import qualified Ganeti.HTools.Types as Types
  52 import qualified Ganeti.Utils as Utils
  53
  54 -- * Instance text loader tests
  55
  56 prop_Load_Instance :: String -> Int -> Int -> Int -> Types.InstanceStatus
  57                    -> NonEmptyList Char -> String
  58                    -> NonNegative Int -> NonNegative Int -> Bool
  59                    -> Types.DiskTemplate -> Int -> Property
  60 prop_Load_Instance name mem dsk vcpus status
  61                    (NonEmpty pnode) snode
  62                    (NonNegative pdx) (NonNegative sdx) autobal dt su =
  63   pnode /= snode && pdx /= sdx ==>
  64   let vcpus_s = show vcpus
  65       dsk_s = show dsk
  66       mem_s = show mem
  67       su_s = show su
  68       status_s = Types.instanceStatusToRaw status
  69       ndx = if null snode
  70               then [(pnode, pdx)]
  71               else [(pnode, pdx), (snode, sdx)]
  72       nl = Map.fromList ndx
  73       tags = ""
  74       sbal = if autobal then "Y" else "N"
  75       sdt = Types.diskTemplateToRaw dt
  76       inst = Text.loadInst nl
  77              [name, mem_s, dsk_s, vcpus_s, status_s,
  78               sbal, pnode, snode, sdt, tags, su_s]
  79       fail1 = Text.loadInst nl
  80               [name, mem_s, dsk_s, vcpus_s, status_s,
  81                sbal, pnode, pnode, tags]
  82   in case inst of
  83        Bad msg -> failTest $ "Failed to load instance: " ++ msg
  84        Ok (_, i) -> printTestCase "Mismatch in some field while\
  85                                   \ loading the instance" $
  86                Instance.name i == name &&
  87                Instance.vcpus i == vcpus &&
  88                Instance.mem i == mem &&
  89                Instance.pNode i == pdx &&
  90                Instance.sNode i == (if null snode
  91                                       then Node.noSecondary
  92                                       else sdx) &&
  93                Instance.autoBalance i == autobal &&
  94                Instance.spindleUse i == su &&
  95                isBad fail1
  96
  97 prop_Load_InstanceFail :: [(String, Int)] -> [String] -> Property
  98 prop_Load_InstanceFail ktn fields =
  99   length fields /= 10 && length fields /= 11 ==>
 100     case Text.loadInst nl fields of
 101       Ok _ -> failTest "Managed to load instance from invalid data"
 102       Bad msg -> printTestCase ("Unrecognised error message: " ++ msg) $
 103                  "Invalid/incomplete instance data: '" `isPrefixOf` msg
 104     where nl = Map.fromList ktn
 105
 106 prop_Load_Node :: String -> Int -> Int -> Int -> Int -> Int
 107                -> Int -> Bool -> Bool
 108 prop_Load_Node name tm nm fm td fd tc fo =
 109   let conv v = if v < 0
 110                  then "?"
 111                  else show v
 112       tm_s = conv tm
 113       nm_s = conv nm
 114       fm_s = conv fm
 115       td_s = conv td
 116       fd_s = conv fd
 117       tc_s = conv tc
 118       fo_s = if fo
 119                then "Y"
 120                else "N"
 121       any_broken = any (< 0) [tm, nm, fm, td, fd, tc]
 122       gid = Group.uuid defGroup
 123   in case Text.loadNode defGroupAssoc
 124        [name, tm_s, nm_s, fm_s, td_s, fd_s, tc_s, fo_s, gid] of
 125        Nothing -> False
 126        Just (name', node) ->
 127          if fo || any_broken
 128            then Node.offline node
 129            else Node.name node == name' && name' == name &&
 130                 Node.alias node == name &&
 131                 Node.tMem node == fromIntegral tm &&
 132                 Node.nMem node == nm &&
 133                 Node.fMem node == fm &&
 134                 Node.tDsk node == fromIntegral td &&
 135                 Node.fDsk node == fd &&
 136                 Node.tCpu node == fromIntegral tc
 137
 138 prop_Load_NodeFail :: [String] -> Property
 139 prop_Load_NodeFail fields =
 140   length fields /= 8 ==> isNothing $ Text.loadNode Map.empty fields
 141
 142 prop_NodeLSIdempotent :: Property
 143 prop_NodeLSIdempotent =
 144   forAll (genNode (Just 1) Nothing) $ \node ->
 145   -- override failN1 to what loadNode returns by default
 146   let n = Node.setPolicy Types.defIPolicy $
 147           node { Node.failN1 = True, Node.offline = False }
 148   in
 149     (Text.loadNode defGroupAssoc.
 150          Utils.sepSplit '|' . Text.serializeNode defGroupList) n ==?
 151     Just (Node.name n, n)
 152
 153 prop_ISpecIdempotent :: Types.ISpec -> Property
 154 prop_ISpecIdempotent ispec =
 155   case Text.loadISpec "dummy" . Utils.sepSplit ',' .
 156        Text.serializeISpec $ ispec of
 157     Bad msg -> failTest $ "Failed to load ispec: " ++ msg
 158     Ok ispec' -> ispec ==? ispec'
 159
 160 prop_IPolicyIdempotent :: Types.IPolicy -> Property
 161 prop_IPolicyIdempotent ipol =
 162   case Text.loadIPolicy . Utils.sepSplit '|' $
 163        Text.serializeIPolicy owner ipol of
 164     Bad msg -> failTest $ "Failed to load ispec: " ++ msg
 165     Ok res -> (owner, ipol) ==? res
 166   where owner = "dummy"
 167
 168 -- | This property, while being in the text tests, does more than just
 169 -- test end-to-end the serialisation and loading back workflow; it
 170 -- also tests the Loader.mergeData and the actual
 171 -- Cluster.iterateAlloc (for well-behaving w.r.t. instance
 172 -- allocations, not for the business logic). As such, it's a quite
 173 -- complex and slow test, and that's the reason we restrict it to
 174 -- small cluster sizes.
 175 prop_CreateSerialise :: Property
 176 prop_CreateSerialise =
 177   forAll genTags $ \ctags ->
 178   forAll (choose (1, 20)) $ \maxiter ->
 179   forAll (choose (2, 10)) $ \count ->
 180   forAll genOnlineNode $ \node ->
 181   forAll (genInstanceSmallerThanNode node) $ \inst ->
 182   let nl = makeSmallCluster node count
 183       reqnodes = Instance.requiredNodes $ Instance.diskTemplate inst
 184   in case Cluster.genAllocNodes defGroupList nl reqnodes True >>= \allocn ->
 185      Cluster.iterateAlloc nl Container.empty (Just maxiter) inst allocn [] []
 186      of
 187        Bad msg -> failTest $ "Failed to allocate: " ++ msg
 188        Ok (_, _, _, [], _) -> printTestCase
 189                               "Failed to allocate: no allocations" False
 190        Ok (_, nl', il', _, _) ->
 191          let cdata = Loader.ClusterData defGroupList nl' il' ctags
 192                      Types.defIPolicy
 193              saved = Text.serializeCluster cdata
 194          in case Text.parseData saved >>= Loader.mergeData [] [] [] [] of
 195               Bad msg -> failTest $ "Failed to load/merge: " ++ msg
 196               Ok (Loader.ClusterData gl2 nl2 il2 ctags2 cpol2) ->
 197                 conjoin [ ctags ==? ctags2
 198                         , Types.defIPolicy ==? cpol2
 199                         , il' ==? il2
 200                         , defGroupList ==? gl2
 201                         , nl' ==? nl2
 202                         ]
 203
 204 testSuite "HTools/Text"
 205             [ 'prop_Load_Instance
 206             , 'prop_Load_InstanceFail
 207             , 'prop_Load_Node
 208             , 'prop_Load_NodeFail
 209             , 'prop_NodeLSIdempotent
 210             , 'prop_ISpecIdempotent
 211             , 'prop_IPolicyIdempotent
 212             , 'prop_CreateSerialise
 213             ]