Statistics
| Branch: | Tag: | Revision:

root / htools / Ganeti / Types.hs @ 22381768

History | View | Annotate | Download (7.6 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
  , MigrationMode(..)
53
  , VerifyOptionalChecks(..)
54
  , DdmSimple(..)
55
  , CVErrorCode(..)
56
  , cVErrorCodeToRaw
57
  , Hypervisor(..)
58
  ) where
59

    
60
import qualified Text.JSON as JSON
61

    
62
import qualified Ganeti.Constants as C
63
import qualified Ganeti.THH as THH
64
import Ganeti.JSON
65

    
66
-- * Generic types
67

    
68
-- | Type that holds a non-negative value.
69
newtype NonNegative a = NonNegative { fromNonNegative :: a }
70
  deriving (Show, Read, Eq)
71

    
72
-- | Smart constructor for 'NonNegative'.
73
mkNonNegative :: (Monad m, Num a, Ord a, Show a) => a -> m (NonNegative a)
74
mkNonNegative i | i >= 0 = return (NonNegative i)
75
                | otherwise = fail $ "Invalid value for non-negative type '" ++
76
                              show i ++ "'"
77

    
78
instance (JSON.JSON a, Num a, Ord a, Show a) => JSON.JSON (NonNegative a) where
79
  showJSON = JSON.showJSON . fromNonNegative
80
  readJSON v = JSON.readJSON v >>= mkNonNegative
81

    
82
-- | Type that holds a positive value.
83
newtype Positive a = Positive { fromPositive :: a }
84
  deriving (Show, Read, Eq)
85

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

    
92
instance (JSON.JSON a, Num a, Ord a, Show a) => JSON.JSON (Positive a) where
93
  showJSON = JSON.showJSON . fromPositive
94
  readJSON v = JSON.readJSON v >>= mkPositive
95

    
96
-- | Type that holds a non-null list.
97
newtype NonEmpty a = NonEmpty { fromNonEmpty :: [a] }
98
  deriving (Show, Read, Eq)
99

    
100
-- | Smart constructor for 'NonEmpty'.
101
mkNonEmpty :: (Monad m) => [a] -> m (NonEmpty a)
102
mkNonEmpty [] = fail "Received empty value for non-empty list"
103
mkNonEmpty xs = return (NonEmpty xs)
104

    
105
instance (JSON.JSON a) => JSON.JSON (NonEmpty a) where
106
  showJSON = JSON.showJSON . fromNonEmpty
107
  readJSON v = JSON.readJSON v >>= mkNonEmpty
