+{-# LANGUAGE TemplateHaskell #-}
+
{-| Some common types.
-}
{-
-Copyright (C) 2009, 2010 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(..)
- , apolFromString
- , apolToString
- , RSpec(..)
- , DynUtil(..)
- , zeroUtil
- , baseUtil
- , addUtil
- , subUtil
- , defVcpuRatio
- , defReservedDiskRatio
- , unitMem
- , unitCpu
- , unitDsk
- , unknownField
- , Placement
- , IMove(..)
- , MoveJob
- , JobSet
- , Result(..)
- , isOk
- , isBad
- , Element(..)
- , FailMode(..)
- , FailStats
- , OpResult(..)
- , connTimeout
- , queryTimeout
- ) where
+ ( 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
-- Ord instance will order them in the order they are defined, so when
-- changing this data type be careful about the interaction with the
-- desired sorting order.
-data AllocPolicy
- = AllocPreferred -- ^ This is the normal status, the group
- -- should be used normally during allocations
- | AllocLastResort -- ^ This group should be used only as
- -- last-resort, after the preferred groups
- | AllocUnallocable -- ^ This group must not be used for new
- -- allocations
- deriving (Show, Read, Eq, Ord)
-
--- | Convert a string to an alloc policy
-apolFromString :: (Monad m) => String -> m AllocPolicy
-apolFromString s =
- case s of
- "preferred" -> return AllocPreferred
- "last_resort" -> return AllocLastResort
- "unallocable" -> return AllocUnallocable
- o -> fail $ "Invalid alloc policy mode: " ++ o
-
--- | Convert an alloc policy to the Ganeti string equivalent
-apolToString :: AllocPolicy -> String
-apolToString AllocPreferred = "preferred"
-apolToString AllocLastResort = "last_resort"
-apolToString AllocUnallocable = "unallocable"
-
-instance JSON.JSON AllocPolicy where
- showJSON = JSON.showJSON . apolToString
- readJSON s = case JSON.readJSON s of
- JSON.Ok s' -> apolFromString s'
- JSON.Error e -> JSON.Error $
- "Can't parse alloc_policy: " ++ e
+$(THH.declareSADT "AllocPolicy"
+ [ ("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)
+ ])
+$(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
+-- | Initial empty utilisation.
zeroUtil :: DynUtil
zeroUtil = DynUtil { cpuWeight = 0, memWeight = 0
, dskWeight = 0, netWeight = 0 }
+-- | Base utilisation (used when no actual utilisation data is
+-- supplied).
baseUtil :: DynUtil
baseUtil = DynUtil { cpuWeight = 1, memWeight = 1
, dskWeight = 1, netWeight = 1 }
+-- | 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
-- performed and the score of the cluster after the move.
type Placement = (Idx, Ndx, Ndx, IMove, Score)
--- | An instance move definition
+-- | 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)
deriving (Show, Read)
-- | Formatted solution output for one move (involved nodes and
--- commands
+-- commands.
type MoveJob = ([Ndx], Idx, IMove, [String])
--- | Unknown field in table output
+-- | Unknown field in table output.
unknownField :: String
unknownField = "<unknown field>"
--- | A list of command elements
+-- | 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
-
--}
-data Result a
- = Bad String
- | Ok a
- deriving (Show, Read)
-
-instance Monad Result where
- (>>=) (Bad x) _ = Bad x
- (>>=) (Ok x) fn = fn x
- return = Ok
- fail = Bad
-
--- | Simple checker for whether Result is OK
-isOk :: Result a -> Bool
-isOk (Ok _) = True
-isOk _ = False
-
--- | Simple checker for whether Result is a failure
-isBad :: Result a -> Bool
-isBad = not . isOk
-
--- | Reason for an operation's falure
+-- | Reason for an operation's falure.
data FailMode = FailMem -- ^ Failed due to not enough RAM
| FailDisk -- ^ Failed due to not enough disk
| FailCPU -- ^ Failed due to not enough CPU capacity
| FailTags -- ^ Failed due to tag exclusion
deriving (Eq, Enum, Bounded, Show, Read)
--- | List with failure statistics
+-- | List with failure statistics.
type FailStats = [(FailMode, Int)]
--- | Either-like data-type customized for our failure modes
+-- | Either-like data-type customized for our failure modes.
+--
+-- The failure values for this monad track the specific allocation
+-- failures, so this is not a general error-monad (compare with the
+-- 'Result' data type). One downside is that this type cannot encode a
+-- generic failure mode, hence 'fail' for this monad is not defined
+-- and will cause an exception.
data OpResult a = OpFail FailMode -- ^ Failed operation
| OpGood a -- ^ Success operation
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
+opToResult (OpFail f) = Bad $ show f
+opToResult (OpGood v) = Ok v
-- | 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)
+ ])
+$(THH.makeJSONInstance ''EvacMode)