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.

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")

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

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

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)

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

Remote.hs

@@ -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

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]

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
+class FromUUID a where
-fromUUID (UUID u) = u
+	fromUUID :: UUID -> a
-fromUUID NoUUID = ""
 
 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 = toUUID (toRawFilePath s)
-	toUUID s = UUID 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