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