Statistics
| Branch: | Tag: | Revision:

root / src / Ganeti / Types.hs @ ccf17aa3

History | View | Annotate | Download (24.2 kB)

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
  , NodeEvacMode(..)
86
  , nodeEvacModeToRaw
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
  , OpSubmitPriority(..)
114
  , opSubmitPriorityToRaw
115
  , parseSubmitPriority
116
  , fmtSubmitPriority
117
  , OpStatus(..)
118
  , opStatusToRaw
119
  , opStatusFromRaw
120
  , ELogType(..)
121
  , eLogTypeToRaw
122
  , ReasonElem
123
  , ReasonTrail
124
  , StorageUnit(..)
125
  , StorageUnitRaw(..)
126
  , StorageKey
127
  , addParamsToStorageUnit
128
  , diskTemplateToStorageType
129
  , VType(..)
130
  , vTypeFromRaw
131
  , vTypeToRaw
132
  , NodeRole(..)
133
  , nodeRoleToRaw
134
  , roleDescription
135
  , DiskMode(..)
136
  , diskModeToRaw
137
  , BlockDriver(..)
138
  , blockDriverToRaw
139
  , AdminState(..)
140
  , adminStateFromRaw
141
  , adminStateToRaw
142
  , StorageField(..)
143
  , storageFieldToRaw
144
  ) where
145

    
146
import Control.Monad (liftM)
147
import qualified Text.JSON as JSON
148
import Text.JSON (JSON, readJSON, showJSON)
149
import Data.Ratio (numerator, denominator)
150

    
151
import qualified Ganeti.ConstantUtils as ConstantUtils
152
import Ganeti.JSON
153
import qualified Ganeti.THH as THH
154
import Ganeti.Utils
155

    
156
-- * Generic types
157

    
158
-- | Type that holds a non-negative value.
159
newtype NonNegative a = NonNegative { fromNonNegative :: a }
160
  deriving (Show, Eq)
161

    
162
-- | Smart constructor for 'NonNegative'.
163
mkNonNegative :: (Monad m, Num a, Ord a, Show a) => a -> m (NonNegative a)
164
mkNonNegative i | i >= 0 = return (NonNegative i)
165
                | otherwise = fail $ "Invalid value for non-negative type '" ++
166
                              show i ++ "'"
167

    
168
instance (JSON.JSON a, Num a, Ord a, Show a) => JSON.JSON (NonNegative a) where
169
  showJSON = JSON.showJSON . fromNonNegative
170
  readJSON v = JSON.readJSON v >>= mkNonNegative
171

    
172
-- | Type that holds a positive value.
173
newtype Positive a = Positive { fromPositive :: a }
174
  deriving (Show, Eq)
175

    
176
-- | Smart constructor for 'Positive'.
177
mkPositive :: (Monad m, Num a, Ord a, Show a) => a -> m (Positive a)
178
mkPositive i | i > 0 = return (Positive i)
179
             | otherwise = fail $ "Invalid value for positive type '" ++
180
                           show i ++ "'"
181

    
182
instance (JSON.JSON a, Num a, Ord a, Show a) => JSON.JSON (Positive a) where
183
  showJSON = JSON.showJSON . fromPositive
184
  readJSON v = JSON.readJSON v >>= mkPositive
185

    
186
-- | Type that holds a negative value.
187
newtype Negative a = Negative { fromNegative :: a }
188
  deriving (Show, Eq)
189

    
190
-- | Smart constructor for 'Negative'.
191
mkNegative :: (Monad m, Num a, Ord a, Show a) => a -> m (Negative a)
192
mkNegative i | i < 0 = return (Negative i)
193
             | otherwise = fail $ "Invalid value for negative type '" ++
194
                           show i ++ "'"
195

    
196
instance (JSON.JSON a, Num a, Ord a, Show a) => JSON.JSON (Negative a) where
197
  showJSON = JSON.showJSON . fromNegative
198
  readJSON v = JSON.readJSON v >>= mkNegative
