Statistics
| Branch: | Tag: | Revision:

root / src / Ganeti / Types.hs @ 88b58ed6

History | View | Annotate | Download (26.4 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
  , 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
  , 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
  , DiskAccessMode(..)
145
  , diskAccessModeToRaw
146
  , LocalDiskStatus(..)
147
  , localDiskStatusFromRaw
148
  , localDiskStatusToRaw
149
  , localDiskStatusName
150
  , ReplaceDisksMode(..)
151
  , replaceDisksModeToRaw
152
  , RpcTimeout(..)
153
  , rpcTimeoutFromRaw -- FIXME: no used anywhere
154
  , rpcTimeoutToRaw
155
  ) where
156

    
157
import Control.Monad (liftM)
158
import qualified Text.JSON as JSON
159
import Text.JSON (JSON, readJSON, showJSON)
160
import Data.Ratio (numerator, denominator)
161

    
162
import qualified Ganeti.ConstantUtils as ConstantUtils
163
import Ganeti.JSON
164
import qualified Ganeti.THH as THH
165
import Ganeti.Utils
166

    
167
-- * Generic types
168

    
169
-- | Type that holds a non-negative value.
170
newtype NonNegative a = NonNegative { fromNonNegative :: a }
171
  deriving (Show, Eq)
172

    
173
-- | Smart constructor for 'NonNegative'.
174
mkNonNegative :: (Monad m, Num a, Ord a, Show a) => a -> m (NonNegative a)
175
mkNonNegative i | i >= 0 = return (NonNegative i)
176
                | otherwise = fail $ "Invalid value for non-negative type '" ++
177
                              show i ++ "'"
178

    
179
instance (JSON.JSON a, Num a, Ord a, Show a) => JSON.JSON (NonNegative a) where
180
  showJSON = JSON.showJSON . fromNonNegative
181
  readJSON v = JSON.readJSON v >>= mkNonNegative
182

    
183
-- | Type that holds a positive value.
184
newtype Positive a = Positive { fromPositive :: a }
185
  deriving (Show, Eq)
186

    
187
-- | Smart constructor for 'Positive'.
188
mkPositive :: (Monad m, Num a, Ord a, Show a) => a -> m (Positive a)
189
mkPositive i | i > 0 = return (Positive i)
190
             | otherwise = fail $ "Invalid value for positive type '" ++
191
                           show i ++ "'"
192

    
193
instance (JSON.JSON a, Num a, Ord a, Show a) => JSON.JSON (Positive a) where
194
  showJSON = JSON.showJSON . fromPositive
195
  readJSON v = JSON.readJSON v >>= mkPositive
196

    
197
-- | Type that holds a negative value.
198
newtype Negative a = Negative { fromNegative :: a }
199
  deriving (Show, Eq)
200

    
201
-- | Smart constructor for 'Negative'.
202
mkNegative :: (Monad m, Num a, Ord a, Show a) => a -> m (Negative a)
203
mkNegative i | i < 0 = return (Negative i)
204
             | otherwise = fail $ "Invalid value for negative type '" ++
205
                           show i ++ "'"
206

    
207
instance (JSON.JSON a, Num a, Ord a, Show a) => JSON.JSON (Negative a) where
208
  showJSON = JSON.showJSON . fromNegative
209
  readJSON v = JSON.readJSON v >>= mkNegative
210

    
211
-- | Type that holds a non-null list.
212
newtype NonEmpty a = NonEmpty { fromNonEmpty :: [a] }
213
  deriving (Show, Eq)
214

    
215
-- | Smart constructor for 'NonEmpty'.
216
mkNonEmpty :: (Monad m) => [a] -> m (NonEmpty a)
217
mkNonEmpty [] = fail "Received empty value for non-empty list"
218
mkNonEmpty xs = return (NonEmpty xs)
219

    
220
instance (Eq a, Ord a) => Ord (NonEmpty a) where
221
  NonEmpty { fromNonEmpty = x1 } `compare` NonEmpty { fromNonEmpty = x2 } =
222
    x1 `compare` x2
223

    
224
instance (JSON.JSON a) => JSON.JSON (NonEmpty a) where
225
  showJSON = JSON.showJSON . fromNonEmpty
226
  readJSON v = JSON.readJSON v >>= mkNonEmpty
227

    
228
-- | A simple type alias for non-empty strings.
229
type NonEmptyString = NonEmpty Char
230

    
231
type QueryResultCode = Int
232

    
233
newtype IPv4Address = IPv4Address { fromIPv4Address :: String }
234
  deriving (Show, Eq)
235

    
236
-- FIXME: this should check that 'address' is a valid ip
237
mkIPv4Address :: Monad m => String -> m IPv4Address
238
mkIPv4Address address =
239
  return IPv4Address { fromIPv4Address = address }
240

    
241
instance JSON.JSON IPv4Address where
242
  showJSON = JSON.showJSON . fromIPv4Address
243
  readJSON v = JSON.readJSON v >>= mkIPv4Address
244

    
245
newtype IPv4Network = IPv4Network { fromIPv4Network :: String }
246
  deriving (Show, Eq)
247

    
248
-- FIXME: this should check that 'address' is a valid ip
249
mkIPv4Network :: Monad m => String -> m IPv4Network
250
mkIPv4Network address =
251
  return IPv4Network { fromIPv4Network = address }
252

    
253
instance JSON.JSON IPv4Network where
254
  showJSON = JSON.showJSON . fromIPv4Network
255
  readJSON v = JSON.readJSON v >>= mkIPv4Network
256

    
257
newtype IPv6Address = IPv6Address { fromIPv6Address :: String }
258
  deriving (Show, Eq)
259

    
260
-- FIXME: this should check that 'address' is a valid ip
261
mkIPv6Address :: Monad m => String -> m IPv6Address
262
mkIPv6Address address =
263
  return IPv6Address { fromIPv6Address = address }
264

    
265
instance JSON.JSON IPv6Address where
266
  showJSON = JSON.showJSON . fromIPv6Address
267
  readJSON v = JSON.readJSON v >>= mkIPv6Address
268

    
269
newtype IPv6Network = IPv6Network { fromIPv6Network :: String }
270
  deriving (Show, Eq)
271

    
272
-- FIXME: this should check that 'address' is a valid ip
273
mkIPv6Network :: Monad m => String -> m IPv6Network
274
mkIPv6Network address =
275
  return IPv6Network { fromIPv6Network = address }
276

    
277
instance JSON.JSON IPv6Network where
278
  showJSON = JSON.showJSON . fromIPv6Network
279
  readJSON v = JSON.readJSON v >>= mkIPv6Network
280

    
281
-- * Ganeti types
282

    
283
-- | Instance disk template type.
284
$(THH.declareLADT ''String "DiskTemplate"
285
       [ ("DTDiskless",   "diskless")
286
       , ("DTFile",       "file")
287
       , ("DTSharedFile", "sharedfile")
288
       , ("DTPlain",      "plain")
289
       , ("DTBlock",      "blockdev")
290
       , ("DTDrbd8",      "drbd")
291
       , ("DTRbd",        "rbd")
292
       , ("DTExt",        "ext")
293
       ])
294
$(THH.makeJSONInstance ''DiskTemplate)
295

    
296
instance THH.PyValue DiskTemplate where
297
  showValue = show . diskTemplateToRaw
298

    
299
instance HasStringRepr DiskTemplate where
300
  fromStringRepr = diskTemplateFromRaw
301
  toStringRepr = diskTemplateToRaw
302

    
303
-- | Data type representing what items the tag operations apply to.
304
$(THH.declareLADT ''String "TagKind"
305
  [ ("TagKindInstance", "instance")
306
  , ("TagKindNode",     "node")
307
  , ("TagKindGroup",    "nodegroup")
308
  , ("TagKindCluster",  "cluster")
309
  , ("TagKindNetwork",  "network")
310
  ])
311
$(THH.makeJSONInstance ''TagKind)
312

    
313
-- | The Group allocation policy type.
314
--
315
-- Note that the order of constructors is important as the automatic
316
-- Ord instance will order them in the order they are defined, so when
317
-- changing this data type be careful about the interaction with the
318
-- desired sorting order.
319
$(THH.declareLADT ''String "AllocPolicy"
320
       [ ("AllocPreferred",   "preferred")
321
       , ("AllocLastResort",  "last_resort")
322
       , ("AllocUnallocable", "unallocable")
323
       ])
