Statistics
| Branch: | Tag: | Revision:

root / htools / Ganeti / Types.hs @ fd958a3d

History | View | Annotate | Download (15.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 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
  , NetworkType(..)
74
  , networkTypeToRaw
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
  , 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
       ])
179
$(THH.makeJSONInstance ''DiskTemplate)
180

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

    
361
-- | Network type.
362
$(THH.declareSADT "NetworkType"
363
  [ ("PrivateNetwork", 'C.networkTypePrivate)
364
  , ("PublicNetwork",  'C.networkTypePublic)
365
  ])
366
$(THH.makeJSONInstance ''NetworkType)
367

    
368
-- | Netork 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
441
                      (fromJResult "parsing absolute job id" (readJSON v) >>=
442
                       makeJobId)
443

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

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

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

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

    
472
-- | Type for the job message type.
473
$(THH.declareSADT "ELogType"
474
  [ ("ELogMessage",      'C.elogMessage)
475
  , ("ELogRemoteImport", 'C.elogRemoteImport)
476
  , ("ELogJqueueTest",   'C.elogJqueueTest)
477
  ])
478
$(THH.makeJSONInstance ''ELogType)