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

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 |
, pEnabledStorageTypes |

179 |
]) |

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

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

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

183 |
, ("OpQuery", |

184 |
[ pQueryWhat |

185 |
, pUseLocking |

186 |
, pQueryFields |

187 |
, pQueryFilter |

188 |
]) |

189 |
, ("OpQueryFields", |

190 |
[ pQueryWhat |

191 |
, pQueryFields |

192 |
]) |

193 |
, ("OpOobCommand", |

194 |
[ pNodeNames |

195 |
, pOobCommand |

196 |
, pOobTimeout |

197 |
, pIgnoreStatus |

198 |
, pPowerDelay |

199 |
]) |

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

201 |
, ("OpNodeAdd", |

202 |
[ pNodeName |

203 |
, pHvState |

204 |
, pDiskState |

205 |
, pPrimaryIp |

206 |
, pSecondaryIp |

207 |
, pReadd |

208 |
, pNodeGroup |

209 |
, pMasterCapable |

210 |
, pVmCapable |

211 |
, pNdParams |

212 |
]) |

213 |
, ("OpNodeQuery", dOldQuery) |

214 |
, ("OpNodeQueryvols", |

215 |
[ pOutputFields |

216 |
, pNodes |

217 |
]) |

218 |
, ("OpNodeQueryStorage", |

219 |
[ pOutputFields |

220 |
, pStorageType |

221 |
, pNodes |

222 |
, pStorageName |

223 |
]) |

224 |
, ("OpNodeModifyStorage", |

225 |
[ pNodeName |

226 |
, pStorageType |

227 |
, pStorageName |

228 |
, pStorageChanges |

229 |
]) |

230 |
, ("OpRepairNodeStorage", |

231 |
[ pNodeName |

232 |
, pStorageType |

233 |
, pStorageName |

234 |
, pIgnoreConsistency |

235 |
]) |

236 |
, ("OpNodeSetParams", |

237 |
[ pNodeName |

238 |
, pForce |

239 |
, pHvState |

240 |
, pDiskState |

241 |
, pMasterCandidate |

242 |
, pOffline |

243 |
, pDrained |

244 |
, pAutoPromote |

245 |
, pMasterCapable |

246 |
, pVmCapable |

247 |
, pSecondaryIp |

248 |
, pNdParams |

249 |
, pPowered |

250 |
]) |

251 |
, ("OpNodePowercycle", |

252 |
[ pNodeName |

253 |
, pForce |

254 |
]) |

255 |
, ("OpNodeMigrate", |

256 |
[ pNodeName |

257 |
, pMigrationMode |

258 |
, pMigrationLive |

259 |
, pMigrationTargetNode |

260 |
, pAllowRuntimeChgs |

261 |
, pIgnoreIpolicy |

262 |
, pIallocator |

263 |
]) |

264 |
, ("OpNodeEvacuate", |

265 |
[ pEarlyRelease |

266 |
, pNodeName |

267 |
, pRemoteNode |

268 |
, pIallocator |

269 |
, pEvacMode |

270 |
]) |

271 |
, ("OpInstanceCreate", |

272 |
[ pInstanceName |

273 |
, pForceVariant |

274 |
, pWaitForSync |

275 |
, pNameCheck |

276 |
, pIgnoreIpolicy |

277 |
, pInstBeParams |

278 |
, pInstDisks |

279 |
, pDiskTemplate |

280 |
, pFileDriver |

281 |
, pFileStorageDir |

282 |
, pInstHvParams |

283 |
, pHypervisor |

284 |
, pIallocator |

285 |
, pResetDefaults |

286 |
, pIpCheck |

287 |
, pIpConflictsCheck |

288 |
, pInstCreateMode |

289 |
, pInstNics |

290 |
, pNoInstall |

291 |
, pInstOsParams |

292 |
, pInstOs |

293 |
, pPrimaryNode |

294 |
, pSecondaryNode |

295 |
, pSourceHandshake |

296 |
, pSourceInstance |

297 |
, pSourceShutdownTimeout |

298 |
, pSourceX509Ca |

299 |
, pSrcNode |

300 |
, pSrcPath |

301 |
, pStartInstance |

302 |
, pOpportunisticLocking |

303 |
, pInstTags |

304 |
]) |

