Statistics
| Branch: | Tag: | Revision:

root / src / Ganeti / Types.hs @ 212b66c3

History | View | Annotate | Download (19.5 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
  , NonNegative
44
  , fromNonNegative
45
  , mkNonNegative
46
  , Positive
47
  , fromPositive
48
  , mkPositive
49
  , Negative
50
  , fromNegative
51
  , mkNegative
52
  , NonEmpty
53
  , fromNonEmpty
54
  , mkNonEmpty
55
  , NonEmptyString
56
  , MigrationMode(..)
57
  , VerifyOptionalChecks(..)
58
  , DdmSimple(..)
59
  , DdmFull(..)
60
  , CVErrorCode(..)
61
  , cVErrorCodeToRaw
62
  , Hypervisor(..)
63
  , hypervisorToRaw
64
  , OobCommand(..)
65
  , StorageType(..)
66
  , storageTypeToRaw
67
  , NodeEvacMode(..)
68
  , FileDriver(..)
69
  , InstCreateMode(..)
70
  , RebootType(..)
71
  , ExportMode(..)
72
  , IAllocatorTestDir(..)
73
  , IAllocatorMode(..)
74
  , iAllocatorModeToRaw
75
  , NICMode(..)
76
  , nICModeToRaw
77
  , JobStatus(..)
78
  , jobStatusToRaw
79
  , jobStatusFromRaw
80
  , FinalizedJobStatus(..)
81
  , finalizedJobStatusToRaw
82
  , JobId
83
  , fromJobId
84
  , makeJobId
85
  , makeJobIdS
86
  , RelativeJobId
87
  , JobIdDep(..)
88
  , JobDependency(..)
89
  , OpSubmitPriority(..)
90
  , opSubmitPriorityToRaw
91
  , parseSubmitPriority
92
  , fmtSubmitPriority
93
  , OpStatus(..)
94
  , opStatusToRaw
95
  , opStatusFromRaw
96
  , ELogType(..)
97
  , ReasonElem
98
  , ReasonTrail
99
  , StorageUnit(..)
100
  , StorageUnitRaw(..)
101
  , StorageKey
102
  , addParamsToStorageUnit
103
  , diskTemplateToStorageType
104
  ) where
105

    
106
import Control.Monad (liftM)
107
import qualified Text.JSON as JSON
108
import Text.JSON (JSON, readJSON, showJSON)
109
import Data.Ratio (numerator, denominator)
110

    
111
import qualified Ganeti.Constants as C
112
import qualified Ganeti.THH as THH
113
import Ganeti.JSON
114
import Ganeti.Utils
115

    
116
-- * Generic types
117

    
118
-- | Type that holds a non-negative value.
119
newtype NonNegative a = NonNegative { fromNonNegative :: a }
120
  deriving (Show, Eq)
121

    
122
-- | Smart constructor for 'NonNegative'.
123
mkNonNegative :: (Monad m, Num a, Ord a, Show a) => a -> m (NonNegative a)
124
mkNonNegative i | i >= 0 = return (NonNegative i)
125
                | otherwise = fail $ "Invalid value for non-negative type '" ++
126
                              show i ++ "'"
127

    
128
instance (JSON.JSON a, Num a, Ord a, Show a) => JSON.JSON (NonNegative a) where
129
  showJSON = JSON.showJSON . fromNonNegative
130
  readJSON v = JSON.readJSON v >>= mkNonNegative
131

    
132
-- | Type that holds a positive value.
133
newtype Positive a = Positive { fromPositive :: a }
134
  deriving (Show, Eq)
135

    
136
-- | Smart constructor for 'Positive'.
137
mkPositive :: (Monad m, Num a, Ord a, Show a) => a -> m (Positive a)
138
mkPositive i | i > 0 = return (Positive i)
139
             | otherwise = fail $ "Invalid value for positive type '" ++
140
                           show i ++ "'"
141

    
142
instance (JSON.JSON a, Num a, Ord a, Show a) => JSON.JSON (Positive a) where
143
  showJSON = JSON.showJSON . fromPositive
