{-# 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.Node
  ( testHTools_Node
  , Node.Node(..)
  , setInstanceSmallerThanNode
  , genNode
  , genOnlineNode
  , genNodeList
  , genUniqueNodeList
  ) where

import Test.QuickCheck
import Test.HUnit

import Control.Monad
import qualified Data.Map as Map
import qualified Data.Graph as Graph
import Data.List

import Test.Ganeti.TestHelper
import Test.Ganeti.TestCommon
import Test.Ganeti.TestHTools
import Test.Ganeti.HTools.Instance ( genInstanceSmallerThanNode
                                   , genInstanceList
                                   , genInstanceOnNodeList)

import Ganeti.BasicTypes
import qualified Ganeti.HTools.Loader as Loader
import qualified Ganeti.HTools.Container as Container
import qualified Ganeti.HTools.Instance as Instance
import qualified Ganeti.HTools.Node as Node
import qualified Ganeti.HTools.Types as Types
import qualified Ganeti.HTools.Graph as HGraph

{-# ANN module "HLint: ignore Use camelCase" #-}

-- * Arbitrary instances

-- | Generates an arbitrary node based on sizing information.
genNode :: Maybe Int -- ^ Minimum node size in terms of units
        -> Maybe Int -- ^ Maximum node size (when Nothing, bounded
                     -- just by the max... constants)
        -> Gen Node.Node
genNode min_multiplier max_multiplier = do
  let (base_mem, base_dsk, base_cpu, base_spindles) =
        case min_multiplier of
          Just mm -> (mm * Types.unitMem,
                      mm * Types.unitDsk,
                      mm * Types.unitCpu,
                      mm)
          Nothing -> (0, 0, 0, 0)
      (top_mem, top_dsk, top_cpu, top_spindles)  =
        case max_multiplier of
          Just mm -> (mm * Types.unitMem,
                      mm * Types.unitDsk,
                      mm * Types.unitCpu,
                      mm)
          Nothing -> (maxMem, maxDsk, maxCpu, maxSpindles)
  name  <- genFQDN
  mem_t <- choose (base_mem, top_mem)
  mem_f <- choose (base_mem, mem_t)
  mem_n <- choose (0, mem_t - mem_f)
  dsk_t <- choose (base_dsk, top_dsk)
  dsk_f <- choose (base_dsk, dsk_t)
  cpu_t <- choose (base_cpu, top_cpu)
  cpu_n <- choose (base_cpu, cpu_t)
  offl  <- arbitrary
  spindles <- choose (base_spindles, top_spindles)
  let n = Node.create name (fromIntegral mem_t) mem_n mem_f
          (fromIntegral dsk_t) dsk_f (fromIntegral cpu_t) cpu_n offl spindles
          0 0 False
      n' = Node.setPolicy nullIPolicy n
  return $ Node.buildPeers n' Container.empty

-- | Helper function to generate a sane node.
genOnlineNode :: Gen Node.Node
genOnlineNode =
  arbitrary `suchThat` (\n -> not (Node.offline n) &&
                              not (Node.failN1 n) &&
                              Node.availDisk n > 0 &&
                              Node.availMem n > 0 &&
                              Node.availCpu n > 0 &&
                              Node.tSpindles n > 0)

-- | Generate a node with exclusive storage enabled.
genExclStorNode :: Gen Node.Node
genExclStorNode = do
  n <- genOnlineNode
  fs <- choose (Types.unitSpindle, Node.tSpindles n)
  let pd = fromIntegral fs / fromIntegral (Node.tSpindles n)::Double
  return n { Node.exclStorage = True
           , Node.fSpindles = fs
           , Node.pDsk = pd
           }

-- | Generate a node with exclusive storage possibly enabled.
genMaybeExclStorNode :: Gen Node.Node
genMaybeExclStorNode = oneof [genOnlineNode, genExclStorNode]

-- and a random node
instance Arbitrary Node.Node where
  arbitrary = genNode Nothing Nothing

-- | Node list generator.
-- Given a node generator, create a random length node list.  Note that "real"
-- clusters always have at least one node, so we don't generate empty node
-- lists here.
genNodeList :: Gen Node.Node -> Gen Node.List
genNodeList ngen = fmap (snd . Loader.assignIndices) names_nodes
    where names_nodes = (fmap . map) (\n -> (Node.name n, n)) nodes
          nodes = listOf1 ngen `suchThat`
                  ((\ns -> ns == nub ns) . map Node.name)

-- | Node list generator where node names are unique
genUniqueNodeList :: Gen Node.Node -> Gen (Node.List, Types.NameAssoc)
genUniqueNodeList ngen = (do
  nl <- genNodeList ngen
  let na = (fst . Loader.assignIndices) $
           map (\n -> (Node.name n, n)) (Container.elems nl)
  return (nl, na)) `suchThat`
    (\(nl, na) -> Container.size nl == Map.size na)

-- | Generate a node list, an instance list, and a node graph.
-- We choose instances with nodes contained in the node list.
genNodeGraph :: Gen (Maybe Graph.Graph, Node.List, Instance.List)
genNodeGraph = do
  nl <- genNodeList genOnlineNode `suchThat` ((2<=).Container.size)
  il <- genInstanceList (genInstanceOnNodeList nl)
  return (Node.mkNodeGraph nl il, nl, il)

-- * Test cases

prop_setAlias :: Node.Node -> String -> Bool
prop_setAlias node name =
  Node.name newnode == Node.name node &&
  Node.alias newnode == name
    where newnode = Node.setAlias node name

prop_setOffline :: Node.Node -> Bool -> Property
prop_setOffline node status =
  Node.offline newnode ==? status
    where newnode = Node.setOffline node status

prop_setXmem :: Node.Node -> Int -> Property
prop_setXmem node xm =
  Node.xMem newnode ==? xm
    where newnode = Node.setXmem node xm

prop_setMcpu :: Node.Node -> Double -> Property
prop_setMcpu node mc =
  Types.iPolicyVcpuRatio (Node.iPolicy newnode) ==? mc
    where newnode = Node.setMcpu node mc

prop_setFmemGreater :: Node.Node -> Int -> Property
prop_setFmemGreater node new_mem =
  not (Node.failN1 node) && (Node.rMem node >= 0) &&
  (new_mem > Node.rMem node) ==>
  not (Node.failN1 (Node.setFmem node new_mem))

prop_setFmemExact :: Node.Node -> Property
prop_setFmemExact node =
  not (Node.failN1 node) && (Node.rMem node >= 0) ==>
  not (Node.failN1 (Node.setFmem node (Node.rMem node)))

-- Check if adding an instance that consumes exactly all reserved
-- memory does not raise an N+1 error
prop_addPri_NoN1Fail :: Property
prop_addPri_NoN1Fail =
  forAll genMaybeExclStorNode $ \node ->
  forAll (genInstanceSmallerThanNode node) $ \inst ->
  let inst' = inst { Instance.mem = Node.fMem node - Node.rMem node }
  in (Node.addPri node inst' /=? Bad Types.FailN1)

-- | Check that an instance add with too high memory or disk will be
-- rejected.
prop_addPriFM :: Node.Node -> Instance.Instance -> Property
prop_addPriFM node inst =
  Instance.mem inst >= Node.fMem node && not (Node.failN1 node) &&
  not (Instance.isOffline inst) ==>
  (Node.addPri node inst'' ==? Bad Types.FailMem)
  where inst' = setInstanceSmallerThanNode node inst
        inst'' = inst' { Instance.mem = Instance.mem inst }

-- | Check that adding a primary instance with too much disk fails
-- with type FailDisk.
prop_addPriFD :: Node.Node -> Instance.Instance -> Property
prop_addPriFD node inst =
  forAll (elements Instance.localStorageTemplates) $ \dt ->
  Instance.dsk inst >= Node.fDsk node && not (Node.failN1 node) ==>
  let inst' = setInstanceSmallerThanNode node inst
      inst'' = inst' { Instance.dsk = Instance.dsk inst
                     , Instance.diskTemplate = dt }
  in (Node.addPri node inst'' ==? Bad Types.FailDisk)

-- | Check if an instance exceeds a spindles limit or has no spindles set.
hasInstTooManySpindles :: Instance.Instance -> Int -> Bool
hasInstTooManySpindles inst sp_lim =
  case Instance.getTotalSpindles inst of
    Just s -> s > sp_lim
    Nothing -> True

-- | Check that adding a primary instance with too many spindles fails
-- with type FailSpindles (when exclusive storage is enabled).
prop_addPriFS :: Instance.Instance -> Property
prop_addPriFS inst =
  forAll genExclStorNode $ \node ->
  forAll (elements Instance.localStorageTemplates) $ \dt ->
  hasInstTooManySpindles inst (Node.fSpindles node) &&
    not (Node.failN1 node) ==>
  let inst' = setInstanceSmallerThanNode node inst
      inst'' = inst' { Instance.disks = Instance.disks inst
                     , Instance.diskTemplate = dt }
  in (Node.addPri node inst'' ==? Bad Types.FailSpindles)

-- | Check that adding a primary instance with too many VCPUs fails
-- with type FailCPU.
prop_addPriFC :: Property
prop_addPriFC =
  forAll (choose (1, maxCpu)) $ \extra ->
  forAll genMaybeExclStorNode $ \node ->
  forAll (arbitrary `suchThat` Instance.notOffline) $ \inst ->
  let inst' = setInstanceSmallerThanNode node inst
      inst'' = inst' { Instance.vcpus = Node.availCpu node + extra }
  in case Node.addPri node inst'' of
       Bad Types.FailCPU -> passTest
       v -> failTest $ "Expected OpFail FailCPU, but got " ++ show v

-- | Check that an instance add with too high memory or disk will be
-- rejected.
prop_addSec :: Node.Node -> Instance.Instance -> Int -> Property
prop_addSec node inst pdx =
  ((Instance.mem inst >= (Node.fMem node - Node.rMem node) &&
    not (Instance.isOffline inst)) ||
   Instance.dsk inst >= Node.fDsk node ||
   (Node.exclStorage node &&
    hasInstTooManySpindles inst (Node.fSpindles node))) &&
  not (Node.failN1 node) ==>
      isBad (Node.addSec node inst pdx)

-- | Check that an offline instance with reasonable disk size but
-- extra mem/cpu can always be added.
prop_addOfflinePri :: NonNegative Int -> NonNegative Int -> Property
prop_addOfflinePri (NonNegative extra_mem) (NonNegative extra_cpu) =
  forAll genMaybeExclStorNode $ \node ->
  forAll (genInstanceSmallerThanNode node) $ \inst ->
  let inst' = inst { Instance.runSt = Types.StatusOffline
                   , Instance.mem = Node.availMem node + extra_mem
                   , Instance.vcpus = Node.availCpu node + extra_cpu }
  in case Node.addPri node inst' of
       Ok _ -> passTest
       v -> failTest $ "Expected OpGood, but got: " ++ show v

