Cleanup HTools.Types/BasicTypes imports
[ganeti-local] / htools / Ganeti / HTools / Instance.hs
index 519e385..b78eaa6 100644 (file)
@@ -7,7 +7,7 @@ intelligence is in the "Node" and "Cluster" modules.
 
 {-
 
-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
@@ -27,62 +27,101 @@ Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
 -}
 
 module Ganeti.HTools.Instance
-    ( Instance(..)
-    , AssocList
-    , List
-    , create
-    , setIdx
-    , setName
-    , setAlias
-    , setPri
-    , setSec
-    , setBoth
-    , setMovable
-    , specOf
-    , shrinkByType
-    , runningStates
-    , localStorageTemplates
-    , hasSecondary
-    , requiredNodes
-    , allNodes
-    , usesLocalStorage
-    ) where
-
+  ( Instance(..)
+  , AssocList
+  , List
+  , create
+  , isRunning
+  , isOffline
+  , notOffline
+  , instanceDown
+  , usesSecMem
+  , applyIfOnline
+  , setIdx
+  , setName
+  , setAlias
+  , setPri
+  , setSec
+  , setBoth
+  , setMovable
+  , specOf
+  , instBelowISpec
+  , instAboveISpec
+  , instMatchesPolicy
+  , shrinkByType
+  , localStorageTemplates
+  , hasSecondary
+  , requiredNodes
+  , allNodes
+  , usesLocalStorage
+  , mirrorType
+  ) where
+
+import Ganeti.BasicTypes
 import qualified Ganeti.HTools.Types as T
 import qualified Ganeti.HTools.Container as Container
-import qualified Ganeti.Constants as C
+
+import Ganeti.Utils
 
 -- * Type declarations
 
 -- | The instance type.
 data Instance = Instance
-    { name         :: String    -- ^ The instance name
-    , alias        :: String    -- ^ The shortened name
-    , mem          :: Int       -- ^ Memory of the instance
-    , dsk          :: Int       -- ^ Disk size of instance
-    , vcpus        :: Int       -- ^ Number of VCPUs
-    , running      :: Bool      -- ^ Is the instance running?
-    , runSt        :: T.InstanceStatus -- ^ Original run status
-    , pNode        :: T.Ndx     -- ^ Original primary node
-    , sNode        :: T.Ndx     -- ^ Original secondary node
-    , idx          :: T.Idx     -- ^ Internal index
-    , util         :: T.DynUtil -- ^ Dynamic resource usage
-    , movable      :: Bool      -- ^ Can and should the instance be moved?
-    , autoBalance  :: Bool      -- ^ Is the instance auto-balanced?
-    , tags         :: [String]  -- ^ List of instance tags
-    , diskTemplate :: T.DiskTemplate -- ^ The disk template of the instance
-    } deriving (Show, Read)
+  { name         :: String    -- ^ The instance name
+  , alias        :: String    -- ^ The shortened name
+  , mem          :: Int       -- ^ Memory of the instance
+  , dsk          :: Int       -- ^ Disk size of instance
+  , vcpus        :: Int       -- ^ Number of VCPUs
+  , runSt        :: T.InstanceStatus -- ^ Original run status
+  , pNode        :: T.Ndx     -- ^ Original primary node
+  , sNode        :: T.Ndx     -- ^ Original secondary node
+  , idx          :: T.Idx     -- ^ Internal index
+  , util         :: T.DynUtil -- ^ Dynamic resource usage
+  , movable      :: Bool      -- ^ Can and should the instance be moved?
+  , autoBalance  :: Bool      -- ^ Is the instance auto-balanced?
+  , tags         :: [String]  -- ^ List of instance tags
+  , diskTemplate :: T.DiskTemplate -- ^ The disk template of the instance
+  , spindleUse   :: Int       -- ^ The numbers of used spindles
+  } deriving (Show, Read, Eq)
 
 instance T.Element Instance where
