Commit 669ea132 authored by Iustin Pop's avatar Iustin Pop
Browse files

Read cluster tags in the IAllocator backend

parent f89235f1
......@@ -110,7 +110,9 @@ parseData body = do
iobj <- mapM (\(x,y) ->
asJSObject y >>= parseInstance ktn x . fromJSObject) idata
let (kti, il) = assignIndices iobj
(map_n, map_i, _, csf) <- mergeData [] [] (nl, il, [])
-- cluster tags
ctags <- fromObj "cluster_tags" obj
(map_n, map_i, ptags, csf) <- mergeData [] [] (nl, il, ctags)
req_nodes <- fromObj "required_nodes" request
optype <- fromObj "type" request
rqtype <-
......@@ -128,7 +130,7 @@ parseData body = do
ex_idex <- mapM (Container.findByName map_n) ex_nodes'
return $ Relocate ridx req_nodes (map Node.idx ex_idex)
other -> fail ("Invalid request type '" ++ other ++ "'")
return $ Request rqtype map_n map_i csf
return $ Request rqtype map_n map_i ptags csf
-- | Formats the response into a valid IAllocator response message.
formatResponse :: Bool -- ^ Whether the request was successful
......
......@@ -63,7 +63,7 @@ data RqType
deriving (Show)
-- | A complete request, as received from Ganeti.
data Request = Request RqType Node.List Instance.List String
data Request = Request RqType Node.List Instance.List [String] String
deriving (Show)
-- * Functions
......
......@@ -62,7 +62,7 @@ processResults (fstats, successes, sols) =
processRequest :: Request
-> Result Cluster.AllocSolution
processRequest request =
let Request rqtype nl il _ = request
let Request rqtype nl il _ _ = request
in case rqtype of
Allocate xi reqn -> Cluster.tryAlloc nl il xi reqn
Relocate idx reqn exnodes -> Cluster.tryReloc nl il idx reqn exnodes
......@@ -86,7 +86,7 @@ main = do
exitWith $ ExitFailure 1
Ok rq -> return rq
let Request _ _ _ csf = request
let Request _ _ _ _ csf = request
sols = processRequest request >>= processResults
let (ok, info, rn) =
case sols of
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment