## root / src / Ganeti / OpCodes.hs @ 551b44e2

History | View | Annotate | Download (16.6 kB)

1 |
{-# LANGUAGE TemplateHaskell #-} |
---|---|

2 | |

3 |
{-| Implementation of the opcodes. |

4 | |

5 |
-} |

6 | |

7 |
{- |

8 | |

9 |
Copyright (C) 2009, 2010, 2011, 2012, 2013 Google Inc. |

10 | |

11 |
This program is free software; you can redistribute it and/or modify |

12 |
it under the terms of the GNU General Public License as published by |

13 |
the Free Software Foundation; either version 2 of the License, or |

14 |
(at your option) any later version. |

15 | |

16 |
This program is distributed in the hope that it will be useful, but |

17 |
WITHOUT ANY WARRANTY; without even the implied warranty of |

18 |
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU |

19 |
General Public License for more details. |

20 | |

21 |
You should have received a copy of the GNU General Public License |

22 |
along with this program; if not, write to the Free Software |

23 |
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA |

24 |
02110-1301, USA. |

25 | |

26 |
-} |

27 | |

28 |
module Ganeti.OpCodes |

29 |
( OpCode(..) |

30 |
, TagObject(..) |

31 |
, tagObjectFrom |

32 |
, encodeTagObject |

33 |
, decodeTagObject |

34 |
, ReplaceDisksMode(..) |

35 |
, DiskIndex |

36 |
, mkDiskIndex |

37 |
, unDiskIndex |

38 |
, opID |

39 |
, allOpIDs |

40 |
, allOpFields |

41 |
, opSummary |

42 |
, CommonOpParams(..) |

43 |
, defOpParams |

44 |
, MetaOpCode(..) |

45 |
, wrapOpCode |

46 |
, setOpComment |

47 |
, setOpPriority |

48 |
) where |

49 | |

50 |
import Data.Maybe (fromMaybe) |

51 |
import Text.JSON (readJSON, showJSON, JSON, JSValue, makeObj) |

52 |
import qualified Text.JSON |

53 | |

54 |
import Ganeti.THH |

55 | |

56 |
import Ganeti.OpParams |

57 |
import Ganeti.Types (OpSubmitPriority(..), fromNonEmpty) |

58 |
import Ganeti.Query.Language (queryTypeOpToRaw) |

59 | |

60 |
-- | OpCode representation. |

61 |
-- |

62 |
-- We only implement a subset of Ganeti opcodes: those which are actually used |

63 |
-- in the htools codebase. |

64 |
$(genOpCode "OpCode" |

65 |
[ ("OpTestDelay", |

66 |
[ pDelayDuration |

67 |
, pDelayOnMaster |

68 |
, pDelayOnNodes |

69 |
, pDelayRepeat |

70 |
]) |

71 |
, ("OpInstanceReplaceDisks", |

72 |
[ pInstanceName |

73 |
, pEarlyRelease |

74 |
, pIgnoreIpolicy |

75 |
, pReplaceDisksMode |

76 |
, pReplaceDisksList |

77 |
, pRemoteNode |

78 |
, pIallocator |

79 |
]) |

80 |
, ("OpInstanceFailover", |

81 |
[ pInstanceName |

82 |
, pShutdownTimeout |

83 |
, pIgnoreConsistency |

84 |
, pMigrationTargetNode |

85 |
, pIgnoreIpolicy |

86 |
, pIallocator |

87 |
]) |

88 |
, ("OpInstanceMigrate", |

89 |
[ pInstanceName |

90 |
, pMigrationMode |

91 |
, pMigrationLive |

92 |
, pMigrationTargetNode |

93 |
, pAllowRuntimeChgs |

94 |
, pIgnoreIpolicy |

95 |
, pMigrationCleanup |

96 |
, pIallocator |

97 |
, pAllowFailover |

98 |
]) |

99 |
, ("OpTagsGet", |

100 |
[ pTagsObject |

101 |
, pUseLocking |

102 |
]) |

103 |
, ("OpTagsSearch", |

104 |
[ pTagSearchPattern ]) |

105 |
, ("OpTagsSet", |

106 |
[ pTagsObject |

107 |
, pTagsList |

108 |
]) |

109 |
, ("OpTagsDel", |

110 |
[ pTagsObject |

111 |
, pTagsList |

112 |
]) |

113 |
, ("OpClusterPostInit", []) |

114 |
, ("OpClusterDestroy", []) |

115 |
, ("OpClusterQuery", []) |

116 |
, ("OpClusterVerify", |

117 |
[ pDebugSimulateErrors |

118 |
, pErrorCodes |

119 |
, pSkipChecks |

120 |
, pIgnoreErrors |

121 |
, pVerbose |

122 |
, pOptGroupName |

123 |
]) |

124 |
, ("OpClusterVerifyConfig", |

125 |
[ pDebugSimulateErrors |

126 |
, pErrorCodes |

127 |
, pIgnoreErrors |

128 |
, pVerbose |

129 |
]) |

130 |
, ("OpClusterVerifyGroup", |

131 |
[ pGroupName |

132 |
, pDebugSimulateErrors |

133 |
, pErrorCodes |

134 |
, pSkipChecks |

135 |
, pIgnoreErrors |

136 |
, pVerbose |

137 |
]) |

138 |
, ("OpClusterVerifyDisks", []) |

139 |
, ("OpGroupVerifyDisks", |

140 |
[ pGroupName |

141 |
]) |

142 |
, ("OpClusterRepairDiskSizes", |

143 |
[ pInstances |

144 |
]) |

145 |
, ("OpClusterConfigQuery", |

146 |
[ pOutputFields |

147 |
]) |

148 |
, ("OpClusterRename", |

149 |
[ pName |

150 |
]) |

151 |
, ("OpClusterSetParams", |

152 |
[ pHvState |

153 |
, pDiskState |

154 |
, pVgName |

155 |
, pEnabledHypervisors |

156 |
, pClusterHvParams |

157 |
, pClusterBeParams |

158 |
, pOsHvp |

159 |
, pClusterOsParams |

160 |
, pDiskParams |

161 |
, pCandidatePoolSize |

162 |
, pUidPool |

163 |
, pAddUids |

164 |
, pRemoveUids |

165 |
, pMaintainNodeHealth |

166 |
, pPreallocWipeDisks |

167 |
, pNicParams |

168 |
, pNdParams |

169 |
, pIpolicy |

170 |
, pDrbdHelper |

171 |
, pDefaultIAllocator |

172 |
, pMasterNetdev |

173 |
, pMasterNetmask |

174 |
, pReservedLvs |

175 |
, pHiddenOs |

176 |
, pBlacklistedOs |

177 |
, pUseExternalMipScript |

178 |
]) |

179 |
, ("OpClusterRedistConf", []) |

180 |
, ("OpClusterActivateMasterIp", []) |

181 |
, ("OpClusterDeactivateMasterIp", []) |

182 |
, ("OpQuery", |

183 |
[ pQueryWhat |

184 |
, pUseLocking |

185 |
, pQueryFields |

186 |
, pQueryFilter |

187 |
]) |

188 |
, ("OpQueryFields", |

189 |
[ pQueryWhat |

190 |
, pQueryFields |

191 |
]) |

192 |
, ("OpOobCommand", |

193 |
[ pNodeNames |

194 |
, pOobCommand |

195 |
, pOobTimeout |

196 |
, pIgnoreStatus |

197 |
, pPowerDelay |

198 |
]) |

199 |
, ("OpNodeRemove", [ pNodeName ]) |

200 |
, ("OpNodeAdd", |

201 |
[ pNodeName |

202 |
, pHvState |

203 |
, pDiskState |

204 |
, pPrimaryIp |

205 |
, pSecondaryIp |

206 |
, pReadd |

207 |
, pNodeGroup |

208 |
, pMasterCapable |

209 |
, pVmCapable |

210 |
, pNdParams |

211 |
]) |

212 |
, ("OpNodeQuery", dOldQuery) |

213 |
, ("OpNodeQueryvols", |

214 |
[ pOutputFields |

215 |
, pNodes |

216 |
]) |

217 |
, ("OpNodeQueryStorage", |

218 |
[ pOutputFields |

219 |
, pStorageType |

220 |
, pNodes |

221 |
, pStorageName |

222 |
]) |

223 |
, ("OpNodeModifyStorage", |

224 |
[ pNodeName |

225 |
, pStorageType |

226 |
, pStorageName |

227 |
, pStorageChanges |

228 |
]) |

229 |
, ("OpRepairNodeStorage", |

230 |
[ pNodeName |

231 |
, pStorageType |

232 |
, pStorageName |

233 |
, pIgnoreConsistency |

234 |
]) |

235 |
, ("OpNodeSetParams", |

236 |
[ pNodeName |

237 |
, pForce |

238 |
, pHvState |

239 |
, pDiskState |

240 |
, pMasterCandidate |

241 |
, pOffline |

242 |
, pDrained |

243 |
, pAutoPromote |

244 |
, pMasterCapable |

245 |
, pVmCapable |

246 |
, pSecondaryIp |

247 |
, pNdParams |

248 |
, pPowered |

249 |
]) |

250 |
, ("OpNodePowercycle", |

251 |
[ pNodeName |

252 |
, pForce |

253 |
]) |

254 |
, ("OpNodeMigrate", |

255 |
[ pNodeName |

256 |
, pMigrationMode |

257 |
, pMigrationLive |

258 |
, pMigrationTargetNode |

259 |
, pAllowRuntimeChgs |

260 |
, pIgnoreIpolicy |

261 |
, pIallocator |

262 |
]) |

263 |
, ("OpNodeEvacuate", |

264 |
[ pEarlyRelease |

265 |
, pNodeName |

266 |
, pRemoteNode |

267 |
, pIallocator |

268 |
, pEvacMode |

269 |
]) |

270 |
, ("OpInstanceCreate", |

271 |
[ pInstanceName |

272 |
, pForceVariant |

273 |
, pWaitForSync |

274 |
, pNameCheck |

275 |
, pIgnoreIpolicy |

276 |
, pInstBeParams |

277 |
, pInstDisks |

278 |
, pDiskTemplate |

279 |
, pFileDriver |

280 |
, pFileStorageDir |

281 |
, pInstHvParams |

282 |
, pHypervisor |

283 |
, pIallocator |

284 |
, pResetDefaults |

285 |
, pIpCheck |

286 |
, pIpConflictsCheck |

287 |
, pInstCreateMode |

288 |
, pInstNics |

289 |
, pNoInstall |

290 |
, pInstOsParams |

291 |
, pInstOs |

292 |
, pPrimaryNode |

293 |
, pSecondaryNode |

294 |
, pSourceHandshake |

295 |
, pSourceInstance |

296 |
, pSourceShutdownTimeout |

297 |
, pSourceX509Ca |

298 |
, pSrcNode |

299 |
, pSrcPath |

300 |
, pStartInstance |

301 |
, pOpportunisticLocking |

302 |
, pInstTags |

303 |
]) |

304 |
, ("OpInstanceMultiAlloc", |

305 |
[ pIallocator |

306 |
, pMultiAllocInstances |

307 |
, pOpportunisticLocking |

308 |
]) |

309 |
, ("OpInstanceReinstall", |

310 |
[ pInstanceName |

311 |
, pForceVariant |

312 |
, pInstOs |

313 |
, pTempOsParams |

314 |
]) |

315 |
, ("OpInstanceRemove", |

316 |
[ pInstanceName |

317 |
, pShutdownTimeout |

318 |
, pIgnoreFailures |

319 |
]) |

320 |
, ("OpInstanceRename", |

321 |
[ pInstanceName |

322 |
, pNewName |

323 |
, pNameCheck |

324 |
, pIpCheck |

325 |
]) |

326 |
, ("OpInstanceStartup", |

327 |
[ pInstanceName |

328 |
, pForce |

329 |
, pIgnoreOfflineNodes |

330 |
, pTempHvParams |

331 |
, pTempBeParams |

332 |
, pNoRemember |

333 |
, pStartupPaused |

334 |
]) |

335 |
, ("OpInstanceShutdown", |

336 |
[ pInstanceName |

337 |
, pForce |

338 |
, pIgnoreOfflineNodes |

339 |
, pShutdownTimeout' |

340 |
, pNoRemember |

341 |
]) |

342 |
, ("OpInstanceReboot", |

343 |
[ pInstanceName |

344 |
, pShutdownTimeout |

345 |
, pIgnoreSecondaries |

346 |
, pRebootType |

347 |
]) |

348 |
, ("OpInstanceMove", |

349 |
[ pInstanceName |

350 |
, pShutdownTimeout |

351 |
, pIgnoreIpolicy |

352 |
, pMoveTargetNode |

353 |
, pIgnoreConsistency |

354 |
]) |

355 |
, ("OpInstanceConsole", |

356 |
[ pInstanceName ]) |

357 |
, ("OpInstanceActivateDisks", |

358 |
[ pInstanceName |

359 |
, pIgnoreDiskSize |

360 |
, pWaitForSyncFalse |

361 |
]) |

362 |
, ("OpInstanceDeactivateDisks", |

363 |
[ pInstanceName |

364 |
, pForce |

365 |
]) |

366 |
, ("OpInstanceRecreateDisks", |

367 |
[ pInstanceName |

368 |
, pRecreateDisksInfo |

369 |
, pNodes |

370 |
, pIallocator |

371 |
]) |

372 |
, ("OpInstanceQuery", dOldQuery) |

373 |
, ("OpInstanceQueryData", |

374 |
[ pUseLocking |

375 |
, pInstances |

376 |
, pStatic |

377 |
]) |

378 |
, ("OpInstanceSetParams", |

379 |
[ pInstanceName |

380 |
, pForce |

381 |
, pForceVariant |

382 |
, pIgnoreIpolicy |

383 |
, pInstParamsNicChanges |

384 |
, pInstParamsDiskChanges |

385 |
, pInstBeParams |

386 |
, pRuntimeMem |

387 |
, pInstHvParams |

388 |
, pOptDiskTemplate |

389 |
, pRemoteNode |

390 |
, pOsNameChange |

391 |
, pInstOsParams |

392 |
, pWaitForSync |

393 |
, pOffline |

394 |
, pIpConflictsCheck |

395 |
]) |

396 |
, ("OpInstanceGrowDisk", |

397 |
[ pInstanceName |

398 |
, pWaitForSync |

399 |
, pDiskIndex |

400 |
, pDiskChgAmount |

401 |
, pDiskChgAbsolute |

402 |
]) |

403 |
, ("OpInstanceChangeGroup", |

404 |
[ pInstanceName |

405 |
, pEarlyRelease |

406 |
, pIallocator |

407 |
, pTargetGroups |

408 |
]) |

409 |
, ("OpGroupAdd", |

410 |
[ pGroupName |

411 |
, pNodeGroupAllocPolicy |

412 |
, pGroupNodeParams |

413 |
, pDiskParams |

414 |
, pHvState |

415 |
, pDiskState |

416 |
, pIpolicy |

417 |
]) |

418 |
, ("OpGroupAssignNodes", |

419 |
[ pGroupName |

420 |
, pForce |

421 |
, pRequiredNodes |

422 |
]) |

423 |
, ("OpGroupQuery", dOldQueryNoLocking) |

424 |
, ("OpGroupSetParams", |

425 |
[ pGroupName |

426 |
, pNodeGroupAllocPolicy |

427 |
, pGroupNodeParams |

428 |
, pDiskParams |

429 |
, pHvState |

430 |
, pDiskState |

431 |
, pIpolicy |

432 |
]) |

433 |
, ("OpGroupRemove", |

434 |
[ pGroupName ]) |

435 |
, ("OpGroupRename", |

436 |
[ pGroupName |

437 |
, pNewName |

438 |
]) |

439 |
, ("OpGroupEvacuate", |

440 |
[ pGroupName |

441 |
, pEarlyRelease |

442 |
, pIallocator |

443 |
, pTargetGroups |

444 |
]) |

445 |
, ("OpOsDiagnose", |

446 |
[ pOutputFields |

447 |
, pNames ]) |

448 |
, ("OpExtStorageDiagnose", |

449 |
[ pOutputFields |

450 |
, pNames ]) |

451 |
, ("OpBackupQuery", |

452 |
[ pUseLocking |

453 |
, pNodes |

454 |
]) |

455 |
, ("OpBackupPrepare", |

456 |
[ pInstanceName |

457 |
, pExportMode |

458 |
]) |

459 |
, ("OpBackupExport", |

460 |
[ pInstanceName |

461 |
, pShutdownTimeout |

462 |
, pExportTargetNode |

463 |
, pShutdownInstance |

464 |
, pRemoveInstance |

465 |
, pIgnoreRemoveFailures |

466 |
, pExportMode |

467 |
, pX509KeyName |

468 |
, pX509DestCA |

469 |
]) |

470 |
, ("OpBackupRemove", |

471 |
[ pInstanceName ]) |

472 |
, ("OpTestAllocator", |

473 |
[ pIAllocatorDirection |

474 |
, pIAllocatorMode |

475 |
, pIAllocatorReqName |

476 |
, pIAllocatorNics |

477 |
, pIAllocatorDisks |

478 |
, pHypervisor |

479 |
, pIallocator |

480 |
, pInstTags |

481 |
, pIAllocatorMemory |

482 |
, pIAllocatorVCpus |

483 |
, pIAllocatorOs |

484 |
, pDiskTemplate |

485 |
, pIAllocatorInstances |

486 |
, pIAllocatorEvacMode |

487 |
, pTargetGroups |

488 |
, pIAllocatorSpindleUse |

489 |
, pIAllocatorCount |

490 |
]) |

491 |
, ("OpTestJqueue", |

492 |
[ pJQueueNotifyWaitLock |

493 |
, pJQueueNotifyExec |

494 |
, pJQueueLogMessages |

495 |
, pJQueueFail |

496 |
]) |

497 |
, ("OpTestDummy", |

498 |
[ pTestDummyResult |

499 |
, pTestDummyMessages |

500 |
, pTestDummyFail |

501 |
, pTestDummySubmitJobs |

502 |
]) |

503 |
, ("OpNetworkAdd", |

504 |
[ pNetworkName |

505 |
, pNetworkAddress4 |

506 |
, pNetworkGateway4 |

507 |
, pNetworkAddress6 |

508 |
, pNetworkGateway6 |

509 |
, pNetworkMacPrefix |

510 |
, pNetworkAddRsvdIps |

511 |
, pIpConflictsCheck |

512 |
, pInstTags |

513 |
]) |

514 |
, ("OpNetworkRemove", |

515 |
[ pNetworkName |

516 |
, pForce |

517 |
]) |

518 |
, ("OpNetworkSetParams", |

519 |
[ pNetworkName |

520 |
, pNetworkGateway4 |

521 |
, pNetworkAddress6 |

522 |
, pNetworkGateway6 |

523 |
, pNetworkMacPrefix |

524 |
, pNetworkAddRsvdIps |

525 |
, pNetworkRemoveRsvdIps |

526 |
]) |

527 |
, ("OpNetworkConnect", |

528 |
[ pGroupName |

529 |
, pNetworkName |

530 |
, pNetworkMode |

531 |
, pNetworkLink |

532 |
, pIpConflictsCheck |

533 |
]) |

534 |
, ("OpNetworkDisconnect", |

535 |
[ pGroupName |

536 |
, pNetworkName |

537 |
]) |

538 |
, ("OpNetworkQuery", dOldQuery) |

539 |
, ("OpRestrictedCommand", |

540 |
[ pUseLocking |

541 |
, pRequiredNodes |

542 |
, pRestrictedCommand |

543 |
]) |

544 |
]) |

545 | |

546 |
-- | Returns the OP_ID for a given opcode value. |

547 |
$(genOpID ''OpCode "opID") |

548 | |

549 |
-- | A list of all defined/supported opcode IDs. |

550 |
$(genAllOpIDs ''OpCode "allOpIDs") |

551 | |

552 |
instance JSON OpCode where |

553 |
readJSON = loadOpCode |

554 |
showJSON = saveOpCode |

555 | |

556 |
-- | Generates the summary value for an opcode. |

557 |
opSummaryVal :: OpCode -> Maybe String |

558 |
opSummaryVal OpClusterVerifyGroup { opGroupName = s } = Just (fromNonEmpty s) |

559 |
opSummaryVal OpGroupVerifyDisks { opGroupName = s } = Just (fromNonEmpty s) |

560 |
opSummaryVal OpClusterRename { opName = s } = Just (fromNonEmpty s) |

561 |
opSummaryVal OpQuery { opWhat = s } = Just (queryTypeOpToRaw s) |

562 |
opSummaryVal OpQueryFields { opWhat = s } = Just (queryTypeOpToRaw s) |

563 |
opSummaryVal OpNodeRemove { opNodeName = s } = Just (fromNonEmpty s) |

564 |
opSummaryVal OpNodeAdd { opNodeName = s } = Just (fromNonEmpty s) |

565 |
opSummaryVal OpNodeModifyStorage { opNodeName = s } = Just (fromNonEmpty s) |

566 |
opSummaryVal OpRepairNodeStorage { opNodeName = s } = Just (fromNonEmpty s) |

567 |
opSummaryVal OpNodeSetParams { opNodeName = s } = Just (fromNonEmpty s) |

568 |
opSummaryVal OpNodePowercycle { opNodeName = s } = Just (fromNonEmpty s) |

569 |
opSummaryVal OpNodeMigrate { opNodeName = s } = Just (fromNonEmpty s) |

570 |
opSummaryVal OpNodeEvacuate { opNodeName = s } = Just (fromNonEmpty s) |

571 |
opSummaryVal OpInstanceCreate { opInstanceName = s } = Just s |

572 |
opSummaryVal OpInstanceReinstall { opInstanceName = s } = Just s |

573 |
opSummaryVal OpInstanceRemove { opInstanceName = s } = Just s |

574 |
-- FIXME: instance rename should show both names; currently it shows none |

575 |
-- opSummaryVal OpInstanceRename { opInstanceName = s } = Just s |

576 |
opSummaryVal OpInstanceStartup { opInstanceName = s } = Just s |

577 |
opSummaryVal OpInstanceShutdown { opInstanceName = s } = Just s |

578 |
opSummaryVal OpInstanceReboot { opInstanceName = s } = Just s |

579 |
opSummaryVal OpInstanceReplaceDisks { opInstanceName = s } = Just s |

580 |
opSummaryVal OpInstanceFailover { opInstanceName = s } = Just s |

581 |
opSummaryVal OpInstanceMigrate { opInstanceName = s } = Just s |

582 |
opSummaryVal OpInstanceMove { opInstanceName = s } = Just s |

583 |
opSummaryVal OpInstanceConsole { opInstanceName = s } = Just s |

584 |
opSummaryVal OpInstanceActivateDisks { opInstanceName = s } = Just s |

585 |
opSummaryVal OpInstanceDeactivateDisks { opInstanceName = s } = Just s |

586 |
opSummaryVal OpInstanceRecreateDisks { opInstanceName = s } = Just s |

587 |
opSummaryVal OpInstanceSetParams { opInstanceName = s } = Just s |

588 |
opSummaryVal OpInstanceGrowDisk { opInstanceName = s } = Just s |

589 |
opSummaryVal OpInstanceChangeGroup { opInstanceName = s } = Just s |

590 |
opSummaryVal OpGroupAdd { opGroupName = s } = Just (fromNonEmpty s) |

591 |
opSummaryVal OpGroupAssignNodes { opGroupName = s } = Just (fromNonEmpty s) |

592 |
opSummaryVal OpGroupSetParams { opGroupName = s } = Just (fromNonEmpty s) |

593 |
opSummaryVal OpGroupRemove { opGroupName = s } = Just (fromNonEmpty s) |

594 |
opSummaryVal OpGroupEvacuate { opGroupName = s } = Just (fromNonEmpty s) |

595 |
opSummaryVal OpBackupPrepare { opInstanceName = s } = Just s |

596 |
opSummaryVal OpBackupExport { opInstanceName = s } = Just s |

597 |
opSummaryVal OpBackupRemove { opInstanceName = s } = Just s |

598 |
opSummaryVal OpTagsGet { opKind = k } = |

599 |
Just . fromMaybe "None" $ tagNameOf k |

600 |
opSummaryVal OpTagsSearch { opTagSearchPattern = s } = Just (fromNonEmpty s) |

601 |
opSummaryVal OpTestDelay { opDelayDuration = d } = Just (show d) |

602 |
opSummaryVal OpTestAllocator { opIallocator = s } = |

603 |
-- FIXME: Python doesn't handle None fields well, so we have behave the same |

604 |
Just $ maybe "None" fromNonEmpty s |

605 |
opSummaryVal OpNetworkAdd { opNetworkName = s} = Just (fromNonEmpty s) |

606 |
opSummaryVal OpNetworkRemove { opNetworkName = s} = Just (fromNonEmpty s) |

607 |
opSummaryVal OpNetworkSetParams { opNetworkName = s} = Just (fromNonEmpty s) |

608 |
opSummaryVal OpNetworkConnect { opNetworkName = s} = Just (fromNonEmpty s) |

609 |
opSummaryVal OpNetworkDisconnect { opNetworkName = s} = Just (fromNonEmpty s) |

610 |
opSummaryVal _ = Nothing |

611 | |

612 |
-- | Computes the summary of the opcode. |

613 |
opSummary :: OpCode -> String |

614 |
opSummary op = |

615 |
case opSummaryVal op of |

616 |
Nothing -> op_suffix |

617 |
Just s -> op_suffix ++ "(" ++ s ++ ")" |

618 |
where op_suffix = drop 3 $ opID op |

619 | |

620 |
-- | Generic\/common opcode parameters. |

621 |
$(buildObject "CommonOpParams" "op" |

622 |
[ pDryRun |

623 |
, pDebugLevel |

624 |
, pOpPriority |

625 |
, pDependencies |

626 |
, pComment |

627 |
]) |

628 | |

629 |
-- | Default common parameter values. |

630 |
defOpParams :: CommonOpParams |

631 |
defOpParams = |

632 |
CommonOpParams { opDryRun = Nothing |

633 |
, opDebugLevel = Nothing |

634 |
, opPriority = OpPrioNormal |

635 |
, opDepends = Nothing |

636 |
, opComment = Nothing |

637 |
} |

638 | |

639 |
-- | The top-level opcode type. |

640 |
data MetaOpCode = MetaOpCode { metaParams :: CommonOpParams |

641 |
, metaOpCode :: OpCode |

642 |
} deriving (Show, Eq) |

643 | |

644 |
-- | JSON serialisation for 'MetaOpCode'. |

645 |
showMeta :: MetaOpCode -> JSValue |

646 |
showMeta (MetaOpCode params op) = |

647 |
let objparams = toDictCommonOpParams params |

648 |
objop = toDictOpCode op |

649 |
in makeObj (objparams ++ objop) |

650 | |

651 |
-- | JSON deserialisation for 'MetaOpCode' |

652 |
readMeta :: JSValue -> Text.JSON.Result MetaOpCode |

653 |
readMeta v = do |

654 |
meta <- readJSON v |

655 |
op <- readJSON v |

656 |
return $ MetaOpCode meta op |

657 | |

658 |
instance JSON MetaOpCode where |

659 |
showJSON = showMeta |

660 |
readJSON = readMeta |

661 | |

662 |
-- | Wraps an 'OpCode' with the default parameters to build a |

663 |
-- 'MetaOpCode'. |

664 |
wrapOpCode :: OpCode -> MetaOpCode |

665 |
wrapOpCode = MetaOpCode defOpParams |

666 | |

667 |
-- | Sets the comment on a meta opcode. |

668 |
setOpComment :: String -> MetaOpCode -> MetaOpCode |

669 |
setOpComment comment (MetaOpCode common op) = |

670 |
MetaOpCode (common { opComment = Just comment}) op |

671 | |

672 |
-- | Sets the priority on a meta opcode. |

673 |
setOpPriority :: OpSubmitPriority -> MetaOpCode -> MetaOpCode |

674 |
setOpPriority prio (MetaOpCode common op) = |

675 |
MetaOpCode (common { opPriority = prio }) op |