324
$(THH.makeJSONInstance ''AllocPolicy)
325

    
326
-- | The Instance real state type. FIXME: this could be improved to
327
-- just wrap a /NormalState AdminStatus | ErrorState ErrorCondition/.
328
$(THH.declareLADT ''String "InstanceStatus"
329
       [ ("StatusDown",    "ADMIN_down")
330
       , ("StatusOffline", "ADMIN_offline")
331
       , ("ErrorDown",     "ERROR_down")
332
       , ("ErrorUp",       "ERROR_up")
333
       , ("NodeDown",      "ERROR_nodedown")
334
       , ("NodeOffline",   "ERROR_nodeoffline")
335
       , ("Running",       "running")
336
       , ("WrongNode",     "ERROR_wrongnode")
337
       ])
338
$(THH.makeJSONInstance ''InstanceStatus)
339

    
340
-- | Migration mode.
341
$(THH.declareLADT ''String "MigrationMode"
342
     [ ("MigrationLive",    "live")
343
     , ("MigrationNonLive", "non-live")
344
     ])
345
$(THH.makeJSONInstance ''MigrationMode)
346

    
347
-- | Verify optional checks.
348
$(THH.declareLADT ''String "VerifyOptionalChecks"
349
     [ ("VerifyNPlusOneMem", "nplusone_mem")
350
     ])
351
$(THH.makeJSONInstance ''VerifyOptionalChecks)
352

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

    
397
-- | Dynamic device modification, just add\/remove version.
398
$(THH.declareLADT ''String "DdmSimple"
399
     [ ("DdmSimpleAdd",    "add")
400
     , ("DdmSimpleRemove", "remove")
401
     ])
402
$(THH.makeJSONInstance ''DdmSimple)
403

    
404
-- | Dynamic device modification, all operations version.
405
--
406
-- TODO: DDM_SWAP, DDM_MOVE?
407
$(THH.declareLADT ''String "DdmFull"
408
     [ ("DdmFullAdd",    "add")
409
     , ("DdmFullRemove", "remove")
410
     , ("DdmFullModify", "modify")
411
     ])
412
$(THH.makeJSONInstance ''DdmFull)
413

    
414
-- | Hypervisor type definitions.
415
$(THH.declareLADT ''String "Hypervisor"
416
  [ ("Kvm",    "kvm")
417
  , ("XenPvm", "xen-pvm")
418
  , ("Chroot", "chroot")
419
  , ("XenHvm", "xen-hvm")
420
  , ("Lxc",    "lxc")
421
  , ("Fake",   "fake")
422
  ])
423
$(THH.makeJSONInstance ''Hypervisor)
424

    
425
instance THH.PyValue Hypervisor where
426
  showValue = show . hypervisorToRaw
427

    
428
instance HasStringRepr Hypervisor where
429
  fromStringRepr = hypervisorFromRaw
430
  toStringRepr = hypervisorToRaw
431

    
432
-- | Oob command type.
433
$(THH.declareLADT ''String "OobCommand"
434
  [ ("OobHealth",      "health")
435
  , ("OobPowerCycle",  "power-cycle")
436
  , ("OobPowerOff",    "power-off")
437
  , ("OobPowerOn",     "power-on")
438
  , ("OobPowerStatus", "power-status")
439
  ])
440
$(THH.makeJSONInstance ''OobCommand)
441

    
442
-- | Oob command status
443
$(THH.declareLADT ''String "OobStatus"
444
  [ ("OobStatusCritical", "CRITICAL")
445
  , ("OobStatusOk",       "OK")
446
  , ("OobStatusUnknown",  "UNKNOWN")
447
  , ("OobStatusWarning",  "WARNING")
448
  ])
449
$(THH.makeJSONInstance ''OobStatus)
450

    
451
-- | Storage type.
452
$(THH.declareLADT ''String "StorageType"
453
  [ ("StorageFile", "file")
454
  , ("StorageLvmPv", "lvm-pv")
455
  , ("StorageLvmVg", "lvm-vg")
456
  , ("StorageDiskless", "diskless")
457
  , ("StorageBlock", "blockdev")
458
  , ("StorageRados", "rados")
459
  , ("StorageExt", "ext")
460
  ])
461
$(THH.makeJSONInstance ''StorageType)
462

    
463
-- | Storage keys are identifiers for storage units. Their content varies
464
-- depending on the storage type, for example a storage key for LVM storage
465
-- is the volume group name.
466
type StorageKey = String
467

    
468
-- | Storage parameters
469
type SPExclusiveStorage = Bool
470

    
471
-- | Storage units without storage-type-specific parameters
472
data StorageUnitRaw = SURaw StorageType StorageKey
473

    
474
-- | Full storage unit with storage-type-specific parameters
475
data StorageUnit = SUFile StorageKey
476
                 | SULvmPv StorageKey SPExclusiveStorage
