Revision 76b62028 htools/Ganeti/Luxi.hs
| b/htools/Ganeti/Luxi.hs | ||
|---|---|---|
| 44 | 44 |
) where |
| 45 | 45 |
|
| 46 | 46 |
import Data.IORef |
| 47 |
import Data.Ratio (numerator, denominator) |
|
| 47 | 48 |
import Control.Monad |
| 48 | 49 |
import Text.JSON (encodeStrict, decodeStrict) |
| 49 | 50 |
import qualified Text.JSON as J |
| ... | ... | |
| 73 | 74 |
-- * Generic protocol functionality |
| 74 | 75 |
|
| 75 | 76 |
-- | The Ganeti job type. |
| 76 |
type JobId = String
|
|
| 77 |
type JobId = Int
|
|
| 77 | 78 |
|
| 78 | 79 |
$(declareSADT "QrViaLuxi" |
| 79 | 80 |
[ ("QRLock", 'qrLock)
|
| ... | ... | |
| 107 | 108 |
, ("lock", [t| Bool |], [| id |])
|
| 108 | 109 |
]) |
| 109 | 110 |
, (luxiReqQueryJobs, |
| 110 |
[ ("ids", [t| [Int] |], [| map show |])
|
|
| 111 |
[ ("ids", [t| [Int] |], [| id |])
|
|
| 111 | 112 |
, ("fields", [t| [String] |], [| id |])
|
| 112 | 113 |
]) |
| 113 | 114 |
, (luxiReqQueryExports, |
| ... | ... | |
| 129 | 130 |
[ ("ops", [t| [[OpCode]] |], [| id |]) ]
|
| 130 | 131 |
) |
| 131 | 132 |
, (luxiReqWaitForJobChange, |
| 132 |
[ ("job", [t| Int |], [| show |])
|
|
| 133 |
[ ("job", [t| Int |], [| id |])
|
|
| 133 | 134 |
, ("fields", [t| [String]|], [| id |])
|
| 134 | 135 |
, ("prev_job", [t| JSValue |], [| id |])
|
| 135 | 136 |
, ("prev_log", [t| JSValue |], [| id |])
|
| 136 | 137 |
, ("tmout", [t| Int |], [| id |])
|
| 137 | 138 |
]) |
| 138 | 139 |
, (luxiReqArchiveJob, |
| 139 |
[ ("job", [t| Int |], [| show |]) ]
|
|
| 140 |
[ ("job", [t| Int |], [| id |]) ]
|
|
| 140 | 141 |
) |
| 141 | 142 |
, (luxiReqAutoArchiveJobs, |
| 142 | 143 |
[ ("age", [t| Int |], [| id |])
|
| 143 | 144 |
, ("tmout", [t| Int |], [| id |])
|
| 144 | 145 |
]) |
| 145 | 146 |
, (luxiReqCancelJob, |
| 146 |
[ ("job", [t| Int |], [| show |]) ]
|
|
| 147 |
[ ("job", [t| Int |], [| id |]) ]
|
|
| 147 | 148 |
) |
| 148 | 149 |
, (luxiReqSetDrainFlag, |
| 149 | 150 |
[ ("flag", [t| Bool |], [| id |]) ]
|
| ... | ... | |
| 267 | 268 |
case call of |
| 268 | 269 |
ReqQueryJobs -> do |
| 269 | 270 |
(jid, jargs) <- fromJVal args |
| 270 |
rid <- mapM (tryRead "parsing job ID" . fromJSString) jid
|
|
| 271 |
rid <- mapM parseJobId jid
|
|
| 271 | 272 |
let rargs = map fromJSString jargs |
| 272 | 273 |
return $ QueryJobs rid rargs |
| 273 | 274 |
ReqQueryInstances -> do |
| ... | ... | |
| 307 | 308 |
J.readJSON d `ap` |
| 308 | 309 |
J.readJSON e |
| 309 | 310 |
_ -> J.Error "Not enough values" |
| 310 |
rid <- tryRead "parsing job ID" jid
|
|
| 311 |
rid <- parseJobId jid
|
|
| 311 | 312 |
return $ WaitForJobChange rid fields pinfo pidx wtmout |
| 312 | 313 |
ReqArchiveJob -> do |
| 313 | 314 |
[jid] <- fromJVal args |
| 314 |
rid <- tryRead "parsing job ID" jid
|
|
| 315 |
rid <- parseJobId jid
|
|
| 315 | 316 |
return $ ArchiveJob rid |
| 316 | 317 |
ReqAutoArchiveJobs -> do |
| 317 | 318 |
(age, tmout) <- fromJVal args |
| ... | ... | |
| 327 | 328 |
return $ QueryTags kind name |
| 328 | 329 |
ReqCancelJob -> do |
| 329 | 330 |
[job] <- fromJVal args |
| 330 |
rid <- tryRead "parsing job ID" job
|
|
| 331 |
rid <- parseJobId job
|
|
| 331 | 332 |
return $ CancelJob rid |
| 332 | 333 |
ReqSetDrainFlag -> do |
| 333 | 334 |
[flag] <- fromJVal args |
| ... | ... | |
| 359 | 360 |
|
| 360 | 361 |
-- | Parses a job ID. |
| 361 | 362 |
parseJobId :: JSValue -> Result JobId |
| 362 |
parseJobId (JSString x) = Ok $ fromJSString x |
|
| 363 |
parseJobId (JSString x) = tryRead "parsing job id" . fromJSString $ x |
|
| 364 |
parseJobId (JSRational _ x) = |
|
| 365 |
if denominator x /= 1 |
|
| 366 |
then Bad $ "Got fractional job ID from master daemon?! Value:" ++ show x |
|
| 367 |
-- FIXME: potential integer overflow here on 32-bit platforms |
|
| 368 |
else Ok . fromIntegral . numerator $ x |
|
| 363 | 369 |
parseJobId x = Bad $ "Wrong type/value for job id: " ++ show x |
| 364 | 370 |
|
| 365 | 371 |
-- | Parse job submission result. |
| ... | ... | |
| 383 | 389 |
-- | Custom queryJobs call. |
| 384 | 390 |
queryJobsStatus :: Client -> [JobId] -> IO (Result [JobStatus]) |
| 385 | 391 |
queryJobsStatus s jids = do |
| 386 |
rval <- callMethod (QueryJobs (map read jids) ["status"]) s
|
|
| 392 |
rval <- callMethod (QueryJobs jids ["status"]) s
|
|
| 387 | 393 |
return $ case rval of |
| 388 | 394 |
Bad x -> Bad x |
| 389 | 395 |
Ok y -> case J.readJSON y::(J.Result [[JobStatus]]) of |
Also available in: Unified diff