Statistics
| Branch: | Tag: | Revision:

root / src / Ganeti / Types.hs @ e78a8c0b

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