merging sqlite and bs branches

Since the sqlite branch uses blobs extensively, there are some
performance benefits, ByteStrings now get stored and retrieved w/o
conversion in some cases like in Database.Export.

Git/AutoCorrect.hs

@@ -5,6 +5,8 @@
  - Licensed under the GNU AGPL version 3 or higher.
  -}
 
+{-# LANGUAGE OverloadedStrings #-}
+
 module Git.AutoCorrect where
 
 import Common
@@ -44,7 +46,7 @@ fuzzymatches input showchoice choices = fst $ unzip $
  -}
 prepare :: String -> (c -> String) -> [c] -> Maybe Repo -> IO ()
 prepare input showmatch matches r =
-	case readish . Git.Config.get "help.autocorrect" "0" =<< r of
+	case readish . fromConfigValue . Git.Config.get "help.autocorrect" "0" =<< r of
 		Just n
 			| n == 0 -> list
 			| n < 0 -> warn Nothing

Git/Branch.hs

@@ -6,6 +6,7 @@
  -}
 
 {-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE OverloadedStrings #-}
 
 module Git.Branch where
 
@@ -16,6 +17,8 @@ import Git.Command
 import qualified Git.Config
 import qualified Git.Ref
 
+import qualified Data.ByteString as B
+
 {- The currently checked out branch.
  -
  - In a just initialized git repo before the first commit,
@@ -29,19 +32,19 @@ current r = do
 	case v of
 		Nothing -> return Nothing
 		Just branch -> 
-			ifM (null <$> pipeReadStrict [Param "show-ref", Param $ fromRef branch] r)
+			ifM (B.null <$> pipeReadStrict [Param "show-ref", Param $ fromRef branch] r)
 				( return Nothing
 				, return v
 				)
 
 {- The current branch, which may not really exist yet. -}
 currentUnsafe :: Repo -> IO (Maybe Branch)
-currentUnsafe r = parse . firstLine
+currentUnsafe r = parse . firstLine'
 	<$> pipeReadStrict [Param "symbolic-ref", Param "-q", Param $ fromRef Git.Ref.headRef] r
   where
-	parse l
-		| null l = Nothing
-		| otherwise = Just $ Git.Ref l
+	parse b
+		| B.null b = Nothing
+		| otherwise = Just $ Git.Ref $ decodeBS b
 
 {- Checks if the second branch has any commits not present on the first
  - branch. -}
@@ -53,7 +56,8 @@ changed origbranch newbranch repo
   where
 
 changed' :: Branch -> Branch -> [CommandParam] -> Repo -> IO String
-changed' origbranch newbranch extraps repo = pipeReadStrict ps repo
+changed' origbranch newbranch extraps repo =
+	decodeBS <$> pipeReadStrict ps repo
   where
 	ps =
 		[ Param "log"
@@ -72,7 +76,7 @@ changedCommits origbranch newbranch extraps repo =
  -
  - This requires there to be a path from the old to the new. -}
 fastForwardable :: Ref -> Ref -> Repo -> IO Bool
-fastForwardable old new repo = not . null <$>
+fastForwardable old new repo = not . B.null <$>
 	pipeReadStrict
 		[ Param "log"
 		, Param $ fromRef old ++ ".." ++ fromRef new
@@ -132,8 +136,8 @@ applyCommitMode commitmode ps
 applyCommitModeForCommitTree :: CommitMode -> [CommandParam] -> Repo -> [CommandParam]
 applyCommitModeForCommitTree commitmode ps r
 	| commitmode == ManualCommit =
-		case (Git.Config.getMaybe "commit.gpgsign" r) of
-			Just s | Git.Config.isTrue s == Just True ->
+		case Git.Config.getMaybe "commit.gpgsign" r of
+			Just s | Git.Config.isTrue' s == Just True ->
 				Param "-S":ps
 			_ -> ps'
 	| otherwise = ps'
@@ -160,7 +164,7 @@ commitCommand' runner commitmode ps = runner $
 commit :: CommitMode -> Bool -> String -> Branch -> [Ref] -> Repo -> IO (Maybe Sha)
 commit commitmode allowempty message branch parentrefs repo = do
 	tree <- getSha "write-tree" $
-		pipeReadStrict [Param "write-tree"] repo
+		decodeBS' <$> pipeReadStrict [Param "write-tree"] repo
 	ifM (cancommit tree)
 		( do
 			sha <- commitTree commitmode message parentrefs tree repo

Git/CatFile.hs

@@ -66,13 +66,13 @@ catFileStop h = do
 	CoProcess.stop (checkFileProcess h)
 
 {- Reads a file from a specified branch. -}
-catFile :: CatFileHandle -> Branch -> FilePath -> IO L.ByteString
+catFile :: CatFileHandle -> Branch -> RawFilePath -> IO L.ByteString
 catFile h branch file = catObject h $ Ref $
-	fromRef branch ++ ":" ++ toInternalGitPath file
+	fromRef branch ++ ":" ++ fromRawFilePath (toInternalGitPath file)
 
-catFileDetails :: CatFileHandle -> Branch -> FilePath -> IO (Maybe (L.ByteString, Sha, ObjectType))
+catFileDetails :: CatFileHandle -> Branch -> RawFilePath -> IO (Maybe (L.ByteString, Sha, ObjectType))
 catFileDetails h branch file = catObjectDetails h $ Ref $
-	fromRef branch ++ ":" ++ toInternalGitPath file
+	fromRef branch ++ ":" ++ fromRawFilePath (toInternalGitPath file)
 
 {- Uses a running git cat-file read the content of an object.
  - Objects that do not exist will have "" returned. -}
@@ -148,7 +148,7 @@ parseResp object l
 	| otherwise = case words l of
 		[sha, objtype, size]
 			| length sha == shaSize ->
-				case (readObjectType objtype, reads size) of
+				case (readObjectType (encodeBS objtype), reads size) of
 					(Just t, [(bytes, "")]) -> 
 						Just $ ParsedResp (Ref sha) bytes t
 					_ -> Nothing
@@ -185,7 +185,7 @@ querySize r repo = maybe Nothing (readMaybe . takeWhile (/= '\n'))
 	<$> querySingle (Param "-s") r repo hGetContentsStrict
 
 queryObjectType :: Ref -> Repo -> IO (Maybe ObjectType)
-queryObjectType r repo = maybe Nothing (readObjectType . takeWhile (/= '\n'))
+queryObjectType r repo = maybe Nothing (readObjectType . encodeBS . takeWhile (/= '\n'))
 	<$> querySingle (Param "-t") r repo hGetContentsStrict
 
 queryContent :: Ref -> Repo -> IO (Maybe L.ByteString)

Git/Command.hs

@@ -14,6 +14,9 @@ import Git
 import Git.Types
 import qualified Utility.CoProcess as CoProcess
 
+import qualified Data.ByteString.Lazy as L
+import qualified Data.ByteString as S
+
 {- Constructs a git command line operating on the specified repo. -}
 gitCommandLine :: [CommandParam] -> Repo -> [CommandParam]
 gitCommandLine params r@(Repo { location = l@(Local { } ) }) =
@@ -50,10 +53,10 @@ runQuiet params repo = withQuietOutput createProcessSuccess $
  - read, that will wait on the command, and
  - return True if it succeeded. Failure to wait will result in zombies.
  -}
-pipeReadLazy :: [CommandParam] -> Repo -> IO (String, IO Bool)
+pipeReadLazy :: [CommandParam] -> Repo -> IO (L.ByteString, IO Bool)
 pipeReadLazy params repo = assertLocal repo $ do
 	(_, Just h, _, pid) <- createProcess p { std_out = CreatePipe }
-	c <- hGetContents h
+	c <- L.hGetContents h
 	return (c, checkSuccessProcess pid)
   where
 	p  = gitCreateProcess params repo
@@ -62,8 +65,8 @@ pipeReadLazy params repo = assertLocal repo $ do
  -
  - Nonzero exit status is ignored.
  -}
-pipeReadStrict :: [CommandParam] -> Repo -> IO String
-pipeReadStrict = pipeReadStrict' hGetContentsStrict
+pipeReadStrict :: [CommandParam] -> Repo -> IO S.ByteString
+pipeReadStrict = pipeReadStrict' S.hGetContents
 
 {- The reader action must be strict. -}
 pipeReadStrict' :: (Handle -> IO a) -> [CommandParam] -> Repo -> IO a
@@ -93,23 +96,30 @@ pipeWrite params repo = assertLocal repo $
 
 {- Reads null terminated output of a git command (as enabled by the -z 
  - parameter), and splits it. -}
-pipeNullSplit :: [CommandParam] -> Repo -> IO ([String], IO Bool)
+pipeNullSplit :: [CommandParam] -> Repo -> IO ([L.ByteString], IO Bool)
 pipeNullSplit params repo = do
 	(s, cleanup) <- pipeReadLazy params repo
-	return (filter (not . null) $ splitc sep s, cleanup)
-  where
-	sep = '\0'
+	return (filter (not . L.null) $ L.split 0 s, cleanup)
 
-pipeNullSplitStrict :: [CommandParam] -> Repo -> IO [String]
+{- Reads lazily, but copies each part to a strict ByteString for
+ - convenience.
+ -}
+pipeNullSplit' :: [CommandParam] -> Repo -> IO ([S.ByteString], IO Bool)
+pipeNullSplit' params repo = do
+	(s, cleanup) <- pipeNullSplit params repo
+	return (map L.toStrict s, cleanup)
+
+pipeNullSplitStrict :: [CommandParam] -> Repo -> IO [S.ByteString]
 pipeNullSplitStrict params repo = do
 	s <- pipeReadStrict params repo
-	return $ filter (not . null) $ splitc sep s
-  where
-	sep = '\0'
+	return $ filter (not . S.null) $ S.split 0 s
 
-pipeNullSplitZombie :: [CommandParam] -> Repo -> IO [String]
+pipeNullSplitZombie :: [CommandParam] -> Repo -> IO [L.ByteString]
 pipeNullSplitZombie params repo = leaveZombie <$> pipeNullSplit params repo
 
+pipeNullSplitZombie' :: [CommandParam] -> Repo -> IO [S.ByteString]
+pipeNullSplitZombie' params repo = leaveZombie <$> pipeNullSplit' params repo
+
 {- Doesn't run the cleanup action. A zombie results. -}
 leaveZombie :: (a, IO Bool) -> a
 leaveZombie = fst

Git/Config.hs

@@ -1,13 +1,17 @@
 {- git repository configuration handling
  -
- - Copyright 2010-2012 Joey Hess <id@joeyh.name>
+ - Copyright 2010-2019 Joey Hess <id@joeyh.name>
  -
  - Licensed under the GNU AGPL version 3 or higher.
  -}
 
+{-# LANGUAGE OverloadedStrings #-}
+
 module Git.Config where
 
 import qualified Data.Map as M
+import qualified Data.ByteString as S
+import qualified Data.ByteString.Char8 as S8
 import Data.Char
 
 import Common
@@ -17,16 +21,16 @@ import qualified Git.Command
 import qualified Git.Construct
 import Utility.UserInfo
 
-{- Returns a single git config setting, or a default value if not set. -}
-get :: String -> String -> Repo -> String
-get key defaultValue repo = M.findWithDefault defaultValue key (config repo)
+{- Returns a single git config setting, or a fallback value if not set. -}
+get :: ConfigKey -> ConfigValue -> Repo -> ConfigValue
+get key fallback repo = M.findWithDefault fallback key (config repo)
 
-{- Returns a list with each line of a multiline config setting. -}
-getList :: String -> Repo -> [String]
+{- Returns a list of values. -}
+getList :: ConfigKey -> Repo -> [ConfigValue]
 getList key repo = M.findWithDefault [] key (fullconfig repo)
 
 {- Returns a single git config setting, if set. -}
-getMaybe :: String -> Repo -> Maybe String
+getMaybe :: ConfigKey -> Repo -> Maybe ConfigValue
 getMaybe key repo = M.lookup key (config repo)
 
 {- Runs git config and populates a repo with its config.
@@ -79,14 +83,14 @@ global = do
 {- Reads git config from a handle and populates a repo with it. -}
 hRead :: Repo -> Handle -> IO Repo
 hRead repo h = do
-	val <- hGetContentsStrict h
+	val <- S.hGetContents h
 	store val repo
 
 {- Stores a git config into a Repo, returning the new version of the Repo.
  - The git config may be multiple lines, or a single line.
  - Config settings can be updated incrementally.
  -}
-store :: String -> Repo -> IO Repo
+store :: S.ByteString -> Repo -> IO Repo
 store s repo = do
 	let c = parse s
 	updateLocation $ repo
@@ -96,7 +100,7 @@ store s repo = do
 
 {- Stores a single config setting in a Repo, returning the new version of
  - the Repo. Config settings can be updated incrementally. -}
-store' :: String -> String -> Repo -> Repo
+store' :: ConfigKey -> ConfigValue -> Repo -> Repo
 store' k v repo = repo
 	{ config = M.singleton k v `M.union` config repo
 	, fullconfig = M.unionWith (++) (M.singleton k [v]) (fullconfig repo)
@@ -124,52 +128,66 @@ updateLocation' :: Repo -> RepoLocation -> IO Repo
 updateLocation' r l = do
 	l' <- case getMaybe "core.worktree" r of
 		Nothing -> return l
-		Just d -> do
+		Just (ConfigValue d) -> do
 			{- core.worktree is relative to the gitdir -}
 			top <- absPath $ gitdir l
-			return $ l { worktree = Just $ absPathFrom top d }
+			let p = absPathFrom top (fromRawFilePath d)
+			return $ l { worktree = Just p }
 	return $ r { location = l' }
 
 {- Parses git config --list or git config --null --list output into a
  - config map. -}
-parse :: String -> M.Map String [String]
-parse [] = M.empty
+parse :: S.ByteString -> M.Map ConfigKey [ConfigValue]
 parse s
-	-- --list output will have an = in the first line
-	| all ('=' `elem`) (take 1 ls) = sep '=' ls
+	| S.null s = M.empty
+	-- --list output will have a '=' in the first line
+	-- (The first line of --null --list output is the name of a key,
+	-- which is assumed to never contain '='.)
+	| S.elem eq firstline = sep eq $ S.split nl s
 	-- --null --list output separates keys from values with newlines
-	| otherwise = sep '\n' $ splitc '\0' s
+	| otherwise = sep nl $ S.split 0 s
   where
-	ls = lines s
-	sep c = M.fromListWith (++) . map (\(k,v) -> (k, [v])) .
-		map (separate (== c))
+	nl = fromIntegral (ord '\n')
+	eq = fromIntegral (ord '=')
+	firstline = S.takeWhile (/= nl) s
+
+	sep c = M.fromListWith (++)
+		. map (\(k,v) -> (ConfigKey k, [ConfigValue (S.drop 1 v)])) 
+		. map (S.break (== c))
 
 {- Checks if a string from git config is a true value. -}
 isTrue :: String -> Maybe Bool
-isTrue s
+isTrue = isTrue' . ConfigValue . encodeBS'
+
+isTrue' :: ConfigValue -> Maybe Bool
+isTrue' (ConfigValue s)
 	| s' == "true" = Just True
 	| s' == "false" = Just False
 	| otherwise = Nothing
   where
-	s' = map toLower s
+	s' = S8.map toLower s
 
 boolConfig :: Bool -> String
 boolConfig True = "true"
 boolConfig False = "false"
 
-isBare :: Repo -> Bool
-isBare r = fromMaybe False $ isTrue =<< getMaybe coreBare r
+boolConfig' :: Bool -> S.ByteString
+boolConfig' True = "true"
+boolConfig' False = "false"
 
-coreBare :: String
+isBare :: Repo -> Bool
+isBare r = fromMaybe False $ isTrue' =<< getMaybe coreBare r
+
+coreBare :: ConfigKey
 coreBare = "core.bare"
 
 {- Runs a command to get the configuration of a repo,
  - and returns a repo populated with the configuration, as well as the raw
  - output of the command. -}
-fromPipe :: Repo -> String -> [CommandParam] -> IO (Either SomeException (Repo, String))
+fromPipe :: Repo -> String -> [CommandParam] -> IO (Either SomeException (Repo, S.ByteString))
 fromPipe r cmd params = try $
 	withHandle StdoutHandle createProcessSuccess p $ \h -> do
-		val <- hGetContentsStrict h
+		val <- S.hGetContents h
 		r' <- store val r
 		return (r', val)
   where
@@ -177,7 +195,7 @@ fromPipe r cmd params = try $
 
 {- Reads git config from a specified file and returns the repo populated
  - with the configuration. -}
-fromFile :: Repo -> FilePath -> IO (Either SomeException (Repo, String))
+fromFile :: Repo -> FilePath -> IO (Either SomeException (Repo, S.ByteString))
 fromFile r f = fromPipe r "git"
 	[ Param "config"
 	, Param "--file"
@@ -187,13 +205,13 @@ fromFile r f = fromPipe r "git"
 
 {- Changes a git config setting in the specified config file.
  - (Creates the file if it does not already exist.) -}
-changeFile :: FilePath -> String -> String -> IO Bool
-changeFile f k v = boolSystem "git"
+changeFile :: FilePath -> ConfigKey -> S.ByteString -> IO Bool
+changeFile f (ConfigKey k) v = boolSystem "git"
 	[ Param "config"
 	, Param "--file"
 	, File f
-	, Param k
-	, Param v
+	, Param (decodeBS' k)
+	, Param (decodeBS' v)
 	]
 
 {- Unsets a git config setting, in both the git repo,
@@ -202,10 +220,10 @@ changeFile f k v = boolSystem "git"
  - If unsetting the config fails, including in a read-only repo, or
  - when the config is not set, returns Nothing.
  -}
-unset :: String -> Repo -> IO (Maybe Repo)
-unset k r = ifM (Git.Command.runBool ps r)
-	( return $ Just $ r { config = M.delete k (config r) }
+unset :: ConfigKey -> Repo -> IO (Maybe Repo)
+unset ck@(ConfigKey k) r = ifM (Git.Command.runBool ps r)
+	( return $ Just $ r { config = M.delete ck (config r) }
 	, return Nothing
 	)
   where
-	ps = [Param "config", Param "--unset-all", Param k]
+	ps = [Param "config", Param "--unset-all", Param (decodeBS' k)]

Git/ConfigTypes.hs

@@ -5,12 +5,16 @@
  - Licensed under the GNU AGPL version 3 or higher.
  -}
 
+{-# LANGUAGE OverloadedStrings #-}
+
 module Git.ConfigTypes where
 
 import Data.Char
+import qualified Data.ByteString.Char8 as S8
 
 import Common
 import Git
+import Git.Types
 import qualified Git.Config
 
 data SharedRepository = UnShared | GroupShared | AllShared | UmaskShared Int
@@ -18,23 +22,27 @@ data SharedRepository = UnShared | GroupShared | AllShared | UmaskShared Int
 
 getSharedRepository :: Repo -> SharedRepository
 getSharedRepository r =
-	case map toLower $ Git.Config.get "core.sharedrepository" "" r of
-		"1" -> GroupShared
-		"2" -> AllShared
-		"group" -> GroupShared
-		"true" -> GroupShared
-		"all" -> AllShared
-		"world" -> AllShared
-		"everybody" -> AllShared
-		v -> maybe UnShared UmaskShared (readish v)
+	case Git.Config.getMaybe "core.sharedrepository" r of
+		Nothing -> UnShared
+		Just (ConfigValue v) -> case S8.map toLower v of
+			"1" -> GroupShared
+			"2" -> AllShared
+			"group" -> GroupShared
+			"true" -> GroupShared
+			"all" -> AllShared
+			"world" -> AllShared
+			"everybody" -> AllShared
+			_ -> maybe UnShared UmaskShared (readish (decodeBS' v))
 
 data DenyCurrentBranch = UpdateInstead | RefusePush | WarnPush | IgnorePush
 	deriving (Eq)
 
 getDenyCurrentBranch :: Repo -> DenyCurrentBranch
-getDenyCurrentBranch r =
-	case map toLower $ Git.Config.get "receive.denycurrentbranch" "" r of
-		"updateinstead" -> UpdateInstead
-		"warn" -> WarnPush
-		"ignore" -> IgnorePush
-		_ -> RefusePush
+getDenyCurrentBranch r = 
+	case Git.Config.getMaybe "receive.denycurrentbranch" r of
+		Just (ConfigValue v) -> case S8.map toLower v of
+			"updateinstead" -> UpdateInstead
+			"warn" -> WarnPush
+			"ignore" -> IgnorePush
+			_ -> RefusePush
+		Nothing -> RefusePush

Git/Construct.hs

@@ -58,7 +58,7 @@ fromPath dir = fromAbsPath =<< absPath dir
  - specified. -}
 fromAbsPath :: FilePath -> IO Repo
 fromAbsPath dir
-	| absoluteGitPath dir = hunt
+	| absoluteGitPath (encodeBS dir) = hunt
 	| otherwise =
 		error $ "internal error, " ++ dir ++ " is not absolute"
   where
@@ -128,7 +128,7 @@ fromRemotes repo = mapM construct remotepairs
 	filterconfig f = filter f $ M.toList $ config repo
 	filterkeys f = filterconfig (\(k,_) -> f k)
 	remotepairs = filterkeys isRemoteKey
-	construct (k,v) = remoteNamedFromKey k $ fromRemoteLocation v repo
+	construct (k,v) = remoteNamedFromKey k (fromRemoteLocation (fromConfigValue v) repo)
 
 {- Sets the name of a remote when constructing the Repo to represent it. -}
 remoteNamed :: String -> IO Repo -> IO Repo
@@ -138,7 +138,7 @@ remoteNamed n constructor = do
 
 {- Sets the name of a remote based on the git config key, such as
  - "remote.foo.url". -}
-remoteNamedFromKey :: String -> IO Repo -> IO Repo
+remoteNamedFromKey :: ConfigKey -> IO Repo -> IO Repo
 remoteNamedFromKey = remoteNamed . remoteKeyToRemoteName
 
 {- Constructs a new Repo for one of a Repo's remotes using a given

Git/DiffTree.hs

@@ -89,7 +89,7 @@ commitDiff ref = getdiff (Param "show")
 getdiff :: CommandParam -> [CommandParam] -> Repo -> IO ([DiffTreeItem], IO Bool)
 getdiff command params repo = do
 	(diff, cleanup) <- pipeNullSplit ps repo
-	return (parseDiffRaw diff, cleanup)
+	return (parseDiffRaw (map decodeBL diff), cleanup)
   where
 	ps = 
 		command :
@@ -113,7 +113,7 @@ parseDiffRaw l = go l
 		, srcsha = fromMaybe (error "bad srcsha") $ extractSha ssha
 		, dstsha = fromMaybe (error "bad dstsha") $ extractSha dsha
 		, status = s
-		, file = asTopFilePath $ fromInternalGitPath $ Git.Filename.decode f
+		, file = asTopFilePath $ fromRawFilePath $ fromInternalGitPath $ Git.Filename.decode $ toRawFilePath f
 		}
 	  where
 		readmode = fst . Prelude.head . readOct

Git/FilePath.hs

@@ -12,6 +12,7 @@
 
 {-# LANGUAGE CPP #-}
 {-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE OverloadedStrings #-}
 
 module Git.FilePath (
 	TopFilePath,
@@ -33,8 +34,9 @@ import Git
 import qualified System.FilePath.Posix
 import GHC.Generics
 import Control.DeepSeq
+import qualified Data.ByteString as S
 
-{- A FilePath, relative to the top of the git repository. -}
+{- A RawFilePath, relative to the top of the git repository. -}
 newtype TopFilePath = TopFilePath { getTopFilePath :: FilePath }
 	deriving (Show, Eq, Ord, Generic)
 
@@ -45,8 +47,9 @@ data BranchFilePath = BranchFilePath Ref TopFilePath
 	deriving (Show, Eq, Ord)
 
 {- Git uses the branch:file form to refer to a BranchFilePath -}
-descBranchFilePath :: BranchFilePath -> String
-descBranchFilePath (BranchFilePath b f) = fromRef b ++ ':' : getTopFilePath f
+descBranchFilePath :: BranchFilePath -> S.ByteString
+descBranchFilePath (BranchFilePath b f) =
+	encodeBS' (fromRef b) <> ":" <> toRawFilePath (getTopFilePath f)
 
 {- Path to a TopFilePath, within the provided git repo. -}
 fromTopFilePath :: TopFilePath -> Git.Repo -> FilePath
@@ -68,25 +71,25 @@ asTopFilePath file = TopFilePath file
  - despite Windows using '\'.
  -
  -}
-type InternalGitPath = String
+type InternalGitPath = RawFilePath
 
-toInternalGitPath :: FilePath -> InternalGitPath
+toInternalGitPath :: RawFilePath -> InternalGitPath
 #ifndef mingw32_HOST_OS
 toInternalGitPath = id
 #else
-toInternalGitPath = replace "\\" "/"
+toInternalGitPath = encodeBS . replace "\\" "/" . decodeBS
 #endif
 
-fromInternalGitPath :: InternalGitPath -> FilePath
+fromInternalGitPath :: InternalGitPath -> RawFilePath
 #ifndef mingw32_HOST_OS
 fromInternalGitPath = id
 #else
-fromInternalGitPath = replace "/" "\\"
+fromInternalGitPath = encodeBS . replace "/" "\\" . decodeBS
 #endif
 
 {- isAbsolute on Windows does not think "/foo" or "\foo" is absolute,
  - so try posix paths.
  -}
-absoluteGitPath :: FilePath -> Bool
-absoluteGitPath p = isAbsolute p ||
-	System.FilePath.Posix.isAbsolute (toInternalGitPath p)
+absoluteGitPath :: RawFilePath -> Bool
+absoluteGitPath p = isAbsolute (decodeBS p) ||
+	System.FilePath.Posix.isAbsolute (decodeBS (toInternalGitPath p))

Git/Filename.hs

@@ -12,23 +12,44 @@ import Common
 import Utility.Format (decode_c, encode_c)
 
 import Data.Char
+import Data.Word
+import qualified Data.ByteString as S
 
-decode :: String -> FilePath
-decode [] = []
-decode f@(c:s)
-	-- encoded strings will be inside double quotes
-	| c == '"' && end s == ['"'] = decode_c $ beginning s
-	| otherwise = f
+-- encoded filenames will be inside double quotes
+decode :: S.ByteString -> RawFilePath
+decode b = case S.uncons b of
+	Nothing -> b
+	Just (h, t)
+		| h /= q -> b
+		| otherwise -> case S.unsnoc t of
+			Nothing -> b
+			Just (i, l)
+				| l /= q -> b
+				| otherwise ->
+					encodeBS $ decode_c $ decodeBS i
+  where
+  	q :: Word8
+	q = fromIntegral (ord '"')
 
 {- Should not need to use this, except for testing decode. -}
-encode :: FilePath -> String
-encode s = "\"" ++ encode_c s ++ "\""
+encode :: RawFilePath -> S.ByteString
+encode s = encodeBS $ "\"" ++ encode_c (decodeBS s) ++ "\""
 
-{- For quickcheck. 
- -
- - See comment on Utility.Format.prop_encode_c_decode_c_roundtrip for
- - why this only tests chars < 256 -}
-prop_encode_decode_roundtrip :: String -> Bool
-prop_encode_decode_roundtrip s = s' == decode (encode s')
+prop_encode_decode_roundtrip :: FilePath -> Bool
+prop_encode_decode_roundtrip s = s' ==
+	fromRawFilePath (decode (encode (toRawFilePath s')))
   where
-	s' = filter (\c -> ord c < 256) s
+	s' = nonul (nohigh s)
+	-- Encoding and then decoding roundtrips only when
+	-- the string does not contain high unicode, because eg, 
+	-- both "\12345" and "\227\128\185" are encoded to
+	-- "\343\200\271".
+	--
+	-- This property papers over the problem, by only
+	-- testing chars < 256.
+	nohigh = filter (\c -> ord c < 256)
+	-- A String can contain a NUL, but toRawFilePath
+	-- truncates on the NUL, which is generally fine
+	-- because unix filenames cannot contain NUL.
+	-- So the encoding only roundtrips when there is no nul.
+	nonul = filter (/= '\NUL')

Git/GCrypt.hs

@@ -7,6 +7,8 @@
  - Licensed under the GNU AGPL version 3 or higher.
  -}
 
+{-# LANGUAGE OverloadedStrings #-}
+
 module Git.GCrypt where
 
 import Common
@@ -16,6 +18,8 @@ import qualified Git.Config as Config
 import qualified Git.Command as Command
 import Utility.Gpg
 
+import qualified Data.ByteString as S
+
 urlScheme :: String
 urlScheme = "gcrypt:"
 
@@ -75,9 +79,9 @@ type GCryptId = String
  - which is stored in the repository (in encrypted form)
  - and cached in a per-remote gcrypt-id configuration setting. -}
 remoteRepoId :: Repo -> Maybe RemoteName -> Maybe GCryptId
-remoteRepoId = getRemoteConfig "gcrypt-id"
+remoteRepoId r n = fromConfigValue <$> getRemoteConfig "gcrypt-id" r n
 
-getRemoteConfig :: String -> Repo -> Maybe RemoteName -> Maybe String
+getRemoteConfig :: S.ByteString -> Repo -> Maybe RemoteName -> Maybe ConfigValue
 getRemoteConfig field repo remotename = do
 	n <- remotename
 	Config.getMaybe (remoteConfigKey field n) repo
@@ -92,18 +96,19 @@ getParticiantList globalconfigrepo repo remotename = KeyIds $ parse $ firstJust
 	]
   where
 	defaultkey = "gcrypt.participants"
-	parse (Just "simple") = []
-	parse (Just l) = words l
+	parse (Just (ConfigValue "simple")) = []
+	parse (Just (ConfigValue b)) = words (decodeBS' b)
 	parse Nothing = []
 
-remoteParticipantConfigKey :: RemoteName -> String
+remoteParticipantConfigKey :: RemoteName -> ConfigKey
 remoteParticipantConfigKey = remoteConfigKey "gcrypt-participants"
 
-remotePublishParticipantConfigKey :: RemoteName -> String
+remotePublishParticipantConfigKey :: RemoteName -> ConfigKey
 remotePublishParticipantConfigKey = remoteConfigKey "gcrypt-publish-participants"
 
-remoteSigningKey :: RemoteName -> String
+remoteSigningKey :: RemoteName -> ConfigKey
 remoteSigningKey = remoteConfigKey "gcrypt-signingkey"
 
-remoteConfigKey :: String -> RemoteName -> String
-remoteConfigKey key remotename = "remote." ++ remotename ++ "." ++ key
+remoteConfigKey :: S.ByteString -> RemoteName -> ConfigKey
+remoteConfigKey key remotename = ConfigKey $
+	"remote." <> encodeBS' remotename <> "." <> key

Git/HashObject.hs

@@ -73,4 +73,4 @@ hashObject' objtype writer repo = getSha subcmd $
 	pipeWriteRead (map Param params) (Just writer) repo
   where
 	subcmd = "hash-object"
-	params = [subcmd, "-t", show objtype, "-w", "--stdin", "--no-filters"]
+	params = [subcmd, "-t", decodeBS (fmtObjectType objtype), "-w", "--stdin", "--no-filters"]

Git/LsFiles.hs

@@ -38,37 +38,40 @@ import Utility.TimeStamp
 import Numeric
 import System.Posix.Types
 import qualified Data.Map as M
+import qualified Data.ByteString.Lazy as L
 
 {- Scans for files that are checked into git's index at the specified locations. -}
-inRepo :: [FilePath] -> Repo -> IO ([FilePath], IO Bool)
+inRepo :: [RawFilePath] -> Repo -> IO ([RawFilePath], IO Bool)
 inRepo = inRepo' [] 
 
-inRepo' :: [CommandParam] -> [FilePath] -> Repo -> IO ([FilePath], IO Bool)
-inRepo' ps l = pipeNullSplit $ 
-	Param "ls-files" :
-	Param "--cached" :
-	Param "-z" :
-	ps ++
-	(Param "--" : map File l)
+inRepo' :: [CommandParam] -> [RawFilePath] -> Repo -> IO ([RawFilePath], IO Bool)
+inRepo' ps l repo = pipeNullSplit' params repo
+  where
+	params = 
+		Param "ls-files" :
+		Param "--cached" :
+		Param "-z" :
+		ps ++
+		(Param "--" : map (File . fromRawFilePath) l)
 
 {- Files that are checked into the index or have been committed to a
  - branch. -}
-inRepoOrBranch :: Branch -> [FilePath] -> Repo -> IO ([FilePath], IO Bool)
+inRepoOrBranch :: Branch -> [RawFilePath] -> Repo -> IO ([RawFilePath], IO Bool)
 inRepoOrBranch (Ref b) = inRepo' [Param $ "--with-tree=" ++ b]
 
 {- Scans for files at the specified locations that are not checked into git. -}
-notInRepo :: Bool -> [FilePath] -> Repo -> IO ([FilePath], IO Bool)
+notInRepo :: Bool -> [RawFilePath] -> Repo -> IO ([RawFilePath], IO Bool)
 notInRepo = notInRepo' []
 
-notInRepo' :: [CommandParam] -> Bool -> [FilePath] -> Repo -> IO ([FilePath], IO Bool)
-notInRepo' ps include_ignored l repo = pipeNullSplit params repo
+notInRepo' :: [CommandParam] -> Bool -> [RawFilePath] -> Repo -> IO ([RawFilePath], IO Bool)
+notInRepo' ps include_ignored l repo = pipeNullSplit' params repo
   where
 	params = concat
 		[ [ Param "ls-files", Param "--others"]
 		, ps
 		, exclude
 		, [ Param "-z", Param "--" ]
-		, map File l
+		, map (File . fromRawFilePath) l
 		]
 	exclude
 		| include_ignored = []
@@ -76,48 +79,48 @@ notInRepo' ps include_ignored l repo = pipeNullSplit params repo
 
 {- Scans for files at the specified locations that are not checked into
  - git. Empty directories are included in the result. -}
-notInRepoIncludingEmptyDirectories :: Bool -> [FilePath] -> Repo -> IO ([FilePath], IO Bool)
+notInRepoIncludingEmptyDirectories :: Bool -> [RawFilePath] -> Repo -> IO ([RawFilePath], IO Bool)
 notInRepoIncludingEmptyDirectories = notInRepo' [Param "--directory"]
 
 {- Finds all files in the specified locations, whether checked into git or
  - not. -}
-allFiles :: [FilePath] -> Repo -> IO ([FilePath], IO Bool)
-allFiles l = pipeNullSplit $
+allFiles :: [RawFilePath] -> Repo -> IO ([RawFilePath], IO Bool)
+allFiles l = pipeNullSplit' $
 	Param "ls-files" :
 	Param "--cached" :
 	Param "--others" :
 	Param "-z" :
 	Param "--" :
-	map File l
+	map (File . fromRawFilePath) l
 
 {- Returns a list of files in the specified locations that have been
  - deleted. -}
-deleted :: [FilePath] -> Repo -> IO ([FilePath], IO Bool)
-deleted l repo = pipeNullSplit params repo
+deleted :: [RawFilePath] -> Repo -> IO ([RawFilePath], IO Bool)
+deleted l repo = pipeNullSplit' params repo
   where
 	params =
 		Param "ls-files" :
 		Param "--deleted" :
 		Param "-z" :
 		Param "--" :
-		map File l
+		map (File . fromRawFilePath) l
 
 {- Returns a list of files in the specified locations that have been
  - modified. -}
-modified :: [FilePath] -> Repo -> IO ([FilePath], IO Bool)
-modified l repo = pipeNullSplit params repo
+modified :: [RawFilePath] -> Repo -> IO ([RawFilePath], IO Bool)
+modified l repo = pipeNullSplit' params repo
   where
 	params = 
 		Param "ls-files" :
 		Param "--modified" :
 		Param "-z" :
 		Param "--" :
-		map File l
+		map (File . fromRawFilePath) l
 
 {- Files that have been modified or are not checked into git (and are not
  - ignored). -}
-modifiedOthers :: [FilePath] -> Repo -> IO ([FilePath], IO Bool)
-modifiedOthers l repo = pipeNullSplit params repo
+modifiedOthers :: [RawFilePath] -> Repo -> IO ([RawFilePath], IO Bool)
+modifiedOthers l repo = pipeNullSplit' params repo
   where
 	params = 
 		Param "ls-files" :
@@ -126,69 +129,69 @@ modifiedOthers l repo = pipeNullSplit params repo
 		Param "--exclude-standard" :
 		Param "-z" :
 		Param "--" :
-		map File l
+		map (File . fromRawFilePath) l
 
 {- Returns a list of all files that are staged for commit. -}
-staged :: [FilePath] -> Repo -> IO ([FilePath], IO Bool)
+staged :: [RawFilePath] -> Repo -> IO ([RawFilePath], IO Bool)
 staged = staged' []
 
 {- Returns a list of the files, staged for commit, that are being added,
  - moved, or changed (but not deleted), from the specified locations. -}
-stagedNotDeleted :: [FilePath] -> Repo -> IO ([FilePath], IO Bool)
+stagedNotDeleted :: [RawFilePath] -> Repo -> IO ([RawFilePath], IO Bool)
 stagedNotDeleted = staged' [Param "--diff-filter=ACMRT"]
 
-staged' :: [CommandParam] -> [FilePath] -> Repo -> IO ([FilePath], IO Bool)
-staged' ps l = pipeNullSplit $ prefix ++ ps ++ suffix
+staged' :: [CommandParam] -> [RawFilePath] -> Repo -> IO ([RawFilePath], IO Bool)
+staged' ps l repo = pipeNullSplit' (prefix ++ ps ++ suffix) repo
   where
 	prefix = [Param "diff", Param "--cached", Param "--name-only", Param "-z"]
-	suffix = Param "--" : map File l
+	suffix = Param "--" : map (File . fromRawFilePath) l
 
-type StagedDetails = (FilePath, Maybe Sha, Maybe FileMode)
+type StagedDetails = (RawFilePath, Maybe Sha, Maybe FileMode)
 
 {- Returns details about files that are staged in the index,
  - as well as files not yet in git. Skips ignored files. -}
-stagedOthersDetails :: [FilePath] -> Repo -> IO ([StagedDetails], IO Bool)
+stagedOthersDetails :: [RawFilePath] -> Repo -> IO ([StagedDetails], IO Bool)
 stagedOthersDetails = stagedDetails' [Param "--others", Param "--exclude-standard"]
 
 {- Returns details about all files that are staged in the index. -}
-stagedDetails :: [FilePath] -> Repo -> IO ([StagedDetails], IO Bool)
+stagedDetails :: [RawFilePath] -> Repo -> IO ([StagedDetails], IO Bool)
 stagedDetails = stagedDetails' []
 
 {- Gets details about staged files, including the Sha of their staged
  - contents. -}
-stagedDetails' :: [CommandParam] -> [FilePath] -> Repo -> IO ([StagedDetails], IO Bool)
+stagedDetails' :: [CommandParam] -> [RawFilePath] -> Repo -> IO ([StagedDetails], IO Bool)
 stagedDetails' ps l repo = do
 	(ls, cleanup) <- pipeNullSplit params repo
 	return (map parse ls, cleanup)
   where
 	params = Param "ls-files" : Param "--stage" : Param "-z" : ps ++ 
-		Param "--" : map File l
+		Param "--" : map (File . fromRawFilePath) l
 	parse s
-		| null file = (s, Nothing, Nothing)
-		| otherwise = (file, extractSha $ take shaSize rest, readmode mode)
+		| null file = (L.toStrict s, Nothing, Nothing)
+		| otherwise = (toRawFilePath file, extractSha $ take shaSize rest, readmode mode)
 	  where
-		(metadata, file) = separate (== '\t') s
+		(metadata, file) = separate (== '\t') (decodeBL' s)
 		(mode, rest) = separate (== ' ') metadata
 		readmode = fst <$$> headMaybe . readOct
 
 {- Returns a list of the files in the specified locations that are staged
  - for commit, and whose type has changed. -}
-typeChangedStaged :: [FilePath] -> Repo -> IO ([FilePath], IO Bool)
+typeChangedStaged :: [RawFilePath] -> Repo -> IO ([RawFilePath], IO Bool)
 typeChangedStaged = typeChanged' [Param "--cached"]
 
 {- Returns a list of the files in the specified locations whose type has
  - changed.  Files only staged for commit will not be included. -}
-typeChanged :: [FilePath] -> Repo -> IO ([FilePath], IO Bool)
+typeChanged :: [RawFilePath] -> Repo -> IO ([RawFilePath], IO Bool)
 typeChanged = typeChanged' []
 
-typeChanged' :: [CommandParam] -> [FilePath] -> Repo -> IO ([FilePath], IO Bool)
+typeChanged' :: [CommandParam] -> [RawFilePath] -> Repo -> IO ([RawFilePath], IO Bool)
 typeChanged' ps l repo = do
 	(fs, cleanup) <- pipeNullSplit (prefix ++ ps ++ suffix) repo
 	-- git diff returns filenames relative to the top of the git repo;
 	-- convert to filenames relative to the cwd, like git ls-files.
 	top <- absPath (repoPath repo)
 	currdir <- getCurrentDirectory
-	return (map (\f -> relPathDirToFileAbs currdir $ top </> f) fs, cleanup)
+	return (map (\f -> toRawFilePath (relPathDirToFileAbs currdir $ top </> decodeBL' f)) fs, cleanup)
   where
 	prefix = 
 		[ Param "diff"
@@ -196,7 +199,7 @@ typeChanged' ps l repo = do
 		, Param "--diff-filter=T"
 		, Param "-z"
 		]
-	suffix = Param "--" : (if null l then [File "."] else map File l)
+	suffix = Param "--" : (if null l then [File "."] else map (File . fromRawFilePath) l)
 
 {- A item in conflict has two possible values.
  - Either can be Nothing, when that side deleted the file. -}
@@ -206,7 +209,7 @@ data Conflicting v = Conflicting
 	} deriving (Show)
 
 data Unmerged = Unmerged
-	{ unmergedFile :: FilePath
+	{ unmergedFile :: RawFilePath
 	, unmergedTreeItemType :: Conflicting TreeItemType
 	, unmergedSha :: Conflicting Sha
 	}
@@ -221,21 +224,21 @@ data Unmerged = Unmerged
  -   3 = them
  - If a line is omitted, that side removed the file.
  -}
-unmerged :: [FilePath] -> Repo -> IO ([Unmerged], IO Bool)
+unmerged :: [RawFilePath] -> Repo -> IO ([Unmerged], IO Bool)
 unmerged l repo = do
 	(fs, cleanup) <- pipeNullSplit params repo
-	return (reduceUnmerged [] $ catMaybes $ map parseUnmerged fs, cleanup)
+	return (reduceUnmerged [] $ catMaybes $ map (parseUnmerged . decodeBL') fs, cleanup)
   where
 	params = 
 		Param "ls-files" :
 		Param "--unmerged" :
 		Param "-z" :
 		Param "--" :
-		map File l
+		map (File . fromRawFilePath) l
 
 data InternalUnmerged = InternalUnmerged
 	{ isus :: Bool
-	, ifile :: FilePath
+	, ifile :: RawFilePath
 	, itreeitemtype :: Maybe TreeItemType
 	, isha :: Maybe Sha
 	}
@@ -249,9 +252,9 @@ parseUnmerged s
 			if stage /= 2 && stage /= 3
 				then Nothing
 				else do
-					treeitemtype <- readTreeItemType rawtreeitemtype
+					treeitemtype <- readTreeItemType (encodeBS rawtreeitemtype)
 					sha <- extractSha rawsha
-					return $ InternalUnmerged (stage == 2) file
+					return $ InternalUnmerged (stage == 2) (toRawFilePath file)
 						(Just treeitemtype) (Just sha)
 		_ -> Nothing
   where
@@ -285,10 +288,10 @@ reduceUnmerged c (i:is) = reduceUnmerged (new:c) rest
  - Note that this uses a --debug option whose output could change at some
  - point in the future. If the output is not as expected, will use Nothing.
  -}
-inodeCaches :: [FilePath] -> Repo -> IO ([(FilePath, Maybe InodeCache)], IO Bool)
+inodeCaches :: [RawFilePath] -> Repo -> IO ([(FilePath, Maybe InodeCache)], IO Bool)
 inodeCaches locs repo = do
 	(ls, cleanup) <- pipeNullSplit params repo
-	return (parse Nothing ls, cleanup)
+	return (parse Nothing (map decodeBL ls), cleanup)
   where
 	params = 
 		Param "ls-files" :
@@ -296,7 +299,7 @@ inodeCaches locs repo = do
 		Param "-z" :
 		Param "--debug" :
 		Param "--" :
-		map File locs
+		map (File . fromRawFilePath) locs
 	
 	parse Nothing (f:ls) = parse (Just f) ls
 	parse (Just f) (s:[]) = 

Git/LsTree.hs

@@ -24,14 +24,19 @@ import Git.Command
 import Git.Sha
 import Git.FilePath
 import qualified Git.Filename
+import Utility.Attoparsec
 
 import Numeric
-import Data.Char
+import Data.Either
 import System.Posix.Types
+import qualified Data.ByteString as S
+import qualified Data.ByteString.Lazy as L
+import qualified Data.Attoparsec.ByteString.Lazy as A
+import qualified Data.Attoparsec.ByteString.Char8 as A8
 
 data TreeItem = TreeItem
 	{ mode :: FileMode
-	, typeobj :: String
+	, typeobj :: S.ByteString
 	, sha :: Ref
 	, file :: TopFilePath
 	} deriving Show
@@ -45,7 +50,7 @@ lsTree = lsTree' []
 lsTree' :: [CommandParam] -> LsTreeMode -> Ref -> Repo -> IO ([TreeItem], IO Bool)
 lsTree' ps lsmode t repo = do
 	(l, cleanup) <- pipeNullSplit (lsTreeParams lsmode t ps) repo
-	return (map parseLsTree l, cleanup)
+	return (rights (map parseLsTree l), cleanup)
 
 lsTreeParams :: LsTreeMode -> Ref -> [CommandParam] -> [CommandParam]
 lsTreeParams lsmode r ps =
@@ -63,7 +68,8 @@ lsTreeParams lsmode r ps =
 
 {- Lists specified files in a tree. -}
 lsTreeFiles :: Ref -> [FilePath] -> Repo -> IO [TreeItem]
-lsTreeFiles t fs repo = map parseLsTree <$> pipeNullSplitStrict ps repo
+lsTreeFiles t fs repo = rights . map (parseLsTree . L.fromStrict)
+	<$> pipeNullSplitStrict ps repo
   where
 	ps =
 		[ Param "ls-tree"
@@ -73,30 +79,34 @@ lsTreeFiles t fs repo = map parseLsTree <$> pipeNullSplitStrict ps repo
 		, File $ fromRef t
 		] ++ map File fs
 
+parseLsTree :: L.ByteString -> Either String TreeItem
+parseLsTree b = case A.parse parserLsTree b of
+	A.Done _ r  -> Right r
+	A.Fail _ _ err -> Left err
+
 {- Parses a line of ls-tree output, in format:
  - mode SP type SP sha TAB file
  -
  - (The --long format is not currently supported.) -}
-parseLsTree :: String -> TreeItem
-parseLsTree l = TreeItem 
-	{ mode = smode
-	, typeobj = t
-	, sha = Ref s
-	, file = sfile
-	}
-  where
-	(m, past_m) = splitAt 7 l -- mode is 6 bytes
-	(!t, past_t) = separate isSpace past_m
-	(!s, past_s) = splitAt shaSize past_t
-	!f = drop 1 past_s
-	!smode = fst $ Prelude.head $ readOct m
-	!sfile = asTopFilePath $ Git.Filename.decode f
+parserLsTree :: A.Parser TreeItem
+parserLsTree = TreeItem
+	-- mode
+	<$> octal
+	<* A8.char ' '
+	-- type
+	<*> A.takeTill (== 32)
+	<* A8.char ' '
+	-- sha
+	<*> (Ref . decodeBS' <$> A.take shaSize)
+	<* A8.char '\t'
+	-- file
+	<*> (asTopFilePath . decodeBS' . Git.Filename.decode <$> A.takeByteString)
 
 {- Inverse of parseLsTree -}
 formatLsTree :: TreeItem -> String
 formatLsTree ti = unwords
 	[ showOct (mode ti) ""
-	, typeobj ti
+	, decodeBS (typeobj ti)
 	, fromRef (sha ti)
 	, getTopFilePath (file ti)
 	]

Git/Ref.hs

@@ -5,6 +5,8 @@
  - Licensed under the GNU AGPL version 3 or higher.
  -}
 
+{-# LANGUAGE OverloadedStrings #-}
+
 module Git.Ref where
 
 import Common
@@ -13,7 +15,8 @@ import Git.Command
 import Git.Sha
 import Git.Types
 
-import Data.Char (chr)
+import Data.Char (chr, ord)
+import qualified Data.ByteString as S
 
 headRef :: Ref
 headRef = Ref "HEAD"
@@ -62,8 +65,8 @@ branchRef = underBase "refs/heads"
  - Prefixing the file with ./ makes this work even if in a subdirectory
  - of a repo.
  -}
-fileRef :: FilePath -> Ref
-fileRef f = Ref $ ":./" ++ f
+fileRef :: RawFilePath -> Ref
+fileRef f = Ref $ ":./" ++ fromRawFilePath f
 
 {- Converts a Ref to refer to the content of the Ref on a given date. -}
 dateRef :: Ref -> RefDate -> Ref
@@ -71,7 +74,7 @@ dateRef (Ref r) (RefDate d) = Ref $ r ++ "@" ++ d
 
 {- A Ref that can be used to refer to a file in the repository as it
  - appears in a given Ref. -}
-fileFromRef :: Ref -> FilePath -> Ref
+fileFromRef :: Ref -> RawFilePath -> Ref
 fileFromRef (Ref r) f = let (Ref fr) = fileRef f in Ref (r ++ fr)
 
 {- Checks if a ref exists. -}
@@ -88,8 +91,10 @@ file ref repo = localGitDir repo </> fromRef ref
  - that was just created. -}
 headExists :: Repo -> IO Bool
 headExists repo = do
-	ls <- lines <$> pipeReadStrict [Param "show-ref", Param "--head"] repo
-	return $ any (" HEAD" `isSuffixOf`) ls
+	ls <- S.split nl <$> pipeReadStrict [Param "show-ref", Param "--head"] repo
+	return $ any (" HEAD" `S.isSuffixOf`) ls
+  where
+	nl = fromIntegral (ord '\n')
 
 {- Get the sha of a fully qualified git ref, if it exists. -}
 sha :: Branch -> Repo -> IO (Maybe Sha)
@@ -100,8 +105,9 @@ sha branch repo = process <$> showref repo
 		, Param "--hash" -- get the hash
 		, Param $ fromRef branch
 		]
-	process [] = Nothing
-	process s = Just $ Ref $ firstLine s
+	process s
+		| S.null s = Nothing
+		| otherwise = Just $ Ref $ decodeBS' $ firstLine' s
 
 headSha :: Repo -> IO (Maybe Sha)
 headSha = sha headRef
@@ -116,7 +122,7 @@ matchingWithHEAD refs repo = matching' ("--head" : map fromRef refs) repo
 
 {- List of (shas, branches) matching a given ref spec. -}
 matching' :: [String] -> Repo -> IO [(Sha, Branch)]
-matching' ps repo = map gen . lines <$> 
+matching' ps repo = map gen . lines . decodeBS' <$> 
 	pipeReadStrict (Param "show-ref" : map Param ps) repo
   where
 	gen l = let (r, b) = separate (== ' ') l
@@ -148,7 +154,7 @@ delete oldvalue ref = run
  - The ref may be something like a branch name, and it could contain
  - ":subdir" if a subtree is wanted. -}
 tree :: Ref -> Repo -> IO (Maybe Sha)
-tree (Ref ref) = extractSha <$$> pipeReadStrict
+tree (Ref ref) = extractSha . decodeBS <$$> pipeReadStrict
 	[ Param "rev-parse", Param "--verify", Param "--quiet", Param ref' ]
   where
 	ref' = if ":" `isInfixOf` ref

Git/RefLog.hs

@@ -21,7 +21,7 @@ getMulti :: [Branch] -> Repo -> IO [Sha]
 getMulti bs = get' (map (Param . fromRef) bs)
 
 get' :: [CommandParam] -> Repo -> IO [Sha]
-get' ps = mapMaybe extractSha . lines <$$> pipeReadStrict ps'
+get' ps = mapMaybe extractSha . lines . decodeBS <$$> pipeReadStrict ps'
   where
 	ps' = catMaybes
 		[ Just $ Param "log"

Git/Remote.hs

@@ -6,6 +6,7 @@
  -}
 
 {-# LANGUAGE CPP #-}
+{-# LANGUAGE OverloadedStrings #-}
 
 module Git.Remote where
 
@@ -15,18 +16,21 @@ import Git.Types
 
 import Data.Char
 import qualified Data.Map as M
+import qualified Data.ByteString as S
+import qualified Data.ByteString.Char8 as S8
 import Network.URI
 #ifdef mingw32_HOST_OS
 import Git.FilePath
 #endif
 
 {- Is a git config key one that specifies the location of a remote? -}
-isRemoteKey :: String -> Bool
-isRemoteKey k = "remote." `isPrefixOf` k && ".url" `isSuffixOf` k
+isRemoteKey :: ConfigKey -> Bool
+isRemoteKey (ConfigKey k) = "remote." `S.isPrefixOf` k && ".url" `S.isSuffixOf` k
 
 {- Get a remote's name from the config key that specifies its location. -}
-remoteKeyToRemoteName :: String -> RemoteName
-remoteKeyToRemoteName k = intercalate "." $ dropFromEnd 1 $ drop 1 $ splitc '.' k
+remoteKeyToRemoteName :: ConfigKey -> RemoteName
+remoteKeyToRemoteName (ConfigKey k) = decodeBS' $
+	S.intercalate "." $ dropFromEnd 1 $ drop 1 $ S8.split '.' k
 
 {- Construct a legal git remote name out of an arbitrary input string.
  -
@@ -76,16 +80,16 @@ parseRemoteLocation s repo = ret $ calcloc s
 	-- insteadof config can rewrite remote location
 	calcloc l
 		| null insteadofs = l
-		| otherwise = replacement ++ drop (length bestvalue) l
+		| otherwise = replacement ++ drop (S.length bestvalue) l
 	  where
-		replacement = drop (length prefix) $
-			take (length bestkey - length suffix) bestkey
-		(bestkey, bestvalue) = maximumBy longestvalue insteadofs
+		replacement = decodeBS' $ S.drop (S.length prefix) $
+			S.take (S.length bestkey - S.length suffix) bestkey
+		(ConfigKey bestkey, ConfigValue bestvalue) = maximumBy longestvalue insteadofs
 		longestvalue (_, a) (_, b) = compare b a
-		insteadofs = filterconfig $ \(k, v) -> 
-			prefix `isPrefixOf` k &&
-			suffix `isSuffixOf` k &&
-			v `isPrefixOf` l
+		insteadofs = filterconfig $ \(ConfigKey k, ConfigValue v) -> 
+			prefix `S.isPrefixOf` k &&
+			suffix `S.isSuffixOf` k &&
+			v `S.isPrefixOf` encodeBS l
 		filterconfig f = filter f $
 			concatMap splitconfigs $ M.toList $ fullconfig repo
 		splitconfigs (k, vs) = map (\v -> (k, v)) vs

Git/Repair.hs

@@ -284,7 +284,7 @@ findUncorruptedCommit missing goodcommits branch r = do
 				, Param "--format=%H"
 				, Param (fromRef branch)
 				] r
-			let branchshas = catMaybes $ map extractSha ls
+			let branchshas = catMaybes $ map (extractSha . decodeBL) ls
 			reflogshas <- RefLog.get branch r
 			-- XXX Could try a bit harder here, and look
 			-- for uncorrupted old commits in branches in the
@@ -313,7 +313,7 @@ verifyCommit missing goodcommits commit r
 			, Param "--format=%H %T"
 			, Param (fromRef commit)
 			] r
-		let committrees = map parse ls
+		let committrees = map (parse . decodeBL) ls
 		if any isNothing committrees || null committrees
 			then do
 				void cleanup
@@ -342,7 +342,7 @@ verifyTree missing treesha r
 	| S.member treesha missing = return False
 	| otherwise = do
 		(ls, cleanup) <- pipeNullSplit (LsTree.lsTreeParams LsTree.LsTreeRecursive treesha []) r
-		let objshas = map (LsTree.sha . LsTree.parseLsTree) ls
+		let objshas = mapMaybe (LsTree.sha <$$> eitherToMaybe . LsTree.parseLsTree) ls
 		if any (`S.member` missing) objshas
 			then do
 				void cleanup
@@ -366,7 +366,7 @@ checkIndex r = do
  - itself is not corrupt. -}
 checkIndexFast :: Repo -> IO Bool
 checkIndexFast r = do
-	(indexcontents, cleanup) <- LsFiles.stagedDetails [repoPath r] r
+	(indexcontents, cleanup) <- LsFiles.stagedDetails [toRawFilePath (repoPath r)] r
 	length indexcontents `seq` cleanup
 
 missingIndex :: Repo -> IO Bool
@@ -375,7 +375,7 @@ missingIndex r = not <$> doesFileExist (localGitDir r </> "index")
 {- Finds missing and ok files staged in the index. -}
 partitionIndex :: Repo -> IO ([LsFiles.StagedDetails], [LsFiles.StagedDetails], IO Bool)
 partitionIndex r = do
-	(indexcontents, cleanup) <- LsFiles.stagedDetails [repoPath r] r
+	(indexcontents, cleanup) <- LsFiles.stagedDetails [toRawFilePath (repoPath r)] r
 	l <- forM indexcontents $ \i -> case i of
 		(_file, Just sha, Just _mode) -> (,) <$> isMissing sha r <*> pure i
 		_ -> pure (False, i)
@@ -394,12 +394,12 @@ rewriteIndex r
 			UpdateIndex.streamUpdateIndex r
 				=<< (catMaybes <$> mapM reinject good)
 		void cleanup
-		return $ map fst3 bad
+		return $ map (fromRawFilePath . fst3) bad
   where
 	reinject (file, Just sha, Just mode) = case toTreeItemType mode of
 		Nothing -> return Nothing
 		Just treeitemtype -> Just <$>
-			UpdateIndex.stageFile sha treeitemtype file r
+			UpdateIndex.stageFile sha treeitemtype (fromRawFilePath file) r
 	reinject _ = return Nothing
 
 newtype GoodCommits = GoodCommits (S.Set Sha)

Git/Status.hs

@@ -69,7 +69,7 @@ parseStatusZ = go []
 getStatus :: [CommandParam] -> [FilePath] -> Repo -> IO ([StagedUnstaged Status], IO Bool)
 getStatus ps fs r = do
 	(ls, cleanup) <- pipeNullSplit ps' r
-	return (parseStatusZ ls, cleanup)
+	return (parseStatusZ (map decodeBL ls), cleanup)
   where
 	ps' = concat
 		[ [Param "status"]

Git/Tree.hs

@@ -115,7 +115,7 @@ mkTreeOutput :: FileMode -> ObjectType -> Sha -> TopFilePath -> String
 mkTreeOutput fm ot s f = concat
 	[ showOct fm ""
 	, " "
-	, show ot
+	, decodeBS (fmtObjectType ot)
 	, " "
 	, fromRef s
 	, "\t"
@@ -134,7 +134,7 @@ treeItemToTreeContent (TreeItem f m s) = case toTreeItemType m of
 treeItemToLsTreeItem :: TreeItem -> LsTree.TreeItem
 treeItemToLsTreeItem (TreeItem f mode sha) = LsTree.TreeItem
 	{ LsTree.mode = mode
-	, LsTree.typeobj = show BlobObject
+	, LsTree.typeobj = fmtObjectType BlobObject
 	, LsTree.sha = sha
 	, LsTree.file = f
 	}
@@ -239,7 +239,7 @@ adjustTree adjusttreeitem addtreeitems resolveaddconflict removefiles r repo =
 			Just CommitObject -> do
 				let ti = TreeCommit (LsTree.file i) (LsTree.mode i) (LsTree.sha i)
 				go h wasmodified (ti:c) depth intree is
-			_ -> error ("unexpected object type \"" ++ LsTree.typeobj i ++ "\"")
+			_ -> error ("unexpected object type \"" ++ decodeBS (LsTree.typeobj i) ++ "\"")
 		| otherwise = return (c, wasmodified, i:is)
 
 	adjustlist h depth ishere underhere l = do
@@ -328,7 +328,7 @@ graftTree' subtree graftloc basetree repo hdl = go basetree graftdirs
 	
 	-- For a graftloc of "foo/bar/baz", this generates
 	-- ["foo", "foo/bar", "foo/bar/baz"]
-	graftdirs = map (asTopFilePath . toInternalGitPath) $
+	graftdirs = map (asTopFilePath . decodeBS . toInternalGitPath . encodeBS) $
 		mkpaths [] $ splitDirectories $ gitPath graftloc
 	mkpaths _ [] = []
 	mkpaths base (d:rest) = (joinPath base </> d) : mkpaths (base ++ [d]) rest
@@ -355,7 +355,7 @@ extractTree l = case go [] inTopTree l of
 			Just CommitObject ->
 				let c = TreeCommit (LsTree.file i) (LsTree.mode i) (LsTree.sha i)
 				in go (c:t) intree is
-			_ -> parseerr ("unexpected object type \"" ++ LsTree.typeobj i ++ "\"")
+			_ -> parseerr ("unexpected object type \"" ++ decodeBS (LsTree.typeobj i) ++ "\"")
 		| otherwise = Right (t, i:is)
 	parseerr = Left
 

Git/Types.hs

@@ -1,16 +1,23 @@
 {- git data types
  -
- - Copyright 2010-2018 Joey Hess <id@joeyh.name>
+ - Copyright 2010-2019 Joey Hess <id@joeyh.name>
  -
  - Licensed under the GNU AGPL version 3 or higher.
  -}
 
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+
 module Git.Types where
 
 import Network.URI
+import Data.String
+import Data.Default
 import qualified Data.Map as M
+import qualified Data.ByteString as S
 import System.Posix.Types
 import Utility.SafeCommand
+import Utility.FileSystemEncoding
 
 {- Support repositories on local disk, and repositories accessed via an URL.
  -
@@ -31,9 +38,9 @@ data RepoLocation
 
 data Repo = Repo
 	{ location :: RepoLocation
-	, config :: M.Map String String
+	, config :: M.Map ConfigKey ConfigValue
 	-- a given git config key can actually have multiple values
-	, fullconfig :: M.Map String [String]
+	, fullconfig :: M.Map ConfigKey [ConfigValue]
 	-- remoteName holds the name used for this repo in some other
 	-- repo's list of remotes, when this repo is such a remote
 	, remoteName :: Maybe RemoteName
@@ -44,6 +51,33 @@ data Repo = Repo
 	, gitGlobalOpts :: [CommandParam]
 	} deriving (Show, Eq, Ord)
 
+newtype ConfigKey = ConfigKey S.ByteString
+	deriving (Ord, Eq)
+
+newtype ConfigValue = ConfigValue S.ByteString
+	deriving (Ord, Eq, Semigroup, Monoid)
+
+instance Default ConfigValue where
+	def = ConfigValue mempty
+
+fromConfigKey :: ConfigKey -> String
+fromConfigKey (ConfigKey s) = decodeBS' s
+
+instance Show ConfigKey where
+	show = fromConfigKey
+
+fromConfigValue :: ConfigValue -> String
+fromConfigValue (ConfigValue s) = decodeBS' s
+
+instance Show ConfigValue where
+	show = fromConfigValue
+
+instance IsString ConfigKey where
+	fromString = ConfigKey . encodeBS'
+
+instance IsString ConfigValue where
+	fromString = ConfigValue . encodeBS'
+
 type RemoteName = String
 
 {- A git ref. Can be a sha1, or a branch or tag name. -}
@@ -64,32 +98,31 @@ newtype RefDate = RefDate String
 
 {- Types of objects that can be stored in git. -}
 data ObjectType = BlobObject | CommitObject | TreeObject
-	deriving (Eq)
 
-instance Show ObjectType where
-	show BlobObject = "blob"
-	show CommitObject = "commit"
-	show TreeObject = "tree"
-
-readObjectType :: String -> Maybe ObjectType
+readObjectType :: S.ByteString -> Maybe ObjectType
 readObjectType "blob" = Just BlobObject
 readObjectType "commit" = Just CommitObject
 readObjectType "tree" = Just TreeObject
 readObjectType _ = Nothing
 
+fmtObjectType :: ObjectType -> S.ByteString
+fmtObjectType BlobObject = "blob"
+fmtObjectType CommitObject = "commit"
+fmtObjectType TreeObject = "tree"
+
 {- Types of items in a tree. -}
 data TreeItemType = TreeFile | TreeExecutable | TreeSymlink | TreeSubmodule
-	deriving (Eq)
+	deriving (Eq, Show)
 
 {- Git uses magic numbers to denote the type of a tree item. -}
-readTreeItemType :: String -> Maybe TreeItemType
+readTreeItemType :: S.ByteString -> Maybe TreeItemType
 readTreeItemType "100644" = Just TreeFile
 readTreeItemType "100755" = Just TreeExecutable
 readTreeItemType "120000" = Just TreeSymlink
 readTreeItemType "160000" = Just TreeSubmodule
 readTreeItemType _ = Nothing
 
-fmtTreeItemType :: TreeItemType -> String
+fmtTreeItemType :: TreeItemType -> S.ByteString
 fmtTreeItemType TreeFile = "100644"
 fmtTreeItemType TreeExecutable = "100755"
 fmtTreeItemType TreeSymlink = "120000"

Git/UnionMerge.hs

@@ -10,6 +10,7 @@ module Git.UnionMerge (
 	mergeIndex
 ) where
 
+import qualified Data.ByteString.Lazy as L
 import qualified Data.ByteString.Lazy.Char8 as L8
 import qualified Data.Set as S
 
@@ -69,7 +70,7 @@ diffOpts = ["--raw", "-z", "-r", "--no-renames", "-l0"]
 doMerge :: HashObjectHandle -> CatFileHandle -> [String] -> Repo -> Streamer
 doMerge hashhandle ch differ repo streamer = do
 	(diff, cleanup) <- pipeNullSplit (map Param differ) repo
-	go diff
+	go (map decodeBL' diff)
 	void $ cleanup
   where
 	go [] = noop
@@ -80,7 +81,7 @@ doMerge hashhandle ch differ repo streamer = do
 {- Given an info line from a git raw diff, and the filename, generates
  - a line suitable for update-index that union merges the two sides of the
  - diff. -}
-mergeFile :: String -> FilePath -> HashObjectHandle -> CatFileHandle -> IO (Maybe String)
+mergeFile :: String -> FilePath -> HashObjectHandle -> CatFileHandle -> IO (Maybe L.ByteString)
 mergeFile info file hashhandle h = case filter (/= nullSha) [Ref asha, Ref bsha] of
 	[] -> return Nothing
 	(sha:[]) -> use sha

Git/UpdateIndex.hs

@@ -1,11 +1,11 @@
 {- git-update-index library
  -
- - Copyright 2011-2018 Joey Hess <id@joeyh.name>
+ - Copyright 2011-2019 Joey Hess <id@joeyh.name>
  -
  - Licensed under the GNU AGPL version 3 or higher.
  -}
 
-{-# LANGUAGE BangPatterns, CPP #-}
+{-# LANGUAGE BangPatterns, OverloadedStrings, CPP #-}
 
 module Git.UpdateIndex (
 	Streamer,
@@ -32,12 +32,14 @@ import Git.FilePath
 import Git.Sha
 import qualified Git.DiffTreeItem as Diff
 
+import qualified Data.ByteString.Lazy as L
+
 {- Streamers are passed a callback and should feed it lines in the form
  - read by update-index, and generated by ls-tree. -}
-type Streamer = (String -> IO ()) -> IO ()
+type Streamer = (L.ByteString -> IO ()) -> IO ()
 
 {- A streamer with a precalculated value. -}
-pureStreamer :: String -> Streamer
+pureStreamer :: L.ByteString -> Streamer
 pureStreamer !s = \streamer -> streamer s
 
 {- Streams content into update-index from a list of Streamers. -}
@@ -49,8 +51,8 @@ data UpdateIndexHandle = UpdateIndexHandle ProcessHandle Handle
 
 streamUpdateIndex' :: UpdateIndexHandle -> Streamer -> IO ()
 streamUpdateIndex' (UpdateIndexHandle _ h) a = a $ \s -> do
-	hPutStr h s
-	hPutStr h "\0"
+	L.hPutStr h s
+	L.hPutStr h "\0"
 
 startUpdateIndex :: Repo -> IO UpdateIndexHandle
 startUpdateIndex repo = do
@@ -84,14 +86,13 @@ lsSubTree (Ref x) p repo streamer = do
 
 {- Generates a line suitable to be fed into update-index, to add
  - a given file with a given sha. -}
-updateIndexLine :: Sha -> TreeItemType -> TopFilePath -> String
-updateIndexLine sha treeitemtype file = concat
-	[ fmtTreeItemType treeitemtype
-	, " blob "
-	, fromRef sha
-	, "\t"
-	, indexPath file
-	]
+updateIndexLine :: Sha -> TreeItemType -> TopFilePath -> L.ByteString
+updateIndexLine sha treeitemtype file = L.fromStrict $
+	fmtTreeItemType treeitemtype
+	<> " blob "
+	<> encodeBS (fromRef sha)
+	<> "\t"
+	<> indexPath file
 
 stageFile :: Sha -> TreeItemType -> FilePath -> Repo -> IO Streamer
 stageFile sha treeitemtype file repo = do
@@ -105,7 +106,11 @@ unstageFile file repo = do
 	return $ unstageFile' p
 
 unstageFile' :: TopFilePath -> Streamer
-unstageFile' p = pureStreamer $ "0 " ++ fromRef nullSha ++ "\t" ++ indexPath p
+unstageFile' p = pureStreamer $ L.fromStrict $
+	"0 "
+	<> encodeBS' (fromRef nullSha)
+	<> "\t"
+	<> indexPath p
 
 {- A streamer that adds a symlink to the index. -}
 stageSymlink :: FilePath -> Sha -> Repo -> IO Streamer
@@ -123,7 +128,7 @@ stageDiffTreeItem d = case toTreeItemType (Diff.dstmode d) of
 	Just t -> pureStreamer $ updateIndexLine (Diff.dstsha d) t (Diff.file d)
 
 indexPath :: TopFilePath -> InternalGitPath
-indexPath = toInternalGitPath . getTopFilePath
+indexPath = toInternalGitPath . toRawFilePath . getTopFilePath
 
 {- Refreshes the index, by checking file stat information.  -}
 refreshIndex :: Repo -> ((FilePath -> IO ()) -> IO ()) -> IO Bool