477
                 | SULvmVg StorageKey SPExclusiveStorage
478
                 | SUDiskless StorageKey
479
                 | SUBlock StorageKey
480
                 | SURados StorageKey
481
                 | SUExt StorageKey
482
                 deriving (Eq)
483

    
484
instance Show StorageUnit where
485
  show (SUFile key) = showSUSimple StorageFile key
486
  show (SULvmPv key es) = showSULvm StorageLvmPv key es
487
  show (SULvmVg key es) = showSULvm StorageLvmVg key es
488
  show (SUDiskless key) = showSUSimple StorageDiskless key
489
  show (SUBlock key) = showSUSimple StorageBlock key
490
  show (SURados key) = showSUSimple StorageRados key
491
  show (SUExt key) = showSUSimple StorageExt key
492

    
493
instance JSON StorageUnit where
494
  showJSON (SUFile key) = showJSON (StorageFile, key, []::[String])
495
  showJSON (SULvmPv key es) = showJSON (StorageLvmPv, key, [es])
496
  showJSON (SULvmVg key es) = showJSON (StorageLvmVg, key, [es])
497
  showJSON (SUDiskless key) = showJSON (StorageDiskless, key, []::[String])
498
  showJSON (SUBlock key) = showJSON (StorageBlock, key, []::[String])
499
  showJSON (SURados key) = showJSON (StorageRados, key, []::[String])
500
  showJSON (SUExt key) = showJSON (StorageExt, key, []::[String])
501
-- FIXME: add readJSON implementation
502
  readJSON = fail "Not implemented"
503

    
504
-- | Composes a string representation of storage types without
505
-- storage parameters
506
showSUSimple :: StorageType -> StorageKey -> String
507
showSUSimple st sk = show (storageTypeToRaw st, sk, []::[String])
508

    
509
-- | Composes a string representation of the LVM storage types
510
showSULvm :: StorageType -> StorageKey -> SPExclusiveStorage -> String
511
showSULvm st sk es = show (storageTypeToRaw st, sk, [es])
512

    
513
-- | Mapping from disk templates to storage types
514
-- FIXME: This is semantically the same as the constant
515
-- C.diskTemplatesStorageType, remove this when python constants
516
-- are generated from haskell constants
517
diskTemplateToStorageType :: DiskTemplate -> StorageType
518
diskTemplateToStorageType DTExt = StorageExt
519
diskTemplateToStorageType DTFile = StorageFile
520
diskTemplateToStorageType DTSharedFile = StorageFile
521
diskTemplateToStorageType DTDrbd8 = StorageLvmVg
522
diskTemplateToStorageType DTPlain = StorageLvmVg
523
diskTemplateToStorageType DTRbd = StorageRados
524
diskTemplateToStorageType DTDiskless = StorageDiskless
525
diskTemplateToStorageType DTBlock = StorageBlock
526

    
527
-- | Equips a raw storage unit with its parameters
528
addParamsToStorageUnit :: SPExclusiveStorage -> StorageUnitRaw -> StorageUnit
529
addParamsToStorageUnit _ (SURaw StorageBlock key) = SUBlock key
530
addParamsToStorageUnit _ (SURaw StorageDiskless key) = SUDiskless key
531
addParamsToStorageUnit _ (SURaw StorageExt key) = SUExt key
532
addParamsToStorageUnit _ (SURaw StorageFile key) = SUFile key
533
addParamsToStorageUnit es (SURaw StorageLvmPv key) = SULvmPv key es
534
addParamsToStorageUnit es (SURaw StorageLvmVg key) = SULvmVg key es
535
addParamsToStorageUnit _ (SURaw StorageRados key) = SURados key
536

    
537
-- | Node evac modes.
538
--
539
-- This is part of the 'IAllocator' interface and it is used, for
540
-- example, in 'Ganeti.HTools.Loader.RqType'.  However, it must reside
541
-- in this module, and not in 'Ganeti.HTools.Types', because it is
542
-- also used by 'Ganeti.HsConstants'.
543
$(THH.declareLADT ''String "EvacMode"
544
  [ ("ChangePrimary",   "primary-only")
545
  , ("ChangeSecondary", "secondary-only")
546
  , ("ChangeAll",       "all")
547
  ])
