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   , MigrationMode(..)
  53   , VerifyOptionalChecks(..)
  54   , DdmSimple(..)
  55   , CVErrorCode(..)
  56   , cVErrorCodeToRaw
  57   ) where
  58
  59 import qualified Text.JSON as JSON
  60
  61 import qualified Ganeti.Constants as C
  62 import qualified Ganeti.THH as THH
  63 import Ganeti.JSON
  64
  65 -- * Generic types
  66
  67 -- | Type that holds a non-negative value.
  68 newtype NonNegative a = NonNegative { fromNonNegative :: a }
  69   deriving (Show, Read, Eq)
  70
  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 '" ++
  75                               show i ++ "'"
  76
  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
  80
  81 -- | Type that holds a positive value.
  82 newtype Positive a = Positive { fromPositive :: a }
  83   deriving (Show, Read, Eq)
  84
  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 '" ++
  89                            show i ++ "'"
  90
  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
  94
  95 -- | Type that holds a non-null list.
  96 newtype NonEmpty a = NonEmpty { fromNonEmpty :: [a] }
  97   deriving (Show, Read, Eq)
  98
  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)
 103
 104 instance (JSON.JSON a) => JSON.JSON (NonEmpty a) where
 105   showJSON = JSON.showJSON . fromNonEmpty
 106   readJSON v = JSON.readJSON v >>= mkNonEmpty
 107
 108 -- * Ganeti types
 109
 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)
 119        ])
 120 $(THH.makeJSONInstance ''DiskTemplate)
 121
 122 instance HasStringRepr DiskTemplate where
 123   fromStringRepr = diskTemplateFromRaw
 124   toStringRepr = diskTemplateToRaw
 125
 126 -- | The Group allocation policy type.
 127 --
 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)
 136        ])
 137 $(THH.makeJSONInstance ''AllocPolicy)
 138
 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)
 150        ])
 151 $(THH.makeJSONInstance ''InstanceStatus)
 152
 153 -- | Migration mode.
 154 $(THH.declareSADT "MigrationMode"
 155      [ ("MigrationLive",    'C.htMigrationLive)
 156      , ("MigrationNonLive", 'C.htMigrationNonlive)
 157      ])
 158 $(THH.makeJSONInstance ''MigrationMode)
 159
 160 -- | Verify optional checks.
 161 $(THH.declareSADT "VerifyOptionalChecks"
 162      [ ("VerifyNPlusOneMem", 'C.verifyNplusoneMem)
 163      ])
 164 $(THH.makeJSONInstance ''VerifyOptionalChecks)
 165
 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)
 200   ])
 201 $(THH.makeJSONInstance ''CVErrorCode)
 202
 203 -- | Dynamic device modification, just add\/remove version.
 204 $(THH.declareSADT "DdmSimple"
 205      [ ("DdmSimpleAdd",    'C.ddmAdd)
 206      , ("DdmSimpleRemove", 'C.ddmRemove)
 207      ])
 208 $(THH.makeJSONInstance ''DdmSimple)