-    nameOf   = name
-    idxOf    = idx
-    setAlias = setAlias
-    setIdx   = setIdx
-    allNames n = [name n, alias n]
-
--- | Constant holding the running instance states.
-runningStates :: [T.InstanceStatus]
-runningStates = [T.Running, T.ErrorUp]
+  nameOf   = name
+  idxOf    = idx
+  setAlias = setAlias
+  setIdx   = setIdx
+  allNames n = [name n, alias n]
+
+-- | Check if instance is running.
+isRunning :: Instance -> Bool
+isRunning (Instance {runSt = T.Running}) = True
+isRunning (Instance {runSt = T.ErrorUp}) = True
+isRunning _                              = False
+
+-- | Check if instance is offline.
+isOffline :: Instance -> Bool
+isOffline (Instance {runSt = T.AdminOffline}) = True
+isOffline _                                   = False
+
+
+-- | Helper to check if the instance is not offline.
+notOffline :: Instance -> Bool
+notOffline = not . isOffline
+
+-- | Check if instance is down.
+instanceDown :: Instance -> Bool
+instanceDown inst | isRunning inst = False
+instanceDown inst | isOffline inst = False
+instanceDown _                     = True
+
+-- | Apply the function if the instance is online. Otherwise use
+-- the initial value
+applyIfOnline :: Instance -> (a -> a) -> a -> a
+applyIfOnline = applyIf . notOffline
+
+-- | Helper for determining whether an instance's memory needs to be
+-- taken into account for secondary memory reservation.
+usesSecMem :: Instance -> Bool
+usesSecMem inst = notOffline inst && autoBalance inst
 
 -- | Constant holding the local storage templates.
 --
@@ -101,7 +140,12 @@ localStorageTemplates = [ T.DTDrbd8, T.DTPlain ]
 -- instance. Further the movable state can be restricted more due to
 -- user choices, etc.
 movableDiskTemplates :: [T.DiskTemplate]
-movableDiskTemplates = [ T.DTDrbd8, T.DTBlock, T.DTSharedFile ]
+movableDiskTemplates =
+  [ T.DTDrbd8
+  , T.DTBlock
+  , T.DTSharedFile
+  , T.DTRbd
+  ]
 
 -- | A simple name for the int, instance association list.
 type AssocList = [(T.Idx, Instance)]
@@ -116,25 +160,26 @@ type List = Container.Container Instance
 -- Some parameters are not initialized by function, and must be set
 -- later (via 'setIdx' for example).
 create :: String -> Int -> Int -> Int -> T.InstanceStatus
-       -> [String] -> Bool -> T.Ndx -> T.Ndx -> T.DiskTemplate -> Instance
+       -> [String] -> Bool -> T.Ndx -> T.Ndx -> T.DiskTemplate -> Int
+       -> Instance
 create name_init mem_init dsk_init vcpus_init run_init tags_init
-       auto_balance_init pn sn dt =
-    Instance { name = name_init
-             , alias = name_init
-             , mem = mem_init
-             , dsk = dsk_init
-             , vcpus = vcpus_init
-             , running = run_init `elem` runningStates
-             , runSt = run_init
-             , pNode = pn
-             , sNode = sn
-             , idx = -1
-             , util = T.baseUtil
-             , tags = tags_init
-             , movable = supportsMoves dt
-             , autoBalance = auto_balance_init
-             , diskTemplate = dt
-             }
+       auto_balance_init pn sn dt su =
+  Instance { name = name_init
+           , alias = name_init
+           , mem = mem_init
+           , dsk = dsk_init
+           , vcpus = vcpus_init
+           , runSt = run_init
+           , pNode = pn
+           , sNode = sn
+           , idx = -1
+           , util = T.baseUtil
+           , tags = tags_init
+           , movable = supportsMoves dt
+           , autoBalance = auto_balance_init
+           , diskTemplate = dt
+           , spindleUse = su
+           }
 
 -- | Changes the index.
 --
