Revision 34c5a24a htools/Ganeti/HTools/IAlloc.hs
| b/htools/Ganeti/HTools/IAlloc.hs | ||
|---|---|---|
| 32 | 32 |
import Data.Maybe (fromMaybe, isJust) |
| 33 | 33 |
import Data.List |
| 34 | 34 |
import Control.Monad |
| 35 |
import Text.JSON (JSObject, JSValue(JSBool, JSString, JSArray), |
|
| 36 |
makeObj, encodeStrict, decodeStrict, |
|
| 37 |
fromJSObject, toJSString) |
|
| 35 |
import Text.JSON (JSObject, JSValue(JSArray), |
|
| 36 |
makeObj, encodeStrict, decodeStrict, fromJSObject, showJSON) |
|
| 38 | 37 |
import System (exitWith, ExitCode(..)) |
| 39 | 38 |
import System.IO |
| 40 | 39 |
|
| ... | ... | |
| 226 | 225 |
-> String -- ^ The full JSON-formatted message |
| 227 | 226 |
formatResponse success info result = |
| 228 | 227 |
let |
| 229 |
e_success = ("success", JSBool success)
|
|
| 230 |
e_info = ("info", JSString . toJSString $ info)
|
|
| 228 |
e_success = ("success", showJSON success)
|
|
| 229 |
e_info = ("info", showJSON info)
|
|
| 231 | 230 |
e_result = ("result", result)
|
| 232 | 231 |
in encodeStrict $ makeObj [e_success, e_info, e_result] |
| 233 | 232 |
|
| ... | ... | |
| 243 | 242 |
when (null elems) $ fail info |
| 244 | 243 |
let sols = map (\(_, inst, nl, _) -> Instance.name inst : map Node.name nl) |
| 245 | 244 |
elems |
| 246 |
jsols = map (JSArray . map (JSString . toJSString)) sols |
|
| 247 |
return (info, JSArray jsols) |
|
| 245 |
return (info, showJSON sols) |
|
| 248 | 246 |
|
| 249 | 247 |
-- | Convert allocation/relocation results into the result format. |
| 250 | 248 |
formatAllocate :: Cluster.AllocSolution -> Result IAllocResult |
| ... | ... | |
| 252 | 250 |
let info = describeSolution as |
| 253 | 251 |
case Cluster.asSolutions as of |
| 254 | 252 |
[] -> fail info |
| 255 |
(_, _, nodes, _):[] -> do |
|
| 256 |
let nodes' = map Node.name nodes |
|
| 257 |
return (info, JSArray $ map (JSString . toJSString) nodes') |
|
| 253 |
(_, _, nodes, _):[] -> return (info, showJSON $ map (Node.name) nodes) |
|
| 258 | 254 |
_ -> fail "Internal error: multiple allocation solutions" |
| 259 | 255 |
|
| 260 | 256 |
-- | Process a request and return new node lists |
Also available in: Unified diff