305 |
, ("OpInstanceMultiAlloc", |

306 |
[ pIallocator |

307 |
, pMultiAllocInstances |

308 |
, pOpportunisticLocking |

309 |
]) |

310 |
, ("OpInstanceReinstall", |

311 |
[ pInstanceName |

312 |
, pForceVariant |

313 |
, pInstOs |

314 |
, pTempOsParams |

315 |
]) |

316 |
, ("OpInstanceRemove", |

317 |
[ pInstanceName |

318 |
, pShutdownTimeout |

319 |
, pIgnoreFailures |

320 |
]) |

321 |
, ("OpInstanceRename", |

322 |
[ pInstanceName |

323 |
, pNewName |

324 |
, pNameCheck |

325 |
, pIpCheck |

326 |
]) |

327 |
, ("OpInstanceStartup", |

328 |
[ pInstanceName |

329 |
, pForce |

330 |
, pIgnoreOfflineNodes |

331 |
, pTempHvParams |

332 |
, pTempBeParams |

333 |
, pNoRemember |

334 |
, pStartupPaused |

335 |
]) |

336 |
, ("OpInstanceShutdown", |

337 |
[ pInstanceName |

338 |
, pForce |

339 |
, pIgnoreOfflineNodes |

340 |
, pShutdownTimeout' |

341 |
, pNoRemember |

342 |
]) |

343 |
, ("OpInstanceReboot", |

344 |
[ pInstanceName |

345 |
, pShutdownTimeout |

346 |
, pIgnoreSecondaries |

347 |
, pRebootType |

348 |
, pReason |

349 |
]) |

350 |
, ("OpInstanceMove", |

351 |
[ pInstanceName |

352 |
, pShutdownTimeout |

353 |
, pIgnoreIpolicy |

354 |
, pMoveTargetNode |

355 |
, pIgnoreConsistency |

356 |
]) |

357 |
, ("OpInstanceConsole", |

358 |
[ pInstanceName ]) |

359 |
, ("OpInstanceActivateDisks", |

360 |
[ pInstanceName |

361 |
, pIgnoreDiskSize |

362 |
, pWaitForSyncFalse |

363 |
]) |

364 |
, ("OpInstanceDeactivateDisks", |

365 |
[ pInstanceName |

366 |
, pForce |

367 |
]) |

368 |
, ("OpInstanceRecreateDisks", |

369 |
[ pInstanceName |

370 |
, pRecreateDisksInfo |

371 |
, pNodes |

372 |
, pIallocator |

373 |
]) |

374 |
, ("OpInstanceQuery", dOldQuery) |

375 |
, ("OpInstanceQueryData", |

376 |
[ pUseLocking |

377 |
, pInstances |

378 |
, pStatic |

379 |
]) |

380 |
, ("OpInstanceSetParams", |

381 |
[ pInstanceName |

382 |
, pForce |

383 |
, pForceVariant |

384 |
, pIgnoreIpolicy |

385 |
, pInstParamsNicChanges |

386 |
, pInstParamsDiskChanges |

387 |
, pInstBeParams |

388 |
, pRuntimeMem |

389 |
, pInstHvParams |

390 |
, pOptDiskTemplate |

391 |
, pRemoteNode |

392 |
, pOsNameChange |

393 |
, pInstOsParams |

394 |
, pWaitForSync |

395 |
, pOffline |

396 |
, pIpConflictsCheck |

397 |
]) |

398 |
, ("OpInstanceGrowDisk", |

399 |
[ pInstanceName |

400 |
, pWaitForSync |

401 |
, pDiskIndex |

402 |
, pDiskChgAmount |

403 |
, pDiskChgAbsolute |

404 |
]) |

405 |
, ("OpInstanceChangeGroup", |

406 |
[ pInstanceName |

407 |
, pEarlyRelease |

408 |
, pIallocator |

409 |
, pTargetGroups |

410 |
]) |

