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