144
  readJSON v = JSON.readJSON v >>= mkPositive
145

    
146
-- | Type that holds a negative value.
147
newtype Negative a = Negative { fromNegative :: a }
148
  deriving (Show, Eq)
149

    
150
-- | Smart constructor for 'Negative'.
151
mkNegative :: (Monad m, Num a, Ord a, Show a) => a -> m (Negative a)
152
mkNegative i | i < 0 = return (Negative i)
153
             | otherwise = fail $ "Invalid value for negative type '" ++
154
                           show i ++ "'"
155

    
156
instance (JSON.JSON a, Num a, Ord a, Show a) => JSON.JSON (Negative a) where
157
  showJSON = JSON.showJSON . fromNegative
158
  readJSON v = JSON.readJSON v >>= mkNegative
159

    
160
-- | Type that holds a non-null list.
161
newtype NonEmpty a = NonEmpty { fromNonEmpty :: [a] }
162
  deriving (Show, Eq)
163

    
164
-- | Smart constructor for 'NonEmpty'.
165
mkNonEmpty :: (Monad m) => [a] -> m (NonEmpty a)
166
mkNonEmpty [] = fail "Received empty value for non-empty list"
167
mkNonEmpty xs = return (NonEmpty xs)
168

    
169
instance (JSON.JSON a) => JSON.JSON (NonEmpty a) where
170
  showJSON = JSON.showJSON . fromNonEmpty
171
  readJSON v = JSON.readJSON v >>= mkNonEmpty
