Statistics
| Branch: | Tag: | Revision:

root / htools / Ganeti / Types.hs @ 497beee2

History | View | Annotate | Download (10.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 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
  , NonEmpty
50
  , fromNonEmpty
51
  , mkNonEmpty
52
  , NonEmptyString
53
  , MigrationMode(..)
54
  , VerifyOptionalChecks(..)
55
  , DdmSimple(..)
56
  , DdmFull(..)
57
  , CVErrorCode(..)
58
  , cVErrorCodeToRaw
59
  , Hypervisor(..)
60
  , OobCommand(..)
61
  , StorageType(..)
62
  , NodeEvacMode(..)
63
  , FileDriver(..)
64
  , InstCreateMode(..)
65
  , RebootType(..)
66
  , ExportMode(..)
67
  , IAllocatorTestDir(..)
68
  , IAllocatorMode(..)
69
  , iAllocatorModeToRaw
70
  , NICMode(..)
71
  , nICModeToRaw
72
  ) where
73

    
74
import qualified Text.JSON as JSON
75

    
76
import qualified Ganeti.Constants as C
77
import qualified Ganeti.THH as THH
78
import Ganeti.JSON
79

    
80
-- * Generic types
81

    
82
-- | Type that holds a non-negative value.
83
newtype NonNegative a = NonNegative { fromNonNegative :: a }
84
  deriving (Show, Read, Eq)
85

    
86
-- | Smart constructor for 'NonNegative'.
87
mkNonNegative :: (Monad m, Num a, Ord a, Show a) => a -> m (NonNegative a)
88
mkNonNegative i | i >= 0 = return (NonNegative i)
89
                | otherwise = fail $ "Invalid value for non-negative type '" ++
90
                              show i ++ "'"
91

    
92
instance (JSON.JSON a, Num a, Ord a, Show a) => JSON.JSON (NonNegative a) where
93
  showJSON = JSON.showJSON . fromNonNegative
94
  readJSON v = JSON.readJSON v >>= mkNonNegative
95

    
96
-- | Type that holds a positive value.
97
newtype Positive a = Positive { fromPositive :: a }
98
  deriving (Show, Read, Eq)
99

    
100
-- | Smart constructor for 'Positive'.
101
mkPositive :: (Monad m, Num a, Ord a, Show a) => a -> m (Positive a)
102
mkPositive i | i > 0 = return (Positive i)
103
             | otherwise = fail $ "Invalid value for positive type '" ++
104
                           show i ++ "'"
105

    
106
instance (JSON.JSON a, Num a, Ord a, Show a) => JSON.JSON (Positive a) where
107
  showJSON = JSON.showJSON . fromPositive
108
  readJSON v = JSON.readJSON v >>= mkPositive
109

    
110
-- | Type that holds a non-null list.
111
newtype NonEmpty a = NonEmpty { fromNonEmpty :: [a] }
112
  deriving (Show, Read, Eq)
113

    
114
-- | Smart constructor for 'NonEmpty'.
115
mkNonEmpty :: (Monad m) => [a] -> m (NonEmpty a)
116
mkNonEmpty [] = fail "Received empty value for non-empty list"
117
mkNonEmpty xs = return (NonEmpty xs)
118

    
119
instance (JSON.JSON a) => JSON.JSON (NonEmpty a) where
120
  showJSON = JSON.showJSON . fromNonEmpty
121
  readJSON v = JSON.readJSON v >>= mkNonEmpty
