module Ganeti.Types
( AllocPolicy(..)
, allocPolicyFromRaw
, allocPolicyToRaw
, InstanceStatus(..)
, instanceStatusFromRaw
, instanceStatusToRaw
, DiskTemplate(..)
, diskTemplateToRaw
, diskTemplateFromRaw
, diskTemplateMovable
, TagKind(..)
, tagKindToRaw
, tagKindFromRaw
, NonNegative
, fromNonNegative
, mkNonNegative
, Positive
, fromPositive
, mkPositive
, Negative
, fromNegative
, mkNegative
, NonEmpty
, fromNonEmpty
, mkNonEmpty
, NonEmptyString
, QueryResultCode
, IPv4Address
, mkIPv4Address
, IPv4Network
, mkIPv4Network
, IPv6Address
, mkIPv6Address
, IPv6Network
, mkIPv6Network
, MigrationMode(..)
, migrationModeToRaw
, VerifyOptionalChecks(..)
, verifyOptionalChecksToRaw
, DdmSimple(..)
, DdmFull(..)
, ddmFullToRaw
, CVErrorCode(..)
, cVErrorCodeToRaw
, Hypervisor(..)
, hypervisorFromRaw
, hypervisorToRaw
, OobCommand(..)
, oobCommandToRaw
, OobStatus(..)
, oobStatusToRaw
, StorageType(..)
, storageTypeToRaw
, EvacMode(..)
, evacModeToRaw
, FileDriver(..)
, fileDriverToRaw
, InstCreateMode(..)
, instCreateModeToRaw
, RebootType(..)
, rebootTypeToRaw
, ExportMode(..)
, exportModeToRaw
, IAllocatorTestDir(..)
, iAllocatorTestDirToRaw
, IAllocatorMode(..)
, iAllocatorModeToRaw
, NICMode(..)
, nICModeToRaw
, JobStatus(..)
, jobStatusToRaw
, jobStatusFromRaw
, FinalizedJobStatus(..)
, finalizedJobStatusToRaw
, JobId
, fromJobId
, makeJobId
, makeJobIdS
, RelativeJobId
, JobIdDep(..)
, JobDependency(..)
, absoluteJobDependency
, getJobIdFromDependency
, OpSubmitPriority(..)
, opSubmitPriorityToRaw
, parseSubmitPriority
, fmtSubmitPriority
, OpStatus(..)
, opStatusToRaw
, opStatusFromRaw
, ELogType(..)
, eLogTypeToRaw
, ReasonElem
, ReasonTrail
, StorageUnit(..)
, StorageUnitRaw(..)
, StorageKey
, addParamsToStorageUnit
, diskTemplateToStorageType
, VType(..)
, vTypeFromRaw
, vTypeToRaw
, NodeRole(..)
, nodeRoleToRaw
, roleDescription
, DiskMode(..)
, diskModeToRaw
, BlockDriver(..)
, blockDriverToRaw
, AdminState(..)
, adminStateFromRaw
, adminStateToRaw
, AdminStateSource(..)
, adminStateSourceFromRaw
, adminStateSourceToRaw
, StorageField(..)
, storageFieldToRaw
, DiskAccessMode(..)
, diskAccessModeToRaw
, LocalDiskStatus(..)
, localDiskStatusFromRaw
, localDiskStatusToRaw
, localDiskStatusName
, ReplaceDisksMode(..)
, replaceDisksModeToRaw
, RpcTimeout(..)
, rpcTimeoutFromRaw
, rpcTimeoutToRaw
, HotplugTarget(..)
, hotplugTargetToRaw
, HotplugAction(..)
, hotplugActionToRaw
, SshKeyType(..)
, sshKeyTypeToRaw
, Private(..)
, showPrivateJSObject
, Secret(..)
, showSecretJSObject
, revealValInJSObject
, redacted
, HvParams
, OsParams
, OsParamsPrivate
, TimeStampObject(..)
, UuidObject(..)
, ForthcomingObject(..)
, SerialNoObject(..)
, TagsObject(..)
) where
import Control.Applicative
import Control.Monad (liftM)
import qualified Text.JSON as JSON
import Text.JSON (JSON, readJSON, showJSON)
import Data.Ratio (numerator, denominator)
import qualified Data.Set as Set
import System.Time (ClockTime)
import qualified Ganeti.ConstantUtils as ConstantUtils
import Ganeti.JSON
import qualified Ganeti.THH as THH
import Ganeti.Utils
newtype NonNegative a = NonNegative { fromNonNegative :: a }
deriving (Show, Eq, Ord)
mkNonNegative :: (Monad m, Num a, Ord a, Show a) => a -> m (NonNegative a)
mkNonNegative i | i >= 0 = return (NonNegative i)
| otherwise = fail $ "Invalid value for non-negative type '" ++
show i ++ "'"
instance (JSON.JSON a, Num a, Ord a, Show a) => JSON.JSON (NonNegative a) where
showJSON = JSON.showJSON . fromNonNegative
readJSON v = JSON.readJSON v >>= mkNonNegative
newtype Positive a = Positive { fromPositive :: a }
deriving (Show, Eq, Ord)
mkPositive :: (Monad m, Num a, Ord a, Show a) => a -> m (Positive a)
mkPositive i | i > 0 = return (Positive i)
| otherwise = fail $ "Invalid value for positive type '" ++
show i ++ "'"
instance (JSON.JSON a, Num a, Ord a, Show a) => JSON.JSON (Positive a) where
showJSON = JSON.showJSON . fromPositive
readJSON v = JSON.readJSON v >>= mkPositive
newtype Negative a = Negative { fromNegative :: a }
deriving (Show, Eq, Ord)
mkNegative :: (Monad m, Num a, Ord a, Show a) => a -> m (Negative a)
mkNegative i | i < 0 = return (Negative i)
| otherwise = fail $ "Invalid value for negative type '" ++
show i ++ "'"
instance (JSON.JSON a, Num a, Ord a, Show a) => JSON.JSON (Negative a) where
showJSON = JSON.showJSON . fromNegative
readJSON v = JSON.readJSON v >>= mkNegative
newtype NonEmpty a = NonEmpty { fromNonEmpty :: [a] }
deriving (Show, Eq, Ord)
mkNonEmpty :: (Monad m) => [a] -> m (NonEmpty a)
mkNonEmpty [] = fail "Received empty value for non-empty list"
mkNonEmpty xs = return (NonEmpty xs)
instance (JSON.JSON a) => JSON.JSON (NonEmpty a) where
showJSON = JSON.showJSON . fromNonEmpty
readJSON v = JSON.readJSON v >>= mkNonEmpty
type NonEmptyString = NonEmpty Char
type QueryResultCode = Int
newtype IPv4Address = IPv4Address { fromIPv4Address :: String }
deriving (Show, Eq, Ord)
mkIPv4Address :: Monad m => String -> m IPv4Address
mkIPv4Address address =
return IPv4Address { fromIPv4Address = address }
instance JSON.JSON IPv4Address where
showJSON = JSON.showJSON . fromIPv4Address
readJSON v = JSON.readJSON v >>= mkIPv4Address
newtype IPv4Network = IPv4Network { fromIPv4Network :: String }
deriving (Show, Eq, Ord)
mkIPv4Network :: Monad m => String -> m IPv4Network
mkIPv4Network address =
return IPv4Network { fromIPv4Network = address }
instance JSON.JSON IPv4Network where
showJSON = JSON.showJSON . fromIPv4Network
readJSON v = JSON.readJSON v >>= mkIPv4Network
newtype IPv6Address = IPv6Address { fromIPv6Address :: String }
deriving (Show, Eq, Ord)
mkIPv6Address :: Monad m => String -> m IPv6Address
mkIPv6Address address =
return IPv6Address { fromIPv6Address = address }
instance JSON.JSON IPv6Address where
showJSON = JSON.showJSON . fromIPv6Address
readJSON v = JSON.readJSON v >>= mkIPv6Address
newtype IPv6Network = IPv6Network { fromIPv6Network :: String }
deriving (Show, Eq, Ord)
mkIPv6Network :: Monad m => String -> m IPv6Network
mkIPv6Network address =
return IPv6Network { fromIPv6Network = address }
instance JSON.JSON IPv6Network where
showJSON = JSON.showJSON . fromIPv6Network
readJSON v = JSON.readJSON v >>= mkIPv6Network
$(THH.declareLADT ''String "DiskTemplate"
[ ("DTDiskless", "diskless")
, ("DTFile", "file")
, ("DTSharedFile", "sharedfile")
, ("DTPlain", "plain")
, ("DTBlock", "blockdev")
, ("DTDrbd8", "drbd")
, ("DTRbd", "rbd")
, ("DTExt", "ext")
, ("DTGluster", "gluster")
])
$(THH.makeJSONInstance ''DiskTemplate)
instance THH.PyValue DiskTemplate where
showValue = show . diskTemplateToRaw
instance HasStringRepr DiskTemplate where
fromStringRepr = diskTemplateFromRaw
toStringRepr = diskTemplateToRaw
diskTemplateMovable :: DiskTemplate -> Bool
diskTemplateMovable DTDiskless = True
diskTemplateMovable DTFile = False
diskTemplateMovable DTSharedFile = True
diskTemplateMovable DTPlain = False
diskTemplateMovable DTBlock = False
diskTemplateMovable DTDrbd8 = False
diskTemplateMovable DTRbd = True
diskTemplateMovable DTExt = True
diskTemplateMovable DTGluster = True
$(THH.declareLADT ''String "TagKind"
[ ("TagKindInstance", "instance")
, ("TagKindNode", "node")
, ("TagKindGroup", "nodegroup")
, ("TagKindCluster", "cluster")
, ("TagKindNetwork", "network")
])
$(THH.makeJSONInstance ''TagKind)
$(THH.declareLADT ''String "AllocPolicy"
[ ("AllocPreferred", "preferred")
, ("AllocLastResort", "last_resort")
, ("AllocUnallocable", "unallocable")
])
$(THH.makeJSONInstance ''AllocPolicy)
$(THH.declareLADT ''String "InstanceStatus"
[ ("StatusDown", "ADMIN_down")
, ("StatusOffline", "ADMIN_offline")
, ("ErrorDown", "ERROR_down")
, ("ErrorUp", "ERROR_up")
, ("NodeDown", "ERROR_nodedown")
, ("NodeOffline", "ERROR_nodeoffline")
, ("Running", "running")
, ("UserDown", "USER_down")
, ("WrongNode", "ERROR_wrongnode")
])
$(THH.makeJSONInstance ''InstanceStatus)
$(THH.declareLADT ''String "MigrationMode"
[ ("MigrationLive", "live")
, ("MigrationNonLive", "non-live")
])
$(THH.makeJSONInstance ''MigrationMode)
$(THH.declareLADT ''String "VerifyOptionalChecks"
[ ("VerifyNPlusOneMem", "nplusone_mem")
])
$(THH.makeJSONInstance ''VerifyOptionalChecks)
$(THH.declareLADT ''String "CVErrorCode"
[ ("CvECLUSTERCFG", "ECLUSTERCFG")
, ("CvECLUSTERCERT", "ECLUSTERCERT")
, ("CvECLUSTERCLIENTCERT", "ECLUSTERCLIENTCERT")
, ("CvECLUSTERFILECHECK", "ECLUSTERFILECHECK")
, ("CvECLUSTERDANGLINGNODES", "ECLUSTERDANGLINGNODES")
, ("CvECLUSTERDANGLINGINST", "ECLUSTERDANGLINGINST")
, ("CvEINSTANCEBADNODE", "EINSTANCEBADNODE")
, ("CvEINSTANCEDOWN", "EINSTANCEDOWN")
, ("CvEINSTANCELAYOUT", "EINSTANCELAYOUT")
, ("CvEINSTANCEMISSINGDISK", "EINSTANCEMISSINGDISK")
, ("CvEINSTANCEFAULTYDISK", "EINSTANCEFAULTYDISK")
, ("CvEINSTANCEWRONGNODE", "EINSTANCEWRONGNODE")
, ("CvEINSTANCESPLITGROUPS", "EINSTANCESPLITGROUPS")
, ("CvEINSTANCEPOLICY", "EINSTANCEPOLICY")
, ("CvEINSTANCEUNSUITABLENODE", "EINSTANCEUNSUITABLENODE")
, ("CvEINSTANCEMISSINGCFGPARAMETER", "EINSTANCEMISSINGCFGPARAMETER")
, ("CvENODEDRBD", "ENODEDRBD")
, ("CvENODEDRBDVERSION", "ENODEDRBDVERSION")
, ("CvENODEDRBDHELPER", "ENODEDRBDHELPER")
, ("CvENODEFILECHECK", "ENODEFILECHECK")
, ("CvENODEHOOKS", "ENODEHOOKS")
, ("CvENODEHV", "ENODEHV")
, ("CvENODELVM", "ENODELVM")
, ("CvENODEN1", "ENODEN1")
, ("CvENODENET", "ENODENET")
, ("CvENODEOS", "ENODEOS")
, ("CvENODEORPHANINSTANCE", "ENODEORPHANINSTANCE")
, ("CvENODEORPHANLV", "ENODEORPHANLV")
, ("CvENODERPC", "ENODERPC")
, ("CvENODESSH", "ENODESSH")
, ("CvENODEVERSION", "ENODEVERSION")
, ("CvENODESETUP", "ENODESETUP")
, ("CvENODETIME", "ENODETIME")
, ("CvENODEOOBPATH", "ENODEOOBPATH")
, ("CvENODEUSERSCRIPTS", "ENODEUSERSCRIPTS")
, ("CvENODEFILESTORAGEPATHS", "ENODEFILESTORAGEPATHS")
, ("CvENODEFILESTORAGEPATHUNUSABLE", "ENODEFILESTORAGEPATHUNUSABLE")
, ("CvENODESHAREDFILESTORAGEPATHUNUSABLE",
"ENODESHAREDFILESTORAGEPATHUNUSABLE")
, ("CvENODEGLUSTERSTORAGEPATHUNUSABLE",
"ENODEGLUSTERSTORAGEPATHUNUSABLE")
, ("CvEGROUPDIFFERENTPVSIZE", "EGROUPDIFFERENTPVSIZE")
, ("CvEEXTAGS", "EEXTAGS")
])
$(THH.makeJSONInstance ''CVErrorCode)
$(THH.declareLADT ''String "DdmSimple"
[ ("DdmSimpleAdd", "add")
, ("DdmSimpleAttach", "attach")
, ("DdmSimpleRemove", "remove")
, ("DdmSimpleDetach", "detach")
])
$(THH.makeJSONInstance ''DdmSimple)
$(THH.declareLADT ''String "DdmFull"
[ ("DdmFullAdd", "add")
, ("DdmFullAttach", "attach")
, ("DdmFullRemove", "remove")
, ("DdmFullDetach", "detach")
, ("DdmFullModify", "modify")
])
$(THH.makeJSONInstance ''DdmFull)
$(THH.declareLADT ''String "Hypervisor"
[ ("Kvm", "kvm")
, ("XenPvm", "xen-pvm")
, ("Chroot", "chroot")
, ("XenHvm", "xen-hvm")
, ("Lxc", "lxc")
, ("Fake", "fake")
])
$(THH.makeJSONInstance ''Hypervisor)
instance THH.PyValue Hypervisor where
showValue = show . hypervisorToRaw
instance HasStringRepr Hypervisor where
fromStringRepr = hypervisorFromRaw
toStringRepr = hypervisorToRaw
$(THH.declareLADT ''String "OobCommand"
[ ("OobHealth", "health")
, ("OobPowerCycle", "power-cycle")
, ("OobPowerOff", "power-off")
, ("OobPowerOn", "power-on")
, ("OobPowerStatus", "power-status")
])
$(THH.makeJSONInstance ''OobCommand)
$(THH.declareLADT ''String "OobStatus"
[ ("OobStatusCritical", "CRITICAL")
, ("OobStatusOk", "OK")
, ("OobStatusUnknown", "UNKNOWN")
, ("OobStatusWarning", "WARNING")
])
$(THH.makeJSONInstance ''OobStatus)
$(THH.declareLADT ''String "StorageType"
[ ("StorageFile", "file")
, ("StorageSharedFile", "sharedfile")
, ("StorageGluster", "gluster")
, ("StorageLvmPv", "lvm-pv")
, ("StorageLvmVg", "lvm-vg")
, ("StorageDiskless", "diskless")
, ("StorageBlock", "blockdev")
, ("StorageRados", "rados")
, ("StorageExt", "ext")
])
$(THH.makeJSONInstance ''StorageType)
type StorageKey = String
type SPExclusiveStorage = Bool
data StorageUnitRaw = SURaw StorageType StorageKey
data StorageUnit = SUFile StorageKey
| SUSharedFile StorageKey
| SUGluster StorageKey
| SULvmPv StorageKey SPExclusiveStorage
| SULvmVg StorageKey SPExclusiveStorage
| SUDiskless StorageKey
| SUBlock StorageKey
| SURados StorageKey
| SUExt StorageKey
deriving (Eq)
instance Show StorageUnit where
show (SUFile key) = showSUSimple StorageFile key
show (SUSharedFile key) = showSUSimple StorageSharedFile key
show (SUGluster key) = showSUSimple StorageGluster key
show (SULvmPv key es) = showSULvm StorageLvmPv key es
show (SULvmVg key es) = showSULvm StorageLvmVg key es
show (SUDiskless key) = showSUSimple StorageDiskless key
show (SUBlock key) = showSUSimple StorageBlock key
show (SURados key) = showSUSimple StorageRados key
show (SUExt key) = showSUSimple StorageExt key
instance JSON StorageUnit where
showJSON (SUFile key) = showJSON (StorageFile, key, []::[String])
showJSON (SUSharedFile key) = showJSON (StorageSharedFile, key, []::[String])
showJSON (SUGluster key) = showJSON (StorageGluster, key, []::[String])
showJSON (SULvmPv key es) = showJSON (StorageLvmPv, key, [es])
showJSON (SULvmVg key es) = showJSON (StorageLvmVg, key, [es])
showJSON (SUDiskless key) = showJSON (StorageDiskless, key, []::[String])
showJSON (SUBlock key) = showJSON (StorageBlock, key, []::[String])
showJSON (SURados key) = showJSON (StorageRados, key, []::[String])
showJSON (SUExt key) = showJSON (StorageExt, key, []::[String])
readJSON = fail "Not implemented"
showSUSimple :: StorageType -> StorageKey -> String
showSUSimple st sk = show (storageTypeToRaw st, sk, []::[String])
showSULvm :: StorageType -> StorageKey -> SPExclusiveStorage -> String
showSULvm st sk es = show (storageTypeToRaw st, sk, [es])
diskTemplateToStorageType :: DiskTemplate -> StorageType
diskTemplateToStorageType DTExt = StorageExt
diskTemplateToStorageType DTFile = StorageFile
diskTemplateToStorageType DTSharedFile = StorageSharedFile
diskTemplateToStorageType DTDrbd8 = StorageLvmVg
diskTemplateToStorageType DTPlain = StorageLvmVg
diskTemplateToStorageType DTRbd = StorageRados
diskTemplateToStorageType DTDiskless = StorageDiskless
diskTemplateToStorageType DTBlock = StorageBlock
diskTemplateToStorageType DTGluster = StorageGluster
addParamsToStorageUnit :: SPExclusiveStorage -> StorageUnitRaw -> StorageUnit
addParamsToStorageUnit _ (SURaw StorageBlock key) = SUBlock key
addParamsToStorageUnit _ (SURaw StorageDiskless key) = SUDiskless key
addParamsToStorageUnit _ (SURaw StorageExt key) = SUExt key
addParamsToStorageUnit _ (SURaw StorageFile key) = SUFile key
addParamsToStorageUnit _ (SURaw StorageSharedFile key) = SUSharedFile key
addParamsToStorageUnit _ (SURaw StorageGluster key) = SUGluster key
addParamsToStorageUnit es (SURaw StorageLvmPv key) = SULvmPv key es
addParamsToStorageUnit es (SURaw StorageLvmVg key) = SULvmVg key es
addParamsToStorageUnit _ (SURaw StorageRados key) = SURados key
$(THH.declareLADT ''String "EvacMode"
[ ("ChangePrimary", "primary-only")
, ("ChangeSecondary", "secondary-only")
, ("ChangeAll", "all")
])
$(THH.makeJSONInstance ''EvacMode)
$(THH.declareLADT ''String "FileDriver"
[ ("FileLoop", "loop")
, ("FileBlktap", "blktap")
, ("FileBlktap2", "blktap2")
])
$(THH.makeJSONInstance ''FileDriver)
$(THH.declareLADT ''String "InstCreateMode"
[ ("InstCreate", "create")
, ("InstImport", "import")
, ("InstRemoteImport", "remote-import")
])
$(THH.makeJSONInstance ''InstCreateMode)
$(THH.declareLADT ''String "RebootType"
[ ("RebootSoft", "soft")
, ("RebootHard", "hard")
, ("RebootFull", "full")
])
$(THH.makeJSONInstance ''RebootType)
$(THH.declareLADT ''String "ExportMode"
[ ("ExportModeLocal", "local")
, ("ExportModeRemote", "remote")
])
$(THH.makeJSONInstance ''ExportMode)
$(THH.declareLADT ''String "IAllocatorTestDir"
[ ("IAllocatorDirIn", "in")
, ("IAllocatorDirOut", "out")
])
$(THH.makeJSONInstance ''IAllocatorTestDir)
$(THH.declareLADT ''String "IAllocatorMode"
[ ("IAllocatorAlloc", "allocate")
, ("IAllocatorAllocateSecondary", "allocate-secondary")
, ("IAllocatorMultiAlloc", "multi-allocate")
, ("IAllocatorReloc", "relocate")
, ("IAllocatorNodeEvac", "node-evacuate")
, ("IAllocatorChangeGroup", "change-group")
])
$(THH.makeJSONInstance ''IAllocatorMode)
$(THH.declareLADT ''String "NICMode"
[ ("NMBridged", "bridged")
, ("NMRouted", "routed")
, ("NMOvs", "openvswitch")
, ("NMPool", "pool")
])
$(THH.makeJSONInstance ''NICMode)
$(THH.declareLADT ''String "JobStatus"
[ ("JOB_STATUS_QUEUED", "queued")
, ("JOB_STATUS_WAITING", "waiting")
, ("JOB_STATUS_CANCELING", "canceling")
, ("JOB_STATUS_RUNNING", "running")
, ("JOB_STATUS_CANCELED", "canceled")
, ("JOB_STATUS_SUCCESS", "success")
, ("JOB_STATUS_ERROR", "error")
])
$(THH.makeJSONInstance ''JobStatus)
$(THH.declareLADT ''String "FinalizedJobStatus"
[ ("JobStatusCanceled", "canceled")
, ("JobStatusSuccessful", "success")
, ("JobStatusFailed", "error")
])
$(THH.makeJSONInstance ''FinalizedJobStatus)
newtype JobId = JobId { fromJobId :: Int }
deriving (Show, Eq, Ord)
makeJobId :: (Monad m) => Int -> m JobId
makeJobId i | i >= 0 = return $ JobId i
| otherwise = fail $ "Invalid value for job ID ' " ++ show i ++ "'"
makeJobIdS :: (Monad m) => String -> m JobId
makeJobIdS s = tryRead "parsing job id" s >>= makeJobId
parseJobId :: (Monad m) => JSON.JSValue -> m JobId
parseJobId (JSON.JSString x) = makeJobIdS $ JSON.fromJSString x
parseJobId (JSON.JSRational _ x) =
if denominator x /= 1
then fail $ "Got fractional job ID from master daemon?! Value:" ++ show x
else makeJobId . fromIntegral . numerator $ x
parseJobId x = fail $ "Wrong type/value for job id: " ++ show x
instance JSON.JSON JobId where
showJSON = JSON.showJSON . fromJobId
readJSON = parseJobId
type RelativeJobId = Negative Int
data JobIdDep = JobDepRelative RelativeJobId
| JobDepAbsolute JobId
deriving (Show, Eq, Ord)
instance JSON.JSON JobIdDep where
showJSON (JobDepRelative i) = showJSON i
showJSON (JobDepAbsolute i) = showJSON i
readJSON v =
case JSON.readJSON v::JSON.Result (Negative Int) of
JSON.Ok r -> return $ JobDepRelative r
JSON.Error _ -> liftM JobDepAbsolute (parseJobId v)
absoluteJobIdDep :: (Monad m) => JobIdDep -> JobId -> m JobIdDep
absoluteJobIdDep (JobDepAbsolute jid) _ = return $ JobDepAbsolute jid
absoluteJobIdDep (JobDepRelative rjid) jid =
liftM JobDepAbsolute . makeJobId $ fromJobId jid + fromNegative rjid
data JobDependency = JobDependency JobIdDep [FinalizedJobStatus]
deriving (Show, Eq, Ord)
instance JSON JobDependency where
showJSON (JobDependency dep status) = showJSON (dep, status)
readJSON = liftM (uncurry JobDependency) . readJSON
absoluteJobDependency :: (Monad m) => JobDependency -> JobId -> m JobDependency
absoluteJobDependency (JobDependency jdep fstats) jid =
liftM (flip JobDependency fstats) $ absoluteJobIdDep jdep jid
getJobIdFromDependency :: JobDependency -> [JobId]
getJobIdFromDependency (JobDependency (JobDepAbsolute jid) _) = [jid]
getJobIdFromDependency _ = []
$(THH.declareIADT "OpSubmitPriority"
[ ("OpPrioLow", 'ConstantUtils.priorityLow)
, ("OpPrioNormal", 'ConstantUtils.priorityNormal)
, ("OpPrioHigh", 'ConstantUtils.priorityHigh)
])
$(THH.makeJSONInstance ''OpSubmitPriority)
parseSubmitPriority :: (Monad m) => String -> m OpSubmitPriority
parseSubmitPriority "low" = return OpPrioLow
parseSubmitPriority "normal" = return OpPrioNormal
parseSubmitPriority "high" = return OpPrioHigh
parseSubmitPriority str = fail $ "Unknown priority '" ++ str ++ "'"
fmtSubmitPriority :: OpSubmitPriority -> String
fmtSubmitPriority OpPrioLow = "low"
fmtSubmitPriority OpPrioNormal = "normal"
fmtSubmitPriority OpPrioHigh = "high"
$(THH.declareLADT ''String "OpStatus"
[ ("OP_STATUS_QUEUED", "queued")
, ("OP_STATUS_WAITING", "waiting")
, ("OP_STATUS_CANCELING", "canceling")
, ("OP_STATUS_RUNNING", "running")
, ("OP_STATUS_CANCELED", "canceled")
, ("OP_STATUS_SUCCESS", "success")
, ("OP_STATUS_ERROR", "error")
])
$(THH.makeJSONInstance ''OpStatus)
$(THH.declareLADT ''String "ELogType"
[ ("ELogMessage", "message")
, ("ELogRemoteImport", "remote-import")
, ("ELogJqueueTest", "jqueue-test")
, ("ELogDelayTest", "delay-test")
])
$(THH.makeJSONInstance ''ELogType)
type ReasonElem = (String, String, Integer)
type ReasonTrail = [ReasonElem]
$(THH.declareLADT ''String "VType"
[ ("VTypeString", "string")
, ("VTypeMaybeString", "maybe-string")
, ("VTypeBool", "bool")
, ("VTypeSize", "size")
, ("VTypeInt", "int")
, ("VTypeFloat", "float")
])
$(THH.makeJSONInstance ''VType)
instance THH.PyValue VType where
showValue = THH.showValue . vTypeToRaw
$(THH.declareLADT ''String "NodeRole"
[ ("NROffline", "O")
, ("NRDrained", "D")
, ("NRRegular", "R")
, ("NRCandidate", "C")
, ("NRMaster", "M")
])
$(THH.makeJSONInstance ''NodeRole)
roleDescription :: NodeRole -> String
roleDescription NROffline = "offline"
roleDescription NRDrained = "drained"
roleDescription NRRegular = "regular"
roleDescription NRCandidate = "master candidate"
roleDescription NRMaster = "master"
$(THH.declareLADT ''String "DiskMode"
[ ("DiskRdOnly", "ro")
, ("DiskRdWr", "rw")
])
$(THH.makeJSONInstance ''DiskMode)
$(THH.declareLADT ''String "BlockDriver"
[ ("BlockDrvManual", "manual")
])
$(THH.makeJSONInstance ''BlockDriver)
$(THH.declareLADT ''String "AdminState"
[ ("AdminOffline", "offline")
, ("AdminDown", "down")
, ("AdminUp", "up")
])
$(THH.makeJSONInstance ''AdminState)
$(THH.declareLADT ''String "AdminStateSource"
[ ("AdminSource", "admin")
, ("UserSource", "user")
])
$(THH.makeJSONInstance ''AdminStateSource)
instance THH.PyValue AdminStateSource where
showValue = THH.showValue . adminStateSourceToRaw
$(THH.declareLADT ''String "StorageField"
[ ( "SFUsed", "used")
, ( "SFName", "name")
, ( "SFAllocatable", "allocatable")
, ( "SFFree", "free")
, ( "SFSize", "size")
])
$(THH.makeJSONInstance ''StorageField)
$(THH.declareLADT ''String "DiskAccessMode"
[ ( "DiskUserspace", "userspace")
, ( "DiskKernelspace", "kernelspace")
])
$(THH.makeJSONInstance ''DiskAccessMode)
$(THH.declareILADT "LocalDiskStatus"
[ ("DiskStatusOk", 1)
, ("DiskStatusSync", 2)
, ("DiskStatusUnknown", 3)
, ("DiskStatusFaulty", 4)
])
localDiskStatusName :: LocalDiskStatus -> String
localDiskStatusName DiskStatusFaulty = "faulty"
localDiskStatusName DiskStatusOk = "ok"
localDiskStatusName DiskStatusSync = "syncing"
localDiskStatusName DiskStatusUnknown = "unknown"
$(THH.declareLADT ''String "ReplaceDisksMode"
[
("ReplaceOnPrimary", "replace_on_primary")
, ("ReplaceOnSecondary", "replace_on_secondary")
, ("ReplaceNewSecondary", "replace_new_secondary")
, ("ReplaceAuto", "replace_auto")
])
$(THH.makeJSONInstance ''ReplaceDisksMode)
$(THH.declareILADT "RpcTimeout"
[ ("Urgent", 60)
, ("Fast", 5 * 60)
, ("Normal", 15 * 60)
, ("Slow", 3600)
, ("FourHours", 4 * 3600)
, ("OneDay", 86400)
])
$(THH.declareLADT ''String "HotplugAction"
[ ("HAAdd", "hotadd")
, ("HARemove", "hotremove")
, ("HAMod", "hotmod")
])
$(THH.makeJSONInstance ''HotplugAction)
$(THH.declareLADT ''String "HotplugTarget"
[ ("HTDisk", "disk")
, ("HTNic", "nic")
])
$(THH.makeJSONInstance ''HotplugTarget)
$(THH.declareLADT ''String "SshKeyType"
[ ("RSA", "rsa")
, ("DSA", "dsa")
, ("ECDSA", "ecdsa")
])
$(THH.makeJSONInstance ''SshKeyType)
redacted :: String
redacted = "<redacted>"
newtype Private a = Private { getPrivate :: a }
deriving (Eq, Ord, Functor)
instance (Show a, JSON.JSON a) => JSON.JSON (Private a) where
readJSON = liftM Private . JSON.readJSON
showJSON (Private x) = JSON.showJSON x
instance Show a => Show (Private a) where
show _ = redacted
instance THH.PyValue a => THH.PyValue (Private a) where
showValue (Private x) = "Private(" ++ THH.showValue x ++ ")"
instance Applicative Private where
pure = Private
Private f <*> Private x = Private (f x)
instance Monad Private where
(Private x) >>= f = f x
return = Private
showPrivateJSObject :: (JSON.JSON a) =>
[(String, a)] -> JSON.JSObject (Private JSON.JSValue)
showPrivateJSObject value = JSON.toJSObject $ map f value
where f (k, v) = (k, Private $ JSON.showJSON v)
newtype Secret a = Secret { getSecret :: a }
deriving (Eq, Ord, Functor)
instance (Show a, JSON.JSON a) => JSON.JSON (Secret a) where
readJSON = liftM Secret . JSON.readJSON
showJSON = const . JSON.JSString $ JSON.toJSString redacted
instance Show a => Show (Secret a) where
show _ = redacted
instance THH.PyValue a => THH.PyValue (Secret a) where
showValue (Secret x) = "Secret(" ++ THH.showValue x ++ ")"
instance Applicative Secret where
pure = Secret
Secret f <*> Secret x = Secret (f x)
instance Monad Secret where
(Secret x) >>= f = f x
return = Secret
showSecretJSObject :: (JSON.JSON a) =>
[(String, a)] -> JSON.JSObject (Secret JSON.JSValue)
showSecretJSObject value = JSON.toJSObject $ map f value
where f (k, _) = (k, Secret $ JSON.showJSON redacted)
revealValInJSObject :: JSON.JSObject (Secret JSON.JSValue)
-> JSON.JSObject (Private JSON.JSValue)
revealValInJSObject object = JSON.toJSObject . map f $ JSON.fromJSObject object
where f (k, v) = (k, Private $ getSecret v)
type HvParams = Container JSON.JSValue
type OsParams = Container String
type OsParamsPrivate = Container (Private String)
class TimeStampObject a where
cTimeOf :: a -> ClockTime
mTimeOf :: a -> ClockTime
class UuidObject a where
uuidOf :: a -> String
class ForthcomingObject a where
isForthcoming :: a -> Bool
class SerialNoObject a where
serialOf :: a -> Int
class TagsObject a where
tagsOf :: a -> Set.Set String