{-# LANGUAGE TemplateHaskell #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| Unittests for ganeti-htools. -} {- Copyright (C) 2009, 2010, 2011, 2012 Google Inc. This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. -} module Test.Ganeti.HTools.Text (testHTools_Text) where import Test.QuickCheck import qualified Data.Map as Map import Data.List import Data.Maybe import Test.Ganeti.TestHelper import Test.Ganeti.TestCommon import Test.Ganeti.TestHTools import Test.Ganeti.HTools.Instance (genInstanceSmallerThanNode) import Test.Ganeti.HTools.Node (genNode, genOnlineNode) import Ganeti.BasicTypes import qualified Ganeti.HTools.Cluster as Cluster import qualified Ganeti.HTools.Container as Container import qualified Ganeti.HTools.Group as Group import qualified Ganeti.HTools.Instance as Instance import qualified Ganeti.HTools.Loader as Loader import qualified Ganeti.HTools.Node as Node import qualified Ganeti.HTools.Text as Text import qualified Ganeti.HTools.Types as Types import qualified Ganeti.Utils as Utils -- * Instance text loader tests prop_Load_Instance :: String -> Int -> Int -> Int -> Types.InstanceStatus -> NonEmptyList Char -> String -> NonNegative Int -> NonNegative Int -> Bool -> Types.DiskTemplate -> Int -> Property prop_Load_Instance name mem dsk vcpus status (NonEmpty pnode) snode (NonNegative pdx) (NonNegative sdx) autobal dt su = pnode /= snode && pdx /= sdx ==> let vcpus_s = show vcpus dsk_s = show dsk mem_s = show mem su_s = show su status_s = Types.instanceStatusToRaw status ndx = if null snode then [(pnode, pdx)] else [(pnode, pdx), (snode, sdx)] nl = Map.fromList ndx tags = "" sbal = if autobal then "Y" else "N" sdt = Types.diskTemplateToRaw dt inst = Text.loadInst nl [name, mem_s, dsk_s, vcpus_s, status_s, sbal, pnode, snode, sdt, tags, su_s] fail1 = Text.loadInst nl [name, mem_s, dsk_s, vcpus_s, status_s, sbal, pnode, pnode, tags] in case inst of Bad msg -> failTest $ "Failed to load instance: " ++ msg Ok (_, i) -> printTestCase "Mismatch in some field while\ \ loading the instance" $ Instance.name i == name && Instance.vcpus i == vcpus && Instance.mem i == mem && Instance.pNode i == pdx && Instance.sNode i == (if null snode then Node.noSecondary else sdx) && Instance.autoBalance i == autobal && Instance.spindleUse i == su && isBad fail1 prop_Load_InstanceFail :: [(String, Int)] -> [String] -> Property prop_Load_InstanceFail ktn fields = length fields /= 10 && length fields /= 11 ==> case Text.loadInst nl fields of Ok _ -> failTest "Managed to load instance from invalid data" Bad msg -> printTestCase ("Unrecognised error message: " ++ msg) $ "Invalid/incomplete instance data: '" `isPrefixOf` msg where nl = Map.fromList ktn prop_Load_Node :: String -> Int -> Int -> Int -> Int -> Int -> Int -> Bool -> Bool prop_Load_Node name tm nm fm td fd tc fo = let conv v = if v < 0 then "?" else show v tm_s = conv tm nm_s = conv nm fm_s = conv fm td_s = conv td fd_s = conv fd tc_s = conv tc fo_s = if fo then "Y" else "N" any_broken = any (< 0) [tm, nm, fm, td, fd, tc] gid = Group.uuid defGroup in case Text.loadNode defGroupAssoc [name, tm_s, nm_s, fm_s, td_s, fd_s, tc_s, fo_s, gid] of Nothing -> False Just (name', node) -> if fo || any_broken then Node.offline node else Node.name node == name' && name' == name && Node.alias node == name && Node.tMem node == fromIntegral tm && Node.nMem node == nm && Node.fMem node == fm && Node.tDsk node == fromIntegral td && Node.fDsk node == fd && Node.tCpu node == fromIntegral tc prop_Load_NodeFail :: [String] -> Property prop_Load_NodeFail fields = length fields /= 8 ==> isNothing $ Text.loadNode Map.empty fields prop_NodeLSIdempotent :: Property prop_NodeLSIdempotent = forAll (genNode (Just 1) Nothing) $ \node -> -- override failN1 to what loadNode returns by default let n = Node.setPolicy Types.defIPolicy $ node { Node.failN1 = True, Node.offline = False } in (Text.loadNode defGroupAssoc. Utils.sepSplit '|' . Text.serializeNode defGroupList) n ==? Just (Node.name n, n) prop_ISpecIdempotent :: Types.ISpec -> Property prop_ISpecIdempotent ispec = case Text.loadISpec "dummy" . Utils.sepSplit ',' . Text.serializeISpec $ ispec of Bad msg -> failTest $ "Failed to load ispec: " ++ msg Ok ispec' -> ispec ==? ispec' prop_IPolicyIdempotent :: Types.IPolicy -> Property prop_IPolicyIdempotent ipol = case Text.loadIPolicy . Utils.sepSplit '|' $ Text.serializeIPolicy owner ipol of Bad msg -> failTest $ "Failed to load ispec: " ++ msg Ok res -> (owner, ipol) ==? res where owner = "dummy" -- | This property, while being in the text tests, does more than just -- test end-to-end the serialisation and loading back workflow; it -- also tests the Loader.mergeData and the actual -- Cluster.iterateAlloc (for well-behaving w.r.t. instance -- allocations, not for the business logic). As such, it's a quite -- complex and slow test, and that's the reason we restrict it to -- small cluster sizes. prop_CreateSerialise :: Property prop_CreateSerialise = forAll genTags $ \ctags -> forAll (choose (1, 20)) $ \maxiter -> forAll (choose (2, 10)) $ \count -> forAll genOnlineNode $ \node -> forAll (genInstanceSmallerThanNode node) $ \inst -> let nl = makeSmallCluster node count reqnodes = Instance.requiredNodes $ Instance.diskTemplate inst in case Cluster.genAllocNodes defGroupList nl reqnodes True >>= \allocn -> Cluster.iterateAlloc nl Container.empty (Just maxiter) inst allocn [] [] of Bad msg -> failTest $ "Failed to allocate: " ++ msg Ok (_, _, _, [], _) -> printTestCase "Failed to allocate: no allocations" False Ok (_, nl', il', _, _) -> let cdata = Loader.ClusterData defGroupList nl' il' ctags Types.defIPolicy saved = Text.serializeCluster cdata in case Text.parseData saved >>= Loader.mergeData [] [] [] [] of Bad msg -> failTest $ "Failed to load/merge: " ++ msg Ok (Loader.ClusterData gl2 nl2 il2 ctags2 cpol2) -> ctags ==? ctags2 .&&. Types.defIPolicy ==? cpol2 .&&. il' ==? il2 .&&. defGroupList ==? gl2 .&&. nl' ==? nl2 testSuite "HTools/Text" [ 'prop_Load_Instance , 'prop_Load_InstanceFail , 'prop_Load_Node , 'prop_Load_NodeFail , 'prop_NodeLSIdempotent , 'prop_ISpecIdempotent , 'prop_IPolicyIdempotent , 'prop_CreateSerialise ]