122

    
123
-- | A simple type alias for non-empty strings.
124
type NonEmptyString = NonEmpty Char
125

    
126
-- * Ganeti types
127

    
128
-- | Instance disk template type.
129
$(THH.declareSADT "DiskTemplate"
130
       [ ("DTDiskless",   'C.dtDiskless)
131
       , ("DTFile",       'C.dtFile)
132
       , ("DTSharedFile", 'C.dtSharedFile)
133
       , ("DTPlain",      'C.dtPlain)
134
       , ("DTBlock",      'C.dtBlock)
135
       , ("DTDrbd8",      'C.dtDrbd8)
136
       , ("DTRbd",        'C.dtRbd)
137
       ])
138
$(THH.makeJSONInstance ''DiskTemplate)
139

    
140
instance HasStringRepr DiskTemplate where
141
  fromStringRepr = diskTemplateFromRaw
142
  toStringRepr = diskTemplateToRaw
143

    
144
-- | The Group allocation policy type.
145
--
146
-- Note that the order of constructors is important as the automatic
147
-- Ord instance will order them in the order they are defined, so when
148
-- changing this data type be careful about the interaction with the
149
-- desired sorting order.
150
$(THH.declareSADT "AllocPolicy"
151
       [ ("AllocPreferred",   'C.allocPolicyPreferred)
152
       , ("AllocLastResort",  'C.allocPolicyLastResort)
153
       , ("AllocUnallocable", 'C.allocPolicyUnallocable)
154
       ])
155
$(THH.makeJSONInstance ''AllocPolicy)
156

    
157
-- | The Instance real state type. FIXME: this could be improved to
158
-- just wrap a /NormalState AdminStatus | ErrorState ErrorCondition/.
159
$(THH.declareSADT "InstanceStatus"
160
       [ ("StatusDown",    'C.inststAdmindown)
161
       , ("StatusOffline", 'C.inststAdminoffline)
162
       , ("ErrorDown",     'C.inststErrordown)
163
       , ("ErrorUp",       'C.inststErrorup)
164
       , ("NodeDown",      'C.inststNodedown)
165
       , ("NodeOffline",   'C.inststNodeoffline)
166
       , ("Running",       'C.inststRunning)
167
       , ("WrongNode",     'C.inststWrongnode)
168
       ])
169
$(THH.makeJSONInstance ''InstanceStatus)
170

    
171
-- | Migration mode.
172
$(THH.declareSADT "MigrationMode"
173
     [ ("MigrationLive",    'C.htMigrationLive)
174
     , ("MigrationNonLive", 'C.htMigrationNonlive)
175
     ])
176
$(THH.makeJSONInstance ''MigrationMode)
177

    
178
-- | Verify optional checks.
179
$(THH.declareSADT "VerifyOptionalChecks"
180
     [ ("VerifyNPlusOneMem", 'C.verifyNplusoneMem)
181
     ])
182
$(THH.makeJSONInstance ''VerifyOptionalChecks)
183

    
184
-- | Cluster verify error codes.
185
$(THH.declareSADT "CVErrorCode"
186
  [ ("CvECLUSTERCFG",           'C.cvEclustercfgCode)
187
  , ("CvECLUSTERCERT",          'C.cvEclustercertCode)
188
  , ("CvECLUSTERFILECHECK",     'C.cvEclusterfilecheckCode)
189
  , ("CvECLUSTERDANGLINGNODES", 'C.cvEclusterdanglingnodesCode)
190
  , ("CvECLUSTERDANGLINGINST",  'C.cvEclusterdanglinginstCode)
191
  , ("CvEINSTANCEBADNODE",      'C.cvEinstancebadnodeCode)
192
  , ("CvEINSTANCEDOWN",         'C.cvEinstancedownCode)
193
  , ("CvEINSTANCELAYOUT",       'C.cvEinstancelayoutCode)
194
  , ("CvEINSTANCEMISSINGDISK",  'C.cvEinstancemissingdiskCode)
195
  , ("CvEINSTANCEFAULTYDISK",   'C.cvEinstancefaultydiskCode)
196
  , ("CvEINSTANCEWRONGNODE",    'C.cvEinstancewrongnodeCode)
197
  , ("CvEINSTANCESPLITGROUPS",  'C.cvEinstancesplitgroupsCode)
198
  , ("CvEINSTANCEPOLICY",       'C.cvEinstancepolicyCode)
199
  , ("CvENODEDRBD",             'C.cvEnodedrbdCode)
200
  , ("CvENODEDRBDHELPER",       'C.cvEnodedrbdhelperCode)
201
  , ("CvENODEFILECHECK",        'C.cvEnodefilecheckCode)
202
  , ("CvENODEHOOKS",            'C.cvEnodehooksCode)
203
  , ("CvENODEHV",               'C.cvEnodehvCode)
204
  , ("CvENODELVM",              'C.cvEnodelvmCode)
205
  , ("CvENODEN1",               'C.cvEnoden1Code)
206
  , ("CvENODENET",              'C.cvEnodenetCode)
207
  , ("CvENODEOS",               'C.cvEnodeosCode)
208
  , ("CvENODEORPHANINSTANCE",   'C.cvEnodeorphaninstanceCode)
209
  , ("CvENODEORPHANLV",         'C.cvEnodeorphanlvCode)
210
  , ("CvENODERPC",              'C.cvEnoderpcCode)
211
  , ("CvENODESSH",              'C.cvEnodesshCode)
212
  , ("CvENODEVERSION",          'C.cvEnodeversionCode)
213
  , ("CvENODESETUP",            'C.cvEnodesetupCode)
214
  , ("CvENODETIME",             'C.cvEnodetimeCode)
215
  , ("CvENODEOOBPATH",          'C.cvEnodeoobpathCode)
216
  , ("CvENODEUSERSCRIPTS",      'C.cvEnodeuserscriptsCode)
217
  , ("CvENODEFILESTORAGEPATHS", 'C.cvEnodefilestoragepathsCode)
218
  ])
219
$(THH.makeJSONInstance ''CVErrorCode)
220

    
221
-- | Dynamic device modification, just add\/remove version.
222
$(THH.declareSADT "DdmSimple"
223
     [ ("DdmSimpleAdd",    'C.ddmAdd)
224
     , ("DdmSimpleRemove", 'C.ddmRemove)
225
     ])
226
$(THH.makeJSONInstance ''DdmSimple)
227

    
228
-- | Dynamic device modification, all operations version.
229
$(THH.declareSADT "DdmFull"
230
     [ ("DdmFullAdd",    'C.ddmAdd)
231
     , ("DdmFullRemove", 'C.ddmRemove)
232
     , ("DdmFullModify", 'C.ddmModify)
233
     ])
234
$(THH.makeJSONInstance ''DdmFull)
235

    
236
-- | Hypervisor type definitions.
237
$(THH.declareSADT "Hypervisor"
238
  [ ( "Kvm",    'C.htKvm )
239
  , ( "XenPvm", 'C.htXenPvm )
240
  , ( "Chroot", 'C.htChroot )
241
  , ( "XenHvm", 'C.htXenHvm )
242
  , ( "Lxc",    'C.htLxc )
243
  , ( "Fake",   'C.htFake )
244
  ])
245
$(THH.makeJSONInstance ''Hypervisor)
246

    
247
-- | Oob command type.
248
$(THH.declareSADT "OobCommand"
249
  [ ("OobHealth",      'C.oobHealth)
250
  , ("OobPowerCycle",  'C.oobPowerCycle)
251
  , ("OobPowerOff",    'C.oobPowerOff)
252
  , ("OobPowerOn",     'C.oobPowerOn)
253
  , ("OobPowerStatus", 'C.oobPowerStatus)
254
  ])
255
$(THH.makeJSONInstance ''OobCommand)
256

    
257
-- | Storage type.
258
$(THH.declareSADT "StorageType"
259
  [ ("StorageFile", 'C.stFile)
260
  , ("StorageLvmPv", 'C.stLvmPv)
261
  , ("StorageLvmVg", 'C.stLvmVg)
262
  ])
263
$(THH.makeJSONInstance ''StorageType)
264

    
265
-- | Node evac modes.
266
$(THH.declareSADT "NodeEvacMode"
267
  [ ("NEvacPrimary",   'C.iallocatorNevacPri)
268
  , ("NEvacSecondary", 'C.iallocatorNevacSec)
269
  , ("NEvacAll",       'C.iallocatorNevacAll)
270
  ])
271
$(THH.makeJSONInstance ''NodeEvacMode)
272

    
273
-- | The file driver type.
274
$(THH.declareSADT "FileDriver"
275
  [ ("FileLoop",   'C.fdLoop)
276
  , ("FileBlktap", 'C.fdBlktap)
277
  ])
278
$(THH.makeJSONInstance ''FileDriver)
279

    
280
-- | The instance create mode.
281
$(THH.declareSADT "InstCreateMode"
282
  [ ("InstCreate",       'C.instanceCreate)
283
  , ("InstImport",       'C.instanceImport)
284
  , ("InstRemoteImport", 'C.instanceRemoteImport)
285
  ])
286
$(THH.makeJSONInstance ''InstCreateMode)
287

    
288
-- | Reboot type.
289
$(THH.declareSADT "RebootType"
290
  [ ("RebootSoft", 'C.instanceRebootSoft)
291
  , ("RebootHard", 'C.instanceRebootHard)
292
  , ("RebootFull", 'C.instanceRebootFull)
293
  ])
294
$(THH.makeJSONInstance ''RebootType)
295

    
296
-- | Export modes.
297
$(THH.declareSADT "ExportMode"
298
  [ ("ExportModeLocal",  'C.exportModeLocal)
299
  , ("ExportModeRemove", 'C.exportModeRemote)
300
  ])
301
$(THH.makeJSONInstance ''ExportMode)
302

    
303
-- | IAllocator run types (OpTestIAllocator).
304
$(THH.declareSADT "IAllocatorTestDir"
305
  [ ("IAllocatorDirIn",  'C.iallocatorDirIn)
306
  , ("IAllocatorDirOut", 'C.iallocatorDirOut)
307
  ])
308
$(THH.makeJSONInstance ''IAllocatorTestDir)
309

    
310
-- | IAllocator mode. FIXME: use this in "HTools.Backend.IAlloc".
311
$(THH.declareSADT "IAllocatorMode"
312
  [ ("IAllocatorAlloc",       'C.iallocatorModeAlloc)
313
  , ("IAllocatorMultiAlloc",  'C.iallocatorModeMultiAlloc)
314
  , ("IAllocatorReloc",       'C.iallocatorModeReloc)
315
  , ("IAllocatorNodeEvac",    'C.iallocatorModeNodeEvac)
316
  , ("IAllocatorChangeGroup", 'C.iallocatorModeChgGroup)
317
  ])
318
$(THH.makeJSONInstance ''IAllocatorMode)
319

    
320
-- | Netork mode.
321
$(THH.declareSADT "NICMode"
322
  [ ("NMBridged", 'C.nicModeBridged)
323
  , ("NMRouted",  'C.nicModeRouted)
324
  ])
325
$(THH.makeJSONInstance ''NICMode)