199

    
200
-- | Type that holds a non-null list.
201
newtype NonEmpty a = NonEmpty { fromNonEmpty :: [a] }
202
  deriving (Show, Eq)
203

    
204
-- | Smart constructor for 'NonEmpty'.
205
mkNonEmpty :: (Monad m) => [a] -> m (NonEmpty a)
206
mkNonEmpty [] = fail "Received empty value for non-empty list"
207
mkNonEmpty xs = return (NonEmpty xs)
208

    
209
instance (Eq a, Ord a) => Ord (NonEmpty a) where
210
  NonEmpty { fromNonEmpty = x1 } `compare` NonEmpty { fromNonEmpty = x2 } =
211
    x1 `compare` x2
212

    
213
instance (JSON.JSON a) => JSON.JSON (NonEmpty a) where
214
  showJSON = JSON.showJSON . fromNonEmpty
215
  readJSON v = JSON.readJSON v >>= mkNonEmpty
216

    
217
-- | A simple type alias for non-empty strings.
218
type NonEmptyString = NonEmpty Char
219

    
220
type QueryResultCode = Int
221

    
222
newtype IPv4Address = IPv4Address { fromIPv4Address :: String }
223
  deriving (Show, Eq)
224

    
225
-- FIXME: this should check that 'address' is a valid ip
226
mkIPv4Address :: Monad m => String -> m IPv4Address
227
mkIPv4Address address =
228
  return IPv4Address { fromIPv4Address = address }
229

    
230
instance JSON.JSON IPv4Address where
231
  showJSON = JSON.showJSON . fromIPv4Address
232
  readJSON v = JSON.readJSON v >>= mkIPv4Address
233

    
234
newtype IPv4Network = IPv4Network { fromIPv4Network :: String }
235
  deriving (Show, Eq)
236

    
237
-- FIXME: this should check that 'address' is a valid ip
238
mkIPv4Network :: Monad m => String -> m IPv4Network
239
mkIPv4Network address =
240
  return IPv4Network { fromIPv4Network = address }
241

    
242
instance JSON.JSON IPv4Network where
243
  showJSON = JSON.showJSON . fromIPv4Network
244
  readJSON v = JSON.readJSON v >>= mkIPv4Network
245

    
246
newtype IPv6Address = IPv6Address { fromIPv6Address :: String }
247
  deriving (Show, Eq)
248

    
249
-- FIXME: this should check that 'address' is a valid ip
250
mkIPv6Address :: Monad m => String -> m IPv6Address
251
mkIPv6Address address =
252
  return IPv6Address { fromIPv6Address = address }
253

    
254
instance JSON.JSON IPv6Address where
255
  showJSON = JSON.showJSON . fromIPv6Address
256
  readJSON v = JSON.readJSON v >>= mkIPv6Address
257

    
258
newtype IPv6Network = IPv6Network { fromIPv6Network :: String }
259
  deriving (Show, Eq)
260

    
261
-- FIXME: this should check that 'address' is a valid ip
262
mkIPv6Network :: Monad m => String -> m IPv6Network
263
mkIPv6Network address =
264
  return IPv6Network { fromIPv6Network = address }
265

    
266
instance JSON.JSON IPv6Network where
267
  showJSON = JSON.showJSON . fromIPv6Network
268
  readJSON v = JSON.readJSON v >>= mkIPv6Network
269

    
270
-- * Ganeti types
271

    
272
-- | Instance disk template type.
273
$(THH.declareLADT ''String "DiskTemplate"
274
       [ ("DTDiskless",   "diskless")
275
       , ("DTFile",       "file")
276
       , ("DTSharedFile", "sharedfile")
277
       , ("DTPlain",      "plain")
278
       , ("DTBlock",      "blockdev")
279
       , ("DTDrbd8",      "drbd")
280
       , ("DTRbd",        "rbd")
281
       , ("DTExt",        "ext")
282
       ])
283
$(THH.makeJSONInstance ''DiskTemplate)
284

    
285
instance HasStringRepr DiskTemplate where
286
  fromStringRepr = diskTemplateFromRaw
