Commit 81236679 authored by Petr Pudlak's avatar Petr Pudlak

Use Hypervisor as the key in ClusterHvParams

.. instead of String. This imposes a type-level restriction that the
keys of the map are just hypervisor names.

Note about 'Arbitrary GroupDiskParams': Since GroupDiskParams and
ClusterHvParams were both synonyms for 'Container (Container JSValue)',
the Arbitrary instance worked for both. After fixing the type of
ClousterHvParams, its instance become different from GroupDiskParams,
hence the latter needs the addition.
Signed-off-by: default avatarPetr Pudlak <pudlak@google.com>
Reviewed-by: default avatarKlaus Aehlig <aehlig@google.com>
parent 9be0fe40
......@@ -311,7 +311,7 @@ getGroupInstances cfg gname =
getFilledInstHvParams :: [String] -> ConfigData -> Instance -> HvParams
getFilledInstHvParams globals cfg inst =
-- First get the defaults of the parent
let hvName = hypervisorToRaw . instHypervisor $ inst
let hvName = instHypervisor inst
hvParamMap = fromContainer . clusterHvparams $ configCluster cfg
parentHvParams = maybe M.empty fromContainer $ M.lookup hvName hvParamMap
-- Then the os defaults for the given hypervisor
......
......@@ -761,7 +761,7 @@ ipFamilyToVersion IpFamilyV4 = C.ip4Version
ipFamilyToVersion IpFamilyV6 = C.ip6Version
-- | Cluster HvParams (hvtype to hvparams mapping).
type ClusterHvParams = Container HvParams
type ClusterHvParams = GenericContainer Hypervisor HvParams
-- | Cluster Os-HvParams (os to hvparams mapping).
type OsHvParams = Container ClusterHvParams
......
......@@ -259,7 +259,7 @@ getDefaultHypervisorSpec cfg = (hv, getHvParamsFromCluster cfg hv)
getHvParamsFromCluster :: ConfigData -> Hypervisor -> HvParams
getHvParamsFromCluster cfg hv =
fromMaybe (GenericContainer Map.empty) .
Map.lookup (hypervisorToRaw hv) .
Map.lookup hv .
fromContainer . clusterHvparams $ configCluster cfg
-- | Given an alias list and a field list, copies field definitions under a
......
......@@ -875,7 +875,7 @@ getHypervisorSpecs :: ConfigData -> [Instance] -> [(Hypervisor, HvParams)]
getHypervisorSpecs cfg instances =
let hvs = nub . map instHypervisor $ instances
hvParamMap = (fromContainer . clusterHvparams . configCluster $ cfg)
in zip hvs . map ((Map.!) hvParamMap . hypervisorToRaw) $ hvs
in zip hvs . map ((Map.!) hvParamMap) $ hvs
-- | Collect live data from RPC query if enabled.
collectLiveData :: Bool -- ^ Live queries allowed
......
......@@ -99,11 +99,10 @@ verifyConfig cd = do
reportIf (null enabledHvs)
"enabled hypervisors list doesn't have any entries"
-- we don't need to check for invalid HVS as they would fail to parse
let missingHvp = S.fromList (map hypervisorToRaw enabledHvs)
S.\\ keysSet hvParams
let missingHvp = S.fromList enabledHvs S.\\ keysSet hvParams
reportIf (not $ S.null missingHvp)
$ "hypervisor parameters missing for the enabled hypervisor(s) "
++ (commaJoin . S.toList $ missingHvp)
++ (commaJoin . map hypervisorToRaw . S.toList $ missingHvp)
let enabledDiskTemplates = clusterEnabledDiskTemplates cluster
reportIf (null enabledDiskTemplates)
......
......@@ -242,6 +242,10 @@ instance Arbitrary ClusterHvParams where
instance Arbitrary OsHvParams where
arbitrary = return $ GenericContainer Map.empty
-- | No real arbitrary instance for 'GroupDiskParams' yet.
instance Arbitrary GroupDiskParams where
arbitrary = return $ GenericContainer Map.empty
instance Arbitrary ClusterNicParams where
arbitrary = (GenericContainer . Map.singleton C.ppDefault) <$> arbitrary
......
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