Statistics
| Branch: | Tag: | Revision:

root / src / Ganeti / Types.hs @ 4fe04580

History | View | Annotate | Download (16 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
  , OobCommand(..)
64
  , StorageType(..)
65
  , NodeEvacMode(..)
66
  , FileDriver(..)
67
  , InstCreateMode(..)
68
  , RebootType(..)
69
  , ExportMode(..)
70
  , IAllocatorTestDir(..)
71
  , IAllocatorMode(..)
72
  , iAllocatorModeToRaw
73
  , NICMode(..)
74
  , nICModeToRaw
75
  , JobStatus(..)
76
  , jobStatusToRaw
77
  , jobStatusFromRaw
78
  , FinalizedJobStatus(..)
79
  , finalizedJobStatusToRaw
80
  , JobId
81
  , fromJobId
82
  , makeJobId
83
  , makeJobIdS
84
  , RelativeJobId
85
  , JobIdDep(..)
86
  , JobDependency(..)
87
  , OpSubmitPriority(..)
88
  , opSubmitPriorityToRaw
89
  , parseSubmitPriority
90
  , fmtSubmitPriority
91
  , OpStatus(..)
92
  , opStatusToRaw
93
  , opStatusFromRaw
94
  , ELogType(..)
95
  , ReasonElem
96
  , ReasonTrail
97
  ) where
98

    
99
import Control.Monad (liftM)
100
import qualified Text.JSON as JSON
101
import Text.JSON (JSON, readJSON, showJSON)
102
import Data.Ratio (numerator, denominator)
103

    
104
import qualified Ganeti.Constants as C
105
import qualified Ganeti.THH as THH
106
import Ganeti.JSON
107
import Ganeti.Utils
108

    
109
-- * Generic types
110

    
111
-- | Type that holds a non-negative value.
112
newtype NonNegative a = NonNegative { fromNonNegative :: a }
113
  deriving (Show, Eq)
114

    
115
-- | Smart constructor for 'NonNegative'.
116
mkNonNegative :: (Monad m, Num a, Ord a, Show a) => a -> m (NonNegative a)
117
mkNonNegative i | i >= 0 = return (NonNegative i)
118
                | otherwise = fail $ "Invalid value for non-negative type '" ++
119
                              show i ++ "'"
120

    
121
instance (JSON.JSON a, Num a, Ord a, Show a) => JSON.JSON (NonNegative a) where
122
  showJSON = JSON.showJSON . fromNonNegative
123
  readJSON v = JSON.readJSON v >>= mkNonNegative
124

    
125
-- | Type that holds a positive value.
126
newtype Positive a = Positive { fromPositive :: a }
127
  deriving (Show, Eq)
128

    
129
-- | Smart constructor for 'Positive'.
130
mkPositive :: (Monad m, Num a, Ord a, Show a) => a -> m (Positive a)
131
mkPositive i | i > 0 = return (Positive i)
132
             | otherwise = fail $ "Invalid value for positive type '" ++
133
                           show i ++ "'"
134

    
135
instance (JSON.JSON a, Num a, Ord a, Show a) => JSON.JSON (Positive a) where
136
  showJSON = JSON.showJSON . fromPositive
137
  readJSON v = JSON.readJSON v >>= mkPositive
138

    
139
-- | Type that holds a negative value.
140
newtype Negative a = Negative { fromNegative :: a }
141
  deriving (Show, Eq)
142

    
143
-- | Smart constructor for 'Negative'.
144
mkNegative :: (Monad m, Num a, Ord a, Show a) => a -> m (Negative a)
145
mkNegative i | i < 0 = return (Negative i)
146
             | otherwise = fail $ "Invalid value for negative type '" ++
147
                           show i ++ "'"
148

    
149
instance (JSON.JSON a, Num a, Ord a, Show a) => JSON.JSON (Negative a) where
150
  showJSON = JSON.showJSON . fromNegative
151
  readJSON v = JSON.readJSON v >>= mkNegative
152

    
153
-- | Type that holds a non-null list.
154
newtype NonEmpty a = NonEmpty { fromNonEmpty :: [a] }
155
  deriving (Show, Eq)
156

    
157
-- | Smart constructor for 'NonEmpty'.
158
mkNonEmpty :: (Monad m) => [a] -> m (NonEmpty a)
159
mkNonEmpty [] = fail "Received empty value for non-empty list"
160
mkNonEmpty xs = return (NonEmpty xs)
161

    
162
instance (JSON.JSON a) => JSON.JSON (NonEmpty a) where
163
  showJSON = JSON.showJSON . fromNonEmpty