287
  toStringRepr = diskTemplateToRaw
288

    
289
-- | Data type representing what items the tag operations apply to.
290
$(THH.declareLADT ''String "TagKind"
291
  [ ("TagKindInstance", "instance")
292
  , ("TagKindNode",     "node")
293
  , ("TagKindGroup",    "nodegroup")
294
  , ("TagKindCluster",  "cluster")
295
  , ("TagKindNetwork",  "network")
296
  ])
297
$(THH.makeJSONInstance ''TagKind)
298

    
299
-- | The Group allocation policy type.
300
--
301
-- Note that the order of constructors is important as the automatic
302
-- Ord instance will order them in the order they are defined, so when
303
-- changing this data type be careful about the interaction with the
304
-- desired sorting order.
305
$(THH.declareLADT ''String "AllocPolicy"
306
       [ ("AllocPreferred",   "preferred")
307
       , ("AllocLastResort",  "last_resort")
308
       , ("AllocUnallocable", "unallocable")
309
       ])
310
$(THH.makeJSONInstance ''AllocPolicy)
311

    
312
-- | The Instance real state type. FIXME: this could be improved to
313
-- just wrap a /NormalState AdminStatus | ErrorState ErrorCondition/.
314
$(THH.declareLADT ''String "InstanceStatus"
315
       [ ("StatusDown",    "ADMIN_down")
316
       , ("StatusOffline", "ADMIN_offline")
317
       , ("ErrorDown",     "ERROR_down")
318
       , ("ErrorUp",       "ERROR_up")
319
       , ("NodeDown",      "ERROR_nodedown")
320
       , ("NodeOffline",   "ERROR_nodeoffline")
321
       , ("Running",       "running")
322
       , ("WrongNode",     "ERROR_wrongnode")
323
       ])
324
$(THH.makeJSONInstance ''InstanceStatus)
325

    
326
-- | Migration mode.
327
$(THH.declareLADT ''String "MigrationMode"
328
     [ ("MigrationLive",    "live")
329
     , ("MigrationNonLive", "non-live")
330
     ])
331
$(THH.makeJSONInstance ''MigrationMode)
332

    
333
-- | Verify optional checks.
334
$(THH.declareLADT ''String "VerifyOptionalChecks"
335
     [ ("VerifyNPlusOneMem", "nplusone_mem")
336
     ])