-- | Check that an offline instance with reasonable disk size but
-- extra mem/cpu can always be added.
prop_addOfflineSec :: NonNegative Int -> NonNegative Int
                   -> Types.Ndx -> Property
prop_addOfflineSec (NonNegative extra_mem) (NonNegative extra_cpu) pdx =
  forAll genMaybeExclStorNode $ \node ->
  forAll (genInstanceSmallerThanNode node) $ \inst ->
  let inst' = inst { Instance.runSt = Types.StatusOffline
                   , Instance.mem = Node.availMem node + extra_mem
                   , Instance.vcpus = Node.availCpu node + extra_cpu
                   , Instance.diskTemplate = Types.DTDrbd8 }
  in case Node.addSec node inst' pdx of
       Ok _ -> passTest
       v -> failTest $ "Expected OpGood/OpGood, but got: " ++ show v

-- | Checks for memory reservation changes.
prop_rMem :: Instance.Instance -> Property
prop_rMem inst =
  not (Instance.isOffline inst) ==>
  forAll (genMaybeExclStorNode `suchThat` ((> Types.unitMem) . Node.fMem)) $
    \node ->
  -- ab = auto_balance, nb = non-auto_balance
  -- we use -1 as the primary node of the instance
  let inst' = inst { Instance.pNode = -1, Instance.autoBalance = True
                   , Instance.diskTemplate = Types.DTDrbd8 }
      inst_ab = setInstanceSmallerThanNode node inst'
      inst_nb = inst_ab { Instance.autoBalance = False }
      -- now we have the two instances, identical except the
      -- autoBalance attribute
      orig_rmem = Node.rMem node
      inst_idx = Instance.idx inst_ab
      node_add_ab = Node.addSec node inst_ab (-1)
      node_add_nb = Node.addSec node inst_nb (-1)
      node_del_ab = liftM (`Node.removeSec` inst_ab) node_add_ab
      node_del_nb = liftM (`Node.removeSec` inst_nb) node_add_nb
  in case (node_add_ab, node_add_nb, node_del_ab, node_del_nb) of
       (Ok a_ab, Ok a_nb,
        Ok d_ab, Ok d_nb) ->
         printTestCase "Consistency checks failed" $
           Node.rMem a_ab >  orig_rmem &&
           Node.rMem a_ab - orig_rmem == Instance.mem inst_ab &&
           Node.rMem a_nb == orig_rmem &&
           Node.rMem d_ab == orig_rmem &&
           Node.rMem d_nb == orig_rmem &&
           -- this is not related to rMem, but as good a place to
           -- test as any
           inst_idx `elem` Node.sList a_ab &&
           inst_idx `notElem` Node.sList d_ab
       x -> failTest $ "Failed to add/remove instances: " ++ show x

