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     , DiskTemplate(..)
  52     , dtToString
  53     , dtFromString
  54     , MoveJob
  55     , JobSet
  56     , Result(..)
  57     , isOk
  58     , isBad
  59     , eitherToResult
  60     , Element(..)
  61     , FailMode(..)
  62     , FailStats
  63     , OpResult(..)
  64     , opToResult
  65     , connTimeout
  66     , queryTimeout
  67     , EvacMode(..)
  68     ) where
  69
  70 import qualified Data.Map as M
  71 import qualified Text.JSON as JSON
  72
  73 import qualified Ganeti.Constants as C
  74
  75 -- | The instance index type.
  76 type Idx = Int
  77
  78 -- | The node index type.
  79 type Ndx = Int
  80
  81 -- | The group index type.
  82 type Gdx = Int
  83
  84 -- | The type used to hold name-to-idx mappings.
  85 type NameAssoc = M.Map String Int
  86
  87 -- | A separate name for the cluster score type.
  88 type Score = Double
  89
  90 -- | A separate name for a weight metric.
  91 type Weight = Double
  92
  93 -- | The Group UUID type.
  94 type GroupID = String
  95
  96 -- | The Group allocation policy type.
  97 --
  98 -- Note that the order of constructors is important as the automatic
  99 -- Ord instance will order them in the order they are defined, so when
 100 -- changing this data type be careful about the interaction with the
 101 -- desired sorting order.
 102 data AllocPolicy
 103     = AllocPreferred   -- ^ This is the normal status, the group
 104                        -- should be used normally during allocations
 105     | AllocLastResort  -- ^ This group should be used only as
 106                        -- last-resort, after the preferred groups
 107     | AllocUnallocable -- ^ This group must not be used for new
 108                        -- allocations
 109       deriving (Show, Read, Eq, Ord, Enum, Bounded)
 110
 111 -- | Convert a string to an alloc policy.
 112 apolFromString :: (Monad m) => String -> m AllocPolicy
 113 apolFromString s =
 114     case () of
 115       _ | s == C.allocPolicyPreferred -> return AllocPreferred
 116         | s == C.allocPolicyLastResort -> return AllocLastResort
 117         | s == C.allocPolicyUnallocable -> return AllocUnallocable
 118         | otherwise -> fail $ "Invalid alloc policy mode: " ++ s
 119
 120 -- | Convert an alloc policy to the Ganeti string equivalent.
 121 apolToString :: AllocPolicy -> String
 122 apolToString AllocPreferred   = C.allocPolicyPreferred
 123 apolToString AllocLastResort  = C.allocPolicyLastResort
 124 apolToString AllocUnallocable = C.allocPolicyUnallocable
 125
 126 instance JSON.JSON AllocPolicy where
 127     showJSON = JSON.showJSON . apolToString
 128     readJSON s = case JSON.readJSON s of
 129                    JSON.Ok s' -> apolFromString s'
 130                    JSON.Error e -> JSON.Error $
 131                                    "Can't parse alloc_policy: " ++ e
 132
 133 -- | The resource spec type.
 134 data RSpec = RSpec
 135     { rspecCpu  :: Int  -- ^ Requested VCPUs
 136     , rspecMem  :: Int  -- ^ Requested memory
 137     , rspecDsk  :: Int  -- ^ Requested disk
 138     } deriving (Show, Read, Eq)
 139
 140 -- | The dynamic resource specs of a machine (i.e. load or load
 141 -- capacity, as opposed to size).
 142 data DynUtil = DynUtil
 143     { cpuWeight :: Weight -- ^ Standardised CPU usage
 144     , memWeight :: Weight -- ^ Standardised memory load
 145     , dskWeight :: Weight -- ^ Standardised disk I\/O usage
 146     , netWeight :: Weight -- ^ Standardised network usage
 147     } deriving (Show, Read, Eq)
 148
 149 -- | Initial empty utilisation.
 150 zeroUtil :: DynUtil
 151 zeroUtil = DynUtil { cpuWeight = 0, memWeight = 0
 152                    , dskWeight = 0, netWeight = 0 }
 153
 154 -- | Base utilisation (used when no actual utilisation data is
 155 -- supplied).
 156 baseUtil :: DynUtil
 157 baseUtil = DynUtil { cpuWeight = 1, memWeight = 1
 158                    , dskWeight = 1, netWeight = 1 }
 159
 160 -- | Sum two utilisation records.
 161 addUtil :: DynUtil -> DynUtil -> DynUtil
 162 addUtil (DynUtil a1 a2 a3 a4) (DynUtil b1 b2 b3 b4) =
 163     DynUtil (a1+b1) (a2+b2) (a3+b3) (a4+b4)
 164
 165 -- | Substracts one utilisation record from another.
 166 subUtil :: DynUtil -> DynUtil -> DynUtil
 167 subUtil (DynUtil a1 a2 a3 a4) (DynUtil b1 b2 b3 b4) =
 168     DynUtil (a1-b1) (a2-b2) (a3-b3) (a4-b4)
 169
 170 -- | The description of an instance placement. It contains the
 171 -- instance index, the new primary and secondary node, the move being
 172 -- performed and the score of the cluster after the move.
 173 type Placement = (Idx, Ndx, Ndx, IMove, Score)
 174
 175 -- | An instance move definition.
 176 data IMove = Failover                -- ^ Failover the instance (f)
 177            | ReplacePrimary Ndx      -- ^ Replace primary (f, r:np, f)
 178            | ReplaceSecondary Ndx    -- ^ Replace secondary (r:ns)
 179            | ReplaceAndFailover Ndx  -- ^ Replace secondary, failover (r:np, f)
 180            | FailoverAndReplace Ndx  -- ^ Failover, replace secondary (f, r:ns)
 181              deriving (Show, Read)
 182
 183 -- | Instance disk template type
 184 data DiskTemplate = DTDiskless
 185                   | DTFile
 186                   | DTSharedFile
 187                   | DTPlain
 188                   | DTBlock
 189                   | DTDrbd8
 190                     deriving (Show, Read, Eq, Enum, Bounded)
 191
 192 -- | Converts a DiskTemplate to String
 193 dtToString :: DiskTemplate -> String
 194 dtToString DTDiskless   = C.dtDiskless
 195 dtToString DTFile       = C.dtFile
 196 dtToString DTSharedFile = C.dtSharedFile
 197 dtToString DTPlain      = C.dtPlain
 198 dtToString DTBlock      = C.dtBlock
 199 dtToString DTDrbd8      = C.dtDrbd8
 200
 201 -- | Converts a DiskTemplate from String
 202 dtFromString :: (Monad m) => String -> m DiskTemplate
 203 dtFromString s =
 204     case () of
 205       _ | s == C.dtDiskless   -> return DTDiskless
 206         | s == C.dtFile       -> return DTFile
 207         | s == C.dtSharedFile -> return DTSharedFile
 208         | s == C.dtPlain      -> return DTPlain
 209         | s == C.dtBlock      -> return DTBlock
 210         | s == C.dtDrbd8      -> return DTDrbd8
 211         | otherwise           -> fail $ "Invalid disk template: " ++ s
 212
 213 instance JSON.JSON DiskTemplate where
 214     showJSON = JSON.showJSON . dtToString
 215     readJSON s = case JSON.readJSON s of
 216                    JSON.Ok s' -> dtFromString s'
 217                    JSON.Error e -> JSON.Error $
 218                                    "Can't parse disk_template as string: " ++ e
 219
 220 -- | Formatted solution output for one move (involved nodes and
 221 -- commands.
 222 type MoveJob = ([Ndx], Idx, IMove, [String])
 223
 224 -- | Unknown field in table output.
 225 unknownField :: String
 226 unknownField = "<unknown field>"
 227
 228 -- | A list of command elements.
 229 type JobSet = [MoveJob]
 230
 231 -- | Connection timeout (when using non-file methods).
 232 connTimeout :: Int
 233 connTimeout = 15
 234
 235 -- | The default timeout for queries (when using non-file methods).
 236 queryTimeout :: Int
 237 queryTimeout = 60
 238
 239 -- | Default vcpu-to-pcpu ratio (randomly chosen value).
 240 defVcpuRatio :: Double
 241 defVcpuRatio = 64
 242
 243 -- | Default max disk usage ratio.
 244 defReservedDiskRatio :: Double
 245 defReservedDiskRatio = 0
 246
 247 -- | Base memory unit.
 248 unitMem :: Int
 249 unitMem = 64
 250
 251 -- | Base disk unit.
 252 unitDsk :: Int
 253 unitDsk = 256
 254
 255 -- | Base vcpus unit.
 256 unitCpu :: Int
 257 unitCpu = 1
 258
 259 -- | This is similar to the JSON library Result type - /very/ similar,
 260 -- but we want to use it in multiple places, so we abstract it into a
 261 -- mini-library here.
 262 --
 263 -- The failure value for this monad is simply a string.
 264 data Result a
 265     = Bad String
 266     | Ok a
 267     deriving (Show, Read, Eq)
 268
 269 instance Monad Result where
 270     (>>=) (Bad x) _ = Bad x
 271     (>>=) (Ok x) fn = fn x
 272     return = Ok
 273     fail = Bad
 274
 275 -- | Simple checker for whether a 'Result' is OK.
 276 isOk :: Result a -> Bool
 277 isOk (Ok _) = True
 278 isOk _ = False
 279
 280 -- | Simple checker for whether a 'Result' is a failure.
 281 isBad :: Result a  -> Bool
 282 isBad = not . isOk
 283
 284 -- | Converter from Either String to 'Result'
 285 eitherToResult :: Either String a -> Result a
 286 eitherToResult (Left s) = Bad s
 287 eitherToResult (Right v) = Ok v
 288
 289 -- | Reason for an operation's falure.
 290 data FailMode = FailMem  -- ^ Failed due to not enough RAM
 291               | FailDisk -- ^ Failed due to not enough disk
 292               | FailCPU  -- ^ Failed due to not enough CPU capacity
 293               | FailN1   -- ^ Failed due to not passing N1 checks
 294               | FailTags -- ^ Failed due to tag exclusion
 295                 deriving (Eq, Enum, Bounded, Show, Read)
 296
 297 -- | List with failure statistics.
 298 type FailStats = [(FailMode, Int)]
 299
 300 -- | Either-like data-type customized for our failure modes.
 301 --
 302 -- The failure values for this monad track the specific allocation
 303 -- failures, so this is not a general error-monad (compare with the
 304 -- 'Result' data type). One downside is that this type cannot encode a
 305 -- generic failure mode, hence 'fail' for this monad is not defined
 306 -- and will cause an exception.
 307 data OpResult a = OpFail FailMode -- ^ Failed operation
 308                 | OpGood a        -- ^ Success operation
 309                   deriving (Show, Read)
 310
 311 instance Monad OpResult where
 312     (OpGood x) >>= fn = fn x
 313     (OpFail y) >>= _ = OpFail y
 314     return = OpGood
 315
 316 -- | Conversion from 'OpResult' to 'Result'.
 317 opToResult :: OpResult a -> Result a
 318 opToResult (OpFail f) = Bad $ show f
 319 opToResult (OpGood v) = Ok v
 320
 321 -- | A generic class for items that have updateable names and indices.
 322 class Element a where
 323     -- | Returns the name of the element
 324     nameOf  :: a -> String
 325     -- | Returns all the known names of the element
 326     allNames :: a -> [String]
 327     -- | Returns the index of the element
 328     idxOf   :: a -> Int
 329     -- | Updates the alias of the element
 330     setAlias :: a -> String -> a
 331     -- | Compute the alias by stripping a given suffix (domain) from
 332     -- the name
 333     computeAlias :: String -> a -> a
 334     computeAlias dom e = setAlias e alias
 335         where alias = take (length name - length dom) name
 336               name = nameOf e
 337     -- | Updates the index of the element
 338     setIdx  :: a -> Int -> a
 339
 340 -- | The iallocator node-evacuate evac_mode type.
 341 data EvacMode = ChangePrimary
 342               | ChangeSecondary
 343               | ChangeAll
 344                 deriving (Show, Read)