337
$(THH.makeJSONInstance ''VerifyOptionalChecks)
338

    
339
-- | Cluster verify error codes.
340
$(THH.declareLADT ''String "CVErrorCode"
341
  [ ("CvECLUSTERCFG",                  "ECLUSTERCFG")
342
  , ("CvECLUSTERCERT",                 "ECLUSTERCERT")
343
  , ("CvECLUSTERFILECHECK",            "ECLUSTERFILECHECK")
344
  , ("CvECLUSTERDANGLINGNODES",        "ECLUSTERDANGLINGNODES")
345
  , ("CvECLUSTERDANGLINGINST",         "ECLUSTERDANGLINGINST")
346
  , ("CvEINSTANCEBADNODE",             "EINSTANCEBADNODE")
347
  , ("CvEINSTANCEDOWN",                "EINSTANCEDOWN")
348
  , ("CvEINSTANCELAYOUT",              "EINSTANCELAYOUT")
349
  , ("CvEINSTANCEMISSINGDISK",         "EINSTANCEMISSINGDISK")
350
  , ("CvEINSTANCEFAULTYDISK",          "EINSTANCEFAULTYDISK")
351
  , ("CvEINSTANCEWRONGNODE",           "EINSTANCEWRONGNODE")
352
  , ("CvEINSTANCESPLITGROUPS",         "EINSTANCESPLITGROUPS")
353
  , ("CvEINSTANCEPOLICY",              "EINSTANCEPOLICY")
354
  , ("CvEINSTANCEUNSUITABLENODE",      "EINSTANCEUNSUITABLENODE")
355
  , ("CvEINSTANCEMISSINGCFGPARAMETER", "EINSTANCEMISSINGCFGPARAMETER")
356
  , ("CvENODEDRBD",                    "ENODEDRBD")
357
  , ("CvENODEDRBDVERSION",             "ENODEDRBDVERSION")
358
  , ("CvENODEDRBDHELPER",              "ENODEDRBDHELPER")
359
  , ("CvENODEFILECHECK",               "ENODEFILECHECK")
360
  , ("CvENODEHOOKS",                   "ENODEHOOKS")
361
  , ("CvENODEHV",                      "ENODEHV")
362
  , ("CvENODELVM",                     "ENODELVM")
363
  , ("CvENODEN1",                      "ENODEN1")
364
  , ("CvENODENET",                     "ENODENET")
365
  , ("CvENODEOS",                      "ENODEOS")
366
  , ("CvENODEORPHANINSTANCE",          "ENODEORPHANINSTANCE")
367
  , ("CvENODEORPHANLV",                "ENODEORPHANLV")
368
  , ("CvENODERPC",                     "ENODERPC")
369
  , ("CvENODESSH",                     "ENODESSH")
370
  , ("CvENODEVERSION",                 "ENODEVERSION")
371
  , ("CvENODESETUP",                   "ENODESETUP")
372
  , ("CvENODETIME",                    "ENODETIME")
373
  , ("CvENODEOOBPATH",                 "ENODEOOBPATH")
374
  , ("CvENODEUSERSCRIPTS",             "ENODEUSERSCRIPTS")
375
  , ("CvENODEFILESTORAGEPATHS",        "ENODEFILESTORAGEPATHS")
376
  , ("CvENODEFILESTORAGEPATHUNUSABLE", "ENODEFILESTORAGEPATHUNUSABLE")
377
  , ("CvENODESHAREDFILESTORAGEPATHUNUSABLE",
378
     "ENODESHAREDFILESTORAGEPATHUNUSABLE")
379
  , ("CvEGROUPDIFFERENTPVSIZE",        "EGROUPDIFFERENTPVSIZE")
380
  ])
381
$(THH.makeJSONInstance ''CVErrorCode)
382

    
383
-- | Dynamic device modification, just add\/remove version.
384
$(THH.declareLADT ''String "DdmSimple"
385
     [ ("DdmSimpleAdd",    "add")
386
     , ("DdmSimpleRemove", "remove")
387
     ])
388
$(THH.makeJSONInstance ''DdmSimple)
389

    
390
-- | Dynamic device modification, all operations version.
391
$(THH.declareLADT ''String "DdmFull"
392
     [ ("DdmFullAdd",    "add")
393
     , ("DdmFullRemove", "remove")
394
     , ("DdmFullModify", "modify")
395
     ])
396
$(THH.makeJSONInstance ''DdmFull)
397

    
398
-- | Hypervisor type definitions.
399
$(THH.declareLADT ''String "Hypervisor"
400
  [ ("Kvm",    "kvm")
401
  , ("XenPvm", "xen-pvm")
402
  , ("Chroot", "chroot")
403
  , ("XenHvm", "xen-hvm")
404
  , ("Lxc",    "lxc")
405
  , ("Fake",   "fake")
406
  ])
407
$(THH.makeJSONInstance ''Hypervisor)
408

    
409
-- | Oob command type.
410
$(THH.declareLADT ''String "OobCommand"
411
  [ ("OobHealth",      "health")
412
  , ("OobPowerCycle",  "power-cycle")
413
  , ("OobPowerOff",    "power-off")
414
  , ("OobPowerOn",     "power-on")
415
  , ("OobPowerStatus", "power-status")
416
  ])
417
$(THH.makeJSONInstance ''OobCommand)
418

    
419
-- | Oob command status
420
$(THH.declareLADT ''String "OobStatus"
421
  [ ("OobStatusCritical", "CRITICAL")
422
  , ("OobStatusOk",       "OK")
423
  , ("OobStatusUnknown",  "UNKNOWN")
424
  , ("OobStatusWarning",  "WARNING")
425
  ])
