## root / src / Ganeti / OpCodes.hs @ e7a77eb8

History | View | Annotate | Download (16.8 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, 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 |
, pMigrationCleanup |

88 |
]) |

89 |
, ("OpInstanceMigrate", |

90 |
[ pInstanceName |

91 |
, pMigrationMode |

92 |
, pMigrationLive |

93 |
, pMigrationTargetNode |

94 |
, pAllowRuntimeChgs |

95 |
, pIgnoreIpolicy |

96 |
, pMigrationCleanup |

97 |
, pIallocator |

98 |
, pAllowFailover |

99 |
]) |

100 |
, ("OpTagsGet", |

101 |
[ pTagsObject |

102 |
, pUseLocking |

103 |
]) |

104 |
, ("OpTagsSearch", |

105 |
[ pTagSearchPattern ]) |

106 |
, ("OpTagsSet", |

107 |
[ pTagsObject |

108 |
, pTagsList |

109 |
]) |

110 |
, ("OpTagsDel", |

111 |
[ pTagsObject |

112 |
, pTagsList |

113 |
]) |

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

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

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

117 |
, ("OpClusterVerify", |

118 |
[ pDebugSimulateErrors |

119 |
, pErrorCodes |

120 |
, pSkipChecks |

121 |
, pIgnoreErrors |

122 |
, pVerbose |

123 |
, pOptGroupName |

124 |
]) |

125 |
, ("OpClusterVerifyConfig", |

126 |
[ pDebugSimulateErrors |

127 |
, pErrorCodes |

128 |
, pIgnoreErrors |

129 |
, pVerbose |

130 |
]) |

131 |
, ("OpClusterVerifyGroup", |

132 |
[ pGroupName |

133 |
, pDebugSimulateErrors |

134 |
, pErrorCodes |

135 |
, pSkipChecks |

136 |
, pIgnoreErrors |

137 |
, pVerbose |

138 |
]) |

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

140 |
, ("OpGroupVerifyDisks", |

141 |
[ pGroupName |

142 |
]) |

143 |
, ("OpClusterRepairDiskSizes", |

144 |
[ pInstances |

145 |
]) |

146 |
, ("OpClusterConfigQuery", |

147 |
[ pOutputFields |

148 |
]) |

149 |
, ("OpClusterRename", |

150 |
[ pName |

151 |
]) |

152 |
, ("OpClusterSetParams", |

153 |
[ pForce |

154 |
, pHvState |

155 |
, pDiskState |

156 |
, pVgName |

157 |
, pEnabledHypervisors |

158 |
, pClusterHvParams |

159 |
, pClusterBeParams |

160 |
, pOsHvp |

161 |
, pClusterOsParams |

162 |
, pDiskParams |

163 |
, pCandidatePoolSize |

164 |
, pUidPool |

165 |
, pAddUids |

166 |
, pRemoveUids |

167 |
, pMaintainNodeHealth |

168 |
, pPreallocWipeDisks |

169 |
, pNicParams |

170 |
, pNdParams |

171 |
, pIpolicy |

172 |
, pDrbdHelper |

173 |
, pDefaultIAllocator |

174 |
, pMasterNetdev |

175 |
, pMasterNetmask |

176 |
, pReservedLvs |

177 |
, pHiddenOs |

178 |
, pBlacklistedOs |

179 |
, pUseExternalMipScript |

180 |
, pEnabledDiskTemplates |

181 |
, pModifyEtcHosts |

182 |
]) |

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

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

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

186 |
, ("OpQuery", |

187 |
[ pQueryWhat |

188 |
, pUseLocking |

189 |
, pQueryFields |

190 |
, pQueryFilter |

191 |
]) |

192 |
, ("OpQueryFields", |

193 |
[ pQueryWhat |

194 |
, pQueryFields |

195 |
]) |

