Synnefo » snf-ganeti

{-| Some common types.

-}

{-

Copyright (C) 2009, 2010, 2011 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.Types

    ( Idx

    , Ndx

    , Gdx

    , NameAssoc

    , Score

    , Weight

    , GroupID

    , AllocPolicy(..)

    , apolFromString

    , apolToString

    , RSpec(..)

    , DynUtil(..)

    , zeroUtil

    , baseUtil

    , addUtil

    , subUtil

    , defVcpuRatio

    , defReservedDiskRatio

    , unitMem

    , unitCpu

    , unitDsk

    , unknownField

    , Placement

    , IMove(..)

    , DiskTemplate(..)

    , dtToString

    , dtFromString

    , MoveJob

    , JobSet

    , Result(..)

    , isOk

    , isBad

    , eitherToResult

    , Element(..)

    , FailMode(..)

    , FailStats

    , OpResult(..)

    , opToResult

    , connTimeout

    , queryTimeout

    , EvacMode(..)

    ) where

import Control.Monad

import qualified Data.Map as M

import qualified Text.JSON as JSON

import qualified Ganeti.Constants as C

-- | The instance index type.

type Idx = Int

-- | The node index type.

type Ndx = Int

-- | The group index type.

type Gdx = Int

-- | The type used to hold name-to-idx mappings.

type NameAssoc = M.Map String Int

-- | A separate name for the cluster score type.

type Score = Double

-- | A separate name for a weight metric.

type Weight = Double

-- | The Group UUID type.

type GroupID = String

-- | The Group allocation policy type.

--

-- Note that the order of constructors is important as the automatic

-- Ord instance will order them in the order they are defined, so when

-- changing this data type be careful about the interaction with the

-- desired sorting order.

data AllocPolicy

    = AllocPreferred   -- ^ This is the normal status, the group

                       -- should be used normally during allocations

    | AllocLastResort  -- ^ This group should be used only as

                       -- last-resort, after the preferred groups

    | AllocUnallocable -- ^ This group must not be used for new

                       -- allocations

      deriving (Show, Read, Eq, Ord, Enum, Bounded)

-- | Convert a string to an alloc policy.

apolFromString :: (Monad m) => String -> m AllocPolicy

apolFromString s =

    case () of

      _ | s == C.allocPolicyPreferred -> return AllocPreferred

        | s == C.allocPolicyLastResort -> return AllocLastResort

        | s == C.allocPolicyUnallocable -> return AllocUnallocable

        | otherwise -> fail $ "Invalid alloc policy mode: " ++ s

-- | Convert an alloc policy to the Ganeti string equivalent.

apolToString :: AllocPolicy -> String

apolToString AllocPreferred   = C.allocPolicyPreferred

apolToString AllocLastResort  = C.allocPolicyLastResort

apolToString AllocUnallocable = C.allocPolicyUnallocable

instance JSON.JSON AllocPolicy where

    showJSON = JSON.showJSON . apolToString

    readJSON s = case JSON.readJSON s of

                   JSON.Ok s' -> apolFromString s'

                   JSON.Error e -> JSON.Error $

                                   "Can't parse alloc_policy: " ++ e

-- | The resource spec type.

data RSpec = RSpec

    { rspecCpu  :: Int  -- ^ Requested VCPUs

    , rspecMem  :: Int  -- ^ Requested memory

    , rspecDsk  :: Int  -- ^ Requested disk

    } deriving (Show, Read, Eq)

-- | The dynamic resource specs of a machine (i.e. load or load

-- capacity, as opposed to size).

data DynUtil = DynUtil

    { cpuWeight :: Weight -- ^ Standardised CPU usage

    , memWeight :: Weight -- ^ Standardised memory load

    , dskWeight :: Weight -- ^ Standardised disk I\/O usage

    , netWeight :: Weight -- ^ Standardised network usage

    } deriving (Show, Read, Eq)

-- | Initial empty utilisation.

zeroUtil :: DynUtil

zeroUtil = DynUtil { cpuWeight = 0, memWeight = 0

                   , dskWeight = 0, netWeight = 0 }

-- | Base utilisation (used when no actual utilisation data is

-- supplied).

baseUtil :: DynUtil

baseUtil = DynUtil { cpuWeight = 1, memWeight = 1

                   , dskWeight = 1, netWeight = 1 }

-- | Sum two utilisation records.

addUtil :: DynUtil -> DynUtil -> DynUtil

addUtil (DynUtil a1 a2 a3 a4) (DynUtil b1 b2 b3 b4) =

    DynUtil (a1+b1) (a2+b2) (a3+b3) (a4+b4)

-- | Substracts one utilisation record from another.

subUtil :: DynUtil -> DynUtil -> DynUtil

subUtil (DynUtil a1 a2 a3 a4) (DynUtil b1 b2 b3 b4) =

    DynUtil (a1-b1) (a2-b2) (a3-b3) (a4-b4)

-- | The description of an instance placement. It contains the

-- instance index, the new primary and secondary node, the move being

-- performed and the score of the cluster after the move.

type Placement = (Idx, Ndx, Ndx, IMove, Score)

-- | An instance move definition.

data IMove = Failover                -- ^ Failover the instance (f)

           | ReplacePrimary Ndx      -- ^ Replace primary (f, r:np, f)

           | ReplaceSecondary Ndx    -- ^ Replace secondary (r:ns)

           | ReplaceAndFailover Ndx  -- ^ Replace secondary, failover (r:np, f)

           | FailoverAndReplace Ndx  -- ^ Failover, replace secondary (f, r:ns)

             deriving (Show, Read)

-- | Instance disk template type.

data DiskTemplate = DTDiskless

                  | DTFile

                  | DTSharedFile

                  | DTPlain

                  | DTBlock

                  | DTDrbd8

                    deriving (Show, Read, Eq, Enum, Bounded)

-- | Converts a DiskTemplate to String.

dtToString :: DiskTemplate -> String

dtToString DTDiskless   = C.dtDiskless

dtToString DTFile       = C.dtFile

dtToString DTSharedFile = C.dtSharedFile

dtToString DTPlain      = C.dtPlain

dtToString DTBlock      = C.dtBlock

dtToString DTDrbd8      = C.dtDrbd8

-- | Converts a DiskTemplate from String.

dtFromString :: (Monad m) => String -> m DiskTemplate

dtFromString s =

    case () of

      _ | s == C.dtDiskless   -> return DTDiskless

        | s == C.dtFile       -> return DTFile

        | s == C.dtSharedFile -> return DTSharedFile

        | s == C.dtPlain      -> return DTPlain

        | s == C.dtBlock      -> return DTBlock

        | s == C.dtDrbd8      -> return DTDrbd8

        | otherwise           -> fail $ "Invalid disk template: " ++ s

instance JSON.JSON DiskTemplate where

    showJSON = JSON.showJSON . dtToString

    readJSON s = case JSON.readJSON s of

                   JSON.Ok s' -> dtFromString s'

                   JSON.Error e -> JSON.Error $

                                   "Can't parse disk_template as string: " ++ e

-- | Formatted solution output for one move (involved nodes and

-- commands.

type MoveJob = ([Ndx], Idx, IMove, [String])

-- | Unknown field in table output.

unknownField :: String

unknownField = "<unknown field>"

-- | A list of command elements.

type JobSet = [MoveJob]

-- | Connection timeout (when using non-file methods).

connTimeout :: Int

connTimeout = 15

-- | The default timeout for queries (when using non-file methods).

queryTimeout :: Int

queryTimeout = 60

-- | Default vcpu-to-pcpu ratio (randomly chosen value).

defVcpuRatio :: Double

defVcpuRatio = 64

-- | Default max disk usage ratio.

defReservedDiskRatio :: Double

defReservedDiskRatio = 0

-- | Base memory unit.

unitMem :: Int

unitMem = 64

-- | Base disk unit.

unitDsk :: Int

unitDsk = 256

-- | Base vcpus unit.

unitCpu :: Int

unitCpu = 1

-- | This is similar to the JSON library Result type - /very/ similar,

-- but we want to use it in multiple places, so we abstract it into a

-- mini-library here.

--

-- The failure value for this monad is simply a string.

data Result a

    = Bad String

    | Ok a

    deriving (Show, Read, Eq)

instance Monad Result where

    (>>=) (Bad x) _ = Bad x

    (>>=) (Ok x) fn = fn x

    return = Ok

    fail = Bad

instance MonadPlus Result where

    mzero = Bad "zero Result when used as MonadPlus"

    -- for mplus, when we 'add' two Bad values, we concatenate their

    -- error descriptions

    (Bad x) `mplus` (Bad y) = Bad (x ++ "; " ++ y)

    (Bad _) `mplus` x = x

    x@(Ok _) `mplus` _ = x

-- | Simple checker for whether a 'Result' is OK.

isOk :: Result a -> Bool

isOk (Ok _) = True

isOk _ = False

-- | Simple checker for whether a 'Result' is a failure.

isBad :: Result a  -> Bool

isBad = not . isOk

-- | Converter from Either String to 'Result'.

eitherToResult :: Either String a -> Result a

eitherToResult (Left s) = Bad s

eitherToResult (Right v) = Ok v

-- | Reason for an operation's falure.

data FailMode = FailMem  -- ^ Failed due to not enough RAM

              | FailDisk -- ^ Failed due to not enough disk

              | FailCPU  -- ^ Failed due to not enough CPU capacity

              | FailN1   -- ^ Failed due to not passing N1 checks

              | FailTags -- ^ Failed due to tag exclusion

                deriving (Eq, Enum, Bounded, Show, Read)

-- | List with failure statistics.

type FailStats = [(FailMode, Int)]

-- | Either-like data-type customized for our failure modes.

--

-- The failure values for this monad track the specific allocation

-- failures, so this is not a general error-monad (compare with the

-- 'Result' data type). One downside is that this type cannot encode a

-- generic failure mode, hence 'fail' for this monad is not defined

-- and will cause an exception.

data OpResult a = OpFail FailMode -- ^ Failed operation

                | OpGood a        -- ^ Success operation

                  deriving (Show, Read)

instance Monad OpResult where

    (OpGood x) >>= fn = fn x

    (OpFail y) >>= _ = OpFail y

    return = OpGood

-- | Conversion from 'OpResult' to 'Result'.

opToResult :: OpResult a -> Result a

opToResult (OpFail f) = Bad $ show f

opToResult (OpGood v) = Ok v

-- | A generic class for items that have updateable names and indices.

class Element a where

    -- | Returns the name of the element

    nameOf  :: a -> String

    -- | Returns all the known names of the element

    allNames :: a -> [String]

    -- | Returns the index of the element

    idxOf   :: a -> Int

    -- | Updates the alias of the element

    setAlias :: a -> String -> a

    -- | Compute the alias by stripping a given suffix (domain) from

    -- the name

    computeAlias :: String -> a -> a

    computeAlias dom e = setAlias e alias

        where alias = take (length name - length dom) name

              name = nameOf e

    -- | Updates the index of the element

    setIdx  :: a -> Int -> a

-- | The iallocator node-evacuate evac_mode type.

data EvacMode = ChangePrimary

              | ChangeSecondary

              | ChangeAll

                deriving (Show, Read)

instance JSON.JSON EvacMode where

    showJSON mode = case mode of

                      ChangeAll       -> JSON.showJSON C.iallocatorNevacAll

                      ChangePrimary   -> JSON.showJSON C.iallocatorNevacPri

                      ChangeSecondary -> JSON.showJSON C.iallocatorNevacSec

    readJSON v =

        case JSON.readJSON v of

          JSON.Ok s | s == C.iallocatorNevacAll -> return ChangeAll

                    | s == C.iallocatorNevacPri -> return ChangePrimary

                    | s == C.iallocatorNevacSec -> return ChangeSecondary

                    | otherwise -> fail $ "Invalid evacuate mode " ++ s

          JSON.Error e -> JSON.Error $

                          "Can't parse evacuate mode as string: " ++ e