{-
-Copyright (C) 2009, 2010, 2011 Google Inc.
+Copyright (C) 2009, 2010, 2011, 2012 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
-}
module Ganeti.HTools.Types
- ( Idx
- , Ndx
- , Gdx
- , NameAssoc
- , Score
- , Weight
- , GroupID
- , AllocPolicy(..)
- , allocPolicyFromRaw
- , allocPolicyToRaw
- , InstanceStatus(..)
- , instanceStatusFromRaw
- , instanceStatusToRaw
- , RSpec(..)
- , DynUtil(..)
- , zeroUtil
- , baseUtil
- , addUtil
- , subUtil
- , defVcpuRatio
- , defReservedDiskRatio
- , unitMem
- , unitCpu
- , unitDsk
- , unknownField
- , Placement
- , IMove(..)
- , DiskTemplate(..)
- , diskTemplateToRaw
- , diskTemplateFromRaw
- , MoveJob
- , JobSet
- , Result(..)
- , isOk
- , isBad
- , eitherToResult
- , Element(..)
- , FailMode(..)
- , FailStats
- , OpResult(..)
- , opToResult
- , connTimeout
- , queryTimeout
- , EvacMode(..)
- ) where
-
-import Control.Monad
+ ( Idx
+ , Ndx
+ , Gdx
+ , NameAssoc
+ , Score
+ , Weight
+ , GroupID
+ , defaultGroupID
+ , AllocPolicy(..)
+ , allocPolicyFromRaw
+ , allocPolicyToRaw
+ , InstanceStatus(..)
+ , instanceStatusFromRaw
+ , instanceStatusToRaw
+ , RSpec(..)
+ , AllocInfo(..)
+ , AllocStats
+ , DynUtil(..)
+ , zeroUtil
+ , baseUtil
+ , addUtil
+ , subUtil
+ , defReservedDiskRatio
+ , unitMem
+ , unitCpu
+ , unitDsk
+ , unknownField
+ , Placement
+ , IMove(..)
+ , DiskTemplate(..)
+ , diskTemplateToRaw
+ , diskTemplateFromRaw
+ , MirrorType(..)
+ , templateMirrorType
+ , MoveJob
+ , JobSet
+ , Element(..)
+ , FailMode(..)
+ , FailStats
+ , OpResult(..)
+ , opToResult
+ , EvacMode(..)
+ , ISpec(..)
+ , IPolicy(..)
+ , defIPolicy
+ , rspecFromISpec
+ ) where
+
import qualified Data.Map as M
-import qualified Text.JSON as JSON
+import Text.JSON (makeObj, readJSON, showJSON)
import qualified Ganeti.Constants as C
import qualified Ganeti.THH as THH
+import Ganeti.BasicTypes
+import Ganeti.JSON
-- | The instance index type.
type Idx = Int
-- | The Group UUID type.
type GroupID = String
+-- | Default group UUID (just a string, not a real UUID).
+defaultGroupID :: GroupID
+defaultGroupID = "00000000-0000-0000-0000-000000000000"
+
+-- | Instance disk template type.
+$(THH.declareSADT "DiskTemplate"
+ [ ("DTDiskless", 'C.dtDiskless)
+ , ("DTFile", 'C.dtFile)
+ , ("DTSharedFile", 'C.dtSharedFile)
+ , ("DTPlain", 'C.dtPlain)
+ , ("DTBlock", 'C.dtBlock)
+ , ("DTDrbd8", 'C.dtDrbd8)
+ , ("DTRbd", 'C.dtRbd)
+ ])
+$(THH.makeJSONInstance ''DiskTemplate)
+
+-- | Mirroring type.
+data MirrorType = MirrorNone -- ^ No mirroring/movability
+ | MirrorInternal -- ^ DRBD-type mirroring
+ | MirrorExternal -- ^ Shared-storage type mirroring
+ deriving (Eq, Show, Read)
+
+-- | Correspondence between disk template and mirror type.
+templateMirrorType :: DiskTemplate -> MirrorType
+templateMirrorType DTDiskless = MirrorExternal
+templateMirrorType DTFile = MirrorNone
+templateMirrorType DTSharedFile = MirrorExternal
+templateMirrorType DTPlain = MirrorNone
+templateMirrorType DTBlock = MirrorExternal
+templateMirrorType DTDrbd8 = MirrorInternal
+templateMirrorType DTRbd = MirrorExternal
+
-- | The Group allocation policy type.
--
-- Note that the order of constructors is important as the automatic
-- changing this data type be careful about the interaction with the
-- desired sorting order.
$(THH.declareSADT "AllocPolicy"
- [ ("AllocPreferred", 'C.allocPolicyPreferred)
- , ("AllocLastResort", 'C.allocPolicyLastResort)
- , ("AllocUnallocable", 'C.allocPolicyUnallocable)
- ])
+ [ ("AllocPreferred", 'C.allocPolicyPreferred)
+ , ("AllocLastResort", 'C.allocPolicyLastResort)
+ , ("AllocUnallocable", 'C.allocPolicyUnallocable)
+ ])
$(THH.makeJSONInstance ''AllocPolicy)
-- | The Instance real state type.
$(THH.declareSADT "InstanceStatus"
- [ ("AdminDown", 'C.inststAdmindown)
- , ("AdminOffline", 'C.inststAdminoffline)
- , ("ErrorDown", 'C.inststErrordown)
- , ("ErrorUp", 'C.inststErrorup)
- , ("NodeDown", 'C.inststNodedown)
- , ("NodeOffline", 'C.inststNodeoffline)
- , ("Running", 'C.inststRunning)
- , ("WrongNode", 'C.inststWrongnode)
- ])
+ [ ("AdminDown", 'C.inststAdmindown)
+ , ("AdminOffline", 'C.inststAdminoffline)
+ , ("ErrorDown", 'C.inststErrordown)
+ , ("ErrorUp", 'C.inststErrorup)
+ , ("NodeDown", 'C.inststNodedown)
+ , ("NodeOffline", 'C.inststNodeoffline)
+ , ("Running", 'C.inststRunning)
+ , ("WrongNode", 'C.inststWrongnode)
+ ])
$(THH.makeJSONInstance ''InstanceStatus)
-- | The resource spec type.
data RSpec = RSpec
- { rspecCpu :: Int -- ^ Requested VCPUs
- , rspecMem :: Int -- ^ Requested memory
- , rspecDsk :: Int -- ^ Requested disk
- } deriving (Show, Read, Eq)
+ { rspecCpu :: Int -- ^ Requested VCPUs
+ , rspecMem :: Int -- ^ Requested memory
+ , rspecDsk :: Int -- ^ Requested disk
+ } deriving (Show, Read, Eq)
+
+-- | Allocation stats type. This is used instead of 'RSpec' (which was
+-- used at first), because we need to track more stats. The actual
+-- data can refer either to allocated, or available, etc. values
+-- depending on the context. See also
+-- 'Cluster.computeAllocationDelta'.
+data AllocInfo = AllocInfo
+ { allocInfoVCpus :: Int -- ^ VCPUs
+ , allocInfoNCpus :: Double -- ^ Normalised CPUs
+ , allocInfoMem :: Int -- ^ Memory
+ , allocInfoDisk :: Int -- ^ Disk
+ } deriving (Show, Read, Eq)
+
+-- | Currently used, possibly to allocate, unallocable.
+type AllocStats = (AllocInfo, AllocInfo, AllocInfo)
+
+-- | Instance specification type.
+$(THH.buildObject "ISpec" "iSpec"
+ [ THH.renameField "MemorySize" $ THH.simpleField C.ispecMemSize [t| Int |]
+ , THH.renameField "CpuCount" $ THH.simpleField C.ispecCpuCount [t| Int |]
+ , THH.renameField "DiskSize" $ THH.simpleField C.ispecDiskSize [t| Int |]
+ , THH.renameField "DiskCount" $ THH.simpleField C.ispecDiskCount [t| Int |]
+ , THH.renameField "NicCount" $ THH.simpleField C.ispecNicCount [t| Int |]
+ , THH.renameField "SpindleUse" $ THH.simpleField C.ispecSpindleUse [t| Int |]
+ ])
+
+-- | The default minimum ispec.
+defMinISpec :: ISpec
+defMinISpec = ISpec { iSpecMemorySize = C.ipolicyDefaultsMinMemorySize
+ , iSpecCpuCount = C.ipolicyDefaultsMinCpuCount
+ , iSpecDiskSize = C.ipolicyDefaultsMinDiskSize
+ , iSpecDiskCount = C.ipolicyDefaultsMinDiskCount
+ , iSpecNicCount = C.ipolicyDefaultsMinNicCount
+ , iSpecSpindleUse = C.ipolicyDefaultsMinSpindleUse
+ }
+
+-- | The default standard ispec.
+defStdISpec :: ISpec
+defStdISpec = ISpec { iSpecMemorySize = C.ipolicyDefaultsStdMemorySize
+ , iSpecCpuCount = C.ipolicyDefaultsStdCpuCount
+ , iSpecDiskSize = C.ipolicyDefaultsStdDiskSize
+ , iSpecDiskCount = C.ipolicyDefaultsStdDiskCount
+ , iSpecNicCount = C.ipolicyDefaultsStdNicCount
+ , iSpecSpindleUse = C.ipolicyDefaultsStdSpindleUse
+ }
+
+-- | The default max ispec.
+defMaxISpec :: ISpec
+defMaxISpec = ISpec { iSpecMemorySize = C.ipolicyDefaultsMaxMemorySize
+ , iSpecCpuCount = C.ipolicyDefaultsMaxCpuCount
+ , iSpecDiskSize = C.ipolicyDefaultsMaxDiskSize
+ , iSpecDiskCount = C.ipolicyDefaultsMaxDiskCount
+ , iSpecNicCount = C.ipolicyDefaultsMaxNicCount
+ , iSpecSpindleUse = C.ipolicyDefaultsMaxSpindleUse
+ }
+
+-- | Instance policy type.
+$(THH.buildObject "IPolicy" "iPolicy"
+ [ THH.renameField "StdSpec" $ THH.simpleField C.ispecsStd [t| ISpec |]
+ , THH.renameField "MinSpec" $ THH.simpleField C.ispecsMin [t| ISpec |]
+ , THH.renameField "MaxSpec" $ THH.simpleField C.ispecsMax [t| ISpec |]
+ , THH.renameField "DiskTemplates" $
+ THH.simpleField C.ipolicyDts [t| [DiskTemplate] |]
+ , THH.renameField "VcpuRatio" $
+ THH.simpleField C.ipolicyVcpuRatio [t| Double |]
+ , THH.renameField "SpindleRatio" $
+ THH.simpleField C.ipolicySpindleRatio [t| Double |]
+ ])
+
+-- | Converts an ISpec type to a RSpec one.
+rspecFromISpec :: ISpec -> RSpec
+rspecFromISpec ispec = RSpec { rspecCpu = iSpecCpuCount ispec
+ , rspecMem = iSpecMemorySize ispec
+ , rspecDsk = iSpecDiskSize ispec
+ }
+
+-- | The default instance policy.
+defIPolicy :: IPolicy
+defIPolicy = IPolicy { iPolicyStdSpec = defStdISpec
+ , iPolicyMinSpec = defMinISpec
+ , iPolicyMaxSpec = defMaxISpec
+ -- hardcoding here since Constants.hs exports the
+ -- string values, not the actual type; and in
+ -- htools, we are mostly looking at DRBD
+ , iPolicyDiskTemplates = [minBound..maxBound]
+ , iPolicyVcpuRatio = C.ipolicyDefaultsVcpuRatio
+ , iPolicySpindleRatio = C.ipolicyDefaultsSpindleRatio
+ }
-- | 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)
+ { 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
-- | 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)
+ 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)
+ 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
-- | An instance move definition.
data IMove = Failover -- ^ Failover the instance (f)
+ | FailoverToAny Ndx -- ^ Failover to a random node
+ -- (fa:np), for shared storage
| 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.
-$(THH.declareSADT "DiskTemplate"
- [ ("DTDiskless", 'C.dtDiskless)
- , ("DTFile", 'C.dtFile)
- , ("DTSharedFile", 'C.dtSharedFile)
- , ("DTPlain", 'C.dtPlain)
- , ("DTBlock", 'C.dtBlock)
- , ("DTDrbd8", 'C.dtDrbd8)
- ])
-$(THH.makeJSONInstance ''DiskTemplate)
-
-- | Formatted solution output for one move (involved nodes and
-- commands.
type MoveJob = ([Ndx], Idx, IMove, [String])
-- | 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
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
deriving (Show, Read)
instance Monad OpResult where
- (OpGood x) >>= fn = fn x
- (OpFail y) >>= _ = OpFail y
- return = OpGood
+ (OpGood x) >>= fn = fn x
+ (OpFail y) >>= _ = OpFail y
+ return = OpGood
-- | Conversion from 'OpResult' to 'Result'.
opToResult :: OpResult a -> Result a
-- | 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
+ -- | 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.
$(THH.declareSADT "EvacMode"
- [ ("ChangePrimary", 'C.iallocatorNevacPri)
- , ("ChangeSecondary", 'C.iallocatorNevacSec)
- , ("ChangeAll", 'C.iallocatorNevacAll)
- ])
+ [ ("ChangePrimary", 'C.iallocatorNevacPri)
+ , ("ChangeSecondary", 'C.iallocatorNevacSec)
+ , ("ChangeAll", 'C.iallocatorNevacAll)
+ ])
$(THH.makeJSONInstance ''EvacMode)
projects / ganeti-local / blobdiff