196 |
, ("OpOobCommand", |

197 |
[ pNodeNames |

198 |
, pOobCommand |

199 |
, pOobTimeout |

200 |
, pIgnoreStatus |

201 |
, pPowerDelay |

202 |
]) |

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

204 |
, ("OpNodeAdd", |

205 |
[ pNodeName |

206 |
, pHvState |

207 |
, pDiskState |

208 |
, pPrimaryIp |

209 |
, pSecondaryIp |

210 |
, pReadd |

211 |
, pNodeGroup |

212 |
, pMasterCapable |

213 |
, pVmCapable |

214 |
, pNdParams |

215 |
]) |

216 |
, ("OpNodeQuery", dOldQuery) |

217 |
, ("OpNodeQueryvols", |

218 |
[ pOutputFields |

219 |
, pNodes |

220 |
]) |

221 |
, ("OpNodeQueryStorage", |

222 |
[ pOutputFields |

223 |
, pStorageType |

224 |
, pNodes |

225 |
, pStorageName |

226 |
]) |

227 |
, ("OpNodeModifyStorage", |

228 |
[ pNodeName |

229 |
, pStorageType |

230 |
, pStorageName |

231 |
, pStorageChanges |

232 |
]) |

233 |
, ("OpRepairNodeStorage", |

234 |
[ pNodeName |

235 |
, pStorageType |

236 |
, pStorageName |

237 |
, pIgnoreConsistency |

238 |
]) |

239 |
, ("OpNodeSetParams", |

240 |
[ pNodeName |

241 |
, pForce |

242 |
, pHvState |

243 |
, pDiskState |

244 |
, pMasterCandidate |

245 |
, pOffline |

246 |
, pDrained |

247 |
, pAutoPromote |

248 |
, pMasterCapable |

249 |
, pVmCapable |

250 |
, pSecondaryIp |

251 |
, pNdParams |

252 |
, pPowered |

253 |
]) |

254 |
, ("OpNodePowercycle", |

255 |
[ pNodeName |

256 |
, pForce |

257 |
]) |

258 |
, ("OpNodeMigrate", |

259 |
[ pNodeName |

260 |
, pMigrationMode |

261 |
, pMigrationLive |

262 |
, pMigrationTargetNode |

263 |
, pAllowRuntimeChgs |

264 |
, pIgnoreIpolicy |

265 |
, pIallocator |

266 |
]) |

267 |
, ("OpNodeEvacuate", |

268 |
[ pEarlyRelease |

269 |
, pNodeName |

270 |
, pRemoteNode |

271 |
, pIallocator |

272 |
, pEvacMode |

273 |
]) |

274 |
, ("OpInstanceCreate", |

275 |
[ pInstanceName |

276 |
, pForceVariant |

277 |
, pWaitForSync |

278 |
, pNameCheck |

279 |
, pIgnoreIpolicy |

280 |
, pInstBeParams |

281 |
, pInstDisks |

282 |
, pDiskTemplate |

283 |
, pFileDriver |

284 |
, pFileStorageDir |

285 |
, pInstHvParams |

286 |
, pHypervisor |

287 |
, pIallocator |

288 |
, pResetDefaults |

289 |
, pIpCheck |

290 |
, pIpConflictsCheck |

291 |
, pInstCreateMode |

292 |
, pInstNics |

293 |
, pNoInstall |

294 |
, pInstOsParams |

295 |
, pInstOs |

296 |
, pPrimaryNode |

297 |
, pSecondaryNode |

298 |
, pSourceHandshake |

299 |
, pSourceInstance |

300 |
, pSourceShutdownTimeout |

301 |
, pSourceX509Ca |

302 |
, pSrcNode |

303 |
, pSrcPath |

304 |
, pStartInstance |

305 |
, pOpportunisticLocking |

306 |
, pInstTags |

307 |
]) |

308 |
, ("OpInstanceMultiAlloc", |

309 |
[ pIallocator |

310 |
, pMultiAllocInstances |

311 |
, pOpportunisticLocking |

312 |
]) |