@@ -189,25 +234,52 @@ setMovable t m = t { movable = m }
 
 -- | Try to shrink the instance based on the reason why we can't
 -- allocate it.
-shrinkByType :: Instance -> T.FailMode -> T.Result Instance
+shrinkByType :: Instance -> T.FailMode -> Result Instance
 shrinkByType inst T.FailMem = let v = mem inst - T.unitMem
                               in if v < T.unitMem
-                                 then T.Bad "out of memory"
-                                 else T.Ok inst { mem = v }
+                                 then Bad "out of memory"
+                                 else Ok inst { mem = v }
 shrinkByType inst T.FailDisk = let v = dsk inst - T.unitDsk
                                in if v < T.unitDsk
-                                  then T.Bad "out of disk"
-                                  else T.Ok inst { dsk = v }
+                                  then Bad "out of disk"
+                                  else Ok inst { dsk = v }
 shrinkByType inst T.FailCPU = let v = vcpus inst - T.unitCpu
                               in if v < T.unitCpu
-                                 then T.Bad "out of vcpus"
-                                 else T.Ok inst { vcpus = v }
-shrinkByType _ f = T.Bad $ "Unhandled failure mode " ++ show f
+                                 then Bad "out of vcpus"
+                                 else Ok inst { vcpus = v }
+shrinkByType _ f = Bad $ "Unhandled failure mode " ++ show f
 
 -- | Return the spec of an instance.
 specOf :: Instance -> T.RSpec
 specOf Instance { mem = m, dsk = d, vcpus = c } =
-    T.RSpec { T.rspecCpu = c, T.rspecMem = m, T.rspecDsk = d }
+  T.RSpec { T.rspecCpu = c, T.rspecMem = m, T.rspecDsk = d }
+
+-- | Checks if an instance is smaller than a given spec. Returns
+-- OpGood for a correct spec, otherwise OpFail one of the possible
+-- failure modes.
+instBelowISpec :: Instance -> T.ISpec -> T.OpResult ()
+instBelowISpec inst ispec
+  | mem inst > T.iSpecMemorySize ispec = T.OpFail T.FailMem
+  | dsk inst > T.iSpecDiskSize ispec   = T.OpFail T.FailDisk
+  | vcpus inst > T.iSpecCpuCount ispec = T.OpFail T.FailCPU
+  | otherwise = T.OpGood ()
+
+-- | Checks if an instance is bigger than a given spec.
+instAboveISpec :: Instance -> T.ISpec -> T.OpResult ()
+instAboveISpec inst ispec
+  | mem inst < T.iSpecMemorySize ispec = T.OpFail T.FailMem
+  | dsk inst < T.iSpecDiskSize ispec   = T.OpFail T.FailDisk
+  | vcpus inst < T.iSpecCpuCount ispec = T.OpFail T.FailCPU
+  | otherwise = T.OpGood ()
+
+-- | Checks if an instance matches a policy.
+instMatchesPolicy :: Instance -> T.IPolicy -> T.OpResult ()
+instMatchesPolicy inst ipol = do
+  instAboveISpec inst (T.iPolicyMinSpec ipol)
+  instBelowISpec inst (T.iPolicyMaxSpec ipol)
+  if diskTemplate inst `elem` T.iPolicyDiskTemplates ipol
+    then T.OpGood ()
+    else T.OpFail T.FailDisk
 
 -- | Checks whether the instance uses a secondary node.
 --
@@ -234,3 +306,7 @@ usesLocalStorage = (`elem` localStorageTemplates) . diskTemplate
 -- | Checks whether a given disk template supported moves.
 supportsMoves :: T.DiskTemplate -> Bool
 supportsMoves = (`elem` movableDiskTemplates)
+
+-- | A simple wrapper over 'T.templateMirrorType'.
+mirrorType :: Instance -> T.MirrorType
+mirrorType = T.templateMirrorType . diskTemplate