Revision 54365762 Ganeti/HTools/IAlloc.hs

b/Ganeti/HTools/IAlloc.hs
131 131 
              let ex_nodes' = map (stripSuffix $ length csf) ex_nodes
132 132 
              ex_idex <- mapM (Container.findByName map_n) ex_nodes'
133 133 
              return $ Relocate ridx req_nodes (map Node.idx ex_idex)
134 
        "multi-evacuate" ->
135 
            do
136 
              ex_names <- fromObj "evac_nodes" request
137 
              ex_nodes <- mapM (Container.findByName map_n) ex_names
138 
              let ex_ndx = map Node.idx ex_nodes
139 
              return $ Evacuate ex_ndx
134 140 
        other -> fail ("Invalid request type '" ++ other ++ "'")
135 141 
  return $ Request rqtype map_n map_i ptags csf
136 142 

  		





  
  143
  
    
formatRVal :: String -> RqType


  		





  
  144
  
    
           -> [Node.AllocElement] -> JSValue


  		





  
  145
  
    
formatRVal csf (Evacuate _) elems =


  		





  
  146
  
    
    let sols = map (\(_, inst, nl) ->


  		





  
  147
  
    
                        let names = Instance.name inst : map Node.name nl


  		





  
  148
  
    
                        in map (++ csf) names) elems


  		





  
  149
  
    
        jsols = map (JSArray . map (JSString . toJSString)) sols


  		





  
  150
  
    
    in JSArray jsols


  		





  
  151
  
    

  		





  
  152
  
    
formatRVal csf _ elems =


  		





  
  153
  
    
    let (_, _, nodes) = head elems


  		





  
  154
  
    
        nodes' = map ((++ csf) . Node.name) nodes


  		





  
  155
  
    
    in JSArray $ map (JSString . toJSString) nodes'


  		





  
  156
  
    

  		





  
  157
  
    

  		





  137
  158
  
    
-- | Formats the response into a valid IAllocator response message.


  		





  138
  159
  
    
formatResponse :: Bool     -- ^ Whether the request was successful


  		





  139
  160
  
    
               -> String   -- ^ Information text


  		





  140
  
  
    
               -> [String] -- ^ The list of chosen nodes


  		





  
  161
  
    
               -> String   -- ^ Suffix for nodes/instances


  		





  
  162
  
    
               -> RqType   -- ^ Request type


  		





  
  163
  
    
               -> [Node.AllocElement] -- ^ The resulting allocations


  		





  141
  164
  
    
               -> String   -- ^ The JSON-formatted message


  		





  142
  
  
    
formatResponse success info nodes =


  		





  
  165
  
    
formatResponse success info csf rq elems =


  		





  143
  166
  
    
    let


  		





  144
  167
  
    
        e_success = ("success", JSBool success)


  		





  145
  168
  
    
        e_info = ("info", JSString . toJSString $ info)


  		





  146
  
  
    
        e_nodes = ("nodes", JSArray $ map (JSString . toJSString) nodes)


  		





  
  169
  
    
        e_nodes = ("nodes", formatRVal csf rq elems)


  		





  147
  170
  
    
    in encodeStrict $ makeObj [e_success, e_info, e_nodes]


  		












Also available in:
  Unified diff