313 |
, ("OpInstanceReinstall", |

314 |
[ pInstanceName |

315 |
, pForceVariant |

316 |
, pInstOs |

317 |
, pTempOsParams |

318 |
]) |

319 |
, ("OpInstanceRemove", |

320 |
[ pInstanceName |

321 |
, pShutdownTimeout |

322 |
, pIgnoreFailures |

323 |
]) |

324 |
, ("OpInstanceRename", |

325 |
[ pInstanceName |

326 |
, pNewName |

327 |
, pNameCheck |

328 |
, pIpCheck |

329 |
]) |

330 |
, ("OpInstanceStartup", |

331 |
[ pInstanceName |

332 |
, pForce |

333 |
, pIgnoreOfflineNodes |

334 |
, pTempHvParams |

335 |
, pTempBeParams |

336 |
, pNoRemember |

337 |
, pStartupPaused |

338 |
]) |

339 |
, ("OpInstanceShutdown", |

340 |
[ pInstanceName |

341 |
, pForce |

342 |
, pIgnoreOfflineNodes |

343 |
, pShutdownTimeout' |

344 |
, pNoRemember |

345 |
]) |

346 |
, ("OpInstanceReboot", |

347 |
[ pInstanceName |

348 |
, pShutdownTimeout |

349 |
, pIgnoreSecondaries |

350 |
, pRebootType |

351 |
]) |

352 |
, ("OpInstanceMove", |

353 |
[ pInstanceName |

354 |
, pShutdownTimeout |

355 |
, pIgnoreIpolicy |

356 |
, pMoveTargetNode |

357 |
, pIgnoreConsistency |

358 |
]) |

359 |
, ("OpInstanceConsole", |

360 |
[ pInstanceName ]) |

361 |
, ("OpInstanceActivateDisks", |

362 |
[ pInstanceName |

363 |
, pIgnoreDiskSize |

364 |
, pWaitForSyncFalse |

365 |
]) |

366 |
, ("OpInstanceDeactivateDisks", |

367 |
[ pInstanceName |

368 |
, pForce |

369 |
]) |

370 |
, ("OpInstanceRecreateDisks", |

371 |
[ pInstanceName |

372 |
, pRecreateDisksInfo |

373 |
, pNodes |

374 |
, pIallocator |

375 |
]) |

376 |
, ("OpInstanceQuery", dOldQuery) |

377 |
, ("OpInstanceQueryData", |

378 |
[ pUseLocking |

379 |
, pInstances |

380 |
, pStatic |

381 |
]) |

382 |
, ("OpInstanceSetParams", |

383 |
[ pInstanceName |

384 |
, pForce |

385 |
, pForceVariant |

386 |
, pIgnoreIpolicy |

387 |
, pInstParamsNicChanges |

388 |
, pInstParamsDiskChanges |

389 |
, pInstBeParams |

390 |
, pRuntimeMem |

391 |
, pInstHvParams |

392 |
, pOptDiskTemplate |

393 |
, pPrimaryNode |

394 |
, pRemoteNode |

395 |
, pOsNameChange |

396 |
, pInstOsParams |

397 |
, pWaitForSync |

398 |
, pOffline |

399 |
, pIpConflictsCheck |

400 |
, pHotplug |

401 |
, pHotplugIfPossible |

402 |
]) |

403 |
, ("OpInstanceGrowDisk", |

404 |
[ pInstanceName |

405 |
, pWaitForSync |

406 |
, pDiskIndex |

407 |
, pDiskChgAmount |

408 |
, pDiskChgAbsolute |

409 |
]) |

410 |
, ("OpInstanceChangeGroup", |

411 |
[ pInstanceName |

412 |
, pEarlyRelease |

413 |
, pIallocator |

414 |
, pTargetGroups |

415 |
]) |