411 |
, ("OpGroupAdd", |

412 |
[ pGroupName |

413 |
, pNodeGroupAllocPolicy |

414 |
, pGroupNodeParams |

415 |
, pDiskParams |

416 |
, pHvState |

417 |
, pDiskState |

418 |
, pIpolicy |

419 |
]) |

420 |
, ("OpGroupAssignNodes", |

421 |
[ pGroupName |

422 |
, pForce |

423 |
, pRequiredNodes |

424 |
]) |

425 |
, ("OpGroupQuery", dOldQueryNoLocking) |

426 |
, ("OpGroupSetParams", |

427 |
[ pGroupName |

428 |
, pNodeGroupAllocPolicy |

429 |
, pGroupNodeParams |

430 |
, pDiskParams |

431 |
, pHvState |

432 |
, pDiskState |

433 |
, pIpolicy |

434 |
]) |

435 |
, ("OpGroupRemove", |

436 |
[ pGroupName ]) |

437 |
, ("OpGroupRename", |

438 |
[ pGroupName |

439 |
, pNewName |

440 |
]) |

441 |
, ("OpGroupEvacuate", |

442 |
[ pGroupName |

443 |
, pEarlyRelease |

444 |
, pIallocator |

445 |
, pTargetGroups |

446 |
]) |

447 |
, ("OpOsDiagnose", |

448 |
[ pOutputFields |

449 |
, pNames ]) |

450 |
, ("OpExtStorageDiagnose", |

451 |
[ pOutputFields |

452 |
, pNames ]) |

453 |
, ("OpBackupQuery", |

454 |
[ pUseLocking |

455 |
, pNodes |

456 |
]) |

457 |
, ("OpBackupPrepare", |

458 |
[ pInstanceName |

459 |
, pExportMode |

460 |
]) |

461 |
, ("OpBackupExport", |

462 |
[ pInstanceName |

463 |
, pShutdownTimeout |

464 |
, pExportTargetNode |

465 |
, pShutdownInstance |

466 |
, pRemoveInstance |

467 |
, pIgnoreRemoveFailures |

468 |
, pExportMode |

469 |
, pX509KeyName |

470 |
, pX509DestCA |

471 |
]) |

472 |
, ("OpBackupRemove", |

473 |
[ pInstanceName ]) |

474 |
, ("OpTestAllocator", |

475 |
[ pIAllocatorDirection |

476 |
, pIAllocatorMode |

477 |
, pIAllocatorReqName |

478 |
, pIAllocatorNics |

479 |
, pIAllocatorDisks |

480 |
, pHypervisor |

481 |
, pIallocator |

482 |
, pInstTags |

483 |
, pIAllocatorMemory |

484 |
, pIAllocatorVCpus |

485 |
, pIAllocatorOs |

486 |
, pDiskTemplate |

487 |
, pIAllocatorInstances |

488 |
, pIAllocatorEvacMode |

489 |
, pTargetGroups |

490 |
, pIAllocatorSpindleUse |

491 |
, pIAllocatorCount |

492 |
]) |

493 |
, ("OpTestJqueue", |

494 |
[ pJQueueNotifyWaitLock |

495 |
, pJQueueNotifyExec |

496 |
, pJQueueLogMessages |

497 |
, pJQueueFail |

498 |
]) |

499 |
, ("OpTestDummy", |

500 |
[ pTestDummyResult |

501 |
, pTestDummyMessages |

502 |
, pTestDummyFail |

503 |
, pTestDummySubmitJobs |

504 |
]) |

505 |
, ("OpNetworkAdd", |

506 |
[ pNetworkName |

507 |
, pNetworkAddress4 |

508 |
, pNetworkGateway4 |

509 |
, pNetworkAddress6 |

510 |
, pNetworkGateway6 |

511 |
, pNetworkMacPrefix |

512 |
, pNetworkAddRsvdIps |

513 |
, pIpConflictsCheck |

514 |
, pInstTags |

515 |
]) |