548
$(THH.makeJSONInstance ''EvacMode)
549

    
550
-- | The file driver type.
551
$(THH.declareLADT ''String "FileDriver"
552
  [ ("FileLoop",   "loop")
553
  , ("FileBlktap", "blktap")
554
  ])
555
$(THH.makeJSONInstance ''FileDriver)
556

    
557
-- | The instance create mode.
558
$(THH.declareLADT ''String "InstCreateMode"
559
  [ ("InstCreate",       "create")
560
  , ("InstImport",       "import")
561
  , ("InstRemoteImport", "remote-import")
562
  ])
563
$(THH.makeJSONInstance ''InstCreateMode)
564

    
565
-- | Reboot type.
566
$(THH.declareLADT ''String "RebootType"
567
  [ ("RebootSoft", "soft")
568
  , ("RebootHard", "hard")
569
  , ("RebootFull", "full")
570
  ])
571
$(THH.makeJSONInstance ''RebootType)
572

    
573
-- | Export modes.
574
$(THH.declareLADT ''String "ExportMode"
575
  [ ("ExportModeLocal",  "local")
576
  , ("ExportModeRemote", "remote")
577
  ])
578
$(THH.makeJSONInstance ''ExportMode)
579

    
580
-- | IAllocator run types (OpTestIAllocator).
581
$(THH.declareLADT ''String "IAllocatorTestDir"
582
  [ ("IAllocatorDirIn",  "in")
583
  , ("IAllocatorDirOut", "out")
584
  ])
585
$(THH.makeJSONInstance ''IAllocatorTestDir)
586

    
587
-- | IAllocator mode. FIXME: use this in "HTools.Backend.IAlloc".
588
$(THH.declareLADT ''String "IAllocatorMode"
589
  [ ("IAllocatorAlloc",       "allocate")
590
  , ("IAllocatorMultiAlloc",  "multi-allocate")
591
  , ("IAllocatorReloc",       "relocate")
592
  , ("IAllocatorNodeEvac",    "node-evacuate")
593
  , ("IAllocatorChangeGroup", "change-group")
594
  ])
595
$(THH.makeJSONInstance ''IAllocatorMode)
596

    
597
-- | Network mode.
598
$(THH.declareLADT ''String "NICMode"
599
  [ ("NMBridged", "bridged")
600
  , ("NMRouted",  "routed")
601
  , ("NMOvs",     "openvswitch")
602
  , ("NMPool",    "pool")
603
  ])
604
$(THH.makeJSONInstance ''NICMode)
605

    
606
-- | The JobStatus data type. Note that this is ordered especially
607
-- such that greater\/lesser comparison on values of this type makes
608
-- sense.
609
$(THH.declareLADT ''String "JobStatus"
610
  [ ("JOB_STATUS_QUEUED",    "queued")
611
  , ("JOB_STATUS_WAITING",   "waiting")
612
  , ("JOB_STATUS_CANCELING", "canceling")
613
  , ("JOB_STATUS_RUNNING",   "running")
614
  , ("JOB_STATUS_CANCELED",  "canceled")
615
  , ("JOB_STATUS_SUCCESS",   "success")
616
  , ("JOB_STATUS_ERROR",     "error")
617
  ])
618
$(THH.makeJSONInstance ''JobStatus)
619

    
620
-- | Finalized job status.
621
$(THH.declareLADT ''String "FinalizedJobStatus"
622
  [ ("JobStatusCanceled",   "canceled")
623
  , ("JobStatusSuccessful", "success")
624
  , ("JobStatusFailed",     "error")
625
  ])
626
$(THH.makeJSONInstance ''FinalizedJobStatus)
627

    
628
-- | The Ganeti job type.
629
newtype JobId = JobId { fromJobId :: Int }
630
  deriving (Show, Eq)
631

    
632
-- | Builds a job ID.
633
makeJobId :: (Monad m) => Int -> m JobId
634
makeJobId i | i >= 0 = return $ JobId i
635
            | otherwise = fail $ "Invalid value for job ID ' " ++ show i ++ "'"
636

    
637
-- | Builds a job ID from a string.
638
makeJobIdS :: (Monad m) => String -> m JobId
639
makeJobIdS s = tryRead "parsing job id" s >>= makeJobId
640

    
641
-- | Parses a job ID.
642
parseJobId :: (Monad m) => JSON.JSValue -> m JobId
643
parseJobId (JSON.JSString x) = makeJobIdS $ JSON.fromJSString x
644
parseJobId (JSON.JSRational _ x) =
645
  if denominator x /= 1
