Add a separate function for looking up instances

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

diff --git a/Ganeti/HTools/IAlloc.hs b/Ganeti/HTools/IAlloc.hs
index f6a2733..bafde49 100644 (file)
--- a/Ganeti/HTools/IAlloc.hs
+++ b/Ganeti/HTools/IAlloc.hs
@@ -6,6 +6,8 @@ module Ganeti.HTools.IAlloc
     (
       parseData
     , formatResponse
+    , RqType(..)
+    , Request(..)
     ) where
 
 import Data.Either ()
@@ -15,6 +17,7 @@ import Text.JSON (JSObject, JSValue(JSBool, JSString, JSArray),
                   makeObj, encodeStrict, decodeStrict,
                   fromJSObject, toJSString)
 --import Text.Printf (printf)
+import qualified Ganeti.HTools.Container as Container
 import qualified Ganeti.HTools.Node as Node
 import qualified Ganeti.HTools.Instance as Instance
 import Ganeti.HTools.Loader
@@ -22,11 +25,11 @@ import Ganeti.HTools.Utils
 import Ganeti.HTools.Types
 
 data RqType
-    = Allocate String Instance.Instance
-    | Relocate Int
+    = Allocate Instance.Instance Int
+    | Relocate Idx Int [Ndx]
     deriving (Show)
 
-data Request = Request RqType IdxNode IdxInstance NameList NameList
+data Request = Request RqType Node.List Instance.List String
     deriving (Show)
 
 parseBaseInstance :: String
@@ -53,23 +56,28 @@ parseInstance ktn n a = do
     base <- parseBaseInstance n a
     nodes <- fromObj "nodes" a
     pnode <- readEitherString $ head nodes
-    snode <- readEitherString $ (head . tail) nodes
     pidx <- lookupNode ktn n pnode
-    sidx <- lookupNode ktn n snode
+    let snodes = tail nodes
+    sidx <- (if null snodes then return Node.noSecondary
+             else (readEitherString $ head snodes) >>= lookupNode ktn n)
     return (n, Instance.setBoth (snd base) pidx sidx)
 
 parseNode :: String -> JSObject JSValue -> Result (String, Node.Node)
 parseNode n a = do
     let name = n
-    mtotal <- fromObj "total_memory" a
-    mnode <- fromObj "reserved_memory" a
-    mfree <- fromObj "free_memory" a
-    dtotal <- fromObj "total_disk" a
-    dfree <- fromObj "free_disk" a
     offline <- fromObj "offline" a
-    drained <- fromObj "offline" a
-    return $ (name, Node.create n mtotal mnode mfree dtotal dfree
-                      (offline || drained))
+    drained <- fromObj "drained" a
+    node <- (case offline of
+               True -> return $ Node.create name 0 0 0 0 0 True
+               _ -> do
+                 mtotal <- fromObj "total_memory" a
+                 mnode <- fromObj "reserved_memory" a
+                 mfree <- fromObj "free_memory" a
+                 dtotal <- fromObj "total_disk" a
+                 dfree <- fromObj "free_disk" a
+                 return $ Node.create n mtotal mnode mfree
+                        dtotal dfree (offline || drained))
+    return (name, node)
 
 parseData :: String -> Result Request
 parseData body = do
@@ -82,27 +90,31 @@ parseData body = do
   nlist <- fromObj "nodes" obj
   let ndata = fromJSObject nlist
   nobj <- (mapM (\(x,y) -> asJSObject y >>= parseNode x)) ndata
-  let (ktn, nl) = assignIndices Node.setIdx nobj
+  let (ktn, nl) = assignIndices nobj
   -- existing instance parsing
   ilist <- fromObj "instances" obj
   let idata = fromJSObject ilist
   iobj <- (mapM (\(x,y) -> asJSObject y >>= parseInstance ktn x)) idata
-  let (kti, il) = assignIndices Instance.setIdx iobj
+  let (kti, il) = assignIndices iobj
+  (map_n, map_i, csf) <- mergeData (nl, il)
+  req_nodes <- fromObj "required_nodes" request
   optype <- fromObj "type" request
   rqtype <-
       case optype of
         "allocate" ->
             do
               inew <- parseBaseInstance rname request
-              let (iname, io) = inew
-              return $ Allocate iname io
+              let io = snd inew
+              return $ Allocate io req_nodes
         "relocate" ->
             do
-              ridx <- lookupNode kti rname rname
-              return $ Relocate ridx
+              ridx <- lookupInstance kti rname
+              ex_nodes <- fromObj "relocate_from" request
+              let ex_nodes' = map (stripSuffix $ length csf) ex_nodes
+              ex_idex <- mapM (Container.findByName map_n) ex_nodes'
+              return $ Relocate ridx req_nodes ex_idex
         other -> fail $ ("Invalid request type '" ++ other ++ "'")
-
-  return $ Request rqtype nl il (swapPairs ktn) (swapPairs kti)
+  return $ Request rqtype map_n map_i csf
 
 formatResponse :: Bool -> String -> [String] -> String
 formatResponse success info nodes =