Merge 'EvacNode' and 'NodeEvacMode'

[ganeti-local] / src / Ganeti / HTools / Backend / IAlloc.hs

diff --git a/src/Ganeti/HTools/Backend/IAlloc.hs b/src/Ganeti/HTools/Backend/IAlloc.hs
index 65cbf3d..27dc2e6 100644 (file)
--- a/src/Ganeti/HTools/Backend/IAlloc.hs
+++ b/src/Ganeti/HTools/Backend/IAlloc.hs
@@ -44,11 +44,13 @@ import qualified Ganeti.HTools.Container as Container
 import qualified Ganeti.HTools.Group as Group
 import qualified Ganeti.HTools.Node as Node
 import qualified Ganeti.HTools.Instance as Instance
+import qualified Ganeti.HTools.Nic as Nic
 import qualified Ganeti.Constants as C
 import Ganeti.HTools.CLI
 import Ganeti.HTools.Loader
 import Ganeti.HTools.Types
 import Ganeti.JSON
+import Ganeti.Types (EvacMode(ChangePrimary, ChangeSecondary))
 import Ganeti.Utils
 
 {-# ANN module "HLint: ignore Eta reduce" #-}
@@ -56,6 +58,22 @@ import Ganeti.Utils
 -- | Type alias for the result of an IAllocator call.
 type IAllocResult = (String, JSValue, Node.List, Instance.List)
 
+-- | Parse a NIC within an instance (in a creation request)
+parseNic :: String -> JSRecord -> Result Nic.Nic
+parseNic n a = do
+  mac     <- maybeFromObj a "mac"
+  ip      <- maybeFromObj a "ip"
+  mode    <- maybeFromObj a "mode" >>= \m -> case m of
+               Just "bridged" -> Ok $ Just Nic.Bridged
+               Just "routed" -> Ok $ Just Nic.Routed
+               Just "openvswitch" -> Ok $ Just Nic.OpenVSwitch
+               Nothing -> Ok Nothing
+               _ -> Bad $ "invalid NIC mode in instance " ++ n
+  link    <- maybeFromObj a "link"
+  bridge  <- maybeFromObj a "bridge"
+  network <- maybeFromObj a "network"
+  return (Nic.create mac ip mode link bridge network)
+
 -- | Parse the basic specifications of an instance.
 --
 -- Instances in the cluster instance list and the instance in an
@@ -68,14 +86,21 @@ parseBaseInstance n a = do
   let errorMessage = "invalid data for instance '" ++ n ++ "'"
   let extract x = tryFromObj errorMessage a x
   disk  <- extract "disk_space_total"
-  disks <- extract "disks" >>= toArray >>= asObjectList >>=
-           mapM (flip (tryFromObj errorMessage) "size" . fromJSObject)
+  jsdisks <- extract "disks" >>= toArray >>= asObjectList
+  dsizes <- mapM (flip (tryFromObj errorMessage) "size" . fromJSObject) jsdisks
+  dspindles <- mapM (annotateResult errorMessage .
+                     flip maybeFromObj "spindles" . fromJSObject) jsdisks
+  let disks = zipWith Instance.Disk dsizes dspindles
   mem   <- extract "memory"
   vcpus <- extract "vcpus"
   tags  <- extract "tags"
   dt    <- extract "disk_template"
   su    <- extract "spindle_use"
-  return (n, Instance.create n mem disk disks vcpus Running tags True 0 0 dt su)
+  nics  <- extract "nics" >>= toArray >>= asObjectList >>=
+           mapM (parseNic n . fromJSObject)
+  return
+    (n,
+     Instance.create n mem disk disks vcpus Running tags True 0 0 dt su nics)
 
 -- | Parses an instance as found in the cluster instance list.
 parseInstance :: NameAssoc -- ^ The node name-to-index association list
@@ -109,20 +134,23 @@ parseNode ktg n a = do
   vm_capable  <- annotateResult desc $ maybeFromObj a "vm_capable"
   let vm_capable' = fromMaybe True vm_capable
   gidx <- lookupGroup ktg n guuid
-  node <- if offline || drained || not vm_capable'
-            then return $ Node.create n 0 0 0 0 0 0 True 0 gidx
-            else do
-              mtotal <- extract "total_memory"
-              mnode  <- extract "reserved_memory"
-              mfree  <- extract "free_memory"
-              dtotal <- extract "total_disk"
-              dfree  <- extract "free_disk"
-              ctotal <- extract "total_cpus"
-              ndparams <- extract "ndparams" >>= asJSObject
-              spindles <- tryFromObj desc (fromJSObject ndparams)
-                          "spindle_count"
-              return $ Node.create n mtotal mnode mfree
-                     dtotal dfree ctotal False spindles gidx
+  ndparams <- extract "ndparams" >>= asJSObject
+  excl_stor <- tryFromObj desc (fromJSObject ndparams) "exclusive_storage"
+  let live = not offline && not drained && vm_capable'
+      lvextract def = eitherLive live def . extract
+  sptotal <- if excl_stor
+             then lvextract 0 "total_spindles"
+             else tryFromObj desc (fromJSObject ndparams) "spindle_count"
+  spfree <- lvextract 0 "free_spindles"
+  mtotal <- lvextract 0.0 "total_memory"
+  mnode  <- lvextract 0 "reserved_memory"
+  mfree  <- lvextract 0 "free_memory"
+  dtotal <- lvextract 0.0 "total_disk"
+  dfree  <- lvextract 0 "free_disk"
+  ctotal <- lvextract 0.0 "total_cpus"
+  cnos <- lvextract 0 "reserved_cpus"
+  let node = Node.create n mtotal mnode mfree dtotal dfree ctotal cnos
+             (not live) sptotal spfree gidx excl_stor
   return (n, node)
 
 -- | Parses a group as found in the cluster group list.
@@ -133,9 +161,10 @@ parseGroup u a = do
   let extract x = tryFromObj ("invalid data for group '" ++ u ++ "'") a x
   name <- extract "name"
   apol <- extract "alloc_policy"
+  nets <- extract "networks"
   ipol <- extract "ipolicy"
   tags <- extract "tags"
-  return (u, Group.create name u apol ipol tags)
+  return (u, Group.create name u apol nets ipol tags)
 
 -- | Top-level parser.
 --