Statistics
| Branch: | Tag: | Revision:

root / src / Ganeti / Types.hs @ 37fe56e0

History | View | Annotate | Download (15.7 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
  ) where
96

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

    
102
import qualified Ganeti.Constants as C
103
import qualified Ganeti.THH as THH
104
import Ganeti.JSON
105
import Ganeti.Utils
106

    
107
-- * Generic types
108

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

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

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

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

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

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

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

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

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

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

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

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

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

    
167
-- * Ganeti types
168

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

    
182
instance HasStringRepr DiskTemplate where
183
  fromStringRepr = diskTemplateFromRaw
184
  toStringRepr = diskTemplateToRaw
185

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

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

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

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

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

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

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

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

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

    
299
-- | Storage type.
300
$(THH.declareSADT "StorageType"
301
  [ ("StorageFile", 'C.stFile)
302
  , ("StorageLvmPv", 'C.stLvmPv)
303
  , ("StorageLvmVg", 'C.stLvmVg)
304
  ])
305
$(THH.makeJSONInstance ''StorageType)
306

    
307
-- | Node evac modes.
308
$(THH.declareSADT "NodeEvacMode"
309
  [ ("NEvacPrimary",   'C.iallocatorNevacPri)
310
  , ("NEvacSecondary", 'C.iallocatorNevacSec)
311
  , ("NEvacAll",       'C.iallocatorNevacAll)
312
  ])
313
$(THH.makeJSONInstance ''NodeEvacMode)
314

    
315
-- | The file driver type.
316
$(THH.declareSADT "FileDriver"
317
  [ ("FileLoop",   'C.fdLoop)
318
  , ("FileBlktap", 'C.fdBlktap)
319
  ])
320
$(THH.makeJSONInstance ''FileDriver)
321

    
322
-- | The instance create mode.
323
$(THH.declareSADT "InstCreateMode"
324
  [ ("InstCreate",       'C.instanceCreate)
325
  , ("InstImport",       'C.instanceImport)
326
  , ("InstRemoteImport", 'C.instanceRemoteImport)
327
  ])
328
$(THH.makeJSONInstance ''InstCreateMode)
329

    
330
-- | Reboot type.
331
$(THH.declareSADT "RebootType"
332
  [ ("RebootSoft", 'C.instanceRebootSoft)
333
  , ("RebootHard", 'C.instanceRebootHard)
334
  , ("RebootFull", 'C.instanceRebootFull)
335
  ])
336
$(THH.makeJSONInstance ''RebootType)
337

    
338
-- | Export modes.
339
$(THH.declareSADT "ExportMode"
340
  [ ("ExportModeLocal",  'C.exportModeLocal)
341
  , ("ExportModeRemove", 'C.exportModeRemote)
342
  ])
343
$(THH.makeJSONInstance ''ExportMode)
344

    
345
-- | IAllocator run types (OpTestIAllocator).
346
$(THH.declareSADT "IAllocatorTestDir"
347
  [ ("IAllocatorDirIn",  'C.iallocatorDirIn)
348
  , ("IAllocatorDirOut", 'C.iallocatorDirOut)
349
  ])
350
$(THH.makeJSONInstance ''IAllocatorTestDir)
351

    
352
-- | IAllocator mode. FIXME: use this in "HTools.Backend.IAlloc".
353
$(THH.declareSADT "IAllocatorMode"
354
  [ ("IAllocatorAlloc",       'C.iallocatorModeAlloc)
355
  , ("IAllocatorMultiAlloc",  'C.iallocatorModeMultiAlloc)
356
  , ("IAllocatorReloc",       'C.iallocatorModeReloc)
357
  , ("IAllocatorNodeEvac",    'C.iallocatorModeNodeEvac)
358
  , ("IAllocatorChangeGroup", 'C.iallocatorModeChgGroup)
359
  ])
360
$(THH.makeJSONInstance ''IAllocatorMode)
361

    
362
-- | Netork mode.
363
$(THH.declareSADT "NICMode"
364
  [ ("NMBridged", 'C.nicModeBridged)
365
  , ("NMRouted",  'C.nicModeRouted)
366
  , ("NMOvs",     'C.nicModeOvs)
367
  ])
368
$(THH.makeJSONInstance ''NICMode)
369

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

    
384
-- | Finalized job status.
385
$(THH.declareSADT "FinalizedJobStatus"
386
  [ ("JobStatusCanceled",   'C.jobStatusCanceled)
387
  , ("JobStatusSuccessful", 'C.jobStatusSuccess)
388
  , ("JobStatusFailed",     'C.jobStatusError)
389
  ])
390
$(THH.makeJSONInstance ''FinalizedJobStatus)
391

    
392
-- | The Ganeti job type.
393
newtype JobId = JobId { fromJobId :: Int }
394
  deriving (Show, Eq)
395

    
396
-- | Builds a job ID.
397
makeJobId :: (Monad m) => Int -> m JobId
398
makeJobId i | i >= 0 = return $ JobId i
399
            | otherwise = fail $ "Invalid value for job ID ' " ++ show i ++ "'"
400

    
401
-- | Builds a job ID from a string.
402
makeJobIdS :: (Monad m) => String -> m JobId
403
makeJobIdS s = tryRead "parsing job id" s >>= makeJobId
404

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

    
415
instance JSON.JSON JobId where
416
  showJSON = JSON.showJSON . fromJobId
417
  readJSON = parseJobId
418

    
419
-- | Relative job ID type alias.
420
type RelativeJobId = Negative Int
421

    
422
-- | Job ID dependency.
423
data JobIdDep = JobDepRelative RelativeJobId
424
              | JobDepAbsolute JobId
425
                deriving (Show, Eq)
426

    
427
instance JSON.JSON JobIdDep where
428
  showJSON (JobDepRelative i) = showJSON i
429
  showJSON (JobDepAbsolute i) = showJSON i
430
  readJSON v =
431
    case JSON.readJSON v::JSON.Result (Negative Int) of
432
      -- first try relative dependency, usually most common
433
      JSON.Ok r -> return $ JobDepRelative r
434
      JSON.Error _ -> liftM JobDepAbsolute (parseJobId v)
435

    
436
-- | Job Dependency type.
437
data JobDependency = JobDependency JobIdDep [FinalizedJobStatus]
438
                     deriving (Show, Eq)
439

    
440
instance JSON JobDependency where
441
  showJSON (JobDependency dep status) = showJSON (dep, status)
442
  readJSON = liftM (uncurry JobDependency) . readJSON
443

    
444
-- | Valid opcode priorities for submit.
445
$(THH.declareIADT "OpSubmitPriority"
446
  [ ("OpPrioLow",    'C.opPrioLow)
447
  , ("OpPrioNormal", 'C.opPrioNormal)
448
  , ("OpPrioHigh",   'C.opPrioHigh)
449
  ])
450
$(THH.makeJSONInstance ''OpSubmitPriority)
451

    
452
-- | Parse submit priorities from a string.
453
parseSubmitPriority :: (Monad m) => String -> m OpSubmitPriority
454
parseSubmitPriority "low"    = return OpPrioLow
455
parseSubmitPriority "normal" = return OpPrioNormal
456
parseSubmitPriority "high"   = return OpPrioHigh
457
parseSubmitPriority str      = fail $ "Unknown priority '" ++ str ++ "'"
458

    
459
-- | Format a submit priority as string.
460
fmtSubmitPriority :: OpSubmitPriority -> String
461
fmtSubmitPriority OpPrioLow    = "low"
462
fmtSubmitPriority OpPrioNormal = "normal"
463
fmtSubmitPriority OpPrioHigh   = "high"
464

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

    
477
-- | Type for the job message type.
478
$(THH.declareSADT "ELogType"
479
  [ ("ELogMessage",      'C.elogMessage)
480
  , ("ELogRemoteImport", 'C.elogRemoteImport)
481
  , ("ELogJqueueTest",   'C.elogJqueueTest)
482
  ])
483
$(THH.makeJSONInstance ''ELogType)