Commit 4e6f1cde authored by Hrvoje Ribicic's avatar Hrvoje Ribicic
Browse files

Add instance parameter fields



This patch adds instance parameter fields to the Haskell instance
queries. The fields retrieve maps of parameters related to e.g.
hypervisors, or operating systems.
Every instance can have parameters different from the defaults,
and the fields allow for retrieving changes, defaults, and the
complete parameters.
To achieve this, some constants were converted from being
Python- to Haskell-generated.
Signed-off-by: default avatarHrvoje Ribicic <riba@google.com>
Reviewed-by: default avatarJose A. Lopes <jabolopes@google.com>
parent 9491766c
......@@ -45,6 +45,9 @@ module Ganeti.Config
, getInstPrimaryNode
, getInstMinorsForNode
, getInstAllNodes
, getFilledInstHvParams
, getFilledInstBeParams
, getFilledInstOsParams
, getNetwork
, buildLinkIpInstnameMap
, instNodes
......@@ -57,6 +60,7 @@ import qualified Data.Set as S
import qualified Text.JSON as J
import Ganeti.BasicTypes
import qualified Ganeti.ConstantUtils as C
import qualified Ganeti.Constants as C
import Ganeti.Errors
import Ganeti.JSON
......@@ -237,6 +241,46 @@ getNetwork cfg name =
networks
in getItem "Network" name by_name
-- | Retrieves the instance hypervisor params, missing values filled with
-- cluster defaults.
getFilledInstHvParams :: ConfigData -> Instance -> HvParams
getFilledInstHvParams cfg inst =
-- First get the defaults of the parent
let hvName = hypervisorToRaw . instHypervisor $ inst
hvParamMap = fromContainer . clusterHvparams $ configCluster cfg
parentHvParams = maybe M.empty fromContainer $ M.lookup hvName hvParamMap
-- Then the os defaults for the given hypervisor
osName = instOs inst
osParamMap = fromContainer . clusterOsHvp $ configCluster cfg
osHvParamMap = maybe M.empty fromContainer $ M.lookup osName osParamMap
osHvParams = maybe M.empty fromContainer $ M.lookup hvName osHvParamMap
-- Then the child
childHvParams = fromContainer . instHvparams $ inst
-- Helper function
fillFn con val = fillDict con val $ C.toList C.hvcGlobals
in GenericContainer $ fillFn (fillFn parentHvParams osHvParams) childHvParams
-- | Retrieves the instance backend params, missing values filled with cluster
-- defaults.
getFilledInstBeParams :: ConfigData -> Instance -> ErrorResult FilledBeParams
getFilledInstBeParams cfg inst = do
let beParamMap = fromContainer . clusterBeparams . configCluster $ cfg
parentParams <- getItem "FilledBeParams" C.ppDefault beParamMap
return $ fillBeParams parentParams (instBeparams inst)
-- | Retrieves the instance os params, missing values filled with cluster
-- defaults.
getFilledInstOsParams :: ConfigData -> Instance -> OsParams
getFilledInstOsParams cfg inst =
let osLookupName = takeWhile (/= '+') (instOs inst)
osParamMap = fromContainer . clusterOsparams $ configCluster cfg
childOsParams = instOsparams inst
in case getItem "OsParams" osLookupName osParamMap of
Ok parentOsParams -> GenericContainer $
fillDict (fromContainer parentOsParams)
(fromContainer childOsParams) []
Bad _ -> childOsParams
-- | Looks up an instance's primary node.
getInstPrimaryNode :: ConfigData -> String -> ErrorResult Node
getInstPrimaryNode cfg name =
......
......@@ -61,6 +61,9 @@ instance PyValue a => PyValue (FrozenSet a) where
mkSet :: Ord a => [a] -> FrozenSet a
mkSet = FrozenSet . Set.fromList
toList :: FrozenSet a -> [a]
toList = Set.toList . unFrozenSet
union :: Ord a => FrozenSet a -> FrozenSet a -> FrozenSet a
union x y = FrozenSet (unFrozenSet x `Set.union` unFrozenSet y)
......
......@@ -1601,6 +1601,87 @@ hvsParameterTitles =
(hvPassthrough, "pci_pass"),
(hvVncBindAddress, "VNC_bind_address")]
-- | Converted from Python list or set @HVS_PARAMETERS@
hvsParameters :: FrozenSet String
hvsParameters = ConstantUtils.mkSet $ Map.keys hvsParameterTypes
-- | Converted from Python list or set @HVS_PARAMETER_TYPES@
hvsParameterTypes :: Map String VType
hvsParameterTypes = Map.fromList
[ (hvAcpi, VTypeBool)
, (hvBlockdevPrefix, VTypeString)
, (hvBootloaderArgs, VTypeString)
, (hvBootloaderPath, VTypeString)
, (hvBootOrder, VTypeString)
, (hvCdromImagePath, VTypeString)
, (hvCpuCap, VTypeInt)
, (hvCpuCores, VTypeInt)
, (hvCpuMask, VTypeString)
, (hvCpuSockets, VTypeInt)
, (hvCpuThreads, VTypeInt)
, (hvCpuType, VTypeString)
, (hvCpuWeight, VTypeInt)
, (hvDeviceModel, VTypeString)
, (hvDiskCache, VTypeString)
, (hvDiskType, VTypeString)
, (hvInitrdPath, VTypeString)
, (hvInitScript, VTypeString)
, (hvKernelArgs, VTypeString)
, (hvKernelPath, VTypeString)
, (hvKeymap, VTypeString)
, (hvKvmCdrom2ImagePath, VTypeString)
, (hvKvmCdromDiskType, VTypeString)
, (hvKvmExtra, VTypeString)
, (hvKvmFlag, VTypeString)
, (hvKvmFloppyImagePath, VTypeString)
, (hvKvmMachineVersion, VTypeString)
, (hvKvmPath, VTypeString)
, (hvKvmSpiceAudioCompr, VTypeBool)
, (hvKvmSpiceBind, VTypeString)
, (hvKvmSpiceIpVersion, VTypeInt)
, (hvKvmSpiceJpegImgCompr, VTypeString)
, (hvKvmSpiceLosslessImgCompr, VTypeString)
, (hvKvmSpicePasswordFile, VTypeString)
, (hvKvmSpiceStreamingVideoDetection, VTypeString)
, (hvKvmSpiceTlsCiphers, VTypeString)
, (hvKvmSpiceUseTls, VTypeBool)
, (hvKvmSpiceUseVdagent, VTypeBool)
, (hvKvmSpiceZlibGlzImgCompr, VTypeString)
, (hvKvmUseChroot, VTypeBool)
, (hvMemPath, VTypeString)
, (hvMigrationBandwidth, VTypeInt)
, (hvMigrationDowntime, VTypeInt)
, (hvMigrationMode, VTypeString)
, (hvMigrationPort, VTypeInt)
, (hvNicType, VTypeString)
, (hvPae, VTypeBool)
, (hvPassthrough, VTypeString)
, (hvRebootBehavior, VTypeString)
, (hvRootPath, VTypeMaybeString)
, (hvSecurityDomain, VTypeString)
, (hvSecurityModel, VTypeString)
, (hvSerialConsole, VTypeBool)
, (hvSerialSpeed, VTypeInt)
, (hvSoundhw, VTypeString)
, (hvUsbDevices, VTypeString)
, (hvUsbMouse, VTypeString)
, (hvUseBootloader, VTypeBool)
, (hvUseLocaltime, VTypeBool)
, (hvVga, VTypeString)
, (hvVhostNet, VTypeBool)
, (hvVifScript, VTypeString)
, (hvVifType, VTypeString)
, (hvViridian, VTypeBool)
, (hvVncBindAddress, VTypeString)
, (hvVncPasswordFile, VTypeString)
, (hvVncTls, VTypeString)
, (hvVncX509, VTypeString)
, (hvVncX509Verify, VTypeBool)
, (hvVnetHdr, VTypeBool)
, (hvXenCmd, VTypeString)
, (hvXenCpuid, VTypeString)
]
-- * Migration statuses
hvMigrationActive :: String
......
......@@ -418,10 +418,12 @@ includesLogicalId vg_name lv_name disk =
-- * Instance definitions
$(buildParam "Be" "bep"
[ simpleField "minmem" [t| Int |]
, simpleField "maxmem" [t| Int |]
, simpleField "vcpus" [t| Int |]
, simpleField "auto_balance" [t| Bool |]
[ simpleField "minmem" [t| Int |]
, simpleField "maxmem" [t| Int |]
, simpleField "vcpus" [t| Int |]
, simpleField "auto_balance" [t| Bool |]
, simpleField "always_failover" [t| Bool |]
, simpleField "spindle_use" [t| Int |]
])
$(buildObject "Instance" "inst" $
......
......@@ -40,6 +40,8 @@ module Ganeti.Query.Common
, tagsFields
, dictFieldGetter
, buildNdParamField
, buildBeParamField
, buildHvParamField
, getDefaultHypervisorSpec
, getHvParamsFromCluster
) where
......@@ -183,13 +185,47 @@ ndParamGetter field config =
-- | Builds the ndparam fields for an object.
buildNdParamField :: (NdParamObject a) => String -> FieldData a b
buildNdParamField field =
let full_name = "ndp/" ++ field
title = fromMaybe field $ field `Map.lookup` ndParamTitles
qft = fromMaybe QFTOther $ field `Map.lookup` ndParamTypes
desc = "The \"" ++ field ++ "\" node parameter"
in (FieldDefinition full_name title qft desc,
FieldConfig (ndParamGetter field), QffNormal)
buildNdParamField =
buildParamField "ndp" "node" ndParamTitles ndParamTypes ndParamGetter
-- | Beparams optimised lookup map.
beParamTypes :: Map.Map String FieldType
beParamTypes = Map.map vTypeToQFT C.besParameterTypes
-- | Builds the beparam fields for an object.
buildBeParamField :: (String -> ConfigData -> a -> ResultEntry)
-> String
-> FieldData a b
buildBeParamField =
buildParamField "be" "backend" C.besParameterTitles beParamTypes
-- | Hvparams optimised lookup map.
hvParamTypes :: Map.Map String FieldType
hvParamTypes = Map.map vTypeToQFT C.hvsParameterTypes
-- | Builds the beparam fields for an object.
buildHvParamField :: (String -> ConfigData -> a -> ResultEntry)
-> String
-> FieldData a b
buildHvParamField =
buildParamField "hv" "hypervisor" C.hvsParameterTitles hvParamTypes
-- | Builds a param field for a certain getter class
buildParamField :: String -- ^ Prefix
-> String -- ^ Parameter group name
-> Map.Map String String -- ^ Parameter title map
-> Map.Map String FieldType -- ^ Parameter type map
-> (String -> ConfigData -> a -> ResultEntry)
-> String -- ^ The parameter name
-> FieldData a b
buildParamField prefix paramGroupName titleMap typeMap getter field =
let full_name = prefix ++ "/" ++ field
title = fromMaybe full_name $ field `Map.lookup` titleMap
qft = fromMaybe QFTOther $ field `Map.lookup` typeMap
desc = "The \"" ++ field ++ "\" " ++ paramGroupName ++ " parameter"
in ( FieldDefinition full_name title qft desc
, FieldConfig (getter field), QffNormal
)
-- | Looks up the default hypervisor and its hvparams
getDefaultHypervisorSpec :: ConfigData -> (Hypervisor, HvParams)
......
......@@ -39,7 +39,10 @@ import qualified Text.JSON as J
import Ganeti.BasicTypes
import Ganeti.Common
import Ganeti.Config
import qualified Ganeti.Constants as C
import qualified Ganeti.ConstantUtils as C
import Ganeti.Errors
import Ganeti.JSON
import Ganeti.Objects
import Ganeti.Query.Common
import Ganeti.Query.Language
......@@ -106,6 +109,31 @@ instanceFields =
FieldConfig (getSecondaryNodeGroupAttribute groupUuid), QffNormal)
] ++
-- Instance parameter fields, whole
[ (FieldDefinition "hvparams" "HypervisorParameters" QFTOther
"Hypervisor parameters (merged)",
FieldConfig ((rsNormal .) . getFilledInstHvParams), QffNormal)
, (FieldDefinition "beparams" "BackendParameters" QFTOther
"Backend parameters (merged)",
FieldConfig ((rsErrorNoData .) . getFilledInstBeParams), QffNormal)
, (FieldDefinition "osparams" "OpSysParameters" QFTOther
"Operating system parameters (merged)",
FieldConfig ((rsNormal .) . getFilledInstOsParams), QffNormal)
, (FieldDefinition "custom_hvparams" "CustomHypervisorParameters" QFTOther
"Custom hypervisor parameters",
FieldSimple (rsNormal . instHvparams), QffNormal)
, (FieldDefinition "custom_beparams" "CustomBackendParameters" QFTOther
"Custom backend parameters",
FieldSimple (rsNormal . instBeparams), QffNormal)
, (FieldDefinition "custom_osparams" "CustomOpSysParameters" QFTOther
"Custom operating system parameters",
FieldSimple (rsNormal . instOsparams), QffNormal)
] ++
-- Instance parameter fields, generated
map (buildBeParamField beParamGetter) allBeParamFields ++
map (buildHvParamField hvParamGetter) (C.toList C.hvsParameters) ++
-- Live fields using special getters
[ (FieldDefinition "status" "Status" QFTText
statusDocText,
......@@ -132,7 +160,7 @@ getPrimaryNode cfg = getInstPrimaryNode cfg . instName
-- | Get primary node hostname
getPrimaryNodeName :: ConfigData -> Instance -> ResultEntry
getPrimaryNodeName cfg inst =
rsErrorNoData $ (J.showJSON . nodeName) <$> getPrimaryNode cfg inst
rsErrorNoData $ nodeName <$> getPrimaryNode cfg inst
-- | Get primary node hostname
getPrimaryNodeGroup :: ConfigData -> Instance -> ResultEntry
......@@ -172,6 +200,27 @@ getSecondaryNodeGroupAttribute :: (J.JSON a)
getSecondaryNodeGroupAttribute getter cfg inst =
rsErrorNoData $ map (J.showJSON . getter) <$> getSecondaryNodeGroups cfg inst
-- | Beparam getter builder: given a field, it returns a FieldConfig
-- getter, that is a function that takes the config and the object and
-- returns the Beparam field specified when the getter was built.
beParamGetter :: String -- ^ The field we are building the getter for
-> ConfigData -- ^ The configuration object
-> Instance -- ^ The instance configuration object
-> ResultEntry -- ^ The result
beParamGetter field config inst =
case getFilledInstBeParams config inst of
Ok beParams -> dictFieldGetter field $ Just beParams
Bad _ -> rsNoData
-- | Hvparam getter builder: given a field, it returns a FieldConfig
-- getter, that is a function that takes the config and the object and
-- returns the Hvparam field specified when the getter was built.
hvParamGetter :: String -- ^ The field we're building the getter for
-> ConfigData -> Instance -> ResultEntry
hvParamGetter field cfg inst =
rsMaybeUnavail . Map.lookup field . fromContainer $
getFilledInstHvParams cfg inst
-- * Live fields functionality
-- | List of node live fields.
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment