content: {-# LANGUAGE TemplateHaskell #-}
  {-# OPTIONS_GHC -fno-warn-orphans #-}
  
  {-| Unittests for ganeti-htools.
  
  -}
  
  {-
  
  Copyright (C) 2009, 2010, 2011, 2012, 2013 Google Inc.
  All rights reserved.
  
  Redistribution and use in source and binary forms, with or without
  modification, are permitted provided that the following conditions are
  met:
  
  1. Redistributions of source code must retain the above copyright notice,
  this list of conditions and the following disclaimer.
  
  2. Redistributions in binary form must reproduce the above copyright
  notice, this list of conditions and the following disclaimer in the
  documentation and/or other materials provided with the distribution.
  
  THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
  IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
  TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
  PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR
  CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
  EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
  PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
  PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
  LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
  NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
  SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
  
  -}
  
  module Test.Ganeti.HTools.Instance
    ( testHTools_Instance
    , genInstanceSmallerThanNode
    , genInstanceMaybeBiggerThanNode
    , genInstanceOnNodeList
    , genInstanceList
    , Instance.Instance(..)
    ) where
  
  import Control.Arrow ((&&&))
  import Control.Monad (liftM)
  import Test.QuickCheck hiding (Result)
  
  import Test.Ganeti.TestHTools (nullISpec)
  import Test.Ganeti.TestHelper
  import Test.Ganeti.TestCommon
  import Test.Ganeti.HTools.Types ()
  
  import Ganeti.BasicTypes
  import qualified Ganeti.HTools.Instance as Instance
  import qualified Ganeti.HTools.Node as Node
  import qualified Ganeti.HTools.Container as Container
  import qualified Ganeti.HTools.Loader as Loader
  import qualified Ganeti.HTools.Types as Types
  
  -- * Arbitrary instances
  
  -- | Generates a random instance with maximum and minimum disk/mem/cpu values.
  genInstanceWithin :: Int -> Int -> Int -> Int
                    -> Int -> Int -> Int -> Maybe Int
                    -> Gen Instance.Instance
  genInstanceWithin min_mem min_dsk min_cpu min_spin
                    max_mem max_dsk max_cpu max_spin = do
    name <- genFQDN
    mem <- choose (min_mem, max_mem)
    dsk <- choose (min_dsk, max_dsk)
    run_st <- arbitrary
    pn <- arbitrary
    sn <- arbitrary
    vcpus <- choose (min_cpu, max_cpu)
    dt <- arbitrary
    spindles <- case max_spin of
      Nothing -> genMaybe $ choose (min_spin, maxSpindles)
      Just ls -> liftM Just $ choose (min_spin, ls)
    forthcoming <- arbitrary
    let disk = Instance.Disk dsk spindles
    return $ Instance.create
      name mem dsk [disk] vcpus run_st [] True pn sn dt 1 [] forthcoming
  
  -- | Generate an instance with maximum disk/mem/cpu values.
  genInstanceSmallerThan :: Int -> Int -> Int -> Maybe Int
                         -> Gen Instance.Instance
  genInstanceSmallerThan = genInstanceWithin 1 0 1 0
  
  -- | Generates an instance smaller than a node.
  genInstanceSmallerThanNode :: Node.Node -> Gen Instance.Instance
  genInstanceSmallerThanNode node =
    genInstanceSmallerThan (Node.availMem node `div` 2)
                           (Node.availDisk node `div` 2)
                           (Node.availCpu node `div` 2)
                           (if Node.exclStorage node
                            then Just $ Node.fSpindlesForth node `div` 2
                            else Nothing)
  
  -- | Generates an instance possibly bigger than a node.
  -- In any case, that instance will be bigger than the node's ipolicy's lower
  -- bound.
  genInstanceMaybeBiggerThanNode :: Node.Node -> Gen Instance.Instance
  genInstanceMaybeBiggerThanNode node =
    let minISpec = runListHead nullISpec Types.minMaxISpecsMinSpec
                   . Types.iPolicyMinMaxISpecs $ Node.iPolicy node
    in genInstanceWithin (Types.iSpecMemorySize minISpec)
                         (Types.iSpecDiskSize minISpec)
                         (Types.iSpecCpuCount minISpec)
                         (Types.iSpecSpindleUse minISpec)
                         (Node.availMem  node + Types.unitMem * 2)
                         (Node.availDisk node + Types.unitDsk * 3)
                         (Node.availCpu  node + Types.unitCpu * 4)
                         (if Node.exclStorage node
                            then Just $ Node.fSpindles node +
                                 Types.unitSpindle * 5
                            else Nothing)
  
  -- | Generates an instance with nodes on a node list.
  -- The following rules are respected:
  -- 1. The instance is never bigger than its primary node
  -- 2. If possible the instance has different pnode and snode
  -- 3. Else disk templates which require secondary nodes are disabled
  genInstanceOnNodeList :: Node.List -> Gen Instance.Instance
  genInstanceOnNodeList nl = do
    let nsize = Container.size nl
    pnode <- choose (0, nsize-1)
    let (snodefilter, dtfilter) =
          if nsize >= 2
            then ((/= pnode), const True)
            else (const True, not . Instance.hasSecondary)
    snode <- choose (0, nsize-1) `suchThat` snodefilter
    i <- genInstanceSmallerThanNode (Container.find pnode nl) `suchThat` dtfilter
    return $ i { Instance.pNode = pnode, Instance.sNode = snode }
  
  -- | Generates an instance list given an instance generator.
  genInstanceList :: Gen Instance.Instance -> Gen Instance.List
  genInstanceList igen = fmap (snd . Loader.assignIndices) names_instances
      where names_instances =
              map (Instance.name &&& id) <$> listOf igen
  
  -- let's generate a random instance
  instance Arbitrary Instance.Instance where
    arbitrary = genInstanceSmallerThan maxMem maxDsk maxCpu Nothing
  
  -- * Test cases
  
  -- Simple instance tests, we only have setter/getters
  
  prop_creat :: Instance.Instance -> Property
  prop_creat inst =
    Instance.name inst ==? Instance.alias inst
  
  prop_setIdx :: Instance.Instance -> Types.Idx -> Property
  prop_setIdx inst idx =
    Instance.idx (Instance.setIdx inst idx) ==? idx
  
  prop_setName :: Instance.Instance -> String -> Bool
  prop_setName inst name =
    Instance.name newinst == name &&
    Instance.alias newinst == name
      where newinst = Instance.setName inst name
  
  prop_setAlias :: Instance.Instance -> String -> Bool
  prop_setAlias inst name =
    Instance.name newinst == Instance.name inst &&
    Instance.alias newinst == name
      where newinst = Instance.setAlias inst name
  
  prop_setPri :: Instance.Instance -> Types.Ndx -> Property
  prop_setPri inst pdx =
    Instance.pNode (Instance.setPri inst pdx) ==? pdx
  
  prop_setSec :: Instance.Instance -> Types.Ndx -> Property
  prop_setSec inst sdx =
    Instance.sNode (Instance.setSec inst sdx) ==? sdx
  
  prop_setBoth :: Instance.Instance -> Types.Ndx -> Types.Ndx -> Bool
  prop_setBoth inst pdx sdx =
    Instance.pNode si == pdx && Instance.sNode si == sdx
      where si = Instance.setBoth inst pdx sdx
  
  prop_shrinkMG :: Instance.Instance -> Property
  prop_shrinkMG inst =
    Instance.mem inst >= 2 * Types.unitMem ==>
      case Instance.shrinkByType inst Types.FailMem of
        Ok inst' -> Instance.mem inst' ==? Instance.mem inst - Types.unitMem
        Bad msg -> failTest msg
  
  prop_shrinkMF :: Instance.Instance -> Property
  prop_shrinkMF inst =
    forAll (choose (0, 2 * Types.unitMem - 1)) $ \mem ->
      let inst' = inst { Instance.mem = mem}
      in isBad $ Instance.shrinkByType inst' Types.FailMem
  
  prop_shrinkCG :: Instance.Instance -> Property
  prop_shrinkCG inst =
    Instance.vcpus inst >= 2 * Types.unitCpu ==>
      case Instance.shrinkByType inst Types.FailCPU of
        Ok inst' -> Instance.vcpus inst' ==? Instance.vcpus inst - Types.unitCpu
        Bad msg -> failTest msg
  
  prop_shrinkCF :: Instance.Instance -> Property
  prop_shrinkCF inst =
    forAll (choose (0, 2 * Types.unitCpu - 1)) $ \vcpus ->
      let inst' = inst { Instance.vcpus = vcpus }
      in isBad $ Instance.shrinkByType inst' Types.FailCPU
  
  prop_shrinkDG :: Instance.Instance -> Property
  prop_shrinkDG inst =
    Instance.dsk inst >= 2 * Types.unitDsk ==>
      case Instance.shrinkByType inst Types.FailDisk of
        Ok inst' -> Instance.dsk inst' ==? Instance.dsk inst - Types.unitDsk
        Bad msg -> failTest msg
  
  prop_shrinkDF :: Instance.Instance -> Property
  prop_shrinkDF inst =
    forAll (choose (0, 2 * Types.unitDsk - 1)) $ \dsk ->
      let inst' = inst { Instance.dsk = dsk
                       , Instance.disks = [Instance.Disk dsk Nothing] }
      in isBad $ Instance.shrinkByType inst' Types.FailDisk
  
  prop_setMovable :: Instance.Instance -> Bool -> Property
  prop_setMovable inst m =
    Instance.movable inst' ==? m
      where inst' = Instance.setMovable inst m
  
  testSuite "HTools/Instance"
              [ 'prop_creat
              , 'prop_setIdx
              , 'prop_setName
              , 'prop_setAlias
              , 'prop_setPri
              , 'prop_setSec
              , 'prop_setBoth
              , 'prop_shrinkMG
              , 'prop_shrinkMF
              , 'prop_shrinkCG
              , 'prop_shrinkCF
              , 'prop_shrinkDG
              , 'prop_shrinkDF
              , 'prop_setMovable
              ]
  