Add Cluster.splitCluster for node groups

[ganeti-local] / Ganeti / HTools / Instance.hs

diff --git a/Ganeti/HTools/Instance.hs b/Ganeti/HTools/Instance.hs
index d14ad93..6bcf88e 100644 (file)
--- a/Ganeti/HTools/Instance.hs
+++ b/Ganeti/HTools/Instance.hs
@@ -33,12 +33,14 @@ module Ganeti.HTools.Instance
     , create
     , setIdx
     , setName
     , create
     , setIdx
     , setName

+    , setAlias

     , setPri
     , setSec
     , setBoth
     , setMovable
     , specOf
     , shrinkByType
     , setPri
     , setSec
     , setBoth
     , setMovable
     , specOf
     , shrinkByType

+    , runningStates

     ) where
 
 import qualified Ganeti.HTools.Types as T
     ) where
 
 import qualified Ganeti.HTools.Types as T

@@ -48,6 +50,7 @@ import qualified Ganeti.HTools.Container as Container
 
 -- | The instance type
 data Instance = Instance { name :: String    -- ^ The instance name
 
 -- | 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
                          , mem :: Int        -- ^ Memory of the instance
                          , dsk :: Int        -- ^ Disk size of instance
                          , vcpus :: Int      -- ^ Number of VCPUs

@@ -62,20 +65,15 @@ data Instance = Instance { name :: String    -- ^ The instance name
                          } deriving (Show)
 
 instance T.Element Instance where
                          } deriving (Show)
 
 instance T.Element Instance where

-    nameOf  = name
-    idxOf   = idx
-    setName = setName
-    setIdx  = setIdx
-
--- | Base memory unit.
-unitMem :: Int
-unitMem = 64
--- | Base disk unit.
-unitDsk :: Int
-unitDsk = 256
--- | Base vcpus unit.
-unitCpu :: Int
-unitCpu = 1
+    nameOf   = name
+    idxOf    = idx
+    setAlias = setAlias
+    setIdx   = setIdx
+    allNames n = [name n, alias n]
+
+-- | Running instance states.
+runningStates :: [String]
+runningStates = ["running", "ERROR_up"]

 
 -- | A simple name for the int, instance association list.
 type AssocList = [(T.Idx, Instance)]
 
 -- | A simple name for the int, instance association list.
 type AssocList = [(T.Idx, Instance)]

@@ -93,10 +91,11 @@ create :: String -> Int -> Int -> Int -> String
        -> [String] -> T.Ndx -> T.Ndx -> Instance
 create name_init mem_init dsk_init vcpus_init run_init tags_init pn sn =
     Instance { name = name_init
        -> [String] -> T.Ndx -> T.Ndx -> Instance
 create name_init mem_init dsk_init vcpus_init run_init tags_init pn sn =
     Instance { name = name_init

+             , alias = name_init

              , mem = mem_init
              , dsk = dsk_init
              , vcpus = vcpus_init
              , mem = mem_init
              , dsk = dsk_init
              , vcpus = vcpus_init

-             , running = run_init == "running" || run_init == "ERROR_up"
+             , running = run_init `elem` runningStates

              , runSt = run_init
              , pNode = pn
              , sNode = sn
              , runSt = run_init
              , pNode = pn
              , sNode = sn

@@ -120,7 +119,15 @@ setIdx t i = t { idx = i }
 setName :: Instance -- ^ The original instance
         -> String   -- ^ New name
         -> Instance -- ^ The modified instance
 setName :: Instance -- ^ The original instance
         -> String   -- ^ New name
         -> Instance -- ^ The modified instance

-setName t s = t { name = s }
+setName t s = t { name = s, alias = s }
+
+-- | Changes the alias.
+--
+-- This is used only during the building of the data structures.
+setAlias :: Instance -- ^ The original instance
+         -> String   -- ^ New alias
+         -> Instance -- ^ The modified instance
+setAlias t s = t { alias = s }

 
 -- * Update functions
 
 
 -- * Update functions
 

@@ -151,16 +158,16 @@ 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
 -- | Try to shrink the instance based on the reason why we can't
 -- allocate it.
 shrinkByType :: Instance -> T.FailMode -> T.Result Instance

-shrinkByType inst T.FailMem = let v = mem inst - unitMem
-                              in if v < unitMem
+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 T.Bad "out of memory"
                                  else T.Ok inst { mem = v }

-shrinkByType inst T.FailDisk = let v = dsk inst - unitDsk
-                               in if v < unitDsk
+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 T.Bad "out of disk"
                                   else T.Ok inst { dsk = v }

-shrinkByType inst T.FailCPU = let v = vcpus inst - unitCpu
-                              in if v < unitCpu
+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 T.Bad "out of vcpus"
                                  else T.Ok inst { vcpus = v }
 shrinkByType _ f = T.Bad $ "Unhandled failure mode " ++ show f