426
$(THH.makeJSONInstance ''OobStatus)
427

    
428
-- | Storage type.
429
$(THH.declareLADT ''String "StorageType"
430
  [ ("StorageFile", "file")
431
  , ("StorageLvmPv", "lvm-pv")
432
  , ("StorageLvmVg", "lvm-vg")
433
  , ("StorageDiskless", "diskless")
434
  , ("StorageBlock", "blockdev")
435
  , ("StorageRados", "rados")
436
  , ("StorageExt", "ext")
437
  ])
438
$(THH.makeJSONInstance ''StorageType)
439

    
440
-- | Storage keys are identifiers for storage units. Their content varies
441
-- depending on the storage type, for example a storage key for LVM storage
442
-- is the volume group name.
443
type StorageKey = String
444

    
445
-- | Storage parameters
446
type SPExclusiveStorage = Bool
447

    
448
-- | Storage units without storage-type-specific parameters
449
data StorageUnitRaw = SURaw StorageType StorageKey
450

    
451
-- | Full storage unit with storage-type-specific parameters
452
data StorageUnit = SUFile StorageKey
453
                 | SULvmPv StorageKey SPExclusiveStorage
454
                 | SULvmVg StorageKey SPExclusiveStorage
455
                 | SUDiskless StorageKey
456
                 | SUBlock StorageKey
457
                 | SURados StorageKey
458
                 | SUExt StorageKey
459
                 deriving (Eq)
460

    
461
instance Show StorageUnit where
462
  show (SUFile key) = showSUSimple StorageFile key
463
  show (SULvmPv key es) = showSULvm StorageLvmPv key es
464
  show (SULvmVg key es) = showSULvm StorageLvmVg key es
465
  show (SUDiskless key) = showSUSimple StorageDiskless key
466
  show (SUBlock key) = showSUSimple StorageBlock key
467
  show (SURados key) = showSUSimple StorageRados key
468
  show (SUExt key) = showSUSimple StorageExt key
469

    
470
instance JSON StorageUnit where
471
  showJSON (SUFile key) = showJSON (StorageFile, key, []::[String])
472
  showJSON (SULvmPv key es) = showJSON (StorageLvmPv, key, [es])
473
  showJSON (SULvmVg key es) = showJSON (StorageLvmVg, key, [es])
474
  showJSON (SUDiskless key) = showJSON (StorageDiskless, key, []::[String])
475
  showJSON (SUBlock key) = showJSON (StorageBlock, key, []::[String])
476
  showJSON (SURados key) = showJSON (StorageRados, key, []::[String])
477
  showJSON (SUExt key) = showJSON (StorageExt, key, []::[String])
478
-- FIXME: add readJSON implementation
479
  readJSON = fail "Not implemented"
480

    
481
-- | Composes a string representation of storage types without
482
-- storage parameters
483
showSUSimple :: StorageType -> StorageKey -> String
484
showSUSimple st sk = show (storageTypeToRaw st, sk, []::[String])
485

    
486
-- | Composes a string representation of the LVM storage types
487
showSULvm :: StorageType -> StorageKey -> SPExclusiveStorage -> String
488
showSULvm st sk es = show (storageTypeToRaw st, sk, [es])
489

    
490
-- | Mapping from disk templates to storage types
491
-- FIXME: This is semantically the same as the constant
492
-- C.diskTemplatesStorageType, remove this when python constants
493
-- are generated from haskell constants
494
diskTemplateToStorageType :: DiskTemplate -> StorageType
495
diskTemplateToStorageType DTExt = StorageExt
496
diskTemplateToStorageType DTFile = StorageFile
497
diskTemplateToStorageType DTSharedFile = StorageFile
498
diskTemplateToStorageType DTDrbd8 = StorageLvmVg
499
diskTemplateToStorageType DTPlain = StorageLvmVg
500
diskTemplateToStorageType DTRbd = StorageRados
501
diskTemplateToStorageType DTDiskless = StorageDiskless
502
diskTemplateToStorageType DTBlock = StorageBlock
503

    
504
-- | Equips a raw storage unit with its parameters
505
addParamsToStorageUnit :: SPExclusiveStorage -> StorageUnitRaw -> StorageUnit
506
addParamsToStorageUnit _ (SURaw StorageBlock key) = SUBlock key
507
addParamsToStorageUnit _ (SURaw StorageDiskless key) = SUDiskless key
508
addParamsToStorageUnit _ (SURaw StorageExt key) = SUExt key
509
addParamsToStorageUnit _ (SURaw StorageFile key) = SUFile key
510
addParamsToStorageUnit es (SURaw StorageLvmPv key) = SULvmPv key es
511
addParamsToStorageUnit es (SURaw StorageLvmVg key) = SULvmVg key es
512
addParamsToStorageUnit _ (SURaw StorageRados key) = SURados key
513

    
514
-- | Node evac modes.
515
$(THH.declareLADT ''String "NodeEvacMode"
516
  [ ("NEvacPrimary",   "primary-only")
517
  , ("NEvacSecondary", "secondary-only")
518
  , ("NEvacAll",       "all")
519
  ])
