8e2f4ecc2f8acf876ae41cba253b6b1b5b25ad68
[ganeti-github.git] / src / Ganeti / Types.hs
1 {-# LANGUAGE TemplateHaskell #-}
2
3 {-| Some common Ganeti types.
4
5 This holds types common to both core work, and to htools. Types that
6 are very core specific (e.g. configuration objects) should go in
7 'Ganeti.Objects', while types that are specific to htools in-memory
8 representation should go into 'Ganeti.HTools.Types'.
9
10 -}
11
12 {-
13
14 Copyright (C) 2012, 2013 Google Inc.
15
16 This program is free software; you can redistribute it and/or modify
17 it under the terms of the GNU General Public License as published by
18 the Free Software Foundation; either version 2 of the License, or
19 (at your option) any later version.
20
21 This program is distributed in the hope that it will be useful, but
22 WITHOUT ANY WARRANTY; without even the implied warranty of
23 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
24 General Public License for more details.
25
26 You should have received a copy of the GNU General Public License
27 along with this program; if not, write to the Free Software
28 Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
29 02110-1301, USA.
30
31 -}
32
33 module Ganeti.Types
34 ( AllocPolicy(..)
35 , allocPolicyFromRaw
36 , allocPolicyToRaw
37 , InstanceStatus(..)
38 , instanceStatusFromRaw
39 , instanceStatusToRaw
40 , DiskTemplate(..)
41 , diskTemplateToRaw
42 , diskTemplateFromRaw
43 , TagKind(..)
44 , tagKindToRaw
45 , tagKindFromRaw
46 , NonNegative
47 , fromNonNegative
48 , mkNonNegative
49 , Positive
50 , fromPositive
51 , mkPositive
52 , Negative
53 , fromNegative
54 , mkNegative
55 , NonEmpty
56 , fromNonEmpty
57 , mkNonEmpty
58 , NonEmptyString
59 , QueryResultCode
60 , IPv4Address
61 , mkIPv4Address
62 , IPv4Network
63 , mkIPv4Network
64 , IPv6Address
65 , mkIPv6Address
66 , IPv6Network
67 , mkIPv6Network
68 , MigrationMode(..)
69 , migrationModeToRaw
70 , VerifyOptionalChecks(..)
71 , verifyOptionalChecksToRaw
72 , DdmSimple(..)
73 , DdmFull(..)
74 , ddmFullToRaw
75 , CVErrorCode(..)
76 , cVErrorCodeToRaw
77 , Hypervisor(..)
78 , hypervisorToRaw
79 , OobCommand(..)
80 , oobCommandToRaw
81 , OobStatus(..)
82 , oobStatusToRaw
83 , StorageType(..)
84 , storageTypeToRaw
85 , EvacMode(..)
86 , evacModeToRaw
87 , FileDriver(..)
88 , fileDriverToRaw
89 , InstCreateMode(..)
90 , instCreateModeToRaw
91 , RebootType(..)
92 , rebootTypeToRaw
93 , ExportMode(..)
94 , exportModeToRaw
95 , IAllocatorTestDir(..)
96 , iAllocatorTestDirToRaw
97 , IAllocatorMode(..)
98 , iAllocatorModeToRaw
99 , NICMode(..)
100 , nICModeToRaw
101 , JobStatus(..)
102 , jobStatusToRaw
103 , jobStatusFromRaw
104 , FinalizedJobStatus(..)
105 , finalizedJobStatusToRaw
106 , JobId
107 , fromJobId
108 , makeJobId
109 , makeJobIdS
110 , RelativeJobId
111 , JobIdDep(..)
112 , JobDependency(..)
113 , absoluteJobDependency
114 , OpSubmitPriority(..)
115 , opSubmitPriorityToRaw
116 , parseSubmitPriority
117 , fmtSubmitPriority
118 , OpStatus(..)
119 , opStatusToRaw
120 , opStatusFromRaw
121 , ELogType(..)
122 , eLogTypeToRaw
123 , ReasonElem
124 , ReasonTrail
125 , StorageUnit(..)
126 , StorageUnitRaw(..)
127 , StorageKey
128 , addParamsToStorageUnit
129 , diskTemplateToStorageType
130 , VType(..)
131 , vTypeFromRaw
132 , vTypeToRaw
133 , NodeRole(..)
134 , nodeRoleToRaw
135 , roleDescription
136 , DiskMode(..)
137 , diskModeToRaw
138 , BlockDriver(..)
139 , blockDriverToRaw
140 , AdminState(..)
141 , adminStateFromRaw
142 , adminStateToRaw
143 , StorageField(..)
144 , storageFieldToRaw
145 , DiskAccessMode(..)
146 , diskAccessModeToRaw
147 , LocalDiskStatus(..)
148 , localDiskStatusFromRaw
149 , localDiskStatusToRaw
150 , localDiskStatusName
151 , ReplaceDisksMode(..)
152 , replaceDisksModeToRaw
153 , RpcTimeout(..)
154 , rpcTimeoutFromRaw -- FIXME: no used anywhere
155 , rpcTimeoutToRaw
156 , ImportExportCompression(..)
157 , importExportCompressionToRaw
158 , HotplugTarget(..)
159 , hotplugTargetToRaw
160 , HotplugAction(..)
161 , hotplugActionToRaw
162 ) where
163
164 import Control.Monad (liftM)
165 import qualified Text.JSON as JSON
166 import Text.JSON (JSON, readJSON, showJSON)
167 import Data.Ratio (numerator, denominator)
168
169 import qualified Ganeti.ConstantUtils as ConstantUtils
170 import Ganeti.JSON
171 import qualified Ganeti.THH as THH
172 import Ganeti.Utils
173
174 -- * Generic types
175
176 -- | Type that holds a non-negative value.
177 newtype NonNegative a = NonNegative { fromNonNegative :: a }
178 deriving (Show, Eq)
179
180 -- | Smart constructor for 'NonNegative'.
181 mkNonNegative :: (Monad m, Num a, Ord a, Show a) => a -> m (NonNegative a)
182 mkNonNegative i | i >= 0 = return (NonNegative i)
183 | otherwise = fail $ "Invalid value for non-negative type '" ++
184 show i ++ "'"
185
186 instance (JSON.JSON a, Num a, Ord a, Show a) => JSON.JSON (NonNegative a) where
187 showJSON = JSON.showJSON . fromNonNegative
188 readJSON v = JSON.readJSON v >>= mkNonNegative
189
190 -- | Type that holds a positive value.
191 newtype Positive a = Positive { fromPositive :: a }
192 deriving (Show, Eq)
193
194 -- | Smart constructor for 'Positive'.
195 mkPositive :: (Monad m, Num a, Ord a, Show a) => a -> m (Positive a)
196 mkPositive i | i > 0 = return (Positive i)
197 | otherwise = fail $ "Invalid value for positive type '" ++
198 show i ++ "'"
199
200 instance (JSON.JSON a, Num a, Ord a, Show a) => JSON.JSON (Positive a) where
201 showJSON = JSON.showJSON . fromPositive
202 readJSON v = JSON.readJSON v >>= mkPositive
203
204 -- | Type that holds a negative value.
205 newtype Negative a = Negative { fromNegative :: a }
206 deriving (Show, Eq)
207
208 -- | Smart constructor for 'Negative'.
209 mkNegative :: (Monad m, Num a, Ord a, Show a) => a -> m (Negative a)
210 mkNegative i | i < 0 = return (Negative i)
211 | otherwise = fail $ "Invalid value for negative type '" ++
212 show i ++ "'"
213
214 instance (JSON.JSON a, Num a, Ord a, Show a) => JSON.JSON (Negative a) where
215 showJSON = JSON.showJSON . fromNegative
216 readJSON v = JSON.readJSON v >>= mkNegative
217
218 -- | Type that holds a non-null list.
219 newtype NonEmpty a = NonEmpty { fromNonEmpty :: [a] }
220 deriving (Show, Eq)
221
222 -- | Smart constructor for 'NonEmpty'.
223 mkNonEmpty :: (Monad m) => [a] -> m (NonEmpty a)
224 mkNonEmpty [] = fail "Received empty value for non-empty list"
225 mkNonEmpty xs = return (NonEmpty xs)
226
227 instance (Eq a, Ord a) => Ord (NonEmpty a) where
228 NonEmpty { fromNonEmpty = x1 } `compare` NonEmpty { fromNonEmpty = x2 } =
229 x1 `compare` x2
230
231 instance (JSON.JSON a) => JSON.JSON (NonEmpty a) where
232 showJSON = JSON.showJSON . fromNonEmpty
233 readJSON v = JSON.readJSON v >>= mkNonEmpty
234
235 -- | A simple type alias for non-empty strings.
236 type NonEmptyString = NonEmpty Char
237
238 type QueryResultCode = Int
239
240 newtype IPv4Address = IPv4Address { fromIPv4Address :: String }
241 deriving (Show, Eq)
242
243 -- FIXME: this should check that 'address' is a valid ip
244 mkIPv4Address :: Monad m => String -> m IPv4Address
245 mkIPv4Address address =
246 return IPv4Address { fromIPv4Address = address }
247
248 instance JSON.JSON IPv4Address where
249 showJSON = JSON.showJSON . fromIPv4Address
250 readJSON v = JSON.readJSON v >>= mkIPv4Address
251
252 newtype IPv4Network = IPv4Network { fromIPv4Network :: String }
253 deriving (Show, Eq)
254
255 -- FIXME: this should check that 'address' is a valid ip
256 mkIPv4Network :: Monad m => String -> m IPv4Network
257 mkIPv4Network address =
258 return IPv4Network { fromIPv4Network = address }
259
260 instance JSON.JSON IPv4Network where
261 showJSON = JSON.showJSON . fromIPv4Network
262 readJSON v = JSON.readJSON v >>= mkIPv4Network
263
264 newtype IPv6Address = IPv6Address { fromIPv6Address :: String }
265 deriving (Show, Eq)
266
267 -- FIXME: this should check that 'address' is a valid ip
268 mkIPv6Address :: Monad m => String -> m IPv6Address
269 mkIPv6Address address =
270 return IPv6Address { fromIPv6Address = address }
271
272 instance JSON.JSON IPv6Address where
273 showJSON = JSON.showJSON . fromIPv6Address
274 readJSON v = JSON.readJSON v >>= mkIPv6Address
275
276 newtype IPv6Network = IPv6Network { fromIPv6Network :: String }
277 deriving (Show, Eq)
278
279 -- FIXME: this should check that 'address' is a valid ip
280 mkIPv6Network :: Monad m => String -> m IPv6Network
281 mkIPv6Network address =
282 return IPv6Network { fromIPv6Network = address }
283
284 instance JSON.JSON IPv6Network where
285 showJSON = JSON.showJSON . fromIPv6Network
286 readJSON v = JSON.readJSON v >>= mkIPv6Network
287
288 -- * Ganeti types
289
290 -- | Instance disk template type.
291 $(THH.declareLADT ''String "DiskTemplate"
292 [ ("DTDiskless", "diskless")
293 , ("DTFile", "file")
294 , ("DTSharedFile", "sharedfile")
295 , ("DTPlain", "plain")
296 , ("DTBlock", "blockdev")
297 , ("DTDrbd8", "drbd")
298 , ("DTRbd", "rbd")
299 , ("DTExt", "ext")
300 ])
301 $(THH.makeJSONInstance ''DiskTemplate)
302
303 instance THH.PyValue DiskTemplate where
304 showValue = show . diskTemplateToRaw
305
306 instance HasStringRepr DiskTemplate where
307 fromStringRepr = diskTemplateFromRaw
308 toStringRepr = diskTemplateToRaw
309
310 -- | Data type representing what items the tag operations apply to.
311 $(THH.declareLADT ''String "TagKind"
312 [ ("TagKindInstance", "instance")
313 , ("TagKindNode", "node")
314 , ("TagKindGroup", "nodegroup")
315 , ("TagKindCluster", "cluster")
316 , ("TagKindNetwork", "network")
317 ])
318 $(THH.makeJSONInstance ''TagKind)
319
320 -- | The Group allocation policy type.
321 --
322 -- Note that the order of constructors is important as the automatic
323 -- Ord instance will order them in the order they are defined, so when
324 -- changing this data type be careful about the interaction with the
325 -- desired sorting order.
326 $(THH.declareLADT ''String "AllocPolicy"
327 [ ("AllocPreferred", "preferred")
328 , ("AllocLastResort", "last_resort")
329 , ("AllocUnallocable", "unallocable")
330 ])
331 $(THH.makeJSONInstance ''AllocPolicy)
332
333 -- | The Instance real state type. FIXME: this could be improved to
334 -- just wrap a /NormalState AdminStatus | ErrorState ErrorCondition/.
335 $(THH.declareLADT ''String "InstanceStatus"
336 [ ("StatusDown", "ADMIN_down")
337 , ("StatusOffline", "ADMIN_offline")
338 , ("ErrorDown", "ERROR_down")
339 , ("ErrorUp", "ERROR_up")
340 , ("NodeDown", "ERROR_nodedown")
341 , ("NodeOffline", "ERROR_nodeoffline")
342 , ("Running", "running")
343 , ("WrongNode", "ERROR_wrongnode")
344 ])
345 $(THH.makeJSONInstance ''InstanceStatus)
346
347 -- | Migration mode.
348 $(THH.declareLADT ''String "MigrationMode"
349 [ ("MigrationLive", "live")
350 , ("MigrationNonLive", "non-live")
351 ])
352 $(THH.makeJSONInstance ''MigrationMode)
353
354 -- | Verify optional checks.
355 $(THH.declareLADT ''String "VerifyOptionalChecks"
356 [ ("VerifyNPlusOneMem", "nplusone_mem")
357 ])
358 $(THH.makeJSONInstance ''VerifyOptionalChecks)
359
360 -- | Cluster verify error codes.
361 $(THH.declareLADT ''String "CVErrorCode"
362 [ ("CvECLUSTERCFG", "ECLUSTERCFG")
363 , ("CvECLUSTERCERT", "ECLUSTERCERT")
364 , ("CvECLUSTERFILECHECK", "ECLUSTERFILECHECK")
365 , ("CvECLUSTERDANGLINGNODES", "ECLUSTERDANGLINGNODES")
366 , ("CvECLUSTERDANGLINGINST", "ECLUSTERDANGLINGINST")
367 , ("CvEINSTANCEBADNODE", "EINSTANCEBADNODE")
368 , ("CvEINSTANCEDOWN", "EINSTANCEDOWN")
369 , ("CvEINSTANCELAYOUT", "EINSTANCELAYOUT")
370 , ("CvEINSTANCEMISSINGDISK", "EINSTANCEMISSINGDISK")
371 , ("CvEINSTANCEFAULTYDISK", "EINSTANCEFAULTYDISK")
372 , ("CvEINSTANCEWRONGNODE", "EINSTANCEWRONGNODE")
373 , ("CvEINSTANCESPLITGROUPS", "EINSTANCESPLITGROUPS")
374 , ("CvEINSTANCEPOLICY", "EINSTANCEPOLICY")
375 , ("CvEINSTANCEUNSUITABLENODE", "EINSTANCEUNSUITABLENODE")
376 , ("CvEINSTANCEMISSINGCFGPARAMETER", "EINSTANCEMISSINGCFGPARAMETER")
377 , ("CvENODEDRBD", "ENODEDRBD")
378 , ("CvENODEDRBDVERSION", "ENODEDRBDVERSION")
379 , ("CvENODEDRBDHELPER", "ENODEDRBDHELPER")
380 , ("CvENODEFILECHECK", "ENODEFILECHECK")
381 , ("CvENODEHOOKS", "ENODEHOOKS")
382 , ("CvENODEHV", "ENODEHV")
383 , ("CvENODELVM", "ENODELVM")
384 , ("CvENODEN1", "ENODEN1")
385 , ("CvENODENET", "ENODENET")
386 , ("CvENODEOS", "ENODEOS")
387 , ("CvENODEORPHANINSTANCE", "ENODEORPHANINSTANCE")
388 , ("CvENODEORPHANLV", "ENODEORPHANLV")
389 , ("CvENODERPC", "ENODERPC")
390 , ("CvENODESSH", "ENODESSH")
391 , ("CvENODEVERSION", "ENODEVERSION")
392 , ("CvENODESETUP", "ENODESETUP")
393 , ("CvENODETIME", "ENODETIME")
394 , ("CvENODEOOBPATH", "ENODEOOBPATH")
395 , ("CvENODEUSERSCRIPTS", "ENODEUSERSCRIPTS")
396 , ("CvENODEFILESTORAGEPATHS", "ENODEFILESTORAGEPATHS")
397 , ("CvENODEFILESTORAGEPATHUNUSABLE", "ENODEFILESTORAGEPATHUNUSABLE")
398 , ("CvENODESHAREDFILESTORAGEPATHUNUSABLE",
399 "ENODESHAREDFILESTORAGEPATHUNUSABLE")
400 , ("CvEGROUPDIFFERENTPVSIZE", "EGROUPDIFFERENTPVSIZE")
401 ])
402 $(THH.makeJSONInstance ''CVErrorCode)
403
404 -- | Dynamic device modification, just add\/remove version.
405 $(THH.declareLADT ''String "DdmSimple"
406 [ ("DdmSimpleAdd", "add")
407 , ("DdmSimpleRemove", "remove")
408 ])
409 $(THH.makeJSONInstance ''DdmSimple)
410
411 -- | Dynamic device modification, all operations version.
412 --
413 -- TODO: DDM_SWAP, DDM_MOVE?
414 $(THH.declareLADT ''String "DdmFull"
415 [ ("DdmFullAdd", "add")
416 , ("DdmFullRemove", "remove")
417 , ("DdmFullModify", "modify")
418 ])
419 $(THH.makeJSONInstance ''DdmFull)
420
421 -- | Hypervisor type definitions.
422 $(THH.declareLADT ''String "Hypervisor"
423 [ ("Kvm", "kvm")
424 , ("XenPvm", "xen-pvm")
425 , ("Chroot", "chroot")
426 , ("XenHvm", "xen-hvm")
427 , ("Lxc", "lxc")
428 , ("Fake", "fake")
429 ])
430 $(THH.makeJSONInstance ''Hypervisor)
431
432 instance THH.PyValue Hypervisor where
433 showValue = show . hypervisorToRaw
434
435 instance HasStringRepr Hypervisor where
436 fromStringRepr = hypervisorFromRaw
437 toStringRepr = hypervisorToRaw
438
439 -- | Oob command type.
440 $(THH.declareLADT ''String "OobCommand"
441 [ ("OobHealth", "health")
442 , ("OobPowerCycle", "power-cycle")
443 , ("OobPowerOff", "power-off")
444 , ("OobPowerOn", "power-on")
445 , ("OobPowerStatus", "power-status")
446 ])
447 $(THH.makeJSONInstance ''OobCommand)
448
449 -- | Oob command status
450 $(THH.declareLADT ''String "OobStatus"
451 [ ("OobStatusCritical", "CRITICAL")
452 , ("OobStatusOk", "OK")
453 , ("OobStatusUnknown", "UNKNOWN")
454 , ("OobStatusWarning", "WARNING")
455 ])
456 $(THH.makeJSONInstance ''OobStatus)
457
458 -- | Storage type.
459 $(THH.declareLADT ''String "StorageType"
460 [ ("StorageFile", "file")
461 , ("StorageLvmPv", "lvm-pv")
462 , ("StorageLvmVg", "lvm-vg")
463 , ("StorageDiskless", "diskless")
464 , ("StorageBlock", "blockdev")
465 , ("StorageRados", "rados")
466 , ("StorageExt", "ext")
467 ])
468 $(THH.makeJSONInstance ''StorageType)
469
470 -- | Storage keys are identifiers for storage units. Their content varies
471 -- depending on the storage type, for example a storage key for LVM storage
472 -- is the volume group name.
473 type StorageKey = String
474
475 -- | Storage parameters
476 type SPExclusiveStorage = Bool
477
478 -- | Storage units without storage-type-specific parameters
479 data StorageUnitRaw = SURaw StorageType StorageKey
480
481 -- | Full storage unit with storage-type-specific parameters
482 data StorageUnit = SUFile StorageKey
483 | SULvmPv StorageKey SPExclusiveStorage
484 | SULvmVg StorageKey SPExclusiveStorage
485 | SUDiskless StorageKey
486 | SUBlock StorageKey
487 | SURados StorageKey
488 | SUExt StorageKey
489 deriving (Eq)
490
491 instance Show StorageUnit where
492 show (SUFile key) = showSUSimple StorageFile key
493 show (SULvmPv key es) = showSULvm StorageLvmPv key es
494 show (SULvmVg key es) = showSULvm StorageLvmVg key es
495 show (SUDiskless key) = showSUSimple StorageDiskless key
496 show (SUBlock key) = showSUSimple StorageBlock key
497 show (SURados key) = showSUSimple StorageRados key
498 show (SUExt key) = showSUSimple StorageExt key
499
500 instance JSON StorageUnit where
501 showJSON (SUFile key) = showJSON (StorageFile, key, []::[String])
502 showJSON (SULvmPv key es) = showJSON (StorageLvmPv, key, [es])
503 showJSON (SULvmVg key es) = showJSON (StorageLvmVg, key, [es])
504 showJSON (SUDiskless key) = showJSON (StorageDiskless, key, []::[String])
505 showJSON (SUBlock key) = showJSON (StorageBlock, key, []::[String])
506 showJSON (SURados key) = showJSON (StorageRados, key, []::[String])
507 showJSON (SUExt key) = showJSON (StorageExt, key, []::[String])
508 -- FIXME: add readJSON implementation
509 readJSON = fail "Not implemented"
510
511 -- | Composes a string representation of storage types without
512 -- storage parameters
513 showSUSimple :: StorageType -> StorageKey -> String
514 showSUSimple st sk = show (storageTypeToRaw st, sk, []::[String])
515
516 -- | Composes a string representation of the LVM storage types
517 showSULvm :: StorageType -> StorageKey -> SPExclusiveStorage -> String
518 showSULvm st sk es = show (storageTypeToRaw st, sk, [es])
519
520 -- | Mapping from disk templates to storage types
521 -- FIXME: This is semantically the same as the constant
522 -- C.diskTemplatesStorageType, remove this when python constants
523 -- are generated from haskell constants
524 diskTemplateToStorageType :: DiskTemplate -> StorageType
525 diskTemplateToStorageType DTExt = StorageExt
526 diskTemplateToStorageType DTFile = StorageFile
527 diskTemplateToStorageType DTSharedFile = StorageFile
528 diskTemplateToStorageType DTDrbd8 = StorageLvmVg
529 diskTemplateToStorageType DTPlain = StorageLvmVg
530 diskTemplateToStorageType DTRbd = StorageRados
531 diskTemplateToStorageType DTDiskless = StorageDiskless
532 diskTemplateToStorageType DTBlock = StorageBlock
533
534 -- | Equips a raw storage unit with its parameters
535 addParamsToStorageUnit :: SPExclusiveStorage -> StorageUnitRaw -> StorageUnit
536 addParamsToStorageUnit _ (SURaw StorageBlock key) = SUBlock key
537 addParamsToStorageUnit _ (SURaw StorageDiskless key) = SUDiskless key
538 addParamsToStorageUnit _ (SURaw StorageExt key) = SUExt key
539 addParamsToStorageUnit _ (SURaw StorageFile key) = SUFile key
540 addParamsToStorageUnit es (SURaw StorageLvmPv key) = SULvmPv key es
541 addParamsToStorageUnit es (SURaw StorageLvmVg key) = SULvmVg key es
542 addParamsToStorageUnit _ (SURaw StorageRados key) = SURados key
543
544 -- | Node evac modes.
545 --
546 -- This is part of the 'IAllocator' interface and it is used, for
547 -- example, in 'Ganeti.HTools.Loader.RqType'. However, it must reside
548 -- in this module, and not in 'Ganeti.HTools.Types', because it is
549 -- also used by 'Ganeti.HsConstants'.
550 $(THH.declareLADT ''String "EvacMode"
551 [ ("ChangePrimary", "primary-only")
552 , ("ChangeSecondary", "secondary-only")
553 , ("ChangeAll", "all")
554 ])
555 $(THH.makeJSONInstance ''EvacMode)
556
557 -- | The file driver type.
558 $(THH.declareLADT ''String "FileDriver"
559 [ ("FileLoop", "loop")
560 , ("FileBlktap", "blktap")
561 ])
562 $(THH.makeJSONInstance ''FileDriver)
563
564 -- | The instance create mode.
565 $(THH.declareLADT ''String "InstCreateMode"
566 [ ("InstCreate", "create")
567 , ("InstImport", "import")
568 , ("InstRemoteImport", "remote-import")
569 ])
570 $(THH.makeJSONInstance ''InstCreateMode)
571
572 -- | Reboot type.
573 $(THH.declareLADT ''String "RebootType"
574 [ ("RebootSoft", "soft")
575 , ("RebootHard", "hard")
576 , ("RebootFull", "full")
577 ])
578 $(THH.makeJSONInstance ''RebootType)
579
580 -- | Export modes.
581 $(THH.declareLADT ''String "ExportMode"
582 [ ("ExportModeLocal", "local")
583 , ("ExportModeRemote", "remote")
584 ])
585 $(THH.makeJSONInstance ''ExportMode)
586
587 -- | IAllocator run types (OpTestIAllocator).
588 $(THH.declareLADT ''String "IAllocatorTestDir"
589 [ ("IAllocatorDirIn", "in")
590 , ("IAllocatorDirOut", "out")
591 ])
592 $(THH.makeJSONInstance ''IAllocatorTestDir)
593
594 -- | IAllocator mode. FIXME: use this in "HTools.Backend.IAlloc".
595 $(THH.declareLADT ''String "IAllocatorMode"
596 [ ("IAllocatorAlloc", "allocate")
597 , ("IAllocatorMultiAlloc", "multi-allocate")
598 , ("IAllocatorReloc", "relocate")
599 , ("IAllocatorNodeEvac", "node-evacuate")
600 , ("IAllocatorChangeGroup", "change-group")
601 ])
602 $(THH.makeJSONInstance ''IAllocatorMode)
603
604 -- | Network mode.
605 $(THH.declareLADT ''String "NICMode"
606 [ ("NMBridged", "bridged")
607 , ("NMRouted", "routed")
608 , ("NMOvs", "openvswitch")
609 , ("NMPool", "pool")
610 ])
611 $(THH.makeJSONInstance ''NICMode)
612
613 -- | The JobStatus data type. Note that this is ordered especially
614 -- such that greater\/lesser comparison on values of this type makes
615 -- sense.
616 $(THH.declareLADT ''String "JobStatus"
617 [ ("JOB_STATUS_QUEUED", "queued")
618 , ("JOB_STATUS_WAITING", "waiting")
619 , ("JOB_STATUS_CANCELING", "canceling")
620 , ("JOB_STATUS_RUNNING", "running")
621 , ("JOB_STATUS_CANCELED", "canceled")
622 , ("JOB_STATUS_SUCCESS", "success")
623 , ("JOB_STATUS_ERROR", "error")
624 ])
625 $(THH.makeJSONInstance ''JobStatus)
626
627 -- | Finalized job status.
628 $(THH.declareLADT ''String "FinalizedJobStatus"
629 [ ("JobStatusCanceled", "canceled")
630 , ("JobStatusSuccessful", "success")
631 , ("JobStatusFailed", "error")
632 ])
633 $(THH.makeJSONInstance ''FinalizedJobStatus)
634
635 -- | The Ganeti job type.
636 newtype JobId = JobId { fromJobId :: Int }
637 deriving (Show, Eq)
638
639 -- | Builds a job ID.
640 makeJobId :: (Monad m) => Int -> m JobId
641 makeJobId i | i >= 0 = return $ JobId i
642 | otherwise = fail $ "Invalid value for job ID ' " ++ show i ++ "'"
643
644 -- | Builds a job ID from a string.
645 makeJobIdS :: (Monad m) => String -> m JobId
646 makeJobIdS s = tryRead "parsing job id" s >>= makeJobId
647
648 -- | Parses a job ID.
649 parseJobId :: (Monad m) => JSON.JSValue -> m JobId
650 parseJobId (JSON.JSString x) = makeJobIdS $ JSON.fromJSString x
651 parseJobId (JSON.JSRational _ x) =
652 if denominator x /= 1
653 then fail $ "Got fractional job ID from master daemon?! Value:" ++ show x
654 -- FIXME: potential integer overflow here on 32-bit platforms
655 else makeJobId . fromIntegral . numerator $ x
656 parseJobId x = fail $ "Wrong type/value for job id: " ++ show x
657
658 instance JSON.JSON JobId where
659 showJSON = JSON.showJSON . fromJobId
660 readJSON = parseJobId
661
662 -- | Relative job ID type alias.
663 type RelativeJobId = Negative Int
664
665 -- | Job ID dependency.
666 data JobIdDep = JobDepRelative RelativeJobId
667 | JobDepAbsolute JobId
668 deriving (Show, Eq)
669
670 instance JSON.JSON JobIdDep where
671 showJSON (JobDepRelative i) = showJSON i
672 showJSON (JobDepAbsolute i) = showJSON i
673 readJSON v =
674 case JSON.readJSON v::JSON.Result (Negative Int) of
675 -- first try relative dependency, usually most common
676 JSON.Ok r -> return $ JobDepRelative r
677 JSON.Error _ -> liftM JobDepAbsolute (parseJobId v)
678
679 -- | From job ID dependency and job ID, compute the absolute dependency.
680 absoluteJobIdDep :: (Monad m) => JobIdDep -> JobId -> m JobIdDep
681 absoluteJobIdDep (JobDepAbsolute jid) _ = return $ JobDepAbsolute jid
682 absoluteJobIdDep (JobDepRelative rjid) jid =
683 liftM JobDepAbsolute . makeJobId $ fromJobId jid + fromNegative rjid
684
685 -- | Job Dependency type.
686 data JobDependency = JobDependency JobIdDep [FinalizedJobStatus]
687 deriving (Show, Eq)
688
689 instance JSON JobDependency where
690 showJSON (JobDependency dep status) = showJSON (dep, status)
691 readJSON = liftM (uncurry JobDependency) . readJSON
692
693 -- | From job dependency and job id compute an absolute job dependency.
694 absoluteJobDependency :: (Monad m) => JobDependency -> JobId -> m JobDependency
695 absoluteJobDependency (JobDependency jdep fstats) jid =
696 liftM (flip JobDependency fstats) $ absoluteJobIdDep jdep jid
697
698 -- | Valid opcode priorities for submit.
699 $(THH.declareIADT "OpSubmitPriority"
700 [ ("OpPrioLow", 'ConstantUtils.priorityLow)
701 , ("OpPrioNormal", 'ConstantUtils.priorityNormal)
702 , ("OpPrioHigh", 'ConstantUtils.priorityHigh)
703 ])
704 $(THH.makeJSONInstance ''OpSubmitPriority)
705
706 -- | Parse submit priorities from a string.
707 parseSubmitPriority :: (Monad m) => String -> m OpSubmitPriority
708 parseSubmitPriority "low" = return OpPrioLow
709 parseSubmitPriority "normal" = return OpPrioNormal
710 parseSubmitPriority "high" = return OpPrioHigh
711 parseSubmitPriority str = fail $ "Unknown priority '" ++ str ++ "'"
712
713 -- | Format a submit priority as string.
714 fmtSubmitPriority :: OpSubmitPriority -> String
715 fmtSubmitPriority OpPrioLow = "low"
716 fmtSubmitPriority OpPrioNormal = "normal"
717 fmtSubmitPriority OpPrioHigh = "high"
718
719 -- | Our ADT for the OpCode status at runtime (while in a job).
720 $(THH.declareLADT ''String "OpStatus"
721 [ ("OP_STATUS_QUEUED", "queued")
722 , ("OP_STATUS_WAITING", "waiting")
723 , ("OP_STATUS_CANCELING", "canceling")
724 , ("OP_STATUS_RUNNING", "running")
725 , ("OP_STATUS_CANCELED", "canceled")
726 , ("OP_STATUS_SUCCESS", "success")
727 , ("OP_STATUS_ERROR", "error")
728 ])
729 $(THH.makeJSONInstance ''OpStatus)
730
731 -- | Type for the job message type.
732 $(THH.declareLADT ''String "ELogType"
733 [ ("ELogMessage", "message")
734 , ("ELogRemoteImport", "remote-import")
735 , ("ELogJqueueTest", "jqueue-test")
736 ])
737 $(THH.makeJSONInstance ''ELogType)
738
739 -- | Type of one element of a reason trail.
740 type ReasonElem = (String, String, Integer)
741
742 -- | Type representing a reason trail.
743 type ReasonTrail = [ReasonElem]
744
745 -- | The VTYPES, a mini-type system in Python.
746 $(THH.declareLADT ''String "VType"
747 [ ("VTypeString", "string")
748 , ("VTypeMaybeString", "maybe-string")
749 , ("VTypeBool", "bool")
750 , ("VTypeSize", "size")
751 , ("VTypeInt", "int")
752 ])
753 $(THH.makeJSONInstance ''VType)
754
755 instance THH.PyValue VType where
756 showValue = THH.showValue . vTypeToRaw
757
758 -- * Node role type
759
760 $(THH.declareLADT ''String "NodeRole"
761 [ ("NROffline", "O")
762 , ("NRDrained", "D")
763 , ("NRRegular", "R")
764 , ("NRCandidate", "C")
765 , ("NRMaster", "M")
766 ])
767 $(THH.makeJSONInstance ''NodeRole)
768
769 -- | The description of the node role.
770 roleDescription :: NodeRole -> String
771 roleDescription NROffline = "offline"
772 roleDescription NRDrained = "drained"
773 roleDescription NRRegular = "regular"
774 roleDescription NRCandidate = "master candidate"
775 roleDescription NRMaster = "master"
776
777 -- * Disk types
778
779 $(THH.declareLADT ''String "DiskMode"
780 [ ("DiskRdOnly", "ro")
781 , ("DiskRdWr", "rw")
782 ])
783 $(THH.makeJSONInstance ''DiskMode)
784
785 -- | The persistent block driver type. Currently only one type is allowed.
786 $(THH.declareLADT ''String "BlockDriver"
787 [ ("BlockDrvManual", "manual")
788 ])
789 $(THH.makeJSONInstance ''BlockDriver)
790
791 -- * Instance types
792
793 $(THH.declareLADT ''String "AdminState"
794 [ ("AdminOffline", "offline")
795 , ("AdminDown", "down")
796 , ("AdminUp", "up")
797 ])
798 $(THH.makeJSONInstance ''AdminState)
799
800 -- * Storage field type
801
802 $(THH.declareLADT ''String "StorageField"
803 [ ( "SFUsed", "used")
804 , ( "SFName", "name")
805 , ( "SFAllocatable", "allocatable")
806 , ( "SFFree", "free")
807 , ( "SFSize", "size")
808 ])
809 $(THH.makeJSONInstance ''StorageField)
810
811 -- * Disk access protocol
812
813 $(THH.declareLADT ''String "DiskAccessMode"
814 [ ( "DiskUserspace", "userspace")
815 , ( "DiskKernelspace", "kernelspace")
816 ])
817 $(THH.makeJSONInstance ''DiskAccessMode)
818
819 -- | Local disk status
820 --
821 -- Python code depends on:
822 -- DiskStatusOk < DiskStatusUnknown < DiskStatusFaulty
823 $(THH.declareILADT "LocalDiskStatus"
824 [ ("DiskStatusFaulty", 3)
825 , ("DiskStatusOk", 1)
826 , ("DiskStatusUnknown", 2)
827 ])
828
829 localDiskStatusName :: LocalDiskStatus -> String
830 localDiskStatusName DiskStatusFaulty = "faulty"
831 localDiskStatusName DiskStatusOk = "ok"
832 localDiskStatusName DiskStatusUnknown = "unknown"
833
834 -- | Replace disks type.
835 $(THH.declareLADT ''String "ReplaceDisksMode"
836 [ -- Replace disks on primary
837 ("ReplaceOnPrimary", "replace_on_primary")
838 -- Replace disks on secondary
839 , ("ReplaceOnSecondary", "replace_on_secondary")
840 -- Change secondary node
841 , ("ReplaceNewSecondary", "replace_new_secondary")
842 , ("ReplaceAuto", "replace_auto")
843 ])
844 $(THH.makeJSONInstance ''ReplaceDisksMode)
845
846 -- | Basic timeouts for RPC calls.
847 $(THH.declareILADT "RpcTimeout"
848 [ ("Urgent", 60) -- 1 minute
849 , ("Fast", 5 * 60) -- 5 minutes
850 , ("Normal", 15 * 60) -- 15 minutes
851 , ("Slow", 3600) -- 1 hour
852 , ("FourHours", 4 * 3600) -- 4 hours
853 , ("OneDay", 86400) -- 1 day
854 ])
855
856 $(THH.declareLADT ''String "ImportExportCompression"
857 [ -- No compression
858 ("None", "none")
859 -- gzip compression
860 , ("GZip", "gzip")
861 ])
862 $(THH.makeJSONInstance ''ImportExportCompression)
863
864 instance THH.PyValue ImportExportCompression where
865 showValue = THH.showValue . importExportCompressionToRaw
866
867 -- | Hotplug action.
868
869 $(THH.declareLADT ''String "HotplugAction"
870 [ ("HAAdd", "hotadd")
871 , ("HARemove", "hotremove")
872 , ("HAMod", "hotmod")
873 ])
874 $(THH.makeJSONInstance ''HotplugAction)
875
876 -- | Hotplug Device Target.
877
878 $(THH.declareLADT ''String "HotplugTarget"
879 [ ("HTDisk", "hotdisk")
880 , ("HTNic", "hotnic")
881 ])
882 $(THH.makeJSONInstance ''HotplugTarget)