Store keys as ByteStrings
authorKlaus Aehlig <aehlig@google.com>
Thu, 12 Nov 2015 13:51:16 +0000 (14:51 +0100)
committerKlaus Aehlig <aehlig@google.com>
Fri, 13 Nov 2015 11:44:39 +0000 (12:44 +0100)
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 <aehlig@google.com>
Reviewed-by: Hrvoje Ribicic <riba@google.com>

16 files changed:
src/Ganeti/Config.hs
src/Ganeti/DataCollectors.hs
src/Ganeti/JSON.hs
src/Ganeti/Monitoring/Server.hs
src/Ganeti/Query/Instance.hs
src/Ganeti/Query/Network.hs
src/Ganeti/Query/Query.hs
src/Ganeti/Query/Server.hs
src/Ganeti/WConfd/ConfigModifications.hs
src/Ganeti/WConfd/ConfigVerify.hs
src/Ganeti/WConfd/Ssconf.hs
src/Ganeti/WConfd/TempRes.hs
test/hs/Test/Ganeti/Objects.hs
test/hs/Test/Ganeti/OpCodes.hs
test/hs/Test/Ganeti/Query/Filter.hs
test/hs/Test/Ganeti/Query/Network.hs

index 264aae0..379df93 100644 (file)
@@ -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)
index bca6848..33ad9cb 100644 (file)
@@ -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 =
index e1c91b3..24938e3 100644 (file)
@@ -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
index 0c3cb0f..da78b00 100644 (file)
@@ -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
index fa74204..4d2e660 100644 (file)
@@ -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
index f89c87b..1fda614 100644 (file)
@@ -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)
index 147303f..7ccc4db 100644 (file)
@@ -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
index 056d59c..352e0f2 100644 (file)
@@ -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
index aa11b2a..b0a425b 100644 (file)
@@ -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
 
index 8b85027..246b627 100644 (file)
@@ -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
index 6ab7f8f..b8c83c0 100644 (file)
@@ -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
index ef152ea..565fae2 100644 (file)
@@ -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.
index f048ea7..e2a17a1 100644 (file)
@@ -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)
index 694c9fe..229696f 100644 (file)
@@ -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
index c36294b..adf7cfa 100644 (file)
@@ -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
 
index 01cbb26..aee0376 100644 (file)
@@ -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
-  in notElem uuid net_keys ==> isNothing (getGroupConnection uuid group)
+  let net_map = fromContainer . groupNetworks $ group
+  in not (UTF8.fromString uuid `Map.member` net_map)
+     ==> 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)