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   , ("FileBlktap2", "blktap2")
 555   ])
 556 $(THH.makeJSONInstance ''FileDriver)
 557
 558 -- | The instance create mode.
 559 $(THH.declareLADT ''String "InstCreateMode"
 560   [ ("InstCreate",       "create")
 561   , ("InstImport",       "import")
 562   , ("InstRemoteImport", "remote-import")
 563   ])
 564 $(THH.makeJSONInstance ''InstCreateMode)
 565
 566 -- | Reboot type.
 567 $(THH.declareLADT ''String "RebootType"
 568   [ ("RebootSoft", "soft")
 569   , ("RebootHard", "hard")
 570   , ("RebootFull", "full")
 571   ])
 572 $(THH.makeJSONInstance ''RebootType)
 573
 574 -- | Export modes.
 575 $(THH.declareLADT ''String "ExportMode"
 576   [ ("ExportModeLocal",  "local")
 577   , ("ExportModeRemote", "remote")
 578   ])
 579 $(THH.makeJSONInstance ''ExportMode)
 580
 581 -- | IAllocator run types (OpTestIAllocator).
 582 $(THH.declareLADT ''String "IAllocatorTestDir"
 583   [ ("IAllocatorDirIn",  "in")
 584   , ("IAllocatorDirOut", "out")
 585   ])
 586 $(THH.makeJSONInstance ''IAllocatorTestDir)
 587
 588 -- | IAllocator mode. FIXME: use this in "HTools.Backend.IAlloc".
 589 $(THH.declareLADT ''String "IAllocatorMode"
 590   [ ("IAllocatorAlloc",       "allocate")
 591   , ("IAllocatorMultiAlloc",  "multi-allocate")
 592   , ("IAllocatorReloc",       "relocate")
 593   , ("IAllocatorNodeEvac",    "node-evacuate")
 594   , ("IAllocatorChangeGroup", "change-group")
 595   ])
 596 $(THH.makeJSONInstance ''IAllocatorMode)
 597
 598 -- | Network mode.
 599 $(THH.declareLADT ''String "NICMode"
 600   [ ("NMBridged", "bridged")
 601   , ("NMRouted",  "routed")
 602   , ("NMOvs",     "openvswitch")
 603   , ("NMPool",    "pool")
 604   ])
 605 $(THH.makeJSONInstance ''NICMode)
 606
 607 -- | The JobStatus data type. Note that this is ordered especially
 608 -- such that greater\/lesser comparison on values of this type makes
 609 -- sense.
 610 $(THH.declareLADT ''String "JobStatus"
 611   [ ("JOB_STATUS_QUEUED",    "queued")
 612   , ("JOB_STATUS_WAITING",   "waiting")
 613   , ("JOB_STATUS_CANCELING", "canceling")
 614   , ("JOB_STATUS_RUNNING",   "running")
 615   , ("JOB_STATUS_CANCELED",  "canceled")
 616   , ("JOB_STATUS_SUCCESS",   "success")
 617   , ("JOB_STATUS_ERROR",     "error")
 618   ])
 619 $(THH.makeJSONInstance ''JobStatus)
 620
 621 -- | Finalized job status.
 622 $(THH.declareLADT ''String "FinalizedJobStatus"
 623   [ ("JobStatusCanceled",   "canceled")
 624   , ("JobStatusSuccessful", "success")
 625   , ("JobStatusFailed",     "error")
 626   ])
 627 $(THH.makeJSONInstance ''FinalizedJobStatus)
 628
 629 -- | The Ganeti job type.
 630 newtype JobId = JobId { fromJobId :: Int }
 631   deriving (Show, Eq)
 632
 633 -- | Builds a job ID.
 634 makeJobId :: (Monad m) => Int -> m JobId
 635 makeJobId i | i >= 0 = return $ JobId i
 636             | otherwise = fail $ "Invalid value for job ID ' " ++ show i ++ "'"
 637
 638 -- | Builds a job ID from a string.
 639 makeJobIdS :: (Monad m) => String -> m JobId
 640 makeJobIdS s = tryRead "parsing job id" s >>= makeJobId
 641
 642 -- | Parses a job ID.
 643 parseJobId :: (Monad m) => JSON.JSValue -> m JobId
 644 parseJobId (JSON.JSString x) = makeJobIdS $ JSON.fromJSString x
 645 parseJobId (JSON.JSRational _ x) =
 646   if denominator x /= 1
 647     then fail $ "Got fractional job ID from master daemon?! Value:" ++ show x
 648     -- FIXME: potential integer overflow here on 32-bit platforms
 649     else makeJobId . fromIntegral . numerator $ x
 650 parseJobId x = fail $ "Wrong type/value for job id: " ++ show x
 651
 652 instance JSON.JSON JobId where
 653   showJSON = JSON.showJSON . fromJobId
 654   readJSON = parseJobId
 655
 656 -- | Relative job ID type alias.
 657 type RelativeJobId = Negative Int
 658
 659 -- | Job ID dependency.
 660 data JobIdDep = JobDepRelative RelativeJobId
 661               | JobDepAbsolute JobId
 662                 deriving (Show, Eq)
 663
 664 instance JSON.JSON JobIdDep where
 665   showJSON (JobDepRelative i) = showJSON i
 666   showJSON (JobDepAbsolute i) = showJSON i
 667   readJSON v =
 668     case JSON.readJSON v::JSON.Result (Negative Int) of
 669       -- first try relative dependency, usually most common
 670       JSON.Ok r -> return $ JobDepRelative r
 671       JSON.Error _ -> liftM JobDepAbsolute (parseJobId v)
 672
 673 -- | Job Dependency type.
 674 data JobDependency = JobDependency JobIdDep [FinalizedJobStatus]
 675                      deriving (Show, Eq)
 676
 677 instance JSON JobDependency where
 678   showJSON (JobDependency dep status) = showJSON (dep, status)
 679   readJSON = liftM (uncurry JobDependency) . readJSON
 680
 681 -- | Valid opcode priorities for submit.
 682 $(THH.declareIADT "OpSubmitPriority"
 683   [ ("OpPrioLow",    'ConstantUtils.priorityLow)
 684   , ("OpPrioNormal", 'ConstantUtils.priorityNormal)
 685   , ("OpPrioHigh",   'ConstantUtils.priorityHigh)
 686   ])
 687 $(THH.makeJSONInstance ''OpSubmitPriority)
 688
 689 -- | Parse submit priorities from a string.
 690 parseSubmitPriority :: (Monad m) => String -> m OpSubmitPriority
 691 parseSubmitPriority "low"    = return OpPrioLow
 692 parseSubmitPriority "normal" = return OpPrioNormal
 693 parseSubmitPriority "high"   = return OpPrioHigh
 694 parseSubmitPriority str      = fail $ "Unknown priority '" ++ str ++ "'"
 695
 696 -- | Format a submit priority as string.
 697 fmtSubmitPriority :: OpSubmitPriority -> String
 698 fmtSubmitPriority OpPrioLow    = "low"
 699 fmtSubmitPriority OpPrioNormal = "normal"
 700 fmtSubmitPriority OpPrioHigh   = "high"
 701
 702 -- | Our ADT for the OpCode status at runtime (while in a job).
 703 $(THH.declareLADT ''String "OpStatus"
 704   [ ("OP_STATUS_QUEUED",    "queued")
 705   , ("OP_STATUS_WAITING",   "waiting")
 706   , ("OP_STATUS_CANCELING", "canceling")
 707   , ("OP_STATUS_RUNNING",   "running")
 708   , ("OP_STATUS_CANCELED",  "canceled")
 709   , ("OP_STATUS_SUCCESS",   "success")
 710   , ("OP_STATUS_ERROR",     "error")
 711   ])
 712 $(THH.makeJSONInstance ''OpStatus)
 713
 714 -- | Type for the job message type.
 715 $(THH.declareLADT ''String "ELogType"
 716   [ ("ELogMessage",      "message")
 717   , ("ELogRemoteImport", "remote-import")
 718   , ("ELogJqueueTest",   "jqueue-test")
 719   ])
 720 $(THH.makeJSONInstance ''ELogType)
 721
 722 -- | Type of one element of a reason trail.
 723 type ReasonElem = (String, String, Integer)
 724
 725 -- | Type representing a reason trail.
 726 type ReasonTrail = [ReasonElem]
 727
 728 -- | The VTYPES, a mini-type system in Python.
 729 $(THH.declareLADT ''String "VType"
 730   [ ("VTypeString",      "string")
 731   , ("VTypeMaybeString", "maybe-string")
 732   , ("VTypeBool",        "bool")
 733   , ("VTypeSize",        "size")
 734   , ("VTypeInt",         "int")
 735   ])
 736 $(THH.makeJSONInstance ''VType)
 737
 738 instance THH.PyValue VType where
 739   showValue = THH.showValue . vTypeToRaw
 740
 741 -- * Node role type
 742
 743 $(THH.declareLADT ''String "NodeRole"
 744   [ ("NROffline",   "O")
 745   , ("NRDrained",   "D")
 746   , ("NRRegular",   "R")
 747   , ("NRCandidate", "C")
 748   , ("NRMaster",    "M")
 749   ])
 750 $(THH.makeJSONInstance ''NodeRole)
 751
 752 -- | The description of the node role.
 753 roleDescription :: NodeRole -> String
 754 roleDescription NROffline   = "offline"
 755 roleDescription NRDrained   = "drained"
 756 roleDescription NRRegular   = "regular"
 757 roleDescription NRCandidate = "master candidate"
 758 roleDescription NRMaster    = "master"
 759
 760 -- * Disk types
 761
 762 $(THH.declareLADT ''String "DiskMode"
 763   [ ("DiskRdOnly", "ro")
 764   , ("DiskRdWr",   "rw")
 765   ])
 766 $(THH.makeJSONInstance ''DiskMode)
 767
 768 -- | The persistent block driver type. Currently only one type is allowed.
 769 $(THH.declareLADT ''String "BlockDriver"
 770   [ ("BlockDrvManual", "manual")
 771   ])
 772 $(THH.makeJSONInstance ''BlockDriver)
 773
 774 -- * Instance types
 775
 776 $(THH.declareLADT ''String "AdminState"
 777   [ ("AdminOffline", "offline")
 778   , ("AdminDown",    "down")
 779   , ("AdminUp",      "up")
 780   ])
 781 $(THH.makeJSONInstance ''AdminState)
 782
 783 -- * Storage field type
 784
 785 $(THH.declareLADT ''String "StorageField"
 786   [ ( "SFUsed",        "used")
 787   , ( "SFName",        "name")
 788   , ( "SFAllocatable", "allocatable")
 789   , ( "SFFree",        "free")
 790   , ( "SFSize",        "size")
 791   ])
 792 $(THH.makeJSONInstance ''StorageField)
 793
 794 -- * Disk access protocol
 795
 796 $(THH.declareLADT ''String "DiskAccessMode"
 797   [ ( "DiskUserspace",   "userspace")
 798   , ( "DiskKernelspace", "kernelspace")
 799   ])
 800 $(THH.makeJSONInstance ''DiskAccessMode)
 801
 802 -- | Local disk status
 803 --
 804 -- Python code depends on:
 805 --   DiskStatusOk < DiskStatusUnknown < DiskStatusFaulty
 806 $(THH.declareILADT "LocalDiskStatus"
 807   [ ("DiskStatusFaulty",  3)
 808   , ("DiskStatusOk",      1)
 809   , ("DiskStatusUnknown", 2)
 810   ])
 811
 812 localDiskStatusName :: LocalDiskStatus -> String
 813 localDiskStatusName DiskStatusFaulty = "faulty"
 814 localDiskStatusName DiskStatusOk = "ok"
 815 localDiskStatusName DiskStatusUnknown = "unknown"
 816
 817 -- | Replace disks type.
 818 $(THH.declareLADT ''String "ReplaceDisksMode"
 819   [ -- Replace disks on primary
 820     ("ReplaceOnPrimary",    "replace_on_primary")
 821     -- Replace disks on secondary
 822   , ("ReplaceOnSecondary",  "replace_on_secondary")
 823     -- Change secondary node
 824   , ("ReplaceNewSecondary", "replace_new_secondary")
 825   , ("ReplaceAuto",         "replace_auto")
 826   ])
 827 $(THH.makeJSONInstance ''ReplaceDisksMode)
 828
 829 -- | Basic timeouts for RPC calls.
 830 $(THH.declareILADT "RpcTimeout"
 831   [ ("Urgent",    60)       -- 1 minute
 832   , ("Fast",      5 * 60)   -- 5 minutes
 833   , ("Normal",    15 * 60)  -- 15 minutes
 834   , ("Slow",      3600)     -- 1 hour
 835   , ("FourHours", 4 * 3600) -- 4 hours
 836   , ("OneDay",    86400)    -- 1 day
 837   ])
 838
 839 -- | Hotplug action.
 840
 841 $(THH.declareLADT ''String "HotplugAction"
 842   [ ("HAAdd", "hotadd")
 843   , ("HARemove",  "hotremove")
 844   , ("HAMod",     "hotmod")
 845   ])
 846 $(THH.makeJSONInstance ''HotplugAction)
 847
 848 -- | Hotplug Device Target.
 849
 850 $(THH.declareLADT ''String "HotplugTarget"
 851   [ ("HTDisk", "hotdisk")
 852   , ("HTNic",  "hotnic")
 853   ])
 854 $(THH.makeJSONInstance ''HotplugTarget)