520
$(THH.makeJSONInstance ''NodeEvacMode)
521

    
522
-- | The file driver type.
523
$(THH.declareLADT ''String "FileDriver"
524
  [ ("FileLoop",   "loop")
525
  , ("FileBlktap", "blktap")
526
  ])
527
$(THH.makeJSONInstance ''FileDriver)
528

    
529
-- | The instance create mode.
530
$(THH.declareLADT ''String "InstCreateMode"
531
  [ ("InstCreate",       "create")
532
  , ("InstImport",       "import")
533
  , ("InstRemoteImport", "remote-import")
534
  ])
535
$(THH.makeJSONInstance ''InstCreateMode)
536

    
537
-- | Reboot type.
538
$(THH.declareLADT ''String "RebootType"
539
  [ ("RebootSoft", "soft")
540
  , ("RebootHard", "hard")
541
  , ("RebootFull", "full")
542
  ])
543
$(THH.makeJSONInstance ''RebootType)
544

    
545
-- | Export modes.
546
$(THH.declareLADT ''String "ExportMode"
547
  [ ("ExportModeLocal",  "local")
548
  , ("ExportModeRemote", "remote")
549
  ])
550
$(THH.makeJSONInstance ''ExportMode)
551

    
552
-- | IAllocator run types (OpTestIAllocator).
553
$(THH.declareLADT ''String "IAllocatorTestDir"
554
  [ ("IAllocatorDirIn",  "in")
555
  , ("IAllocatorDirOut", "out")
556
  ])
557
$(THH.makeJSONInstance ''IAllocatorTestDir)
558

    
559
-- | IAllocator mode. FIXME: use this in "HTools.Backend.IAlloc".
560
$(THH.declareLADT ''String "IAllocatorMode"
561
  [ ("IAllocatorAlloc",       "allocate")
562
  , ("IAllocatorMultiAlloc",  "multi-allocate")
563
  , ("IAllocatorReloc",       "relocate")
564
  , ("IAllocatorNodeEvac",    "node-evacuate")
565
  , ("IAllocatorChangeGroup", "change-group")
566
  ])
567
$(THH.makeJSONInstance ''IAllocatorMode)
568

    
569
-- | Network mode.
570
$(THH.declareLADT ''String "NICMode"
571
  [ ("NMBridged", "bridged")
572
  , ("NMRouted",  "routed")
573
  , ("NMOvs",     "openvswitch")
574
  , ("NMPool",    "pool")
575
  ])
576
$(THH.makeJSONInstance ''NICMode)
577

    
578
-- | The JobStatus data type. Note that this is ordered especially
579
-- such that greater\/lesser comparison on values of this type makes
580
-- sense.
581
$(THH.declareLADT ''String "JobStatus"
582
  [ ("JOB_STATUS_QUEUED",    "queued")
583
  , ("JOB_STATUS_WAITING",   "waiting")
584
  , ("JOB_STATUS_CANCELING", "canceling")
585
  , ("JOB_STATUS_RUNNING",   "running")
586
  , ("JOB_STATUS_CANCELED",  "canceled")
587
  , ("JOB_STATUS_SUCCESS",   "success")
588
  , ("JOB_STATUS_ERROR",     "error")
589
  ])
