diff --git a/Ganeti/HTools/IAlloc.hs b/Ganeti/HTools/IAlloc.hs index be9d5063d2138f5df506b4e32212a60129543442..819021c8aea8c32ed3bec6ded99b5bfc4acee778 100644 --- a/Ganeti/HTools/IAlloc.hs +++ b/Ganeti/HTools/IAlloc.hs @@ -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 diff --git a/Ganeti/HTools/Loader.hs b/Ganeti/HTools/Loader.hs index c1ad0a70fb5367e63cb74999e85a3be819e02cf4..385015eae21bb924029d551dff648de5dea4a974 100644 --- a/Ganeti/HTools/Loader.hs +++ b/Ganeti/HTools/Loader.hs @@ -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 diff --git a/hail.hs b/hail.hs index 74c2ac2799cf667f0f86b5cca6a4f3da987689a4..56143c0b15d7e0483de9678beb2ac28e4e6619d4 100644 --- a/hail.hs +++ b/hail.hs @@ -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