X-Git-Url: https://code.grnet.gr/git/ganeti-local/blobdiff_plain/924f9c163a2319861a7eabf5162b8bef844651eb..31463db58ffa3ce346bdbf613a00263d14b17405:/Ganeti/HTools/Types.hs

diff --git a/Ganeti/HTools/Types.hs b/Ganeti/HTools/Types.hs
index 000b7a6..7cab641 100644
--- a/Ganeti/HTools/Types.hs
+++ b/Ganeti/HTools/Types.hs
@@ -4,7 +4,7 @@
 
 {-
 
-Copyright (C) 2009 Google Inc.
+Copyright (C) 2009, 2010 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
@@ -28,6 +28,19 @@ module Ganeti.HTools.Types
     , Ndx
     , NameAssoc
     , Score
+    , Weight
+    , RSpec(..)
+    , DynUtil(..)
+    , zeroUtil
+    , baseUtil
+    , addUtil
+    , subUtil
+    , defVcpuRatio
+    , defReservedDiskRatio
+    , unitMem
+    , unitCpu
+    , unitDsk
+    , unknownField
     , Placement
     , IMove(..)
     , MoveJob
@@ -53,6 +66,42 @@ type NameAssoc = [(String, Int)]
 -- | A separate name for the cluster score type.
 type Score = Double
 
+-- | A separate name for a weight metric.
+type Weight = Double
+
+-- | The resource spec type.
+data RSpec = RSpec
+    { rspecCpu  :: Int  -- ^ Requested VCPUs
+    , rspecMem  :: Int  -- ^ Requested memory
+    , rspecDsk  :: Int  -- ^ Requested disk
+    } deriving (Show, Eq)
+
+-- | 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 }
+
+baseUtil :: DynUtil
+baseUtil = DynUtil { cpuWeight = 1, memWeight = 1
+                   , dskWeight = 1, netWeight = 1 }
+
+addUtil :: DynUtil -> DynUtil -> DynUtil
+addUtil (DynUtil a1 a2 a3 a4) (DynUtil b1 b2 b3 b4) =
+    DynUtil (a1+b1) (a2+b2) (a3+b3) (a4+b4)
+
+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.
@@ -70,6 +119,10 @@ data IMove = Failover                -- ^ Failover the instance (f)
 -- 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]
 
@@ -81,6 +134,26 @@ connTimeout = 15
 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
+
+-- | Base memory unit.
+unitMem :: Int
+unitMem = 64
+
+-- | Base disk unit.
+unitDsk :: Int
+unitDsk = 256
+
+-- | Base vcpus unit.
+unitCpu :: Int
+unitCpu = 1
+
 {-|
 
 This is similar to the JSON library Result type - *very* similar, but
@@ -104,6 +177,7 @@ 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
+              | FailTags -- ^ Failed due to tag exclusion
                 deriving (Eq, Enum, Bounded, Show)
 
 -- | List with failure statistics
@@ -112,6 +186,7 @@ type FailStats = [(FailMode, Int)]
 -- | Either-like data-type customized for our failure modes
 data OpResult a = OpFail FailMode -- ^ Failed operation
                 | OpGood a        -- ^ Success operation
+                  deriving (Show)
 
 instance Monad OpResult where
     (OpGood x) >>= fn = fn x
@@ -122,9 +197,17 @@ instance Monad OpResult where
 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 name of the element
-    setName :: a -> String -> a
+    -- | 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