Statistics
| Branch: | Tag: | Revision:

root / src / Ganeti / Types.hs @ 01eea342

History | View | Annotate | Download (15.3 kB)

1 5e9deac0 Iustin Pop
{-# LANGUAGE TemplateHaskell #-}
2 5e9deac0 Iustin Pop
3 5e9deac0 Iustin Pop
{-| Some common Ganeti types.
4 5e9deac0 Iustin Pop
5 5e9deac0 Iustin Pop
This holds types common to both core work, and to htools. Types that
6 5e9deac0 Iustin Pop
are very core specific (e.g. configuration objects) should go in
7 5e9deac0 Iustin Pop
'Ganeti.Objects', while types that are specific to htools in-memory
8 5e9deac0 Iustin Pop
representation should go into 'Ganeti.HTools.Types'.
9 5e9deac0 Iustin Pop
10 5e9deac0 Iustin Pop
-}
11 5e9deac0 Iustin Pop
12 5e9deac0 Iustin Pop
{-
13 5e9deac0 Iustin Pop
14 5e9deac0 Iustin Pop
Copyright (C) 2012 Google Inc.
15 5e9deac0 Iustin Pop
16 5e9deac0 Iustin Pop
This program is free software; you can redistribute it and/or modify
17 5e9deac0 Iustin Pop
it under the terms of the GNU General Public License as published by
18 5e9deac0 Iustin Pop
the Free Software Foundation; either version 2 of the License, or
19 5e9deac0 Iustin Pop
(at your option) any later version.
20 5e9deac0 Iustin Pop
21 5e9deac0 Iustin Pop
This program is distributed in the hope that it will be useful, but
22 5e9deac0 Iustin Pop
WITHOUT ANY WARRANTY; without even the implied warranty of
23 5e9deac0 Iustin Pop
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
24 5e9deac0 Iustin Pop
General Public License for more details.
25 5e9deac0 Iustin Pop
26 5e9deac0 Iustin Pop
You should have received a copy of the GNU General Public License
27 5e9deac0 Iustin Pop
along with this program; if not, write to the Free Software
28 5e9deac0 Iustin Pop
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
29 5e9deac0 Iustin Pop
02110-1301, USA.
30 5e9deac0 Iustin Pop
31 5e9deac0 Iustin Pop
-}
32 5e9deac0 Iustin Pop
33 5e9deac0 Iustin Pop
module Ganeti.Types
34 5e9deac0 Iustin Pop
  ( AllocPolicy(..)
35 5e9deac0 Iustin Pop
  , allocPolicyFromRaw
36 5e9deac0 Iustin Pop
  , allocPolicyToRaw
37 5e9deac0 Iustin Pop
  , InstanceStatus(..)
38 5e9deac0 Iustin Pop
  , instanceStatusFromRaw
39 5e9deac0 Iustin Pop
  , instanceStatusToRaw
40 5e9deac0 Iustin Pop
  , DiskTemplate(..)
41 5e9deac0 Iustin Pop
  , diskTemplateToRaw
42 5e9deac0 Iustin Pop
  , diskTemplateFromRaw
43 edb5a1c8 Iustin Pop
  , NonNegative
44 edb5a1c8 Iustin Pop
  , fromNonNegative
45 edb5a1c8 Iustin Pop
  , mkNonNegative
46 edb5a1c8 Iustin Pop
  , Positive
47 edb5a1c8 Iustin Pop
  , fromPositive
48 edb5a1c8 Iustin Pop
  , mkPositive
49 c67b908a Iustin Pop
  , Negative
50 c67b908a Iustin Pop
  , fromNegative
51 c67b908a Iustin Pop
  , mkNegative
52 edb5a1c8 Iustin Pop
  , NonEmpty
53 edb5a1c8 Iustin Pop
  , fromNonEmpty
54 edb5a1c8 Iustin Pop
  , mkNonEmpty
55 6a28e02c Iustin Pop
  , NonEmptyString
56 d696bbef Iustin Pop
  , MigrationMode(..)
57 d696bbef Iustin Pop
  , VerifyOptionalChecks(..)
58 d696bbef Iustin Pop
  , DdmSimple(..)
59 c2d3219b Iustin Pop
  , DdmFull(..)
60 d696bbef Iustin Pop
  , CVErrorCode(..)
61 d696bbef Iustin Pop
  , cVErrorCodeToRaw
62 22381768 Iustin Pop
  , Hypervisor(..)
63 6a28e02c Iustin Pop
  , OobCommand(..)
64 48755fac Iustin Pop
  , StorageType(..)
65 6a28e02c Iustin Pop
  , NodeEvacMode(..)
66 c65621d7 Iustin Pop
  , FileDriver(..)
67 6d558717 Iustin Pop
  , InstCreateMode(..)
68 c2d3219b Iustin Pop
  , RebootType(..)
69 398e9066 Iustin Pop
  , ExportMode(..)
70 a3f02317 Iustin Pop
  , IAllocatorTestDir(..)
71 a3f02317 Iustin Pop
  , IAllocatorMode(..)
72 a3f02317 Iustin Pop
  , iAllocatorModeToRaw
73 8d239fa4 Iustin Pop
  , NetworkType(..)
74 8d239fa4 Iustin Pop
  , networkTypeToRaw
75 497beee2 Iustin Pop
  , NICMode(..)
76 497beee2 Iustin Pop
  , nICModeToRaw
77 3bdbe4b3 Dato Simó
  , JobStatus(..)
78 3bdbe4b3 Dato Simó
  , jobStatusToRaw
79 3bdbe4b3 Dato Simó
  , jobStatusFromRaw
80 6903fea0 Iustin Pop
  , FinalizedJobStatus(..)
81 6903fea0 Iustin Pop
  , finalizedJobStatusToRaw
82 c48711d5 Iustin Pop
  , JobId
83 c48711d5 Iustin Pop
  , fromJobId
84 c48711d5 Iustin Pop
  , makeJobId
85 fd958a3d Iustin Pop
  , makeJobIdS
86 b46ba79c Iustin Pop
  , RelativeJobId
87 b46ba79c Iustin Pop
  , JobIdDep(..)
88 b46ba79c Iustin Pop
  , JobDependency(..)
89 b46ba79c Iustin Pop
  , OpSubmitPriority(..)
90 fd958a3d Iustin Pop
  , opSubmitPriorityToRaw
91 3bdbe4b3 Dato Simó
  , OpStatus(..)
92 3bdbe4b3 Dato Simó
  , opStatusToRaw
93 3bdbe4b3 Dato Simó
  , opStatusFromRaw
94 5cd95d46 Iustin Pop
  , ELogType(..)
95 5e9deac0 Iustin Pop
  ) where
96 5e9deac0 Iustin Pop
97 b46ba79c Iustin Pop
import Control.Monad (liftM)
98 edb5a1c8 Iustin Pop
import qualified Text.JSON as JSON
99 b46ba79c Iustin Pop
import Text.JSON (JSON, readJSON, showJSON)
100 c48711d5 Iustin Pop
import Data.Ratio (numerator, denominator)
101 edb5a1c8 Iustin Pop
102 5e9deac0 Iustin Pop
import qualified Ganeti.Constants as C
103 5e9deac0 Iustin Pop
import qualified Ganeti.THH as THH
104 edc1acde Iustin Pop
import Ganeti.JSON
105 c48711d5 Iustin Pop
import Ganeti.Utils
106 5e9deac0 Iustin Pop
107 edb5a1c8 Iustin Pop
-- * Generic types
108 edb5a1c8 Iustin Pop
109 edb5a1c8 Iustin Pop
-- | Type that holds a non-negative value.
110 edb5a1c8 Iustin Pop
newtype NonNegative a = NonNegative { fromNonNegative :: a }
111 139c0683 Iustin Pop
  deriving (Show, Eq)
112 edb5a1c8 Iustin Pop
113 edb5a1c8 Iustin Pop
-- | Smart constructor for 'NonNegative'.
114 edb5a1c8 Iustin Pop
mkNonNegative :: (Monad m, Num a, Ord a, Show a) => a -> m (NonNegative a)
115 edb5a1c8 Iustin Pop
mkNonNegative i | i >= 0 = return (NonNegative i)
116 edb5a1c8 Iustin Pop
                | otherwise = fail $ "Invalid value for non-negative type '" ++
117 edb5a1c8 Iustin Pop
                              show i ++ "'"
118 edb5a1c8 Iustin Pop
119 edb5a1c8 Iustin Pop
instance (JSON.JSON a, Num a, Ord a, Show a) => JSON.JSON (NonNegative a) where
120 edb5a1c8 Iustin Pop
  showJSON = JSON.showJSON . fromNonNegative
121 edb5a1c8 Iustin Pop
  readJSON v = JSON.readJSON v >>= mkNonNegative
122 edb5a1c8 Iustin Pop
123 edb5a1c8 Iustin Pop
-- | Type that holds a positive value.
124 edb5a1c8 Iustin Pop
newtype Positive a = Positive { fromPositive :: a }
125 139c0683 Iustin Pop
  deriving (Show, Eq)
126 edb5a1c8 Iustin Pop
127 edb5a1c8 Iustin Pop
-- | Smart constructor for 'Positive'.
128 edb5a1c8 Iustin Pop
mkPositive :: (Monad m, Num a, Ord a, Show a) => a -> m (Positive a)
129 edb5a1c8 Iustin Pop
mkPositive i | i > 0 = return (Positive i)
130 edb5a1c8 Iustin Pop
             | otherwise = fail $ "Invalid value for positive type '" ++
131 edb5a1c8 Iustin Pop
                           show i ++ "'"
132 edb5a1c8 Iustin Pop
133 edb5a1c8 Iustin Pop
instance (JSON.JSON a, Num a, Ord a, Show a) => JSON.JSON (Positive a) where
134 edb5a1c8 Iustin Pop
  showJSON = JSON.showJSON . fromPositive
135 edb5a1c8 Iustin Pop
  readJSON v = JSON.readJSON v >>= mkPositive
136 edb5a1c8 Iustin Pop
137 c67b908a Iustin Pop
-- | Type that holds a negative value.
138 c67b908a Iustin Pop
newtype Negative a = Negative { fromNegative :: a }
139 c67b908a Iustin Pop
  deriving (Show, Eq)
140 c67b908a Iustin Pop
141 c67b908a Iustin Pop
-- | Smart constructor for 'Negative'.
142 c67b908a Iustin Pop
mkNegative :: (Monad m, Num a, Ord a, Show a) => a -> m (Negative a)
143 c67b908a Iustin Pop
mkNegative i | i < 0 = return (Negative i)
144 c67b908a Iustin Pop
             | otherwise = fail $ "Invalid value for negative type '" ++
145 c67b908a Iustin Pop
                           show i ++ "'"
146 c67b908a Iustin Pop
147 c67b908a Iustin Pop
instance (JSON.JSON a, Num a, Ord a, Show a) => JSON.JSON (Negative a) where
148 c67b908a Iustin Pop
  showJSON = JSON.showJSON . fromNegative
149 c67b908a Iustin Pop
  readJSON v = JSON.readJSON v >>= mkNegative
150 c67b908a Iustin Pop
151 edb5a1c8 Iustin Pop
-- | Type that holds a non-null list.
152 edb5a1c8 Iustin Pop
newtype NonEmpty a = NonEmpty { fromNonEmpty :: [a] }
153 139c0683 Iustin Pop
  deriving (Show, Eq)
154 edb5a1c8 Iustin Pop
155 edb5a1c8 Iustin Pop
-- | Smart constructor for 'NonEmpty'.
156 edb5a1c8 Iustin Pop
mkNonEmpty :: (Monad m) => [a] -> m (NonEmpty a)
157 edb5a1c8 Iustin Pop
mkNonEmpty [] = fail "Received empty value for non-empty list"
158 edb5a1c8 Iustin Pop
mkNonEmpty xs = return (NonEmpty xs)
159 edb5a1c8 Iustin Pop
160 edb5a1c8 Iustin Pop
instance (JSON.JSON a) => JSON.JSON (NonEmpty a) where
161 edb5a1c8 Iustin Pop
  showJSON = JSON.showJSON . fromNonEmpty
162 edb5a1c8 Iustin Pop
  readJSON v = JSON.readJSON v >>= mkNonEmpty
163 edb5a1c8 Iustin Pop
164 6a28e02c Iustin Pop
-- | A simple type alias for non-empty strings.
165 6a28e02c Iustin Pop
type NonEmptyString = NonEmpty Char
166 6a28e02c Iustin Pop
167 edb5a1c8 Iustin Pop
-- * Ganeti types
168 edb5a1c8 Iustin Pop
169 5e9deac0 Iustin Pop
-- | Instance disk template type.
170 5e9deac0 Iustin Pop
$(THH.declareSADT "DiskTemplate"
171 5e9deac0 Iustin Pop
       [ ("DTDiskless",   'C.dtDiskless)
172 5e9deac0 Iustin Pop
       , ("DTFile",       'C.dtFile)
173 5e9deac0 Iustin Pop
       , ("DTSharedFile", 'C.dtSharedFile)
174 5e9deac0 Iustin Pop
       , ("DTPlain",      'C.dtPlain)
175 5e9deac0 Iustin Pop
       , ("DTBlock",      'C.dtBlock)
176 5e9deac0 Iustin Pop
       , ("DTDrbd8",      'C.dtDrbd8)
177 5e9deac0 Iustin Pop
       , ("DTRbd",        'C.dtRbd)
178 277a2ec9 Constantinos Venetsanopoulos
       , ("DTExt",        'C.dtExt)
179 5e9deac0 Iustin Pop
       ])
180 5e9deac0 Iustin Pop
$(THH.makeJSONInstance ''DiskTemplate)
181 5e9deac0 Iustin Pop
182 edc1acde Iustin Pop
instance HasStringRepr DiskTemplate where
183 edc1acde Iustin Pop
  fromStringRepr = diskTemplateFromRaw
184 edc1acde Iustin Pop
  toStringRepr = diskTemplateToRaw
185 edc1acde Iustin Pop
186 5e9deac0 Iustin Pop
-- | The Group allocation policy type.
187 5e9deac0 Iustin Pop
--
188 5e9deac0 Iustin Pop
-- Note that the order of constructors is important as the automatic
189 5e9deac0 Iustin Pop
-- Ord instance will order them in the order they are defined, so when
190 5e9deac0 Iustin Pop
-- changing this data type be careful about the interaction with the
191 5e9deac0 Iustin Pop
-- desired sorting order.
192 5e9deac0 Iustin Pop
$(THH.declareSADT "AllocPolicy"
193 5e9deac0 Iustin Pop
       [ ("AllocPreferred",   'C.allocPolicyPreferred)
194 5e9deac0 Iustin Pop
       , ("AllocLastResort",  'C.allocPolicyLastResort)
195 5e9deac0 Iustin Pop
       , ("AllocUnallocable", 'C.allocPolicyUnallocable)
196 5e9deac0 Iustin Pop
       ])
197 5e9deac0 Iustin Pop
$(THH.makeJSONInstance ''AllocPolicy)
198 5e9deac0 Iustin Pop
199 5e9deac0 Iustin Pop
-- | The Instance real state type. FIXME: this could be improved to
200 5e9deac0 Iustin Pop
-- just wrap a /NormalState AdminStatus | ErrorState ErrorCondition/.
201 5e9deac0 Iustin Pop
$(THH.declareSADT "InstanceStatus"
202 5e9deac0 Iustin Pop
       [ ("StatusDown",    'C.inststAdmindown)
203 5e9deac0 Iustin Pop
       , ("StatusOffline", 'C.inststAdminoffline)
204 5e9deac0 Iustin Pop
       , ("ErrorDown",     'C.inststErrordown)
205 5e9deac0 Iustin Pop
       , ("ErrorUp",       'C.inststErrorup)
206 5e9deac0 Iustin Pop
       , ("NodeDown",      'C.inststNodedown)
207 5e9deac0 Iustin Pop
       , ("NodeOffline",   'C.inststNodeoffline)
208 5e9deac0 Iustin Pop
       , ("Running",       'C.inststRunning)
209 5e9deac0 Iustin Pop
       , ("WrongNode",     'C.inststWrongnode)
210 5e9deac0 Iustin Pop
       ])
211 5e9deac0 Iustin Pop
$(THH.makeJSONInstance ''InstanceStatus)
212 d696bbef Iustin Pop
213 d696bbef Iustin Pop
-- | Migration mode.
214 d696bbef Iustin Pop
$(THH.declareSADT "MigrationMode"
215 d696bbef Iustin Pop
     [ ("MigrationLive",    'C.htMigrationLive)
216 d696bbef Iustin Pop
     , ("MigrationNonLive", 'C.htMigrationNonlive)
217 d696bbef Iustin Pop
     ])
218 d696bbef Iustin Pop
$(THH.makeJSONInstance ''MigrationMode)
219 d696bbef Iustin Pop
220 d696bbef Iustin Pop
-- | Verify optional checks.
221 d696bbef Iustin Pop
$(THH.declareSADT "VerifyOptionalChecks"
222 d696bbef Iustin Pop
     [ ("VerifyNPlusOneMem", 'C.verifyNplusoneMem)
223 d696bbef Iustin Pop
     ])
224 d696bbef Iustin Pop
$(THH.makeJSONInstance ''VerifyOptionalChecks)
225 d696bbef Iustin Pop
226 d696bbef Iustin Pop
-- | Cluster verify error codes.
227 d696bbef Iustin Pop
$(THH.declareSADT "CVErrorCode"
228 d696bbef Iustin Pop
  [ ("CvECLUSTERCFG",           'C.cvEclustercfgCode)
229 d696bbef Iustin Pop
  , ("CvECLUSTERCERT",          'C.cvEclustercertCode)
230 d696bbef Iustin Pop
  , ("CvECLUSTERFILECHECK",     'C.cvEclusterfilecheckCode)
231 d696bbef Iustin Pop
  , ("CvECLUSTERDANGLINGNODES", 'C.cvEclusterdanglingnodesCode)
232 d696bbef Iustin Pop
  , ("CvECLUSTERDANGLINGINST",  'C.cvEclusterdanglinginstCode)
233 d696bbef Iustin Pop
  , ("CvEINSTANCEBADNODE",      'C.cvEinstancebadnodeCode)
234 d696bbef Iustin Pop
  , ("CvEINSTANCEDOWN",         'C.cvEinstancedownCode)
235 d696bbef Iustin Pop
  , ("CvEINSTANCELAYOUT",       'C.cvEinstancelayoutCode)
236 d696bbef Iustin Pop
  , ("CvEINSTANCEMISSINGDISK",  'C.cvEinstancemissingdiskCode)
237 d696bbef Iustin Pop
  , ("CvEINSTANCEFAULTYDISK",   'C.cvEinstancefaultydiskCode)
238 d696bbef Iustin Pop
  , ("CvEINSTANCEWRONGNODE",    'C.cvEinstancewrongnodeCode)
239 d696bbef Iustin Pop
  , ("CvEINSTANCESPLITGROUPS",  'C.cvEinstancesplitgroupsCode)
240 d696bbef Iustin Pop
  , ("CvEINSTANCEPOLICY",       'C.cvEinstancepolicyCode)
241 d696bbef Iustin Pop
  , ("CvENODEDRBD",             'C.cvEnodedrbdCode)
242 d696bbef Iustin Pop
  , ("CvENODEDRBDHELPER",       'C.cvEnodedrbdhelperCode)
243 d696bbef Iustin Pop
  , ("CvENODEFILECHECK",        'C.cvEnodefilecheckCode)
244 d696bbef Iustin Pop
  , ("CvENODEHOOKS",            'C.cvEnodehooksCode)
245 d696bbef Iustin Pop
  , ("CvENODEHV",               'C.cvEnodehvCode)
246 d696bbef Iustin Pop
  , ("CvENODELVM",              'C.cvEnodelvmCode)
247 d696bbef Iustin Pop
  , ("CvENODEN1",               'C.cvEnoden1Code)
248 d696bbef Iustin Pop
  , ("CvENODENET",              'C.cvEnodenetCode)
249 d696bbef Iustin Pop
  , ("CvENODEOS",               'C.cvEnodeosCode)
250 d696bbef Iustin Pop
  , ("CvENODEORPHANINSTANCE",   'C.cvEnodeorphaninstanceCode)
251 d696bbef Iustin Pop
  , ("CvENODEORPHANLV",         'C.cvEnodeorphanlvCode)
252 d696bbef Iustin Pop
  , ("CvENODERPC",              'C.cvEnoderpcCode)
253 d696bbef Iustin Pop
  , ("CvENODESSH",              'C.cvEnodesshCode)
254 d696bbef Iustin Pop
  , ("CvENODEVERSION",          'C.cvEnodeversionCode)
255 d696bbef Iustin Pop
  , ("CvENODESETUP",            'C.cvEnodesetupCode)
256 d696bbef Iustin Pop
  , ("CvENODETIME",             'C.cvEnodetimeCode)
257 d696bbef Iustin Pop
  , ("CvENODEOOBPATH",          'C.cvEnodeoobpathCode)
258 d696bbef Iustin Pop
  , ("CvENODEUSERSCRIPTS",      'C.cvEnodeuserscriptsCode)
259 d696bbef Iustin Pop
  , ("CvENODEFILESTORAGEPATHS", 'C.cvEnodefilestoragepathsCode)
260 d696bbef Iustin Pop
  ])
261 d696bbef Iustin Pop
$(THH.makeJSONInstance ''CVErrorCode)
262 d696bbef Iustin Pop
263 d696bbef Iustin Pop
-- | Dynamic device modification, just add\/remove version.
264 d696bbef Iustin Pop
$(THH.declareSADT "DdmSimple"
265 d696bbef Iustin Pop
     [ ("DdmSimpleAdd",    'C.ddmAdd)
266 d696bbef Iustin Pop
     , ("DdmSimpleRemove", 'C.ddmRemove)
267 d696bbef Iustin Pop
     ])
268 d696bbef Iustin Pop
$(THH.makeJSONInstance ''DdmSimple)
269 22381768 Iustin Pop
270 c2d3219b Iustin Pop
-- | Dynamic device modification, all operations version.
271 c2d3219b Iustin Pop
$(THH.declareSADT "DdmFull"
272 c2d3219b Iustin Pop
     [ ("DdmFullAdd",    'C.ddmAdd)
273 c2d3219b Iustin Pop
     , ("DdmFullRemove", 'C.ddmRemove)
274 c2d3219b Iustin Pop
     , ("DdmFullModify", 'C.ddmModify)
275 c2d3219b Iustin Pop
     ])
276 c2d3219b Iustin Pop
$(THH.makeJSONInstance ''DdmFull)
277 c2d3219b Iustin Pop
278 22381768 Iustin Pop
-- | Hypervisor type definitions.
279 22381768 Iustin Pop
$(THH.declareSADT "Hypervisor"
280 22381768 Iustin Pop
  [ ( "Kvm",    'C.htKvm )
281 22381768 Iustin Pop
  , ( "XenPvm", 'C.htXenPvm )
282 22381768 Iustin Pop
  , ( "Chroot", 'C.htChroot )
283 22381768 Iustin Pop
  , ( "XenHvm", 'C.htXenHvm )
284 22381768 Iustin Pop
  , ( "Lxc",    'C.htLxc )
285 22381768 Iustin Pop
  , ( "Fake",   'C.htFake )
286 22381768 Iustin Pop
  ])
287 22381768 Iustin Pop
$(THH.makeJSONInstance ''Hypervisor)
288 48755fac Iustin Pop
289 6a28e02c Iustin Pop
-- | Oob command type.
290 6a28e02c Iustin Pop
$(THH.declareSADT "OobCommand"
291 6a28e02c Iustin Pop
  [ ("OobHealth",      'C.oobHealth)
292 6a28e02c Iustin Pop
  , ("OobPowerCycle",  'C.oobPowerCycle)
293 6a28e02c Iustin Pop
  , ("OobPowerOff",    'C.oobPowerOff)
294 6a28e02c Iustin Pop
  , ("OobPowerOn",     'C.oobPowerOn)
295 6a28e02c Iustin Pop
  , ("OobPowerStatus", 'C.oobPowerStatus)
296 6a28e02c Iustin Pop
  ])
297 6a28e02c Iustin Pop
$(THH.makeJSONInstance ''OobCommand)
298 6a28e02c Iustin Pop
299 48755fac Iustin Pop
-- | Storage type.
300 48755fac Iustin Pop
$(THH.declareSADT "StorageType"
301 48755fac Iustin Pop
  [ ("StorageFile", 'C.stFile)
302 48755fac Iustin Pop
  , ("StorageLvmPv", 'C.stLvmPv)
303 48755fac Iustin Pop
  , ("StorageLvmVg", 'C.stLvmVg)
304 48755fac Iustin Pop
  ])
305 48755fac Iustin Pop
$(THH.makeJSONInstance ''StorageType)
306 6a28e02c Iustin Pop
307 6a28e02c Iustin Pop
-- | Node evac modes.
308 6a28e02c Iustin Pop
$(THH.declareSADT "NodeEvacMode"
309 6a28e02c Iustin Pop
  [ ("NEvacPrimary",   'C.iallocatorNevacPri)
310 6a28e02c Iustin Pop
  , ("NEvacSecondary", 'C.iallocatorNevacSec)
311 6a28e02c Iustin Pop
  , ("NEvacAll",       'C.iallocatorNevacAll)
312 6a28e02c Iustin Pop
  ])
313 6a28e02c Iustin Pop
$(THH.makeJSONInstance ''NodeEvacMode)
314 c65621d7 Iustin Pop
315 c65621d7 Iustin Pop
-- | The file driver type.
316 c65621d7 Iustin Pop
$(THH.declareSADT "FileDriver"
317 c65621d7 Iustin Pop
  [ ("FileLoop",   'C.fdLoop)
318 c65621d7 Iustin Pop
  , ("FileBlktap", 'C.fdBlktap)
319 c65621d7 Iustin Pop
  ])
320 c65621d7 Iustin Pop
$(THH.makeJSONInstance ''FileDriver)
321 6d558717 Iustin Pop
322 6d558717 Iustin Pop
-- | The instance create mode.
323 6d558717 Iustin Pop
$(THH.declareSADT "InstCreateMode"
324 6d558717 Iustin Pop
  [ ("InstCreate",       'C.instanceCreate)
325 6d558717 Iustin Pop
  , ("InstImport",       'C.instanceImport)
326 6d558717 Iustin Pop
  , ("InstRemoteImport", 'C.instanceRemoteImport)
327 6d558717 Iustin Pop
  ])
328 6d558717 Iustin Pop
$(THH.makeJSONInstance ''InstCreateMode)
329 c2d3219b Iustin Pop
330 c2d3219b Iustin Pop
-- | Reboot type.
331 c2d3219b Iustin Pop
$(THH.declareSADT "RebootType"
332 c2d3219b Iustin Pop
  [ ("RebootSoft", 'C.instanceRebootSoft)
333 c2d3219b Iustin Pop
  , ("RebootHard", 'C.instanceRebootHard)
334 c2d3219b Iustin Pop
  , ("RebootFull", 'C.instanceRebootFull)
335 c2d3219b Iustin Pop
  ])
336 c2d3219b Iustin Pop
$(THH.makeJSONInstance ''RebootType)
337 398e9066 Iustin Pop
338 398e9066 Iustin Pop
-- | Export modes.
339 398e9066 Iustin Pop
$(THH.declareSADT "ExportMode"
340 398e9066 Iustin Pop
  [ ("ExportModeLocal",  'C.exportModeLocal)
341 398e9066 Iustin Pop
  , ("ExportModeRemove", 'C.exportModeRemote)
342 398e9066 Iustin Pop
  ])
343 398e9066 Iustin Pop
$(THH.makeJSONInstance ''ExportMode)
344 a3f02317 Iustin Pop
345 a3f02317 Iustin Pop
-- | IAllocator run types (OpTestIAllocator).
346 a3f02317 Iustin Pop
$(THH.declareSADT "IAllocatorTestDir"
347 a3f02317 Iustin Pop
  [ ("IAllocatorDirIn",  'C.iallocatorDirIn)
348 a3f02317 Iustin Pop
  , ("IAllocatorDirOut", 'C.iallocatorDirOut)
349 a3f02317 Iustin Pop
  ])
350 a3f02317 Iustin Pop
$(THH.makeJSONInstance ''IAllocatorTestDir)
351 a3f02317 Iustin Pop
352 a3f02317 Iustin Pop
-- | IAllocator mode. FIXME: use this in "HTools.Backend.IAlloc".
353 a3f02317 Iustin Pop
$(THH.declareSADT "IAllocatorMode"
354 a3f02317 Iustin Pop
  [ ("IAllocatorAlloc",       'C.iallocatorModeAlloc)
355 a3f02317 Iustin Pop
  , ("IAllocatorMultiAlloc",  'C.iallocatorModeMultiAlloc)
356 a3f02317 Iustin Pop
  , ("IAllocatorReloc",       'C.iallocatorModeReloc)
357 a3f02317 Iustin Pop
  , ("IAllocatorNodeEvac",    'C.iallocatorModeNodeEvac)
358 a3f02317 Iustin Pop
  , ("IAllocatorChangeGroup", 'C.iallocatorModeChgGroup)
359 a3f02317 Iustin Pop
  ])
360 a3f02317 Iustin Pop
$(THH.makeJSONInstance ''IAllocatorMode)
361 497beee2 Iustin Pop
362 8d239fa4 Iustin Pop
-- | Network type.
363 8d239fa4 Iustin Pop
$(THH.declareSADT "NetworkType"
364 8d239fa4 Iustin Pop
  [ ("PrivateNetwork", 'C.networkTypePrivate)
365 8d239fa4 Iustin Pop
  , ("PublicNetwork",  'C.networkTypePublic)
366 8d239fa4 Iustin Pop
  ])
367 8d239fa4 Iustin Pop
$(THH.makeJSONInstance ''NetworkType)
368 8d239fa4 Iustin Pop
369 497beee2 Iustin Pop
-- | Netork mode.
370 497beee2 Iustin Pop
$(THH.declareSADT "NICMode"
371 497beee2 Iustin Pop
  [ ("NMBridged", 'C.nicModeBridged)
372 497beee2 Iustin Pop
  , ("NMRouted",  'C.nicModeRouted)
373 57fb6fcb Guido Trotter
  , ("NMOvs",     'C.nicModeOvs)
374 497beee2 Iustin Pop
  ])
375 497beee2 Iustin Pop
$(THH.makeJSONInstance ''NICMode)
376 6903fea0 Iustin Pop
377 3bdbe4b3 Dato Simó
-- | The JobStatus data type. Note that this is ordered especially
378 3bdbe4b3 Dato Simó
-- such that greater\/lesser comparison on values of this type makes
379 3bdbe4b3 Dato Simó
-- sense.
380 3bdbe4b3 Dato Simó
$(THH.declareSADT "JobStatus"
381 3bdbe4b3 Dato Simó
       [ ("JOB_STATUS_QUEUED",    'C.jobStatusQueued)
382 3bdbe4b3 Dato Simó
       , ("JOB_STATUS_WAITING",   'C.jobStatusWaiting)
383 3bdbe4b3 Dato Simó
       , ("JOB_STATUS_CANCELING", 'C.jobStatusCanceling)
384 3bdbe4b3 Dato Simó
       , ("JOB_STATUS_RUNNING",   'C.jobStatusRunning)
385 3bdbe4b3 Dato Simó
       , ("JOB_STATUS_CANCELED",  'C.jobStatusCanceled)
386 3bdbe4b3 Dato Simó
       , ("JOB_STATUS_SUCCESS",   'C.jobStatusSuccess)
387 3bdbe4b3 Dato Simó
       , ("JOB_STATUS_ERROR",     'C.jobStatusError)
388 3bdbe4b3 Dato Simó
       ])
389 3bdbe4b3 Dato Simó
$(THH.makeJSONInstance ''JobStatus)
390 3bdbe4b3 Dato Simó
391 6903fea0 Iustin Pop
-- | Finalized job status.
392 6903fea0 Iustin Pop
$(THH.declareSADT "FinalizedJobStatus"
393 6903fea0 Iustin Pop
  [ ("JobStatusCanceled",   'C.jobStatusCanceled)
394 6903fea0 Iustin Pop
  , ("JobStatusSuccessful", 'C.jobStatusSuccess)
395 6903fea0 Iustin Pop
  , ("JobStatusFailed",     'C.jobStatusError)
396 6903fea0 Iustin Pop
  ])
397 6903fea0 Iustin Pop
$(THH.makeJSONInstance ''FinalizedJobStatus)
398 c48711d5 Iustin Pop
399 c48711d5 Iustin Pop
-- | The Ganeti job type.
400 c48711d5 Iustin Pop
newtype JobId = JobId { fromJobId :: Int }
401 c48711d5 Iustin Pop
  deriving (Show, Eq)
402 c48711d5 Iustin Pop
403 c48711d5 Iustin Pop
-- | Builds a job ID.
404 c48711d5 Iustin Pop
makeJobId :: (Monad m) => Int -> m JobId
405 c48711d5 Iustin Pop
makeJobId i | i >= 0 = return $ JobId i
406 c48711d5 Iustin Pop
            | otherwise = fail $ "Invalid value for job ID ' " ++ show i ++ "'"
407 c48711d5 Iustin Pop
408 fd958a3d Iustin Pop
-- | Builds a job ID from a string.
409 fd958a3d Iustin Pop
makeJobIdS :: (Monad m) => String -> m JobId
410 fd958a3d Iustin Pop
makeJobIdS s = tryRead "parsing job id" s >>= makeJobId
411 fd958a3d Iustin Pop
412 c48711d5 Iustin Pop
-- | Parses a job ID.
413 c48711d5 Iustin Pop
parseJobId :: (Monad m) => JSON.JSValue -> m JobId
414 fd958a3d Iustin Pop
parseJobId (JSON.JSString x) = makeJobIdS $ JSON.fromJSString x
415 c48711d5 Iustin Pop
parseJobId (JSON.JSRational _ x) =
416 c48711d5 Iustin Pop
  if denominator x /= 1
417 c48711d5 Iustin Pop
    then fail $ "Got fractional job ID from master daemon?! Value:" ++ show x
418 c48711d5 Iustin Pop
    -- FIXME: potential integer overflow here on 32-bit platforms
419 c48711d5 Iustin Pop
    else makeJobId . fromIntegral . numerator $ x
420 c48711d5 Iustin Pop
parseJobId x = fail $ "Wrong type/value for job id: " ++ show x
421 c48711d5 Iustin Pop
422 c48711d5 Iustin Pop
instance JSON.JSON JobId where
423 c48711d5 Iustin Pop
  showJSON = JSON.showJSON . fromJobId
424 c48711d5 Iustin Pop
  readJSON = parseJobId
425 b46ba79c Iustin Pop
426 b46ba79c Iustin Pop
-- | Relative job ID type alias.
427 b46ba79c Iustin Pop
type RelativeJobId = Negative Int
428 b46ba79c Iustin Pop
429 b46ba79c Iustin Pop
-- | Job ID dependency.
430 b46ba79c Iustin Pop
data JobIdDep = JobDepRelative RelativeJobId
431 b46ba79c Iustin Pop
              | JobDepAbsolute JobId
432 b46ba79c Iustin Pop
                deriving (Show, Eq)
433 b46ba79c Iustin Pop
434 b46ba79c Iustin Pop
instance JSON.JSON JobIdDep where
435 b46ba79c Iustin Pop
  showJSON (JobDepRelative i) = showJSON i
436 b46ba79c Iustin Pop
  showJSON (JobDepAbsolute i) = showJSON i
437 b46ba79c Iustin Pop
  readJSON v =
438 b46ba79c Iustin Pop
    case JSON.readJSON v::JSON.Result (Negative Int) of
439 b46ba79c Iustin Pop
      -- first try relative dependency, usually most common
440 b46ba79c Iustin Pop
      JSON.Ok r -> return $ JobDepRelative r
441 77d43564 Iustin Pop
      JSON.Error _ -> liftM JobDepAbsolute (parseJobId v)
442 b46ba79c Iustin Pop
443 b46ba79c Iustin Pop
-- | Job Dependency type.
444 b46ba79c Iustin Pop
data JobDependency = JobDependency JobIdDep [FinalizedJobStatus]
445 b46ba79c Iustin Pop
                     deriving (Show, Eq)
446 b46ba79c Iustin Pop
447 b46ba79c Iustin Pop
instance JSON JobDependency where
448 b46ba79c Iustin Pop
  showJSON (JobDependency dep status) = showJSON (dep, status)
449 b46ba79c Iustin Pop
  readJSON = liftM (uncurry JobDependency) . readJSON
450 b46ba79c Iustin Pop
451 b46ba79c Iustin Pop
-- | Valid opcode priorities for submit.
452 b46ba79c Iustin Pop
$(THH.declareIADT "OpSubmitPriority"
453 b46ba79c Iustin Pop
  [ ("OpPrioLow",    'C.opPrioLow)
454 b46ba79c Iustin Pop
  , ("OpPrioNormal", 'C.opPrioNormal)
455 b46ba79c Iustin Pop
  , ("OpPrioHigh",   'C.opPrioHigh)
456 b46ba79c Iustin Pop
  ])
457 b46ba79c Iustin Pop
$(THH.makeJSONInstance ''OpSubmitPriority)
458 3bdbe4b3 Dato Simó
459 3bdbe4b3 Dato Simó
-- | Our ADT for the OpCode status at runtime (while in a job).
460 3bdbe4b3 Dato Simó
$(THH.declareSADT "OpStatus"
461 5cd95d46 Iustin Pop
  [ ("OP_STATUS_QUEUED",    'C.opStatusQueued)
462 5cd95d46 Iustin Pop
  , ("OP_STATUS_WAITING",   'C.opStatusWaiting)
463 5cd95d46 Iustin Pop
  , ("OP_STATUS_CANCELING", 'C.opStatusCanceling)
464 5cd95d46 Iustin Pop
  , ("OP_STATUS_RUNNING",   'C.opStatusRunning)
465 5cd95d46 Iustin Pop
  , ("OP_STATUS_CANCELED",  'C.opStatusCanceled)
466 5cd95d46 Iustin Pop
  , ("OP_STATUS_SUCCESS",   'C.opStatusSuccess)
467 5cd95d46 Iustin Pop
  , ("OP_STATUS_ERROR",     'C.opStatusError)
468 5cd95d46 Iustin Pop
  ])
469 3bdbe4b3 Dato Simó
$(THH.makeJSONInstance ''OpStatus)
470 5cd95d46 Iustin Pop
471 5cd95d46 Iustin Pop
-- | Type for the job message type.
472 5cd95d46 Iustin Pop
$(THH.declareSADT "ELogType"
473 5cd95d46 Iustin Pop
  [ ("ELogMessage",      'C.elogMessage)
474 5cd95d46 Iustin Pop
  , ("ELogRemoteImport", 'C.elogRemoteImport)
475 5cd95d46 Iustin Pop
  , ("ELogJqueueTest",   'C.elogJqueueTest)
476 5cd95d46 Iustin Pop
  ])
477 5cd95d46 Iustin Pop
$(THH.makeJSONInstance ''ELogType)