Synnefo » snf-ganeti

{-| Module describing a node.

    All updates are functional (copy-based) and return a new node with

    updated value.

-}

{-

Copyright (C) 2009, 2010 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 Ganeti.HTools.Node

    ( Node(..)

    , List

    -- * Constructor

    , create

    -- ** Finalization after data loading

    , buildPeers

    , setIdx

    , setAlias

    , setOffline

    , setXmem

    , setFmem

    , setPri

    , setSec

    , setMdsk

    , setMcpu

    -- * Tag maps

    , addTags

    , delTags

    , rejectAddTags

    -- * Instance (re)location

    , removePri

    , removeSec

    , addPri

    , addPriEx

    , addSec

    , addSecEx

    -- * Stats

    , availDisk

    , availMem

    , availCpu

    , conflictingPrimaries

    -- * Formatting

    , defaultFields

    , showHeader

    , showField

    , list

    -- * Misc stuff

    , AssocList

    , AllocElement

    , noSecondary

    ) where

import Data.List

import qualified Data.Map as Map

import qualified Data.Foldable as Foldable

import Text.Printf (printf)

import qualified Ganeti.HTools.Container as Container

import qualified Ganeti.HTools.Instance as Instance

import qualified Ganeti.HTools.PeerMap as P

import qualified Ganeti.HTools.Types as T

-- * Type declarations

-- | The tag map type

type TagMap = Map.Map String Int

-- | The node type.

data Node = Node

    { name     :: String    -- ^ The node name

    , alias    :: String    -- ^ The shortened name (for display purposes)

    , tMem     :: Double    -- ^ Total memory (MiB)

    , nMem     :: Int       -- ^ Node memory (MiB)

    , fMem     :: Int       -- ^ Free memory (MiB)

    , xMem     :: Int       -- ^ Unaccounted memory (MiB)

    , tDsk     :: Double    -- ^ Total disk space (MiB)

    , fDsk     :: Int       -- ^ Free disk space (MiB)

    , tCpu     :: Double    -- ^ Total CPU count

    , uCpu     :: Int       -- ^ Used VCPU count

    , pList    :: [T.Idx]   -- ^ List of primary instance indices

    , sList    :: [T.Idx]   -- ^ List of secondary instance indices

    , idx      :: T.Ndx     -- ^ Internal index for book-keeping

    , peers    :: P.PeerMap -- ^ Pnode to instance mapping

    , failN1   :: Bool      -- ^ Whether the node has failed n1

    , rMem     :: Int       -- ^ Maximum memory needed for failover by

                            -- primaries of this node

    , pMem     :: Double    -- ^ Percent of free memory

    , pDsk     :: Double    -- ^ Percent of free disk

    , pRem     :: Double    -- ^ Percent of reserved memory

    , pCpu     :: Double    -- ^ Ratio of virtual to physical CPUs

    , mDsk     :: Double    -- ^ Minimum free disk ratio

    , mCpu     :: Double    -- ^ Max ratio of virt-to-phys CPUs

    , loDsk    :: Int       -- ^ Autocomputed from mDsk low disk

                            -- threshold

    , hiCpu    :: Int       -- ^ Autocomputed from mCpu high cpu

                            -- threshold

    , offline  :: Bool      -- ^ Whether the node should not be used

                            -- for allocations and skipped from score

                            -- computations

    , utilPool :: T.DynUtil -- ^ Total utilisation capacity

    , utilLoad :: T.DynUtil -- ^ Sum of instance utilisation

    , pTags    :: TagMap    -- ^ Map of primary instance tags and their count

    } deriving (Show, Eq)

instance T.Element Node where

    nameOf = name

    idxOf = idx

    setAlias = setAlias

    setIdx = setIdx

    allNames n = [name n, alias n]

-- | A simple name for the int, node association list.

type AssocList = [(T.Ndx, Node)]

-- | A simple name for a node map.

type List = Container.Container Node

-- | A simple name for an allocation element (here just for logistic

-- reasons)

type AllocElement = (List, Instance.Instance, [Node])

-- | Constant node index for a non-moveable instance.

noSecondary :: T.Ndx

noSecondary = -1

-- * Helper functions

-- | Add a tag to a tagmap

addTag :: TagMap -> String -> TagMap

addTag t s = Map.insertWith (+) s 1 t

-- | Add multiple tags

addTags :: TagMap -> [String] -> TagMap

addTags = foldl' addTag

-- | Adjust or delete a tag from a tagmap

delTag :: TagMap -> String -> TagMap

delTag t s = Map.update (\v -> if v > 1

                               then Just (v-1)

                               else Nothing)

             s t

-- | Remove multiple tags

delTags :: TagMap -> [String] -> TagMap

delTags = foldl' delTag

-- | Check if we can add a list of tags to a tagmap

rejectAddTags :: TagMap -> [String] -> Bool

rejectAddTags t = any (`Map.member` t)

-- | Check how many primary instances have conflicting tags. The

-- algorithm to compute this is to sum the count of all tags, then

-- subtract the size of the tag map (since each tag has at least one,

-- non-conflicting instance); this is equivalent to summing the

-- values in the tag map minus one.

conflictingPrimaries :: Node -> Int

conflictingPrimaries (Node { pTags = t }) = Foldable.sum t - Map.size t

-- * Initialization functions

-- | Create a new node.

--

-- The index and the peers maps are empty, and will be need to be

-- update later via the 'setIdx' and 'buildPeers' functions.

create :: String -> Double -> Int -> Int -> Double

       -> Int -> Double -> Bool -> Node

create name_init mem_t_init mem_n_init mem_f_init

       dsk_t_init dsk_f_init cpu_t_init offline_init =

    Node { name = name_init

         , alias = name_init

         , tMem = mem_t_init

         , nMem = mem_n_init

         , fMem = mem_f_init

         , tDsk = dsk_t_init

         , fDsk = dsk_f_init

         , tCpu = cpu_t_init

         , uCpu = 0

         , pList = []

         , sList = []

         , failN1 = True

         , idx = -1

         , peers = P.empty

         , rMem = 0

         , pMem = fromIntegral mem_f_init / mem_t_init

         , pDsk = fromIntegral dsk_f_init / dsk_t_init

         , pRem = 0

         , pCpu = 0

         , offline = offline_init

         , xMem = 0

         , mDsk = T.defReservedDiskRatio

         , mCpu = T.defVcpuRatio

         , loDsk = mDskToloDsk T.defReservedDiskRatio dsk_t_init

         , hiCpu = mCpuTohiCpu T.defVcpuRatio cpu_t_init

         , utilPool = T.baseUtil

         , utilLoad = T.zeroUtil

         , pTags = Map.empty

         }

-- | Conversion formula from mDsk\/tDsk to loDsk

mDskToloDsk :: Double -> Double -> Int

mDskToloDsk mval tdsk = floor (mval * tdsk)

-- | Conversion formula from mCpu\/tCpu to hiCpu

mCpuTohiCpu :: Double -> Double -> Int

mCpuTohiCpu mval tcpu = floor (mval * tcpu)

-- | Changes the index.

--

-- This is used only during the building of the data structures.

setIdx :: Node -> T.Ndx -> Node

setIdx t i = t {idx = i}

-- | Changes the alias.

--

-- This is used only during the building of the data structures.

setAlias :: Node -> String -> Node

setAlias t s = t { alias = s }

-- | Sets the offline attribute.

setOffline :: Node -> Bool -> Node

setOffline t val = t { offline = val }

-- | Sets the unnaccounted memory.

setXmem :: Node -> Int -> Node

setXmem t val = t { xMem = val }

-- | Sets the max disk usage ratio

setMdsk :: Node -> Double -> Node

setMdsk t val = t { mDsk = val, loDsk = mDskToloDsk val (tDsk t) }

-- | Sets the max cpu usage ratio

setMcpu :: Node -> Double -> Node

setMcpu t val = t { mCpu = val, hiCpu = mCpuTohiCpu val (tCpu t) }

-- | Computes the maximum reserved memory for peers from a peer map.

computeMaxRes :: P.PeerMap -> P.Elem

computeMaxRes = P.maxElem

-- | Builds the peer map for a given node.

buildPeers :: Node -> Instance.List -> Node

buildPeers t il =

    let mdata = map

                (\i_idx -> let inst = Container.find i_idx il

                           in (Instance.pNode inst, Instance.mem inst))

                (sList t)

        pmap = P.accumArray (+) mdata

        new_rmem = computeMaxRes pmap

        new_failN1 = fMem t <= new_rmem

        new_prem = fromIntegral new_rmem / tMem t

    in t {peers=pmap, failN1 = new_failN1, rMem = new_rmem, pRem = new_prem}

-- | Assigns an instance to a node as primary and update the used VCPU

-- count, utilisation data and tags map.

setPri :: Node -> Instance.Instance -> Node

setPri t inst = t { pList = Instance.idx inst:pList t

                  , uCpu = new_count

                  , pCpu = fromIntegral new_count / tCpu t

                  , utilLoad = utilLoad t `T.addUtil` Instance.util inst

                  , pTags = addTags (pTags t) (Instance.tags inst)

                  }

    where new_count = uCpu t + Instance.vcpus inst

-- | Assigns an instance to a node as secondary without other updates.

setSec :: Node -> Instance.Instance -> Node

setSec t inst = t { sList = Instance.idx inst:sList t

                  , utilLoad = old_load { T.dskWeight = T.dskWeight old_load +

                                          T.dskWeight (Instance.util inst) }

                  }

    where old_load = utilLoad t

-- * Update functions

-- | Sets the free memory.

setFmem :: Node -> Int -> Node

setFmem t new_mem =

    let new_n1 = new_mem <= rMem t

        new_mp = fromIntegral new_mem / tMem t

    in t { fMem = new_mem, failN1 = new_n1, pMem = new_mp }

-- | Removes a primary instance.

removePri :: Node -> Instance.Instance -> Node

removePri t inst =

    let iname = Instance.idx inst

        new_plist = delete iname (pList t)

        new_mem = fMem t + Instance.mem inst

        new_dsk = fDsk t + Instance.dsk inst

        new_mp = fromIntegral new_mem / tMem t

        new_dp = fromIntegral new_dsk / tDsk t

        new_failn1 = new_mem <= rMem t

        new_ucpu = uCpu t - Instance.vcpus inst

        new_rcpu = fromIntegral new_ucpu / tCpu t

        new_load = utilLoad t `T.subUtil` Instance.util inst

    in t { pList = new_plist, fMem = new_mem, fDsk = new_dsk

         , failN1 = new_failn1, pMem = new_mp, pDsk = new_dp

         , uCpu = new_ucpu, pCpu = new_rcpu, utilLoad = new_load

         , pTags = delTags (pTags t) (Instance.tags inst) }

-- | Removes a secondary instance.

removeSec :: Node -> Instance.Instance -> Node

removeSec t inst =

    let iname = Instance.idx inst

        pnode = Instance.pNode inst

        new_slist = delete iname (sList t)

        new_dsk = fDsk t + Instance.dsk inst

        old_peers = peers t

        old_peem = P.find pnode old_peers

        new_peem =  old_peem - Instance.mem inst

        new_peers = if new_peem > 0

                    then P.add pnode new_peem old_peers

                    else P.remove pnode old_peers

        old_rmem = rMem t

        new_rmem = if old_peem < old_rmem

                   then old_rmem

                   else computeMaxRes new_peers

        new_prem = fromIntegral new_rmem / tMem t

        new_failn1 = fMem t <= new_rmem

        new_dp = fromIntegral new_dsk / tDsk t

        old_load = utilLoad t

        new_load = old_load { T.dskWeight = T.dskWeight old_load -

                                            T.dskWeight (Instance.util inst) }

    in t { sList = new_slist, fDsk = new_dsk, peers = new_peers

         , failN1 = new_failn1, rMem = new_rmem, pDsk = new_dp

         , pRem = new_prem, utilLoad = new_load }

-- | Adds a primary instance (basic version).

addPri :: Node -> Instance.Instance -> T.OpResult Node

addPri = addPriEx False

-- | Adds a primary instance (extended version).

addPriEx :: Bool               -- ^ Whether to override the N+1 and

                               -- other /soft/ checks, useful if we

                               -- come from a worse status

                               -- (e.g. offline)

         -> Node               -- ^ The target node

         -> Instance.Instance  -- ^ The instance to add

         -> T.OpResult Node    -- ^ The result of the operation,

                               -- either the new version of the node

                               -- or a failure mode

addPriEx force t inst =

    let iname = Instance.idx inst

        new_mem = fMem t - Instance.mem inst

        new_dsk = fDsk t - Instance.dsk inst

        new_failn1 = new_mem <= rMem t

        new_ucpu = uCpu t + Instance.vcpus inst

        new_pcpu = fromIntegral new_ucpu / tCpu t

        new_dp = fromIntegral new_dsk / tDsk t

        l_cpu = mCpu t

        new_load = utilLoad t `T.addUtil` Instance.util inst

        inst_tags = Instance.tags inst

        old_tags = pTags t

        strict = not force

    in case () of

         _ | new_mem <= 0 -> T.OpFail T.FailMem

           | new_dsk <= 0 -> T.OpFail T.FailDisk

           | mDsk t > new_dp && strict -> T.OpFail T.FailDisk

           | new_failn1 && not (failN1 t) && strict -> T.OpFail T.FailMem

           | l_cpu >= 0 && l_cpu < new_pcpu && strict -> T.OpFail T.FailCPU

           | rejectAddTags old_tags inst_tags -> T.OpFail T.FailTags

           | otherwise ->

               let new_plist = iname:pList t

                   new_mp = fromIntegral new_mem / tMem t

                   r = t { pList = new_plist, fMem = new_mem, fDsk = new_dsk

                         , failN1 = new_failn1, pMem = new_mp, pDsk = new_dp

                         , uCpu = new_ucpu, pCpu = new_pcpu

                         , utilLoad = new_load

                         , pTags = addTags old_tags inst_tags }

               in T.OpGood r

-- | Adds a secondary instance (basic version).

addSec :: Node -> Instance.Instance -> T.Ndx -> T.OpResult Node

addSec = addSecEx False

-- | Adds a secondary instance (extended version).

addSecEx :: Bool -> Node -> Instance.Instance -> T.Ndx -> T.OpResult Node

addSecEx force t inst pdx =

    let iname = Instance.idx inst

        old_peers = peers t

        old_mem = fMem t

        new_dsk = fDsk t - Instance.dsk inst

        new_peem = P.find pdx old_peers + Instance.mem inst

        new_peers = P.add pdx new_peem old_peers

        new_rmem = max (rMem t) new_peem

        new_prem = fromIntegral new_rmem / tMem t

        new_failn1 = old_mem <= new_rmem

        new_dp = fromIntegral new_dsk / tDsk t

        old_load = utilLoad t

        new_load = old_load { T.dskWeight = T.dskWeight old_load +

                                            T.dskWeight (Instance.util inst) }

        strict = not force

    in case () of

         _ | new_dsk <= 0 -> T.OpFail T.FailDisk

           | mDsk t > new_dp && strict -> T.OpFail T.FailDisk

           | Instance.mem inst >= old_mem && strict -> T.OpFail T.FailMem

           | new_failn1 && not (failN1 t) && strict -> T.OpFail T.FailMem

           | otherwise ->

               let new_slist = iname:sList t

                   r = t { sList = new_slist, fDsk = new_dsk

                         , peers = new_peers, failN1 = new_failn1

                         , rMem = new_rmem, pDsk = new_dp

                         , pRem = new_prem, utilLoad = new_load }

               in T.OpGood r

-- * Stats functions

-- | Computes the amount of available disk on a given node

availDisk :: Node -> Int

availDisk t =

    let _f = fDsk t

        _l = loDsk t

    in if _f < _l

       then 0

       else _f - _l

-- | Computes the amount of available memory on a given node

availMem :: Node -> Int

availMem t =

    let _f = fMem t

        _l = rMem t

    in if _f < _l

       then 0

       else _f - _l

-- | Computes the amount of available memory on a given node

availCpu :: Node -> Int

availCpu t =

    let _u = uCpu t

        _l = hiCpu t

    in if _l >= _u

       then _l - _u

       else 0

-- * Display functions

showField :: Node -> String -> String

showField t field =

    case field of

      "idx"  -> printf "%4d" $ idx t

      "name" -> alias t

      "fqdn" -> name t

      "status" -> if offline t then "-"

                  else if failN1 t then "*" else " "

      "tmem" -> printf "%5.0f" $ tMem t

      "nmem" -> printf "%5d" $ nMem t

      "xmem" -> printf "%5d" $ xMem t

      "fmem" -> printf "%5d" $ fMem t

      "imem" -> printf "%5d" imem

      "rmem" -> printf "%5d" $ rMem t

      "amem" -> printf "%5d" $ fMem t - rMem t

      "tdsk" -> printf "%5.0f" $ tDsk t / 1024

      "fdsk" -> printf "%5d" $ fDsk t `div` 1024

      "tcpu" -> printf "%4.0f" $ tCpu t

      "ucpu" -> printf "%4d" $ uCpu t

      "pcnt" -> printf "%3d" $ length (pList t)

      "scnt" -> printf "%3d" $ length (sList t)

      "plist" -> show $ pList t

      "slist" -> show $ sList t

      "pfmem" -> printf "%6.4f" $ pMem t

      "pfdsk" -> printf "%6.4f" $ pDsk t

      "rcpu"  -> printf "%5.2f" $ pCpu t

      "cload" -> printf "%5.3f" uC

      "mload" -> printf "%5.3f" uM

      "dload" -> printf "%5.3f" uD

      "nload" -> printf "%5.3f" uN

      "ptags" -> intercalate "," . map (\(k, v) -> printf "%s=%d" k v) .

                 Map.toList $ pTags t

      "peermap" -> show $ peers t

      _ -> T.unknownField

    where

      T.DynUtil { T.cpuWeight = uC, T.memWeight = uM,

                  T.dskWeight = uD, T.netWeight = uN } = utilLoad t

      imem = truncate (tMem t) - nMem t - xMem t - fMem t

-- | Returns the header and numeric propery of a field

showHeader :: String -> (String, Bool)

showHeader field =

    case field of

      "idx" -> ("Index", True)

      "name" -> ("Name", False)

      "fqdn" -> ("Name", False)

      "status" -> ("F", False)

      "tmem" -> ("t_mem", True)

      "nmem" -> ("n_mem", True)

      "xmem" -> ("x_mem", True)

      "fmem" -> ("f_mem", True)

      "imem" -> ("i_mem", True)

      "rmem" -> ("r_mem", True)

      "amem" -> ("a_mem", True)

      "tdsk" -> ("t_dsk", True)

      "fdsk" -> ("f_dsk", True)

      "tcpu" -> ("pcpu", True)

      "ucpu" -> ("vcpu", True)

      "pcnt" -> ("pcnt", True)

      "scnt" -> ("scnt", True)

      "plist" -> ("primaries", True)

      "slist" -> ("secondaries", True)

      "pfmem" -> ("p_fmem", True)

      "pfdsk" -> ("p_fdsk", True)

      "rcpu"  -> ("r_cpu", True)

      "cload" -> ("lCpu", True)

      "mload" -> ("lMem", True)

      "dload" -> ("lDsk", True)

      "nload" -> ("lNet", True)

      "ptags" -> ("PrimaryTags", False)

      "peermap" -> ("PeerMap", False)

      _ -> (T.unknownField, False)

-- | String converter for the node list functionality.

list :: [String] -> Node -> [String]

list fields t = map (showField t) fields

defaultFields :: [String]

defaultFields =

    [ "status", "name", "tmem", "nmem", "imem", "xmem", "fmem"

    , "rmem", "tdsk", "fdsk", "tcpu", "ucpu", "pcnt", "scnt"

    , "pfmem", "pfdsk", "rcpu"

    , "cload", "mload", "dload", "nload" ]