Safe Haskell | None |
---|
Implementation of the Ganeti config objects.
Synopsis
- fillDict :: Ord k => Map k v -> Map k v -> [k] -> Map k v
- data Ip4Address = Ip4Address Word8 Word8 Word8 Word8
- mkIp4Address :: (Word8, Word8, Word8, Word8) -> Ip4Address
- readIp4Address :: (Applicative m, MonadFail m) => String -> m Ip4Address
- ip4AddressToList :: Ip4Address -> [Word8]
- ip4AddressToNumber :: Ip4Address -> Integer
- ip4AddressFromNumber :: Integer -> Ip4Address
- nextIp4Address :: Ip4Address -> Ip4Address
- data Ip4Network = Ip4Network {
- ip4netAddr :: Ip4Address
- ip4netMask :: Word8
- mkIp4Network :: Ip4Address -> Word8 -> Ip4Network
- newtype AddressPool = AddressPool {}
- data Network = Network {
- networkName :: NonEmptyString
- networkMacPrefix :: (Maybe String)
- networkNetwork :: Ip4Network
- networkNetwork6 :: (Maybe String)
- networkGateway :: (Maybe Ip4Address)
- networkGateway6 :: (Maybe String)
- networkReservations :: (Maybe AddressPool)
- networkExtReservations :: (Maybe AddressPool)
- networkUuid :: ByteString
- networkCtime :: ClockTime
- networkMtime :: ClockTime
- networkSerial :: Int
- networkTags :: TagSet
- loadNetwork :: JSValue -> Result Network
- saveNetwork :: Network -> JSValue
- type MicroSeconds = Integer
- data DataCollectorConfig = DataCollectorConfig {}
- loadDataCollectorConfig :: JSValue -> Result DataCollectorConfig
- saveDataCollectorConfig :: DataCollectorConfig -> JSValue
- data FilledISpecParams = FilledISpecParams {
- ispecMemorySize :: Int
- ispecDiskSize :: Int
- ispecDiskCount :: Int
- ispecCpuCount :: Int
- ispecNicCount :: Int
- ispecSpindleUse :: Int
- data PartialISpecParams = PartialISpecParams {
- ispecMemorySizeP :: (Maybe Int)
- ispecDiskSizeP :: (Maybe Int)
- ispecDiskCountP :: (Maybe Int)
- ispecCpuCountP :: (Maybe Int)
- ispecNicCountP :: (Maybe Int)
- ispecSpindleUseP :: (Maybe Int)
- allISpecParamFields :: [String]
- loadPartialISpecParams :: JSValue -> Result PartialISpecParams
- savePartialISpecParams :: PartialISpecParams -> JSValue
- loadFilledISpecParams :: JSValue -> Result FilledISpecParams
- saveFilledISpecParams :: FilledISpecParams -> JSValue
- data MinMaxISpecs = MinMaxISpecs {}
- loadMinMaxISpecs :: JSValue -> Result MinMaxISpecs
- saveMinMaxISpecs :: MinMaxISpecs -> JSValue
- data PartialIPolicy = PartialIPolicy {
- ipolicyMinMaxISpecsP :: (Maybe [MinMaxISpecs])
- ipolicyStdSpecP :: (Maybe PartialISpecParams)
- ipolicySpindleRatioP :: (Maybe Double)
- ipolicyVcpuRatioP :: (Maybe Double)
- ipolicyDiskTemplatesP :: (Maybe [DiskTemplate])
- loadPartialIPolicy :: JSValue -> Result PartialIPolicy
- savePartialIPolicy :: PartialIPolicy -> JSValue
- data FilledIPolicy = FilledIPolicy {
- ipolicyMinMaxISpecs :: [MinMaxISpecs]
- ipolicyStdSpec :: FilledISpecParams
- ipolicySpindleRatio :: Double
- ipolicyVcpuRatio :: Double
- ipolicyDiskTemplates :: [DiskTemplate]
- loadFilledIPolicy :: JSValue -> Result FilledIPolicy
- saveFilledIPolicy :: FilledIPolicy -> JSValue
- data FilledNDParams = FilledNDParams {
- ndpOobProgram :: String
- ndpSpindleCount :: Int
- ndpExclusiveStorage :: Bool
- ndpOvs :: Bool
- ndpOvsName :: String
- ndpOvsLink :: String
- ndpSshPort :: Int
- ndpCpuSpeed :: Double
- data PartialNDParams = PartialNDParams {
- ndpOobProgramP :: (Maybe String)
- ndpSpindleCountP :: (Maybe Int)
- ndpExclusiveStorageP :: (Maybe Bool)
- ndpOvsP :: (Maybe Bool)
- ndpOvsNameP :: (Maybe String)
- ndpOvsLinkP :: (Maybe String)
- ndpSshPortP :: (Maybe Int)
- ndpCpuSpeedP :: (Maybe Double)
- allNDParamFields :: [String]
- loadPartialNDParams :: JSValue -> Result PartialNDParams
- savePartialNDParams :: PartialNDParams -> JSValue
- loadFilledNDParams :: JSValue -> Result FilledNDParams
- saveFilledNDParams :: FilledNDParams -> JSValue
- type DiskState = Container JSValue
- type HypervisorState = Container JSValue
- data Node = Node {
- nodeName :: String
- nodePrimaryIp :: String
- nodeSecondaryIp :: String
- nodeMasterCandidate :: Bool
- nodeOffline :: Bool
- nodeDrained :: Bool
- nodeGroup :: String
- nodeMasterCapable :: Bool
- nodeVmCapable :: Bool
- nodeNdparams :: PartialNDParams
- nodePowered :: Bool
- nodeHvStateStatic :: HypervisorState
- nodeDiskStateStatic :: DiskState
- nodeCtime :: ClockTime
- nodeMtime :: ClockTime
- nodeUuid :: ByteString
- nodeSerial :: Int
- nodeTags :: TagSet
- loadNode :: JSValue -> Result Node
- saveNode :: Node -> JSValue
- type GroupDiskParams = Container DiskParams
- type Networks = Container PartialNicParams
- data NodeGroup = NodeGroup {
- groupName :: String
- groupMembers :: [String]
- groupNdparams :: PartialNDParams
- groupAllocPolicy :: AllocPolicy
- groupIpolicy :: PartialIPolicy
- groupDiskparams :: GroupDiskParams
- groupNetworks :: Networks
- groupHvStateStatic :: HypervisorState
- groupDiskStateStatic :: DiskState
- groupCtime :: ClockTime
- groupMtime :: ClockTime
- groupUuid :: ByteString
- groupSerial :: Int
- groupTags :: TagSet
- loadNodeGroup :: JSValue -> Result NodeGroup
- saveNodeGroup :: NodeGroup -> JSValue
- data FilterAction
- data FilterPredicate
- data FilterRule = FilterRule {
- frWatermark :: JobId
- frPriority :: (NonNegative Int)
- frPredicates :: [FilterPredicate]
- frAction :: FilterAction
- frReasonTrail :: ReasonTrail
- frUuid :: ByteString
- loadFilterRule :: JSValue -> Result FilterRule
- saveFilterRule :: FilterRule -> JSValue
- filterRuleOrder :: FilterRule -> FilterRule -> Ordering
- data IpFamily
- ipFamilyFromRaw :: forall m. (Monad m, MonadFail m) => Int -> m IpFamily
- ipFamilyToRaw :: IpFamily -> Int
- ipFamilyToVersion :: IpFamily -> Int
- type ClusterHvParams = GenericContainer Hypervisor HvParams
- type OsHvParams = Container ClusterHvParams
- type ClusterBeParams = Container FilledBeParams
- type ClusterOsParams = Container OsParams
- type ClusterOsParamsPrivate = Container (Private OsParams)
- type ClusterNicParams = Container FilledNicParams
- type UidRange = (Int, Int)
- formatUidRange :: UidRange -> String
- type UidPool = [UidRange]
- type IAllocatorParams = Container JSValue
- type CandidateCertificates = Container String
- data Cluster = Cluster {
- clusterRsahostkeypub :: String
- clusterDsahostkeypub :: (Maybe String)
- clusterHighestUsedPort :: Int
- clusterTcpudpPortPool :: [Int]
- clusterMacPrefix :: String
- clusterVolumeGroupName :: (Maybe String)
- clusterReservedLvs :: [String]
- clusterDrbdUsermodeHelper :: (Maybe String)
- clusterMasterNode :: String
- clusterMasterIp :: String
- clusterMasterNetdev :: String
- clusterMasterNetmask :: Int
- clusterUseExternalMipScript :: Bool
- clusterClusterName :: String
- clusterFileStorageDir :: String
- clusterSharedFileStorageDir :: String
- clusterGlusterStorageDir :: String
- clusterEnabledHypervisors :: [Hypervisor]
- clusterHvparams :: ClusterHvParams
- clusterOsHvp :: OsHvParams
- clusterBeparams :: ClusterBeParams
- clusterOsparams :: ClusterOsParams
- clusterOsparamsPrivateCluster :: ClusterOsParamsPrivate
- clusterNicparams :: ClusterNicParams
- clusterNdparams :: FilledNDParams
- clusterDiskparams :: GroupDiskParams
- clusterCandidatePoolSize :: Int
- clusterModifyEtcHosts :: Bool
- clusterModifySshSetup :: Bool
- clusterMaintainNodeHealth :: Bool
- clusterUidPool :: UidPool
- clusterDefaultIallocator :: String
- clusterDefaultIallocatorParams :: IAllocatorParams
- clusterHiddenOs :: [String]
- clusterBlacklistedOs :: [String]
- clusterPrimaryIpFamily :: IpFamily
- clusterPreallocWipeDisks :: Bool
- clusterIpolicy :: FilledIPolicy
- clusterHvStateStatic :: HypervisorState
- clusterDiskStateStatic :: DiskState
- clusterEnabledDiskTemplates :: [DiskTemplate]
- clusterCandidateCerts :: CandidateCertificates
- clusterMaxRunningJobs :: Int
- clusterMaxTrackedJobs :: Int
- clusterInstallImage :: String
- clusterInstanceCommunicationNetwork :: String
- clusterZeroingImage :: String
- clusterCompressionTools :: [String]
- clusterEnabledUserShutdown :: Bool
- clusterDataCollectors :: (Container DataCollectorConfig)
- clusterSshKeyType :: SshKeyType
- clusterSshKeyBits :: Int
- clusterCtime :: ClockTime
- clusterMtime :: ClockTime
- clusterUuid :: ByteString
- clusterSerial :: Int
- clusterTags :: TagSet
- loadCluster :: JSValue -> Result Cluster
- saveCluster :: Cluster -> JSValue
- data ConfigData = ConfigData {
- configVersion :: Int
- configCluster :: Cluster
- configNodes :: (Container Node)
- configNodegroups :: (Container NodeGroup)
- configInstances :: (Container Instance)
- configNetworks :: (Container Network)
- configDisks :: (Container Disk)
- configFilters :: (Container FilterRule)
- configCtime :: ClockTime
- configMtime :: ClockTime
- configSerial :: Int
- loadConfigData :: JSValue -> Result ConfigData
- saveConfigData :: ConfigData -> JSValue
- data MasterNetworkParameters = MasterNetworkParameters {
- masterNetworkParametersUuid :: String
- masterNetworkParametersIp :: String
- masterNetworkParametersNetmask :: Int
- masterNetworkParametersNetdev :: String
- masterNetworkParametersIpFamily :: IpFamily
- loadMasterNetworkParameters :: JSValue -> Result MasterNetworkParameters
- saveMasterNetworkParameters :: MasterNetworkParameters -> JSValue
Generic definitions
fillDict :: Ord k => Map k v -> Map k v -> [k] -> Map k v Source #
Fills one map with keys from the other map, if not already existing. Mirrors objects.py:FillDict.
Network definitions
Ipv4 types
data Ip4Address Source #
Ip4Address Word8 Word8 Word8 Word8 |
Instances
mkIp4Address :: (Word8, Word8, Word8, Word8) -> Ip4Address Source #
readIp4Address :: (Applicative m, MonadFail m) => String -> m Ip4Address Source #
ip4AddressToList :: Ip4Address -> [Word8] Source #
ip4AddressToNumber :: Ip4Address -> Integer Source #
Converts an address into its ordinal number. This is needed for indexing IP adresses in reservation pools.
ip4AddressFromNumber :: Integer -> Ip4Address Source #
Converts a number into an address. This is needed for indexing IP adresses in reservation pools.
data Ip4Network Source #
Custom type for an IPv4 network.
Ip4Network | |
|
Instances
Eq Ip4Network # | |
Defined in Ganeti.Objects (==) :: Ip4Network -> Ip4Network -> Bool (/=) :: Ip4Network -> Ip4Network -> Bool | |
Show Ip4Network # | |
Defined in Ganeti.Objects showsPrec :: Int -> Ip4Network -> ShowS show :: Ip4Network -> String showList :: [Ip4Network] -> ShowS | |
JSON Ip4Network # | JSON instance for |
Defined in Ganeti.Objects readJSON :: JSValue -> Result Ip4Network showJSON :: Ip4Network -> JSValue readJSONs :: JSValue -> Result [Ip4Network] showJSONs :: [Ip4Network] -> JSValue | |
Arbitrary Ip4Network | |
Defined in Test.Ganeti.Objects arbitrary :: Gen Ip4Network shrink :: Ip4Network -> [Ip4Network] |
mkIp4Network :: Ip4Address -> Word8 -> Ip4Network Source #
Address pools
newtype AddressPool Source #
Currently address pools just wrap a reservation BitArray
.
In future, Network
might be extended to include several address pools
and address pools might include their own ranges of addresses.
Instances
Eq AddressPool # | |
Defined in Ganeti.Objects (==) :: AddressPool -> AddressPool -> Bool (/=) :: AddressPool -> AddressPool -> Bool | |
Ord AddressPool # | |
Defined in Ganeti.Objects compare :: AddressPool -> AddressPool -> Ordering (<) :: AddressPool -> AddressPool -> Bool (<=) :: AddressPool -> AddressPool -> Bool (>) :: AddressPool -> AddressPool -> Bool (>=) :: AddressPool -> AddressPool -> Bool max :: AddressPool -> AddressPool -> AddressPool min :: AddressPool -> AddressPool -> AddressPool | |
Show AddressPool # | |
Defined in Ganeti.Objects showsPrec :: Int -> AddressPool -> ShowS show :: AddressPool -> String showList :: [AddressPool] -> ShowS | |
JSON AddressPool # | |
Defined in Ganeti.Objects readJSON :: JSValue -> Result AddressPool showJSON :: AddressPool -> JSValue readJSONs :: JSValue -> Result [AddressPool] showJSONs :: [AddressPool] -> JSValue | |
Arbitrary AddressPool | |
Defined in Test.Ganeti.Objects arbitrary :: Gen AddressPool shrink :: AddressPool -> [AddressPool] |
Ganeti "network" config object.
Network | |
|
Instances
Eq Network # | |
Show Network # | |
JSON Network # | |
ArrayObject Network # | |
Defined in Ganeti.Objects | |
DictObject Network # | |
TagsObject Network # | |
SerialNoObject Network # | |
Defined in Ganeti.Objects | |
UuidObject Network # | |
Defined in Ganeti.Objects | |
TimeStampObject Network # | |
TagsObjectL Network # | |
SerialNoObjectL Network # | |
Defined in Ganeti.Objects.Lens | |
UuidObjectL Network # | |
Defined in Ganeti.Objects.Lens | |
TimeStampObjectL Network # | |
Defined in Ganeti.Objects.Lens | |
Arbitrary Network | |
loadNetwork :: JSValue -> Result Network Source #
saveNetwork :: Network -> JSValue Source #
Datacollector definitions
type MicroSeconds = Integer Source #
data DataCollectorConfig Source #
The configuration regarding a single data collector.
Instances
loadDataCollectorConfig :: JSValue -> Result DataCollectorConfig Source #
saveDataCollectorConfig :: DataCollectorConfig -> JSValue Source #
IPolicy definitions
data FilledISpecParams Source #
FilledISpecParams | |
|
Instances
data PartialISpecParams Source #
PartialISpecParams | |
|
Instances
allISpecParamFields :: [String] Source #
loadPartialISpecParams :: JSValue -> Result PartialISpecParams Source #
savePartialISpecParams :: PartialISpecParams -> JSValue Source #
loadFilledISpecParams :: JSValue -> Result FilledISpecParams Source #
saveFilledISpecParams :: FilledISpecParams -> JSValue Source #
data MinMaxISpecs Source #
Instances
loadMinMaxISpecs :: JSValue -> Result MinMaxISpecs Source #
saveMinMaxISpecs :: MinMaxISpecs -> JSValue Source #
data PartialIPolicy Source #
Custom partial ipolicy. This is not built via buildParam since it has a special 2-level inheritance mode.
PartialIPolicy | |
|
Instances
loadPartialIPolicy :: JSValue -> Result PartialIPolicy Source #
savePartialIPolicy :: PartialIPolicy -> JSValue Source #
data FilledIPolicy Source #
Custom filled ipolicy. This is not built via buildParam since it has a special 2-level inheritance mode.
FilledIPolicy | |
|
Instances
loadFilledIPolicy :: JSValue -> Result FilledIPolicy Source #
saveFilledIPolicy :: FilledIPolicy -> JSValue Source #
Node definitions
data FilledNDParams Source #
FilledNDParams | |
|
Instances
data PartialNDParams Source #
PartialNDParams | |
|
Instances
allNDParamFields :: [String] Source #
loadPartialNDParams :: JSValue -> Result PartialNDParams Source #
savePartialNDParams :: PartialNDParams -> JSValue Source #
loadFilledNDParams :: JSValue -> Result FilledNDParams Source #
saveFilledNDParams :: FilledNDParams -> JSValue Source #
type DiskState = Container JSValue Source #
Disk state parameters.
As according to the documentation this option is unused by Ganeti,
the content is just a JSValue
.
type HypervisorState = Container JSValue Source #
Hypervisor state parameters.
As according to the documentation this option is unused by Ganeti,
the content is just a JSValue
.
Node | |
|
Instances
Eq Node # | |
Show Node # | |
JSON Node # | |
ArrayObject Node # | |
Defined in Ganeti.Objects | |
DictObject Node # | |
TagsObject Node # | |
SerialNoObject Node # | |
Defined in Ganeti.Objects | |
UuidObject Node # | |
Defined in Ganeti.Objects | |
TimeStampObject Node # | |
TagsObjectL Node # | |
SerialNoObjectL Node # | |
Defined in Ganeti.Objects.Lens | |
UuidObjectL Node # | |
Defined in Ganeti.Objects.Lens | |
TimeStampObjectL Node # | |
Defined in Ganeti.Objects.Lens | |
NdParamObject Node # | |
Defined in Ganeti.Config getNdParamsOf :: ConfigData -> Node -> Maybe FilledNDParams Source # | |
Arbitrary Node | |
NodeGroup definitions
type GroupDiskParams = Container DiskParams Source #
The cluster/group disk parameters type.
type Networks = Container PartialNicParams Source #
A mapping from network UUIDs to nic params of the networks.
NodeGroup | |
|
Instances
Eq NodeGroup # | |
Show NodeGroup # | |
JSON NodeGroup # | |
ArrayObject NodeGroup # | |
Defined in Ganeti.Objects | |
DictObject NodeGroup # | |
TagsObject NodeGroup # | |
SerialNoObject NodeGroup # | |
Defined in Ganeti.Objects | |
UuidObject NodeGroup # | |
Defined in Ganeti.Objects | |
TimeStampObject NodeGroup # | |
TagsObjectL NodeGroup # | |
SerialNoObjectL NodeGroup # | |
Defined in Ganeti.Objects.Lens | |
UuidObjectL NodeGroup # | |
Defined in Ganeti.Objects.Lens | |
TimeStampObjectL NodeGroup # | |
Defined in Ganeti.Objects.Lens | |
NdParamObject NodeGroup # | |
Defined in Ganeti.Config getNdParamsOf :: ConfigData -> NodeGroup -> Maybe FilledNDParams Source # | |
Arbitrary NodeGroup | |
loadNodeGroup :: JSValue -> Result NodeGroup Source #
saveNodeGroup :: NodeGroup -> JSValue Source #
Job scheduler filtering definitions
data FilterAction Source #
Actions that can be performed when a filter matches.
Instances
Eq FilterAction # | |
Defined in Ganeti.Objects (==) :: FilterAction -> FilterAction -> Bool (/=) :: FilterAction -> FilterAction -> Bool | |
Ord FilterAction # | |
Defined in Ganeti.Objects compare :: FilterAction -> FilterAction -> Ordering (<) :: FilterAction -> FilterAction -> Bool (<=) :: FilterAction -> FilterAction -> Bool (>) :: FilterAction -> FilterAction -> Bool (>=) :: FilterAction -> FilterAction -> Bool max :: FilterAction -> FilterAction -> FilterAction min :: FilterAction -> FilterAction -> FilterAction | |
Show FilterAction # | |
Defined in Ganeti.Objects showsPrec :: Int -> FilterAction -> ShowS show :: FilterAction -> String showList :: [FilterAction] -> ShowS | |
JSON FilterAction # | |
Defined in Ganeti.Objects readJSON :: JSValue -> Result FilterAction showJSON :: FilterAction -> JSValue readJSONs :: JSValue -> Result [FilterAction] showJSONs :: [FilterAction] -> JSValue | |
Arbitrary FilterAction | |
Defined in Test.Ganeti.Objects arbitrary :: Gen FilterAction shrink :: FilterAction -> [FilterAction] |
data FilterPredicate Source #
Instances
data FilterRule Source #
FilterRule | |
|
Instances
loadFilterRule :: JSValue -> Result FilterRule Source #
saveFilterRule :: FilterRule -> JSValue Source #
filterRuleOrder :: FilterRule -> FilterRule -> Ordering Source #
Order in which filter rules are evaluated, according to
`doc/design-optables.rst`.
For FilterRule
fields not specified as important for the order,
we choose an arbitrary ordering effect (after the ones from the spec).
The Ord
instance for FilterRule
agrees with this function.
Yet it is recommended to use this function instead of compare
to be
explicit that the spec order is used.
IP family type
Instances
Bounded IpFamily # | |
Defined in Ganeti.Objects | |
Enum IpFamily # | |
Defined in Ganeti.Objects | |
Eq IpFamily # | |
Ord IpFamily # | |
Show IpFamily # | |
JSON IpFamily # | |
Arbitrary IpFamily | |
ipFamilyFromRaw :: forall m. (Monad m, MonadFail m) => Int -> m IpFamily Source #
ipFamilyToRaw :: IpFamily -> Int Source #
ipFamilyToVersion :: IpFamily -> Int Source #
Conversion from IP family to IP version. This is needed because Python uses both, depending on context.
type ClusterHvParams = GenericContainer Hypervisor HvParams Source #
Cluster HvParams (hvtype to hvparams mapping).
type OsHvParams = Container ClusterHvParams Source #
Cluster Os-HvParams (os to hvparams mapping).
type ClusterBeParams = Container FilledBeParams Source #
Cluser BeParams.
type ClusterOsParams = Container OsParams Source #
Cluster OsParams.
type ClusterNicParams = Container FilledNicParams Source #
Cluster NicParams.
formatUidRange :: UidRange -> String Source #
type IAllocatorParams = Container JSValue Source #
The iallocator parameters type.
type CandidateCertificates = Container String Source #
The master candidate client certificate digests
Cluster definitions
Instances
Eq Cluster # | |
Show Cluster # | |
JSON Cluster # | |
ArrayObject Cluster # | |
Defined in Ganeti.Objects | |
DictObject Cluster # | |
TagsObject Cluster # | |
SerialNoObject Cluster # | |
Defined in Ganeti.Objects | |
UuidObject Cluster # | |
Defined in Ganeti.Objects | |
TimeStampObject Cluster # | |
TagsObjectL Cluster # | |
SerialNoObjectL Cluster # | |
Defined in Ganeti.Objects.Lens | |
UuidObjectL Cluster # | |
Defined in Ganeti.Objects.Lens | |
TimeStampObjectL Cluster # | |
Defined in Ganeti.Objects.Lens | |
NdParamObject Cluster # | |
Defined in Ganeti.Config getNdParamsOf :: ConfigData -> Cluster -> Maybe FilledNDParams Source # | |
Arbitrary Cluster | |
loadCluster :: JSValue -> Result Cluster Source #
saveCluster :: Cluster -> JSValue Source #
ConfigData definitions
data ConfigData Source #
ConfigData | |
|
Instances
loadConfigData :: JSValue -> Result ConfigData Source #
saveConfigData :: ConfigData -> JSValue Source #
Master network parameters
data MasterNetworkParameters Source #
MasterNetworkParameters | |
|
Instances
loadMasterNetworkParameters :: JSValue -> Result MasterNetworkParameters Source #
saveMasterNetworkParameters :: MasterNetworkParameters -> JSValue Source #