172

    
173
-- | A simple type alias for non-empty strings.
174
type NonEmptyString = NonEmpty Char
175

    
176
-- * Ganeti types
177

    
178
-- | Instance disk template type.
179
$(THH.declareSADT "DiskTemplate"
180
       [ ("DTDiskless",   'C.dtDiskless)
181
       , ("DTFile",       'C.dtFile)
182
       , ("DTSharedFile", 'C.dtSharedFile)
183
       , ("DTPlain",      'C.dtPlain)
184
       , ("DTBlock",      'C.dtBlock)
185
       , ("DTDrbd8",      'C.dtDrbd8)
186
       , ("DTRbd",        'C.dtRbd)
187
       , ("DTExt",        'C.dtExt)
188
       ])
189
$(THH.makeJSONInstance ''DiskTemplate)
190

    
191
instance HasStringRepr DiskTemplate where
192
  fromStringRepr = diskTemplateFromRaw
193
  toStringRepr = diskTemplateToRaw
194

    
195
-- | The Group allocation policy type.
196
--
197
-- Note that the order of constructors is important as the automatic
198
-- Ord instance will order them in the order they are defined, so when
199
-- changing this data type be careful about the interaction with the
200
-- desired sorting order.
201
$(THH.declareSADT "AllocPolicy"
202
       [ ("AllocPreferred",   'C.allocPolicyPreferred)
203
       , ("AllocLastResort",  'C.allocPolicyLastResort)
204
       , ("AllocUnallocable", 'C.allocPolicyUnallocable)
205
       ])
206
$(THH.makeJSONInstance ''AllocPolicy)
207

    
208
-- | The Instance real state type. FIXME: this could be improved to
209
-- just wrap a /NormalState AdminStatus | ErrorState ErrorCondition/.
210
$(THH.declareSADT "InstanceStatus"
211
       [ ("StatusDown",    'C.inststAdmindown)
212
       , ("StatusOffline", 'C.inststAdminoffline)
213
       , ("ErrorDown",     'C.inststErrordown)
214
       , ("ErrorUp",       'C.inststErrorup)
215
       , ("NodeDown",      'C.inststNodedown)
216
       , ("NodeOffline",   'C.inststNodeoffline)
217
       , ("Running",       'C.inststRunning)
218
       , ("WrongNode",     'C.inststWrongnode)
219
       ])
220
$(THH.makeJSONInstance ''InstanceStatus)
221

    
222
-- | Migration mode.
223
$(THH.declareSADT "MigrationMode"
224
     [ ("MigrationLive",    'C.htMigrationLive)
225
     , ("MigrationNonLive", 'C.htMigrationNonlive)
226
     ])
227
$(THH.makeJSONInstance ''MigrationMode)
228

    
229
-- | Verify optional checks.
230
$(THH.declareSADT "VerifyOptionalChecks"
231
     [ ("VerifyNPlusOneMem", 'C.verifyNplusoneMem)
232
     ])
233
$(THH.makeJSONInstance ''VerifyOptionalChecks)
234

    
235
-- | Cluster verify error codes.
236
$(THH.declareSADT "CVErrorCode"
237
  [ ("CvECLUSTERCFG",           'C.cvEclustercfgCode)
238
  , ("CvECLUSTERCERT",          'C.cvEclustercertCode)
239
  , ("CvECLUSTERFILECHECK",     'C.cvEclusterfilecheckCode)
240
  , ("CvECLUSTERDANGLINGNODES", 'C.cvEclusterdanglingnodesCode)
241
  , ("CvECLUSTERDANGLINGINST",  'C.cvEclusterdanglinginstCode)
242
  , ("CvEINSTANCEBADNODE",      'C.cvEinstancebadnodeCode)
243
  , ("CvEINSTANCEDOWN",         'C.cvEinstancedownCode)
244
  , ("CvEINSTANCELAYOUT",       'C.cvEinstancelayoutCode)
245
  , ("CvEINSTANCEMISSINGDISK",  'C.cvEinstancemissingdiskCode)
246
  , ("CvEINSTANCEFAULTYDISK",   'C.cvEinstancefaultydiskCode)
247
  , ("CvEINSTANCEWRONGNODE",    'C.cvEinstancewrongnodeCode)
248
  , ("CvEINSTANCESPLITGROUPS",  'C.cvEinstancesplitgroupsCode)
249
  , ("CvEINSTANCEPOLICY",       'C.cvEinstancepolicyCode)
250
  , ("CvENODEDRBD",             'C.cvEnodedrbdCode)
251
  , ("CvENODEDRBDHELPER",       'C.cvEnodedrbdhelperCode)
252
  , ("CvENODEFILECHECK",        'C.cvEnodefilecheckCode)
253
  , ("CvENODEHOOKS",            'C.cvEnodehooksCode)
254
  , ("CvENODEHV",               'C.cvEnodehvCode)
255
  , ("CvENODELVM",              'C.cvEnodelvmCode)
256
  , ("CvENODEN1",               'C.cvEnoden1Code)
257
  , ("CvENODENET",              'C.cvEnodenetCode)
258
  , ("CvENODEOS",               'C.cvEnodeosCode)
259
  , ("CvENODEORPHANINSTANCE",   'C.cvEnodeorphaninstanceCode)
260
  , ("CvENODEORPHANLV",         'C.cvEnodeorphanlvCode)
261
  , ("CvENODERPC",              'C.cvEnoderpcCode)
262
  , ("CvENODESSH",              'C.cvEnodesshCode)
263
  , ("CvENODEVERSION",          'C.cvEnodeversionCode)
264
  , ("CvENODESETUP",            'C.cvEnodesetupCode)
265
  , ("CvENODETIME",             'C.cvEnodetimeCode)
266
  , ("CvENODEOOBPATH",          'C.cvEnodeoobpathCode)
267
  , ("CvENODEUSERSCRIPTS",      'C.cvEnodeuserscriptsCode)
268
  , ("CvENODEFILESTORAGEPATHS", 'C.cvEnodefilestoragepathsCode)
269
  ])
270
$(THH.makeJSONInstance ''CVErrorCode)
271

    
272
-- | Dynamic device modification, just add\/remove version.
273
$(THH.declareSADT "DdmSimple"
274
     [ ("DdmSimpleAdd",    'C.ddmAdd)
275
     , ("DdmSimpleRemove", 'C.ddmRemove)
276
     ])
277
$(THH.makeJSONInstance ''DdmSimple)
278

    
279
-- | Dynamic device modification, all operations version.
280
$(THH.declareSADT "DdmFull"
281
     [ ("DdmFullAdd",    'C.ddmAdd)
282
     , ("DdmFullRemove", 'C.ddmRemove)
283
     , ("DdmFullModify", 'C.ddmModify)
284
     ])
285
$(THH.makeJSONInstance ''DdmFull)
286

    
287
-- | Hypervisor type definitions.
288
$(THH.declareSADT "Hypervisor"
289
  [ ( "Kvm",    'C.htKvm )
290
  , ( "XenPvm", 'C.htXenPvm )
291
  , ( "Chroot", 'C.htChroot )
292
  , ( "XenHvm", 'C.htXenHvm )
293
  , ( "Lxc",    'C.htLxc )
294
  , ( "Fake",   'C.htFake )
295
  ])
296
$(THH.makeJSONInstance ''Hypervisor)
297

    
298
-- | Oob command type.
299
$(THH.declareSADT "OobCommand"
300
  [ ("OobHealth",      'C.oobHealth)
301
  , ("OobPowerCycle",  'C.oobPowerCycle)
302
  , ("OobPowerOff",    'C.oobPowerOff)
303
  , ("OobPowerOn",     'C.oobPowerOn)
304
  , ("OobPowerStatus", 'C.oobPowerStatus)
305
  ])
306
$(THH.makeJSONInstance ''OobCommand)
307

    
308
-- | Storage type.
309
$(THH.declareSADT "StorageType"
310
  [ ("StorageFile", 'C.stFile)
311
  , ("StorageLvmPv", 'C.stLvmPv)
312
  , ("StorageLvmVg", 'C.stLvmVg)
313
  , ("StorageDiskless", 'C.stDiskless)
314
  , ("StorageBlock", 'C.stBlock)
315
  , ("StorageRados", 'C.stRados)
316
  , ("StorageExt", 'C.stExt)
317
  ])
318
$(THH.makeJSONInstance ''StorageType)
319

    
320
-- | Storage keys are identifiers for storage units. Their content varies
321
-- depending on the storage type, for example a storage key for LVM storage
322
-- is the volume group name.
323
type StorageKey = String
324

    
325
-- | Storage parameters
326
type SPExclusiveStorage = Bool
327

    
328
-- | Storage units without storage-type-specific parameters
329
data StorageUnitRaw = SURaw StorageType StorageKey
330

    
331
-- | Full storage unit with storage-type-specific parameters
332
data StorageUnit = SUFile StorageKey
333
                 | SULvmPv StorageKey SPExclusiveStorage
334
                 | SULvmVg StorageKey SPExclusiveStorage
335
                 | SUDiskless StorageKey
336
                 | SUBlock StorageKey
337
                 | SURados StorageKey
338
                 | SUExt StorageKey
339
                 deriving (Eq)
340

    
341
instance Show StorageUnit where
342
  show (SUFile key) = showSUSimple StorageFile key
343
  show (SULvmPv key es) = showSULvm StorageLvmPv key es
344
  show (SULvmVg key es) = showSULvm StorageLvmVg key es
345
  show (SUDiskless key) = showSUSimple StorageDiskless key
346
  show (SUBlock key) = showSUSimple StorageBlock key
347
  show (SURados key) = showSUSimple StorageRados key
348
  show (SUExt key) = showSUSimple StorageExt key
349

    
350
instance JSON StorageUnit where
351
  showJSON (SUFile key) = showJSON (StorageFile, key, []::[String])
352
  showJSON (SULvmPv key es) = showJSON (StorageLvmPv, key, [es])
353
  showJSON (SULvmVg key es) = showJSON (StorageLvmVg, key, [es])
354
  showJSON (SUDiskless key) = showJSON (StorageDiskless, key, []::[String])
355
  showJSON (SUBlock key) = showJSON (StorageBlock, key, []::[String])
356
  showJSON (SURados key) = showJSON (StorageRados, key, []::[String])
357
  showJSON (SUExt key) = showJSON (StorageExt, key, []::[String])
358
-- FIXME: add readJSON implementation
359
  readJSON = fail "Not implemented"
360

    
361
-- | Composes a string representation of storage types without
362
-- storage parameters
363
showSUSimple :: StorageType -> StorageKey -> String
364
showSUSimple st sk = show (storageTypeToRaw st, sk, []::[String])
365

    
366
-- | Composes a string representation of the LVM storage types
367
showSULvm :: StorageType -> StorageKey -> SPExclusiveStorage -> String
368
showSULvm st sk es = show (storageTypeToRaw st, sk, [es])
369

    
370
-- | Mapping fo disk templates to storage type
371
-- FIXME: This is semantically the same as the constant
372
-- C.diskTemplatesStorageType, remove this when python constants
373
-- are generated from haskell constants
374
diskTemplateToStorageType :: DiskTemplate -> StorageType
375
diskTemplateToStorageType DTExt = StorageExt
376
diskTemplateToStorageType DTFile = StorageFile
377
diskTemplateToStorageType DTSharedFile = StorageFile
378
diskTemplateToStorageType DTDrbd8 = StorageLvmVg
379
diskTemplateToStorageType DTPlain = StorageLvmVg
380
diskTemplateToStorageType DTRbd = StorageRados
381
diskTemplateToStorageType DTDiskless = StorageDiskless
382
diskTemplateToStorageType DTBlock = StorageBlock
383

    
384
-- | Equips a raw storage unit with its parameters
385
addParamsToStorageUnit :: SPExclusiveStorage -> StorageUnitRaw -> StorageUnit
386
addParamsToStorageUnit _ (SURaw StorageBlock key) = SUBlock key
387
addParamsToStorageUnit _ (SURaw StorageDiskless key) = SUDiskless key
388
addParamsToStorageUnit _ (SURaw StorageExt key) = SUExt key
389
addParamsToStorageUnit _ (SURaw StorageFile key) = SUFile key
390
addParamsToStorageUnit es (SURaw StorageLvmPv key) = SULvmPv key es
391
addParamsToStorageUnit es (SURaw StorageLvmVg key) = SULvmVg key es
392
addParamsToStorageUnit _ (SURaw StorageRados key) = SURados key
393

    
394
-- | Node evac modes.
395
$(THH.declareSADT "NodeEvacMode"
396
  [ ("NEvacPrimary",   'C.iallocatorNevacPri)
397
  , ("NEvacSecondary", 'C.iallocatorNevacSec)
398
  , ("NEvacAll",       'C.iallocatorNevacAll)
399
  ])
400
$(THH.makeJSONInstance ''NodeEvacMode)
401

    
402
-- | The file driver type.
403
$(THH.declareSADT "FileDriver"
404
  [ ("FileLoop",   'C.fdLoop)
405
  , ("FileBlktap", 'C.fdBlktap)
406
  ])
407
$(THH.makeJSONInstance ''FileDriver)
408

    
409
-- | The instance create mode.
410
$(THH.declareSADT "InstCreateMode"
411
  [ ("InstCreate",       'C.instanceCreate)
412
  , ("InstImport",       'C.instanceImport)
413
  , ("InstRemoteImport", 'C.instanceRemoteImport)
414
  ])
415
$(THH.makeJSONInstance ''InstCreateMode)
416

    
417
-- | Reboot type.
418
$(THH.declareSADT "RebootType"
419
  [ ("RebootSoft", 'C.instanceRebootSoft)
420
  , ("RebootHard", 'C.instanceRebootHard)
421
  , ("RebootFull", 'C.instanceRebootFull)
422
  ])
423
$(THH.makeJSONInstance ''RebootType)
424

    
425
-- | Export modes.
426
$(THH.declareSADT "ExportMode"
427
  [ ("ExportModeLocal",  'C.exportModeLocal)
428
  , ("ExportModeRemove", 'C.exportModeRemote)
429
  ])
430
$(THH.makeJSONInstance ''ExportMode)
431

    
432
-- | IAllocator run types (OpTestIAllocator).
433
$(THH.declareSADT "IAllocatorTestDir"
434
  [ ("IAllocatorDirIn",  'C.iallocatorDirIn)
435
  , ("IAllocatorDirOut", 'C.iallocatorDirOut)
436
  ])
437
$(THH.makeJSONInstance ''IAllocatorTestDir)
438

    
439
-- | IAllocator mode. FIXME: use this in "HTools.Backend.IAlloc".
440
$(THH.declareSADT "IAllocatorMode"
441
  [ ("IAllocatorAlloc",       'C.iallocatorModeAlloc)
442
  , ("IAllocatorMultiAlloc",  'C.iallocatorModeMultiAlloc)
443
  , ("IAllocatorReloc",       'C.iallocatorModeReloc)
444
  , ("IAllocatorNodeEvac",    'C.iallocatorModeNodeEvac)
445
  , ("IAllocatorChangeGroup", 'C.iallocatorModeChgGroup)
446
  ])
447
$(THH.makeJSONInstance ''IAllocatorMode)
448

    
449
-- | Network mode.
450
$(THH.declareSADT "NICMode"
451
  [ ("NMBridged", 'C.nicModeBridged)
452
  , ("NMRouted",  'C.nicModeRouted)
453
  , ("NMOvs",     'C.nicModeOvs)
454
  ])
455
$(THH.makeJSONInstance ''NICMode)
456

    
457
-- | The JobStatus data type. Note that this is ordered especially
458
-- such that greater\/lesser comparison on values of this type makes
459
-- sense.
460
$(THH.declareSADT "JobStatus"
461
       [ ("JOB_STATUS_QUEUED",    'C.jobStatusQueued)
462
       , ("JOB_STATUS_WAITING",   'C.jobStatusWaiting)
463
       , ("JOB_STATUS_CANCELING", 'C.jobStatusCanceling)
464
       , ("JOB_STATUS_RUNNING",   'C.jobStatusRunning)
465
       , ("JOB_STATUS_CANCELED",  'C.jobStatusCanceled)
466
       , ("JOB_STATUS_SUCCESS",   'C.jobStatusSuccess)
467
       , ("JOB_STATUS_ERROR",     'C.jobStatusError)
468
       ])
469
$(THH.makeJSONInstance ''JobStatus)
470

    
471
-- | Finalized job status.
472
$(THH.declareSADT "FinalizedJobStatus"
473
  [ ("JobStatusCanceled",   'C.jobStatusCanceled)
474
  , ("JobStatusSuccessful", 'C.jobStatusSuccess)
475
  , ("JobStatusFailed",     'C.jobStatusError)
476
  ])
477
$(THH.makeJSONInstance ''FinalizedJobStatus)
478

    
479
-- | The Ganeti job type.
480
newtype JobId = JobId { fromJobId :: Int }
481
  deriving (Show, Eq)
482

    
483
-- | Builds a job ID.
484
makeJobId :: (Monad m) => Int -> m JobId
485
makeJobId i | i >= 0 = return $ JobId i
486
            | otherwise = fail $ "Invalid value for job ID ' " ++ show i ++ "'"
487

    
488
-- | Builds a job ID from a string.
489
makeJobIdS :: (Monad m) => String -> m JobId
490
makeJobIdS s = tryRead "parsing job id" s >>= makeJobId
491

    
492
-- | Parses a job ID.
493
parseJobId :: (Monad m) => JSON.JSValue -> m JobId
494
parseJobId (JSON.JSString x) = makeJobIdS $ JSON.fromJSString x
495
parseJobId (JSON.JSRational _ x) =
496
  if denominator x /= 1
497
    then fail $ "Got fractional job ID from master daemon?! Value:" ++ show x
498
    -- FIXME: potential integer overflow here on 32-bit platforms
499
    else makeJobId . fromIntegral . numerator $ x
500
parseJobId x = fail $ "Wrong type/value for job id: " ++ show x
501

    
502
instance JSON.JSON JobId where
503
  showJSON = JSON.showJSON . fromJobId
504
  readJSON = parseJobId
505

    
506
-- | Relative job ID type alias.
507
type RelativeJobId = Negative Int
508

    
509
-- | Job ID dependency.
510
data JobIdDep = JobDepRelative RelativeJobId
511
              | JobDepAbsolute JobId
512
                deriving (Show, Eq)
513

    
514
instance JSON.JSON JobIdDep where
515
  showJSON (JobDepRelative i) = showJSON i
516
  showJSON (JobDepAbsolute i) = showJSON i
517
  readJSON v =
518
    case JSON.readJSON v::JSON.Result (Negative Int) of
519
      -- first try relative dependency, usually most common
520
      JSON.Ok r -> return $ JobDepRelative r
521
      JSON.Error _ -> liftM JobDepAbsolute (parseJobId v)
522

    
523
-- | Job Dependency type.
524
data JobDependency = JobDependency JobIdDep [FinalizedJobStatus]
525
                     deriving (Show, Eq)
526

    
527
instance JSON JobDependency where
528
  showJSON (JobDependency dep status) = showJSON (dep, status)
529
  readJSON = liftM (uncurry JobDependency) . readJSON
530

    
531
-- | Valid opcode priorities for submit.
532
$(THH.declareIADT "OpSubmitPriority"
533
  [ ("OpPrioLow",    'C.opPrioLow)
534
  , ("OpPrioNormal", 'C.opPrioNormal)
535
  , ("OpPrioHigh",   'C.opPrioHigh)
536
  ])
537
$(THH.makeJSONInstance ''OpSubmitPriority)
538

    
539
-- | Parse submit priorities from a string.
540
parseSubmitPriority :: (Monad m) => String -> m OpSubmitPriority
541
parseSubmitPriority "low"    = return OpPrioLow
542
parseSubmitPriority "normal" = return OpPrioNormal
543
parseSubmitPriority "high"   = return OpPrioHigh
544
parseSubmitPriority str      = fail $ "Unknown priority '" ++ str ++ "'"
545

    
546
-- | Format a submit priority as string.
547
fmtSubmitPriority :: OpSubmitPriority -> String
548
fmtSubmitPriority OpPrioLow    = "low"
549
fmtSubmitPriority OpPrioNormal = "normal"
550
fmtSubmitPriority OpPrioHigh   = "high"
551

    
552
-- | Our ADT for the OpCode status at runtime (while in a job).
553
$(THH.declareSADT "OpStatus"
554
  [ ("OP_STATUS_QUEUED",    'C.opStatusQueued)
555
  , ("OP_STATUS_WAITING",   'C.opStatusWaiting)
556
  , ("OP_STATUS_CANCELING", 'C.opStatusCanceling)
557
  , ("OP_STATUS_RUNNING",   'C.opStatusRunning)
558
  , ("OP_STATUS_CANCELED",  'C.opStatusCanceled)
559
  , ("OP_STATUS_SUCCESS",   'C.opStatusSuccess)
560
  , ("OP_STATUS_ERROR",     'C.opStatusError)
561
  ])
562
$(THH.makeJSONInstance ''OpStatus)
563

    
564
-- | Type for the job message type.
565
$(THH.declareSADT "ELogType"
566
  [ ("ELogMessage",      'C.elogMessage)
567
  , ("ELogRemoteImport", 'C.elogRemoteImport)
568
  , ("ELogJqueueTest",   'C.elogJqueueTest)
569
  ])
570
$(THH.makeJSONInstance ''ELogType)
571

    
572
-- | Type of one element of a reason trail.
573
type ReasonElem = (String, String, Integer)
574

    
575
-- | Type representing a reason trail.
576
type ReasonTrail = [ReasonElem]