Revision cdd495ae htools/Ganeti/Luxi.hs
b/htools/Ganeti/Luxi.hs | ||
---|---|---|
37 | 37 |
, callMethod |
38 | 38 |
, submitManyJobs |
39 | 39 |
, queryJobsStatus |
40 |
, buildCall |
|
41 |
, validateCall |
|
42 |
, decodeCall |
|
40 | 43 |
) where |
41 | 44 |
|
42 | 45 |
import Data.IORef |
... | ... | |
49 | 52 |
|
50 | 53 |
import Ganeti.HTools.JSON |
51 | 54 |
import Ganeti.HTools.Types |
55 |
import Ganeti.HTools.Utils |
|
52 | 56 |
|
53 | 57 |
import Ganeti.Constants |
54 | 58 |
import Ganeti.Jobs (JobStatus) |
... | ... | |
121 | 125 |
[ ("ops", [t| [[OpCode]] |], [| id |]) ] |
122 | 126 |
) |
123 | 127 |
, (luxiReqWaitForJobChange, |
124 |
[ ("job", [t| Int |], [| id |])
|
|
128 |
[ ("job", [t| Int |], [| show |])
|
|
125 | 129 |
, ("fields", [t| [String]|], [| id |]) |
126 | 130 |
, ("prev_job", [t| JSValue |], [| id |]) |
127 | 131 |
, ("prev_log", [t| JSValue |], [| id |]) |
... | ... | |
160 | 164 |
|
161 | 165 |
$(makeJSONInstance ''ResultStatus) |
162 | 166 |
|
167 |
-- | Type holding the initial (unparsed) Luxi call. |
|
168 |
data LuxiCall = LuxiCall LuxiReq JSValue |
|
169 |
|
|
163 | 170 |
-- | Check that ResultStatus is success or fail with descriptive message. |
164 | 171 |
checkRS :: (Monad m) => ResultStatus -> a -> m a |
165 | 172 |
checkRS RSNormal val = return val |
... | ... | |
238 | 245 |
jo = toJSObject ja |
239 | 246 |
in encodeStrict jo |
240 | 247 |
|
248 |
-- | Check that luxi request contains the required keys and parse it. |
|
249 |
validateCall :: String -> Result LuxiCall |
|
250 |
validateCall s = do |
|
251 |
arr <- fromJResult "luxi call" $ decodeStrict s::Result (JSObject JSValue) |
|
252 |
let aobj = fromJSObject arr |
|
253 |
call <- fromObj aobj (strOfKey Method)::Result LuxiReq |
|
254 |
args <- fromObj aobj (strOfKey Args) |
|
255 |
return (LuxiCall call args) |
|
256 |
|
|
257 |
-- | Converts Luxi call arguments into a 'LuxiOp' data structure. |
|
258 |
-- |
|
259 |
-- This is currently hand-coded until we make it more uniform so that |
|
260 |
-- it can be generated using TH. |
|
261 |
decodeCall :: LuxiCall -> Result LuxiOp |
|
262 |
decodeCall (LuxiCall call args) = |
|
263 |
case call of |
|
264 |
ReqQueryJobs -> do |
|
265 |
(jid, jargs) <- fromJVal args |
|
266 |
rid <- mapM (tryRead "parsing job ID" . fromJSString) jid |
|
267 |
let rargs = map fromJSString jargs |
|
268 |
return $ QueryJobs rid rargs |
|
269 |
ReqQueryInstances -> do |
|
270 |
(names, fields, locking) <- fromJVal args |
|
271 |
return $ QueryInstances names fields locking |
|
272 |
ReqQueryNodes -> do |
|
273 |
(names, fields, locking) <- fromJVal args |
|
274 |
return $ QueryNodes names fields locking |
|
275 |
ReqQueryGroups -> do |
|
276 |
(names, fields, locking) <- fromJVal args |
|
277 |
return $ QueryGroups names fields locking |
|
278 |
ReqQueryClusterInfo -> do |
|
279 |
return QueryClusterInfo |
|
280 |
ReqQuery -> do |
|
281 |
(what, fields, _) <- |
|
282 |
fromJVal args::Result (QrViaLuxi, [String], JSValue) |
|
283 |
return $ Query what fields () |
|
284 |
ReqSubmitJob -> do |
|
285 |
[ops1] <- fromJVal args |
|
286 |
ops2 <- mapM (fromJResult (luxiReqToRaw call) . J.readJSON) ops1 |
|
287 |
return $ SubmitJob ops2 |
|
288 |
ReqSubmitManyJobs -> do |
|
289 |
[ops1] <- fromJVal args |
|
290 |
ops2 <- mapM (fromJResult (luxiReqToRaw call) . J.readJSON) ops1 |
|
291 |
return $ SubmitManyJobs ops2 |
|
292 |
ReqWaitForJobChange -> do |
|
293 |
(jid, fields, pinfo, pidx, wtmout) <- |
|
294 |
-- No instance for 5-tuple, code copied from the |
|
295 |
-- json sources and adapted |
|
296 |
fromJResult "Parsing WaitForJobChange message" $ |
|
297 |
case args of |
|
298 |
JSArray [a, b, c, d, e] -> |
|
299 |
(,,,,) `fmap` |
|
300 |
J.readJSON a `ap` |
|
301 |
J.readJSON b `ap` |
|
302 |
J.readJSON c `ap` |
|
303 |
J.readJSON d `ap` |
|
304 |
J.readJSON e |
|
305 |
_ -> J.Error "Not enough values" |
|
306 |
rid <- tryRead "parsing job ID" jid |
|
307 |
return $ WaitForJobChange rid fields pinfo pidx wtmout |
|
308 |
ReqArchiveJob -> do |
|
309 |
[jid] <- fromJVal args |
|
310 |
rid <- tryRead "parsing job ID" jid |
|
311 |
return $ ArchiveJob rid |
|
312 |
ReqAutoArchiveJobs -> do |
|
313 |
(age, tmout) <- fromJVal args |
|
314 |
return $ AutoArchiveJobs age tmout |
|
315 |
ReqQueryExports -> do |
|
316 |
(nodes, lock) <- fromJVal args |
|
317 |
return $ QueryExports nodes lock |
|
318 |
ReqQueryConfigValues -> do |
|
319 |
[fields] <- fromJVal args |
|
320 |
return $ QueryConfigValues fields |
|
321 |
ReqQueryTags -> do |
|
322 |
(kind, name) <- fromJVal args |
|
323 |
return $ QueryTags kind name |
|
324 |
ReqCancelJob -> do |
|
325 |
[job] <- fromJVal args |
|
326 |
rid <- tryRead "parsing job ID" job |
|
327 |
return $ CancelJob rid |
|
328 |
ReqSetDrainFlag -> do |
|
329 |
[flag] <- fromJVal args |
|
330 |
return $ SetDrainFlag flag |
|
331 |
ReqSetWatcherPause -> do |
|
332 |
[duration] <- fromJVal args |
|
333 |
return $ SetWatcherPause duration |
|
334 |
|
|
241 | 335 |
-- | Check that luxi responses contain the required keys and that the |
242 | 336 |
-- call was successful. |
243 | 337 |
validateResult :: String -> Result JSValue |
Also available in: Unified diff