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