| {-# LANGUAGE TemplateHaskell #-} |
| |
| {-| Some common types. |
| |
| -} |
| |
| {- |
| |
| Copyright (C) 2009, 2010, 2011, 2012, 2013 Google Inc. |
| All rights reserved. |
| |
| Redistribution and use in source and binary forms, with or without |
| modification, are permitted provided that the following conditions are |
| met: |
| |
| 1. Redistributions of source code must retain the above copyright notice, |
| this list of conditions and the following disclaimer. |
| |
| 2. Redistributions in binary form must reproduce the above copyright |
| notice, this list of conditions and the following disclaimer in the |
| documentation and/or other materials provided with the distribution. |
| |
| THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS |
| IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED |
| TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR |
| PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR |
| CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, |
| EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, |
| PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR |
| PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF |
| LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING |
| NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS |
| SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. |
| |
| -} |
| |
| module Ganeti.HTools.Types |
| ( Idx |
| , Ndx |
| , Gdx |
| , NameAssoc |
| , Score |
| , Weight |
| , GroupID |
| , defaultGroupID |
| , AllocPolicy(..) |
| , allocPolicyFromRaw |
| , allocPolicyToRaw |
| , NetworkID |
| , InstanceStatus(..) |
| , instanceStatusFromRaw |
| , instanceStatusToRaw |
| , RSpec(..) |
| , AllocInfo(..) |
| , AllocStats |
| , DynUtil(..) |
| , zeroUtil |
| , baseUtil |
| , addUtil |
| , subUtil |
| , defReservedDiskRatio |
| , unitMem |
| , unitCpu |
| , unitDsk |
| , unitSpindle |
| , unknownField |
| , Placement |
| , IMove(..) |
| , DiskTemplate(..) |
| , diskTemplateToRaw |
| , diskTemplateFromRaw |
| , MirrorType(..) |
| , templateMirrorType |
| , MoveJob |
| , JobSet |
| , Element(..) |
| , FailMode(..) |
| , FailStats |
| , OpResult |
| , opToResult |
| , ISpec(..) |
| , defMinISpec |
| , defStdISpec |
| , maxDisks |
| , maxNics |
| , defMaxISpec |
| , MinMaxISpecs(..) |
| , IPolicy(..) |
| , defIPolicy |
| , rspecFromISpec |
| , AutoRepairType(..) |
| , autoRepairTypeToRaw |
| , autoRepairTypeFromRaw |
| , AutoRepairResult(..) |
| , autoRepairResultToRaw |
| , autoRepairResultFromRaw |
| , AutoRepairPolicy(..) |
| , AutoRepairSuspendTime(..) |
| , AutoRepairData(..) |
| , AutoRepairStatus(..) |
| ) where |
| |
| import qualified Data.Map as M |
| import System.Time (ClockTime) |
| |
| import qualified Ganeti.ConstantUtils as ConstantUtils |
| import qualified Ganeti.THH as THH |
| import Ganeti.BasicTypes |
| import Ganeti.Types |
| |
| -- | The instance index type. |
| type Idx = Int |
| |
| -- | The node index type. |
| type Ndx = Int |
| |
| -- | The group index type. |
| type Gdx = Int |
| |
| -- | The type used to hold name-to-idx mappings. |
| type NameAssoc = M.Map String Int |
| |
| -- | A separate name for the cluster score type. |
| type Score = Double |
| |
| -- | A separate name for a weight metric. |
| 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" |
| |
| -- | Mirroring type. |
| data MirrorType = MirrorNone -- ^ No mirroring/movability |
| | MirrorInternal -- ^ DRBD-type mirroring |
| | MirrorExternal -- ^ Shared-storage type mirroring |
| deriving (Eq, Show) |
| |
| -- | 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 |
| templateMirrorType DTExt = MirrorExternal |
| templateMirrorType DTGluster = MirrorExternal |
| |
| -- | The resource spec type. |
| data RSpec = RSpec |
| { rspecCpu :: Int -- ^ Requested VCPUs |
| , rspecMem :: Int -- ^ Requested memory |
| , rspecDsk :: Int -- ^ Requested disk |
| , rspecSpn :: Int -- ^ Requested spindles |
| } deriving (Show, 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 |
| , allocInfoSpn :: Int -- ^ Spindles |
| } deriving (Show, Eq) |
| |
| -- | Currently used, possibly to allocate, unallocable. |
| type AllocStats = (AllocInfo, AllocInfo, AllocInfo) |
| |
| -- | The network UUID type. |
| type NetworkID = String |
| |
| -- | Instance specification type. |
| $(THH.buildObject "ISpec" "iSpec" |
| [ THH.renameField "MemorySize" $ |
| THH.simpleField ConstantUtils.ispecMemSize [t| Int |] |
| , THH.renameField "CpuCount" $ |
| THH.simpleField ConstantUtils.ispecCpuCount [t| Int |] |
| , THH.renameField "DiskSize" $ |
| THH.simpleField ConstantUtils.ispecDiskSize [t| Int |] |
| , THH.renameField "DiskCount" $ |
| THH.simpleField ConstantUtils.ispecDiskCount [t| Int |] |
| , THH.renameField "NicCount" $ |
| THH.simpleField ConstantUtils.ispecNicCount [t| Int |] |
| , THH.renameField "SpindleUse" $ |
| THH.simpleField ConstantUtils.ispecSpindleUse [t| Int |] |
| ]) |
| |
| -- | The default minimum ispec. |
| defMinISpec :: ISpec |
| defMinISpec = ISpec { iSpecMemorySize = 128 |
| , iSpecCpuCount = 1 |
| , iSpecDiskCount = 1 |
| , iSpecDiskSize = 1024 |
| , iSpecNicCount = 1 |
| , iSpecSpindleUse = 1 |
| } |
| |
| -- | The default standard ispec. |
| defStdISpec :: ISpec |
| defStdISpec = ISpec { iSpecMemorySize = 128 |
| , iSpecCpuCount = 1 |
| , iSpecDiskCount = 1 |
| , iSpecDiskSize = 1024 |
| , iSpecNicCount = 1 |
| , iSpecSpindleUse = 1 |
| } |
| |
| maxDisks :: Int |
| maxDisks = 16 |
| |
| maxNics :: Int |
| maxNics = 8 |
| |
| -- | The default max ispec. |
| defMaxISpec :: ISpec |
| defMaxISpec = ISpec { iSpecMemorySize = 32768 |
| , iSpecCpuCount = 8 |
| , iSpecDiskCount = maxDisks |
| , iSpecDiskSize = 1024 * 1024 |
| , iSpecNicCount = maxNics |
| , iSpecSpindleUse = 12 |
| } |
| |
| -- | Minimum and maximum instance specs type. |
| $(THH.buildObject "MinMaxISpecs" "minMaxISpecs" |
| [ THH.renameField "MinSpec" $ THH.simpleField "min" [t| ISpec |] |
| , THH.renameField "MaxSpec" $ THH.simpleField "max" [t| ISpec |] |
| ]) |
| |
| -- | Defult minimum and maximum instance specs. |
| defMinMaxISpecs :: [MinMaxISpecs] |
| defMinMaxISpecs = [MinMaxISpecs { minMaxISpecsMinSpec = defMinISpec |
| , minMaxISpecsMaxSpec = defMaxISpec |
| }] |
| |
| -- | Instance policy type. |
| $(THH.buildObject "IPolicy" "iPolicy" |
| [ THH.renameField "MinMaxISpecs" $ |
| THH.simpleField ConstantUtils.ispecsMinmax [t| [MinMaxISpecs] |] |
| , THH.renameField "StdSpec" $ |
| THH.simpleField ConstantUtils.ispecsStd [t| ISpec |] |
| , THH.renameField "DiskTemplates" $ |
| THH.simpleField ConstantUtils.ipolicyDts [t| [DiskTemplate] |] |
| , THH.renameField "VcpuRatio" $ |
| THH.simpleField ConstantUtils.ipolicyVcpuRatio [t| Double |] |
| , THH.renameField "SpindleRatio" $ |
| THH.simpleField ConstantUtils.ipolicySpindleRatio [t| Double |] |
| , THH.renameField "MemoryRatio" . |
| THH.defaultField [| ConstantUtils.ipolicyDefaultsMemoryRatio |] $ |
| THH.simpleField ConstantUtils.ipolicyMemoryRatio [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 |
| , rspecSpn = iSpecSpindleUse ispec |
| } |
| |
| -- | The default instance policy. |
| defIPolicy :: IPolicy |
| defIPolicy = |
| IPolicy { iPolicyMinMaxISpecs = defMinMaxISpecs |
| , iPolicyStdSpec = defStdISpec |
| -- 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 = ConstantUtils.ipolicyDefaultsVcpuRatio |
| , iPolicySpindleRatio = ConstantUtils.ipolicyDefaultsSpindleRatio |
| , iPolicyMemoryRatio = ConstantUtils.ipolicyDefaultsMemoryRatio |
| } |
| |
| -- | 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, Eq) |
| |
| -- | 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) |
| |
| -- | 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) |
| |
| -- | 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. |
| 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) |
| |
| -- | Formatted solution output for one move (involved nodes and |
| -- commands. |
| type MoveJob = ([Ndx], Idx, IMove, [String]) |
| |
| -- | Unknown field in table output. |
| unknownField :: String |
| unknownField = "<unknown field>" |
| |
| -- | A list of command elements. |
| type JobSet = [MoveJob] |
| |
| -- | Default max disk usage ratio. |
| defReservedDiskRatio :: Double |
| defReservedDiskRatio = 0 |
| |
| -- | Base memory unit. |
| unitMem :: Int |
| unitMem = 64 |
| |
| -- | Base disk unit. |
| unitDsk :: Int |
| unitDsk = 256 |
| |
| -- | Base vcpus unit. |
| unitCpu :: Int |
| unitCpu = 1 |
| |
| -- | Base spindles unit. |
| unitSpindle :: Int |
| unitSpindle = 1 |
| |
| -- | 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 |
| | FailN1 -- ^ Failed due to not passing N1 checks |
| | FailTooSmall -- ^ Failed due to the instance being smaller |
| -- than allowed |
| | FailTags -- ^ Failed due to tag exclusion |
| | FailMig -- ^ Failed due to migration restrictions |
| | FailDiskCount -- ^ Failed due to wrong number of disks |
| | FailSpindles -- ^ Failed due to wrong/missing spindles |
| | FailInternal -- ^ Internal error |
| deriving (Eq, Enum, Bounded, Show) |
| |
| -- | List with failure statistics. |
| type FailStats = [(FailMode, Int)] |
| |
| -- | 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 our way to build a FailMode from string |
| -- will instead raise an exception. |
| type OpResult = GenericResult FailMode |
| |
| -- | 'FromString' instance for 'FailMode' designed to catch unintended |
| -- use as a general monad. |
| instance FromString FailMode where |
| mkFromString v = error $ "Programming error: OpResult used as generic monad" |
| ++ v |
| |
| -- | Conversion from 'OpResult' to 'Result'. |
| opToResult :: OpResult a -> Result a |
| opToResult (Bad f) = Bad $ show f |
| opToResult (Ok 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 |
| |
| -- | The repair modes for the auto-repair tool. |
| $(THH.declareLADT ''String "AutoRepairType" |
| -- Order is important here: from least destructive to most. |
| [ ("ArFixStorage", "fix-storage") |
| , ("ArMigrate", "migrate") |
| , ("ArFailover", "failover") |
| , ("ArReinstall", "reinstall") |
| ]) |
| |
| -- | The possible auto-repair results. |
| $(THH.declareLADT ''String "AutoRepairResult" |
| -- Order is important here: higher results take precedence when an object |
| -- has several result annotations attached. |
| [ ("ArEnoperm", "enoperm") |
| , ("ArSuccess", "success") |
| , ("ArFailure", "failure") |
| ]) |
| |
| -- | The possible auto-repair policy for a given instance. |
| data AutoRepairPolicy |
| = ArEnabled AutoRepairType -- ^ Auto-repair explicitly enabled |
| | ArSuspended AutoRepairSuspendTime -- ^ Suspended temporarily, or forever |
| | ArNotEnabled -- ^ Auto-repair not explicitly enabled |
| deriving (Eq, Show) |
| |
| -- | The suspend timeout for 'ArSuspended'. |
| data AutoRepairSuspendTime = Forever -- ^ Permanently suspended |
| | Until ClockTime -- ^ Suspended up to a certain time |
| deriving (Eq, Show) |
| |
| -- | The possible auto-repair states for any given instance. |
| data AutoRepairStatus |
| = ArHealthy (Maybe AutoRepairData) -- ^ No problems detected with the instance |
| | ArNeedsRepair AutoRepairData -- ^ Instance has problems, no action taken |
| | ArPendingRepair AutoRepairData -- ^ Repair jobs ongoing for the instance |
| | ArFailedRepair AutoRepairData -- ^ Some repair jobs for the instance failed |
| deriving (Eq, Show) |
| |
| -- | The data accompanying a repair operation (future, pending, or failed). |
| data AutoRepairData = AutoRepairData { arType :: AutoRepairType |
| , arUuid :: String |
| , arTime :: ClockTime |
| , arJobs :: [JobId] |
| , arResult :: Maybe AutoRepairResult |
| , arTag :: String |
| } |
| deriving (Eq, Show) |
