more RawFilePath conversion

This commit was sponsored by Luke Shumaker on Patreon.

Command/FuzzTest.hs

@@ -174,7 +174,7 @@ instance Arbitrary FuzzAction where
 
 runFuzzAction :: FuzzAction -> Annex ()
 runFuzzAction (FuzzAdd (FuzzFile f)) = do
-	createWorkTreeDirectory (parentDir f)
+	createWorkTreeDirectory (parentDir (toRawFilePath f))
 	n <- liftIO (getStdRandom random :: IO Int)
 	liftIO $ writeFile f $ show n ++ "\n"
 runFuzzAction (FuzzDelete (FuzzFile f)) = liftIO $
@@ -209,7 +209,7 @@ genFuzzAction = do
 			case md of
 				Nothing -> genFuzzAction
 				Just d -> do
-					newd <- liftIO $ newDir (parentDir $ toFilePath d)
+					newd <- liftIO $ newDir (parentDir $ toRawFilePath $ toFilePath d)
 					maybe genFuzzAction (return . FuzzMoveDir d) newd
 		FuzzDeleteDir _ -> do
 			d <- liftIO existingDir
@@ -261,13 +261,13 @@ newFile = go (100 :: Int)
 			, go (n - 1)
 			)
 
-newDir :: FilePath -> IO (Maybe FuzzDir)
+newDir :: RawFilePath -> IO (Maybe FuzzDir)
 newDir parent = go (100 :: Int)
   where
 	go 0 = return Nothing
 	go n = do
 		(FuzzDir d) <- genFuzzDir
-		ifM (doesnotexist (parent </> d))
+		ifM (doesnotexist (fromRawFilePath parent </> d))
 			( return $ Just $ FuzzDir d
 			, go (n - 1)
 			)

Command/Info.hs

@@ -12,6 +12,7 @@ module Command.Info where
 import "mtl" Control.Monad.State.Strict
 import qualified Data.Map.Strict as M
 import qualified Data.Vector as V
+import qualified System.FilePath.ByteString as P
 import Data.Ord
 import qualified Data.Semigroup as Sem
 import Prelude
@@ -152,9 +153,9 @@ itemInfo o (si, p) = ifM (isdir p)
 				case v' of
 					Right u -> uuidInfo o u si
 					Left _ -> do
-						relp <- liftIO $ relPathCwdToFile p
+						relp <- liftIO $ relPathCwdToFile (toRawFilePath p)
-						ifAnnexed (toRawFilePath relp)
+						ifAnnexed relp
-							(fileInfo o relp si)
+							(fileInfo o (fromRawFilePath relp) si)
 							(treeishInfo o p si)
 	)
   where
@@ -435,7 +436,7 @@ transfer_list = stat desc $ nojson $ lift $ do
   where
 	desc = "transfers in progress"
 	line uuidmap t i = unwords
