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

   1 {-# LANGUAGE TemplateHaskell #-}
   2
   3 {-| Some common types.
   4
   5 -}
   6
   7 {-
   8
   9 Copyright (C) 2009, 2010, 2011 Google Inc.
  10
  11 This program is free software; you can redistribute it and/or modify
  12 it under the terms of the GNU General Public License as published by
  13 the Free Software Foundation; either version 2 of the License, or
  14 (at your option) any later version.
  15
  16 This program is distributed in the hope that it will be useful, but
  17 WITHOUT ANY WARRANTY; without even the implied warranty of
  18 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  19 General Public License for more details.
  20
  21 You should have received a copy of the GNU General Public License
  22 along with this program; if not, write to the Free Software
  23 Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
  24 02110-1301, USA.
  25
  26 -}
  27
  28 module Ganeti.HTools.Types
  29     ( Idx
  30     , Ndx
  31     , Gdx
  32     , NameAssoc
  33     , Score
  34     , Weight
  35     , GroupID
  36     , AllocPolicy(..)
  37     , allocPolicyFromRaw
  38     , allocPolicyToRaw
  39     , InstanceStatus(..)
  40     , instanceStatusFromRaw
  41     , instanceStatusToRaw
  42     , RSpec(..)
  43     , DynUtil(..)
  44     , zeroUtil
  45     , baseUtil
  46     , addUtil
  47     , subUtil
  48     , defVcpuRatio
  49     , defReservedDiskRatio
  50     , unitMem
  51     , unitCpu
  52     , unitDsk
  53     , unknownField
  54     , Placement
  55     , IMove(..)
  56     , DiskTemplate(..)
  57     , diskTemplateToRaw
  58     , diskTemplateFromRaw
  59     , MoveJob
  60     , JobSet
  61     , Result(..)
  62     , isOk
  63     , isBad
  64     , eitherToResult
  65     , Element(..)
  66     , FailMode(..)
  67     , FailStats
  68     , OpResult(..)
  69     , opToResult
  70     , connTimeout
  71     , queryTimeout
  72     , EvacMode(..)
  73     ) where
  74
  75 import Control.Monad
  76 import qualified Data.Map as M
  77 import qualified Text.JSON as JSON
  78
  79 import qualified Ganeti.Constants as C
  80 import qualified Ganeti.THH as THH
  81
  82 -- | The instance index type.
  83 type Idx = Int
  84
  85 -- | The node index type.
  86 type Ndx = Int
  87
  88 -- | The group index type.
  89 type Gdx = Int
  90
  91 -- | The type used to hold name-to-idx mappings.
  92 type NameAssoc = M.Map String Int
  93
  94 -- | A separate name for the cluster score type.
  95 type Score = Double
  96
  97 -- | A separate name for a weight metric.
  98 type Weight = Double
  99
 100 -- | The Group UUID type.
 101 type GroupID = String
 102
 103 -- | The Group allocation policy type.
 104 --
 105 -- Note that the order of constructors is important as the automatic
 106 -- Ord instance will order them in the order they are defined, so when
 107 -- changing this data type be careful about the interaction with the
 108 -- desired sorting order.
 109 $(THH.declareSADT "AllocPolicy"
 110          [ ("AllocPreferred",   'C.allocPolicyPreferred)
 111          , ("AllocLastResort",  'C.allocPolicyLastResort)
 112          , ("AllocUnallocable", 'C.allocPolicyUnallocable)
 113          ])
 114 $(THH.makeJSONInstance ''AllocPolicy)
 115
 116 -- | The Instance real state type.
 117 $(THH.declareSADT "InstanceStatus"
 118          [ ("AdminDown", 'C.inststAdmindown)
 119          , ("AdminOffline", 'C.inststAdminoffline)
 120          , ("ErrorDown", 'C.inststErrordown)
 121          , ("ErrorUp", 'C.inststErrorup)
 122          , ("NodeDown", 'C.inststNodedown)
 123          , ("NodeOffline", 'C.inststNodeoffline)
 124          , ("Running", 'C.inststRunning)
 125          , ("WrongNode", 'C.inststWrongnode)
 126          ])
 127 $(THH.makeJSONInstance ''InstanceStatus)
 128
 129 -- | The resource spec type.
 130 data RSpec = RSpec
 131     { rspecCpu  :: Int  -- ^ Requested VCPUs
 132     , rspecMem  :: Int  -- ^ Requested memory
 133     , rspecDsk  :: Int  -- ^ Requested disk
 134     } deriving (Show, Read, Eq)
 135
 136 -- | The dynamic resource specs of a machine (i.e. load or load
 137 -- capacity, as opposed to size).
 138 data DynUtil = DynUtil
 139     { cpuWeight :: Weight -- ^ Standardised CPU usage
 140     , memWeight :: Weight -- ^ Standardised memory load
 141     , dskWeight :: Weight -- ^ Standardised disk I\/O usage
 142     , netWeight :: Weight -- ^ Standardised network usage
 143     } deriving (Show, Read, Eq)
 144
 145 -- | Initial empty utilisation.
 146 zeroUtil :: DynUtil
 147 zeroUtil = DynUtil { cpuWeight = 0, memWeight = 0
 148                    , dskWeight = 0, netWeight = 0 }
 149
 150 -- | Base utilisation (used when no actual utilisation data is
 151 -- supplied).
 152 baseUtil :: DynUtil
 153 baseUtil = DynUtil { cpuWeight = 1, memWeight = 1
 154                    , dskWeight = 1, netWeight = 1 }
 155
 156 -- | Sum two utilisation records.
 157 addUtil :: DynUtil -> DynUtil -> DynUtil
 158 addUtil (DynUtil a1 a2 a3 a4) (DynUtil b1 b2 b3 b4) =
 159     DynUtil (a1+b1) (a2+b2) (a3+b3) (a4+b4)
 160
 161 -- | Substracts one utilisation record from another.
 162 subUtil :: DynUtil -> DynUtil -> DynUtil
 163 subUtil (DynUtil a1 a2 a3 a4) (DynUtil b1 b2 b3 b4) =
 164     DynUtil (a1-b1) (a2-b2) (a3-b3) (a4-b4)
 165
 166 -- | The description of an instance placement. It contains the
 167 -- instance index, the new primary and secondary node, the move being
 168 -- performed and the score of the cluster after the move.
 169 type Placement = (Idx, Ndx, Ndx, IMove, Score)
 170
 171 -- | An instance move definition.
 172 data IMove = Failover                -- ^ Failover the instance (f)
 173            | ReplacePrimary Ndx      -- ^ Replace primary (f, r:np, f)
 174            | ReplaceSecondary Ndx    -- ^ Replace secondary (r:ns)
 175            | ReplaceAndFailover Ndx  -- ^ Replace secondary, failover (r:np, f)
 176            | FailoverAndReplace Ndx  -- ^ Failover, replace secondary (f, r:ns)
 177              deriving (Show, Read)
 178
 179 -- | Instance disk template type.
 180 $(THH.declareSADT "DiskTemplate"
 181      [ ("DTDiskless",   'C.dtDiskless)
 182      , ("DTFile",       'C.dtFile)
 183      , ("DTSharedFile", 'C.dtSharedFile)
 184      , ("DTPlain",      'C.dtPlain)
 185      , ("DTBlock",      'C.dtBlock)
 186      , ("DTDrbd8",      'C.dtDrbd8)
 187      ])
 188 $(THH.makeJSONInstance ''DiskTemplate)
 189
 190 -- | Formatted solution output for one move (involved nodes and
 191 -- commands.
 192 type MoveJob = ([Ndx], Idx, IMove, [String])
 193
 194 -- | Unknown field in table output.
 195 unknownField :: String
 196 unknownField = "<unknown field>"
 197
 198 -- | A list of command elements.
 199 type JobSet = [MoveJob]
 200
 201 -- | Connection timeout (when using non-file methods).
 202 connTimeout :: Int
 203 connTimeout = 15
 204
 205 -- | The default timeout for queries (when using non-file methods).
 206 queryTimeout :: Int
 207 queryTimeout = 60
 208
 209 -- | Default vcpu-to-pcpu ratio (randomly chosen value).
 210 defVcpuRatio :: Double
 211 defVcpuRatio = 64
 212
 213 -- | Default max disk usage ratio.
 214 defReservedDiskRatio :: Double
 215 defReservedDiskRatio = 0
 216
 217 -- | Base memory unit.
 218 unitMem :: Int
 219 unitMem = 64
 220
 221 -- | Base disk unit.
 222 unitDsk :: Int
 223 unitDsk = 256
 224
 225 -- | Base vcpus unit.
 226 unitCpu :: Int
 227 unitCpu = 1
 228
 229 -- | This is similar to the JSON library Result type - /very/ similar,
 230 -- but we want to use it in multiple places, so we abstract it into a
 231 -- mini-library here.
 232 --
 233 -- The failure value for this monad is simply a string.
 234 data Result a
 235     = Bad String
 236     | Ok a
 237     deriving (Show, Read, Eq)
 238
 239 instance Monad Result where
 240     (>>=) (Bad x) _ = Bad x
 241     (>>=) (Ok x) fn = fn x
 242     return = Ok
 243     fail = Bad
 244
 245 instance MonadPlus Result where
 246     mzero = Bad "zero Result when used as MonadPlus"
 247     -- for mplus, when we 'add' two Bad values, we concatenate their
 248     -- error descriptions
 249     (Bad x) `mplus` (Bad y) = Bad (x ++ "; " ++ y)
 250     (Bad _) `mplus` x = x
 251     x@(Ok _) `mplus` _ = x
 252
 253 -- | Simple checker for whether a 'Result' is OK.
 254 isOk :: Result a -> Bool
 255 isOk (Ok _) = True
 256 isOk _ = False
 257
 258 -- | Simple checker for whether a 'Result' is a failure.
 259 isBad :: Result a  -> Bool
 260 isBad = not . isOk
 261
 262 -- | Converter from Either String to 'Result'.
 263 eitherToResult :: Either String a -> Result a
 264 eitherToResult (Left s) = Bad s
 265 eitherToResult (Right v) = Ok v
 266
 267 -- | Reason for an operation's falure.
 268 data FailMode = FailMem  -- ^ Failed due to not enough RAM
 269               | FailDisk -- ^ Failed due to not enough disk
 270               | FailCPU  -- ^ Failed due to not enough CPU capacity
 271               | FailN1   -- ^ Failed due to not passing N1 checks
 272               | FailTags -- ^ Failed due to tag exclusion
 273                 deriving (Eq, Enum, Bounded, Show, Read)
 274
 275 -- | List with failure statistics.
 276 type FailStats = [(FailMode, Int)]
 277
 278 -- | Either-like data-type customized for our failure modes.
 279 --
 280 -- The failure values for this monad track the specific allocation
 281 -- failures, so this is not a general error-monad (compare with the
 282 -- 'Result' data type). One downside is that this type cannot encode a
 283 -- generic failure mode, hence 'fail' for this monad is not defined
 284 -- and will cause an exception.
 285 data OpResult a = OpFail FailMode -- ^ Failed operation
 286                 | OpGood a        -- ^ Success operation
 287                   deriving (Show, Read)
 288
 289 instance Monad OpResult where
 290     (OpGood x) >>= fn = fn x
 291     (OpFail y) >>= _ = OpFail y
 292     return = OpGood
 293
 294 -- | Conversion from 'OpResult' to 'Result'.
 295 opToResult :: OpResult a -> Result a
 296 opToResult (OpFail f) = Bad $ show f
 297 opToResult (OpGood v) = Ok v
 298
 299 -- | A generic class for items that have updateable names and indices.
 300 class Element a where
 301     -- | Returns the name of the element
 302     nameOf  :: a -> String
 303     -- | Returns all the known names of the element
 304     allNames :: a -> [String]
 305     -- | Returns the index of the element
 306     idxOf   :: a -> Int
 307     -- | Updates the alias of the element
 308     setAlias :: a -> String -> a
 309     -- | Compute the alias by stripping a given suffix (domain) from
 310     -- the name
 311     computeAlias :: String -> a -> a
 312     computeAlias dom e = setAlias e alias
 313         where alias = take (length name - length dom) name
 314               name = nameOf e
 315     -- | Updates the index of the element
 316     setIdx  :: a -> Int -> a
 317
 318 -- | The iallocator node-evacuate evac_mode type.
 319 $(THH.declareSADT "EvacMode"
 320      [ ("ChangePrimary",   'C.iallocatorNevacPri)
 321      , ("ChangeSecondary", 'C.iallocatorNevacSec)
 322      , ("ChangeAll",       'C.iallocatorNevacAll)
 323      ])
 324 $(THH.makeJSONInstance ''EvacMode)