root / htools / Ganeti / HTools / IAlloc.hs @ d6cf394e
History | View | Annotate | Download (11.9 kB)
1 | 43643696 | Iustin Pop | {-| Implementation of the iallocator interface. |
---|---|---|---|
2 | 43643696 | Iustin Pop | |
3 | 43643696 | Iustin Pop | -} |
4 | 43643696 | Iustin Pop | |
5 | e2fa2baf | Iustin Pop | {- |
6 | e2fa2baf | Iustin Pop | |
7 | e8230242 | Iustin Pop | Copyright (C) 2009, 2010, 2011 Google Inc. |
8 | e2fa2baf | Iustin Pop | |
9 | e2fa2baf | Iustin Pop | This program is free software; you can redistribute it and/or modify |
10 | e2fa2baf | Iustin Pop | it under the terms of the GNU General Public License as published by |
11 | e2fa2baf | Iustin Pop | the Free Software Foundation; either version 2 of the License, or |
12 | e2fa2baf | Iustin Pop | (at your option) any later version. |
13 | e2fa2baf | Iustin Pop | |
14 | e2fa2baf | Iustin Pop | This program is distributed in the hope that it will be useful, but |
15 | e2fa2baf | Iustin Pop | WITHOUT ANY WARRANTY; without even the implied warranty of |
16 | e2fa2baf | Iustin Pop | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU |
17 | e2fa2baf | Iustin Pop | General Public License for more details. |
18 | e2fa2baf | Iustin Pop | |
19 | e2fa2baf | Iustin Pop | You should have received a copy of the GNU General Public License |
20 | e2fa2baf | Iustin Pop | along with this program; if not, write to the Free Software |
21 | e2fa2baf | Iustin Pop | Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA |
22 | e2fa2baf | Iustin Pop | 02110-1301, USA. |
23 | e2fa2baf | Iustin Pop | |
24 | e2fa2baf | Iustin Pop | -} |
25 | e2fa2baf | Iustin Pop | |
26 | 43643696 | Iustin Pop | module Ganeti.HTools.IAlloc |
27 | 00152519 | Iustin Pop | ( readRequest |
28 | 00152519 | Iustin Pop | , runIAllocator |
29 | 43643696 | Iustin Pop | ) where |
30 | 43643696 | Iustin Pop | |
31 | 43643696 | Iustin Pop | import Data.Either () |
32 | 00152519 | Iustin Pop | import Data.Maybe (fromMaybe, isJust) |
33 | cabce2f4 | Iustin Pop | import Data.List |
34 | 43643696 | Iustin Pop | import Control.Monad |
35 | 942403e6 | Iustin Pop | import Text.JSON (JSObject, JSValue(JSBool, JSString, JSArray), |
36 | 942403e6 | Iustin Pop | makeObj, encodeStrict, decodeStrict, |
37 | 942403e6 | Iustin Pop | fromJSObject, toJSString) |
38 | cabce2f4 | Iustin Pop | import System (exitWith, ExitCode(..)) |
39 | cabce2f4 | Iustin Pop | import System.IO |
40 | cabce2f4 | Iustin Pop | |
41 | cabce2f4 | Iustin Pop | import qualified Ganeti.HTools.Cluster as Cluster |
42 | 262a08a2 | Iustin Pop | import qualified Ganeti.HTools.Container as Container |
43 | a679e9dc | Iustin Pop | import qualified Ganeti.HTools.Group as Group |
44 | 942403e6 | Iustin Pop | import qualified Ganeti.HTools.Node as Node |
45 | 942403e6 | Iustin Pop | import qualified Ganeti.HTools.Instance as Instance |
46 | df5227dc | Iustin Pop | import qualified Ganeti.Constants as C |
47 | cabce2f4 | Iustin Pop | import Ganeti.HTools.CLI |
48 | e4c5beaf | Iustin Pop | import Ganeti.HTools.Loader |
49 | cabce2f4 | Iustin Pop | import Ganeti.HTools.ExtLoader (loadExternalData) |
50 | e4c5beaf | Iustin Pop | import Ganeti.HTools.Utils |
51 | e4c5beaf | Iustin Pop | import Ganeti.HTools.Types |
52 | 43643696 | Iustin Pop | |
53 | 9188aeef | Iustin Pop | -- | Parse the basic specifications of an instance. |
54 | 9188aeef | Iustin Pop | -- |
55 | 9188aeef | Iustin Pop | -- Instances in the cluster instance list and the instance in an |
56 | 9188aeef | Iustin Pop | -- 'Allocate' request share some common properties, which are read by |
57 | 9188aeef | Iustin Pop | -- this function. |
58 | e4c5beaf | Iustin Pop | parseBaseInstance :: String |
59 | 28f19313 | Iustin Pop | -> JSRecord |
60 | e4c5beaf | Iustin Pop | -> Result (String, Instance.Instance) |
61 | e4c5beaf | Iustin Pop | parseBaseInstance n a = do |
62 | e8230242 | Iustin Pop | let extract x = tryFromObj ("invalid data for instance '" ++ n ++ "'") a x |
63 | e8230242 | Iustin Pop | disk <- extract "disk_space_total" |
64 | e8230242 | Iustin Pop | mem <- extract "memory" |
65 | e8230242 | Iustin Pop | vcpus <- extract "vcpus" |
66 | e8230242 | Iustin Pop | tags <- extract "tags" |
67 | e4c5beaf | Iustin Pop | let running = "running" |
68 | c352b0a9 | Iustin Pop | return (n, Instance.create n mem disk vcpus running tags True 0 0) |
69 | 585d4420 | Iustin Pop | |
70 | 525bfb36 | Iustin Pop | -- | Parses an instance as found in the cluster instance list. |
71 | 28f19313 | Iustin Pop | parseInstance :: NameAssoc -- ^ The node name-to-index association list |
72 | 28f19313 | Iustin Pop | -> String -- ^ The name of the instance |
73 | 28f19313 | Iustin Pop | -> JSRecord -- ^ The JSON object |
74 | e4c5beaf | Iustin Pop | -> Result (String, Instance.Instance) |
75 | e4c5beaf | Iustin Pop | parseInstance ktn n a = do |
76 | 262f3e6c | Iustin Pop | base <- parseBaseInstance n a |
77 | e8230242 | Iustin Pop | nodes <- fromObj a "nodes" |
78 | e41f4ba0 | Iustin Pop | pnode <- if null nodes |
79 | e41f4ba0 | Iustin Pop | then Bad $ "empty node list for instance " ++ n |
80 | e41f4ba0 | Iustin Pop | else readEitherString $ head nodes |
81 | 262f3e6c | Iustin Pop | pidx <- lookupNode ktn n pnode |
82 | 262f3e6c | Iustin Pop | let snodes = tail nodes |
83 | 262f3e6c | Iustin Pop | sidx <- (if null snodes then return Node.noSecondary |
84 | 262f3e6c | Iustin Pop | else readEitherString (head snodes) >>= lookupNode ktn n) |
85 | 262f3e6c | Iustin Pop | return (n, Instance.setBoth (snd base) pidx sidx) |
86 | 585d4420 | Iustin Pop | |
87 | 9188aeef | Iustin Pop | -- | Parses a node as found in the cluster node list. |
88 | 28f19313 | Iustin Pop | parseNode :: NameAssoc -- ^ The group association |
89 | 28f19313 | Iustin Pop | -> String -- ^ The node's name |
90 | 28f19313 | Iustin Pop | -> JSRecord -- ^ The JSON object |
91 | 9188aeef | Iustin Pop | -> Result (String, Node.Node) |
92 | 10ef6b4e | Iustin Pop | parseNode ktg n a = do |
93 | 3eeea90f | Iustin Pop | let desc = "invalid data for node '" ++ n ++ "'" |
94 | 3eeea90f | Iustin Pop | extract x = tryFromObj desc a x |
95 | e8230242 | Iustin Pop | offline <- extract "offline" |
96 | e8230242 | Iustin Pop | drained <- extract "drained" |
97 | e8230242 | Iustin Pop | guuid <- extract "group" |
98 | 3eeea90f | Iustin Pop | vm_capable <- annotateResult desc $ maybeFromObj a "vm_capable" |
99 | 3eeea90f | Iustin Pop | let vm_capable' = fromMaybe True vm_capable |
100 | 10ef6b4e | Iustin Pop | gidx <- lookupGroup ktg n guuid |
101 | 3eeea90f | Iustin Pop | node <- (if offline || drained || not vm_capable' |
102 | 10ef6b4e | Iustin Pop | then return $ Node.create n 0 0 0 0 0 0 True gidx |
103 | 262f3e6c | Iustin Pop | else do |
104 | e8230242 | Iustin Pop | mtotal <- extract "total_memory" |
105 | e8230242 | Iustin Pop | mnode <- extract "reserved_memory" |
106 | e8230242 | Iustin Pop | mfree <- extract "free_memory" |
107 | e8230242 | Iustin Pop | dtotal <- extract "total_disk" |
108 | e8230242 | Iustin Pop | dfree <- extract "free_disk" |
109 | e8230242 | Iustin Pop | ctotal <- extract "total_cpus" |
110 | 262f3e6c | Iustin Pop | return $ Node.create n mtotal mnode mfree |
111 | 10ef6b4e | Iustin Pop | dtotal dfree ctotal False gidx) |
112 | 262f3e6c | Iustin Pop | return (n, node) |
113 | 144f190b | Iustin Pop | |
114 | a679e9dc | Iustin Pop | -- | Parses a group as found in the cluster group list. |
115 | 28f19313 | Iustin Pop | parseGroup :: String -- ^ The group UUID |
116 | 28f19313 | Iustin Pop | -> JSRecord -- ^ The JSON object |
117 | a679e9dc | Iustin Pop | -> Result (String, Group.Group) |
118 | a679e9dc | Iustin Pop | parseGroup u a = do |
119 | 1b2cb110 | Iustin Pop | let extract x = tryFromObj ("invalid data for group '" ++ u ++ "'") a x |
120 | 1b2cb110 | Iustin Pop | name <- extract "name" |
121 | 1b2cb110 | Iustin Pop | apol <- extract "alloc_policy" |
122 | 1b2cb110 | Iustin Pop | return (u, Group.create name u apol) |
123 | a679e9dc | Iustin Pop | |
124 | 28f19313 | Iustin Pop | parseTargetGroups :: JSRecord -- ^ The JSON object (request dict) |
125 | 28f19313 | Iustin Pop | -> Group.List -- ^ The existing groups |
126 | 695c1bab | Iustin Pop | -> Result [Gdx] |
127 | 695c1bab | Iustin Pop | parseTargetGroups req map_g = do |
128 | 695c1bab | Iustin Pop | group_uuids <- fromObjWithDefault req "target_groups" [] |
129 | 695c1bab | Iustin Pop | mapM (liftM Group.idx . Container.findByName map_g) group_uuids |
130 | 695c1bab | Iustin Pop | |
131 | 9188aeef | Iustin Pop | -- | Top-level parser. |
132 | 9188aeef | Iustin Pop | parseData :: String -- ^ The JSON message as received from Ganeti |
133 | 9188aeef | Iustin Pop | -> Result Request -- ^ A (possible valid) request |
134 | e4c5beaf | Iustin Pop | parseData body = do |
135 | c96d44df | Iustin Pop | decoded <- fromJResult "Parsing input IAllocator message" (decodeStrict body) |
136 | 262f3e6c | Iustin Pop | let obj = fromJSObject decoded |
137 | e8230242 | Iustin Pop | extrObj x = tryFromObj "invalid iallocator message" obj x |
138 | e4c5beaf | Iustin Pop | -- request parser |
139 | e8230242 | Iustin Pop | request <- liftM fromJSObject (extrObj "request") |
140 | e8230242 | Iustin Pop | let extrReq x = tryFromObj "invalid request dict" request x |
141 | a679e9dc | Iustin Pop | -- existing group parsing |
142 | e8230242 | Iustin Pop | glist <- liftM fromJSObject (extrObj "nodegroups") |
143 | a679e9dc | Iustin Pop | gobj <- mapM (\(x, y) -> asJSObject y >>= parseGroup x . fromJSObject) glist |
144 | 10ef6b4e | Iustin Pop | let (ktg, gl) = assignIndices gobj |
145 | e4c5beaf | Iustin Pop | -- existing node parsing |
146 | e8230242 | Iustin Pop | nlist <- liftM fromJSObject (extrObj "nodes") |
147 | 10ef6b4e | Iustin Pop | nobj <- mapM (\(x,y) -> |
148 | 10ef6b4e | Iustin Pop | asJSObject y >>= parseNode ktg x . fromJSObject) nlist |
149 | 497e30a1 | Iustin Pop | let (ktn, nl) = assignIndices nobj |
150 | e4c5beaf | Iustin Pop | -- existing instance parsing |
151 | e8230242 | Iustin Pop | ilist <- extrObj "instances" |
152 | e4c5beaf | Iustin Pop | let idata = fromJSObject ilist |
153 | 262f3e6c | Iustin Pop | iobj <- mapM (\(x,y) -> |
154 | 262f3e6c | Iustin Pop | asJSObject y >>= parseInstance ktn x . fromJSObject) idata |
155 | 497e30a1 | Iustin Pop | let (kti, il) = assignIndices iobj |
156 | 669ea132 | Iustin Pop | -- cluster tags |
157 | e8230242 | Iustin Pop | ctags <- extrObj "cluster_tags" |
158 | 2d1708e0 | Guido Trotter | cdata <- mergeData [] [] [] [] (ClusterData gl nl il ctags) |
159 | 017a0c3d | Iustin Pop | let map_n = cdNodes cdata |
160 | 695c1bab | Iustin Pop | map_i = cdInstances cdata |
161 | 695c1bab | Iustin Pop | map_g = cdGroups cdata |
162 | e8230242 | Iustin Pop | optype <- extrReq "type" |
163 | e4c5beaf | Iustin Pop | rqtype <- |
164 | df5227dc | Iustin Pop | case () of |
165 | df5227dc | Iustin Pop | _ | optype == C.iallocatorModeAlloc -> |
166 | df5227dc | Iustin Pop | do |
167 | df5227dc | Iustin Pop | rname <- extrReq "name" |
168 | df5227dc | Iustin Pop | req_nodes <- extrReq "required_nodes" |
169 | df5227dc | Iustin Pop | inew <- parseBaseInstance rname request |
170 | df5227dc | Iustin Pop | let io = snd inew |
171 | df5227dc | Iustin Pop | return $ Allocate io req_nodes |
172 | df5227dc | Iustin Pop | | optype == C.iallocatorModeReloc -> |
173 | df5227dc | Iustin Pop | do |
174 | df5227dc | Iustin Pop | rname <- extrReq "name" |
175 | df5227dc | Iustin Pop | ridx <- lookupInstance kti rname |
176 | df5227dc | Iustin Pop | req_nodes <- extrReq "required_nodes" |
177 | df5227dc | Iustin Pop | ex_nodes <- extrReq "relocate_from" |
178 | df5227dc | Iustin Pop | ex_idex <- mapM (Container.findByName map_n) ex_nodes |
179 | df5227dc | Iustin Pop | return $ Relocate ridx req_nodes (map Node.idx ex_idex) |
180 | df5227dc | Iustin Pop | | optype == C.iallocatorModeMevac -> |
181 | df5227dc | Iustin Pop | do |
182 | df5227dc | Iustin Pop | ex_names <- extrReq "evac_nodes" |
183 | df5227dc | Iustin Pop | ex_nodes <- mapM (Container.findByName map_n) ex_names |
184 | df5227dc | Iustin Pop | let ex_ndx = map Node.idx ex_nodes |
185 | df5227dc | Iustin Pop | return $ Evacuate ex_ndx |
186 | 695c1bab | Iustin Pop | | optype == C.iallocatorModeMreloc -> |
187 | 695c1bab | Iustin Pop | do |
188 | 695c1bab | Iustin Pop | rl_names <- extrReq "instances" |
189 | 695c1bab | Iustin Pop | rl_insts <- mapM (Container.findByName map_i) rl_names |
190 | 695c1bab | Iustin Pop | let rl_idx = map Instance.idx rl_insts |
191 | cc532bdd | Iustin Pop | rl_mode <- |
192 | 695c1bab | Iustin Pop | case extrReq "reloc_mode" of |
193 | 695c1bab | Iustin Pop | Ok s | s == C.iallocatorMrelocKeep -> return KeepGroup |
194 | 695c1bab | Iustin Pop | | s == C.iallocatorMrelocChange -> |
195 | 695c1bab | Iustin Pop | do |
196 | 695c1bab | Iustin Pop | tg_groups <- parseTargetGroups request map_g |
197 | 695c1bab | Iustin Pop | return $ ChangeGroup tg_groups |
198 | 695c1bab | Iustin Pop | | s == C.iallocatorMrelocAny -> return AnyGroup |
199 | 695c1bab | Iustin Pop | | otherwise -> Bad $ "Invalid relocate mode " ++ s |
200 | 695c1bab | Iustin Pop | Bad x -> Bad x |
201 | 695c1bab | Iustin Pop | return $ MultiReloc rl_idx rl_mode |
202 | 4e84ca27 | Iustin Pop | | optype == C.iallocatorModeNodeEvac -> |
203 | 4e84ca27 | Iustin Pop | do |
204 | 4e84ca27 | Iustin Pop | rl_names <- extrReq "instances" |
205 | 4e84ca27 | Iustin Pop | rl_insts <- mapM (Container.findByName map_i) rl_names |
206 | 4e84ca27 | Iustin Pop | let rl_idx = map Instance.idx rl_insts |
207 | 4e84ca27 | Iustin Pop | rl_mode <- |
208 | 4e84ca27 | Iustin Pop | case extrReq "evac_mode" of |
209 | 4e84ca27 | Iustin Pop | Ok s | s == C.iallocatorNevacAll -> return ChangeAll |
210 | 4e84ca27 | Iustin Pop | | s == C.iallocatorNevacPri -> return ChangePrimary |
211 | 4e84ca27 | Iustin Pop | | s == C.iallocatorNevacSec -> return ChangeSecondary |
212 | 4e84ca27 | Iustin Pop | | otherwise -> Bad $ "Invalid evacuate mode " ++ s |
213 | 4e84ca27 | Iustin Pop | Bad x -> Bad x |
214 | 4e84ca27 | Iustin Pop | return $ NodeEvacuate rl_idx rl_mode |
215 | 695c1bab | Iustin Pop | |
216 | df5227dc | Iustin Pop | | otherwise -> fail ("Invalid request type '" ++ optype ++ "'") |
217 | 017a0c3d | Iustin Pop | return $ Request rqtype cdata |
218 | 942403e6 | Iustin Pop | |
219 | e41f4ba0 | Iustin Pop | -- | Format the result |
220 | 3e4480e0 | Iustin Pop | formatRVal :: RqType -> [Node.AllocElement] -> JSValue |
221 | 3e4480e0 | Iustin Pop | formatRVal _ [] = JSArray [] |
222 | e41f4ba0 | Iustin Pop | |
223 | 3e4480e0 | Iustin Pop | formatRVal (Evacuate _) elems = |
224 | 7d3f4253 | Iustin Pop | let sols = map (\(_, inst, nl, _) -> Instance.name inst : map Node.name nl) |
225 | 3e4480e0 | Iustin Pop | elems |
226 | 54365762 | Iustin Pop | jsols = map (JSArray . map (JSString . toJSString)) sols |
227 | 54365762 | Iustin Pop | in JSArray jsols |
228 | 54365762 | Iustin Pop | |
229 | 3e4480e0 | Iustin Pop | formatRVal _ elems = |
230 | 7d3f4253 | Iustin Pop | let (_, _, nodes, _) = head elems |
231 | 3e4480e0 | Iustin Pop | nodes' = map Node.name nodes |
232 | 54365762 | Iustin Pop | in JSArray $ map (JSString . toJSString) nodes' |
233 | 54365762 | Iustin Pop | |
234 | d6cf394e | Iustin Pop | -- | Formats the result into a valid IAllocator response message. |
235 | 9188aeef | Iustin Pop | formatResponse :: Bool -- ^ Whether the request was successful |
236 | 9188aeef | Iustin Pop | -> String -- ^ Information text |
237 | d6cf394e | Iustin Pop | -> JSValue -- ^ The JSON encoded result |
238 | d6cf394e | Iustin Pop | -> String -- ^ The full JSON-formatted message |
239 | d6cf394e | Iustin Pop | formatResponse success info result = |
240 | 43643696 | Iustin Pop | let |
241 | 43643696 | Iustin Pop | e_success = ("success", JSBool success) |
242 | 43643696 | Iustin Pop | e_info = ("info", JSString . toJSString $ info) |
243 | d6cf394e | Iustin Pop | e_result = ("result", result) |
244 | b5cec17a | Iustin Pop | in encodeStrict $ makeObj [e_success, e_info, e_result] |
245 | cabce2f4 | Iustin Pop | |
246 | cabce2f4 | Iustin Pop | processResults :: (Monad m) => |
247 | cabce2f4 | Iustin Pop | RqType -> Cluster.AllocSolution |
248 | cabce2f4 | Iustin Pop | -> m Cluster.AllocSolution |
249 | cabce2f4 | Iustin Pop | processResults _ (Cluster.AllocSolution { Cluster.asSolutions = [], |
250 | cabce2f4 | Iustin Pop | Cluster.asLog = msgs }) = |
251 | cabce2f4 | Iustin Pop | fail $ intercalate ", " msgs |
252 | cabce2f4 | Iustin Pop | |
253 | cabce2f4 | Iustin Pop | processResults (Evacuate _) as = return as |
254 | cabce2f4 | Iustin Pop | |
255 | cabce2f4 | Iustin Pop | processResults _ as = |
256 | cabce2f4 | Iustin Pop | case Cluster.asSolutions as of |
257 | cabce2f4 | Iustin Pop | _:[] -> return as |
258 | cabce2f4 | Iustin Pop | _ -> fail "Internal error: multiple allocation solutions" |
259 | cabce2f4 | Iustin Pop | |
260 | cabce2f4 | Iustin Pop | -- | Process a request and return new node lists |
261 | cabce2f4 | Iustin Pop | processRequest :: Request |
262 | cabce2f4 | Iustin Pop | -> Result Cluster.AllocSolution |
263 | cabce2f4 | Iustin Pop | processRequest request = |
264 | cabce2f4 | Iustin Pop | let Request rqtype (ClusterData gl nl il _) = request |
265 | cabce2f4 | Iustin Pop | in case rqtype of |
266 | cabce2f4 | Iustin Pop | Allocate xi reqn -> Cluster.tryMGAlloc gl nl il xi reqn |
267 | cabce2f4 | Iustin Pop | Relocate idx reqn exnodes -> Cluster.tryMGReloc gl nl il |
268 | cabce2f4 | Iustin Pop | idx reqn exnodes |
269 | cabce2f4 | Iustin Pop | Evacuate exnodes -> Cluster.tryMGEvac gl nl il exnodes |
270 | cabce2f4 | Iustin Pop | MultiReloc _ _ -> fail "multi-reloc not handled" |
271 | cabce2f4 | Iustin Pop | NodeEvacuate _ _ -> fail "node-evacuate not handled" |
272 | cabce2f4 | Iustin Pop | |
273 | cabce2f4 | Iustin Pop | -- | Reads the request from the data file(s) |
274 | cabce2f4 | Iustin Pop | readRequest :: Options -> [String] -> IO Request |
275 | cabce2f4 | Iustin Pop | readRequest opts args = do |
276 | cabce2f4 | Iustin Pop | when (null args) $ do |
277 | cabce2f4 | Iustin Pop | hPutStrLn stderr "Error: this program needs an input file." |
278 | cabce2f4 | Iustin Pop | exitWith $ ExitFailure 1 |
279 | cabce2f4 | Iustin Pop | |
280 | cabce2f4 | Iustin Pop | input_data <- readFile (head args) |
281 | cabce2f4 | Iustin Pop | r1 <- case parseData input_data of |
282 | cabce2f4 | Iustin Pop | Bad err -> do |
283 | cabce2f4 | Iustin Pop | hPutStrLn stderr $ "Error: " ++ err |
284 | cabce2f4 | Iustin Pop | exitWith $ ExitFailure 1 |
285 | cabce2f4 | Iustin Pop | Ok rq -> return rq |
286 | cabce2f4 | Iustin Pop | (if isJust (optDataFile opts) || (not . null . optNodeSim) opts |
287 | cabce2f4 | Iustin Pop | then do |
288 | cabce2f4 | Iustin Pop | cdata <- loadExternalData opts |
289 | cabce2f4 | Iustin Pop | let Request rqt _ = r1 |
290 | cabce2f4 | Iustin Pop | return $ Request rqt cdata |
291 | cabce2f4 | Iustin Pop | else return r1) |
292 | 00152519 | Iustin Pop | |
293 | 00152519 | Iustin Pop | -- | Main iallocator pipeline. |
294 | 00152519 | Iustin Pop | runIAllocator :: Request -> String |
295 | 00152519 | Iustin Pop | runIAllocator request = |
296 | 00152519 | Iustin Pop | let Request rq _ = request |
297 | 00152519 | Iustin Pop | sols = processRequest request >>= processResults rq |
298 | 00152519 | Iustin Pop | (ok, info, rn) = |
299 | 00152519 | Iustin Pop | case sols of |
300 | 00152519 | Iustin Pop | Ok as -> (True, "Request successful: " ++ |
301 | 00152519 | Iustin Pop | intercalate ", " (Cluster.asLog as), |
302 | 00152519 | Iustin Pop | Cluster.asSolutions as) |
303 | 00152519 | Iustin Pop | Bad s -> (False, "Request failed: " ++ s, []) |
304 | d6cf394e | Iustin Pop | result = formatRVal rq rn |
305 | d6cf394e | Iustin Pop | resp = formatResponse ok info result |
306 | 00152519 | Iustin Pop | in resp |