-		[ formatDirection (transferDirection t) ++ "ing"
+		[ fromRawFilePath (formatDirection (transferDirection t)) ++ "ing"
 		, fromRawFilePath $ actionItemDesc $ mkActionItem
 			(transferKey t, associatedFile i)
 		, if transferDirection t == Upload then "to" else "from"
@@ -579,7 +580,7 @@ getDirStatInfo o dir = do
 					then return (numcopiesstats, repodata)
 					else do
 						locs <- Remote.keyLocations key
-						nc <- updateNumCopiesStats (fromRawFilePath file) numcopiesstats locs
+						nc <- updateNumCopiesStats file numcopiesstats locs
 						return (nc, updateRepoData key locs repodata)
 				return $! (presentdata', referenceddata', numcopiesstats', repodata')
 			, return vs
@@ -643,7 +644,7 @@ updateRepoData key locs m = m'
 		M.fromList $ zip locs (map update locs)
 	update loc = addKey key (fromMaybe emptyKeyInfo $ M.lookup loc m)
 
-updateNumCopiesStats :: FilePath -> NumCopiesStats -> [UUID] -> Annex NumCopiesStats
+updateNumCopiesStats :: RawFilePath -> NumCopiesStats -> [UUID] -> Annex NumCopiesStats
 updateNumCopiesStats file (NumCopiesStats m) locs = do
 	have <- trustExclude UnTrusted locs
 	!variance <- Variance <$> numCopiesCheck' file (-) have
@@ -663,7 +664,7 @@ showSizeKeys d = do
 			"+ " ++ show (unknownSizeKeys d) ++
 			" unknown size"
 
-staleSize :: String -> (Git.Repo -> FilePath) -> Stat
+staleSize :: String -> (Git.Repo -> RawFilePath) -> Stat
 staleSize label dirspec = go =<< lift (dirKeys dirspec)
   where
 	go [] = nostat
@@ -676,7 +677,7 @@ staleSize label dirspec = go =<< lift (dirKeys dirspec)
 	keysizes keys = do
 		dir <- lift $ fromRepo dirspec
 		liftIO $ forM keys $ \k -> catchDefaultIO 0 $
-			getFileSize (dir </> fromRawFilePath (keyFile k))
+			getFileSize (fromRawFilePath (dir P.</> keyFile k))
 
 aside :: String -> String
 aside s = " (" ++ s ++ ")"

Command/Inprogress.hs

@@ -55,7 +55,7 @@ start s _si _file k
 
 start' :: Key -> CommandStart
 start' k = startingCustomOutput k $ do
-	tmpf <- fromRepo $ gitAnnexTmpObjectLocation k
+	tmpf <- fromRawFilePath <$> fromRepo (gitAnnexTmpObjectLocation k)
 	whenM (liftIO $ doesFileExist tmpf) $
 		liftIO $ putStrLn tmpf
 	next $ return True

Command/Lock.hs

@@ -67,7 +67,7 @@ perform file key = do
 	lockdown obj = do
 		ifM (isUnmodified key obj)
 			( breakhardlink obj
-			, repopulate (fromRawFilePath obj)
+			, repopulate obj
 			)
 		whenM (liftIO $ R.doesPathExist obj) $
 			freezeContent $ fromRawFilePath obj
@@ -78,7 +78,7 @@ perform file key = do
 		mfc <- withTSDelta (liftIO . genInodeCache file)
 		unlessM (sameInodeCache obj (maybeToList mfc)) $ do
 			let obj' = fromRawFilePath obj
-			modifyContent obj' $ replaceGitAnnexDirFile obj' $ \tmp -> do
+			modifyContent obj $ replaceGitAnnexDirFile obj' $ \tmp -> do
 				unlessM (checkedCopyFile key obj' tmp Nothing) $
 					giveup "unable to lock file"
 			Database.Keys.storeInodeCaches key [obj]
@@ -89,10 +89,10 @@ perform file key = do
 		fs <- map (`fromTopFilePath` g)
 			<$> Database.Keys.getAssociatedFiles key
 		mfile <- firstM (isUnmodified key) fs
-		liftIO $ removeWhenExistsWith removeLink obj
+		liftIO $ removeWhenExistsWith R.removeLink obj
 		case mfile of
 			Just unmodified ->
-				unlessM (checkedCopyFile key (fromRawFilePath unmodified) obj Nothing)
+				unlessM (checkedCopyFile key (fromRawFilePath unmodified) (fromRawFilePath obj) Nothing)
 					lostcontent
 			Nothing -> lostcontent
 

Command/Log.hs

@@ -12,6 +12,7 @@ import qualified Data.Map as M
 import Data.Char
 import Data.Time.Clock.POSIX
 import Data.Time
+import qualified System.FilePath.ByteString as P
 
 import Command
 import Logs
@@ -207,10 +208,10 @@ compareChanges format changes = concatMap diff changes
 getKeyLog :: Key -> [CommandParam] -> Annex ([RefChange], IO Bool)
 getKeyLog key os = do
 	top <- fromRepo Git.repoPath
-	p <- liftIO $ relPathCwdToFile $ fromRawFilePath top
+	p <- liftIO $ relPathCwdToFile top
 	config <- Annex.getGitConfig
-	let logfile = p </> fromRawFilePath (locationLogFile config key)
+	let logfile = p P.</> locationLogFile config key
-	getGitLog [logfile] (Param "--remove-empty" : os)
+	getGitLog [fromRawFilePath logfile] (Param "--remove-empty" : os)
 
 {- Streams the git log for all git-annex branch changes. -}
 getAllLog :: [CommandParam] -> Annex ([RefChange], IO Bool)

Command/Map.hs

@@ -178,8 +178,7 @@ absRepo reference r
 	| Git.repoIsUrl reference = return $ Git.Construct.localToUrl reference r
 	| Git.repoIsUrl r = return r
 	| otherwise = liftIO $ do
-		r' <- Git.Construct.fromAbsPath
+		r' <- Git.Construct.fromAbsPath =<< absPath (Git.repoPath r)
-			=<< absPath (fromRawFilePath (Git.repoPath r))
 		r'' <- safely $ flip Annex.eval Annex.gitRepo =<< Annex.new r'
 		return (fromMaybe r' r'')
 

Command/MetaData.hs

@@ -165,8 +165,8 @@ parseJSONInput i = case eitherDecode (BU.fromString i) of
 			(Just k, _) -> return $
 				Right (Right k, m)
 			(Nothing, Just f) -> do
-				f' <- liftIO $ relPathCwdToFile f
+				f' <- liftIO $ relPathCwdToFile (toRawFilePath f)
-				return $ Right (Left (toRawFilePath f'), m)
+				return $ Right (Left f', m)
 			(Nothing, Nothing) -> return $ 
 				Left "JSON input is missing either file or key"
 

Command/Multicast.hs

@@ -83,7 +83,7 @@ genAddress = starting "gen-address" (ActionItemOther Nothing) (SeekInput []) $ d
 	(s, ok) <- case k of
 		KeyContainer s -> liftIO $ genkey (Param s)
 		KeyFile f -> do
-			createAnnexDirectory (takeDirectory f)
+			createAnnexDirectory (toRawFilePath (takeDirectory f))
 			liftIO $ removeWhenExistsWith removeLink f
 			liftIO $ protectedOutput $ genkey (File f)
 	case (ok, parseFingerprint s) of
@@ -176,8 +176,8 @@ receive ups = starting "receiving multicast files" ai si $ do
 	(callback, environ, statush) <- liftIO multicastCallbackEnv
 	tmpobjdir <- fromRepo gitAnnexTmpObjectDir
 	createAnnexDirectory tmpobjdir
-	withTmpDirIn tmpobjdir "multicast" $ \tmpdir -> withAuthList $ \authlist -> do
+	withTmpDirIn (fromRawFilePath tmpobjdir) "multicast" $ \tmpdir -> withAuthList $ \authlist -> do
-		abstmpdir <- liftIO $ absPath tmpdir
+		abstmpdir <- liftIO $ absPath (toRawFilePath tmpdir)
 		abscallback <- liftIO $ searchPath callback
 		let ps =
 			-- Avoid it running as a daemon.
@@ -190,7 +190,7 @@ receive ups = starting "receiving multicast files" ai si $ do
 			, Param "-S", Param authlist
 			-- Receive files into tmpdir
 			-- (it needs an absolute path)
-			, Param "-D", File abstmpdir
+			, Param "-D", File (fromRawFilePath abstmpdir)
 			-- Run callback after each file received
 			-- (it needs an absolute path)
 			, Param "-s", Param (fromMaybe callback abscallback)
@@ -214,7 +214,7 @@ storeReceived f = do
 		Just k -> void $
 			getViaTmpFromDisk RetrievalVerifiableKeysSecure AlwaysVerify k $ \dest -> unVerified $
 				liftIO $ catchBoolIO $ do
-					rename f dest
+					rename f (fromRawFilePath dest)
 					return True
 
 -- Under Windows, uftp uses key containers, which are not files on the

Command/ReKey.hs

@@ -47,8 +47,8 @@ batchParser s = case separate (== ' ') (reverse s) of
 			Nothing -> return $ Left "bad key"
 			Just k -> do
 				let f = reverse rf
-				f' <- liftIO $ relPathCwdToFile f
+				f' <- liftIO $ relPathCwdToFile (toRawFilePath f)
-				return $ Right (toRawFilePath f', k)
+				return $ Right (f', k)
 
 seek :: ReKeyOptions -> CommandSeek
 seek o = case batchOption o of
@@ -91,7 +91,7 @@ linkKey file oldkey newkey = ifM (isJust <$> isAnnexLink file)
 	 - unlocked file, which would leave the new key unlocked
 	 - and vulnerable to corruption. -}
 	( getViaTmpFromDisk RetrievalAllKeysSecure DefaultVerify newkey $ \tmp -> unVerified $ do
-		oldobj <- fromRawFilePath <$> calcRepo (gitAnnexLocation oldkey)
+		oldobj <- calcRepo (gitAnnexLocation oldkey)
 		isJust <$> linkOrCopy' (return True) newkey oldobj tmp Nothing
 	, do
 	 	{- The file being rekeyed is itself an unlocked file; if
@@ -111,7 +111,7 @@ linkKey file oldkey newkey = ifM (isJust <$> isAnnexLink file)
 				warning (show e)
 				return False
 			Right () -> do
-				r <- linkToAnnex newkey (fromRawFilePath file) ic
+				r <- linkToAnnex newkey file ic
 				return $ case r of
 					LinkAnnexFailed -> False
 					LinkAnnexOk -> True

Command/RecvKey.hs

@@ -45,4 +45,4 @@ start (_, key) = fieldTransfer Download key $ \_p -> do
 	go tmp = unVerified $ do
 		opts <- filterRsyncSafeOptions . maybe [] words
 			<$> getField "RsyncOptions"
-		liftIO $ rsyncServerReceive (map Param opts) tmp
+		liftIO $ rsyncServerReceive (map Param opts) (fromRawFilePath tmp)

Command/Reinject.hs

@@ -43,11 +43,13 @@ seek os
 startSrcDest :: [FilePath] -> CommandStart
 startSrcDest ps@(src:dest:[])
 	| src == dest = stop
-	| otherwise = notAnnexed src $ ifAnnexed (toRawFilePath dest) go stop
+	| otherwise = notAnnexed src' $
+		ifAnnexed (toRawFilePath dest) go stop
   where
+	src' = toRawFilePath src
 	go key = starting "reinject" ai si $
 		ifM (verifyKeyContent RetrievalAllKeysSecure DefaultVerify UnVerified key src)
-			( perform src key
+			( perform src' key
 			, giveup $ src ++ " does not have expected content of " ++ dest
 			)
 	ai = ActionItemOther (Just src)
@@ -55,31 +57,31 @@ startSrcDest ps@(src:dest:[])
 startSrcDest _ = giveup "specify a src file and a dest file"
 
 startKnown :: FilePath -> CommandStart
-startKnown src = notAnnexed src $
+startKnown src = notAnnexed src' $
 	starting "reinject" ai si $ do
 		(key, _) <- genKey ks nullMeterUpdate Nothing
 		ifM (isKnownKey key)
-			( perform src key
+			( perform src' key
 			, do
 				warning "Not known content; skipping"
 				next $ return True
 			)
   where
-	ks = KeySource src' src' Nothing
 	src' = toRawFilePath src
+	ks = KeySource src' src' Nothing
 	ai = ActionItemOther (Just src)
 	si = SeekInput [src]
 
-notAnnexed :: FilePath -> CommandStart -> CommandStart
+notAnnexed :: RawFilePath -> CommandStart -> CommandStart
 notAnnexed src a = 
 	ifM (fromRepo Git.repoIsLocalBare)
 		( a
-		, ifAnnexed (toRawFilePath src)
+		, ifAnnexed src
-			(giveup $ "cannot used annexed file as src: " ++ src)
+			(giveup $ "cannot used annexed file as src: " ++ fromRawFilePath src)
 			a
 		)
 
-perform :: FilePath -> Key -> CommandPerform
+perform :: RawFilePath -> Key -> CommandPerform
 perform src key = ifM move
 	( next $ cleanup key
 	, error "failed"

Command/RmUrl.hs

@@ -41,7 +41,8 @@ batchParser s = case separate (== ' ') (reverse s) of
 		| null ru || null rf -> return $ Left "Expected: \"file url\""
 		| otherwise -> do
 			let f = reverse rf
-			f' <- liftIO $ relPathCwdToFile f
+			f' <- liftIO $ fromRawFilePath
+				<$> relPathCwdToFile (toRawFilePath f)
 			return $ Right (f', reverse ru)
 
 start :: (SeekInput, (FilePath, URLString)) -> CommandStart

Command/SetKey.hs

@@ -21,7 +21,7 @@ seek = withWords (commandAction . start)
 
 start :: [String] -> CommandStart
 start ps@(keyname:file:[]) = starting "setkey" ai si $
-	perform file (keyOpt keyname)
+	perform (toRawFilePath file) (keyOpt keyname)
   where
 	ai = ActionItemOther (Just file)
 	si = SeekInput ps
@@ -30,7 +30,7 @@ start _ = giveup "specify a key and a content file"
 keyOpt :: String -> Key
 keyOpt = fromMaybe (giveup "bad key") . deserializeKey
 
-perform :: FilePath -> Key -> CommandPerform
+perform :: RawFilePath -> Key -> CommandPerform
 perform file key = do
 	-- the file might be on a different filesystem, so moveFile is used
 	-- rather than simply calling moveAnnex; disk space is also
@@ -38,7 +38,7 @@ perform file key = do
 	ok <- getViaTmp RetrievalAllKeysSecure DefaultVerify key $ \dest -> unVerified $
 		if dest /= file
 			then liftIO $ catchBoolIO $ do
-				moveFile file dest
+				moveFile (fromRawFilePath file) (fromRawFilePath dest)
 				return True
 		else return True
 	if ok

Command/Smudge.hs

@@ -54,7 +54,7 @@ optParser desc = smudgeoptions <|> updateoption
 
 seek :: SmudgeOptions -> CommandSeek
 seek (SmudgeOptions f False) = commandAction (smudge f)
-seek (SmudgeOptions f True) = commandAction (clean f)
+seek (SmudgeOptions f True) = commandAction (clean (toRawFilePath f))
 seek UpdateOption = commandAction update
 
 -- Smudge filter is fed git file content, and if it's a pointer to an
@@ -83,7 +83,7 @@ smudge file = do
 -- Clean filter is fed file content on stdin, decides if a file
 -- should be stored in the annex, and outputs a pointer to its
 -- injested content if so. Otherwise, the original content.
-clean :: FilePath -> CommandStart
+clean :: RawFilePath -> CommandStart
 clean file = do
 	b <- liftIO $ L.hGetContents stdin
 	ifM fileoutsiderepo
@@ -98,10 +98,10 @@ clean file = do
   where
 	go b = case parseLinkTargetOrPointerLazy b of
 		Just k -> do
-			getMoveRaceRecovery k (toRawFilePath file)
+			getMoveRaceRecovery k file
 			liftIO $ L.hPut stdout b
 		Nothing -> do
-			let fileref = Git.Ref.fileRef (toRawFilePath file)
+			let fileref = Git.Ref.fileRef file
 			indexmeta <- catObjectMetaData fileref
 			go' b indexmeta =<< catKey' fileref indexmeta
 	go' b indexmeta oldkey = ifM (shouldAnnex file indexmeta oldkey)
@@ -120,7 +120,7 @@ clean file = do
 			-- annexed and is unmodified.
 			case oldkey of
 				Nothing -> doingest oldkey
-				Just ko -> ifM (isUnmodifiedCheap ko (toRawFilePath file))
+				Just ko -> ifM (isUnmodifiedCheap ko file)
 					( liftIO $ emitPointer ko
 					, doingest oldkey
 					)
@@ -141,7 +141,7 @@ clean file = do
 		liftIO . emitPointer
 			=<< postingest
 			=<< (\ld -> ingest' oldbackend nullMeterUpdate ld Nothing norestage)
-			=<< lockDown cfg file
+			=<< lockDown cfg (fromRawFilePath file)
 
 	postingest (Just k, _) = do
 		logStatus k InfoPresent
@@ -156,8 +156,7 @@ clean file = do
 	-- git diff can run the clean filter on files outside the
 	-- repository; can't annex those
 	fileoutsiderepo = do
-	        repopath <- liftIO . absPath . fromRawFilePath
+	        repopath <- liftIO . absPath =<< fromRepo Git.repoPath
-			=<< fromRepo Git.repoPath
 		filepath <- liftIO $ absPath file
 		return $ not $ dirContains repopath filepath
 
@@ -175,7 +174,7 @@ clean file = do
 -- annexed content before, annex it. This handles cases such as renaming an
 -- unlocked annexed file followed by git add, which the user naturally
 -- expects to behave the same as git mv.
-shouldAnnex :: FilePath -> Maybe (Sha, FileSize, ObjectType) -> Maybe Key -> Annex Bool
+shouldAnnex :: RawFilePath -> Maybe (Sha, FileSize, ObjectType) -> Maybe Key -> Annex Bool
 shouldAnnex file indexmeta moldkey = ifM (annexGitAddToAnnex <$> Annex.getGitConfig)
 	( checkunchangedgitfile $ checkmatcher checkheuristics
 	, checkunchangedgitfile checkheuristics
@@ -196,7 +195,7 @@ shouldAnnex file indexmeta moldkey = ifM (annexGitAddToAnnex <$> Annex.getGitCon
 		Just _ -> return True
 		Nothing -> checkknowninode
 
-	checkknowninode = withTSDelta (liftIO . genInodeCache (toRawFilePath file)) >>= \case
+	checkknowninode = withTSDelta (liftIO . genInodeCache file) >>= \case
 		Nothing -> pure False
 		Just ic -> Database.Keys.isInodeKnown ic =<< sentinalStatus
 
@@ -208,7 +207,7 @@ shouldAnnex file indexmeta moldkey = ifM (annexGitAddToAnnex <$> Annex.getGitCon
 	-- annex.largefiles now matches it, because the content is not
 	-- changed.
 	checkunchangedgitfile cont = case (moldkey, indexmeta) of
-		(Nothing, Just (sha, sz, _)) -> liftIO (catchMaybeIO (getFileSize file)) >>= \case
+		(Nothing, Just (sha, sz, _)) -> liftIO (catchMaybeIO (getFileSize (fromRawFilePath file))) >>= \case
 			Just sz' | sz' == sz -> do
 				-- The size is the same, so the file
 				-- is not much larger than what was stored

Command/Status.hs

@@ -61,6 +61,6 @@ displayStatus (Renamed _ _) = noop
 displayStatus s = do
 	let c = statusChar s
 	absf <- fromRepo $ fromTopFilePath (statusFile s)
-	f <- liftIO $ relPathCwdToFile $ fromRawFilePath absf
+	f <- liftIO $ fromRawFilePath <$> relPathCwdToFile absf
 	unlessM (showFullJSON $ JSONChunk [("status", [c]), ("file", f)]) $
 		liftIO $ putStrLn $ [c] ++ " " ++ f

Command/TestRemote.hs

@@ -251,7 +251,7 @@ test runannex mkr mkk =
 	, check "fsck downloaded object" fsck
 	, check "retrieveKeyFile resume from 33%" $ \r k -> do
 		loc <- fromRawFilePath <$> Annex.calcRepo (gitAnnexLocation k)
-		tmp <- prepTmp k
+		tmp <- fromRawFilePath <$> prepTmp k
 		partial <- liftIO $ bracket (openBinaryFile loc ReadMode) hClose $ \h -> do
 			sz <- hFileSize h
 			L.hGet h $ fromInteger $ sz `div` 3
@@ -260,14 +260,14 @@ test runannex mkr mkk =
 		get r k
 	, check "fsck downloaded object" fsck
 	, check "retrieveKeyFile resume from 0" $ \r k -> do
-		tmp <- prepTmp k
+		tmp <- fromRawFilePath <$> prepTmp k
 		liftIO $ writeFile tmp ""
 		lockContentForRemoval k noop removeAnnex
 		get r k
 	, check "fsck downloaded object" fsck
 	, check "retrieveKeyFile resume from end" $ \r k -> do
 		loc <- fromRawFilePath <$> Annex.calcRepo (gitAnnexLocation k)
-		tmp <- prepTmp k
+		tmp <- fromRawFilePath <$> prepTmp k
 		void $ liftIO $ copyFileExternal CopyAllMetaData loc tmp
 		lockContentForRemoval k noop removeAnnex
 		get r k
@@ -295,7 +295,7 @@ test runannex mkr mkk =
 			Nothing -> return True
 			Just verifier -> verifier k (serializeKey k)
 	get r k = getViaTmp (Remote.retrievalSecurityPolicy r) (RemoteVerify r) k $ \dest ->
-		tryNonAsync (Remote.retrieveKeyFile r k (AssociatedFile Nothing) dest nullMeterUpdate) >>= \case
+		tryNonAsync (Remote.retrieveKeyFile r k (AssociatedFile Nothing) (fromRawFilePath dest) nullMeterUpdate) >>= \case
 			Right v -> return (True, v)
 			Left _ -> return (False, UnVerified)
 	store r k = Remote.storeKey r k (AssociatedFile Nothing) nullMeterUpdate
@@ -369,14 +369,14 @@ testUnavailable runannex mkr mkk =
 		Remote.checkPresent r k
 	, check (== Right False) "retrieveKeyFile" $ \r k ->
 		getViaTmp (Remote.retrievalSecurityPolicy r) (RemoteVerify r) k $ \dest ->
-			tryNonAsync (Remote.retrieveKeyFile r k (AssociatedFile Nothing) dest nullMeterUpdate) >>= \case
+			tryNonAsync (Remote.retrieveKeyFile r k (AssociatedFile Nothing) (fromRawFilePath dest) nullMeterUpdate) >>= \case
 				Right v -> return (True, v)
 				Left _ -> return (False, UnVerified)
 	, check (== Right False) "retrieveKeyFileCheap" $ \r k -> case Remote.retrieveKeyFileCheap r of
 		Nothing -> return False
 		Just a -> getViaTmp (Remote.retrievalSecurityPolicy r) (RemoteVerify r) k $ \dest -> 
 			unVerified $ isRight
-				<$> tryNonAsync (a k (AssociatedFile Nothing) dest)
+				<$> tryNonAsync (a k (AssociatedFile Nothing) (fromRawFilePath dest))
 	]
   where
 	check checkval desc a = testCase desc $ 
@@ -436,7 +436,7 @@ randKey sz = withTmpFile "randkey" $ \f h -> do
 	k <- case Types.Backend.genKey Backend.Hash.testKeyBackend of
 		Just a -> a ks nullMeterUpdate
 		Nothing -> giveup "failed to generate random key (backend problem)"
-	_ <- moveAnnex k f
+	_ <- moveAnnex k (toRawFilePath f)
 	return k
 
 getReadonlyKey :: Remote -> FilePath -> Annex Key

Command/TransferInfo.hs

@@ -11,9 +11,10 @@ import Command
 import Annex.Content
 import Types.Transfer
 import Logs.Transfer
-import qualified CmdLine.GitAnnexShell.Fields as Fields
 import Utility.Metered
 import Utility.SimpleProtocol
+import qualified CmdLine.GitAnnexShell.Fields as Fields
+import qualified Utility.RawFilePath as R
 
 cmd :: Command
 cmd = noCommit $ 
@@ -58,7 +59,7 @@ start (k:[]) = do
 					bytes <- readUpdate
 					maybe (error "transferinfo protocol error")
 						(update . toBytesProcessed) bytes
-				, tryIO $ removeFile tfile
+				, tryIO $ R.removeLink tfile
 				, exitSuccess
 				]
 	stop

Command/TransferKey.hs

@@ -64,7 +64,7 @@ fromPerform :: Key -> AssociatedFile -> Remote -> CommandPerform
 fromPerform key file remote = go Upload file $
 	download (uuid remote) key file stdRetry $ \p ->
 		getViaTmp (retrievalSecurityPolicy remote) (RemoteVerify remote) key $ \t ->
-			tryNonAsync (Remote.retrieveKeyFile remote key file t p) >>= \case
+			tryNonAsync (Remote.retrieveKeyFile remote key file (fromRawFilePath t) p) >>= \case
 				Right v -> return (True, v)	
 				Left e -> do
 					warning (show e)

Command/TransferKeys.hs

@@ -48,7 +48,7 @@ start = do
 		| otherwise = notifyTransfer direction file $
 			download (Remote.uuid remote) key file stdRetry $ \p ->
 				getViaTmp (Remote.retrievalSecurityPolicy remote) (RemoteVerify remote) key $ \t -> do
-					r <- tryNonAsync (Remote.retrieveKeyFile remote key file t p) >>= \case
+					r <- tryNonAsync (Remote.retrieveKeyFile remote key file (fromRawFilePath t) p) >>= \case
 						Left e -> do
 							warning (show e)
 							return (False, UnVerified)

Git/Construct.hs

@@ -134,7 +134,8 @@ 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 (fromConfigValue 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

Git/Types.hs

@@ -5,7 +5,7 @@
  - Licensed under the GNU AGPL version 3 or higher.
  -}
 
-{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE OverloadedStrings, TypeSynonymInstances, FlexibleInstances #-}
 
 module Git.Types where
 
@@ -79,9 +79,15 @@ fromConfigKey (ConfigKey s) = decodeBS' s
 instance Show ConfigKey where
 	show = fromConfigKey
 
-fromConfigValue :: ConfigValue -> String
+class FromConfigValue a where
-fromConfigValue (ConfigValue s) = decodeBS' s
+	fromConfigValue :: ConfigValue -> a
-fromConfigValue NoConfigValue = mempty
+
+instance FromConfigValue S.ByteString where
+	fromConfigValue (ConfigValue s) = s
+	fromConfigValue NoConfigValue = mempty
+
+instance FromConfigValue String where
+	fromConfigValue = decodeBS' . fromConfigValue
 
 instance Show ConfigValue where
 	show = fromConfigValue

Test/Framework.hs

@@ -93,8 +93,9 @@ with_ssh_origin :: (Assertion -> Assertion) -> (Assertion -> Assertion)
 with_ssh_origin cloner a = cloner $ do
 	let k = Git.Types.ConfigKey (encodeBS' config)
 	let v = Git.Types.ConfigValue (toRawFilePath "/dev/null")
-	origindir <- absPath . Git.Types.fromConfigValue =<< annexeval (Config.getConfig k v)
+	origindir <- absPath . Git.Types.fromConfigValue
-	let originurl = "localhost:" ++ origindir
+		=<< annexeval (Config.getConfig k v)
+	let originurl = "localhost:" ++ fromRawFilePath origindir
 	boolSystem "git" [Param "config", Param config, Param originurl] @? "git config failed"
 	a
   where
@@ -105,7 +106,7 @@ intmpclonerepo a = withtmpclonerepo $ \r -> indir r a
 
 checkRepo :: Types.Annex a -> FilePath -> IO a
 checkRepo getval d = do
-	s <- Annex.new =<< Git.Construct.fromPath d
+	s <- Annex.new =<< Git.Construct.fromPath (toRawFilePath d)
 	Annex.eval s $
 		getval `finally` Annex.Action.stopCoProcesses
 
@@ -223,7 +224,7 @@ ensuretmpdir = do
 {- Prevent global git configs from affecting the test suite. -}
 isolateGitConfig :: IO a -> IO a
 isolateGitConfig a = Utility.Tmp.Dir.withTmpDir "testhome" $ \tmphome -> do
-	tmphomeabs <- absPath tmphome
+	tmphomeabs <- fromRawFilePath <$> absPath (toRawFilePath tmphome)
 	Utility.Env.Set.setEnv "HOME" tmphomeabs True
 	Utility.Env.Set.setEnv "XDG_CONFIG_HOME" tmphomeabs True
 	Utility.Env.Set.setEnv "GIT_CONFIG_NOSYSTEM" "1" True