1 {-# LANGUAGE TemplateHaskell #-}
3 {-| Some common Ganeti types.
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'.
14 Copyright (C) 2012 Google Inc.
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.
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.
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
38 , instanceStatusFromRaw
53 , VerifyOptionalChecks(..)
59 import qualified Text.JSON as JSON
61 import qualified Ganeti.Constants as C
62 import qualified Ganeti.THH as THH
67 -- | Type that holds a non-negative value.
68 newtype NonNegative a = NonNegative { fromNonNegative :: a }
69 deriving (Show, Read, Eq)
71 -- | Smart constructor for 'NonNegative'.
72 mkNonNegative :: (Monad m, Num a, Ord a, Show a) => a -> m (NonNegative a)
73 mkNonNegative i | i >= 0 = return (NonNegative i)
74 | otherwise = fail $ "Invalid value for non-negative type '" ++
77 instance (JSON.JSON a, Num a, Ord a, Show a) => JSON.JSON (NonNegative a) where
78 showJSON = JSON.showJSON . fromNonNegative
79 readJSON v = JSON.readJSON v >>= mkNonNegative
81 -- | Type that holds a positive value.
82 newtype Positive a = Positive { fromPositive :: a }
83 deriving (Show, Read, Eq)
85 -- | Smart constructor for 'Positive'.
86 mkPositive :: (Monad m, Num a, Ord a, Show a) => a -> m (Positive a)
87 mkPositive i | i > 0 = return (Positive i)
88 | otherwise = fail $ "Invalid value for positive type '" ++
91 instance (JSON.JSON a, Num a, Ord a, Show a) => JSON.JSON (Positive a) where
92 showJSON = JSON.showJSON . fromPositive
93 readJSON v = JSON.readJSON v >>= mkPositive
95 -- | Type that holds a non-null list.
96 newtype NonEmpty a = NonEmpty { fromNonEmpty :: [a] }
97 deriving (Show, Read, Eq)
99 -- | Smart constructor for 'NonEmpty'.
100 mkNonEmpty :: (Monad m) => [a] -> m (NonEmpty a)
101 mkNonEmpty [] = fail "Received empty value for non-empty list"
102 mkNonEmpty xs = return (NonEmpty xs)
104 instance (JSON.JSON a) => JSON.JSON (NonEmpty a) where
105 showJSON = JSON.showJSON . fromNonEmpty
106 readJSON v = JSON.readJSON v >>= mkNonEmpty
110 -- | Instance disk template type.
111 $(THH.declareSADT "DiskTemplate"
112 [ ("DTDiskless", 'C.dtDiskless)
113 , ("DTFile", 'C.dtFile)
114 , ("DTSharedFile", 'C.dtSharedFile)
115 , ("DTPlain", 'C.dtPlain)
116 , ("DTBlock", 'C.dtBlock)
117 , ("DTDrbd8", 'C.dtDrbd8)
118 , ("DTRbd", 'C.dtRbd)
120 $(THH.makeJSONInstance ''DiskTemplate)
122 instance HasStringRepr DiskTemplate where
123 fromStringRepr = diskTemplateFromRaw
124 toStringRepr = diskTemplateToRaw
126 -- | The Group allocation policy type.
128 -- Note that the order of constructors is important as the automatic
129 -- Ord instance will order them in the order they are defined, so when
130 -- changing this data type be careful about the interaction with the
131 -- desired sorting order.
132 $(THH.declareSADT "AllocPolicy"
133 [ ("AllocPreferred", 'C.allocPolicyPreferred)
134 , ("AllocLastResort", 'C.allocPolicyLastResort)
135 , ("AllocUnallocable", 'C.allocPolicyUnallocable)
137 $(THH.makeJSONInstance ''AllocPolicy)
139 -- | The Instance real state type. FIXME: this could be improved to
140 -- just wrap a /NormalState AdminStatus | ErrorState ErrorCondition/.
141 $(THH.declareSADT "InstanceStatus"
142 [ ("StatusDown", 'C.inststAdmindown)
143 , ("StatusOffline", 'C.inststAdminoffline)
144 , ("ErrorDown", 'C.inststErrordown)
145 , ("ErrorUp", 'C.inststErrorup)
146 , ("NodeDown", 'C.inststNodedown)
147 , ("NodeOffline", 'C.inststNodeoffline)
148 , ("Running", 'C.inststRunning)
149 , ("WrongNode", 'C.inststWrongnode)
151 $(THH.makeJSONInstance ''InstanceStatus)
154 $(THH.declareSADT "MigrationMode"
155 [ ("MigrationLive", 'C.htMigrationLive)
156 , ("MigrationNonLive", 'C.htMigrationNonlive)
158 $(THH.makeJSONInstance ''MigrationMode)
160 -- | Verify optional checks.
161 $(THH.declareSADT "VerifyOptionalChecks"
162 [ ("VerifyNPlusOneMem", 'C.verifyNplusoneMem)
164 $(THH.makeJSONInstance ''VerifyOptionalChecks)
166 -- | Cluster verify error codes.
167 $(THH.declareSADT "CVErrorCode"
168 [ ("CvECLUSTERCFG", 'C.cvEclustercfgCode)
169 , ("CvECLUSTERCERT", 'C.cvEclustercertCode)
170 , ("CvECLUSTERFILECHECK", 'C.cvEclusterfilecheckCode)
171 , ("CvECLUSTERDANGLINGNODES", 'C.cvEclusterdanglingnodesCode)
172 , ("CvECLUSTERDANGLINGINST", 'C.cvEclusterdanglinginstCode)
173 , ("CvEINSTANCEBADNODE", 'C.cvEinstancebadnodeCode)
174 , ("CvEINSTANCEDOWN", 'C.cvEinstancedownCode)
175 , ("CvEINSTANCELAYOUT", 'C.cvEinstancelayoutCode)
176 , ("CvEINSTANCEMISSINGDISK", 'C.cvEinstancemissingdiskCode)
177 , ("CvEINSTANCEFAULTYDISK", 'C.cvEinstancefaultydiskCode)
178 , ("CvEINSTANCEWRONGNODE", 'C.cvEinstancewrongnodeCode)
179 , ("CvEINSTANCESPLITGROUPS", 'C.cvEinstancesplitgroupsCode)
180 , ("CvEINSTANCEPOLICY", 'C.cvEinstancepolicyCode)
181 , ("CvENODEDRBD", 'C.cvEnodedrbdCode)
182 , ("CvENODEDRBDHELPER", 'C.cvEnodedrbdhelperCode)
183 , ("CvENODEFILECHECK", 'C.cvEnodefilecheckCode)
184 , ("CvENODEHOOKS", 'C.cvEnodehooksCode)
185 , ("CvENODEHV", 'C.cvEnodehvCode)
186 , ("CvENODELVM", 'C.cvEnodelvmCode)
187 , ("CvENODEN1", 'C.cvEnoden1Code)
188 , ("CvENODENET", 'C.cvEnodenetCode)
189 , ("CvENODEOS", 'C.cvEnodeosCode)
190 , ("CvENODEORPHANINSTANCE", 'C.cvEnodeorphaninstanceCode)
191 , ("CvENODEORPHANLV", 'C.cvEnodeorphanlvCode)
192 , ("CvENODERPC", 'C.cvEnoderpcCode)
193 , ("CvENODESSH", 'C.cvEnodesshCode)
194 , ("CvENODEVERSION", 'C.cvEnodeversionCode)
195 , ("CvENODESETUP", 'C.cvEnodesetupCode)
196 , ("CvENODETIME", 'C.cvEnodetimeCode)
197 , ("CvENODEOOBPATH", 'C.cvEnodeoobpathCode)
198 , ("CvENODEUSERSCRIPTS", 'C.cvEnodeuserscriptsCode)
199 , ("CvENODEFILESTORAGEPATHS", 'C.cvEnodefilestoragepathsCode)
201 $(THH.makeJSONInstance ''CVErrorCode)
203 -- | Dynamic device modification, just add\/remove version.
204 $(THH.declareSADT "DdmSimple"
205 [ ("DdmSimpleAdd", 'C.ddmAdd)
206 , ("DdmSimpleRemove", 'C.ddmRemove)
208 $(THH.makeJSONInstance ''DdmSimple)