code.grnet.gr Git - ganeti-local/blob - htools/Ganeti/HTools/Types.hs

   1 {-| Some common types.
   2
   3 -}
   4
   5 {-
   6
   7 Copyright (C) 2009, 2010, 2011 Google Inc.
   8
   9 This program is free software; you can redistribute it and/or modify
  10 it under the terms of the GNU General Public License as published by
  11 the Free Software Foundation; either version 2 of the License, or
  12 (at your option) any later version.
  13
  14 This program is distributed in the hope that it will be useful, but
  15 WITHOUT ANY WARRANTY; without even the implied warranty of
  16 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  17 General Public License for more details.
  18
  19 You should have received a copy of the GNU General Public License
  20 along with this program; if not, write to the Free Software
  21 Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
  22 02110-1301, USA.
  23
  24 -}
  25
  26 module Ganeti.HTools.Types
  27     ( Idx
  28     , Ndx
  29     , Gdx
  30     , NameAssoc
  31     , Score
  32     , Weight
  33     , GroupID
  34     , AllocPolicy(..)
  35     , apolFromString
  36     , apolToString
  37     , RSpec(..)
  38     , DynUtil(..)
  39     , zeroUtil
  40     , baseUtil
  41     , addUtil
  42     , subUtil
  43     , defVcpuRatio
  44     , defReservedDiskRatio
  45     , unitMem
  46     , unitCpu
  47     , unitDsk
  48     , unknownField
  49     , Placement
  50     , IMove(..)
  51     , MoveJob
  52     , JobSet
  53     , Result(..)
  54     , isOk
  55     , isBad
  56     , Element(..)
  57     , FailMode(..)
  58     , FailStats
  59     , OpResult(..)
  60     , connTimeout
  61     , queryTimeout
  62     ) where
  63
  64 import qualified Data.Map as M
  65 import qualified Text.JSON as JSON
  66
  67 import qualified Ganeti.Constants as C
  68
  69 -- | The instance index type.
  70 type Idx = Int
  71
  72 -- | The node index type.
  73 type Ndx = Int
  74
  75 -- | The group index type.
  76 type Gdx = Int
  77
  78 -- | The type used to hold name-to-idx mappings.
  79 type NameAssoc = M.Map String Int
  80
  81 -- | A separate name for the cluster score type.
  82 type Score = Double
  83
  84 -- | A separate name for a weight metric.
  85 type Weight = Double
  86
  87 -- | The Group UUID type.
  88 type GroupID = String
  89
  90 -- | The Group allocation policy type.
  91 --
  92 -- Note that the order of constructors is important as the automatic
  93 -- Ord instance will order them in the order they are defined, so when
  94 -- changing this data type be careful about the interaction with the
  95 -- desired sorting order.
  96 data AllocPolicy
  97     = AllocPreferred   -- ^ This is the normal status, the group
  98                        -- should be used normally during allocations
  99     | AllocLastResort  -- ^ This group should be used only as
 100                        -- last-resort, after the preferred groups
 101     | AllocUnallocable -- ^ This group must not be used for new
 102                        -- allocations
 103       deriving (Show, Read, Eq, Ord)
 104
 105 -- | Convert a string to an alloc policy
 106 apolFromString :: (Monad m) => String -> m AllocPolicy
 107 apolFromString s =
 108     case () of
 109       _ | s == C.allocPolicyPreferred -> return AllocPreferred
 110         | s == C.allocPolicyLastResort -> return AllocLastResort
 111         | s == C.allocPolicyUnallocable -> return AllocUnallocable
 112         | otherwise -> fail $ "Invalid alloc policy mode: " ++ s
 113
 114 -- | Convert an alloc policy to the Ganeti string equivalent
 115 apolToString :: AllocPolicy -> String
 116 apolToString AllocPreferred   = C.allocPolicyPreferred
 117 apolToString AllocLastResort  = C.allocPolicyLastResort
 118 apolToString AllocUnallocable = C.allocPolicyUnallocable
 119
 120 instance JSON.JSON AllocPolicy where
 121     showJSON = JSON.showJSON . apolToString
 122     readJSON s = case JSON.readJSON s of
 123                    JSON.Ok s' -> apolFromString s'
 124                    JSON.Error e -> JSON.Error $
 125                                    "Can't parse alloc_policy: " ++ e
 126
 127 -- | The resource spec type.
 128 data RSpec = RSpec
 129     { rspecCpu  :: Int  -- ^ Requested VCPUs
 130     , rspecMem  :: Int  -- ^ Requested memory
 131     , rspecDsk  :: Int  -- ^ Requested disk
 132     } deriving (Show, Read, Eq)
 133
 134 -- | The dynamic resource specs of a machine (i.e. load or load
 135 -- capacity, as opposed to size).
 136 data DynUtil = DynUtil
 137     { cpuWeight :: Weight -- ^ Standardised CPU usage
 138     , memWeight :: Weight -- ^ Standardised memory load
 139     , dskWeight :: Weight -- ^ Standardised disk I\/O usage
 140     , netWeight :: Weight -- ^ Standardised network usage
 141     } deriving (Show, Read, Eq)
 142
 143 -- | Initial empty utilisation
 144 zeroUtil :: DynUtil
 145 zeroUtil = DynUtil { cpuWeight = 0, memWeight = 0
 146                    , dskWeight = 0, netWeight = 0 }
 147
 148 baseUtil :: DynUtil
 149 baseUtil = DynUtil { cpuWeight = 1, memWeight = 1
 150                    , dskWeight = 1, netWeight = 1 }
 151
 152 addUtil :: DynUtil -> DynUtil -> DynUtil
 153 addUtil (DynUtil a1 a2 a3 a4) (DynUtil b1 b2 b3 b4) =
 154     DynUtil (a1+b1) (a2+b2) (a3+b3) (a4+b4)
 155
 156 subUtil :: DynUtil -> DynUtil -> DynUtil
 157 subUtil (DynUtil a1 a2 a3 a4) (DynUtil b1 b2 b3 b4) =
 158     DynUtil (a1-b1) (a2-b2) (a3-b3) (a4-b4)
 159
 160 -- | The description of an instance placement. It contains the
 161 -- instance index, the new primary and secondary node, the move being
 162 -- performed and the score of the cluster after the move.
 163 type Placement = (Idx, Ndx, Ndx, IMove, Score)
 164
 165 -- | An instance move definition
 166 data IMove = Failover                -- ^ Failover the instance (f)
 167            | ReplacePrimary Ndx      -- ^ Replace primary (f, r:np, f)
 168            | ReplaceSecondary Ndx    -- ^ Replace secondary (r:ns)
 169            | ReplaceAndFailover Ndx  -- ^ Replace secondary, failover (r:np, f)
 170            | FailoverAndReplace Ndx  -- ^ Failover, replace secondary (f, r:ns)
 171              deriving (Show, Read)
 172
 173 -- | Formatted solution output for one move (involved nodes and
 174 -- commands
 175 type MoveJob = ([Ndx], Idx, IMove, [String])
 176
 177 -- | Unknown field in table output
 178 unknownField :: String
 179 unknownField = "<unknown field>"
 180
 181 -- | A list of command elements
 182 type JobSet = [MoveJob]
 183
 184 -- | Connection timeout (when using non-file methods).
 185 connTimeout :: Int
 186 connTimeout = 15
 187
 188 -- | The default timeout for queries (when using non-file methods).
 189 queryTimeout :: Int
 190 queryTimeout = 60
 191
 192 -- | Default vcpu-to-pcpu ratio (randomly chosen value).
 193 defVcpuRatio :: Double
 194 defVcpuRatio = 64
 195
 196 -- | Default max disk usage ratio.
 197 defReservedDiskRatio :: Double
 198 defReservedDiskRatio = 0
 199
 200 -- | Base memory unit.
 201 unitMem :: Int
 202 unitMem = 64
 203
 204 -- | Base disk unit.
 205 unitDsk :: Int
 206 unitDsk = 256
 207
 208 -- | Base vcpus unit.
 209 unitCpu :: Int
 210 unitCpu = 1
 211
 212 {-|
 213
 214 This is similar to the JSON library Result type - *very* similar, but
 215 we want to use it in multiple places, so we abstract it into a
 216 mini-library here
 217
 218 -}
 219 data Result a
 220     = Bad String
 221     | Ok a
 222     deriving (Show, Read)
 223
 224 instance Monad Result where
 225     (>>=) (Bad x) _ = Bad x
 226     (>>=) (Ok x) fn = fn x
 227     return = Ok
 228     fail = Bad
 229
 230 -- | Simple checker for whether Result is OK
 231 isOk :: Result a -> Bool
 232 isOk (Ok _) = True
 233 isOk _ = False
 234
 235 -- | Simple checker for whether Result is a failure
 236 isBad :: Result a  -> Bool
 237 isBad = not . isOk
 238
 239 -- | Reason for an operation's falure
 240 data FailMode = FailMem  -- ^ Failed due to not enough RAM
 241               | FailDisk -- ^ Failed due to not enough disk
 242               | FailCPU  -- ^ Failed due to not enough CPU capacity
 243               | FailN1   -- ^ Failed due to not passing N1 checks
 244               | FailTags -- ^ Failed due to tag exclusion
 245                 deriving (Eq, Enum, Bounded, Show, Read)
 246
 247 -- | List with failure statistics
 248 type FailStats = [(FailMode, Int)]
 249
 250 -- | Either-like data-type customized for our failure modes
 251 data OpResult a = OpFail FailMode -- ^ Failed operation
 252                 | OpGood a        -- ^ Success operation
 253                   deriving (Show, Read)
 254
 255 instance Monad OpResult where
 256     (OpGood x) >>= fn = fn x
 257     (OpFail y) >>= _ = OpFail y
 258     return = OpGood
 259
 260 -- | A generic class for items that have updateable names and indices.
 261 class Element a where
 262     -- | Returns the name of the element
 263     nameOf  :: a -> String
 264     -- | Returns all the known names of the element
 265     allNames :: a -> [String]
 266     -- | Returns the index of the element
 267     idxOf   :: a -> Int
 268     -- | Updates the alias of the element
 269     setAlias :: a -> String -> a
 270     -- | Compute the alias by stripping a given suffix (domain) from
 271     -- | the name
 272     computeAlias :: String -> a -> a
 273     computeAlias dom e = setAlias e alias
 274         where alias = take (length name - length dom) name
 275               name = nameOf e
 276     -- | Updates the index of the element
 277     setIdx  :: a -> Int -> a