164
  readJSON v = JSON.readJSON v >>= mkNonEmpty
165

    
166
-- | A simple type alias for non-empty strings.
167
type NonEmptyString = NonEmpty Char
168

    
169
-- * Ganeti types
170

    
171
-- | Instance disk template type.
172
$(THH.declareSADT "DiskTemplate"
173
       [ ("DTDiskless",   'C.dtDiskless)
174
       , ("DTFile",       'C.dtFile)
175
       , ("DTSharedFile", 'C.dtSharedFile)
176
       , ("DTPlain",      'C.dtPlain)
177
       , ("DTBlock",      'C.dtBlock)
178
       , ("DTDrbd8",      'C.dtDrbd8)
179
       , ("DTRbd",        'C.dtRbd)
180
       , ("DTExt",        'C.dtExt)
181
       ])
182
$(THH.makeJSONInstance ''DiskTemplate)
183

    
184
instance HasStringRepr DiskTemplate where
185
  fromStringRepr = diskTemplateFromRaw
186
  toStringRepr = diskTemplateToRaw
187

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

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

    
215
-- | Migration mode.
216
$(THH.declareSADT "MigrationMode"
217
     [ ("MigrationLive",    'C.htMigrationLive)
218
     , ("MigrationNonLive", 'C.htMigrationNonlive)
219
     ])
220
$(THH.makeJSONInstance ''MigrationMode)
221

    
222
-- | Verify optional checks.
223
$(THH.declareSADT "VerifyOptionalChecks"
224
     [ ("VerifyNPlusOneMem", 'C.verifyNplusoneMem)
225
     ])
226
$(THH.makeJSONInstance ''VerifyOptionalChecks)
227

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

    
265
-- | Dynamic device modification, just add\/remove version.
266
$(THH.declareSADT "DdmSimple"
267
     [ ("DdmSimpleAdd",    'C.ddmAdd)
268
     , ("DdmSimpleRemove", 'C.ddmRemove)
269
     ])
270
$(THH.makeJSONInstance ''DdmSimple)
271

    
272
-- | Dynamic device modification, all operations version.
273
$(THH.declareSADT "DdmFull"
274
     [ ("DdmFullAdd",    'C.ddmAdd)
275
     , ("DdmFullRemove", 'C.ddmRemove)
276
     , ("DdmFullModify", 'C.ddmModify)
277
     ])
278
$(THH.makeJSONInstance ''DdmFull)
279

    
280
-- | Hypervisor type definitions.
281
$(THH.declareSADT "Hypervisor"
282
  [ ( "Kvm",    'C.htKvm )
283
  , ( "XenPvm", 'C.htXenPvm )
284
  , ( "Chroot", 'C.htChroot )
285
  , ( "XenHvm", 'C.htXenHvm )
286
  , ( "Lxc",    'C.htLxc )
287
  , ( "Fake",   'C.htFake )
288
  ])
289
$(THH.makeJSONInstance ''Hypervisor)
290

    
291
-- | Oob command type.
292
$(THH.declareSADT "OobCommand"
293
  [ ("OobHealth",      'C.oobHealth)
294
  , ("OobPowerCycle",  'C.oobPowerCycle)
295
  , ("OobPowerOff",    'C.oobPowerOff)
296
  , ("OobPowerOn",     'C.oobPowerOn)
297
  , ("OobPowerStatus", 'C.oobPowerStatus)
298
  ])
299
$(THH.makeJSONInstance ''OobCommand)
300

    
301
-- | Storage type.
302
$(THH.declareSADT "StorageType"
303
  [ ("StorageFile", 'C.stFile)
304
  , ("StorageLvmPv", 'C.stLvmPv)
305
  , ("StorageLvmVg", 'C.stLvmVg)
306
  , ("StorageDiskless", 'C.stDiskless)
307
  , ("StorageBlock", 'C.stBlock)
308
  , ("StorageRados", 'C.stRados)
309
  , ("StorageExt", 'C.stExt)
310
  ])
311
$(THH.makeJSONInstance ''StorageType)
312

    
313
-- | Node evac modes.
314
$(THH.declareSADT "NodeEvacMode"
315
  [ ("NEvacPrimary",   'C.iallocatorNevacPri)
316
  , ("NEvacSecondary", 'C.iallocatorNevacSec)
317
  , ("NEvacAll",       'C.iallocatorNevacAll)
318
  ])
319
$(THH.makeJSONInstance ''NodeEvacMode)
320

    
321
-- | The file driver type.
322
$(THH.declareSADT "FileDriver"
323
  [ ("FileLoop",   'C.fdLoop)
324
  , ("FileBlktap", 'C.fdBlktap)
325
  ])
326
$(THH.makeJSONInstance ''FileDriver)
327

    
328
-- | The instance create mode.
329
$(THH.declareSADT "InstCreateMode"
330
  [ ("InstCreate",       'C.instanceCreate)
331
  , ("InstImport",       'C.instanceImport)
332
  , ("InstRemoteImport", 'C.instanceRemoteImport)
333
  ])
334
$(THH.makeJSONInstance ''InstCreateMode)
335

    
336
-- | Reboot type.
337
$(THH.declareSADT "RebootType"
338
  [ ("RebootSoft", 'C.instanceRebootSoft)
339
  , ("RebootHard", 'C.instanceRebootHard)
340
  , ("RebootFull", 'C.instanceRebootFull)
341
  ])
342
$(THH.makeJSONInstance ''RebootType)
343

    
344
-- | Export modes.
345
$(THH.declareSADT "ExportMode"
346
  [ ("ExportModeLocal",  'C.exportModeLocal)
347
  , ("ExportModeRemove", 'C.exportModeRemote)
348
  ])
349
$(THH.makeJSONInstance ''ExportMode)
350

    
351
-- | IAllocator run types (OpTestIAllocator).
352
$(THH.declareSADT "IAllocatorTestDir"
353
  [ ("IAllocatorDirIn",  'C.iallocatorDirIn)
354
  , ("IAllocatorDirOut", 'C.iallocatorDirOut)
355
  ])
356
$(THH.makeJSONInstance ''IAllocatorTestDir)
357

    
358
-- | IAllocator mode. FIXME: use this in "HTools.Backend.IAlloc".
359
$(THH.declareSADT "IAllocatorMode"
360
  [ ("IAllocatorAlloc",       'C.iallocatorModeAlloc)
361
  , ("IAllocatorMultiAlloc",  'C.iallocatorModeMultiAlloc)
362
  , ("IAllocatorReloc",       'C.iallocatorModeReloc)
363
  , ("IAllocatorNodeEvac",    'C.iallocatorModeNodeEvac)
364
  , ("IAllocatorChangeGroup", 'C.iallocatorModeChgGroup)
365
  ])
366
$(THH.makeJSONInstance ''IAllocatorMode)
367

    
368
-- | Network mode.
369
$(THH.declareSADT "NICMode"
370
  [ ("NMBridged", 'C.nicModeBridged)
371
  , ("NMRouted",  'C.nicModeRouted)
372
  , ("NMOvs",     'C.nicModeOvs)
373
  ])
374
$(THH.makeJSONInstance ''NICMode)
375

    
376
-- | The JobStatus data type. Note that this is ordered especially
377
-- such that greater\/lesser comparison on values of this type makes
378
-- sense.
379
$(THH.declareSADT "JobStatus"
380
       [ ("JOB_STATUS_QUEUED",    'C.jobStatusQueued)
381
       , ("JOB_STATUS_WAITING",   'C.jobStatusWaiting)
382
       , ("JOB_STATUS_CANCELING", 'C.jobStatusCanceling)
383
       , ("JOB_STATUS_RUNNING",   'C.jobStatusRunning)
384
       , ("JOB_STATUS_CANCELED",  'C.jobStatusCanceled)
385
       , ("JOB_STATUS_SUCCESS",   'C.jobStatusSuccess)
386
       , ("JOB_STATUS_ERROR",     'C.jobStatusError)
387
       ])
388
$(THH.makeJSONInstance ''JobStatus)
389

    
390
-- | Finalized job status.
391
$(THH.declareSADT "FinalizedJobStatus"
392
  [ ("JobStatusCanceled",   'C.jobStatusCanceled)
393
  , ("JobStatusSuccessful", 'C.jobStatusSuccess)
394
  , ("JobStatusFailed",     'C.jobStatusError)
395
  ])
396
$(THH.makeJSONInstance ''FinalizedJobStatus)
397

    
398
-- | The Ganeti job type.
399
newtype JobId = JobId { fromJobId :: Int }
400
  deriving (Show, Eq)
401

    
402
-- | Builds a job ID.
403
makeJobId :: (Monad m) => Int -> m JobId
404
makeJobId i | i >= 0 = return $ JobId i
405
            | otherwise = fail $ "Invalid value for job ID ' " ++ show i ++ "'"
406

    
407
-- | Builds a job ID from a string.
408
makeJobIdS :: (Monad m) => String -> m JobId
409
makeJobIdS s = tryRead "parsing job id" s >>= makeJobId
410

    
411
-- | Parses a job ID.
412
parseJobId :: (Monad m) => JSON.JSValue -> m JobId
413
parseJobId (JSON.JSString x) = makeJobIdS $ JSON.fromJSString x
414
parseJobId (JSON.JSRational _ x) =
415
  if denominator x /= 1
416
    then fail $ "Got fractional job ID from master daemon?! Value:" ++ show x
417
    -- FIXME: potential integer overflow here on 32-bit platforms
418
    else makeJobId . fromIntegral . numerator $ x
419
parseJobId x = fail $ "Wrong type/value for job id: " ++ show x
420

    
421
instance JSON.JSON JobId where
422
  showJSON = JSON.showJSON . fromJobId
423
  readJSON = parseJobId
424

    
425
-- | Relative job ID type alias.
426
type RelativeJobId = Negative Int
427

    
428
-- | Job ID dependency.
429
data JobIdDep = JobDepRelative RelativeJobId
430
              | JobDepAbsolute JobId
431
                deriving (Show, Eq)
432

    
433
instance JSON.JSON JobIdDep where
434
  showJSON (JobDepRelative i) = showJSON i
435
  showJSON (JobDepAbsolute i) = showJSON i
436
  readJSON v =
437
    case JSON.readJSON v::JSON.Result (Negative Int) of
438
      -- first try relative dependency, usually most common
439
      JSON.Ok r -> return $ JobDepRelative r
440
      JSON.Error _ -> liftM JobDepAbsolute (parseJobId v)
441

    
442
-- | Job Dependency type.
443
data JobDependency = JobDependency JobIdDep [FinalizedJobStatus]
444
                     deriving (Show, Eq)
445

    
446
instance JSON JobDependency where
447
  showJSON (JobDependency dep status) = showJSON (dep, status)
448
  readJSON = liftM (uncurry JobDependency) . readJSON
449

    
450
-- | Valid opcode priorities for submit.
451
$(THH.declareIADT "OpSubmitPriority"
452
  [ ("OpPrioLow",    'C.opPrioLow)
453
  , ("OpPrioNormal", 'C.opPrioNormal)
454
  , ("OpPrioHigh",   'C.opPrioHigh)
455
  ])
456
$(THH.makeJSONInstance ''OpSubmitPriority)
457

    
458
-- | Parse submit priorities from a string.
459
parseSubmitPriority :: (Monad m) => String -> m OpSubmitPriority
460
parseSubmitPriority "low"    = return OpPrioLow
461
parseSubmitPriority "normal" = return OpPrioNormal
462
parseSubmitPriority "high"   = return OpPrioHigh
463
parseSubmitPriority str      = fail $ "Unknown priority '" ++ str ++ "'"
464

    
465
-- | Format a submit priority as string.
466
fmtSubmitPriority :: OpSubmitPriority -> String
467
fmtSubmitPriority OpPrioLow    = "low"
468
fmtSubmitPriority OpPrioNormal = "normal"
469
fmtSubmitPriority OpPrioHigh   = "high"
470

    
471
-- | Our ADT for the OpCode status at runtime (while in a job).
472
$(THH.declareSADT "OpStatus"
473
  [ ("OP_STATUS_QUEUED",    'C.opStatusQueued)
474
  , ("OP_STATUS_WAITING",   'C.opStatusWaiting)
475
  , ("OP_STATUS_CANCELING", 'C.opStatusCanceling)
476
  , ("OP_STATUS_RUNNING",   'C.opStatusRunning)
477
  , ("OP_STATUS_CANCELED",  'C.opStatusCanceled)
478
  , ("OP_STATUS_SUCCESS",   'C.opStatusSuccess)
479
  , ("OP_STATUS_ERROR",     'C.opStatusError)
480
  ])
481
$(THH.makeJSONInstance ''OpStatus)
482

    
483
-- | Type for the job message type.
484
$(THH.declareSADT "ELogType"
485
  [ ("ELogMessage",      'C.elogMessage)
486
  , ("ELogRemoteImport", 'C.elogRemoteImport)
487
  , ("ELogJqueueTest",   'C.elogJqueueTest)
488
  ])
489
$(THH.makeJSONInstance ''ELogType)
490

    
491
-- | Type of one element of a reason trail.
492
type ReasonElem = (String, String, Integer)
493

    
494
-- | Type representing a reason trail.
495
type ReasonTrail = [ReasonElem]