Optional suggestions present, else LGTM. On Thu, Nov 12, 2015 at 5:46 PM, 'Klaus Aehlig' via ganeti-devel < [email protected]> wrote:
> 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 > Since this pattern repeats itself: would it make sense to make the constant a ByteString and modify our Python-generating code to handle this adequately? > > -- | 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.hsCan't we do this lookup a bit > better than extracting an array of keys? > @@ -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) > Replace key array creation with map lookup? > > -- | 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 > > Hrvoje Ribicic Ganeti Engineering Google Germany GmbH Dienerstr. 12, 80331, München Geschäftsführer: Matthew Scott Sucherman, Paul Terence Manicle Registergericht und -nummer: Hamburg, HRB 86891 Sitz der Gesellschaft: Hamburg Diese E-Mail ist vertraulich. Wenn Sie nicht der richtige Adressat sind, leiten Sie diese bitte nicht weiter, informieren Sie den Absender und löschen Sie die E-Mail und alle Anhänge. Vielen Dank. This e-mail is confidential. If you are not the right addressee please do not forward it, please inform the sender, and please erase this e-mail including any attachments. Thanks.
