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   , TagKind(..)
  44   , tagKindToRaw
  45   , tagKindFromRaw
  46   , NonNegative
  47   , fromNonNegative
  48   , mkNonNegative
  49   , Positive
  50   , fromPositive
  51   , mkPositive
  52   , Negative
  53   , fromNegative
  54   , mkNegative
  55   , NonEmpty
  56   , fromNonEmpty
  57   , mkNonEmpty
  58   , NonEmptyString
  59   , QueryResultCode
  60   , IPv4Address
  61   , mkIPv4Address
  62   , IPv4Network
  63   , mkIPv4Network
  64   , IPv6Address
  65   , mkIPv6Address
  66   , IPv6Network
  67   , mkIPv6Network
  68   , MigrationMode(..)
  69   , migrationModeToRaw
  70   , VerifyOptionalChecks(..)
  71   , verifyOptionalChecksToRaw
  72   , DdmSimple(..)
  73   , DdmFull(..)
  74   , ddmFullToRaw
  75   , CVErrorCode(..)
  76   , cVErrorCodeToRaw
  77   , Hypervisor(..)
  78   , hypervisorToRaw
  79   , OobCommand(..)
  80   , oobCommandToRaw
  81   , OobStatus(..)
  82   , oobStatusToRaw
  83   , StorageType(..)
  84   , storageTypeToRaw
  85   , EvacMode(..)
  86   , evacModeToRaw
  87   , FileDriver(..)
  88   , fileDriverToRaw
  89   , InstCreateMode(..)
  90   , instCreateModeToRaw
  91   , RebootType(..)
  92   , rebootTypeToRaw
  93   , ExportMode(..)
  94   , exportModeToRaw
  95   , IAllocatorTestDir(..)
  96   , iAllocatorTestDirToRaw
  97   , IAllocatorMode(..)
  98   , iAllocatorModeToRaw
  99   , NICMode(..)
 100   , nICModeToRaw
 101   , JobStatus(..)
 102   , jobStatusToRaw
 103   , jobStatusFromRaw
 104   , FinalizedJobStatus(..)
 105   , finalizedJobStatusToRaw
 106   , JobId
 107   , fromJobId
 108   , makeJobId
 109   , makeJobIdS
 110   , RelativeJobId
 111   , JobIdDep(..)
 112   , JobDependency(..)
 113   , OpSubmitPriority(..)
 114   , opSubmitPriorityToRaw
 115   , parseSubmitPriority
 116   , fmtSubmitPriority
 117   , OpStatus(..)
 118   , opStatusToRaw
 119   , opStatusFromRaw
 120   , ELogType(..)
 121   , eLogTypeToRaw
 122   , ReasonElem
 123   , ReasonTrail
 124   , StorageUnit(..)
 125   , StorageUnitRaw(..)
 126   , StorageKey
 127   , addParamsToStorageUnit
 128   , diskTemplateToStorageType
 129   , VType(..)
 130   , vTypeFromRaw
 131   , vTypeToRaw
 132   , NodeRole(..)
 133   , nodeRoleToRaw
 134   , roleDescription
 135   , DiskMode(..)
 136   , diskModeToRaw
 137   , BlockDriver(..)
 138   , blockDriverToRaw
 139   , AdminState(..)
 140   , adminStateFromRaw
 141   , adminStateToRaw
 142   , StorageField(..)
 143   , storageFieldToRaw
 144   , DiskAccessMode(..)
 145   , diskAccessModeToRaw
 146   , LocalDiskStatus(..)
 147   , localDiskStatusFromRaw
 148   , localDiskStatusToRaw
 149   , localDiskStatusName
 150   , ReplaceDisksMode(..)
 151   , replaceDisksModeToRaw
 152   , RpcTimeout(..)
 153   , rpcTimeoutFromRaw -- FIXME: no used anywhere
 154   , rpcTimeoutToRaw
 155   , HotplugTarget(..)
 156   , hotplugTargetToRaw
 157   , HotplugAction(..)
 158   , hotplugActionToRaw
 159   ) where
 160
 161 import Control.Monad (liftM)
 162 import qualified Text.JSON as JSON
 163 import Text.JSON (JSON, readJSON, showJSON)
 164 import Data.Ratio (numerator, denominator)
 165
 166 import qualified Ganeti.ConstantUtils as ConstantUtils
 167 import Ganeti.JSON
 168 import qualified Ganeti.THH as THH
 169 import Ganeti.Utils
 170
 171 -- * Generic types
 172
 173 -- | Type that holds a non-negative value.
 174 newtype NonNegative a = NonNegative { fromNonNegative :: a }
 175   deriving (Show, Eq)
 176
 177 -- | Smart constructor for 'NonNegative'.
 178 mkNonNegative :: (Monad m, Num a, Ord a, Show a) => a -> m (NonNegative a)
 179 mkNonNegative i | i >= 0 = return (NonNegative i)
 180                 | otherwise = fail $ "Invalid value for non-negative type '" ++
 181                               show i ++ "'"
 182
 183 instance (JSON.JSON a, Num a, Ord a, Show a) => JSON.JSON (NonNegative a) where
 184   showJSON = JSON.showJSON . fromNonNegative
 185   readJSON v = JSON.readJSON v >>= mkNonNegative
 186
 187 -- | Type that holds a positive value.
 188 newtype Positive a = Positive { fromPositive :: a }
 189   deriving (Show, Eq)
 190
 191 -- | Smart constructor for 'Positive'.
 192 mkPositive :: (Monad m, Num a, Ord a, Show a) => a -> m (Positive a)
 193 mkPositive i | i > 0 = return (Positive i)
 194              | otherwise = fail $ "Invalid value for positive type '" ++
 195                            show i ++ "'"
 196
 197 instance (JSON.JSON a, Num a, Ord a, Show a) => JSON.JSON (Positive a) where
 198   showJSON = JSON.showJSON . fromPositive
 199   readJSON v = JSON.readJSON v >>= mkPositive
 200
 201 -- | Type that holds a negative value.
 202 newtype Negative a = Negative { fromNegative :: a }
 203   deriving (Show, Eq)
 204
 205 -- | Smart constructor for 'Negative'.
 206 mkNegative :: (Monad m, Num a, Ord a, Show a) => a -> m (Negative a)
 207 mkNegative i | i < 0 = return (Negative i)
 208              | otherwise = fail $ "Invalid value for negative type '" ++
 209                            show i ++ "'"
 210
 211 instance (JSON.JSON a, Num a, Ord a, Show a) => JSON.JSON (Negative a) where
 212   showJSON = JSON.showJSON . fromNegative
 213   readJSON v = JSON.readJSON v >>= mkNegative
 214
 215 -- | Type that holds a non-null list.
 216 newtype NonEmpty a = NonEmpty { fromNonEmpty :: [a] }
 217   deriving (Show, Eq)
 218
 219 -- | Smart constructor for 'NonEmpty'.
 220 mkNonEmpty :: (Monad m) => [a] -> m (NonEmpty a)
 221 mkNonEmpty [] = fail "Received empty value for non-empty list"
 222 mkNonEmpty xs = return (NonEmpty xs)
 223
 224 instance (Eq a, Ord a) => Ord (NonEmpty a) where
 225   NonEmpty { fromNonEmpty = x1 } `compare` NonEmpty { fromNonEmpty = x2 } =
 226     x1 `compare` x2
 227
 228 instance (JSON.JSON a) => JSON.JSON (NonEmpty a) where
 229   showJSON = JSON.showJSON . fromNonEmpty
 230   readJSON v = JSON.readJSON v >>= mkNonEmpty
 231
 232 -- | A simple type alias for non-empty strings.
 233 type NonEmptyString = NonEmpty Char
 234
 235 type QueryResultCode = Int
 236
 237 newtype IPv4Address = IPv4Address { fromIPv4Address :: String }
 238   deriving (Show, Eq)
 239
 240 -- FIXME: this should check that 'address' is a valid ip
 241 mkIPv4Address :: Monad m => String -> m IPv4Address
 242 mkIPv4Address address =
 243   return IPv4Address { fromIPv4Address = address }
 244
 245 instance JSON.JSON IPv4Address where
 246   showJSON = JSON.showJSON . fromIPv4Address
 247   readJSON v = JSON.readJSON v >>= mkIPv4Address
 248
 249 newtype IPv4Network = IPv4Network { fromIPv4Network :: String }
 250   deriving (Show, Eq)
 251
 252 -- FIXME: this should check that 'address' is a valid ip
 253 mkIPv4Network :: Monad m => String -> m IPv4Network
 254 mkIPv4Network address =
 255   return IPv4Network { fromIPv4Network = address }
 256
 257 instance JSON.JSON IPv4Network where
 258   showJSON = JSON.showJSON . fromIPv4Network
 259   readJSON v = JSON.readJSON v >>= mkIPv4Network
 260
 261 newtype IPv6Address = IPv6Address { fromIPv6Address :: String }
 262   deriving (Show, Eq)
 263
 264 -- FIXME: this should check that 'address' is a valid ip
 265 mkIPv6Address :: Monad m => String -> m IPv6Address
 266 mkIPv6Address address =
 267   return IPv6Address { fromIPv6Address = address }
 268
 269 instance JSON.JSON IPv6Address where
 270   showJSON = JSON.showJSON . fromIPv6Address
 271   readJSON v = JSON.readJSON v >>= mkIPv6Address
 272
 273 newtype IPv6Network = IPv6Network { fromIPv6Network :: String }
 274   deriving (Show, Eq)
 275
 276 -- FIXME: this should check that 'address' is a valid ip
 277 mkIPv6Network :: Monad m => String -> m IPv6Network
 278 mkIPv6Network address =
 279   return IPv6Network { fromIPv6Network = address }
 280
 281 instance JSON.JSON IPv6Network where
 282   showJSON = JSON.showJSON . fromIPv6Network
 283   readJSON v = JSON.readJSON v >>= mkIPv6Network
 284
 285 -- * Ganeti types
 286
 287 -- | Instance disk template type.
 288 $(THH.declareLADT ''String "DiskTemplate"
 289        [ ("DTDiskless",   "diskless")
 290        , ("DTFile",       "file")
 291        , ("DTSharedFile", "sharedfile")
 292        , ("DTPlain",      "plain")
 293        , ("DTBlock",      "blockdev")
 294        , ("DTDrbd8",      "drbd")
 295        , ("DTRbd",        "rbd")
 296        , ("DTExt",        "ext")
 297        ])
 298 $(THH.makeJSONInstance ''DiskTemplate)
 299
 300 instance THH.PyValue DiskTemplate where
 301   showValue = show . diskTemplateToRaw
 302
 303 instance HasStringRepr DiskTemplate where
 304   fromStringRepr = diskTemplateFromRaw
 305   toStringRepr = diskTemplateToRaw
 306
 307 -- | Data type representing what items the tag operations apply to.
 308 $(THH.declareLADT ''String "TagKind"
 309   [ ("TagKindInstance", "instance")
 310   , ("TagKindNode",     "node")
 311   , ("TagKindGroup",    "nodegroup")
 312   , ("TagKindCluster",  "cluster")
 313   , ("TagKindNetwork",  "network")
 314   ])
 315 $(THH.makeJSONInstance ''TagKind)
 316
 317 -- | The Group allocation policy type.
 318 --
 319 -- Note that the order of constructors is important as the automatic
 320 -- Ord instance will order them in the order they are defined, so when
 321 -- changing this data type be careful about the interaction with the
 322 -- desired sorting order.
 323 $(THH.declareLADT ''String "AllocPolicy"
 324        [ ("AllocPreferred",   "preferred")
 325        , ("AllocLastResort",  "last_resort")
 326        , ("AllocUnallocable", "unallocable")
 327        ])
 328 $(THH.makeJSONInstance ''AllocPolicy)
 329
 330 -- | The Instance real state type. FIXME: this could be improved to
 331 -- just wrap a /NormalState AdminStatus | ErrorState ErrorCondition/.
 332 $(THH.declareLADT ''String "InstanceStatus"
 333        [ ("StatusDown",    "ADMIN_down")
 334        , ("StatusOffline", "ADMIN_offline")
 335        , ("ErrorDown",     "ERROR_down")
 336        , ("ErrorUp",       "ERROR_up")
 337        , ("NodeDown",      "ERROR_nodedown")
 338        , ("NodeOffline",   "ERROR_nodeoffline")
 339        , ("Running",       "running")
 340        , ("WrongNode",     "ERROR_wrongnode")
 341        ])
 342 $(THH.makeJSONInstance ''InstanceStatus)
 343
 344 -- | Migration mode.
 345 $(THH.declareLADT ''String "MigrationMode"
 346      [ ("MigrationLive",    "live")
 347      , ("MigrationNonLive", "non-live")
 348      ])
 349 $(THH.makeJSONInstance ''MigrationMode)
 350
 351 -- | Verify optional checks.
 352 $(THH.declareLADT ''String "VerifyOptionalChecks"
 353      [ ("VerifyNPlusOneMem", "nplusone_mem")
 354      ])
 355 $(THH.makeJSONInstance ''VerifyOptionalChecks)
 356
 357 -- | Cluster verify error codes.
 358 $(THH.declareLADT ''String "CVErrorCode"
 359   [ ("CvECLUSTERCFG",                  "ECLUSTERCFG")
 360   , ("CvECLUSTERCERT",                 "ECLUSTERCERT")
 361   , ("CvECLUSTERFILECHECK",            "ECLUSTERFILECHECK")
 362   , ("CvECLUSTERDANGLINGNODES",        "ECLUSTERDANGLINGNODES")
 363   , ("CvECLUSTERDANGLINGINST",         "ECLUSTERDANGLINGINST")
 364   , ("CvEINSTANCEBADNODE",             "EINSTANCEBADNODE")
 365   , ("CvEINSTANCEDOWN",                "EINSTANCEDOWN")
 366   , ("CvEINSTANCELAYOUT",              "EINSTANCELAYOUT")
 367   , ("CvEINSTANCEMISSINGDISK",         "EINSTANCEMISSINGDISK")
 368   , ("CvEINSTANCEFAULTYDISK",          "EINSTANCEFAULTYDISK")
 369   , ("CvEINSTANCEWRONGNODE",           "EINSTANCEWRONGNODE")
 370   , ("CvEINSTANCESPLITGROUPS",         "EINSTANCESPLITGROUPS")
 371   , ("CvEINSTANCEPOLICY",              "EINSTANCEPOLICY")
 372   , ("CvEINSTANCEUNSUITABLENODE",      "EINSTANCEUNSUITABLENODE")
 373   , ("CvEINSTANCEMISSINGCFGPARAMETER", "EINSTANCEMISSINGCFGPARAMETER")
 374   , ("CvENODEDRBD",                    "ENODEDRBD")
 375   , ("CvENODEDRBDVERSION",             "ENODEDRBDVERSION")
 376   , ("CvENODEDRBDHELPER",              "ENODEDRBDHELPER")
 377   , ("CvENODEFILECHECK",               "ENODEFILECHECK")
 378   , ("CvENODEHOOKS",                   "ENODEHOOKS")
 379   , ("CvENODEHV",                      "ENODEHV")
 380   , ("CvENODELVM",                     "ENODELVM")
 381   , ("CvENODEN1",                      "ENODEN1")
 382   , ("CvENODENET",                     "ENODENET")
 383   , ("CvENODEOS",                      "ENODEOS")
 384   , ("CvENODEORPHANINSTANCE",          "ENODEORPHANINSTANCE")
 385   , ("CvENODEORPHANLV",                "ENODEORPHANLV")
 386   , ("CvENODERPC",                     "ENODERPC")
 387   , ("CvENODESSH",                     "ENODESSH")
 388   , ("CvENODEVERSION",                 "ENODEVERSION")
 389   , ("CvENODESETUP",                   "ENODESETUP")
 390   , ("CvENODETIME",                    "ENODETIME")
 391   , ("CvENODEOOBPATH",                 "ENODEOOBPATH")
 392   , ("CvENODEUSERSCRIPTS",             "ENODEUSERSCRIPTS")
 393   , ("CvENODEFILESTORAGEPATHS",        "ENODEFILESTORAGEPATHS")
 394   , ("CvENODEFILESTORAGEPATHUNUSABLE", "ENODEFILESTORAGEPATHUNUSABLE")
 395   , ("CvENODESHAREDFILESTORAGEPATHUNUSABLE",
 396      "ENODESHAREDFILESTORAGEPATHUNUSABLE")
 397   , ("CvEGROUPDIFFERENTPVSIZE",        "EGROUPDIFFERENTPVSIZE")
 398   ])
 399 $(THH.makeJSONInstance ''CVErrorCode)
 400
 401 -- | Dynamic device modification, just add\/remove version.
 402 $(THH.declareLADT ''String "DdmSimple"
 403      [ ("DdmSimpleAdd",    "add")
 404      , ("DdmSimpleRemove", "remove")
 405      ])
 406 $(THH.makeJSONInstance ''DdmSimple)
 407
 408 -- | Dynamic device modification, all operations version.
 409 --
 410 -- TODO: DDM_SWAP, DDM_MOVE?
 411 $(THH.declareLADT ''String "DdmFull"
 412      [ ("DdmFullAdd",    "add")
 413      , ("DdmFullRemove", "remove")
 414      , ("DdmFullModify", "modify")
 415      ])
 416 $(THH.makeJSONInstance ''DdmFull)
 417
 418 -- | Hypervisor type definitions.
 419 $(THH.declareLADT ''String "Hypervisor"
 420   [ ("Kvm",    "kvm")
 421   , ("XenPvm", "xen-pvm")
 422   , ("Chroot", "chroot")
 423   , ("XenHvm", "xen-hvm")
 424   , ("Lxc",    "lxc")
 425   , ("Fake",   "fake")
 426   ])
 427 $(THH.makeJSONInstance ''Hypervisor)
 428
 429 instance THH.PyValue Hypervisor where
 430   showValue = show . hypervisorToRaw
 431
 432 -- | Oob command type.
 433 $(THH.declareLADT ''String "OobCommand"
 434   [ ("OobHealth",      "health")
 435   , ("OobPowerCycle",  "power-cycle")
 436   , ("OobPowerOff",    "power-off")
 437   , ("OobPowerOn",     "power-on")
 438   , ("OobPowerStatus", "power-status")
 439   ])
 440 $(THH.makeJSONInstance ''OobCommand)
 441
 442 -- | Oob command status
 443 $(THH.declareLADT ''String "OobStatus"
 444   [ ("OobStatusCritical", "CRITICAL")
 445   , ("OobStatusOk",       "OK")
 446   , ("OobStatusUnknown",  "UNKNOWN")
 447   , ("OobStatusWarning",  "WARNING")
 448   ])
 449 $(THH.makeJSONInstance ''OobStatus)
 450
 451 -- | Storage type.
 452 $(THH.declareLADT ''String "StorageType"
 453   [ ("StorageFile", "file")
 454   , ("StorageLvmPv", "lvm-pv")
 455   , ("StorageLvmVg", "lvm-vg")
 456   , ("StorageDiskless", "diskless")
 457   , ("StorageBlock", "blockdev")
 458   , ("StorageRados", "rados")
 459   , ("StorageExt", "ext")
 460   ])
 461 $(THH.makeJSONInstance ''StorageType)
 462
 463 -- | Storage keys are identifiers for storage units. Their content varies
 464 -- depending on the storage type, for example a storage key for LVM storage
 465 -- is the volume group name.
 466 type StorageKey = String
 467
 468 -- | Storage parameters
 469 type SPExclusiveStorage = Bool
 470
 471 -- | Storage units without storage-type-specific parameters
 472 data StorageUnitRaw = SURaw StorageType StorageKey
 473
 474 -- | Full storage unit with storage-type-specific parameters
 475 data StorageUnit = SUFile StorageKey
 476                  | SULvmPv StorageKey SPExclusiveStorage
 477                  | SULvmVg StorageKey SPExclusiveStorage
 478                  | SUDiskless StorageKey
 479                  | SUBlock StorageKey
 480                  | SURados StorageKey
 481                  | SUExt StorageKey
 482                  deriving (Eq)
 483
 484 instance Show StorageUnit where
 485   show (SUFile key) = showSUSimple StorageFile key
 486   show (SULvmPv key es) = showSULvm StorageLvmPv key es
 487   show (SULvmVg key es) = showSULvm StorageLvmVg key es
 488   show (SUDiskless key) = showSUSimple StorageDiskless key
 489   show (SUBlock key) = showSUSimple StorageBlock key
 490   show (SURados key) = showSUSimple StorageRados key
 491   show (SUExt key) = showSUSimple StorageExt key
 492
 493 instance JSON StorageUnit where
 494   showJSON (SUFile key) = showJSON (StorageFile, key, []::[String])
 495   showJSON (SULvmPv key es) = showJSON (StorageLvmPv, key, [es])
 496   showJSON (SULvmVg key es) = showJSON (StorageLvmVg, key, [es])
 497   showJSON (SUDiskless key) = showJSON (StorageDiskless, key, []::[String])
 498   showJSON (SUBlock key) = showJSON (StorageBlock, key, []::[String])
 499   showJSON (SURados key) = showJSON (StorageRados, key, []::[String])
 500   showJSON (SUExt key) = showJSON (StorageExt, key, []::[String])
 501 -- FIXME: add readJSON implementation
 502   readJSON = fail "Not implemented"
 503
 504 -- | Composes a string representation of storage types without
 505 -- storage parameters
 506 showSUSimple :: StorageType -> StorageKey -> String
 507 showSUSimple st sk = show (storageTypeToRaw st, sk, []::[String])
 508
 509 -- | Composes a string representation of the LVM storage types
 510 showSULvm :: StorageType -> StorageKey -> SPExclusiveStorage -> String
 511 showSULvm st sk es = show (storageTypeToRaw st, sk, [es])
 512
 513 -- | Mapping from disk templates to storage types
 514 -- FIXME: This is semantically the same as the constant
 515 -- C.diskTemplatesStorageType, remove this when python constants
 516 -- are generated from haskell constants
 517 diskTemplateToStorageType :: DiskTemplate -> StorageType
 518 diskTemplateToStorageType DTExt = StorageExt
 519 diskTemplateToStorageType DTFile = StorageFile
 520 diskTemplateToStorageType DTSharedFile = StorageFile
 521 diskTemplateToStorageType DTDrbd8 = StorageLvmVg
 522 diskTemplateToStorageType DTPlain = StorageLvmVg
 523 diskTemplateToStorageType DTRbd = StorageRados
 524 diskTemplateToStorageType DTDiskless = StorageDiskless
 525 diskTemplateToStorageType DTBlock = StorageBlock
 526
 527 -- | Equips a raw storage unit with its parameters
 528 addParamsToStorageUnit :: SPExclusiveStorage -> StorageUnitRaw -> StorageUnit
 529 addParamsToStorageUnit _ (SURaw StorageBlock key) = SUBlock key
 530 addParamsToStorageUnit _ (SURaw StorageDiskless key) = SUDiskless key
 531 addParamsToStorageUnit _ (SURaw StorageExt key) = SUExt key
 532 addParamsToStorageUnit _ (SURaw StorageFile key) = SUFile key
 533 addParamsToStorageUnit es (SURaw StorageLvmPv key) = SULvmPv key es
 534 addParamsToStorageUnit es (SURaw StorageLvmVg key) = SULvmVg key es
 535 addParamsToStorageUnit _ (SURaw StorageRados key) = SURados key
 536
 537 -- | Node evac modes.
 538 --
 539 -- This is part of the 'IAllocator' interface and it is used, for
 540 -- example, in 'Ganeti.HTools.Loader.RqType'.  However, it must reside
 541 -- in this module, and not in 'Ganeti.HTools.Types', because it is
 542 -- also used by 'Ganeti.Constants'.
 543 $(THH.declareLADT ''String "EvacMode"
 544   [ ("ChangePrimary",   "primary-only")
 545   , ("ChangeSecondary", "secondary-only")
 546   , ("ChangeAll",       "all")
 547   ])
 548 $(THH.makeJSONInstance ''EvacMode)
 549
 550 -- | The file driver type.
 551 $(THH.declareLADT ''String "FileDriver"
 552   [ ("FileLoop",   "loop")
 553   , ("FileBlktap", "blktap")
 554   ])
 555 $(THH.makeJSONInstance ''FileDriver)
 556
 557 -- | The instance create mode.
 558 $(THH.declareLADT ''String "InstCreateMode"
 559   [ ("InstCreate",       "create")
 560   , ("InstImport",       "import")
 561   , ("InstRemoteImport", "remote-import")
 562   ])
 563 $(THH.makeJSONInstance ''InstCreateMode)
 564
 565 -- | Reboot type.
 566 $(THH.declareLADT ''String "RebootType"
 567   [ ("RebootSoft", "soft")
 568   , ("RebootHard", "hard")
 569   , ("RebootFull", "full")
 570   ])
 571 $(THH.makeJSONInstance ''RebootType)
 572
 573 -- | Export modes.
 574 $(THH.declareLADT ''String "ExportMode"
 575   [ ("ExportModeLocal",  "local")
 576   , ("ExportModeRemote", "remote")
 577   ])
 578 $(THH.makeJSONInstance ''ExportMode)
 579
 580 -- | IAllocator run types (OpTestIAllocator).
 581 $(THH.declareLADT ''String "IAllocatorTestDir"
 582   [ ("IAllocatorDirIn",  "in")
 583   , ("IAllocatorDirOut", "out")
 584   ])
 585 $(THH.makeJSONInstance ''IAllocatorTestDir)
 586
 587 -- | IAllocator mode. FIXME: use this in "HTools.Backend.IAlloc".
 588 $(THH.declareLADT ''String "IAllocatorMode"
 589   [ ("IAllocatorAlloc",       "allocate")
 590   , ("IAllocatorMultiAlloc",  "multi-allocate")
 591   , ("IAllocatorReloc",       "relocate")
 592   , ("IAllocatorNodeEvac",    "node-evacuate")
 593   , ("IAllocatorChangeGroup", "change-group")
 594   ])
 595 $(THH.makeJSONInstance ''IAllocatorMode)
 596
 597 -- | Network mode.
 598 $(THH.declareLADT ''String "NICMode"
 599   [ ("NMBridged", "bridged")
 600   , ("NMRouted",  "routed")
 601   , ("NMOvs",     "openvswitch")
 602   , ("NMPool",    "pool")
 603   ])
 604 $(THH.makeJSONInstance ''NICMode)
 605
 606 -- | The JobStatus data type. Note that this is ordered especially
 607 -- such that greater\/lesser comparison on values of this type makes
 608 -- sense.
 609 $(THH.declareLADT ''String "JobStatus"
 610   [ ("JOB_STATUS_QUEUED",    "queued")
 611   , ("JOB_STATUS_WAITING",   "waiting")
 612   , ("JOB_STATUS_CANCELING", "canceling")
 613   , ("JOB_STATUS_RUNNING",   "running")
 614   , ("JOB_STATUS_CANCELED",  "canceled")
 615   , ("JOB_STATUS_SUCCESS",   "success")
 616   , ("JOB_STATUS_ERROR",     "error")
 617   ])
 618 $(THH.makeJSONInstance ''JobStatus)
 619
 620 -- | Finalized job status.
 621 $(THH.declareLADT ''String "FinalizedJobStatus"
 622   [ ("JobStatusCanceled",   "canceled")
 623   , ("JobStatusSuccessful", "success")
 624   , ("JobStatusFailed",     "error")
 625   ])
 626 $(THH.makeJSONInstance ''FinalizedJobStatus)
 627
 628 -- | The Ganeti job type.
 629 newtype JobId = JobId { fromJobId :: Int }
 630   deriving (Show, Eq)
 631
 632 -- | Builds a job ID.
 633 makeJobId :: (Monad m) => Int -> m JobId
 634 makeJobId i | i >= 0 = return $ JobId i
 635             | otherwise = fail $ "Invalid value for job ID ' " ++ show i ++ "'"
 636
 637 -- | Builds a job ID from a string.
 638 makeJobIdS :: (Monad m) => String -> m JobId
 639 makeJobIdS s = tryRead "parsing job id" s >>= makeJobId
 640
 641 -- | Parses a job ID.
 642 parseJobId :: (Monad m) => JSON.JSValue -> m JobId
 643 parseJobId (JSON.JSString x) = makeJobIdS $ JSON.fromJSString x
 644 parseJobId (JSON.JSRational _ x) =
 645   if denominator x /= 1
 646     then fail $ "Got fractional job ID from master daemon?! Value:" ++ show x
 647     -- FIXME: potential integer overflow here on 32-bit platforms
 648     else makeJobId . fromIntegral . numerator $ x
 649 parseJobId x = fail $ "Wrong type/value for job id: " ++ show x
 650
 651 instance JSON.JSON JobId where
 652   showJSON = JSON.showJSON . fromJobId
 653   readJSON = parseJobId
 654
 655 -- | Relative job ID type alias.
 656 type RelativeJobId = Negative Int
 657
 658 -- | Job ID dependency.
 659 data JobIdDep = JobDepRelative RelativeJobId
 660               | JobDepAbsolute JobId
 661                 deriving (Show, Eq)
 662
 663 instance JSON.JSON JobIdDep where
 664   showJSON (JobDepRelative i) = showJSON i
 665   showJSON (JobDepAbsolute i) = showJSON i
 666   readJSON v =
 667     case JSON.readJSON v::JSON.Result (Negative Int) of
 668       -- first try relative dependency, usually most common
 669       JSON.Ok r -> return $ JobDepRelative r
 670       JSON.Error _ -> liftM JobDepAbsolute (parseJobId v)
 671
 672 -- | Job Dependency type.
 673 data JobDependency = JobDependency JobIdDep [FinalizedJobStatus]
 674                      deriving (Show, Eq)
 675
 676 instance JSON JobDependency where
 677   showJSON (JobDependency dep status) = showJSON (dep, status)
 678   readJSON = liftM (uncurry JobDependency) . readJSON
 679
 680 -- | Valid opcode priorities for submit.
 681 $(THH.declareIADT "OpSubmitPriority"
 682   [ ("OpPrioLow",    'ConstantUtils.priorityLow)
 683   , ("OpPrioNormal", 'ConstantUtils.priorityNormal)
 684   , ("OpPrioHigh",   'ConstantUtils.priorityHigh)
 685   ])
 686 $(THH.makeJSONInstance ''OpSubmitPriority)
 687
 688 -- | Parse submit priorities from a string.
 689 parseSubmitPriority :: (Monad m) => String -> m OpSubmitPriority
 690 parseSubmitPriority "low"    = return OpPrioLow
 691 parseSubmitPriority "normal" = return OpPrioNormal
 692 parseSubmitPriority "high"   = return OpPrioHigh
 693 parseSubmitPriority str      = fail $ "Unknown priority '" ++ str ++ "'"
 694
 695 -- | Format a submit priority as string.
 696 fmtSubmitPriority :: OpSubmitPriority -> String
 697 fmtSubmitPriority OpPrioLow    = "low"
 698 fmtSubmitPriority OpPrioNormal = "normal"
 699 fmtSubmitPriority OpPrioHigh   = "high"
 700
 701 -- | Our ADT for the OpCode status at runtime (while in a job).
 702 $(THH.declareLADT ''String "OpStatus"
 703   [ ("OP_STATUS_QUEUED",    "queued")
 704   , ("OP_STATUS_WAITING",   "waiting")
 705   , ("OP_STATUS_CANCELING", "canceling")
 706   , ("OP_STATUS_RUNNING",   "running")
 707   , ("OP_STATUS_CANCELED",  "canceled")
 708   , ("OP_STATUS_SUCCESS",   "success")
 709   , ("OP_STATUS_ERROR",     "error")
 710   ])
 711 $(THH.makeJSONInstance ''OpStatus)
 712
 713 -- | Type for the job message type.
 714 $(THH.declareLADT ''String "ELogType"
 715   [ ("ELogMessage",      "message")
 716   , ("ELogRemoteImport", "remote-import")
 717   , ("ELogJqueueTest",   "jqueue-test")
 718   ])
 719 $(THH.makeJSONInstance ''ELogType)
 720
 721 -- | Type of one element of a reason trail.
 722 type ReasonElem = (String, String, Integer)
 723
 724 -- | Type representing a reason trail.
 725 type ReasonTrail = [ReasonElem]
 726
 727 -- | The VTYPES, a mini-type system in Python.
 728 $(THH.declareLADT ''String "VType"
 729   [ ("VTypeString",      "string")
 730   , ("VTypeMaybeString", "maybe-string")
 731   , ("VTypeBool",        "bool")
 732   , ("VTypeSize",        "size")
 733   , ("VTypeInt",         "int")
 734   ])
 735 $(THH.makeJSONInstance ''VType)
 736
 737 instance THH.PyValue VType where
 738   showValue = THH.showValue . vTypeToRaw
 739
 740 -- * Node role type
 741
 742 $(THH.declareLADT ''String "NodeRole"
 743   [ ("NROffline",   "O")
 744   , ("NRDrained",   "D")
 745   , ("NRRegular",   "R")
 746   , ("NRCandidate", "C")
 747   , ("NRMaster",    "M")
 748   ])
 749 $(THH.makeJSONInstance ''NodeRole)
 750
 751 -- | The description of the node role.
 752 roleDescription :: NodeRole -> String
 753 roleDescription NROffline   = "offline"
 754 roleDescription NRDrained   = "drained"
 755 roleDescription NRRegular   = "regular"
 756 roleDescription NRCandidate = "master candidate"
 757 roleDescription NRMaster    = "master"
 758
 759 -- * Disk types
 760
 761 $(THH.declareLADT ''String "DiskMode"
 762   [ ("DiskRdOnly", "ro")
 763   , ("DiskRdWr",   "rw")
 764   ])
 765 $(THH.makeJSONInstance ''DiskMode)
 766
 767 -- | The persistent block driver type. Currently only one type is allowed.
 768 $(THH.declareLADT ''String "BlockDriver"
 769   [ ("BlockDrvManual", "manual")
 770   ])
 771 $(THH.makeJSONInstance ''BlockDriver)
 772
 773 -- * Instance types
 774
 775 $(THH.declareLADT ''String "AdminState"
 776   [ ("AdminOffline", "offline")
 777   , ("AdminDown",    "down")
 778   , ("AdminUp",      "up")
 779   ])
 780 $(THH.makeJSONInstance ''AdminState)
 781
 782 -- * Storage field type
 783
 784 $(THH.declareLADT ''String "StorageField"
 785   [ ( "SFUsed",        "used")
 786   , ( "SFName",        "name")
 787   , ( "SFAllocatable", "allocatable")
 788   , ( "SFFree",        "free")
 789   , ( "SFSize",        "size")
 790   ])
 791 $(THH.makeJSONInstance ''StorageField)
 792
 793 -- * Disk access protocol
 794
 795 $(THH.declareLADT ''String "DiskAccessMode"
 796   [ ( "DiskUserspace",   "userspace")
 797   , ( "DiskKernelspace", "kernelspace")
 798   ])
 799 $(THH.makeJSONInstance ''DiskAccessMode)
 800
 801 -- | Local disk status
 802 --
 803 -- Python code depends on:
 804 --   DiskStatusOk < DiskStatusUnknown < DiskStatusFaulty
 805 $(THH.declareILADT "LocalDiskStatus"
 806   [ ("DiskStatusFaulty",  3)
 807   , ("DiskStatusOk",      1)
 808   , ("DiskStatusUnknown", 2)
 809   ])
 810
 811 localDiskStatusName :: LocalDiskStatus -> String
 812 localDiskStatusName DiskStatusFaulty = "faulty"
 813 localDiskStatusName DiskStatusOk = "ok"
 814 localDiskStatusName DiskStatusUnknown = "unknown"
 815
 816 -- | Replace disks type.
 817 $(THH.declareLADT ''String "ReplaceDisksMode"
 818   [ -- Replace disks on primary
 819     ("ReplaceOnPrimary",    "replace_on_primary")
 820     -- Replace disks on secondary
 821   , ("ReplaceOnSecondary",  "replace_on_secondary")
 822     -- Change secondary node
 823   , ("ReplaceNewSecondary", "replace_new_secondary")
 824   , ("ReplaceAuto",         "replace_auto")
 825   ])
 826 $(THH.makeJSONInstance ''ReplaceDisksMode)
 827
 828 -- | Basic timeouts for RPC calls.
 829 $(THH.declareILADT "RpcTimeout"
 830   [ ("Urgent",    60)       -- 1 minute
 831   , ("Fast",      5 * 60)   -- 5 minutes
 832   , ("Normal",    15 * 60)  -- 15 minutes
 833   , ("Slow",      3600)     -- 1 hour
 834   , ("FourHours", 4 * 3600) -- 4 hours
 835   , ("OneDay",    86400)    -- 1 day
 836   ])
 837
 838 -- | Hotplug action.
 839
 840 $(THH.declareLADT ''String "HotplugAction"
 841   [ ("HAAdd", "hotadd")
 842   , ("HARemove",  "hotremove")
 843   , ("HAMod",     "hotmod")
 844   ])
 845 $(THH.makeJSONInstance ''HotplugAction)
 846
 847 -- | Hotplug Device Target.
 848
 849 $(THH.declareLADT ''String "HotplugTarget"
 850   [ ("HTDisk", "hotdisk")
 851   , ("HTNic",  "hotnic")
 852   ])
 853 $(THH.makeJSONInstance ''HotplugTarget)