root / src / Ganeti / OpCodes.hs @ 7b6996a8
History  View  Annotate  Download (27.6 kB)
1 
{# LANGUAGE ExistentialQuantification, TemplateHaskell #} 

2 
{# OPTIONS_GHC fnowarnorphans #} 
3  
4 
{ Implementation of the opcodes. 
5  
6 
} 
7  
8 
{ 
9  
10 
Copyright (C) 2009, 2010, 2011, 2012, 2013 Google Inc. 
11  
12 
This program is free software; you can redistribute it and/or modify 
13 
it under the terms of the GNU General Public License as published by 
14 
the Free Software Foundation; either version 2 of the License, or 
15 
(at your option) any later version. 
16  
17 
This program is distributed in the hope that it will be useful, but 
18 
WITHOUT ANY WARRANTY; without even the implied warranty of 
19 
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 
20 
General Public License for more details. 
21  
22 
You should have received a copy of the GNU General Public License 
23 
along with this program; if not, write to the Free Software 
24 
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 
25 
021101301, USA. 
26  
27 
} 
28  
29 
module Ganeti.OpCodes 
30 
( pyClasses 
31 
, OpCode(..) 
32 
, ReplaceDisksMode(..) 
33 
, DiskIndex 
34 
, mkDiskIndex 
35 
, unDiskIndex 
36 
, opID 
37 
, allOpIDs 
38 
, allOpFields 
39 
, opSummary 
40 
, CommonOpParams(..) 
41 
, defOpParams 
42 
, MetaOpCode(..) 
43 
, wrapOpCode 
44 
, setOpComment 
45 
, setOpPriority 
46 
) where 
47  
48 
import Text.JSON (readJSON, JSObject, JSON, JSValue(..), makeObj, fromJSObject) 
49 
import qualified Text.JSON 
50  
51 
import Ganeti.THH 
52  
53 
import qualified Ganeti.Hs2Py.OpDoc as OpDoc 
54 
import Ganeti.OpParams 
55 
import Ganeti.Types 
56 
import Ganeti.Query.Language (queryTypeOpToRaw) 
57  
58 
import Data.List (intercalate) 
59 
import Data.Map (Map) 
60 
import qualified Data.Map as Map 
61 
import Data.Set (Set) 
62 
import qualified Data.Set as Set 
63  
64 
import qualified Ganeti.Constants as C 
65  
66 
instance PyValue Bool 
67 
instance PyValue Int 
68 
instance PyValue Double 
69 
instance PyValue Char 
70  
71 
instance (PyValue a, PyValue b) => PyValue (a, b) where 
72 
showValue (x, y) = show (showValue x, showValue y) 
73  
74 
instance PyValue a => PyValue [a] where 
75 
showValue xs = show (map showValue xs) 
76  
77 
instance PyValue a => PyValue (Set a) where 
78 
showValue s = showValue (Set.toList s) 
79  
80 
instance (PyValue k, PyValue a) => PyValue (Map k a) where 
81 
showValue mp = 
82 
"{" ++ intercalate ", " (map showPair (Map.assocs mp)) ++ "}" 
83 
where showPair (k, x) = show k ++ ":" ++ show x 
84  
85 
instance PyValue DiskIndex where 
86 
showValue = showValue . unDiskIndex 
87  
88 
instance PyValue IDiskParams where 
89 
showValue _ = error "OpCodes.showValue(IDiskParams): unhandled case" 
90  
91 
instance PyValue RecreateDisksInfo where 
92 
showValue RecreateDisksAll = "[]" 
93 
showValue (RecreateDisksIndices is) = showValue is 
94 
showValue (RecreateDisksParams is) = showValue is 
95  
96 
instance PyValue a => PyValue (SetParamsMods a) where 
97 
showValue SetParamsEmpty = "[]" 
98 
showValue _ = error "OpCodes.showValue(SetParamsMods): unhandled case" 
99  
100 
instance PyValue a => PyValue (NonNegative a) where 
101 
showValue = showValue . fromNonNegative 
102 

103 
instance PyValue a => PyValue (NonEmpty a) where 
104 
showValue = showValue . fromNonEmpty 
105 

106 
 FIXME: should use the 'toRaw' function instead of being harcoded or 
107 
 perhaps use something similar to the NonNegative type instead of 
108 
 using the declareSADT 
109 
instance PyValue ExportMode where 
110 
showValue ExportModeLocal = show C.exportModeLocal 
111 
showValue ExportModeRemove = show C.exportModeLocal 
112  
113 
instance PyValue CVErrorCode where 
114 
showValue = cVErrorCodeToRaw 
115 

116 
instance PyValue VerifyOptionalChecks where 
117 
showValue = verifyOptionalChecksToRaw 
118  
119 
instance PyValue INicParams where 
120 
showValue = error "instance PyValue INicParams: not implemented" 
121  
122 
instance PyValue a => PyValue (JSObject a) where 
123 
showValue obj = 
124 
"{" ++ intercalate ", " (map showPair (fromJSObject obj)) ++ "}" 
125 
where showPair (k, v) = show k ++ ":" ++ showValue v 
126  
127 
instance PyValue JSValue where 
128 
showValue (JSObject obj) = showValue obj 
129 
showValue x = show x 
130  
131 
type JobIdListOnly = [(Bool, Either String JobId)] 
132  
133 
type InstanceMultiAllocResponse = 
134 
([(Bool, Either String JobId)], NonEmptyString) 
135  
136 
type QueryFieldDef = 
137 
(NonEmptyString, NonEmptyString, TagKind, NonEmptyString) 
138  
139 
type QueryResponse = 
140 
([QueryFieldDef], [[(QueryResultCode, JSValue)]]) 
141  
142 
type QueryFieldsResponse = [QueryFieldDef] 
143  
144 
  OpCode representation. 
145 
 
146 
 We only implement a subset of Ganeti opcodes: those which are actually used 
147 
 in the htools codebase. 
148 
$(genOpCode "OpCode" 
149 
[ ("OpClusterPostInit", 
150 
[t Bool ], 
151 
OpDoc.opClusterPostInit, 
152 
[], 
153 
[]) 
154 
, ("OpClusterDestroy", 
155 
[t NonEmptyString ], 
156 
OpDoc.opClusterDestroy, 
157 
[], 
158 
[]) 
159 
, ("OpClusterQuery", 
160 
[t JSObject JSValue ], 
161 
OpDoc.opClusterQuery, 
162 
[], 
163 
[]) 
164 
, ("OpClusterVerify", 
165 
[t JobIdListOnly ], 
166 
OpDoc.opClusterVerify, 
167 
[ pDebugSimulateErrors 
168 
, pErrorCodes 
169 
, pSkipChecks 
170 
, pIgnoreErrors 
171 
, pVerbose 
172 
, pOptGroupName 
173 
], 
174 
[]) 
175 
, ("OpClusterVerifyConfig", 
176 
[t Bool ], 
177 
OpDoc.opClusterVerifyConfig, 
178 
[ pDebugSimulateErrors 
179 
, pErrorCodes 
180 
, pIgnoreErrors 
181 
, pVerbose 
182 
], 
183 
[]) 
184 
, ("OpClusterVerifyGroup", 
185 
[t Bool ], 
186 
OpDoc.opClusterVerifyGroup, 
187 
[ pGroupName 
188 
, pDebugSimulateErrors 
189 
, pErrorCodes 
190 
, pSkipChecks 
191 
, pIgnoreErrors 
192 
, pVerbose 
193 
], 
194 
"group_name") 
195 
, ("OpClusterVerifyDisks", 
196 
[t JobIdListOnly ], 
197 
OpDoc.opClusterVerifyDisks, 
198 
[], 
199 
[]) 
200 
, ("OpGroupVerifyDisks", 
201 
[t (Map String String, [String], Map String [[String]]) ], 
202 
OpDoc.opGroupVerifyDisks, 
203 
[ pGroupName 
204 
], 
205 
"group_name") 
206 
, ("OpClusterRepairDiskSizes", 
207 
[t [(NonEmptyString, NonNegative Int, NonEmptyString, NonNegative Int)]], 
208 
OpDoc.opClusterRepairDiskSizes, 
209 
[ pInstances 
210 
], 
211 
[]) 
212 
, ("OpClusterConfigQuery", 
213 
[t [JSValue] ], 
214 
OpDoc.opClusterConfigQuery, 
215 
[ pOutputFields 
216 
], 
217 
[]) 
218 
, ("OpClusterRename", 
219 
[t NonEmptyString ], 
220 
OpDoc.opClusterRename, 
221 
[ pName 
222 
], 
223 
"name") 
224 
, ("OpClusterSetParams", 
225 
[t () ], 
226 
OpDoc.opClusterSetParams, 
227 
[ pForce 
228 
, pHvState 
229 
, pDiskState 
230 
, pVgName 
231 
, pEnabledHypervisors 
232 
, pClusterHvParams 
233 
, pClusterBeParams 
234 
, pOsHvp 
235 
, pClusterOsParams 
236 
, pDiskParams 
237 
, pCandidatePoolSize 
238 
, pUidPool 
239 
, pAddUids 
240 
, pRemoveUids 
241 
, pMaintainNodeHealth 
242 
, pPreallocWipeDisks 
243 
, pNicParams 
244 
, withDoc "Clusterwide node parameter defaults" pNdParams 
245 
, withDoc "Clusterwide ipolicy specs" pIpolicy 
246 
, pDrbdHelper 
247 
, pDefaultIAllocator 
248 
, pMasterNetdev 
249 
, pMasterNetmask 
250 
, pReservedLvs 
251 
, pHiddenOs 
252 
, pBlacklistedOs 
253 
, pUseExternalMipScript 
254 
, pEnabledDiskTemplates 
255 
, pModifyEtcHosts 
256 
, pGlobalFileStorageDir 
257 
, pGlobalSharedFileStorageDir 
258 
], 
259 
[]) 
260 
, ("OpClusterRedistConf", 
261 
[t () ], 
262 
OpDoc.opClusterRedistConf, 
263 
[], 
264 
[]) 
265 
, ("OpClusterActivateMasterIp", 
266 
[t () ], 
267 
OpDoc.opClusterActivateMasterIp, 
268 
[], 
269 
[]) 
270 
, ("OpClusterDeactivateMasterIp", 
271 
[t () ], 
272 
OpDoc.opClusterDeactivateMasterIp, 
273 
[], 
274 
[]) 
275 
, ("OpQuery", 
276 
[t QueryResponse ], 
277 
OpDoc.opQuery, 
278 
[ pQueryWhat 
279 
, pUseLocking 
280 
, pQueryFields 
281 
, pQueryFilter 
282 
], 
283 
"what") 
284 
, ("OpQueryFields", 
285 
[t QueryFieldsResponse ], 
286 
OpDoc.opQueryFields, 
287 
[ pQueryWhat 
288 
, pQueryFieldsFields 
289 
], 
290 
"what") 
291 
, ("OpOobCommand", 
292 
[t [[(QueryResultCode, JSValue)]] ], 
293 
OpDoc.opOobCommand, 
294 
[ pNodeNames 
295 
, withDoc "List of node UUIDs to run the OOB command against" pNodeUuids 
296 
, pOobCommand 
297 
, pOobTimeout 
298 
, pIgnoreStatus 
299 
, pPowerDelay 
300 
], 
301 
[]) 
302 
, ("OpRestrictedCommand", 
303 
[t [(Bool, String)] ], 
304 
OpDoc.opRestrictedCommand, 
305 
[ pUseLocking 
306 
, withDoc 
307 
"Nodes on which the command should be run (at least one)" 
308 
pRequiredNodes 
309 
, withDoc 
310 
"Node UUIDs on which the command should be run (at least one)" 
311 
pRequiredNodeUuids 
312 
, pRestrictedCommand 
313 
], 
314 
[]) 
315 
, ("OpNodeRemove", 
316 
[t () ], 
317 
OpDoc.opNodeRemove, 
318 
[ pNodeName 
319 
, pNodeUuid 
320 
], 
321 
"node_name") 
322 
, ("OpNodeAdd", 
323 
[t () ], 
324 
OpDoc.opNodeAdd, 
325 
[ pNodeName 
326 
, pHvState 
327 
, pDiskState 
328 
, pPrimaryIp 
329 
, pSecondaryIp 
330 
, pReadd 
331 
, pNodeGroup 
332 
, pMasterCapable 
333 
, pVmCapable 
334 
, pNdParams 
335 
], 
336 
"node_name") 
337 
, ("OpNodeQuery", 
338 
[t [[JSValue]] ], 
339 
OpDoc.opNodeQuery, 
340 
[ pOutputFields 
341 
, withDoc "Empty list to query all nodes, node names otherwise" pNames 
342 
, pUseLocking 
343 
], 
344 
[]) 
345 
, ("OpNodeQueryvols", 
346 
[t [JSValue] ], 
347 
OpDoc.opNodeQueryvols, 
348 
[ pOutputFields 
349 
, withDoc "Empty list to query all nodes, node names otherwise" pNodes 
350 
], 
351 
[]) 
352 
, ("OpNodeQueryStorage", 
353 
[t [[JSValue]] ], 
354 
OpDoc.opNodeQueryStorage, 
355 
[ pOutputFields 
356 
, pStorageType 
357 
, withDoc 
358 
"Empty list to query all, list of names to query otherwise" 
359 
pNodes 
360 
, pStorageName 
361 
], 
362 
[]) 
363 
, ("OpNodeModifyStorage", 
364 
[t () ], 
365 
OpDoc.opNodeModifyStorage, 
366 
[ pNodeName 
367 
, pNodeUuid 
368 
, pStorageType 
369 
, pStorageName 
370 
, pStorageChanges 
371 
], 
372 
"node_name") 
373 
, ("OpRepairNodeStorage", 
374 
[t () ], 
375 
OpDoc.opRepairNodeStorage, 
376 
[ pNodeName 
377 
, pNodeUuid 
378 
, pStorageType 
379 
, pStorageName 
380 
, pIgnoreConsistency 
381 
], 
382 
"node_name") 
383 
, ("OpNodeSetParams", 
384 
[t [(NonEmptyString, JSValue)] ], 
385 
OpDoc.opNodeSetParams, 
386 
[ pNodeName 
387 
, pNodeUuid 
388 
, pForce 
389 
, pHvState 
390 
, pDiskState 
391 
, pMasterCandidate 
392 
, withDoc "Whether to mark the node offline" pOffline 
393 
, pDrained 
394 
, pAutoPromote 
395 
, pMasterCapable 
396 
, pVmCapable 
397 
, pSecondaryIp 
398 
, pNdParams 
399 
, pPowered 
400 
], 
401 
"node_name") 
402 
, ("OpNodePowercycle", 
403 
[t Maybe NonEmptyString ], 
404 
OpDoc.opNodePowercycle, 
405 
[ pNodeName 
406 
, pNodeUuid 
407 
, pForce 
408 
], 
409 
"node_name") 
410 
, ("OpNodeMigrate", 
411 
[t JobIdListOnly ], 
412 
OpDoc.opNodeMigrate, 
413 
[ pNodeName 
414 
, pNodeUuid 
415 
, pMigrationMode 
416 
, pMigrationLive 
417 
, pMigrationTargetNode 
418 
, pMigrationTargetNodeUuid 
419 
, pAllowRuntimeChgs 
420 
, pIgnoreIpolicy 
421 
, pIallocator 
422 
], 
423 
"node_name") 
424 
, ("OpNodeEvacuate", 
425 
[t JobIdListOnly ], 
426 
OpDoc.opNodeEvacuate, 
427 
[ pEarlyRelease 
428 
, pNodeName 
429 
, pNodeUuid 
430 
, pRemoteNode 
431 
, pRemoteNodeUuid 
432 
, pIallocator 
433 
, pEvacMode 
434 
], 
435 
"node_name") 
436 
, ("OpInstanceCreate", 
437 
[t [NonEmptyString] ], 
438 
OpDoc.opInstanceCreate, 
439 
[ pInstanceName 
440 
, pForceVariant 
441 
, pWaitForSync 
442 
, pNameCheck 
443 
, pIgnoreIpolicy 
444 
, pOpportunisticLocking 
445 
, pInstBeParams 
446 
, pInstDisks 
447 
, pOptDiskTemplate 
448 
, pFileDriver 
449 
, pFileStorageDir 
450 
, pInstHvParams 
451 
, pHypervisor 
452 
, pIallocator 
453 
, pResetDefaults 
454 
, pIpCheck 
455 
, pIpConflictsCheck 
456 
, pInstCreateMode 
457 
, pInstNics 
458 
, pNoInstall 
459 
, pInstOsParams 
460 
, pInstOs 
461 
, pPrimaryNode 
462 
, pPrimaryNodeUuid 
463 
, pSecondaryNode 
464 
, pSecondaryNodeUuid 
465 
, pSourceHandshake 
466 
, pSourceInstance 
467 
, pSourceShutdownTimeout 
468 
, pSourceX509Ca 
469 
, pSrcNode 
470 
, pSrcNodeUuid 
471 
, pSrcPath 
472 
, pStartInstance 
473 
, pInstTags 
474 
], 
475 
"instance_name") 
476 
, ("OpInstanceMultiAlloc", 
477 
[t InstanceMultiAllocResponse ], 
478 
OpDoc.opInstanceMultiAlloc, 
479 
[ pOpportunisticLocking 
480 
, pIallocator 
481 
, pMultiAllocInstances 
482 
], 
483 
[]) 
484 
, ("OpInstanceReinstall", 
485 
[t () ], 
486 
OpDoc.opInstanceReinstall, 
487 
[ pInstanceName 
488 
, pInstanceUuid 
489 
, pForceVariant 
490 
, pInstOs 
491 
, pTempOsParams 
492 
], 
493 
"instance_name") 
494 
, ("OpInstanceRemove", 
495 
[t () ], 
496 
OpDoc.opInstanceRemove, 
497 
[ pInstanceName 
498 
, pInstanceUuid 
499 
, pShutdownTimeout 
500 
, pIgnoreFailures 
501 
], 
502 
"instance_name") 
503 
, ("OpInstanceRename", 
504 
[t NonEmptyString ], 
505 
OpDoc.opInstanceRename, 
506 
[ pInstanceName 
507 
, pInstanceUuid 
508 
, withDoc "New instance name" pNewName 
509 
, pNameCheck 
510 
, pIpCheck 
511 
], 
512 
[]) 
513 
, ("OpInstanceStartup", 
514 
[t () ], 
515 
OpDoc.opInstanceStartup, 
516 
[ pInstanceName 
517 
, pInstanceUuid 
518 
, pForce 
519 
, pIgnoreOfflineNodes 
520 
, pTempHvParams 
521 
, pTempBeParams 
522 
, pNoRemember 
523 
, pStartupPaused 
524 
], 
525 
"instance_name") 
526 
, ("OpInstanceShutdown", 
527 
[t () ], 
528 
OpDoc.opInstanceShutdown, 
529 
[ pInstanceName 
530 
, pInstanceUuid 
531 
, pForce 
532 
, pIgnoreOfflineNodes 
533 
, pShutdownTimeout' 
534 
, pNoRemember 
535 
], 
536 
"instance_name") 
537 
, ("OpInstanceReboot", 
538 
[t () ], 
539 
OpDoc.opInstanceReboot, 
540 
[ pInstanceName 
541 
, pInstanceUuid 
542 
, pShutdownTimeout 
543 
, pIgnoreSecondaries 
544 
, pRebootType 
545 
], 
546 
"instance_name") 
547 
, ("OpInstanceReplaceDisks", 
548 
[t () ], 
549 
OpDoc.opInstanceReplaceDisks, 
550 
[ pInstanceName 
551 
, pInstanceUuid 
552 
, pEarlyRelease 
553 
, pIgnoreIpolicy 
554 
, pReplaceDisksMode 
555 
, pReplaceDisksList 
556 
, pRemoteNode 
557 
, pRemoteNodeUuid 
558 
, pIallocator 
559 
], 
560 
"instance_name") 
561 
, ("OpInstanceFailover", 
562 
[t () ], 
563 
OpDoc.opInstanceFailover, 
564 
[ pInstanceName 
565 
, pInstanceUuid 
566 
, pShutdownTimeout 
567 
, pIgnoreConsistency 
568 
, pMigrationTargetNode 
569 
, pMigrationTargetNodeUuid 
570 
, pIgnoreIpolicy 
571 
, pMigrationCleanup 
572 
, pIallocator 
573 
], 
574 
"instance_name") 
575 
, ("OpInstanceMigrate", 
576 
[t () ], 
577 
OpDoc.opInstanceMigrate, 
578 
[ pInstanceName 
579 
, pInstanceUuid 
580 
, pMigrationMode 
581 
, pMigrationLive 
582 
, pMigrationTargetNode 
583 
, pMigrationTargetNodeUuid 
584 
, pAllowRuntimeChgs 
585 
, pIgnoreIpolicy 
586 
, pMigrationCleanup 
587 
, pIallocator 
588 
, pAllowFailover 
589 
], 
590 
"instance_name") 
591 
, ("OpInstanceMove", 
592 
[t () ], 
593 
OpDoc.opInstanceMove, 
594 
[ pInstanceName 
595 
, pInstanceUuid 
596 
, pShutdownTimeout 
597 
, pIgnoreIpolicy 
598 
, pMoveTargetNode 
599 
, pMoveTargetNodeUuid 
600 
, pIgnoreConsistency 
601 
], 
602 
"instance_name") 
603 
, ("OpInstanceConsole", 
604 
[t JSObject JSValue ], 
605 
OpDoc.opInstanceConsole, 
606 
[ pInstanceName 
607 
, pInstanceUuid 
608 
], 
609 
"instance_name") 
610 
, ("OpInstanceActivateDisks", 
611 
[t [(NonEmptyString, NonEmptyString, NonEmptyString)] ], 
612 
OpDoc.opInstanceActivateDisks, 
613 
[ pInstanceName 
614 
, pInstanceUuid 
615 
, pIgnoreDiskSize 
616 
, pWaitForSyncFalse 
617 
], 
618 
"instance_name") 
619 
, ("OpInstanceDeactivateDisks", 
620 
[t () ], 
621 
OpDoc.opInstanceDeactivateDisks, 
622 
[ pInstanceName 
623 
, pInstanceUuid 
624 
, pForce 
625 
], 
626 
"instance_name") 
627 
, ("OpInstanceRecreateDisks", 
628 
[t () ], 
629 
OpDoc.opInstanceRecreateDisks, 
630 
[ pInstanceName 
631 
, pInstanceUuid 
632 
, pRecreateDisksInfo 
633 
, withDoc "New instance nodes, if relocation is desired" pNodes 
634 
, withDoc "New instance node UUIDs, if relocation is desired" pNodeUuids 
635 
, pIallocator 
636 
], 
637 
"instance_name") 
638 
, ("OpInstanceQuery", 
639 
[t [[JSValue]] ], 
640 
OpDoc.opInstanceQuery, 
641 
[ pOutputFields 
642 
, pUseLocking 
643 
, withDoc 
644 
"Empty list to query all instances, instance names otherwise" 
645 
pNames 
646 
], 
647 
[]) 
648 
, ("OpInstanceQueryData", 
649 
[t JSObject (JSObject JSValue) ], 
650 
OpDoc.opInstanceQueryData, 
651 
[ pUseLocking 
652 
, pInstances 
653 
, pStatic 
654 
], 
655 
[]) 
656 
, ("OpInstanceSetParams", 
657 
[t [(NonEmptyString, JSValue)] ], 
658 
OpDoc.opInstanceSetParams, 
659 
[ pInstanceName 
660 
, pInstanceUuid 
661 
, pForce 
662 
, pForceVariant 
663 
, pIgnoreIpolicy 
664 
, pInstParamsNicChanges 
665 
, pInstParamsDiskChanges 
666 
, pInstBeParams 
667 
, pRuntimeMem 
668 
, pInstHvParams 
669 
, pOptDiskTemplate 
670 
, pPrimaryNode 
671 
, pPrimaryNodeUuid 
672 
, withDoc "Secondary node (used when changing disk template)" pRemoteNode 
673 
, withDoc 
674 
"Secondary node UUID (used when changing disk template)" 
675 
pRemoteNodeUuid 
676 
, pOsNameChange 
677 
, pInstOsParams 
678 
, pWaitForSync 
679 
, withDoc "Whether to mark the instance as offline" pOffline 
680 
, pIpConflictsCheck 
681 
], 
682 
"instance_name") 
683 
, ("OpInstanceGrowDisk", 
684 
[t () ], 
685 
OpDoc.opInstanceGrowDisk, 
686 
[ pInstanceName 
687 
, pInstanceUuid 
688 
, pWaitForSync 
689 
, pDiskIndex 
690 
, pDiskChgAmount 
691 
, pDiskChgAbsolute 
692 
], 
693 
"instance_name") 
694 
, ("OpInstanceChangeGroup", 
695 
[t JobIdListOnly ], 
696 
OpDoc.opInstanceChangeGroup, 
697 
[ pInstanceName 
698 
, pInstanceUuid 
699 
, pEarlyRelease 
700 
, pIallocator 
701 
, pTargetGroups 
702 
], 
703 
"instance_name") 
704 
, ("OpGroupAdd", 
705 
[t () ], 
706 
OpDoc.opGroupAdd, 
707 
[ pGroupName 
708 
, pNodeGroupAllocPolicy 
709 
, pGroupNodeParams 
710 
, pDiskParams 
711 
, pHvState 
712 
, pDiskState 
713 
, withDoc "Groupwide ipolicy specs" pIpolicy 
714 
], 
715 
"group_name") 
716 
, ("OpGroupAssignNodes", 
717 
[t () ], 
718 
OpDoc.opGroupAssignNodes, 
719 
[ pGroupName 
720 
, pForce 
721 
, withDoc "List of nodes to assign" pRequiredNodes 
722 
, withDoc "List of node UUIDs to assign" pRequiredNodeUuids 
723 
], 
724 
"group_name") 
725 
, ("OpGroupQuery", 
726 
[t [[JSValue]] ], 
727 
OpDoc.opGroupQuery, 
728 
[ pOutputFields 
729 
, withDoc "Empty list to query all groups, group names otherwise" pNames 
730 
], 
731 
[]) 
732 
, ("OpGroupSetParams", 
733 
[t [(NonEmptyString, JSValue)] ], 
734 
OpDoc.opGroupSetParams, 
735 
[ pGroupName 
736 
, pNodeGroupAllocPolicy 
737 
, pGroupNodeParams 
738 
, pDiskParams 
739 
, pHvState 
740 
, pDiskState 
741 
, withDoc "Groupwide ipolicy specs" pIpolicy 
742 
], 
743 
"group_name") 
744 
, ("OpGroupRemove", 
745 
[t () ], 
746 
OpDoc.opGroupRemove, 
747 
[ pGroupName 
748 
], 
749 
"group_name") 
750 
, ("OpGroupRename", 
751 
[t NonEmptyString ], 
752 
OpDoc.opGroupRename, 
753 
[ pGroupName 
754 
, withDoc "New group name" pNewName 
755 
], 
756 
[]) 
757 
, ("OpGroupEvacuate", 
758 
[t JobIdListOnly ], 
759 
OpDoc.opGroupEvacuate, 
760 
[ pGroupName 
761 
, pEarlyRelease 
762 
, pIallocator 
763 
, pTargetGroups 
764 
], 
765 
"group_name") 
766 
, ("OpOsDiagnose", 
767 
[t [[JSValue]] ], 
768 
OpDoc.opOsDiagnose, 
769 
[ pOutputFields 
770 
, withDoc "Which operating systems to diagnose" pNames 
771 
], 
772 
[]) 
773 
, ("OpExtStorageDiagnose", 
774 
[t [[JSValue]] ], 
775 
OpDoc.opExtStorageDiagnose, 
776 
[ pOutputFields 
777 
, withDoc "Which ExtStorage Provider to diagnose" pNames 
778 
], 
779 
[]) 
780 
, ("OpBackupQuery", 
781 
[t JSObject (Either Bool [NonEmptyString]) ], 
782 
OpDoc.opBackupQuery, 
783 
[ pUseLocking 
784 
, withDoc "Empty list to query all nodes, node names otherwise" pNodes 
785 
], 
786 
[]) 
787 
, ("OpBackupPrepare", 
788 
[t Maybe (JSObject JSValue) ], 
789 
OpDoc.opBackupPrepare, 
790 
[ pInstanceName 
791 
, pInstanceUuid 
792 
, pExportMode 
793 
], 
794 
"instance_name") 
795 
, ("OpBackupExport", 
796 
[t (Bool, [Bool]) ], 
797 
OpDoc.opBackupExport, 
798 
[ pInstanceName 
799 
, pInstanceUuid 
800 
, pShutdownTimeout 
801 
, pExportTargetNode 
802 
, pExportTargetNodeUuid 
803 
, pShutdownInstance 
804 
, pRemoveInstance 
805 
, pIgnoreRemoveFailures 
806 
, defaultField [ ExportModeLocal ] pExportMode 
807 
, pX509KeyName 
808 
, pX509DestCA 
809 
], 
810 
"instance_name") 
811 
, ("OpBackupRemove", 
812 
[t () ], 
813 
OpDoc.opBackupRemove, 
814 
[ pInstanceName 
815 
, pInstanceUuid 
816 
], 
817 
"instance_name") 
818 
, ("OpTagsGet", 
819 
[t [NonEmptyString] ], 
820 
OpDoc.opTagsGet, 
821 
[ pTagsObject 
822 
, pUseLocking 
823 
, withDoc "Name of object to retrieve tags from" pTagsName 
824 
], 
825 
"name") 
826 
, ("OpTagsSearch", 
827 
[t [(NonEmptyString, NonEmptyString)] ], 
828 
OpDoc.opTagsSearch, 
829 
[ pTagSearchPattern 
830 
], 
831 
"pattern") 
832 
, ("OpTagsSet", 
833 
[t () ], 
834 
OpDoc.opTagsSet, 
835 
[ pTagsObject 
836 
, pTagsList 
837 
, withDoc "Name of object where tag(s) should be added" pTagsName 
838 
], 
839 
[]) 
840 
, ("OpTagsDel", 
841 
[t () ], 
842 
OpDoc.opTagsDel, 
843 
[ pTagsObject 
844 
, pTagsList 
845 
, withDoc "Name of object where tag(s) should be deleted" pTagsName 
846 
], 
847 
[]) 
848 
, ("OpTestDelay", 
849 
[t () ], 
850 
OpDoc.opTestDelay, 
851 
[ pDelayDuration 
852 
, pDelayOnMaster 
853 
, pDelayOnNodes 
854 
, pDelayOnNodeUuids 
855 
, pDelayRepeat 
856 
], 
857 
"duration") 
858 
, ("OpTestAllocator", 
859 
[t String ], 
860 
OpDoc.opTestAllocator, 
861 
[ pIAllocatorDirection 
862 
, pIAllocatorMode 
863 
, pIAllocatorReqName 
864 
, pIAllocatorNics 
865 
, pIAllocatorDisks 
866 
, pHypervisor 
867 
, pIallocator 
868 
, pInstTags 
869 
, pIAllocatorMemory 
870 
, pIAllocatorVCpus 
871 
, pIAllocatorOs 
872 
, pDiskTemplate 
873 
, pIAllocatorInstances 
874 
, pIAllocatorEvacMode 
875 
, pTargetGroups 
876 
, pIAllocatorSpindleUse 
877 
, pIAllocatorCount 
878 
], 
879 
"iallocator") 
880 
, ("OpTestJqueue", 
881 
[t Bool ], 
882 
OpDoc.opTestJqueue, 
883 
[ pJQueueNotifyWaitLock 
884 
, pJQueueNotifyExec 
885 
, pJQueueLogMessages 
886 
, pJQueueFail 
887 
], 
888 
[]) 
889 
, ("OpTestDummy", 
890 
[t () ], 
891 
OpDoc.opTestDummy, 
892 
[ pTestDummyResult 
893 
, pTestDummyMessages 
894 
, pTestDummyFail 
895 
, pTestDummySubmitJobs 
896 
], 
897 
[]) 
898 
, ("OpNetworkAdd", 
899 
[t () ], 
900 
OpDoc.opNetworkAdd, 
901 
[ pNetworkName 
902 
, pNetworkAddress4 
903 
, pNetworkGateway4 
904 
, pNetworkAddress6 
905 
, pNetworkGateway6 
906 
, pNetworkMacPrefix 
907 
, pNetworkAddRsvdIps 
908 
, pIpConflictsCheck 
909 
, withDoc "Network tags" pInstTags 
910 
], 
911 
"network_name") 
912 
, ("OpNetworkRemove", 
913 
[t () ], 
914 
OpDoc.opNetworkRemove, 
915 
[ pNetworkName 
916 
, pForce 
917 
], 
918 
"network_name") 
919 
, ("OpNetworkSetParams", 
920 
[t () ], 
921 
OpDoc.opNetworkSetParams, 
922 
[ pNetworkName 
923 
, pNetworkGateway4 
924 
, pNetworkAddress6 
925 
, pNetworkGateway6 
926 
, pNetworkMacPrefix 
927 
, withDoc "Which external IP addresses to reserve" pNetworkAddRsvdIps 
928 
, pNetworkRemoveRsvdIps 
929 
], 
930 
"network_name") 
931 
, ("OpNetworkConnect", 
932 
[t () ], 
933 
OpDoc.opNetworkConnect, 
934 
[ pGroupName 
935 
, pNetworkName 
936 
, pNetworkMode 
937 
, pNetworkLink 
938 
, pIpConflictsCheck 
939 
], 
940 
"network_name") 
941 
, ("OpNetworkDisconnect", 
942 
[t () ], 
943 
OpDoc.opNetworkDisconnect, 
944 
[ pGroupName 
945 
, pNetworkName 
946 
], 
947 
"network_name") 
948 
, ("OpNetworkQuery", 
949 
[t [[JSValue]] ], 
950 
OpDoc.opNetworkQuery, 
951 
[ pOutputFields 
952 
, pUseLocking 
953 
, withDoc "Empty list to query all groups, group names otherwise" pNames 
954 
], 
955 
[]) 
956 
]) 
957  
958 
  Returns the OP_ID for a given opcode value. 
959 
$(genOpID ''OpCode "opID") 
960  
961 
  A list of all defined/supported opcode IDs. 
962 
$(genAllOpIDs ''OpCode "allOpIDs") 
963  
964 
instance JSON OpCode where 
965 
readJSON = loadOpCode 
966 
showJSON = saveOpCode 
967  
968 
  Generates the summary value for an opcode. 
969 
opSummaryVal :: OpCode > Maybe String 
970 
opSummaryVal OpClusterVerifyGroup { opGroupName = s } = Just (fromNonEmpty s) 
971 
opSummaryVal OpGroupVerifyDisks { opGroupName = s } = Just (fromNonEmpty s) 
972 
opSummaryVal OpClusterRename { opName = s } = Just (fromNonEmpty s) 
973 
opSummaryVal OpQuery { opWhat = s } = Just (queryTypeOpToRaw s) 
974 
opSummaryVal OpQueryFields { opWhat = s } = Just (queryTypeOpToRaw s) 
975 
opSummaryVal OpNodeRemove { opNodeName = s } = Just (fromNonEmpty s) 
976 
opSummaryVal OpNodeAdd { opNodeName = s } = Just (fromNonEmpty s) 
977 
opSummaryVal OpNodeModifyStorage { opNodeName = s } = Just (fromNonEmpty s) 
978 
opSummaryVal OpRepairNodeStorage { opNodeName = s } = Just (fromNonEmpty s) 
979 
opSummaryVal OpNodeSetParams { opNodeName = s } = Just (fromNonEmpty s) 
980 
opSummaryVal OpNodePowercycle { opNodeName = s } = Just (fromNonEmpty s) 
981 
opSummaryVal OpNodeMigrate { opNodeName = s } = Just (fromNonEmpty s) 
982 
opSummaryVal OpNodeEvacuate { opNodeName = s } = Just (fromNonEmpty s) 
983 
opSummaryVal OpInstanceCreate { opInstanceName = s } = Just s 
984 
opSummaryVal OpInstanceReinstall { opInstanceName = s } = Just s 
985 
opSummaryVal OpInstanceRemove { opInstanceName = s } = Just s 
986 
 FIXME: instance rename should show both names; currently it shows none 
987 
 opSummaryVal OpInstanceRename { opInstanceName = s } = Just s 
988 
opSummaryVal OpInstanceStartup { opInstanceName = s } = Just s 
989 
opSummaryVal OpInstanceShutdown { opInstanceName = s } = Just s 
990 
opSummaryVal OpInstanceReboot { opInstanceName = s } = Just s 
991 
opSummaryVal OpInstanceReplaceDisks { opInstanceName = s } = Just s 
992 
opSummaryVal OpInstanceFailover { opInstanceName = s } = Just s 
993 
opSummaryVal OpInstanceMigrate { opInstanceName = s } = Just s 
994 
opSummaryVal OpInstanceMove { opInstanceName = s } = Just s 
995 
opSummaryVal OpInstanceConsole { opInstanceName = s } = Just s 
996 
opSummaryVal OpInstanceActivateDisks { opInstanceName = s } = Just s 
997 
opSummaryVal OpInstanceDeactivateDisks { opInstanceName = s } = Just s 
998 
opSummaryVal OpInstanceRecreateDisks { opInstanceName = s } = Just s 
999 
opSummaryVal OpInstanceSetParams { opInstanceName = s } = Just s 
1000 
opSummaryVal OpInstanceGrowDisk { opInstanceName = s } = Just s 
1001 
opSummaryVal OpInstanceChangeGroup { opInstanceName = s } = Just s 
1002 
opSummaryVal OpGroupAdd { opGroupName = s } = Just (fromNonEmpty s) 
1003 
opSummaryVal OpGroupAssignNodes { opGroupName = s } = Just (fromNonEmpty s) 
1004 
opSummaryVal OpGroupSetParams { opGroupName = s } = Just (fromNonEmpty s) 
1005 
opSummaryVal OpGroupRemove { opGroupName = s } = Just (fromNonEmpty s) 
1006 
opSummaryVal OpGroupEvacuate { opGroupName = s } = Just (fromNonEmpty s) 
1007 
opSummaryVal OpBackupPrepare { opInstanceName = s } = Just s 
1008 
opSummaryVal OpBackupExport { opInstanceName = s } = Just s 
1009 
opSummaryVal OpBackupRemove { opInstanceName = s } = Just s 
1010 
opSummaryVal OpTagsGet { opKind = s } = Just (show s) 
1011 
opSummaryVal OpTagsSearch { opTagSearchPattern = s } = Just (fromNonEmpty s) 
1012 
opSummaryVal OpTestDelay { opDelayDuration = d } = Just (show d) 
1013 
opSummaryVal OpTestAllocator { opIallocator = s } = 
1014 
 FIXME: Python doesn't handle None fields well, so we have behave the same 
1015 
Just $ maybe "None" fromNonEmpty s 
1016 
opSummaryVal OpNetworkAdd { opNetworkName = s} = Just (fromNonEmpty s) 
1017 
opSummaryVal OpNetworkRemove { opNetworkName = s} = Just (fromNonEmpty s) 
1018 
opSummaryVal OpNetworkSetParams { opNetworkName = s} = Just (fromNonEmpty s) 
1019 
opSummaryVal OpNetworkConnect { opNetworkName = s} = Just (fromNonEmpty s) 
1020 
opSummaryVal OpNetworkDisconnect { opNetworkName = s} = Just (fromNonEmpty s) 
1021 
opSummaryVal _ = Nothing 
1022  
1023 
  Computes the summary of the opcode. 
1024 
opSummary :: OpCode > String 
1025 
opSummary op = 
1026 
case opSummaryVal op of 
1027 
Nothing > op_suffix 
1028 
Just s > op_suffix ++ "(" ++ s ++ ")" 
1029 
where op_suffix = drop 3 $ opID op 
1030  
1031 
  Generic\/common opcode parameters. 
1032 
$(buildObject "CommonOpParams" "op" 
1033 
[ pDryRun 
1034 
, pDebugLevel 
1035 
, pOpPriority 
1036 
, pDependencies 
1037 
, pComment 
1038 
, pReason 
1039 
]) 
1040  
1041 
  Default common parameter values. 
1042 
defOpParams :: CommonOpParams 
1043 
defOpParams = 
1044 
CommonOpParams { opDryRun = Nothing 
1045 
, opDebugLevel = Nothing 
1046 
, opPriority = OpPrioNormal 
1047 
, opDepends = Nothing 
1048 
, opComment = Nothing 
1049 
, opReason = [] 
1050 
} 
1051  
1052 
  The toplevel opcode type. 
1053 
data MetaOpCode = MetaOpCode { metaParams :: CommonOpParams 
1054 
, metaOpCode :: OpCode 
1055 
} deriving (Show, Eq) 
1056  
1057 
  JSON serialisation for 'MetaOpCode'. 
1058 
showMeta :: MetaOpCode > JSValue 
1059 
showMeta (MetaOpCode params op) = 
1060 
let objparams = toDictCommonOpParams params 
1061 
objop = toDictOpCode op 
1062 
in makeObj (objparams ++ objop) 
1063  
1064 
  JSON deserialisation for 'MetaOpCode' 
1065 
readMeta :: JSValue > Text.JSON.Result MetaOpCode 
1066 
readMeta v = do 
1067 
meta < readJSON v 
1068 
op < readJSON v 
1069 
return $ MetaOpCode meta op 
1070  
1071 
instance JSON MetaOpCode where 
1072 
showJSON = showMeta 
1073 
readJSON = readMeta 
1074  
1075 
  Wraps an 'OpCode' with the default parameters to build a 
1076 
 'MetaOpCode'. 
1077 
wrapOpCode :: OpCode > MetaOpCode 
1078 
wrapOpCode = MetaOpCode defOpParams 
1079  
1080 
  Sets the comment on a meta opcode. 
1081 
setOpComment :: String > MetaOpCode > MetaOpCode 
1082 
setOpComment comment (MetaOpCode common op) = 
1083 
MetaOpCode (common { opComment = Just comment}) op 
1084  
1085 
  Sets the priority on a meta opcode. 
1086 
setOpPriority :: OpSubmitPriority > MetaOpCode > MetaOpCode 
1087 
setOpPriority prio (MetaOpCode common op) = 
1088 
MetaOpCode (common { opPriority = prio }) op 