-- | Check mdsk setting.
prop_setMdsk :: Node.Node -> SmallRatio -> Bool
prop_setMdsk node mx =
  Node.loDsk node' >= 0 &&
  fromIntegral (Node.loDsk node') <= Node.tDsk node &&
  Node.availDisk node' >= 0 &&
  Node.availDisk node' <= Node.fDsk node' &&
  fromIntegral (Node.availDisk node') <= Node.tDsk node' &&
  Node.mDsk node' == mx'
    where node' = Node.setMdsk node mx'
          SmallRatio mx' = mx

-- Check tag maps
prop_tagMaps_idempotent :: Property
prop_tagMaps_idempotent =
  forAll genTags $ \tags ->
  Node.delTags (Node.addTags m tags) tags ==? m
    where m = Map.empty

prop_tagMaps_reject :: Property
prop_tagMaps_reject =
  forAll (genTags `suchThat` (not . null)) $ \tags ->
  let m = Node.addTags Map.empty tags
  in all (\t -> Node.rejectAddTags m [t]) tags

prop_showField :: Node.Node -> Property
prop_showField node =
  forAll (elements Node.defaultFields) $ \ field ->
  fst (Node.showHeader field) /= Types.unknownField &&
  Node.showField node field /= Types.unknownField

prop_computeGroups :: [Node.Node] -> Bool
prop_computeGroups nodes =
  let ng = Node.computeGroups nodes
      onlyuuid = map fst ng
  in length nodes == sum (map (length . snd) ng) &&
     all (\(guuid, ns) -> all ((== guuid) . Node.group) ns) ng &&
     length (nub onlyuuid) == length onlyuuid &&
     (null nodes || not (null ng))

-- Check idempotence of add/remove operations
prop_addPri_idempotent :: Property
prop_addPri_idempotent =
  forAll genMaybeExclStorNode $ \node ->
  forAll (genInstanceSmallerThanNode node) $ \inst ->
  case Node.addPri node inst of
    Ok node' -> Node.removePri node' inst ==? node
    _ -> failTest "Can't add instance"

prop_addSec_idempotent :: Property
prop_addSec_idempotent =
  forAll genMaybeExclStorNode $ \node ->
  forAll (genInstanceSmallerThanNode node) $ \inst ->
  let pdx = Node.idx node + 1
      inst' = Instance.setPri inst pdx
      inst'' = inst' { Instance.diskTemplate = Types.DTDrbd8 }
  in case Node.addSec node inst'' pdx of
       Ok node' -> Node.removeSec node' inst'' ==? node
       _ -> failTest "Can't add instance"

-- | Check that no graph is created on an empty node list.
case_emptyNodeList :: Assertion
case_emptyNodeList =
  assertEqual "" Nothing $ Node.mkNodeGraph emptynodes emptyinstances
    where emptynodes = Container.empty :: Node.List
          emptyinstances = Container.empty :: Instance.List

-- | Check that the number of vertices of a nodegraph is equal to the number of
-- nodes in the original node list.
prop_numVertices :: Property
prop_numVertices =
  forAll genNodeGraph $ \(graph, nl, _) ->
    (fmap numvertices graph ==? Just (Container.size nl))
    where numvertices = length . Graph.vertices

-- | Check that the number of edges of a nodegraph is equal to twice the number
-- of instances with secondary nodes in the original instance list.
prop_numEdges :: Property
prop_numEdges =
  forAll genNodeGraph $ \(graph, _, il) ->
    (fmap numedges graph ==? Just (numwithsec il * 2))
    where numedges = length . Graph.edges
          numwithsec = length . filter Instance.hasSecondary . Container.elems

-- | Check that a node graph is colorable.
prop_nodeGraphIsColorable :: Property
prop_nodeGraphIsColorable =
  forAll genNodeGraph $ \(graph, _, _) ->
    fmap HGraph.isColorable graph ==? Just True

-- | Check that each edge in a nodegraph is an instance.
prop_instanceIsEdge :: Property
prop_instanceIsEdge =
  forAll genNodeGraph $ \(graph, _, il) ->
    fmap (\g -> all (`isEdgeOn` g) (iwithsec il)) graph ==? Just True
    where i `isEdgeOn` g = iEdges i `intersect` Graph.edges g == iEdges i
          iEdges i = [ (Instance.pNode i, Instance.sNode i)
                     , (Instance.sNode i, Instance.pNode i)]
          iwithsec = filter Instance.hasSecondary . Container.elems

-- | Check that each instance in an edge in the resulting nodegraph.
prop_edgeIsInstance :: Property
prop_edgeIsInstance =
  forAll genNodeGraph $ \(graph, _, il) ->
    fmap (all (`isInstanceIn` il).Graph.edges) graph ==? Just True
      where e `isInstanceIn` il = any (`hasNodes` e) (Container.elems il)
            i `hasNodes` (v1,v2) =
              Instance.allNodes i `elem` permutations [v1,v2]

-- | List of tests for the Node module.
testSuite "HTools/Node"
            [ 'prop_setAlias
            , 'prop_setOffline
            , 'prop_setMcpu
            , 'prop_setFmemGreater
            , 'prop_setFmemExact
            , 'prop_setXmem
            , 'prop_addPriFM
            , 'prop_addPriFD
            , 'prop_addPriFS
            , 'prop_addPriFC
            , 'prop_addPri_NoN1Fail
            , 'prop_addSec
            , 'prop_addOfflinePri
            , 'prop_addOfflineSec
            , 'prop_rMem
            , 'prop_setMdsk
            , 'prop_tagMaps_idempotent
            , 'prop_tagMaps_reject
            , 'prop_showField
            , 'prop_computeGroups
            , 'prop_addPri_idempotent
            , 'prop_addSec_idempotent
            , 'case_emptyNodeList
            , 'prop_numVertices
            , 'prop_numEdges
            , 'prop_nodeGraphIsColorable
            , 'prop_edgeIsInstance
            , 'prop_instanceIsEdge
            ]