516 |
, ("OpNetworkRemove", |

517 |
[ pNetworkName |

518 |
, pForce |

519 |
]) |

520 |
, ("OpNetworkSetParams", |

521 |
[ pNetworkName |

522 |
, pNetworkGateway4 |

523 |
, pNetworkAddress6 |

524 |
, pNetworkGateway6 |

525 |
, pNetworkMacPrefix |

526 |
, pNetworkAddRsvdIps |

527 |
, pNetworkRemoveRsvdIps |

528 |
]) |

529 |
, ("OpNetworkConnect", |

530 |
[ pGroupName |

531 |
, pNetworkName |

532 |
, pNetworkMode |

533 |
, pNetworkLink |

534 |
, pIpConflictsCheck |

535 |
]) |

536 |
, ("OpNetworkDisconnect", |

537 |
[ pGroupName |

538 |
, pNetworkName |

539 |
]) |

540 |
, ("OpNetworkQuery", dOldQuery) |

541 |
, ("OpRestrictedCommand", |

542 |
[ pUseLocking |

543 |
, pRequiredNodes |

544 |
, pRestrictedCommand |

545 |
]) |

546 |
]) |

547 | |

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

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

550 | |

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

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

553 | |

554 |
instance JSON OpCode where |

555 |
readJSON = loadOpCode |

556 |
showJSON = saveOpCode |

557 | |

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

559 |
opSummaryVal :: OpCode -> Maybe String |

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

600 |
opSummaryVal OpTagsGet { opKind = k } = |

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

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

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

604 |
opSummaryVal OpTestAllocator { opIallocator = s } = |

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

606 |
Just $ maybe "None" fromNonEmpty s |

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

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

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

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

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

612 |
opSummaryVal _ = Nothing |

613 | |

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

615 |
opSummary :: OpCode -> String |

616 |
opSummary op = |

617 |
case opSummaryVal op of |

618 |
Nothing -> op_suffix |

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

620 |
where op_suffix = drop 3 $ opID op |

621 | |

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

623 |
$(buildObject "CommonOpParams" "op" |

624 |
[ pDryRun |

625 |
, pDebugLevel |

626 |
, pOpPriority |

627 |
, pDependencies |

628 |
, pComment |

629 |
]) |

630 | |

631 |
-- | Default common parameter values. |

632 |
defOpParams :: CommonOpParams |

633 |
defOpParams = |

634 |
CommonOpParams { opDryRun = Nothing |

635 |
, opDebugLevel = Nothing |

636 |
, opPriority = OpPrioNormal |

637 |
, opDepends = Nothing |

638 |
, opComment = Nothing |

639 |
} |

640 | |

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

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

643 |
, metaOpCode :: OpCode |

644 |
} deriving (Show, Eq) |

645 | |

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

647 |
showMeta :: MetaOpCode -> JSValue |

648 |
showMeta (MetaOpCode params op) = |

649 |
let objparams = toDictCommonOpParams params |

650 |
objop = toDictOpCode op |

651 |
in makeObj (objparams ++ objop) |

652 | |

653 |
-- | JSON deserialisation for 'MetaOpCode' |

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

655 |
readMeta v = do |

656 |
meta <- readJSON v |

657 |
op <- readJSON v |

658 |
return $ MetaOpCode meta op |

659 | |

660 |
instance JSON MetaOpCode where |

661 |
showJSON = showMeta |

662 |
readJSON = readMeta |

663 | |

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

665 |
-- 'MetaOpCode'. |

666 |
wrapOpCode :: OpCode -> MetaOpCode |

667 |
wrapOpCode = MetaOpCode defOpParams |

668 | |

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

670 |
setOpComment :: String -> MetaOpCode -> MetaOpCode |

671 |
setOpComment comment (MetaOpCode common op) = |

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

673 | |

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

675 |
setOpPriority :: OpSubmitPriority -> MetaOpCode -> MetaOpCode |

676 |
setOpPriority prio (MetaOpCode common op) = |

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