Reduce the warnings during the unittests
[ganeti-local] / Ganeti / HTools / Instance.hs
index d562005..6bcf88e 100644 (file)
@@ -26,7 +26,22 @@ Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
 
 -}
 
-module Ganeti.HTools.Instance where
+module Ganeti.HTools.Instance
+    ( Instance(..)
+    , AssocList
+    , List
+    , create
+    , setIdx
+    , setName
+    , setAlias
+    , setPri
+    , setSec
+    , setBoth
+    , setMovable
+    , specOf
+    , shrinkByType
+    , runningStates
+    ) where
 
 import qualified Ganeti.HTools.Types as T
 import qualified Ganeti.HTools.Container as Container
@@ -34,23 +49,31 @@ import qualified Ganeti.HTools.Container as Container
 -- * Type declarations
 
 -- | The instance type
-data Instance = Instance { name :: String   -- ^ The instance name
-                         , mem :: Int       -- ^ Memory of the instance
-                         , dsk :: Int       -- ^ Disk size of instance
-                         , running :: Bool  -- ^ Whether the instance
-                                            -- is running
-                         , run_st :: String -- ^ Original (text) run status
-                         , pnode :: T.Ndx   -- ^ Original primary node
-                         , snode :: T.Ndx   -- ^ Original secondary node
-                         , idx :: T.Idx     -- ^ Internal index for
-                                            -- book-keeping
+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 :: String   -- ^ Original (text) 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 the instance be moved?
+                         , tags :: [String]  -- ^ List of instance tags
                          } deriving (Show)
 
 instance T.Element Instance where
-    nameOf  = name
-    idxOf   = idx
-    setName = setName
-    setIdx  = setIdx
+    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)]
@@ -64,28 +87,30 @@ 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 -> String -> T.Ndx -> T.Ndx -> Instance
-create name_init mem_init dsk_init run_init pn sn =
-    Instance {
-          name = name_init,
-          mem = mem_init,
-          dsk = dsk_init,
-          running = case run_init of
-                      "running" -> True
-                      "ERROR_up" -> True
-                      _ -> False,
-          run_st = run_init,
-          pnode = pn,
-          snode = sn,
-          idx = -1
-        }
+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
+             , 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 = True
+             }
 
 -- | Changes the index.
 --
 -- This is used only during the building of the data structures.
-setIdx :: Instance  -- ^ the original instance
-        -> T.Idx    -- ^ new index
-        -> Instance -- ^ the modified instance
+setIdx :: Instance -- ^ The original instance
+       -> T.Idx    -- ^ New index
+       -> Instance -- ^ The modified instance
 setIdx t i = t { idx = i }
 
 -- | Changes the name.
@@ -93,8 +118,16 @@ setIdx t i = t { idx = i }
 -- This is used only during the building of the data structures.
 setName :: Instance -- ^ The original instance
         -> String   -- ^ New name
-        -> Instance
-setName t s = t { name = s }
+        -> Instance -- ^ The modified instance
+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
 
@@ -102,17 +135,44 @@ setName t s = t { name = s }
 setPri :: Instance  -- ^ the original instance
         -> T.Ndx    -- ^ the new primary node
         -> Instance -- ^ the modified instance
-setPri t p = t { pnode = p }
+setPri t p = t { pNode = p }
 
 -- | Changes the secondary node of the instance.
 setSec :: Instance  -- ^ the original instance
         -> T.Ndx    -- ^ the new secondary node
         -> Instance -- ^ the modified instance
-setSec t s = t { snode = s }
+setSec t s = t { sNode = s }
 
 -- | Changes both nodes of the instance.
 setBoth :: Instance  -- ^ the original instance
          -> T.Ndx    -- ^ new primary node index
          -> T.Ndx    -- ^ new secondary node index
          -> Instance -- ^ the modified instance
-setBoth t p s = t { pnode = p, snode = s }
+setBoth t p s = t { pNode = p, sNode = s }
+
+setMovable :: Instance -- ^ The original instance
+           -> Bool     -- ^ New movable flag
+           -> Instance -- ^ The modified instance
+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 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 }
+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 }
+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
+
+-- | 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 }