code.grnet.gr Git - ganeti-local/blob - htools/Ganeti/Types.hs

   1 {-# LANGUAGE TemplateHaskell #-}
   2
   3 {-| Some common Ganeti types.
   4
   5 This holds types common to both core work, and to htools. Types that
   6 are very core specific (e.g. configuration objects) should go in
   7 'Ganeti.Objects', while types that are specific to htools in-memory
   8 representation should go into 'Ganeti.HTools.Types'.
   9
  10 -}
  11
  12 {-
  13
  14 Copyright (C) 2012 Google Inc.
  15
  16 This program is free software; you can redistribute it and/or modify
  17 it under the terms of the GNU General Public License as published by
  18 the Free Software Foundation; either version 2 of the License, or
  19 (at your option) any later version.
  20
  21 This program is distributed in the hope that it will be useful, but
  22 WITHOUT ANY WARRANTY; without even the implied warranty of
  23 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  24 General Public License for more details.
  25
  26 You should have received a copy of the GNU General Public License
  27 along with this program; if not, write to the Free Software
  28 Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
  29 02110-1301, USA.
  30
  31 -}
  32
  33 module Ganeti.Types
  34   ( AllocPolicy(..)
  35   , allocPolicyFromRaw
  36   , allocPolicyToRaw
  37   , InstanceStatus(..)
  38   , instanceStatusFromRaw
  39   , instanceStatusToRaw
  40   , DiskTemplate(..)
  41   , diskTemplateToRaw
  42   , diskTemplateFromRaw
  43   , NonNegative
  44   , fromNonNegative
  45   , mkNonNegative
  46   , Positive
  47   , fromPositive
  48   , mkPositive
  49   , NonEmpty
  50   , fromNonEmpty
  51   , mkNonEmpty
  52   , NonEmptyString
  53   , MigrationMode(..)
  54   , VerifyOptionalChecks(..)
  55   , DdmSimple(..)
  56   , DdmFull(..)
  57   , CVErrorCode(..)
  58   , cVErrorCodeToRaw
  59   , Hypervisor(..)
  60   , OobCommand(..)
  61   , StorageType(..)
  62   , NodeEvacMode(..)
  63   , FileDriver(..)
  64   , InstCreateMode(..)
  65   , RebootType(..)
  66   , ExportMode(..)
  67   , IAllocatorTestDir(..)
  68   , IAllocatorMode(..)
  69   , iAllocatorModeToRaw
  70   , NetworkType(..)
  71   , networkTypeToRaw
  72   , NICMode(..)
  73   , nICModeToRaw
  74   ) where
  75
  76 import qualified Text.JSON as JSON
  77
  78 import qualified Ganeti.Constants as C
  79 import qualified Ganeti.THH as THH
  80 import Ganeti.JSON
  81
  82 -- * Generic types
  83
  84 -- | Type that holds a non-negative value.
  85 newtype NonNegative a = NonNegative { fromNonNegative :: a }
  86   deriving (Show, Eq)
  87
  88 -- | Smart constructor for 'NonNegative'.
  89 mkNonNegative :: (Monad m, Num a, Ord a, Show a) => a -> m (NonNegative a)
  90 mkNonNegative i | i >= 0 = return (NonNegative i)
  91                 | otherwise = fail $ "Invalid value for non-negative type '" ++
  92                               show i ++ "'"
  93
  94 instance (JSON.JSON a, Num a, Ord a, Show a) => JSON.JSON (NonNegative a) where
  95   showJSON = JSON.showJSON . fromNonNegative
  96   readJSON v = JSON.readJSON v >>= mkNonNegative
  97
  98 -- | Type that holds a positive value.
  99 newtype Positive a = Positive { fromPositive :: a }
 100   deriving (Show, Eq)
 101
 102 -- | Smart constructor for 'Positive'.
 103 mkPositive :: (Monad m, Num a, Ord a, Show a) => a -> m (Positive a)
 104 mkPositive i | i > 0 = return (Positive i)
 105              | otherwise = fail $ "Invalid value for positive type '" ++
 106                            show i ++ "'"
 107
 108 instance (JSON.JSON a, Num a, Ord a, Show a) => JSON.JSON (Positive a) where
 109   showJSON = JSON.showJSON . fromPositive
 110   readJSON v = JSON.readJSON v >>= mkPositive
 111
 112 -- | Type that holds a non-null list.
 113 newtype NonEmpty a = NonEmpty { fromNonEmpty :: [a] }
 114   deriving (Show, Eq)
 115
 116 -- | Smart constructor for 'NonEmpty'.
 117 mkNonEmpty :: (Monad m) => [a] -> m (NonEmpty a)
 118 mkNonEmpty [] = fail "Received empty value for non-empty list"
 119 mkNonEmpty xs = return (NonEmpty xs)
 120
 121 instance (JSON.JSON a) => JSON.JSON (NonEmpty a) where
 122   showJSON = JSON.showJSON . fromNonEmpty
 123   readJSON v = JSON.readJSON v >>= mkNonEmpty
 124
 125 -- | A simple type alias for non-empty strings.
 126 type NonEmptyString = NonEmpty Char
 127
 128 -- * Ganeti types
 129
 130 -- | Instance disk template type.
 131 $(THH.declareSADT "DiskTemplate"
 132        [ ("DTDiskless",   'C.dtDiskless)
 133        , ("DTFile",       'C.dtFile)
 134        , ("DTSharedFile", 'C.dtSharedFile)
 135        , ("DTPlain",      'C.dtPlain)
 136        , ("DTBlock",      'C.dtBlock)
 137        , ("DTDrbd8",      'C.dtDrbd8)
 138        , ("DTRbd",        'C.dtRbd)
 139        ])
 140 $(THH.makeJSONInstance ''DiskTemplate)
 141
 142 instance HasStringRepr DiskTemplate where
 143   fromStringRepr = diskTemplateFromRaw
 144   toStringRepr = diskTemplateToRaw
 145
 146 -- | The Group allocation policy type.
 147 --
 148 -- Note that the order of constructors is important as the automatic
 149 -- Ord instance will order them in the order they are defined, so when
 150 -- changing this data type be careful about the interaction with the
 151 -- desired sorting order.
 152 $(THH.declareSADT "AllocPolicy"
 153        [ ("AllocPreferred",   'C.allocPolicyPreferred)
 154        , ("AllocLastResort",  'C.allocPolicyLastResort)
 155        , ("AllocUnallocable", 'C.allocPolicyUnallocable)
 156        ])
 157 $(THH.makeJSONInstance ''AllocPolicy)
 158
 159 -- | The Instance real state type. FIXME: this could be improved to
 160 -- just wrap a /NormalState AdminStatus | ErrorState ErrorCondition/.
 161 $(THH.declareSADT "InstanceStatus"
 162        [ ("StatusDown",    'C.inststAdmindown)
 163        , ("StatusOffline", 'C.inststAdminoffline)
 164        , ("ErrorDown",     'C.inststErrordown)
 165        , ("ErrorUp",       'C.inststErrorup)
 166        , ("NodeDown",      'C.inststNodedown)
 167        , ("NodeOffline",   'C.inststNodeoffline)
 168        , ("Running",       'C.inststRunning)
 169        , ("WrongNode",     'C.inststWrongnode)
 170        ])
 171 $(THH.makeJSONInstance ''InstanceStatus)
 172
 173 -- | Migration mode.
 174 $(THH.declareSADT "MigrationMode"
 175      [ ("MigrationLive",    'C.htMigrationLive)
 176      , ("MigrationNonLive", 'C.htMigrationNonlive)
 177      ])
 178 $(THH.makeJSONInstance ''MigrationMode)
 179
 180 -- | Verify optional checks.
 181 $(THH.declareSADT "VerifyOptionalChecks"
 182      [ ("VerifyNPlusOneMem", 'C.verifyNplusoneMem)
 183      ])
 184 $(THH.makeJSONInstance ''VerifyOptionalChecks)
 185
 186 -- | Cluster verify error codes.
 187 $(THH.declareSADT "CVErrorCode"
 188   [ ("CvECLUSTERCFG",           'C.cvEclustercfgCode)
 189   , ("CvECLUSTERCERT",          'C.cvEclustercertCode)
 190   , ("CvECLUSTERFILECHECK",     'C.cvEclusterfilecheckCode)
 191   , ("CvECLUSTERDANGLINGNODES", 'C.cvEclusterdanglingnodesCode)
 192   , ("CvECLUSTERDANGLINGINST",  'C.cvEclusterdanglinginstCode)
 193   , ("CvEINSTANCEBADNODE",      'C.cvEinstancebadnodeCode)
 194   , ("CvEINSTANCEDOWN",         'C.cvEinstancedownCode)
 195   , ("CvEINSTANCELAYOUT",       'C.cvEinstancelayoutCode)
 196   , ("CvEINSTANCEMISSINGDISK",  'C.cvEinstancemissingdiskCode)
 197   , ("CvEINSTANCEFAULTYDISK",   'C.cvEinstancefaultydiskCode)
 198   , ("CvEINSTANCEWRONGNODE",    'C.cvEinstancewrongnodeCode)
 199   , ("CvEINSTANCESPLITGROUPS",  'C.cvEinstancesplitgroupsCode)
 200   , ("CvEINSTANCEPOLICY",       'C.cvEinstancepolicyCode)
 201   , ("CvENODEDRBD",             'C.cvEnodedrbdCode)
 202   , ("CvENODEDRBDHELPER",       'C.cvEnodedrbdhelperCode)
 203   , ("CvENODEFILECHECK",        'C.cvEnodefilecheckCode)
 204   , ("CvENODEHOOKS",            'C.cvEnodehooksCode)
 205   , ("CvENODEHV",               'C.cvEnodehvCode)
 206   , ("CvENODELVM",              'C.cvEnodelvmCode)
 207   , ("CvENODEN1",               'C.cvEnoden1Code)
 208   , ("CvENODENET",              'C.cvEnodenetCode)
 209   , ("CvENODEOS",               'C.cvEnodeosCode)
 210   , ("CvENODEORPHANINSTANCE",   'C.cvEnodeorphaninstanceCode)
 211   , ("CvENODEORPHANLV",         'C.cvEnodeorphanlvCode)
 212   , ("CvENODERPC",              'C.cvEnoderpcCode)
 213   , ("CvENODESSH",              'C.cvEnodesshCode)
 214   , ("CvENODEVERSION",          'C.cvEnodeversionCode)
 215   , ("CvENODESETUP",            'C.cvEnodesetupCode)
 216   , ("CvENODETIME",             'C.cvEnodetimeCode)
 217   , ("CvENODEOOBPATH",          'C.cvEnodeoobpathCode)
 218   , ("CvENODEUSERSCRIPTS",      'C.cvEnodeuserscriptsCode)
 219   , ("CvENODEFILESTORAGEPATHS", 'C.cvEnodefilestoragepathsCode)
 220   ])
 221 $(THH.makeJSONInstance ''CVErrorCode)
 222
 223 -- | Dynamic device modification, just add\/remove version.
 224 $(THH.declareSADT "DdmSimple"
 225      [ ("DdmSimpleAdd",    'C.ddmAdd)
 226      , ("DdmSimpleRemove", 'C.ddmRemove)
 227      ])
 228 $(THH.makeJSONInstance ''DdmSimple)
 229
 230 -- | Dynamic device modification, all operations version.
 231 $(THH.declareSADT "DdmFull"
 232      [ ("DdmFullAdd",    'C.ddmAdd)
 233      , ("DdmFullRemove", 'C.ddmRemove)
 234      , ("DdmFullModify", 'C.ddmModify)
 235      ])
 236 $(THH.makeJSONInstance ''DdmFull)
 237
 238 -- | Hypervisor type definitions.
 239 $(THH.declareSADT "Hypervisor"
 240   [ ( "Kvm",    'C.htKvm )
 241   , ( "XenPvm", 'C.htXenPvm )
 242   , ( "Chroot", 'C.htChroot )
 243   , ( "XenHvm", 'C.htXenHvm )
 244   , ( "Lxc",    'C.htLxc )
 245   , ( "Fake",   'C.htFake )
 246   ])
 247 $(THH.makeJSONInstance ''Hypervisor)
 248
 249 -- | Oob command type.
 250 $(THH.declareSADT "OobCommand"
 251   [ ("OobHealth",      'C.oobHealth)
 252   , ("OobPowerCycle",  'C.oobPowerCycle)
 253   , ("OobPowerOff",    'C.oobPowerOff)
 254   , ("OobPowerOn",     'C.oobPowerOn)
 255   , ("OobPowerStatus", 'C.oobPowerStatus)
 256   ])
 257 $(THH.makeJSONInstance ''OobCommand)
 258
 259 -- | Storage type.
 260 $(THH.declareSADT "StorageType"
 261   [ ("StorageFile", 'C.stFile)
 262   , ("StorageLvmPv", 'C.stLvmPv)
 263   , ("StorageLvmVg", 'C.stLvmVg)
 264   ])
 265 $(THH.makeJSONInstance ''StorageType)
 266
 267 -- | Node evac modes.
 268 $(THH.declareSADT "NodeEvacMode"
 269   [ ("NEvacPrimary",   'C.iallocatorNevacPri)
 270   , ("NEvacSecondary", 'C.iallocatorNevacSec)
 271   , ("NEvacAll",       'C.iallocatorNevacAll)
 272   ])
 273 $(THH.makeJSONInstance ''NodeEvacMode)
 274
 275 -- | The file driver type.
 276 $(THH.declareSADT "FileDriver"
 277   [ ("FileLoop",   'C.fdLoop)
 278   , ("FileBlktap", 'C.fdBlktap)
 279   ])
 280 $(THH.makeJSONInstance ''FileDriver)
 281
 282 -- | The instance create mode.
 283 $(THH.declareSADT "InstCreateMode"
 284   [ ("InstCreate",       'C.instanceCreate)
 285   , ("InstImport",       'C.instanceImport)
 286   , ("InstRemoteImport", 'C.instanceRemoteImport)
 287   ])
 288 $(THH.makeJSONInstance ''InstCreateMode)
 289
 290 -- | Reboot type.
 291 $(THH.declareSADT "RebootType"
 292   [ ("RebootSoft", 'C.instanceRebootSoft)
 293   , ("RebootHard", 'C.instanceRebootHard)
 294   , ("RebootFull", 'C.instanceRebootFull)
 295   ])
 296 $(THH.makeJSONInstance ''RebootType)
 297
 298 -- | Export modes.
 299 $(THH.declareSADT "ExportMode"
 300   [ ("ExportModeLocal",  'C.exportModeLocal)
 301   , ("ExportModeRemove", 'C.exportModeRemote)
 302   ])
 303 $(THH.makeJSONInstance ''ExportMode)
 304
 305 -- | IAllocator run types (OpTestIAllocator).
 306 $(THH.declareSADT "IAllocatorTestDir"
 307   [ ("IAllocatorDirIn",  'C.iallocatorDirIn)
 308   , ("IAllocatorDirOut", 'C.iallocatorDirOut)
 309   ])
 310 $(THH.makeJSONInstance ''IAllocatorTestDir)
 311
 312 -- | IAllocator mode. FIXME: use this in "HTools.Backend.IAlloc".
 313 $(THH.declareSADT "IAllocatorMode"
 314   [ ("IAllocatorAlloc",       'C.iallocatorModeAlloc)
 315   , ("IAllocatorMultiAlloc",  'C.iallocatorModeMultiAlloc)
 316   , ("IAllocatorReloc",       'C.iallocatorModeReloc)
 317   , ("IAllocatorNodeEvac",    'C.iallocatorModeNodeEvac)
 318   , ("IAllocatorChangeGroup", 'C.iallocatorModeChgGroup)
 319   ])
 320 $(THH.makeJSONInstance ''IAllocatorMode)
 321
 322 -- | Network type.
 323 $(THH.declareSADT "NetworkType"
 324   [ ("PrivateNetwork", 'C.networkTypePrivate)
 325   , ("PublicNetwork",  'C.networkTypePublic)
 326   ])
 327 $(THH.makeJSONInstance ''NetworkType)
 328
 329 -- | Netork mode.
 330 $(THH.declareSADT "NICMode"
 331   [ ("NMBridged", 'C.nicModeBridged)
 332   , ("NMRouted",  'C.nicModeRouted)
 333   ])
 334 $(THH.makeJSONInstance ''NICMode)