Revision ebf38064 htools/Ganeti/HTools/Types.hs
| b/htools/Ganeti/HTools/Types.hs | ||
|---|---|---|
| 26 | 26 |
-} |
| 27 | 27 |
|
| 28 | 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
|
|
| 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 | 74 |
|
| 75 | 75 |
import Control.Monad |
| 76 | 76 |
import qualified Data.Map as M |
| ... | ... | |
| 107 | 107 |
-- changing this data type be careful about the interaction with the |
| 108 | 108 |
-- desired sorting order. |
| 109 | 109 |
$(THH.declareSADT "AllocPolicy" |
| 110 |
[ ("AllocPreferred", 'C.allocPolicyPreferred)
|
|
| 111 |
, ("AllocLastResort", 'C.allocPolicyLastResort)
|
|
| 112 |
, ("AllocUnallocable", 'C.allocPolicyUnallocable)
|
|
| 113 |
])
|
|
| 110 |
[ ("AllocPreferred", 'C.allocPolicyPreferred)
|
|
| 111 |
, ("AllocLastResort", 'C.allocPolicyLastResort)
|
|
| 112 |
, ("AllocUnallocable", 'C.allocPolicyUnallocable)
|
|
| 113 |
]) |
|
| 114 | 114 |
$(THH.makeJSONInstance ''AllocPolicy) |
| 115 | 115 |
|
| 116 | 116 |
-- | The Instance real state type. |
| 117 | 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 |
])
|
|
| 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 | 127 |
$(THH.makeJSONInstance ''InstanceStatus) |
| 128 | 128 |
|
| 129 | 129 |
-- | The resource spec type. |
| 130 | 130 |
data RSpec = RSpec |
| 131 |
{ rspecCpu :: Int -- ^ Requested VCPUs
|
|
| 132 |
, rspecMem :: Int -- ^ Requested memory
|
|
| 133 |
, rspecDsk :: Int -- ^ Requested disk
|
|
| 134 |
} deriving (Show, Read, Eq)
|
|
| 131 |
{ rspecCpu :: Int -- ^ Requested VCPUs
|
|
| 132 |
, rspecMem :: Int -- ^ Requested memory |
|
| 133 |
, rspecDsk :: Int -- ^ Requested disk |
|
| 134 |
} deriving (Show, Read, Eq) |
|
| 135 | 135 |
|
| 136 | 136 |
-- | The dynamic resource specs of a machine (i.e. load or load |
| 137 | 137 |
-- capacity, as opposed to size). |
| 138 | 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)
|
|
| 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 | 144 |
|
| 145 | 145 |
-- | Initial empty utilisation. |
| 146 | 146 |
zeroUtil :: DynUtil |
| ... | ... | |
| 156 | 156 |
-- | Sum two utilisation records. |
| 157 | 157 |
addUtil :: DynUtil -> DynUtil -> DynUtil |
| 158 | 158 |
addUtil (DynUtil a1 a2 a3 a4) (DynUtil b1 b2 b3 b4) = |
| 159 |
DynUtil (a1+b1) (a2+b2) (a3+b3) (a4+b4)
|
|
| 159 |
DynUtil (a1+b1) (a2+b2) (a3+b3) (a4+b4) |
|
| 160 | 160 |
|
| 161 | 161 |
-- | Substracts one utilisation record from another. |
| 162 | 162 |
subUtil :: DynUtil -> DynUtil -> DynUtil |
| 163 | 163 |
subUtil (DynUtil a1 a2 a3 a4) (DynUtil b1 b2 b3 b4) = |
| 164 |
DynUtil (a1-b1) (a2-b2) (a3-b3) (a4-b4)
|
|
| 164 |
DynUtil (a1-b1) (a2-b2) (a3-b3) (a4-b4) |
|
| 165 | 165 |
|
| 166 | 166 |
-- | The description of an instance placement. It contains the |
| 167 | 167 |
-- instance index, the new primary and secondary node, the move being |
| ... | ... | |
| 178 | 178 |
|
| 179 | 179 |
-- | Instance disk template type. |
| 180 | 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 |
]) |
|
| 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 | 188 |
$(THH.makeJSONInstance ''DiskTemplate) |
| 189 | 189 |
|
| 190 | 190 |
-- | Formatted solution output for one move (involved nodes and |
| ... | ... | |
| 237 | 237 |
deriving (Show, Read, Eq) |
| 238 | 238 |
|
| 239 | 239 |
instance Monad Result where |
| 240 |
(>>=) (Bad x) _ = Bad x
|
|
| 241 |
(>>=) (Ok x) fn = fn x
|
|
| 242 |
return = Ok
|
|
| 243 |
fail = Bad
|
|
| 240 |
(>>=) (Bad x) _ = Bad x |
|
| 241 |
(>>=) (Ok x) fn = fn x |
|
| 242 |
return = Ok |
|
| 243 |
fail = Bad |
|
| 244 | 244 |
|
| 245 | 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
|
|
| 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 | 252 |
|
| 253 | 253 |
-- | Simple checker for whether a 'Result' is OK. |
| 254 | 254 |
isOk :: Result a -> Bool |
| ... | ... | |
| 287 | 287 |
deriving (Show, Read) |
| 288 | 288 |
|
| 289 | 289 |
instance Monad OpResult where |
| 290 |
(OpGood x) >>= fn = fn x
|
|
| 291 |
(OpFail y) >>= _ = OpFail y
|
|
| 292 |
return = OpGood
|
|
| 290 |
(OpGood x) >>= fn = fn x |
|
| 291 |
(OpFail y) >>= _ = OpFail y |
|
| 292 |
return = OpGood |
|
| 293 | 293 |
|
| 294 | 294 |
-- | Conversion from 'OpResult' to 'Result'. |
| 295 | 295 |
opToResult :: OpResult a -> Result a |
| ... | ... | |
| 298 | 298 |
|
| 299 | 299 |
-- | A generic class for items that have updateable names and indices. |
| 300 | 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
|
|
| 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 | 317 |
|
| 318 | 318 |
-- | The iallocator node-evacuate evac_mode type. |
| 319 | 319 |
$(THH.declareSADT "EvacMode" |
| 320 |
[ ("ChangePrimary", 'C.iallocatorNevacPri)
|
|
| 321 |
, ("ChangeSecondary", 'C.iallocatorNevacSec)
|
|
| 322 |
, ("ChangeAll", 'C.iallocatorNevacAll)
|
|
| 323 |
]) |
|
| 320 |
[ ("ChangePrimary", 'C.iallocatorNevacPri)
|
|
| 321 |
, ("ChangeSecondary", 'C.iallocatorNevacSec)
|
|
| 322 |
, ("ChangeAll", 'C.iallocatorNevacAll)
|
|
| 323 |
])
|
|
| 324 | 324 |
$(THH.makeJSONInstance ''EvacMode) |
Also available in: Unified diff