590
$(THH.makeJSONInstance ''JobStatus)
591

    
592
-- | Finalized job status.
593
$(THH.declareLADT ''String "FinalizedJobStatus"
594
  [ ("JobStatusCanceled",   "canceled")
595
  , ("JobStatusSuccessful", "success")
596
  , ("JobStatusFailed",     "error")
597
  ])
598
$(THH.makeJSONInstance ''FinalizedJobStatus)
599

    
600
-- | The Ganeti job type.
601
newtype JobId = JobId { fromJobId :: Int }
602
  deriving (Show, Eq)
603

    
604
-- | Builds a job ID.
605
makeJobId :: (Monad m) => Int -> m JobId
606
makeJobId i | i >= 0 = return $ JobId i
607
            | otherwise = fail $ "Invalid value for job ID ' " ++ show i ++ "'"
608

    
609
-- | Builds a job ID from a string.
610
makeJobIdS :: (Monad m) => String -> m JobId
611
makeJobIdS s = tryRead "parsing job id" s >>= makeJobId
612

    
613
-- | Parses a job ID.
614
parseJobId :: (Monad m) => JSON.JSValue -> m JobId
615
parseJobId (JSON.JSString x) = makeJobIdS $ JSON.fromJSString x
616
parseJobId (JSON.JSRational _ x) =
617
  if denominator x /= 1
618
    then fail $ "Got fractional job ID from master daemon?! Value:" ++ show x
619
    -- FIXME: potential integer overflow here on 32-bit platforms
620
    else makeJobId . fromIntegral . numerator $ x
621
parseJobId x = fail $ "Wrong type/value for job id: " ++ show x
622

    
623
instance JSON.JSON JobId where
624
  showJSON = JSON.showJSON . fromJobId
625
  readJSON = parseJobId
626

    
627
-- | Relative job ID type alias.
628
type RelativeJobId = Negative Int
629

    
630
-- | Job ID dependency.
631
data JobIdDep = JobDepRelative RelativeJobId
632
              | JobDepAbsolute JobId
633
                deriving (Show, Eq)
634

    
635
instance JSON.JSON JobIdDep where
636
  showJSON (JobDepRelative i) = showJSON i
637
  showJSON (JobDepAbsolute i) = showJSON i
638
  readJSON v =
639
    case JSON.readJSON v::JSON.Result (Negative Int) of
640
      -- first try relative dependency, usually most common
641
      JSON.Ok r -> return $ JobDepRelative r
642
      JSON.Error _ -> liftM JobDepAbsolute (parseJobId v)
643

    
644
-- | Job Dependency type.
645
data JobDependency = JobDependency JobIdDep [FinalizedJobStatus]
646
                     deriving (Show, Eq)
647

    
648
instance JSON JobDependency where
649
  showJSON (JobDependency dep status) = showJSON (dep, status)
650
  readJSON = liftM (uncurry JobDependency) . readJSON