416 |
, ("OpGroupAdd", |

417 |
[ pGroupName |

418 |
, pNodeGroupAllocPolicy |

419 |
, pGroupNodeParams |

420 |
, pDiskParams |

421 |
, pHvState |

422 |
, pDiskState |

423 |
, pIpolicy |

424 |
]) |

425 |
, ("OpGroupAssignNodes", |

426 |
[ pGroupName |

427 |
, pForce |

428 |
, pRequiredNodes |

429 |
]) |

430 |
, ("OpGroupQuery", dOldQueryNoLocking) |

431 |
, ("OpGroupSetParams", |

432 |
[ pGroupName |

433 |
, pNodeGroupAllocPolicy |

434 |
, pGroupNodeParams |

435 |
, pDiskParams |

436 |
, pHvState |

437 |
, pDiskState |

438 |
, pIpolicy |

439 |
]) |

440 |
, ("OpGroupRemove", |

441 |
[ pGroupName ]) |

442 |
, ("OpGroupRename", |

443 |
[ pGroupName |

444 |
, pNewName |

445 |
]) |

446 |
, ("OpGroupEvacuate", |

447 |
[ pGroupName |

448 |
, pEarlyRelease |

449 |
, pIallocator |

450 |
, pTargetGroups |

451 |
]) |

452 |
, ("OpOsDiagnose", |

453 |
[ pOutputFields |

454 |
, pNames ]) |

455 |
, ("OpExtStorageDiagnose", |

456 |
[ pOutputFields |

457 |
, pNames ]) |

458 |
, ("OpBackupQuery", |

459 |
[ pUseLocking |

460 |
, pNodes |

461 |
]) |

462 |
, ("OpBackupPrepare", |

463 |
[ pInstanceName |

464 |
, pExportMode |

465 |
]) |

466 |
, ("OpBackupExport", |

467 |
[ pInstanceName |

468 |
, pShutdownTimeout |

469 |
, pExportTargetNode |

470 |
, pShutdownInstance |

471 |
, pRemoveInstance |

472 |
, pIgnoreRemoveFailures |

473 |
, pExportMode |

474 |
, pX509KeyName |

475 |
, pX509DestCA |

476 |
]) |

477 |
, ("OpBackupRemove", |

478 |
[ pInstanceName ]) |

479 |
, ("OpTestAllocator", |

480 |
[ pIAllocatorDirection |

481 |
, pIAllocatorMode |

482 |
, pIAllocatorReqName |

483 |
, pIAllocatorNics |

484 |
, pIAllocatorDisks |

485 |
, pHypervisor |

486 |
, pIallocator |

487 |
, pInstTags |

488 |
, pIAllocatorMemory |

489 |
, pIAllocatorVCpus |

490 |
, pIAllocatorOs |

491 |
, pDiskTemplate |

492 |
, pIAllocatorInstances |

493 |
, pIAllocatorEvacMode |

494 |
, pTargetGroups |

495 |
, pIAllocatorSpindleUse |

496 |
, pIAllocatorCount |

497 |
]) |

498 |
, ("OpTestJqueue", |

499 |
[ pJQueueNotifyWaitLock |

500 |
, pJQueueNotifyExec |

501 |
, pJQueueLogMessages |

502 |
, pJQueueFail |

503 |
]) |

504 |
, ("OpTestDummy", |

505 |
[ pTestDummyResult |

506 |
, pTestDummyMessages |

507 |
, pTestDummyFail |

508 |
, pTestDummySubmitJobs |

509 |
]) |

510 |
, ("OpNetworkAdd", |

511 |
[ pNetworkName |

512 |
, pNetworkAddress4 |

513 |
, pNetworkGateway4 |

514 |
, pNetworkAddress6 |

515 |
, pNetworkGateway6 |

516 |
, pNetworkMacPrefix |

517 |
, pNetworkAddRsvdIps |

518 |
, pIpConflictsCheck |

519 |
, pInstTags |

520 |
]) |

521 |
, ("OpNetworkRemove", |

522 |
[ pNetworkName |

523 |
, pForce |

524 |
]) |

