Statistics
| Branch: | Tag: | Revision:

root / src / Ganeti / Types.hs @ 4fe04580

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