651

    
652
-- | Valid opcode priorities for submit.
653
$(THH.declareIADT "OpSubmitPriority"
654
  [ ("OpPrioLow",    'ConstantUtils.priorityLow)
655
  , ("OpPrioNormal", 'ConstantUtils.priorityNormal)
656
  , ("OpPrioHigh",   'ConstantUtils.priorityHigh)
657
  ])
658
$(THH.makeJSONInstance ''OpSubmitPriority)
659

    
660
-- | Parse submit priorities from a string.
661
parseSubmitPriority :: (Monad m) => String -> m OpSubmitPriority
662
parseSubmitPriority "low"    = return OpPrioLow
663
parseSubmitPriority "normal" = return OpPrioNormal
664
parseSubmitPriority "high"   = return OpPrioHigh
665
parseSubmitPriority str      = fail $ "Unknown priority '" ++ str ++ "'"
666

    
667
-- | Format a submit priority as string.
668
fmtSubmitPriority :: OpSubmitPriority -> String
669
fmtSubmitPriority OpPrioLow    = "low"
670
fmtSubmitPriority OpPrioNormal = "normal"
671
fmtSubmitPriority OpPrioHigh   = "high"
672

    
673
-- | Our ADT for the OpCode status at runtime (while in a job).
674
$(THH.declareLADT ''String "OpStatus"
675
  [ ("OP_STATUS_QUEUED",    "queued")
676
  , ("OP_STATUS_WAITING",   "waiting")
677
  , ("OP_STATUS_CANCELING", "canceling")
678
  , ("OP_STATUS_RUNNING",   "running")
679
  , ("OP_STATUS_CANCELED",  "canceled")
680
  , ("OP_STATUS_SUCCESS",   "success")
681
  , ("OP_STATUS_ERROR",     "error")
682
  ])
683
$(THH.makeJSONInstance ''OpStatus)
684

    
685
-- | Type for the job message type.
686
$(THH.declareLADT ''String "ELogType"
687
  [ ("ELogMessage",      "message")
688
  , ("ELogRemoteImport", "remote-import")
689
  , ("ELogJqueueTest",   "jqueue-test")
690
  ])
691
$(THH.makeJSONInstance ''ELogType)
692

    
693
-- | Type of one element of a reason trail.
694
type ReasonElem = (String, String, Integer)
695

    
696
-- | Type representing a reason trail.
697
type ReasonTrail = [ReasonElem]
698

    
699
-- | The VTYPES, a mini-type system in Python.
700
$(THH.declareLADT ''String "VType"
701
  [ ("VTypeString",      "string")
702
  , ("VTypeMaybeString", "maybe-string")
703
  , ("VTypeBool",        "bool")
704
  , ("VTypeSize",        "size")
705
  , ("VTypeInt",         "int")
706
  ])
707
$(THH.makeJSONInstance ''VType)
708

    
709
-- * Node role type
710

    
711
$(THH.declareLADT ''String "NodeRole"
712
  [ ("NROffline",   "O")
713
  , ("NRDrained",   "D")
714
  , ("NRRegular",   "R")
715
  , ("NRCandidate", "C")
716
  , ("NRMaster",    "M")
717
  ])
718
$(THH.makeJSONInstance ''NodeRole)
719

    
720
-- | The description of the node role.
721
roleDescription :: NodeRole -> String
722
roleDescription NROffline   = "offline"
723
roleDescription NRDrained   = "drained"
724
roleDescription NRRegular   = "regular"
725
roleDescription NRCandidate = "master candidate"
726
roleDescription NRMaster    = "master"
727

    
728
-- * Disk types
729

    
730
$(THH.declareLADT ''String "DiskMode"
731
  [ ("DiskRdOnly", "ro")
732
  , ("DiskRdWr",   "rw")
733
  ])
734
$(THH.makeJSONInstance ''DiskMode)
735

    
736
-- | The persistent block driver type. Currently only one type is allowed.
737
$(THH.declareLADT ''String "BlockDriver"
738
  [ ("BlockDrvManual", "manual")
739
  ])
740
$(THH.makeJSONInstance ''BlockDriver)
741

    
742
-- * Instance types
743

    
744
$(THH.declareLADT ''String "AdminState"
745
  [ ("AdminOffline", "offline")
746
  , ("AdminDown",    "down")
747
  , ("AdminUp",      "up")
748
  ])
749
$(THH.makeJSONInstance ''AdminState)
750

    
751
-- * Storage field type
752

    
753
$(THH.declareLADT ''String "StorageField"
754
  [ ( "SFUsed",        "used")
755
  , ( "SFName",        "name")
756
  , ( "SFAllocatable", "allocatable")
757
  , ( "SFFree",        "free")
758
  , ( "SFSize",        "size")
759
  ])
760
$(THH.makeJSONInstance ''StorageField)