525 |
, ("OpNetworkSetParams", |

526 |
[ pNetworkName |

527 |
, pNetworkGateway4 |

528 |
, pNetworkAddress6 |

529 |
, pNetworkGateway6 |

530 |
, pNetworkMacPrefix |

531 |
, pNetworkAddRsvdIps |

532 |
, pNetworkRemoveRsvdIps |

533 |
]) |

534 |
, ("OpNetworkConnect", |

535 |
[ pGroupName |

536 |
, pNetworkName |

537 |
, pNetworkMode |

538 |
, pNetworkLink |

539 |
, pIpConflictsCheck |

540 |
]) |

541 |
, ("OpNetworkDisconnect", |

542 |
[ pGroupName |

543 |
, pNetworkName |

544 |
]) |

545 |
, ("OpNetworkQuery", dOldQuery) |

546 |
, ("OpRestrictedCommand", |

547 |
[ pUseLocking |

548 |
, pRequiredNodes |

549 |
, pRestrictedCommand |

550 |
]) |

551 |
]) |

552 | |

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

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

555 | |

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

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

558 | |

559 |
instance JSON OpCode where |

560 |
readJSON = loadOpCode |

561 |
showJSON = saveOpCode |

562 | |

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

564 |
opSummaryVal :: OpCode -> Maybe String |

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

605 |
opSummaryVal OpTagsGet { opKind = k } = |

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

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

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

609 |
opSummaryVal OpTestAllocator { opIallocator = s } = |

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

611 |
Just $ maybe "None" fromNonEmpty s |

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

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

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

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

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

617 |
opSummaryVal _ = Nothing |

618 | |

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

620 |
opSummary :: OpCode -> String |

621 |
opSummary op = |

622 |
case opSummaryVal op of |

623 |
Nothing -> op_suffix |

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

625 |
where op_suffix = drop 3 $ opID op |

626 | |

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

628 |
$(buildObject "CommonOpParams" "op" |

629 |
[ pDryRun |

630 |
, pDebugLevel |

631 |
, pOpPriority |

632 |
, pDependencies |

633 |
, pComment |

634 |
, pReason |

635 |
]) |

636 | |

637 |
-- | Default common parameter values. |

638 |
defOpParams :: CommonOpParams |

639 |
defOpParams = |

640 |
CommonOpParams { opDryRun = Nothing |

641 |
, opDebugLevel = Nothing |

642 |
, opPriority = OpPrioNormal |

643 |
, opDepends = Nothing |

644 |
, opComment = Nothing |

645 |
, opReason = [] |

646 |
} |

647 | |

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

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

650 |
, metaOpCode :: OpCode |

651 |
} deriving (Show, Eq) |

652 | |

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

654 |
showMeta :: MetaOpCode -> JSValue |

655 |
showMeta (MetaOpCode params op) = |

656 |
let objparams = toDictCommonOpParams params |

657 |
objop = toDictOpCode op |

658 |
in makeObj (objparams ++ objop) |

659 | |

660 |
-- | JSON deserialisation for 'MetaOpCode' |

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

662 |
readMeta v = do |

663 |
meta <- readJSON v |

664 |
op <- readJSON v |

665 |
return $ MetaOpCode meta op |

666 | |

667 |
instance JSON MetaOpCode where |

668 |
showJSON = showMeta |

669 |
readJSON = readMeta |

670 | |

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

672 |
-- 'MetaOpCode'. |

673 |
wrapOpCode :: OpCode -> MetaOpCode |

674 |
wrapOpCode = MetaOpCode defOpParams |

675 | |

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

677 |
setOpComment :: String -> MetaOpCode -> MetaOpCode |

678 |
setOpComment comment (MetaOpCode common op) = |

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

680 | |

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

682 |
setOpPriority :: OpSubmitPriority -> MetaOpCode -> MetaOpCode |

683 |
setOpPriority prio (MetaOpCode common op) = |

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