root / src / Ganeti / OpCodes.hs @ 95c0c0bc
History | View | Annotate | Download (17.7 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 |
, pDelayOnNodeUuids |
70 |
, pDelayRepeat |
71 |
]) |
72 |
, ("OpInstanceReplaceDisks", |
73 |
[ pInstanceName |
74 |
, pInstanceUuid |
75 |
, pEarlyRelease |
76 |
, pIgnoreIpolicy |
77 |
, pReplaceDisksMode |
78 |
, pReplaceDisksList |
79 |
, pRemoteNode |
80 |
, pRemoteNodeUuid |
81 |
, pIallocator |
82 |
]) |
83 |
, ("OpInstanceFailover", |
84 |
[ pInstanceName |
85 |
, pInstanceUuid |
86 |
, pShutdownTimeout |
87 |
, pIgnoreConsistency |
88 |
, pMigrationTargetNode |
89 |
, pMigrationTargetNodeUuid |
90 |
, pIgnoreIpolicy |
91 |
, pIallocator |
92 |
]) |
93 |
, ("OpInstanceMigrate", |
94 |
[ pInstanceName |
95 |
, pInstanceUuid |
96 |
, pMigrationMode |
97 |
, pMigrationLive |
98 |
, pMigrationTargetNode |
99 |
, pMigrationTargetNodeUuid |
100 |
, pAllowRuntimeChgs |
101 |
, pIgnoreIpolicy |
102 |
, pMigrationCleanup |
103 |
, pIallocator |
104 |
, pAllowFailover |
105 |
]) |
106 |
, ("OpTagsGet", |
107 |
[ pTagsObject |
108 |
, pUseLocking |
109 |
]) |
110 |
, ("OpTagsSearch", |
111 |
[ pTagSearchPattern ]) |
112 |
, ("OpTagsSet", |
113 |
[ pTagsObject |
114 |
, pTagsList |
115 |
]) |
116 |
, ("OpTagsDel", |
117 |
[ pTagsObject |
118 |
, pTagsList |
119 |
]) |
120 |
, ("OpClusterPostInit", []) |
121 |
, ("OpClusterDestroy", []) |
122 |
, ("OpClusterQuery", []) |
123 |
, ("OpClusterVerify", |
124 |
[ pDebugSimulateErrors |
125 |
, pErrorCodes |
126 |
, pSkipChecks |
127 |
, pIgnoreErrors |
128 |
, pVerbose |
129 |
, pOptGroupName |
130 |
]) |
131 |
, ("OpClusterVerifyConfig", |
132 |
[ pDebugSimulateErrors |
133 |
, pErrorCodes |
134 |
, pIgnoreErrors |
135 |
, pVerbose |
136 |
]) |
137 |
, ("OpClusterVerifyGroup", |
138 |
[ pGroupName |
139 |
, pDebugSimulateErrors |
140 |
, pErrorCodes |
141 |
, pSkipChecks |
142 |
, pIgnoreErrors |
143 |
, pVerbose |
144 |
]) |
145 |
, ("OpClusterVerifyDisks", []) |
146 |
, ("OpGroupVerifyDisks", |
147 |
[ pGroupName |
148 |
]) |
149 |
, ("OpClusterRepairDiskSizes", |
150 |
[ pInstances |
151 |
]) |
152 |
, ("OpClusterConfigQuery", |
153 |
[ pOutputFields |
154 |
]) |
155 |
, ("OpClusterRename", |
156 |
[ pName |
157 |
]) |
158 |
, ("OpClusterSetParams", |
159 |
[ pForce |
160 |
, pHvState |
161 |
, pDiskState |
162 |
, pVgName |
163 |
, pEnabledHypervisors |
164 |
, pClusterHvParams |
165 |
, pClusterBeParams |
166 |
, pOsHvp |
167 |
, pClusterOsParams |
168 |
, pDiskParams |
169 |
, pCandidatePoolSize |
170 |
, pUidPool |
171 |
, pAddUids |
172 |
, pRemoveUids |
173 |
, pMaintainNodeHealth |
174 |
, pPreallocWipeDisks |
175 |
, pNicParams |
176 |
, pNdParams |
177 |
, pIpolicy |
178 |
, pDrbdHelper |
179 |
, pDefaultIAllocator |
180 |
, pMasterNetdev |
181 |
, pMasterNetmask |
182 |
, pReservedLvs |
183 |
, pHiddenOs |
184 |
, pBlacklistedOs |
185 |
, pUseExternalMipScript |
186 |
, pEnabledDiskTemplates |
187 |
, pModifyEtcHosts |
188 |
]) |
189 |
, ("OpClusterRedistConf", []) |
190 |
, ("OpClusterActivateMasterIp", []) |
191 |
, ("OpClusterDeactivateMasterIp", []) |
192 |
, ("OpQuery", |
193 |
[ pQueryWhat |
194 |
, pUseLocking |
195 |
, pQueryFields |
196 |
, pQueryFilter |
197 |
]) |
198 |
, ("OpQueryFields", |
199 |
[ pQueryWhat |
200 |
, pQueryFields |
201 |
]) |
202 |
, ("OpOobCommand", |
203 |
[ pNodeNames |
204 |
, pNodeUuids |
205 |
, pOobCommand |
206 |
, pOobTimeout |
207 |
, pIgnoreStatus |
208 |
, pPowerDelay |
209 |
]) |
210 |
, ("OpNodeRemove", |
211 |
[ pNodeName |
212 |
, pNodeUuid |
213 |
]) |
214 |
, ("OpNodeAdd", |
215 |
[ pNodeName |
216 |
, pHvState |
217 |
, pDiskState |
218 |
, pPrimaryIp |
219 |
, pSecondaryIp |
220 |
, pReadd |
221 |
, pNodeGroup |
222 |
, pMasterCapable |
223 |
, pVmCapable |
224 |
, pNdParams |
225 |
]) |
226 |
, ("OpNodeQuery", dOldQuery) |
227 |
, ("OpNodeQueryvols", |
228 |
[ pOutputFields |
229 |
, pNodes |
230 |
]) |
231 |
, ("OpNodeQueryStorage", |
232 |
[ pOutputFields |
233 |
, pStorageType |
234 |
, pNodes |
235 |
, pStorageName |
236 |
]) |
237 |
, ("OpNodeModifyStorage", |
238 |
[ pNodeName |
239 |
, pNodeUuid |
240 |
, pStorageType |
241 |
, pStorageName |
242 |
, pStorageChanges |
243 |
]) |
244 |
, ("OpRepairNodeStorage", |
245 |
[ pNodeName |
246 |
, pNodeUuid |
247 |
, pStorageType |
248 |
, pStorageName |
249 |
, pIgnoreConsistency |
250 |
]) |
251 |
, ("OpNodeSetParams", |
252 |
[ pNodeName |
253 |
, pNodeUuid |
254 |
, pForce |
255 |
, pHvState |
256 |
, pDiskState |
257 |
, pMasterCandidate |
258 |
, pOffline |
259 |
, pDrained |
260 |
, pAutoPromote |
261 |
, pMasterCapable |
262 |
, pVmCapable |
263 |
, pSecondaryIp |
264 |
, pNdParams |
265 |
, pPowered |
266 |
]) |
267 |
, ("OpNodePowercycle", |
268 |
[ pNodeName |
269 |
, pNodeUuid |
270 |
, pForce |
271 |
]) |
272 |
, ("OpNodeMigrate", |
273 |
[ pNodeName |
274 |
, pNodeUuid |
275 |
, pMigrationMode |
276 |
, pMigrationLive |
277 |
, pMigrationTargetNode |
278 |
, pMigrationTargetNodeUuid |
279 |
, pAllowRuntimeChgs |
280 |
, pIgnoreIpolicy |
281 |
, pIallocator |
282 |
]) |
283 |
, ("OpNodeEvacuate", |
284 |
[ pEarlyRelease |
285 |
, pNodeName |
286 |
, pNodeUuid |
287 |
, pRemoteNode |
288 |
, pRemoteNodeUuid |
289 |
, pIallocator |
290 |
, pEvacMode |
291 |
]) |
292 |
, ("OpInstanceCreate", |
293 |
[ pInstanceName |
294 |
, pForceVariant |
295 |
, pWaitForSync |
296 |
, pNameCheck |
297 |
, pIgnoreIpolicy |
298 |
, pInstBeParams |
299 |
, pInstDisks |
300 |
, pDiskTemplate |
301 |
, pFileDriver |
302 |
, pFileStorageDir |
303 |
, pInstHvParams |
304 |
, pHypervisor |
305 |
, pIallocator |
306 |
, pResetDefaults |
307 |
, pIpCheck |
308 |
, pIpConflictsCheck |
309 |
, pInstCreateMode |
310 |
, pInstNics |
311 |
, pNoInstall |
312 |
, pInstOsParams |
313 |
, pInstOs |
314 |
, pPrimaryNode |
315 |
, pPrimaryNodeUuid |
316 |
, pSecondaryNode |
317 |
, pSecondaryNodeUuid |
318 |
, pSourceHandshake |
319 |
, pSourceInstance |
320 |
, pSourceShutdownTimeout |
321 |
, pSourceX509Ca |
322 |
, pSrcNode |
323 |
, pSrcNodeUuid |
324 |
, pSrcPath |
325 |
, pStartInstance |
326 |
, pOpportunisticLocking |
327 |
, pInstTags |
328 |
]) |
329 |
, ("OpInstanceMultiAlloc", |
330 |
[ pIallocator |
331 |
, pMultiAllocInstances |
332 |
, pOpportunisticLocking |
333 |
]) |
334 |
, ("OpInstanceReinstall", |
335 |
[ pInstanceName |
336 |
, pInstanceUuid |
337 |
, pForceVariant |
338 |
, pInstOs |
339 |
, pTempOsParams |
340 |
]) |
341 |
, ("OpInstanceRemove", |
342 |
[ pInstanceName |
343 |
, pInstanceUuid |
344 |
, pShutdownTimeout |
345 |
, pIgnoreFailures |
346 |
]) |
347 |
, ("OpInstanceRename", |
348 |
[ pInstanceName |
349 |
, pInstanceUuid |
350 |
, pNewName |
351 |
, pNameCheck |
352 |
, pIpCheck |
353 |
]) |
354 |
, ("OpInstanceStartup", |
355 |
[ pInstanceName |
356 |
, pInstanceUuid |
357 |
, pForce |
358 |
, pIgnoreOfflineNodes |
359 |
, pTempHvParams |
360 |
, pTempBeParams |
361 |
, pNoRemember |
362 |
, pStartupPaused |
363 |
]) |
364 |
, ("OpInstanceShutdown", |
365 |
[ pInstanceName |
366 |
, pInstanceUuid |
367 |
, pForce |
368 |
, pIgnoreOfflineNodes |
369 |
, pShutdownTimeout' |
370 |
, pNoRemember |
371 |
]) |
372 |
, ("OpInstanceReboot", |
373 |
[ pInstanceName |
374 |
, pInstanceUuid |
375 |
, pShutdownTimeout |
376 |
, pIgnoreSecondaries |
377 |
, pRebootType |
378 |
]) |
379 |
, ("OpInstanceMove", |
380 |
[ pInstanceName |
381 |
, pInstanceUuid |
382 |
, pShutdownTimeout |
383 |
, pIgnoreIpolicy |
384 |
, pMoveTargetNode |
385 |
, pMoveTargetNodeUuid |
386 |
, pIgnoreConsistency |
387 |
]) |
388 |
, ("OpInstanceConsole", |
389 |
[ pInstanceName |
390 |
, pInstanceUuid |
391 |
]) |
392 |
, ("OpInstanceActivateDisks", |
393 |
[ pInstanceName |
394 |
, pInstanceUuid |
395 |
, pIgnoreDiskSize |
396 |
, pWaitForSyncFalse |
397 |
]) |
398 |
, ("OpInstanceDeactivateDisks", |
399 |
[ pInstanceName |
400 |
, pInstanceUuid |
401 |
, pForce |
402 |
]) |
403 |
, ("OpInstanceRecreateDisks", |
404 |
[ pInstanceName |
405 |
, pInstanceUuid |
406 |
, pRecreateDisksInfo |
407 |
, pNodes |
408 |
, pNodeUuids |
409 |
, pIallocator |
410 |
]) |
411 |
, ("OpInstanceQuery", dOldQuery) |
412 |
, ("OpInstanceQueryData", |
413 |
[ pUseLocking |
414 |
, pInstances |
415 |
, pStatic |
416 |
]) |
417 |
, ("OpInstanceSetParams", |
418 |
[ pInstanceName |
419 |
, pInstanceUuid |
420 |
, pForce |
421 |
, pForceVariant |
422 |
, pIgnoreIpolicy |
423 |
, pInstParamsNicChanges |
424 |
, pInstParamsDiskChanges |
425 |
, pInstBeParams |
426 |
, pRuntimeMem |
427 |
, pInstHvParams |
428 |
, pOptDiskTemplate |
429 |
, pPrimaryNode |
430 |
, pPrimaryNodeUuid |
431 |
, pRemoteNode |
432 |
, pRemoteNodeUuid |
433 |
, pOsNameChange |
434 |
, pInstOsParams |
435 |
, pWaitForSync |
436 |
, pOffline |
437 |
, pIpConflictsCheck |
438 |
, pHotplug |
439 |
]) |
440 |
, ("OpInstanceGrowDisk", |
441 |
[ pInstanceName |
442 |
, pInstanceUuid |
443 |
, pWaitForSync |
444 |
, pDiskIndex |
445 |
, pDiskChgAmount |
446 |
, pDiskChgAbsolute |
447 |
]) |
448 |
, ("OpInstanceChangeGroup", |
449 |
[ pInstanceName |
450 |
, pInstanceUuid |
451 |
, pEarlyRelease |
452 |
, pIallocator |
453 |
, pTargetGroups |
454 |
]) |
455 |
, ("OpGroupAdd", |
456 |
[ pGroupName |
457 |
, pNodeGroupAllocPolicy |
458 |
, pGroupNodeParams |
459 |
, pDiskParams |
460 |
, pHvState |
461 |
, pDiskState |
462 |
, pIpolicy |
463 |
]) |
464 |
, ("OpGroupAssignNodes", |
465 |
[ pGroupName |
466 |
, pForce |
467 |
, pRequiredNodes |
468 |
, pRequiredNodeUuids |
469 |
]) |
470 |
, ("OpGroupQuery", dOldQueryNoLocking) |
471 |
, ("OpGroupSetParams", |
472 |
[ pGroupName |
473 |
, pNodeGroupAllocPolicy |
474 |
, pGroupNodeParams |
475 |
, pDiskParams |
476 |
, pHvState |
477 |
, pDiskState |
478 |
, pIpolicy |
479 |
]) |
480 |
, ("OpGroupRemove", |
481 |
[ pGroupName ]) |
482 |
, ("OpGroupRename", |
483 |
[ pGroupName |
484 |
, pNewName |
485 |
]) |
486 |
, ("OpGroupEvacuate", |
487 |
[ pGroupName |
488 |
, pEarlyRelease |
489 |
, pIallocator |
490 |
, pTargetGroups |
491 |
]) |
492 |
, ("OpOsDiagnose", |
493 |
[ pOutputFields |
494 |
, pNames ]) |
495 |
, ("OpExtStorageDiagnose", |
496 |
[ pOutputFields |
497 |
, pNames ]) |
498 |
, ("OpBackupQuery", |
499 |
[ pUseLocking |
500 |
, pNodes |
501 |
]) |
502 |
, ("OpBackupPrepare", |
503 |
[ pInstanceName |
504 |
, pInstanceUuid |
505 |
, pExportMode |
506 |
]) |
507 |
, ("OpBackupExport", |
508 |
[ pInstanceName |
509 |
, pInstanceUuid |
510 |
, pShutdownTimeout |
511 |
, pExportTargetNode |
512 |
, pExportTargetNodeUuid |
513 |
, pShutdownInstance |
514 |
, pRemoveInstance |
515 |
, pIgnoreRemoveFailures |
516 |
, pExportMode |
517 |
, pX509KeyName |
518 |
, pX509DestCA |
519 |
]) |
520 |
, ("OpBackupRemove", |
521 |
[ pInstanceName |
522 |
, pInstanceUuid |
523 |
]) |
524 |
, ("OpTestAllocator", |
525 |
[ pIAllocatorDirection |
526 |
, pIAllocatorMode |
527 |
, pIAllocatorReqName |
528 |
, pIAllocatorNics |
529 |
, pIAllocatorDisks |
530 |
, pHypervisor |
531 |
, pIallocator |
532 |
, pInstTags |
533 |
, pIAllocatorMemory |
534 |
, pIAllocatorVCpus |
535 |
, pIAllocatorOs |
536 |
, pDiskTemplate |
537 |
, pIAllocatorInstances |
538 |
, pIAllocatorEvacMode |
539 |
, pTargetGroups |
540 |
, pIAllocatorSpindleUse |
541 |
, pIAllocatorCount |
542 |
]) |
543 |
, ("OpTestJqueue", |
544 |
[ pJQueueNotifyWaitLock |
545 |
, pJQueueNotifyExec |
546 |
, pJQueueLogMessages |
547 |
, pJQueueFail |
548 |
]) |
549 |
, ("OpTestDummy", |
550 |
[ pTestDummyResult |
551 |
, pTestDummyMessages |
552 |
, pTestDummyFail |
553 |
, pTestDummySubmitJobs |
554 |
]) |
555 |
, ("OpNetworkAdd", |
556 |
[ pNetworkName |
557 |
, pNetworkAddress4 |
558 |
, pNetworkGateway4 |
559 |
, pNetworkAddress6 |
560 |
, pNetworkGateway6 |
561 |
, pNetworkMacPrefix |
562 |
, pNetworkAddRsvdIps |
563 |
, pIpConflictsCheck |
564 |
, pInstTags |
565 |
]) |
566 |
, ("OpNetworkRemove", |
567 |
[ pNetworkName |
568 |
, pForce |
569 |
]) |
570 |
, ("OpNetworkSetParams", |
571 |
[ pNetworkName |
572 |
, pNetworkGateway4 |
573 |
, pNetworkAddress6 |
574 |
, pNetworkGateway6 |
575 |
, pNetworkMacPrefix |
576 |
, pNetworkAddRsvdIps |
577 |
, pNetworkRemoveRsvdIps |
578 |
]) |
579 |
, ("OpNetworkConnect", |
580 |
[ pGroupName |
581 |
, pNetworkName |
582 |
, pNetworkMode |
583 |
, pNetworkLink |
584 |
, pIpConflictsCheck |
585 |
]) |
586 |
, ("OpNetworkDisconnect", |
587 |
[ pGroupName |
588 |
, pNetworkName |
589 |
]) |
590 |
, ("OpNetworkQuery", dOldQuery) |
591 |
, ("OpRestrictedCommand", |
592 |
[ pUseLocking |
593 |
, pRequiredNodes |
594 |
, pRequiredNodeUuids |
595 |
, pRestrictedCommand |
596 |
]) |
597 |
]) |
598 |
|
599 |
-- | Returns the OP_ID for a given opcode value. |
600 |
$(genOpID ''OpCode "opID") |
601 |
|
602 |
-- | A list of all defined/supported opcode IDs. |
603 |
$(genAllOpIDs ''OpCode "allOpIDs") |
604 |
|
605 |
instance JSON OpCode where |
606 |
readJSON = loadOpCode |
607 |
showJSON = saveOpCode |
608 |
|
609 |
-- | Generates the summary value for an opcode. |
610 |
opSummaryVal :: OpCode -> Maybe String |
611 |
opSummaryVal OpClusterVerifyGroup { opGroupName = s } = Just (fromNonEmpty s) |
612 |
opSummaryVal OpGroupVerifyDisks { opGroupName = s } = Just (fromNonEmpty s) |
613 |
opSummaryVal OpClusterRename { opName = s } = Just (fromNonEmpty s) |
614 |
opSummaryVal OpQuery { opWhat = s } = Just (queryTypeOpToRaw s) |
615 |
opSummaryVal OpQueryFields { opWhat = s } = Just (queryTypeOpToRaw s) |
616 |
opSummaryVal OpNodeRemove { opNodeName = s } = Just (fromNonEmpty s) |
617 |
opSummaryVal OpNodeAdd { opNodeName = s } = Just (fromNonEmpty s) |
618 |
opSummaryVal OpNodeModifyStorage { opNodeName = s } = Just (fromNonEmpty s) |
619 |
opSummaryVal OpRepairNodeStorage { opNodeName = s } = Just (fromNonEmpty s) |
620 |
opSummaryVal OpNodeSetParams { opNodeName = s } = Just (fromNonEmpty s) |
621 |
opSummaryVal OpNodePowercycle { opNodeName = s } = Just (fromNonEmpty s) |
622 |
opSummaryVal OpNodeMigrate { opNodeName = s } = Just (fromNonEmpty s) |
623 |
opSummaryVal OpNodeEvacuate { opNodeName = s } = Just (fromNonEmpty s) |
624 |
opSummaryVal OpInstanceCreate { opInstanceName = s } = Just s |
625 |
opSummaryVal OpInstanceReinstall { opInstanceName = s } = Just s |
626 |
opSummaryVal OpInstanceRemove { opInstanceName = s } = Just s |
627 |
-- FIXME: instance rename should show both names; currently it shows none |
628 |
-- opSummaryVal OpInstanceRename { opInstanceName = s } = Just s |
629 |
opSummaryVal OpInstanceStartup { opInstanceName = s } = Just s |
630 |
opSummaryVal OpInstanceShutdown { opInstanceName = s } = Just s |
631 |
opSummaryVal OpInstanceReboot { opInstanceName = s } = Just s |
632 |
opSummaryVal OpInstanceReplaceDisks { opInstanceName = s } = Just s |
633 |
opSummaryVal OpInstanceFailover { opInstanceName = s } = Just s |
634 |
opSummaryVal OpInstanceMigrate { opInstanceName = s } = Just s |
635 |
opSummaryVal OpInstanceMove { opInstanceName = s } = Just s |
636 |
opSummaryVal OpInstanceConsole { opInstanceName = s } = Just s |
637 |
opSummaryVal OpInstanceActivateDisks { opInstanceName = s } = Just s |
638 |
opSummaryVal OpInstanceDeactivateDisks { opInstanceName = s } = Just s |
639 |
opSummaryVal OpInstanceRecreateDisks { opInstanceName = s } = Just s |
640 |
opSummaryVal OpInstanceSetParams { opInstanceName = s } = Just s |
641 |
opSummaryVal OpInstanceGrowDisk { opInstanceName = s } = Just s |
642 |
opSummaryVal OpInstanceChangeGroup { opInstanceName = s } = Just s |
643 |
opSummaryVal OpGroupAdd { opGroupName = s } = Just (fromNonEmpty s) |
644 |
opSummaryVal OpGroupAssignNodes { opGroupName = s } = Just (fromNonEmpty s) |
645 |
opSummaryVal OpGroupSetParams { opGroupName = s } = Just (fromNonEmpty s) |
646 |
opSummaryVal OpGroupRemove { opGroupName = s } = Just (fromNonEmpty s) |
647 |
opSummaryVal OpGroupEvacuate { opGroupName = s } = Just (fromNonEmpty s) |
648 |
opSummaryVal OpBackupPrepare { opInstanceName = s } = Just s |
649 |
opSummaryVal OpBackupExport { opInstanceName = s } = Just s |
650 |
opSummaryVal OpBackupRemove { opInstanceName = s } = Just s |
651 |
opSummaryVal OpTagsGet { opKind = k } = |
652 |
Just . fromMaybe "None" $ tagNameOf k |
653 |
opSummaryVal OpTagsSearch { opTagSearchPattern = s } = Just (fromNonEmpty s) |
654 |
opSummaryVal OpTestDelay { opDelayDuration = d } = Just (show d) |
655 |
opSummaryVal OpTestAllocator { opIallocator = s } = |
656 |
-- FIXME: Python doesn't handle None fields well, so we have behave the same |
657 |
Just $ maybe "None" fromNonEmpty s |
658 |
opSummaryVal OpNetworkAdd { opNetworkName = s} = Just (fromNonEmpty s) |
659 |
opSummaryVal OpNetworkRemove { opNetworkName = s} = Just (fromNonEmpty s) |
660 |
opSummaryVal OpNetworkSetParams { opNetworkName = s} = Just (fromNonEmpty s) |
661 |
opSummaryVal OpNetworkConnect { opNetworkName = s} = Just (fromNonEmpty s) |
662 |
opSummaryVal OpNetworkDisconnect { opNetworkName = s} = Just (fromNonEmpty s) |
663 |
opSummaryVal _ = Nothing |
664 |
|
665 |
-- | Computes the summary of the opcode. |
666 |
opSummary :: OpCode -> String |
667 |
opSummary op = |
668 |
case opSummaryVal op of |
669 |
Nothing -> op_suffix |
670 |
Just s -> op_suffix ++ "(" ++ s ++ ")" |
671 |
where op_suffix = drop 3 $ opID op |
672 |
|
673 |
-- | Generic\/common opcode parameters. |
674 |
$(buildObject "CommonOpParams" "op" |
675 |
[ pDryRun |
676 |
, pDebugLevel |
677 |
, pOpPriority |
678 |
, pDependencies |
679 |
, pComment |
680 |
, pReason |
681 |
]) |
682 |
|
683 |
-- | Default common parameter values. |
684 |
defOpParams :: CommonOpParams |
685 |
defOpParams = |
686 |
CommonOpParams { opDryRun = Nothing |
687 |
, opDebugLevel = Nothing |
688 |
, opPriority = OpPrioNormal |
689 |
, opDepends = Nothing |
690 |
, opComment = Nothing |
691 |
, opReason = [] |
692 |
} |
693 |
|
694 |
-- | The top-level opcode type. |
695 |
data MetaOpCode = MetaOpCode { metaParams :: CommonOpParams |
696 |
, metaOpCode :: OpCode |
697 |
} deriving (Show, Eq) |
698 |
|
699 |
-- | JSON serialisation for 'MetaOpCode'. |
700 |
showMeta :: MetaOpCode -> JSValue |
701 |
showMeta (MetaOpCode params op) = |
702 |
let objparams = toDictCommonOpParams params |
703 |
objop = toDictOpCode op |
704 |
in makeObj (objparams ++ objop) |
705 |
|
706 |
-- | JSON deserialisation for 'MetaOpCode' |
707 |
readMeta :: JSValue -> Text.JSON.Result MetaOpCode |
708 |
readMeta v = do |
709 |
meta <- readJSON v |
710 |
op <- readJSON v |
711 |
return $ MetaOpCode meta op |
712 |
|
713 |
instance JSON MetaOpCode where |
714 |
showJSON = showMeta |
715 |
readJSON = readMeta |
716 |
|
717 |
-- | Wraps an 'OpCode' with the default parameters to build a |
718 |
-- 'MetaOpCode'. |
719 |
wrapOpCode :: OpCode -> MetaOpCode |
720 |
wrapOpCode = MetaOpCode defOpParams |
721 |
|
722 |
-- | Sets the comment on a meta opcode. |
723 |
setOpComment :: String -> MetaOpCode -> MetaOpCode |
724 |
setOpComment comment (MetaOpCode common op) = |
725 |
MetaOpCode (common { opComment = Just comment}) op |
726 |
|
727 |
-- | Sets the priority on a meta opcode. |
728 |
setOpPriority :: OpSubmitPriority -> MetaOpCode -> MetaOpCode |
729 |
setOpPriority prio (MetaOpCode common op) = |
730 |
MetaOpCode (common { opPriority = prio }) op |