108

    
109
-- * Ganeti types
110

    
111
-- | Instance disk template type.
112
$(THH.declareSADT "DiskTemplate"
113
       [ ("DTDiskless",   'C.dtDiskless)
114
       , ("DTFile",       'C.dtFile)
115
       , ("DTSharedFile", 'C.dtSharedFile)
116
       , ("DTPlain",      'C.dtPlain)
117
       , ("DTBlock",      'C.dtBlock)
118
       , ("DTDrbd8",      'C.dtDrbd8)
119
       , ("DTRbd",        'C.dtRbd)
120
       ])
121
$(THH.makeJSONInstance ''DiskTemplate)
122

    
123
instance HasStringRepr DiskTemplate where
124
  fromStringRepr = diskTemplateFromRaw
125
  toStringRepr = diskTemplateToRaw
126

    
127
-- | The Group allocation policy type.
128
--
129
-- Note that the order of constructors is important as the automatic
130
-- Ord instance will order them in the order they are defined, so when
131
-- changing this data type be careful about the interaction with the
132
-- desired sorting order.
133
$(THH.declareSADT "AllocPolicy"
134
       [ ("AllocPreferred",   'C.allocPolicyPreferred)
135
       , ("AllocLastResort",  'C.allocPolicyLastResort)
136
       , ("AllocUnallocable", 'C.allocPolicyUnallocable)
137
       ])
138
$(THH.makeJSONInstance ''AllocPolicy)
139

    
140
-- | The Instance real state type. FIXME: this could be improved to
141
-- just wrap a /NormalState AdminStatus | ErrorState ErrorCondition/.
142
$(THH.declareSADT "InstanceStatus"
143
       [ ("StatusDown",    'C.inststAdmindown)
144
       , ("StatusOffline", 'C.inststAdminoffline)
145
       , ("ErrorDown",     'C.inststErrordown)
146
       , ("ErrorUp",       'C.inststErrorup)
147
       , ("NodeDown",      'C.inststNodedown)
148
       , ("NodeOffline",   'C.inststNodeoffline)
149
       , ("Running",       'C.inststRunning)
150
       , ("WrongNode",     'C.inststWrongnode)
151
       ])
152
$(THH.makeJSONInstance ''InstanceStatus)
153

    
154
-- | Migration mode.
155
$(THH.declareSADT "MigrationMode"
156
     [ ("MigrationLive",    'C.htMigrationLive)
157
     , ("MigrationNonLive", 'C.htMigrationNonlive)
158
     ])
159
$(THH.makeJSONInstance ''MigrationMode)
160

    
161
-- | Verify optional checks.
162
$(THH.declareSADT "VerifyOptionalChecks"
163
     [ ("VerifyNPlusOneMem", 'C.verifyNplusoneMem)
164
     ])
165
$(THH.makeJSONInstance ''VerifyOptionalChecks)
166

    
167
-- | Cluster verify error codes.
168
$(THH.declareSADT "CVErrorCode"
169
  [ ("CvECLUSTERCFG",           'C.cvEclustercfgCode)
170
  , ("CvECLUSTERCERT",          'C.cvEclustercertCode)
171
  , ("CvECLUSTERFILECHECK",     'C.cvEclusterfilecheckCode)
172
  , ("CvECLUSTERDANGLINGNODES", 'C.cvEclusterdanglingnodesCode)
173
  , ("CvECLUSTERDANGLINGINST",  'C.cvEclusterdanglinginstCode)
174
  , ("CvEINSTANCEBADNODE",      'C.cvEinstancebadnodeCode)
175
  , ("CvEINSTANCEDOWN",         'C.cvEinstancedownCode)
176
  , ("CvEINSTANCELAYOUT",       'C.cvEinstancelayoutCode)
177
  , ("CvEINSTANCEMISSINGDISK",  'C.cvEinstancemissingdiskCode)
178
  , ("CvEINSTANCEFAULTYDISK",   'C.cvEinstancefaultydiskCode)
179
  , ("CvEINSTANCEWRONGNODE",    'C.cvEinstancewrongnodeCode)
180
  , ("CvEINSTANCESPLITGROUPS",  'C.cvEinstancesplitgroupsCode)
181
  , ("CvEINSTANCEPOLICY",       'C.cvEinstancepolicyCode)
182
  , ("CvENODEDRBD",             'C.cvEnodedrbdCode)
183
  , ("CvENODEDRBDHELPER",       'C.cvEnodedrbdhelperCode)
184
  , ("CvENODEFILECHECK",        'C.cvEnodefilecheckCode)
185
  , ("CvENODEHOOKS",            'C.cvEnodehooksCode)
186
  , ("CvENODEHV",               'C.cvEnodehvCode)
187
  , ("CvENODELVM",              'C.cvEnodelvmCode)
188
  , ("CvENODEN1",               'C.cvEnoden1Code)
189
  , ("CvENODENET",              'C.cvEnodenetCode)
190
  , ("CvENODEOS",               'C.cvEnodeosCode)
191
  , ("CvENODEORPHANINSTANCE",   'C.cvEnodeorphaninstanceCode)
192
  , ("CvENODEORPHANLV",         'C.cvEnodeorphanlvCode)
193
  , ("CvENODERPC",              'C.cvEnoderpcCode)
194
  , ("CvENODESSH",              'C.cvEnodesshCode)
195
  , ("CvENODEVERSION",          'C.cvEnodeversionCode)
196
  , ("CvENODESETUP",            'C.cvEnodesetupCode)
197
  , ("CvENODETIME",             'C.cvEnodetimeCode)
198
  , ("CvENODEOOBPATH",          'C.cvEnodeoobpathCode)
199
  , ("CvENODEUSERSCRIPTS",      'C.cvEnodeuserscriptsCode)
200
  , ("CvENODEFILESTORAGEPATHS", 'C.cvEnodefilestoragepathsCode)
201
  ])
202
$(THH.makeJSONInstance ''CVErrorCode)
203

    
204
-- | Dynamic device modification, just add\/remove version.
205
$(THH.declareSADT "DdmSimple"
206
     [ ("DdmSimpleAdd",    'C.ddmAdd)
207
     , ("DdmSimpleRemove", 'C.ddmRemove)
208
     ])
209
$(THH.makeJSONInstance ''DdmSimple)
210

    
211
-- | Hypervisor type definitions.
212
$(THH.declareSADT "Hypervisor"
213
  [ ( "Kvm",    'C.htKvm )
214
  , ( "XenPvm", 'C.htXenPvm )
215
  , ( "Chroot", 'C.htChroot )
216
  , ( "XenHvm", 'C.htXenHvm )
217
  , ( "Lxc",    'C.htLxc )
218
  , ( "Fake",   'C.htFake )
219
  ])
220
$(THH.makeJSONInstance ''Hypervisor)