X-Git-Url: https://code.grnet.gr/git/ganeti-local/blobdiff_plain/3771d104caa87546cf3ef97e088261d14aa814e9..01e524934eae5ae964c51a19ff2a1a1011f5e51a:/htools/Ganeti/HTools/Types.hs diff --git a/htools/Ganeti/HTools/Types.hs b/htools/Ganeti/HTools/Types.hs index a3719d8..b625cef 100644 --- a/htools/Ganeti/HTools/Types.hs +++ b/htools/Ganeti/HTools/Types.hs @@ -6,7 +6,7 @@ {- -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 @@ -26,58 +26,61 @@ Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA -} 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 @@ -100,6 +103,38 @@ type Weight = Double -- | 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 @@ -107,40 +142,128 @@ type GroupID = String -- 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 @@ -156,12 +279,12 @@ baseUtil = DynUtil { cpuWeight = 1, memWeight = 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 @@ -170,23 +293,14 @@ type Placement = (Idx, Ndx, Ndx, IMove, Score) -- | 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]) @@ -198,18 +312,6 @@ unknownField = "" -- | 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 @@ -226,44 +328,6 @@ unitDsk = 256 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 @@ -287,9 +351,9 @@ data OpResult a = OpFail FailMode -- ^ Failed 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 @@ -298,27 +362,27 @@ 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) - ]) + [ ("ChangePrimary", 'C.iallocatorNevacPri) + , ("ChangeSecondary", 'C.iallocatorNevacSec) + , ("ChangeAll", 'C.iallocatorNevacAll) + ]) $(THH.makeJSONInstance ''EvacMode)