diff options
author | Joey Hess <joeyh@joeyh.name> | 2019-01-01 13:49:19 -0400 |
---|---|---|
committer | Joey Hess <joeyh@joeyh.name> | 2019-01-01 14:45:33 -0400 |
commit | 9cc6d5549b84e0ca8a0375aa14ecc8d359c977cc (patch) | |
tree | 15fece3c9f8ba4cab2604a92967fcdcac782d41d | |
parent | 1f52e5c5cbc2bd4845d0c332cbfabd0bdd6e19fb (diff) |
convert UUID from String to ByteString
This should make == comparison of UUIDs somewhat faster, and perhaps a
few other operations around maps of UUIDs etc.
FromUUID/ToUUID are used to convert String, which is still used for all
IO of UUIDs. Eventually the hope is those instances can be removed,
and all git-annex branch log files etc use ByteString throughout, for a
real speed improvement.
Note the use of fromRawFilePath / toRawFilePath -- while a UUID usually
contains only alphanumerics and so could be treated as ascii, it's
conceivable that some git-annex repository has been initialized using
a UUID that is not only not a canonical UUID, but contains high unicode
or invalid unicode. Using the filesystem encoding avoids any problems
with such a thing. However, a NUL in a UUID seems extremely unlikely,
so I didn't use encodeBS / decodeBS to avoid their extra overhead in
handling NULs.
The Read/Show instance for UUID luckily serializes the same way for
ByteString as it did for String.
-rw-r--r-- | Annex/UUID.hs | 9 | ||||
-rw-r--r-- | Command/Info.hs | 2 | ||||
-rw-r--r-- | Command/Map.hs | 2 | ||||
-rw-r--r-- | Command/TransferKeys.hs | 2 | ||||
-rw-r--r-- | Logs/Location.hs | 4 | ||||
-rw-r--r-- | Remote.hs | 2 | ||||
-rw-r--r-- | Remote/Helper/Ssh.hs | 2 | ||||
-rw-r--r-- | Types/UUID.hs | 34 |
8 files changed, 39 insertions, 18 deletions
diff --git a/Annex/UUID.hs b/Annex/UUID.hs index 8a2d884277..b65c98ace1 100644 --- a/Annex/UUID.hs +++ b/Annex/UUID.hs @@ -37,6 +37,7 @@ import Config import qualified Data.UUID as U import qualified Data.UUID.V4 as U4 import qualified Data.UUID.V5 as U5 +import Data.String import Utility.FileSystemEncoding configkey :: ConfigKey @@ -44,13 +45,13 @@ configkey = annexConfig "uuid" {- Generates a random UUID, that does not include the MAC address. -} genUUID :: IO UUID -genUUID = UUID . show <$> U4.nextRandom +genUUID = toUUID <$> U4.nextRandom {- Generates a UUID from a given string, using a namespace. - Given the same namespace, the same string will always result - in the same UUID. -} genUUIDInNameSpace :: U.UUID -> String -> UUID -genUUIDInNameSpace namespace = UUID . show . U5.generateNamed namespace . s2w8 +genUUIDInNameSpace namespace = toUUID . U5.generateNamed namespace . s2w8 {- Namespace used for UUIDs derived from git-remote-gcrypt ids. -} gCryptNameSpace :: U.UUID @@ -117,8 +118,8 @@ setUUID r u = do -- Dummy uuid for the whole web. Do not alter. webUUID :: UUID -webUUID = UUID "00000000-0000-0000-0000-000000000001" +webUUID = UUID (fromString "00000000-0000-0000-0000-000000000001") -- Dummy uuid for bittorrent. Do not alter. bitTorrentUUID :: UUID -bitTorrentUUID = UUID "00000000-0000-0000-0000-000000000002" +bitTorrentUUID = UUID (fromString "00000000-0000-0000-0000-000000000002") diff --git a/Command/Info.hs b/Command/Info.hs index 1fcf9b9d94..e4b61c4bec 100644 --- a/Command/Info.hs +++ b/Command/Info.hs @@ -456,7 +456,7 @@ transfer_list = stat desc $ nojson $ lift $ do [ ("transfer", toJSON' (formatDirection (transferDirection t))) , ("key", toJSON' (transferKey t)) , ("file", toJSON' afile) - , ("remote", toJSON' (fromUUID (transferUUID t))) + , ("remote", toJSON' (fromUUID (transferUUID t) :: String)) ] where AssociatedFile afile = associatedFile i diff --git a/Command/Map.hs b/Command/Map.hs index a4e44697e2..6889f44f22 100644 --- a/Command/Map.hs +++ b/Command/Map.hs @@ -113,7 +113,7 @@ nodeId :: Git.Repo -> String nodeId r = case getUncachedUUID r of NoUUID -> Git.repoLocation r - UUID u -> u + u@(UUID _) -> fromUUID u {- A node representing a repo. -} node :: M.Map UUID String -> [Git.Repo] -> TrustMap -> RepoRemotes -> String diff --git a/Command/TransferKeys.hs b/Command/TransferKeys.hs index cd841f2819..462480c6f0 100644 --- a/Command/TransferKeys.hs +++ b/Command/TransferKeys.hs @@ -82,7 +82,7 @@ sendRequest :: Transfer -> TransferInfo -> Handle -> IO () sendRequest t tinfo h = do hPutStr h $ intercalate fieldSep [ serialize (transferDirection t) - , maybe (serialize (fromUUID (transferUUID t))) + , maybe (serialize ((fromUUID (transferUUID t)) :: String)) (serialize . Remote.name) (transferRemote tinfo) , serialize (transferKey t) diff --git a/Logs/Location.hs b/Logs/Location.hs index 725ce1a075..57c8f53908 100644 --- a/Logs/Location.hs +++ b/Logs/Location.hs @@ -54,9 +54,9 @@ logChange :: Key -> UUID -> LogStatus -> Annex () logChange = logChange' logNow logChange' :: (LogStatus -> String -> Annex LogLine) -> Key -> UUID -> LogStatus -> Annex () -logChange' mklog key (UUID u) s = do +logChange' mklog key u@(UUID _) s = do config <- Annex.getGitConfig - maybeAddLog (locationLogFile config key) =<< mklog s u + maybeAddLog (locationLogFile config key) =<< mklog s (fromUUID u) logChange' _ _ NoUUID _ = noop {- Returns a list of repository UUIDs that, according to the log, have @@ -224,7 +224,7 @@ prettyPrintUUIDsWith optfield header descm showval uuidvals = do Nothing -> s Just val -> val ++ ": " ++ s jsonify hereu (u, optval) = object $ catMaybes - [ Just (packString "uuid", toJSON' $ fromUUID u) + [ Just (packString "uuid", toJSON' (fromUUID u :: String)) , Just (packString "description", toJSON' $ finddescription u) , Just (packString "here", toJSON' $ hereu == u) , case (optfield, optval) of diff --git a/Remote/Helper/Ssh.hs b/Remote/Helper/Ssh.hs index 53e60a553a..9c07a60382 100644 --- a/Remote/Helper/Ssh.hs +++ b/Remote/Helper/Ssh.hs @@ -67,7 +67,7 @@ git_annex_shell cs r command params fields else params return (Param command : File dir : params') uuidcheck NoUUID = [] - uuidcheck (UUID u) = ["--uuid", u] + uuidcheck u@(UUID _) = ["--uuid", fromUUID u] fieldopts | null fields = [] | otherwise = fieldsep : map fieldopt fields ++ [fieldsep] diff --git a/Types/UUID.hs b/Types/UUID.hs index f5c9cda301..5efc26dd0b 100644 --- a/Types/UUID.hs +++ b/Types/UUID.hs @@ -1,6 +1,6 @@ {- git-annex UUID type - - - Copyright 2011 Joey Hess <id@joeyh.name> + - Copyright 2011-2019 Joey Hess <id@joeyh.name> - - Licensed under the GNU GPL version 3 or higher. -} @@ -9,29 +9,49 @@ module Types.UUID where +import qualified Data.ByteString as B import qualified Data.Map as M import qualified Data.UUID as U import Data.Maybe +import Utility.FileSystemEncoding import qualified Utility.SimpleProtocol as Proto -- A UUID is either an arbitrary opaque string, or UUID info may be missing. -data UUID = NoUUID | UUID String +data UUID = NoUUID | UUID B.ByteString deriving (Eq, Ord, Show, Read) -fromUUID :: UUID -> String -fromUUID (UUID u) = u -fromUUID NoUUID = "" +class FromUUID a where + fromUUID :: UUID -> a class ToUUID a where toUUID :: a -> UUID +instance FromUUID UUID where + fromUUID = id + instance ToUUID UUID where toUUID = id +instance FromUUID B.ByteString where + fromUUID (UUID u) = u + fromUUID NoUUID = B.empty + +instance ToUUID B.ByteString where + toUUID b + | B.null b = NoUUID + | otherwise = UUID b + +instance FromUUID String where + fromUUID s = fromRawFilePath (fromUUID s) + instance ToUUID String where - toUUID [] = NoUUID - toUUID s = UUID s + toUUID s = toUUID (toRawFilePath s) + +-- There is no matching FromUUID U.UUID because a git-annex UUID may +-- be NoUUID or perhaps contain something not allowed in a canonical UUID. +instance ToUUID U.UUID where + toUUID = toUUID . U.toASCIIBytes isUUID :: String -> Bool isUUID = isJust . U.fromString |