Keys to maps are only used to look up values, so a compact representation does impact flexibility. However, it does save on memory usage; having more locality in the keys also improves time when comparing them.
While there, also refrain from linearly looking through keys searching for partial matches where partial matches are not desired (e.g., when looking up things by uuid). Signed-off-by: Klaus Aehlig <[email protected]> --- src/Ganeti/Config.hs | 42 +++++++++++++++++++++----------- src/Ganeti/DataCollectors.hs | 3 ++- src/Ganeti/JSON.hs | 8 +++++- src/Ganeti/Monitoring/Server.hs | 4 ++- src/Ganeti/Query/Instance.hs | 12 ++++++--- src/Ganeti/Query/Network.hs | 3 ++- src/Ganeti/Query/Query.hs | 3 ++- src/Ganeti/Query/Server.hs | 7 +++--- src/Ganeti/WConfd/ConfigModifications.hs | 6 +++-- src/Ganeti/WConfd/ConfigVerify.hs | 11 ++++++--- src/Ganeti/WConfd/Ssconf.hs | 7 +++--- src/Ganeti/WConfd/TempRes.hs | 14 +++++++---- test/hs/Test/Ganeti/Objects.hs | 15 ++++++------ test/hs/Test/Ganeti/OpCodes.hs | 4 +-- test/hs/Test/Ganeti/Query/Filter.hs | 4 ++- test/hs/Test/Ganeti/Query/Network.hs | 11 ++++++--- 16 files changed, 100 insertions(+), 54 deletions(-) diff --git a/src/Ganeti/Config.hs b/src/Ganeti/Config.hs index 264aae0..379df93 100644 --- a/src/Ganeti/Config.hs +++ b/src/Ganeti/Config.hs @@ -86,6 +86,8 @@ import Control.Applicative import Control.Arrow ((&&&)) import Control.Monad import Control.Monad.State +import qualified Data.ByteString as BS +import qualified Data.ByteString.UTF8 as UTF8 import qualified Data.Foldable as F import Data.List (foldl', nub) import Data.Maybe (fromMaybe) @@ -216,8 +218,9 @@ getOnlineNodes = filter (not . nodeOffline) . F.toList . configNodes -- | Returns the default cluster link. getDefaultNicLink :: ConfigData -> String getDefaultNicLink = - nicpLink . (M.! C.ppDefault) . fromContainer . - clusterNicparams . configCluster + let ppDefault = UTF8.fromString C.ppDefault + in nicpLink . (M.! ppDefault) . fromContainer + . clusterNicparams . configCluster -- | Returns the default cluster hypervisor. getDefaultHypervisor :: ConfigData -> Hypervisor @@ -249,11 +252,20 @@ getItem kind name allitems = do maybe (err "not found after successfull match?!") Ok $ M.lookup fullname allitems +-- | Simple lookup function, insisting on exact matches and using +-- byte strings. +getItem' :: String -> String -> M.Map BS.ByteString a -> ErrorResult a +getItem' kind name allitems = + let name' = UTF8.fromString name + err = Bad $ OpPrereqError (kind ++ " uuid " ++ name ++ " not found") + ECodeNoEnt + in maybe err Ok $ M.lookup name' allitems + -- | Looks up a node by name or uuid. getNode :: ConfigData -> String -> ErrorResult Node getNode cfg name = let nodes = fromContainer (configNodes cfg) - in case getItem "Node" name nodes of + in case getItem' "Node" name nodes of -- if not found by uuid, we need to look it up by name Ok node -> Ok node Bad _ -> let by_name = M.mapKeys @@ -264,7 +276,7 @@ getNode cfg name = getInstance :: ConfigData -> String -> ErrorResult Instance getInstance cfg name = let instances = fromContainer (configInstances cfg) - in case getItem "Instance" name instances of + in case getItem' "Instance" name instances of -- if not found by uuid, we need to look it up by name Ok inst -> Ok inst Bad _ -> let by_name = @@ -277,19 +289,19 @@ getInstance cfg name = getDisk :: ConfigData -> String -> ErrorResult Disk getDisk cfg name = let disks = fromContainer (configDisks cfg) - in getItem "Disk" name disks + in getItem' "Disk" name disks -- | Looks up a filter by uuid. getFilterRule :: ConfigData -> String -> ErrorResult FilterRule getFilterRule cfg name = let filters = fromContainer (configFilters cfg) - in getItem "Filter" name filters + in getItem' "Filter" name filters -- | Looks up a node group by name or uuid. getGroup :: ConfigData -> String -> ErrorResult NodeGroup getGroup cfg name = let groups = fromContainer (configNodegroups cfg) - in case getItem "NodeGroup" name groups of + in case getItem' "NodeGroup" name groups of -- if not found by uuid, we need to look it up by name, slow Ok grp -> Ok grp Bad _ -> let by_name = M.mapKeys @@ -336,7 +348,7 @@ getFilledInstHvParams globals cfg inst = parentHvParams = maybe M.empty fromContainer (maybeHvName >>= flip M.lookup hvParamMap) -- Then the os defaults for the given hypervisor - maybeOsName = instOs inst + maybeOsName = UTF8.fromString <$> instOs inst osParamMap = fromContainer . clusterOsHvp $ configCluster cfg osHvParamMap = maybe M.empty (maybe M.empty fromContainer . flip M.lookup osParamMap) @@ -347,7 +359,7 @@ getFilledInstHvParams globals cfg inst = -- Then the child childHvParams = fromContainer . instHvparams $ inst -- Helper function - fillFn con val = fillDict con val globals + fillFn con val = fillDict con val $ fmap UTF8.fromString globals in GenericContainer $ fillFn (fillFn parentHvParams osHvParams) childHvParams -- | Retrieves the instance backend params, missing values filled with cluster @@ -355,7 +367,7 @@ getFilledInstHvParams globals cfg inst = getFilledInstBeParams :: ConfigData -> Instance -> ErrorResult FilledBeParams getFilledInstBeParams cfg inst = do let beParamMap = fromContainer . clusterBeparams . configCluster $ cfg - parentParams <- getItem "FilledBeParams" C.ppDefault beParamMap + parentParams <- getItem' "FilledBeParams" C.ppDefault beParamMap return $ fillParams parentParams (instBeparams inst) -- | Retrieves the instance os params, missing values filled with cluster @@ -366,7 +378,7 @@ getFilledInstOsParams cfg inst = osParamMap = fromContainer . clusterOsparams $ configCluster cfg childOsParams = instOsparams inst in case withMissingParam "Instance without OS" - (flip (getItem "OsParams") osParamMap) + (flip (getItem' "OsParams") osParamMap) maybeOsLookupName of Ok parentOsParams -> GenericContainer $ fillDict (fromContainer parentOsParams) @@ -495,7 +507,8 @@ buildLinkIpInstnameMap :: ConfigData -> LinkIpMap buildLinkIpInstnameMap cfg = let cluster = configCluster cfg instances = M.elems . fromContainer . configInstances $ cfg - defparams = (M.!) (fromContainer $ clusterNicparams cluster) C.ppDefault + defparams = (M.!) (fromContainer $ clusterNicparams cluster) + $ UTF8.fromString C.ppDefault nics = concatMap (\i -> [(fromMaybe (uuidOf i) $ instName i, nic) | nic <- instNics i]) instances @@ -516,7 +529,8 @@ buildLinkIpInstnameMap cfg = -- (configuration corrupt). getGroupOfNode :: ConfigData -> Node -> Maybe NodeGroup getGroupOfNode cfg node = - M.lookup (nodeGroup node) (fromContainer . configNodegroups $ cfg) + M.lookup (UTF8.fromString $ nodeGroup node) + (fromContainer . configNodegroups $ cfg) -- | Returns a node's ndparams, filled. getNodeNdParams :: ConfigData -> Node -> Maybe FilledNDParams @@ -532,7 +546,7 @@ getNodeNdParams cfg node = do getNetwork :: ConfigData -> String -> ErrorResult Network getNetwork cfg name = let networks = fromContainer (configNetworks cfg) - in case getItem "Network" name networks of + in case getItem' "Network" name networks of Ok net -> Ok net Bad _ -> let by_name = M.mapKeys (fromNonEmpty . networkName . (M.!) networks) diff --git a/src/Ganeti/DataCollectors.hs b/src/Ganeti/DataCollectors.hs index bca6848..33ad9cb 100644 --- a/src/Ganeti/DataCollectors.hs +++ b/src/Ganeti/DataCollectors.hs @@ -34,6 +34,7 @@ SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. module Ganeti.DataCollectors( collectors ) where +import qualified Data.ByteString.UTF8 as UTF8 import Data.Map (findWithDefault) import Data.Monoid (mempty) @@ -65,7 +66,7 @@ collectors = any xenHypervisor . clusterEnabledHypervisors $ configCluster cfg collectorConfig name cfg = let config = fromContainer . clusterDataCollectors $ configCluster cfg - in findWithDefault mempty name config + in findWithDefault mempty (UTF8.fromString name) config updateInterval name cfg = dataCollectorInterval $ collectorConfig name cfg activeConfig name cfg = dataCollectorActive $ collectorConfig name cfg diskStatsCollector = diff --git a/src/Ganeti/JSON.hs b/src/Ganeti/JSON.hs index e1c91b3..24938e3 100644 --- a/src/Ganeti/JSON.hs +++ b/src/Ganeti/JSON.hs @@ -87,6 +87,8 @@ import Control.Applicative import Control.DeepSeq import Control.Monad.Error.Class import Control.Monad.Writer +import qualified Data.ByteString as BS +import qualified Data.ByteString.UTF8 as UTF8 import qualified Data.Foldable as F import qualified Data.Text as T import qualified Data.Traversable as F @@ -338,7 +340,11 @@ emptyContainer :: GenericContainer a b emptyContainer = GenericContainer Map.empty -- | Type alias for string keys. -type Container = GenericContainer String +type Container = GenericContainer BS.ByteString + +instance HasStringRepr BS.ByteString where + fromStringRepr = return . UTF8.fromString + toStringRepr = UTF8.toString -- | Creates a GenericContainer from a list of key-value pairs. containerFromList :: Ord a => [(a,b)] -> GenericContainer a b diff --git a/src/Ganeti/Monitoring/Server.hs b/src/Ganeti/Monitoring/Server.hs index 0c3cb0f..da78b00 100644 --- a/src/Ganeti/Monitoring/Server.hs +++ b/src/Ganeti/Monitoring/Server.hs @@ -47,6 +47,7 @@ import Control.Exception.Base (evaluate) import Control.Monad import Control.Monad.IO.Class import Data.ByteString.Char8 (pack, unpack) +import qualified Data.ByteString.UTF8 as UTF8 import Data.Maybe (fromMaybe) import Data.List (find) import Data.Monoid (mempty) @@ -146,7 +147,8 @@ collectorConfigs confdClient = do let answer = CT.confdReplyAnswer confdReply case J.readJSON answer :: J.Result (GJ.Container DataCollectorConfig) of J.Error _ -> Nothing - J.Ok container -> GJ.lookupContainer Nothing name container + J.Ok container -> GJ.lookupContainer Nothing (UTF8.fromString name) + container activeCollectors :: MVar ConfigAccess -> IO [DataCollector] activeCollectors mvarConfig = do diff --git a/src/Ganeti/Query/Instance.hs b/src/Ganeti/Query/Instance.hs index fa74204..4d2e660 100644 --- a/src/Ganeti/Query/Instance.hs +++ b/src/Ganeti/Query/Instance.hs @@ -43,6 +43,7 @@ module Ganeti.Query.Instance import Control.Applicative import Control.Monad (liftM, (>=>)) +import qualified Data.ByteString.UTF8 as UTF8 import Data.Either import Data.List import Data.Maybe @@ -351,6 +352,7 @@ nicAggDescPrefix = "List containing each network interface's " -- | Given a network name id, returns the network's name. getNetworkName :: ConfigData -> String -> NonEmptyString getNetworkName cfg = networkName . (Map.!) (fromContainer $ configNetworks cfg) + . UTF8.fromString -- | Gets the bridge of a NIC. getNicBridge :: FilledNicParams -> Maybe String @@ -371,7 +373,8 @@ fillNicParamsFromConfig cfg = fillParams (getDefaultNicParams cfg) -- | Retrieves the default network interface parameters. getDefaultNicParams :: ConfigData -> FilledNicParams getDefaultNicParams cfg = - (Map.!) (fromContainer . clusterNicparams . configCluster $ cfg) C.ppDefault + (Map.!) (fromContainer . clusterNicparams . configCluster $ cfg) + $ UTF8.fromString C.ppDefault -- | Retrieves the real disk size requirements for all the disks of the -- instance. This includes the metadata etc. and is different from the values @@ -634,7 +637,7 @@ beParamGetter field config inst = hvParamGetter :: String -- ^ The field we're building the getter for -> ConfigData -> Instance -> ResultEntry hvParamGetter field cfg inst = - rsMaybeUnavail . Map.lookup field . fromContainer $ + rsMaybeUnavail . Map.lookup (UTF8.fromString field) . fromContainer $ getFilledInstHvParams (C.toList C.hvcGlobals) cfg inst -- * Live fields functionality @@ -736,8 +739,9 @@ liveInstanceStatus cfg (instInfo, foundOnPrimary) inst allowDown = userShutdownEnabled cfg && (instHypervisor inst /= Just Kvm || - (Map.member C.hvKvmUserShutdown hvparams && - hvparams Map.! C.hvKvmUserShutdown == J.JSBool True)) + (Map.member (UTF8.fromString C.hvKvmUserShutdown) hvparams && + hvparams Map.! UTF8.fromString C.hvKvmUserShutdown + == J.JSBool True)) -- | Determines the status of a dead instance. deadInstanceStatus :: ConfigData -> Instance -> InstanceStatus diff --git a/src/Ganeti/Query/Network.hs b/src/Ganeti/Query/Network.hs index f89c87b..1fda614 100644 --- a/src/Ganeti/Query/Network.hs +++ b/src/Ganeti/Query/Network.hs @@ -42,6 +42,7 @@ module Ganeti.Query.Network -- FIXME: everything except fieldsMap -- is only exported for testing. +import qualified Data.ByteString.UTF8 as UTF8 import qualified Data.Map as Map import Data.Maybe (fromMaybe, mapMaybe) import Data.List (find, intercalate) @@ -124,7 +125,7 @@ getGroupConnection :: String -> NodeGroup -> Maybe (String, String, String, String) getGroupConnection network_uuid group = let networks = fromContainer . groupNetworks $ group - in case Map.lookup network_uuid networks of + in case Map.lookup (UTF8.fromString network_uuid) networks of Nothing -> Nothing Just net -> Just (groupName group, getNicMode net, getNicLink net, getNicVlan net) diff --git a/src/Ganeti/Query/Query.hs b/src/Ganeti/Query/Query.hs index 147303f..7ccc4db 100644 --- a/src/Ganeti/Query/Query.hs +++ b/src/Ganeti/Query/Query.hs @@ -70,6 +70,7 @@ import Control.DeepSeq import Control.Monad (filterM, foldM, liftM, unless) import Control.Monad.IO.Class import Control.Monad.Trans (lift) +import qualified Data.ByteString.UTF8 as UTF8 import qualified Data.Foldable as Foldable import Data.List (intercalate, nub, find) import Data.Maybe (fromMaybe) @@ -292,7 +293,7 @@ query cfg live (Query (ItemTypeLuxi QRLock) fields qfilter) = runResultT $ do (CollectorSimple $ recollectLocksData livedata) id (const . GenericContainer . Map.fromList - . map ((id &&& id) . lockName) $ allLocks) + . map ((UTF8.fromString &&& id) . lockName) $ allLocks) (const Ok) cfg live fields qfilter [] toError answer diff --git a/src/Ganeti/Query/Server.hs b/src/Ganeti/Query/Server.hs index 056d59c..352e0f2 100644 --- a/src/Ganeti/Query/Server.hs +++ b/src/Ganeti/Query/Server.hs @@ -346,7 +346,8 @@ handleCall _ status _ (ReplaceFilter mUuid priority predicates action , frUuid = UTF8.fromString uuid } writeConfig cid - . (configFiltersL . alterContainerL uuid .~ Just rule) + . (configFiltersL . alterContainerL (UTF8.fromString uuid) + .~ Just rule) $ lockedCfg -- Return UUID of added/replaced filter. @@ -356,14 +357,14 @@ handleCall _ status cfg (DeleteFilter uuid) = runResultT $ do -- Check if filter exists. _ <- lookupContainer (failError $ "Filter rule with UUID " ++ uuid ++ " does not exist") - uuid + (UTF8.fromString uuid) (configFilters cfg) -- Ask WConfd to change the config for us. cid <- liftIO $ makeLuxidClientId status withLockedWconfdConfig cid $ \lockedCfg -> writeConfig cid - . (configFiltersL . alterContainerL uuid .~ Nothing) + . (configFiltersL . alterContainerL (UTF8.fromString uuid) .~ Nothing) $ lockedCfg return JSNull diff --git a/src/Ganeti/WConfd/ConfigModifications.hs b/src/Ganeti/WConfd/ConfigModifications.hs index aa11b2a..b0a425b 100644 --- a/src/Ganeti/WConfd/ConfigModifications.hs +++ b/src/Ganeti/WConfd/ConfigModifications.hs @@ -39,6 +39,7 @@ SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. module Ganeti.WConfd.ConfigModifications where +import qualified Data.ByteString.UTF8 as UTF8 import Control.Lens.Setter ((.~)) import Control.Lens.Traversal (mapMOf) import Data.Maybe (isJust) @@ -67,12 +68,13 @@ addInstance inst cid = do logDebug $ "AddInstance: client " ++ show (ciIdentifier cid) ++ " adding instance " ++ uuidOf inst ++ " with name " ++ show (instName inst) - let addInst = csConfigDataL . configInstancesL . alterContainerL (uuidOf inst) + let addInst = csConfigDataL . configInstancesL + . alterContainerL (UTF8.fromString $ uuidOf inst) .~ Just inst commitRes tr = mapMOf csConfigDataL $ T.commitReservedIps cid tr r <- modifyConfigWithLock (\tr cs -> commitRes tr $ addInst cs) - . T.releaseDRBDMinors $ uuidOf inst + . T.releaseDRBDMinors . UTF8.fromString $ uuidOf inst logDebug $ "AddInstance: result of config modification is " ++ show r return $ isJust r diff --git a/src/Ganeti/WConfd/ConfigVerify.hs b/src/Ganeti/WConfd/ConfigVerify.hs index 8b85027..246b627 100644 --- a/src/Ganeti/WConfd/ConfigVerify.hs +++ b/src/Ganeti/WConfd/ConfigVerify.hs @@ -40,6 +40,7 @@ module Ganeti.WConfd.ConfigVerify ) where import Control.Monad.Error +import qualified Data.ByteString.UTF8 as UTF8 import qualified Data.Foldable as F import qualified Data.Map as M import qualified Data.Set as S @@ -62,9 +63,10 @@ checkUUIDKeys :: (UuidObject a, Show a) => String -> Container a -> ValidationMonad () checkUUIDKeys what = mapM_ check . M.toList . fromContainer where - check (uuid, x) = reportIf (uuid /= uuidOf x) + check (uuid, x) = reportIf (uuid /= UTF8.fromString (uuidOf x)) $ what ++ " '" ++ show x - ++ "' is indexed by wrong UUID '" ++ uuid ++ "'" + ++ "' is indexed by wrong UUID '" + ++ UTF8.toString uuid ++ "'" -- | Checks that all linked UUID of given objects exist. checkUUIDRefs :: (UuidObject a, Show a, F.Foldable f) @@ -75,7 +77,7 @@ checkUUIDRefs whatObj whatTarget linkf xs targets = F.mapM_ check xs where uuids = keysSet targets check x = forM_ (linkf x) $ \uuid -> - reportIf (not $ S.member uuid uuids) + reportIf (not $ S.member (UTF8.fromString uuid) uuids) $ whatObj ++ " '" ++ show x ++ "' references a non-existing " ++ whatTarget ++ " UUID '" ++ uuid ++ "'" @@ -110,7 +112,8 @@ verifyConfig cd = do -- we don't need to check for invalid templates as they wouldn't parse let masterNodeName = clusterMasterNode cluster - reportIf (not $ masterNodeName `S.member` keysSet (configNodes cd)) + reportIf (not $ UTF8.fromString masterNodeName + `S.member` keysSet (configNodes cd)) $ "cluster has invalid primary node " ++ masterNodeName -- UUIDs diff --git a/src/Ganeti/WConfd/Ssconf.hs b/src/Ganeti/WConfd/Ssconf.hs index 6ab7f8f..b8c83c0 100644 --- a/src/Ganeti/WConfd/Ssconf.hs +++ b/src/Ganeti/WConfd/Ssconf.hs @@ -42,7 +42,8 @@ module Ganeti.WConfd.Ssconf , mkSSConf ) where -import Control.Arrow ((&&&), first, second) +import Control.Arrow ((&&&), (***), first) +import qualified Data.ByteString.UTF8 as UTF8 import Data.Foldable (Foldable(..), toList) import Data.List (partition) import Data.Maybe (mapMaybe) @@ -72,7 +73,7 @@ mkSSConfHvparams cluster = map (id &&& hvparams) [minBound..maxBound] -- @key=value@. hvparamsStrings :: HvParams -> [String] hvparamsStrings = - map (eqPair . second hvparamShow) . M.toList . fromContainer + map (eqPair . (UTF8.toString *** hvparamShow)) . M.toList . fromContainer -- | Convert a hypervisor parameter in its JSON representation to a String. -- Strings, numbers and booleans are just printed (without quotes), booleans @@ -135,7 +136,7 @@ mkSSConf cdata = SSConf . M.fromList $ mapLines :: (Foldable f) => (a -> String) -> f a -> [String] mapLines f = map f . toList spcPair (x, y) = x ++ " " ++ y - toPairs = M.assocs . fromContainer + toPairs = M.assocs . M.mapKeys UTF8.toString . fromContainer cluster = configCluster cdata mcs = getMasterOrCandidates cdata diff --git a/src/Ganeti/WConfd/TempRes.hs b/src/Ganeti/WConfd/TempRes.hs index ef152ea..565fae2 100644 --- a/src/Ganeti/WConfd/TempRes.hs +++ b/src/Ganeti/WConfd/TempRes.hs @@ -78,6 +78,8 @@ import Control.Lens.At import Control.Monad.Error import Control.Monad.State import Control.Monad.Trans.Maybe +import qualified Data.ByteString as BS +import qualified Data.ByteString.UTF8 as UTF8 import qualified Data.Foldable as F import Data.Maybe import Data.Map (Map) @@ -108,13 +110,13 @@ import qualified Ganeti.Utils.MultiMap as MM -- ** Aliases to make types more meaningful: -type NodeUUID = String +type NodeUUID = BS.ByteString -type InstanceUUID = String +type InstanceUUID = BS.ByteString -type DiskUUID = String +type DiskUUID = BS.ByteString -type NetworkUUID = String +type NetworkUUID = BS.ByteString type DRBDMinor = Int @@ -229,7 +231,9 @@ computeDRBDMap' cfg trs = -- | Adds minors of a disk within the state monad addMinors disk = do let minors = getDrbdMinorsForDisk disk - forM_ minors $ \(minor, node) -> nodeMinor node minor %= (uuidOf disk :) + forM_ minors $ \(minor, node) -> + nodeMinor (UTF8.fromString node) minor %= + (UTF8.fromString (uuidOf disk) :) -- | Compute the map of used DRBD minor/nodes. -- Report any duplicate entries as an error. diff --git a/test/hs/Test/Ganeti/Objects.hs b/test/hs/Test/Ganeti/Objects.hs index f048ea7..e2a17a1 100644 --- a/test/hs/Test/Ganeti/Objects.hs +++ b/test/hs/Test/Ganeti/Objects.hs @@ -84,7 +84,7 @@ import Ganeti.Types instance Arbitrary (Container DataCollectorConfig) where arbitrary = do - let names = CU.toList C.dataCollectorNames + let names = map UTF8.fromString $ CU.toList C.dataCollectorNames activations <- vector $ length names timeouts <- vector $ length names let configs = zipWith DataCollectorConfig activations timeouts @@ -323,7 +323,8 @@ instance Arbitrary GroupDiskParams where arbitrary = return $ GenericContainer Map.empty instance Arbitrary ClusterNicParams where - arbitrary = (GenericContainer . Map.singleton C.ppDefault) <$> arbitrary + arbitrary = (GenericContainer . Map.singleton (UTF8.fromString C.ppDefault)) + <$> arbitrary instance Arbitrary OsParams where arbitrary = (GenericContainer . Map.fromList) <$> arbitrary @@ -421,8 +422,8 @@ genEmptyCluster ncount = do nodes' = zipWith (\n idx -> let newname = takeWhile (/= '.') (nodeName n) ++ "-" ++ show idx - in (newname, n { nodeGroup = guuid, - nodeName = newname})) + in ( UTF8.fromString newname + , n { nodeGroup = guuid, nodeName = newname})) nodes [(1::Int)..] nodemap = Map.fromList nodes' contnodes = if Map.size nodemap /= ncount @@ -434,7 +435,7 @@ genEmptyCluster ncount = do networks = GenericContainer Map.empty disks = GenericContainer Map.empty filters = GenericContainer Map.empty - let contgroups = GenericContainer $ Map.singleton guuid grp + let contgroups = GenericContainer $ Map.singleton (UTF8.fromString guuid) grp serial <- arbitrary -- timestamp fields ctime <- arbitrary @@ -458,7 +459,7 @@ genConfigDataWithNetworks old_cfg = do let nets_unique = map ( \(name, net) -> net { networkName = name } ) (zip net_names nets) net_map = GenericContainer $ Map.fromList - (map (\n -> (uuidOf n, n)) nets_unique) + (map (\n -> (UTF8.fromString $ uuidOf n, n)) nets_unique) new_cfg = old_cfg { configNetworks = net_map } return new_cfg @@ -629,7 +630,7 @@ genNodeGroup = do ipolicy <- arbitrary diskparams <- pure (GenericContainer Map.empty) num_networks <- choose (0, 3) - net_uuid_list <- vectorOf num_networks (arbitrary::Gen String) + net_uuid_list <- vectorOf num_networks (arbitrary::Gen BS.ByteString) nic_param_list <- vectorOf num_networks (arbitrary::Gen PartialNicParams) net_map <- pure (GenericContainer . Map.fromList $ zip net_uuid_list nic_param_list) diff --git a/test/hs/Test/Ganeti/OpCodes.hs b/test/hs/Test/Ganeti/OpCodes.hs index 694c9fe..229696f 100644 --- a/test/hs/Test/Ganeti/OpCodes.hs +++ b/test/hs/Test/Ganeti/OpCodes.hs @@ -126,13 +126,13 @@ instance Arbitrary ExportTarget where , ExportTargetRemote <$> pure [] ] -arbitraryDataCollector :: Gen (Container Bool) +arbitraryDataCollector :: Gen (GenericContainer String Bool) arbitraryDataCollector = do els <- listOf . elements $ CU.toList C.dataCollectorNames activation <- vector $ length els return . GenericContainer . Map.fromList $ zip els activation -arbitraryDataCollectorInterval :: Gen (Maybe (Container Int)) +arbitraryDataCollectorInterval :: Gen (Maybe (GenericContainer String Int)) arbitraryDataCollectorInterval = do els <- listOf . elements $ CU.toList C.dataCollectorNames intervals <- vector $ length els diff --git a/test/hs/Test/Ganeti/Query/Filter.hs b/test/hs/Test/Ganeti/Query/Filter.hs index c36294b..adf7cfa 100644 --- a/test/hs/Test/Ganeti/Query/Filter.hs +++ b/test/hs/Test/Ganeti/Query/Filter.hs @@ -40,6 +40,7 @@ module Test.Ganeti.Query.Filter (testQuery_Filter) where import Test.QuickCheck hiding (Result) import Test.QuickCheck.Monadic +import qualified Data.ByteString.UTF8 as UTF8 import qualified Data.Map as Map import Data.List import Text.JSON (showJSON) @@ -88,7 +89,8 @@ genClusterNames :: Int -> Int -> Gen (ConfigData, [String]) genClusterNames min_nodes max_nodes = do numnodes <- choose (min_nodes, max_nodes) cfg <- genEmptyCluster numnodes - return (cfg, niceSort . Map.keys . fromContainer $ configNodes cfg) + return (cfg , niceSort . map UTF8.toString . Map.keys . fromContainer + $ configNodes cfg) -- * Test cases diff --git a/test/hs/Test/Ganeti/Query/Network.hs b/test/hs/Test/Ganeti/Query/Network.hs index 01cbb26..6e01825 100644 --- a/test/hs/Test/Ganeti/Query/Network.hs +++ b/test/hs/Test/Ganeti/Query/Network.hs @@ -49,6 +49,7 @@ import Test.Ganeti.TestHelper import Test.QuickCheck +import qualified Data.ByteString.UTF8 as UTF8 import qualified Data.Map as Map import Data.Maybe @@ -59,7 +60,8 @@ instance Arbitrary ConfigData where -- a non-Nothing result. prop_getGroupConnection :: NodeGroup -> Property prop_getGroupConnection group = - let net_keys = (Map.keys . fromContainer . groupNetworks) group + let net_keys = map UTF8.toString . Map.keys . fromContainer . groupNetworks + $ group in True ==? all (\nk -> isJust (getGroupConnection nk group)) net_keys @@ -67,14 +69,15 @@ prop_getGroupConnection group = -- yields 'Nothing'. prop_getGroupConnection_notFound :: NodeGroup -> String -> Property prop_getGroupConnection_notFound group uuid = - let net_keys = (Map.keys . fromContainer . groupNetworks) group + let net_keys = map UTF8.toString . Map.keys . fromContainer . groupNetworks + $ group in notElem uuid net_keys ==> isNothing (getGroupConnection uuid group) -- | Checks whether actually connected instances are identified as such. prop_instIsConnected :: ConfigData -> Property prop_instIsConnected cfg = let nets = (fromContainer . configNetworks) cfg - net_keys = Map.keys nets + net_keys = map UTF8.toString $ Map.keys nets in forAll (genInstWithNets net_keys) $ \inst -> True ==? all (`instIsConnected` inst) net_keys @@ -83,7 +86,7 @@ prop_instIsConnected cfg = prop_instIsConnected_notFound :: ConfigData -> String -> Property prop_instIsConnected_notFound cfg network_uuid = let nets = (fromContainer . configNetworks) cfg - net_keys = Map.keys nets + net_keys = map UTF8.toString $ Map.keys nets in notElem network_uuid net_keys ==> forAll (genInstWithNets net_keys) $ \inst -> not (instIsConnected network_uuid inst) -- 2.6.0.rc2.230.g3dd15c0