646
    then fail $ "Got fractional job ID from master daemon?! Value:" ++ show x
647
    -- FIXME: potential integer overflow here on 32-bit platforms
648
    else makeJobId . fromIntegral . numerator $ x
649
parseJobId x = fail $ "Wrong type/value for job id: " ++ show x
650

    
651
instance JSON.JSON JobId where
652
  showJSON = JSON.showJSON . fromJobId
653
  readJSON = parseJobId
654

    
655
-- | Relative job ID type alias.
656
type RelativeJobId = Negative Int
657

    
658
-- | Job ID dependency.
659
data JobIdDep = JobDepRelative RelativeJobId
660
              | JobDepAbsolute JobId
661
                deriving (Show, Eq)
662

    
663
instance JSON.JSON JobIdDep where
664
  showJSON (JobDepRelative i) = showJSON i
665
  showJSON (JobDepAbsolute i) = showJSON i
666
  readJSON v =
667
    case JSON.readJSON v::JSON.Result (Negative Int) of
668
      -- first try relative dependency, usually most common
669
      JSON.Ok r -> return $ JobDepRelative r
670
      JSON.Error _ -> liftM JobDepAbsolute (parseJobId v)
671

    
672
-- | Job Dependency type.
673
data JobDependency = JobDependency JobIdDep [FinalizedJobStatus]
674
                     deriving (Show, Eq)
675

    
676
instance JSON JobDependency where
677
  showJSON (JobDependency dep status) = showJSON (dep, status)
678
  readJSON = liftM (uncurry JobDependency) . readJSON
679

    
680
-- | Valid opcode priorities for submit.
681
$(THH.declareIADT "OpSubmitPriority"
682
  [ ("OpPrioLow",    'ConstantUtils.priorityLow)
683
  , ("OpPrioNormal", 'ConstantUtils.priorityNormal)
684
  , ("OpPrioHigh",   'ConstantUtils.priorityHigh)
685
  ])
686
$(THH.makeJSONInstance ''OpSubmitPriority)
687

    
688
-- | Parse submit priorities from a string.
689
parseSubmitPriority :: (Monad m) => String -> m OpSubmitPriority
690
parseSubmitPriority "low"    = return OpPrioLow
691
parseSubmitPriority "normal" = return OpPrioNormal
692
parseSubmitPriority "high"   = return OpPrioHigh
693
parseSubmitPriority str      = fail $ "Unknown priority '" ++ str ++ "'"
694

    
695
-- | Format a submit priority as string.
696
fmtSubmitPriority :: OpSubmitPriority -> String
697
fmtSubmitPriority OpPrioLow    = "low"
698
fmtSubmitPriority OpPrioNormal = "normal"
699
fmtSubmitPriority OpPrioHigh   = "high"
700

    
701
-- | Our ADT for the OpCode status at runtime (while in a job).
702
$(THH.declareLADT ''String "OpStatus"
703
  [ ("OP_STATUS_QUEUED",    "queued")
704
  , ("OP_STATUS_WAITING",   "waiting")
705
  , ("OP_STATUS_CANCELING", "canceling")
706
  , ("OP_STATUS_RUNNING",   "running")
707
  , ("OP_STATUS_CANCELED",  "canceled")
708
  , ("OP_STATUS_SUCCESS",   "success")
709
  , ("OP_STATUS_ERROR",     "error")
710
  ])
711
$(THH.makeJSONInstance ''OpStatus)
712

    
713
-- | Type for the job message type.
714
$(THH.declareLADT ''String "ELogType"
715
  [ ("ELogMessage",      "message")
716
  , ("ELogRemoteImport", "remote-import")
717
  , ("ELogJqueueTest",   "jqueue-test")
718
  ])
719
$(THH.makeJSONInstance ''ELogType)
720

    
721
-- | Type of one element of a reason trail.
722
type ReasonElem = (String, String, Integer)
723

    
724
-- | Type representing a reason trail.
725
type ReasonTrail = [ReasonElem]
726

    
727
-- | The VTYPES, a mini-type system in Python.
728
$(THH.declareLADT ''String "VType"
729
  [ ("VTypeString",      "string")
730
  , ("VTypeMaybeString", "maybe-string")
731
  , ("VTypeBool",        "bool")
732
  , ("VTypeSize",        "size")
733
  , ("VTypeInt",         "int")
734
  ])
735
$(THH.makeJSONInstance ''VType)
736

    
737
instance THH.PyValue VType where
738
  showValue = THH.showValue . vTypeToRaw
739

    
740
-- * Node role type
741

    
742
$(THH.declareLADT ''String "NodeRole"
743
  [ ("NROffline",   "O")
744
  , ("NRDrained",   "D")
745
  , ("NRRegular",   "R")
746
  , ("NRCandidate", "C")
747
  , ("NRMaster",    "M")
748
  ])
749
$(THH.makeJSONInstance ''NodeRole)
750

    
751
-- | The description of the node role.
752
roleDescription :: NodeRole -> String
753
roleDescription NROffline   = "offline"
754
roleDescription NRDrained   = "drained"
755
roleDescription NRRegular   = "regular"
756
roleDescription NRCandidate = "master candidate"
757
roleDescription NRMaster    = "master"
758

    
759
-- * Disk types
760

    
761
$(THH.declareLADT ''String "DiskMode"
762
  [ ("DiskRdOnly", "ro")
763
  , ("DiskRdWr",   "rw")
764
  ])
765
$(THH.makeJSONInstance ''DiskMode)
766

    
767
-- | The persistent block driver type. Currently only one type is allowed.
768
$(THH.declareLADT ''String "BlockDriver"
769
  [ ("BlockDrvManual", "manual")
770
  ])
771
$(THH.makeJSONInstance ''BlockDriver)
772

    
773
-- * Instance types
774

    
775
$(THH.declareLADT ''String "AdminState"
776
  [ ("AdminOffline", "offline")
777
  , ("AdminDown",    "down")
778
  , ("AdminUp",      "up")
779
  ])
780
$(THH.makeJSONInstance ''AdminState)
781

    
782
-- * Storage field type
783

    
784
$(THH.declareLADT ''String "StorageField"
785
  [ ( "SFUsed",        "used")
786
  , ( "SFName",        "name")
787
  , ( "SFAllocatable", "allocatable")
788
  , ( "SFFree",        "free")
789
  , ( "SFSize",        "size")
790
  ])
791
$(THH.makeJSONInstance ''StorageField)
792

    
793
-- * Disk access protocol
794

    
795
$(THH.declareLADT ''String "DiskAccessMode"
796
  [ ( "DiskUserspace",   "userspace")
797
  , ( "DiskKernelspace", "kernelspace")
798
  ])
799
$(THH.makeJSONInstance ''DiskAccessMode)
800

    
801
-- | Local disk status
802
--
803
-- Python code depends on:
804
--   DiskStatusOk < DiskStatusUnknown < DiskStatusFaulty
805
$(THH.declareILADT "LocalDiskStatus"
806
  [ ("DiskStatusFaulty",  3)
807
  , ("DiskStatusOk",      1)
808
  , ("DiskStatusUnknown", 2)
809
  ])
810

    
811
localDiskStatusName :: LocalDiskStatus -> String
812
localDiskStatusName DiskStatusFaulty = "faulty"
813
localDiskStatusName DiskStatusOk = "ok"
814
localDiskStatusName DiskStatusUnknown = "unknown"
815

    
816
-- | Replace disks type.
817
$(THH.declareLADT ''String "ReplaceDisksMode"
818
  [ -- Replace disks on primary
819
    ("ReplaceOnPrimary",    "replace_on_primary")
820
    -- Replace disks on secondary
821
  , ("ReplaceOnSecondary",  "replace_on_secondary")
822
    -- Change secondary node
823
  , ("ReplaceNewSecondary", "replace_new_secondary")
824
  , ("ReplaceAuto",         "replace_auto")
825
  ])
826
$(THH.makeJSONInstance ''ReplaceDisksMode)
827

    
828
-- | Basic timeouts for RPC calls.
829
$(THH.declareILADT "RpcTimeout"
830
  [ ("Urgent",    60)       -- 1 minute
831
  , ("Fast",      5 * 60)   -- 5 minutes
832
  , ("Normal",    15 * 60)  -- 15 minutes
833
  , ("Slow",      3600)     -- 1 hour
834
  , ("FourHours", 4 * 3600) -- 4 hours
835
  , ("OneDay",    86400)    -- 1 day
836
  ])