packages feed

git-annex 10.20250115 → 10.20250320

raw patch · 401 files changed

+6910/−4573 lines, 401 filesdep +file-iodep +os-stringdep ~directorydep ~filepath

Dependencies added: file-io, os-string

Dependency ranges changed: directory, filepath

This diff is very large; some files are shown as “too large to diff”. Download the raw patch for the complete diff.

Files

Annex.hs view
@@ -221,7 +221,7 @@ 	, existinghooks :: M.Map Git.Hook.Hook Bool 	, workers :: Maybe (TMVar (WorkerPool (AnnexState, AnnexRead))) 	, cachedcurrentbranch :: (Maybe (Maybe Git.Branch, Maybe Adjustment))-	, cachedgitenv :: Maybe (AltIndexFile, FilePath, [(String, String)])+	, cachedgitenv :: Maybe (AltIndexFile, OsPath, [(String, String)]) 	, urloptions :: Maybe UrlOptions 	, insmudgecleanfilter :: Bool 	, getvectorclock :: IO CandidateVectorClock@@ -465,7 +465,7 @@  - because the git repo paths are stored relative.  - Instead, use this.  -}-changeDirectory :: FilePath -> Annex ()+changeDirectory :: OsPath -> Annex () changeDirectory d = do 	r <- liftIO . Git.adjustPath absPath =<< gitRepo 	liftIO $ setCurrentDirectory d
Annex/AdjustedBranch.hs view
@@ -70,6 +70,7 @@ import Logs.AdjustedBranchUpdate import Utility.FileMode import qualified Utility.RawFilePath as R+import qualified Utility.FileIO as F  import Data.Time.Clock.POSIX import qualified Data.Map as M@@ -160,7 +161,7 @@ 		Database.Keys.addAssociatedFile k f 		exe <- catchDefaultIO False $ 			(isExecutable . fileMode) <$> -				(liftIO . R.getFileStatus+				(liftIO . R.getFileStatus . fromOsPath 					=<< calcRepo (gitAnnexLocation k)) 		let mode = fromTreeItemType $  			if exe then TreeExecutable else TreeFile@@ -170,13 +171,13 @@ adjustToSymlink :: TreeItem -> Annex (Maybe TreeItem) adjustToSymlink = adjustToSymlink' gitAnnexLink -adjustToSymlink' :: (RawFilePath -> Key -> Git.Repo -> GitConfig -> IO RawFilePath) -> TreeItem -> Annex (Maybe TreeItem)+adjustToSymlink' :: (OsPath -> Key -> Git.Repo -> GitConfig -> IO OsPath) -> TreeItem -> Annex (Maybe TreeItem) adjustToSymlink' gitannexlink ti@(TreeItem f _m s) = catKey s >>= \case 	Just k -> do 		absf <- inRepo $ \r -> absPath $ fromTopFilePath f r 		linktarget <- calcRepo $ gitannexlink absf k 		Just . TreeItem f (fromTreeItemType TreeSymlink)-			<$> hashSymlink linktarget+			<$> hashSymlink (fromOsPath linktarget) 	Nothing -> return (Just ti)  -- This is a hidden branch ref, that's used as the basis for the AdjBranch,@@ -268,7 +269,7 @@ 			-- origbranch. 			_ <- propigateAdjustedCommits' True origbranch adj commitlck 			-			origheadfile <- inRepo $ readFileStrict . Git.Ref.headFile+			origheadfile <- inRepo $ F.readFile' . Git.Ref.headFile 			origheadsha <- inRepo (Git.Ref.sha currbranch) 			 			b <- adjustBranch adj origbranch@@ -280,8 +281,8 @@ 			newheadfile <- case origheadsha of 				Just s -> do 					inRepo $ \r -> do-						let newheadfile = fromRef s-						writeFile (Git.Ref.headFile r) newheadfile+						let newheadfile = fromRef' s+						F.writeFile' (Git.Ref.headFile r) newheadfile 						return (Just newheadfile) 				_ -> return Nothing 	@@ -295,9 +296,9 @@ 		unless ok $ case newheadfile of 			Nothing -> noop 			Just v -> preventCommits $ \_commitlck -> inRepo $ \r -> do-				v' <- readFileStrict (Git.Ref.headFile r)+				v' <- F.readFile' (Git.Ref.headFile r) 				when (v == v') $-					writeFile (Git.Ref.headFile r) origheadfile+					F.writeFile' (Git.Ref.headFile r) origheadfile  		return ok 	| otherwise = preventCommits $ \commitlck -> do@@ -307,16 +308,12 @@ 		-- adjustment is stable. 		return True -{- Passed an action that, if it succeeds may get or drop the Key associated- - with the file. When the adjusted branch needs to be refreshed to reflect+{- Passed an action that, if it succeeds may get or drop a key.+ - When the adjusted branch needs to be refreshed to reflect  - those changes, it's handled here.- -- - Note that the AssociatedFile must be verified by this to point to the- - Key. In some cases, the value was provided by the user and might not- - really be an associated file.  -}-adjustedBranchRefresh :: AssociatedFile -> Annex a -> Annex a-adjustedBranchRefresh _af a = do+adjustedBranchRefresh :: Annex a -> Annex a+adjustedBranchRefresh a = do 	r <- a 	go 	return r@@ -450,7 +447,7 @@   where 	setup = do 		lck <- fromRepo $ indexFileLock . indexFile-		liftIO $ Git.LockFile.openLock (fromRawFilePath lck)+		liftIO $ Git.LockFile.openLock lck 	cleanup = liftIO . Git.LockFile.closeLock  {- Commits a given adjusted tree, with the provided parent ref.@@ -630,7 +627,7 @@ 	  where 		m = M.fromList $ map (\i@(TreeItem f' _ _) -> (norm f', i)) $ 			map diffTreeToTreeItem changes-		norm = normalise . fromRawFilePath . getTopFilePath+		norm = normalise . getTopFilePath  diffTreeToTreeItem :: Git.DiffTree.DiffTreeItem -> TreeItem diffTreeToTreeItem dti = TreeItem
Annex/AdjustedBranch/Merge.hs view
@@ -29,9 +29,7 @@ import Utility.Tmp.Dir import Utility.CopyFile import Utility.Directory.Create--import qualified Data.ByteString as S-import qualified System.FilePath.ByteString as P+import qualified Utility.FileIO as F  canMergeToAdjustedBranch :: Branch -> (OrigBranch, Adjustment) -> Annex Bool canMergeToAdjustedBranch tomerge (origbranch, adj) =@@ -72,26 +70,26 @@ 	 -} 	changestomerge (Just updatedorig) = withOtherTmp $ \othertmpdir -> do 		git_dir <- fromRepo Git.localGitDir-		let git_dir' = fromRawFilePath git_dir 		tmpwt <- fromRepo gitAnnexMergeDir-		withTmpDirIn (fromRawFilePath othertmpdir) "git" $ \tmpgit -> withWorkTreeRelated tmpgit $+		withTmpDirIn othertmpdir (literalOsPath "git") $ \tmpgit -> withWorkTreeRelated tmpgit $ 			withemptydir git_dir tmpwt $ withWorkTree tmpwt $ do-				liftIO $ writeFile (tmpgit </> "HEAD") (fromRef updatedorig)+				liftIO $ F.writeFile'+					(tmpgit </> literalOsPath "HEAD")+					(fromRef' updatedorig) 				-- Copy in refs and packed-refs, to work 				-- around bug in git 2.13.0, which 				-- causes it not to look in GIT_DIR for refs. 				refs <- liftIO $ emptyWhenDoesNotExist $  					dirContentsRecursive $-						git_dir' </> "refs"-				let refs' = (git_dir' </> "packed-refs") : refs+						git_dir </> literalOsPath "refs"+				let refs' = (git_dir </> literalOsPath "packed-refs") : refs 				liftIO $ forM_ refs' $ \src -> do-					let src' = toRawFilePath src 					whenM (doesFileExist src) $ do-						dest <- relPathDirToFile git_dir src'-						let dest' = toRawFilePath tmpgit P.</> dest+						dest <- relPathDirToFile git_dir src+						let dest' = tmpgit </> dest 						createDirectoryUnder [git_dir]-							(P.takeDirectory dest')-						void $ createLinkOrCopy src' dest'+							(takeDirectory dest')+						void $ createLinkOrCopy src dest' 				-- This reset makes git merge not care 				-- that the work tree is empty; otherwise 				-- it will think that all the files have@@ -107,7 +105,7 @@ 				if merged 					then do 						!mergecommit <- liftIO $ extractSha-							<$> S.readFile (tmpgit </> "HEAD")+							<$> F.readFile' (tmpgit </> literalOsPath "HEAD") 						-- This is run after the commit lock is dropped. 						return $ postmerge mergecommit 					else return $ return False@@ -118,7 +116,7 @@ 		setup = do 			whenM (doesDirectoryExist d) $ 				removeDirectoryRecursive d-			createDirectoryUnder [git_dir] (toRawFilePath d)+			createDirectoryUnder [git_dir] d 		cleanup _ = removeDirectoryRecursive d  	{- A merge commit has been made between the basisbranch and
Annex/AutoMerge.hs view
@@ -35,10 +35,10 @@ import Utility.InodeCache import Utility.FileMode import qualified Utility.RawFilePath as R+import qualified Utility.FileIO as F  import qualified Data.Set as S import qualified Data.Map as M-import qualified Data.ByteString.Lazy as L import System.PosixCompat.Files (isSymbolicLink)  {- Merges from a branch into the current branch (which may not exist yet),@@ -133,7 +133,7 @@ resolveMerge :: Maybe Git.Ref -> Git.Ref -> Bool -> Annex Bool resolveMerge us them inoverlay = do 	top <- if inoverlay-		then pure "."+		then pure (literalOsPath ".") 		else fromRepo Git.repoPath 	(fs, cleanup) <- inRepo (LsFiles.unmerged [top]) 	srcmap <- if inoverlay@@ -150,7 +150,7 @@ 		unless (null deleted) $ 			Annex.Queue.addCommand [] "rm" 				[Param "--quiet", Param "-f", Param "--"]-				(map fromRawFilePath deleted)+				(map fromOsPath deleted) 		void $ liftIO cleanup2  	when merged $ do@@ -167,7 +167,7 @@ 		, LsFiles.unmergedSiblingFile u 		] -resolveMerge' :: InodeMap -> Maybe Git.Ref -> Git.Ref -> Bool -> LsFiles.Unmerged -> Annex ([Key], Maybe FilePath)+resolveMerge' :: InodeMap -> Maybe Git.Ref -> Git.Ref -> Bool -> LsFiles.Unmerged -> Annex ([Key], Maybe OsPath) resolveMerge' _ Nothing _ _ _ = return ([], Nothing) resolveMerge' unstagedmap (Just us) them inoverlay u = do 	kus <- getkey LsFiles.valUs@@ -182,7 +182,7 @@ 				-- files, so delete here. 				unless inoverlay $ 					unless (islocked LsFiles.valUs) $-						liftIO $ removeWhenExistsWith R.removeLink (toRawFilePath file)+						liftIO $ removeWhenExistsWith removeFile file 			| otherwise -> resolveby [keyUs, keyThem] $ 				-- Only resolve using symlink when both 				-- were locked, otherwise use unlocked@@ -204,8 +204,8 @@ 		-- Neither side is annexed file; cannot resolve. 		(Nothing, Nothing) -> return ([], Nothing)   where-	file = fromRawFilePath $ LsFiles.unmergedFile u-	sibfile = fromRawFilePath <$> LsFiles.unmergedSiblingFile u+	file = LsFiles.unmergedFile u+	sibfile = LsFiles.unmergedSiblingFile u  	getkey select =  		case select (LsFiles.unmergedSha u) of@@ -230,15 +230,15 @@ 		dest = variantFile file key 		destmode = fromTreeItemType <$> select (LsFiles.unmergedTreeItemType u) -	stagefile :: FilePath -> Annex FilePath+	stagefile :: OsPath -> Annex OsPath 	stagefile f-		| inoverlay = (</> f) . fromRawFilePath <$> fromRepo Git.repoPath+		| inoverlay = (</> f) <$> fromRepo Git.repoPath 		| otherwise = pure f  	makesymlink key dest = do-		l <- calcRepo $ gitAnnexLink (toRawFilePath dest) key+		l <- fromOsPath <$> calcRepo (gitAnnexLink dest key) 		unless inoverlay $ replacewithsymlink dest l-		dest' <- toRawFilePath <$> stagefile dest+		dest' <- stagefile dest 		stageSymlink dest' =<< hashSymlink l  	replacewithsymlink dest link = replaceWorkTreeFile dest $@@ -247,27 +247,27 @@ 	makepointer key dest destmode = do 		unless inoverlay $  			unlessM (reuseOldFile unstagedmap key file dest) $-				linkFromAnnex key (toRawFilePath dest) destmode >>= \case+				linkFromAnnex key dest destmode >>= \case 					LinkAnnexFailed -> liftIO $-						writePointerFile (toRawFilePath dest) key destmode+						writePointerFile dest key destmode 					_ -> noop-		dest' <- toRawFilePath <$> stagefile dest+		dest' <- stagefile dest 		stagePointerFile dest' destmode =<< hashPointerFile key 		unless inoverlay $ 			Database.Keys.addAssociatedFile key-				=<< inRepo (toTopFilePath (toRawFilePath dest))+				=<< inRepo (toTopFilePath dest)  	{- Stage a graft of a directory or file from a branch 	 - and update the work tree. -} 	graftin b item selectwant selectwant' selectunwant = do 		Annex.Queue.addUpdateIndex-			=<< fromRepo (UpdateIndex.lsSubTree b item)-				+			=<< fromRepo (UpdateIndex.lsSubTree b (fromOsPath item))+		 		let replacefile isexecutable = case selectwant' (LsFiles.unmergedSha u) of 			Nothing -> noop 			Just sha -> replaceWorkTreeFile item $ \tmp -> do 				c <- catObject sha-				liftIO $ L.writeFile (decodeBS tmp) c+				liftIO $ F.writeFile tmp c 				when isexecutable $ 					liftIO $ void $ tryIO $  						modifyFileMode tmp $@@ -280,7 +280,7 @@ 					Nothing -> noop 					Just sha -> do 						link <- catSymLinkTarget sha-						replacewithsymlink item link+						replacewithsymlink item (fromOsPath link) 			(Just TreeFile, Just TreeSymlink) -> replacefile False 			(Just TreeExecutable, Just TreeSymlink) -> replacefile True 			_ -> ifM (liftIO $ doesDirectoryExist item)@@ -304,9 +304,9 @@ 			, Param "--cached" 			, Param "--" 			]-			(catMaybes [Just file, sibfile])+			(map fromOsPath $ catMaybes [Just file, sibfile]) 		liftIO $ maybe noop-			(removeWhenExistsWith R.removeLink . toRawFilePath)+			(removeWhenExistsWith removeFile) 			sibfile 		void a 		return (ks, Just file)@@ -321,13 +321,13 @@  - C) are pointers to or have the content of keys that were involved  - in the merge.  -}-cleanConflictCruft :: [Key] -> [FilePath] -> InodeMap -> Annex ()+cleanConflictCruft :: [Key] -> [OsPath] -> InodeMap -> Annex () cleanConflictCruft resolvedks resolvedfs unstagedmap = do 	is <- S.fromList . map (inodeCacheToKey Strongly) . concat  		<$> mapM Database.Keys.getInodeCaches resolvedks 	forM_ (M.toList unstagedmap) $ \(i, f) -> 		whenM (matchesresolved is i f) $-			liftIO $ removeWhenExistsWith R.removeLink (toRawFilePath f)+			liftIO $ removeWhenExistsWith removeFile f   where 	fs = S.fromList resolvedfs 	ks = S.fromList resolvedks@@ -335,19 +335,24 @@ 	matchesresolved is i f 		| S.member f fs || S.member (conflictCruftBase f) fs = anyM id 			[ pure $ either (const False) (`S.member` is) i-			, inks <$> isAnnexLink (toRawFilePath f)-			, inks <$> liftIO (isPointerFile (toRawFilePath f))+			, inks <$> isAnnexLink f+			, inks <$> liftIO (isPointerFile f) 			] 		| otherwise = return False -conflictCruftBase :: FilePath -> FilePath-conflictCruftBase f = reverse $ drop 1 $ dropWhile (/= '~') $ reverse f+conflictCruftBase :: OsPath -> OsPath+conflictCruftBase = toOsPath+	. reverse+	. drop 1+	. dropWhile (/= '~')+	. reverse+	. fromOsPath  {- When possible, reuse an existing file from the srcmap as the  - content of a worktree file in the resolved merge. It must have the  - same name as the origfile, or a name that git would use for conflict  - cruft. And, its inode cache must be a known one for the key. -}-reuseOldFile :: InodeMap -> Key -> FilePath -> FilePath -> Annex Bool+reuseOldFile :: InodeMap -> Key -> OsPath -> OsPath -> Annex Bool reuseOldFile srcmap key origfile destfile = do 	is <- map (inodeCacheToKey Strongly) 		<$> Database.Keys.getInodeCaches key@@ -373,19 +378,18 @@ 		, Param "git-annex automatic merge conflict fix" 		] -type InodeMap = M.Map (Either FilePath InodeCacheKey) FilePath+type InodeMap = M.Map (Either OsPath InodeCacheKey) OsPath -inodeMap :: Annex ([RawFilePath], IO Bool) -> Annex InodeMap+inodeMap :: Annex ([OsPath], IO Bool) -> Annex InodeMap inodeMap getfiles = do 	(fs, cleanup) <- getfiles 	fsis <- forM fs $ \f -> do-		s <- liftIO $ R.getSymbolicLinkStatus f-		let f' = fromRawFilePath f+		s <- liftIO $ R.getSymbolicLinkStatus (fromOsPath f) 		if isSymbolicLink s-			then pure $ Just (Left f', f')+			then pure $ Just (Left f, f) 			else withTSDelta (\d -> liftIO $ toInodeCache d f s) 				>>= return . \case-					Just i -> Just (Right (inodeCacheToKey Strongly i), f')+					Just i -> Just (Right (inodeCacheToKey Strongly i), f) 					Nothing -> Nothing 	void $ liftIO cleanup 	return $ M.fromList $ catMaybes fsis
Annex/Balanced.hs view
@@ -11,11 +11,12 @@ import Types.UUID import Utility.Hash -import Data.List import Data.Maybe import Data.Bits (shiftL) import qualified Data.Set as S import qualified Data.ByteArray as BA+import Data.List+import Prelude  -- The Int is how many UUIDs to pick. type BalancedPicker = S.Set UUID -> Key -> Int -> [UUID]
Annex/Branch.hs view
@@ -54,7 +54,6 @@ import Data.ByteString.Builder import Control.Concurrent (threadDelay) import Control.Concurrent.MVar-import qualified System.FilePath.ByteString as P import System.PosixCompat.Files (isRegularFile)  import Annex.Common@@ -96,6 +95,7 @@ import Utility.Directory.Stream import Utility.Tmp import qualified Utility.RawFilePath as R+import qualified Utility.FileIO as F  {- Name of the branch that is used to store git-annex's information. -} name :: Git.Ref@@ -312,7 +312,7 @@  - transitions that have not been applied to all refs will be applied on  - the fly.  -}-get :: RawFilePath -> Annex L.ByteString+get :: OsPath -> Annex L.ByteString get file = do 	st <- update 	case getCache file st of@@ -352,7 +352,7 @@  - using some optimised method. The journal has to be checked, in case  - it has a newer version of the file that has not reached the branch yet.  -}-precache :: RawFilePath -> L.ByteString -> Annex ()+precache :: OsPath -> L.ByteString -> Annex () precache file branchcontent = do 	st <- getState 	content <- if journalIgnorable st@@ -368,12 +368,12 @@  - reflect changes in remotes.  - (Changing the value this returns, and then merging is always the  - same as using get, and then changing its value.) -}-getLocal :: RawFilePath -> Annex L.ByteString+getLocal :: OsPath -> Annex L.ByteString getLocal = getLocal' (GetPrivate True) -getLocal' :: GetPrivate -> RawFilePath -> Annex L.ByteString+getLocal' :: GetPrivate -> OsPath -> Annex L.ByteString getLocal' getprivate file = do-	fastDebug "Annex.Branch" ("read " ++ fromRawFilePath file)+	fastDebug "Annex.Branch" ("read " ++ fromOsPath file) 	go =<< getJournalFileStale getprivate file   where 	go NoJournalledContent = getRef fullname file@@ -383,14 +383,14 @@ 		return (v <> journalcontent)  {- Gets the content of a file as staged in the branch's index. -}-getStaged :: RawFilePath -> Annex L.ByteString+getStaged :: OsPath -> Annex L.ByteString getStaged = getRef indexref   where 	-- This makes git cat-file be run with ":file", 	-- so it looks at the index. 	indexref = Ref "" -getHistorical :: RefDate -> RawFilePath -> Annex L.ByteString+getHistorical :: RefDate -> OsPath -> Annex L.ByteString getHistorical date file = 	-- This check avoids some ugly error messages when the reflog 	-- is empty.@@ -399,7 +399,7 @@ 		, getRef (Git.Ref.dateRef fullname date) file 		) -getRef :: Ref -> RawFilePath -> Annex L.ByteString+getRef :: Ref -> OsPath -> Annex L.ByteString getRef ref file = withIndex $ catFile ref file  {- Applies a function to modify the content of a file.@@ -407,7 +407,7 @@  - Note that this does not cause the branch to be merged, it only  - modifies the current content of the file on the branch.  -}-change :: Journalable content => RegardingUUID -> RawFilePath -> (L.ByteString -> content) -> Annex ()+change :: Journalable content => RegardingUUID -> OsPath -> (L.ByteString -> content) -> Annex () change ru file f = lockJournal $ \jl -> f <$> getToChange ru file >>= set jl ru file  {- Applies a function which can modify the content of a file, or not.@@ -415,7 +415,7 @@  - When the file was modified, runs the onchange action, and returns  - True. The action is run while the journal is still locked,  - so another concurrent call to this cannot happen while it is running. -}-maybeChange :: Journalable content => RegardingUUID -> RawFilePath -> (L.ByteString -> Maybe content) -> Annex () -> Annex Bool+maybeChange :: Journalable content => RegardingUUID -> OsPath -> (L.ByteString -> Maybe content) -> Annex () -> Annex Bool maybeChange ru file f onchange = lockJournal $ \jl -> do 	v <- getToChange ru file 	case f v of@@ -448,7 +448,7 @@  - state that would confuse the older version. This is planned to be  - changed in a future repository version.  -}-changeOrAppend :: Journalable content => RegardingUUID -> RawFilePath -> (L.ByteString -> ChangeOrAppend content) -> Annex ()+changeOrAppend :: Journalable content => RegardingUUID -> OsPath -> (L.ByteString -> ChangeOrAppend content) -> Annex () changeOrAppend ru file f = lockJournal $ \jl -> 	checkCanAppendJournalFile jl ru file >>= \case 		Just appendable -> ifM (annexAlwaysCompact <$> Annex.getGitConfig)@@ -480,7 +480,7 @@ 					oldc <> journalableByteString toappend  {- Only get private information when the RegardingUUID is itself private. -}-getToChange :: RegardingUUID -> RawFilePath -> Annex L.ByteString+getToChange :: RegardingUUID -> OsPath -> Annex L.ByteString getToChange ru f = flip getLocal' f . GetPrivate =<< regardingPrivateUUID ru  {- Records new content of a file into the journal.@@ -492,11 +492,11 @@  - git-annex index, and should not be written to the public git-annex  - branch.  -}-set :: Journalable content => JournalLocked -> RegardingUUID -> RawFilePath -> content -> Annex ()+set :: Journalable content => JournalLocked -> RegardingUUID -> OsPath -> content -> Annex () set jl ru f c = do 	journalChanged 	setJournalFile jl ru f c-	fastDebug "Annex.Branch" ("set " ++ fromRawFilePath f)+	fastDebug "Annex.Branch" ("set " ++ fromOsPath f) 	-- Could cache the new content, but it would involve 	-- evaluating a Journalable Builder twice, which is not very 	-- efficient. Instead, assume that it's not common to need to read@@ -504,11 +504,11 @@ 	invalidateCache f  {- Appends content to the journal file. -}-append :: Journalable content => JournalLocked -> RawFilePath -> AppendableJournalFile -> content -> Annex ()+append :: Journalable content => JournalLocked -> OsPath -> AppendableJournalFile -> content -> Annex () append jl f appendable toappend = do 	journalChanged 	appendJournalFile jl appendable toappend-	fastDebug "Annex.Branch" ("append " ++ fromRawFilePath f)+	fastDebug "Annex.Branch" ("append " ++ fromOsPath f) 	invalidateCache f  {- Commit message used when making a commit of whatever data has changed@@ -610,7 +610,7 @@  - not been merged in, returns Nothing, because it's not possible to  - efficiently handle that.  -}-files :: Annex (Maybe ([RawFilePath], IO Bool))+files :: Annex (Maybe ([OsPath], IO Bool)) files = do 	st <- update         if not (null (unmergedRefs st))@@ -628,10 +628,10 @@  {- Lists all files currently in the journal, but not files in the private  - journal. -}-journalledFiles :: Annex [RawFilePath]+journalledFiles :: Annex [OsPath] journalledFiles = getJournalledFilesStale gitAnnexJournalDir -journalledFilesPrivate :: Annex [RawFilePath]+journalledFilesPrivate :: Annex [OsPath] journalledFilesPrivate = ifM privateUUIDsKnown 	( getJournalledFilesStale gitAnnexPrivateJournalDir 	, return []@@ -639,11 +639,11 @@  {- Files in the branch, not including any from journalled changes,  - and without updating the branch. -}-branchFiles :: Annex ([RawFilePath], IO Bool)+branchFiles :: Annex ([OsPath], IO Bool) branchFiles = withIndex $ inRepo branchFiles' -branchFiles' :: Git.Repo -> IO ([RawFilePath], IO Bool)-branchFiles' = Git.Command.pipeNullSplit' $+branchFiles' :: Git.Repo -> IO ([OsPath], IO Bool)+branchFiles' = Git.Command.pipeNullSplit'' toOsPath $ 	lsTreeParams Git.LsTree.LsTreeRecursive (Git.LsTree.LsTreeLong False) 		fullname 		[Param "--name-only"]@@ -680,7 +680,8 @@ prepareModifyIndex :: JournalLocked -> Annex () prepareModifyIndex _jl = do 	index <- fromRepo gitAnnexIndex-	void $ liftIO $ tryIO $ R.removeLink (index <> ".lock")+	void $ liftIO $ tryIO $+		removeFile (index <> literalOsPath ".lock")  {- Runs an action using the branch's index file. -} withIndex :: Annex a -> Annex a@@ -689,7 +690,7 @@ withIndex' bootstrapping a = withIndexFile AnnexIndexFile $ \f -> do 	checkIndexOnce $ unlessM (liftIO $ doesFileExist f) $ do 		unless bootstrapping create-		createAnnexDirectory $ toRawFilePath $ takeDirectory f+		createAnnexDirectory $ takeDirectory f 		unless bootstrapping $ inRepo genIndex 	a @@ -711,9 +712,9 @@ {- Checks if the index needs to be updated. -} needUpdateIndex :: Git.Ref -> Annex Bool needUpdateIndex branchref = do-	f <- fromRawFilePath <$> fromRepo gitAnnexIndexStatus+	f <- fromRepo gitAnnexIndexStatus 	committedref <- Git.Ref . firstLine' <$>-		liftIO (catchDefaultIO mempty $ B.readFile f)+		liftIO (catchDefaultIO mempty $ F.readFile' f) 	return (committedref /= branchref)  {- Record that the branch's index has been updated to correspond to a@@ -741,25 +742,26 @@ 	g <- gitRepo 	st <- getState 	let dir = gitAnnexJournalDir st g-	(jlogf, jlogh) <- openjlog (fromRawFilePath tmpdir)+	(jlogf, jlogh) <- openjlog tmpdir 	withHashObjectHandle $ \h -> 		withJournalHandle gitAnnexJournalDir $ \jh -> 			Git.UpdateIndex.streamUpdateIndex g 				[genstream dir h jh jlogh] 	commitindex-	liftIO $ cleanup (fromRawFilePath dir) jlogh jlogf+	liftIO $ cleanup dir jlogh jlogf   where 	genstream dir h jh jlogh streamer = readDirectory jh >>= \case 		Nothing -> return () 		Just file -> do-			let path = dir P.</> toRawFilePath file-			unless (dirCruft file) $ whenM (isfile path) $ do+			let file' = toOsPath file+			let path = dir </> file'+			unless (file' `elem` dirCruft) $ whenM (isfile path) $ do 				sha <- Git.HashObject.hashFile h path-				hPutStrLn jlogh file+				B.hPutStr jlogh (file <> "\n") 				streamer $ Git.UpdateIndex.updateIndexLine-					sha TreeFile (asTopFilePath $ fileJournal $ toRawFilePath file)+					sha TreeFile (asTopFilePath $ fileJournal file') 			genstream dir h jh jlogh streamer-	isfile file = isRegularFile <$> R.getFileStatus file+	isfile file = isRegularFile <$> R.getFileStatus (fromOsPath file) 	-- Clean up the staged files, as listed in the temp log file. 	-- The temp file is used to avoid needing to buffer all the 	-- filenames in memory.@@ -767,10 +769,10 @@ 		hFlush jlogh 		hSeek jlogh AbsoluteSeek 0 		stagedfs <- lines <$> hGetContents jlogh-		mapM_ (removeFile . (dir </>)) stagedfs+		mapM_ (removeFile . (dir </>) . toOsPath) stagedfs 		hClose jlogh-		removeWhenExistsWith (R.removeLink) (toRawFilePath jlogf)-	openjlog tmpdir = liftIO $ openTmpFileIn tmpdir "jlog"+		removeWhenExistsWith removeFile jlogf+	openjlog tmpdir = liftIO $ openTmpFileIn tmpdir (literalOsPath "jlog")  getLocalTransitions :: Annex Transitions getLocalTransitions = @@ -931,8 +933,8 @@ 	S.fromList . mapMaybe Git.Sha.extractSha . fileLines' <$> content   where 	content = do-		f <- fromRawFilePath <$> fromRepo gitAnnexIgnoredRefs-		liftIO $ catchDefaultIO mempty $ B.readFile f+		f <- fromRepo gitAnnexIgnoredRefs+		liftIO $ catchDefaultIO mempty $ F.readFile' f  addMergedRefs :: [(Git.Sha, Git.Branch)] -> Annex () addMergedRefs [] = return ()@@ -949,8 +951,8 @@  getMergedRefs' :: Annex [(Git.Sha, Git.Branch)] getMergedRefs' = do-	f <- fromRawFilePath <$> fromRepo gitAnnexMergedRefs-	s <- liftIO $ catchDefaultIO mempty $ B.readFile f+	f <- fromRepo gitAnnexMergedRefs+	s <- liftIO $ catchDefaultIO mempty $ F.readFile' f 	return $ map parse $ fileLines' s   where 	parse l = @@ -998,7 +1000,7 @@ 	= UnmergedBranches t  	| NoUnmergedBranches t -type FileContents t b = Maybe (t, RawFilePath, Maybe (L.ByteString, Maybe b))+type FileContents t b = Maybe (t, OsPath, Maybe (L.ByteString, Maybe b))  {- Runs an action on the content of selected files from the branch.  - This is much faster than reading the content of each file in turn,@@ -1021,7 +1023,7 @@ 	-- the callback can be run more than once on the same filename, 	-- and in this case it's also possible for the callback to be 	-- passed some of the same file content repeatedly.-	-> (RawFilePath -> Maybe v)+	-> (OsPath -> Maybe v) 	-> (Annex (FileContents v Bool) -> Annex a) 	-> Annex (UnmergedBranches (a, Git.Sha)) overBranchFileContents ignorejournal select go = do@@ -1035,7 +1037,7 @@ 		else NoUnmergedBranches v  overBranchFileContents'-	:: (RawFilePath -> Maybe v)+	:: (OsPath -> Maybe v) 	-> (Annex (FileContents v Bool) -> Annex a) 	-> BranchState 	-> Annex (a, Git.Sha)@@ -1085,11 +1087,11 @@  - files.  -} overJournalFileContents-	:: (RawFilePath -> L.ByteString -> Annex (L.ByteString, Maybe b))+	:: (OsPath -> L.ByteString -> Annex (L.ByteString, Maybe b)) 	-- ^ Called with the journalled file content when the journalled 	-- content may be stale or lack information committed to the 	-- git-annex branch.-	-> (RawFilePath -> Maybe v)+	-> (OsPath -> Maybe v) 	-> (Annex (FileContents v b) -> Annex a) 	-> Annex a overJournalFileContents handlestale select go = do@@ -1097,9 +1099,9 @@ 	go $ overJournalFileContents' buf handlestale select  overJournalFileContents'-	:: MVar ([RawFilePath], [RawFilePath])-	-> (RawFilePath -> L.ByteString -> Annex (L.ByteString, Maybe b))-	-> (RawFilePath -> Maybe a)+	:: MVar ([OsPath], [OsPath])+	-> (OsPath -> L.ByteString -> Annex (L.ByteString, Maybe b))+	-> (OsPath -> Maybe a) 	-> Annex (FileContents a b) overJournalFileContents' buf handlestale select = 	liftIO (tryTakeMVar buf) >>= \case
Annex/BranchState.hs view
@@ -118,7 +118,7 @@ 	, journalIgnorable = False 	} -setCache :: RawFilePath -> L.ByteString -> Annex ()+setCache :: OsPath -> L.ByteString -> Annex () setCache file content = changeState $ \s -> s 	{ cachedFileContents = add (cachedFileContents s) }   where@@ -126,7 +126,7 @@ 		| length l < logFilesToCache = (file, content) : l 		| otherwise = (file, content) : Prelude.init l -getCache :: RawFilePath -> BranchState -> Maybe L.ByteString+getCache :: OsPath -> BranchState -> Maybe L.ByteString getCache file state = go (cachedFileContents state)   where 	go [] = Nothing@@ -134,7 +134,7 @@ 		| f == file && not (needInteractiveAccess state) = Just c 		| otherwise = go rest -invalidateCache :: RawFilePath -> Annex ()+invalidateCache :: OsPath -> Annex () invalidateCache f = changeState $ \s -> s 	{ cachedFileContents = filter (\(f', _) -> f' /= f)  		(cachedFileContents s)
Annex/CatFile.hs view
@@ -45,11 +45,11 @@ import Types.CatFileHandles import Utility.ResourcePool -catFile :: Git.Branch -> RawFilePath -> Annex L.ByteString+catFile :: Git.Branch -> OsPath -> Annex L.ByteString catFile branch file = withCatFileHandle $ \h ->  	liftIO $ Git.CatFile.catFile h branch file -catFileDetails :: Git.Branch -> RawFilePath -> Annex (Maybe (L.ByteString, Sha, ObjectType))+catFileDetails :: Git.Branch -> OsPath -> Annex (Maybe (L.ByteString, Sha, ObjectType)) catFileDetails branch file = withCatFileHandle $ \h ->  	liftIO $ Git.CatFile.catFileDetails h branch file @@ -167,8 +167,8 @@ catKey' _ _ = return Nothing  {- Gets a symlink target. -}-catSymLinkTarget :: Sha -> Annex RawFilePath-catSymLinkTarget sha = fromInternalGitPath . L.toStrict <$> get+catSymLinkTarget :: Sha -> Annex OsPath+catSymLinkTarget sha = fromInternalGitPath . toOsPath . L.toStrict <$> get   where 	-- Avoid buffering the whole file content, which might be large. 	-- 8192 is enough if it really is a symlink.@@ -195,25 +195,25 @@  -  - So, this gets info from the index, unless running as a daemon.  -}-catKeyFile :: RawFilePath -> Annex (Maybe Key)+catKeyFile :: OsPath -> Annex (Maybe Key) catKeyFile f = ifM (Annex.getState Annex.daemon) 	( catKeyFileHEAD f 	, maybe (pure Nothing) catKey =<< inRepo (Git.Ref.fileRef f) 	) -catKeyFileHEAD :: RawFilePath -> Annex (Maybe Key)+catKeyFileHEAD :: OsPath -> Annex (Maybe Key) catKeyFileHEAD f = maybe (pure Nothing) catKey 	=<< inRepo (Git.Ref.fileFromRef Git.Ref.headRef f)  {- Look in the original branch from whence an adjusted branch is based  - to find the file. But only when the adjustment hides some files. -}-catKeyFileHidden :: RawFilePath -> CurrBranch -> Annex (Maybe Key) +catKeyFileHidden :: OsPath -> CurrBranch -> Annex (Maybe Key)  catKeyFileHidden = hiddenCat catKey -catObjectMetaDataHidden :: RawFilePath -> CurrBranch -> Annex (Maybe (Sha, Integer, ObjectType))+catObjectMetaDataHidden :: OsPath -> CurrBranch -> Annex (Maybe (Sha, Integer, ObjectType)) catObjectMetaDataHidden = hiddenCat catObjectMetaData -hiddenCat :: (Ref -> Annex (Maybe a)) -> RawFilePath -> CurrBranch -> Annex (Maybe a)+hiddenCat :: (Ref -> Annex (Maybe a)) -> OsPath -> CurrBranch -> Annex (Maybe a) hiddenCat a f (Just origbranch, Just adj) 	| adjustmentHidesFiles adj =  		maybe (pure Nothing) a
Annex/ChangedRefs.hs view
@@ -23,12 +23,12 @@ import qualified Git import Git.Sha import qualified Utility.SimpleProtocol as Proto+import qualified Utility.FileIO as F+import qualified Utility.OsString as OS  import Control.Concurrent import Control.Concurrent.STM import Control.Concurrent.STM.TBMChan-import qualified Data.ByteString as S-import qualified System.FilePath.ByteString as P  newtype ChangedRefs = ChangedRefs [Git.Ref] 	deriving (Show)@@ -82,7 +82,7 @@ 	 	g <- gitRepo 	let gittop = Git.localGitDir g-	let refdir = gittop P.</> "refs"+	let refdir = gittop </> literalOsPath "refs" 	liftIO $ createDirectoryUnder [gittop] refdir  	let notifyhook = Just $ notifyHook chan@@ -93,18 +93,17 @@  	if canWatch 		then do-			h <- liftIO $ watchDir-				(fromRawFilePath refdir)+			h <- liftIO $ watchDir refdir 				(const False) True hooks id 			return $ Just $ ChangedRefsHandle h chan 		else return Nothing -notifyHook :: TBMChan Git.Sha -> FilePath -> Maybe FileStatus -> IO ()+notifyHook :: TBMChan Git.Sha -> OsPath -> Maybe FileStatus -> IO () notifyHook chan reffile _-	| ".lock" `isSuffixOf` reffile = noop+	| literalOsPath ".lock" `OS.isSuffixOf` reffile = noop 	| otherwise = void $ do 		sha <- catchDefaultIO Nothing $-			extractSha <$> S.readFile reffile+			extractSha <$> F.readFile' reffile 		-- When the channel is full, there is probably no reader 		-- running, or ref changes have been occurring very fast, 		-- so it's ok to not write the change to it.
Annex/CheckAttr.hs view
@@ -29,14 +29,14 @@ 	, "annex.mincopies" 	] -checkAttr :: Git.Attr -> RawFilePath -> Annex String+checkAttr :: Git.Attr -> OsPath -> Annex String checkAttr attr file = withCheckAttrHandle $ \h -> do 	r <- liftIO $ Git.checkAttr h attr file 	if r == Git.unspecifiedAttr 		then return "" 		else return r -checkAttrs :: [Git.Attr] -> RawFilePath -> Annex [String]+checkAttrs :: [Git.Attr] -> OsPath -> Annex [String] checkAttrs attrs file = withCheckAttrHandle $ \h ->  	liftIO $ Git.checkAttrs h attrs file
Annex/CheckIgnore.hs view
@@ -22,7 +22,7 @@  newtype CheckGitIgnore = CheckGitIgnore Bool -checkIgnored :: CheckGitIgnore -> RawFilePath -> Annex Bool+checkIgnored :: CheckGitIgnore -> OsPath -> Annex Bool checkIgnored (CheckGitIgnore False) _ = pure False checkIgnored (CheckGitIgnore True) file = 	ifM (Annex.getRead Annex.force)
Annex/Content.hs view
@@ -108,8 +108,8 @@ import Utility.TimeStamp import Utility.FileMode import qualified Utility.RawFilePath as R+import qualified Utility.FileIO as F -import qualified System.FilePath.ByteString as P import System.PosixCompat.Files (isSymbolicLink, linkCount) import Data.Time.Clock.POSIX @@ -247,7 +247,7 @@ {- Passed the object content file, and maybe a separate lock file to use,  - when the content file itself should not be locked. -} type ContentLocker -	= RawFilePath+	= OsPath 	-> Maybe LockFile  	-> 		( Annex (Maybe LockHandle)@@ -259,7 +259,7 @@ 		-- and prior to deleting the lock file, in order to  		-- ensure that no other processes also have a shared lock. #else-		, Maybe (RawFilePath -> Annex ())+		, Maybe (OsPath -> Annex ()) 		-- ^ On Windows, this is called after the lock is dropped, 		-- but before the lock file is cleaned up. #endif@@ -277,7 +277,7 @@ 	let lck = do 		modifyContentDir lockfile $ 			void $ liftIO $ tryIO $-				writeFile (fromRawFilePath lockfile) ""+				writeFile (fromOsPath lockfile) "" 		liftIO $ takelock lockfile 	in (lck, Nothing) -- never reached; windows always uses a separate lock file@@ -370,24 +370,24 @@  	cleanuplockfile lockfile = void $ tryNonAsync $ do 		thawContentDir lockfile-		liftIO $ removeWhenExistsWith R.removeLink lockfile+		liftIO $ removeWhenExistsWith removeFile lockfile 		cleanObjectDirs lockfile  {- Runs an action, passing it the temp file to get,  - and if the action succeeds, verifies the file matches  - the key and moves the file into the annex as a key's content. -}-getViaTmp :: RetrievalSecurityPolicy -> VerifyConfig -> Key -> AssociatedFile -> Maybe FileSize -> (RawFilePath -> Annex (Bool, Verification)) -> Annex Bool-getViaTmp rsp v key af sz action =+getViaTmp :: RetrievalSecurityPolicy -> VerifyConfig -> Key -> Maybe FileSize -> (OsPath -> Annex (Bool, Verification)) -> Annex Bool+getViaTmp rsp v key sz action = 	checkDiskSpaceToGet key sz False $-		getViaTmpFromDisk rsp v key af action+		getViaTmpFromDisk rsp v key action  {- Like getViaTmp, but does not check that there is enough disk space  - for the incoming key. For use when the key content is already on disk  - and not being copied into place. -}-getViaTmpFromDisk :: RetrievalSecurityPolicy -> VerifyConfig -> Key -> AssociatedFile -> (RawFilePath -> Annex (Bool, Verification)) -> Annex Bool-getViaTmpFromDisk rsp v key af action = checkallowed $ do+getViaTmpFromDisk :: RetrievalSecurityPolicy -> VerifyConfig -> Key -> (OsPath -> Annex (Bool, Verification)) -> Annex Bool+getViaTmpFromDisk rsp v key action = checkallowed $ do 	tmpfile <- prepTmp key-	resuming <- liftIO $ R.doesPathExist tmpfile+	resuming <- liftIO $ doesPathExist tmpfile 	(ok, verification) <- action tmpfile 	-- When the temp file already had content, we don't know if 	-- that content is good or not, so only trust if it the action@@ -400,7 +400,7 @@ 		else verification 	if ok 		then ifM (verifyKeyContentPostRetrieval rsp v verification' key tmpfile)-			( pruneTmpWorkDirBefore tmpfile (moveAnnex key af)+			( pruneTmpWorkDirBefore tmpfile (moveAnnex key) 			, do 				verificationOfContentFailed tmpfile 				return False@@ -433,11 +433,11 @@  - left off, and so if the bad content were not deleted, repeated downloads  - would continue to fail.  -}-verificationOfContentFailed :: RawFilePath -> Annex ()+verificationOfContentFailed :: OsPath -> Annex () verificationOfContentFailed tmpfile = do 	warning "Verification of content failed" 	pruneTmpWorkDirBefore tmpfile-		(liftIO . removeWhenExistsWith R.removeLink)+		(liftIO . removeWhenExistsWith removeFile)  {- Checks if there is enough free disk space to download a key  - to its temp file.@@ -450,7 +450,7 @@ checkDiskSpaceToGet :: Key -> Maybe FileSize -> a -> Annex a -> Annex a checkDiskSpaceToGet key sz unabletoget getkey = do 	tmp <- fromRepo (gitAnnexTmpObjectLocation key)-	e <- liftIO $ doesFileExist (fromRawFilePath tmp)+	e <- liftIO $ doesFileExist tmp 	alreadythere <- liftIO $ if e 		then getFileSize tmp 		else return 0@@ -462,7 +462,7 @@ 		, return unabletoget 		) -prepTmp :: Key -> Annex RawFilePath+prepTmp :: Key -> Annex OsPath prepTmp key = do 	tmp <- fromRepo $ gitAnnexTmpObjectLocation key 	createAnnexDirectory (parentDir tmp)@@ -472,11 +472,11 @@  - the temp file. If the action throws an exception, the temp file is  - left behind, which allows for resuming.  -}-withTmp :: Key -> (RawFilePath -> Annex a) -> Annex a+withTmp :: Key -> (OsPath -> Annex a) -> Annex a withTmp key action = do 	tmp <- prepTmp key 	res <- action tmp-	pruneTmpWorkDirBefore tmp (liftIO . removeWhenExistsWith R.removeLink)+	pruneTmpWorkDirBefore tmp (liftIO . removeWhenExistsWith removeFile) 	return res  {- Moves a key's content into .git/annex/objects/@@ -507,8 +507,8 @@  - accepted into the repository. Will display a warning message in this  - case. May also throw exceptions in some cases.  -}-moveAnnex :: Key -> AssociatedFile -> RawFilePath -> Annex Bool-moveAnnex key af src = ifM (checkSecureHashes' key)+moveAnnex :: Key -> OsPath -> Annex Bool+moveAnnex key src = ifM (checkSecureHashes' key) 	( do #ifdef mingw32_HOST_OS 		{- Windows prevents deletion of files that are not@@ -521,9 +521,9 @@ 	, return False 	)   where-	storeobject dest = ifM (liftIO $ R.doesPathExist dest)+	storeobject dest = ifM (liftIO $ doesPathExist dest) 		( alreadyhave-		, adjustedBranchRefresh af $ modifyContentDir dest $ do+		, adjustedBranchRefresh $ modifyContentDir dest $ do 			liftIO $ moveFile src dest 			-- Freeze the object file now that it is in place. 			-- Waiting until now to freeze it allows for freeze@@ -539,7 +539,7 @@ 				Database.Keys.addInodeCaches key 					(catMaybes (destic:ics)) 		)-	alreadyhave = liftIO $ R.removeLink src+	alreadyhave = liftIO $ removeFile src  checkSecureHashes :: Key -> Annex (Maybe String) checkSecureHashes key = ifM (Backend.isCryptographicallySecureKey key)@@ -562,7 +562,7 @@  {- Populates the annex object file by hard linking or copying a source  - file to it. -}-linkToAnnex :: Key -> RawFilePath -> Maybe InodeCache -> Annex LinkAnnexResult+linkToAnnex :: Key -> OsPath -> Maybe InodeCache -> Annex LinkAnnexResult linkToAnnex key src srcic = ifM (checkSecureHashes' key) 	( do 		dest <- calcRepo (gitAnnexLocation key)@@ -579,13 +579,13 @@  - afterwards. Note that a consequence of this is that, if the file  - already exists, it will be overwritten.  -}-linkFromAnnex :: Key -> RawFilePath -> Maybe FileMode -> Annex LinkAnnexResult+linkFromAnnex :: Key -> OsPath -> Maybe FileMode -> Annex LinkAnnexResult linkFromAnnex key dest destmode =-	replaceFile' (const noop) (fromRawFilePath dest) (== LinkAnnexOk) $ \tmp ->+	replaceFile' (const noop) dest (== LinkAnnexOk) $ \tmp -> 		linkFromAnnex' key tmp destmode  {- This is only safe to use when dest is not a worktree file. -}-linkFromAnnex' :: Key -> RawFilePath -> Maybe FileMode -> Annex LinkAnnexResult+linkFromAnnex' :: Key -> OsPath -> Maybe FileMode -> Annex LinkAnnexResult linkFromAnnex' key dest destmode = do 	src <- calcRepo (gitAnnexLocation key) 	srcic <- withTSDelta (liftIO . genInodeCache src)@@ -605,7 +605,7 @@  -  - Nothing is done if the destination file already exists.  -}-linkAnnex :: FromTo -> Key -> RawFilePath -> Maybe InodeCache -> RawFilePath -> Maybe FileMode -> Annex LinkAnnexResult+linkAnnex :: FromTo -> Key -> OsPath -> Maybe InodeCache -> OsPath -> Maybe FileMode -> Annex LinkAnnexResult linkAnnex _ _ _ Nothing _ _ = return LinkAnnexFailed linkAnnex fromto key src (Just srcic) dest destmode = 	withTSDelta (liftIO . genInodeCache dest) >>= \case@@ -635,7 +635,7 @@ 				catMaybes [destic, Just srcic] 			return LinkAnnexOk 		_ -> do-			liftIO $ removeWhenExistsWith R.removeLink dest+			liftIO $ removeWhenExistsWith removeFile dest 			failed  {- Removes the annex object file for a key. Lowlevel. -}@@ -644,7 +644,7 @@ 	obj <- calcRepo (gitAnnexLocation key) 	modifyContentDir obj $ do 		secureErase obj-		liftIO $ removeWhenExistsWith R.removeLink obj+		liftIO $ removeWhenExistsWith removeFile obj  {- Runs an action to transfer an object's content. The action is also  - passed the size of the object.@@ -653,7 +653,7 @@  - If this happens, runs the rollback action and throws an exception.  - The rollback action should remove the data that was transferred.  -}-sendAnnex :: Key -> Maybe FilePath -> Annex () -> (FilePath -> FileSize -> Annex a) -> Annex a+sendAnnex :: Key -> Maybe OsPath -> Annex () -> (OsPath -> FileSize -> Annex a) -> Annex a sendAnnex key o rollback sendobject = go =<< prepSendAnnex' key o   where 	go (Just (f, sz, check)) = do@@ -676,10 +676,10 @@  - Annex monad of the remote that is receiving the object, rather than  - the sender. So it cannot rely on Annex state.  -}-prepSendAnnex :: Key -> Maybe FilePath -> Annex (Maybe (FilePath, FileSize, Annex Bool))+prepSendAnnex :: Key -> Maybe OsPath -> Annex (Maybe (OsPath, FileSize, Annex Bool)) prepSendAnnex key Nothing = withObjectLoc key $ \f -> do 	let retval c cs = return $ Just -		( fromRawFilePath f+		( f 		, inodeCacheFileSize c 		, sameInodeCache f cs 		)@@ -704,19 +704,18 @@ 			Nothing -> return Nothing -- If the provided object file is the annex object file, handle as above. prepSendAnnex key (Just o) = withObjectLoc key $ \aof ->-	let o' = toRawFilePath o-	in if aof == o'+	if aof == o 		then prepSendAnnex key Nothing 		else do-			withTSDelta (liftIO . genInodeCache o') >>= \case+			withTSDelta (liftIO . genInodeCache o) >>= \case 				Nothing -> return Nothing 				Just c -> return $ Just 					( o 					, inodeCacheFileSize c-					, sameInodeCache o' [c]+					, sameInodeCache o [c] 					) -prepSendAnnex' :: Key -> Maybe FilePath -> Annex (Maybe (FilePath, FileSize, Annex (Maybe String)))+prepSendAnnex' :: Key -> Maybe OsPath -> Annex (Maybe (OsPath, FileSize, Annex (Maybe String))) prepSendAnnex' key o = prepSendAnnex key o >>= \case 	Just (f, sz, checksuccess) ->  		let checksuccess' = ifM checksuccess@@ -750,7 +749,7 @@  -   - Does nothing if the object directory is not empty, and does not  - throw an exception if it's unable to remove a directory. -}-cleanObjectDirs :: RawFilePath -> Annex ()+cleanObjectDirs :: OsPath -> Annex () cleanObjectDirs f = do 	HashLevels n <- objectHashLevels <$> Annex.getGitConfig 	liftIO $ go f (succ n)@@ -760,14 +759,14 @@ 		let dir = parentDir file 		maybe noop (const $ go dir (n-1)) 			<=< catchMaybeIO $ tryWhenExists $-				removeDirectory (fromRawFilePath dir)+				removeDirectory dir  {- Removes a key's file from .git/annex/objects/ -} removeAnnex :: ContentRemovalLock -> Annex () removeAnnex (ContentRemovalLock key) = withObjectLoc key $ \file -> 	cleanObjectLoc key $ do 		secureErase file-		liftIO $ removeWhenExistsWith R.removeLink file+		liftIO $ removeWhenExistsWith removeFile file 		g <- Annex.gitRepo  		mapM_ (\f -> void $ tryIO $ resetpointer $ fromTopFilePath f g) 			=<< Database.Keys.getAssociatedFiles key@@ -775,9 +774,9 @@   where 	-- Check associated pointer file for modifications, and reset if 	-- it's unmodified.-	resetpointer file = unlessM (liftIO $ isSymbolicLink <$> R.getSymbolicLinkStatus file) $+	resetpointer file = unlessM (liftIO $ isSymbolicLink <$> R.getSymbolicLinkStatus (fromOsPath file)) $ 		ifM (isUnmodified key file)-			( adjustedBranchRefresh (AssociatedFile (Just file)) $+			( adjustedBranchRefresh $  				depopulatePointerFile key file 			-- Modified file, so leave it alone. 			-- If it was a hard link to the annex object,@@ -788,11 +787,11 @@  {- Moves a key out of .git/annex/objects/ into .git/annex/bad, and  - returns the file it was moved to. -}-moveBad :: Key -> Annex RawFilePath+moveBad :: Key -> Annex OsPath moveBad key = do 	src <- calcRepo (gitAnnexLocation key) 	bad <- fromRepo gitAnnexBadDir-	let dest = bad P.</> P.takeFileName src+	let dest = bad </> takeFileName src 	createAnnexDirectory (parentDir dest) 	cleanObjectLoc key $ 		liftIO $ moveFile src dest@@ -817,7 +816,7 @@ 	s <- Annex.getState id 	r <- Annex.getRead id 	depth <- gitAnnexLocationDepth <$> Annex.getGitConfig-	liftIO $ walk (s, r) depth (fromRawFilePath dir)+	liftIO $ walk (s, r) depth dir   where 	walk s depth dir = do 		contents <- catchDefaultIO [] (dirContents dir)@@ -825,7 +824,7 @@ 			then do 				contents' <- filterM present contents 				keys <- filterM (Annex.eval s . want) $-					mapMaybe (fileKey . P.takeFileName . toRawFilePath) contents'+					mapMaybe (fileKey . takeFileName) contents' 				continue keys [] 			else do 				let deeper = walk s (depth - 1)@@ -843,7 +842,7 @@ 	present _ | inanywhere = pure True 	present d = presentInAnnex d -	presentInAnnex = doesFileExist . contentfile+	presentInAnnex = doesPathExist . contentfile 	contentfile d = d </> takeFileName d  {- Things to do to record changes to content when shutting down.@@ -867,11 +866,11 @@  - Otherwise, only displays one error message, from one of the urls  - that failed.  -}-downloadUrl :: Bool -> Key -> MeterUpdate -> Maybe IncrementalVerifier -> [Url.URLString] -> FilePath -> Url.UrlOptions -> Annex Bool+downloadUrl :: Bool -> Key -> MeterUpdate -> Maybe IncrementalVerifier -> [Url.URLString] -> OsPath -> Url.UrlOptions -> Annex Bool downloadUrl listfailedurls k p iv urls file uo =  	-- Poll the file to handle configurations where an external 	-- download command is used.-	meteredFile (toRawFilePath file) (Just p) k (go urls [])+	meteredFile file (Just p) k (go urls [])   where 	go (u:us) errs p' = Url.download' p' iv u file uo >>= \case 		Right () -> return True@@ -897,18 +896,18 @@  {- Copies a key's content, when present, to a temp file.  - This is used to speed up some rsyncs. -}-preseedTmp :: Key -> FilePath -> Annex Bool+preseedTmp :: Key -> OsPath -> Annex Bool preseedTmp key file = go =<< inAnnex key   where 	go False = return False 	go True = do 		ok <- copy-		when ok $ thawContent (toRawFilePath file)+		when ok $ thawContent file 		return ok 	copy = ifM (liftIO $ doesFileExist file) 		( return True 		, do-			s <- fromRawFilePath <$> (calcRepo $ gitAnnexLocation key)+			s <- calcRepo $ gitAnnexLocation key 			liftIO $ ifM (doesFileExist s) 				( copyFileExternal CopyTimeStamps s file 				, return False@@ -917,15 +916,15 @@  {- Finds files directly inside a directory like gitAnnexBadDir   - (not in subdirectories) and returns the corresponding keys. -}-dirKeys :: (Git.Repo -> RawFilePath) -> Annex [Key]+dirKeys :: (Git.Repo -> OsPath) -> Annex [Key] dirKeys dirspec = do-	dir <- fromRawFilePath <$> fromRepo dirspec+	dir <- fromRepo dirspec 	ifM (liftIO $ doesDirectoryExist dir) 		( do 			contents <- liftIO $ getDirectoryContents dir 			files <- liftIO $ filterM doesFileExist $ 				map (dir </>) contents-			return $ mapMaybe (fileKey . P.takeFileName . toRawFilePath) files+			return $ mapMaybe (fileKey . takeFileName) files 		, return [] 		) @@ -935,7 +934,7 @@  - Also, stale keys that can be proven to have no value  - (ie, their content is already present) are deleted.  -}-staleKeysPrune :: (Git.Repo -> RawFilePath) -> Bool -> Annex [Key]+staleKeysPrune :: (Git.Repo -> OsPath) -> Bool -> Annex [Key] staleKeysPrune dirspec nottransferred = do 	contents <- dirKeys dirspec 	@@ -944,8 +943,8 @@  	dir <- fromRepo dirspec 	forM_ dups $ \k ->-		pruneTmpWorkDirBefore (dir P.</> keyFile k)-			(liftIO . R.removeLink)+		pruneTmpWorkDirBefore (dir </> keyFile k)+			(liftIO . removeFile)  	if nottransferred 		then do@@ -960,9 +959,9 @@  - This preserves the invariant that the workdir never exists without  - the content file.  -}-pruneTmpWorkDirBefore :: RawFilePath -> (RawFilePath -> Annex a) -> Annex a+pruneTmpWorkDirBefore :: OsPath -> (OsPath -> Annex a) -> Annex a pruneTmpWorkDirBefore f action = do-	let workdir = fromRawFilePath $ gitAnnexTmpWorkDir f+	let workdir = gitAnnexTmpWorkDir f 	liftIO $ whenM (doesDirectoryExist workdir) $ 		removeDirectoryRecursive workdir 	action f@@ -977,22 +976,21 @@  - the temporary work directory is retained (unless  - empty), so anything in it can be used on resume.  -}-withTmpWorkDir :: Key -> (RawFilePath -> Annex (Maybe a)) -> Annex (Maybe a)+withTmpWorkDir :: Key -> (OsPath -> Annex (Maybe a)) -> Annex (Maybe a) withTmpWorkDir key action = do 	-- Create the object file if it does not exist. This way, 	-- staleKeysPrune only has to look for object files, and can 	-- clean up gitAnnexTmpWorkDir for those it finds. 	obj <- prepTmp key-	let obj' = fromRawFilePath obj-	unlessM (liftIO $ doesFileExist obj') $ do-		liftIO $ writeFile obj' ""+	unlessM (liftIO $ doesFileExist obj) $ do+		liftIO $ writeFile (fromOsPath obj) "" 		setAnnexFilePerm obj 	let tmpdir = gitAnnexTmpWorkDir obj 	createAnnexDirectory tmpdir 	res <- action tmpdir 	case res of-		Just _ -> liftIO $ removeDirectoryRecursive (fromRawFilePath tmpdir)-		Nothing -> liftIO $ void $ tryIO $ removeDirectory (fromRawFilePath tmpdir)+		Just _ -> liftIO $ removeDirectoryRecursive tmpdir+		Nothing -> liftIO $ void $ tryIO $ removeDirectory tmpdir 	return res  {- Finds items in the first, smaller list, that are not@@ -1027,12 +1025,12 @@ getKeyStatus key = catchDefaultIO KeyMissing $ do 	afs <- not . null <$> Database.Keys.getAssociatedFiles key 	obj <- calcRepo (gitAnnexLocation key)-	multilink <- ((> 1) . linkCount <$> liftIO (R.getFileStatus obj))+	multilink <- ((> 1) . linkCount <$> liftIO (R.getFileStatus (fromOsPath obj))) 	return $ if multilink && afs 		then KeyUnlockedThin 		else KeyPresent -getKeyFileStatus :: Key -> RawFilePath -> Annex KeyStatus+getKeyFileStatus :: Key -> OsPath -> Annex KeyStatus getKeyFileStatus key file = do 	s <- getKeyStatus key 	case s of@@ -1070,23 +1068,22 @@  - timestamp. The file is written atomically, so when it contained an  - earlier timestamp, a reader will always see one or the other timestamp.  -}-writeContentRetentionTimestamp :: Key -> RawFilePath -> POSIXTime -> Annex ()+writeContentRetentionTimestamp :: Key -> OsPath -> POSIXTime -> Annex () writeContentRetentionTimestamp key rt t = do 	lckfile <- calcRepo (gitAnnexContentRetentionTimestampLock key) 	modifyContentDirWhenExists lckfile $ bracket (lock lckfile) unlock $ \_ -> 		readContentRetentionTimestamp rt >>= \case 			Just ts | ts >= t -> return ()-			_ -> replaceFile (const noop) (fromRawFilePath rt) $ \tmp ->-				liftIO $ writeFile (fromRawFilePath tmp) $ show t+			_ -> replaceFile (const noop) rt $ \tmp ->+				liftIO $ writeFile (fromOsPath tmp) $ show t   where 	lock = takeExclusiveLock 	unlock = liftIO . dropLock  {- Does not need locking because the file is written atomically. -}-readContentRetentionTimestamp :: RawFilePath -> Annex (Maybe POSIXTime)+readContentRetentionTimestamp :: OsPath -> Annex (Maybe POSIXTime) readContentRetentionTimestamp rt =-	liftIO $ join <$> tryWhenExists -		(parsePOSIXTime <$> readFile (fromRawFilePath rt))+	liftIO $ join <$> tryWhenExists (parsePOSIXTime <$> F.readFile' rt)  {- Checks if the retention timestamp is in the future, if so returns  - Nothing.@@ -1117,8 +1114,8 @@ {- Remove the retention timestamp and its lock file. Another lock must  - be held, that prevents anything else writing to the file at the same  - time. -}-removeRetentionTimeStamp :: Key -> RawFilePath -> Annex ()+removeRetentionTimeStamp :: Key -> OsPath -> Annex () removeRetentionTimeStamp key rt = modifyContentDirWhenExists rt $ do-	liftIO $ removeWhenExistsWith R.removeLink rt+	liftIO $ removeWhenExistsWith removeFile rt 	rtl <- calcRepo (gitAnnexContentRetentionTimestampLock key)-	liftIO $ removeWhenExistsWith R.removeLink rtl+	liftIO $ removeWhenExistsWith removeFile rtl
Annex/Content/LowLevel.hs view
@@ -19,13 +19,12 @@ import Utility.CopyFile import qualified Utility.RawFilePath as R -import qualified System.FilePath.ByteString as P import System.PosixCompat.Files (linkCount)  {- Runs the secure erase command if set, otherwise does nothing.  - File may or may not be deleted at the end; caller is responsible for  - making sure it's deleted. -}-secureErase :: RawFilePath -> Annex ()+secureErase :: OsPath -> Annex () secureErase = void . runAnnexPathHook "%file" 	secureEraseAnnexHook annexSecureEraseCommand @@ -44,45 +43,48 @@  - execute bit will be set. The mode is not fully copied over because  - git doesn't support file modes beyond execute.  -}-linkOrCopy :: Key -> RawFilePath -> RawFilePath -> Maybe FileMode -> Annex (Maybe LinkedOrCopied)+linkOrCopy :: Key -> OsPath -> OsPath -> Maybe FileMode -> Annex (Maybe LinkedOrCopied) linkOrCopy = linkOrCopy' (annexThin <$> Annex.getGitConfig) -linkOrCopy' :: Annex Bool -> Key -> RawFilePath -> RawFilePath -> Maybe FileMode -> Annex (Maybe LinkedOrCopied)+linkOrCopy' :: Annex Bool -> Key -> OsPath -> OsPath -> Maybe FileMode -> Annex (Maybe LinkedOrCopied) linkOrCopy' canhardlink key src dest destmode = catchDefaultIO Nothing $ 	ifM canhardlink-		( hardlink+		( hardlinkorcopy 		, copy =<< getstat 		)   where-	hardlink = do+	hardlinkorcopy = do 		s <- getstat 		if linkCount s > 1 			then copy s-			else liftIO (R.createLink src dest >> preserveGitMode dest destmode >> return (Just Linked))-				`catchIO` const (copy s)+			else hardlink `catchIO` const (copy s)+	hardlink = liftIO $ do+		R.createLink (fromOsPath src) (fromOsPath dest)+		void $ preserveGitMode dest destmode+		return (Just Linked) 	copy s = ifM (checkedCopyFile' key src dest destmode s) 		( return (Just Copied) 		, return Nothing 		)-	getstat = liftIO $ R.getFileStatus src+	getstat = liftIO $ R.getFileStatus (fromOsPath src)  {- Checks disk space before copying. -}-checkedCopyFile :: Key -> RawFilePath -> RawFilePath -> Maybe FileMode -> Annex Bool+checkedCopyFile :: Key -> OsPath -> OsPath -> Maybe FileMode -> Annex Bool checkedCopyFile key src dest destmode = catchBoolIO $ 	checkedCopyFile' key src dest destmode-		=<< liftIO (R.getFileStatus src)+		=<< liftIO (R.getFileStatus (fromOsPath src)) -checkedCopyFile' :: Key -> RawFilePath -> RawFilePath -> Maybe FileMode -> FileStatus -> Annex Bool+checkedCopyFile' :: Key -> OsPath -> OsPath -> Maybe FileMode -> FileStatus -> Annex Bool checkedCopyFile' key src dest destmode s = catchBoolIO $ do 	sz <- liftIO $ getFileSize' src s-	ifM (checkDiskSpace' sz (Just $ P.takeDirectory dest) key 0 True)+	ifM (checkDiskSpace' sz (Just $ takeDirectory dest) key 0 True) 		( liftIO $-			copyFileExternal CopyAllMetaData (fromRawFilePath src) (fromRawFilePath dest)+			copyFileExternal CopyAllMetaData src dest 				<&&> preserveGitMode dest destmode 		, return False 		) -preserveGitMode :: RawFilePath -> Maybe FileMode -> IO Bool+preserveGitMode :: OsPath -> Maybe FileMode -> IO Bool preserveGitMode f (Just mode) 	| isExecutable mode = catchBoolIO $ do 		modifyFileMode f $ addModes executeModes@@ -100,12 +102,12 @@  - to be downloaded from the free space. This way, we avoid overcommitting  - when doing concurrent downloads.  -}-checkDiskSpace :: Maybe FileSize -> Maybe RawFilePath -> Key -> Integer -> Bool -> Annex Bool+checkDiskSpace :: Maybe FileSize -> Maybe OsPath -> Key -> Integer -> Bool -> Annex Bool checkDiskSpace msz destdir key = checkDiskSpace' sz destdir key   where 	sz = fromMaybe 1 (fromKey keySize key <|> msz) -checkDiskSpace' :: FileSize -> Maybe RawFilePath -> Key -> Integer -> Bool -> Annex Bool+checkDiskSpace' :: FileSize -> Maybe OsPath -> Key -> Integer -> Bool -> Annex Bool checkDiskSpace' sz destdir key alreadythere samefilesystem = ifM (Annex.getRead Annex.force) 	( return True 	, do@@ -118,7 +120,7 @@ 		inprogress <- if samefilesystem 			then sizeOfDownloadsInProgress (/= key) 			else pure 0-		dir >>= liftIO . getDiskFree . fromRawFilePath >>= \case+		dir >>= liftIO . getDiskFree . fromOsPath >>= \case 			Just have -> do 				reserve <- annexDiskReserve <$> Annex.getGitConfig 				let delta = sz + reserve - have - alreadythere + inprogress
Annex/Content/PointerFile.hs view
@@ -30,14 +30,14 @@  -  - Returns an InodeCache if it populated the pointer file.  -}-populatePointerFile :: Restage -> Key -> RawFilePath -> RawFilePath -> Annex (Maybe InodeCache)+populatePointerFile :: Restage -> Key -> OsPath -> OsPath -> Annex (Maybe InodeCache) populatePointerFile restage k obj f = go =<< liftIO (isPointerFile f)   where 	go (Just k') | k == k' = do-		let f' = fromRawFilePath f-		destmode <- liftIO $ catchMaybeIO $ fileMode <$> R.getFileStatus f-		liftIO $ removeWhenExistsWith R.removeLink f-		(ic, populated) <- replaceWorkTreeFile f' $ \tmp -> do+		destmode <- liftIO $ catchMaybeIO $+			fileMode <$> R.getFileStatus (fromOsPath f)+		liftIO $ removeWhenExistsWith removeFile f+		(ic, populated) <- replaceWorkTreeFile f $ \tmp -> do 			ok <- linkOrCopy k obj tmp destmode >>= \case 				Just _ -> thawContent tmp >> return True 				Nothing -> liftIO (writePointerFile tmp k destmode) >> return False@@ -48,23 +48,23 @@ 			then return ic 			else return Nothing 	go _ = return Nothing-	+ {- Removes the content from a pointer file, replacing it with a pointer.  -  - Does not check if the pointer file is modified. -}-depopulatePointerFile :: Key -> RawFilePath -> Annex ()+depopulatePointerFile :: Key -> OsPath -> Annex () depopulatePointerFile key file = do-	st <- liftIO $ catchMaybeIO $ R.getFileStatus file+	st <- liftIO $ catchMaybeIO $ R.getFileStatus (fromOsPath file) 	let mode = fmap fileMode st 	secureErase file-	liftIO $ removeWhenExistsWith R.removeLink file-	ic <- replaceWorkTreeFile (fromRawFilePath file) $ \tmp -> do+	liftIO $ removeWhenExistsWith removeFile file+	ic <- replaceWorkTreeFile file $ \tmp -> do 		liftIO $ writePointerFile tmp key mode #if ! defined(mingw32_HOST_OS) 		-- Don't advance mtime; this avoids unnecessary re-smudging 		-- by git in some cases. 		liftIO $ maybe noop-			(\t -> touch tmp t False)+			(\t -> touch (fromOsPath tmp) t False) 			(fmap Posix.modificationTimeHiRes st) #endif 		withTSDelta (liftIO . genInodeCache tmp)
Annex/Content/Presence.hs view
@@ -33,7 +33,6 @@ import qualified Database.Keys import Annex.InodeSentinal import Utility.InodeCache-import qualified Utility.RawFilePath as R import qualified Git import Config @@ -41,18 +40,16 @@ import Annex.Perms #endif -import qualified System.FilePath.ByteString as P- {- Checks if a given key's content is currently present. -} inAnnex :: Key -> Annex Bool-inAnnex key = inAnnexCheck key $ liftIO . R.doesPathExist+inAnnex key = inAnnexCheck key $ liftIO . doesPathExist  {- Runs an arbitrary check on a key's content. -}-inAnnexCheck :: Key -> (RawFilePath -> Annex Bool) -> Annex Bool+inAnnexCheck :: Key -> (OsPath -> Annex Bool) -> Annex Bool inAnnexCheck key check = inAnnex' id False check key  {- inAnnex that performs an arbitrary check of the key's content. -}-inAnnex' :: (a -> Bool) -> a -> (RawFilePath -> Annex a) -> Key -> Annex a+inAnnex' :: (a -> Bool) -> a -> (OsPath -> Annex a) -> Key -> Annex a inAnnex' isgood bad check key = withObjectLoc key $ \loc -> do 	r <- check loc 	if isgood r@@ -75,7 +72,7 @@ objectFileExists :: Key -> Annex Bool objectFileExists key = 	calcRepo (gitAnnexLocation key)-		>>= liftIO . R.doesPathExist+		>>= liftIO . doesFileExist  {- A safer check; the key's content must not only be present, but  - is not in the process of being removed. -}@@ -93,7 +90,7 @@ 	{- The content file must exist, but the lock file generally 	 - won't exist unless a removal is in process. -} 	checklock (Just lockfile) contentfile =-		ifM (liftIO $ doesFileExist (fromRawFilePath contentfile))+		ifM (liftIO $ doesFileExist contentfile) 			( checkOr is_unlocked lockfile 			, return is_missing 			)@@ -102,7 +99,7 @@ 		Just True -> is_locked 		Just False -> is_unlocked #else-	checklock Nothing contentfile = liftIO $ ifM (doesFileExist (fromRawFilePath contentfile))+	checklock Nothing contentfile = liftIO $ ifM (doesFileExist contentfile) 		( lockShared contentfile >>= \case 			Nothing -> return is_locked 			Just lockhandle -> do@@ -113,13 +110,13 @@ 	{- In Windows, see if we can take a shared lock. If so,  	 - remove the lock file to clean up after ourselves. -} 	checklock (Just lockfile) contentfile =-		ifM (liftIO $ doesFileExist (fromRawFilePath contentfile))+		ifM (liftIO $ doesFileExist contentfile) 			( modifyContentDir lockfile $ liftIO $ 				lockShared lockfile >>= \case 					Nothing -> return is_locked 					Just lockhandle -> do 						dropLock lockhandle-						void $ tryIO $ removeWhenExistsWith R.removeLink lockfile+						void $ tryIO $ removeWhenExistsWith removeFile lockfile 						return is_unlocked 			, return is_missing 			)@@ -134,7 +131,7 @@  - content locking works, from running at the same time as content is locked  - using the old method.  -}-withContentLockFile :: Key -> (Maybe RawFilePath -> Annex a) -> Annex a+withContentLockFile :: Key -> (Maybe OsPath -> Annex a) -> Annex a withContentLockFile k a = do 	v <- getVersion 	if versionNeedsWritableContentFiles v@@ -146,7 +143,7 @@ 			 - will switch over to v10 content lock files at the 			 - right time. -} 			gitdir <- fromRepo Git.localGitDir-			let gitconfig = gitdir P.</> "config"+			let gitconfig = gitdir </> literalOsPath "config" 			ic <- withTSDelta (liftIO . genInodeCache gitconfig) 			oldic <- Annex.getState Annex.gitconfiginodecache 			v' <- if fromMaybe False (compareStrong <$> ic <*> oldic)@@ -161,7 +158,7 @@   where 	go v = contentLockFile k v >>= a -contentLockFile :: Key -> Maybe RepoVersion -> Annex (Maybe RawFilePath)+contentLockFile :: Key -> Maybe RepoVersion -> Annex (Maybe OsPath) #ifndef mingw32_HOST_OS {- Older versions of git-annex locked content files themselves, but newer  - versions use a separate lock file, to better support repos shared@@ -177,7 +174,7 @@ #endif  {- Performs an action, passing it the location to use for a key's content. -}-withObjectLoc :: Key -> (RawFilePath -> Annex a) -> Annex a+withObjectLoc :: Key -> (OsPath -> Annex a) -> Annex a withObjectLoc key a = a =<< calcRepo (gitAnnexLocation key)  {- Check if a file contains the unmodified content of the key.@@ -185,7 +182,7 @@  - The expensive way to tell is to do a verification of its content.  - The cheaper way is to see if the InodeCache for the key matches the  - file. -}-isUnmodified :: Key -> RawFilePath -> Annex Bool+isUnmodified :: Key -> OsPath -> Annex Bool isUnmodified key f =  	withTSDelta (liftIO . genInodeCache f) >>= \case 		Just fc -> do@@ -193,7 +190,7 @@ 			isUnmodified' key f fc ic 		Nothing -> return False -isUnmodified' :: Key -> RawFilePath -> InodeCache -> [InodeCache] -> Annex Bool+isUnmodified' :: Key -> OsPath -> InodeCache -> [InodeCache] -> Annex Bool isUnmodified' = isUnmodifiedLowLevel Database.Keys.addInodeCaches  {- Cheap check if a file contains the unmodified content of the key,@@ -206,7 +203,7 @@  - this may report a false positive when repeated edits are made to a file  - within a small time window (eg 1 second).  -}-isUnmodifiedCheap :: Key -> RawFilePath -> Annex Bool+isUnmodifiedCheap :: Key -> OsPath -> Annex Bool isUnmodifiedCheap key f = maybe (pure False) (isUnmodifiedCheap' key)  	=<< withTSDelta (liftIO . genInodeCache f)
Annex/Content/Presence/LowLevel.hs view
@@ -12,7 +12,7 @@ import Annex.InodeSentinal import Utility.InodeCache -isUnmodifiedLowLevel :: (Key -> [InodeCache] -> Annex ()) -> Key -> RawFilePath -> InodeCache -> [InodeCache] -> Annex Bool+isUnmodifiedLowLevel :: (Key -> [InodeCache] -> Annex ()) -> Key -> OsPath -> InodeCache -> [InodeCache] -> Annex Bool isUnmodifiedLowLevel addinodecaches key f fc ic = 	isUnmodifiedCheapLowLevel fc ic <||> expensivecheck   where
Annex/CopyFile.hs view
@@ -15,6 +15,7 @@ import Utility.FileMode import Utility.Touch import Utility.Hash (IncrementalVerifier(..))+import qualified Utility.FileIO as F import qualified Utility.RawFilePath as R  import Control.Concurrent@@ -34,7 +35,7 @@  - The destination file must not exist yet (or may exist but be empty),   - or it will fail to make a CoW copy, and will return false.  -}-tryCopyCoW :: CopyCoWTried -> FilePath -> FilePath -> MeterUpdate -> IO Bool+tryCopyCoW :: CopyCoWTried -> OsPath -> OsPath -> MeterUpdate -> IO Bool tryCopyCoW (CopyCoWTried copycowtried) src dest meterupdate = 	-- If multiple threads reach this at the same time, they 	-- will both try CoW, which is acceptable.@@ -57,19 +58,17 @@ 			) 		)   where-	docopycow = watchFileSize dest' meterupdate $ const $+	docopycow = watchFileSize dest meterupdate $ const $ 		copyCoW CopyTimeStamps src dest-	-	dest' = toRawFilePath dest  	-- Check if the dest file already exists, which would prevent 	-- probing CoW. If the file exists but is empty, there's no benefit 	-- to resuming from it when CoW does not work, so remove it. 	destfilealreadypopulated = -		tryIO (R.getFileStatus dest') >>= \case+		tryIO (R.getFileStatus (fromOsPath dest)) >>= \case 			Left _ -> return False 			Right st -> do-				sz <- getFileSize' dest' st+				sz <- getFileSize' dest st 				if sz == 0 					then tryIO (removeFile dest) >>= \case 						Right () -> return False@@ -95,7 +94,7 @@  - (eg when isStableKey is false), and doing this avoids getting a  - corrupted file in such cases.  -}-fileCopier :: CopyCoWTried -> FilePath -> FilePath -> MeterUpdate -> Maybe IncrementalVerifier -> IO CopyMethod+fileCopier :: CopyCoWTried -> OsPath -> OsPath -> MeterUpdate -> Maybe IncrementalVerifier -> IO CopyMethod #ifdef mingw32_HOST_OS fileCopier _ src dest meterupdate iv = docopy #else@@ -111,27 +110,26 @@ 	docopy = do 		-- The file might have had the write bit removed, 		-- so make sure we can write to it.-		void $ tryIO $ allowWrite dest'+		void $ tryIO $ allowWrite dest -		withBinaryFile src ReadMode $ \hsrc ->+		F.withBinaryFile src ReadMode $ \hsrc -> 			fileContentCopier hsrc dest meterupdate iv 		 		-- Copy src mode and mtime.-		mode <- fileMode <$> R.getFileStatus (toRawFilePath src)+		mode <- fileMode <$> R.getFileStatus (fromOsPath src) 		mtime <- utcTimeToPOSIXSeconds <$> getModificationTime src+		let dest' = fromOsPath dest 		R.setFileMode dest' mode 		touch dest' mtime False  		return Copied-	-	dest' = toRawFilePath dest  {- Copies content from a handle to a destination file. Does not  - use copy-on-write, and does not copy file mode and mtime.  -}-fileContentCopier :: Handle -> FilePath -> MeterUpdate -> Maybe IncrementalVerifier -> IO ()+fileContentCopier :: Handle -> OsPath -> MeterUpdate -> Maybe IncrementalVerifier -> IO () fileContentCopier hsrc dest meterupdate iv =-	withBinaryFile dest ReadWriteMode $ \hdest -> do+	F.withBinaryFile dest ReadWriteMode $ \hdest -> do 		sofar <- compareexisting hdest zeroBytesProcessed 		docopy hdest sofar   where
Annex/DirHashes.hs view
@@ -23,7 +23,6 @@ import qualified Data.ByteArray as BA import qualified Data.ByteArray.Encoding as BA import qualified Data.ByteString as S-import qualified System.FilePath.ByteString as P  import Common import Key@@ -32,7 +31,7 @@ import Utility.Hash import Utility.MD5 -type Hasher = Key -> RawFilePath+type Hasher = Key -> OsPath  -- Number of hash levels to use. 2 is the default. newtype HashLevels = HashLevels Int@@ -51,7 +50,7 @@ 	| hasDifference d (annexDifferences config) = HashLevels 1 	| otherwise = def -branchHashDir :: GitConfig -> Key -> S.ByteString+branchHashDir :: GitConfig -> Key -> OsPath branchHashDir = hashDirLower . branchHashLevels  {- Two different directory hashes may be used. The mixed case hash@@ -64,9 +63,10 @@ dirHashes :: NE.NonEmpty (HashLevels -> Hasher) dirHashes = hashDirLower NE.:| [hashDirMixed] -hashDirs :: HashLevels -> Int -> S.ByteString -> RawFilePath-hashDirs (HashLevels 1) sz s = P.addTrailingPathSeparator $ S.take sz s-hashDirs _ sz s = P.addTrailingPathSeparator $ h P.</> t+hashDirs :: HashLevels -> Int -> S.ByteString -> OsPath+hashDirs (HashLevels 1) sz s = addTrailingPathSeparator $+	toOsPath (S.take sz s)+hashDirs _ sz s = addTrailingPathSeparator $ toOsPath h </> toOsPath t   where 	(h, t) = S.splitAt sz s
Annex/Drop.hs view
@@ -108,7 +108,7 @@ 					[ "dropped" 					, case afile of 						AssociatedFile Nothing -> serializeKey key-						AssociatedFile (Just af) -> fromRawFilePath af+						AssociatedFile (Just af) -> fromOsPath af 					, "(from " ++ maybe "here" show u ++ ")" 					, "(copies now " ++ show (have - 1) ++ ")" 					, ": " ++ reason
Annex/Export.hs view
@@ -11,16 +11,13 @@  import Annex import Annex.CatFile+import Annex.GitShaKey import Types-import Types.Key import qualified Git import qualified Types.Remote as Remote import Git.Quote import Messages -import Data.Maybe-import qualified Data.ByteString.Short as S (fromShort, toShort)- -- From a sha pointing to the content of a file to the key -- to use to export it. When the file is annexed, it's the annexed key. -- When the file is stored in git, it's a special type of key to indicate@@ -30,31 +27,6 @@   where 	mk (Just k) = k 	mk Nothing = gitShaKey sha---- Encodes a git sha as a key. This is used to represent a non-annexed--- file that is stored on a special remote, which necessarily needs a--- key.------ This is not the same as a SHA1 key, because the mapping needs to be--- bijective, also because git may not always use SHA1, and because git--- takes a SHA1 of the file size + content, while git-annex SHA1 keys--- only checksum the content.-gitShaKey :: Git.Sha -> Key-gitShaKey (Git.Ref s) = mkKey $ \kd -> kd-	{ keyName = S.toShort s-	, keyVariety = OtherKey "GIT"-	}---- Reverse of gitShaKey-keyGitSha :: Key -> Maybe Git.Sha-keyGitSha k-	| fromKey keyVariety k == OtherKey "GIT" =-		Just (Git.Ref (S.fromShort (fromKey keyName k)))-	| otherwise = Nothing---- Is a key storing a git sha, and not used for an annexed file?-isGitShaKey :: Key -> Bool-isGitShaKey = isJust . keyGitSha  warnExportImportConflict :: Remote -> Annex () warnExportImportConflict r = do
Annex/ExternalAddonProcess.hs view
@@ -85,9 +85,9 @@  	runerr (Just cmd) = 		return $ Left $ ProgramFailure $-			"Cannot run " ++ cmd ++ " -- Make sure it's executable and that its dependencies are installed."+			"Cannot run " ++ fromOsPath cmd ++ " -- Make sure it's executable and that its dependencies are installed." 	runerr Nothing = do-		path <- intercalate ":" <$> getSearchPath+		path <- intercalate ":" . map fromOsPath <$> getSearchPath 		return $ Left $ ProgramNotInstalled $ 			"Cannot run " ++ basecmd ++ " -- It is not installed in PATH (" ++ path ++ ")"
Annex/FileMatcher.hs view
@@ -5,6 +5,7 @@  - Licensed under the GNU AGPL version 3 or higher.  -} +{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE CPP #-}  module Annex.FileMatcher (@@ -56,14 +57,14 @@ import qualified Data.Set as S import Control.Monad.Writer -type GetFileMatcher = RawFilePath -> Annex (FileMatcher Annex)+type GetFileMatcher = OsPath -> Annex (FileMatcher Annex) -checkFileMatcher :: LiveUpdate -> GetFileMatcher -> RawFilePath -> Annex Bool+checkFileMatcher :: LiveUpdate -> GetFileMatcher -> OsPath -> Annex Bool checkFileMatcher lu getmatcher file = 	checkFileMatcher' lu getmatcher file (return True)  -- | Allows running an action when no matcher is configured for the file.-checkFileMatcher' :: LiveUpdate -> GetFileMatcher -> RawFilePath -> Annex Bool -> Annex Bool+checkFileMatcher' :: LiveUpdate -> GetFileMatcher -> OsPath -> Annex Bool -> Annex Bool checkFileMatcher' lu getmatcher file notconfigured = do 	matcher <- getmatcher file 	checkMatcher matcher Nothing afile lu S.empty notconfigured d@@ -120,7 +121,7 @@ 					fromMaybe mempty descmsg <> UnquotedString s 				return False -fileMatchInfo :: RawFilePath -> Maybe Key -> Annex MatchInfo+fileMatchInfo :: OsPath -> Maybe Key -> Annex MatchInfo fileMatchInfo file mkey = do 	matchfile <- getTopFilePath <$> inRepo (toTopFilePath file) 	return $ MatchingFile FileInfo@@ -160,7 +161,7 @@ tokenizeMatcher :: String -> [String] tokenizeMatcher = filter (not . null) . concatMap splitparens . words   where-	splitparens = segmentDelim (`elem` "()")+	splitparens = segmentDelim (`elem` ("()" :: String))  commonTokens :: LimitBy -> [ParseToken (MatchFiles Annex)] commonTokens lb =@@ -201,7 +202,7 @@ 	, ValueToken "fullysizebalanced" (usev $ limitFullySizeBalanced (repoUUID pcd) (getGroupMap pcd)) 	] ++ commonTokens LimitAnnexFiles   where-	preferreddir = maybe "public" fromProposedAccepted $+	preferreddir = toOsPath $ maybe "public" fromProposedAccepted $ 		M.lookup preferreddirField =<< (`M.lookup` configMap pcd) =<< repoUUID pcd  preferredContentParser :: [ParseToken (MatchFiles Annex)] -> String -> [ParseResult (MatchFiles Annex)]
Annex/Fixup.hs view
@@ -18,9 +18,11 @@ import Utility.Directory import Utility.Exception import Utility.Monad-import Utility.FileSystemEncoding+import Utility.SystemDirectory+import Utility.OsPath import qualified Utility.RawFilePath as R import Utility.PartialPrelude+import qualified Utility.OsString as OS  import System.IO import Data.List@@ -28,8 +30,6 @@ import Control.Monad import Control.Monad.IfElse import qualified Data.Map as M-import qualified Data.ByteString as S-import System.FilePath.ByteString import Control.Applicative import Prelude @@ -108,28 +108,29 @@ 		, return r 		)   where-	dotgit = w </> ".git"+	dotgit = w </> literalOsPath ".git" -	replacedotgit = whenM (doesFileExist (fromRawFilePath dotgit)) $ do+	replacedotgit = whenM (doesFileExist dotgit) $ do 		linktarget <- relPathDirToFile w d-		removeWhenExistsWith R.removeLink dotgit-		R.createSymbolicLink linktarget dotgit+		removeWhenExistsWith removeFile dotgit+		R.createSymbolicLink (fromOsPath linktarget) (fromOsPath dotgit) 	 	-- Unsetting a config fails if it's not set, so ignore failure. 	unsetcoreworktree = void $ Git.Config.unset "core.worktree" r 	-	worktreefixup =+	worktreefixup = do 		-- git-worktree sets up a "commondir" file that contains 		-- the path to the main git directory. 		-- Using --separate-git-dir does not.-		catchDefaultIO Nothing (headMaybe . lines <$> readFile (fromRawFilePath (d </> "commondir"))) >>= \case+		let commondirfile = fromOsPath (d </> literalOsPath "commondir")+		catchDefaultIO Nothing (headMaybe . lines <$> readFile commondirfile) >>= \case 			Just gd -> do 				-- Make the worktree's git directory 				-- contain an annex symlink to the main 				-- repository's annex directory.-				let linktarget = toRawFilePath gd </> "annex"-				R.createSymbolicLink linktarget-					(dotgit </> "annex")+				let linktarget = toOsPath gd </> literalOsPath "annex"+				R.createSymbolicLink (fromOsPath linktarget) $+					fromOsPath $ dotgit </> literalOsPath "annex" 			Nothing -> return ()  	-- Repo adjusted, so that symlinks to objects that get checked@@ -142,7 +143,7 @@  needsSubmoduleFixup :: Repo -> Bool needsSubmoduleFixup (Repo { location = (Local { worktree = Just _, gitdir = d }) }) =-	(".git" </> "modules") `S.isInfixOf` d+	(literalOsPath ".git" </> literalOsPath "modules") `OS.isInfixOf` d needsSubmoduleFixup _ = False  needsGitLinkFixup :: Repo -> IO Bool@@ -150,6 +151,6 @@ 	-- Optimization: Avoid statting .git in the common case; only 	-- when the gitdir is not in the usual place inside the worktree 	-- might .git be a file.-	| wt </> ".git" == d = return False-	| otherwise = doesFileExist (fromRawFilePath (wt </> ".git"))+	| wt </> literalOsPath ".git" == d = return False+	| otherwise = doesFileExist (wt </> literalOsPath ".git") needsGitLinkFixup _ = return False
Annex/GitOverlay.hs view
@@ -23,7 +23,7 @@ import Config.Smudge  {- Runs an action using a different git index file. -}-withIndexFile :: AltIndexFile -> (FilePath -> Annex a) -> Annex a+withIndexFile :: AltIndexFile -> (OsPath -> Annex a) -> Annex a withIndexFile i = withAltRepo usecachedgitenv restoregitenv   where 	-- This is an optimisation. Since withIndexFile is run repeatedly,@@ -58,7 +58,7 @@ 		f <- indexEnvVal $ case i of 			AnnexIndexFile -> gitAnnexIndex g 			ViewIndexFile -> gitAnnexViewIndex g-		g' <- addGitEnv g indexEnv f+		g' <- addGitEnv g indexEnv (fromOsPath f) 		return (g', f) 	 	restoregitenv g g' = g' { gitEnv = gitEnv g }@@ -66,13 +66,13 @@ {- Runs an action using a different git work tree.  -  - Smudge and clean filters are disabled in this work tree. -}-withWorkTree :: FilePath -> Annex a -> Annex a+withWorkTree :: OsPath -> Annex a -> Annex a withWorkTree d a = withAltRepo 	(\g -> return $ (g { location = modlocation (location g), gitGlobalOpts = gitGlobalOpts g ++ bypassSmudgeConfig }, ())) 	(\g g' -> g' { location = location g, gitGlobalOpts = gitGlobalOpts g }) 	(const a)   where-	modlocation l@(Local {}) = l { worktree = Just (toRawFilePath d) }+	modlocation l@(Local {}) = l { worktree = Just d } 	modlocation _ = giveup "withWorkTree of non-local git repo"  {- Runs an action with the git index file and HEAD, and a few other@@ -83,13 +83,13 @@  -  - Needs git 2.2.0 or newer.  -}-withWorkTreeRelated :: FilePath -> Annex a -> Annex a+withWorkTreeRelated :: OsPath -> Annex a -> Annex a withWorkTreeRelated d a = withAltRepo modrepo unmodrepo (const a)   where 	modrepo g = liftIO $ do-		g' <- addGitEnv g "GIT_COMMON_DIR" . fromRawFilePath+		g' <- addGitEnv g "GIT_COMMON_DIR" . fromOsPath 			=<< absPath (localGitDir g)-		g'' <- addGitEnv g' "GIT_DIR" d+		g'' <- addGitEnv g' "GIT_DIR" (fromOsPath d) 		return (g'' { gitEnvOverridesGitDir = True }, ()) 	unmodrepo g g' = g' 		{ gitEnv = gitEnv g
+ Annex/GitShaKey.hs view
@@ -0,0 +1,41 @@+{- Encoding a git sha as a Key+ -+ - Copyright 2017-2025 Joey Hess <id@joeyh.name>+ -+ - Licensed under the GNU AGPL version 3 or higher.+ -}++{-# LANGUAGE OverloadedStrings #-}++module Annex.GitShaKey where++import Types+import Types.Key+import qualified Git++import Data.Maybe+import qualified Data.ByteString.Short as S (fromShort, toShort)++-- Encodes a git sha as a Key. This is used to represent a non-annexed+-- file. For example, when storing a git sha on a special remote.+--+-- This is not the same as a SHA1 key, because the mapping needs to be+-- bijective, also because git may not always use SHA1, and because git+-- takes a SHA1 of the file size + content, while git-annex SHA1 keys+-- only checksum the content.+gitShaKey :: Git.Sha -> Key+gitShaKey (Git.Ref s) = mkKey $ \kd -> kd+	{ keyName = S.toShort s+	, keyVariety = OtherKey "GIT"+	}++-- Reverse of gitShaKey+keyGitSha :: Key -> Maybe Git.Sha+keyGitSha k+	| fromKey keyVariety k == OtherKey "GIT" =+		Just (Git.Ref (S.fromShort (fromKey keyName k)))+	| otherwise = Nothing++-- Is a key storing a git sha, and not used for an annexed file?+isGitShaKey :: Key -> Bool+isGitShaKey = isJust . keyGitSha
Annex/HashObject.hs view
@@ -28,7 +28,7 @@ 		liftIO $ freeResourcePool p Git.HashObject.hashObjectStop 		Annex.changeState $ \s -> s { Annex.hashobjecthandle = Nothing } -hashFile :: RawFilePath -> Annex Sha+hashFile :: OsPath -> Annex Sha hashFile f = withHashObjectHandle $ \h ->  	liftIO $ Git.HashObject.hashFile h f
Annex/Hook.hs view
@@ -9,6 +9,8 @@  - Licensed under the GNU AGPL version 3 or higher.  -} +{-# LANGUAGE OverloadedStrings #-}+ module Annex.Hook where  import Annex.Common@@ -19,10 +21,11 @@ import qualified Data.Map as M  preCommitHook :: Git.Hook-preCommitHook = Git.Hook "pre-commit" (mkHookScript "git annex pre-commit .") []+preCommitHook = Git.Hook (literalOsPath "pre-commit")+	(mkHookScript "git annex pre-commit .") []  postReceiveHook :: Git.Hook-postReceiveHook = Git.Hook "post-receive"+postReceiveHook = Git.Hook (literalOsPath "post-receive") 	-- Only run git-annex post-receive when git-annex supports it, 	-- to avoid failing if the repository with this hook is used 	-- with an older version of git-annex.@@ -32,10 +35,10 @@ 	]  postCheckoutHook :: Git.Hook-postCheckoutHook = Git.Hook "post-checkout" smudgeHook []+postCheckoutHook = Git.Hook (literalOsPath "post-checkout") smudgeHook []  postMergeHook :: Git.Hook-postMergeHook = Git.Hook "post-merge" smudgeHook []+postMergeHook = Git.Hook (literalOsPath "post-merge") smudgeHook []  -- Older versions of git-annex didn't support this command, but neither did -- they support v7 repositories.@@ -43,28 +46,28 @@ smudgeHook = mkHookScript "git annex smudge --update"  preCommitAnnexHook :: Git.Hook-preCommitAnnexHook = Git.Hook "pre-commit-annex" "" []+preCommitAnnexHook = Git.Hook (literalOsPath "pre-commit-annex") "" []  postUpdateAnnexHook :: Git.Hook-postUpdateAnnexHook = Git.Hook "post-update-annex" "" []+postUpdateAnnexHook = Git.Hook (literalOsPath "post-update-annex") "" []  preInitAnnexHook :: Git.Hook-preInitAnnexHook = Git.Hook "pre-init-annex" "" []+preInitAnnexHook = Git.Hook (literalOsPath "pre-init-annex") "" []  freezeContentAnnexHook :: Git.Hook-freezeContentAnnexHook = Git.Hook "freezecontent-annex" "" []+freezeContentAnnexHook = Git.Hook (literalOsPath "freezecontent-annex") "" []  thawContentAnnexHook :: Git.Hook-thawContentAnnexHook = Git.Hook "thawcontent-annex" "" []+thawContentAnnexHook = Git.Hook (literalOsPath "thawcontent-annex") "" []  secureEraseAnnexHook :: Git.Hook-secureEraseAnnexHook = Git.Hook "secure-erase-annex" "" []+secureEraseAnnexHook = Git.Hook (literalOsPath "secure-erase-annex") "" []  commitMessageAnnexHook :: Git.Hook-commitMessageAnnexHook = Git.Hook "commitmessage-annex" "" []+commitMessageAnnexHook = Git.Hook (literalOsPath "commitmessage-annex") "" []  httpHeadersAnnexHook :: Git.Hook-httpHeadersAnnexHook = Git.Hook "http-headers-annex" "" []+httpHeadersAnnexHook = Git.Hook (literalOsPath "http-headers-annex") "" []  mkHookScript :: String -> String mkHookScript s = unlines@@ -85,7 +88,8 @@ hookWarning h msg = do 	r <- gitRepo 	warning $ UnquotedString $-		Git.hookName h ++ " hook (" ++ Git.hookFile h r ++ ") " ++ msg+		fromOsPath (Git.hookName h) ++ +			" hook (" ++ fromOsPath (Git.hookFile h r) ++ ") " ++ msg  {- To avoid checking if the hook exists every time, the existing hooks  - are cached. -}@@ -118,7 +122,7 @@ 		( return Nothing 		, do 			h <- fromRepo (Git.hookFile hook)-			commandfailed h+			commandfailed (fromOsPath h) 		) 	runcommandcfg = commandcfg <$> Annex.getGitConfig >>= \case 		Nothing -> return Nothing@@ -129,18 +133,19 @@ 				) 	commandfailed c = return $ Just c -runAnnexPathHook :: String -> Git.Hook -> (GitConfig -> Maybe String) -> RawFilePath -> Annex Bool+runAnnexPathHook :: String -> Git.Hook -> (GitConfig -> Maybe String) -> OsPath -> Annex Bool runAnnexPathHook pathtoken hook commandcfg p = ifM (doesAnnexHookExist hook) 	( runhook 	, runcommandcfg 	)   where-	runhook = inRepo $ Git.runHook boolSystem hook [ File (fromRawFilePath p) ]+	runhook = inRepo $ Git.runHook boolSystem hook [ File p' ] 	runcommandcfg = commandcfg <$> Annex.getGitConfig >>= \case 		Nothing -> return True 		Just basecmd -> liftIO $ 			boolSystem "sh" [Param "-c", Param $ gencmd basecmd]-	gencmd = massReplace [ (pathtoken, shellEscape (fromRawFilePath p)) ]+	gencmd = massReplace [ (pathtoken, shellEscape p') ]+	p' = fromOsPath p  outputOfAnnexHook :: Git.Hook -> (GitConfig -> Maybe String) -> Annex (Maybe String) outputOfAnnexHook hook commandcfg = ifM (doesAnnexHookExist hook)
Annex/Import.hs view
@@ -6,6 +6,7 @@  -}  {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE CPP #-}  module Annex.Import ( 	ImportTreeConfig(..),@@ -37,12 +38,12 @@ import Annex.Link import Annex.LockFile import Annex.Content-import Annex.Export import Annex.RemoteTrackingBranch import Annex.HashObject import Annex.Transfer import Annex.CheckIgnore import Annex.CatFile+import Annex.GitShaKey import Annex.VectorClock import Annex.SpecialRemote.Config import Command@@ -68,9 +69,10 @@ import Control.Concurrent.STM import qualified Data.Map.Strict as M import qualified Data.Set as S-import qualified System.FilePath.Posix.ByteString as Posix-import qualified System.FilePath.ByteString as P import qualified Data.ByteArray.Encoding as BA+#ifdef mingw32_HOST_OS+import qualified System.FilePath.Posix as Posix+#endif  {- Configures how to build an import tree. -} data ImportTreeConfig@@ -154,7 +156,7 @@ 				let subtreeref = Ref $ 					fromRef' finaltree 						<> ":"-						<> getTopFilePath dir+						<> fromOsPath (getTopFilePath dir) 				in fromMaybe emptyTree 					<$> inRepo (Git.Ref.tree subtreeref) 		updateexportdb importedtree@@ -349,11 +351,11 @@ 	lf = fromImportLocation loc 	treepath = asTopFilePath lf 	topf = asTopFilePath $-		maybe lf (\sd -> getTopFilePath sd P.</> lf) msubdir+		maybe lf (\sd -> getTopFilePath sd </> lf) msubdir 	mklink k = do 		relf <- fromRepo $ fromTopFilePath topf 		symlink <- calcRepo $ gitAnnexLink relf k-		linksha <- hashSymlink symlink+		linksha <- hashSymlink (fromOsPath symlink) 		return $ TreeItem treepath (fromTreeItemType TreeSymlink) linksha 	mkpointer k = TreeItem treepath (fromTreeItemType TreeFile) 		<$> hashPointerFile k@@ -429,7 +431,12 @@ 		-- Full directory prefix where the sub tree is located. 		let fullprefix = asTopFilePath $ case msubdir of 			Nothing -> subdir-			Just d -> getTopFilePath d Posix.</> subdir+			Just d ->+#ifdef mingw32_HOST_OS+				toOsPath $ fromOsPath (getTopFilePath d) Posix.</> fromOsPath subdir+#else+				getTopFilePath d </> subdir+#endif 		Tree ts <- converttree (Just fullprefix) $ 			map (\(p, i) -> (mkImportLocation p, i)) 				(importableContentsSubTree c)@@ -853,10 +860,10 @@ 			let af = AssociatedFile (Just f) 			let downloader p' tmpfile = do 				_ <- Remote.retrieveExportWithContentIdentifier-					ia loc [cid] (fromRawFilePath tmpfile)+					ia loc [cid] tmpfile 					(Left k) 					(combineMeterUpdate p' p)-				ok <- moveAnnex k af tmpfile+				ok <- moveAnnex k tmpfile 				when ok $ 					logStatus NoLiveUpdate k InfoPresent 				return (Just (k, ok))@@ -871,7 +878,7 @@ 	doimportsmall cidmap loc cid sz p = do 		let downloader tmpfile = do 			(k, _) <- Remote.retrieveExportWithContentIdentifier-				ia loc [cid] (fromRawFilePath tmpfile)+				ia loc [cid] tmpfile 				(Right (mkkey tmpfile)) 				p 			case keyGitSha k of@@ -894,12 +901,12 @@ 		let af = AssociatedFile (Just f) 		let downloader tmpfile p = do 			(k, _) <- Remote.retrieveExportWithContentIdentifier-				ia loc [cid] (fromRawFilePath tmpfile)+				ia loc [cid] tmpfile 				(Right (mkkey tmpfile)) 				p 			case keyGitSha k of 				Nothing -> do-					ok <- moveAnnex k af tmpfile+					ok <- moveAnnex k tmpfile 					when ok $ do 						recordcidkey cidmap cid k 						logStatus NoLiveUpdate k InfoPresent@@ -950,7 +957,7 @@ 		case importtreeconfig of 			ImportTree -> fromImportLocation loc 			ImportSubTree subdir _ ->-				getTopFilePath subdir P.</> fromImportLocation loc+				getTopFilePath subdir </> fromImportLocation loc  	getcidkey cidmap db cid = liftIO $ 		-- Avoiding querying the database when it's empty speeds up@@ -1091,7 +1098,11 @@ 			isknown <||> (matches <&&> notignored) 	  where 		-- Checks, from least to most expensive.-		ingitdir = ".git" `elem` Posix.splitDirectories (fromImportLocation loc)+#ifdef mingw32_HOST_OS+		ingitdir = ".git" `elem` Posix.splitDirectories (fromOsPath (fromImportLocation loc))+#else+		ingitdir = literalOsPath ".git" `elem` splitDirectories (fromImportLocation loc)+#endif 		matches = matchesImportLocation matcher loc sz 		isknown = isKnownImportLocation dbhandle loc 		notignored = notIgnoredImportLocation importtreeconfig ci loc@@ -1120,6 +1131,6 @@   where 	f = case importtreeconfig of 		ImportSubTree dir _ ->-			getTopFilePath dir P.</> fromImportLocation loc+			getTopFilePath dir </> fromImportLocation loc 		ImportTree -> 			fromImportLocation loc
Annex/Ingest.hs view
@@ -66,7 +66,7 @@ data LockDownConfig = LockDownConfig 	{ lockingFile :: Bool 	-- ^ write bit removed during lock down-	, hardlinkFileTmpDir :: Maybe RawFilePath+	, hardlinkFileTmpDir :: Maybe OsPath 	-- ^ hard link to temp directory 	, checkWritePerms :: Bool 	-- ^ check that write perms are successfully removed@@ -87,13 +87,13 @@  - Lockdown can fail if a file gets deleted, or if it's unable to remove  - write permissions, and Nothing will be returned.  -}-lockDown :: LockDownConfig-> FilePath -> Annex (Maybe LockedDown)+lockDown :: LockDownConfig-> OsPath -> Annex (Maybe LockedDown) lockDown cfg file = either  		(\e -> warning (UnquotedString (show e)) >> return Nothing) 		(return . Just) 	=<< lockDown' cfg file -lockDown' :: LockDownConfig -> FilePath -> Annex (Either SomeException LockedDown)+lockDown' :: LockDownConfig -> OsPath -> Annex (Either SomeException LockedDown) lockDown' cfg file = tryNonAsync $ ifM crippledFileSystem 	( nohardlink 	, case hardlinkFileTmpDir cfg of@@ -101,48 +101,46 @@ 		Just tmpdir -> withhardlink tmpdir 	)   where-	file' = toRawFilePath file- 	nohardlink = do 		setperms 		withTSDelta $ liftIO . nohardlink'  	nohardlink' delta = do-		cache <- genInodeCache file' delta+		cache <- genInodeCache file delta 		return $ LockedDown cfg $ KeySource-			{ keyFilename = file'-			, contentLocation = file'+			{ keyFilename = file+			, contentLocation = file 			, inodeCache = cache 			} 	 	withhardlink tmpdir = do 		setperms 		withTSDelta $ \delta -> liftIO $ do-			(tmpfile, h) <- openTmpFileIn (fromRawFilePath tmpdir) $-				relatedTemplate $ "ingest-" ++ takeFileName file+			(tmpfile, h) <- openTmpFileIn tmpdir $+				relatedTemplate $ fromOsPath $+					literalOsPath "ingest-" <> takeFileName file 			hClose h-			removeWhenExistsWith R.removeLink (toRawFilePath tmpfile)+			removeWhenExistsWith removeFile tmpfile 			withhardlink' delta tmpfile 				`catchIO` const (nohardlink' delta)  	withhardlink' delta tmpfile = do-		let tmpfile' = toRawFilePath tmpfile-		R.createLink file' tmpfile'-		cache <- genInodeCache tmpfile' delta+		R.createLink (fromOsPath file) (fromOsPath tmpfile)+		cache <- genInodeCache tmpfile delta 		return $ LockedDown cfg $ KeySource-			{ keyFilename = file'-			, contentLocation = tmpfile'+			{ keyFilename = file+			, contentLocation = tmpfile 			, inodeCache = cache 			} 		 	setperms = when (lockingFile cfg) $ do-		freezeContent file'+		freezeContent file 		when (checkWritePerms cfg) $ do 			qp <- coreQuotePath <$> Annex.getGitConfig 			maybe noop (giveup . decodeBS . quote qp)-				=<< checkLockedDownWritePerms file' file'+				=<< checkLockedDownWritePerms file file -checkLockedDownWritePerms :: RawFilePath -> RawFilePath -> Annex (Maybe StringContainingQuotedPath)+checkLockedDownWritePerms :: OsPath -> OsPath -> Annex (Maybe StringContainingQuotedPath) checkLockedDownWritePerms file displayfile = checkContentWritePerm file >>= return . \case 	Just False -> Just $ "Unable to remove all write permissions from " 		<> QuotedPath displayfile@@ -166,7 +164,8 @@ 				then addSymlink f k mic 				else do 					mode <- liftIO $ catchMaybeIO $-						fileMode <$> R.getFileStatus (contentLocation source)+						fileMode <$> R.getFileStatus+							(fromOsPath (contentLocation source)) 					stagePointerFile f mode =<< hashPointerFile k 			return (Just k) @@ -187,7 +186,7 @@ 			fst <$> genKey source meterupdate backend 		Just k -> return k 	let src = contentLocation source-	ms <- liftIO $ catchMaybeIO $ R.getFileStatus src+	ms <- liftIO $ catchMaybeIO $ R.getFileStatus (fromOsPath src) 	mcache <- maybe (pure Nothing) (liftIO . toInodeCache delta src) ms 	case (mcache, inodeCache source) of 		(_, Nothing) -> go k mcache@@ -199,17 +198,11 @@ 		| otherwise = gounlocked key mcache  	golocked key mcache =-		tryNonAsync (moveAnnex key naf (contentLocation source)) >>= \case+		tryNonAsync (moveAnnex key (contentLocation source)) >>= \case 			Right True -> success key mcache 			Right False -> giveup "failed to add content to annex" 			Left e -> restoreFile (keyFilename source) key e -	-- moveAnnex uses the AssociatedFile provided to it to unlock-	-- locked files when getting a file in an adjusted branch.-	-- That case does not apply here, where we're adding an unlocked-	-- file, so provide it nothing.-	naf = AssociatedFile Nothing- 	gounlocked key (Just cache) = do 		-- Remove temp directory hard link first because 		-- linkToAnnex falls back to copying if a file@@ -262,12 +255,12 @@  cleanCruft :: KeySource -> Annex () cleanCruft source = when (contentLocation source /= keyFilename source) $-	liftIO $ removeWhenExistsWith R.removeLink $ contentLocation source+	liftIO $ removeWhenExistsWith removeFile $ contentLocation source  -- If a worktree file was was hard linked to an annex object before, -- modifying the file would have caused the object to have the wrong -- content. Clean up from that.-cleanOldKeys :: RawFilePath -> Key -> Annex ()+cleanOldKeys :: OsPath -> Key -> Annex () cleanOldKeys file newkey = do 	g <- Annex.gitRepo 	topf <- inRepo (toTopFilePath file)@@ -292,39 +285,38 @@  {- On error, put the file back so it doesn't seem to have vanished.  - This can be called before or after the symlink is in place. -}-restoreFile :: RawFilePath -> Key -> SomeException -> Annex a+restoreFile :: OsPath -> Key -> SomeException -> Annex a restoreFile file key e = do 	whenM (inAnnex key) $ do-		liftIO $ removeWhenExistsWith R.removeLink file+		liftIO $ removeWhenExistsWith removeFile file 		-- The key could be used by other files too, so leave the 		-- content in the annex, and make a copy back to the file.-		obj <- fromRawFilePath <$> calcRepo (gitAnnexLocation key)-		unlessM (liftIO $ copyFileExternal CopyTimeStamps obj (fromRawFilePath file)) $-			warning $ "Unable to restore content of " <> QuotedPath file <> "; it should be located in " <> QuotedPath (toRawFilePath obj)+		obj <- calcRepo (gitAnnexLocation key)+		unlessM (liftIO $ copyFileExternal CopyTimeStamps obj file) $+			warning $ "Unable to restore content of " <> QuotedPath file <> "; it should be located in " <> QuotedPath obj 		thawContent file 	throwM e  {- Creates the symlink to the annexed content, returns the link target. -}-makeLink :: RawFilePath -> Key -> Maybe InodeCache -> Annex LinkTarget+makeLink :: OsPath -> Key -> Maybe InodeCache -> Annex LinkTarget makeLink file key mcache = flip catchNonAsync (restoreFile file key) $ do-	l <- calcRepo $ gitAnnexLink file key-	replaceWorkTreeFile file' $ makeAnnexLink l+	l <- fromOsPath <$> calcRepo (gitAnnexLink file key)+	replaceWorkTreeFile file $ makeAnnexLink l  	-- touch symlink to have same time as the original file, 	-- as provided in the InodeCache 	case mcache of-		Just c -> liftIO $ touch file (inodeCacheToMtime c) False+		Just c -> liftIO $+			touch (fromOsPath file) (inodeCacheToMtime c) False 		Nothing -> noop  	return l-  where-	file' = fromRawFilePath file  {- Creates the symlink to the annexed content, and stages it in git. -}-addSymlink :: RawFilePath -> Key -> Maybe InodeCache -> Annex ()+addSymlink :: OsPath -> Key -> Maybe InodeCache -> Annex () addSymlink file key mcache = stageSymlink file =<< genSymlink file key mcache -genSymlink :: RawFilePath -> Key -> Maybe InodeCache -> Annex Git.Sha+genSymlink :: OsPath -> Key -> Maybe InodeCache -> Annex Git.Sha genSymlink file key mcache = do 	linktarget <- makeLink file key mcache 	hashSymlink linktarget@@ -369,17 +361,17 @@  -  - When the content of the key is not accepted into the annex, returns False.  -}-addAnnexedFile :: AddUnlockedMatcher -> RawFilePath -> Key -> Maybe RawFilePath -> Annex Bool+addAnnexedFile :: AddUnlockedMatcher -> OsPath -> Key -> Maybe OsPath -> Annex Bool addAnnexedFile matcher file key mtmp = ifM (addUnlocked matcher mi (isJust mtmp)) 	( do 		mode <- maybe 			(pure Nothing)-			(\tmp -> liftIO $ catchMaybeIO $ fileMode <$> R.getFileStatus tmp)+			(\tmp -> liftIO $ catchMaybeIO $ fileMode <$> R.getFileStatus (fromOsPath tmp)) 			mtmp 		stagePointerFile file mode =<< hashPointerFile key 		Database.Keys.addAssociatedFile key =<< inRepo (toTopFilePath file) 		case mtmp of-			Just tmp -> ifM (moveAnnex key af tmp)+			Just tmp -> ifM (moveAnnex key tmp) 				( linkunlocked mode >> return True 				, writepointer mode >> return False 				)@@ -390,11 +382,10 @@ 	, do 		addSymlink file key Nothing 		case mtmp of-			Just tmp -> moveAnnex key af tmp+			Just tmp -> moveAnnex key tmp 			Nothing -> return True 	)   where-	af = AssociatedFile (Just file) 	mi = case mtmp of 		Just tmp -> MatchingFile $ FileInfo 			{ contentFile = tmp@@ -412,7 +403,7 @@ {- Use with actions that add an already existing annex symlink or pointer  - file. The warning avoids a confusing situation where the file got copied  - from another git-annex repo, probably by accident. -}-addingExistingLink :: RawFilePath -> Key -> Annex a -> Annex a+addingExistingLink :: OsPath -> Key -> Annex a -> Annex a addingExistingLink f k a = do 	unlessM (isKnownKey k <||> inAnnex k) $ do 		islink <- isJust <$> isAnnexLink f
Annex/Init.hs view
@@ -56,6 +56,7 @@ #ifndef mingw32_HOST_OS import Utility.ThreadScheduler import qualified Utility.RawFilePath as R+import qualified Utility.FileIO as F import Utility.FileMode import System.Posix.User import qualified Utility.LockFile.Posix as Posix@@ -66,7 +67,6 @@ #ifndef mingw32_HOST_OS import System.PosixCompat.Files (ownerReadMode, isNamedPipe) import Data.Either-import qualified System.FilePath.ByteString as P import Control.Concurrent.Async #endif @@ -99,21 +99,20 @@ 	Just _ -> return False  noAnnexFileContent' :: Annex (Maybe String)-noAnnexFileContent' = inRepo $-	noAnnexFileContent . fmap fromRawFilePath . Git.repoWorkTree+noAnnexFileContent' = inRepo $ noAnnexFileContent . Git.repoWorkTree  genDescription :: Maybe String -> Annex UUIDDesc genDescription (Just d) = return $ UUIDDesc $ encodeBS d genDescription Nothing = do-	reldir <- liftIO . relHome . fromRawFilePath+	reldir <- liftIO . relHome 		=<< liftIO . absPath 		=<< fromRepo Git.repoPath 	hostname <- fromMaybe "" <$> liftIO getHostname 	let at = if null hostname then "" else "@" 	v <- liftIO myUserName 	return $ UUIDDesc $ encodeBS $ concat $ case v of-		Right username -> [username, at, hostname, ":", reldir]-		Left _ -> [hostname, ":", reldir]+		Right username -> [username, at, hostname, ":", fromOsPath reldir]+		Left _ -> [hostname, ":", fromOsPath reldir]  initialize :: Annex () -> Maybe String -> Maybe RepoVersion -> Annex () initialize startupannex mdescription mversion = checkInitializeAllowed $ \initallowed -> do@@ -238,12 +237,12 @@  objectDirNotPresent :: Annex Bool objectDirNotPresent = do-	d <- fromRawFilePath <$> fromRepo gitAnnexObjectDir+	d <- fromRepo gitAnnexObjectDir 	exists <- liftIO $ doesDirectoryExist d 	when exists $ guardSafeToUseRepo $ 		giveup $ unwords $  			[ "This repository is not initialized for use"-			, "by git-annex, but " ++ d ++ " exists,"+			, "by git-annex, but " ++ fromOsPath d ++ " exists," 			, "which indicates this repository was used by" 			, "git-annex before, and may have lost its" 			, "annex.uuid and annex.version configs. Either"@@ -263,7 +262,7 @@ 			, "" 			-- This mirrors git's wording. 			, "To add an exception for this directory, call:"-			, "\tgit config --global --add safe.directory " ++ fromRawFilePath p+			, "\tgit config --global --add safe.directory " ++ fromOsPath p 			] 	, a 	)@@ -301,40 +300,39 @@  probeCrippledFileSystem' 	:: (MonadIO m, MonadCatch m)-	=> RawFilePath-	-> Maybe (RawFilePath -> m ())-	-> Maybe (RawFilePath -> m ())+	=> OsPath+	-> Maybe (OsPath -> m ())+	-> Maybe (OsPath -> m ()) 	-> Bool 	-> m (Bool, [String]) #ifdef mingw32_HOST_OS probeCrippledFileSystem' _ _ _ _ = return (True, []) #else probeCrippledFileSystem' tmp freezecontent thawcontent hasfreezehook = do-	let f = tmp P.</> "gaprobe"-	let f' = fromRawFilePath f-	liftIO $ writeFile f' ""-	r <- probe f'+	let f = tmp </> literalOsPath "gaprobe"+	liftIO $ F.writeFile' f ""+	r <- probe f 	void $ tryNonAsync $ (fromMaybe (liftIO . allowWrite) thawcontent) f-	liftIO $ removeFile f'+	liftIO $ removeFile f 	return r   where 	probe f = catchDefaultIO (True, []) $ do-		let f2 = f ++ "2"-		liftIO $ removeWhenExistsWith R.removeLink (toRawFilePath f2)-		liftIO $ R.createSymbolicLink (toRawFilePath f) (toRawFilePath f2)-		liftIO $ removeWhenExistsWith R.removeLink (toRawFilePath f2)-		(fromMaybe (liftIO . preventWrite) freezecontent) (toRawFilePath f)+		let f2 = f <> literalOsPath "2"+		liftIO $ removeWhenExistsWith removeFile f2+		liftIO $ R.createSymbolicLink (fromOsPath f) (fromOsPath f2)+		liftIO $ removeWhenExistsWith removeFile f2+		(fromMaybe (liftIO . preventWrite) freezecontent) f 		-- Should be unable to write to the file (unless 		-- running as root). But some crippled 		-- filesystems ignore write bit removals or ignore 		-- permissions entirely.-		ifM ((== Just False) <$> liftIO (checkContentWritePerm' UnShared (toRawFilePath f) Nothing hasfreezehook))+		ifM ((== Just False) <$> liftIO (checkContentWritePerm' UnShared f Nothing hasfreezehook)) 			( return (True, ["Filesystem does not allow removing write bit from files."]) 			, liftIO $ ifM ((== 0) <$> getRealUserID) 				( return (False, []) 				, do 					r <- catchBoolIO $ do-						writeFile f "2"+						F.writeFile' f "2" 						return True 					if r 						then return (True, ["Filesystem allows writing to files whose write bit is not set."])@@ -363,19 +361,19 @@ probeLockSupport = return True #else probeLockSupport = withEventuallyCleanedOtherTmp $ \tmp -> do-	let f = tmp P.</> "lockprobe"+	let f = tmp </> literalOsPath "lockprobe" 	mode <- annexFileMode 	annexrunner <- Annex.makeRunner 	liftIO $ withAsync (warnstall annexrunner) (const (go f mode))   where 	go f mode = do-		removeWhenExistsWith R.removeLink f+		removeWhenExistsWith removeFile f 		let locktest = bracket 			(Posix.lockExclusive (Just mode) f) 			Posix.dropLock 			(const noop) 		ok <- isRight <$> tryNonAsync locktest-		removeWhenExistsWith R.removeLink f+		removeWhenExistsWith removeFile f 		return ok 	 	warnstall annexrunner = do@@ -391,17 +389,17 @@ 	return False #else 	withEventuallyCleanedOtherTmp $ \tmp -> do-		let f = tmp P.</> "gaprobe"-		let f2 = tmp P.</> "gaprobe2"+		let f = tmp </> literalOsPath "gaprobe"+		let f2 = tmp </> literalOsPath "gaprobe2" 		liftIO $ do-			removeWhenExistsWith R.removeLink f-			removeWhenExistsWith R.removeLink f2+			removeWhenExistsWith removeFile f+			removeWhenExistsWith removeFile f2 			ms <- tryIO $ do-				R.createNamedPipe f ownerReadMode-				R.createLink f f2-				R.getFileStatus f-			removeWhenExistsWith R.removeLink f-			removeWhenExistsWith R.removeLink f2+				R.createNamedPipe (fromOsPath f) ownerReadMode+				R.createLink (fromOsPath f) (fromOsPath f2)+				R.getFileStatus (fromOsPath f)+			removeWhenExistsWith removeFile f+			removeWhenExistsWith removeFile f2 			return $ either (const False) isNamedPipe ms #endif @@ -473,14 +471,14 @@ 	-- could result in password prompts for http credentials, 	-- which would then not end up cached in this process's state. 	_ <- remotelist-	rp <- fromRawFilePath <$> fromRepo Git.repoPath+	rp <- fromRepo Git.repoPath 	withNullHandle $ \nullh -> gitAnnexChildProcess "init" 		[ Param "--autoenable" ] 		(\p -> p 			{ std_out = UseHandle nullh 			, std_err = UseHandle nullh 			, std_in = UseHandle nullh-			, cwd = Just rp+			, cwd = Just (fromOsPath rp) 			} 		) 		(\_ _ _ pid -> void $ waitForProcess pid)
Annex/InodeSentinal.hs view
@@ -15,7 +15,7 @@ import Utility.InodeCache import Annex.Perms -{- If the sendinal shows the inodes have changed, only the size and mtime+{- If the sentinal shows the inodes have changed, only the size and mtime  - are compared. -} compareInodeCaches :: InodeCache -> InodeCache -> Annex Bool compareInodeCaches x y@@ -30,22 +30,22 @@  {- Checks if one of the provided old InodeCache matches the current  - version of a file. -}-sameInodeCache :: RawFilePath -> [InodeCache] -> Annex Bool+sameInodeCache :: OsPath -> [InodeCache] -> Annex Bool sameInodeCache file [] = do 	fastDebug "Annex.InodeSentinal" $-		fromRawFilePath file ++ " inode cache empty"+		fromOsPath file ++ " inode cache empty" 	return False sameInodeCache file old = go =<< withTSDelta (liftIO . genInodeCache file)   where 	go Nothing = do 		fastDebug "Annex.InodeSentinal" $-			fromRawFilePath file ++ " not present, cannot compare with inode cache"+			fromOsPath file ++ " not present, cannot compare with inode cache" 		return False 	go (Just curr) = ifM (elemInodeCaches curr old) 		( return True 		, do 			fastDebug "Annex.InodeSentinal" $-				fromRawFilePath file ++ " (" ++ show curr ++ ") does not match inode cache (" ++ show old ++ ")"+				fromOsPath file ++ " (" ++ show curr ++ ") does not match inode cache (" ++ show old ++ ")" 			return False 		) @@ -99,7 +99,7 @@ 	alreadyexists = liftIO. sentinalFileExists =<< annexSentinalFile 	hasobjects 		| evenwithobjects = pure False-		| otherwise = liftIO . doesDirectoryExist . fromRawFilePath+		| otherwise = liftIO . doesDirectoryExist 			=<< fromRepo gitAnnexObjectDir  annexSentinalFile :: Annex SentinalFile
Annex/Journal.hs view
@@ -26,12 +26,12 @@ import Annex.BranchState import Types.BranchState import Utility.Directory.Stream-import qualified Utility.RawFilePath as R+import qualified Utility.FileIO as F+import qualified Utility.OsString as OS  import qualified Data.Set as S import qualified Data.ByteString.Lazy as L import qualified Data.ByteString as B-import qualified System.FilePath.ByteString as P import Data.ByteString.Builder import Data.Char @@ -82,7 +82,7 @@  - interrupted write truncating information that was earlier read from the  - file, and so losing data.  -}-setJournalFile :: Journalable content => JournalLocked -> RegardingUUID -> RawFilePath -> content -> Annex ()+setJournalFile :: Journalable content => JournalLocked -> RegardingUUID -> OsPath -> content -> Annex () setJournalFile _jl ru file content = withOtherTmp $ \tmp -> do 	st <- getState 	jd <- fromRepo =<< ifM (regardingPrivateUUID ru)@@ -91,10 +91,10 @@ 		) 	-- journal file is written atomically 	let jfile = journalFile file-	let tmpfile = tmp P.</> jfile-	liftIO $ withFile (fromRawFilePath tmpfile) WriteMode $ \h ->+	let tmpfile = tmp </> jfile+	liftIO $ F.withFile tmpfile WriteMode $ \h -> 		writeJournalHandle h content-	let dest = jd P.</> jfile+	let dest = jd </> jfile 	let mv = do 		liftIO $ moveFile tmpfile dest 		setAnnexFilePerm dest@@ -102,20 +102,20 @@ 	-- exists 	mv `catchIO` (const (createAnnexDirectory jd >> mv)) -newtype AppendableJournalFile = AppendableJournalFile (RawFilePath, RawFilePath)+newtype AppendableJournalFile = AppendableJournalFile (OsPath, OsPath)  {- If the journal file does not exist, it cannot be appended to, because  - that would overwrite whatever content the file has in the git-annex  - branch. -}-checkCanAppendJournalFile :: JournalLocked -> RegardingUUID -> RawFilePath -> Annex (Maybe AppendableJournalFile)+checkCanAppendJournalFile :: JournalLocked -> RegardingUUID -> OsPath -> Annex (Maybe AppendableJournalFile) checkCanAppendJournalFile _jl ru file = do 	st <- getState 	jd <- fromRepo =<< ifM (regardingPrivateUUID ru) 		( return (gitAnnexPrivateJournalDir st) 		, return (gitAnnexJournalDir st) 		)-	let jfile = jd P.</> journalFile file-	ifM (liftIO $ R.doesPathExist jfile)+	let jfile = jd </> journalFile file+	ifM (liftIO $ doesFileExist jfile) 		( return (Just (AppendableJournalFile (jd, jfile))) 		, return Nothing 		)@@ -133,7 +133,7 @@  -} appendJournalFile :: Journalable content => JournalLocked -> AppendableJournalFile -> content -> Annex () appendJournalFile _jl (AppendableJournalFile (jd, jfile)) content = do-	let write = liftIO $ withFile (fromRawFilePath jfile) ReadWriteMode $ \h -> do+	let write = liftIO $ F.withFile jfile ReadWriteMode $ \h -> do 		sz <- hFileSize h 		when (sz /= 0) $ do 			hSeek h SeekFromEnd (-1)@@ -160,7 +160,7 @@ 	-- information that were made after that journal file was written.  {- Gets any journalled content for a file in the branch. -}-getJournalFile :: JournalLocked -> GetPrivate -> RawFilePath -> Annex JournalledContent+getJournalFile :: JournalLocked -> GetPrivate -> OsPath -> Annex JournalledContent getJournalFile _jl = getJournalFileStale  data GetPrivate = GetPrivate Bool@@ -178,7 +178,7 @@  - (or is in progress when this is called), if the file content does not end  - with a newline, it is truncated back to the previous newline.  -}-getJournalFileStale :: GetPrivate -> RawFilePath -> Annex JournalledContent+getJournalFileStale :: GetPrivate -> OsPath -> Annex JournalledContent getJournalFileStale (GetPrivate getprivate) file = do 	st <- Annex.getState id 	let repo = Annex.repo st@@ -204,7 +204,7 @@ 	jfile = journalFile file 	getfrom d = catchMaybeIO $ 		discardIncompleteAppend . L.fromStrict-			<$> B.readFile (fromRawFilePath (d P.</> jfile))+			<$> F.readFile' (d </> jfile)  -- Note that this forces read of the whole lazy bytestring. discardIncompleteAppend :: L.ByteString -> L.ByteString@@ -223,18 +223,18 @@ {- List of existing journal files in a journal directory, but without locking,  - may miss new ones just being added, or may have false positives if the  - journal is staged as it is run. -}-getJournalledFilesStale :: (BranchState -> Git.Repo -> RawFilePath) -> Annex [RawFilePath]+getJournalledFilesStale :: (BranchState -> Git.Repo -> OsPath) -> Annex [OsPath] getJournalledFilesStale getjournaldir = do 	bs <- getState 	repo <- Annex.gitRepo 	let d = getjournaldir bs repo 	fs <- liftIO $ catchDefaultIO [] $ -		getDirectoryContents (fromRawFilePath d)-	return $ filter (`notElem` [".", ".."]) $-		map (fileJournal . toRawFilePath) fs+		getDirectoryContents d+	return $ filter (`notElem` dirCruft) $+		map fileJournal fs  {- Directory handle open on a journal directory. -}-withJournalHandle :: (BranchState -> Git.Repo -> RawFilePath) -> (DirectoryHandle -> IO a) -> Annex a+withJournalHandle :: (BranchState -> Git.Repo -> OsPath) -> (DirectoryHandle -> IO a) -> Annex a withJournalHandle getjournaldir a = do 	bs <- getState 	repo <- Annex.gitRepo@@ -243,17 +243,15 @@   where 	-- avoid overhead of creating the journal directory when it already 	-- exists-	opendir d = liftIO (openDirectory (fromRawFilePath d))+	opendir d = liftIO (openDirectory (fromOsPath d)) 		`catchIO` (const (createAnnexDirectory d >> opendir d))  {- Checks if there are changes in the journal. -}-journalDirty :: (BranchState -> Git.Repo -> RawFilePath) -> Annex Bool+journalDirty :: (BranchState -> Git.Repo -> OsPath) -> Annex Bool journalDirty getjournaldir = do 	st <- getState-	d <- fromRawFilePath <$> fromRepo (getjournaldir st)-	liftIO $ -		(not <$> isDirectoryEmpty d)-			`catchIO` (const $ doesDirectoryExist d)+	d <- fromRepo (getjournaldir st)+	liftIO $ isDirectoryPopulated (fromOsPath d)  {- Produces a filename to use in the journal for a file on the branch.  - The filename does not include the journal directory.@@ -262,33 +260,33 @@  - used in the branch is not necessary, and all the files are put directly  - in the journal directory.  -}-journalFile :: RawFilePath -> RawFilePath-journalFile file = B.concatMap mangle file+journalFile :: OsPath -> OsPath+journalFile file = OS.concat $ map mangle $ OS.unpack file   where 	mangle c-		| P.isPathSeparator c = B.singleton underscore-		| c == underscore = B.pack [underscore, underscore]-		| otherwise = B.singleton c-	underscore = fromIntegral (ord '_')+		| isPathSeparator c = OS.singleton underscore+		| c == underscore = OS.pack [underscore, underscore]+		| otherwise = OS.singleton c+	underscore = unsafeFromChar '_'  {- Converts a journal file (relative to the journal dir) back to the  - filename on the branch. -}-fileJournal :: RawFilePath -> RawFilePath+fileJournal :: OsPath -> OsPath fileJournal = go   where 	go b = -		let (h, t) = B.break (== underscore) b-		in h <> case B.uncons t of+		let (h, t) = OS.break (== underscore) b+		in h <> case OS.uncons t of 			Nothing -> t-			Just (_u, t') -> case B.uncons t' of+			Just (_u, t') -> case OS.uncons t' of 				Nothing -> t'			 				Just (w, t'') 					| w == underscore ->-						B.cons underscore (go t'')+						OS.cons underscore (go t'') 					| otherwise -> -						B.cons P.pathSeparator (go t')+						OS.cons pathSeparator (go t') 	-	underscore = fromIntegral (ord '_')+	underscore = unsafeFromChar '_'  {- Sentinal value, only produced by lockJournal; required  - as a parameter by things that need to ensure the journal is
Annex/Link.hs view
@@ -38,11 +38,12 @@ import Utility.CopyFile import qualified Database.Keys.Handle import qualified Utility.RawFilePath as R+import qualified Utility.FileIO as F+import qualified Utility.OsString as OS  import qualified Data.ByteString as S import qualified Data.ByteString.Char8 as S8 import qualified Data.ByteString.Lazy as L-import qualified System.FilePath.ByteString as P #ifndef mingw32_HOST_OS #if MIN_VERSION_unix(2,8,0) #else@@ -53,7 +54,7 @@ type LinkTarget = S.ByteString  {- Checks if a file is a link to a key. -}-isAnnexLink :: RawFilePath -> Annex (Maybe Key)+isAnnexLink :: OsPath -> Annex (Maybe Key) isAnnexLink file = maybe Nothing parseLinkTargetOrPointer <$> getAnnexLinkTarget file  {- Gets the link target of a symlink.@@ -64,13 +65,13 @@  - Returns Nothing if the file is not a symlink, or not a link to annex  - content.  -}-getAnnexLinkTarget :: RawFilePath -> Annex (Maybe LinkTarget)+getAnnexLinkTarget :: OsPath -> Annex (Maybe LinkTarget) getAnnexLinkTarget f = getAnnexLinkTarget' f 	=<< (coreSymlinks <$> Annex.getGitConfig)  {- Pass False to force looking inside file, for when git checks out  - symlinks as plain files. -}-getAnnexLinkTarget' :: RawFilePath -> Bool -> Annex (Maybe S.ByteString)+getAnnexLinkTarget' :: OsPath -> Bool -> Annex (Maybe LinkTarget) getAnnexLinkTarget' file coresymlinks = if coresymlinks 	then check probesymlink $ 		return Nothing@@ -85,9 +86,9 @@ 				| otherwise -> return Nothing 			Nothing -> fallback -	probesymlink = R.readSymbolicLink file+	probesymlink = R.readSymbolicLink (fromOsPath file) -	probefilecontent = withFile (fromRawFilePath file) ReadMode $ \h -> do+	probefilecontent = F.withFile file ReadMode $ \h -> do 		s <- S.hGet h maxSymlinkSz 		-- If we got the full amount, the file is too large 		-- to be a symlink target.@@ -102,7 +103,7 @@ 					then mempty 					else s -makeAnnexLink :: LinkTarget -> RawFilePath -> Annex ()+makeAnnexLink :: LinkTarget -> OsPath -> Annex () makeAnnexLink = makeGitLink  {- Creates a link on disk.@@ -112,26 +113,29 @@  - it's staged as such, so use addAnnexLink when adding a new file or  - modified link to git.  -}-makeGitLink :: LinkTarget -> RawFilePath -> Annex ()+makeGitLink :: LinkTarget -> OsPath -> Annex () makeGitLink linktarget file = ifM (coreSymlinks <$> Annex.getGitConfig) 	( liftIO $ do-		void $ tryIO $ R.removeLink file-		R.createSymbolicLink linktarget file-	, liftIO $ S.writeFile (fromRawFilePath file) linktarget+		void $ tryIO $ removeFile file+		R.createSymbolicLink linktarget (fromOsPath file)+	, liftIO $ F.writeFile' file linktarget 	)  {- Creates a link on disk, and additionally stages it in git. -}-addAnnexLink :: LinkTarget -> RawFilePath -> Annex ()+addAnnexLink :: LinkTarget -> OsPath -> Annex () addAnnexLink linktarget file = do 	makeAnnexLink linktarget file 	stageSymlink file =<< hashSymlink linktarget  {- Injects a symlink target into git, returning its Sha. -} hashSymlink :: LinkTarget -> Annex Sha-hashSymlink = hashBlob . toInternalGitPath+hashSymlink = go . fromOsPath . toInternalGitPath . toOsPath+  where+	go :: LinkTarget -> Annex Sha+	go = hashBlob  {- Stages a symlink to an annexed object, using a Sha of its target. -}-stageSymlink :: RawFilePath -> Sha -> Annex ()+stageSymlink :: OsPath -> Sha -> Annex () stageSymlink file sha = 	Annex.Queue.addUpdateIndex =<< 		inRepo (Git.UpdateIndex.stageSymlink file sha)@@ -141,7 +145,7 @@ hashPointerFile key = hashBlob $ formatPointer key  {- Stages a pointer file, using a Sha of its content -}-stagePointerFile :: RawFilePath -> Maybe FileMode -> Sha -> Annex ()+stagePointerFile :: OsPath -> Maybe FileMode -> Sha -> Annex () stagePointerFile file mode sha = 	Annex.Queue.addUpdateIndex =<< 		inRepo (Git.UpdateIndex.stageFile sha treeitemtype file)@@ -150,10 +154,10 @@ 		| maybe False isExecutable mode = TreeExecutable 		| otherwise = TreeFile -writePointerFile :: RawFilePath -> Key -> Maybe FileMode -> IO ()+writePointerFile :: OsPath -> Key -> Maybe FileMode -> IO () writePointerFile file k mode = do-	S.writeFile (fromRawFilePath file) (formatPointer k)-	maybe noop (R.setFileMode file) mode+	F.writeFile' file (formatPointer k)+	maybe noop (R.setFileMode (fromOsPath file)) mode  newtype Restage = Restage Bool @@ -186,7 +190,7 @@  - if the process is interrupted before the git queue is fulushed, the  - restage will be taken care of later.  -}-restagePointerFile :: Restage -> RawFilePath -> InodeCache -> Annex ()+restagePointerFile :: Restage -> OsPath -> InodeCache -> Annex () restagePointerFile (Restage False) f orig = do 	flip writeRestageLog orig =<< inRepo (toTopFilePath f) 	toplevelWarning True $ unableToRestage $ Just f@@ -224,17 +228,18 @@ 		=<< Annex.getRead Annex.keysdbhandle 	realindex <- liftIO $ Git.Index.currentIndexFile r 	numsz@(numfiles, _) <- calcnumsz-	let lock = fromRawFilePath (Git.Index.indexFileLock realindex)+	let lock = Git.Index.indexFileLock realindex 	    lockindex = liftIO $ catchMaybeIO $ Git.LockFile.openLock' lock 	    unlockindex = liftIO . maybe noop Git.LockFile.closeLock 	    showwarning = warning $ unableToRestage Nothing 	    go Nothing = showwarning 	    go (Just _) = withtmpdir $ \tmpdir -> do 		tsd <- getTSDelta -		let tmpindex = toRawFilePath (tmpdir </> "index")+		let tmpindex = tmpdir </> literalOsPath "index" 		let replaceindex = liftIO $ moveFile tmpindex realindex 		let updatetmpindex = do 			r' <- liftIO $ Git.Env.addGitEnv r Git.Index.indexEnv+				. fromOsPath 				=<< Git.Index.indexEnvVal tmpindex 			configfilterprocess numsz $ 				runupdateindex tsd r' replaceindex@@ -245,7 +250,9 @@ 	when (numfiles > 0) $ 		bracket lockindex unlockindex go   where-	withtmpdir = withTmpDirIn (fromRawFilePath $ Git.localGitDir r) "annexindex"+	withtmpdir = withTmpDirIn+		(Git.localGitDir r)+		(literalOsPath "annexindex")  	isunmodified tsd f orig =  		genInodeCache f tsd >>= return . \case@@ -322,7 +329,7 @@ 		ck = ConfigKey "filter.annex.process" 		ckd = ConfigKey "filter.annex.process-temp-disabled" -unableToRestage :: Maybe RawFilePath -> StringContainingQuotedPath+unableToRestage :: Maybe OsPath -> StringContainingQuotedPath unableToRestage mf = 	"git status will show " <> maybe "some files" QuotedPath mf 	<> " to be modified, since content availability has changed"@@ -358,7 +365,8 @@ 		Nothing -> Right Nothing   where 	parsekey l-		| isLinkToAnnex l = fileKey $ snd $ S8.breakEnd pathsep l+		| isLinkToAnnex l = fileKey $ toOsPath $+			snd $ S8.breakEnd pathsep l 		| otherwise = Nothing  	restvalid r@@ -397,9 +405,9 @@ 	in parseLinkTargetOrPointer' (L.toStrict b')  formatPointer :: Key -> S.ByteString-formatPointer k = prefix <> keyFile k <> nl+formatPointer k = fromOsPath prefix <> fromOsPath (keyFile k) <> nl   where-	prefix = toInternalGitPath $ P.pathSeparator `S.cons` objectDir+	prefix = toInternalGitPath $ pathSeparator `OS.cons` objectDir 	nl = S8.singleton '\n'  {- Maximum size of a file that could be a pointer to a key.@@ -431,21 +439,21 @@  - an object that looks like a pointer file. Or that a non-annex  - symlink does. Avoids a false positive in those cases.  - -}-isPointerFile :: RawFilePath -> IO (Maybe Key)+isPointerFile :: OsPath -> IO (Maybe Key) isPointerFile f = catchDefaultIO Nothing $ #if defined(mingw32_HOST_OS)-	withFile (fromRawFilePath f) ReadMode readhandle+	F.withFile f ReadMode readhandle #else #if MIN_VERSION_unix(2,8,0) 	let open = do-		fd <- openFd (fromRawFilePath f) ReadOnly +		fd <- openFd (fromOsPath f) ReadOnly  			(defaultFileFlags { nofollow = True }) 		fdToHandle fd 	in bracket open hClose readhandle #else-	ifM (isSymbolicLink <$> R.getSymbolicLinkStatus f)+	ifM (isSymbolicLink <$> R.getSymbolicLinkStatus (fromOsPath f)) 		( return Nothing-		, withFile (fromRawFilePath f) ReadMode readhandle+		, F.withFile f ReadMode readhandle 		) #endif #endif@@ -460,13 +468,14 @@  - than .git to be used.  -} isLinkToAnnex :: S.ByteString -> Bool-isLinkToAnnex s = p `S.isInfixOf` s+isLinkToAnnex s = p `OS.isInfixOf` s' #ifdef mingw32_HOST_OS 	-- '/' is used inside pointer files on Windows, not the native '\'-	|| p' `S.isInfixOf` s+	|| p' `OS.isInfixOf` s' #endif   where-	p = P.pathSeparator `S.cons` objectDir+	s' = toOsPath s+	p = pathSeparator `OS.cons` objectDir #ifdef mingw32_HOST_OS 	p' = toInternalGitPath p #endif
Annex/Locations.hs view
@@ -6,6 +6,7 @@  -}  {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE CPP #-}  module Annex.Locations ( 	keyFile,@@ -120,7 +121,7 @@ import Data.Default import qualified Data.List.NonEmpty as NE import qualified Data.ByteString.Char8 as S8-import qualified System.FilePath.ByteString as P+import qualified Data.ByteString.Short as SB  import Common import Key@@ -134,7 +135,6 @@ import Git.FilePath import Annex.DirHashes import Annex.Fixup-import qualified Utility.RawFilePath as R  {- Conventions:  -@@ -151,13 +151,13 @@  {- The directory git annex uses for local state, relative to the .git  - directory -}-annexDir :: RawFilePath-annexDir = P.addTrailingPathSeparator "annex"+annexDir :: OsPath+annexDir = addTrailingPathSeparator (literalOsPath "annex")  {- The directory git annex uses for locally available object content,  - relative to the .git directory -}-objectDir :: RawFilePath-objectDir = P.addTrailingPathSeparator $ annexDir P.</> "objects"+objectDir :: OsPath+objectDir = addTrailingPathSeparator $ annexDir </> literalOsPath "objects"  {- Annexed file's possible locations relative to the .git directory  - in a non-bare eepository.@@ -165,24 +165,24 @@  - Normally it is hashDirMixed. However, it's always possible that a  - bare repository was converted to non-bare, or that the cripped  - filesystem setting changed, so still need to check both. -}-annexLocationsNonBare :: GitConfig -> Key -> [RawFilePath]+annexLocationsNonBare :: GitConfig -> Key -> [OsPath] annexLocationsNonBare config key =  	map (annexLocation config key) [hashDirMixed, hashDirLower]  {- Annexed file's possible locations relative to a bare repository. -}-annexLocationsBare :: GitConfig -> Key -> [RawFilePath]+annexLocationsBare :: GitConfig -> Key -> [OsPath] annexLocationsBare config key =  	map (annexLocation config key) [hashDirLower, hashDirMixed] -annexLocation :: GitConfig -> Key -> (HashLevels -> Hasher) -> RawFilePath-annexLocation config key hasher = objectDir P.</> keyPath key (hasher $ objectHashLevels config)+annexLocation :: GitConfig -> Key -> (HashLevels -> Hasher) -> OsPath+annexLocation config key hasher = objectDir </> keyPath key (hasher $ objectHashLevels config)  {- For exportree remotes with annexobjects=true, objects are stored  - in this location as well as in the exported tree. -} exportAnnexObjectLocation :: GitConfig -> Key -> ExportLocation exportAnnexObjectLocation gc k = 	mkExportLocation $-		".git" P.</> annexLocation gc k hashDirLower+		literalOsPath ".git" </> annexLocation gc k hashDirLower  {- Number of subdirectories from the gitAnnexObjectDir  - to the gitAnnexLocation. -}@@ -199,17 +199,17 @@  - When the file is not present, returns the location where the file should  - be stored.  -}-gitAnnexLocation :: Key -> Git.Repo -> GitConfig -> IO RawFilePath-gitAnnexLocation = gitAnnexLocation' R.doesPathExist+gitAnnexLocation :: Key -> Git.Repo -> GitConfig -> IO OsPath+gitAnnexLocation = gitAnnexLocation' doesPathExist -gitAnnexLocation' :: (RawFilePath -> IO Bool) -> Key -> Git.Repo -> GitConfig -> IO RawFilePath+gitAnnexLocation' :: (OsPath -> IO Bool) -> Key -> Git.Repo -> GitConfig -> IO OsPath gitAnnexLocation' checker key r config = gitAnnexLocation'' key r config 	(annexCrippledFileSystem config) 	(coreSymlinks config) 	checker 	(Git.localGitDir r) -gitAnnexLocation'' :: Key -> Git.Repo -> GitConfig -> Bool -> Bool -> (RawFilePath -> IO Bool) -> RawFilePath -> IO RawFilePath+gitAnnexLocation'' :: Key -> Git.Repo -> GitConfig -> Bool -> Bool -> (OsPath -> IO Bool) -> OsPath -> IO OsPath gitAnnexLocation'' key r config crippled symlinkssupported checker gitdir 	{- Bare repositories default to hashDirLower for new 	 - content, as it's more portable. But check all locations. -}@@ -228,14 +228,14 @@ 	only = return . inrepo . annexLocation config key 	checkall f = check $ map inrepo $ f config key -	inrepo d = gitdir P.</> d+	inrepo d = gitdir </> d 	check locs@(l:_) = fromMaybe l <$> firstM checker locs 	check [] = error "internal"  {- Calculates a symlink target to link a file to an annexed object. -}-gitAnnexLink :: RawFilePath -> Key -> Git.Repo -> GitConfig -> IO RawFilePath+gitAnnexLink :: OsPath -> Key -> Git.Repo -> GitConfig -> IO OsPath gitAnnexLink file key r config = do-	currdir <- R.getCurrentDirectory+	currdir <- getCurrentDirectory 	let absfile = absNormPathUnix currdir file 	let gitdir = getgitdir currdir 	loc <- gitAnnexLocation'' key r config False False (\_ -> return True) gitdir@@ -246,19 +246,19 @@ 		 - supporting symlinks; generate link target that will 		 - work portably. -} 		| not (coreSymlinks config) && needsSubmoduleFixup r =-			absNormPathUnix currdir (Git.repoPath r P.</> ".git")+			absNormPathUnix currdir (Git.repoPath r </> literalOsPath ".git") 		| otherwise = Git.localGitDir r 	absNormPathUnix d p = toInternalGitPath $ 		absPathFrom (toInternalGitPath d) (toInternalGitPath p)  {- Calculates a symlink target as would be used in a typical git  - repository, with .git in the top of the work tree. -}-gitAnnexLinkCanonical :: RawFilePath -> Key -> Git.Repo -> GitConfig -> IO RawFilePath+gitAnnexLinkCanonical :: OsPath -> Key -> Git.Repo -> GitConfig -> IO OsPath gitAnnexLinkCanonical file key r config = gitAnnexLink file key r' config'   where 	r' = case r of 		Git.Repo { Git.location = l@Git.Local { Git.worktree = Just wt } } ->-			r { Git.location = l { Git.gitdir = wt P.</> ".git" } }+			r { Git.location = l { Git.gitdir = wt </> literalOsPath ".git" } } 		_ -> r 	config' = config 		{ annexCrippledFileSystem = False@@ -266,23 +266,23 @@ 		}  {- File used to lock a key's content. -}-gitAnnexContentLock :: Key -> Git.Repo -> GitConfig -> IO RawFilePath+gitAnnexContentLock :: Key -> Git.Repo -> GitConfig -> IO OsPath gitAnnexContentLock key r config = do 	loc <- gitAnnexLocation key r config-	return $ loc <> ".lck"+	return $ loc <> literalOsPath ".lck"  {- File used to indicate a key's content should not be dropped until after  - a specified time. -}-gitAnnexContentRetentionTimestamp :: Key -> Git.Repo -> GitConfig -> IO RawFilePath+gitAnnexContentRetentionTimestamp :: Key -> Git.Repo -> GitConfig -> IO OsPath gitAnnexContentRetentionTimestamp key r config = do 	loc <- gitAnnexLocation key r config-	return $ loc <> ".rtm"+	return $ loc <> literalOsPath ".rtm"  {- Lock file for gitAnnexContentRetentionTimestamp -}-gitAnnexContentRetentionTimestampLock :: Key -> Git.Repo -> GitConfig -> IO RawFilePath+gitAnnexContentRetentionTimestampLock :: Key -> Git.Repo -> GitConfig -> IO OsPath gitAnnexContentRetentionTimestampLock key r config = do 	loc <- gitAnnexLocation key r config-	return $ loc <> ".rtl"+	return $ loc <> literalOsPath ".rtl"  {- Lock that is held when taking the gitAnnexContentLock to support the v10  - upgrade.@@ -292,52 +292,52 @@  - is mounted read-only. The gitAnnexInodeSentinal is created by git-annex  - init, so should already exist.  -}-gitAnnexContentLockLock :: Git.Repo -> RawFilePath+gitAnnexContentLockLock :: Git.Repo -> OsPath gitAnnexContentLockLock = gitAnnexInodeSentinal -gitAnnexInodeSentinal :: Git.Repo -> RawFilePath-gitAnnexInodeSentinal r = gitAnnexDir r P.</> "sentinal"+gitAnnexInodeSentinal :: Git.Repo -> OsPath+gitAnnexInodeSentinal r = gitAnnexDir r </> literalOsPath "sentinal" -gitAnnexInodeSentinalCache :: Git.Repo -> RawFilePath-gitAnnexInodeSentinalCache r = gitAnnexInodeSentinal r <> ".cache"+gitAnnexInodeSentinalCache :: Git.Repo -> OsPath+gitAnnexInodeSentinalCache r = gitAnnexInodeSentinal r <> literalOsPath ".cache"  {- The annex directory of a repository. -}-gitAnnexDir :: Git.Repo -> RawFilePath-gitAnnexDir r = P.addTrailingPathSeparator $ Git.localGitDir r P.</> annexDir+gitAnnexDir :: Git.Repo -> OsPath+gitAnnexDir r = addTrailingPathSeparator $ Git.localGitDir r </> annexDir  {- The part of the annex directory where file contents are stored. -}-gitAnnexObjectDir :: Git.Repo -> RawFilePath-gitAnnexObjectDir r = P.addTrailingPathSeparator $-	Git.localGitDir r P.</> objectDir+gitAnnexObjectDir :: Git.Repo -> OsPath+gitAnnexObjectDir r = addTrailingPathSeparator $+	Git.localGitDir r </> objectDir  {- .git/annex/tmp/ is used for temp files for key's contents -}-gitAnnexTmpObjectDir :: Git.Repo -> RawFilePath-gitAnnexTmpObjectDir r = P.addTrailingPathSeparator $-	gitAnnexDir r P.</> "tmp"+gitAnnexTmpObjectDir :: Git.Repo -> OsPath+gitAnnexTmpObjectDir r = addTrailingPathSeparator $+	gitAnnexDir r </> literalOsPath "tmp"  {- .git/annex/othertmp/ is used for other temp files -}-gitAnnexTmpOtherDir :: Git.Repo -> RawFilePath-gitAnnexTmpOtherDir r = P.addTrailingPathSeparator $-	gitAnnexDir r P.</> "othertmp"+gitAnnexTmpOtherDir :: Git.Repo -> OsPath+gitAnnexTmpOtherDir r = addTrailingPathSeparator $+	gitAnnexDir r </> literalOsPath "othertmp"  {- Lock file for gitAnnexTmpOtherDir. -}-gitAnnexTmpOtherLock :: Git.Repo -> RawFilePath-gitAnnexTmpOtherLock r = gitAnnexDir r P.</> "othertmp.lck"+gitAnnexTmpOtherLock :: Git.Repo -> OsPath+gitAnnexTmpOtherLock r = gitAnnexDir r </> literalOsPath "othertmp.lck"  {- .git/annex/misctmp/ was used by old versions of git-annex and is still  - used during initialization -}-gitAnnexTmpOtherDirOld :: Git.Repo -> RawFilePath-gitAnnexTmpOtherDirOld r = P.addTrailingPathSeparator $ -	gitAnnexDir r P.</> "misctmp"+gitAnnexTmpOtherDirOld :: Git.Repo -> OsPath+gitAnnexTmpOtherDirOld r = addTrailingPathSeparator $ +	gitAnnexDir r </> literalOsPath "misctmp"  {- .git/annex/watchtmp/ is used by the watcher and assistant -}-gitAnnexTmpWatcherDir :: Git.Repo -> RawFilePath-gitAnnexTmpWatcherDir r = P.addTrailingPathSeparator $-	gitAnnexDir r P.</> "watchtmp"+gitAnnexTmpWatcherDir :: Git.Repo -> OsPath+gitAnnexTmpWatcherDir r = addTrailingPathSeparator $+	gitAnnexDir r </> literalOsPath "watchtmp"  {- The temp file to use for a given key's content. -}-gitAnnexTmpObjectLocation :: Key -> Git.Repo -> RawFilePath-gitAnnexTmpObjectLocation key r = gitAnnexTmpObjectDir r P.</> keyFile key+gitAnnexTmpObjectLocation :: Key -> Git.Repo -> OsPath+gitAnnexTmpObjectLocation key r = gitAnnexTmpObjectDir r </> keyFile key  {- Given a temp file such as gitAnnexTmpObjectLocation, makes a name for a  - subdirectory in the same location, that can be used as a work area@@ -346,339 +346,351 @@  - There are ordering requirements for creating these directories;  - use Annex.Content.withTmpWorkDir to set them up.  -}-gitAnnexTmpWorkDir :: RawFilePath -> RawFilePath+gitAnnexTmpWorkDir :: OsPath -> OsPath gitAnnexTmpWorkDir p =-	let (dir, f) = P.splitFileName p+	let (dir, f) = splitFileName p 	-- Using a prefix avoids name conflict with any other keys.-	in dir P.</> "work." <> f+	in dir </> literalOsPath "work." <> f  {- .git/annex/bad/ is used for bad files found during fsck -}-gitAnnexBadDir :: Git.Repo -> RawFilePath-gitAnnexBadDir r = P.addTrailingPathSeparator $ gitAnnexDir r P.</> "bad"+gitAnnexBadDir :: Git.Repo -> OsPath+gitAnnexBadDir r = addTrailingPathSeparator $+	gitAnnexDir r </> literalOsPath "bad"  {- The bad file to use for a given key. -}-gitAnnexBadLocation :: Key -> Git.Repo -> RawFilePath-gitAnnexBadLocation key r = gitAnnexBadDir r P.</> keyFile key+gitAnnexBadLocation :: Key -> Git.Repo -> OsPath+gitAnnexBadLocation key r = gitAnnexBadDir r </> keyFile key  {- .git/annex/foounused is used to number possibly unused keys -}-gitAnnexUnusedLog :: RawFilePath -> Git.Repo -> RawFilePath-gitAnnexUnusedLog prefix r = gitAnnexDir r P.</> (prefix <> "unused")+gitAnnexUnusedLog :: OsPath -> Git.Repo -> OsPath+gitAnnexUnusedLog prefix r =+	gitAnnexDir r </> (prefix <> literalOsPath "unused")  {- .git/annex/keysdb/ contains a database of information about keys. -}-gitAnnexKeysDbDir :: Git.Repo -> GitConfig -> RawFilePath-gitAnnexKeysDbDir r c = fromMaybe (gitAnnexDir r) (annexDbDir c) P.</> "keysdb"+gitAnnexKeysDbDir :: Git.Repo -> GitConfig -> OsPath+gitAnnexKeysDbDir r c = +	fromMaybe (gitAnnexDir r) (annexDbDir c) </> literalOsPath "keysdb"  {- Lock file for the keys database. -}-gitAnnexKeysDbLock :: Git.Repo -> GitConfig -> RawFilePath-gitAnnexKeysDbLock r c = gitAnnexKeysDbDir r c <> ".lck"+gitAnnexKeysDbLock :: Git.Repo -> GitConfig -> OsPath+gitAnnexKeysDbLock r c = gitAnnexKeysDbDir r c <> literalOsPath ".lck"  {- Contains the stat of the last index file that was  - reconciled with the keys database. -}-gitAnnexKeysDbIndexCache :: Git.Repo -> GitConfig -> RawFilePath-gitAnnexKeysDbIndexCache r c = gitAnnexKeysDbDir r c <> ".cache"+gitAnnexKeysDbIndexCache :: Git.Repo -> GitConfig -> OsPath+gitAnnexKeysDbIndexCache r c =+	gitAnnexKeysDbDir r c <> literalOsPath ".cache"  {- .git/annex/fsck/uuid/ is used to store information about incremental  - fscks. -}-gitAnnexFsckDir :: UUID -> Git.Repo -> Maybe GitConfig -> RawFilePath+gitAnnexFsckDir :: UUID -> Git.Repo -> Maybe GitConfig -> OsPath gitAnnexFsckDir u r mc = case annexDbDir =<< mc of 	Nothing -> go (gitAnnexDir r) 	Just d -> go d   where-	go d = d P.</> "fsck" P.</> fromUUID u+	go d = d </> literalOsPath "fsck" </> fromUUID u  {- used to store information about incremental fscks. -}-gitAnnexFsckState :: UUID -> Git.Repo -> RawFilePath-gitAnnexFsckState u r = gitAnnexFsckDir u r Nothing P.</> "state"+gitAnnexFsckState :: UUID -> Git.Repo -> OsPath+gitAnnexFsckState u r = gitAnnexFsckDir u r Nothing </> literalOsPath "state"  {- Directory containing database used to record fsck info. -}-gitAnnexFsckDbDir :: UUID -> Git.Repo -> GitConfig -> RawFilePath-gitAnnexFsckDbDir u r c = gitAnnexFsckDir u r (Just c) P.</> "fsckdb"+gitAnnexFsckDbDir :: UUID -> Git.Repo -> GitConfig -> OsPath+gitAnnexFsckDbDir u r c = gitAnnexFsckDir u r (Just c) </> literalOsPath "fsckdb"  {- Directory containing old database used to record fsck info. -}-gitAnnexFsckDbDirOld :: UUID -> Git.Repo -> GitConfig -> RawFilePath-gitAnnexFsckDbDirOld u r c = gitAnnexFsckDir u r (Just c) P.</> "db"+gitAnnexFsckDbDirOld :: UUID -> Git.Repo -> GitConfig -> OsPath+gitAnnexFsckDbDirOld u r c = gitAnnexFsckDir u r (Just c) </> literalOsPath "db"  {- Lock file for the fsck database. -}-gitAnnexFsckDbLock :: UUID -> Git.Repo -> GitConfig -> RawFilePath-gitAnnexFsckDbLock u r c = gitAnnexFsckDir u r (Just c) P.</> "fsck.lck"+gitAnnexFsckDbLock :: UUID -> Git.Repo -> GitConfig -> OsPath+gitAnnexFsckDbLock u r c = gitAnnexFsckDir u r (Just c) </> literalOsPath "fsck.lck"  {- .git/annex/fsckresults/uuid is used to store results of git fscks -}-gitAnnexFsckResultsLog :: UUID -> Git.Repo -> RawFilePath+gitAnnexFsckResultsLog :: UUID -> Git.Repo -> OsPath gitAnnexFsckResultsLog u r = -	gitAnnexDir r P.</> "fsckresults" P.</> fromUUID u+	gitAnnexDir r </> literalOsPath "fsckresults" </> fromUUID u  {- .git/annex/upgrade.log is used to record repository version upgrades. -}-gitAnnexUpgradeLog :: Git.Repo -> RawFilePath-gitAnnexUpgradeLog r = gitAnnexDir r P.</> "upgrade.log"+gitAnnexUpgradeLog :: Git.Repo -> OsPath+gitAnnexUpgradeLog r = gitAnnexDir r </> literalOsPath "upgrade.log" -gitAnnexUpgradeLock :: Git.Repo -> RawFilePath-gitAnnexUpgradeLock r = gitAnnexDir r P.</> "upgrade.lck"+gitAnnexUpgradeLock :: Git.Repo -> OsPath+gitAnnexUpgradeLock r = gitAnnexDir r </> literalOsPath "upgrade.lck"  {- .git/annex/smudge.log is used to log smudged worktree files that need to  - be updated. -}-gitAnnexSmudgeLog :: Git.Repo -> RawFilePath-gitAnnexSmudgeLog r = gitAnnexDir r P.</> "smudge.log"+gitAnnexSmudgeLog :: Git.Repo -> OsPath+gitAnnexSmudgeLog r = gitAnnexDir r </> literalOsPath "smudge.log" -gitAnnexSmudgeLock :: Git.Repo -> RawFilePath-gitAnnexSmudgeLock r = gitAnnexDir r P.</> "smudge.lck"+gitAnnexSmudgeLock :: Git.Repo -> OsPath+gitAnnexSmudgeLock r = gitAnnexDir r </> literalOsPath "smudge.lck"  {- .git/annex/restage.log is used to log worktree files that need to be  - restaged in git -}-gitAnnexRestageLog :: Git.Repo -> RawFilePath-gitAnnexRestageLog r = gitAnnexDir r P.</> "restage.log"+gitAnnexRestageLog :: Git.Repo -> OsPath+gitAnnexRestageLog r = gitAnnexDir r </> literalOsPath "restage.log"  {- .git/annex/restage.old is used while restaging files in git -}-gitAnnexRestageLogOld :: Git.Repo -> RawFilePath-gitAnnexRestageLogOld r = gitAnnexDir r P.</> "restage.old"+gitAnnexRestageLogOld :: Git.Repo -> OsPath+gitAnnexRestageLogOld r = gitAnnexDir r </> literalOsPath "restage.old" -gitAnnexRestageLock :: Git.Repo -> RawFilePath-gitAnnexRestageLock r = gitAnnexDir r P.</> "restage.lck"+gitAnnexRestageLock :: Git.Repo -> OsPath+gitAnnexRestageLock r = gitAnnexDir r </> literalOsPath "restage.lck"  {- .git/annex/adjust.log is used to log when the adjusted branch needs to  - be updated. -}-gitAnnexAdjustedBranchUpdateLog :: Git.Repo -> RawFilePath-gitAnnexAdjustedBranchUpdateLog r = gitAnnexDir r P.</> "adjust.log"+gitAnnexAdjustedBranchUpdateLog :: Git.Repo -> OsPath+gitAnnexAdjustedBranchUpdateLog r = gitAnnexDir r </> literalOsPath "adjust.log" -gitAnnexAdjustedBranchUpdateLock :: Git.Repo -> RawFilePath-gitAnnexAdjustedBranchUpdateLock r = gitAnnexDir r P.</> "adjust.lck"+gitAnnexAdjustedBranchUpdateLock :: Git.Repo -> OsPath+gitAnnexAdjustedBranchUpdateLock r = gitAnnexDir r </> literalOsPath "adjust.lck"  {- .git/annex/migrate.log is used to log migrations before committing them. -}-gitAnnexMigrateLog :: Git.Repo -> RawFilePath-gitAnnexMigrateLog r = gitAnnexDir r P.</> "migrate.log"+gitAnnexMigrateLog :: Git.Repo -> OsPath+gitAnnexMigrateLog r = gitAnnexDir r </> literalOsPath "migrate.log" -gitAnnexMigrateLock :: Git.Repo -> RawFilePath-gitAnnexMigrateLock r = gitAnnexDir r P.</> "migrate.lck"+gitAnnexMigrateLock :: Git.Repo -> OsPath+gitAnnexMigrateLock r = gitAnnexDir r </> literalOsPath "migrate.lck"  {- .git/annex/migrations.log is used to log committed migrations. -}-gitAnnexMigrationsLog :: Git.Repo -> RawFilePath-gitAnnexMigrationsLog r = gitAnnexDir r P.</> "migrations.log"+gitAnnexMigrationsLog :: Git.Repo -> OsPath+gitAnnexMigrationsLog r = gitAnnexDir r </> literalOsPath "migrations.log" -gitAnnexMigrationsLock :: Git.Repo -> RawFilePath-gitAnnexMigrationsLock r = gitAnnexDir r P.</> "migrations.lck"+gitAnnexMigrationsLock :: Git.Repo -> OsPath+gitAnnexMigrationsLock r = gitAnnexDir r </> literalOsPath "migrations.lck"  {- .git/annex/move.log is used to log moves that are in progress,  - to better support resuming an interrupted move. -}-gitAnnexMoveLog :: Git.Repo -> RawFilePath-gitAnnexMoveLog r = gitAnnexDir r P.</> "move.log"+gitAnnexMoveLog :: Git.Repo -> OsPath+gitAnnexMoveLog r = gitAnnexDir r </> literalOsPath "move.log" -gitAnnexMoveLock :: Git.Repo -> RawFilePath-gitAnnexMoveLock r = gitAnnexDir r P.</> "move.lck"+gitAnnexMoveLock :: Git.Repo -> OsPath+gitAnnexMoveLock r = gitAnnexDir r </> literalOsPath "move.lck"  {- .git/annex/export/ is used to store information about  - exports to special remotes. -}-gitAnnexExportDir :: Git.Repo -> GitConfig -> RawFilePath-gitAnnexExportDir r c = fromMaybe (gitAnnexDir r) (annexDbDir c) P.</> "export"+gitAnnexExportDir :: Git.Repo -> GitConfig -> OsPath+gitAnnexExportDir r c = fromMaybe (gitAnnexDir r) (annexDbDir c)+	</> literalOsPath "export"  {- Directory containing database used to record export info. -}-gitAnnexExportDbDir :: UUID -> Git.Repo -> GitConfig -> RawFilePath+gitAnnexExportDbDir :: UUID -> Git.Repo -> GitConfig -> OsPath gitAnnexExportDbDir u r c = -	gitAnnexExportDir r c P.</> fromUUID u P.</> "exportdb"+	gitAnnexExportDir r c </> fromUUID u </> literalOsPath "exportdb"  {- Lock file for export database. -}-gitAnnexExportLock :: UUID -> Git.Repo -> GitConfig -> RawFilePath-gitAnnexExportLock u r c = gitAnnexExportDbDir u r c <> ".lck"+gitAnnexExportLock :: UUID -> Git.Repo -> GitConfig -> OsPath+gitAnnexExportLock u r c = gitAnnexExportDbDir u r c <> literalOsPath ".lck"  {- Lock file for updating the export database with information from the  - repository. -}-gitAnnexExportUpdateLock :: UUID -> Git.Repo -> GitConfig -> RawFilePath-gitAnnexExportUpdateLock u r c = gitAnnexExportDbDir u r c <> ".upl"+gitAnnexExportUpdateLock :: UUID -> Git.Repo -> GitConfig -> OsPath+gitAnnexExportUpdateLock u r c = gitAnnexExportDbDir u r c <> literalOsPath ".upl"  {- Log file used to keep track of files that were in the tree exported to a  - remote, but were excluded by its preferred content settings. -}-gitAnnexExportExcludeLog :: UUID -> Git.Repo -> RawFilePath-gitAnnexExportExcludeLog u r = gitAnnexDir r P.</> "export.ex" P.</> fromUUID u+gitAnnexExportExcludeLog :: UUID -> Git.Repo -> OsPath+gitAnnexExportExcludeLog u r = gitAnnexDir r +	</> literalOsPath "export.ex" </> fromUUID u  {- Directory containing database used to record remote content ids.  -  - (This used to be "cid", but a problem with the database caused it to  - need to be rebuilt with a new name.)  -}-gitAnnexContentIdentifierDbDir :: Git.Repo -> GitConfig -> RawFilePath+gitAnnexContentIdentifierDbDir :: Git.Repo -> GitConfig -> OsPath gitAnnexContentIdentifierDbDir r c =-	fromMaybe (gitAnnexDir r) (annexDbDir c) P.</> "cidsdb"+	fromMaybe (gitAnnexDir r) (annexDbDir c) </> literalOsPath "cidsdb"  {- Lock file for writing to the content id database. -}-gitAnnexContentIdentifierLock :: Git.Repo -> GitConfig -> RawFilePath-gitAnnexContentIdentifierLock r c = gitAnnexContentIdentifierDbDir r c <> ".lck"+gitAnnexContentIdentifierLock :: Git.Repo -> GitConfig -> OsPath+gitAnnexContentIdentifierLock r c = +	gitAnnexContentIdentifierDbDir r c <> literalOsPath ".lck"  {- .git/annex/import/ is used to store information about  - imports from special remotes. -}-gitAnnexImportDir :: Git.Repo -> GitConfig -> RawFilePath-gitAnnexImportDir r c = fromMaybe (gitAnnexDir r) (annexDbDir c) P.</> "import"+gitAnnexImportDir :: Git.Repo -> GitConfig -> OsPath+gitAnnexImportDir r c =+	fromMaybe (gitAnnexDir r) (annexDbDir c) </> literalOsPath "import"  {- File containing state about the last import done from a remote. -}-gitAnnexImportLog :: UUID -> Git.Repo -> GitConfig -> RawFilePath-gitAnnexImportLog u r c = -	gitAnnexImportDir r c P.</> fromUUID u P.</> "log"+gitAnnexImportLog :: UUID -> Git.Repo -> GitConfig -> OsPath+gitAnnexImportLog u r c =+	gitAnnexImportDir r c </> fromUUID u </> literalOsPath "log"  {- Directory containing database used by importfeed. -}-gitAnnexImportFeedDbDir :: Git.Repo -> GitConfig -> RawFilePath+gitAnnexImportFeedDbDir :: Git.Repo -> GitConfig -> OsPath gitAnnexImportFeedDbDir r c =-	fromMaybe (gitAnnexDir r) (annexDbDir c) P.</> "importfeed"+	fromMaybe (gitAnnexDir r) (annexDbDir c) </> literalOsPath "importfeed"  {- Lock file for writing to the importfeed database. -}-gitAnnexImportFeedDbLock :: Git.Repo -> GitConfig -> RawFilePath-gitAnnexImportFeedDbLock r c = gitAnnexImportFeedDbDir r c <> ".lck"+gitAnnexImportFeedDbLock :: Git.Repo -> GitConfig -> OsPath+gitAnnexImportFeedDbLock r c =+	gitAnnexImportFeedDbDir r c <> literalOsPath ".lck"  {- Directory containing reposize database. -}-gitAnnexRepoSizeDbDir :: Git.Repo -> GitConfig -> RawFilePath+gitAnnexRepoSizeDbDir :: Git.Repo -> GitConfig -> OsPath gitAnnexRepoSizeDbDir r c =-	fromMaybe (gitAnnexDir r) (annexDbDir c) P.</> "reposize" P.</> "db"+	fromMaybe (gitAnnexDir r) (annexDbDir c) </> literalOsPath "reposize" </> literalOsPath "db"  {- Lock file for the reposize database. -}-gitAnnexRepoSizeDbLock :: Git.Repo -> GitConfig -> RawFilePath+gitAnnexRepoSizeDbLock :: Git.Repo -> GitConfig -> OsPath gitAnnexRepoSizeDbLock r c =-	fromMaybe (gitAnnexDir r) (annexDbDir c) P.</> "reposize" P.</> "lock"+	fromMaybe (gitAnnexDir r) (annexDbDir c) </> literalOsPath "reposize" </> literalOsPath "lock"  {- Directory containing liveness pid files. -}-gitAnnexRepoSizeLiveDir :: Git.Repo -> GitConfig -> RawFilePath+gitAnnexRepoSizeLiveDir :: Git.Repo -> GitConfig -> OsPath gitAnnexRepoSizeLiveDir r c =-	fromMaybe (gitAnnexDir r) (annexDbDir c) P.</> "reposize" P.</> "live"+	fromMaybe (gitAnnexDir r) (annexDbDir c) </> literalOsPath "reposize" </> literalOsPath "live"  {- .git/annex/schedulestate is used to store information about when  - scheduled jobs were last run. -}-gitAnnexScheduleState :: Git.Repo -> RawFilePath-gitAnnexScheduleState r = gitAnnexDir r P.</> "schedulestate"+gitAnnexScheduleState :: Git.Repo -> OsPath+gitAnnexScheduleState r = gitAnnexDir r </> literalOsPath "schedulestate"  {- .git/annex/creds/ is used to store credentials to access some special  - remotes. -}-gitAnnexCredsDir :: Git.Repo -> RawFilePath-gitAnnexCredsDir r = P.addTrailingPathSeparator $ gitAnnexDir r P.</> "creds"+gitAnnexCredsDir :: Git.Repo -> OsPath+gitAnnexCredsDir r = addTrailingPathSeparator $+	gitAnnexDir r </> literalOsPath "creds"  {- .git/annex/certificate.pem and .git/annex/key.pem are used by the webapp  - when HTTPS is enabled -}-gitAnnexWebCertificate :: Git.Repo -> FilePath-gitAnnexWebCertificate r = fromRawFilePath $ gitAnnexDir r P.</> "certificate.pem"-gitAnnexWebPrivKey :: Git.Repo -> FilePath-gitAnnexWebPrivKey r = fromRawFilePath $ gitAnnexDir r P.</> "privkey.pem"+gitAnnexWebCertificate :: Git.Repo -> OsPath+gitAnnexWebCertificate r = gitAnnexDir r </> literalOsPath "certificate.pem"+gitAnnexWebPrivKey :: Git.Repo -> OsPath+gitAnnexWebPrivKey r = gitAnnexDir r </> literalOsPath "privkey.pem"  {- .git/annex/feeds/ is used to record per-key (url) state by importfeed -}-gitAnnexFeedStateDir :: Git.Repo -> RawFilePath-gitAnnexFeedStateDir r = P.addTrailingPathSeparator $-	gitAnnexDir r P.</> "feedstate"+gitAnnexFeedStateDir :: Git.Repo -> OsPath+gitAnnexFeedStateDir r = addTrailingPathSeparator $+	gitAnnexDir r </> literalOsPath "feedstate" -gitAnnexFeedState :: Key -> Git.Repo -> RawFilePath-gitAnnexFeedState k r = gitAnnexFeedStateDir r P.</> keyFile k+gitAnnexFeedState :: Key -> Git.Repo -> OsPath+gitAnnexFeedState k r = gitAnnexFeedStateDir r </> keyFile k  {- .git/annex/merge/ is used as a empty work tree for merges in   - adjusted branches. -}-gitAnnexMergeDir :: Git.Repo -> FilePath-gitAnnexMergeDir r = fromRawFilePath $-	P.addTrailingPathSeparator $ gitAnnexDir r P.</> "merge"+gitAnnexMergeDir :: Git.Repo -> OsPath+gitAnnexMergeDir r = addTrailingPathSeparator $+	gitAnnexDir r </> literalOsPath "merge"  {- .git/annex/transfer/ is used to record keys currently  - being transferred, and other transfer bookkeeping info. -}-gitAnnexTransferDir :: Git.Repo -> RawFilePath+gitAnnexTransferDir :: Git.Repo -> OsPath gitAnnexTransferDir r =-	P.addTrailingPathSeparator $ gitAnnexDir r P.</> "transfer"+	addTrailingPathSeparator $ gitAnnexDir r </> literalOsPath "transfer"  {- .git/annex/journal/ is used to journal changes made to the git-annex  - branch -}-gitAnnexJournalDir :: BranchState -> Git.Repo -> RawFilePath-gitAnnexJournalDir st r = P.addTrailingPathSeparator $ +gitAnnexJournalDir :: BranchState -> Git.Repo -> OsPath+gitAnnexJournalDir st r = addTrailingPathSeparator $  	case alternateJournal st of-		Nothing -> gitAnnexDir r P.</> "journal"+		Nothing -> gitAnnexDir r </> literalOsPath "journal" 		Just d -> d  {- .git/annex/journal.private/ is used to journal changes regarding private  - repositories. -}-gitAnnexPrivateJournalDir :: BranchState -> Git.Repo -> RawFilePath-gitAnnexPrivateJournalDir st r = P.addTrailingPathSeparator $+gitAnnexPrivateJournalDir :: BranchState -> Git.Repo -> OsPath+gitAnnexPrivateJournalDir st r = addTrailingPathSeparator $ 	case alternateJournal st of-		Nothing -> gitAnnexDir r P.</> "journal-private"+		Nothing -> gitAnnexDir r </> literalOsPath "journal-private" 		Just d -> d  {- Lock file for the journal. -}-gitAnnexJournalLock :: Git.Repo -> RawFilePath-gitAnnexJournalLock r = gitAnnexDir r P.</> "journal.lck"+gitAnnexJournalLock :: Git.Repo -> OsPath+gitAnnexJournalLock r = gitAnnexDir r </> literalOsPath "journal.lck"  {- Lock file for flushing a git queue that writes to the git index or  - other git state that should only have one writer at a time. -}-gitAnnexGitQueueLock :: Git.Repo -> RawFilePath-gitAnnexGitQueueLock r = gitAnnexDir r P.</> "gitqueue.lck"+gitAnnexGitQueueLock :: Git.Repo -> OsPath+gitAnnexGitQueueLock r = gitAnnexDir r </> literalOsPath "gitqueue.lck"  {- .git/annex/index is used to stage changes to the git-annex branch -}-gitAnnexIndex :: Git.Repo -> RawFilePath-gitAnnexIndex r = gitAnnexDir r P.</> "index"+gitAnnexIndex :: Git.Repo -> OsPath+gitAnnexIndex r = gitAnnexDir r </> literalOsPath "index"  {- .git/annex/index-private is used to store information that is not to  - be exposed to the git-annex branch. -}-gitAnnexPrivateIndex :: Git.Repo -> RawFilePath-gitAnnexPrivateIndex r = gitAnnexDir r P.</> "index-private"+gitAnnexPrivateIndex :: Git.Repo -> OsPath+gitAnnexPrivateIndex r = gitAnnexDir r </> literalOsPath "index-private"  {- Holds the sha of the git-annex branch that the index was last updated to.  -  - The .lck in the name is a historical accident; this is not used as a  - lock. -}-gitAnnexIndexStatus :: Git.Repo -> RawFilePath-gitAnnexIndexStatus r = gitAnnexDir r P.</> "index.lck"+gitAnnexIndexStatus :: Git.Repo -> OsPath+gitAnnexIndexStatus r = gitAnnexDir r </> literalOsPath "index.lck"  {- The index file used to generate a filtered branch view._-}-gitAnnexViewIndex :: Git.Repo -> RawFilePath-gitAnnexViewIndex r = gitAnnexDir r P.</> "viewindex"+gitAnnexViewIndex :: Git.Repo -> OsPath+gitAnnexViewIndex r = gitAnnexDir r </> literalOsPath "viewindex"  {- File containing a log of recently accessed views. -}-gitAnnexViewLog :: Git.Repo -> RawFilePath-gitAnnexViewLog r = gitAnnexDir r P.</> "viewlog"+gitAnnexViewLog :: Git.Repo -> OsPath+gitAnnexViewLog r = gitAnnexDir r </> literalOsPath "viewlog"  {- List of refs that have already been merged into the git-annex branch. -}-gitAnnexMergedRefs :: Git.Repo -> RawFilePath-gitAnnexMergedRefs r = gitAnnexDir r P.</> "mergedrefs"+gitAnnexMergedRefs :: Git.Repo -> OsPath+gitAnnexMergedRefs r = gitAnnexDir r </> literalOsPath "mergedrefs"  {- List of refs that should not be merged into the git-annex branch. -}-gitAnnexIgnoredRefs :: Git.Repo -> RawFilePath-gitAnnexIgnoredRefs r = gitAnnexDir r P.</> "ignoredrefs"+gitAnnexIgnoredRefs :: Git.Repo -> OsPath+gitAnnexIgnoredRefs r = gitAnnexDir r </> literalOsPath "ignoredrefs"  {- Pid file for daemon mode. -}-gitAnnexPidFile :: Git.Repo -> RawFilePath-gitAnnexPidFile r = gitAnnexDir r P.</> "daemon.pid"+gitAnnexPidFile :: Git.Repo -> OsPath+gitAnnexPidFile r = gitAnnexDir r </> literalOsPath "daemon.pid"  {- Pid lock file for pidlock mode -}-gitAnnexPidLockFile :: Git.Repo -> RawFilePath-gitAnnexPidLockFile r = gitAnnexDir r P.</> "pidlock"+gitAnnexPidLockFile :: Git.Repo -> OsPath+gitAnnexPidLockFile r = gitAnnexDir r </> literalOsPath "pidlock"  {- Status file for daemon mode. -} gitAnnexDaemonStatusFile :: Git.Repo -> FilePath-gitAnnexDaemonStatusFile r = fromRawFilePath $-	gitAnnexDir r P.</> "daemon.status"+gitAnnexDaemonStatusFile r = fromOsPath $+	gitAnnexDir r </> literalOsPath "daemon.status"  {- Log file for daemon mode. -}-gitAnnexDaemonLogFile :: Git.Repo -> RawFilePath-gitAnnexDaemonLogFile r = gitAnnexDir r P.</> "daemon.log"+gitAnnexDaemonLogFile :: Git.Repo -> OsPath+gitAnnexDaemonLogFile r = gitAnnexDir r </> literalOsPath "daemon.log"  {- Log file for fuzz test. -} gitAnnexFuzzTestLogFile :: Git.Repo -> FilePath-gitAnnexFuzzTestLogFile r = fromRawFilePath $-	gitAnnexDir r P.</> "fuzztest.log"+gitAnnexFuzzTestLogFile r = fromOsPath $+	gitAnnexDir r </> literalOsPath "fuzztest.log"  {- Html shim file used to launch the webapp. -}-gitAnnexHtmlShim :: Git.Repo -> RawFilePath-gitAnnexHtmlShim r = gitAnnexDir r P.</> "webapp.html"+gitAnnexHtmlShim :: Git.Repo -> OsPath+gitAnnexHtmlShim r = gitAnnexDir r </> literalOsPath "webapp.html"  {- File containing the url to the webapp. -}-gitAnnexUrlFile :: Git.Repo -> RawFilePath-gitAnnexUrlFile r = gitAnnexDir r P.</> "url"+gitAnnexUrlFile :: Git.Repo -> OsPath+gitAnnexUrlFile r = gitAnnexDir r </> literalOsPath "url"  {- Temporary file used to edit configuriation from the git-annex branch. -}-gitAnnexTmpCfgFile :: Git.Repo -> RawFilePath-gitAnnexTmpCfgFile r = gitAnnexDir r P.</> "config.tmp"+gitAnnexTmpCfgFile :: Git.Repo -> OsPath+gitAnnexTmpCfgFile r = gitAnnexDir r </> literalOsPath "config.tmp"  {- .git/annex/ssh/ is used for ssh connection caching -}-gitAnnexSshDir :: Git.Repo -> RawFilePath-gitAnnexSshDir r = P.addTrailingPathSeparator $ gitAnnexDir r P.</> "ssh"+gitAnnexSshDir :: Git.Repo -> OsPath+gitAnnexSshDir r = addTrailingPathSeparator $+	gitAnnexDir r </> literalOsPath "ssh"  {- .git/annex/remotes/ is used for remote-specific state. -}-gitAnnexRemotesDir :: Git.Repo -> RawFilePath-gitAnnexRemotesDir r =-	P.addTrailingPathSeparator $ gitAnnexDir r P.</> "remotes"+gitAnnexRemotesDir :: Git.Repo -> OsPath+gitAnnexRemotesDir r = addTrailingPathSeparator $+	gitAnnexDir r </> literalOsPath "remotes"  {- This is the base directory name used by the assistant when making  - repositories, by default. -}-gitAnnexAssistantDefaultDir :: FilePath-gitAnnexAssistantDefaultDir = "annex"+gitAnnexAssistantDefaultDir :: OsPath+gitAnnexAssistantDefaultDir = literalOsPath "annex" -gitAnnexSimDir :: Git.Repo -> RawFilePath-gitAnnexSimDir r = P.addTrailingPathSeparator $ gitAnnexDir r P.</> "sim"+gitAnnexSimDir :: Git.Repo -> OsPath+gitAnnexSimDir r = addTrailingPathSeparator $+	gitAnnexDir r </> literalOsPath "sim"  {- Sanitizes a String that will be used as part of a Key's keyName,  - dealing with characters that cause problems.@@ -730,23 +742,32 @@  - Changing what this function escapes and how is not a good idea, as it  - can cause existing objects to get lost.  -}-keyFile :: Key -> RawFilePath+keyFile :: Key -> OsPath keyFile k = -	let b = serializeKey' k-	in if S8.any (`elem` ['&', '%', ':', '/']) b-		then S8.concatMap esc b+	let b = serializeKey'' k+	in toOsPath $ if anyneedesc b+		then mconcat $ map esc (SB.unpack b) 		else b   where-	esc '&' = "&a"-	esc '%' = "&s"-	esc ':' = "&c"-	esc '/' = "%"-	esc c = S8.singleton c+	esc w = case chr (fromIntegral w) of+		'&' -> "&a"+		'%' -> "&s"+		':' -> "&c"+		'/' -> "%"+		_ -> SB.pack [w] +	needesc = map (fromIntegral . ord) ['&', '%', ':', '/']++#if MIN_VERSION_bytestring(0,11,3)+	anyneedesc = SB.any (`elem` needesc)+#else+	anyneedesc = any (`elem` needesc) . SB.unpack+#endif+ {- Reverses keyFile, converting a filename fragment (ie, the basename of  - the symlink target) into a key. -}-fileKey :: RawFilePath -> Maybe Key-fileKey = deserializeKey' . S8.intercalate "/" . map go . S8.split '%'+fileKey :: OsPath -> Maybe Key+fileKey = deserializeKey' . S8.intercalate "/" . map go . S8.split '%' . fromOsPath   where 	go = S8.concat . unescafterfirst . S8.split '&' 	unescafterfirst [] = []@@ -765,8 +786,8 @@  - The file is put in a directory with the same name, this allows  - write-protecting the directory to avoid accidental deletion of the file.  -}-keyPath :: Key -> Hasher -> RawFilePath-keyPath key hasher = hasher key P.</> f P.</> f+keyPath :: Key -> Hasher -> OsPath+keyPath key hasher = hasher key </> f </> f   where 	f = keyFile key @@ -776,5 +797,6 @@  - This is compatible with the annexLocationsNonBare and annexLocationsBare,  - for interoperability between special remotes and git-annex repos.  -}-keyPaths :: Key -> NE.NonEmpty RawFilePath+keyPaths :: Key -> NE.NonEmpty OsPath keyPaths key = NE.map (\h -> keyPath key (h def)) dirHashes+
Annex/LockFile.hs view
@@ -26,11 +26,10 @@ import Annex.LockPool  import qualified Data.Map as M-import qualified System.FilePath.ByteString as P  {- Create a specified lock file, and takes a shared lock, which is retained  - in the cache. -}-lockFileCached :: RawFilePath -> Annex ()+lockFileCached :: OsPath -> Annex () lockFileCached file = go =<< fromLockCache file   where 	go (Just _) = noop -- already locked@@ -43,7 +42,7 @@ #endif 		changeLockCache $ M.insert file lockhandle -unlockFile :: RawFilePath -> Annex ()+unlockFile :: OsPath -> Annex () unlockFile file = maybe noop go =<< fromLockCache file   where 	go lockhandle = do@@ -53,7 +52,7 @@ getLockCache :: Annex LockCache getLockCache = getState lockcache -fromLockCache :: RawFilePath -> Annex (Maybe LockHandle)+fromLockCache :: OsPath -> Annex (Maybe LockHandle) fromLockCache file = M.lookup file <$> getLockCache  changeLockCache :: (LockCache -> LockCache) -> Annex ()@@ -63,9 +62,9 @@  {- Runs an action with a shared lock held. If an exclusive lock is held,  - blocks until it becomes free. -}-withSharedLock :: RawFilePath -> Annex a -> Annex a+withSharedLock :: OsPath -> Annex a -> Annex a withSharedLock lockfile a = debugLocks $ do-	createAnnexDirectory $ P.takeDirectory lockfile+	createAnnexDirectory $ takeDirectory lockfile 	mode <- annexFileMode 	bracket (lock mode lockfile) (liftIO . dropLock) (const a)   where@@ -77,16 +76,16 @@  {- Runs an action with an exclusive lock held. If the lock is already  - held, blocks until it becomes free. -}-withExclusiveLock :: RawFilePath -> Annex a -> Annex a+withExclusiveLock :: OsPath -> Annex a -> Annex a withExclusiveLock lockfile a = bracket 	(takeExclusiveLock lockfile) 	(liftIO . dropLock) 	(const a)  {- Takes an exclusive lock, blocking until it's free. -}-takeExclusiveLock :: RawFilePath -> Annex LockHandle+takeExclusiveLock :: OsPath -> Annex LockHandle takeExclusiveLock lockfile = debugLocks $ do-	createAnnexDirectory $ P.takeDirectory lockfile+	createAnnexDirectory $ takeDirectory lockfile 	mode <- annexFileMode 	lock mode lockfile   where@@ -98,9 +97,9 @@  {- Tries to take an exclusive lock and run an action. If the lock is  - already held, returns Nothing. -}-tryExclusiveLock :: RawFilePath -> Annex a -> Annex (Maybe a)+tryExclusiveLock :: OsPath -> Annex a -> Annex (Maybe a) tryExclusiveLock lockfile a = debugLocks $ do-	createAnnexDirectory $ P.takeDirectory lockfile+	createAnnexDirectory $ takeDirectory lockfile 	mode <- annexFileMode 	bracket (lock mode lockfile) (liftIO . unlock) go   where@@ -118,7 +117,7 @@  - Does not create the lock directory or lock file if it does not exist,  - taking an exclusive lock will create them.  -}-trySharedLock :: RawFilePath -> Annex (Maybe LockHandle)+trySharedLock :: OsPath -> Annex (Maybe LockHandle) trySharedLock lockfile = debugLocks $ #ifndef mingw32_HOST_OS 	tryLockShared Nothing lockfile
Annex/Magic.hs view
@@ -5,6 +5,7 @@  - Licensed under the GNU AGPL version 3 or higher.  -} +{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE CPP #-}  module Annex.Magic (@@ -16,6 +17,7 @@ 	getMagicMimeEncoding, ) where +import Common import Types.Mime import Control.Monad.IO.Class #ifdef WITH_MAGICMIME@@ -23,7 +25,6 @@ import Utility.Env import Control.Concurrent import System.IO.Unsafe (unsafePerformIO)-import Common #else type Magic = () #endif@@ -34,16 +35,18 @@ 	m <- magicOpen [MagicMime] 	liftIO $ getEnv "GIT_ANNEX_DIR" >>= \case 		Nothing -> magicLoadDefault m-		Just d -> magicLoad m-			(d </> "magic" </> "magic.mgc")+		Just d -> magicLoad m $ fromOsPath $+			toOsPath d+				</> literalOsPath "magic"+				</> literalOsPath "magic.mgc" 	return m #else initMagicMime = return Nothing #endif -getMagicMime :: Magic -> FilePath -> IO (Maybe (MimeType, MimeEncoding))+getMagicMime :: Magic -> OsPath -> IO (Maybe (MimeType, MimeEncoding)) #ifdef WITH_MAGICMIME-getMagicMime m f = Just . parse <$> magicConcurrentSafe (magicFile m f)+getMagicMime m f = Just . parse <$> magicConcurrentSafe (magicFile m (fromOsPath f))   where 	parse s =  		let (mimetype, rest) = separate (== ';') s@@ -55,10 +58,10 @@ getMagicMime _ _ = return Nothing #endif -getMagicMimeType :: MonadIO m => Magic -> FilePath -> m (Maybe MimeType)+getMagicMimeType :: MonadIO m => Magic -> OsPath -> m (Maybe MimeType) getMagicMimeType m f = liftIO $ fmap fst <$> getMagicMime m f -getMagicMimeEncoding :: MonadIO m => Magic -> FilePath -> m(Maybe MimeEncoding)+getMagicMimeEncoding :: MonadIO m => Magic -> OsPath -> m(Maybe MimeEncoding) getMagicMimeEncoding m f = liftIO $ fmap snd <$> getMagicMime m f  #ifdef WITH_MAGICMIME
Annex/MetaData.hs view
@@ -38,7 +38,7 @@  -  - Also, can generate new metadata, if configured to do so.  -}-genMetaData :: Key -> RawFilePath -> Maybe POSIXTime -> Annex ()+genMetaData :: Key -> OsPath -> Maybe POSIXTime -> Annex () genMetaData key file mmtime = do 	catKeyFileHEAD file >>= \case 		Nothing -> noop@@ -57,8 +57,8 @@ 			Nothing -> noop   where 	warncopied = warning $ UnquotedString $-		"Copied metadata from old version of " ++ fromRawFilePath file ++ " to new version. " ++ -		"If you don't want this copied metadata, run: git annex metadata --remove-all " ++ fromRawFilePath file+		"Copied metadata from old version of " ++ fromOsPath file ++ " to new version. " ++ +		"If you don't want this copied metadata, run: git annex metadata --remove-all " ++ fromOsPath file 	-- If the only fields copied were date metadata, and they'll 	-- be overwritten with the current mtime, no need to warn about 	-- copying.
Annex/Multicast.hs view
@@ -7,20 +7,17 @@  module Annex.Multicast where +import Common import Annex.Path import Utility.Env-import Utility.PartialPrelude  import System.Process-import System.IO import GHC.IO.Handle.FD-import Control.Applicative-import Prelude  multicastReceiveEnv :: String multicastReceiveEnv = "GIT_ANNEX_MULTICAST_RECEIVE" -multicastCallbackEnv :: IO (FilePath, [(String, String)], Handle)+multicastCallbackEnv :: IO (OsPath, [(String, String)], Handle) multicastCallbackEnv = do 	gitannex <- programPath 	-- This will even work on Windows
Annex/Notification.hs view
@@ -60,7 +60,7 @@ 	wanted <- Annex.getRead Annex.desktopnotify 	when (notifyFinish wanted) $ liftIO $ do 		client <- DBus.Client.connectSession-		void $ Notify.notify client (droppedNote ok (fromRawFilePath f))+		void $ Notify.notify client (droppedNote ok (fromOsPath f)) #else notifyDrop (AssociatedFile (Just _)) _ = noop #endif
Annex/NumCopies.hs view
@@ -88,7 +88,7 @@  {- NumCopies and MinCopies value for a file, from any configuration source,  - including .gitattributes. -}-getFileNumMinCopies :: RawFilePath -> Annex (NumCopies, MinCopies)+getFileNumMinCopies :: OsPath -> Annex (NumCopies, MinCopies) getFileNumMinCopies f = do 	fnumc <- getForcedNumCopies 	fminc <- getForcedMinCopies@@ -141,7 +141,7 @@ 	Database.Keys.getAssociatedFilesIncluding afile k 		>>= getSafestNumMinCopies' afile k -getSafestNumMinCopies' :: AssociatedFile -> Key -> [RawFilePath] -> Annex (NumCopies, MinCopies)+getSafestNumMinCopies' :: AssociatedFile -> Key -> [OsPath] -> Annex (NumCopies, MinCopies) getSafestNumMinCopies' afile k fs = do 	l <- mapM getFileNumMinCopies fs 	let l' = zip l fs@@ -174,13 +174,13 @@ {- This is the globally visible numcopies value for a file. So it does  - not include local configuration in the git config or command line  - options. -}-getGlobalFileNumCopies :: RawFilePath  -> Annex NumCopies+getGlobalFileNumCopies :: OsPath  -> Annex NumCopies getGlobalFileNumCopies f = fromSourcesOr defaultNumCopies 	[ fst <$> getNumMinCopiesAttr f 	, getGlobalNumCopies 	] -getNumMinCopiesAttr :: RawFilePath  -> Annex (Maybe NumCopies, Maybe MinCopies)+getNumMinCopiesAttr :: OsPath  -> Annex (Maybe NumCopies, Maybe MinCopies) getNumMinCopiesAttr file = 	checkAttrs ["annex.numcopies", "annex.mincopies"] file >>= \case 		(n:m:[]) -> return@@ -196,12 +196,12 @@  - This is good enough for everything except dropping the file, which  - requires active verification of the copies.  -}-numCopiesCheck :: RawFilePath -> Key -> (Int -> Int -> v) -> Annex v+numCopiesCheck :: OsPath -> Key -> (Int -> Int -> v) -> Annex v numCopiesCheck file key vs = do 	have <- trustExclude UnTrusted =<< Remote.keyLocations key 	numCopiesCheck' file vs have -numCopiesCheck' :: RawFilePath -> (Int -> Int -> v) -> [UUID] -> Annex v+numCopiesCheck' :: OsPath -> (Int -> Int -> v) -> [UUID] -> Annex v numCopiesCheck' file vs have = do 	needed <- fst <$> getFileNumMinCopies file 	let nhave = numCopiesCount have
Annex/Path.hs view
@@ -40,20 +40,20 @@  - git-annex-shell or git-remote-annex, this finds a git-annex program  - instead.  -}-programPath :: IO FilePath+programPath :: IO OsPath programPath = go =<< getEnv "GIT_ANNEX_DIR"   where 	go (Just dir) = do 		name <- reqgitannex <$> getProgName-		return (dir </> name)+		return (toOsPath dir </> toOsPath name) 	go Nothing = do 		name <- getProgName 		exe <- if isgitannex name 			then getExecutablePath 			else pure "git-annex"-		p <- if isAbsolute exe+		p <- if isAbsolute (toOsPath exe) 			then return exe-			else fromMaybe exe <$> readProgramFile+			else maybe exe fromOsPath <$> readProgramFile 		maybe cannotFindProgram return =<< searchPath p  	reqgitannex name@@ -62,15 +62,15 @@ 	isgitannex = flip M.notMember otherMulticallCommands  {- Returns the path for git-annex that is recorded in the programFile. -}-readProgramFile :: IO (Maybe FilePath)+readProgramFile :: IO (Maybe OsPath) readProgramFile = catchDefaultIO Nothing $ do 	programfile <- programFile-	headMaybe . lines <$> readFile programfile+	fmap toOsPath . headMaybe . lines <$> readFile (fromOsPath programfile)  cannotFindProgram :: IO a cannotFindProgram = do 	f <- programFile-	giveup $ "cannot find git-annex program in PATH or in " ++ f+	giveup $ "cannot find git-annex program in PATH or in " ++ fromOsPath f  {- Runs a git-annex child process.  -@@ -88,7 +88,7 @@ gitAnnexChildProcess subcmd ps f a = do 	cmd <- liftIO programPath 	ps' <- gitAnnexChildProcessParams subcmd ps-	pidLockChildProcess cmd ps' f a+	pidLockChildProcess (fromOsPath cmd) ps' f a  {- Parameters to pass to a git-annex child process to run a subcommand  - with some parameters.
Annex/Perms.hs view
@@ -49,20 +49,20 @@ withShared :: (SharedRepository -> Annex a) -> Annex a withShared a = a =<< coreSharedRepository <$> Annex.getGitConfig -setAnnexFilePerm :: RawFilePath -> Annex ()+setAnnexFilePerm :: OsPath -> Annex () setAnnexFilePerm = setAnnexPerm False -setAnnexDirPerm :: RawFilePath -> Annex ()+setAnnexDirPerm :: OsPath -> Annex () setAnnexDirPerm = setAnnexPerm True  {- Sets appropriate file mode for a file or directory in the annex,  - other than the content files and content directory. Normally,  - don't change the mode, but with core.sharedRepository set,  - allow the group to write, etc. -}-setAnnexPerm :: Bool -> RawFilePath -> Annex ()+setAnnexPerm :: Bool -> OsPath -> Annex () setAnnexPerm isdir file = setAnnexPerm' Nothing isdir >>= \go -> liftIO (go file) -setAnnexPerm' :: Maybe ([FileMode] -> FileMode -> FileMode) -> Bool -> Annex (RawFilePath -> IO ())+setAnnexPerm' :: Maybe ([FileMode] -> FileMode -> FileMode) -> Bool -> Annex (OsPath -> IO ()) setAnnexPerm' modef isdir = ifM crippledFileSystem 	( return (const noop) 	, withShared $ \s -> return $ \file -> go s file@@ -79,11 +79,12 @@ 		Nothing -> noop 		Just f -> void $ tryIO $ 			modifyFileMode file $ f []-	go (UmaskShared n) file = void $ tryIO $ R.setFileMode file $-		if isdir then umaskSharedDirectory n else n+	go (UmaskShared n) file = void $ tryIO $+		R.setFileMode (fromOsPath file) $+			if isdir then umaskSharedDirectory n else n 	modef' = fromMaybe addModes modef -resetAnnexFilePerm :: RawFilePath -> Annex ()+resetAnnexFilePerm :: OsPath -> Annex () resetAnnexFilePerm = resetAnnexPerm False  {- Like setAnnexPerm, but ignores the current mode of the file entirely,@@ -94,7 +95,7 @@  - which is going to be moved to a non-temporary location and needs  - usual modes.  -}-resetAnnexPerm :: Bool -> RawFilePath -> Annex ()+resetAnnexPerm :: Bool -> OsPath -> Annex () resetAnnexPerm isdir file = unlessM crippledFileSystem $ do 	defmode <- liftIO defaultFileMode 	let modef moremodes _oldmode = addModes moremodes defmode@@ -115,7 +116,7 @@ {- Creates a directory inside the gitAnnexDir (or possibly the dbdir),   - creating any parent directories up to and including the gitAnnexDir.  - Makes directories with appropriate permissions. -}-createAnnexDirectory :: RawFilePath -> Annex ()+createAnnexDirectory :: OsPath -> Annex () createAnnexDirectory dir = do 	top <- parentDir <$> fromRepo gitAnnexDir 	tops <- annexDbDir <$> Annex.getGitConfig >>= return . \case@@ -124,7 +125,7 @@ 	createDirectoryUnder' tops dir createdir   where 	createdir p = do-		liftIO $ R.createDirectory p+		liftIO $ createDirectory p 		setAnnexDirPerm p  {- Create a directory in the git work tree, creating any parent@@ -132,7 +133,7 @@  -  - Uses default permissions.  -}-createWorkTreeDirectory :: RawFilePath -> Annex ()+createWorkTreeDirectory :: OsPath -> Annex () createWorkTreeDirectory dir = do 	fromRepo repoWorkTree >>= liftIO . \case 		Just wt -> createDirectoryUnder [wt] dir@@ -159,16 +160,16 @@  - it should not normally have. checkContentWritePerm can detect when  - that happens with write permissions.  -}-freezeContent :: RawFilePath -> Annex ()+freezeContent :: OsPath -> Annex () freezeContent file = 	withShared $ \sr -> freezeContent' sr file -freezeContent' :: SharedRepository -> RawFilePath -> Annex ()+freezeContent' :: SharedRepository -> OsPath -> Annex () freezeContent' sr file = freezeContent'' sr file =<< getVersion -freezeContent'' :: SharedRepository -> RawFilePath -> Maybe RepoVersion -> Annex ()+freezeContent'' :: SharedRepository -> OsPath -> Maybe RepoVersion -> Annex () freezeContent'' sr file rv = do-	fastDebug "Annex.Perms" ("freezing content " ++ fromRawFilePath file)+	fastDebug "Annex.Perms" ("freezing content " ++ fromOsPath file) 	unlessM crippledFileSystem $ go sr 	freezeHook file   where@@ -211,7 +212,7 @@  - support removing write permissions, so when there is such a hook  - write permissions are ignored.  -}-checkContentWritePerm :: RawFilePath -> Annex (Maybe Bool)+checkContentWritePerm :: OsPath -> Annex (Maybe Bool) checkContentWritePerm file = ifM crippledFileSystem 	( return (Just True) 	, do@@ -221,7 +222,7 @@ 			liftIO $ checkContentWritePerm' sr file rv hasfreezehook 	) -checkContentWritePerm' :: SharedRepository -> RawFilePath -> Maybe RepoVersion -> Bool -> IO (Maybe Bool)+checkContentWritePerm' :: SharedRepository -> OsPath -> Maybe RepoVersion -> Bool -> IO (Maybe Bool) checkContentWritePerm' sr file rv hasfreezehook 	| hasfreezehook = return (Just True) 	| otherwise = case sr of@@ -240,7 +241,7 @@ 			| otherwise -> want sharedret 				(\havemode -> havemode == removeModes writeModes n)   where-	want mk f = catchMaybeIO (fileMode <$> R.getFileStatus file)+	want mk f = catchMaybeIO (fileMode <$> R.getFileStatus (fromOsPath file)) 		>>= return . \case 			Just havemode -> mk (f havemode) 			Nothing -> mk True@@ -253,18 +254,19 @@  {- Allows writing to an annexed file that freezeContent was called on  - before. -}-thawContent :: RawFilePath -> Annex ()+thawContent :: OsPath -> Annex () thawContent file = withShared $ \sr -> thawContent' sr file -thawContent' :: SharedRepository -> RawFilePath -> Annex ()+thawContent' :: SharedRepository -> OsPath -> Annex () thawContent' sr file = do-	fastDebug "Annex.Perms" ("thawing content " ++ fromRawFilePath file)+	fastDebug "Annex.Perms" ("thawing content " ++ fromOsPath file) 	thawPerms (go sr) (thawHook file)   where 	go GroupShared = liftIO $ void $ tryIO $ groupWriteRead file 	go AllShared = liftIO $ void $ tryIO $ groupWriteRead file 	go UnShared = liftIO $ allowWrite file-	go (UmaskShared n) = liftIO $ void $ tryIO $ R.setFileMode file n+	go (UmaskShared n) = liftIO $ void $ tryIO $+		R.setFileMode (fromOsPath file) n  {- Runs an action that thaws a file's permissions. This will probably  - fail on a crippled filesystem. But, if file modes are supported on a@@ -281,9 +283,9 @@  - is set, this is not done, since the group must be allowed to delete the  - file without being able to thaw the directory.  -}-freezeContentDir :: RawFilePath -> Annex ()+freezeContentDir :: OsPath -> Annex () freezeContentDir file = do-	fastDebug "Annex.Perms" ("freezing content directory " ++ fromRawFilePath dir)+	fastDebug "Annex.Perms" ("freezing content directory " ++ fromOsPath dir) 	unlessM crippledFileSystem $ withShared go 	freezeHook dir   where@@ -291,29 +293,29 @@ 	go UnShared = liftIO $ preventWrite dir 	go GroupShared = liftIO $ void $ tryIO $ groupWriteRead dir 	go AllShared = liftIO $ void $ tryIO $ groupWriteRead dir-	go (UmaskShared n) = liftIO $ void $ tryIO $ R.setFileMode dir $+	go (UmaskShared n) = liftIO $ void $ tryIO $ R.setFileMode (fromOsPath dir) $ 		umaskSharedDirectory $ -			-- If n includes group or other write mode, leave them set-			-- to allow them to delete the file without being able to-			-- thaw the directory.+			-- If n includes group or other write mode, leave+			-- them set to allow them to delete the file without+			-- being able to thaw the directory. 			removeModes [ownerWriteMode] n -thawContentDir :: RawFilePath -> Annex ()+thawContentDir :: OsPath -> Annex () thawContentDir file = do-	fastDebug "Annex.Perms" ("thawing content directory " ++ fromRawFilePath dir)+	fastDebug "Annex.Perms" ("thawing content directory " ++ fromOsPath dir) 	thawPerms (withShared (liftIO . go)) (thawHook dir)   where 	dir = parentDir file 	go UnShared = allowWrite dir 	go GroupShared = allowWrite dir 	go AllShared = allowWrite dir-	go (UmaskShared n) = R.setFileMode dir n+	go (UmaskShared n) = R.setFileMode (fromOsPath dir) n  {- Makes the directory tree to store an annexed file's content,  - with appropriate permissions on each level. -}-createContentDir :: RawFilePath -> Annex ()+createContentDir :: OsPath -> Annex () createContentDir dest = do-	unlessM (liftIO $ R.doesPathExist dir) $+	unlessM (liftIO $ doesDirectoryExist dir) $ 		createAnnexDirectory dir  	-- might have already existed with restricted perms 	thawHook dir@@ -324,7 +326,7 @@ {- Creates the content directory for a file if it doesn't already exist,  - or thaws it if it does, then runs an action to modify a file in the  - directory, and finally, freezes the content directory. -}-modifyContentDir :: RawFilePath -> Annex a -> Annex a+modifyContentDir :: OsPath -> Annex a -> Annex a modifyContentDir f a = do 	createContentDir f -- also thaws it 	v <- tryNonAsync a@@ -333,7 +335,7 @@  {- Like modifyContentDir, but avoids creating the content directory if it  - does not already exist. In that case, the action will probably fail. -}-modifyContentDirWhenExists :: RawFilePath -> Annex a -> Annex a+modifyContentDirWhenExists :: OsPath -> Annex a -> Annex a modifyContentDirWhenExists f a = do 	thawContentDir f 	v <- tryNonAsync a@@ -352,11 +354,11 @@ 		<||> 	(doesAnnexHookExist thawContentAnnexHook) -freezeHook :: RawFilePath -> Annex ()+freezeHook :: OsPath -> Annex () freezeHook = void . runAnnexPathHook "%path" 	freezeContentAnnexHook annexFreezeContentCommand -thawHook :: RawFilePath -> Annex ()+thawHook :: OsPath -> Annex () thawHook = void . runAnnexPathHook "%path" 	thawContentAnnexHook annexThawContentCommand
Annex/Proxy.hs view
@@ -6,6 +6,7 @@  -}  {-# LANGUAGE CPP #-}+{-# LANGUAGE OverloadedStrings #-}  module Annex.Proxy where @@ -30,20 +31,24 @@ import Utility.Metered import Git.Types import qualified Database.Export as Export+import qualified Utility.FileIO as F #ifndef mingw32_HOST_OS import Utility.OpenFile #endif +#ifndef mingw32_HOST_OS import Control.Concurrent+#endif import Control.Concurrent.STM import Control.Concurrent.Async import qualified Data.ByteString as B-import qualified Data.ByteString as BS import qualified Data.ByteString.Lazy as L-import qualified System.FilePath.ByteString as P import qualified Data.Map as M import qualified Data.Set as S+#ifndef mingw32_HOST_OS+import qualified Data.ByteString as BS import System.IO.Unsafe+#endif  proxyRemoteSide :: ProtocolVersion -> Bypass -> Remote -> Annex RemoteSide proxyRemoteSide clientmaxversion bypass r@@ -173,8 +178,8 @@ 	-- independently. Also, this key is not getting added into the 	-- local annex objects. 	withproxytmpfile k a = withOtherTmp $ \othertmpdir ->-		withTmpDirIn (fromRawFilePath othertmpdir) "proxy" $ \tmpdir ->-			a (toRawFilePath tmpdir P.</> keyFile k)+		withTmpDirIn othertmpdir (literalOsPath "proxy") $ \tmpdir ->+			a (tmpdir </> keyFile k) 			 	proxyput af k = do 		liftIO $ sendmessage $ PUT_FROM (Offset 0)@@ -184,14 +189,14 @@ 				-- the client, to avoid bad content 				-- being stored in the special remote. 				iv <- startVerifyKeyContentIncrementally Remote.AlwaysVerify k-				h <- liftIO $ openFile (fromRawFilePath tmpfile) WriteMode-				let nuketmp = liftIO $ removeWhenExistsWith removeFile (fromRawFilePath tmpfile)+				h <- liftIO $ F.openFile tmpfile WriteMode+				let nuketmp = liftIO $ removeWhenExistsWith removeFile tmpfile 				gotall <- liftIO $ receivetofile iv h len 				liftIO $ hClose h 				verified <- if gotall 					then fst <$> finishVerifyKeyContentIncrementally' True iv 					else pure False-				let store = tryNonAsync (storeput k af (decodeBS tmpfile)) >>= \case+				let store = tryNonAsync (storeput k af tmpfile) >>= \case 					Right () -> liftIO $ sendmessage SUCCESS 					Left err -> liftIO $ propagateerror err 				if protoversion > ProtocolVersion 1@@ -258,9 +263,13 @@ 		storetofile iv h (n - fromIntegral (B.length b)) bs  	proxyget offset af k = withproxytmpfile k $ \tmpfile -> do-		let retrieve = tryNonAsync $ Remote.retrieveKeyFile r k af-			(fromRawFilePath tmpfile) nullMeterUpdate vc+		let retrieve = tryNonAsync $ Remote.retrieveKeyFile+			r k af tmpfile nullMeterUpdate vc+#ifndef mingw32_HOST_OS 		ordered <- Remote.retrieveKeyFileInOrder r+#else+		_ <- Remote.retrieveKeyFileInOrder r+#endif 		case fromKey keySize k of #ifndef mingw32_HOST_OS 			Just size | size > 0 && ordered -> do@@ -290,7 +299,7 @@ 		sendlen offset size 		waitforfile 		x <- tryNonAsync $ do-			h <- openFileBeingWritten f+			h <- openFileBeingWritten (fromOsPath f) 			hSeek h AbsoluteSeek offset 			senddata' h (getcontents size) 		case x of@@ -342,7 +351,7 @@ 	senddata (Offset offset) f = do 		size <- fromIntegral <$> getFileSize f 		sendlen offset size-		withBinaryFile (fromRawFilePath f) ReadMode $ \h -> do+		F.withBinaryFile f ReadMode $ \h -> do 			hSeek h AbsoluteSeek offset 			senddata' h L.hGetContents
Annex/Queue.hs view
@@ -31,7 +31,7 @@ 	store =<< flushWhenFull =<< 		(Git.Queue.addCommand commonparams command params files q =<< gitRepo) -addFlushAction :: Git.Queue.FlushActionRunner Annex -> [RawFilePath] -> Annex ()+addFlushAction :: Git.Queue.FlushActionRunner Annex -> [OsPath] -> Annex () addFlushAction runner files = do 	q <- get 	store =<< flushWhenFull =<<
Annex/ReplaceFile.hs view
@@ -1,12 +1,10 @@ {- git-annex file replacing  -- - Copyright 2013-2021 Joey Hess <id@joeyh.name>+ - Copyright 2013-2025 Joey Hess <id@joeyh.name>  -  - Licensed under the GNU AGPL version 3 or higher.  -} -{-# LANGUAGE CPP #-}- module Annex.ReplaceFile ( 	replaceGitAnnexDirFile, 	replaceGitDirFile,@@ -19,24 +17,22 @@ import Annex.Tmp import Annex.Perms import Git+import Utility.Tmp import Utility.Tmp.Dir import Utility.Directory.Create-#ifndef mingw32_HOST_OS-import Utility.Path.Max-#endif  {- replaceFile on a file located inside the gitAnnexDir. -}-replaceGitAnnexDirFile :: FilePath -> (RawFilePath -> Annex a) -> Annex a+replaceGitAnnexDirFile :: OsPath -> (OsPath -> Annex a) -> Annex a replaceGitAnnexDirFile = replaceFile createAnnexDirectory  {- replaceFile on a file located inside the .git directory. -}-replaceGitDirFile :: FilePath -> (RawFilePath -> Annex a) -> Annex a+replaceGitDirFile :: OsPath -> (OsPath -> Annex a) -> Annex a replaceGitDirFile = replaceFile $ \dir -> do 	top <- fromRepo localGitDir 	liftIO $ createDirectoryUnder [top] dir  {- replaceFile on a worktree file. -}-replaceWorkTreeFile :: FilePath -> (RawFilePath -> Annex a) -> Annex a+replaceWorkTreeFile :: OsPath -> (OsPath -> Annex a) -> Annex a replaceWorkTreeFile = replaceFile createWorkTreeDirectory  {- Replaces a possibly already existing file with a new version, @@ -54,31 +50,20 @@  - The createdirectory action is only run when moving the file into place  - fails, and can create any parent directory structure needed.  -}-replaceFile :: (RawFilePath -> Annex ()) -> FilePath -> (RawFilePath -> Annex a) -> Annex a+replaceFile :: (OsPath -> Annex ()) -> OsPath -> (OsPath -> Annex a) -> Annex a replaceFile createdirectory file action = replaceFile' createdirectory file (const True) action -replaceFile' :: (RawFilePath -> Annex ()) -> FilePath -> (a -> Bool) -> (RawFilePath -> Annex a) -> Annex a+replaceFile' :: (OsPath -> Annex ()) -> OsPath -> (a -> Bool) -> (OsPath -> Annex a) -> Annex a replaceFile' createdirectory file checkres action = withOtherTmp $ \othertmpdir -> do-	let othertmpdir' = fromRawFilePath othertmpdir-#ifndef mingw32_HOST_OS-	-- Use part of the filename as the template for the temp-	-- directory. This does not need to be unique, but it-	-- makes it more clear what this temp directory is for.-	filemax <- liftIO $ fileNameLengthLimit othertmpdir'-	let basetmp = take (filemax `div` 2) (takeFileName file)-#else-	-- Windows has limits on the whole path length, so keep-	-- it short.-	let basetmp = "t"-#endif-	withTmpDirIn othertmpdir' basetmp $ \tmpdir -> do-		let tmpfile = toRawFilePath (tmpdir </> basetmp)+	let basetmp = relatedTemplate (fromOsPath (takeFileName file))+	withTmpDirIn othertmpdir basetmp $ \tmpdir -> do+		let tmpfile = tmpdir </> basetmp 		r <- action tmpfile 		when (checkres r) $-			replaceFileFrom tmpfile (toRawFilePath file) createdirectory+			replaceFileFrom tmpfile file createdirectory 		return r -replaceFileFrom :: RawFilePath -> RawFilePath -> (RawFilePath -> Annex ()) -> Annex ()+replaceFileFrom :: OsPath -> OsPath -> (OsPath -> Annex ()) -> Annex () replaceFileFrom src dest createdirectory = go `catchIO` fallback   where 	go = liftIO $ moveFile src dest
Annex/RepoSize/LiveUpdate.hs view
@@ -23,8 +23,6 @@ import Control.Concurrent import Text.Read import Data.Time.Clock.POSIX-import qualified Utility.RawFilePath as R-import qualified System.FilePath.ByteString as P  {- Called when a location log change is journalled, so the LiveUpdate  - is done. This is called with the journal still locked, so no concurrent@@ -146,12 +144,11 @@ checkStaleSizeChanges h@(RepoSizeHandle (Just _) livev) = do 	livedir <- calcRepo' gitAnnexRepoSizeLiveDir 	pid <- liftIO getPID-	let pidlockfile = show pid+	let pidlockfile = toOsPath (show pid) 	now <- liftIO getPOSIXTime 	liftIO (takeMVar livev) >>= \case 		Nothing -> do-			lck <- takeExclusiveLock $-				livedir P.</> toRawFilePath pidlockfile+			lck <- takeExclusiveLock $ livedir </> pidlockfile 			go livedir lck pidlockfile now 		Just v@(lck, lastcheck) 			| now >= lastcheck + 60 ->@@ -161,11 +158,11 @@   where 	go livedir lck pidlockfile now = do 		void $ tryNonAsync $ do-			lockfiles <- liftIO $ filter (not . dirCruft) -				<$> getDirectoryContents (fromRawFilePath livedir)+			lockfiles <- liftIO $ filter (`notElem` dirCruft)+				<$> getDirectoryContents livedir 			stale <- forM lockfiles $ \lockfile -> 				if (lockfile /= pidlockfile)-					then case readMaybe lockfile of+					then case readMaybe (fromOsPath lockfile) of 						Nothing -> return Nothing 						Just pid -> checkstale livedir lockfile pid 					else return Nothing@@ -176,7 +173,7 @@ 		liftIO $ putMVar livev (Just (lck, now))  	checkstale livedir lockfile pid =-		let f = livedir P.</> toRawFilePath lockfile+		let f = livedir </> lockfile 		in trySharedLock f >>= \case 			Nothing -> return Nothing 			Just lck -> do@@ -184,6 +181,6 @@ 					( StaleSizeChanger (SizeChangeProcessId pid) 					, do 						dropLock lck-						removeWhenExistsWith R.removeLink f+						removeWhenExistsWith removeFile f 					) checkStaleSizeChanges (RepoSizeHandle Nothing _) = noop
Annex/Sim.hs view
@@ -55,8 +55,6 @@ import qualified Data.ByteString.Lazy as L import qualified Data.UUID as U import qualified Data.UUID.V5 as U5-import qualified Utility.RawFilePath as R-import qualified System.FilePath.ByteString as P  data SimState t = SimState 	{ simRepos :: M.Map RepoName UUID@@ -342,7 +340,7 @@ 			_ -> return ("sh", ["-c", unwords cmdparams]) 		exitcode <- liftIO $ 			safeSystem' cmd (map Param params)-				(\p -> p { cwd = Just dir })+				(\p -> p { cwd = Just (fromOsPath dir) }) 		when (null cmdparams) $ 			showLongNote "Finished visit to simulated repository." 		if null cmdparams@@ -431,7 +429,7 @@ 				<$> inRepo (toTopFilePath f) 			ifM (checkMatcher matcher (Just k) afile NoLiveUpdate mempty (pure False) (pure False)) 				( let st'' = setPresentKey True (u, repo) k u $ st'-					{ simFiles = M.insert f k (simFiles st')+					{ simFiles = M.insert (fromOsPath f) k (simFiles st') 					} 				  in go matcher u st'' fs 				, go matcher u st' fs @@ -758,7 +756,7 @@ 		Right (Left (st, map (go remoteu) $ M.toList $ simFiles st))   where 	go remoteu (f, k) st' = -	  	let af = AssociatedFile $ Just f+	  	let af = AssociatedFile $ Just $ toOsPath f 		in liftIO $ runSimRepo u st' $ \st'' rst -> 			case M.lookup remoteu (simRepoState st'') of 				Nothing -> return (st'', False)@@ -814,7 +812,7 @@ 	Right $ Left (st, map go $ M.toList $ simFiles st)   where 	go (f, k) st' = liftIO $ runSimRepo u st' $ \st'' rst ->-		let af = AssociatedFile $ Just f+		let af = AssociatedFile $ Just $ toOsPath f 		in if present dropfrom rst k 			then updateLiveSizeChanges rst $ 				ifM (wantDrop NoLiveUpdate False (Just dropfrom) (Just k) af Nothing)@@ -1104,7 +1102,7 @@ 	go st ((u, rst):rest) = 		case simRepo rst of 			Nothing -> do-				let d = simRepoDirectory st u+				let d = fromOsPath $ simRepoDirectory st u 				sr <- initSimRepo (simRepoName rst) u d st 				let rst' = rst { simRepo = Just sr } 				let st' = st@@ -1114,8 +1112,8 @@ 				go st' rest 			_ -> go st rest -simRepoDirectory :: SimState t -> UUID -> FilePath-simRepoDirectory st u = simRootDirectory st </> fromUUID u+simRepoDirectory :: SimState t -> UUID -> OsPath+simRepoDirectory st u = toOsPath (simRootDirectory st) </> fromUUID u  initSimRepo :: RepoName -> UUID -> FilePath -> SimState SimRepo -> IO SimRepo initSimRepo simreponame u dest st = do@@ -1126,7 +1124,7 @@ 		] 	unless inited $ 		giveup "git init failed"-	simrepo <- Git.Construct.fromPath (toRawFilePath dest)+	simrepo <- Git.Construct.fromPath (toOsPath dest) 	ast <- Annex.new simrepo 	((), ast') <- Annex.run ast $ doQuietAction $ do 		storeUUID u@@ -1301,15 +1299,14 @@ 	setdesc r u = describeUUID u $ toUUIDDesc $ 		simulatedRepositoryDescription r 	stageannexedfile f k = do-		let f' = annexedfilepath f+		let f' = annexedfilepath (toOsPath f) 		l <- calcRepo $ gitAnnexLink f' k-		liftIO $ createDirectoryIfMissing True $-			takeDirectory $ fromRawFilePath f'-		addAnnexLink l f'-	unstageannexedfile f = do-		liftIO $ removeWhenExistsWith R.removeLink $-			annexedfilepath f-	annexedfilepath f = repoPath (simRepoGitRepo sr) P.</> f+		liftIO $ createDirectoryIfMissing True $ takeDirectory f'+		addAnnexLink (fromOsPath l) f'+	unstageannexedfile f =+		liftIO $ removeWhenExistsWith removeFile $+			annexedfilepath (toOsPath f)+	annexedfilepath f = repoPath (simRepoGitRepo sr) </> f 	getlocations = maybe mempty simLocations 		. M.lookup (simRepoUUID sr) 		. simRepoState@@ -1359,19 +1356,21 @@ 	let st'' = st' 		{ simRepoState = M.map freeze (simRepoState st') 		}-	writeFile (simRootDirectory st'' </> "state") (show st'')+	let statefile = fromOsPath $ +		toOsPath (simRootDirectory st'') </> literalOsPath "state"+	writeFile statefile (show st'')   where 	freeze :: SimRepoState SimRepo -> SimRepoState () 	freeze rst = rst { simRepo = Nothing } -restoreSim :: RawFilePath -> IO (Either String (SimState SimRepo))+restoreSim :: OsPath -> IO (Either String (SimState SimRepo)) restoreSim rootdir = -	tryIO (readFile (fromRawFilePath rootdir </> "state")) >>= \case+	tryIO (readFile statefile) >>= \case 		Left err -> return (Left (show err)) 		Right c -> case readMaybe c :: Maybe (SimState ()) of 			Nothing -> return (Left "unable to parse sim state file") 			Just st -> do-				let st' = st { simRootDirectory = fromRawFilePath rootdir }+				let st' = st { simRootDirectory = fromOsPath rootdir } 				repostate <- M.fromList 					<$> mapM (thaw st') (M.toList (simRepoState st)) 				let st'' = st'@@ -1380,12 +1379,12 @@ 					} 				return (Right st'')   where+	statefile = fromOsPath $ rootdir </> literalOsPath "state" 	thaw st (u, rst) = tryNonAsync (thaw' st u) >>= return . \case 		Left _ -> (u, rst { simRepo = Nothing }) 		Right r -> (u, rst { simRepo = Just r }) 	thaw' st u = do-		simrepo <- Git.Construct.fromPath $ toRawFilePath $-			simRepoDirectory st u+		simrepo <- Git.Construct.fromPath $ simRepoDirectory st u 		ast <- Annex.new simrepo 		return $ SimRepo 			{ simRepoGitRepo = simrepo
Annex/Ssh.hs view
@@ -5,6 +5,7 @@  - Licensed under the GNU AGPL version 3 or higher.  -} +{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE CPP #-}  module Annex.Ssh (@@ -38,15 +39,14 @@ import Types.Concurrency import Git.Env import Git.Ssh-import qualified Utility.RawFilePath as R+import qualified Utility.OsString as OS import Annex.Perms #ifndef mingw32_HOST_OS import Annex.LockPool #endif  import Control.Concurrent.STM-import qualified Data.ByteString as S-import qualified System.FilePath.ByteString as P+import qualified Data.ByteString.Short as SBS  {- Some ssh commands are fed stdin on a pipe and so should be allowed to  - consume it. But ssh commands that are not piped stdin should generally@@ -100,15 +100,16 @@  {- Returns a filename to use for a ssh connection caching socket, and  - parameters to enable ssh connection caching. -}-sshCachingInfo :: (SshHost, Maybe Integer) -> Annex (Maybe FilePath, [CommandParam])+sshCachingInfo :: (SshHost, Maybe Integer) -> Annex (Maybe OsPath, [CommandParam]) sshCachingInfo (host, port) = go =<< sshCacheDir'   where 	go (Right dir) =-		liftIO (bestSocketPath $ dir P.</> hostport2socket host port) >>= return . \case+		liftIO (bestSocketPath $ dir </> hostport2socket host port) >>= return . \case 			Nothing -> (Nothing, []) 			Just socketfile -> -				let socketfile' = fromRawFilePath socketfile-				in (Just socketfile', sshConnectionCachingParams socketfile')+				(Just socketfile+				, sshConnectionCachingParams (fromOsPath socketfile)+				) 	-- No connection caching with concurrency is not a good 	-- combination, so warn the user. 	go (Left whynocaching) = do@@ -135,10 +136,10 @@  - file.  -  - If no path can be constructed that is a valid socket, returns Nothing. -}-bestSocketPath :: RawFilePath -> IO (Maybe RawFilePath)+bestSocketPath :: OsPath -> IO (Maybe OsPath) bestSocketPath abssocketfile = do 	relsocketfile <- liftIO $ relPathCwdToFile abssocketfile-	let socketfile = if S.length abssocketfile <= S.length relsocketfile+	let socketfile = if OS.length abssocketfile <= OS.length relsocketfile 		then abssocketfile 		else relsocketfile 	return $ if valid_unix_socket_path socketfile sshgarbagelen@@ -165,10 +166,10 @@  -   - The directory will be created if it does not exist.  -}-sshCacheDir :: Annex (Maybe RawFilePath)+sshCacheDir :: Annex (Maybe OsPath) sshCacheDir = eitherToMaybe <$> sshCacheDir' -sshCacheDir' :: Annex (Either String RawFilePath)+sshCacheDir' :: Annex (Either String OsPath) sshCacheDir' =  	ifM (fromMaybe BuildInfo.sshconnectioncaching . annexSshCaching <$> Annex.getGitConfig) 		( ifM crippledFileSystem@@ -189,9 +190,9 @@ 	gettmpdir = liftIO $ getEnv sshSocketDirEnv  	usetmpdir tmpdir = do-		let socktmp = tmpdir </> "ssh"+		let socktmp = toOsPath tmpdir </> literalOsPath "ssh" 		createDirectoryIfMissing True socktmp-		return (toRawFilePath socktmp)+		return socktmp 	 	crippledfswarning = unwords 		[ "This repository is on a crippled filesystem, so unix named"@@ -214,7 +215,7 @@  - Locks the socket lock file to prevent other git-annex processes from  - stopping the ssh multiplexer on this socket.  -}-prepSocket :: FilePath -> SshHost -> [CommandParam] -> Annex ()+prepSocket :: OsPath -> SshHost -> [CommandParam] -> Annex () prepSocket socketfile sshhost sshparams = do 	-- There could be stale ssh connections hanging around 	-- from a previous git-annex run that was interrupted.@@ -286,13 +287,13 @@  - and this check makes such files be skipped since the corresponding lock  - file won't exist.  -}-enumSocketFiles :: Annex [FilePath]+enumSocketFiles :: Annex [OsPath] enumSocketFiles = liftIO . go =<< sshCacheDir   where 	go Nothing = return []-	go (Just dir) = filterM (R.doesPathExist . socket2lock)+	go (Just dir) = filterM (doesPathExist . socket2lock) 		=<< filter (not . isLock)-		<$> catchDefaultIO [] (dirContents (fromRawFilePath dir))+		<$> catchDefaultIO [] (dirContents dir)  {- Stop any unused ssh connection caching processes. -} sshCleanup :: Annex ()@@ -324,45 +325,45 @@ forceSshCleanup :: Annex () forceSshCleanup = mapM_ forceStopSsh =<< enumSocketFiles -forceStopSsh :: FilePath -> Annex ()+forceStopSsh :: OsPath -> Annex () forceStopSsh socketfile = withNullHandle $ \nullh -> do 	let (dir, base) = splitFileName socketfile 	let p = (proc "ssh" $ toCommand $ 		[ Param "-O", Param "stop" ] ++ -		sshConnectionCachingParams base ++ +		sshConnectionCachingParams (fromOsPath base) ++  		[Param "localhost"])-		{ cwd = Just dir+		{ cwd = Just (fromOsPath dir) 		-- "ssh -O stop" is noisy on stderr even with -q 		, std_out = UseHandle nullh 		, std_err = UseHandle nullh 		} 	void $ liftIO $ catchMaybeIO $ withCreateProcess p $ \_ _ _ pid -> 		forceSuccessProcess p pid-	liftIO $ removeWhenExistsWith R.removeLink (toRawFilePath socketfile)+	liftIO $ removeWhenExistsWith removeFile socketfile  {- This needs to be as short as possible, due to limitations on the length  - of the path to a socket file. At the same time, it needs to be unique  - for each host.  -}-hostport2socket :: SshHost -> Maybe Integer -> RawFilePath+hostport2socket :: SshHost -> Maybe Integer -> OsPath hostport2socket host Nothing = hostport2socket' $ fromSshHost host hostport2socket host (Just port) = hostport2socket' $ 	fromSshHost host ++ "!" ++ show port-hostport2socket' :: String -> RawFilePath+hostport2socket' :: String -> OsPath hostport2socket' s-	| length s > lengthofmd5s = toRawFilePath $ show $ md5 $ encodeBL s-	| otherwise = toRawFilePath s+	| length s > lengthofmd5s = toOsPath $ show $ md5 $ encodeBL s+	| otherwise = toOsPath s   where 	lengthofmd5s = 32 -socket2lock :: FilePath -> RawFilePath-socket2lock socket = toRawFilePath (socket ++ lockExt)+socket2lock :: OsPath -> OsPath+socket2lock socket = socket <> lockExt -isLock :: FilePath -> Bool-isLock f = lockExt `isSuffixOf` f+isLock :: OsPath -> Bool+isLock f = lockExt `OS.isSuffixOf` f -lockExt :: String-lockExt = ".lock"+lockExt :: OsPath+lockExt = literalOsPath ".lock"  {- This is the size of the sun_path component of sockaddr_un, which  - is the limit to the total length of the filename of a unix socket.@@ -374,8 +375,9 @@  {- Note that this looks at the true length of the path in bytes, as it will  - appear on disk. -}-valid_unix_socket_path :: RawFilePath -> Int -> Bool-valid_unix_socket_path f n = S.length f + n < sizeof_sockaddr_un_sun_path+valid_unix_socket_path :: OsPath -> Int -> Bool+valid_unix_socket_path f n = +	SBS.length (fromOsPath f) + n < sizeof_sockaddr_un_sun_path  {- Parses the SSH port, and returns the other OpenSSH options. If  - several ports are found, the last one takes precedence. -}@@ -461,7 +463,7 @@ 				liftIO $ do 					localr' <- addGitEnv localr sshOptionsEnv 						(toSshOptionsEnv sshopts)-					addGitEnv localr' gitSshEnv command+					addGitEnv localr' gitSshEnv (fromOsPath command)  runSshOptions :: [String] -> String -> IO () runSshOptions args s = do
Annex/Tmp.hs view
@@ -23,7 +23,7 @@ -- directory that is passed to it. However, once the action is done, -- any files left in that directory may be cleaned up by another process at -- any time.-withOtherTmp :: (RawFilePath -> Annex a) -> Annex a+withOtherTmp :: (OsPath -> Annex a) -> Annex a withOtherTmp a = do 	Annex.addCleanupAction OtherTmpCleanup cleanupOtherTmp 	tmpdir <- fromRepo gitAnnexTmpOtherDir@@ -40,14 +40,14 @@ -- Unlike withOtherTmp, this does not rely on locking working. -- Its main use is in situations where the state of lockfile is not -- determined yet, eg during initialization.-withEventuallyCleanedOtherTmp :: (RawFilePath -> Annex a) -> Annex a+withEventuallyCleanedOtherTmp :: (OsPath -> Annex a) -> Annex a withEventuallyCleanedOtherTmp = bracket setup cleanup   where 	setup = do 		tmpdir <- fromRepo gitAnnexTmpOtherDirOld 		void $ createAnnexDirectory tmpdir 		return tmpdir-	cleanup = liftIO . void . tryIO . removeDirectory . fromRawFilePath+	cleanup = liftIO . void . tryIO . removeDirectory  -- | Cleans up any tmp files that were left by a previous -- git-annex process that got interrupted or failed to clean up after@@ -58,17 +58,18 @@ cleanupOtherTmp = do 	tmplck <- fromRepo gitAnnexTmpOtherLock 	void $ tryIO $ tryExclusiveLock tmplck $ do-		tmpdir <- fromRawFilePath <$> fromRepo gitAnnexTmpOtherDir+		tmpdir <- fromRepo gitAnnexTmpOtherDir 		void $ liftIO $ tryIO $ removeDirectoryRecursive tmpdir-		oldtmp <- fromRawFilePath <$> fromRepo gitAnnexTmpOtherDirOld+		oldtmp <- fromRepo gitAnnexTmpOtherDirOld 		liftIO $ mapM_ cleanold 			=<< emptyWhenDoesNotExist (dirContentsRecursive oldtmp)-		liftIO $ void $ tryIO $ removeDirectory oldtmp -- when empty+		-- remove when empty+		liftIO $ void $ tryIO $ removeDirectory oldtmp   where 	cleanold f = do 		now <- liftIO getPOSIXTime 		let oldenough = now - (60 * 60 * 24 * 7)-		catchMaybeIO (modificationTime <$> R.getSymbolicLinkStatus (toRawFilePath f)) >>= \case+		catchMaybeIO (modificationTime <$> R.getSymbolicLinkStatus (fromOsPath f)) >>= \case 			Just mtime | realToFrac mtime <= oldenough -> -				void $ tryIO $ removeWhenExistsWith R.removeLink (toRawFilePath f)+				void $ tryIO $ removeWhenExistsWith removeFile f 			_ -> return ()
Annex/Transfer.hs view
@@ -44,13 +44,11 @@ import Annex.StallDetection import Backend (isCryptographicallySecureKey) import Types.StallDetection-import qualified Utility.RawFilePath as R  import Control.Concurrent import Control.Concurrent.Async import Control.Concurrent.STM hiding (retry) import qualified Data.Map.Strict as M-import qualified System.FilePath.ByteString as P import Data.Ord  -- Upload, supporting canceling detected stalls.@@ -80,10 +78,10 @@ 		Just StallDetectionDisabled -> go Nothing 		Just sd -> runTransferrer sd r key f d Download witness   where-	go sd = getViaTmp (Remote.retrievalSecurityPolicy r) vc key f Nothing $ \dest ->+	go sd = getViaTmp (Remote.retrievalSecurityPolicy r) vc key Nothing $ \dest -> 		download' (Remote.uuid r) key f sd d (go' dest) witness 	go' dest p = verifiedAction $-		Remote.retrieveKeyFile r key f (fromRawFilePath dest) p vc+		Remote.retrieveKeyFile r key f dest p vc 	vc = Remote.RemoteVerify r  -- Download, not supporting canceling detected stalls.@@ -146,10 +144,10 @@ 					else recordFailedTransfer t info 				return v 	-	prep :: RawFilePath -> Maybe RawFilePath -> Annex () -> ModeSetter -> Annex (Maybe (LockHandle, Maybe LockHandle), Bool)+	prep :: OsPath -> Maybe OsPath -> Annex () -> ModeSetter -> Annex (Maybe (LockHandle, Maybe LockHandle), Bool) #ifndef mingw32_HOST_OS 	prep lckfile moldlckfile createtfile mode = catchPermissionDenied (const prepfailed) $ do-		createAnnexDirectory $ P.takeDirectory lckfile+		createAnnexDirectory $ takeDirectory lckfile 		tryLockExclusive (Just mode) lckfile >>= \case 			Nothing -> return (Nothing, True) 			-- Since the lock file is removed in cleanup,@@ -163,7 +161,7 @@ 						createtfile 						return (Just (lockhandle, Nothing), False) 					Just oldlckfile -> do-						createAnnexDirectory $ P.takeDirectory oldlckfile+						createAnnexDirectory $ takeDirectory oldlckfile 						tryLockExclusive (Just mode) oldlckfile >>= \case 							Nothing -> do 								liftIO $ dropLock lockhandle@@ -183,14 +181,14 @@ 				) #else 	prep lckfile moldlckfile createtfile _mode = catchPermissionDenied (const prepfailed) $ do-		createAnnexDirectory $ P.takeDirectory lckfile+		createAnnexDirectory $ takeDirectory lckfile 		catchMaybeIO (liftIO $ lockExclusive lckfile) >>= \case 			Just (Just lockhandle) -> case moldlckfile of 				Nothing -> do 					createtfile 					return (Just (lockhandle, Nothing), False) 				Just oldlckfile -> do-					createAnnexDirectory $ P.takeDirectory oldlckfile+					createAnnexDirectory $ takeDirectory oldlckfile 					catchMaybeIO (liftIO $ lockExclusive oldlckfile) >>= \case 						Just (Just oldlockhandle) -> do 							createtfile@@ -204,10 +202,10 @@  	cleanup _ _ _ Nothing = noop 	cleanup tfile lckfile moldlckfile (Just (lockhandle, moldlockhandle)) = do-		void $ tryIO $ R.removeLink tfile+		void $ tryIO $ removeFile tfile #ifndef mingw32_HOST_OS-		void $ tryIO $ R.removeLink lckfile-		maybe noop (void . tryIO . R.removeLink) moldlckfile+		void $ tryIO $ removeFile lckfile+		maybe noop (void . tryIO . removeFile) moldlckfile 		maybe noop dropLock moldlockhandle 		dropLock lockhandle #else@@ -218,8 +216,8 @@ 		 -} 		maybe noop dropLock moldlockhandle 		dropLock lockhandle-		void $ tryIO $ R.removeLink lckfile-		maybe noop (void . tryIO . R.removeLink) moldlckfile+		void $ tryIO $ removeFile lckfile+		maybe noop (void . tryIO . removeFile) moldlckfile #endif  	retry numretries oldinfo metervar run =
Annex/TransferrerPool.hs view
@@ -43,7 +43,7 @@  mkRunTransferrer :: BatchCommandMaker -> Annex RunTransferrer mkRunTransferrer batchmaker = RunTransferrer-	<$> liftIO programPath+	<$> liftIO (fromOsPath <$> programPath) 	<*> gitAnnexChildProcessParams "transferrer" [] 	<*> pure batchmaker
Annex/Url.hs view
@@ -174,13 +174,13 @@ 		Right r -> return r 		Left err -> warning (UnquotedString err) >> return False -download :: MeterUpdate -> Maybe IncrementalVerifier -> U.URLString -> FilePath -> U.UrlOptions -> Annex Bool+download :: MeterUpdate -> Maybe IncrementalVerifier -> U.URLString -> OsPath -> U.UrlOptions -> Annex Bool download meterupdate iv url file uo = 	liftIO (U.download meterupdate iv url file uo) >>= \case 		Right () -> return True 		Left err -> warning (UnquotedString err) >> return False -download' :: MeterUpdate -> Maybe IncrementalVerifier -> U.URLString -> FilePath -> U.UrlOptions -> Annex (Either String ())+download' :: MeterUpdate -> Maybe IncrementalVerifier -> U.URLString -> OsPath -> U.UrlOptions -> Annex (Either String ()) download' meterupdate iv url file uo = 	liftIO (U.download meterupdate iv url file uo)
Annex/VariantFile.hs view
@@ -5,21 +5,24 @@  - Licensed under the GNU AGPL version 3 or higher.  -} +{-# LANGUAGE OverloadedStrings #-}+ module Annex.VariantFile where  import Annex.Common import Utility.Hash+import qualified Utility.OsString as OS  import qualified Data.ByteString as S -variantMarker :: String-variantMarker = ".variant-"+variantMarker :: OsPath+variantMarker = literalOsPath ".variant-" -mkVariant :: FilePath -> String -> FilePath+mkVariant :: OsPath -> OsPath -> OsPath mkVariant file variant = takeDirectory file 	</> dropExtension (takeFileName file)-	++ variantMarker ++ variant-	++ takeExtension file+	<> variantMarker <> variant+	<> takeExtension file  {- The filename to use when resolving a conflicted merge of a file,  - that points to a key.@@ -34,12 +37,12 @@  - conflicted merge resolution code. That case is detected, and the full  - key is used in the filename.  -}-variantFile :: FilePath -> Key -> FilePath+variantFile :: OsPath -> Key -> OsPath variantFile file key-	| doubleconflict = mkVariant file (fromRawFilePath (keyFile key))-	| otherwise = mkVariant file (shortHash $ serializeKey' key)+	| doubleconflict = mkVariant file (keyFile key)+	| otherwise = mkVariant file (toOsPath (shortHash $ serializeKey' key))   where-	doubleconflict = variantMarker `isInfixOf` file+	doubleconflict = variantMarker `OS.isInfixOf` file  shortHash :: S.ByteString -> String shortHash = take 4 . show . md5s
Annex/VectorClock.hs view
@@ -21,6 +21,7 @@ import Utility.TimeStamp  import Data.ByteString.Builder+import qualified Data.ByteString as B import qualified Data.Attoparsec.ByteString.Lazy as A  currentVectorClock :: Annex CandidateVectorClock@@ -76,7 +77,7 @@ buildVectorClock :: VectorClock -> Builder buildVectorClock = string7 . formatVectorClock -parseVectorClock :: String -> Maybe VectorClock+parseVectorClock :: B.ByteString -> Maybe VectorClock parseVectorClock t = VectorClock <$> parsePOSIXTime t  vectorClockParser :: A.Parser VectorClock
Annex/VectorClock/Utility.hs view
@@ -12,12 +12,13 @@ import Types.VectorClock import Utility.Env import Utility.TimeStamp+import Utility.FileSystemEncoding  startVectorClock :: IO (IO CandidateVectorClock) startVectorClock = go =<< getEnv "GIT_ANNEX_VECTOR_CLOCK"   where 	go Nothing = timebased-	go (Just s) = case parsePOSIXTime s of+	go (Just s) = case parsePOSIXTime (encodeBS s) of 		Just t -> return (pure (CandidateVectorClock t)) 		Nothing -> timebased 	-- Avoid using fractional seconds in the CandidateVectorClock.
Annex/Verify.hs view
@@ -39,13 +39,13 @@ import Annex.WorkerPool import Types.WorkerPool import Types.Key+import qualified Utility.FileIO as F  import Control.Concurrent.STM import Control.Concurrent.Async import qualified Data.ByteString as S #if WITH_INOTIFY import qualified System.INotify as INotify-import qualified System.FilePath.ByteString as P #endif  shouldVerify :: VerifyConfig -> Annex Bool@@ -73,7 +73,7 @@  - If the RetrievalSecurityPolicy requires verification and the key's  - backend doesn't support it, the verification will fail.  -}-verifyKeyContentPostRetrieval :: RetrievalSecurityPolicy -> VerifyConfig -> Verification -> Key -> RawFilePath -> Annex Bool+verifyKeyContentPostRetrieval :: RetrievalSecurityPolicy -> VerifyConfig -> Verification -> Key -> OsPath -> Annex Bool verifyKeyContentPostRetrieval rsp v verification k f = case (rsp, verification) of 	(_, Verified) -> return True 	(RetrievalVerifiableKeysSecure, _) -> ifM (isVerifiable k)@@ -105,11 +105,11 @@ -- When possible, does an incremental verification, because that can be -- faster. Eg, the VURL backend can need to try multiple checksums and only -- with an incremental verification does it avoid reading files twice.-verifyKeyContent :: Key -> RawFilePath -> Annex Bool+verifyKeyContent :: Key -> OsPath -> Annex Bool verifyKeyContent k f = verifyKeySize k f <&&> verifyKeyContent' k f  -- Does not verify size.-verifyKeyContent' :: Key -> RawFilePath -> Annex Bool+verifyKeyContent' :: Key -> OsPath -> Annex Bool verifyKeyContent' k f =  	Backend.maybeLookupBackendVariety (fromKey keyVariety k) >>= \case 		Nothing -> return True@@ -119,7 +119,7 @@ 				iv <- mkiv k 				showAction (UnquotedString (descIncrementalVerifier iv)) 				res <- liftIO $ catchDefaultIO Nothing $-					withBinaryFile (fromRawFilePath f) ReadMode $ \h -> do+					F.withBinaryFile f ReadMode $ \h -> do 						feedIncrementalVerifier h iv 						finalizeIncrementalVerifier iv 				case res of@@ -129,7 +129,7 @@ 						Just verifier -> verifier k f 			(Nothing, Just verifier) -> verifier k f -resumeVerifyKeyContent :: Key -> RawFilePath -> IncrementalVerifier -> Annex Bool+resumeVerifyKeyContent :: Key -> OsPath -> IncrementalVerifier -> Annex Bool resumeVerifyKeyContent k f iv = liftIO (positionIncrementalVerifier iv) >>= \case 	Nothing -> fallback 	Just endpos -> do@@ -151,7 +151,7 @@ 		| otherwise = do 			showAction (UnquotedString (descIncrementalVerifier iv)) 			liftIO $ catchDefaultIO (Just False) $-				withBinaryFile (fromRawFilePath f) ReadMode $ \h -> do+				F.withBinaryFile f ReadMode $ \h -> do 					hSeek h AbsoluteSeek endpos 					feedIncrementalVerifier h iv 					finalizeIncrementalVerifier iv@@ -167,7 +167,7 @@   where 	chunk = 65536 -verifyKeySize :: Key -> RawFilePath -> Annex Bool+verifyKeySize :: Key -> OsPath -> Annex Bool verifyKeySize k f = case fromKey keySize k of 	Just size -> do 		size' <- liftIO $ catchDefaultIO 0 $ getFileSize f@@ -295,7 +295,7 @@ -- and if the disk is slow, the reader may never catch up to the writer, -- and the disk cache may never speed up reads. So this should only be -- used when there's not a better way to incrementally verify.-tailVerify :: Maybe IncrementalVerifier -> RawFilePath -> Annex a -> Annex a+tailVerify :: Maybe IncrementalVerifier -> OsPath -> Annex a -> Annex a tailVerify (Just iv) f writer = do 	finished <- liftIO newEmptyTMVarIO 	t <- liftIO $ async $ tailVerify' iv f finished@@ -305,7 +305,7 @@ 	writer `finally` finishtail tailVerify Nothing _ writer = writer -tailVerify' :: IncrementalVerifier -> RawFilePath -> TMVar () -> IO ()+tailVerify' :: IncrementalVerifier -> OsPath -> TMVar () -> IO () #if WITH_INOTIFY tailVerify' iv f finished =  	tryNonAsync go >>= \case@@ -318,15 +318,16 @@ 	-- of resuming, and waiting for modification deals with such 	-- situations. 	inotifydirchange i cont =-		INotify.addWatch i [INotify.Modify] dir $ \case+		INotify.addWatch i [INotify.Modify] (fromOsPath dir) $ \case 			-- Ignore changes to other files in the directory. 			INotify.Modified { INotify.maybeFilePath = fn }-				| fn == Just basef -> cont+				| fn == Just basef' -> cont 			_ -> noop 	  where-		(dir, basef) = P.splitFileName f+		(dir, basef) = splitFileName f+		basef' = fromOsPath basef 	-	inotifyfilechange i = INotify.addWatch i [INotify.Modify] f . const+	inotifyfilechange i = INotify.addWatch i [INotify.Modify] (fromOsPath f) . const  	go = INotify.withINotify $ \i -> do 		modified <- newEmptyTMVarIO@@ -354,7 +355,7 @@ 		case v of 			Just () -> do 				r <- tryNonAsync $-					tryWhenExists (openBinaryFile (fromRawFilePath f) ReadMode) >>= \case+					tryWhenExists (F.openBinaryFile f ReadMode) >>= \case 						Just h -> return (Just h) 						-- File does not exist, must have been 						-- deleted. Wait for next modification
Annex/View.hs view
@@ -40,13 +40,12 @@ import Utility.Glob import Types.Command import CmdLine.Action-import qualified Utility.RawFilePath as R+import qualified Utility.OsString as OS  import qualified Data.Text as T import qualified Data.ByteString as B import qualified Data.Set as S import qualified Data.Map as M-import qualified System.FilePath.ByteString as P import Control.Concurrent.Async import "mtl" Control.Monad.Writer @@ -251,7 +250,7 @@  - evaluate this function with the view parameter and reuse  - the result. The globs in the view will then be compiled and memoized.  -}-viewedFiles :: View -> MkViewedFile -> FilePath -> MetaData -> [ViewedFile]+viewedFiles :: View -> MkViewedFile -> OsPath -> MetaData -> [ViewedFile] viewedFiles view =  	let matchers = map viewComponentMatcher (viewComponents view) 	in \mkviewedfile file metadata ->@@ -260,7 +259,8 @@ 			then [] 			else  				let paths = pathProduct $-					map (map toviewpath) (visible matches)+					map (map (toOsPath . toviewpath))+						(visible matches) 				in if null paths 					then [mkviewedfile file] 					else map (</> mkviewedfile file) paths@@ -346,7 +346,7 @@ prop_viewPath_roundtrips :: MetaValue -> Bool prop_viewPath_roundtrips v = fromViewPath (toViewPath v) == v -pathProduct :: [[FilePath]] -> [FilePath]+pathProduct :: [[OsPath]] -> [OsPath] pathProduct [] = [] pathProduct (l:ls) = foldl combinel l ls   where@@ -364,7 +364,7 @@ 		filter (not . isviewunset) (zip visible values) 	visible = filter viewVisible (viewComponents view) 	paths = splitDirectories (dropFileName f)-	values = map (S.singleton . fromViewPath) paths+	values = map (S.singleton . fromViewPath . fromOsPath) paths 	MetaData derived = getViewedFileMetaData f 	convfield (vc, v) = (viewField vc, v) @@ -385,9 +385,9 @@ prop_view_roundtrips :: AssociatedFile -> MetaData -> Bool -> Bool prop_view_roundtrips (AssociatedFile Nothing) _ _ = True prop_view_roundtrips (AssociatedFile (Just f)) metadata visible = or-	[ B.null (P.takeFileName f) && B.null (P.takeDirectory f)+	[ OS.null (takeFileName f) && OS.null (takeDirectory f) 	, viewTooLarge view-	, all hasfields (viewedFiles view (viewedFileFromReference' Nothing Nothing) (fromRawFilePath f) metadata)+	, all hasfields (viewedFiles view (viewedFileFromReference' Nothing Nothing) f metadata) 	]   where 	view = View (Git.Ref "foo") $@@ -402,19 +402,19 @@  - Note that this may generate MetaFields that legalField rejects.  - This is necessary to have a 1:1 mapping between directory names and  - fields. So this MetaData cannot safely be serialized. -}-getDirMetaData :: FilePath -> MetaData+getDirMetaData :: OsPath -> MetaData getDirMetaData d = MetaData $ M.fromList $ zip fields values   where 	dirs = splitDirectories d-	fields = map (mkMetaFieldUnchecked . T.pack . addTrailingPathSeparator . joinPath)+	fields = map (mkMetaFieldUnchecked . T.pack . fromOsPath . addTrailingPathSeparator . joinPath) 		(inits dirs) 	values = map (S.singleton . toMetaValue . encodeBS . fromMaybe "" . headMaybe)-		(tails dirs)+		(tails (map fromOsPath dirs)) -getWorkTreeMetaData :: FilePath -> MetaData+getWorkTreeMetaData :: OsPath -> MetaData getWorkTreeMetaData = getDirMetaData . dropFileName -getViewedFileMetaData :: FilePath -> MetaData+getViewedFileMetaData :: OsPath -> MetaData getViewedFileMetaData = getDirMetaData . dirFromViewedFile . takeFileName  {- Applies a view to the currently checked out branch, generating a new@@ -439,7 +439,7 @@  - Look up the metadata of annexed files, and generate any ViewedFiles,  - and stage them.  -}-applyView' :: MkViewedFile -> (FilePath -> MetaData) -> View -> Maybe Adjustment -> Annex Git.Branch+applyView' :: MkViewedFile -> (OsPath -> MetaData) -> View -> Maybe Adjustment -> Annex Git.Branch applyView' mkviewedfile getfilemetadata view madj = do 	top <- fromRepo Git.repoPath 	(l, clean) <- inRepo $ Git.LsFiles.inRepoDetails [] [top]@@ -452,7 +452,7 @@  applyView'' 	:: MkViewedFile-	-> (FilePath -> MetaData)+	-> (OsPath -> MetaData) 	-> View 	-> Maybe Adjustment 	-> [t]@@ -488,18 +488,18 @@ 				-- Git.UpdateIndex.streamUpdateIndex' 				-- here would race with process's calls 				-- to it.-				| "." `B.isPrefixOf` getTopFilePath topf ->-					feed "dummy"+				| literalOsPath "." `OS.isPrefixOf` getTopFilePath topf ->+					feed (literalOsPath "dummy") 				| otherwise -> noop 		getmetadata gc mdfeeder mdcloser ts  	process uh mdreader = liftIO mdreader >>= \case 		Just ((topf, _, mtreeitemtype, Just k), mdlog) -> do 			let metadata = maybe emptyMetaData parseCurrentMetaData mdlog-			let f = fromRawFilePath $ getTopFilePath topf+			let f = getTopFilePath topf 			let metadata' = getfilemetadata f `unionMetaData` metadata 			forM_ (genviewedfiles f metadata') $ \fv -> do-				f' <- fromRepo (fromTopFilePath $ asTopFilePath $ toRawFilePath fv)+				f' <- fromRepo (fromTopFilePath $ asTopFilePath fv) 				stagefile uh f' k mtreeitemtype 			process uh mdreader 		Just ((topf, sha, Just treeitemtype, Nothing), _) -> do@@ -527,7 +527,7 @@ 		_ -> stagesymlink uh f k  	stagesymlink uh f k = do-		linktarget <- calcRepo (gitAnnexLink f k)+		linktarget <- fromOsPath <$> calcRepo (gitAnnexLink f k) 		sha <- hashSymlink linktarget 		liftIO . Git.UpdateIndex.streamUpdateIndex' uh 			=<< inRepo (Git.UpdateIndex.stageSymlink f sha)@@ -609,7 +609,7 @@ 				=<< catKey (DiffTree.dstsha item) 		| otherwise = noop 	handlechange item a = maybe noop-		(void . commandAction . a (fromRawFilePath $ getTopFilePath $ DiffTree.file item))+		(void . commandAction . a (getTopFilePath $ DiffTree.file item))  {- Runs an action using the view index file.  - Note that the file does not necessarily exist, or can contain@@ -619,7 +619,8 @@  withNewViewIndex :: Annex a -> Annex a withNewViewIndex a = do-	liftIO . removeWhenExistsWith R.removeLink =<< fromRepo gitAnnexViewIndex+	liftIO . removeWhenExistsWith removeFile+		=<< fromRepo gitAnnexViewIndex 	withViewIndex a  {- Generates a branch for a view, using the view index file
Annex/View/ViewedFile.hs view
@@ -5,6 +5,7 @@  - Licensed under the GNU AGPL version 3 or higher.  -} +{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE CPP #-}  module Annex.View.ViewedFile (@@ -20,13 +21,13 @@ import Annex.Common import Utility.QuickCheck import Backend.Utilities (maxExtensions)+import qualified Utility.OsString as OS  import qualified Data.ByteString as S -type FileName = String-type ViewedFile = FileName+type ViewedFile = OsPath -type MkViewedFile = FilePath -> ViewedFile+type MkViewedFile = OsPath -> ViewedFile  {- Converts a filepath used in a reference branch to the  - filename that will be used in the view.@@ -43,24 +44,27 @@ 	(annexMaxExtensions g)  viewedFileFromReference' :: Maybe Int -> Maybe Int -> MkViewedFile-viewedFileFromReference' maxextlen maxextensions f = concat $-	[ escape (fromRawFilePath base')-	, if null dirs then "" else "_%" ++ intercalate "%" (map escape dirs) ++ "%"+viewedFileFromReference' maxextlen maxextensions f = toOsPath $ concat $+	[ escape (fromOsPath base')+	, if null dirs+		then ""+		else "_%" ++ intercalate "%" (map (escape . fromOsPath) dirs) ++ "%" 	, escape $ fromRawFilePath $ S.concat extensions' 	]   where 	(path, basefile) = splitFileName f-	dirs = filter (/= ".") $ map dropTrailingPathSeparator (splitPath path)+	dirs = filter (/= literalOsPath ".") $+		map dropTrailingPathSeparator (splitPath path) 	(base, extensions) = case maxextlen of-		Nothing -> splitShortExtensions (toRawFilePath basefile')-		Just n -> splitShortExtensions' (n+1) (toRawFilePath basefile')+		Nothing -> splitShortExtensions basefile'+		Just n -> splitShortExtensions' (n+1) basefile' 	{- Limit number of extensions. -} 	maxextensions' = fromMaybe maxExtensions maxextensions 	(base', extensions') 		| length extensions <= maxextensions' = (base, extensions) 		| otherwise =  			let (es,more) = splitAt maxextensions' (reverse extensions)-			in (base <> mconcat (reverse more), reverse es)+			in (base <> toOsPath (mconcat (reverse more)), reverse es) 	{- On Windows, if the filename looked like "dir/c:foo" then 	 - basefile would look like it contains a drive letter, which will 	 - not work. There cannot really be a filename like that, probably,@@ -89,8 +93,8 @@  {- Extracts from a ViewedFile the directory where the file is located on  - in the reference branch. -}-dirFromViewedFile :: ViewedFile -> FilePath-dirFromViewedFile = joinPath . drop 1 . sep [] ""+dirFromViewedFile :: ViewedFile -> OsPath+dirFromViewedFile = joinPath . map toOsPath . drop 1 . sep [] "" . fromOsPath   where 	sep l _ [] = reverse l 	sep l curr (c:cs)@@ -103,10 +107,10 @@ prop_viewedFile_roundtrips :: TestableFilePath -> Bool prop_viewedFile_roundtrips tf 	-- Relative filenames wanted, not directories.-	| any (isPathSeparator) (end f ++ beginning f) = True-	| isAbsolute f || isDrive f = True+	| OS.any isPathSeparator (toOsPath (end f ++ beginning f)) = True+	| isAbsolute (toOsPath f) || isDrive (toOsPath f) = True 	| otherwise = dir == dirFromViewedFile -		(viewedFileFromReference' Nothing Nothing f)+		(viewedFileFromReference' Nothing Nothing (toOsPath f))   where 	f = fromTestableFilePath tf-	dir = joinPath $ beginning $ splitDirectories f+	dir = joinPath $ beginning $ splitDirectories (toOsPath f)
Annex/WorkTree.hs view
@@ -22,11 +22,11 @@  - When in an adjusted branch that may have hidden the file, looks for a  - pointer to a key in the original branch.  -}-lookupKey :: RawFilePath -> Annex (Maybe Key)+lookupKey :: OsPath -> Annex (Maybe Key) lookupKey = lookupKey' catkeyfile   where 	catkeyfile file =-		ifM (liftIO $ doesFileExist $ fromRawFilePath file)+		ifM (liftIO $ doesFileExist file) 			( catKeyFile file 			, catKeyFileHidden file =<< getCurrentBranch 			)@@ -35,22 +35,22 @@  - changes in the work tree. This means it's slower, but it also has  - consistently the same behavior for locked files as for unlocked files.  -}-lookupKeyStaged :: RawFilePath -> Annex (Maybe Key)+lookupKeyStaged :: OsPath -> Annex (Maybe Key) lookupKeyStaged file = catKeyFile file >>= \case 	Just k -> return (Just k) 	Nothing -> catKeyFileHidden file =<< getCurrentBranch  {- Like lookupKey, but does not find keys for hidden files. -}-lookupKeyNotHidden :: RawFilePath -> Annex (Maybe Key)+lookupKeyNotHidden :: OsPath -> Annex (Maybe Key) lookupKeyNotHidden = lookupKey' catkeyfile   where 	catkeyfile file =-		ifM (liftIO $ doesFileExist $ fromRawFilePath file)+		ifM (liftIO $ doesFileExist file) 			( catKeyFile file 			, return Nothing 			) -lookupKey' :: (RawFilePath -> Annex (Maybe Key)) -> RawFilePath -> Annex (Maybe Key)+lookupKey' :: (OsPath -> Annex (Maybe Key)) -> OsPath -> Annex (Maybe Key) lookupKey' catkeyfile file = isAnnexLink file >>= \case 	Just key -> return (Just key) 	Nothing -> catkeyfile file
Annex/YoutubeDl.hs view
@@ -5,6 +5,7 @@  - Licensed under the GNU AGPL version 3 or higher.  -} +{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE DeriveGeneric #-}  module Annex.YoutubeDl (@@ -30,6 +31,7 @@ import Utility.Tmp import Messages.Progress import Logs.Transfer+import qualified Utility.FileIO as F  import Network.URI import Control.Concurrent.Async@@ -37,7 +39,6 @@ import Data.Either import qualified Data.Aeson as Aeson import GHC.Generics-import qualified Data.ByteString as B import qualified Data.ByteString.Char8 as B8  -- youtube-dl can follow redirects to anywhere, including potentially@@ -71,20 +72,21 @@ -- (This can fail, but youtube-dl is deprecated, and they closed my -- issue requesting something like --print-to-file;  -- <https://github.com/rg3/youtube-dl/issues/14864>)-youtubeDl :: URLString -> FilePath -> MeterUpdate -> Annex (Either String (Maybe FilePath))+youtubeDl :: URLString -> OsPath -> MeterUpdate -> Annex (Either String (Maybe OsPath)) youtubeDl url workdir p = ifM ipAddressesUnlimited 	( withUrlOptions $ youtubeDl' url workdir p 	, return $ Left youtubeDlNotAllowedMessage 	) -youtubeDl' :: URLString -> FilePath -> MeterUpdate -> UrlOptions -> Annex (Either String (Maybe FilePath))+youtubeDl' :: URLString -> OsPath -> MeterUpdate -> UrlOptions -> Annex (Either String (Maybe OsPath)) youtubeDl' url workdir p uo 	| supportedScheme uo url = do 		cmd <- youtubeDlCommand 		ifM (liftIO $ inSearchPath cmd) 			( runcmd cmd >>= \case 				Right True -> downloadedfiles cmd >>= \case-					(f:[]) -> return (Right (Just f))+					(f:[]) -> return $ +						Right (Just (toOsPath f)) 					[] -> return (nofiles cmd) 					fs -> return (toomanyfiles cmd fs) 				Right False -> workdirfiles >>= \case@@ -99,13 +101,13 @@ 	toomanyfiles cmd fs = Left $ cmd ++ " downloaded multiple media files; git-annex is only able to deal with one per url: " ++ show fs 	downloadedfiles cmd 		| isytdlp cmd = liftIO $ -			(nub . lines <$> readFile filelistfile)+			(nub . lines <$> readFile (fromOsPath filelistfile)) 				`catchIO` (pure . const [])-		| otherwise = workdirfiles+		| otherwise = map fromOsPath <$> workdirfiles 	workdirfiles = liftIO $ filter (/= filelistfile) -		<$> (filterM (doesFileExist) =<< dirContents workdir)+		<$> (filterM doesFileExist =<< dirContents workdir) 	filelistfile = workdir </> filelistfilebase-	filelistfilebase = "git-annex-file-list-file"+	filelistfilebase = literalOsPath "git-annex-file-list-file" 	isytdlp cmd = cmd == "yt-dlp" 	runcmd cmd = youtubeDlMaxSize workdir >>= \case 		Left msg -> return (Left msg)@@ -121,7 +123,7 @@ 				liftIO $ commandMeter' 					(if isytdlp cmd then parseYtdlpProgress else parseYoutubeDlProgress) 					oh (Just meter) meterupdate cmd opts-					(\pr -> pr { cwd = Just workdir })+					(\pr -> pr { cwd = Just (fromOsPath workdir) }) 			return (Right ok) 	dlopts cmd =  		[ Param url@@ -144,7 +146,7 @@ 					, Param progressTemplate 					, Param "--print-to-file" 					, Param "after_move:filepath"-					, Param filelistfilebase+					, Param (fromOsPath filelistfilebase) 					] 				else [] @@ -152,14 +154,14 @@ -- large a media file. Factors in other downloads that are in progress, -- and any files in the workdir that it may have partially downloaded -- before.-youtubeDlMaxSize :: FilePath -> Annex (Either String [CommandParam])+youtubeDlMaxSize :: OsPath -> Annex (Either String [CommandParam]) youtubeDlMaxSize workdir = ifM (Annex.getRead Annex.force) 	( return $ Right []-	, liftIO (getDiskFree workdir) >>= \case+	, liftIO (getDiskFree (fromOsPath workdir)) >>= \case 		Just have -> do 			inprogress <- sizeOfDownloadsInProgress (const True) 			partial <- liftIO $ sum -				<$> (mapM (getFileSize . toRawFilePath) =<< dirContents workdir)+				<$> (mapM getFileSize =<< dirContents workdir) 			reserve <- annexDiskReserve <$> Annex.getGitConfig 			let maxsize = have - reserve - inprogress + partial 			if maxsize > 0@@ -174,12 +176,12 @@ 	)  -- Download a media file to a destination, -youtubeDlTo :: Key -> URLString -> FilePath -> MeterUpdate -> Annex Bool+youtubeDlTo :: Key -> URLString -> OsPath -> MeterUpdate -> Annex Bool youtubeDlTo key url dest p = do 	res <- withTmpWorkDir key $ \workdir ->-		youtubeDl url (fromRawFilePath workdir) p >>= \case+		youtubeDl url workdir p >>= \case 			Right (Just mediafile) -> do-				liftIO $ moveFile (toRawFilePath mediafile) (toRawFilePath dest)+				liftIO $ moveFile mediafile dest 				return (Just True) 			Right Nothing -> return (Just False) 			Left msg -> do@@ -224,7 +226,7 @@ -- Ask youtube-dl for the filename of media in an url. -- -- (This is not always identical to the filename it uses when downloading.)-youtubeDlFileName :: URLString -> Annex (Either String FilePath)+youtubeDlFileName :: URLString -> Annex (Either String OsPath) youtubeDlFileName url = withUrlOptions go   where 	go uo@@ -235,10 +237,10 @@  -- Does not check if the url contains htmlOnly; use when that's already -- been verified.-youtubeDlFileNameHtmlOnly :: URLString -> Annex (Either String FilePath)+youtubeDlFileNameHtmlOnly :: URLString -> Annex (Either String OsPath) youtubeDlFileNameHtmlOnly = withUrlOptions . youtubeDlFileNameHtmlOnly' -youtubeDlFileNameHtmlOnly' :: URLString -> UrlOptions -> Annex (Either String FilePath)+youtubeDlFileNameHtmlOnly' :: URLString -> UrlOptions -> Annex (Either String OsPath) youtubeDlFileNameHtmlOnly' url uo 	| supportedScheme uo url = flip catchIO (pure . Left . show) go 	| otherwise = return nomedia@@ -268,7 +270,7 @@ 		ok <- liftIO $ checkSuccessProcess pid 		wait errt 		return $ case (ok, lines output) of-			(True, (f:_)) | not (null f) -> Right f+			(True, (f:_)) | not (null f) -> Right (toOsPath f) 			_ -> nomedia 	waitproc _ _ _ _ = error "internal" @@ -352,7 +354,7 @@ 		else return $ Left $ "Scraping needs yt-dlp, but git-annex has been configured to use " ++ cmd  youtubePlaylist' :: URLString -> String -> IO (Either String [YoutubePlaylistItem])-youtubePlaylist' url cmd = withTmpFile "yt-dlp" $ \tmpfile h -> do+youtubePlaylist' url cmd = withTmpFile (literalOsPath "yt-dlp") $ \tmpfile h -> do 	hClose h 	(outerr, ok) <- processTranscript cmd 		[ "--simulate"@@ -362,14 +364,14 @@ 		, "--print-to-file" 		-- Write json with selected fields. 		, "%(.{" ++ intercalate "," youtubePlaylistItemFields ++ "})j"-		, tmpfile+		, fromOsPath tmpfile 		, url 		] 		Nothing 	if ok 		then flip catchIO (pure . Left . show) $ do 			v <- map Aeson.eitherDecodeStrict . B8.lines-				<$> B.readFile tmpfile+				<$> F.readFile' tmpfile 			return $ case partitionEithers v of 				((parserr:_), _) ->  					Left $ "yt-dlp json parse error: " ++ parserr@@ -406,5 +408,6 @@ instance Aeson.FromJSON YoutubePlaylistItem   where 	parseJSON = Aeson.genericParseJSON Aeson.defaultOptions-		{ Aeson.fieldLabelModifier = drop (length "youtube_") }-+		{ Aeson.fieldLabelModifier = +			drop (length ("youtube_" :: String))+		}
Assistant.hs view
@@ -62,40 +62,39 @@ import Network.Socket (HostName, PortNumber)  stopDaemon :: Annex ()-stopDaemon = liftIO . Utility.Daemon.stopDaemon . fromRawFilePath-	=<< fromRepo gitAnnexPidFile+stopDaemon = liftIO . Utility.Daemon.stopDaemon =<< fromRepo gitAnnexPidFile  {- Starts the daemon. If the daemon is run in the foreground, once it's  - running, can start the browser.  -  - startbrowser is passed the url and html shim file, as well as the original  - stdout and stderr descriptors. -}-startDaemon :: Bool -> Bool -> Maybe Duration -> Maybe String -> Maybe HostName -> Maybe PortNumber ->  Maybe (Maybe Handle -> Maybe Handle -> String -> FilePath -> IO ()) -> Annex ()+startDaemon :: Bool -> Bool -> Maybe Duration -> Maybe String -> Maybe HostName -> Maybe PortNumber ->  Maybe (Maybe Handle -> Maybe Handle -> String -> OsPath -> IO ()) -> Annex () startDaemon assistant foreground startdelay cannotrun listenhost listenport startbrowser = do 	Annex.changeState $ \s -> s { Annex.daemon = True } 	enableInteractiveBranchAccess 	pidfile <- fromRepo gitAnnexPidFile 	logfile <- fromRepo gitAnnexDaemonLogFile-	liftIO $ Debug.debug "Assistant" $ "logging to " ++ fromRawFilePath logfile+	liftIO $ Debug.debug "Assistant" $ "logging to " ++ fromOsPath logfile 	createAnnexDirectory (parentDir pidfile) #ifndef mingw32_HOST_OS 	createAnnexDirectory (parentDir logfile)-	let logfd = handleToFd =<< openLog (fromRawFilePath logfile)+	let logfd = handleToFd =<< openLog (fromOsPath logfile) 	if foreground 		then do 			origout <- liftIO $ catchMaybeIO $  				fdToHandle =<< dup stdOutput 			origerr <- liftIO $ catchMaybeIO $  				fdToHandle =<< dup stdError-			let undaemonize = Utility.Daemon.foreground logfd (Just (fromRawFilePath pidfile))+			let undaemonize = Utility.Daemon.foreground logfd (Just pidfile) 			start undaemonize $  				case startbrowser of 					Nothing -> Nothing 					Just a -> Just $ a origout origerr 		else do-			git_annex <- liftIO programPath+			git_annex <- fromOsPath <$> liftIO programPath 			ps <- gitAnnexDaemonizeParams-			start (Utility.Daemon.daemonize git_annex ps logfd (Just (fromRawFilePath pidfile)) False) Nothing+			start (Utility.Daemon.daemonize git_annex ps logfd (Just pidfile) False) Nothing #else 	-- Windows doesn't daemonize, but does redirect output to the 	-- log file. The only way to do so is to restart the program.@@ -104,9 +103,9 @@ 		createAnnexDirectory (parentDir logfile) 		ifM (liftIO $ isNothing <$> getEnv flag) 			( liftIO $ withNullHandle $ \nullh -> do-				loghandle <- openLog (fromRawFilePath logfile)+				loghandle <- openLog (fromOsPath logfile) 				e <- getEnvironment-				cmd <- programPath+				cmd <- fromOsPath <$> programPath 				ps <- getArgs 				let p = (proc cmd ps) 					{ env = Just (addEntry flag "1" e)@@ -117,7 +116,7 @@ 				exitcode <- withCreateProcess p $ \_ _ _ pid -> 					waitForProcess pid 				exitWith exitcode-			, start (Utility.Daemon.foreground (Just (fromRawFilePath pidfile))) $+			, start (Utility.Daemon.foreground (Just pidfile)) $ 				case startbrowser of 					Nothing -> Nothing 					Just a -> Just $ a Nothing Nothing@@ -128,7 +127,7 @@ 		checkCanWatch 		dstatus <- startDaemonStatus 		logfile <- fromRepo gitAnnexDaemonLogFile-		liftIO $ Debug.debug "Assistant" $ "logging to " ++ fromRawFilePath logfile+		liftIO $ Debug.debug "Assistant" $ "logging to " ++ fromOsPath logfile 		liftIO $ daemonize $ 			flip runAssistant (go webappwaiter)  				=<< newAssistantData st dstatus
Assistant/Alert.hs view
@@ -395,7 +395,7 @@ 	maxfilesshown = 10  	(!somefiles, !counter) = splitcounter (dedupadjacent files)-	!shortfiles = map (fromString . shortFile . takeFileName) somefiles+	!shortfiles = map (fromString . shortFile . fromOsPath . takeFileName . toOsPath) somefiles  	renderer alert = tenseWords $ msg : alertData alert ++ showcounter 	  where
Assistant/Changes.hs view
@@ -15,14 +15,14 @@ import Control.Concurrent.STM  {- Handlers call this when they made a change that needs to get committed. -}-madeChange :: FilePath -> ChangeInfo -> Assistant (Maybe Change)+madeChange :: OsPath -> ChangeInfo -> Assistant (Maybe Change) madeChange f t = Just <$> (Change <$> liftIO getCurrentTime <*> pure f <*> pure t)  noChange :: Assistant (Maybe Change) noChange = return Nothing  {- Indicates an add needs to be done, but has not started yet. -}-pendingAddChange :: FilePath -> Assistant (Maybe Change)+pendingAddChange :: OsPath -> Assistant (Maybe Change) pendingAddChange f = Just <$> (PendingAddChange <$> liftIO getCurrentTime <*> pure f)  {- Gets all unhandled changes.
Assistant/DaemonStatus.hs view
@@ -22,6 +22,7 @@ import qualified Types.Remote as Remote import Config.DynamicConfig import Annex.SpecialRemote.Config+import qualified Utility.FileIO as F  import Control.Concurrent.STM import System.Posix.Types@@ -121,9 +122,9 @@  - and parts of it are not relevant. -} writeDaemonStatusFile :: FilePath -> DaemonStatus -> IO () writeDaemonStatusFile file status = -	viaTmp writeFile file =<< serialized <$> getPOSIXTime+	viaTmp F.writeFile' (toOsPath (toRawFilePath file)) =<< serialized <$> getPOSIXTime   where-	serialized now = unlines+	serialized now = encodeBS $ unlines 		[ "lastRunning:" ++ show now 		, "scanComplete:" ++ show (scanComplete status) 		, "sanityCheckRunning:" ++ show (sanityCheckRunning status)@@ -135,13 +136,13 @@   where 	parse status = foldr parseline status . lines 	parseline line status-		| key == "lastRunning" = parseval parsePOSIXTime $ \v ->+		| key == "lastRunning" = parseval (parsePOSIXTime . encodeBS) $ \v -> 			status { lastRunning = Just v } 		| key == "scanComplete" = parseval readish $ \v -> 			status { scanComplete = v } 		| key == "sanityCheckRunning" = parseval readish $ \v -> 			status { sanityCheckRunning = v }-		| key == "lastSanityCheck" = parseval parsePOSIXTime $ \v ->+		| key == "lastSanityCheck" = parseval (parsePOSIXTime . encodeBS) $ \v -> 			status { lastSanityCheck = Just v } 		| otherwise = status -- unparsable line 	  where
Assistant/Install.hs view
@@ -5,6 +5,7 @@  - Licensed under the GNU AGPL version 3 or higher.  -} +{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE CPP #-}  module Assistant.Install where@@ -17,6 +18,7 @@ import Utility.Tmp import Utility.Env import Utility.SshConfig+import qualified Utility.FileIO as F  #ifdef darwin_HOST_OS import Utility.OSX@@ -28,9 +30,10 @@ #endif  import System.PosixCompat.Files (ownerExecuteMode)+import qualified Data.ByteString.Char8 as S8 -standaloneAppBase :: IO (Maybe FilePath)-standaloneAppBase = getEnv "GIT_ANNEX_APP_BASE"+standaloneAppBase :: IO (Maybe OsPath)+standaloneAppBase = fmap toOsPath <$> getEnv "GIT_ANNEX_APP_BASE"  {- The standalone app does not have an installation process.  - So when it's run, it needs to set up autostarting of the assistant@@ -49,40 +52,39 @@ 	, go =<< standaloneAppBase 	)   where-	go Nothing = installFileManagerHooks "git-annex"+	go Nothing = installFileManagerHooks (literalOsPath "git-annex") 	go (Just base) = do-		let program = base </> "git-annex"+		let program = base </> literalOsPath "git-annex" 		programfile <- programFile-		createDirectoryIfMissing True $-			fromRawFilePath (parentDir (toRawFilePath programfile))-		writeFile programfile program+		createDirectoryIfMissing True (parentDir programfile)+		writeFile (fromOsPath programfile) (fromOsPath program)  #ifdef darwin_HOST_OS 		autostartfile <- userAutoStart osxAutoStartLabel-		installAutoStart program autostartfile+		installAutoStart (fromOsPath program) autostartfile #else 		ifM osAndroid 			( do 				-- Integration with the Termux:Boot app. 				home <- myHomeDir-				let bootfile = home </> ".termux" </> "boot" </> "git-annex"+				let bootfile = toOsPath home </> literalOsPath ".termux" </> literalOsPath "boot" </> literalOsPath "git-annex" 				unlessM (doesFileExist bootfile) $ do 					createDirectoryIfMissing True (takeDirectory bootfile)-					writeFile bootfile "git-annex assistant --autostart"+					writeFile (fromOsPath bootfile) "git-annex assistant --autostart" 			, do 				menufile <- desktopMenuFilePath "git-annex" <$> userDataDir 				icondir <- iconDir <$> userDataDir-				installMenu program menufile base icondir+				installMenu (fromOsPath program) menufile base icondir 				autostartfile <- autoStartPath "git-annex" <$> userConfigDir-				installAutoStart program autostartfile+				installAutoStart (fromOsPath program) autostartfile 			) #endif  		sshdir <- sshDir-		let runshell var = "exec " ++ base </> "runshell " ++ var+		let runshell var = "exec " ++ fromOsPath (base </> literalOsPath "runshell ") ++ var 		let rungitannexshell var = runshell $ "git-annex-shell -c \"" ++ var ++ "\"" -		installWrapper (sshdir </> "git-annex-shell") $ unlines+		installWrapper (sshdir </> literalOsPath "git-annex-shell") $ 			[ shebang 			, "set -e" 			, "if [ \"x$SSH_ORIGINAL_COMMAND\" != \"x\" ]; then"@@ -91,7 +93,7 @@ 			,   rungitannexshell "$@" 			, "fi" 			]-		installWrapper (sshdir </> "git-annex-wrapper") $ unlines+		installWrapper (sshdir </> literalOsPath "git-annex-wrapper") $ 			[ shebang 			, "set -e" 			, runshell "\"$@\""@@ -99,45 +101,46 @@  		installFileManagerHooks program -installWrapper :: FilePath -> String -> IO ()+installWrapper :: OsPath -> [String] -> IO () installWrapper file content = do-	curr <- catchDefaultIO "" $ readFileStrict file-	when (curr /= content) $ do-		createDirectoryIfMissing True (fromRawFilePath (parentDir (toRawFilePath file)))-		viaTmp writeFile file content-		modifyFileMode (toRawFilePath file) $ -			addModes [ownerExecuteMode]+	let content' = map encodeBS content+	curr <- catchDefaultIO [] $ fileLines' <$> F.readFile' file+	when (curr /= content') $ do+		createDirectoryIfMissing True (parentDir file)+		viaTmp F.writeFile' file $ linesFile' (S8.unlines content')+		modifyFileMode file $ addModes [ownerExecuteMode] -installFileManagerHooks :: FilePath -> IO ()+installFileManagerHooks :: OsPath -> IO () #ifdef linux_HOST_OS installFileManagerHooks program = unlessM osAndroid $ do 	let actions = ["get", "drop", "undo"]  	-- Gnome-	nautilusScriptdir <- (\d -> d </> "nautilus" </> "scripts") <$> userDataDir+	nautilusScriptdir <- (\d -> d </> literalOsPath "nautilus" </> literalOsPath "scripts") <$> userDataDir 	createDirectoryIfMissing True nautilusScriptdir 	forM_ actions $ 		genNautilusScript nautilusScriptdir  	-- KDE 	userdata <- userDataDir-	let kdeServiceMenusdir = userdata </> "kservices5" </> "ServiceMenus"+	let kdeServiceMenusdir = userdata </> literalOsPath "kservices5" </> literalOsPath "ServiceMenus" 	createDirectoryIfMissing True kdeServiceMenusdir-	writeFile (kdeServiceMenusdir </> "git-annex.desktop")+	writeFile (fromOsPath (kdeServiceMenusdir </> literalOsPath "git-annex.desktop")) 		(kdeDesktopFile actions)   where 	genNautilusScript scriptdir action =-		installscript (scriptdir </> scriptname action) $ unlines+		installscript (scriptdir </> toOsPath (scriptname action)) $ unlines 			[ shebang 			, autoaddedcomment-			, "exec " ++ program ++ " " ++ action ++ " --notify-start --notify-finish -- \"$@\""+			, "exec " ++ fromOsPath program ++ " " ++ action ++ " --notify-start --notify-finish -- \"$@\"" 			] 	scriptname action = "git-annex " ++ action 	installscript f c = whenM (safetoinstallscript f) $ do-		writeFile f c-		modifyFileMode (toRawFilePath f) $ addModes [ownerExecuteMode]+		writeFile (fromOsPath f) c+		modifyFileMode f $ addModes [ownerExecuteMode] 	safetoinstallscript f = catchDefaultIO True $-		elem autoaddedcomment . lines <$> readFileStrict f+		elem (encodeBS autoaddedcomment) . fileLines'+			<$> F.readFile' f 	autoaddedcomment = "# " ++ autoaddedmsg ++ " (To disable, chmod 600 this file.)" 	autoaddedmsg = "Automatically added by git-annex, do not edit." @@ -163,7 +166,7 @@ 		, "Icon=git-annex" 		, unwords 			[ "Exec=sh -c 'cd \"$(dirname \"$1\")\" &&"-			, program+			, fromOsPath program 			, command 			, "--notify-start --notify-finish -- \"$1\"'" 			, "false" -- this becomes $0 in sh, so unused
Assistant/Install/AutoStart.hs view
@@ -10,6 +10,7 @@  module Assistant.Install.AutoStart where +import Common import Utility.FreeDesktop #ifdef darwin_HOST_OS import Utility.OSX@@ -18,11 +19,11 @@ import Utility.FileSystemEncoding #endif -installAutoStart :: FilePath -> FilePath -> IO ()+installAutoStart :: String -> OsPath -> IO () installAutoStart command file = do #ifdef darwin_HOST_OS-	createDirectoryIfMissing True (fromRawFilePath (parentDir (toRawFilePath file)))-	writeFile file $ genOSXAutoStartFile osxAutoStartLabel command+	createDirectoryIfMissing True (parentDir file)+	writeFile (fromOsPath file) $ genOSXAutoStartFile osxAutoStartLabel command 		["assistant", "--autostart"] #else 	writeDesktopMenuFile (fdoAutostart command) file
Assistant/Install/Menu.hs view
@@ -5,31 +5,25 @@  - Licensed under the GNU AGPL version 3 or higher.  -} +{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE CPP #-} {-# OPTIONS_GHC -fno-warn-tabs #-}  module Assistant.Install.Menu where +import Common import Utility.FreeDesktop-import Utility.FileSystemEncoding-import Utility.Path -import System.IO-import Utility.SystemDirectory-#ifndef darwin_HOST_OS-import System.FilePath-#endif--installMenu :: FilePath -> FilePath -> FilePath -> FilePath -> IO ()+installMenu :: String -> OsPath -> OsPath -> OsPath -> IO () #ifdef darwin_HOST_OS installMenu _command _menufile _iconsrcdir _icondir = return () #else installMenu command menufile iconsrcdir icondir = do 	writeDesktopMenuFile (fdoDesktopMenu command) menufile-	installIcon (iconsrcdir </> "logo.svg") $-		iconFilePath (iconBaseName ++ ".svg") "scalable" icondir-	installIcon (iconsrcdir </> "logo_16x16.png") $-		iconFilePath (iconBaseName ++ ".png") "16x16" icondir+	installIcon (iconsrcdir </> literalOsPath "logo.svg") $+		iconFilePath (toOsPath (iconBaseName ++ ".svg")) "scalable" icondir+	installIcon (iconsrcdir </> literalOsPath "logo_16x16.png") $+		iconFilePath (toOsPath (iconBaseName ++ ".png")) "16x16" icondir #endif  {- The command can be either just "git-annex", or the full path to use@@ -43,11 +37,11 @@ 	(Just iconBaseName) 	["Network", "FileTransfer"] -installIcon :: FilePath -> FilePath -> IO ()+installIcon :: OsPath -> OsPath -> IO () installIcon src dest = do-	createDirectoryIfMissing True (fromRawFilePath (parentDir (toRawFilePath dest)))-	withBinaryFile src ReadMode $ \hin ->-		withBinaryFile dest WriteMode $ \hout ->+	createDirectoryIfMissing True (parentDir dest)+	withBinaryFile (fromOsPath src) ReadMode $ \hin ->+		withBinaryFile (fromOsPath dest) WriteMode $ \hout -> 			hGetContents hin >>= hPutStr hout  iconBaseName :: String
Assistant/MakeRepo.hs view
@@ -28,7 +28,7 @@  {- Makes a new git repository. Or, if a git repository already  - exists, returns False. -}-makeRepo :: FilePath -> Bool -> IO Bool+makeRepo :: OsPath -> Bool -> IO Bool makeRepo path bare = ifM (probeRepoExists path) 	( return False 	, do@@ -41,19 +41,19 @@   where 	baseparams = [Param "init", Param "--quiet"] 	params-		| bare = baseparams ++ [Param "--bare", File path]-		| otherwise = baseparams ++ [File path]+		| bare = baseparams ++ [Param "--bare", File (fromOsPath path)]+		| otherwise = baseparams ++ [File (fromOsPath path)]  {- Runs an action in the git repository in the specified directory. -}-inDir :: FilePath -> Annex a -> IO a+inDir :: OsPath -> Annex a -> IO a inDir dir a = do 	state <- Annex.new 		=<< Git.Config.read-		=<< Git.Construct.fromPath (toRawFilePath dir)+		=<< Git.Construct.fromPath dir 	Annex.eval state $ a `finally` quiesce True  {- Creates a new repository, and returns its UUID. -}-initRepo :: Bool -> Bool -> FilePath -> Maybe String -> Maybe StandardGroup -> IO UUID+initRepo :: Bool -> Bool -> OsPath -> Maybe String -> Maybe StandardGroup -> IO UUID initRepo True primary_assistant_repo dir desc mgroup = inDir dir $ do 	initRepo' desc mgroup 	{- Initialize the master branch, so things that expect@@ -94,6 +94,6 @@ 	Annex.Branch.commit =<< Annex.Branch.commitMessage  {- Checks if a git repo exists at a location. -}-probeRepoExists :: FilePath -> IO Bool+probeRepoExists :: OsPath -> IO Bool probeRepoExists dir = isJust <$>-	catchDefaultIO Nothing (Git.Construct.checkForRepo (encodeBS dir))+	catchDefaultIO Nothing (Git.Construct.checkForRepo dir)
Assistant/Pairing/MakeRemote.hs view
@@ -22,11 +22,11 @@  {- Authorized keys are set up before pairing is complete, so that the other  - side can immediately begin syncing. -}-setupAuthorizedKeys :: PairMsg -> FilePath -> IO ()+setupAuthorizedKeys :: PairMsg -> OsPath -> IO () setupAuthorizedKeys msg repodir = case validateSshPubKey $ remoteSshPubKey $ pairMsgData msg of 	Left err -> giveup err 	Right pubkey -> do-		absdir <- fromRawFilePath <$> absPath (toRawFilePath repodir)+		absdir <- absPath repodir 		unlessM (liftIO $ addAuthorizedKeys True absdir pubkey) $ 			giveup "failed setting up ssh authorized keys" @@ -66,7 +66,7 @@ 		{ sshHostName = T.pack hostname 		, sshUserName = Just (T.pack $ remoteUserName d) 		, sshDirectory = T.pack dir-		, sshRepoName = genSshRepoName hostname dir+		, sshRepoName = genSshRepoName hostname (toOsPath dir) 		, sshPort = 22 		, needsPubKey = True 		, sshCapabilities = [GitAnnexShellCapable, GitCapable, RsyncCapable]
Assistant/Repair.hs view
@@ -5,6 +5,7 @@  - Licensed under the GNU AGPL version 3 or higher.  -} +{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE CPP #-}  module Assistant.Repair where@@ -30,7 +31,7 @@ #endif import qualified Utility.Lsof as Lsof import Utility.ThreadScheduler-import qualified Utility.RawFilePath as R+import qualified Utility.OsString as OS  import Control.Concurrent.Async @@ -95,7 +96,7 @@ 			thisrepopath <- liftIO . absPath 				=<< liftAnnex (fromRepo Git.repoPath) 			a <- liftAnnex $ mkrepair $-				repair fsckresults (Just (fromRawFilePath thisrepopath))+				repair fsckresults (Just (fromOsPath thisrepopath)) 			liftIO $ catchBoolIO a  	repair fsckresults referencerepo = do@@ -107,7 +108,7 @@ 	 	backgroundfsck params = liftIO $ void $ async $ do 		program <- programPath-		batchCommand program (Param "fsck" : params)+		batchCommand (fromOsPath program) (Param "fsck" : params)  {- Detect when a git lock file exists and has no git process currently  - writing to it. This strongly suggests it is a stale lock file.@@ -132,26 +133,26 @@ 	repairStaleLocks lockfiles 	return $ not $ null lockfiles   where-	findgitfiles = dirContentsRecursiveSkipping (== dropTrailingPathSeparator (fromRawFilePath annexDir)) True . fromRawFilePath . Git.localGitDir+	findgitfiles = dirContentsRecursiveSkipping (== dropTrailingPathSeparator annexDir) True . Git.localGitDir 	islock f-		| "gc.pid" `isInfixOf` f = False-		| ".lock" `isSuffixOf` f = True-		| takeFileName f == "MERGE_HEAD" = True+		| literalOsPath "gc.pid" `OS.isInfixOf` f = False+		| literalOsPath ".lock" `OS.isSuffixOf` f = True+		| takeFileName f == literalOsPath "MERGE_HEAD" = True 		| otherwise = False -repairStaleLocks :: [FilePath] -> Assistant ()+repairStaleLocks :: [OsPath] -> Assistant () repairStaleLocks lockfiles = go =<< getsizes   where 	getsize lf = catchMaybeIO $ (\s -> (lf, s))-		<$> getFileSize (toRawFilePath lf)+		<$> getFileSize lf 	getsizes = liftIO $ catMaybes <$> mapM getsize lockfiles 	go [] = return ()-	go l = ifM (liftIO $ null <$> Lsof.query ("--" : map fst l))+	go l = ifM (liftIO $ null <$> Lsof.query ("--" : map (fromOsPath . fst) l)) 		( do 			waitforit "to check stale git lock file" 			l' <- getsizes 			if l' == l-				then liftIO $ mapM_ (removeWhenExistsWith R.removeLink . toRawFilePath . fst) l+				then liftIO $ mapM_ (removeWhenExistsWith removeFile . fst) l 				else go l' 		, do 			waitforit "for git lock file writer"
Assistant/Restart.hs view
@@ -18,7 +18,6 @@ import Utility.Url import Utility.Url.Parse import Utility.PID-import qualified Utility.RawFilePath as R import qualified Git.Construct import qualified Git.Config import qualified Annex@@ -41,8 +40,8 @@ prepRestart :: Assistant () prepRestart = do 	liftIO . maybe noop (`throwTo` PauseWatcher) =<< namedThreadId watchThread-	liftIO . removeWhenExistsWith R.removeLink =<< liftAnnex (fromRepo gitAnnexUrlFile)-	liftIO . removeWhenExistsWith R.removeLink =<< liftAnnex (fromRepo gitAnnexPidFile)+	liftIO . removeWhenExistsWith removeFile =<< liftAnnex (fromRepo gitAnnexUrlFile)+	liftIO . removeWhenExistsWith removeFile =<< liftAnnex (fromRepo gitAnnexPidFile)  {- To finish a restart, send a global redirect to the new url  - to any web browsers that are displaying the webapp.@@ -66,21 +65,21 @@  runRestart :: Assistant URLString runRestart = liftIO . newAssistantUrl-	=<< liftAnnex (Git.repoLocation <$> Annex.gitRepo)+	=<< liftAnnex (Git.repoPath <$> Annex.gitRepo)  {- Starts up the assistant in the repository, and waits for it to create  - a gitAnnexUrlFile. Waits for the assistant to be up and listening for  - connections by testing the url. -}-newAssistantUrl :: FilePath -> IO URLString+newAssistantUrl :: OsPath -> IO URLString newAssistantUrl repo = do 	startAssistant repo 	geturl   where 	geturl = do-		r <- Git.Config.read =<< Git.Construct.fromPath (toRawFilePath repo)-		waiturl $ fromRawFilePath $ gitAnnexUrlFile r+		r <- Git.Config.read =<< Git.Construct.fromPath repo+		waiturl $ gitAnnexUrlFile r 	waiturl urlfile = do-		v <- tryIO $ readFile urlfile+		v <- tryIO $ readFile (fromOsPath urlfile) 		case v of 			Left _ -> delayed $ waiturl urlfile 			Right url -> ifM (assistantListening url)@@ -112,8 +111,8 @@  - On windows, the assistant does not daemonize, which is why the forkIO is  - done.  -}-startAssistant :: FilePath -> IO ()+startAssistant :: OsPath -> IO () startAssistant repo = void $ forkIO $ do-	program <- programPath-	let p = (proc program ["assistant"]) { cwd = Just repo }+	program <- fromOsPath <$> programPath+	let p = (proc program ["assistant"]) { cwd = Just (fromOsPath repo) } 	withCreateProcess p $ \_ _ _ pid -> void $ checkSuccessProcess pid
Assistant/Ssh.hs view
@@ -5,6 +5,8 @@  - Licensed under the GNU AGPL version 3 or higher.  -} +{-# LANGUAGE OverloadedStrings #-}+ module Assistant.Ssh where  import Annex.Common@@ -17,6 +19,8 @@ import Git.Remote import Utility.SshHost import Utility.Process.Transcript+import qualified Utility.FileIO as F+import qualified Utility.OsString as OS  import Data.Text (Text) import qualified Data.Text as T@@ -93,14 +97,14 @@ {- Reverses genSshUrl -} parseSshUrl :: String -> Maybe SshData parseSshUrl u-	| "ssh://" `isPrefixOf` u = fromssh (drop (length "ssh://") u)+	| "ssh://" `isPrefixOf` u = fromssh (drop (length ("ssh://" :: String)) u) 	| otherwise = fromrsync u   where 	mkdata (userhost, dir) = Just $ SshData 		{ sshHostName = T.pack host 		, sshUserName = if null user then Nothing else Just $ T.pack user 		, sshDirectory = T.pack dir-		, sshRepoName = genSshRepoName host dir+		, sshRepoName = genSshRepoName host (toOsPath dir) 		-- dummy values, cannot determine from url 		, sshPort = 22 		, needsPubKey = True@@ -117,10 +121,10 @@ 	fromssh = mkdata . break (== '/')  {- Generates a git remote name, like host_dir or host -}-genSshRepoName :: String -> FilePath -> String+genSshRepoName :: String -> OsPath -> String genSshRepoName host dir-	| null dir = makeLegalName host-	| otherwise = makeLegalName $ host ++ "_" ++ dir+	| OS.null dir = makeLegalName host+	| otherwise = makeLegalName $ host ++ "_" ++ fromOsPath dir  {- The output of ssh, including both stdout and stderr. -} sshTranscript :: [String] -> SshHost -> String -> (Maybe String) -> IO (String, Bool)@@ -148,18 +152,18 @@ 	  where 		(ssh, keytype) = separate (== '-') prefix -addAuthorizedKeys :: Bool -> FilePath -> SshPubKey -> IO Bool+addAuthorizedKeys :: Bool -> OsPath -> SshPubKey -> IO Bool addAuthorizedKeys gitannexshellonly dir pubkey = boolSystem "sh" 	[ Param "-c" , Param $ addAuthorizedKeysCommand gitannexshellonly dir pubkey ]  {- Should only be used within the same process that added the line;  - the layout of the line is not kepy stable across versions. -}-removeAuthorizedKeys :: Bool -> FilePath -> SshPubKey -> IO ()+removeAuthorizedKeys :: Bool -> OsPath -> SshPubKey -> IO () removeAuthorizedKeys gitannexshellonly dir pubkey = do 	let keyline = authorizedKeysLine gitannexshellonly dir pubkey 	sshdir <- sshDir-	let keyfile = sshdir </> "authorized_keys"-	tryWhenExists (lines <$> readFileStrict keyfile) >>= \case+	let keyfile = sshdir </> literalOsPath "authorized_keys"+	tryWhenExists (map decodeBS . fileLines' <$> F.readFile' keyfile) >>= \case 		Just ls -> viaTmp writeSshConfig keyfile $ 			unlines $ filter (/= keyline) ls 		Nothing -> noop@@ -170,7 +174,7 @@  - The ~/.ssh/git-annex-shell wrapper script is created if not already  - present.  -}-addAuthorizedKeysCommand :: Bool -> FilePath -> SshPubKey -> String+addAuthorizedKeysCommand :: Bool -> OsPath -> SshPubKey -> String addAuthorizedKeysCommand gitannexshellonly dir pubkey = intercalate "&&" 	[ "mkdir -p ~/.ssh" 	, intercalate "; "@@ -201,27 +205,27 @@ 		] 	runshell var = "exec git-annex-shell -c \"" ++ var ++ "\"" -authorizedKeysLine :: Bool -> FilePath -> SshPubKey -> String+authorizedKeysLine :: Bool -> OsPath -> SshPubKey -> String authorizedKeysLine gitannexshellonly dir pubkey 	| gitannexshellonly = limitcommand ++ pubkey 	{- TODO: Locking down rsync is difficult, requiring a rather 	 - long perl script. -} 	| otherwise = pubkey   where-	limitcommand = "command=\"env GIT_ANNEX_SHELL_DIRECTORY="++shellEscape dir++" ~/.ssh/git-annex-shell\",no-agent-forwarding,no-port-forwarding,no-X11-forwarding,no-pty "+	limitcommand = "command=\"env GIT_ANNEX_SHELL_DIRECTORY="++shellEscape (fromOsPath dir)++" ~/.ssh/git-annex-shell\",no-agent-forwarding,no-port-forwarding,no-X11-forwarding,no-pty "  {- Generates a ssh key pair. -} genSshKeyPair :: IO SshKeyPair-genSshKeyPair = withTmpDir "git-annex-keygen" $ \dir -> do+genSshKeyPair = withTmpDir (literalOsPath "git-annex-keygen") $ \dir -> do 	ok <- boolSystem "ssh-keygen" 		[ Param "-P", Param "" -- no password-		, Param "-f", File $ dir </> "key"+		, Param "-f", File $ fromOsPath (dir </> literalOsPath "key") 		] 	unless ok $ 		giveup "ssh-keygen failed" 	SshKeyPair-		<$> readFile (dir </> "key.pub")-		<*> readFile (dir </> "key")+		<$> readFile (fromOsPath (dir </> literalOsPath "key.pub"))+		<*> readFile (fromOsPath (dir </> literalOsPath "key"))  {- Installs a ssh key pair, and sets up ssh config with a mangled hostname  - that will enable use of the key. This way we avoid changing the user's@@ -244,25 +248,28 @@ installSshKeyPair :: SshKeyPair -> SshData -> IO SshData installSshKeyPair sshkeypair sshdata = do 	sshdir <- sshDir-	createDirectoryIfMissing True $ fromRawFilePath $-		parentDir $ toRawFilePath $ sshdir </> sshPrivKeyFile sshdata+	createDirectoryIfMissing True $+		parentDir $ sshdir </> sshPrivKeyFile sshdata  	unlessM (doesFileExist $ sshdir </> sshPrivKeyFile sshdata) $-		writeFileProtected (toRawFilePath (sshdir </> sshPrivKeyFile sshdata)) (sshPrivKey sshkeypair)+		writeFileProtected (sshdir </> sshPrivKeyFile sshdata)+			(sshPrivKey sshkeypair) 	unlessM (doesFileExist $ sshdir </> sshPubKeyFile sshdata) $-		writeFile (sshdir </> sshPubKeyFile sshdata) (sshPubKey sshkeypair)+		writeFile (fromOsPath (sshdir </> sshPubKeyFile sshdata))+			(sshPubKey sshkeypair)  	setSshConfig sshdata-		[ ("IdentityFile", "~/.ssh/" ++ sshPrivKeyFile sshdata)+		[ ("IdentityFile", "~/.ssh/" ++ fromOsPath (sshPrivKeyFile sshdata)) 		, ("IdentitiesOnly", "yes") 		, ("StrictHostKeyChecking", "yes") 		] -sshPrivKeyFile :: SshData -> FilePath-sshPrivKeyFile sshdata = "git-annex" </> "key." ++ mangleSshHostName sshdata+sshPrivKeyFile :: SshData -> OsPath+sshPrivKeyFile sshdata = literalOsPath "git-annex" +	</> literalOsPath "key." <> toOsPath (mangleSshHostName sshdata) -sshPubKeyFile :: SshData -> FilePath-sshPubKeyFile sshdata = sshPrivKeyFile sshdata ++ ".pub"+sshPubKeyFile :: SshData -> OsPath+sshPubKeyFile sshdata = sshPrivKeyFile sshdata <> literalOsPath ".pub"  {- Generates an installs a new ssh key pair if one is not already  - installed. Returns the modified SshData that will use the key pair,@@ -270,8 +277,8 @@ setupSshKeyPair :: SshData -> IO (SshData, SshKeyPair) setupSshKeyPair sshdata = do 	sshdir <- sshDir-	mprivkey <- catchMaybeIO $ readFile (sshdir </> sshPrivKeyFile sshdata)-	mpubkey <- catchMaybeIO $ readFile (sshdir </> sshPubKeyFile sshdata)+	mprivkey <- catchMaybeIO $ readFile (fromOsPath (sshdir </> sshPrivKeyFile sshdata))+	mpubkey <- catchMaybeIO $ readFile (fromOsPath (sshdir </> sshPubKeyFile sshdata)) 	keypair <- case (mprivkey, mpubkey) of 		(Just privkey, Just pubkey) -> return $ SshKeyPair 			{ sshPubKey = pubkey@@ -323,7 +330,7 @@ setSshConfig sshdata config = do 	sshdir <- sshDir 	createDirectoryIfMissing True sshdir-	let configfile = sshdir </> "config"+	let configfile = fromOsPath (sshdir </> literalOsPath "config") 	unlessM (catchBoolIO $ isInfixOf mangledhost <$> readFile configfile) $ do 		appendFile configfile $ unlines $ 			[ ""@@ -331,7 +338,7 @@ 			, "Host " ++ mangledhost 			] ++ map (\(k, v) -> "\t" ++ k ++ " " ++ v) 				(settings ++ config)-		setSshConfigMode (toRawFilePath configfile)+		setSshConfigMode (toOsPath configfile)  	return $ sshdata 		{ sshHostName = T.pack mangledhost@@ -402,7 +409,7 @@ knownHost :: Text -> IO Bool knownHost hostname = do 	sshdir <- sshDir-	ifM (doesFileExist $ sshdir </> "known_hosts")+	ifM (doesFileExist $ sshdir </> literalOsPath "known_hosts") 		( not . null <$> checkhost 		, return False 		)
Assistant/Threads/Committer.hs view
@@ -67,11 +67,10 @@ 	liftAnnex $ do 		-- Clean up anything left behind by a previous process 		-- on unclean shutdown.-		void $ liftIO $ tryIO $ removeDirectoryRecursive-			(fromRawFilePath lockdowndir)+		void $ liftIO $ tryIO $ removeDirectoryRecursive lockdowndir 		void $ createAnnexDirectory lockdowndir 	waitChangeTime $ \(changes, time) -> do-		readychanges <- handleAdds (fromRawFilePath lockdowndir) havelsof largefilematcher annexdotfiles delayadd $+		readychanges <- handleAdds lockdowndir havelsof largefilematcher annexdotfiles delayadd $ 			simplifyChanges changes 		if shouldCommit False time (length readychanges) readychanges 			then do@@ -276,12 +275,12 @@  - Any pending adds that are not ready yet are put back into the ChangeChan,  - where they will be retried later.  -}-handleAdds :: FilePath -> Bool -> GetFileMatcher -> Bool -> Maybe Seconds -> [Change] -> Assistant [Change]+handleAdds :: OsPath -> Bool -> GetFileMatcher -> Bool -> Maybe Seconds -> [Change] -> Assistant [Change] handleAdds lockdowndir havelsof largefilematcher annexdotfiles delayadd cs = returnWhen (null incomplete) $ do 	let (pending, inprocess) = partition isPendingAddChange incomplete 	let lockdownconfig = LockDownConfig 		{ lockingFile = False-		, hardlinkFileTmpDir = Just (toRawFilePath lockdowndir)+		, hardlinkFileTmpDir = Just lockdowndir 		, checkWritePerms = True 		} 	(postponed, toadd) <- partitionEithers@@ -307,12 +306,13 @@ 		| otherwise = a 	 	checkpointerfile change = do-		let file = toRawFilePath $ changeFile change+		let file = changeFile change 		mk <- liftIO $ isPointerFile file 		case mk of 			Nothing -> return (Right change) 			Just key -> do-				mode <- liftIO $ catchMaybeIO $ fileMode <$> R.getFileStatus file+				mode <- liftIO $ catchMaybeIO $+					fileMode <$> R.getFileStatus (fromOsPath file) 				liftAnnex $ stagePointerFile file mode =<< hashPointerFile key 				return $ Left $ Change 					(changeTime change)@@ -328,7 +328,7 @@ 				else checkmatcher 		| otherwise = checkmatcher 	  where-		f = toRawFilePath (changeFile change)+		f = changeFile change 		checkmatcher = ifM (liftAnnex $ checkFileMatcher NoLiveUpdate largefilematcher f) 			( return (Left change) 			, return (Right change)@@ -336,9 +336,9 @@  	addsmall [] = noop 	addsmall toadd = liftAnnex $ void $ tryIO $-		forM (map (toRawFilePath . changeFile) toadd) $ \f ->+		forM (map changeFile toadd) $ \f -> 			Command.Add.addFile Command.Add.Small f-				=<< liftIO (R.getSymbolicLinkStatus f)+				=<< liftIO (R.getSymbolicLinkStatus (fromOsPath f))  	{- Avoid overhead of re-injesting a renamed unlocked file, by 	 - examining the other Changes to see if a removed file has the@@ -353,13 +353,13 @@ 		delta <- liftAnnex getTSDelta 		let cfg = LockDownConfig 			{ lockingFile = False-			, hardlinkFileTmpDir = Just (toRawFilePath lockdowndir)+			, hardlinkFileTmpDir = Just lockdowndir 			, checkWritePerms = True 			} 		if M.null m 			then forM toadd (addannexed' cfg) 			else forM toadd $ \c -> do-				mcache <- liftIO $ genInodeCache (toRawFilePath (changeFile c)) delta+				mcache <- liftIO $ genInodeCache (changeFile c) delta 				case mcache of 					Nothing -> addannexed' cfg c 					Just cache ->@@ -376,19 +376,19 @@ 			(mkey, _mcache) <- liftAnnex $ do 				showStartMessage (StartMessage "add" (ActionItemOther (Just (QuotedPath (keyFilename ks)))) (SeekInput [])) 				ingest nullMeterUpdate (Just $ LockedDown lockdownconfig ks) Nothing-			maybe (failedingest change) (done change $ fromRawFilePath $ keyFilename ks) mkey+			maybe (failedingest change) (done change $ keyFilename ks) mkey 	addannexed' _ _ = return Nothing  	fastadd :: Change -> Key -> Assistant (Maybe Change) 	fastadd change key = do 		let source = keySource $ lockedDown change 		liftAnnex $ finishIngestUnlocked key source-		done change (fromRawFilePath $ keyFilename source) key+		done change (keyFilename source) key  	removedKeysMap :: InodeComparisonType -> [Change] -> Annex (M.Map InodeCacheKey Key) 	removedKeysMap ct l = do 		mks <- forM (filter isRmChange l) $ \c ->-			catKeyFile $ toRawFilePath $ changeFile c+			catKeyFile $ changeFile c 		M.fromList . concat <$> mapM mkpairs (catMaybes mks) 	  where 		mkpairs k = map (\c -> (inodeCacheToKey ct c, k)) <$>@@ -401,8 +401,9 @@  	done change file key = liftAnnex $ do 		logStatus NoLiveUpdate key InfoPresent-		mode <- liftIO $ catchMaybeIO $ fileMode <$> R.getFileStatus (toRawFilePath file)-		stagePointerFile (toRawFilePath file) mode =<< hashPointerFile key+		mode <- liftIO $ catchMaybeIO $+			fileMode <$> R.getFileStatus (fromOsPath file)+		stagePointerFile file mode =<< hashPointerFile key 		showEndOk 		return $ Just $ finishedChange change key @@ -410,14 +411,14 @@ 	 - and is still a hard link to its contentLocation, 	 - before ingesting it. -} 	sanitycheck keysource a = do-		fs <- liftIO $ R.getSymbolicLinkStatus $ keyFilename keysource-		ks <- liftIO $ R.getSymbolicLinkStatus $ contentLocation keysource+		fs <- liftIO $ R.getSymbolicLinkStatus $ fromOsPath $ keyFilename keysource+		ks <- liftIO $ R.getSymbolicLinkStatus $ fromOsPath $ contentLocation keysource 		if deviceID ks == deviceID fs && fileID ks == fileID fs 			then a 			else do 				-- remove the hard link 				when (contentLocation keysource /= keyFilename keysource) $-					void $ liftIO $ tryIO $ removeFile $ fromRawFilePath $ contentLocation keysource+					void $ liftIO $ tryIO $ removeFile $ contentLocation keysource 				return Nothing  	{- Shown an alert while performing an action to add a file or@@ -430,7 +431,7 @@ 	 - the add succeeded. 	 -} 	addaction [] a = a-	addaction toadd a = alertWhile' (addFileAlert $ map changeFile toadd) $+	addaction toadd a = alertWhile' (addFileAlert $ map (fromOsPath . changeFile) toadd) $ 		(,)  			<$> pure True 			<*> a@@ -440,7 +441,7 @@  -  - Check by running lsof on the repository.  -}-safeToAdd :: FilePath -> LockDownConfig -> Bool -> Maybe Seconds -> [Change] -> [Change] -> Assistant [Either Change Change]+safeToAdd :: OsPath -> LockDownConfig -> Bool -> Maybe Seconds -> [Change] -> [Change] -> Assistant [Either Change Change] safeToAdd _ _ _ _ [] [] = return [] safeToAdd lockdowndir lockdownconfig havelsof delayadd pending inprocess = do 	maybe noop (liftIO . threadDelaySeconds) delayadd@@ -451,7 +452,8 @@ 			then S.fromList . map fst3 . filter openwrite <$> 				findopenfiles (map (keySource . lockedDown) inprocess') 			else pure S.empty-		let checked = map (check openfiles) inprocess'+		let openfiles' = S.map toOsPath openfiles+		let checked = map (check openfiles') inprocess'  		{- If new events are received when files are closed, 		 - there's no need to retry any changes that cannot@@ -463,7 +465,7 @@ 			else return checked   where 	check openfiles change@(InProcessAddChange { lockedDown = ld })-		| S.member (fromRawFilePath (contentLocation (keySource ld))) openfiles = Left change+		| S.member (contentLocation (keySource ld)) openfiles = Left change 	check _ change = Right change  	mkinprocess (c, Just ld) = Just InProcessAddChange@@ -478,7 +480,7 @@ 			<> " still has writers, not adding" 		-- remove the hard link 		when (contentLocation ks /= keyFilename ks) $-			void $ liftIO $ tryIO $ removeFile $ fromRawFilePath $ contentLocation ks+			void $ liftIO $ tryIO $ removeFile $ contentLocation ks 	canceladd _ = noop  	openwrite (_file, mode, _pid)@@ -498,9 +500,9 @@ 	findopenfiles keysources = ifM crippledFileSystem 		( liftIO $ do 			let segments = segmentXargsUnordered $-				map (fromRawFilePath . keyFilename) keysources+				map (fromOsPath . keyFilename) keysources 			concat <$> forM segments (\fs -> Lsof.query $ "--" : fs)-		, liftIO $ Lsof.queryDir lockdowndir+		, liftIO $ Lsof.queryDir (fromOsPath lockdowndir) 		)  {- After a Change is committed, queue any necessary transfers or drops@@ -521,5 +523,5 @@ 			handleDrops "file renamed" present k af []   where 	f = changeFile change-	af = AssociatedFile (Just (toRawFilePath f))+	af = AssociatedFile (Just f) checkChangeContent _ = noop
Assistant/Threads/ConfigMonitor.hs view
@@ -44,7 +44,7 @@ 		when (old /= new) $ do 			let changedconfigs = new `S.difference` old 			debug $ "reloading config" : -				map (fromRawFilePath . fst)+				map (fromOsPath . fst) 				(S.toList changedconfigs) 			reloadConfigs new 			{- Record a commit to get this config@@ -54,10 +54,10 @@ 		loop new  {- Config files, and their checksums. -}-type Configs = S.Set (RawFilePath, Sha)+type Configs = S.Set (OsPath, Sha)  {- All git-annex's config files, and actions to run when they change. -}-configFilesActions :: [(RawFilePath, Assistant ())]+configFilesActions :: [(OsPath, Assistant ())] configFilesActions = 	[ (uuidLog, void $ liftAnnex uuidDescMapLoad) 	, (remoteLog, void $ liftAnnex remotesChanged)@@ -91,5 +91,5 @@ getConfigs = S.fromList . map extract 	<$> liftAnnex (inRepo $ LsTree.lsTreeFiles (LsTree.LsTreeLong False) Annex.Branch.fullname files)   where-	files = map (fromRawFilePath . fst) configFilesActions+	files = map (fromOsPath . fst) configFilesActions 	extract treeitem = (getTopFilePath $ LsTree.file treeitem, LsTree.sha treeitem)
Assistant/Threads/Cronner.hs view
@@ -181,7 +181,7 @@  runActivity' :: UrlRenderer -> ScheduledActivity -> Assistant () runActivity' urlrenderer (ScheduledSelfFsck _ d) = do-	program <- liftIO programPath+	program <- fromOsPath <$> liftIO programPath 	g <- liftAnnex gitRepo 	fsckresults <- showFscking urlrenderer Nothing $ tryNonAsync $ do 		void $ batchCommand program (Param "fsck" : annexFsckParams d)@@ -196,7 +196,7 @@ 	dispatch Nothing = debug ["skipping remote fsck of uuid without a configured remote", fromUUID u, fromSchedule s] 	dispatch (Just rmt) = void $ case Remote.remoteFsck rmt of 		Nothing -> go rmt $ do-			program <- programPath+			program <- fromOsPath <$> programPath 			void $ batchCommand program $  				[ Param "fsck" 				-- avoid downloading files
Assistant/Threads/Merger.hs view
@@ -24,8 +24,7 @@ import qualified Git.Branch import qualified Git.Ref import qualified Command.Sync--import qualified System.FilePath.ByteString as P+import qualified Utility.OsString as OS  {- This thread watches for changes to .git/refs/, and handles incoming  - pushes. -}@@ -33,7 +32,7 @@ mergeThread = namedThread "Merger" $ do 	g <- liftAnnex gitRepo 	let gitd = Git.localGitDir g-	let dir = gitd P.</> "refs"+	let dir = gitd </> literalOsPath "refs" 	liftIO $ createDirectoryUnder [gitd] dir 	let hook a = Just <$> asIO2 (runHandler a) 	changehook <- hook onChange@@ -43,21 +42,21 @@ 		, modifyHook = changehook 		, errHook = errhook 		}-	void $ liftIO $ watchDir (fromRawFilePath dir) (const False) True hooks id-	debug ["watching", fromRawFilePath dir]+	void $ liftIO $ watchDir dir (const False) True hooks id+	debug ["watching", fromOsPath dir] -type Handler = FilePath -> Assistant ()+type Handler t = t -> Assistant ()  {- Runs an action handler.  -  - Exceptions are ignored, otherwise a whole thread could be crashed.  -}-runHandler :: Handler -> FilePath -> Maybe FileStatus -> Assistant ()+runHandler :: Handler t -> t -> Maybe FileStatus -> Assistant () runHandler handler file _filestatus = 	either (liftIO . print) (const noop) =<< tryIO <~> handler file  {- Called when there's an error with inotify. -}-onErr :: Handler+onErr :: Handler String onErr = giveup  {- Called when a new branch ref is written, or a branch ref is modified.@@ -66,9 +65,9 @@  - ok; it ensures that any changes pushed since the last time the assistant  - ran are merged in.  -}-onChange :: Handler+onChange :: Handler OsPath onChange file-	| ".lock" `isSuffixOf` file = noop+	| literalOsPath ".lock" `OS.isSuffixOf` file = noop 	| isAnnexBranch file = do 		branchChanged 		diverged <- liftAnnex Annex.Branch.forceUpdate >>= return . \case@@ -112,7 +111,7 @@  - to the second branch, which should be merged into it? -} isRelatedTo :: Git.Ref -> Git.Ref -> Bool isRelatedTo x y-	| basex /= takeDirectory basex ++ "/" ++ basey = False+	| basex /= fromOsPath (takeDirectory (toOsPath basex)) ++ "/" ++ basey = False 	| "/synced/" `isInfixOf` Git.fromRef x = True 	| "refs/remotes/" `isPrefixOf` Git.fromRef x = True 	| otherwise = False@@ -120,12 +119,12 @@ 	basex = Git.fromRef $ Git.Ref.base x 	basey = Git.fromRef $ Git.Ref.base y -isAnnexBranch :: FilePath -> Bool-isAnnexBranch f = n `isSuffixOf` f+isAnnexBranch :: OsPath -> Bool+isAnnexBranch f = n `isSuffixOf` fromOsPath f   where 	n = '/' : Git.fromRef Annex.Branch.name -fileToBranch :: FilePath -> Git.Ref-fileToBranch f = Git.Ref $ encodeBS $ "refs" </> base+fileToBranch :: OsPath -> Git.Ref+fileToBranch f = Git.Ref $ fromOsPath $ literalOsPath "refs" </> toOsPath base   where-	base = Prelude.last $ split "/refs/" f+	base = Prelude.last $ split "/refs/" (fromOsPath f)
Assistant/Threads/MountWatcher.hs view
@@ -138,12 +138,12 @@  handleMounts :: UrlRenderer -> MountPoints -> MountPoints -> Assistant () handleMounts urlrenderer wasmounted nowmounted =-	mapM_ (handleMount urlrenderer . mnt_dir) $+	mapM_ (handleMount urlrenderer . toOsPath . mnt_dir) $ 		S.toList $ newMountPoints wasmounted nowmounted -handleMount :: UrlRenderer -> FilePath -> Assistant ()+handleMount :: UrlRenderer -> OsPath -> Assistant () handleMount urlrenderer dir = do-	debug ["detected mount of", dir]+	debug ["detected mount of", fromOsPath dir] 	rs <- filterM (Git.repoIsLocal <$$> liftAnnex . Remote.getRepo) 		=<< remotesUnder dir 	mapM_ (fsckNudge urlrenderer . Just) rs@@ -157,7 +157,7 @@  - at startup time, or may have changed (it could even be a different  - repository at the same remote location..)  -}-remotesUnder :: FilePath -> Assistant [Remote]+remotesUnder :: OsPath -> Assistant [Remote] remotesUnder dir = do 	repotop <- liftAnnex $ fromRepo Git.repoPath 	rs <- liftAnnex remoteList@@ -169,7 +169,7 @@ 	return $ mapMaybe snd $ filter fst pairs   where 	checkremote repotop r = case Remote.localpath r of-		Just p | dirContains (toRawFilePath dir) (absPathFrom repotop (toRawFilePath p)) ->+		Just p | dirContains dir (absPathFrom repotop p) -> 			(,) <$> pure True <*> updateRemote r 		_ -> return (False, Just r)
Assistant/Threads/PairListener.hs view
@@ -121,7 +121,7 @@ pairAckReceived :: Bool -> Maybe PairingInProgress -> PairMsg -> [PairingInProgress] -> Assistant [PairingInProgress] pairAckReceived True (Just pip) msg cache = do 	stopSending pip-	repodir <- fromRawFilePath . repoPath <$> liftAnnex gitRepo+	repodir <- repoPath <$> liftAnnex gitRepo 	liftIO $ setupAuthorizedKeys msg repodir 	finishedLocalPairing msg (inProgressSshKeyPair pip) 	startSending pip PairDone $ multicastPairMsg
Assistant/Threads/RemoteControl.hs view
@@ -28,7 +28,7 @@  remoteControlThread :: NamedThread remoteControlThread = namedThread "RemoteControl" $ do-	program <- liftIO programPath+	program <- liftIO $ fromOsPath <$> programPath 	(cmd, params) <- liftIO $ toBatchCommand 		(program, [Param "remotedaemon", Param "--foreground"]) 	let p = proc cmd (toCommand params)
Assistant/Threads/SanityChecker.hs view
@@ -68,7 +68,7 @@ 	ifM (not <$> liftAnnex (inRepo checkIndexFast)) 		( do 			debug ["corrupt index file found at startup; removing and restaging"]-			liftAnnex $ inRepo $ removeWhenExistsWith R.removeLink . indexFile+			liftAnnex $ inRepo $ removeWhenExistsWith removeFile . indexFile 			{- Normally the startup scan avoids re-staging files, 			 - but with the index deleted, everything needs to be 			 - restaged. -}@@ -82,7 +82,7 @@ 	 - will be automatically regenerated. -} 	unlessM (liftAnnex $ Annex.Branch.withIndex $ inRepo $ Git.Repair.checkIndexFast) $ do 		debug ["corrupt annex/index file found at startup; removing"]-		liftAnnex $ liftIO . removeWhenExistsWith R.removeLink =<< fromRepo gitAnnexIndex+		liftAnnex $ liftIO . removeWhenExistsWith removeFile =<< fromRepo gitAnnexIndex  	{- Fix up ssh remotes set up by past versions of the assistant. -} 	liftIO $ fixUpSshRemotes@@ -154,13 +154,13 @@ 	batchmaker <- liftIO getBatchCommandMaker  	-- Find old unstaged symlinks, and add them to git.-	(unstaged, cleanup) <- liftIO $ Git.LsFiles.notInRepo [] False ["."] g+	(unstaged, cleanup) <- liftIO $ Git.LsFiles.notInRepo [] False [literalOsPath "."] g 	now <- liftIO getPOSIXTime 	forM_ unstaged $ \file -> do-		ms <- liftIO $ catchMaybeIO $ R.getSymbolicLinkStatus file+		ms <- liftIO $ catchMaybeIO $ R.getSymbolicLinkStatus $ fromOsPath file 		case ms of 			Just s	| toonew (statusChangeTime s) now -> noop-				| isSymbolicLink s -> addsymlink (fromRawFilePath file) ms+				| isSymbolicLink s -> addsymlink file ms 			_ -> noop 	liftIO $ void cleanup @@ -182,7 +182,7 @@ 	{- Run git-annex unused once per day. This is run as a separate 	 - process to stay out of the annex monad and so it can run as a 	 - batch job. -}-	program <- liftIO programPath+	program <- fromOsPath <$> liftIO programPath 	let (program', params') = batchmaker (program, [Param "unused"]) 	void $ liftIO $ boolSystem program' params' 	{- Invalidate unused keys cache, and queue transfers of all unused@@ -202,7 +202,7 @@ 		void $ addAlert $ sanityCheckFixAlert msg 	addsymlink file s = do 		Watcher.runHandler Watcher.onAddSymlink file s-		insanity $ "found unstaged symlink: " ++ file+		insanity $ "found unstaged symlink: " ++ fromOsPath file  hourlyCheck :: Assistant () hourlyCheck = do@@ -222,14 +222,14 @@  -} checkLogSize :: Int -> Assistant () checkLogSize n = do-	f <- liftAnnex $ fromRawFilePath <$> fromRepo gitAnnexDaemonLogFile-	logs <- liftIO $ listLogs f-	totalsize <- liftIO $ sum <$> mapM (getFileSize . toRawFilePath) logs+	f <- liftAnnex $ fromRepo gitAnnexDaemonLogFile+	logs <- liftIO $ listLogs (fromOsPath f)+	totalsize <- liftIO $ sum <$> mapM (getFileSize . toOsPath) logs 	when (totalsize > 2 * oneMegabyte) $ do 		debug ["Rotated logs due to size:", show totalsize]-		liftIO $ openLog f >>= handleToFd >>= redirLog+		liftIO $ openLog (fromOsPath f) >>= handleToFd >>= redirLog 		when (n < maxLogs + 1) $ do-			df <- liftIO $ getDiskFree $ takeDirectory f+			df <- liftIO $ getDiskFree $ fromOsPath $ takeDirectory f 			case df of 				Just free 					| free < fromIntegral totalsize ->@@ -270,5 +270,5 @@ checkRepoExists :: Assistant () checkRepoExists = do 	g <- liftAnnex gitRepo-	liftIO $ unlessM (doesDirectoryExist $ fromRawFilePath $ Git.repoPath g) $+	liftIO $ unlessM (doesDirectoryExist $ Git.repoPath g) $ 		terminateSelf
Assistant/Threads/TransferPoller.hs view
@@ -47,7 +47,7 @@ 		| otherwise = do 			let (f, _, _) = transferFileAndLockFile t g 			mi <- liftIO $ catchDefaultIO Nothing $-				readTransferInfoFile Nothing (fromRawFilePath f)+				readTransferInfoFile Nothing f 			maybe noop (newsize t info . bytesComplete) mi  	newsize t info sz
Assistant/Threads/TransferWatcher.hs view
@@ -38,25 +38,25 @@ 		, modifyHook = modifyhook 		, errHook = errhook 		}-	void $ liftIO $ watchDir (fromRawFilePath dir) (const False) True hooks id+	void $ liftIO $ watchDir dir (const False) True hooks id 	debug ["watching for transfers"] -type Handler = FilePath -> Assistant ()+type Handler t = t -> Assistant ()  {- Runs an action handler.  -  - Exceptions are ignored, otherwise a whole thread could be crashed.  -}-runHandler :: Handler -> FilePath -> Maybe FileStatus -> Assistant ()+runHandler :: Handler t -> t -> Maybe FileStatus -> Assistant () runHandler handler file _filestatus = 	either (liftIO . print) (const noop) =<< tryIO <~> handler file  {- Called when there's an error with inotify. -}-onErr :: Handler+onErr :: Handler String onErr = giveup  {- Called when a new transfer information file is written. -}-onAdd :: Handler+onAdd :: Handler OsPath onAdd file = case parseTransferFile file of 	Nothing -> noop 	Just t -> go t =<< liftAnnex (checkTransfer t)@@ -72,7 +72,7 @@  -  - The only thing that should change in the transfer info is the  - bytesComplete, so that's the only thing updated in the DaemonStatus. -}-onModify :: Handler+onModify :: Handler OsPath onModify file = case parseTransferFile file of 	Nothing -> noop 	Just t -> go t =<< liftIO (readTransferInfoFile Nothing file)@@ -87,7 +87,7 @@ watchesTransferSize = modifyTracked  {- Called when a transfer information file is removed. -}-onDel :: Handler+onDel :: Handler OsPath onDel file = case parseTransferFile file of 	Nothing -> noop 	Just t -> do
Assistant/Threads/UpgradeWatcher.hs view
@@ -46,7 +46,7 @@ 			, modifyHook = changed 			, delDirHook = changed 			}-		let dir = fromRawFilePath (parentDir (toRawFilePath flagfile))+		let dir = parentDir flagfile 		let depth = length (splitPath dir) + 1 		let nosubdirs f = length (splitPath f) == depth 		void $ liftIO $ watchDir dir nosubdirs False hooks (startup mvar)@@ -57,7 +57,7 @@ 		void $ swapMVar mvar Started 		return r -changedFile :: UrlRenderer -> MVar WatcherState -> FilePath -> FilePath -> Maybe FileStatus -> Assistant ()+changedFile :: UrlRenderer -> MVar WatcherState -> OsPath -> OsPath -> Maybe FileStatus -> Assistant () changedFile urlrenderer mvar flagfile file _status 	| flagfile /= file = noop 	| otherwise = do
Assistant/Threads/Watcher.hs view
@@ -42,6 +42,7 @@ import Config.GitConfig import Utility.ThreadScheduler import Logs.Location+import qualified Utility.OsString as OS import qualified Database.Keys #ifndef mingw32_HOST_OS import qualified Utility.Lsof as Lsof@@ -94,16 +95,16 @@ 	delhook <- hook onDel 	addsymlinkhook <- hook onAddSymlink 	deldirhook <- hook onDelDir-	errhook <- hook onErr+	errhook <- asIO2 onErr 	let hooks = mkWatchHooks 		{ addHook = addhook 		, delHook = delhook 		, addSymlinkHook = addsymlinkhook 		, delDirHook = deldirhook-		, errHook = errhook+		, errHook = Just errhook 		} 	scanevents <- liftAnnex $ annexStartupScan <$> Annex.getGitConfig-	h <- liftIO $ watchDir "." ignored scanevents hooks startup+	h <- liftIO $ watchDir (literalOsPath ".") ignored scanevents hooks startup 	debug [ "watching", "."] 	 	{- Let the DirWatcher thread run until signalled to pause it,@@ -138,9 +139,8 @@ 		top <- liftAnnex $ fromRepo Git.repoPath 		(fs, cleanup) <- liftAnnex $ inRepo $ LsFiles.deleted [] [top] 		forM_ fs $ \f -> do-			let f' = fromRawFilePath f-			liftAnnex $ onDel' f'-			maybe noop recordChange =<< madeChange f' RmChange+			liftAnnex $ onDel' f+			maybe noop recordChange =<< madeChange f RmChange 		void $ liftIO cleanup 		 		liftAnnex $ showAction "started"@@ -157,30 +157,31 @@  {- Hardcoded ignores, passed to the DirWatcher so it can avoid looking  - at the entire .git directory. Does not include .gitignores. -}-ignored :: FilePath -> Bool+ignored :: OsPath -> Bool ignored = ig . takeFileName   where-	ig ".git" = True-	ig ".gitignore" = True-	ig ".gitattributes" = True+	ig f+		| f == literalOsPath ".git" = True+		| f == literalOsPath ".gitignore" = True+		| f == literalOsPath ".gitattributes" = True #ifdef darwin_HOST_OS-	ig ".DS_Store" = True+		| f == literalOsPath ".DS_Store" = True #endif-	ig _ = False+		| otherwise = False -unlessIgnored :: FilePath -> Assistant (Maybe Change) -> Assistant (Maybe Change)-unlessIgnored file a = ifM (liftAnnex $ checkIgnored (CheckGitIgnore True) (toRawFilePath file))+unlessIgnored :: OsPath -> Assistant (Maybe Change) -> Assistant (Maybe Change)+unlessIgnored file a = ifM (liftAnnex $ checkIgnored (CheckGitIgnore True) file) 	( noChange 	, a 	) -type Handler = FilePath -> Maybe FileStatus -> Assistant (Maybe Change)+type Handler = OsPath -> Maybe FileStatus -> Assistant (Maybe Change)  {- Runs an action handler, and if there was a change, adds it to the ChangeChan.  -  - Exceptions are ignored, otherwise a whole watcher thread could be crashed.  -}-runHandler :: Handler -> FilePath -> Maybe FileStatus -> Assistant ()+runHandler :: Handler -> OsPath -> Maybe FileStatus -> Assistant () runHandler handler file filestatus = void $ do 	r <- tryIO <~> handler (normalize file) filestatus 	case r of@@ -189,7 +190,7 @@ 		Right (Just change) -> recordChange change   where 	normalize f-		| "./" `isPrefixOf` file = drop 2 f+		| literalOsPath "./" `OS.isPrefixOf` file = OS.drop 2 f 		| otherwise = f  shouldRestage :: DaemonStatus -> Bool@@ -201,34 +202,34 @@   where 	addassociatedfile key file =  		Database.Keys.addAssociatedFile key-			=<< inRepo (toTopFilePath (toRawFilePath file))+			=<< inRepo (toTopFilePath file) 	samefilestatus key file status = do 		cache <- Database.Keys.getInodeCaches key 		curr <- withTSDelta $ \delta ->-			liftIO $ toInodeCache delta (toRawFilePath file) status+			liftIO $ toInodeCache delta file status 		case (cache, curr) of 			(_, Just c) -> elemInodeCaches c cache 			([], Nothing) -> return True 			_ -> return False 	contentchanged oldkey file = do 		Database.Keys.removeAssociatedFile oldkey-			=<< inRepo (toTopFilePath (toRawFilePath file))+			=<< inRepo (toTopFilePath file) 		unlessM (inAnnex oldkey) $ 			logStatus NoLiveUpdate oldkey InfoMissing 	addlink file key = do-		mode <- liftIO $ catchMaybeIO $ fileMode <$> R.getFileStatus (toRawFilePath file)-		liftAnnex $ stagePointerFile (toRawFilePath file) mode =<< hashPointerFile key+		mode <- liftIO $ catchMaybeIO $ fileMode <$> R.getFileStatus (fromOsPath file)+		liftAnnex $ stagePointerFile file mode =<< hashPointerFile key 		madeChange file $ LinkChange (Just key)  onAddFile'-	:: (Key -> FilePath -> Annex ())-	-> (Key -> FilePath -> Annex ())-	-> (FilePath -> Key -> Assistant (Maybe Change))-	-> (Key -> FilePath -> FileStatus -> Annex Bool)+	:: (Key -> OsPath -> Annex ())+	-> (Key -> OsPath -> Annex ())+	-> (OsPath -> Key -> Assistant (Maybe Change))+	-> (Key -> OsPath -> FileStatus -> Annex Bool) 	-> Bool 	-> Handler onAddFile' contentchanged addassociatedfile addlink samefilestatus symlinkssupported file fs = do-	v <- liftAnnex $ catKeyFile (toRawFilePath file)+	v <- liftAnnex $ catKeyFile file 	case (v, fs) of 		(Just key, Just filestatus) -> 			ifM (liftAnnex $ samefilestatus key file filestatus)@@ -242,13 +243,13 @@ 					, noChange 					) 				, guardSymlinkStandin (Just key) $ do-					debug ["changed", file]+					debug ["changed", fromOsPath file] 					liftAnnex $ contentchanged key file 					pendingAddChange file 				) 		_ -> unlessIgnored file $ 			guardSymlinkStandin Nothing $ do-				debug ["add", file]+				debug ["add", fromOsPath file] 				pendingAddChange file   where 	{- On a filesystem without symlinks, we'll get changes for regular@@ -258,8 +259,7 @@ 	guardSymlinkStandin mk a 		| symlinkssupported = a 		| otherwise = do-			linktarget <- liftAnnex $ getAnnexLinkTarget $-				toRawFilePath file+			linktarget <- liftAnnex $ getAnnexLinkTarget file 			case linktarget of 				Nothing -> a 				Just lt -> do@@ -275,17 +275,16 @@  -} onAddSymlink :: Handler onAddSymlink file filestatus = unlessIgnored file $ do-	linktarget <- liftIO (catchMaybeIO $ R.readSymbolicLink file')-	kv <- liftAnnex (lookupKey file')+	linktarget <- liftIO $ catchMaybeIO $+		R.readSymbolicLink (fromOsPath file)+	kv <- liftAnnex (lookupKey file) 	onAddSymlink' linktarget kv file filestatus-  where-	file' = toRawFilePath file  onAddSymlink' :: Maybe LinkTarget -> Maybe Key -> Handler onAddSymlink' linktarget mk file filestatus = go mk   where 	go (Just key) = do-		link <- liftAnnex $ calcRepo $ gitAnnexLink (toRawFilePath file) key+		link <- liftAnnex $ fromOsPath <$> calcRepo (gitAnnexLink file key) 		if linktarget == Just link 			then ensurestaged (Just link) =<< getDaemonStatus 			else do@@ -315,33 +314,32 @@ 	ensurestaged Nothing _ = noChange  {- For speed, tries to reuse the existing blob for symlink target. -}-addLink :: FilePath -> LinkTarget -> Maybe Key -> Assistant (Maybe Change)+addLink :: OsPath -> LinkTarget -> Maybe Key -> Assistant (Maybe Change) addLink file link mk = do-	debug ["add symlink", file]+	debug ["add symlink", fromOsPath file] 	liftAnnex $ do-		v <- catObjectDetails $ Ref $ encodeBS $ ':':file+		v <- catObjectDetails $ Ref $ encodeBS $ ':':fromOsPath file 		case v of 			Just (currlink, sha, _type) 				| L.fromStrict link == currlink ->-					stageSymlink (toRawFilePath file) sha-			_ -> stageSymlink (toRawFilePath file)-				=<< hashSymlink link+					stageSymlink file sha+			_ -> stageSymlink file =<< hashSymlink link 	madeChange file $ LinkChange mk  onDel :: Handler onDel file _ = do-	debug ["file deleted", file]+	debug ["file deleted", fromOsPath file] 	liftAnnex $ onDel' file 	madeChange file RmChange -onDel' :: FilePath -> Annex ()+onDel' :: OsPath -> Annex () onDel' file = do-	topfile <- inRepo (toTopFilePath (toRawFilePath file))+	topfile <- inRepo (toTopFilePath file) 	withkey $ flip Database.Keys.removeAssociatedFile topfile 	Annex.Queue.addUpdateIndex =<<-		inRepo (Git.UpdateIndex.unstageFile (toRawFilePath file))+		inRepo (Git.UpdateIndex.unstageFile file)   where-	withkey a = maybe noop a =<< catKeyFile (toRawFilePath file)+	withkey a = maybe noop a =<< catKeyFile file  {- A directory has been deleted, or moved, so tell git to remove anything  - that was inside it from its cache. Since it could reappear at any time,@@ -351,23 +349,21 @@  - pairing up renamed files when the directory was renamed. -} onDelDir :: Handler onDelDir dir _ = do-	debug ["directory deleted", dir]-	(fs, clean) <- liftAnnex $ inRepo $ LsFiles.deleted [] [toRawFilePath dir]-	let fs' = map fromRawFilePath fs+	debug ["directory deleted", fromOsPath dir]+	(fs, clean) <- liftAnnex $ inRepo $ LsFiles.deleted [] [dir] -	liftAnnex $ mapM_ onDel' fs'+	liftAnnex $ mapM_ onDel' fs  	-- Get the events queued up as fast as possible, so the 	-- committer sees them all in one block. 	now <- liftIO getCurrentTime-	recordChanges $ map (\f -> Change now f RmChange) fs'+	recordChanges $ map (\f -> Change now f RmChange) fs  	void $ liftIO clean 	noChange  {- Called when there's an error with inotify or kqueue. -}-onErr :: Handler+onErr :: String -> Maybe FileStatus -> Assistant () onErr msg _ = do 	liftAnnex $ warning (UnquotedString msg) 	void $ addAlert $ warningAlert "watcher" msg-	noChange
Assistant/Threads/WebApp.hs view
@@ -62,7 +62,7 @@ 	-> Maybe (IO Url) 	-> Maybe HostName 	-> Maybe PortNumber-	-> Maybe (Url -> FilePath -> IO ())+	-> Maybe (Url -> OsPath -> IO ()) 	-> NamedThread webAppThread assistantdata urlrenderer noannex cannotrun postfirstrun listenhost listenport onstartup = thread $ liftIO $ do 	listenhost' <- if isJust listenhost@@ -89,15 +89,13 @@ 		, return app 		) 	runWebApp tlssettings listenhost' listenport' app' $ \addr -> if noannex-		then withTmpFile "webapp.html" $ \tmpfile h -> do+		then withTmpFile (literalOsPath "webapp.html") $ \tmpfile h -> do 			hClose h 			go tlssettings addr webapp tmpfile Nothing 		else do 			htmlshim <- getAnnex' $ fromRepo gitAnnexHtmlShim 			urlfile <- getAnnex' $ fromRepo gitAnnexUrlFile-			go tlssettings addr webapp-				(fromRawFilePath htmlshim)-				(Just urlfile)+			go tlssettings addr webapp htmlshim (Just urlfile)   where 	-- The webapp thread does not wait for the startupSanityCheckThread 	-- to finish, so that the user interface remains responsive while@@ -105,8 +103,8 @@ 	thread = namedThreadUnchecked "WebApp" 	getreldir 		| noannex = return Nothing-		| otherwise = Just <$>-			(relHome . fromRawFilePath =<< absPath =<< getAnnex' (fromRepo repoPath))+		| otherwise = Just . fromOsPath <$>+			(relHome =<< absPath =<< getAnnex' (fromRepo repoPath)) 	go tlssettings addr webapp htmlshim urlfile = do 		let url = myUrl tlssettings webapp addr 		maybe noop (`writeFileProtected` url) urlfile@@ -131,6 +129,8 @@ 	cert <- fromRepo gitAnnexWebCertificate 	privkey <- fromRepo gitAnnexWebPrivKey 	ifM (liftIO $ allM doesFileExist [cert, privkey])-		( return $ Just $ TLS.tlsSettings cert privkey+		( return $ Just $ TLS.tlsSettings+			(fromOsPath cert)+			(fromOsPath privkey) 		, return Nothing 		)
Assistant/TransferSlots.hs view
@@ -174,7 +174,7 @@ 				AssociatedFile Nothing -> noop 				AssociatedFile (Just af) -> void $  					addAlert $ makeAlertFiller True $-						transferFileAlert direction True (fromRawFilePath af)+						transferFileAlert direction True (fromOsPath af) 			unless isdownload $ 				handleDrops 					("object uploaded to " ++ show remote)
Assistant/Types/Changes.hs view
@@ -9,10 +9,10 @@  module Assistant.Types.Changes where +import Common import Types.KeySource import Types.Key import Utility.TList-import Utility.FileSystemEncoding import Annex.Ingest  import Control.Concurrent.STM@@ -34,12 +34,12 @@ data Change 	= Change  		{ changeTime :: UTCTime-		, _changeFile :: FilePath+		, _changeFile :: OsPath 		, changeInfo :: ChangeInfo 		} 	| PendingAddChange 		{ changeTime ::UTCTime-		, _changeFile :: FilePath+		, _changeFile :: OsPath 		} 	| InProcessAddChange 		{ changeTime ::UTCTime@@ -55,10 +55,10 @@ changeInfoKey (LinkChange (Just k)) = Just k changeInfoKey _ = Nothing -changeFile :: Change -> FilePath+changeFile :: Change -> OsPath changeFile (Change _ f _) = f changeFile (PendingAddChange _ f) = f-changeFile (InProcessAddChange _ ld) = fromRawFilePath $ keyFilename $ keySource ld+changeFile (InProcessAddChange _ ld) = keyFilename $ keySource ld  isPendingAddChange :: Change -> Bool isPendingAddChange (PendingAddChange {}) = True
Assistant/Unused.hs view
@@ -34,7 +34,7 @@  - than the remaining free disk space, or more than 1/10th the total  - disk space being unused keys all suggest a problem. -} describeUnused' :: Bool -> Assistant (Maybe TenseText)-describeUnused' whenbig = liftAnnex $ go =<< readUnusedLog ""+describeUnused' whenbig = liftAnnex $ go =<< readUnusedLog (literalOsPath "")   where 	go m = do 		let num = M.size m@@ -64,13 +64,13 @@  	sumkeysize s k = s + fromMaybe 0 (fromKey keySize k) -	forpath a = inRepo $ liftIO . a . fromRawFilePath . Git.repoPath+	forpath a = inRepo $ liftIO . a . fromOsPath . Git.repoPath  {- With a duration, expires all unused files that are older.  - With Nothing, expires *all* unused files. -} expireUnused :: Maybe Duration -> Assistant () expireUnused duration = do-	m <- liftAnnex $ readUnusedLog ""+	m <- liftAnnex $ readUnusedLog (literalOsPath "") 	now <- liftIO getPOSIXTime 	let oldkeys = M.keys $ M.filter (tooold now) m 	forM_ oldkeys $ \k -> do
Assistant/Upgrade.hs view
@@ -5,6 +5,7 @@  - Licensed under the GNU AGPL version 3 or higher.  -} +{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE CPP #-}  module Assistant.Upgrade where@@ -41,6 +42,8 @@ import qualified Annex.Url as Url hiding (download) import Utility.Tuple import qualified Utility.RawFilePath as R+import qualified Utility.FileIO as F+import qualified Utility.OsString as OS  import Data.Either import qualified Data.Map as M@@ -87,12 +90,12 @@ 		hook <- asIO1 $ distributionDownloadComplete d dest cleanup 		modifyDaemonStatus_ $ \s -> s 			{ transferHook = M.insert k hook (transferHook s) }-		maybe noop (queueTransfer "upgrade" Next (AssociatedFile (Just (toRawFilePath f))) t)+		maybe noop (queueTransfer "upgrade" Next (AssociatedFile (Just f)) t) 			=<< liftAnnex (remoteFromUUID webUUID) 		startTransfer t 	k = mkKey $ const $ distributionKey d 	u = distributionUrl d-	f = takeFileName u ++ " (for upgrade)"+	f = takeFileName (toOsPath u) <> literalOsPath " (for upgrade)" 	t = Transfer 		{ transferDirection = Download 		, transferUUID = webUUID@@ -108,7 +111,7 @@  -  - Verifies the content of the downloaded key.  -}-distributionDownloadComplete :: GitAnnexDistribution -> FilePath -> Assistant () -> Transfer -> Assistant ()+distributionDownloadComplete :: GitAnnexDistribution -> OsPath -> Assistant () -> Transfer -> Assistant () distributionDownloadComplete d dest cleanup t  	| transferDirection t == Download = do 		debug ["finished downloading git-annex distribution"]@@ -118,11 +121,11 @@   where 	k = mkKey $ const $ distributionKey d 	fsckit f = Backend.maybeLookupBackendVariety (fromKey keyVariety k) >>= \case-		Nothing -> return $ Just (fromRawFilePath f)+		Nothing -> return $ Just f 		Just b -> case Types.Backend.verifyKeyContent b of-			Nothing -> return $ Just (fromRawFilePath f)+			Nothing -> return $ Just f 			Just verifier -> ifM (verifier k f)-				( return $ Just (fromRawFilePath f)+				( return $ Just f 				, return Nothing 				) 	go f = do@@ -140,7 +143,7 @@  - and unpack the new distribution next to it (in a versioned directory).  - Then update the programFile to point to the new version.  -}-upgradeToDistribution :: FilePath -> Assistant () -> FilePath -> Assistant ()+upgradeToDistribution :: OsPath -> Assistant () -> OsPath -> Assistant () upgradeToDistribution newdir cleanup distributionfile = do 	liftIO $ createDirectoryIfMissing True newdir 	(program, deleteold) <- unpack@@ -154,92 +157,92 @@ 	postUpgrade url   where 	changeprogram program = liftIO $ do-		unlessM (boolSystem program [Param "version"]) $+		unlessM (boolSystem (fromOsPath program) [Param "version"]) $ 			giveup "New git-annex program failed to run! Not using." 		pf <- programFile-		liftIO $ writeFile pf program+		liftIO $ writeFile (fromOsPath pf) (fromOsPath program) 	 #ifdef darwin_HOST_OS 	{- OS X uses a dmg, so mount it, and copy the contents into place. -} 	unpack = liftIO $ do 		olddir <- oldVersionLocation-		withTmpDirIn (fromRawFilePath (parentDir (toRawFilePath newdir))) "git-annex.upgrade" $ \tmpdir -> do+		withTmpDirIn (parentDir newdir) (literalOsPath "git-annex.upgrade") $ \tmpdir -> do 			void $ boolSystem "hdiutil"-				[ Param "attach", File distributionfile-				, Param "-mountpoint", File tmpdir+				[ Param "attach", File (fromOsPath distributionfile)+				, Param "-mountpoint", File (fromOsPath tmpdir) 				] 			void $ boolSystem "cp" 				[ Param "-R"-				, File $ tmpdir </> installBase </> "Contents"-				, File $ newdir+				, File $ fromOsPath $ tmpdir </> toOsPath installBase </> literalOsPath "Contents"+				, File (fromOsPath newdir) 				] 			void $ boolSystem "hdiutil" 				[ Param "eject"-				, File tmpdir+				, File (fromOsPath tmpdir) 				] 			sanitycheck newdir 		let deleteold = do-			deleteFromManifest $ olddir </> "Contents" </> "MacOS"+			deleteFromManifest $ olddir </> literalOsPath "Contents" </> literalOsPath "MacOS" 			makeorigsymlink olddir-		return (newdir </> "Contents" </> "MacOS" </> "git-annex", deleteold)+		return (newdir </> literalOsPath "Contents" </> literalOsPath "MacOS" </> literalOsPath "git-annex", deleteold) #else 	{- Linux uses a tarball (so could other POSIX systems), so 	 - untar it (into a temp directory) and move the directory 	 - into place. -} 	unpack = liftIO $ do 		olddir <- oldVersionLocation-		withTmpDirIn (fromRawFilePath $ parentDir $ toRawFilePath newdir) "git-annex.upgrade" $ \tmpdir -> do-			let tarball = tmpdir </> "tar"+		withTmpDirIn (parentDir newdir) (literalOsPath "git-annex.upgrade") $ \tmpdir -> do+			let tarball = tmpdir </> literalOsPath "tar" 			-- Cannot rely on filename extension, and this also 			-- avoids problems if tar doesn't support transparent 			-- decompression. 			void $ boolSystem "sh" 				[ Param "-c"-				, Param $ "zcat < " ++ shellEscape distributionfile ++-					" > " ++ shellEscape tarball+				, Param $ "zcat < " ++ shellEscape (fromOsPath distributionfile) +++					" > " ++ shellEscape (fromOsPath tarball) 				] 			tarok <- boolSystem "tar" 				[ Param "xf"-				, Param tarball-				, Param "--directory", File tmpdir+				, Param (fromOsPath tarball)+				, Param "--directory", File (fromOsPath tmpdir) 				] 			unless tarok $-				giveup $ "failed to untar " ++ distributionfile-			sanitycheck $ tmpdir </> installBase-			installby R.rename newdir (tmpdir </> installBase)+				giveup $ "failed to untar " ++ fromOsPath distributionfile+			sanitycheck $ tmpdir </> toOsPath installBase+			installby R.rename newdir (tmpdir </> toOsPath installBase) 		let deleteold = do 			deleteFromManifest olddir 			makeorigsymlink olddir-		return (newdir </> "git-annex", deleteold)+		return (newdir </> literalOsPath "git-annex", deleteold) 	installby a dstdir srcdir =-		mapM_ (\x -> a (toRawFilePath x) (toRawFilePath (dstdir </> takeFileName x)))+		mapM_ (\x -> a (fromOsPath x) (fromOsPath (dstdir </> takeFileName x))) 			=<< dirContents srcdir #endif 	sanitycheck dir =  		unlessM (doesDirectoryExist dir) $-			giveup $ "did not find " ++ dir ++ " in " ++ distributionfile+			giveup $ "did not find " ++ fromOsPath dir ++ " in " ++ fromOsPath distributionfile 	makeorigsymlink olddir = do-		let origdir = fromRawFilePath (parentDir (toRawFilePath olddir)) </> installBase-		removeWhenExistsWith R.removeLink (toRawFilePath origdir)-		R.createSymbolicLink (toRawFilePath newdir) (toRawFilePath origdir)+		let origdir = parentDir olddir </> toOsPath installBase+		removeWhenExistsWith removeFile origdir+		R.createSymbolicLink (fromOsPath newdir) (fromOsPath origdir)  {- Finds where the old version was installed. -}-oldVersionLocation :: IO FilePath+oldVersionLocation :: IO OsPath oldVersionLocation = readProgramFile >>= \case 	Nothing -> giveup "Cannot find old distribution bundle; not upgrading." 	Just pf -> do-		let pdir = fromRawFilePath $ parentDir $ toRawFilePath pf+		let pdir = parentDir pf #ifdef darwin_HOST_OS 		let dirs = splitDirectories pdir 		{- It will probably be deep inside a git-annex.app directory. -}-		let olddir = case findIndex ("git-annex.app" `isPrefixOf`) dirs of+		let olddir = case findIndex (literalOsPath "git-annex.app" `OS.isPrefixOf`) dirs of 			Nothing -> pdir 			Just i -> joinPath (take (i + 1) dirs) #else 		let olddir = pdir #endif-		when (null olddir) $-			giveup $ "Cannot find old distribution bundle; not upgrading. (Looked in " ++ pdir ++ ")"+		when (OS.null olddir) $+			giveup $ "Cannot find old distribution bundle; not upgrading. (Looked in " ++ fromOsPath pdir ++ ")" 		return olddir  {- Finds a place to install the new version.@@ -249,15 +252,15 @@  -  - The directory is created. If it already exists, returns Nothing.  -}-newVersionLocation :: GitAnnexDistribution -> FilePath -> IO (Maybe FilePath)+newVersionLocation :: GitAnnexDistribution -> OsPath -> IO (Maybe OsPath) newVersionLocation d olddir =  	trymkdir newloc $ do 		home <- myHomeDir-		trymkdir (home </> s) $+		trymkdir (toOsPath home </> s) $ 			return Nothing   where-	s = installBase ++ "." ++ distributionVersion d-	topdir = fromRawFilePath $ parentDir $ toRawFilePath olddir+	s = toOsPath $ installBase ++ "." ++ distributionVersion d+	topdir = parentDir olddir 	newloc = topdir </> s 	trymkdir dir fallback = 		(createDirectory dir >> return (Just dir))@@ -275,16 +278,17 @@ #endif #endif -deleteFromManifest :: FilePath -> IO ()+deleteFromManifest :: OsPath -> IO () deleteFromManifest dir = do-	fs <- map (dir </>) . lines <$> catchDefaultIO "" (readFile manifest)-	mapM_ (removeWhenExistsWith R.removeLink . toRawFilePath) fs-	removeWhenExistsWith R.removeLink (toRawFilePath manifest)+	fs <- map (\f -> dir </> toOsPath f) . lines +		<$> catchDefaultIO "" (readFile (fromOsPath manifest))+	mapM_ (removeWhenExistsWith removeFile) fs+	removeWhenExistsWith removeFile manifest 	removeEmptyRecursive dir   where-	manifest = dir </> "git-annex.MANIFEST"+	manifest = dir </> literalOsPath "git-annex.MANIFEST" -removeEmptyRecursive :: FilePath -> IO ()+removeEmptyRecursive :: OsPath -> IO () removeEmptyRecursive dir = do 	mapM_ removeEmptyRecursive =<< dirContents dir 	void $ tryIO $ removeDirectory dir@@ -292,7 +296,7 @@ {- This is a file that the UpgradeWatcher can watch for modifications to  - detect when git-annex has been upgraded.  -}-upgradeFlagFile :: IO FilePath+upgradeFlagFile :: IO OsPath upgradeFlagFile = programPath  {- Sanity check to see if an upgrade is complete and the program is ready@@ -307,13 +311,13 @@ 		program <- programPath 		untilM (doesFileExist program <&&> nowriter program) $ 			threadDelaySeconds (Seconds 60)-		boolSystem program [Param "version"]+		boolSystem (fromOsPath program) [Param "version"] 	)   where 	nowriter f = null 		. filter (`elem` [Lsof.OpenReadWrite, Lsof.OpenWriteOnly]) 		. map snd3-		<$> Lsof.query [f]+		<$> Lsof.query [fromOsPath f]  usingDistribution :: IO Bool usingDistribution = isJust <$> getEnv "GIT_ANNEX_STANDLONE_ENV"@@ -322,13 +326,14 @@ downloadDistributionInfo = do 	uo <- liftAnnex Url.getUrlOptions 	gpgcmd <- liftAnnex $ gpgCmd <$> Annex.getGitConfig-	liftIO $ withTmpDir "git-annex.tmp" $ \tmpdir -> do-		let infof = tmpdir </> "info"-		let sigf = infof ++ ".sig"+	liftIO $ withTmpDir (literalOsPath "git-annex.tmp") $ \tmpdir -> do+		let infof = tmpdir </> literalOsPath "info"+		let sigf = infof <> literalOsPath ".sig" 		ifM (isRight <$> Url.download nullMeterUpdate Nothing distributionInfoUrl infof uo 			<&&> (isRight <$> Url.download nullMeterUpdate Nothing distributionInfoSigUrl sigf uo) 			<&&> verifyDistributionSig gpgcmd sigf)-			( parseInfoFile <$> readFileStrict infof+			( parseInfoFile . map decodeBS . fileLines' +				<$> F.readFile' infof 			, return Nothing 			) @@ -357,20 +362,20 @@  - The gpg keyring used to verify the signature is located in  - trustedkeys.gpg, next to the git-annex program.  -}-verifyDistributionSig :: GpgCmd -> FilePath -> IO Bool+verifyDistributionSig :: GpgCmd -> OsPath -> IO Bool verifyDistributionSig gpgcmd sig = readProgramFile >>= \case 	Just p | isAbsolute p ->-		withUmask 0o0077 $ withTmpDir "git-annex-gpg.tmp" $ \gpgtmp -> do-			let trustedkeys = takeDirectory p </> "trustedkeys.gpg"+		withUmask 0o0077 $ withTmpDir (literalOsPath "git-annex-gpg.tmp") $ \gpgtmp -> do+			let trustedkeys = takeDirectory p </> literalOsPath "trustedkeys.gpg" 			boolGpgCmd gpgcmd 				[ Param "--no-default-keyring" 				, Param "--no-auto-check-trustdb" 				, Param "--no-options" 				, Param "--homedir"-				, File gpgtmp+				, File (fromOsPath gpgtmp) 				, Param "--keyring"-				, File trustedkeys+				, File (fromOsPath trustedkeys) 				, Param "--verify"-				, File sig+				, File (fromOsPath sig) 				] 	_ -> return False
Assistant/WebApp/Configurators/Delete.hs view
@@ -78,7 +78,7 @@ 			sanityVerifierAForm $ SanityVerifier magicphrase 	case result of 		FormSuccess _ -> liftH $ do-			dir <- liftAnnex $ fromRawFilePath <$> fromRepo Git.repoPath+			dir <- liftAnnex $ fromRepo Git.repoPath 			liftIO $ removeAutoStartFile dir  			{- Disable syncing to this repository, and all@@ -90,8 +90,7 @@ 				mapM_ (\r -> changeSyncable (Just r) False) rs  			liftAnnex $ prepareRemoveAnnexDir dir-			liftIO $ removeDirectoryRecursive . fromRawFilePath-				=<< absPath (toRawFilePath dir)+			liftIO $ removeDirectoryRecursive =<< absPath dir 			 			redirect ShutdownConfirmedR 		_ -> $(widgetFile "configurators/delete/currentrepository")
Assistant/WebApp/Configurators/Edit.hs view
@@ -121,7 +121,7 @@ 		Just t 			| T.null t -> noop 			| otherwise -> liftAnnex $ do-				let dir = takeBaseName $ T.unpack t+				let dir = fromOsPath $ takeBaseName $ toOsPath $ T.unpack t 				m <- remoteConfigMap 				case M.lookup uuid m of 					Nothing -> noop@@ -246,8 +246,8 @@ 	case repoGroup cfg of 		RepoGroupStandard gr -> case associatedDirectory repoconfig gr of 			Just d -> do-				top <- fromRawFilePath <$> fromRepo Git.repoPath-				createWorkTreeDirectory (toRawFilePath (top </> d))+				top <- fromRepo Git.repoPath+				createWorkTreeDirectory (top </> toOsPath d) 			Nothing -> noop 		_ -> noop
Assistant/WebApp/Configurators/Local.hs view
@@ -81,24 +81,24 @@ checkRepositoryPath p = do 	home <- myHomeDir 	let basepath = expandTilde home $ T.unpack p-	path <- fromRawFilePath <$> absPath (toRawFilePath basepath)-	let parent = fromRawFilePath $ parentDir (toRawFilePath path)+	path <- absPath basepath+	let parent = parentDir path 	problems <- catMaybes <$> mapM runcheck-		[ (return $ path == "/", "Enter the full path to use for the repository.")-		, (return $ all isSpace basepath, "A blank path? Seems unlikely.")+		[ (return $ path == literalOsPath "/", "Enter the full path to use for the repository.")+		, (return $ all isSpace (fromOsPath basepath :: FilePath), "A blank path? Seems unlikely.") 		, (doesFileExist path, "A file already exists with that name.")-		, (return $ path == home, "Sorry, using git-annex for your whole home directory is not currently supported.")+		, (return $ fromOsPath path == home, "Sorry, using git-annex for your whole home directory is not currently supported.") 		, (not <$> doesDirectoryExist parent, "Parent directory does not exist.") 		, (not <$> canWrite path, "Cannot write a repository there.") 		] 	return $  		case headMaybe problems of-			Nothing -> Right $ Just $ T.pack basepath+			Nothing -> Right $ Just $ T.pack $ fromOsPath basepath 			Just prob -> Left prob   where 	runcheck (chk, msg) = ifM chk ( return $ Just msg, return Nothing )-	expandTilde home ('~':'/':path) = home </> path-	expandTilde _ path = path+	expandTilde home ('~':'/':path) = toOsPath home </> toOsPath path+	expandTilde _ path = toOsPath path  {- On first run, if run in the home directory, default to putting it in  - ~/Desktop/annex, when a Desktop directory exists, and ~/annex otherwise.@@ -110,12 +110,12 @@  - the user probably wants to put it there. Unless that directory  - contains a git-annex file, in which case the user has probably  - browsed to a directory with git-annex and run it from there. -}-defaultRepositoryPath :: Bool -> IO FilePath+defaultRepositoryPath :: Bool -> IO OsPath defaultRepositoryPath firstrun = do #ifndef mingw32_HOST_OS 	home <- myHomeDir 	currdir <- liftIO getCurrentDirectory-	if home == currdir && firstrun+	if toOsPath home == currdir && firstrun 		then inhome 		else ifM (legit currdir <&&> canWrite currdir) 			( return currdir@@ -130,29 +130,29 @@   where 	inhome = ifM osAndroid 		( do-			home <- myHomeDir-			let storageshared = home </> "storage" </> "shared"+			home <- toOsPath <$> myHomeDir+			let storageshared = home </> literalOsPath "storage" </> literalOsPath "shared" 			ifM (doesDirectoryExist storageshared) 				( relHome $ storageshared </> gitAnnexAssistantDefaultDir-				, return $ "~" </> gitAnnexAssistantDefaultDir+				, return $ literalOsPath "~" </> gitAnnexAssistantDefaultDir 				) 		, do-			desktop <- userDesktopDir+			desktop <- toOsPath <$> userDesktopDir 			ifM (doesDirectoryExist desktop <&&> canWrite desktop) 				( relHome $ desktop </> gitAnnexAssistantDefaultDir-				, return $ "~" </> gitAnnexAssistantDefaultDir+				, return $ literalOsPath "~" </> gitAnnexAssistantDefaultDir 				) 		) #ifndef mingw32_HOST_OS 	-- Avoid using eg, standalone build's git-annex.linux/ directory 	-- when run from there.-	legit d = not <$> doesFileExist (d </> "git-annex")+	legit d = not <$> doesFileExist (d </> literalOsPath "git-annex") #endif -newRepositoryForm :: FilePath -> Hamlet.Html -> MkMForm RepositoryPath+newRepositoryForm :: OsPath -> Hamlet.Html -> MkMForm RepositoryPath newRepositoryForm defpath msg = do 	(pathRes, pathView) <- mreq (repositoryPathField True) (bfs "")-		(Just $ T.pack $ addTrailingPathSeparator defpath)+		(Just $ T.pack $ fromOsPath $ addTrailingPathSeparator defpath) 	let (err, errmsg) = case pathRes of 		FormMissing -> (False, "") 		FormFailure l -> (True, concatMap T.unpack l)@@ -174,17 +174,17 @@ 	((res, form), enctype) <- liftH $ runFormPostNoToken $ newRepositoryForm path 	case res of 		FormSuccess (RepositoryPath p) -> liftH $-			startFullAssistant (T.unpack p) ClientGroup Nothing+			startFullAssistant (toOsPath $ T.unpack p) ClientGroup Nothing 		_ -> $(widgetFile "configurators/newrepository/first")  getAndroidCameraRepositoryR :: Handler () getAndroidCameraRepositoryR = do 	home <- liftIO myHomeDir-	let dcim = home </> "storage" </> "dcim"+	let dcim = toOsPath home </> literalOsPath "storage" </> literalOsPath "dcim" 	startFullAssistant dcim SourceGroup $ Just addignore	   where 	addignore = do-		liftIO $ unlessM (doesFileExist ".gitignore") $+		liftIO $ unlessM (doesFileExist $ literalOsPath ".gitignore") $ 			writeFile ".gitignore" ".thumbnails" 		void $ inRepo $ 			Git.Command.runBool [Param "add", File ".gitignore"]@@ -195,20 +195,21 @@ getNewRepositoryR = postNewRepositoryR postNewRepositoryR :: Handler Html postNewRepositoryR = page "Add another repository" (Just Configuration) $ do-	home <- liftIO myHomeDir+	home <- toOsPath <$> liftIO myHomeDir 	((res, form), enctype) <- liftH $ runFormPostNoToken $ newRepositoryForm home 	case res of 		FormSuccess (RepositoryPath p) -> do-			let path = T.unpack p+			let path = toOsPath (T.unpack p) 			isnew <- liftIO $ makeRepo path False 			u <- liftIO $ initRepo isnew True path Nothing (Just ClientGroup) 			liftIO $ addAutoStartFile path 			liftIO $ startAssistant path-			askcombine u path+			askcombine u (fromOsPath path) 		_ -> $(widgetFile "configurators/newrepository")   where 	askcombine newrepouuid newrepopath = do-		newrepo <- liftIO $ relHome newrepopath+		newrepo' <- liftIO $ relHome (toOsPath newrepopath)+		let newrepo = fromOsPath newrepo' :: FilePath 		mainrepo <- fromJust . relDir <$> liftH getYesod 		$(widgetFile "configurators/newrepository/combine") @@ -222,17 +223,18 @@  getCombineRepositoryR :: FilePath -> UUID -> Handler Html getCombineRepositoryR newrepopath newrepouuid = do-	liftAssistant . immediateSyncRemote =<< combineRepos newrepopath remotename+	liftAssistant . immediateSyncRemote+		=<< combineRepos (toOsPath newrepopath) remotename 	redirect $ EditRepositoryR $ RepoUUID newrepouuid   where-	remotename = takeFileName newrepopath+	remotename = fromOsPath $ takeFileName $ toOsPath newrepopath  selectDriveForm :: [RemovableDrive] -> Hamlet.Html -> MkMForm RemovableDrive selectDriveForm drives = renderBootstrap3 bootstrapFormLayout $ RemovableDrive 	<$> pure Nothing 	<*> areq (selectFieldList pairs `withNote` onlywritable) (bfs "Select drive:") Nothing 	<*> areq textField (bfs "Use this directory on the drive:")-		(Just $ T.pack gitAnnexAssistantDefaultDir)+		(Just $ T.pack $ fromOsPath gitAnnexAssistantDefaultDir)   where 	pairs = zip (map describe drives) (map mountPoint drives) 	describe drive = case diskFree drive of@@ -246,9 +248,9 @@ 				] 	onlywritable = [whamlet|This list only includes drives you can write to.|] -removableDriveRepository :: RemovableDrive -> FilePath+removableDriveRepository :: RemovableDrive -> OsPath removableDriveRepository drive =-	T.unpack (mountPoint drive) </> T.unpack (driveRepoPath drive)+	toOsPath (T.unpack (mountPoint drive)) </> toOsPath (T.unpack (driveRepoPath drive))  {- Adding a removable drive. -} getAddDriveR :: Handler Html@@ -257,7 +259,7 @@ postAddDriveR = page "Add a removable drive" (Just Configuration) $ do 	removabledrives <- liftIO driveList 	writabledrives <- liftIO $-		filterM (canWrite . T.unpack . mountPoint) removabledrives+		filterM (canWrite . toOsPath . T.unpack . mountPoint) removabledrives 	((res, form), enctype) <- liftH $ runFormPostNoToken $ 		selectDriveForm (sort writabledrives) 	case res of@@ -277,7 +279,7 @@ 		mu <- liftIO $ probeUUID dir 		case mu of 			Nothing -> maybe askcombine isknownuuid-				=<< liftAnnex (probeGCryptRemoteUUID dir)+				=<< liftAnnex (probeGCryptRemoteUUID $ fromOsPath dir) 			Just driveuuid -> isknownuuid driveuuid 	, newrepo 	)@@ -317,19 +319,19 @@   where 	go (RepoKey keyid) = whenGcryptInstalled $ makewith $ const $ do 		r <- liftAnnex $ addRemote $-			makeGCryptRemote remotename dir keyid+			makeGCryptRemote remotename (fromOsPath dir) keyid 		return (Types.Remote.uuid r, r)-	go NoRepoKey = checkGCryptRepoEncryption dir makeunencrypted makeunencrypted $ do-		mu <- liftAnnex $ probeGCryptRemoteUUID dir+	go NoRepoKey = checkGCryptRepoEncryption (fromOsPath dir) makeunencrypted makeunencrypted $ do+		mu <- liftAnnex $ probeGCryptRemoteUUID (fromOsPath dir) 		case mu of 			Just u -> enableexistinggcryptremote u 			Nothing -> giveup "The drive contains a gcrypt repository that is not a git-annex special remote. This is not supported." 	enableexistinggcryptremote u = do-		remotename' <- liftAnnex $ getGCryptRemoteName u dir+		remotename' <- liftAnnex $ getGCryptRemoteName u (fromOsPath dir) 		makewith $ const $ do 			r <- liftAnnex $ addRemote $ 				enableSpecialRemote remotename' GCrypt.remote Nothing $ M.fromList-					[(Proposed "gitrepo", Proposed dir)]+					[(Proposed "gitrepo", Proposed (fromOsPath dir))] 			return (u, r) 	{- Making a new unencrypted repo, or combining with an existing one. -} 	makeunencrypted = makewith $ \isnew -> (,)@@ -347,21 +349,19 @@ 			liftAnnex $ defaultStandardGroup u TransferGroup 		liftAssistant $ immediateSyncRemote r 		redirect $ EditNewRepositoryR u-	mountpoint = T.unpack (mountPoint drive)+	mountpoint = toOsPath $ T.unpack (mountPoint drive) 	dir = removableDriveRepository drive-	remotename = takeFileName mountpoint+	remotename = fromOsPath $ takeFileName mountpoint  {- Each repository is made a remote of the other.  - Next call syncRemote to get them in sync. -}-combineRepos :: FilePath -> String -> Handler Remote+combineRepos :: OsPath -> String -> Handler Remote combineRepos dir name = liftAnnex $ do 	hostname <- fromMaybe "host" <$> liftIO getHostname-	mylocation <- fromRepo Git.repoLocation-	mypath <- liftIO $ fromRawFilePath <$> relPathDirToFile-		(toRawFilePath dir)-		(toRawFilePath mylocation)-	liftIO $ inDir dir $ void $ makeGitRemote hostname mypath-	addRemote $ makeGitRemote name dir+	mylocation <- fromRepo Git.repoPath+	mypath <- liftIO $ relPathDirToFile dir mylocation+	liftIO $ inDir dir $ void $ makeGitRemote hostname (fromOsPath mypath)+	addRemote $ makeGitRemote name (fromOsPath dir)  getEnableDirectoryR :: UUID -> Handler Html getEnableDirectoryR uuid = page "Enable a repository" (Just Configuration) $ do@@ -396,12 +396,12 @@ genRemovableDrive dir = RemovableDrive 	<$> getDiskFree dir 	<*> pure (T.pack dir)-	<*> pure (T.pack gitAnnexAssistantDefaultDir)+	<*> pure (T.pack $ fromOsPath gitAnnexAssistantDefaultDir)  {- Bootstraps from first run mode to a fully running assistant in a  - repository, by running the postFirstRun callback, which returns the  - url to the new webapp. -}-startFullAssistant :: FilePath -> StandardGroup -> Maybe (Annex ())-> Handler ()+startFullAssistant :: OsPath -> StandardGroup -> Maybe (Annex ())-> Handler () startFullAssistant path repogroup setup = do 	webapp <- getYesod 	url <- liftIO $ do@@ -417,17 +417,17 @@  -  - The directory may be in the process of being created; if so  - the parent directory is checked instead. -}-canWrite :: FilePath -> IO Bool		+canWrite :: OsPath -> IO Bool		 canWrite dir = do 	tocheck <- ifM (doesDirectoryExist dir) 		( return dir-		, return $ fromRawFilePath $ parentDir $ toRawFilePath dir+		, return $ parentDir dir 		)-	catchBoolIO $ R.fileAccess (toRawFilePath tocheck) False True False+	catchBoolIO $ R.fileAccess (fromOsPath tocheck) False True False  {- Gets the UUID of the git repo at a location, which may not exist, or  - not be a git-annex repo. -}-probeUUID :: FilePath -> IO (Maybe UUID)+probeUUID :: OsPath -> IO (Maybe UUID) probeUUID dir = catchDefaultIO Nothing $ inDir dir $ do 	u <- getUUID 	return $ if u == NoUUID then Nothing else Just u
Assistant/WebApp/Configurators/Pairing.hs view
@@ -72,7 +72,7 @@  enableTor :: Handler () enableTor = do-	gitannex <- liftIO programPath+	gitannex <- fromOsPath <$> liftIO programPath 	(transcript, ok) <- liftIO $ processTranscript gitannex ["enable-tor"] Nothing 	if ok 		-- Reload remotedameon so it's serving the tor hidden@@ -173,7 +173,7 @@ postFinishLocalPairR :: PairMsg -> Handler Html #ifdef WITH_PAIRING postFinishLocalPairR msg = promptSecret (Just msg) $ \_ secret -> do-	repodir <- liftH $ fromRawFilePath . repoPath <$> liftAnnex gitRepo+	repodir <- liftH $ repoPath <$> liftAnnex gitRepo 	liftIO $ setup repodir 	startLocalPairing PairAck (cleanup repodir) alert uuid "" secret   where
Assistant/WebApp/Configurators/Preferences.hs view
@@ -23,7 +23,6 @@ import Assistant.Upgrade  import qualified Data.Text as T-import qualified System.FilePath.ByteString as P  data PrefsForm = PrefsForm 	{ diskReserve :: Text@@ -89,7 +88,7 @@ 	unsetConfig (annexConfig "numcopies") -- deprecated 	setConfig (annexConfig "autoupgrade") (fromAutoUpgrade $ autoUpgrade p) 	unlessM ((==) <$> pure (autoStart p) <*> inAutoStartFile) $ do-		here <- fromRawFilePath <$> fromRepo Git.repoPath+		here <- fromRepo Git.repoPath 		liftIO $ if autoStart p 			then addAutoStartFile here 			else removeAutoStartFile here@@ -110,5 +109,4 @@ inAutoStartFile :: Annex Bool inAutoStartFile = do 	here <- liftIO . absPath =<< fromRepo Git.repoPath-	any (`P.equalFilePath` here) . map toRawFilePath-		<$> liftIO readAutoStartFile+	any (`equalFilePath` here) <$> liftIO readAutoStartFile
Assistant/WebApp/Configurators/Ssh.hs view
@@ -76,7 +76,7 @@ 	, sshDirectory = fromMaybe "" $ inputDirectory s 	, sshRepoName = genSshRepoName 		(T.unpack $ fromJust $ inputHostname s)-		(maybe "" T.unpack $ inputDirectory s)+		(toOsPath (maybe "" T.unpack $ inputDirectory s)) 	, sshPort = inputPort s 	, needsPubKey = False 	, sshCapabilities = [] -- untested@@ -101,7 +101,7 @@ 		<*> aopt check_username (bfs "User name") (Just $ inputUsername d) 		<*> areq (selectFieldList authmethods) (bfs "Authenticate with") (Just $ inputAuthMethod d) 		<*> aopt passwordField (bfs "Password") Nothing-		<*> aopt textField (bfs "Directory") (Just $ Just $ fromMaybe (T.pack gitAnnexAssistantDefaultDir) $ inputDirectory d)+		<*> aopt textField (bfs "Directory") (Just $ Just $ fromMaybe (T.pack $ fromOsPath gitAnnexAssistantDefaultDir) $ inputDirectory d) 		<*> areq intField (bfs "Port") (Just $ inputPort d) 	 	authmethods :: [(Text, AuthMethod)]@@ -389,13 +389,13 @@ 		v <- getCachedCred login 		liftIO $ case v of 			Nothing -> go [passwordprompts 0] Nothing-			Just pass -> withTmpFile "ssh" $ \passfile h -> do+			Just pass -> withTmpFile (literalOsPath "ssh") $ \passfile h -> do 				hClose h-				writeFileProtected (toRawFilePath passfile) pass+				writeFileProtected passfile pass 				environ <- getEnvironment 				let environ' = addEntries-					[ ("SSH_ASKPASS", program)-					, (sshAskPassEnv, passfile)+					[ ("SSH_ASKPASS", fromOsPath program)+					, (sshAskPassEnv, fromOsPath passfile) 					, ("DISPLAY", ":0") 					] environ 				go [passwordprompts 1] (Just environ')@@ -531,7 +531,7 @@ 			] 		, if needsinit then Just (wrapCommand "git annex init") else Nothing 		, if needsPubKey origsshdata-			then addAuthorizedKeysCommand (hasCapability origsshdata GitAnnexShellCapable) remotedir . sshPubKey <$> keypair+			then addAuthorizedKeysCommand (hasCapability origsshdata GitAnnexShellCapable) (toOsPath remotedir) . sshPubKey <$> keypair 			else Nothing 		] 	rsynconly = onlyCapability origsshdata RsyncCapable@@ -602,7 +602,7 @@ |] 	go sshinput = do 		let reponame = genSshRepoName "rsync.net" -			(maybe "" T.unpack $ inputDirectory sshinput)+			(toOsPath (maybe "" T.unpack $ inputDirectory sshinput)) 		 		prepRsyncNet sshinput reponame $ \sshdata -> inpage $  			checkExistingGCrypt sshdata $ do
Assistant/WebApp/Configurators/Unused.hs view
@@ -51,7 +51,7 @@ 			redirect ConfigurationR 		_ -> do 			munuseddesc <- liftAssistant describeUnused-			ts <- liftAnnex $ dateUnusedLog ""+			ts <- liftAnnex $ dateUnusedLog (literalOsPath "") 			mlastchecked <- case ts of 				Nothing -> pure Nothing 				Just t -> Just <$> liftIO (durationSince t)
Assistant/WebApp/Control.hs view
@@ -73,6 +73,6 @@ getLogR :: Handler Html getLogR = page "Logs" Nothing $ do 	logfile <- liftAnnex $ fromRepo gitAnnexDaemonLogFile-	logs <- liftIO $ listLogs (fromRawFilePath logfile)+	logs <- liftIO $ listLogs (fromOsPath logfile) 	logcontent <- liftIO $ concat <$> mapM readFile logs 	$(widgetFile "control/log")
Assistant/WebApp/DashBoard.hs view
@@ -45,7 +45,7 @@ 		transferPaused info || isNothing (startedTime info) 	desc transfer info = case associatedFile info of 		AssociatedFile Nothing -> serializeKey $ transferKey transfer-		AssociatedFile (Just af) -> fromRawFilePath af+		AssociatedFile (Just af) -> fromOsPath af  {- Simplifies a list of transfers, avoiding display of redundant  - equivalent transfers. -}@@ -118,7 +118,7 @@  - blocking the response to the browser on it. -} openFileBrowser :: Handler Bool openFileBrowser = do-	path <- fromRawFilePath +	path <- fromOsPath  		<$> (liftIO . absPath =<< liftAnnex (fromRepo Git.repoPath)) #ifdef darwin_HOST_OS 	let cmd = "open"
Assistant/WebApp/Documentation.hs view
@@ -16,10 +16,10 @@  {- The full license info may be included in a file on disk that can  - be read in and displayed. -}-licenseFile :: IO (Maybe FilePath)+licenseFile :: IO (Maybe OsPath) licenseFile = do 	base <- standaloneAppBase-	return $ (</> "LICENSE") <$> base+	return $ (</> literalOsPath "LICENSE") <$> base  getAboutR :: Handler Html getAboutR = page "About git-annex" (Just About) $ do@@ -34,7 +34,7 @@ 		Just f -> customPage (Just About) $ do 			-- no sidebar, just pages of legalese.. 			setTitle "License"-			license <- liftIO $ readFile f+			license <- liftIO $ readFile (fromOsPath f) 			$(widgetFile "documentation/license")  getRepoGroupR :: Handler Html
Assistant/WebApp/OtherRepos.hs view
@@ -15,7 +15,6 @@ import Config.Files.AutoStart import Utility.Yesod import Assistant.Restart-import qualified Utility.RawFilePath as R  getRepositorySwitcherR :: Handler Html getRepositorySwitcherR = page "Switch repository" Nothing $ do@@ -25,15 +24,16 @@ listOtherRepos :: IO [(String, String)] listOtherRepos = do 	dirs <- readAutoStartFile-	pwd <- R.getCurrentDirectory+	pwd <- getCurrentDirectory 	gooddirs <- filterM isrepo $-		filter (\d -> not $ toRawFilePath d `dirContains` pwd) dirs+		filter (\d -> not $ d `dirContains` pwd) dirs 	names <- mapM relHome gooddirs-	return $ sort $ zip names gooddirs+	return $ sort $ zip (map fromOsPath names) (map fromOsPath gooddirs)   where-	isrepo d = doesDirectoryExist (d </> ".git")+	isrepo d = doesDirectoryExist (d </> literalOsPath ".git")  getSwitchToRepositoryR :: FilePath -> Handler Html getSwitchToRepositoryR repo = do-	liftIO $ addAutoStartFile repo -- make this the new default repo-	redirect =<< liftIO (newAssistantUrl repo)+	let repo' = toOsPath repo+	liftIO $ addAutoStartFile repo' -- make this the new default repo+	redirect =<< liftIO (newAssistantUrl repo')
Backend.hs view
@@ -10,13 +10,14 @@ module Backend ( 	builtinList, 	defaultBackend,-	defaultHashBackend,+	hashBackend, 	genKey, 	getBackend, 	chooseBackend, 	lookupBackendVariety, 	lookupBuiltinBackendVariety, 	maybeLookupBackendVariety,+	unknownBackendVarietyMessage, 	isStableKey, 	isCryptographicallySecureKey, 	isCryptographicallySecure,@@ -54,6 +55,15 @@ 	valid name = not (null name) 	lookupname = lookupBackendVariety . parseKeyVariety . encodeBS +{- A hashing backend. Takes git config into account, but+ - guarantees the backend is cryptographically secure. -}+hashBackend :: Annex Backend+hashBackend = do+	db <- defaultBackend+	return $ if isCryptographicallySecure db+		then db+		else defaultHashBackend+ {- Generates a key for a file. -} genKey :: KeySource -> MeterUpdate -> Backend -> Annex (Key, Backend) genKey source meterupdate b = case B.genKey b of@@ -63,11 +73,11 @@ 	Nothing -> giveup $ "Cannot generate a key for backend " ++ 		decodeBS (formatKeyVariety (B.backendVariety b)) -getBackend :: FilePath -> Key -> Annex (Maybe Backend)+getBackend :: OsPath -> Key -> Annex (Maybe Backend) getBackend file k = maybeLookupBackendVariety (fromKey keyVariety k) >>= \case 	Just backend -> return $ Just backend 	Nothing -> do-		warning $ "skipping " <> QuotedPath (toRawFilePath file) <> " (" <>+		warning $ "skipping " <> QuotedPath file <> " (" <> 			UnquotedString (unknownBackendVarietyMessage (fromKey keyVariety k)) <> ")" 		return Nothing @@ -78,7 +88,7 @@ {- Looks up the backend that should be used for a file.  - That can be configured on a per-file basis in the gitattributes file,  - or forced with --backend. -}-chooseBackend :: RawFilePath -> Annex Backend+chooseBackend :: OsPath -> Annex Backend chooseBackend f = Annex.getRead Annex.forcebackend >>= go   where 	go Nothing = do
Backend/External.hs view
@@ -96,7 +96,7 @@ 	withExternalState ebname hasext $ \st -> 		handleRequest st req notavail go   where-	req = GENKEY (fromRawFilePath (contentLocation ks))+	req = GENKEY (fromOsPath (contentLocation ks)) 	notavail = giveup $ "Cannot generate a key, since " ++ externalBackendProgram ebname ++ " is not available." 	 	go (GENKEY_SUCCESS pk) = Just $ Result <$> fromProtoKey pk hasext ks@@ -107,12 +107,12 @@ 		return $ GetNextMessage go 	go _ = Nothing -verifyKeyContentExternal :: ExternalBackendName -> HasExt -> MeterUpdate -> Key -> RawFilePath -> Annex Bool+verifyKeyContentExternal :: ExternalBackendName -> HasExt -> MeterUpdate -> Key -> OsPath -> Annex Bool verifyKeyContentExternal ebname hasext meterupdate k f =  	withExternalState ebname hasext $ \st -> 		handleRequest st req notavail go   where-	req = VERIFYKEYCONTENT (toProtoKey k) (fromRawFilePath f)+	req = VERIFYKEYCONTENT (toProtoKey k) (fromOsPath f)  	-- This should not be able to happen, because CANVERIFY is checked 	-- before this function is enable, and so the external program
Backend/GitRemoteAnnex.hs view
@@ -75,7 +75,7 @@ 	expected = reverse $ takeWhile (/= '-') $ reverse $ 		decodeBS $ S.fromShort $ fromKey keyName key -genGitBundleKey :: UUID -> RawFilePath -> MeterUpdate -> Annex Key+genGitBundleKey :: UUID -> OsPath -> MeterUpdate -> Annex Key genGitBundleKey remoteuuid file meterupdate = do 	filesize <- liftIO $ getFileSize file 	s <- Hash.hashFile hash file meterupdate
Backend/Hash.hs view
@@ -127,7 +127,7 @@ 	keyValue hash source meterupdate 		>>= addE source (const $ hashKeyVariety hash (HasExt True)) -checkKeyChecksum :: (Key -> String -> Bool) -> Hash -> Key -> RawFilePath -> Annex Bool+checkKeyChecksum :: (Key -> String -> Bool) -> Hash -> Key -> OsPath -> Annex Bool checkKeyChecksum issame hash key file = catchIOErrorType HardwareFault hwfault $ do 	showAction (UnquotedString descChecksum) 	issame key @@ -205,9 +205,9 @@ 	oldvariety = fromKey keyVariety oldkey 	newvariety = backendVariety newbackend -hashFile :: Hash -> RawFilePath -> MeterUpdate -> Annex String+hashFile :: Hash -> OsPath -> MeterUpdate -> Annex String hashFile hash file meterupdate = -	liftIO $ withMeteredFile (fromRawFilePath file) meterupdate $ \b -> do+	liftIO $ withMeteredFile file meterupdate $ \b -> do 		let h = (fst $ hasher hash) b 		-- Force full evaluation of hash so whole file is read 		-- before returning.
Backend/Utilities.hs view
@@ -14,11 +14,11 @@ import Utility.Hash import Types.Key import Types.KeySource+import qualified Utility.OsString as OS  import qualified Data.ByteString as S import qualified Data.ByteString.Short as S (ShortByteString, toShort) import qualified Data.ByteString.Lazy as L-import qualified System.FilePath.ByteString as P import Data.Char import Data.Word @@ -29,12 +29,12 @@ genKeyName :: String -> S.ShortByteString genKeyName s 	-- Avoid making keys longer than the length of a SHA256 checksum.-	| bytelen > sha256len = S.toShort $ encodeBS $-		truncateFilePath (sha256len - md5len - 1) s' ++ "-" ++ -			show (md5 bl)-	| otherwise = S.toShort $ encodeBS s'+	| bytelen > sha256len = S.toShort $+		truncateFilePath (sha256len - md5len - 1) s' +			<> "-" <> encodeBS (show (md5 bl))+	| otherwise = S.toShort s'   where-	s' = preSanitizeKeyName s+	s' = encodeBS $ preSanitizeKeyName s 	bl = encodeBL s 	bytelen = fromIntegral $ L.length bl @@ -55,7 +55,7 @@ 		, keyVariety = sethasext (keyVariety d) 		} -selectExtension :: Maybe Int -> Maybe Int -> RawFilePath -> S.ByteString+selectExtension :: Maybe Int -> Maybe Int -> OsPath -> S.ByteString selectExtension maxlen maxextensions f 	| null es = "" 	| otherwise = S.intercalate "." ("":es)@@ -64,11 +64,12 @@ 		take (fromMaybe maxExtensions maxextensions) $ 		filter (S.all validInExtension) $ 		takeWhile shortenough $-		reverse $ S.split (fromIntegral (ord '.')) (P.takeExtensions f')+		reverse $ S.split (fromIntegral (ord '.')) $+			fromOsPath $ takeExtensions f' 	shortenough e = S.length e <= fromMaybe maxExtensionLen maxlen 	-- Avoid treating a file ".foo" as having its whole name as an 	-- extension.-	f' = S.dropWhile (== fromIntegral (ord '.')) (P.takeFileName f)+	f' = OS.dropWhile (== unsafeFromChar '.') (takeFileName f)  validInExtension :: Word8 -> Bool validInExtension c
Backend/VURL/Utilities.hs view
@@ -10,10 +10,8 @@ import Annex.Common import Types.Key import Types.Backend-import Types.KeySource import Logs.EquivilantKeys import qualified Backend.Hash-import Utility.Metered  migrateFromURLToVURL :: Key -> Backend -> AssociatedFile -> Bool -> Annex (Maybe Key) migrateFromURLToVURL oldkey newbackend _af inannex@@ -41,18 +39,3 @@ 			(keyData oldkey) 				{ keyVariety = URLKey } 	| otherwise = return Nothing---- The Backend must use a cryptographically secure hash.-generateEquivilantKey :: Backend -> RawFilePath -> Annex (Maybe Key)-generateEquivilantKey b f =-	case genKey b of-		Just genkey -> do-			showSideAction (UnquotedString Backend.Hash.descChecksum)-			Just <$> genkey source nullMeterUpdate-		Nothing -> return Nothing-  where-	source = KeySource-		{ keyFilename = mempty -- avoid adding any extension-		, contentLocation = f-		, inodeCache = Nothing-		}
Backend/WORM.hs view
@@ -42,9 +42,9 @@ keyValue :: KeySource -> MeterUpdate -> Annex Key keyValue source _ = do 	let f = contentLocation source-	stat <- liftIO $ R.getFileStatus f+	stat <- liftIO $ R.getFileStatus (fromOsPath f) 	sz <- liftIO $ getFileSize' f stat-	relf <- fromRawFilePath . getTopFilePath+	relf <- fromOsPath . getTopFilePath 		<$> inRepo (toTopFilePath $ keyFilename source) 	return $ mkKey $ \k -> k 		{ keyName = genKeyName relf
Build/Configure.hs view
@@ -11,6 +11,7 @@ import Utility.Env.Basic import qualified Git.Version import Utility.SystemDirectory+import Utility.OsPath  import Control.Monad import Control.Applicative@@ -91,11 +92,11 @@  setup :: IO () setup = do-	createDirectoryIfMissing True tmpDir+	createDirectoryIfMissing True (toOsPath tmpDir) 	writeFile testFile "test file contents"  cleanup :: IO ()-cleanup = removeDirectoryRecursive tmpDir+cleanup = removeDirectoryRecursive (toOsPath tmpDir)  run :: [TestCase] -> IO () run ts = do
Build/DesktopFile.hs view
@@ -6,17 +6,14 @@  - Licensed under the GNU AGPL version 3 or higher.  -} +{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE CPP #-} {-# OPTIONS_GHC -fno-warn-tabs #-}  module Build.DesktopFile where -import Utility.Exception+import Common import Utility.FreeDesktop-import Utility.Path-import Utility.Monad-import Utility.SystemDirectory-import Utility.FileSystemEncoding import Config.Files import Utility.OSX import Assistant.Install.AutoStart@@ -25,8 +22,6 @@ import System.Environment #ifndef mingw32_HOST_OS  import System.Posix.User-import Data.Maybe-import Control.Applicative import Prelude #endif @@ -42,10 +37,10 @@ systemwideInstall = return False #endif -inDestDir :: FilePath -> IO FilePath+inDestDir :: OsPath -> IO OsPath inDestDir f = do 	destdir <- catchDefaultIO "" (getEnv "DESTDIR")-	return $ destdir ++ "/" ++ f+	return $ toOsPath destdir <> literalOsPath "/" <> f  writeFDODesktop :: FilePath -> IO () writeFDODesktop command = do@@ -54,7 +49,7 @@ 	datadir <- if systemwide then return systemDataDir else userDataDir 	menufile <- inDestDir (desktopMenuFilePath "git-annex" datadir) 	icondir <- inDestDir (iconDir datadir)-	installMenu command menufile "doc" icondir+	installMenu command menufile (literalOsPath "doc") icondir  	configdir <- if systemwide then return systemConfigDir else userConfigDir 	installAutoStart command @@ -78,8 +73,8 @@ 		( return () 		, do 			programfile <- inDestDir =<< programFile-			createDirectoryIfMissing True (fromRawFilePath (parentDir (toRawFilePath programfile)))-			writeFile programfile command+			createDirectoryIfMissing True (parentDir programfile)+			writeFile (fromOsPath programfile) command 		)  installUser :: FilePath -> IO ()
Build/TestConfig.hs view
@@ -8,9 +8,9 @@ import Utility.Monad import Utility.SafeCommand import Utility.SystemDirectory+import Utility.OsPath  import System.IO-import System.FilePath  type ConfigKey = String data ConfigValue =@@ -105,8 +105,11 @@ 		)   where 	find d =-		let f = d </> command-		in ifM (doesFileExist f) ( return (Just f), return Nothing )+		let f = toOsPath d </> toOsPath command+		in ifM (doesFileExist f)+			( return (Just (fromOsPath f))+			, return Nothing+			)  quiet :: String -> String quiet s = s ++ " >/dev/null 2>&1"
Build/Version.hs view
@@ -1,6 +1,6 @@ {- Package version determination. -} -{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE LambdaCase, OverloadedStrings #-} {-# OPTIONS_GHC -fno-warn-tabs #-}  module Build.Version where@@ -14,7 +14,9 @@  import Utility.Monad import Utility.Exception-import Utility.Misc+import Utility.OsPath+import Utility.FileSystemEncoding+import qualified Utility.FileIO as F  type Version = String @@ -56,11 +58,11 @@ 	middle = drop 1 . init  writeVersion :: Version -> IO ()-writeVersion ver = catchMaybeIO (readFileStrict f) >>= \case+writeVersion ver = catchMaybeIO (F.readFile' f) >>= \case 	Just s | s == body -> return ()-	_ -> writeFile f body+	_ -> F.writeFile' f body   where-	body = unlines $ concat+	body = encodeBS $ unlines $ concat 		[ header 		, ["packageversion :: String"] 		, ["packageversion = \"" ++ ver ++ "\""]@@ -71,4 +73,4 @@ 		, "" 		] 	footer = []-	f = "Build/Version"+	f = literalOsPath "Build/Version"
CHANGELOG view
@@ -1,3 +1,21 @@+git-annex (10.20250320) upstream; urgency=medium++  * Added the compute special remote.+  * addcomputed: New command, adds a file that is generated by a compute+    special remote.+  * recompute: New command, recomputes computed files.+  * findcomputed: New command, displays information about computed files.+  * Support help.autocorrect settings "prompt", "never", and "immediate".+  * Allow setting remote.foo.annex-tracking-branch to a branch name+    that contains "/", as long as it's not a remote tracking branch.+  * Added OsPath build flag, which speeds up git-annex's operations on files.+  * git-lfs: Added an optional apiurl parameter.+    (This needs version 1.2.5 of the haskell git-lfs library to be used.)+  * fsck: Remember the files that are checked, so a later run with --more+    will skip them, without needing to use --incremental.++ -- Joey Hess <id@joeyh.name>  Thu, 20 Mar 2025 13:10:48 -0400+ git-annex (10.20250115) upstream; urgency=medium    * Improve handing of ssh connection problems during 
@@ -14,6 +14,10 @@ Copyright: © 2013 Joey Hess <id@joeyh.name> License: GPL-3+ +Files: doc/special_remotes/compute/git-annex-compute-imageconvert doc/special_remotes/compute/git-annex-compute-wasmedge doc/special_remotes/compute/git-annex-compute-singularity+Copyright: © 2025 Joey Hess <id@joeyh.name>+License: GPL-3++ Files: doc/design/external_backend_protocol/git-annex-backend-XFOO Copyright: © 2020 Joey Hess <id@joeyh.name> License: GPL-3+
CmdLine.hs view
@@ -5,6 +5,8 @@  - Licensed under the GNU AGPL version 3 or higher.  -} +{-# LANGUAGE OverloadedStrings #-}+ module CmdLine ( 	dispatch, 	usage,@@ -29,6 +31,7 @@ import Annex.Environment import Command import Types.Messages+import qualified Utility.OsString as OS  {- Parses input arguments, finds a matching Command, and runs it. -} dispatch :: Bool -> Bool -> CmdParams -> [Command] -> [(String, String)] -> IO Git.Repo -> String -> String -> IO ()@@ -92,7 +95,7 @@ 				handleresult (parseCmd progname progdesc correctedargs allcmds getparser) 			res -> handleresult res 	  where-		autocorrect = Git.AutoCorrect.prepare (fromJust subcommandname) cmdname (NE.fromList cmds)+		autocorrect = Git.AutoCorrect.prepare "git-annex" (fromJust subcommandname) cmdname (NE.fromList cmds) 		name 			| fuzzy = case cmds of 				(c:_) -> Just (cmdname c)@@ -159,17 +162,18 @@ findAddonCommand (Just subcommandname) = 	searchPath c >>= \case 		Nothing -> return Nothing-		Just p -> return (Just (mkAddonCommand p subcommandname))+		Just p -> return (Just (mkAddonCommand (fromOsPath p) subcommandname))   where 	c = "git-annex-" ++ subcommandname  findAllAddonCommands :: IO [Command] findAllAddonCommands =  	filter isaddoncommand-		. map (\p -> mkAddonCommand p (deprefix p))-		<$> searchPathContents ("git-annex-" `isPrefixOf`)+		. map go+		<$> searchPathContents (literalOsPath "git-annex-" `OS.isPrefixOf`)   where-	deprefix = replace "git-annex-" "" . takeFileName+	go p = mkAddonCommand (fromOsPath p) (deprefix p)+	deprefix = replace "git-annex-" "" . fromOsPath . takeFileName 	isaddoncommand c 		-- git-annex-shell 		| cmdname c == "shell" = False
CmdLine/Batch.hs view
@@ -154,12 +154,12 @@ -- to handle them. -- -- File matching options are checked, and non-matching files skipped.-batchFiles :: BatchFormat -> ((SeekInput, RawFilePath) -> CommandStart) -> Annex ()+batchFiles :: BatchFormat -> ((SeekInput, OsPath) -> CommandStart) -> Annex () batchFiles fmt a = batchFilesKeys fmt $ \(si, v) -> case v of 	Right f -> a (si, f) 	Left _k -> return Nothing -batchFilesKeys :: BatchFormat -> ((SeekInput, Either Key RawFilePath) -> CommandStart) -> Annex ()+batchFilesKeys :: BatchFormat -> ((SeekInput, Either Key OsPath) -> CommandStart) -> Annex () batchFilesKeys fmt a = do 	matcher <- getMatcher 	go $ \si v -> case v of@@ -177,7 +177,7 @@ 		-- CmdLine.Seek uses git ls-files. 		BatchFormat _ (BatchKeys False) ->  			Right . Right-				<$$> liftIO . relPathCwdToFile . toRawFilePath+				<$$> liftIO . relPathCwdToFile . toOsPath 		BatchFormat _ (BatchKeys True) -> \i -> 			pure $ case deserializeKey i of 				Just k -> Right (Left k)
CmdLine/GitAnnex.hs view
@@ -133,6 +133,9 @@ import qualified Command.UpdateProxy import qualified Command.MaxSize import qualified Command.Sim+import qualified Command.AddComputed+import qualified Command.Recompute+import qualified Command.FindComputed import qualified Command.Version import qualified Command.RemoteDaemon #ifdef WITH_ASSISTANT@@ -265,6 +268,9 @@ 	, Command.UpdateProxy.cmd 	, Command.MaxSize.cmd 	, Command.Sim.cmd+	, Command.AddComputed.cmd+	, Command.Recompute.cmd+	, Command.FindComputed.cmd 	, Command.Version.cmd 	, Command.RemoteDaemon.cmd #ifdef WITH_ASSISTANT
CmdLine/GitAnnexShell.hs view
@@ -136,7 +136,7 @@ 		"Restricted login shell for git-annex only SSH access"   where 	mkrepo = do-		r <- Git.Construct.repoAbsPath (toRawFilePath dir)+		r <- Git.Construct.repoAbsPath (toOsPath dir) 			>>= Git.Construct.fromAbsPath 		let r' = r { repoPathSpecifiedExplicitly = True } 		Git.Config.read r'
CmdLine/GitAnnexShell/Checks.hs view
@@ -48,9 +48,9 @@ 	v <- getEnv "GIT_ANNEX_SHELL_DIRECTORY" 	case (v, mdir) of 		(Nothing, _) -> noop-		(Just d, Nothing) -> req d Nothing+		(Just d, Nothing) -> req (toOsPath d) Nothing 		(Just d, Just dir)-			|  d `equalFilePath` dir -> noop+			| toOsPath d `equalFilePath` toOsPath dir -> noop 			| otherwise -> do 				home <- myHomeDir 				d' <- canondir home d@@ -61,19 +61,21 @@   where 	req d mdir' = giveup $ unwords  		[ "Only allowed to access"-		, d-		, maybe "and could not determine directory from command line" ("not " ++) mdir'+		, fromOsPath d+		, maybe "and could not determine directory from command line"+			(("not " ++) . fromOsPath)+			mdir' 		]  	{- A directory may start with ~/ or in some cases, even /~/, 	 - or could just be relative to home, or of course could 	 - be absolute. -} 	canondir home d-		| "~/" `isPrefixOf` d = return d-		| "/~/" `isPrefixOf` d = return $ drop 1 d-		| otherwise = relHome $ fromRawFilePath $ absPathFrom -			(toRawFilePath home)-			(toRawFilePath d)+		| "~/" `isPrefixOf` d = return $ toOsPath d+		| "/~/" `isPrefixOf` d = return $ toOsPath $ drop 1 d+		| otherwise = relHome $ absPathFrom+			(toOsPath home)+			(toOsPath d)  {- Modifies a Command to check that it is run in either a git-annex  - repository, or a repository with a gcrypt-id set. -}
CmdLine/GitRemoteAnnex.hs view
@@ -57,6 +57,8 @@ import Utility.Env import Utility.Metered import Utility.FileMode+import qualified Utility.RawFilePath as R+import qualified Utility.FileIO as F  import Network.URI import Data.Either@@ -64,8 +66,6 @@ import qualified Data.ByteString as B import qualified Data.ByteString.Char8 as B8 import qualified Data.Map.Strict as M-import qualified System.FilePath.ByteString as P-import qualified Utility.RawFilePath as R import qualified Data.Set as S  run :: [String] -> IO ()@@ -145,13 +145,14 @@ 		else downloadManifestOrFail rmt 	l <- forM (inManifest manifest) $ \k -> do 		b <- downloadGitBundle rmt k-		heads <- inRepo $ Git.Bundle.listHeads b	+		let b' = fromOsPath b+		heads <- inRepo $ Git.Bundle.listHeads b'	 		-- Get all the objects from the bundle. This is done here 		-- so that the tracking refs can be updated with what is 		-- listed, and so what when a full repush is done, all 		-- objects are available to be pushed. 		when forpush $-			inRepo $ Git.Bundle.unbundle b+			inRepo $ Git.Bundle.unbundle b' 		-- The bundle may contain tracking refs, or regular refs, 		-- make sure we're operating on regular refs. 		return $ map (\(s, r) -> (fromTrackingRef rmt r, s)) heads@@ -201,7 +202,8 @@ fetch' st rmt = do 	manifest <- maybe (downloadManifestOrFail rmt) pure (manifestCache st) 	forM_ (inManifest manifest) $ \k ->-		downloadGitBundle rmt k >>= inRepo . Git.Bundle.unbundle+		downloadGitBundle rmt k +			>>= inRepo . Git.Bundle.unbundle . fromOsPath 	-- Newline indicates end of fetch. 	liftIO $ do 		putStrLn ""@@ -495,13 +497,15 @@ resolveSpecialRemoteWebUrl url 	| "http://" `isPrefixOf` lcurl || "https://" `isPrefixOf` lcurl = 		Url.withUrlOptionsPromptingCreds $ \uo ->-			withTmpFile "git-remote-annex" $ \tmp h -> do+			withTmpFile (literalOsPath "git-remote-annex") $ \tmp h -> do 				liftIO $ hClose h 				Url.download' nullMeterUpdate Nothing url tmp uo >>= \case 					Left err -> giveup $ url ++ " " ++ err 					Right () -> liftIO $-						(headMaybe . lines)-							<$> readFileStrict tmp+						fmap decodeBS +							. headMaybe +							. fileLines'+							<$> F.readFile' tmp 	| otherwise = return Nothing   where 	lcurl = map toLower url@@ -724,10 +728,10 @@ 	-- it needs to re-download it fresh every time, and the object 	-- file should not be stored locally. 	gettotmp dl = withOtherTmp $ \othertmp ->-		withTmpFileIn (fromRawFilePath othertmp) "GITMANIFEST" $ \tmp tmph -> do+		withTmpFileIn othertmp (literalOsPath "GITMANIFEST") $ \tmp tmph -> do 			liftIO $ hClose tmph 			_ <- dl tmp-			b <- liftIO (B.readFile tmp)+			b <- liftIO (F.readFile' tmp) 			case parseManifest b of 				Right m -> Just <$> verifyManifest rmt m 				Left err -> giveup err@@ -774,7 +778,7 @@ 		dropKey' rmt mk 		put mk -	put mk = withTmpFile "GITMANIFEST" $ \tmp tmph -> do+	put mk = withTmpFile (literalOsPath "GITMANIFEST") $ \tmp tmph -> do 		liftIO $ B8.hPut tmph (formatManifest manifest) 		liftIO $ hClose tmph 		-- Uploading needs the key to be in the annex objects@@ -785,13 +789,13 @@ 		-- keys, which it is not. 		objfile <- calcRepo (gitAnnexLocation mk) 		modifyContentDir objfile $-			linkOrCopy mk (toRawFilePath tmp) objfile Nothing >>= \case+			linkOrCopy mk tmp objfile Nothing >>= \case 				-- Important to set the right perms even 				-- though the object is only present 				-- briefly, since sending objects may rely 				-- on or even copy file perms. 				Just _ -> do-					liftIO $ R.setFileMode objfile+					liftIO $ R.setFileMode (fromOsPath objfile) 						=<< defaultFileMode 					freezeContent objfile 				Nothing -> uploadfailed@@ -839,9 +843,11 @@  - interrupted before updating the manifest on the remote, or when a race  - causes the uploaded manigest to be overwritten.  -}-lastPushedManifestFile :: UUID -> Git.Repo -> RawFilePath-lastPushedManifestFile u r = gitAnnexDir r P.</> "git-remote-annex" -	P.</> fromUUID u P.</> "manifest"+lastPushedManifestFile :: UUID -> Git.Repo -> OsPath+lastPushedManifestFile u r = gitAnnexDir r +	</> literalOsPath "git-remote-annex" +	</> fromUUID u+	</> literalOsPath "manifest"  {- Call before uploading anything. The returned manifest has added  - to it any bundle keys that were in the lastPushedManifestFile@@ -857,7 +863,7 @@ 	f <- fromRepo (lastPushedManifestFile (Remote.uuid rmt)) 	oldmanifest <- liftIO $  		fromRight mempty . parseManifest-			<$> B.readFile (fromRawFilePath f)+			<$> F.readFile' f 				`catchNonAsync` (const (pure mempty)) 	let oldmanifest' = mkManifest [] $ 		S.fromList (inManifest oldmanifest)@@ -907,7 +913,7 @@ --    and so more things pulled from it, etc. -- 3. Git bundle objects are not usually transferred between repositories --    except special remotes (although the user can if they want to).-downloadGitBundle :: Remote -> Key -> Annex FilePath+downloadGitBundle :: Remote -> Key -> Annex OsPath downloadGitBundle rmt k = getKeyExportLocations rmt k >>= \case 	Nothing -> dlwith $  		download rmt k (AssociatedFile Nothing) stdRetry noNotification@@ -915,15 +921,15 @@ 		anyM getexport locs   where 	dlwith a = ifM a-		( decodeBS <$> calcRepo (gitAnnexLocation k)+		( calcRepo (gitAnnexLocation k) 		, giveup $ "Failed to download " ++ serializeKey k 		)  	getexport loc = catchNonAsync (getexport' loc) (const (pure False)) 	getexport' loc =-		getViaTmp rsp vc k (AssociatedFile Nothing) Nothing $ \tmp -> do+		getViaTmp rsp vc k Nothing $ \tmp -> do 			v <- Remote.retrieveExport (Remote.exportActions rmt)-				k loc (decodeBS tmp) nullMeterUpdate+				k loc tmp nullMeterUpdate 			return (True, v) 	rsp = Remote.retrievalSecurityPolicy rmt 	vc = Remote.RemoteVerify rmt@@ -948,7 +954,7 @@ uploadGitObject :: Remote -> Key -> Annex () uploadGitObject rmt k = getKeyExportLocations rmt k >>= \case 	Just (loc:_) -> do-		objfile <- fromRawFilePath <$> calcRepo (gitAnnexLocation k)+		objfile <- calcRepo (gitAnnexLocation k) 		Remote.storeExport (Remote.exportActions rmt) objfile k loc nullMeterUpdate 	_ ->  		unlessM (upload rmt k (AssociatedFile Nothing) retry noNotification) $@@ -973,14 +979,14 @@ 	-> Manifest 	-> Annex (Key, Annex ()) generateGitBundle rmt bs manifest =-	withTmpFile "GITBUNDLE" $ \tmp tmph -> do+	withTmpFile (literalOsPath "GITBUNDLE") $ \tmp tmph -> do 		liftIO $ hClose tmph-		inRepo $ Git.Bundle.create tmp bs+		inRepo $ Git.Bundle.create (fromOsPath tmp) bs 		bundlekey <- genGitBundleKey (Remote.uuid rmt)-			(toRawFilePath tmp) nullMeterUpdate+			tmp nullMeterUpdate 		if (bundlekey `notElem` inManifest manifest) 			then do-				unlessM (moveAnnex bundlekey (AssociatedFile Nothing) (toRawFilePath tmp)) $+				unlessM (moveAnnex bundlekey tmp) $ 					giveup "Unable to push" 				return (bundlekey, uploadaction bundlekey) 			else return (bundlekey, noop)@@ -1020,7 +1026,7 @@ keyExportLocations :: Remote -> Key -> GitConfig -> UUID -> Maybe [ExportLocation] keyExportLocations rmt k cfg uuid 	| exportTree (Remote.config rmt) || importTree (Remote.config rmt) = -		Just $ map (\p -> mkExportLocation (".git" P.</> p)) $+		Just $ map (\p -> mkExportLocation (literalOsPath ".git" </> p)) $ 			concatMap (`annexLocationsBare` k) cfgs 	| otherwise = Nothing   where@@ -1089,7 +1095,7 @@ 	Nothing -> fixup <$> Git.CurrentRepo.get   where 	fixup r@(Repo { location = loc@(Local { worktree = Just _ }) }) =-		r { location = loc { worktree = Just (P.takeDirectory (gitdir loc)) } }+		r { location = loc { worktree = Just (takeDirectory (gitdir loc)) } } 	fixup r = r  -- Records what the git-annex branch was at the beginning of this command.@@ -1122,11 +1128,11 @@ -- journal writes to a temporary directory, so that all writes -- to the git-annex branch by the action will be discarded. specialRemoteFromUrl :: StartAnnexBranch -> Annex a -> Annex a-specialRemoteFromUrl sab a = withTmpDir "journal" $ \tmpdir -> do+specialRemoteFromUrl sab a = withTmpDir (literalOsPath "journal") $ \tmpdir -> do 	Annex.overrideGitConfig $ \c ->  		c { annexAlwaysCommit = False } 	Annex.BranchState.changeState $ \st -> -		st { alternateJournal = Just (toRawFilePath tmpdir) }+		st { alternateJournal = Just tmpdir } 	a `finally` cleanupInitialization sab tmpdir  -- If the git-annex branch did not exist when this command started,@@ -1160,7 +1166,7 @@ -- involve checking out an adjusted branch. But git clone wants to do its -- own checkout. So no initialization is done then, and the git bundle -- objects are deleted.-cleanupInitialization :: StartAnnexBranch -> FilePath -> Annex ()+cleanupInitialization :: StartAnnexBranch -> OsPath -> Annex () cleanupInitialization sab alternatejournaldir = void $ tryNonAsync $ do 	liftIO $ mapM_ removeFile =<< dirContents alternatejournaldir 	case sab of@@ -1168,7 +1174,7 @@ 		AnnexBranchCreatedEmpty r -> 			whenM ((r ==) <$> Annex.Branch.getBranch) $ do 				indexfile <- fromRepo gitAnnexIndex-				liftIO $ removeWhenExistsWith R.removeLink indexfile+				liftIO $ removeWhenExistsWith removeFile indexfile 				-- When cloning failed and this is being 				-- run as an exception is thrown, HEAD will 				-- not be set to a valid value, which will@@ -1196,7 +1202,7 @@ 		forM_ ks $ \k -> case fromKey keyVariety k of                 	GitBundleKey -> lockContentForRemoval k noop removeAnnex 			_ -> noop-		void $ liftIO $ tryIO $ removeDirectory (decodeBS annexobjectdir)+		void $ liftIO $ tryIO $ removeDirectory annexobjectdir  	notcrippledfilesystem = not <$> probeCrippledFileSystem
CmdLine/Seek.hs view
@@ -48,6 +48,7 @@ import qualified Utility.RawFilePath as R import Utility.Tuple import Utility.HumanTime+import qualified Utility.OsString as OS  import Control.Concurrent.Async import Control.Concurrent.STM@@ -55,10 +56,9 @@ import Data.IORef import Data.Time.Clock.POSIX import System.PosixCompat.Files (isDirectory, isSymbolicLink, deviceID, fileID)-import qualified System.FilePath.ByteString as P  data AnnexedFileSeeker = AnnexedFileSeeker-	{ startAction :: Maybe KeySha -> SeekInput -> RawFilePath -> Key -> CommandStart+	{ startAction :: Maybe KeySha -> SeekInput -> OsPath -> Key -> CommandStart 	, checkContentPresent :: Maybe Bool 	, usesLocationLog :: Bool 	}@@ -81,7 +81,7 @@ 	getfiles c [] = return (reverse c, pure True) 	getfiles c (p:ps) = do 		os <- seekOptions ww-		(fs, cleanup) <- inRepo $ LsFiles.inRepoDetails os [toRawFilePath p]+		(fs, cleanup) <- inRepo $ LsFiles.inRepoDetails os [toOsPath p] 		r <- case fs of 			[f] -> do 				propagateLsFilesError cleanup@@ -95,18 +95,18 @@ 		return (r, pure True) withFilesInGitAnnexNonRecursive _ _ _ NoWorkTreeItems = noop -withFilesNotInGit :: CheckGitIgnore -> WarnUnmatchWhen -> ((SeekInput, RawFilePath) -> CommandSeek) -> WorkTreeItems -> CommandSeek+withFilesNotInGit :: CheckGitIgnore -> WarnUnmatchWhen -> ((SeekInput, OsPath) -> CommandSeek) -> WorkTreeItems -> CommandSeek withFilesNotInGit (CheckGitIgnore ci) ww a l = do 	force <- Annex.getRead Annex.force 	let include_ignored = force || not ci 	seekFiltered (const (pure True)) a $ 		seekHelper id ww (const $ LsFiles.notInRepo [] include_ignored) l -withPathContents :: ((RawFilePath, RawFilePath) -> CommandSeek) -> CmdParams -> CommandSeek+withPathContents :: ((OsPath, OsPath) -> CommandSeek) -> CmdParams -> CommandSeek withPathContents a params = do 	matcher <- Limit.getMatcher 	checktimelimit <- mkCheckTimeLimit-	go matcher checktimelimit params []+	go matcher checktimelimit (map toOsPath params) []   where 	go _ _ [] [] = return () 	go matcher checktimelimit (p:ps) [] =@@ -120,15 +120,12 @@ 	-- fail if the path that the user provided is a broken symlink, 	-- the same as it fails if the path that the user provided does not 	-- exist.-	get p = ifM (isDirectory <$> R.getFileStatus p')+	get p = ifM (isDirectory <$> R.getFileStatus (fromOsPath p)) 		( map (\f -> -			let f' = toRawFilePath f-			in (f', P.makeRelative (P.takeDirectory (P.dropTrailingPathSeparator p')) f'))-			<$> dirContentsRecursiveSkipping (".git" `isSuffixOf`) False p-		, return [(p', P.takeFileName p')]+			(f, makeRelative (takeDirectory (dropTrailingPathSeparator p)) f))+			<$> dirContentsRecursiveSkipping (literalOsPath ".git" `OS.isSuffixOf`) False p+		, return [(p, takeFileName p)] 		)-	  where-		p' = toRawFilePath p  	checkmatch matcher (f, relf) = matcher $ MatchingFile $ FileInfo 		{ contentFile = f@@ -150,24 +147,24 @@ 	pairs c (x:y:xs) = pairs ((x,y):c) xs 	pairs _ _ = giveup "expected pairs" -withFilesToBeCommitted :: WarnUnmatchWhen -> ((SeekInput, RawFilePath) -> CommandSeek) -> WorkTreeItems -> CommandSeek+withFilesToBeCommitted :: WarnUnmatchWhen -> ((SeekInput, OsPath) -> CommandSeek) -> WorkTreeItems -> CommandSeek withFilesToBeCommitted ww a l = seekFiltered (const (pure True)) a $ 	seekHelper id ww (const LsFiles.stagedNotDeleted) l  {- unlocked pointer files that are staged, and whose content has not been  - modified-}-withUnmodifiedUnlockedPointers :: WarnUnmatchWhen -> ((SeekInput, RawFilePath) -> CommandSeek) -> WorkTreeItems -> CommandSeek+withUnmodifiedUnlockedPointers :: WarnUnmatchWhen -> ((SeekInput, OsPath) -> CommandSeek) -> WorkTreeItems -> CommandSeek withUnmodifiedUnlockedPointers ww a l = 	seekFiltered (isUnmodifiedUnlocked . snd) a $ 		seekHelper id ww (const LsFiles.typeChangedStaged) l -isUnmodifiedUnlocked :: RawFilePath -> Annex Bool+isUnmodifiedUnlocked :: OsPath -> Annex Bool isUnmodifiedUnlocked f = catKeyFile f >>= \case 	Nothing -> return False 	Just k -> sameInodeCache f =<< Database.Keys.getInodeCaches k  {- Finds files that may be modified. -}-withFilesMaybeModified :: WarnUnmatchWhen -> ((SeekInput, RawFilePath) -> CommandSeek) -> WorkTreeItems -> CommandSeek+withFilesMaybeModified :: WarnUnmatchWhen -> ((SeekInput, OsPath) -> CommandSeek) -> WorkTreeItems -> CommandSeek withFilesMaybeModified ww a params = seekFiltered (const (pure True)) a $ 	seekHelper id ww LsFiles.modified params @@ -320,7 +317,7 @@ 		forM_ ts $ \(t, i) -> 			keyaction Nothing (SeekInput [], transferKey t, mkActionItem (t, i)) -seekFiltered :: ((SeekInput, RawFilePath) -> Annex Bool) -> ((SeekInput, RawFilePath) -> CommandSeek) -> Annex ([(SeekInput, RawFilePath)], IO Bool) -> Annex ()+seekFiltered :: ((SeekInput, OsPath) -> Annex Bool) -> ((SeekInput, OsPath) -> CommandSeek) -> Annex ([(SeekInput, OsPath)], IO Bool) -> Annex () seekFiltered prefilter a listfs = do 	matcher <- Limit.getMatcher 	checktimelimit <- mkCheckTimeLimit@@ -351,7 +348,7 @@ -- because of the way data is streamed through git cat-file. -- -- It can also precache location logs using the same efficient streaming.-seekFilteredKeys :: AnnexedFileSeeker -> Annex ([(SeekInput, (RawFilePath, Git.Sha, FileMode))], IO Bool) -> Annex ()+seekFilteredKeys :: AnnexedFileSeeker -> Annex ([(SeekInput, (OsPath, Git.Sha, FileMode))], IO Bool) -> Annex () seekFilteredKeys seeker listfs = do 	g <- Annex.gitRepo 	mi <- MatcherInfo@@ -465,7 +462,7 @@ 	 	-- Check if files exist, because a deleted file will still be 	-- listed by ls-tree, but should not be processed.-	exists p = isJust <$> liftIO (catchMaybeIO $ R.getSymbolicLinkStatus p)+	exists p = isJust <$> liftIO (catchMaybeIO $ R.getSymbolicLinkStatus (fromOsPath p))  	mdprocess mi mdreader ofeeder ocloser = liftIO mdreader >>= \case 		Just ((si, f), Just (sha, size, _type))@@ -485,18 +482,18 @@ 			null <$> Annex.Branch.getUnmergedRefs 		| otherwise = pure False -seekHelper :: (a -> RawFilePath) -> WarnUnmatchWhen -> ([LsFiles.Options] -> [RawFilePath] -> Git.Repo -> IO ([a], IO Bool)) -> WorkTreeItems -> Annex ([(SeekInput, a)], IO Bool)+seekHelper :: (a -> OsPath) -> WarnUnmatchWhen -> ([LsFiles.Options] -> [OsPath] -> Git.Repo -> IO ([a], IO Bool)) -> WorkTreeItems -> Annex ([(SeekInput, a)], IO Bool) seekHelper c ww a (WorkTreeItems l) = do 	os <- seekOptions ww 	v <- liftIO $ newIORef [] 	r <- inRepo $ \g -> concat . concat <$> forM (segmentXargsOrdered l)-		(runSegmentPaths' mk c (\fs -> go v os fs g) . map toRawFilePath)+		(runSegmentPaths' mk c (\fs -> go v os fs g) . map toOsPath) 	return (r, cleanupall v)   where-	mk (Just i) f = (SeekInput [fromRawFilePath i], f) +	mk (Just i) f = (SeekInput [fromOsPath i], f)  	-- This is not accurate, but it only happens when there are a 	-- great many input WorkTreeItems.-	mk Nothing f = (SeekInput [fromRawFilePath (c f)], f)+	mk Nothing f = (SeekInput [fromOsPath (c f)], f)  	go v os fs g = do 		(ls, cleanup) <- a os fs g@@ -561,7 +558,7 @@ 		currbranch <- getCurrentBranch 		stopattop <- prepviasymlink 		ps' <- flip filterM ps $ \p -> do-			let p' = toRawFilePath p+			let p' = toOsPath p 			relf <- liftIO $ relPathCwdToFile p' 			ifM (not <$> (exists p' <||> hidden currbranch relf)) 				( prob action FileNotFound p' "not found"@@ -574,13 +571,13 @@ 			then return NoWorkTreeItems 			else return (WorkTreeItems ps') 	-	exists p = isJust <$> liftIO (catchMaybeIO $ R.getSymbolicLinkStatus p)+	exists p = isJust <$> liftIO (catchMaybeIO $ R.getSymbolicLinkStatus $ fromOsPath p)  	prepviasymlink = do 		repotopst <- inRepo $  			maybe 				(pure Nothing)-				(catchMaybeIO . R.getSymbolicLinkStatus) +				(catchMaybeIO . R.getSymbolicLinkStatus . fromOsPath)  			. Git.repoWorkTree 		return $ \st -> case repotopst of 			Nothing -> False@@ -589,7 +586,7 @@  	viasymlink _ Nothing = return False 	viasymlink stopattop (Just p) = do-		st <- liftIO $ R.getSymbolicLinkStatus p+		st <- liftIO $ R.getSymbolicLinkStatus $ fromOsPath p 		if stopattop st 			then return False 			else if isSymbolicLink st@@ -602,12 +599,12 @@ 		| otherwise = return False  	prob action errorid p msg = do-		toplevelFileProblem False errorid msg action p Nothing (SeekInput [fromRawFilePath p])+		toplevelFileProblem False errorid msg action p Nothing (SeekInput [fromOsPath p]) 		Annex.incError 		return False 	-notSymlink :: RawFilePath -> IO Bool-notSymlink f = liftIO $ not . isSymbolicLink <$> R.getSymbolicLinkStatus f+notSymlink :: OsPath -> IO Bool+notSymlink f = liftIO $ not . isSymbolicLink <$> R.getSymbolicLinkStatus (fromOsPath f)  {- Returns an action that, when there's a time limit, can be used  - to check it before processing a file. The first action is run when
Command.hs view
@@ -144,8 +144,7 @@ noDaemonRunning = addCheck NoDaemonRunning $ whenM (isJust <$> daemonpid) $ 	giveup "You cannot run this command while git-annex watch or git-annex assistant is running."   where-	daemonpid = liftIO . checkDaemon . fromRawFilePath-		=<< fromRepo gitAnnexPidFile+	daemonpid = liftIO . checkDaemon =<< fromRepo gitAnnexPidFile  dontCheck :: CommandCheck -> Command -> Command dontCheck check cmd = mutateCheck cmd $ \c -> filter (/= check) c
Command/Add.hs view
@@ -31,7 +31,6 @@ import Annex.InodeSentinal import Annex.CheckIgnore import qualified Utility.RawFilePath as R-import qualified System.FilePath.ByteString as P  import System.PosixCompat.Files (fileSize, isSymbolicLink, isRegularFile, modificationTime, fileID, deviceID, fileMode, ownerExecuteMode, intersectFileModes) @@ -140,23 +139,23 @@ 	dr = dryRunOption o  {- Pass file off to git-add. -}-startSmall :: Bool -> DryRun -> SeekInput -> RawFilePath -> CommandStart+startSmall :: Bool -> DryRun -> SeekInput -> OsPath -> CommandStart startSmall isdotfile dr si file =-	liftIO (catchMaybeIO $ R.getSymbolicLinkStatus file) >>= \case+	liftIO (catchMaybeIO $ R.getSymbolicLinkStatus $ fromOsPath file) >>= \case 		Just s ->  			starting "add" (ActionItemTreeFile file) si $ 				addSmall isdotfile dr file s 		Nothing -> stop -addSmall :: Bool -> DryRun -> RawFilePath -> FileStatus -> CommandPerform+addSmall :: Bool -> DryRun -> OsPath -> FileStatus -> CommandPerform addSmall isdotfile dr file s = do 	showNote $ (if isdotfile then "dotfile" else "non-large file") 		<> "; adding content to git repository" 	skipWhenDryRun dr $ next $ addFile Small file s -startSmallOverridden :: DryRun -> SeekInput -> RawFilePath -> CommandStart+startSmallOverridden :: DryRun -> SeekInput -> OsPath -> CommandStart startSmallOverridden dr si file = -	liftIO (catchMaybeIO $ R.getSymbolicLinkStatus file) >>= \case+	liftIO (catchMaybeIO $ R.getSymbolicLinkStatus $ fromOsPath file) >>= \case 		Just s -> starting "add" (ActionItemTreeFile file) si $ do 			showNote "adding content to git repository" 			skipWhenDryRun dr $ next $ addFile Small file s@@ -164,22 +163,23 @@  data SmallOrLarge = Small | Large -addFile :: SmallOrLarge -> RawFilePath -> FileStatus -> Annex Bool+addFile :: SmallOrLarge -> OsPath -> FileStatus -> Annex Bool addFile smallorlarge file s = do+	let file' = fromOsPath file 	sha <- if isSymbolicLink s-		then hashBlob =<< liftIO (R.readSymbolicLink file)+		then hashBlob =<< liftIO (R.readSymbolicLink file') 		else if isRegularFile s 			then hashFile file 			else do 				qp <- coreQuotePath <$> Annex.getGitConfig-				giveup $ decodeBS $ quote qp $-					file <> " is not a regular file"+				giveup $ decodeBS $ quote qp file+					<> " is not a regular file" 	let treetype = if isSymbolicLink s 		then TreeSymlink 		else if intersectFileModes ownerExecuteMode (fileMode s) /= 0 			then TreeExecutable 			else TreeFile-	s' <- liftIO $ catchMaybeIO $ R.getSymbolicLinkStatus file+	s' <- liftIO $ catchMaybeIO $ R.getSymbolicLinkStatus file' 	if maybe True (changed s) s' 		then do 			warning $ QuotedPath file <> " changed while it was being added"@@ -206,9 +206,9 @@ 		isRegularFile a /= isRegularFile b || 		isSymbolicLink a /= isSymbolicLink b -start :: DryRun -> SeekInput -> RawFilePath -> AddUnlockedMatcher -> CommandStart+start :: DryRun -> SeekInput -> OsPath -> AddUnlockedMatcher -> CommandStart start dr si file addunlockedmatcher = -	liftIO (catchMaybeIO $ R.getSymbolicLinkStatus file) >>= \case+	liftIO (catchMaybeIO $ R.getSymbolicLinkStatus $ fromOsPath file) >>= \case 		Nothing -> stop 		Just s 			| not (isRegularFile s) && not (isSymbolicLink s) -> stop@@ -231,11 +231,11 @@ 		starting "add" (ActionItemTreeFile file) si $ 			addingExistingLink file key $ 				skipWhenDryRun dr $ withOtherTmp $ \tmp -> do-					let tmpf = tmp P.</> P.takeFileName file+					let tmpf = tmp </> takeFileName file 					liftIO $ moveFile file tmpf-					ifM (isSymbolicLink <$> liftIO (R.getSymbolicLinkStatus tmpf))+					ifM (isSymbolicLink <$> liftIO (R.getSymbolicLinkStatus $ fromOsPath tmpf)) 						( do-							liftIO $ R.removeLink tmpf+							liftIO $ removeFile tmpf 							addSymlink file key Nothing 							next $ cleanup key =<< inAnnex key 						, do@@ -249,7 +249,7 @@ 					Database.Keys.addAssociatedFile key =<< inRepo (toTopFilePath file) 					next $ addFile Large file s -perform :: RawFilePath -> AddUnlockedMatcher -> CommandPerform+perform :: OsPath -> AddUnlockedMatcher -> CommandPerform perform file addunlockedmatcher = withOtherTmp $ \tmpdir -> do 	lockingfile <- not <$> addUnlocked addunlockedmatcher 		(MatchingFile (FileInfo file file Nothing))@@ -259,7 +259,7 @@ 		, hardlinkFileTmpDir = Just tmpdir 		, checkWritePerms = True 		}-	ld <- lockDown cfg (fromRawFilePath file)+	ld <- lockDown cfg file 	let sizer = keySource <$> ld 	v <- metered Nothing sizer Nothing $ \_meter meterupdate -> 		ingestAdd meterupdate ld
+ Command/AddComputed.hs view
@@ -0,0 +1,253 @@+{- git-annex command+ -+ - Copyright 2025 Joey Hess <id@joeyh.name>+ -+ - Licensed under the GNU AGPL version 3 or higher.+ -}++{-# LANGUAGE OverloadedStrings #-}++module Command.AddComputed where++import Command+import qualified Git+import qualified Git.Types as Git+import qualified Git.Ref as Git+import qualified Annex+import qualified Remote.Compute+import qualified Types.Remote as Remote+import Backend+import Annex.CatFile+import Annex.Content.Presence+import Annex.Ingest+import Annex.UUID+import Annex.GitShaKey+import Types.KeySource+import Types.Key+import Annex.FileMatcher+import Messages.Progress+import Logs.Location+import Logs.EquivilantKeys+import Utility.Metered+import Backend.URL (fromUrl)+import Git.FilePath++import qualified Data.Map as M+import Data.Time.Clock++cmd :: Command+cmd = notBareRepo $ withAnnexOptions [backendOption, jsonOptions] $+	command "addcomputed" SectionCommon "add computed files to annex"+		(paramRepeating paramExpression)+		(seek <$$> optParser)++data AddComputedOptions = AddComputedOptions+	{ computeParams :: CmdParams+	, computeRemote :: DeferredParse Remote+	, reproducible :: Maybe Reproducible+	}++optParser :: CmdParamsDesc -> Parser AddComputedOptions+optParser desc = AddComputedOptions+	<$> cmdParams desc+	<*> (mkParseRemoteOption <$> parseToOption)+	<*> parseReproducible++newtype Reproducible = Reproducible { isReproducible :: Bool }+	deriving (Show, Eq)++parseReproducible :: Parser (Maybe Reproducible)+parseReproducible = r <|> unr+  where+	r  = flag Nothing (Just (Reproducible True))+		( long "reproducible"+		<> short 'r'+		<> help "computation is fully reproducible"+		)+	unr = flag Nothing (Just (Reproducible False))+		( long "unreproducible"+		<> short 'u'+		<> help "computation is not fully reproducible"+		)++seek :: AddComputedOptions -> CommandSeek+seek o = startConcurrency commandStages (seek' o)++seek' :: AddComputedOptions -> CommandSeek+seek' o = do+	addunlockedmatcher <- addUnlockedMatcher+	r <- getParsed (computeRemote o)+	unless (Remote.Compute.isComputeRemote r) $+		giveup "That is not a compute remote."++	commandAction $ start o r addunlockedmatcher++start :: AddComputedOptions -> Remote -> AddUnlockedMatcher -> CommandStart+start o r = starting "addcomputed" ai si . perform o r+  where+	ai = ActionItemUUID (Remote.uuid r) (UnquotedString (Remote.name r))+	si = SeekInput (computeParams o)++perform :: AddComputedOptions -> Remote -> AddUnlockedMatcher -> CommandPerform+perform o r addunlockedmatcher = do+	program <- Remote.Compute.getComputeProgram r+	repopath <- fromRepo Git.repoPath+	subdir <- liftIO $ relPathDirToFile repopath (literalOsPath ".")+	let state = Remote.Compute.ComputeState+		{ Remote.Compute.computeParams = computeParams o +++			Remote.Compute.defaultComputeParams r+		, Remote.Compute.computeInputs = mempty+		, Remote.Compute.computeOutputs = mempty+		, Remote.Compute.computeSubdir = subdir+		}+	fast <- Annex.getRead Annex.fast+	Remote.Compute.runComputeProgram program state+		(Remote.Compute.ImmutableState False)+		(getInputContent fast)+		Nothing+		(go fast)+	next $ return True+  where+	go fast = addComputed (Just "adding") r (reproducible o)+		chooseBackend Just fast (Right addunlockedmatcher)++addComputed+	:: Maybe StringContainingQuotedPath+	-> Remote+	-> Maybe Reproducible+	-> (OsPath -> Annex Backend)+	-> (OsPath -> Maybe OsPath)+	-> Bool+	-> Either Bool AddUnlockedMatcher+	-> Remote.Compute.ComputeProgramResult+	-> OsPath+	-> NominalDiffTime+	-> Annex ()+addComputed maddaction r reproducibleconfig choosebackend destfile fast addunlockedmatcher result tmpdir ts = do+	when (M.null outputs) $+		giveup "The computation succeeded, but it did not generate any files."+	oks <- forM (M.keys outputs) $ \outputfile -> do+		case maddaction of+			Just addaction -> showAction $+				addaction <> " " <> QuotedPath outputfile+			Nothing -> noop+		k <- catchNonAsync (addfile outputfile)+			(\err -> giveup $ "Failed to ingest output file " ++ fromOsPath outputfile ++ ": " ++ show err)+		return (outputfile, Just k)+	let state' = state+		{ Remote.Compute.computeOutputs = M.fromList oks+		}+	forM_ (mapMaybe snd oks) $ \k -> do+		Remote.Compute.setComputeState+			(Remote.remoteStateHandle r)+			k ts state'++		let u = Remote.uuid r+		unlessM (elem u <$> loggedLocations k) $+			logChange NoLiveUpdate k u InfoPresent+  where+	state = Remote.Compute.computeState result+	+	outputs = Remote.Compute.computeOutputs state+	+	addfile outputfile+		| fast = do+			case destfile outputfile of+				Nothing -> noop+				Just f -> addSymlink f stateurlk Nothing+			return stateurlk+		| isreproducible = do+			sz <- liftIO $ getFileSize outputfile'+			metered Nothing sz Nothing $ \_ p ->+				case destfile outputfile of+					Just f -> ingesthelper f p Nothing+					Nothing -> genkey outputfile p+		| otherwise = case destfile outputfile of+			Just f -> ingesthelper f nullMeterUpdate+				(Just stateurlk)+			Nothing -> return stateurlk+	  where+	  	stateurl = Remote.Compute.computeStateUrl r state outputfile+		stateurlk = fromUrl stateurl Nothing True+		outputfile' = tmpdir </> outputfile+		genkey f p = do+			backend <- choosebackend outputfile+			let ks = KeySource+				{ keyFilename = f+				, contentLocation = outputfile'+				, inodeCache = Nothing+				}+			fst <$> genKey ks p backend+		ingesthelper f p mk = ingestwith $ do+			k <- maybe (genkey f p) return mk+			topf <- inRepo $ toTopFilePath f+			let fi = FileInfo+				{ contentFile = outputfile'+				, matchFile = getTopFilePath topf+				, matchKey = Just k+				}+			lockingfile <- case addunlockedmatcher of+				Right addunlockedmatcher' -> +					not <$> addUnlocked addunlockedmatcher'+						(MatchingFile fi)+						(not fast)+				Left v -> pure v+			let ldc = LockDownConfig+				{ lockingFile = lockingfile+				, hardlinkFileTmpDir = Nothing+				, checkWritePerms = True+				}+			liftIO $ createDirectoryIfMissing True $+				takeDirectory f+			liftIO $ moveFile outputfile' f+			let ks = KeySource+				{ keyFilename = f+				, contentLocation = f+				, inodeCache = Nothing+				}+			let ld = LockedDown ldc ks+			ingestAdd' p (Just ld) (Just k)+		ingestwith a = a >>= \case+			Nothing -> giveup "ingestion failed"+			Just k -> do+				u <- getUUID+				unlessM (elem u <$> loggedLocations k) $+					logStatus NoLiveUpdate k InfoPresent+				when (fromKey keyVariety k == VURLKey) $ do+					hb <- hashBackend+					void $ addEquivilantKey hb k +						=<< calcRepo (gitAnnexLocation k)+				return k+	+	isreproducible = case reproducibleconfig of+		Just v -> isReproducible v+		Nothing -> Remote.Compute.computeReproducible result+	+getInputContent :: Bool -> OsPath -> Bool -> Annex (Key, Maybe (Either Git.Sha OsPath))+getInputContent fast p required = catKeyFile p >>= \case+	Just inputkey -> getInputContent' fast inputkey required filedesc+	Nothing -> inRepo (Git.fileRef p) >>= \case+		Just fileref -> catObjectMetaData fileref >>= \case+			Just (sha, _, t)+				| t == Git.BlobObject ->+					getInputContent' fast (gitShaKey sha) required filedesc+				| otherwise ->+					badinput $ ", not a git " ++ decodeBS (Git.fmtObjectType t)+			Nothing -> notcheckedin+		Nothing -> notcheckedin+  where+	filedesc = fromOsPath p+	badinput s = giveup $ "The computation needs an input file " ++ s ++ ": " ++ fromOsPath p+	notcheckedin = badinput "that is not checked into the git repository"++getInputContent' :: Bool -> Key -> Bool -> String -> Annex (Key, Maybe (Either Git.Sha OsPath))+getInputContent' fast inputkey required filedesc+	| fast && not required = return (inputkey, Nothing)+	| otherwise = case keyGitSha inputkey of+		Nothing -> ifM (inAnnex inputkey)+			( do+				obj <- calcRepo (gitAnnexLocation inputkey)+				return (inputkey, Just (Right obj))+			, giveup $ "The computation needs the content of an annexed file which is not present: " ++ filedesc+			)+		Just sha -> return (inputkey, Just (Left sha))
Command/AddUnused.hs view
@@ -27,7 +27,7 @@ start = startUnused go (other "bad") (other "tmp")   where 	go n key = do-		let file = "unused." <> keyFile key+		let file = literalOsPath "unused." <> keyFile key 		starting "addunused" 			(ActionItemTreeFile file) 			(SeekInput [show n]) $
Command/AddUrl.hs view
@@ -38,7 +38,6 @@ import qualified Annex.Transfer as Transfer  import Network.URI-import qualified System.FilePath.ByteString as P  cmd :: Command cmd = notBareRepo $ withAnnexOptions @@ -177,14 +176,14 @@ 		warning (UnquotedString (show e)) 		next $ return False 	go deffile (Right (UrlContents sz mf)) = do-		f <- maybe (pure deffile) (sanitizeOrPreserveFilePath o) mf+		f <- maybe (pure deffile) (sanitizeOrPreserveFilePath o . fromOsPath) mf 		let f' = adjustFile o (fromMaybe f (fileOption (downloadOptions o))) 		void $ commandAction $ startRemote addunlockedmatcher r o si f' u sz 	go deffile (Right (UrlMulti l)) = case fileOption (downloadOptions o) of 		Nothing -> 			forM_ l $ \(u', sz, f) -> do-				f' <- sanitizeOrPreserveFilePath o f-				let f'' = adjustFile o (deffile </> f')+				f' <- sanitizeOrPreserveFilePath o (fromOsPath f)+				let f'' = adjustFile o (fromOsPath (toOsPath deffile </> toOsPath f')) 				void $ commandAction $ startRemote addunlockedmatcher r o si f'' u' sz 		Just f -> case l of 			[] -> noop@@ -200,14 +199,15 @@ startRemote :: AddUnlockedMatcher -> Remote -> AddUrlOptions -> SeekInput -> FilePath -> URLString -> Maybe Integer -> CommandStart startRemote addunlockedmatcher r o si file uri sz = do 	pathmax <- liftIO $ fileNameLengthLimit "."-	let file' = joinPath $ map (truncateFilePath pathmax) $-		splitDirectories file+	let file' = joinPath $ +		map (toOsPath . truncateFilePath pathmax . fromOsPath) $+			splitDirectories (toOsPath file) 	startingAddUrl si uri o $ do 		showNote $ UnquotedString $ "from " ++ Remote.name r -		showDestinationFile (toRawFilePath file')-		performRemote addunlockedmatcher r o uri (toRawFilePath file') sz+		showDestinationFile file'+		performRemote addunlockedmatcher r o uri file' sz -performRemote :: AddUnlockedMatcher -> Remote -> AddUrlOptions -> URLString -> RawFilePath -> Maybe Integer -> CommandPerform+performRemote :: AddUnlockedMatcher -> Remote -> AddUrlOptions -> URLString -> OsPath -> Maybe Integer -> CommandPerform performRemote addunlockedmatcher r o uri file sz = lookupKey file >>= \case 	Just k -> adduri k 	Nothing -> geturi@@ -219,7 +219,7 @@ 		Just n -> (True, n == fromMaybe n (fromKey keySize key), loguri) 	geturi = next $ isJust <$> downloadRemoteFile addunlockedmatcher r (downloadOptions o) uri file sz -downloadRemoteFile :: AddUnlockedMatcher -> Remote -> DownloadOptions -> URLString -> RawFilePath -> Maybe Integer -> Annex (Maybe Key)+downloadRemoteFile :: AddUnlockedMatcher -> Remote -> DownloadOptions -> URLString -> OsPath -> Maybe Integer -> Annex (Maybe Key) downloadRemoteFile addunlockedmatcher r o uri file sz = checkCanAdd o file $ \canadd -> do 	let urlkey = Backend.URL.fromUrl uri sz (verifiableOption o) 	createWorkTreeDirectory (parentDir file)@@ -265,12 +265,12 @@ 					f <- sanitizeOrPreserveFilePath o sf 					if preserveFilenameOption (downloadOptions o) 						then pure f-						else ifM (liftIO $ doesFileExist f <||> doesDirectoryExist f)+						else ifM (liftIO $ doesFileExist (toOsPath f) <||> doesDirectoryExist (toOsPath f)) 							( pure $ url2file url (pathdepthOption o) pathmax 							, pure f 							) 				_ -> pure $ url2file url (pathdepthOption o) pathmax-		performWeb addunlockedmatcher o urlstring (toRawFilePath file) urlinfo+		performWeb addunlockedmatcher o urlstring (toOsPath file) urlinfo  sanitizeOrPreserveFilePath :: AddUrlOptions -> FilePath -> Annex FilePath sanitizeOrPreserveFilePath o f@@ -279,7 +279,8 @@ 		return f 	| otherwise = do 		pathmax <- liftIO $ fileNameLengthLimit "."-		return $ truncateFilePath pathmax $ sanitizeFilePath f+		return $ fromRawFilePath $ truncateFilePath pathmax $+			toRawFilePath $ sanitizeFilePath f  -- sanitizeFilePath avoids all these security problems -- (and probably others, but at least this catches the most egrarious ones).@@ -293,12 +294,12 @@ 		qp <- coreQuotePath <$> Annex.getGitConfig 		giveup $ decodeBS $ quote qp $ 			"--preserve-filename was used, but the filename ("-				<> QuotedPath (toRawFilePath f)+				<> QuotedPath (toOsPath f) 				<> ") has a security problem (" 				<> d 				<> "), not adding." -performWeb :: AddUnlockedMatcher -> AddUrlOptions -> URLString -> RawFilePath -> Url.UrlInfo -> CommandPerform+performWeb :: AddUnlockedMatcher -> AddUrlOptions -> URLString -> OsPath -> Url.UrlInfo -> CommandPerform performWeb addunlockedmatcher o url file urlinfo = lookupKey file >>= \case 	Just k -> addurl k 	Nothing -> geturl@@ -313,7 +314,7 @@  {- Check that the url exists, and has the same size as the key,  - and add it as an url to the key. -}-addUrlChecked :: AddUrlOptions -> URLString -> RawFilePath -> UUID -> (Key -> Annex (Maybe (Bool, Bool, URLString))) -> Key -> CommandPerform+addUrlChecked :: AddUrlOptions -> URLString -> OsPath -> UUID -> (Key -> Annex (Maybe (Bool, Bool, URLString))) -> Key -> CommandPerform addUrlChecked o url file u checkexistssize key = 	ifM ((elem url <$> getUrls key) <&&> (elem u <$> loggedLocations key)) 		( do@@ -339,21 +340,21 @@  - different file, based on the title of the media. Unless the user  - specified fileOption, which then forces using the FilePath.  -}-addUrlFile :: AddUnlockedMatcher -> DownloadOptions -> URLString -> Url.UrlInfo -> RawFilePath -> Annex (Maybe Key)+addUrlFile :: AddUnlockedMatcher -> DownloadOptions -> URLString -> Url.UrlInfo -> OsPath -> Annex (Maybe Key) addUrlFile addunlockedmatcher o url urlinfo file = 	ifM (Annex.getRead Annex.fast <||> pure (relaxedOption o)) 		( nodownloadWeb addunlockedmatcher o url urlinfo file 		, downloadWeb addunlockedmatcher o url urlinfo file 		) -downloadWeb :: AddUnlockedMatcher -> DownloadOptions -> URLString -> Url.UrlInfo -> RawFilePath -> Annex (Maybe Key)+downloadWeb :: AddUnlockedMatcher -> DownloadOptions -> URLString -> Url.UrlInfo -> OsPath -> Annex (Maybe Key) downloadWeb addunlockedmatcher o url urlinfo file = 	go =<< downloadWith' downloader urlkey webUUID url file   where 	urlkey = addSizeUrlKey urlinfo $ Backend.URL.fromUrl url Nothing (verifiableOption o) 	downloader f p = Url.withUrlOptions $ downloadUrl False urlkey p Nothing [url] f 	go Nothing = return Nothing-	go (Just (tmp, backend)) = ifM (useYoutubeDl o <&&> liftIO (isHtmlFile (fromRawFilePath tmp)))+	go (Just (tmp, backend)) = ifM (useYoutubeDl o <&&> liftIO (isHtmlFile tmp)) 		( tryyoutubedl tmp backend 		, normalfinish tmp backend 		)@@ -365,25 +366,25 @@ 	-- so it's only used when the file contains embedded media. 	tryyoutubedl tmp backend = youtubeDlFileNameHtmlOnly url >>= \case 		Right mediafile -> do-			liftIO $ liftIO $ removeWhenExistsWith R.removeLink tmp-			let f = youtubeDlDestFile o file (toRawFilePath mediafile)+			liftIO $ liftIO $ removeWhenExistsWith removeFile tmp+			let f = youtubeDlDestFile o file mediafile 			lookupKey f >>= \case 				Just k -> alreadyannexed f k 				Nothing -> dl f 		Left err -> checkRaw (Just err) o (pure Nothing) (normalfinish tmp backend) 	  where 		dl dest = withTmpWorkDir mediakey $ \workdir -> do-			let cleanuptmp = pruneTmpWorkDirBefore tmp (liftIO . removeWhenExistsWith R.removeLink)+			let cleanuptmp = pruneTmpWorkDirBefore tmp (liftIO . removeWhenExistsWith removeFile) 			dlcmd <- youtubeDlCommand 			showNote ("using " <> UnquotedString dlcmd) 			Transfer.notifyTransfer Transfer.Download url $ 				Transfer.download' webUUID mediakey (AssociatedFile Nothing) Nothing Transfer.noRetry $ \p -> do 					showDestinationFile dest-					youtubeDl url (fromRawFilePath workdir) p >>= \case+					youtubeDl url workdir p >>= \case 						Right (Just mediafile) -> do 							cleanuptmp 							checkCanAdd o dest $ \canadd -> do-								addWorkTree canadd addunlockedmatcher webUUID mediaurl dest mediakey (Just (toRawFilePath mediafile))+								addWorkTree canadd addunlockedmatcher webUUID mediaurl dest mediakey (Just mediafile) 								return $ Just mediakey 						Left msg -> do 							cleanuptmp@@ -444,10 +445,10 @@ 	ai = OnlyActionOn urlkey (ActionItemOther (Just (UnquotedString url))) 	urlkey = Backend.URL.fromUrl url Nothing (verifiableOption (downloadOptions o)) -showDestinationFile :: RawFilePath -> Annex ()+showDestinationFile :: OsPath -> Annex () showDestinationFile file = do 	showNote ("to " <> QuotedPath file)-	maybeShowJSON $ JSONChunk [("file", fromRawFilePath file)]+	maybeShowJSON $ JSONChunk [("file", file)]  {- The Key should be a dummy key, based on the URL, which is used  - for this download, before we can examine the file and find its real key.@@ -458,7 +459,7 @@  - Downloads the url, sets up the worktree file, and returns the  - real key.  -}-downloadWith :: CanAddFile -> AddUnlockedMatcher -> (FilePath -> MeterUpdate -> Annex Bool) -> Key -> UUID -> URLString -> RawFilePath -> Annex (Maybe Key)+downloadWith :: CanAddFile -> AddUnlockedMatcher -> (OsPath -> MeterUpdate -> Annex Bool) -> Key -> UUID -> URLString -> OsPath -> Annex (Maybe Key) downloadWith canadd addunlockedmatcher downloader dummykey u url file = 	go =<< downloadWith' downloader dummykey u url file   where@@ -467,7 +468,7 @@  {- Like downloadWith, but leaves the dummy key content in  - the returned location. -}-downloadWith' :: (FilePath -> MeterUpdate -> Annex Bool) -> Key -> UUID -> URLString -> RawFilePath -> Annex (Maybe (RawFilePath, Backend))+downloadWith' :: (OsPath -> MeterUpdate -> Annex Bool) -> Key -> UUID -> URLString -> OsPath -> Annex (Maybe (OsPath, Backend)) downloadWith' downloader dummykey u url file = 	checkDiskSpaceToGet dummykey Nothing Nothing $ do 		backend <- chooseBackend file@@ -476,14 +477,14 @@ 		ok <- Transfer.notifyTransfer Transfer.Download url $ \_w -> 			Transfer.runTransfer t (Just backend) afile Nothing Transfer.stdRetry $ \p -> do 				createAnnexDirectory (parentDir tmp)-				downloader (fromRawFilePath tmp) p+				downloader tmp p 		if ok 			then return (Just (tmp, backend)) 			else return Nothing   where 	afile = AssociatedFile (Just file) -finishDownloadWith :: CanAddFile -> AddUnlockedMatcher -> RawFilePath -> Backend -> UUID -> URLString -> RawFilePath -> Annex Key+finishDownloadWith :: CanAddFile -> AddUnlockedMatcher -> OsPath -> Backend -> UUID -> URLString -> OsPath -> Annex Key finishDownloadWith canadd addunlockedmatcher tmp backend u url file = do 	let source = KeySource 		{ keyFilename = file@@ -501,14 +502,14 @@ 	}  {- Adds worktree file to the repository. -}-addWorkTree :: CanAddFile -> AddUnlockedMatcher -> UUID -> URLString -> RawFilePath -> Key -> Maybe RawFilePath -> Annex ()+addWorkTree :: CanAddFile -> AddUnlockedMatcher -> UUID -> URLString -> OsPath -> Key -> Maybe OsPath -> Annex () addWorkTree _ addunlockedmatcher u url file key mtmp = case mtmp of 	Nothing -> go 	Just tmp -> do-		s <- liftIO $ R.getSymbolicLinkStatus tmp+		s <- liftIO $ R.getSymbolicLinkStatus (fromOsPath tmp) 		-- Move to final location for large file check. 		pruneTmpWorkDirBefore tmp $ \_ -> do-			createWorkTreeDirectory (P.takeDirectory file)+			createWorkTreeDirectory (takeDirectory file) 			liftIO $ moveFile tmp file 		largematcher <- largeFilesMatcher 		large <- checkFileMatcher NoLiveUpdate largematcher file@@ -530,15 +531,15 @@ 			( do 				when (isJust mtmp) $ 					logStatus NoLiveUpdate key InfoPresent-			, maybe noop (\tmp -> pruneTmpWorkDirBefore tmp (liftIO . removeWhenExistsWith R.removeLink)) mtmp+			, maybe noop (\tmp -> pruneTmpWorkDirBefore tmp (liftIO . removeWhenExistsWith removeFile)) mtmp 			) -nodownloadWeb :: AddUnlockedMatcher -> DownloadOptions -> URLString -> Url.UrlInfo -> RawFilePath -> Annex (Maybe Key)+nodownloadWeb :: AddUnlockedMatcher -> DownloadOptions -> URLString -> Url.UrlInfo -> OsPath -> Annex (Maybe Key) nodownloadWeb addunlockedmatcher o url urlinfo file 	| Url.urlExists urlinfo = if rawOption o 		then nomedia 		else youtubeDlFileName url >>= \case-			Right mediafile -> usemedia (toRawFilePath mediafile)+			Right mediafile -> usemedia mediafile 			Left err -> checkRaw (Just err) o (pure Nothing) nomedia 	| otherwise = do 		warning $ UnquotedString $ "unable to access url: " ++ url@@ -553,12 +554,12 @@ 		let mediakey = Backend.URL.fromUrl mediaurl Nothing (verifiableOption o) 		nodownloadWeb' o addunlockedmatcher mediaurl mediakey dest -youtubeDlDestFile :: DownloadOptions -> RawFilePath -> RawFilePath -> RawFilePath+youtubeDlDestFile :: DownloadOptions -> OsPath -> OsPath -> OsPath youtubeDlDestFile o destfile mediafile 	| isJust (fileOption o) = destfile-	| otherwise = P.takeFileName mediafile+	| otherwise = takeFileName mediafile -nodownloadWeb' :: DownloadOptions -> AddUnlockedMatcher -> URLString -> Key -> RawFilePath -> Annex (Maybe Key)+nodownloadWeb' :: DownloadOptions -> AddUnlockedMatcher -> URLString -> Key -> OsPath -> Annex (Maybe Key) nodownloadWeb' o addunlockedmatcher url key file = checkCanAdd o file $ \canadd -> do 	showDestinationFile file 	createWorkTreeDirectory (parentDir file)@@ -567,8 +568,8 @@  url2file :: URI -> Maybe Int -> Int -> FilePath url2file url pathdepth pathmax = case pathdepth of-	Nothing -> truncateFilePath pathmax $ sanitizeFilePath fullurl-	Just depth+	Nothing -> truncatesanitize fullurl+	Just depth  		| depth >= length urlbits -> frombits id 		| depth > 0 -> frombits $ drop depth 		| depth < 0 -> frombits $ reverse . take (negate depth) . reverse@@ -580,8 +581,12 @@ 		, uriQuery url 		] 	frombits a = intercalate "/" $ a urlbits-	urlbits = map (truncateFilePath pathmax . sanitizeFilePath) $+	urlbits = map truncatesanitize $ 		filter (not . null) $ splitc '/' fullurl+	truncatesanitize = fromRawFilePath +		. truncateFilePath pathmax +		. toRawFilePath +		. sanitizeFilePath  urlString2file :: URLString -> Maybe Int -> Int -> FilePath urlString2file s pathdepth pathmax = case Url.parseURIRelaxed s of@@ -596,8 +601,8 @@  data CanAddFile = CanAddFile -checkCanAdd :: DownloadOptions -> RawFilePath -> (CanAddFile -> Annex (Maybe a)) -> Annex (Maybe a)-checkCanAdd o file a = ifM (isJust <$> (liftIO $ catchMaybeIO $ R.getSymbolicLinkStatus file))+checkCanAdd :: DownloadOptions -> OsPath -> (CanAddFile -> Annex (Maybe a)) -> Annex (Maybe a)+checkCanAdd o file a = ifM (isJust <$> (liftIO $ catchMaybeIO $ R.getSymbolicLinkStatus (fromOsPath file))) 	( do 		warning $ QuotedPath file <> " already exists; not overwriting" 		return Nothing
Command/Assist.hs view
@@ -28,7 +28,8 @@ 	Command.Sync.prepMerge  	Command.Add.seek Command.Add.AddOptions-		{ Command.Add.addThese = Command.Sync.contentOfOption o+		{ Command.Add.addThese = map fromOsPath $ +			Command.Sync.contentOfOption o 		, Command.Add.batchOption = NoBatch 		, Command.Add.updateOnly = False 		, Command.Add.largeFilesOverride = Nothing
Command/Assistant.hs view
@@ -79,11 +79,11 @@ 	dirs <- liftIO readAutoStartFile 	when (null dirs) $ do 		f <- autoStartFile-		giveup $ "Nothing listed in " ++ f-	program <- programPath+		giveup $ "Nothing listed in " ++ fromOsPath f+	program <- fromOsPath <$> programPath 	haveionice <- pure BuildInfo.ionice <&&> inSearchPath "ionice" 	pids <- forM dirs $ \d -> do-		putStrLn $ "git-annex autostart in " ++ d+		putStrLn $ "git-annex autostart in " ++ fromOsPath d 		mpid <- catchMaybeIO $ go haveionice program d 		if foregroundDaemonOption (daemonOptions o) 			then return mpid@@ -128,9 +128,9 @@ autoStop :: IO () autoStop = do 	dirs <- liftIO readAutoStartFile-	program <- programPath+	program <- fromOsPath <$> programPath 	forM_ dirs $ \d -> do-		putStrLn $ "git-annex autostop in " ++ d+		putStrLn $ "git-annex autostop in " ++ fromOsPath d 		tryIO (setCurrentDirectory d) >>= \case 			Right () -> ifM (boolSystem program [Param "assistant", Param "--stop"]) 				( putStrLn "ok"
Command/CalcKey.hs view
@@ -32,4 +32,4 @@ 	Left _err -> return False   where 	ks = KeySource file' file' Nothing-	file' = toRawFilePath file+	file' = toOsPath file
Command/Config.hs view
@@ -152,7 +152,7 @@ 		| decodeBS name `elem` annexAttrs = 			case forfile of 				Just file -> do-					v <- checkAttr (decodeBS name) (toRawFilePath file)+					v <- checkAttr (decodeBS name) (toOsPath file) 					if null v 						then cont 						else showval "gitattributes" v
Command/ContentLocation.hs view
@@ -9,7 +9,6 @@  import Command import Annex.Content-import qualified Utility.RawFilePath as R  import qualified Data.ByteString.Char8 as B8 @@ -23,10 +22,13 @@ run :: () -> SeekInput -> String -> Annex Bool run _ _ p = do 	let k = fromMaybe (giveup "bad key") $ deserializeKey p-	maybe (return False) (\f -> liftIO (B8.putStrLn f) >> return True)+	maybe (return False) emit 		=<< inAnnex' (pure True) Nothing check k   where-	check f = ifM (liftIO (R.doesPathExist f))+	check f = ifM (liftIO (doesFileExist f)) 		( return (Just f) 		, return Nothing 		)+	emit f = liftIO $ do+		B8.putStrLn $ fromOsPath f+		return True
Command/Copy.hs view
@@ -77,7 +77,7 @@ {- A copy is just a move that does not delete the source file.  - However, auto mode avoids unnecessary copies, and avoids getting or  - sending non-preferred content. -}-start :: CopyOptions -> FromToHereOptions -> SeekInput -> RawFilePath -> Key -> CommandStart+start :: CopyOptions -> FromToHereOptions -> SeekInput -> OsPath -> Key -> CommandStart start o fto si file key = do 	ru <- case fto of 		FromOrToRemote (ToRemote dest) -> getru dest@@ -90,7 +90,7 @@   where 	getru dest = Just . Remote.uuid <$> getParsed dest -start' :: LiveUpdate -> CopyOptions -> FromToHereOptions -> SeekInput -> RawFilePath -> Key -> CommandStart+start' :: LiveUpdate -> CopyOptions -> FromToHereOptions -> SeekInput -> OsPath -> Key -> CommandStart start' lu o fto si file key = stopUnless shouldCopy $  	Command.Move.start lu fto Command.Move.RemoveNever si file key   where
Command/DiffDriver.hs view
@@ -119,7 +119,7 @@ 			maybe (return r) go (parseLinkTargetOrPointer =<< v) 		_ -> maybe (return r) go =<< liftIO (isPointerFile f) 	  where-		f = toRawFilePath (getfile r)+		f = toOsPath (getfile r) 	  	go k = do 			when (getOption opts) $ 				unlessM (inAnnex k) $@@ -132,7 +132,7 @@ 			si = SeekInput [] 			af = AssociatedFile (Just f) 		repoint k = withObjectLoc k $-			pure . setfile r . fromRawFilePath+			pure . setfile r . fromOsPath  externalDiffer :: String -> [String] -> Differ externalDiffer c ps = \req -> boolSystem c (map Param ps ++ serializeReq req )
Command/Drop.hs view
@@ -76,7 +76,7 @@   where 	ww = WarnUnmatchLsFiles "drop" -start :: DropOptions -> Maybe Remote -> SeekInput -> RawFilePath -> Key -> CommandStart+start :: DropOptions -> Maybe Remote -> SeekInput -> OsPath -> Key -> CommandStart start o from si file key = start' o from key afile ai si   where 	afile = AssociatedFile (Just file)
Command/DropUnused.hs view
@@ -17,7 +17,6 @@ import Command.Unused (withUnusedMaps, UnusedMaps(..), startUnused) import Annex.NumCopies import Annex.Content-import qualified Utility.RawFilePath as R  cmd :: Command cmd = withAnnexOptions [jobsOption, jsonOptions] $@@ -77,8 +76,8 @@ 	pcc = Command.Drop.PreferredContentChecked False 	ud = Command.Drop.DroppingUnused True -performOther :: (Key -> Git.Repo -> RawFilePath) -> Key -> CommandPerform+performOther :: (Key -> Git.Repo -> OsPath) -> Key -> CommandPerform performOther filespec key = do 	f <- fromRepo $ filespec key-	pruneTmpWorkDirBefore f (liftIO . removeWhenExistsWith R.removeLink)+	pruneTmpWorkDirBefore f (liftIO . removeWhenExistsWith removeFile) 	next $ return True
Command/EnableTor.hs view
@@ -57,7 +57,7 @@ 			Nothing -> giveup "Need user-id parameter." 			Just userid -> go userid 		else starting "enable-tor" ai si $ do-			gitannex <- liftIO programPath+			gitannex <- fromOsPath <$> liftIO programPath 			let ps = [Param (cmdname cmd), Param (show curruserid)] 			sucommand <- liftIO $ mkSuCommand gitannex ps 			cleanenv <- liftIO $ cleanStandaloneEnvironment@@ -145,6 +145,6 @@  	haslistener sockfile = catchBoolIO $ do 		soc <- S.socket S.AF_UNIX S.Stream S.defaultProtocol-		S.connect soc (S.SockAddrUnix sockfile)+		S.connect soc (S.SockAddrUnix $ fromOsPath sockfile) 		S.close soc 		return True
Command/ExamineKey.hs view
@@ -39,7 +39,7 @@ optParser = ExamineOptions 	<$> optional parseFormatOption 	<*> (fmap (DeferredParse . tobackend) <$> migrateopt)-	<*> (AssociatedFile <$> fileopt)+	<*> (AssociatedFile . fmap stringToOsPath <$> fileopt)   where 	fileopt = optional $ strOption 		( long "filename" <> metavar paramFile@@ -59,8 +59,8 @@ 	let objectpointer = formatPointer k 	isterminal <- liftIO $ checkIsTerminal stdout 	showFormatted isterminal (format o) (serializeKey' k) $-		[ ("objectpath", fromRawFilePath objectpath)-		, ("objectpointer", fromRawFilePath objectpointer)+		[ ("objectpath", fromOsPath objectpath)+		, ("objectpointer", decodeBS objectpointer) 		] ++ formatVars k af 	return True   where@@ -71,7 +71,7 @@ 	ik = fromMaybe (giveup "bad key") (deserializeKey' ikb) 	af = if B.null ifb' 		then associatedFile o-		else AssociatedFile (Just ifb')+		else AssociatedFile (Just (toOsPath ifb'))  	getkey = case migrateToBackend o of 		Nothing -> pure ik
Command/Export.hs view
@@ -26,6 +26,7 @@ import Types.Export import Annex.Export import Annex.Content+import Annex.GitShaKey import Annex.Transfer import Annex.CatFile import Annex.FileMatcher@@ -78,8 +79,8 @@ -- To handle renames which swap files, the exported file is first renamed -- to a stable temporary name based on the key. exportTempName :: Key -> ExportLocation-exportTempName ek = mkExportLocation $ toRawFilePath $-	".git-annex-tmp-content-" ++ serializeKey ek+exportTempName ek = mkExportLocation $+	literalOsPath ".git-annex-tmp-content-" <> toOsPath (serializeKey'' ek)  seek :: ExportOptions -> CommandSeek seek o = startConcurrency commandStages $ do@@ -120,15 +121,21 @@ -- branch. getExportCommit :: Remote -> Git.Ref -> Annex (Maybe (RemoteTrackingBranch, Sha)) getExportCommit r treeish-	| '/' `notElem` fromRef baseref = do-		let tb = mkRemoteTrackingBranch r baseref-		commitsha <- inRepo $ Git.Ref.sha $ Git.Ref.underBase refsheads baseref-		return (fmap (tb, ) commitsha)-	| otherwise = return Nothing+	| '/' `notElem` fromRef baseref = go+	| otherwise = ifM isremoteref+		( return Nothing+		, go+		)   where 	baseref = Ref $ S8.takeWhile (/= ':') $ fromRef' $  		Git.Ref.removeBase refsheads treeish 	refsheads = "refs/heads"+	isremoteref = inRepo $ Git.Ref.exists $+		Git.Ref.underBase "refs/remotes" baseref+	go = do+		let tb = mkRemoteTrackingBranch r baseref+		commitsha <- inRepo $ Git.Ref.sha $ Git.Ref.underBase refsheads baseref+		return (fmap (tb, ) commitsha)  -- | Changes what's exported to the remote. Does not upload any new -- files, but does delete and rename files already exported to the remote.@@ -306,12 +313,11 @@ 	sent <- tryNonAsync $ if not (isGitShaKey ek) 		then tryrenameannexobject $ sendannexobject 		-- Sending a non-annexed file.-		else withTmpFile "export" $ \tmp h -> do+		else withTmpFile (literalOsPath "export") $ \tmp h -> do 			b <- catObject contentsha 			liftIO $ L.hPut h b 			liftIO $ hClose h-			Remote.action $-				storer tmp ek loc nullMeterUpdate+			Remote.action $ storer tmp ek loc nullMeterUpdate 	let failedsend = liftIO $ modifyMVar_ allfilledvar (pure . const (AllFilled False)) 	case sent of 		Right True -> next $ cleanupExport r db ek loc True
Command/FilterBranch.hs view
@@ -27,13 +27,11 @@ import Git.UpdateIndex import qualified Git.LsTree as LsTree import qualified Git.Branch as Git-import Utility.RawFilePath  import qualified Data.Map as M import qualified Data.Set as S import qualified Data.ByteString.Lazy as L import Data.ByteString.Builder-import qualified System.FilePath.ByteString as P  cmd :: Command cmd = noMessages $ withAnnexOptions [annexedMatchingOptions] $ @@ -120,10 +118,10 @@  seek :: FilterBranchOptions -> CommandSeek seek o = withOtherTmp $ \tmpdir -> do-	let tmpindex = tmpdir P.</> "index"+	let tmpindex = tmpdir </> literalOsPath "index" 	gc <- Annex.getGitConfig 	tmpindexrepo <- Annex.inRepo $ \r ->-		addGitEnv r indexEnv (fromRawFilePath tmpindex)+		addGitEnv r indexEnv (fromOsPath tmpindex) 	withUpdateIndex tmpindexrepo $ \h -> do 		keyinfomatcher <- mkUUIDMatcher (keyInformation o) 		repoconfigmatcher <- mkUUIDMatcher (repoConfig o)@@ -186,7 +184,7 @@  	-- Commit the temporary index, and output the result. 	t <- liftIO $ Git.writeTree tmpindexrepo-	liftIO $ removeWhenExistsWith removeLink tmpindex+	liftIO $ removeWhenExistsWith removeFile tmpindex 	cmode <- annexCommitMode <$> Annex.getGitConfig 	cmessage <- Annex.Branch.commitMessage 	c <- inRepo $ Git.commitTree cmode [cmessage] [] t
Command/FilterProcess.hs view
@@ -36,7 +36,7 @@ 			go 		Nothing -> return () -smudge :: FilePath -> Annex ()+smudge :: OsPath -> Annex () smudge file = do 	{- The whole git file content is necessarily buffered in memory, 	 - because we have to consume everything git is sending before@@ -49,7 +49,7 @@ 	 - See Command.Smudge.smudge for details of how this works. -} 	liftIO $ respondFilterRequest b -clean :: FilePath -> Annex ()+clean :: OsPath -> Annex () clean file = do 	{- We have to consume everything git is sending before we can 	 - respond to it. But it can be an arbitrarily large file,@@ -82,7 +82,7 @@ 	-- read from the file. It may be less expensive to incrementally 	-- hash the content provided by git, but Backend does not currently 	-- have an interface to do so.-	Command.Smudge.clean' (toRawFilePath file)+	Command.Smudge.clean' file 		(parseLinkTargetOrPointer' b) 		passthrough 		discardreststdin
Command/Find.hs view
@@ -88,9 +88,9 @@ 			else Just True 		} -start :: FindOptions -> IsTerminal -> SeekInput -> RawFilePath -> Key -> CommandStart+start :: FindOptions -> IsTerminal -> SeekInput -> OsPath -> Key -> CommandStart start o isterminal _ file key = startingCustomOutput key $ do-	showFormatted isterminal (formatOption o) file+	showFormatted isterminal (formatOption o) (fromOsPath file) 		(formatVars key (AssociatedFile (Just file))) 	next $ return True @@ -113,14 +113,14 @@  formatVars :: Key -> AssociatedFile -> [(String, String)] formatVars key (AssociatedFile af) =-	(maybe id (\f l -> (("file", fromRawFilePath f) : l)) af)+	(maybe id (\f l -> (("file", fromOsPath f) : l)) af) 	[ ("key", serializeKey key) 	, ("backend", decodeBS $ formatKeyVariety $ fromKey keyVariety key) 	, ("bytesize", size show) 	, ("humansize", size $ roughSize storageUnits True) 	, ("keyname", decodeBS $ S.fromShort $ fromKey keyName key)-	, ("hashdirlower", fromRawFilePath $ hashDirLower def key)-	, ("hashdirmixed", fromRawFilePath $ hashDirMixed def key)+	, ("hashdirlower", fromOsPath $ hashDirLower def key)+	, ("hashdirmixed", fromOsPath $ hashDirMixed def key) 	, ("mtime", whenavail show $ fromKey keyMtime key) 	]   where
+ Command/FindComputed.hs view
@@ -0,0 +1,131 @@+{- git-annex command+ -+ - Copyright 2025 Joey Hess <id@joeyh.name>+ -+ - Licensed under the GNU AGPL version 3 or higher.+ -}++{-# LANGUAGE OverloadedStrings, TupleSections #-}++module Command.FindComputed where++import Command+import Git.FilePath+import qualified Utility.Format+import Utility.Terminal+import Command.Find (showFormatted, formatVars)+import Remote.Compute (isComputeRemote, getComputeState, ComputeState(..))+import qualified Remote+import qualified Types.Remote as Remote+import Database.Keys+import Annex.CatFile++import qualified Data.Map as M++cmd :: Command+cmd = withAnnexOptions [annexedMatchingOptions] $ noCommit $ noMessages $+	withAnnexOptions [jsonOptions] $+		command "findcomputed" SectionQuery "lists computed files"+			paramPaths (seek <$$> optParser)++data FindComputedOptions = FindComputedOptions+	{ findThese :: CmdParams+	, formatOption :: Maybe Utility.Format.Format+	, keyOptions :: Maybe KeyOptions+	, inputsOption :: Bool+	}++optParser :: CmdParamsDesc -> Parser FindComputedOptions+optParser desc = FindComputedOptions+	<$> cmdParams desc+	<*> optional parseFormatOption+	<*> optional parseBranchKeysOption+	<*> switch+                ( long "inputs"+                <> help "display input files"+                )+	+parseFormatOption :: Parser Utility.Format.Format+parseFormatOption = +	option (Utility.Format.gen <$> str)+		( long "format" <> metavar paramFormat+		<> help "control format of output"+		)++seek :: FindComputedOptions -> CommandSeek+seek o = do+	unless (isJust (keyOptions o)) $+		checkNotBareRepo+	isterminal <- liftIO $ checkIsTerminal stdout+	computeremotes <- filter isComputeRemote <$> Remote.remoteList+	let seeker = AnnexedFileSeeker+		{ startAction = const (start o isterminal computeremotes)+		, checkContentPresent = Nothing+		, usesLocationLog = True+		}+	withKeyOptions (keyOptions o) False seeker+		(commandAction . startKeys o isterminal computeremotes)+		(withFilesInGitAnnex ww seeker)+		=<< workTreeItems ww (findThese o)+  where+	ww = WarnUnmatchLsFiles "findcomputed"++start :: FindComputedOptions -> IsTerminal -> [Remote] -> SeekInput -> OsPath -> Key -> CommandStart+start o isterminal computeremotes _ file key = do+	rs <- Remote.remotesWithUUID computeremotes+		<$> Remote.keyLocations key+	rcs <- catMaybes <$> forM rs get+	if null rcs+		then stop+		else startingCustomOutput key $ do+			forM_ rcs display+			next $ return True+  where+	get r = fmap (r, )+		<$> getComputeState (Remote.remoteStateHandle r) key+	+	showformatted = showFormatted isterminal (formatOption o)+				+	unformatted r computation = fromOsPath file +		<> " (" <> encodeBS (Remote.name r)+		<> ") -- "+		<> encodeBS computation+	+	unformattedinputs (Right inputfile) = fromOsPath file+		<> " " <> fromOsPath inputfile+	unformattedinputs (Left inputkey) = fromOsPath file+		<> " " <> serializeKey' inputkey+	+	display (r, c) = do+		let computation = unwords (computeParams c)+		let formatvars = +			[ ("remote", Remote.name r)+			, ("computation", computation)+			] ++ formatVars key (AssociatedFile (Just file))+		if inputsOption o+			then forM_ (M.elems $ computeInputs c) $ \inputkey -> do+				input <- maybe (Left inputkey) Right+					<$> getassociated inputkey+				showformatted (unformattedinputs input) $+					[ ("input", either serializeKey fromOsPath input)+					, ("inputkey", serializeKey inputkey)+					, ("inputfile", either (const "") fromOsPath input)+					] ++ formatvars+			else showformatted (unformatted r computation) formatvars++	getassociated inputkey = +		getAssociatedFiles inputkey+			>>= mapM (fromRepo . fromTopFilePath)+			>>= firstM (stillassociated inputkey)++	-- Some associated files that are in the keys database may no+	-- longer correspond to files in the repository.+	stillassociated k f = catKeyFile f >>= return . \case+		Just k' | k' == k -> True+		_ -> False++startKeys :: FindComputedOptions -> IsTerminal -> [Remote] -> (SeekInput, Key, ActionItem) -> CommandStart+startKeys o isterminal computeremotes (si, key, ActionItemBranchFilePath (BranchFilePath _ topf) _) =+	start o isterminal computeremotes si (getTopFilePath topf) key+startKeys _ _ _ _ = stop+
Command/Fix.hs view
@@ -44,25 +44,27 @@  data FixWhat = FixSymlinks | FixAll -start :: FixWhat -> SeekInput -> RawFilePath -> Key -> CommandStart+start :: FixWhat -> SeekInput -> OsPath -> Key -> CommandStart start fixwhat si file key = do-	currlink <- liftIO $ catchMaybeIO $ R.readSymbolicLink file+	currlink <- liftIO $ catchMaybeIO $ R.readSymbolicLink file' 	wantlink <- calcRepo $ gitAnnexLink file key 	case currlink of 		Just l-			| l /=  wantlink -> fixby $ fixSymlink file wantlink+			| l /=  fromOsPath wantlink ->+				fixby $ fixSymlink file wantlink 			| otherwise -> stop 		Nothing -> case fixwhat of 			FixAll -> fixthin 			FixSymlinks -> stop   where+	file' = fromOsPath file 	fixby = starting "fix" (mkActionItem (key, file)) si 	fixthin = do 		obj <- calcRepo (gitAnnexLocation key) 		stopUnless (isUnmodified key file <&&> isUnmodified key obj) $ do 			thin <- annexThin <$> Annex.getGitConfig-			fs <- liftIO $ catchMaybeIO $ R.getFileStatus file-			os <- liftIO $ catchMaybeIO $ R.getFileStatus obj+			fs <- liftIO $ catchMaybeIO $ R.getFileStatus file'+			os <- liftIO $ catchMaybeIO $ R.getFileStatus (fromOsPath obj) 			case (linkCount <$> fs, linkCount <$> os, thin) of 				(Just 1, Just 1, True) -> 					fixby $ makeHardLink file key@@ -70,10 +72,10 @@ 					fixby $ breakHardLink file key obj 				_ -> stop -breakHardLink :: RawFilePath -> Key -> RawFilePath -> CommandPerform+breakHardLink :: OsPath -> Key -> OsPath -> CommandPerform breakHardLink file key obj = do-	replaceWorkTreeFile (fromRawFilePath file) $ \tmp -> do-		mode <- liftIO $ catchMaybeIO $ fileMode <$> R.getFileStatus file+	replaceWorkTreeFile file $ \tmp -> do+		mode <- liftIO $ catchMaybeIO $ fileMode <$> R.getFileStatus (fromOsPath file) 		unlessM (checkedCopyFile key obj tmp mode) $ 			giveup "unable to break hard link" 		thawContent tmp@@ -81,26 +83,30 @@ 		modifyContentDir obj $ freezeContent obj 	next $ return True -makeHardLink :: RawFilePath -> Key -> CommandPerform+makeHardLink :: OsPath -> Key -> CommandPerform makeHardLink file key = do-	replaceWorkTreeFile (fromRawFilePath file) $ \tmp -> do-		mode <- liftIO $ catchMaybeIO $ fileMode <$> R.getFileStatus file+	replaceWorkTreeFile file $ \tmp -> do+		mode <- liftIO $ catchMaybeIO $ fileMode+			<$> R.getFileStatus (fromOsPath file) 		linkFromAnnex' key tmp mode >>= \case 			LinkAnnexFailed -> giveup "unable to make hard link" 			_ -> noop 	next $ return True -fixSymlink :: RawFilePath -> RawFilePath -> CommandPerform+fixSymlink :: OsPath -> OsPath -> CommandPerform fixSymlink file link = do #if ! defined(mingw32_HOST_OS) 	-- preserve mtime of symlink 	mtime <- liftIO $ catchMaybeIO $ Posix.modificationTimeHiRes-		<$> R.getSymbolicLinkStatus file+		<$> R.getSymbolicLinkStatus (fromOsPath file) #endif-	replaceWorkTreeFile (fromRawFilePath file) $ \tmpfile -> do-		liftIO $ R.createSymbolicLink link tmpfile+	replaceWorkTreeFile file $ \tmpfile -> do+		let tmpfile' = fromOsPath tmpfile+		liftIO $ R.createSymbolicLink link' tmpfile' #if ! defined(mingw32_HOST_OS)-		liftIO $ maybe noop (\t -> touch tmpfile t False) mtime+		liftIO $ maybe noop (\t -> touch tmpfile' t False) mtime #endif-	stageSymlink file =<< hashSymlink link+	stageSymlink file =<< hashSymlink link' 	next $ return True+  where+	link' = fromOsPath link
Command/FromKey.hs view
@@ -59,7 +59,7 @@ 		let (keyname, file) = separate (== ' ') s 		if not (null keyname) && not (null file) 			then do-				file' <- liftIO $ relPathCwdToFile (toRawFilePath file)+				file' <- liftIO $ relPathCwdToFile (toOsPath file) 				return $ Right (file', keyOpt keyname) 			else return $ 				Left "Expected pairs of key and filename"@@ -75,11 +75,10 @@ 		inbackend <- inAnnex key 		unless inbackend $ giveup $ 			"key ("++ keyname ++") is not present in backend (use --force to override this sanity check)"+	let file' = toOsPath file 	let ai = mkActionItem (key, file') 	starting "fromkey" ai si $ 		perform matcher key file'-  where-	file' = toRawFilePath file  -- From user input to a Key. -- User can input either a serialized key, or an url.@@ -99,9 +98,9 @@ 		Just k -> Right k 		Nothing -> Left $ "bad key/url " ++ s -perform :: AddUnlockedMatcher -> Key -> RawFilePath -> CommandPerform+perform :: AddUnlockedMatcher -> Key -> OsPath -> CommandPerform perform matcher key file = lookupKeyNotHidden file >>= \case-	Nothing -> ifM (liftIO $ doesFileExist (fromRawFilePath file))+	Nothing -> ifM (liftIO $ doesFileExist file) 		( hasothercontent 		, do 			contentpresent <- inAnnex key@@ -123,7 +122,7 @@ 						else writepointer 				, do 					link <- calcRepo $ gitAnnexLink file key-					addAnnexLink link file+					addAnnexLink (fromOsPath link) file 				) 			next $ return True 		)
Command/Fsck.hs view
@@ -45,13 +45,13 @@ import Types.CleanupActions import Types.Key import qualified Utility.RawFilePath as R+import qualified Utility.FileIO as F  import Data.Time.Clock.POSIX import System.Posix.Types (EpochTime) import qualified Data.Set as S import qualified Data.Map as M import Data.Either-import qualified System.FilePath.ByteString as P import System.PosixCompat.Files (fileMode, isSymbolicLink, modificationTime)  cmd :: Command@@ -122,8 +122,8 @@ 	whenM ((==) DeadTrusted <$> lookupTrust u) $ 		earlyWarning "Warning: Fscking a repository that is currently marked as dead." -start :: Maybe Remote -> Incremental -> SeekInput -> RawFilePath -> Key -> CommandStart-start from inc si file key = Backend.getBackend (fromRawFilePath file) key >>= \case+start :: Maybe Remote -> Incremental -> SeekInput -> OsPath -> Key -> CommandStart+start from inc si file key = Backend.getBackend file key >>= \case 	Nothing -> stop 	Just backend -> do 		(numcopies, _mincopies) <- getFileNumMinCopies file@@ -134,7 +134,7 @@ 	go = runFsck inc si (mkActionItem (key, afile)) key 	afile = AssociatedFile (Just file) -perform :: Key -> RawFilePath -> Backend -> NumCopies -> Annex Bool+perform :: Key -> OsPath -> Backend -> NumCopies -> Annex Bool perform key file backend numcopies = do 	keystatus <- getKeyFileStatus key file 	check@@ -193,11 +193,11 @@ 		pid <- liftIO getPID 		t <- fromRepo gitAnnexTmpObjectDir 		createAnnexDirectory t-		let tmp = t P.</> "fsck" <> toRawFilePath (show pid) <> "." <> keyFile key-		let cleanup = liftIO $ catchIO (R.removeLink tmp) (const noop)+		let tmp = t </> literalOsPath "fsck" <> toOsPath (show pid) <> literalOsPath "." <> keyFile key+		let cleanup = liftIO $ catchIO (removeFile tmp) (const noop) 		cleanup 		cleanup `after` a tmp-	getfile tmp = ifM (checkDiskSpace Nothing (Just (P.takeDirectory tmp)) key 0 True)+	getfile tmp = ifM (checkDiskSpace Nothing (Just (takeDirectory tmp)) key 0 True) 		( ifM (getcheap tmp) 			( return (Just (Right UnVerified)) 			, ifM (Annex.getRead Annex.fast)@@ -207,9 +207,9 @@ 			) 		, return Nothing 		)-	getfile' tmp = Remote.retrieveKeyFile remote key (AssociatedFile Nothing) (fromRawFilePath tmp) nullMeterUpdate (RemoteVerify remote)+	getfile' tmp = Remote.retrieveKeyFile remote key (AssociatedFile Nothing) tmp nullMeterUpdate (RemoteVerify remote) 	getcheap tmp = case Remote.retrieveKeyFileCheap remote of-		Just a -> isRight <$> tryNonAsync (a key afile (fromRawFilePath tmp))+		Just a -> isRight <$> tryNonAsync (a key afile tmp) 		Nothing -> return False  startKey :: Maybe Remote -> Incremental -> (SeekInput, Key, ActionItem) -> NumCopies -> CommandStart@@ -235,10 +235,10 @@ check cs = and <$> sequence cs  {- Checks that symlinks points correctly to the annexed content. -}-fixLink :: Key -> RawFilePath -> Annex Bool+fixLink :: Key -> OsPath -> Annex Bool fixLink key file = do 	want <- calcRepo $ gitAnnexLink file key-	have <- getAnnexLinkTarget file+	have <- fmap toOsPath <$> getAnnexLinkTarget file 	maybe noop (go want) have 	return True   where@@ -246,8 +246,8 @@ 		| want /= fromInternalGitPath have = do 			showNote "fixing link" 			createWorkTreeDirectory (parentDir file)-			liftIO $ R.removeLink file-			addAnnexLink want file+			liftIO $ removeFile file+			addAnnexLink (fromOsPath want) file 		| otherwise = noop  {- A repository that supports symlinks and is not bare may have in the past@@ -271,7 +271,7 @@ 	idealloc <- calcRepo (gitAnnexLocation' (const (pure True)) key) 	if loc == idealloc 		then return True-		else ifM (liftIO $ R.doesPathExist loc)+		else ifM (liftIO $ doesPathExist loc) 			( moveobjdir loc idealloc 				`catchNonAsync` \_e -> return True 			, return True@@ -290,14 +290,12 @@ 			-- Thaw the content directory to allow renaming it. 			thawContentDir src 			createAnnexDirectory (parentDir destdir)-			liftIO $ renameDirectory-				(fromRawFilePath srcdir)-				(fromRawFilePath destdir)+			liftIO $ renameDirectory srcdir destdir 			-- Since the directory was moved, lockContentForRemoval 			-- will not be able to remove the lock file it 			-- made. So, remove the lock file here. 			mlockfile <- contentLockFile key =<< getVersion-			liftIO $ maybe noop (removeWhenExistsWith R.removeLink) mlockfile+			liftIO $ maybe noop (removeWhenExistsWith removeFile) mlockfile 			freezeContentDir dest 			cleanObjectDirs src 			return True@@ -309,7 +307,7 @@ verifyLocationLog key keystatus ai = do 	obj <- calcRepo (gitAnnexLocation key) 	present <- if isKeyUnlockedThin keystatus-		then liftIO (doesFileExist (fromRawFilePath obj))+		then liftIO (doesFileExist obj) 		else inAnnex key 	u <- getUUID 	@@ -323,7 +321,7 @@ 		checkContentWritePerm obj >>= \case 			Nothing -> warning $ "** Unable to set correct write mode for " <> QuotedPath obj <> " ; perhaps you don't own that file, or perhaps it has an xattr or ACL set" 			_ -> return ()-	whenM (liftIO $ R.doesPathExist $ parentDir obj) $+	whenM (liftIO $ doesDirectoryExist $ parentDir obj) $ 		freezeContentDir obj  	{- Warn when annex.securehashesonly is set and content using an @@ -400,7 +398,7 @@ verifyRequiredContent _ _ = return True  {- Verifies the associated file records. -}-verifyAssociatedFiles :: Key -> KeyStatus -> RawFilePath -> Annex Bool+verifyAssociatedFiles :: Key -> KeyStatus -> OsPath -> Annex Bool verifyAssociatedFiles key keystatus file = do 	when (isKeyUnlockedThin keystatus) $ do 		f <- inRepo $ toTopFilePath file@@ -409,7 +407,7 @@ 			Database.Keys.addAssociatedFile key f 	return True -verifyWorkTree :: Key -> RawFilePath -> Annex Bool+verifyWorkTree :: Key -> OsPath -> Annex Bool verifyWorkTree key file = do 	{- Make sure that a pointer file is replaced with its content, 	 - when the content is available. -}@@ -417,8 +415,10 @@ 	case mk of 		Just k | k == key -> whenM (inAnnex key) $ do 			showNote "fixing worktree content"-			replaceWorkTreeFile (fromRawFilePath file) $ \tmp -> do-				mode <- liftIO $ catchMaybeIO $ fileMode <$> R.getFileStatus file+			replaceWorkTreeFile file $ \tmp -> do+				mode <- liftIO $ catchMaybeIO $+					fileMode <$> R.getFileStatus+						(fromOsPath file) 				ifM (annexThin <$> Annex.getGitConfig) 					( void $ linkFromAnnex' key tmp mode 					, do@@ -439,20 +439,20 @@ checkKeySize _ KeyUnlockedThin _ = return True checkKeySize key _ ai = do 	file <- calcRepo $ gitAnnexLocation key-	ifM (liftIO $ R.doesPathExist file)+	ifM (liftIO $ doesPathExist file) 		( checkKeySizeOr badContent key file ai 		, return True 		) -withLocalCopy :: Maybe RawFilePath -> (RawFilePath -> Annex Bool) -> Annex Bool+withLocalCopy :: Maybe OsPath -> (OsPath -> Annex Bool) -> Annex Bool withLocalCopy Nothing _ = return True withLocalCopy (Just localcopy) f = f localcopy -checkKeySizeRemote :: Key -> Remote -> ActionItem -> RawFilePath -> Annex Bool+checkKeySizeRemote :: Key -> Remote -> ActionItem -> OsPath -> Annex Bool checkKeySizeRemote key remote ai localcopy = 	checkKeySizeOr (badContentRemote remote localcopy) key localcopy ai -checkKeySizeOr :: (Key -> Annex String) -> Key -> RawFilePath -> ActionItem -> Annex Bool+checkKeySizeOr :: (Key -> Annex String) -> Key -> OsPath -> ActionItem -> Annex Bool checkKeySizeOr bad key file ai = case fromKey keySize key of 	Nothing -> return True 	Just size -> do@@ -504,7 +504,7 @@ checkBackend :: Key -> KeyStatus -> AssociatedFile -> Annex Bool checkBackend key keystatus afile = do 	content <- calcRepo (gitAnnexLocation key)-	ifM (liftIO $ R.doesPathExist content)+	ifM (liftIO $ doesPathExist content) 		( ifM (pure (isKeyUnlockedThin keystatus) <&&> (not <$> isUnmodified key content)) 			( nocheck 			, do@@ -523,11 +523,11 @@  	ai = mkActionItem (key, afile) -checkBackendRemote :: Key -> Remote -> ActionItem -> RawFilePath -> Annex Bool+checkBackendRemote :: Key -> Remote -> ActionItem -> OsPath -> Annex Bool checkBackendRemote key remote ai localcopy = 	checkBackendOr (badContentRemote remote localcopy) key localcopy ai -checkBackendOr :: (Key -> Annex String) -> Key -> RawFilePath -> ActionItem -> Annex Bool+checkBackendOr :: (Key -> Annex String) -> Key -> OsPath -> ActionItem -> Annex Bool checkBackendOr bad key file ai = 	ifM (Annex.getRead Annex.fast) 		( return True@@ -551,7 +551,7 @@  - verified to be correct. The InodeCache is generated again to detect if  - the object file was changed while the content was being verified.  -}-checkInodeCache :: Key -> RawFilePath -> Maybe InodeCache -> ActionItem -> Annex ()+checkInodeCache :: Key -> OsPath -> Maybe InodeCache -> ActionItem -> Annex () checkInodeCache key content mic ai = case mic of 	Nothing -> noop 	Just ic -> do@@ -568,7 +568,7 @@ checkKeyNumCopies :: Key -> AssociatedFile -> NumCopies -> Annex Bool checkKeyNumCopies key afile numcopies = do 	let (desc, hasafile) = case afile of-		AssociatedFile Nothing -> (serializeKey' key, False)+		AssociatedFile Nothing -> (toOsPath (serializeKey'' key), False) 		AssociatedFile (Just af) -> (af, True) 	locs <- loggedLocations key 	(untrustedlocations, otherlocations) <- trustPartition UnTrusted locs@@ -589,7 +589,7 @@ 			) 		else return True -missingNote :: RawFilePath -> Int -> NumCopies -> String -> String -> StringContainingQuotedPath+missingNote :: OsPath -> Int -> NumCopies -> String -> String -> StringContainingQuotedPath missingNote file 0 _ [] dead =  		"** No known copies exist of " <> QuotedPath file <> UnquotedString (honorDead dead) missingNote file 0 _ untrusted dead =@@ -614,25 +614,24 @@ badContent :: Key -> Annex String badContent key = do 	dest <- moveBad key-	return $ "moved to " ++ fromRawFilePath dest+	return $ "moved to " ++ fromOsPath dest  {- Bad content is dropped from the remote. We have downloaded a copy  - from the remote to a temp file already (in some cases, it's just a  - symlink to a file in the remote). To avoid any further data loss,  - that temp file is moved to the bad content directory unless   - the local annex has a copy of the content. -}-badContentRemote :: Remote -> RawFilePath -> Key -> Annex String+badContentRemote :: Remote -> OsPath -> Key -> Annex String badContentRemote remote localcopy key = do 	bad <- fromRepo gitAnnexBadDir-	let destbad = bad P.</> keyFile key-	let destbad' = fromRawFilePath destbad-	movedbad <- ifM (inAnnex key <||> liftIO (doesFileExist destbad'))+	let destbad = bad </> keyFile key+	movedbad <- ifM (inAnnex key <||> liftIO (doesFileExist destbad)) 		( return False 		, do 			createAnnexDirectory (parentDir destbad) 			liftIO $ catchDefaultIO False $-				ifM (isSymbolicLink <$> R.getSymbolicLinkStatus localcopy)-					( copyFileExternal CopyTimeStamps (fromRawFilePath localcopy) destbad'+				ifM (isSymbolicLink <$> R.getSymbolicLinkStatus (fromOsPath localcopy))+					( copyFileExternal CopyTimeStamps localcopy destbad 					, do 						moveFile localcopy destbad 						return True@@ -644,7 +643,7 @@ 		Remote.logStatus NoLiveUpdate remote key InfoMissing 	return $ case (movedbad, dropped) of 		(True, Right ()) -> "moved from " ++ Remote.name remote ++-			" to " ++ fromRawFilePath destbad+			" to " ++ fromOsPath destbad 		(False, Right ()) -> "dropped from " ++ Remote.name remote 		(_, Left e) -> "failed to drop from" ++ Remote.name remote ++ ": " ++ show e @@ -677,10 +676,10 @@ recordStartTime u = do 	f <- fromRepo (gitAnnexFsckState u) 	createAnnexDirectory $ parentDir f-	liftIO $ removeWhenExistsWith R.removeLink f-	liftIO $ withFile (fromRawFilePath f) WriteMode $ \h -> do+	liftIO $ removeWhenExistsWith removeFile f+	liftIO $ F.withFile f WriteMode $ \h -> do #ifndef mingw32_HOST_OS-		t <- modificationTime <$> R.getFileStatus f+		t <- modificationTime <$> R.getFileStatus (fromOsPath f) #else 		t <- getPOSIXTime #endif@@ -691,7 +690,7 @@ 	showTime = show  resetStartTime :: UUID -> Annex ()-resetStartTime u = liftIO . removeWhenExistsWith R.removeLink+resetStartTime u = liftIO . removeWhenExistsWith removeFile 	=<< fromRepo (gitAnnexFsckState u)  {- Gets the incremental fsck start time. -}@@ -699,9 +698,9 @@ getStartTime u = do 	f <- fromRepo (gitAnnexFsckState u) 	liftIO $ catchDefaultIO Nothing $ do-		timestamp <- modificationTime <$> R.getFileStatus f+		timestamp <- modificationTime <$> R.getFileStatus (fromOsPath f) 		let fromstatus = Just (realToFrac timestamp)-		fromfile <- parsePOSIXTime <$> readFile (fromRawFilePath f)+		fromfile <- parsePOSIXTime <$> F.readFile' f 		return $ if matchingtimestamp fromfile fromstatus 			then Just timestamp 			else Nothing@@ -714,13 +713,12 @@ #endif  data Incremental-	= NonIncremental+	= NonIncremental (Maybe FsckDb.FsckHandle) 	| ScheduleIncremental Duration UUID Incremental 	| StartIncremental FsckDb.FsckHandle  	| ContIncremental FsckDb.FsckHandle  prepIncremental :: UUID -> Maybe IncrementalOpt -> Annex Incremental-prepIncremental _ Nothing = pure NonIncremental prepIncremental u (Just StartIncrementalO) = do 	recordStartTime u 	ifM (FsckDb.newPass u)@@ -735,6 +733,14 @@ 		Nothing -> StartIncrementalO 		Just _ -> MoreIncrementalO 	return (ScheduleIncremental delta u i)+prepIncremental u Nothing =+	ifM (Annex.getRead Annex.fast)+		-- Avoid recording fscked files in --fast mode,+		-- since that can interfere with a non-fast incremental+		-- fsck.+		( pure (NonIncremental Nothing)+		, (NonIncremental . Just) <$> openFsckDb u+		)  cleanupIncremental :: Incremental -> Annex () cleanupIncremental (ScheduleIncremental delta u i) = do@@ -758,6 +764,6 @@ withFsckDb :: Incremental -> (FsckDb.FsckHandle -> Annex ()) -> Annex () withFsckDb (ContIncremental h) a = a h withFsckDb (StartIncremental h) a = a h-withFsckDb NonIncremental _ = noop+withFsckDb (NonIncremental mh) a = maybe noop a mh withFsckDb (ScheduleIncremental _ _ i) a = withFsckDb i a
Command/FuzzTest.hs view
@@ -123,13 +123,14 @@ 	toFilePath (FuzzDir d) = d  isFuzzFile :: FilePath -> Bool-isFuzzFile f = "fuzzfile_" `isPrefixOf` takeFileName f+isFuzzFile f = "fuzzfile_" `isPrefixOf` fromOsPath (takeFileName (toOsPath f))  isFuzzDir :: FilePath -> Bool isFuzzDir d = "fuzzdir_" `isPrefixOf` d  mkFuzzFile :: FilePath -> [FuzzDir] -> FuzzFile-mkFuzzFile file dirs = FuzzFile $ joinPath (map toFilePath dirs) </> ("fuzzfile_" ++ file)+mkFuzzFile file dirs = FuzzFile $ fromOsPath $ +	joinPath (map (toOsPath . toFilePath) dirs) </> toOsPath ("fuzzfile_" ++ file)  mkFuzzDir :: Int -> FuzzDir mkFuzzDir n = FuzzDir $ "fuzzdir_" ++ show n@@ -175,15 +176,15 @@  runFuzzAction :: FuzzAction -> Annex () runFuzzAction (FuzzAdd (FuzzFile f)) = do-	createWorkTreeDirectory (parentDir (toRawFilePath f))+	createWorkTreeDirectory (parentDir (toOsPath f)) 	n <- liftIO (getStdRandom random :: IO Int) 	liftIO $ writeFile f $ show n ++ "\n" runFuzzAction (FuzzDelete (FuzzFile f)) = liftIO $-	removeWhenExistsWith R.removeLink (toRawFilePath f)+	removeWhenExistsWith removeFile (toOsPath f) runFuzzAction (FuzzMove (FuzzFile src) (FuzzFile dest)) = liftIO $ 	R.rename (toRawFilePath src) (toRawFilePath dest) runFuzzAction (FuzzDeleteDir (FuzzDir d)) = liftIO $-	removeDirectoryRecursive d+	removeDirectoryRecursive (toOsPath d) runFuzzAction (FuzzMoveDir (FuzzDir src) (FuzzDir dest)) = liftIO $ 	R.rename (toRawFilePath src) (toRawFilePath dest) runFuzzAction (FuzzPause d) = randomDelay d@@ -210,7 +211,7 @@ 			case md of 				Nothing -> genFuzzAction 				Just d -> do-					newd <- liftIO $ newDir (parentDir $ toRawFilePath $ toFilePath d)+					newd <- liftIO $ newDir (parentDir $ toOsPath $ toFilePath d) 					maybe genFuzzAction (return . FuzzMoveDir d) newd 		FuzzDeleteDir _ -> do 			d <- liftIO existingDir@@ -221,7 +222,8 @@ existingFile 0 _ = return Nothing existingFile n top = do 	dir <- existingDirIncludingTop-	contents <- catchDefaultIO [] (getDirectoryContents dir)+	contents <- map fromOsPath +		<$> catchDefaultIO [] (getDirectoryContents (toOsPath dir)) 	let files = filter isFuzzFile contents 	if null files 		then do@@ -230,19 +232,21 @@ 				then return Nothing 				else do 					i <- getStdRandom $ randomR (0, length dirs - 1)-					existingFile (n - 1) (top </> dirs !! i)+					existingFile (n - 1) (fromOsPath (toOsPath top </> toOsPath (dirs !! i))) 		else do 			i <- getStdRandom $ randomR (0, length files - 1)-			return $ Just $ FuzzFile $ top </> dir </> files !! i+			return $ Just $ FuzzFile $ fromOsPath $ +				toOsPath top </> toOsPath dir </> toOsPath (files !! i)  existingDirIncludingTop :: IO FilePath existingDirIncludingTop = do-	dirs <- filter isFuzzDir <$> getDirectoryContents "."+	dirs <- filter (isFuzzDir . fromOsPath) +		<$> getDirectoryContents (literalOsPath ".") 	if null dirs 		then return "." 		else do 			n <- getStdRandom $ randomR (0, length dirs)-			return $ ("." : dirs) !! n+			return $ fromOsPath $ (literalOsPath "." : dirs) !! n  existingDir :: IO (Maybe FuzzDir) existingDir = do@@ -257,21 +261,21 @@ 	go 0 = return Nothing 	go n = do 		f <- genFuzzFile-		ifM (doesnotexist (toFilePath f))+		ifM (doesnotexist (toOsPath (toFilePath f))) 			( return $ Just f 			, go (n - 1) 			) -newDir :: RawFilePath -> IO (Maybe FuzzDir)+newDir :: OsPath -> IO (Maybe FuzzDir) newDir parent = go (100 :: Int)   where 	go 0 = return Nothing 	go n = do 		(FuzzDir d) <- genFuzzDir-		ifM (doesnotexist (fromRawFilePath parent </> d))+		ifM (doesnotexist (parent </> toOsPath d)) 			( return $ Just $ FuzzDir d 			, go (n - 1) 			) -doesnotexist :: FilePath -> IO Bool-doesnotexist f = isNothing <$> catchMaybeIO (R.getSymbolicLinkStatus (toRawFilePath f))+doesnotexist :: OsPath -> IO Bool+doesnotexist f = isNothing <$> catchMaybeIO (R.getSymbolicLinkStatus (fromOsPath f))
Command/Get.hs view
@@ -55,7 +55,7 @@   where 	ww = WarnUnmatchLsFiles "get" -start :: GetOptions -> Maybe Remote -> SeekInput -> RawFilePath -> Key -> CommandStart+start :: GetOptions -> Maybe Remote -> SeekInput -> OsPath -> Key -> CommandStart start o from si file key = do 	lu <- prepareLiveUpdate Nothing key AddingKey 	start' lu (expensivecheck lu) from key afile ai si
Command/Import.hs view
@@ -129,7 +129,7 @@ seek o@(LocalImportOptions {}) = startConcurrency commandStages $ do 	repopath <- liftIO . absPath =<< fromRepo Git.repoPath 	inrepops <- liftIO $ filter (dirContains repopath)-		<$> mapM (absPath . toRawFilePath) (importFiles o)+		<$> mapM (absPath . toOsPath) (importFiles o) 	unless (null inrepops) $ do 		qp <- coreQuotePath <$> Annex.getGitConfig 		giveup $ decodeBS $ quote qp $ @@ -145,7 +145,7 @@ 		giveup "That remote does not support imports." 	subdir <- maybe 		(pure Nothing)-		(Just <$$> inRepo . toTopFilePath . toRawFilePath)+		(Just <$$> inRepo . toTopFilePath . toOsPath) 		(importToSubDir o) 	addunlockedmatcher <- addUnlockedMatcher 	seekRemote r (importToBranch o) subdir (importContent o) @@ -153,9 +153,9 @@ 		addunlockedmatcher 		(messageOption o) -startLocal :: ImportOptions -> AddUnlockedMatcher -> GetFileMatcher -> DuplicateMode -> (RawFilePath, RawFilePath) -> CommandStart+startLocal :: ImportOptions -> AddUnlockedMatcher -> GetFileMatcher -> DuplicateMode -> (OsPath, OsPath) -> CommandStart startLocal o addunlockedmatcher largematcher mode (srcfile, destfile) =-	ifM (liftIO $ isRegularFile <$> R.getSymbolicLinkStatus srcfile)+	ifM (liftIO $ isRegularFile <$> R.getSymbolicLinkStatus (fromOsPath srcfile)) 		( starting "import" ai si pickaction 		, stop 		)@@ -167,7 +167,7 @@ 		showNote $ UnquotedString $ "duplicate of " ++ serializeKey k 		verifyExisting k destfile 			( do-				liftIO $ R.removeLink srcfile+				liftIO $ removeFile srcfile 				next $ return True 			, do 				warning "Could not verify that the content is still present in the annex; not removing from the import location."@@ -183,26 +183,26 @@ 				warning $ "not importing " <> QuotedPath destfile <> " which is .gitignored (use --no-check-gitignore to override)" 				stop 			else do-				existing <- liftIO (catchMaybeIO $ R.getSymbolicLinkStatus destfile)+				existing <- liftIO (catchMaybeIO $ R.getSymbolicLinkStatus (fromOsPath destfile)) 				case existing of 					Nothing -> importfilechecked ld k 					Just s 						| isDirectory s -> notoverwriting "(is a directory)" 						| isSymbolicLink s -> ifM (Annex.getRead Annex.force) 							( do-								liftIO $ removeWhenExistsWith R.removeLink destfile+								liftIO $ removeWhenExistsWith removeFile destfile 								importfilechecked ld k 							, notoverwriting "(is a symlink)" 							) 						| otherwise -> ifM (Annex.getRead Annex.force) 							( do-								liftIO $ removeWhenExistsWith R.removeLink destfile+								liftIO $ removeWhenExistsWith removeFile destfile 								importfilechecked ld k 							, notoverwriting "(use --force to override, or a duplication option such as --deduplicate to clean up)" 							) 	checkdestdir cont = do 		let destdir = parentDir destfile-		existing <- liftIO (catchMaybeIO $ R.getSymbolicLinkStatus destdir)+		existing <- liftIO (catchMaybeIO $ R.getSymbolicLinkStatus (fromOsPath destdir)) 		case existing of 			Nothing -> cont 			Just s@@ -217,10 +217,8 @@ 		createWorkTreeDirectory (parentDir destfile) 		unwind <- liftIO $ if mode == Duplicate || mode == SkipDuplicates 			then do-				void $ copyFileExternal CopyAllMetaData -					(fromRawFilePath srcfile)-					(fromRawFilePath destfile)-				return $ removeWhenExistsWith R.removeLink destfile+				void $ copyFileExternal CopyAllMetaData srcfile destfile+				return $ removeWhenExistsWith removeFile destfile 			else do 				moveFile srcfile destfile 				return $ moveFile destfile srcfile@@ -241,7 +239,7 @@ 		-- weakly the same as the originally locked down file's 		-- inode cache. (Since the file may have been copied, 		-- its inodes may not be the same.)-		s <- liftIO $ R.getSymbolicLinkStatus destfile+		s <- liftIO $ R.getSymbolicLinkStatus (fromOsPath destfile) 		newcache <- withTSDelta $ \d -> liftIO $ toInodeCache d destfile s 		let unchanged = case (newcache, inodeCache (keySource ld)) of 			(_, Nothing) -> True@@ -287,7 +285,7 @@ 			-- the file gets copied into the repository. 			, checkWritePerms = False 			}-		v <- lockDown cfg (fromRawFilePath srcfile)+		v <- lockDown cfg srcfile 		case v of 			Just ld -> do 				backend <- chooseBackend destfile@@ -314,7 +312,7 @@ 		showNote (s <> "; skipping") 		next (return True) -verifyExisting :: Key -> RawFilePath -> (CommandPerform, CommandPerform) -> CommandPerform+verifyExisting :: Key -> OsPath -> (CommandPerform, CommandPerform) -> CommandPerform verifyExisting key destfile (yes, no) = do 	-- Look up the numcopies setting for the file that it would be 	-- imported to, if it were imported.
Command/ImportFeed.hs view
@@ -24,7 +24,6 @@ import Control.Concurrent.STM import qualified Data.Text as T import qualified Data.Text.Encoding as TE-import qualified System.FilePath.ByteString as P import qualified Data.ByteString as B  import Command@@ -158,10 +157,11 @@ 		| scrapeOption o = scrape 		| otherwise = get -	get = withTmpFile "feed" $ \tmpf h -> do+	get = withTmpFile (literalOsPath "feed") $ \tmpf h -> do+		let tmpf' = fromRawFilePath $ fromOsPath tmpf 		liftIO $ hClose h-		ifM (downloadFeed url tmpf)-			( parse tmpf+		ifM (downloadFeed url tmpf')+			( parse tmpf' 			, do 				recordfail 				next $ feedProblem url@@ -269,7 +269,7 @@ downloadFeed url f 	| Url.parseURIRelaxed url == Nothing = giveup "invalid feed url" 	| otherwise = Url.withUrlOptions $-		Url.download nullMeterUpdate Nothing url f+		Url.download nullMeterUpdate Nothing url (toOsPath f)  startDownload :: AddUnlockedMatcher -> ImportFeedOptions -> Cache -> TMVar Bool -> ToDownload -> CommandStart startDownload addunlockedmatcher opts cache cv todownload = case location todownload of@@ -314,15 +314,15 @@ 		ifM (useYoutubeDl (downloadOptions opts) <&&> youtubeDlSupported linkurl) 			( startUrlDownload cv todownload linkurl $ 				withTmpWorkDir mediakey $ \workdir -> do-					dl <- youtubeDl linkurl (fromRawFilePath workdir) nullMeterUpdate+					dl <- youtubeDl linkurl workdir nullMeterUpdate 					case dl of 						Right (Just mediafile) -> do-							let ext = case takeExtension mediafile of+							let ext = case fromOsPath (takeExtension mediafile) of 								[] -> ".m" 								s -> s 							runDownload todownload linkurl ext cache cv $ \f -> 								checkCanAdd (downloadOptions opts) f $ \canadd -> do-									addWorkTree canadd addunlockedmatcher webUUID mediaurl f mediakey (Just (toRawFilePath mediafile))+									addWorkTree canadd addunlockedmatcher webUUID mediaurl f mediakey (Just mediafile) 									return (Just [mediakey]) 						-- youtube-dl didn't support it, so 						-- download it as if the link were@@ -351,16 +351,16 @@ 			)  downloadEnclosure :: AddUnlockedMatcher -> ImportFeedOptions -> Cache -> TMVar Bool -> ToDownload -> URLString -> CommandPerform-downloadEnclosure addunlockedmatcher opts cache cv todownload url = -	runDownload todownload url (takeWhile (/= '?') $ takeExtension url) cache cv $ \f -> do-		let f' = fromRawFilePath f+downloadEnclosure addunlockedmatcher opts cache cv todownload url =+	let extension = takeWhile (/= '?') $ fromOsPath $ takeExtension $ toOsPath url+	in runDownload todownload url extension cache cv $ \f -> do 		r <- checkClaimingUrl (downloadOptions opts) url 		if Remote.uuid r == webUUID || rawOption (downloadOptions opts) 			then checkRaw (Just url) (downloadOptions opts) (pure Nothing) $ do 				let dlopts = (downloadOptions opts) 					-- force using the filename 					-- chosen here-					{ fileOption = Just f'+					{ fileOption = Just (fromOsPath f) 					-- don't use youtube-dl 					, rawOption = True 					}@@ -384,7 +384,7 @@ 							downloadRemoteFile addunlockedmatcher r (downloadOptions opts) url f sz 					Right (UrlMulti l) -> do 						kl <- forM l $ \(url', sz, subf) ->-							let dest = f P.</> toRawFilePath (sanitizeFilePath subf)+							let dest = f </> toOsPath (sanitizeFilePath (fromOsPath subf)) 							in downloadRemoteFile addunlockedmatcher r (downloadOptions opts) url' dest sz 						return $ Just $ if all isJust kl 							then catMaybes kl@@ -396,7 +396,7 @@ 	-> String 	-> Cache 	-> TMVar Bool-	-> (RawFilePath -> Annex (Maybe [Key]))+	-> (OsPath -> Annex (Maybe [Key])) 	-> CommandPerform runDownload todownload url extension cache cv getter = do 	dest <- makeunique (1 :: Integer) $@@ -405,7 +405,7 @@ 		Nothing -> do 			recordsuccess 			next $ return True-		Just f -> getter (toRawFilePath f) >>= \case+		Just f -> getter f >>= \case 			Just ks 				-- Download problem. 				| null ks -> do@@ -439,7 +439,7 @@ 	 - to be re-downloaded. -} 	makeunique n file = ifM alreadyexists 		( ifM forced-			( lookupKey (toRawFilePath f) >>= \case+			( lookupKey f >>= \case 				Just k -> checksameurl k 				Nothing -> tryanother 			, tryanother@@ -448,12 +448,12 @@ 		) 	  where 		f = if n < 2-			then file+			then toOsPath file 			else-				let (d, base) = splitFileName file-				in d </> show n ++ "_" ++ base+				let (d, base) = splitFileName (toOsPath file)+				in d </> toOsPath (show n ++ "_") <> base 		tryanother = makeunique (n + 1) file-		alreadyexists = liftIO $ isJust <$> catchMaybeIO (R.getSymbolicLinkStatus (toRawFilePath f))+		alreadyexists = liftIO $ isJust <$> catchMaybeIO (R.getSymbolicLinkStatus (fromOsPath f)) 		checksameurl k = ifM (elem url . map fst . map getDownloader <$> getUrls k) 			( return Nothing 			, tryanother@@ -608,10 +608,10 @@  - least 23 hours. -} checkFeedBroken :: URLString -> Annex Bool checkFeedBroken url = checkFeedBroken' url =<< feedState url-checkFeedBroken' :: URLString -> RawFilePath -> Annex Bool+checkFeedBroken' :: URLString -> OsPath -> Annex Bool checkFeedBroken' url f = do 	prev <- maybe Nothing readish-		<$> liftIO (catchMaybeIO $ readFile (fromRawFilePath f))+		<$> liftIO (catchMaybeIO $ readFile (fromOsPath f)) 	now <- liftIO getCurrentTime 	case prev of 		Nothing -> do@@ -627,10 +627,9 @@  clearFeedProblem :: URLString -> Annex () clearFeedProblem url =-	void $ liftIO . tryIO . removeFile . fromRawFilePath-		=<< feedState url+	void $ liftIO . tryIO . removeFile =<< feedState url -feedState :: URLString -> Annex RawFilePath+feedState :: URLString -> Annex OsPath feedState url = fromRepo $ gitAnnexFeedState $ fromUrl url Nothing False  {- The feed library parses the feed to Text, and does not use the
Command/Info.hs view
@@ -14,7 +14,7 @@ import qualified Data.Map.Strict as M import qualified Data.Set as S import qualified Data.Vector as V-import qualified System.FilePath.ByteString as P+import Data.ByteString.Short (fromShort) import System.PosixCompat.Files (isDirectory) import Data.Ord import qualified Data.Semigroup as Sem@@ -188,9 +188,9 @@ 		Right r -> remoteInfo o r si 		Left _ -> Remote.nameToUUID' p >>= \case 			([], _) -> do-				relp <- liftIO $ relPathCwdToFile (toRawFilePath p)+				relp <- liftIO $ relPathCwdToFile (toOsPath p) 				lookupKey relp >>= \case-					Just k -> fileInfo o (fromRawFilePath relp) si k+					Just k -> fileInfo o (fromOsPath relp) si k 					Nothing -> treeishInfo o p si 			([u], _) -> uuidInfo o u si 			(_us, msg) -> noInfo p si msg@@ -203,7 +203,7 @@ 	-- The string may not really be a file, but use ActionItemTreeFile, 	-- rather than ActionItemOther to avoid breaking back-compat of 	-- json output.-	let ai = ActionItemTreeFile (toRawFilePath s)+	let ai = ActionItemTreeFile (toOsPath s) 	showStartMessage (StartMessage "info" ai si) 	showNote (UnquotedString msg) 	showEndFail@@ -237,7 +237,7 @@ fileInfo :: InfoOptions -> FilePath -> SeekInput -> Key -> Annex () fileInfo o file si k = do 	matcher <- Limit.getMatcher-	let file' = toRawFilePath file+	let file' = toOsPath file 	whenM (matcher $ MatchingFile $ FileInfo file' file' (Just k)) $ 		showCustom (unwords ["info", file]) si $ do 			evalStateT (mapM_ showStat (file_stats file k)) (emptyStatInfo o)@@ -502,17 +502,17 @@   where 	desc = "transfers in progress" 	line qp uuidmap t i = unwords-		[ fromRawFilePath (formatDirection (transferDirection t)) ++ "ing"-		, fromRawFilePath $ quote qp $ actionItemDesc $ mkActionItem+		[ decodeBS $ fromShort (formatDirection (transferDirection t)) <> "ing"+		, decodeBS $ quote qp $ actionItemDesc $ mkActionItem 			(transferKey t, associatedFile i) 		, if transferDirection t == Upload then "to" else "from" 		, maybe (fromUUID $ transferUUID t) Remote.name $ 			M.lookup (transferUUID t) uuidmap 		] 	jsonify t i = object $ map (\(k, v) -> (textKey (packString k), v)) $-		[ ("transfer", toJSON' (formatDirection (transferDirection t)))+		[ ("transfer", toJSON' (fromShort (formatDirection (transferDirection t)))) 		, ("key", toJSON' (transferKey t))-		, ("file", toJSON' (fromRawFilePath <$> afile))+		, ("file", toJSON' ((fromOsPath <$> afile) :: Maybe FilePath)) 		, ("remote", toJSON' (fromUUID (transferUUID t) :: String)) 		] 	  where@@ -522,7 +522,7 @@ disk_size = simpleStat "available local disk space" $ 	calcfree 		<$> (lift $ annexDiskReserve <$> Annex.getGitConfig)-		<*> (lift $ inRepo $ getDiskFree . fromRawFilePath . gitAnnexDir)+		<*> (lift $ inRepo $ getDiskFree . fromOsPath . gitAnnexDir) 		<*> mkSizer   where 	calcfree reserve (Just have) sizer = unwords@@ -700,7 +700,7 @@ 	fast <- Annex.getRead Annex.fast 	matcher <- Limit.getMatcher 	(presentdata, referenceddata, numcopiesstats, repodata) <--		Command.Unused.withKeysFilesReferencedIn dir initial+		Command.Unused.withKeysFilesReferencedIn (toOsPath dir) initial 			(update matcher fast) 	return $ StatInfo 		(Just presentdata)@@ -797,7 +797,7 @@ 		M.fromList $ zip locs (map update locs) 	update loc = addKey key (fromMaybe emptyKeyInfo $ M.lookup loc m) -updateNumCopiesStats :: RawFilePath -> NumCopiesStats -> [UUID] -> Annex NumCopiesStats+updateNumCopiesStats :: OsPath -> NumCopiesStats -> [UUID] -> Annex NumCopiesStats updateNumCopiesStats file (NumCopiesStats m) locs = do 	have <- trustExclude UnTrusted locs 	!variance <- Variance <$> numCopiesCheck' file (-) have@@ -817,7 +817,7 @@ 			"+ " ++ show (unknownSizeKeys d) ++ 			" unknown size" -staleSize :: String -> (Git.Repo -> RawFilePath) -> Stat+staleSize :: String -> (Git.Repo -> OsPath) -> Stat staleSize label dirspec = go =<< lift (dirKeys dirspec)   where 	go [] = nostat@@ -830,7 +830,7 @@ 	keysizes keys = do 		dir <- lift $ fromRepo dirspec 		liftIO $ forM keys $ \k -> -			catchDefaultIO 0 $ getFileSize (dir P.</> keyFile k)+			catchDefaultIO 0 $ getFileSize (dir </> keyFile k)  aside :: String -> String aside s = " (" ++ s ++ ")"
Command/Inprogress.hs view
@@ -51,14 +51,17 @@   where 	ww = WarnUnmatchLsFiles "inprogress" -start :: IsTerminal -> S.Set Key -> SeekInput -> RawFilePath -> Key -> CommandStart+start :: IsTerminal -> S.Set Key -> SeekInput -> OsPath -> Key -> CommandStart start isterminal s _si _file k 	| S.member k s = start' isterminal k 	| otherwise = stop  start' :: IsTerminal -> Key -> CommandStart start' (IsTerminal isterminal) k = startingCustomOutput k $ do-	tmpf <- fromRawFilePath <$> fromRepo (gitAnnexTmpObjectLocation k)+	tmpf <- fromRepo (gitAnnexTmpObjectLocation k) 	whenM (liftIO $ doesFileExist tmpf) $-		liftIO $ putStrLn (if isterminal then safeOutput tmpf else tmpf)+		liftIO $ putStrLn $ +			if isterminal+				then safeOutput (fromOsPath tmpf)+				else fromOsPath tmpf 	next $ return True
Command/List.hs view
@@ -82,7 +82,7 @@ printHeader :: [(UUID, RemoteName, TrustLevel)] -> Annex () printHeader l = liftIO $ putStrLn $ safeOutput $ lheader $ map (\(_, n, t) -> (n, t)) l -start :: [(UUID, RemoteName, TrustLevel)] -> SeekInput -> RawFilePath -> Key -> CommandStart+start :: [(UUID, RemoteName, TrustLevel)] -> SeekInput -> OsPath -> Key -> CommandStart start l _si file key = do 	ls <- S.fromList <$> keyLocations key 	qp <- coreQuotePath <$> Annex.getGitConfig@@ -100,7 +100,7 @@ 	trust UnTrusted = " (untrusted)" 	trust _ = "" -format :: [(TrustLevel, Present)] -> RawFilePath -> StringContainingQuotedPath+format :: [(TrustLevel, Present)] -> OsPath -> StringContainingQuotedPath format remotes file = UnquotedString (thereMap) <> " " <> QuotedPath file   where  	thereMap = concatMap there remotes
Command/Lock.hs view
@@ -39,7 +39,7 @@ 		, usesLocationLog = False 		} -start :: SeekInput -> RawFilePath -> Key -> CommandStart+start :: SeekInput -> OsPath -> Key -> CommandStart start si file key = ifM (isJust <$> isAnnexLink file) 	( stop 	, starting "lock" (mkActionItem (key, file)) si $@@ -59,7 +59,7 @@ 			) 	cont = perform file key -perform :: RawFilePath -> Key -> CommandPerform+perform :: OsPath -> Key -> CommandPerform perform file key = do 	lockdown =<< calcRepo (gitAnnexLocation key) 	addSymlink file key =<< withTSDelta (liftIO . genInodeCache file)@@ -70,15 +70,17 @@ 			( breakhardlink obj 			, repopulate obj 			)-		whenM (liftIO $ R.doesPathExist obj) $+		whenM (liftIO $ doesFileExist obj) $ 			freezeContent obj +	getlinkcount obj = linkCount <$> liftIO (R.getFileStatus (fromOsPath obj))+ 	-- It's ok if the file is hard linked to obj, but if some other 	-- associated file is, we need to break that link to lock down obj.-	breakhardlink obj = whenM (catchBoolIO $ (> 1) . linkCount <$> liftIO (R.getFileStatus obj)) $ do+	breakhardlink obj = whenM (catchBoolIO $ (> 1) <$> getlinkcount obj) $ do 		mfc <- withTSDelta (liftIO . genInodeCache file) 		unlessM (sameInodeCache obj (maybeToList mfc)) $ do-			modifyContentDir obj $ replaceGitAnnexDirFile (fromRawFilePath obj) $ \tmp -> do+			modifyContentDir obj $ replaceGitAnnexDirFile obj $ \tmp -> do 				unlessM (checkedCopyFile key obj tmp Nothing) $ 					giveup "unable to lock file" 			Database.Keys.storeInodeCaches key [obj]@@ -89,7 +91,7 @@ 		fs <- map (`fromTopFilePath` g) 			<$> Database.Keys.getAssociatedFiles key 		mfile <- firstM (isUnmodified key) fs-		liftIO $ removeWhenExistsWith R.removeLink obj+		liftIO $ removeWhenExistsWith removeFile obj 		case mfile of 			Just unmodified -> 				ifM (checkedCopyFile key unmodified obj Nothing)
Command/Log.hs view
@@ -15,7 +15,6 @@ import Data.Time.Clock.POSIX import Data.Time import qualified Data.ByteString.Char8 as B8-import qualified System.FilePath.ByteString as P import Control.Concurrent.Async  import Command@@ -34,6 +33,7 @@ import Types.TrustLevel import Utility.DataUnits import Utility.HumanTime+import qualified Utility.FileIO as F  data LogChange = Added | Removed @@ -282,15 +282,15 @@ 	top <- fromRepo Git.repoPath 	p <- liftIO $ relPathCwdToFile top 	config <- Annex.getGitConfig-	let logfile = p P.</> locationLogFile config key-	getGitLogAnnex [fromRawFilePath logfile] (Param "--remove-empty" : os)+	let logfile = p </> locationLogFile config key+	getGitLogAnnex [logfile] (Param "--remove-empty" : os) -getGitLogAnnex :: [FilePath] -> [CommandParam] -> Annex ([LoggedFileChange Key], IO Bool)+getGitLogAnnex :: [OsPath] -> [CommandParam] -> Annex ([LoggedFileChange Key], IO Bool) getGitLogAnnex fs os = do 	config <- Annex.getGitConfig 	let fileselector = \_sha f ->-		locationLogFileKey config (toRawFilePath f)-	inRepo $ getGitLog Annex.Branch.fullname Nothing fs os fileselector+		locationLogFileKey config f+	inRepo $ getGitLog Annex.Branch.fullname Nothing (map fromOsPath fs) os fileselector  showTimeStamp :: TimeZone -> String -> POSIXTime -> String showTimeStamp zone format = formatTime defaultTimeLocale format@@ -320,11 +320,11 @@ 	-- and to the trust log. 	getlog = do 		config <- Annex.getGitConfig-		let fileselector = \_sha f -> let f' = toRawFilePath f in-			case locationLogFileKey config f' of+		let fileselector = \_sha f ->+			case locationLogFileKey config f of 				Just k -> Just (Right k) 				Nothing-					| f' == trustLog -> Just (Left ())+					| f == trustLog -> Just (Left ()) 					| otherwise -> Nothing 		inRepo $ getGitLog Annex.Branch.fullname Nothing [] 			[ Param "--date-order"@@ -409,10 +409,10 @@ 	displaystart uuidmap zone 		| gnuplotOption o = do 			file <- (</>)-				<$> fromRepo (fromRawFilePath . gitAnnexDir)-				<*> pure "gnuplot"-			liftIO $ putStrLn $ "Generating gnuplot script in " ++ file-			h <- liftIO $ openFile file WriteMode+				<$> fromRepo gitAnnexDir+				<*> pure (literalOsPath "gnuplot")+			liftIO $ putStrLn $ "Generating gnuplot script in " ++ fromOsPath file+			h <- liftIO $ F.openFile file WriteMode 			liftIO $ mapM_ (hPutStrLn h) 				[ "set datafile separator ','" 				, "set timefmt \"%Y-%m-%dT%H:%M:%S\""@@ -442,7 +442,7 @@ 				hFlush h 				putStrLn $ "Running gnuplot..." 				void $ liftIO $ boolSystem "gnuplot"-					[Param "-p", File file]+					[Param "-p", File (fromOsPath file)] 			return (dispst h endaction) 		| sizesOption o = do 			liftIO $ putStrLn uuidmapheader
Command/LookupKey.hs view
@@ -37,7 +37,7 @@ 	| refOption o = catKey (Ref (toRawFilePath file)) >>= display 	| otherwise = do 		checkNotBareRepo-		seekSingleGitFile file >>= \case+		seekSingleGitFile (toOsPath file) >>= \case 			Nothing -> return False 			Just file' -> catKeyFile file' >>= display @@ -51,13 +51,13 @@  -- To support absolute filenames, pass through git ls-files. -- But, this plumbing command does not recurse through directories.-seekSingleGitFile :: FilePath -> Annex (Maybe RawFilePath)+seekSingleGitFile :: OsPath -> Annex (Maybe OsPath) seekSingleGitFile file-	| isRelative file = return (Just (toRawFilePath file))+	| isRelative file = return (Just file) 	| otherwise = do-		(l, cleanup) <- inRepo (Git.LsFiles.inRepo [] [toRawFilePath file])+		(l, cleanup) <- inRepo (Git.LsFiles.inRepo [] [file]) 		r <- case l of-			(f:[]) | takeFileName (fromRawFilePath f) == takeFileName file ->+			(f:[]) | takeFileName f == takeFileName file -> 				return (Just f) 			_ -> return Nothing 		void $ liftIO cleanup
Command/Map.hs view
@@ -49,22 +49,22 @@ 	trustmap <- trustMapLoad 		 	file <- (</>)-		<$> fromRepo (fromRawFilePath . gitAnnexDir)-		<*> pure "map.dot"+		<$> fromRepo gitAnnexDir+		<*> pure (literalOsPath "map.dot") -	liftIO $ writeFile file (drawMap rs trustmap umap)+	liftIO $ writeFile (fromOsPath file) (drawMap rs trustmap umap) 	next $ 		ifM (Annex.getRead Annex.fast) 			( runViewer file [] 			, runViewer file-	 			[ ("xdot", [File file])-				, ("dot", [Param "-Tx11", File file])+	 			[ ("xdot", [File (fromOsPath file)])+				, ("dot", [Param "-Tx11", File (fromOsPath file)]) 				]	 			) -runViewer :: FilePath -> [(String, [CommandParam])] -> Annex Bool+runViewer :: OsPath -> [(String, [CommandParam])] -> Annex Bool runViewer file [] = do-	showLongNote $ UnquotedString $ "left map in " ++ file+	showLongNote $ UnquotedString $ "left map in " ++ fromOsPath file 	return True runViewer file ((c, ps):rest) = ifM (liftIO $ inSearchPath c) 	( do@@ -244,7 +244,7 @@ 	  where 		remotecmd = "sh -c " ++ shellEscape 			(cddir ++ " && " ++ "git config --null --list")-		dir = fromRawFilePath $ Git.repoPath r+		dir = fromOsPath $ Git.repoPath r 		cddir 			| "/~" `isPrefixOf` dir = 				let (userhome, reldir) = span (/= '/') (drop 1 dir)
Command/MatchExpression.hs view
@@ -39,7 +39,7 @@ 	<*> (MatchingUserInfo . addkeysize <$> dataparser)   where 	dataparser = UserProvidedInfo-		<$> optinfo "file" (strOption+		<$> optinfo "file" ((fmap stringToOsPath . strOption) 			( long "file" <> metavar paramFile 			<> help "specify filename to match against" 			))
Command/MetaData.hs view
@@ -99,7 +99,7 @@ 			) 		_ -> giveup "--batch is currently only supported in --json mode" -start :: CandidateVectorClock -> MetaDataOptions -> SeekInput -> RawFilePath -> Key -> CommandStart+start :: CandidateVectorClock -> MetaDataOptions -> SeekInput -> OsPath -> Key -> CommandStart start c o si file k = startKeys c o (si, k, mkActionItem (k, afile))   where 	afile = AssociatedFile (Just file)@@ -134,7 +134,7 @@ 	unwrapmeta (f, v) = (fromMetaField f, map fromMetaValue (S.toList v)) 	showmeta (f, vs) = map ((T.unpack f ++ "=") ++) (map decodeBS vs) -parseJSONInput :: String -> Annex (Either String (Either RawFilePath Key, MetaData))+parseJSONInput :: String -> Annex (Either String (Either OsPath Key, MetaData)) parseJSONInput i = case eitherDecode (BU.fromString i) of 	Left e -> return (Left e) 	Right v -> do@@ -145,12 +145,12 @@ 			(Just k, _) -> return $ 				Right (Right k, m) 			(Nothing, Just f) -> do-				f' <- liftIO $ relPathCwdToFile (toRawFilePath f)+				f' <- liftIO $ relPathCwdToFile f 				return $ Right (Left f', m) 			(Nothing, Nothing) -> return $  				Left "JSON input is missing either file or key" -startBatch :: (SeekInput, (Either RawFilePath Key, MetaData)) -> CommandStart+startBatch :: (SeekInput, (Either OsPath Key, MetaData)) -> CommandStart startBatch (si, (i, (MetaData m))) = case i of 	Left f -> do 		mk <- lookupKeyStaged f
Command/Migrate.hs view
@@ -79,10 +79,10 @@ 		-- by multiple jobs. 		void $ includeCommandAction $ update oldkey newkey -start :: MigrateOptions -> Maybe KeySha -> SeekInput -> RawFilePath -> Key -> CommandStart+start :: MigrateOptions -> Maybe KeySha -> SeekInput -> OsPath -> Key -> CommandStart start o ksha si file key = do 	forced <- Annex.getRead Annex.force-	v <- Backend.getBackend (fromRawFilePath file) key+	v <- Backend.getBackend file key 	case v of 		Nothing -> stop 		Just oldbackend -> do@@ -118,7 +118,7 @@  - data cannot get corrupted after the fsck but before the new key is  - generated.  -}-perform :: Bool -> MigrateOptions -> RawFilePath -> Key -> MigrationRecord -> Backend -> Backend -> CommandPerform+perform :: Bool -> MigrateOptions -> OsPath -> Key -> MigrationRecord -> Backend -> Backend -> CommandPerform perform onlytweaksize o file oldkey oldkeyrec oldbackend newbackend = go =<< genkey (fastMigrate oldbackend)   where 	go Nothing = stop
Command/Mirror.hs view
@@ -57,7 +57,7 @@ 		, usesLocationLog = True 		} -start :: MirrorOptions -> SeekInput -> RawFilePath -> Key -> CommandStart+start :: MirrorOptions -> SeekInput -> OsPath -> Key -> CommandStart start o si file k = startKey o afile (si, k, ai)   where 	afile = AssociatedFile (Just file)
Command/Move.hs view
@@ -94,7 +94,7 @@ stages (FromRemoteToRemote _ _) = transferStages stages (FromAnywhereToRemote _) = transferStages -start :: LiveUpdate -> FromToHereOptions -> RemoveWhen -> SeekInput -> RawFilePath -> Key -> CommandStart+start :: LiveUpdate -> FromToHereOptions -> RemoveWhen -> SeekInput -> OsPath -> Key -> CommandStart start lu fromto removewhen si f k = start' lu fromto removewhen afile si k ai   where 	afile = AssociatedFile (Just f)
Command/Multicast.hs view
@@ -28,7 +28,6 @@ import Utility.Tmp import Utility.Tmp.Dir import Utility.Process.Transcript-import qualified Utility.RawFilePath as R  import Data.Char import qualified Data.ByteString.Lazy.UTF8 as B8@@ -85,9 +84,9 @@ 	(s, ok) <- case k of 		KeyContainer s -> liftIO $ genkey (Param s) 		KeyFile f -> do-			createAnnexDirectory (toRawFilePath (takeDirectory f))-			liftIO $ removeWhenExistsWith R.removeLink (toRawFilePath f)-			liftIO $ protectedOutput $ genkey (File f)+			createAnnexDirectory (takeDirectory f)+			liftIO $ removeWhenExistsWith removeFile f+			liftIO $ protectedOutput $ genkey (File (fromOsPath f)) 	case (ok, parseFingerprint s) of 		(False, _) -> giveup $ "uftp_keymgt failed: " ++ s 		(_, Nothing) -> giveup $ "Failed to find fingerprint in uftp_keymgt output: " ++ s@@ -130,19 +129,18 @@ 	-- the names of keys, and would have to be copied, which is too 	-- expensive. 	starting "sending files" (ActionItemOther Nothing) (SeekInput []) $-		withTmpFile "send" $ \t h -> do+		withTmpFile (literalOsPath "send") $ \t h -> do 			let ww = WarnUnmatchLsFiles "multicast" 			(fs', cleanup) <- seekHelper id ww LsFiles.inRepo 				=<< workTreeItems ww fs 			matcher <- Limit.getMatcher 			let addlist f o = whenM (matcher $ MatchingFile $ FileInfo f f Nothing) $-				liftIO $ hPutStrLn h o+				liftIO $ hPutStrLn h (fromOsPath o) 			forM_ fs' $ \(_, f) -> do 				mk <- lookupKey f 				case mk of 					Nothing -> noop-					Just k -> withObjectLoc k $-						addlist f . fromRawFilePath+					Just k -> withObjectLoc k $ addlist f 			liftIO $ hClose h 			liftIO $ void cleanup 			@@ -161,9 +159,9 @@ 					, Param "-k", uftpKeyParam serverkey 					, Param "-U", Param (uftpUID u) 					-- only allow clients on the authlist-					, Param "-H", Param ("@"++authlist)+					, Param "-H", Param ("@"++fromOsPath authlist) 					-- pass in list of files to send-					, Param "-i", File t+					, Param "-i", File (fromOsPath t) 					] ++ ups 				liftIO (boolSystem "uftp" ps) >>= showEndResult 			next $ return True@@ -178,9 +176,9 @@ 	(callback, environ, statush) <- liftIO multicastCallbackEnv 	tmpobjdir <- fromRepo gitAnnexTmpObjectDir 	createAnnexDirectory tmpobjdir-	withTmpDirIn (fromRawFilePath tmpobjdir) "multicast" $ \tmpdir -> withAuthList $ \authlist -> do-		abstmpdir <- liftIO $ absPath (toRawFilePath tmpdir)-		abscallback <- liftIO $ searchPath callback+	withTmpDirIn tmpobjdir (literalOsPath "multicast") $ \tmpdir -> withAuthList $ \authlist -> do+		abstmpdir <- liftIO $ absPath tmpdir+		abscallback <- liftIO $ searchPath (fromOsPath callback) 		let ps = 			-- Avoid it running as a daemon. 			[ Param "-d"@@ -189,42 +187,43 @@ 			, Param "-k", uftpKeyParam clientkey 			, Param "-U", Param (uftpUID u) 			-- Only allow servers on the authlist-			, Param "-S", Param authlist+			, Param "-S", Param (fromOsPath authlist) 			-- Receive files into tmpdir 			-- (it needs an absolute path)-			, Param "-D", File (fromRawFilePath abstmpdir)+			, Param "-D", File (fromOsPath abstmpdir) 			-- Run callback after each file received 			-- (it needs an absolute path)-			, Param "-s", Param (fromMaybe callback abscallback)+			, Param "-s", Param (fromOsPath $ fromMaybe callback abscallback) 			] ++ ups 		runner <- liftIO $ async $ 			hClose statush 				`after` boolSystemEnv "uftpd" ps (Just environ)-		mapM_ storeReceived . lines =<< liftIO (hGetContents statush)+		mapM_ storeReceived . map toOsPath . lines+			=<< liftIO (hGetContents statush) 		showEndResult =<< liftIO (wait runner) 	next $ return True   where 	ai = ActionItemOther Nothing 	si = SeekInput [] -storeReceived :: FilePath -> Annex ()+storeReceived :: OsPath -> Annex () storeReceived f = do-	case deserializeKey (takeFileName f) of+	case deserializeKey' (fromOsPath (takeFileName f)) of 		Nothing -> do-			warning $ "Received a file " <> QuotedPath (toRawFilePath f) <> " that is not a git-annex key. Deleting this file."-			liftIO $ removeWhenExistsWith R.removeLink (toRawFilePath f)+			warning $ "Received a file " <> QuotedPath f <> " that is not a git-annex key. Deleting this file."+			liftIO $ removeWhenExistsWith removeFile f 		Just k -> void $ logStatusAfter NoLiveUpdate k $-			getViaTmpFromDisk RetrievalVerifiableKeysSecure AlwaysVerify k (AssociatedFile Nothing) $ \dest -> unVerified $+			getViaTmpFromDisk RetrievalVerifiableKeysSecure AlwaysVerify k $ \dest -> unVerified $ 				liftIO $ catchBoolIO $ do-					R.rename (toRawFilePath f) dest+					renameFile f dest 					return True  -- Under Windows, uftp uses key containers, which are not files on the -- filesystem.-data UftpKey = KeyFile FilePath | KeyContainer String+data UftpKey = KeyFile OsPath | KeyContainer String  uftpKeyParam :: UftpKey -> CommandParam-uftpKeyParam (KeyFile f) = File f+uftpKeyParam (KeyFile f) = File (fromOsPath f) uftpKeyParam (KeyContainer s) = Param s  uftpKey :: Annex UftpKey@@ -233,7 +232,7 @@ 	u <- getUUID 	return $ KeyContainer $ "annex-" ++ fromUUID u #else-uftpKey = KeyFile <$> credsFile "multicast"+uftpKey = KeyFile <$> credsFile (literalOsPath "multicast") #endif  -- uftp needs a unique UID for each client and server, which @@ -242,10 +241,10 @@ uftpUID :: UUID -> String uftpUID u = "0x" ++ (take 8 $ show $ sha2_256 $ B8.fromString (fromUUID u)) -withAuthList :: (FilePath -> Annex a) -> Annex a+withAuthList :: (OsPath -> Annex a) -> Annex a withAuthList a = do 	m <- knownFingerPrints-	withTmpFile "authlist" $ \t h -> do+	withTmpFile (literalOsPath "authlist") $ \t h -> do 		liftIO $ hPutStr h (genAuthList m) 		liftIO $ hClose h 		a t
Command/P2P.hs view
@@ -25,7 +25,7 @@ import Utility.FileMode import Utility.ThreadScheduler import Utility.SafeOutput-import qualified Utility.RawFilePath as R+import qualified Utility.FileIO as F import qualified Utility.MagicWormhole as Wormhole  import Control.Concurrent.Async@@ -193,12 +193,11 @@ serializePairData (PairData (HalfAuthToken ha) addrs) = unlines $ 	T.unpack ha : map formatP2PAddress addrs -deserializePairData :: String -> Maybe PairData-deserializePairData s = case lines s of-	[] -> Nothing-	(ha:l) -> do-		addrs <- mapM unformatP2PAddress l-		return (PairData (HalfAuthToken (T.pack ha)) addrs)+deserializePairData :: [String] -> Maybe PairData+deserializePairData [] = Nothing+deserializePairData (ha:l) = do+	addrs <- mapM unformatP2PAddress l+	return (PairData (HalfAuthToken (T.pack ha)) addrs)  data PairingResult 	= PairSuccess@@ -220,12 +219,12 @@ 	-- files. Permissions of received files may allow others 	-- to read them. So, set up a temp directory that only 	-- we can read.-	withTmpDir "pair" $ \tmp -> do-		liftIO $ void $ tryIO $ modifyFileMode (toRawFilePath tmp) $ +	withTmpDir (literalOsPath "pair") $ \tmp -> do+		liftIO $ void $ tryIO $ modifyFileMode tmp $  			removeModes otherGroupModes-		let sendf = tmp </> "send"-		let recvf = tmp </> "recv"-		liftIO $ writeFileProtected (toRawFilePath sendf) $+		let sendf = tmp </> literalOsPath "send"+		let recvf = tmp </> literalOsPath "recv"+		liftIO $ writeFileProtected sendf $ 			serializePairData ourpairdata  		observer <- liftIO Wormhole.mkCodeObserver@@ -235,23 +234,24 @@ 		-- the same channels that other wormhole users use. 		let appid = Wormhole.appId "git-annex.branchable.com/p2p-setup" 		(sendres, recvres) <- liftIO $-			Wormhole.sendFile sendf observer appid+			Wormhole.sendFile (fromOsPath sendf) observer appid 				`concurrently`-			Wormhole.receiveFile recvf producer appid-		liftIO $ removeWhenExistsWith R.removeLink (toRawFilePath sendf)+			Wormhole.receiveFile (fromOsPath recvf) producer appid+		liftIO $ removeWhenExistsWith removeFile sendf 		if sendres /= True 			then return SendFailed 			else if recvres /= True 				then return ReceiveFailed 				else do 					r <- liftIO $ tryIO $-						readFileStrict recvf+						map decodeBS . fileLines'+							<$> F.readFile' recvf 					case r of 						Left _e -> return ReceiveFailed-						Right s -> maybe +						Right ls -> maybe  							(return ReceiveFailed) 							(finishPairing 100 remotename ourhalf)-							(deserializePairData s)+							(deserializePairData ls)  -- | Allow the peer we're pairing with to authenticate to us, -- using an authtoken constructed from the two HalfAuthTokens.
Command/P2PHttp.hs view
@@ -266,8 +266,8 @@  findRepos :: Options -> IO [Git.Repo] findRepos o = do-	files <- map toRawFilePath . concat-		<$> mapM dirContents (directoryOption o)+	files <- concat+		<$> mapM (dirContents . toOsPath) (directoryOption o) 	map Git.Construct.newFrom . catMaybes  		<$> mapM Git.Construct.checkForRepo files
Command/PostReceive.hs view
@@ -9,6 +9,7 @@  module Command.PostReceive where +import Common import Command import qualified Annex import Annex.UpdateInstead@@ -107,12 +108,11 @@ fixPostReceiveHookEnv = do 	g <- Annex.gitRepo 	case location g of-		Local { gitdir = ".", worktree = Just "." } ->+		l@(Local {}) | gitdir l == literalOsPath "." && worktree l == Just (literalOsPath ".") -> 			Annex.adjustGitRepo $ \g' -> pure $ g' 				{ location = case location g' of 					loc@(Local {}) -> loc -						{ worktree = Just ".." }+						{ worktree = Just (literalOsPath "..") } 					loc -> loc 				} 		_ -> noop-
Command/PreCommit.hs view
@@ -62,14 +62,14 @@ addViewMetaData v f k = starting "metadata" ai si $ 	next $ changeMetaData k $ fromView v f   where-	ai = mkActionItem (k, toRawFilePath f)+	ai = mkActionItem (k, f) 	si = SeekInput []  removeViewMetaData :: View -> ViewedFile -> Key -> CommandStart removeViewMetaData v f k = starting "metadata" ai si $ 	next $ changeMetaData k $ unsetMetaData $ fromView v f   where-	ai = mkActionItem (k, toRawFilePath f)+	ai = mkActionItem (k, f) 	si = SeekInput []  changeMetaData :: Key -> MetaData -> CommandCleanup
Command/ReKey.hs view
@@ -44,7 +44,7 @@  -- Split on the last space, since a FilePath can contain whitespace, -- but a Key very rarely does.-batchParser :: String -> Annex (Either String (RawFilePath, Key))+batchParser :: String -> Annex (Either String (OsPath, Key)) batchParser s = case separate (== ' ') (reverse s) of 	(rk, rf) 		| null rk || null rf -> return $ Left "Expected: \"file key\""@@ -52,7 +52,7 @@ 			Nothing -> return $ Left "bad key" 			Just k -> do 				let f = reverse rf-				f' <- liftIO $ relPathCwdToFile (toRawFilePath f)+				f' <- liftIO $ relPathCwdToFile (toOsPath f) 				return $ Right (f', k)  seek :: ReKeyOptions -> CommandSeek@@ -65,9 +65,9 @@ 		(reKeyThese o)   where 	parsekey (file, skey) =-		(toRawFilePath file, fromMaybe (giveup "bad key") (deserializeKey skey))+		(toOsPath file, fromMaybe (giveup "bad key") (deserializeKey skey)) -start :: SeekInput -> (RawFilePath, Key) -> CommandStart+start :: SeekInput -> (OsPath, Key) -> CommandStart start si (file, newkey) = lookupKey file >>= \case 	Just k -> go k 	Nothing -> stop@@ -79,7 +79,7 @@  	ai = ActionItemTreeFile file -perform :: RawFilePath -> Key -> Key -> CommandPerform+perform :: OsPath -> Key -> Key -> CommandPerform perform file oldkey newkey = do 	ifM (inAnnex oldkey)  		( unlessM (linkKey file oldkey newkey) $@@ -93,7 +93,7 @@  {- Make a hard link to the old key content (when supported),  - to avoid wasting disk space. -}-linkKey :: RawFilePath -> Key -> Key -> Annex Bool+linkKey :: OsPath -> Key -> Key -> Annex Bool linkKey file oldkey newkey = ifM (isJust <$> isAnnexLink file) 	( linkKey' DefaultVerify oldkey newkey 	, do@@ -101,10 +101,10 @@ 		 - it's hard linked to the old key, that link must be broken. -} 		oldobj <- calcRepo (gitAnnexLocation oldkey) 		v <- tryNonAsync $ do-			st <- liftIO $ R.getFileStatus file+			st <- liftIO $ R.getFileStatus (fromOsPath file) 			when (linkCount st > 1) $ do 				freezeContent oldobj-				replaceWorkTreeFile (fromRawFilePath file) $ \tmp -> do+				replaceWorkTreeFile file $ \tmp -> do 					unlessM (checkedCopyFile oldkey oldobj tmp Nothing) $ 						giveup "can't lock old key" 					thawContent tmp@@ -128,11 +128,11 @@  - and vulnerable to corruption. -} linkKey' :: VerifyConfig -> Key -> Key -> Annex Bool linkKey' v oldkey newkey =-	getViaTmpFromDisk RetrievalAllKeysSecure v newkey (AssociatedFile Nothing) $ \tmp -> unVerified $ do+	getViaTmpFromDisk RetrievalAllKeysSecure v newkey $ \tmp -> unVerified $ do 		oldobj <- calcRepo (gitAnnexLocation oldkey) 		isJust <$> linkOrCopy' (return True) newkey oldobj tmp Nothing -cleanup :: RawFilePath -> Key -> (MigrationRecord -> Annex ()) -> CommandCleanup+cleanup :: OsPath -> Key -> (MigrationRecord -> Annex ()) -> CommandCleanup cleanup file newkey a = do 	newkeyrec <- ifM (isJust <$> isAnnexLink file) 		( do@@ -141,7 +141,8 @@ 			stageSymlink file sha 			return (MigrationRecord sha) 		, do-			mode <- liftIO $ catchMaybeIO $ fileMode <$> R.getFileStatus file+			mode <- liftIO $ catchMaybeIO $ +				fileMode <$> R.getFileStatus (fromOsPath file) 			liftIO $ whenM (isJust <$> isPointerFile file) $ 				writePointerFile file newkey mode 			sha <- hashPointerFile newkey
+ Command/Recompute.hs view
@@ -0,0 +1,218 @@+{- git-annex command+ -+ - Copyright 2025 Joey Hess <id@joeyh.name>+ -+ - Licensed under the GNU AGPL version 3 or higher.+ -}++{-# LANGUAGE OverloadedStrings #-}++module Command.Recompute where++import Command+import qualified Remote.Compute+import qualified Remote+import qualified Types.Remote as Remote+import qualified Git.Ref as Git+import Annex.Content+import Annex.UUID+import Annex.CatFile+import Annex.GitShaKey+import Git.FilePath+import Logs.Location+import Command.AddComputed (Reproducible(..), parseReproducible, getInputContent, getInputContent', addComputed)+import Backend (maybeLookupBackendVariety, unknownBackendVarietyMessage, chooseBackend)+import Types.Key+import qualified Utility.RawFilePath as R++import qualified Data.Map as M+import System.PosixCompat.Files (isSymbolicLink)++cmd :: Command+cmd = notBareRepo $ withAnnexOptions [jsonOptions] $+	command "recompute" SectionCommon "recompute computed files"+		paramPaths (seek <$$> optParser)++data RecomputeOptions = RecomputeOptions+	{ recomputeThese :: CmdParams+	, originalOption :: Bool+	, reproducible :: Maybe Reproducible+	, computeRemote :: Maybe (DeferredParse Remote)+	}++optParser :: CmdParamsDesc -> Parser RecomputeOptions+optParser desc = RecomputeOptions+	<$> cmdParams desc+	<*> switch+		( long "original"+		<> help "recompute using original content of input files"+		)+	<*> parseReproducible+	<*> optional (mkParseRemoteOption <$> parseRemoteOption)++seek :: RecomputeOptions -> CommandSeek+seek o = startConcurrency commandStages (seek' o)++seek' :: RecomputeOptions -> CommandSeek+seek' o = do+	computeremote <- maybe (pure Nothing) (Just <$$> getParsed)+		(computeRemote o)+	let seeker = AnnexedFileSeeker+		{ startAction = const $ start o computeremote+		, checkContentPresent = Nothing+		, usesLocationLog = True+		}+	withFilesInGitAnnex ww seeker+		=<< workTreeItems ww (recomputeThese o)+  where+	ww = WarnUnmatchLsFiles "recompute"++start :: RecomputeOptions -> Maybe Remote -> SeekInput -> OsPath -> Key -> CommandStart+start o (Just computeremote) si file key = +	stopUnless (elem (Remote.uuid computeremote) <$> loggedLocations key) $+		start' o computeremote si file key		+start o Nothing si file key = do+	rs <- catMaybes <$> (mapM Remote.byUUID =<< loggedLocations key)+	case sortOn Remote.cost $ filter Remote.Compute.isComputeRemote rs of+		[] -> stop+		(r:_) -> start' o r si file key++start' :: RecomputeOptions -> Remote -> SeekInput -> OsPath -> Key -> CommandStart+start' o r si file key =+	Remote.Compute.getComputeState+		(Remote.remoteStateHandle r) key >>= \case+			Nothing -> stop+			Just state -> shouldrecompute state >>= \case+				Nothing -> stop+				Just mreason -> starting "recompute" ai si $ do+					maybe noop showNote mreason+					perform o r file key state+  where+	ai = mkActionItem (key, file)++	shouldrecompute state+		| originalOption o = return (Just Nothing)+		| otherwise = firstM (inputchanged state)+			(M.toList (Remote.Compute.computeInputs state))+			>>= return . \case+				Nothing -> Nothing+				Just (inputfile, _) -> Just $ Just $+					QuotedPath inputfile <> " changed"++	inputchanged state (inputfile, inputkey) = do+		-- Note that the paths from the remote state are not to be+		-- trusted to point to a file in the repository, but using+		-- the path with git cat-file will only succeed if it+		-- is checked into the repository.+		p <- fromRepo $ fromTopFilePath $ asTopFilePath $+			Remote.Compute.computeSubdir state </> inputfile+		case keyGitSha inputkey of+			Nothing -> +				catKeyFile p >>= return . \case+					Just k -> k /= inputkey+					Nothing -> inputfilemissing+			Just inputgitsha -> inRepo (Git.fileRef p) >>= \case+				Just fileref -> catObjectMetaData fileref >>= return . \case+					Just (sha, _, _) -> sha /= inputgitsha+					Nothing -> inputfilemissing+				Nothing -> return inputfilemissing+	  where+		-- When an input file is missing, go ahead and recompute.+		-- This way, the user will see the computation fail,+		-- with an error message that explains the problem.+		-- Or, if the input file is only optionally used by the+		-- computation, it might succeed.+		inputfilemissing = True++perform :: RecomputeOptions -> Remote -> OsPath -> Key -> Remote.Compute.ComputeState -> CommandPerform+perform o r file origkey origstate = do+	program <- Remote.Compute.getComputeProgram r+	reproducibleconfig <- getreproducibleconfig+	originallocked <- liftIO $ isSymbolicLink+		<$> R.getSymbolicLinkStatus (fromOsPath file)+	showOutput+	Remote.Compute.runComputeProgram program origstate+		(Remote.Compute.ImmutableState False)+		(getinputcontent program)+		Nothing+		(go program reproducibleconfig originallocked)+	next cleanup+  where+	go program reproducibleconfig originallocked result tmpdir ts = do+		checkbehaviorchange program+			(Remote.Compute.computeState result)+		addComputed Nothing r reproducibleconfig+			choosebackend destfile False (Left originallocked)+			result tmpdir ts++	checkbehaviorchange program state = do+		let check s w a b = forM_ (M.keys (w a)) $ \f ->+			unless (M.member f (w b)) $+				Remote.Compute.computationBehaviorChangeError program s f+		+		check "not using input file"+			Remote.Compute.computeInputs origstate state+		check "outputting"+			Remote.Compute.computeOutputs state origstate+		check "not outputting"+			Remote.Compute.computeOutputs origstate state++	getinputcontent program p required+		| originalOption o =+			case M.lookup p (Remote.Compute.computeInputs origstate) of+				Just inputkey -> getInputContent' False inputkey required+					(fromOsPath p ++ "(key " ++ serializeKey inputkey ++ ")")+				Nothing -> Remote.Compute.computationBehaviorChangeError program+					"requesting a new input file" p+		| otherwise = getInputContent False p required+	+	destfile outputfile+		| Just outputfile == origfile = Just file+		| otherwise = Nothing+	+	origfile = headMaybe $ M.keys $ M.filter (== Just origkey)+		(Remote.Compute.computeOutputs origstate)++	origbackendvariety = fromKey keyVariety origkey+	+	recomputingvurl = case origbackendvariety of+		VURLKey -> True+		_ -> False++	getreproducibleconfig = case reproducible o of+		Just (Reproducible True) -> return (Just (Reproducible True))+		-- A VURL key is used when the computation was+		-- unreproducible. So recomputing should too, but that+		-- will result in the same VURL key. Since moveAnnex+		-- will prefer the current annex object to a new one,+		-- delete the annex object first, so that if recomputing+		-- generates a new version of the file, it replaces+		-- the old version.+		v -> if recomputingvurl+			then do+				lockContentForRemoval origkey noop removeAnnex+				return (Just (Reproducible False))+			else return v+	+	cleanup = do+		case reproducible o of+			Just (Reproducible True) -> noop+			-- in case computation failed, update+			-- location log for removal done earlier+			_ -> when recomputingvurl $ do+				u <- getUUID+				unlessM (elem u <$> loggedLocations origkey) $+					logStatus NoLiveUpdate origkey InfoMissing+		return True++	choosebackend outputfile+		-- When converting a VURL to reproducible, can't use+		-- the VURL backend.+		| recomputingvurl && reproducible o == Just (Reproducible True) =+			chooseBackend outputfile+		-- Use the same backend as was used to compute it before,+		-- so if the computed file is the same, there will be+		-- no change.+		| otherwise = maybeLookupBackendVariety origbackendvariety >>= \case+			Just b -> return b+			Nothing -> giveup $ unknownBackendVarietyMessage origbackendvariety
Command/RecvKey.hs view
@@ -28,7 +28,7 @@ start (_, key) = fieldTransfer Download key $ \_p -> do 	-- This matches the retrievalSecurityPolicy of Remote.Git 	let rsp = RetrievalAllKeysSecure-	ifM (getViaTmp rsp DefaultVerify key (AssociatedFile Nothing) Nothing go)+	ifM (getViaTmp rsp DefaultVerify key Nothing go) 		( do 			logStatus NoLiveUpdate key InfoPresent 			_ <- quiesce True@@ -39,4 +39,4 @@ 	go tmp = unVerified $ do 		opts <- filterRsyncSafeOptions . maybe [] words 			<$> getField "RsyncOptions"-		liftIO $ rsyncServerReceive (map Param opts) (fromRawFilePath tmp)+		liftIO $ rsyncServerReceive (map Param opts) (fromOsPath tmp)
Command/Reinject.hs view
@@ -57,26 +57,26 @@ startSrcDest (si, (src, dest)) 	| src == dest = stop 	| otherwise = starting "reinject" ai si $ notAnnexed src' $-		lookupKey (toRawFilePath dest) >>= \case+		lookupKey (toOsPath dest) >>= \case 			Just key -> ifM (verifyKeyContent key src') 				( perform src' key 				, do 					qp <- coreQuotePath <$> Annex.getGitConfig 					giveup $ decodeBS $ quote qp $ QuotedPath src' 						<> " does not have expected content of "-						<> QuotedPath (toRawFilePath dest)+						<> QuotedPath (toOsPath dest) 				) 			Nothing -> do 				qp <- coreQuotePath <$> Annex.getGitConfig 				giveup $ decodeBS $ quote qp $ QuotedPath src' 					<> " is not an annexed file"   where-	src' = toRawFilePath src+	src' = toOsPath src 	ai = ActionItemOther (Just (QuotedPath src'))  startGuessKeys :: FilePath -> CommandStart startGuessKeys src = starting "reinject" ai si $ notAnnexed src' $-	case fileKey (toRawFilePath (takeFileName src)) of+	case fileKey (takeFileName src') of 		Just key -> ifM (verifyKeyContent key src') 			( perform src' key 			, do@@ -88,7 +88,7 @@ 			warning "Not named like an object file; skipping" 			next $ return True   where-	src' = toRawFilePath src+	src' = toOsPath src 	ai = ActionItemOther (Just (QuotedPath src')) 	si = SeekInput [src] @@ -102,12 +102,12 @@ 			next $ return True 		)   where-	src' = toRawFilePath src+	src' = toOsPath src 	ks = KeySource src' src' Nothing 	ai = ActionItemOther (Just (QuotedPath src')) 	si = SeekInput [src] -notAnnexed :: RawFilePath -> CommandPerform -> CommandPerform+notAnnexed :: OsPath -> CommandPerform -> CommandPerform notAnnexed src a =  	ifM (fromRepo Git.repoIsLocalBare) 		( a@@ -120,7 +120,7 @@ 			Nothing -> a 		) -perform :: RawFilePath -> Key -> CommandPerform+perform :: OsPath -> Key -> CommandPerform perform src key = do 	maybeAddJSONField "key" (serializeKey key) 	ifM move@@ -129,7 +129,7 @@ 		)   where 	move = checkDiskSpaceToGet key Nothing False $-		moveAnnex key (AssociatedFile Nothing) src+		moveAnnex key src  cleanup :: Key -> CommandCleanup cleanup key = do
Command/RemoteDaemon.hs view
@@ -29,7 +29,7 @@ 	| foregroundDaemonOption o = liftIO runInteractive 	| otherwise = do #ifndef mingw32_HOST_OS-		git_annex <- liftIO programPath+		git_annex <- fromOsPath <$> liftIO programPath 		ps <- gitAnnexDaemonizeParams 		let logfd = openFdWithMode (toRawFilePath "/dev/null") ReadOnly Nothing defaultFileFlags 		liftIO $ daemonize git_annex ps logfd Nothing False runNonInteractive
Command/Repair.hs view
@@ -14,7 +14,6 @@ import qualified Git.Ref import Git.Types import Annex.Version-import qualified Utility.RawFilePath as R  cmd :: Command cmd = noCommit $ dontCheck repoExists $@@ -76,7 +75,7 @@ 		Annex.Branch.forceCommit "committing index after git repository repair" 		liftIO $ putStrLn "Successfully recovered the git-annex branch using .git/annex/index" 	nukeindex = do-		inRepo $ removeWhenExistsWith R.removeLink . gitAnnexIndex+		inRepo $ removeWhenExistsWith removeFile . gitAnnexIndex 		liftIO $ putStrLn "Had to delete the .git/annex/index file as it was corrupt." 	missingbranch = liftIO $ putStrLn "Since the git-annex branch is not up-to-date anymore. It would be a very good idea to run: git annex fsck --fast"
Command/ResolveMerge.hs view
@@ -5,6 +5,8 @@  - Licensed under the GNU AGPL version 3 or higher.  -} +{-# LANGUAGE OverloadedStrings #-}+ module Command.ResolveMerge where  import Command@@ -12,8 +14,7 @@ import Git.Sha import qualified Git.Branch import Annex.AutoMerge--import qualified Data.ByteString as S+import qualified Utility.FileIO as F  cmd :: Command cmd = command "resolvemerge" SectionPlumbing@@ -26,10 +27,10 @@ start :: CommandStart start = starting "resolvemerge" (ActionItemOther Nothing) (SeekInput []) $ do 	us <- fromMaybe nobranch <$> inRepo Git.Branch.current-	d <- fromRawFilePath <$> fromRepo Git.localGitDir-	let merge_head = d </> "MERGE_HEAD"+	d <- fromRepo Git.localGitDir+	let merge_head = d </> literalOsPath "MERGE_HEAD" 	them <- fromMaybe (giveup nomergehead) . extractSha-		<$> liftIO (S.readFile merge_head)+		<$> liftIO (F.readFile' merge_head) 	ifM (resolveMerge (Just us) them False) 		( do 			void $ commitResolvedMerge Git.Branch.ManualCommit@@ -38,4 +39,4 @@ 		)   where 	nobranch = giveup "No branch is currently checked out."-	nomergehead = giveup "No SHA found in .git/merge_head"+	nomergehead = giveup "No SHA found in .git/MERGE_HEAD"
Command/RmUrl.hs view
@@ -32,29 +32,28 @@ seek o = case batchOption o of 	Batch fmt -> batchOnly Nothing (rmThese o) $ 		batchInput fmt batchParser (batchCommandAction . start)-	NoBatch -> withPairs (commandAction . start) (rmThese o)+	NoBatch -> withPairs (commandAction . start . conv) (rmThese o)+  where+	conv (si, (f, u)) = (si, (toOsPath f, u)) --- Split on the last space, since a FilePath can contain whitespace,+-- Split on the last space, since a OsPath can contain whitespace, -- but a url should not.-batchParser :: String -> Annex (Either String (FilePath, URLString))+batchParser :: String -> Annex (Either String (OsPath, URLString)) batchParser s = case separate (== ' ') (reverse s) of 	(ru, rf) 		| null ru || null rf -> return $ Left "Expected: \"file url\"" 		| otherwise -> do-			let f = reverse rf-			f' <- liftIO $ fromRawFilePath-				<$> relPathCwdToFile (toRawFilePath f)+			let f = toOsPath (reverse rf)+			f' <- liftIO $ relPathCwdToFile f 			return $ Right (f', reverse ru) -start :: (SeekInput, (FilePath, URLString)) -> CommandStart-start (si, (file, url)) = lookupKeyStaged file' >>= \case+start :: (SeekInput, (OsPath, URLString)) -> CommandStart+start (si, (file, url)) = lookupKeyStaged file >>= \case 	Nothing -> stop 	Just key -> do-		let ai = mkActionItem (key, AssociatedFile (Just file'))+		let ai = mkActionItem (key, AssociatedFile (Just file)) 		starting "rmurl" ai si $ 			next $ cleanup url key-  where-	file' = toRawFilePath file  cleanup :: String -> Key -> CommandCleanup cleanup url key = do
Command/SendKey.hs view
@@ -33,7 +33,9 @@ 	ifM (inAnnex key) 		( fieldTransfer Upload key $ \_p -> 			sendAnnex key Nothing rollback $ \f _sz -> -				liftIO $ rsyncServerSend (map Param opts) f+				liftIO $ rsyncServerSend+					(map Param opts)+					(fromOsPath f) 		, do 			warning "requested key is not present" 			liftIO exitFailure
Command/SetKey.hs view
@@ -25,18 +25,18 @@   where 	ai = ActionItemOther (Just (QuotedPath file')) 	si = SeekInput ps-	file' = toRawFilePath file+	file' = toOsPath file start _ = giveup "specify a key and a content file"  keyOpt :: String -> Key keyOpt = fromMaybe (giveup "bad key") . deserializeKey -perform :: RawFilePath -> Key -> CommandPerform+perform :: OsPath -> 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 	-- checked this way.-	ok <- getViaTmp RetrievalAllKeysSecure DefaultVerify key (AssociatedFile Nothing) Nothing $ \dest -> unVerified $+	ok <- getViaTmp RetrievalAllKeysSecure DefaultVerify key Nothing $ \dest -> unVerified $ 		if dest /= file 			then liftIO $ catchBoolIO $ do 				moveFile file dest
Command/Sim.hs view
@@ -61,13 +61,13 @@  startsim' :: Maybe FilePath -> Annex (SimState SimRepo) startsim' simfile = do-	simdir <- fromRawFilePath <$> fromRepo gitAnnexSimDir+	simdir <- fromRepo gitAnnexSimDir 	whenM (liftIO $ doesDirectoryExist simdir) $ 		giveup "A sim was previously started. Use `git-annex sim end` to stop it before starting a new one." 	 	showLongNote $ UnquotedString "Sim started." 	rng <- liftIO $ fst . random <$> getStdGen-	let st = emptySimState rng simdir+	let st = emptySimState rng (fromOsPath simdir) 	case simfile of 		Nothing -> startup simdir st [] 		Just f -> liftIO (readFile f) >>= \c -> @@ -77,7 +77,7 @@   where 	startup simdir st cs = do 		repobyname <- mkGetExistingRepoByName-		createAnnexDirectory (toRawFilePath simdir)+		createAnnexDirectory simdir 		let st' = recordSeed st cs 		go st' repobyname cs @@ -88,7 +88,7 @@ 	 endsim :: CommandSeek endsim = do-	simdir <- fromRawFilePath <$> fromRepo gitAnnexSimDir+	simdir <- fromRepo gitAnnexSimDir 	whenM (liftIO $ doesDirectoryExist simdir) $ do 		liftIO $ removeDirectoryRecursive simdir 	showLongNote $ UnquotedString "Sim ended."
Command/Smudge.hs view
@@ -44,7 +44,7 @@ 		paramFile (seek <$$> optParser)  data SmudgeOptions = UpdateOption | SmudgeOptions-	{ smudgeFile :: FilePath+	{ smudgeFile :: OsPath 	, cleanOption :: Bool 	} @@ -52,14 +52,14 @@ optParser desc = smudgeoptions <|> updateoption   where 	smudgeoptions = SmudgeOptions-		<$> argument str ( metavar desc )+		<$> (stringToOsPath <$> argument str ( metavar desc )) 		<*> switch ( long "clean" <> help "clean filter" ) 	updateoption = flag' UpdateOption 		( long "update" <> help "populate annexed worktree files" )  seek :: SmudgeOptions -> CommandSeek seek (SmudgeOptions f False) = commandAction (smudge f)-seek (SmudgeOptions f True) = commandAction (clean (toRawFilePath f))+seek (SmudgeOptions f True) = commandAction (clean f) seek UpdateOption = commandAction update  -- Smudge filter is fed git file content, and if it's a pointer to an@@ -73,7 +73,7 @@ -- * To support annex.thin -- * Because git currently buffers the whole object received from the --   smudge filter in memory, which is a problem with large files.-smudge :: FilePath -> CommandStart+smudge :: OsPath -> CommandStart smudge file = do 	b <- liftIO $ L.hGetContents stdin 	smudge' file b@@ -81,18 +81,18 @@ 	stop  -- Handles everything except the IO of the file content.-smudge' :: FilePath -> L.ByteString -> Annex ()+smudge' :: OsPath -> L.ByteString -> Annex () smudge' file b = case parseLinkTargetOrPointerLazy b of 	Nothing -> noop 	Just k -> do-		topfile <- inRepo (toTopFilePath (toRawFilePath file))+		topfile <- inRepo (toTopFilePath file) 		Database.Keys.addAssociatedFile k topfile 		void $ smudgeLog k topfile  -- 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 :: RawFilePath -> CommandStart+clean :: OsPath -> CommandStart clean file = do 	Annex.BranchState.disableUpdate -- optimisation 	b <- liftIO $ L.hGetContents stdin@@ -116,7 +116,7 @@  -- Handles everything except the IO of the file content. clean'-	:: RawFilePath+	:: OsPath 	-> Either InvalidAppendedPointerFile (Maybe Key) 	-- ^ If the content provided by git is an annex pointer, 	-- this is the key it points to.@@ -188,7 +188,7 @@ 		emitpointer 			=<< postingest 			=<< (\ld -> ingest' preferredbackend nullMeterUpdate ld Nothing norestage)-			=<< lockDown cfg (fromRawFilePath file)+			=<< lockDown cfg file  	postingest (Just k, _) = do 		logStatus NoLiveUpdate k InfoPresent@@ -203,7 +203,7 @@  -- git diff can run the clean filter on files outside the -- repository; can't annex those-fileOutsideRepo :: RawFilePath -> Annex Bool+fileOutsideRepo :: OsPath -> Annex Bool fileOutsideRepo file = do         repopath <- liftIO . absPath =<< fromRepo Git.repoPath 	filepath <- liftIO $ absPath file@@ -232,7 +232,7 @@ -- in the index, and has the same content, leave it in git. -- This handles cases such as renaming a file followed by git add, -- which the user naturally expects to behave the same as git mv.-shouldAnnex :: RawFilePath -> Maybe (Sha, FileSize, ObjectType) -> Maybe Key -> Annex Bool+shouldAnnex :: OsPath -> Maybe (Sha, FileSize, ObjectType) -> Maybe Key -> Annex Bool shouldAnnex file indexmeta moldkey = do 	ifM (annexGitAddToAnnex <$> Annex.getGitConfig) 		( checkunchanged $ checkmatcher checkwasannexed@@ -299,7 +299,7 @@ -- This also handles the case where a copy of a pointer file is made, -- then git-annex gets the content, and later git add is run on -- the pointer copy. It will then be populated with the content.-getMoveRaceRecovery :: Key -> RawFilePath -> Annex ()+getMoveRaceRecovery :: Key -> OsPath -> Annex () getMoveRaceRecovery k file = void $ tryNonAsync $ 	whenM (inAnnex k) $ do 		obj <- calcRepo (gitAnnexLocation k)
Command/Status.hs view
@@ -66,6 +66,6 @@ 	absf <- fromRepo $ fromTopFilePath (statusFile s) 	f <- liftIO $ relPathCwdToFile absf 	qp <- coreQuotePath <$> Annex.getGitConfig-	unlessM (showFullJSON $ JSONChunk [("status", [c]), ("file", fromRawFilePath f)]) $+	unlessM (showFullJSON $ JSONChunk [("status", [c]), ("file", fromOsPath f)]) $ 		liftIO $ B8.putStrLn $ quote qp $ 			UnquotedString (c : " ") <> QuotedPath f
Command/Sync.hs view
@@ -110,7 +110,7 @@ 	, pushOption :: Bool 	, contentOption :: Maybe Bool 	, noContentOption :: Maybe Bool-	, contentOfOption :: [FilePath]+	, contentOfOption :: [OsPath] 	, cleanupOption :: Bool 	, keyOptions :: Maybe KeyOptions 	, resolveMergeOverride :: Bool@@ -201,7 +201,7 @@ 			<> short 'g' 			<> help "do not transfer annexed file contents" 			)))-	<*> many (strOption+	<*> many (stringToOsPath <$> strOption 		( long "content-of" 		<> short 'C' 		<> help "transfer contents of annexed files in a given location"@@ -248,7 +248,7 @@ 		<*> pure (pushOption v) 		<*> pure (contentOption v) 		<*> pure (noContentOption v)-		<*> liftIO (mapM (fromRawFilePath <$$> absPath . toRawFilePath) (contentOfOption v))+		<*> liftIO (mapM absPath (contentOfOption v)) 		<*> pure (cleanupOption v) 		<*> pure (keyOptions v) 		<*> pure (resolveMergeOverride v)@@ -340,7 +340,7 @@  - of the repo. This also means that sync always acts on all files in the  - repository, not just on a subdirectory. -} prepMerge :: Annex ()-prepMerge = Annex.changeDirectory . fromRawFilePath =<< fromRepo Git.repoPath+prepMerge = Annex.changeDirectory =<< fromRepo Git.repoPath  mergeConfig :: Bool -> Annex [Git.Merge.MergeConfig] mergeConfig mergeunrelated = do@@ -681,7 +681,7 @@ 		Nothing -> return True 		Just wt -> ifM needemulation 			( gitAnnexChildProcess "post-receive" []-				(\cp -> cp { cwd = Just (fromRawFilePath wt) })+				(\cp -> cp { cwd = Just (fromOsPath wt) }) 				(\_ _ _ pid -> waitForProcess pid >>= return . \case 					ExitSuccess -> True 					_ -> False@@ -820,11 +820,13 @@ 			) 		_ -> case currbranch of                 	(Just origbranch, Just adj) | adjustmentHidesFiles adj -> do-				l <- workTreeItems' (AllowHidden True) ww (contentOfOption o)+				l <- workTreeItems' (AllowHidden True) ww +					(map fromOsPath (contentOfOption o)) 				seekincludinghidden origbranch mvar l (const noop) 				pure Nothing 			_ -> do-				l <- workTreeItems ww (contentOfOption o)+				l <- workTreeItems ww+					(map fromOsPath (contentOfOption o)) 				seekworktree mvar l (const noop) 				pure Nothing 	waitForAllRunningCommandActions@@ -1013,7 +1015,7 @@ 			mtree <- inRepo $ Git.Ref.tree b 			let addsubdir = case snd (splitRemoteAnnexTrackingBranchSubdir b) of 				Just subdir -> \cb -> Git.Ref $-					Git.fromRef' cb  <> ":" <> getTopFilePath subdir+					Git.fromRef' cb  <> ":" <> fromOsPath (getTopFilePath subdir) 				Nothing -> id 			mcurrtree <- maybe (pure Nothing) 				(inRepo . Git.Ref.tree . addsubdir)
Command/TestRemote.hs view
@@ -32,6 +32,7 @@ import Remote.Helper.Chunked import Remote.Helper.Encryptable (encryptionField, highRandomQualityField) import Git.Types+import qualified Utility.FileIO as F  import Test.Tasty import Test.Tasty.Runners@@ -86,8 +87,7 @@ 				showAction "generating test keys" 				NE.fromList 					<$> mapM randKey (keySizes basesz fast)-		fs -> NE.fromList-			<$> mapM (getReadonlyKey r . toRawFilePath) fs+		fs -> NE.fromList <$> mapM (getReadonlyKey r . toOsPath) fs 	let r' = if null (testReadonlyFile o) 		then r 		else r { Remote.readonly = True }@@ -255,24 +255,24 @@ 		get r k 	, check "fsck downloaded object" fsck 	, check "retrieveKeyFile resume from 0" $ \r k -> do-		tmp <- fromRawFilePath <$> prepTmp k-		liftIO $ writeFile tmp ""+		tmp <- prepTmp k+		liftIO $ F.writeFile' tmp mempty 		lockContentForRemoval k noop removeAnnex 		get r k 	, check "fsck downloaded object" fsck 	, check "retrieveKeyFile resume from 33%" $ \r k -> do-		loc <- fromRawFilePath <$> Annex.calcRepo (gitAnnexLocation k)-		tmp <- fromRawFilePath <$> prepTmp k-		partial <- liftIO $ bracket (openBinaryFile loc ReadMode) hClose $ \h -> do+		loc <- Annex.calcRepo (gitAnnexLocation k)+		tmp <- prepTmp k+		partial <- liftIO $ bracket (F.openBinaryFile loc ReadMode) hClose $ \h -> do 			sz <- hFileSize h 			L.hGet h $ fromInteger $ sz `div` 3-		liftIO $ L.writeFile tmp partial+		liftIO $ F.writeFile tmp partial 		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 <- fromRawFilePath <$> prepTmp k+		loc <- Annex.calcRepo (gitAnnexLocation k)+		tmp <- prepTmp k 		void $ liftIO $ copyFileExternal CopyAllMetaData loc tmp 		lockContentForRemoval k noop removeAnnex 		get r k@@ -301,8 +301,8 @@ 			Just verifier -> do 				loc <- Annex.calcRepo (gitAnnexLocation k) 				verifier k loc-	get r k = logStatusAfter NoLiveUpdate k $ getViaTmp (Remote.retrievalSecurityPolicy r) (RemoteVerify r) k (AssociatedFile Nothing) Nothing $ \dest ->-		tryNonAsync (Remote.retrieveKeyFile r k (AssociatedFile Nothing) (fromRawFilePath dest) nullMeterUpdate (RemoteVerify r)) >>= \case+	get r k = logStatusAfter NoLiveUpdate k $ getViaTmp (Remote.retrievalSecurityPolicy r) (RemoteVerify r) k Nothing $ \dest ->+		tryNonAsync (Remote.retrieveKeyFile r k (AssociatedFile Nothing) dest nullMeterUpdate (RemoteVerify r)) >>= \case 			Right v -> return (True, v) 			Left _ -> return (False, UnVerified) 	store r k = Remote.storeKey r k (AssociatedFile Nothing) Nothing nullMeterUpdate@@ -341,8 +341,8 @@ 	-- renames are not tested because remotes do not need to support them 	]   where-	testexportdirectory = "testremote-export"-	testexportlocation = mkExportLocation (toRawFilePath (testexportdirectory </> "location"))+	testexportdirectory = literalOsPath "testremote-export"+	testexportlocation = mkExportLocation (testexportdirectory </> literalOsPath "location") 	check desc a = testCase desc $ do 		let a' = mkr >>= \case 			Just r -> do@@ -353,17 +353,17 @@ 			Nothing -> return True 		runannex a' @? "failed" 	storeexport ea k = do-		loc <- fromRawFilePath <$> Annex.calcRepo (gitAnnexLocation k)+		loc <- Annex.calcRepo (gitAnnexLocation k) 		Remote.storeExport ea loc k testexportlocation nullMeterUpdate-	retrieveexport ea k = withTmpFile "exported" $ \tmp h -> do+	retrieveexport ea k = withTmpFile (literalOsPath "exported") $ \tmp h -> do 		liftIO $ hClose h 		tryNonAsync (Remote.retrieveExport ea k testexportlocation tmp nullMeterUpdate) >>= \case 			Left _ -> return False-			Right v -> verifyKeyContentPostRetrieval RetrievalAllKeysSecure AlwaysVerify v k (toRawFilePath tmp)+			Right v -> verifyKeyContentPostRetrieval RetrievalAllKeysSecure AlwaysVerify v k tmp 	checkpresentexport ea k = Remote.checkPresentExport ea k testexportlocation 	removeexport ea k = Remote.removeExport ea k testexportlocation 	removeexportdirectory ea = case Remote.removeExportDirectory ea of-		Just a -> a (mkExportDirectory (toRawFilePath testexportdirectory))+		Just a -> a (mkExportDirectory testexportdirectory) 		Nothing -> noop  testUnavailable :: RunAnnex -> Annex (Maybe Remote) -> Annex Key -> [TestTree]@@ -375,15 +375,15 @@ 	, check (`notElem` [Right True, Right False]) "checkPresent" $ \r k -> 		Remote.checkPresent r k 	, check (== Right False) "retrieveKeyFile" $ \r k ->-		logStatusAfter NoLiveUpdate k $ getViaTmp (Remote.retrievalSecurityPolicy r) (RemoteVerify r) k (AssociatedFile Nothing) Nothing $ \dest ->-			tryNonAsync (Remote.retrieveKeyFile r k (AssociatedFile Nothing) (fromRawFilePath dest) nullMeterUpdate (RemoteVerify r)) >>= \case+		logStatusAfter NoLiveUpdate k $ getViaTmp (Remote.retrievalSecurityPolicy r) (RemoteVerify r) k Nothing $ \dest ->+			tryNonAsync (Remote.retrieveKeyFile r k (AssociatedFile Nothing) dest nullMeterUpdate (RemoteVerify r)) >>= \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 -> logStatusAfter NoLiveUpdate k $ getViaTmp (Remote.retrievalSecurityPolicy r) (RemoteVerify r) k (AssociatedFile Nothing) Nothing $ \dest -> +		Just a -> logStatusAfter NoLiveUpdate k $ getViaTmp (Remote.retrievalSecurityPolicy r) (RemoteVerify r) k Nothing $ \dest ->  			unVerified $ isRight-				<$> tryNonAsync (a k (AssociatedFile Nothing) (fromRawFilePath dest))+				<$> tryNonAsync (a k (AssociatedFile Nothing) dest) 	]   where 	check checkval desc a = testCase desc $ @@ -429,24 +429,24 @@ 		| otherwise = sz > 0  randKey :: Int -> Annex Key-randKey sz = withTmpFile "randkey" $ \f h -> do+randKey sz = withTmpFile (literalOsPath "randkey") $ \f h -> do 	gen <- liftIO (newGenIO :: IO SystemRandom) 	case genBytes sz gen of 		Left e -> giveup $ "failed to generate random key: " ++ show e 		Right (rand, _) -> liftIO $ B.hPut h rand 	liftIO $ hClose h 	let ks = KeySource-		{ keyFilename = toRawFilePath f-		, contentLocation = toRawFilePath f+		{ keyFilename = f+		, contentLocation = f 		, inodeCache = Nothing 		} 	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 (AssociatedFile Nothing) (toRawFilePath f)+	_ <- moveAnnex k f 	return k -getReadonlyKey :: Remote -> RawFilePath -> Annex Key+getReadonlyKey :: Remote -> OsPath -> Annex Key getReadonlyKey r f = do 	qp <- coreQuotePath <$> Annex.getGitConfig 	lookupKey f >>= \case
Command/TransferKey.hs view
@@ -30,7 +30,7 @@ optParser desc  = TransferKeyOptions 	<$> cmdParams desc 	<*> parseFromToOptions-	<*> (AssociatedFile <$> optional (strOption+	<*> (AssociatedFile . fmap stringToOsPath <$> optional (strOption 		( long "file" <> metavar paramFile 		<> help "the associated file" 		)))@@ -63,8 +63,8 @@ fromPerform :: Key -> AssociatedFile -> Remote -> CommandPerform fromPerform key af remote = go Upload af $ 	download' (uuid remote) key af Nothing stdRetry $ \p ->-		logStatusAfter NoLiveUpdate key $ getViaTmp (retrievalSecurityPolicy remote) vc key af Nothing $ \t ->-			tryNonAsync (Remote.retrieveKeyFile remote key af (fromRawFilePath t) p vc) >>= \case+		logStatusAfter NoLiveUpdate key $ getViaTmp (retrievalSecurityPolicy remote) vc key Nothing $ \t ->+			tryNonAsync (Remote.retrieveKeyFile remote key af t p vc) >>= \case 				Right v -> return (True, v)	 				Left e -> do 					warning (UnquotedString (show e))
Command/TransferKeys.hs view
@@ -50,8 +50,8 @@ 						return True 		| otherwise = notifyTransfer direction af $ 			download' (Remote.uuid remote) key af Nothing stdRetry $ \p ->-				logStatusAfter NoLiveUpdate key $ getViaTmp (Remote.retrievalSecurityPolicy remote) (RemoteVerify remote) key af Nothing $ \t -> do-					r <- tryNonAsync (Remote.retrieveKeyFile remote key af (fromRawFilePath t) p (RemoteVerify remote)) >>= \case+				logStatusAfter NoLiveUpdate key $ getViaTmp (Remote.retrievalSecurityPolicy remote) (RemoteVerify remote) key Nothing $ \t -> do+					r <- tryNonAsync (Remote.retrieveKeyFile remote key af t p (RemoteVerify remote)) >>= \case 						Left e -> do 							warning (UnquotedString (show e)) 							return (False, UnVerified)@@ -128,10 +128,10 @@ 	deserialize _ = Nothing  instance TCSerialized AssociatedFile where-	serialize (AssociatedFile (Just f)) = fromRawFilePath f+	serialize (AssociatedFile (Just f)) = fromOsPath f 	serialize (AssociatedFile Nothing) = "" 	deserialize "" = Just (AssociatedFile Nothing)-	deserialize f = Just (AssociatedFile (Just (toRawFilePath f)))+	deserialize f = Just (AssociatedFile (Just (toOsPath f)))  instance TCSerialized RemoteName where 	serialize n = n
Command/Transferrer.hs view
@@ -55,8 +55,8 @@ 		-- so caller is responsible for doing notification 		-- and for retrying, and updating location log, 		-- and stall canceling.-		let go p = getViaTmp (Remote.retrievalSecurityPolicy remote) (RemoteVerify remote) key af Nothing $ \t -> do-			Remote.verifiedAction (Remote.retrieveKeyFile remote key af (fromRawFilePath t) p (RemoteVerify remote))+		let go p = getViaTmp (Remote.retrievalSecurityPolicy remote) (RemoteVerify remote) key Nothing $ \t -> do+			Remote.verifiedAction (Remote.retrieveKeyFile remote key af t p (RemoteVerify remote)) 		in download' (Remote.uuid remote) key af Nothing noRetry go  			noNotification 	runner (AssistantUploadRequest _ key (TransferAssociatedFile af)) remote =@@ -72,8 +72,8 @@ 	runner (AssistantDownloadRequest _ key (TransferAssociatedFile file)) remote = 		notifyTransfer Download file $ 			download' (Remote.uuid remote) key file Nothing stdRetry $ \p ->-				logStatusAfter NoLiveUpdate key $ getViaTmp (Remote.retrievalSecurityPolicy remote) (RemoteVerify remote) key file Nothing $ \t -> do-					r <- tryNonAsync (Remote.retrieveKeyFile remote key file (fromRawFilePath t) p (RemoteVerify remote)) >>= \case+				logStatusAfter NoLiveUpdate key $ getViaTmp (Remote.retrievalSecurityPolicy remote) (RemoteVerify remote) key Nothing $ \t -> do+					r <- tryNonAsync (Remote.retrieveKeyFile remote key file t p (RemoteVerify remote)) >>= \case 						Left e -> do 							warning (UnquotedString (show e)) 							return (False, UnVerified)
Command/Unannex.hs view
@@ -39,12 +39,12 @@ 	, usesLocationLog = False 	} -start :: Bool -> SeekInput -> RawFilePath -> Key -> CommandStart+start :: Bool -> SeekInput -> OsPath -> Key -> CommandStart start fast si file key =  	starting "unannex" (mkActionItem (key, file)) si $ 		perform fast file key -perform :: Bool -> RawFilePath -> Key -> CommandPerform+perform :: Bool -> OsPath -> Key -> CommandPerform perform fast file key = do 	Annex.Queue.addCommand [] "rm" 		[ Param "--cached"@@ -52,7 +52,7 @@ 		, Param "--quiet" 		, Param "--" 		]-		[fromRawFilePath file]+		[fromOsPath file] 	isAnnexLink file >>= \case 		-- If the file is locked, it needs to be replaced with 		-- the content from the annex. Note that it's possible@@ -73,9 +73,9 @@ 		maybe noop Database.Keys.removeInodeCache 			=<< withTSDelta (liftIO . genInodeCache file) -cleanup :: Bool -> RawFilePath -> Key -> CommandCleanup+cleanup :: Bool -> OsPath -> Key -> CommandCleanup cleanup fast file key = do-	liftIO $ removeFile (fromRawFilePath file)+	liftIO $ removeFile file 	src <- calcRepo (gitAnnexLocation key) 	ifM (pure fast <||> Annex.getRead Annex.fast) 		( do@@ -83,7 +83,7 @@ 			-- already have other hard links pointing at it. This 			-- avoids unannexing (and uninit) ending up hard 			-- linking files together, which would be surprising.-			s <- liftIO $ R.getFileStatus src+			s <- liftIO $ R.getFileStatus (fromOsPath src) 			if linkCount s > 1 				then copyfrom src 				else hardlinkfrom src@@ -91,13 +91,14 @@ 		)   where 	copyfrom src = -		thawContent file `after` liftIO -			(copyFileExternal CopyAllMetaData-				(fromRawFilePath src)-				(fromRawFilePath file))+		thawContent file `after`+			liftIO (copyFileExternal CopyAllMetaData src file) 	hardlinkfrom src = 		-- creating a hard link could fall; fall back to copying-		ifM (liftIO $ catchBoolIO $ R.createLink src file >> return True)+		ifM (liftIO $ tryhardlink src file) 			( return True 			, copyfrom src 			)+	tryhardlink src dest = catchBoolIO $ do+		R.createLink (fromOsPath src) (fromOsPath dest)+		return True
Command/Undo.hs view
@@ -18,7 +18,6 @@ import qualified Git.LsFiles as LsFiles import qualified Git.Command as Git import qualified Git.Branch-import qualified Utility.RawFilePath as R  cmd :: Command cmd = notBareRepo $ withAnnexOptions [jsonOptions] $@@ -30,7 +29,7 @@ seek ps = do 	-- Safety first; avoid any undo that would touch files that are not 	-- in the index.-	(fs, cleanup) <- inRepo $ LsFiles.notInRepo [] False (map toRawFilePath ps)+	(fs, cleanup) <- inRepo $ LsFiles.notInRepo [] False (map toOsPath ps) 	unless (null fs) $ do 		qp <- coreQuotePath <$> Annex.getGitConfig 		giveup $ decodeBS $ quote qp $ @@ -48,19 +47,20 @@  start :: FilePath -> CommandStart start p = starting "undo" ai si $-	perform p+	perform p'   where-	ai = ActionItemOther (Just (QuotedPath (toRawFilePath p)))+	p' = toOsPath p+	ai = ActionItemOther (Just (QuotedPath p')) 	si = SeekInput [p] -perform :: FilePath -> CommandPerform+perform :: OsPath -> CommandPerform perform p = do 	g <- gitRepo  	-- Get the reversed diff that needs to be applied to undo. 	(diff, cleanup) <- inRepo $-		diffLog [Param "-R", Param "--", Param p]-	top <- inRepo $ toTopFilePath $ toRawFilePath p+		diffLog [Param "-R", Param "--", Param (fromOsPath p)]+	top <- inRepo $ toTopFilePath p 	let diff' = filter (`isDiffOf` top) diff 	liftIO $ streamUpdateIndex g (map stageDiffTreeItem diff') @@ -73,10 +73,10 @@  	forM_ removals $ \di -> do 		f <- mkrel di-		liftIO $ removeWhenExistsWith R.removeLink f+		liftIO $ removeWhenExistsWith removeFile f  	forM_ adds $ \di -> do-		f <- fromRawFilePath <$> mkrel di+		f <- fromOsPath <$> mkrel di 		inRepo $ Git.run [Param "checkout", Param "--", File f]  	next $ liftIO cleanup
Command/Uninit.hs view
@@ -73,7 +73,7 @@ 		when (b == Just Annex.Branch.name) $ giveup $ 			"cannot uninit when the " ++ Git.fromRef Annex.Branch.name ++ " branch is checked out" 		top <- fromRepo Git.repoPath-		currdir <- liftIO R.getCurrentDirectory+		currdir <- liftIO getCurrentDirectory 		whenM ((/=) <$> liftIO (absPath top) <*> liftIO (absPath currdir)) $ 			giveup "can only run uninit from the top of the git repository" 	@@ -87,14 +87,14 @@  {- git annex symlinks that are not checked into git could be left by an  - interrupted add. -}-startCheckIncomplete :: Annex () -> RawFilePath -> Key -> CommandStart+startCheckIncomplete :: Annex () -> OsPath -> Key -> CommandStart startCheckIncomplete recordnotok file key = 	starting "uninit check" (mkActionItem (file, key)) (SeekInput []) $ do 		recordnotok 		giveup $ unlines err   where 	err =-		[ fromRawFilePath file ++ " points to annexed content, but is not checked into git."+		[ fromOsPath file ++ " points to annexed content, but is not checked into git." 		, "Perhaps this was left behind by an interrupted git annex add?" 		, "Not continuing with uninit; either delete or git annex add the file and retry." 		]@@ -102,7 +102,7 @@ removeAnnexDir :: CommandCleanup -> CommandStart removeAnnexDir recordok = do 	Annex.Queue.flush-	annexdir <- fromRawFilePath <$> fromRepo gitAnnexDir+	annexdir <- fromRepo gitAnnexDir 	annexobjectdir <- fromRepo gitAnnexObjectDir 	starting ("uninit objects") (ActionItemOther Nothing) (SeekInput []) $ do 		leftovers <- removeUnannexed =<< listKeys InAnnex@@ -113,7 +113,7 @@ 				next recordok 			else giveup $ unlines 				[ "Not fully uninitialized"-				, "Some annexed data is still left in " ++ fromRawFilePath annexobjectdir+				, "Some annexed data is still left in " ++ fromOsPath annexobjectdir 				, "This may include deleted files, or old versions of modified files." 				, "" 				, "If you don't care about preserving the data, just delete the"@@ -134,15 +134,15 @@  -  - Also closes sqlite databases that might be in the directory,  - to avoid later failure to write any cached changes to them. -}-prepareRemoveAnnexDir :: FilePath -> Annex ()+prepareRemoveAnnexDir :: OsPath -> Annex () prepareRemoveAnnexDir annexdir = do 	Database.Keys.closeDb 	liftIO $ prepareRemoveAnnexDir' annexdir -prepareRemoveAnnexDir' :: FilePath -> IO ()+prepareRemoveAnnexDir' :: OsPath -> IO () prepareRemoveAnnexDir' annexdir = 	emptyWhenDoesNotExist (dirTreeRecursiveSkipping (const False) annexdir)-		>>= mapM_ (void . tryIO . allowWrite . toRawFilePath)+		>>= mapM_ (void . tryIO . allowWrite)  {- Keys that were moved out of the annex have a hard link still in the  - annex, with > 1 link count, and those can be removed.@@ -159,7 +159,7 @@ 		, go (k:c) ks 		) 	enoughlinks f = catchBoolIO $ do-		s <- R.getFileStatus f+		s <- R.getFileStatus (fromOsPath f) 		return $ linkCount s > 1  completeUnitialize :: CommandStart
Command/Unlock.hs view
@@ -40,7 +40,7 @@ 		, usesLocationLog = False 		} -start :: SeekInput -> RawFilePath -> Key -> CommandStart+start :: SeekInput -> OsPath -> Key -> CommandStart start si file key = ifM (isJust <$> isAnnexLink file) 	( starting "unlock" ai si $ perform file key 	, stop@@ -48,10 +48,10 @@   where 	ai = mkActionItem (key, AssociatedFile (Just file)) -perform :: RawFilePath -> Key -> CommandPerform+perform :: OsPath -> Key -> CommandPerform perform dest key = do-	destmode <- liftIO $ catchMaybeIO $ fileMode <$> R.getFileStatus dest-	destic <- replaceWorkTreeFile (fromRawFilePath dest) $ \tmp -> do+	destmode <- liftIO $ catchMaybeIO $ fileMode <$> R.getFileStatus (fromOsPath dest)+	destic <- replaceWorkTreeFile dest $ \tmp -> do 		ifM (inAnnex key) 			( do 				r <- linkFromAnnex' key tmp destmode@@ -64,7 +64,7 @@ 		withTSDelta (liftIO . genInodeCache tmp) 	next $ cleanup dest destic key destmode -cleanup :: RawFilePath -> Maybe InodeCache -> Key -> Maybe FileMode -> CommandCleanup+cleanup :: OsPath -> Maybe InodeCache -> Key -> Maybe FileMode -> CommandCleanup cleanup dest destic key destmode = do 	stagePointerFile dest destmode =<< hashPointerFile key 	maybe noop (restagePointerFile (Restage True) dest) destic
Command/Unused.hs view
@@ -119,7 +119,7 @@ 	maybeAddJSONField 		((if null fileprefix then "unused" else fileprefix) ++ "-list") 		(M.fromList $ map (\(n,  k) -> (T.pack (show n), serializeKey k)) unusedlist)-	updateUnusedLog (toRawFilePath fileprefix) (M.fromList unusedlist)+	updateUnusedLog (toOsPath fileprefix) (M.fromList unusedlist) 	return $ c + length l  number :: Int -> [a] -> [(Int, a)]@@ -194,7 +194,7 @@  {- Given an initial value, accumulates the value over each key  - referenced by files in the working tree. -}-withKeysReferenced :: v -> (Key -> RawFilePath -> v -> Annex v) -> Annex v+withKeysReferenced :: v -> (Key -> OsPath -> v -> Annex v) -> Annex v withKeysReferenced initial = withKeysReferenced' Nothing initial  {- Runs an action on each referenced key in the working tree. -}@@ -204,10 +204,10 @@ 	calla k _ _ = a k  {- Folds an action over keys and files referenced in a particular directory. -}-withKeysFilesReferencedIn :: FilePath -> v -> (Key -> RawFilePath -> v -> Annex v) -> Annex v+withKeysFilesReferencedIn :: OsPath -> v -> (Key -> OsPath -> v -> Annex v) -> Annex v withKeysFilesReferencedIn = withKeysReferenced' . Just -withKeysReferenced' :: Maybe FilePath -> v -> (Key -> RawFilePath -> v -> Annex v) -> Annex v+withKeysReferenced' :: Maybe OsPath -> v -> (Key -> OsPath -> v -> Annex v) -> Annex v withKeysReferenced' mdir initial a = do 	(files, clean) <- getfiles 	r <- go initial files@@ -221,7 +221,7 @@ 				top <- fromRepo Git.repoPath 				inRepo $ LsFiles.allFiles [] [top] 			)-		Just dir -> inRepo $ LsFiles.inRepo [] [toRawFilePath dir]+		Just dir -> inRepo $ LsFiles.inRepo [] [dir] 	go v [] = return v 	go v (f:fs) = do 		mk <- lookupKey f@@ -308,9 +308,9 @@  withUnusedMaps :: (UnusedMaps -> Int -> CommandStart) -> CmdParams -> CommandSeek withUnusedMaps a params = do-	unused <- readUnusedMap ""-	unusedbad <- readUnusedMap "bad"-	unusedtmp <- readUnusedMap "tmp"+	unused <- readUnusedMap (literalOsPath "")+	unusedbad <- readUnusedMap (literalOsPath "bad")+	unusedtmp <- readUnusedMap (literalOsPath "tmp") 	let m = unused `M.union` unusedbad `M.union` unusedtmp 	let unusedmaps = UnusedMaps unused unusedbad unusedtmp 	commandActions $ map (a unusedmaps) $ concatMap (unusedSpec m) params
Command/Vicfg.hs view
@@ -34,7 +34,7 @@ import Remote import Git.Types (fromConfigKey, fromConfigValue) import Utility.DataUnits-import qualified Utility.RawFilePath as R+import qualified Utility.FileIO as F  cmd :: Command cmd = command "vicfg" SectionSetup "edit configuration in git-annex branch"@@ -46,27 +46,35 @@ start :: CommandStart start = do 	f <- fromRepo gitAnnexTmpCfgFile-	let f' = fromRawFilePath f 	createAnnexDirectory $ parentDir f 	cfg <- getCfg 	descs <- uuidDescriptions-	liftIO $ writeFile f' $ genCfg cfg descs-	vicfg cfg f'+	liftIO $ writeFile (fromOsPath f) $ genCfg cfg descs+	vicfg cfg f 	stop -vicfg :: Cfg -> FilePath -> Annex ()+vicfg :: Cfg -> OsPath -> Annex () vicfg curcfg f = do 	vi <- liftIO $ catchDefaultIO "vi" $ getEnv "EDITOR"-	-- Allow EDITOR to be processed by the shell, so it can contain options.-	unlessM (liftIO $ boolSystem "sh" [Param "-c", Param $ unwords [vi, shellEscape f]]) $+	unlessM (liftIO $ boolSystem "sh" (shparams vi)) $ 		giveup $ vi ++ " exited nonzero; aborting"-	r <- parseCfg (defCfg curcfg) <$> liftIO (readFileStrict f)-	liftIO $ removeWhenExistsWith R.removeLink (toRawFilePath f)+	r <- liftIO $ parseCfg (defCfg curcfg) +		. map decodeBS+		. fileLines'+		<$> F.readFile' f+	liftIO $ removeWhenExistsWith removeFile f 	case r of 		Left s -> do-			liftIO $ writeFile f s+			liftIO $ writeFile (fromOsPath f) s 			vicfg curcfg f 		Right newcfg -> setCfg curcfg newcfg+  where+	-- Allow EDITOR to be processed by the shell,+	-- so it can contain options.+	shparams editor = +		[ Param "-c"+		, Param $ unwords [editor, shellEscape (fromOsPath f)]+		]  data Cfg = Cfg 	{ cfgTrustMap :: M.Map UUID (Down TrustLevel)@@ -278,8 +286,8 @@  {- If there's a parse error, returns a new version of the file,  - with the problem lines noted. -}-parseCfg :: Cfg -> String -> Either String Cfg-parseCfg defcfg = go [] defcfg . lines+parseCfg :: Cfg -> [String] -> Either String Cfg+parseCfg defcfg = go [] defcfg   where 	go c cfg [] 		| null (mapMaybe fst c) = Right cfg
Command/View.hs view
@@ -24,8 +24,6 @@ import Types.AdjustedBranch import Annex.AdjustedBranch.Name -import qualified System.FilePath.ByteString as P- cmd :: Command cmd = notBareRepo $ 	command "view" SectionMetaData "enter a view branch"@@ -120,13 +118,12 @@ 		forM_ l (removeemptydir top) 		liftIO $ void cleanup 		unlessM (liftIO $ doesDirectoryExist here) $ do-			showLongNote $ UnquotedString $ cwdmissing (fromRawFilePath top)+			showLongNote $ UnquotedString $ cwdmissing (fromOsPath top) 	return ok   where 	removeemptydir top d = do 		p <- inRepo $ toTopFilePath d-		liftIO $ tryIO $ removeDirectory $-			fromRawFilePath $ (top P.</> getTopFilePath p)+		liftIO $ tryIO $ removeDirectory $ top </> getTopFilePath p 	cwdmissing top = unlines 		[ "This view does not include the subdirectory you are currently in." 		, "Perhaps you should:  cd " ++ top
Command/WebApp.hs view
@@ -86,15 +86,15 @@ 		listenPort' <- if isJust (listenPort o) 			then pure (listenPort o) 			else annexPort <$> Annex.getGitConfig-		ifM (checkpid <&&> checkshim (fromRawFilePath f))+		ifM (checkpid <&&> checkshim f) 			( if isJust (listenAddress o) || isJust (listenPort o) 				then giveup "The assistant is already running, so --listen and --port cannot be used." 				else do-					url <- liftIO . readFile . fromRawFilePath+					url <- liftIO . readFile . fromOsPath 						=<< fromRepo gitAnnexUrlFile 					liftIO $ if isJust listenAddress' 						then putStrLn url-						else liftIO $ openBrowser browser (fromRawFilePath f) url Nothing Nothing+						else liftIO $ openBrowser browser f url Nothing Nothing 			, do 				startDaemon True True Nothing cannotrun listenAddress' listenPort' $ Just $  					\origout origerr url htmlshim ->@@ -104,11 +104,11 @@ 			) 	checkpid = do 		pidfile <- fromRepo gitAnnexPidFile-		liftIO $ isJust <$> checkDaemon (fromRawFilePath pidfile)+		liftIO $ isJust <$> checkDaemon pidfile 	checkshim f = liftIO $ doesFileExist f 	notinitialized = do 		g <- Annex.gitRepo-		liftIO $ cannotStartIn (Git.repoLocation g) "repository has not been initialized by git-annex"+		liftIO $ cannotStartIn (Git.repoPath g) "repository has not been initialized by git-annex" 		liftIO $ firstRun o  {- If HOME is a git repo, even if it's initialized for git-annex,@@ -117,7 +117,7 @@ notHome = do 	g <- Annex.gitRepo 	d <- liftIO $ absPath (Git.repoPath g)-	h <- liftIO $ absPath . toRawFilePath =<< myHomeDir+	h <- liftIO $ absPath . toOsPath =<< myHomeDir 	return (d /= h)  {- When run without a repo, start the first available listed repository in@@ -136,14 +136,15 @@ 				go ds 			Right state -> void $ Annex.eval state $ do 				whenM (fromRepo Git.repoIsLocalBare) $-					giveup $ d ++ " is a bare git repository, cannot run the webapp in it"+					giveup $ fromOsPath d ++ " is a bare git repository, cannot run the webapp in it" 				r <- callCommandAction $ 					start' False o 				quiesce False 				return r -cannotStartIn :: FilePath -> String -> IO ()-cannotStartIn d reason = warningIO $ "unable to start webapp in repository " ++ d ++ ": " ++ reason+cannotStartIn :: OsPath -> String -> IO ()+cannotStartIn d reason = warningIO $+	"unable to start webapp in repository " ++ fromOsPath d ++ ": " ++ reason  {- Run the webapp without a repository, which prompts the user, makes one,  - changes to it, starts the regular assistant, and redirects the@@ -203,12 +204,12 @@ 					(Just $ sendurlback v) 	sendurlback v _origout _origerr url _htmlshim = putMVar v url -openBrowser :: Maybe FilePath -> FilePath -> String -> Maybe Handle -> Maybe Handle -> IO ()+openBrowser :: Maybe OsPath -> OsPath -> String -> Maybe Handle -> Maybe Handle -> IO () openBrowser mcmd htmlshim realurl outh errh = do-	htmlshim' <- fromRawFilePath <$> absPath (toRawFilePath htmlshim)+	htmlshim' <- absPath htmlshim 	openBrowser' mcmd htmlshim' realurl outh errh -openBrowser' :: Maybe FilePath -> FilePath -> String -> Maybe Handle -> Maybe Handle -> IO ()+openBrowser' :: Maybe OsPath -> OsPath -> String -> Maybe Handle -> Maybe Handle -> IO () openBrowser' mcmd htmlshim realurl outh errh = 	ifM osAndroid 		{- Android does not support file:// urls well, but neither@@ -220,7 +221,7 @@   where 	runbrowser url = do 		let p = case mcmd of-			Just c -> proc c [url]+			Just c -> proc (fromOsPath c) [url] 			Nothing ->  #ifndef mingw32_HOST_OS 				browserProc url@@ -228,8 +229,8 @@ 				{- Windows hack to avoid using the full path, 				 - which might contain spaces that cause problems 				 - for browserProc. -}-				(browserProc (takeFileName htmlshim))-					{ cwd = Just (takeDirectory htmlshim) } +				(browserProc (fromOsPath (takeFileName htmlshim)))+					{ cwd = Just (fromOsPath (takeDirectory htmlshim)) }  #endif 		hPutStrLn (fromMaybe stdout outh) $ "Launching web browser on " ++ url 		hFlush stdout@@ -245,8 +246,8 @@ 				hPutStrLn (fromMaybe stderr errh) "failed to start web browser"  {- web.browser is a generic git config setting for a web browser program -}-webBrowser :: Git.Repo -> Maybe FilePath+webBrowser :: Git.Repo -> Maybe OsPath webBrowser = fmap fromConfigValue <$> Git.Config.getMaybe "web.browser" -fileUrl :: FilePath -> String-fileUrl file = "file://" ++ file+fileUrl :: OsPath -> String+fileUrl file = "file://" ++ fromOsPath file
Command/WhereUsed.hs view
@@ -70,9 +70,9 @@   where 	-- Some associated files that are in the keys database may no 	-- longer correspond to files in the repository.-	stillassociated f = catKeyFile f >>= \case-		Just k | k == key -> return True-		_ -> return False+	stillassociated f = catKeyFile f >>= return . \case+		Just k | k == key -> True+		_ -> False  display :: Key -> StringContainingQuotedPath -> Annex () display key loc = do@@ -124,7 +124,7 @@ 		display key (descBranchFilePath (BranchFilePath r tf)) 		return True -searchLog :: Key -> [CommandParam] -> (S.ByteString -> [RawFilePath] -> Annex Bool) -> Annex Bool+searchLog :: Key -> [CommandParam] -> (S.ByteString -> [OsPath] -> Annex Bool) -> Annex Bool searchLog key ps a = do 	(output, cleanup) <- Annex.inRepo $ Git.Command.pipeNullSplit ps' 	found <- case output of@@ -154,7 +154,7 @@ 		-- so a regexp is used. Since annex pointer files 		-- may contain a newline followed by perhaps something 		-- else, that is also matched.-		, Param ("-G" ++ escapeRegexp (fromRawFilePath (keyFile key)) ++ "($|\n)")+		, Param ("-G" ++ escapeRegexp (fromOsPath (keyFile key)) ++ "($|\n)") 		-- Skip commits where the file was deleted, 		-- only find those where it was added or modified. 		, Param "--diff-filter=ACMRTUX"
Command/Whereis.hs view
@@ -67,7 +67,7 @@   where 	ww = WarnUnmatchLsFiles "whereis" -start :: WhereisOptions -> M.Map UUID Remote -> SeekInput -> RawFilePath -> Key -> CommandStart+start :: WhereisOptions -> M.Map UUID Remote -> SeekInput -> OsPath -> Key -> CommandStart start o remotemap si file key =  	startKeys o remotemap (si, key, mkActionItem (key, afile))   where
Common.hs view
@@ -10,7 +10,6 @@ import Data.Monoid as X import Data.Default as X -import System.FilePath as X import System.IO as X hiding (FilePath) import System.Exit as X import System.PosixCompat.Files as X (FileStatus)@@ -24,6 +23,7 @@ import Utility.Path as X import Utility.Path.AbsRel as X import Utility.Directory as X+import Utility.SystemDirectory as X import Utility.MoveFile as X import Utility.Monad as X import Utility.Data as X@@ -32,5 +32,6 @@ import Utility.Network as X import Utility.Split as X import Utility.FileSystemEncoding as X+import Utility.OsPath as X  import Utility.PartialPrelude as X
Config.hs view
@@ -94,7 +94,7 @@ setCrippledFileSystem b = 	setConfig (annexConfig "crippledfilesystem") (Git.Config.boolConfig b) -pidLockFile :: Annex (Maybe RawFilePath)+pidLockFile :: Annex (Maybe OsPath) #ifndef mingw32_HOST_OS pidLockFile = ifM (annexPidLock <$> Annex.getGitConfig) 	( Just <$> Annex.fromRepo gitAnnexPidLockFile@@ -111,4 +111,4 @@ 	branch = Git.Ref b 	subdir = if S.null p 		then Nothing-		else Just (asTopFilePath p)+		else Just (asTopFilePath (toOsPath p))
Config/Files.hs view
@@ -5,32 +5,31 @@  - Licensed under the GNU AGPL version 3 or higher.  -} +{-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_GHC -fno-warn-tabs #-}  module Config.Files where +import Common import Utility.FreeDesktop-import Utility.Exception -import System.FilePath- {- ~/.config/git-annex/file -}-userConfigFile :: FilePath -> IO FilePath+userConfigFile :: OsPath -> IO OsPath userConfigFile file = do 	dir <- userConfigDir-	return $ dir </> "git-annex" </> file+	return $ dir </> literalOsPath "git-annex" </> file -autoStartFile :: IO FilePath-autoStartFile = userConfigFile "autostart"+autoStartFile :: IO OsPath+autoStartFile = userConfigFile (literalOsPath "autostart")  {- The path to git-annex is written here; which is useful when something  - has installed it to some awful non-PATH location. -}-programFile :: IO FilePath-programFile = userConfigFile "program"+programFile :: IO OsPath+programFile = userConfigFile (literalOsPath "program")  {- A .noannex file in a git repository prevents git-annex from  - initializing that repository. The content of the file is returned. -}-noAnnexFileContent :: Maybe FilePath -> IO (Maybe String)+noAnnexFileContent :: Maybe OsPath -> IO (Maybe String) noAnnexFileContent repoworktree = case repoworktree of 	Nothing -> return Nothing-	Just wt -> catchMaybeIO (readFile (wt </> ".noannex"))+	Just wt -> catchMaybeIO (readFile (fromOsPath (wt </> literalOsPath ".noannex")))
Config/Files/AutoStart.hs view
@@ -14,36 +14,36 @@ import Utility.Tmp  {- Returns anything listed in the autostart file (which may not exist). -}-readAutoStartFile :: IO [FilePath]+readAutoStartFile :: IO [OsPath] readAutoStartFile = do 	f <- autoStartFile-	filter valid . nub . map dropTrailingPathSeparator . lines-		<$> catchDefaultIO "" (readFile f)+	filter valid . nub . map (dropTrailingPathSeparator . toOsPath) . lines+		<$> catchDefaultIO "" (readFile (fromOsPath f))   where 	-- Ignore any relative paths; some old buggy versions added eg "." 	valid = isAbsolute -modifyAutoStartFile :: ([FilePath] -> [FilePath]) -> IO ()+modifyAutoStartFile :: ([OsPath] -> [OsPath]) -> IO () modifyAutoStartFile func = do 	dirs <- readAutoStartFile 	let dirs' = nubBy equalFilePath $ func dirs 	when (dirs' /= dirs) $ do 		f <- autoStartFile-		createDirectoryIfMissing True $-			fromRawFilePath (parentDir (toRawFilePath f))-		viaTmp writeFile f $ unlines dirs'+		createDirectoryIfMissing True (parentDir f)+		viaTmp (writeFile . fromRawFilePath . fromOsPath) f+			(unlines (map fromOsPath dirs'))  {- Adds a directory to the autostart file. If the directory is already  - present, it's moved to the top, so it will be used as the default  - when opening the webapp. -}-addAutoStartFile :: FilePath -> IO ()+addAutoStartFile :: OsPath -> IO () addAutoStartFile path = do-	path' <- fromRawFilePath <$> absPath (toRawFilePath path)+	path' <- absPath path 	modifyAutoStartFile $ (:) path'  {- Removes a directory from the autostart file. -}-removeAutoStartFile :: FilePath -> IO ()+removeAutoStartFile :: OsPath -> IO () removeAutoStartFile path = do-	path' <- fromRawFilePath <$> absPath (toRawFilePath path)+	path' <- absPath path 	modifyAutoStartFile $ 		filter (not . equalFilePath path')
Config/Smudge.hs view
@@ -17,8 +17,9 @@ import Config import Utility.Directory.Create import Annex.Version+import qualified Utility.FileIO as F -import qualified System.FilePath.ByteString as P+import qualified Data.ByteString as S  configureSmudgeFilter :: Annex () configureSmudgeFilter = unlessM (fromRepo Git.repoIsLocalBare) $ do@@ -44,11 +45,12 @@ 	lfs <- readattr lf 	gfs <- readattr gf 	gittop <- Git.localGitDir <$> gitRepo-	liftIO $ unless ("filter=annex" `isInfixOf` (lfs ++ gfs)) $ do-		createDirectoryUnder [gittop] (P.takeDirectory lf)-		writeFile (fromRawFilePath lf) (lfs ++ "\n" ++ unlines stdattr)+	liftIO $ unless ("filter=annex" `S.isInfixOf` (lfs <> gfs)) $ do+		createDirectoryUnder [gittop] (takeDirectory lf)+		F.writeFile' lf $+			linesFile' (lfs <> encodeBS ("\n" ++ unlines stdattr))   where-	readattr = liftIO . catchDefaultIO "" . readFileStrict . fromRawFilePath+	readattr = liftIO . catchDefaultIO mempty . F.readFile'  configureSmudgeFilterProcess :: Annex () configureSmudgeFilterProcess =@@ -65,9 +67,10 @@ -- git-annex does not commit that. deconfigureSmudgeFilter :: Annex () deconfigureSmudgeFilter = do-	lf <- fromRawFilePath <$> Annex.fromRepo Git.attributesLocal-	ls <- liftIO $ catchDefaultIO [] $ lines <$> readFileStrict lf-	liftIO $ writeFile lf $ unlines $+	lf <- Annex.fromRepo Git.attributesLocal+	ls <- liftIO $ catchDefaultIO [] $ +		map decodeBS . fileLines' <$> F.readFile' lf+	liftIO $ writeFile (fromOsPath lf) $ unlines $ 		filter (\l -> l `notElem` stdattr && not (null l)) ls 	unsetConfig (ConfigKey "filter.annex.smudge") 	unsetConfig (ConfigKey "filter.annex.clean")
Creds.hs view
@@ -36,17 +36,16 @@ import Remote.Helper.Encryptable (remoteCipher, remoteCipher', embedCreds, EncryptionIsSetup, extractCipher) import Utility.Env (getEnv) import Utility.Base64-import qualified Utility.RawFilePath as R+import qualified Utility.FileIO as F -import qualified Data.ByteString.Lazy.Char8 as L-import qualified Data.ByteString.Char8 as S+import qualified Data.ByteString.Lazy.Char8 as L8+import qualified Data.ByteString.Char8 as S8 import qualified Data.Map as M-import qualified System.FilePath.ByteString as P  {- A CredPair can be stored in a file, or in the environment, or  - in a remote's configuration. -} data CredPairStorage = CredPairStorage-	{ credPairFile :: FilePath+	{ credPairFile :: OsPath 	, credPairEnvironment :: (String, String) 	, credPairRemoteField :: RemoteConfigField 	}@@ -99,7 +98,7 @@ 	storeconfig creds key (Just cipher) = do 		cmd <- gpgCmd <$> Annex.getGitConfig 		s <- liftIO $ encrypt cmd (pc, gc) cipher-			(feedBytes $ L.pack $ encodeCredPair creds)+			(feedBytes $ L8.pack $ encodeCredPair creds) 			(readBytesStrictly return) 		storeconfig' key (Accepted (decodeBS (toB64 s))) 	storeconfig creds key Nothing =@@ -135,8 +134,8 @@ 	fromenccreds enccreds cipher storablecipher = do 		cmd <- gpgCmd <$> Annex.getGitConfig 		mcreds <- liftIO $ catchMaybeIO $ decrypt cmd (c, gc) cipher-			(feedBytes $ L.fromStrict $ fromB64 enccreds)-			(readBytesStrictly $ return . S.unpack)+			(feedBytes $ L8.fromStrict $ fromB64 enccreds)+			(readBytesStrictly $ return . S8.unpack) 		case mcreds of 			Just creds -> fromcreds creds 			Nothing -> do@@ -195,18 +194,21 @@  {- Stores the creds in a file inside gitAnnexCredsDir that only the user  - can read. -}-writeCreds :: Creds -> FilePath -> Annex ()+writeCreds :: Creds -> OsPath -> Annex () writeCreds creds file = do 	d <- fromRepo gitAnnexCredsDir 	createAnnexDirectory d-	liftIO $ writeFileProtected (d P.</> toRawFilePath file) creds+	liftIO $ writeFileProtected (d </> file) creds -readCreds :: FilePath -> Annex (Maybe Creds)-readCreds f = liftIO . catchMaybeIO . readFileStrict =<< credsFile f+readCreds :: OsPath -> Annex (Maybe Creds)+readCreds f = do+	f' <- credsFile f+	liftIO $ catchMaybeIO $ decodeBS . S8.unlines . fileLines'+		<$> F.readFile' f' -credsFile :: FilePath -> Annex FilePath+credsFile :: OsPath -> Annex OsPath credsFile basefile = do-	d <- fromRawFilePath <$> fromRepo gitAnnexCredsDir+	d <- fromRepo gitAnnexCredsDir 	return $ d </> basefile  encodeCredPair :: CredPair -> Creds@@ -217,10 +219,10 @@ 	l:p:[] -> Just (l, p) 	_ -> Nothing -removeCreds :: FilePath -> Annex ()+removeCreds :: OsPath -> Annex () removeCreds file = do 	d <- fromRepo gitAnnexCredsDir-	liftIO $ removeWhenExistsWith R.removeLink (d P.</> toRawFilePath file)+	liftIO $ removeWhenExistsWith removeFile (d </> file)  includeCredsInfo :: ParsedRemoteConfig -> CredPairStorage -> [(String, String)] -> Annex [(String, String)] includeCredsInfo pc@(ParsedRemoteConfig cm _) storage info = do
Crypto.hs view
@@ -211,7 +211,7 @@ 	Cipher{} ->  		let passphrase = cipherPassphrase cipher 		in case statelessOpenPGPCommand c of-			Just sopcmd -> withTmpDir "sop" $ \d ->+			Just sopcmd -> withTmpDir (literalOsPath "sop") $ \d -> 				SOP.encryptSymmetric sopcmd passphrase 					(SOP.EmptyDirectory d) 					(statelessOpenPGPProfile c)@@ -233,7 +233,7 @@ 	Cipher{} ->  		let passphrase = cipherPassphrase cipher 		in case statelessOpenPGPCommand c of-			Just sopcmd -> withTmpDir "sop" $ \d ->+			Just sopcmd -> withTmpDir (literalOsPath "sop") $ \d -> 				SOP.decryptSymmetric sopcmd passphrase 					(SOP.EmptyDirectory d) 					feeder reader
Database/Benchmark.hs view
@@ -26,13 +26,12 @@ import qualified Data.ByteString.Char8 as B8 import System.Random import Control.Concurrent-import qualified System.FilePath.ByteString as P #endif  benchmarkDbs :: CriterionMode -> Integer -> Annex () #ifdef WITH_BENCHMARK-benchmarkDbs mode n = withTmpDirIn "." "benchmark" $ \tmpdir -> do-	db <- benchDb (toRawFilePath tmpdir) n+benchmarkDbs mode n = withTmpDirIn (literalOsPath ".") (literalOsPath "benchmark") $ \tmpdir -> do+	db <- benchDb tmpdir n 	liftIO $ runMode mode 		[ bgroup "keys database" 			[ getAssociatedFilesHitBench db@@ -93,7 +92,7 @@ 	}  fileN :: Integer -> TopFilePath-fileN n = asTopFilePath (toRawFilePath ("file" ++ show n))+fileN n = asTopFilePath (toOsPath ("file" ++ show n))  keyMiss :: Key keyMiss = keyN 0 -- 0 is never stored@@ -103,7 +102,7 @@  data BenchDb = BenchDb H.DbQueue Integer (MVar Integer) -benchDb :: RawFilePath -> Integer -> Annex BenchDb+benchDb :: OsPath -> Integer -> Annex BenchDb benchDb tmpdir num = do 	liftIO $ putStrLn $ "setting up database with " ++ show num ++ " items" 	initDb db SQL.createTables@@ -115,6 +114,6 @@ 	mv <- liftIO $ newMVar 1 	return (BenchDb h num mv)   where-	db = tmpdir P.</> toRawFilePath (show num </> "db")+	db = tmpdir </> toOsPath (show num) </> literalOsPath "db"  #endif /* WITH_BENCHMARK */
Database/ContentIdentifier.hs view
@@ -47,11 +47,9 @@ import qualified Git.DiffTree as DiffTree import Logs import qualified Logs.ContentIdentifier as Log-import qualified Utility.RawFilePath as R  import Database.Persist.Sql hiding (Key) import Database.Persist.TH-import qualified System.FilePath.ByteString as P  #if MIN_VERSION_persistent_sqlite(2,13,3) import Database.RawFilePath@@ -98,15 +96,15 @@ openDb :: Annex ContentIdentifierHandle openDb = do 	dbdir <- calcRepo' gitAnnexContentIdentifierDbDir-	let db = dbdir P.</> "db"-	isnew <- liftIO $ not <$> R.doesPathExist db+	let db = dbdir </> literalOsPath "db"+	isnew <- liftIO $ not <$> doesFileExist db 	if isnew 		then initDb db $ void $  			runMigrationSilent migrateContentIdentifier 		-- Migrate from old versions of database, which had buggy 		-- and suboptimal uniqueness constraints. #if MIN_VERSION_persistent_sqlite(2,13,3)-		else liftIO $ runSqlite' db $ void $+		else liftIO $ runSqlite' (fromOsPath db) $ void $ 			runMigrationSilent migrateContentIdentifier #else 		else liftIO $ runSqlite (T.pack (fromRawFilePath db)) $ void $
Database/Export.hs view
@@ -58,11 +58,9 @@ import Git.Sha import Git.FilePath import qualified Git.DiffTree-import qualified Utility.RawFilePath as R  import Database.Persist.Sql hiding (Key) import Database.Persist.TH-import qualified System.FilePath.ByteString as P  data ExportHandle = ExportHandle H.DbQueue UUID @@ -98,8 +96,8 @@ openDb :: UUID -> Annex ExportHandle openDb u = do 	dbdir <- calcRepo' (gitAnnexExportDbDir u)-	let db = dbdir P.</> "db"-	unlessM (liftIO $ R.doesPathExist db) $ do+	let db = dbdir </> literalOsPath "db"+	unlessM (liftIO $ doesFileExist db) $ do 		initDb db $ void $ 			runMigrationSilent migrateExport 	h <- liftIO $ H.openDbQueue db "exported"@@ -136,26 +134,27 @@ addExportedLocation h k el = queueDb h $ do 	void $ insertUniqueFast $ Exported k ef 	let edirs = map-		(\ed -> ExportedDirectory (SByteString (fromExportDirectory ed)) ef)+		(\ed -> ExportedDirectory (SByteString (fromOsPath (fromExportDirectory ed))) ef) 		(exportDirectories el) 	putMany edirs   where-	ef = SByteString (fromExportLocation el)+	ef = SByteString (fromOsPath (fromExportLocation el))  removeExportedLocation :: ExportHandle -> Key -> ExportLocation -> IO () removeExportedLocation h k el = queueDb h $ do 	deleteWhere [ExportedKey ==. k, ExportedFile ==. ef]-	let subdirs = map (SByteString . fromExportDirectory)+	let subdirs = map+		(SByteString . fromOsPath . fromExportDirectory) 		(exportDirectories el) 	deleteWhere [ExportedDirectoryFile ==. ef, ExportedDirectorySubdir <-. subdirs]   where-	ef = SByteString (fromExportLocation el)+	ef = SByteString (fromOsPath (fromExportLocation el))  {- Note that this does not see recently queued changes. -} getExportedLocation :: ExportHandle -> Key -> IO [ExportLocation] getExportedLocation (ExportHandle h _) k = H.queryDbQueue h $ do 	l <- selectList [ExportedKey ==. k] []-	return $ map (mkExportLocation . (\(SByteString f) -> f) . exportedFile . entityVal) l+	return $ map (mkExportLocation . (\(SByteString f) -> toOsPath f) . exportedFile . entityVal) l  {- Note that this does not see recently queued changes. -} isExportDirectoryEmpty :: ExportHandle -> ExportDirectory -> IO Bool@@ -163,13 +162,13 @@ 	l <- selectList [ExportedDirectorySubdir ==. ed] [] 	return $ null l   where-	ed = SByteString $ fromExportDirectory d+	ed = SByteString $ fromOsPath $ fromExportDirectory d  {- Get locations in the export that might contain a key. -} getExportTree :: ExportHandle -> Key -> IO [ExportLocation] getExportTree (ExportHandle h _) k = H.queryDbQueue h $ do 	l <- selectList [ExportTreeKey ==. k] []-	return $ map (mkExportLocation . (\(SByteString f) -> f) . exportTreeFile . entityVal) l+	return $ map (mkExportLocation . (\(SByteString f) -> toOsPath f) . exportTreeFile . entityVal) l  {- Get keys that might be currently exported to a location.  -@@ -180,19 +179,19 @@ 	map (exportTreeKey . entityVal)  		<$> selectList [ExportTreeFile ==. ef] []   where-	ef = SByteString (fromExportLocation el)+	ef = SByteString (fromOsPath (fromExportLocation el))  addExportTree :: ExportHandle -> Key -> ExportLocation -> IO () addExportTree h k loc = queueDb h $ 	void $ insertUniqueFast $ ExportTree k ef   where-	ef = SByteString (fromExportLocation loc)+	ef = SByteString (fromOsPath (fromExportLocation loc))  removeExportTree :: ExportHandle -> Key -> ExportLocation -> IO () removeExportTree h k loc = queueDb h $ 	deleteWhere [ExportTreeKey ==. k, ExportTreeFile ==. ef]   where-	ef = SByteString (fromExportLocation loc)+	ef = SByteString (fromOsPath (fromExportLocation loc))  -- An action that is passed the old and new values that were exported, -- and updates state.
Database/Fsck.hs view
@@ -33,12 +33,10 @@ import Utility.Exception import Annex.Common import Annex.LockFile-import qualified Utility.RawFilePath as R  import Database.Persist.Sql hiding (Key) import Database.Persist.TH import Data.Time.Clock-import qualified System.FilePath.ByteString as P  data FsckHandle = FsckHandle H.DbQueue UUID @@ -66,14 +64,14 @@ 	go = do 		removedb =<< calcRepo' (gitAnnexFsckDbDir u) 		removedb =<< calcRepo' (gitAnnexFsckDbDirOld u)-	removedb = liftIO . void . tryIO . removeDirectoryRecursive . fromRawFilePath+	removedb = liftIO . void . tryIO . removeDirectoryRecursive  {- Opens the database, creating it if it doesn't exist yet. -} openDb :: UUID -> Annex FsckHandle openDb u = do 	dbdir <- calcRepo' (gitAnnexFsckDbDir u)-	let db = dbdir P.</> "db"-	unlessM (liftIO $ R.doesPathExist db) $ do+	let db = dbdir </> literalOsPath "db"+	unlessM (liftIO $ doesFileExist db) $ do 		initDb db $ void $ 			runMigrationSilent migrateFsck 	lockFileCached =<< calcRepo' (gitAnnexFsckDbLock u)
Database/Handle.hs view
@@ -23,6 +23,7 @@ import Utility.Debug import Utility.DebugLocks import Utility.InodeCache+import Utility.OsPath  import Database.Persist.Sqlite import qualified Database.Sqlite as Sqlite@@ -41,14 +42,14 @@ {- A DbHandle is a reference to a worker thread that communicates with  - the database. It has a MVar which Jobs are submitted to.   - There is also an MVar which it will fill when there is a fatal error-}-data DbHandle = DbHandle RawFilePath (Async ()) (MVar Job) (MVar String)+data DbHandle = DbHandle OsPath (Async ()) (MVar Job) (MVar String)  {- Name of a table that should exist once the database is initialized. -} type TableName = String  {- Opens the database, but does not perform any migrations. Only use  - once the database is known to exist and have the right tables. -}-openDb :: RawFilePath -> TableName -> IO DbHandle+openDb :: OsPath -> TableName -> IO DbHandle openDb db tablename = do 	jobs <- newEmptyMVar 	errvar <- newEmptyMVar@@ -135,7 +136,7 @@ 	| ChangeJob (SqlPersistM ()) 	| CloseJob -workerThread :: RawFilePath -> TableName -> MVar Job -> MVar String -> IO ()+workerThread :: OsPath -> TableName -> MVar Job -> MVar String -> IO () workerThread db tablename jobs errvar = newconn   where 	newconn = do@@ -174,7 +175,7 @@  - retrying only if the database shows signs of being modified by another  - process at least once each 30 seconds.  -}-runSqliteRobustly :: TableName -> RawFilePath -> (SqlPersistM a) -> IO a+runSqliteRobustly :: TableName -> OsPath -> (SqlPersistM a) -> IO a runSqliteRobustly tablename db a = do 	conn <- opensettle maxretries emptyDatabaseInodeCache 	go conn maxretries emptyDatabaseInodeCache@@ -194,9 +195,9 @@ 	 	opensettle retries ic = do #if MIN_VERSION_persistent_sqlite(2,13,3)-		conn <- Sqlite.open' db+		conn <- Sqlite.open' (fromOsPath db) #else-		conn <- Sqlite.open (T.pack (fromRawFilePath db))+		conn <- Sqlite.open (T.pack (fromOsPath db)) #endif 		settle conn retries ic @@ -237,7 +238,7 @@ 		, BaseBackend backend ~ SqlBackend 		, BackendCompatible SqlBackend backend 	    )-	=> RawFilePath+	=> OsPath 	-> (LogFunc -> IO backend) 	-> (backend -> m a) 	-> m a@@ -260,7 +261,7 @@ 		, BaseBackend backend ~ SqlBackend 		, BackendCompatible SqlBackend backend 	   )-	=> RawFilePath+	=> OsPath 	-> backend 	-> IO () closeRobustly db conn = go maxretries emptyDatabaseInodeCache@@ -294,7 +295,7 @@ 	=> String 	-> err 	-> Int-	-> RawFilePath+	-> OsPath 	-> Int 	-> DatabaseInodeCache 	-> (Int -> DatabaseInodeCache -> IO a)@@ -309,9 +310,9 @@ 				else giveup (databaseAccessStalledMsg action db err) 		else a retries' ic -databaseAccessStalledMsg :: Show err => String -> RawFilePath -> err -> String+databaseAccessStalledMsg :: Show err => String -> OsPath -> err -> String databaseAccessStalledMsg action db err =-	"Repeatedly unable to " ++ action ++ " sqlite database " ++ fromRawFilePath db +	"Repeatedly unable to " ++ action ++ " sqlite database " ++ fromOsPath db  		++ ": " ++ show err ++ ". " 		++ "Perhaps another git-annex process is suspended and is " 		++ "keeping this database locked?"@@ -321,10 +322,10 @@ emptyDatabaseInodeCache :: DatabaseInodeCache emptyDatabaseInodeCache = DatabaseInodeCache Nothing Nothing -getDatabaseInodeCache :: RawFilePath -> IO DatabaseInodeCache+getDatabaseInodeCache :: OsPath -> IO DatabaseInodeCache getDatabaseInodeCache db = DatabaseInodeCache 	<$> genInodeCache db noTSDelta-	<*> genInodeCache (db <> "-wal") noTSDelta+	<*> genInodeCache (db <> literalOsPath "-wal") noTSDelta  isDatabaseModified :: DatabaseInodeCache -> DatabaseInodeCache -> Bool isDatabaseModified (DatabaseInodeCache a1 b1) (DatabaseInodeCache a2 b2) =
Database/ImportFeed.hs view
@@ -40,11 +40,9 @@ import Types.MetaData import Annex.MetaData.StandardFields import Annex.LockFile-import qualified Utility.RawFilePath as R  import Database.Persist.Sql hiding (Key) import Database.Persist.TH-import qualified System.FilePath.ByteString as P import qualified Data.ByteString as B import qualified Data.Set as S @@ -75,8 +73,8 @@ openDb :: Annex ImportFeedDbHandle openDb = do 	dbdir <- calcRepo' gitAnnexImportFeedDbDir-	let db = dbdir P.</> "db"-	isnew <- liftIO $ not <$> R.doesPathExist db+	let db = dbdir </> literalOsPath "db"+	isnew <- liftIO $ not <$> doesFileExist db 	when isnew $ 		initDb db $ void $  			runMigrationSilent migrateImportFeed
Database/Init.hs view
@@ -20,7 +20,6 @@ import Database.Persist.Sqlite import Lens.Micro import qualified Data.Text as T-import qualified System.FilePath.ByteString as P  {- Ensures that the database is freshly initialized. Deletes any  - existing database. Pass the migration action for the database.@@ -30,26 +29,26 @@  - file causes Sqlite to always use the same permissions for additional  - files it writes later on  -}-initDb :: P.RawFilePath -> SqlPersistM () -> Annex ()+initDb :: OsPath -> SqlPersistM () -> Annex () initDb db migration = do-	let dbdir = P.takeDirectory db-	let tmpdbdir = dbdir <> ".tmp"-	let tmpdb = tmpdbdir P.</> "db"-	let tmpdb' = T.pack (fromRawFilePath tmpdb)+	let dbdir = takeDirectory db+	let tmpdbdir = dbdir <> literalOsPath ".tmp"+	let tmpdb = tmpdbdir </> literalOsPath "db"+	let tmpdb' = fromOsPath tmpdb 	createAnnexDirectory tmpdbdir #if MIN_VERSION_persistent_sqlite(2,13,3)-	liftIO $ runSqliteInfo' tmpdb (enableWAL tmpdb') migration+	liftIO $ runSqliteInfo' tmpdb' (enableWAL tmpdb) migration #else-	liftIO $ runSqliteInfo (enableWAL tmpdb') migration+	liftIO $ runSqliteInfo (enableWAL tmpdb) migration #endif 	setAnnexDirPerm tmpdbdir 	-- Work around sqlite bug that prevents it from honoring 	-- less restrictive umasks.-	liftIO $ R.setFileMode tmpdb =<< defaultFileMode+	liftIO $ R.setFileMode tmpdb' =<< defaultFileMode 	setAnnexFilePerm tmpdb 	liftIO $ do-		void $ tryIO $ removeDirectoryRecursive (fromRawFilePath dbdir)-		R.rename tmpdbdir dbdir+		void $ tryIO $ removeDirectoryRecursive dbdir+		R.rename (fromOsPath tmpdbdir) (fromOsPath dbdir)  {- Make sure that the database uses WAL mode, to prevent readers  - from blocking writers, and prevent a writer from blocking readers.@@ -59,6 +58,6 @@  -  - Note that once WAL mode is enabled, it will persist whenever the  - database is opened. -}-enableWAL :: T.Text -> SqliteConnectionInfo+enableWAL :: OsPath -> SqliteConnectionInfo enableWAL db = over walEnabled (const True) $ -	mkSqliteConnectionInfo db+	mkSqliteConnectionInfo (T.pack (fromOsPath db))
Database/Keys.hs view
@@ -54,11 +54,10 @@ import qualified Git.Ref import Config import Config.Smudge-import qualified Utility.RawFilePath as R+import qualified Utility.OsString as OS  import qualified Data.ByteString as S import qualified Data.ByteString.Char8 as S8-import qualified System.FilePath.ByteString as P import Control.Concurrent.Async  {- Runs an action that reads from the database.@@ -129,8 +128,8 @@ 	lck <- calcRepo' gitAnnexKeysDbLock 	catchPermissionDenied permerr $ withExclusiveLock lck $ do 		dbdir <- calcRepo' gitAnnexKeysDbDir-		let db = dbdir P.</> "db"-		dbexists <- liftIO $ R.doesPathExist db+		let db = dbdir </> literalOsPath "db"+		dbexists <- liftIO $ doesFileExist db 		case dbexists of 			True -> open db False 			False -> do@@ -182,7 +181,7 @@ 	)  {- Include a known associated file along with any recorded in the database. -}-getAssociatedFilesIncluding :: AssociatedFile -> Key -> Annex [RawFilePath]+getAssociatedFilesIncluding :: AssociatedFile -> Key -> Annex [OsPath] getAssociatedFilesIncluding afile k = emptyWhenBare $ do 	g <- Annex.gitRepo 	l <- map (`fromTopFilePath` g) <$> getAssociatedFiles k@@ -201,7 +200,7 @@ 	SQL.removeAssociatedFile k  {- Stats the files, and stores their InodeCaches. -}-storeInodeCaches :: Key -> [RawFilePath] -> Annex ()+storeInodeCaches :: Key -> [OsPath] -> Annex () storeInodeCaches k fs = withTSDelta $ \d -> 	addInodeCaches k . catMaybes 		=<< liftIO (mapM (\f -> genInodeCache f d) fs)@@ -265,7 +264,7 @@ 	( return mempty 	, do 		gitindex <- inRepo currentIndexFile-		indexcache <- fromRawFilePath <$> calcRepo' gitAnnexKeysDbIndexCache+		indexcache <- fromOsPath <$> calcRepo' gitAnnexKeysDbIndexCache 		withTSDelta (liftIO . genInodeCache gitindex) >>= \case 			Just cur -> readindexcache indexcache >>= \case 				Nothing -> go cur indexcache =<< getindextree@@ -356,8 +355,9 @@ 		-- be a pointer file. And a pointer file that is replaced with 		-- a non-pointer file will match this. This is only a 		-- prefilter so that's ok.-		, Param $ "-G" ++ fromRawFilePath (toInternalGitPath $-			P.pathSeparator `S.cons` objectDir)+		, Param $ "-G" ++ +			fromOsPath (toInternalGitPath $+				pathSeparator `OS.cons` objectDir) 		-- Disable rename detection. 		, Param "--no-renames" 		-- Avoid other complications.@@ -371,6 +371,7 @@ 	procdiff mdfeeder (info:file:rest) conflicted 		| ":" `S.isPrefixOf` info = case S8.words info of 			(_colonsrcmode:dstmode:srcsha:dstsha:status:[]) -> do+				let file' = asTopFilePath (toOsPath file) 				let conflicted' = status == "U" 				-- avoid removing associated file when 				-- there is a merge conflict@@ -378,17 +379,15 @@ 					send mdfeeder (Ref srcsha) $ \case 						Just oldkey -> do 							liftIO $ SQL.removeAssociatedFile oldkey-								(asTopFilePath file)-								(SQL.WriteHandle qh)+								file' (SQL.WriteHandle qh) 							return True 						Nothing -> return False 				send mdfeeder (Ref dstsha) $ \case 					Just key -> do 						liftIO $ addassociatedfile key-							(asTopFilePath file)-							(SQL.WriteHandle qh)+							file' (SQL.WriteHandle qh) 						when (dstmode /= fmtTreeItemType TreeSymlink) $-							reconcilepointerfile (asTopFilePath file) key+							reconcilepointerfile file' key 						return True 					Nothing -> return False 				procdiff mdfeeder rest@@ -403,11 +402,11 @@ 	procmergeconflictdiff mdfeeder (info:file:rest) conflicted 		| ":" `S.isPrefixOf` info = case S8.words info of 			(_colonmode:_mode:sha:_sha:status:[]) -> do+				let file' = asTopFilePath (toOsPath file) 				send mdfeeder (Ref sha) $ \case 					Just key -> do 						liftIO $ SQL.addAssociatedFile key-							(asTopFilePath file)-							(SQL.WriteHandle qh)+							file' (SQL.WriteHandle qh) 						return True 					Nothing -> return False 				let conflicted' = status == "U"
Database/Keys/SQL.hs view
@@ -22,6 +22,7 @@ import qualified Database.Queue as H import Utility.InodeCache import Git.FilePath+import Utility.OsPath  import Database.Persist.Sql hiding (Key) import Database.Persist.TH@@ -84,7 +85,7 @@ 		(Associated k af) 		[AssociatedFile =. af, AssociatedKey =. k]   where-	af = SByteString (getTopFilePath f)+	af = SByteString (fromOsPath (getTopFilePath f))  -- Faster than addAssociatedFile, but only safe to use when the file -- was not associated with a different key before, as it does not delete@@ -93,14 +94,14 @@ newAssociatedFile k f = queueDb $ 	insert_ $ Associated k af   where-	af = SByteString (getTopFilePath f)+	af = SByteString (fromOsPath (getTopFilePath f))  {- Note that the files returned were once associated with the key, but  - some of them may not be any longer. -} getAssociatedFiles :: Key -> ReadHandle -> IO [TopFilePath] getAssociatedFiles k = readDb $ do 	l <- selectList [AssociatedKey ==. k] []-	return $ map (asTopFilePath . (\(SByteString f) -> f) . associatedFile . entityVal) l+	return $ map (asTopFilePath . toOsPath . (\(SByteString f) -> f) . associatedFile . entityVal) l  {- Gets any keys that are on record as having a particular associated file.  - (Should be one or none.) -}@@ -109,13 +110,13 @@ 	l <- selectList [AssociatedFile ==. af] [] 	return $ map (associatedKey . entityVal) l   where-	af = SByteString (getTopFilePath f)+	af = SByteString (fromOsPath (getTopFilePath f))  removeAssociatedFile :: Key -> TopFilePath -> WriteHandle -> IO () removeAssociatedFile k f = queueDb $ 	deleteWhere [AssociatedKey ==. k, AssociatedFile ==. af]   where-	af = SByteString (getTopFilePath f)+	af = SByteString (fromOsPath (getTopFilePath f))  addInodeCaches :: Key -> [InodeCache] -> WriteHandle -> IO () addInodeCaches k is = queueDb $
Database/Queue.hs view
@@ -19,9 +19,9 @@ ) where  import Utility.Monad-import Utility.RawFilePath import Utility.DebugLocks import Utility.Exception+import Utility.OsPath import Database.Handle  import Database.Persist.Sqlite@@ -39,7 +39,7 @@ {- Opens the database queue, but does not perform any migrations. Only use  - if the database is known to exist and have the right tables; ie after  - running initDb. -}-openDbQueue :: RawFilePath -> TableName -> IO DbQueue+openDbQueue :: OsPath -> TableName -> IO DbQueue openDbQueue db tablename = DQ 	<$> openDb db tablename 	<*> (newMVar =<< emptyQueue)
Database/RawFilePath.hs view
@@ -38,7 +38,7 @@ #if MIN_VERSION_persistent_sqlite(2,13,3) import Database.Persist.Sqlite import qualified Database.Sqlite as Sqlite-import qualified System.FilePath.ByteString as P+import Utility.RawFilePath (RawFilePath) import qualified Control.Exception as E import Control.Monad.Logger (MonadLoggerIO) import Control.Monad.IO.Unlift (MonadUnliftIO)@@ -47,7 +47,7 @@ import UnliftIO.Resource (ResourceT, runResourceT)  openWith'-	:: P.RawFilePath +	:: RawFilePath  	-> (SqlBackend -> Sqlite.Connection -> r) 	-> SqliteConnectionInfo 	-> LogFunc@@ -58,7 +58,7 @@ 	return $ f backend conn  runSqlite' :: (MonadUnliftIO m)-	=> P.RawFilePath+	=> RawFilePath 	-> ReaderT SqlBackend (NoLoggingT (ResourceT m)) a 	-> m a runSqlite' connstr = runResourceT@@ -68,7 +68,7 @@  withSqliteConn' 	:: (MonadUnliftIO m, MonadLoggerIO m)-	=> P.RawFilePath+	=> RawFilePath 	-> (SqlBackend -> m a) 	-> m a withSqliteConn' connstr = withSqliteConnInfo' connstr $@@ -76,7 +76,7 @@  runSqliteInfo' 	:: (MonadUnliftIO m)-	=> P.RawFilePath+	=> RawFilePath 	-> SqliteConnectionInfo 	-> ReaderT SqlBackend (NoLoggingT (ResourceT m)) a 	-> m a@@ -87,7 +87,7 @@  withSqliteConnInfo' 	:: (MonadUnliftIO m, MonadLoggerIO m)-        => P.RawFilePath+        => RawFilePath 	-> SqliteConnectionInfo 	-> (SqlBackend -> m a) 	-> m a
Database/RepoSize.hs view
@@ -42,11 +42,9 @@ import Database.Types import Annex.LockFile import Git.Types-import qualified Utility.RawFilePath as R  import Database.Persist.Sql hiding (Key) import Database.Persist.TH-import qualified System.FilePath.ByteString as P import qualified Data.Map.Strict as M import qualified Data.Set as S import Control.Exception@@ -107,8 +105,8 @@ openDb :: Annex RepoSizeHandle openDb = lockDbWhile permerr $ do 	dbdir <- calcRepo' gitAnnexRepoSizeDbDir-	let db = dbdir P.</> "db"-	unlessM (liftIO $ R.doesPathExist db) $ do+	let db = dbdir </> literalOsPath "db"+	unlessM (liftIO $ doesFileExist db) $ do 		initDb db $ void $ 			runMigrationSilent migrateRepoSizes 	h <- liftIO $ H.openDb db "repo_sizes"
Git.hs view
@@ -38,15 +38,14 @@ 	relPath, ) where -import qualified Data.ByteString as B import Network.URI (uriPath, uriScheme, unEscapeString) #ifndef mingw32_HOST_OS import System.Posix.Files #endif-import qualified System.FilePath.ByteString as P  import Common import Git.Types+import qualified Utility.OsString as OS #ifndef mingw32_HOST_OS import Utility.FileMode #endif@@ -56,37 +55,37 @@ repoDescribe Repo { remoteName = Just name } = name repoDescribe Repo { location = Url url } = show url repoDescribe Repo { location = UnparseableUrl url } = url-repoDescribe Repo { location = Local { worktree = Just dir } } = fromRawFilePath dir-repoDescribe Repo { location = Local { gitdir = dir } } = fromRawFilePath dir-repoDescribe Repo { location = LocalUnknown dir } = fromRawFilePath dir+repoDescribe Repo { location = Local { worktree = Just dir } } = fromOsPath dir+repoDescribe Repo { location = Local { gitdir = dir } } = fromOsPath dir+repoDescribe Repo { location = LocalUnknown dir } = fromOsPath dir repoDescribe Repo { location = Unknown } = "UNKNOWN"  {- Location of the repo, either as a path or url. -} repoLocation :: Repo -> String repoLocation Repo { location = Url url } = show url repoLocation Repo { location = UnparseableUrl url } = url-repoLocation Repo { location = Local { worktree = Just dir } } = fromRawFilePath dir-repoLocation Repo { location = Local { gitdir = dir } } = fromRawFilePath dir-repoLocation Repo { location = LocalUnknown dir } = fromRawFilePath dir+repoLocation Repo { location = Local { worktree = Just dir } } = fromOsPath dir+repoLocation Repo { location = Local { gitdir = dir } } = fromOsPath dir+repoLocation Repo { location = LocalUnknown dir } = fromOsPath dir repoLocation Repo { location = Unknown } = giveup "unknown repoLocation"  {- Path to a repository. For non-bare, this is the worktree, for bare,   - it's the gitdir, and for URL repositories, is the path on the remote  - host. -}-repoPath :: Repo -> RawFilePath-repoPath Repo { location = Url u } = toRawFilePath $ unEscapeString $ uriPath u+repoPath :: Repo -> OsPath+repoPath Repo { location = Url u } = toOsPath $ unEscapeString $ uriPath u repoPath Repo { location = Local { worktree = Just d } } = d repoPath Repo { location = Local { gitdir = d } } = d repoPath Repo { location = LocalUnknown dir } = dir repoPath Repo { location = Unknown } = giveup "unknown repoPath" repoPath Repo { location = UnparseableUrl _u } = giveup "unknown repoPath" -repoWorkTree :: Repo -> Maybe RawFilePath+repoWorkTree :: Repo -> Maybe OsPath repoWorkTree Repo { location = Local { worktree = Just d } } = Just d repoWorkTree _ = Nothing  {- Path to a local repository's .git directory. -}-localGitDir :: Repo -> RawFilePath+localGitDir :: Repo -> OsPath localGitDir Repo { location = Local { gitdir = d } } = d localGitDir _ = giveup "unknown localGitDir" @@ -137,26 +136,27 @@ 	| otherwise = action  {- Path to a repository's gitattributes file. -}-attributes :: Repo -> RawFilePath+attributes :: Repo -> OsPath attributes repo 	| repoIsLocalBare repo = attributesLocal repo-	| otherwise = repoPath repo P.</> ".gitattributes"+	| otherwise = repoPath repo </> literalOsPath ".gitattributes" -attributesLocal :: Repo -> RawFilePath-attributesLocal repo = localGitDir repo P.</> "info" P.</> "attributes"+attributesLocal :: Repo -> OsPath+attributesLocal repo = localGitDir repo </> literalOsPath "info" </> literalOsPath "attributes"  {- Path to a given hook script in a repository, only if the hook exists  - and is executable. -}-hookPath :: String -> Repo -> IO (Maybe FilePath)+hookPath :: String -> Repo -> IO (Maybe OsPath) hookPath script repo = do-	let hook = fromRawFilePath (localGitDir repo) </> "hooks" </> script+	let hook = localGitDir repo </> literalOsPath "hooks" </> toOsPath script 	ifM (catchBoolIO $ isexecutable hook) 		( return $ Just hook , return Nothing )   where #if mingw32_HOST_OS 	isexecutable f = doesFileExist f #else-	isexecutable f = isExecutable . fileMode <$> getSymbolicLinkStatus f+	isexecutable f = isExecutable . fileMode+		<$> getSymbolicLinkStatus (fromOsPath f) #endif  {- Makes the path to a local Repo be relative to the cwd. -}@@ -165,10 +165,12 @@   where 	torel p = do 		p' <- relPathCwdToFile p-		return $ if B.null p' then "." else p'+		return $ if OS.null p'+			then literalOsPath "."+			else p'  {- Adjusts the path to a local Repo using the provided function. -}-adjustPath :: (RawFilePath -> IO RawFilePath) -> Repo -> IO Repo+adjustPath :: (OsPath -> IO OsPath) -> Repo -> IO Repo adjustPath f r@(Repo { location = l@(Local { gitdir = d, worktree = w }) }) = do 	d' <- f d 	w' <- maybe (pure Nothing) (Just <$$> f) w
Git/AutoCorrect.hs view
@@ -1,11 +1,11 @@ {- git autocorrection using Damerau-Levenshtein edit distance  -- - Copyright 2012 Joey Hess <id@joeyh.name>+ - Copyright 2012-2024 Joey Hess <id@joeyh.name>  -  - Licensed under the GNU AGPL version 3 or higher.  -} -{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE OverloadedStrings, ScopedTypeVariables #-}  module Git.AutoCorrect where @@ -16,6 +16,7 @@ import Text.EditDistance import Control.Concurrent import qualified Data.List.NonEmpty as NE+import Data.Char  {- These are the same cost values as used in git. -} gitEditCosts :: EditCosts@@ -45,30 +46,50 @@ {- Takes action based on git's autocorrect configuration, in preparation for  - an autocorrected command being run.  -}-prepare :: String -> (c -> String) -> NE.NonEmpty c -> Maybe Repo -> IO ()-prepare input showmatch matches r =-	case readish . fromConfigValue . Git.Config.get "help.autocorrect" "0" =<< r of+prepare :: String -> String -> (c -> String) -> NE.NonEmpty c -> Maybe Repo -> IO ()+prepare cmdname input showmatch matches r =+	case readish . getcfg =<< r of 		Just n 			| n == 0 -> list 			| n < 0 -> warn Nothing 			| otherwise -> sleep n-		Nothing -> list+		Nothing -> case getcfg <$> r of+			Just "prompt" -> prompt+			Just "never" -> unknowncommand+			Just "immediate" -> warn Nothing+			_ -> list   where+	getcfg = fromConfigValue . Git.Config.get "help.autocorrect" "0"+	 	list = giveup $ unlines $ 		[ "Unknown command '" ++ input ++ "'" 		, "" 		, "Did you mean one of these?" 		] ++ map (\m -> "\t" ++ showmatch m) (NE.toList matches)+ 	warn :: Maybe Float -> IO () 	warn mdelaysec = hPutStr stderr $ unlines-		[ "WARNING: You called a git-annex command named '" ++-		  input ++ "', which does not exist."+		[ warning 		, case mdelaysec of-			Nothing -> "Continuing under the assumption that you meant " ++ match-			Just sec -> "Continuing in " ++ show sec ++ " seconds, assuming that you meant " ++ match+			Nothing -> "Continuing under the assumption that you meant " ++ match ++ "."+			Just sec -> "Continuing in " ++ show sec ++ " seconds, assuming that you meant " ++ match ++ "." 		]-	  where-		match = "'" ++ showmatch (NE.head matches) ++ "'."+	+	match = "'" ++ showmatch (NE.head matches) ++ "'"+	+	warning = "WARNING: You called a " ++ cmdname ++ " command named '" +++                    input ++ "', which does not exist."+ 	sleep n = do 		warn (Just (fromIntegral n / 10 :: Float)) 		threadDelay (n * 100000) -- deciseconds to microseconds+	+	prompt = do+		hPutStrLn stderr warning+		hPutStr stderr ("Run " ++ match ++ " instead [y/N]? ")+		hFlush stderr+		resp <- headMaybe . map toLower <$> getLine+		when (resp /= Just 'y') $+			exitWith (ExitFailure 1)+	+	unknowncommand = giveup $ "Unknown command '" ++ input ++ "'"
Git/CatFile.hs view
@@ -99,11 +99,11 @@ catFileMetaDataStop = CoProcess.stop . checkFileProcess  {- Reads a file from a specified branch. -}-catFile :: CatFileHandle -> Branch -> RawFilePath -> IO L.ByteString+catFile :: CatFileHandle -> Branch -> OsPath -> IO L.ByteString catFile h branch file = catObject h $ 	Git.Ref.branchFileRef branch file -catFileDetails :: CatFileHandle -> Branch -> RawFilePath -> IO (Maybe (L.ByteString, Sha, ObjectType))+catFileDetails :: CatFileHandle -> Branch -> OsPath -> IO (Maybe (L.ByteString, Sha, ObjectType)) catFileDetails h branch file = catObjectDetails h $  	Git.Ref.branchFileRef branch file
Git/CheckAttr.hs view
@@ -11,12 +11,11 @@ import Git import Git.Command import qualified Utility.CoProcess as CoProcess-import qualified Utility.RawFilePath as R  import System.IO.Error import qualified Data.ByteString as B -type CheckAttrHandle = (CoProcess.CoProcessHandle, [Attr], RawFilePath)+type CheckAttrHandle = (CoProcess.CoProcessHandle, [Attr], OsPath)  type Attr = String @@ -24,7 +23,7 @@  - and returns a handle.  -} checkAttrStart :: [Attr] -> Repo -> IO CheckAttrHandle checkAttrStart attrs repo = do-	currdir <- R.getCurrentDirectory+	currdir <- getCurrentDirectory 	h <- gitCoProcessStart True params repo 	return (h, attrs, currdir)   where@@ -38,14 +37,14 @@ checkAttrStop :: CheckAttrHandle -> IO () checkAttrStop (h, _, _) = CoProcess.stop h -checkAttr :: CheckAttrHandle -> Attr -> RawFilePath -> IO String+checkAttr :: CheckAttrHandle -> Attr -> OsPath -> IO String checkAttr h want file = checkAttrs h [want] file >>= return . \case 	(v:_) -> v 	[] -> ""  {- Gets attributes of a file. When an attribute is not specified,  - returns "" for it. -}-checkAttrs :: CheckAttrHandle -> [Attr] -> RawFilePath -> IO [String]+checkAttrs :: CheckAttrHandle -> [Attr] -> OsPath -> IO [String] checkAttrs (h, attrs, currdir) want file = do 	l <- CoProcess.query h send (receive "") 	return (getvals l want)@@ -54,9 +53,9 @@ 	getvals l (x:xs) = case map snd $ filter (\(attr, _) -> attr == x) l of 			["unspecified"] -> "" : getvals l xs 			[v] -> v : getvals l xs-			_ -> giveup $ "unable to determine " ++ x ++ " attribute of " ++ fromRawFilePath file+			_ -> giveup $ "unable to determine " ++ x ++ " attribute of " ++ fromOsPath file -	send to = B.hPutStr to $ file' `B.snoc` 0+	send to = B.hPutStr to $ (fromOsPath file') `B.snoc` 0 	receive c from = do 		s <- hGetSomeString from 1024 		if null s
Git/CheckIgnore.hs view
@@ -52,11 +52,11 @@ checkIgnoreStop = void . tryIO . CoProcess.stop  {- Returns True if a file is ignored. -}-checkIgnored :: CheckIgnoreHandle -> RawFilePath -> IO Bool+checkIgnored :: CheckIgnoreHandle -> OsPath -> IO Bool checkIgnored h file = CoProcess.query h send (receive "")   where 	send to = do-		B.hPutStr to $ file `B.snoc` 0+		B.hPutStr to $ fromOsPath file `B.snoc` 0 		hFlush to 	receive c from = do 		s <- hGetSomeString from 1024@@ -68,4 +68,4 @@ 	parse s = case segment (== '\0') s of 		(_source:_line:pattern:_pathname:_eol:[]) -> Just $ not $ null pattern 		_ -> Nothing-	eofError = ioError $ mkIOError userErrorType "git cat-file EOF" Nothing Nothing+	eofError = ioError $ mkIOError userErrorType "git check-ignore EOF" Nothing Nothing
Git/Command.hs view
@@ -24,10 +24,10 @@   where 	setdir 		| gitEnvOverridesGitDir r = []-		| otherwise = [Param $ "--git-dir=" ++ fromRawFilePath (gitdir l)]+		| otherwise = [Param $ "--git-dir=" ++ fromOsPath (gitdir l)] 	settree = case worktree l of 		Nothing -> []-		Just t -> [Param $ "--work-tree=" ++ fromRawFilePath t]+		Just t -> [Param $ "--work-tree=" ++ fromOsPath t] gitCommandLine _ repo = assertLocal repo $ error "internal"  {- Runs git in the specified repo. -}@@ -123,9 +123,12 @@  - convenience.  -} pipeNullSplit' :: [CommandParam] -> Repo -> IO ([S.ByteString], IO Bool)-pipeNullSplit' params repo = do+pipeNullSplit' = pipeNullSplit'' id++pipeNullSplit'' :: (S.ByteString -> t) -> [CommandParam] -> Repo -> IO ([t], IO Bool)+pipeNullSplit'' f params repo = do 	(s, cleanup) <- pipeNullSplit params repo-	return (map L.toStrict s, cleanup)+	return (map (f . L.toStrict) s, cleanup)  pipeNullSplitStrict :: [CommandParam] -> Repo -> IO [S.ByteString] pipeNullSplitStrict params repo = do
Git/Config.hs view
@@ -14,7 +14,6 @@ import qualified Data.ByteString.Char8 as S8 import qualified Data.List.NonEmpty as NE import Data.Char-import qualified System.FilePath.ByteString as P import Control.Concurrent.Async  import Common@@ -76,7 +75,7 @@ 		params = addparams ++ explicitrepoparams 			++ ["config", "--null", "--list"] 		p = (proc "git" params)-			{ cwd = Just (fromRawFilePath d)+			{ cwd = Just (fromOsPath d) 			, env = gitEnv repo 			, std_out = CreatePipe  			}@@ -99,7 +98,7 @@ global :: IO (Maybe Repo) global = do 	home <- myHomeDir-	ifM (doesFileExist $ home </> ".gitconfig")+	ifM (doesFileExist $ toOsPath home </> literalOsPath ".gitconfig") 		( Just <$> withCreateProcess p go 		, return Nothing 		)@@ -153,22 +152,22 @@  -} updateLocation :: Repo -> IO Repo updateLocation r@(Repo { location = LocalUnknown d }) = case isBare r of-	Just True -> ifM (doesDirectoryExist (fromRawFilePath dotgit))+	Just True -> ifM (doesDirectoryExist dotgit) 		( updateLocation' r $ Local dotgit Nothing 		, updateLocation' r $ Local d Nothing 		) 	Just False -> mknonbare 	{- core.bare not in config, probably because safe.directory 	 - did not allow reading the config -}-	Nothing -> ifM (Git.Construct.isBareRepo (fromRawFilePath d))+	Nothing -> ifM (Git.Construct.isBareRepo d) 		( mkbare 		, mknonbare 		)   where-	dotgit = d P.</> ".git"+	dotgit = d </> literalOsPath ".git" 	-- git treats eg ~/foo as a bare git repository located in 	-- ~/foo/.git if ~/foo/.git/config has core.bare=true-	mkbare = ifM (doesDirectoryExist (fromRawFilePath dotgit))+	mkbare = ifM (doesDirectoryExist dotgit) 		( updateLocation' r $ Local dotgit Nothing 		, updateLocation' r $ Local d Nothing 		)@@ -184,7 +183,7 @@ 		Just (ConfigValue d) -> do 			{- core.worktree is relative to the gitdir -} 			top <- absPath (gitdir l)-			let p = absPathFrom top d+			let p = absPathFrom top (toOsPath d) 			return $ l { worktree = Just p } 		Just NoConfigValue -> return l 	return $ r { location = l' }@@ -337,7 +336,7 @@ 		-- Cannot use gitCommandLine here because specifying --git-dir 		-- will bypass the git security check. 		let p = (proc "git" ["config", "--local", "--list"])-			{ cwd = Just (fromRawFilePath (repoPath r))+			{ cwd = Just (fromOsPath (repoPath r)) 			, env = gitEnv r 			} 		(out, ok) <- processTranscript' p Nothing
Git/Construct.hs view
@@ -40,15 +40,12 @@ import qualified Git.Url as Url import Utility.UserInfo import Utility.Url.Parse-import qualified Utility.RawFilePath as R--import qualified Data.ByteString as B-import qualified System.FilePath.ByteString as P+import qualified Utility.OsString as OS  {- Finds the git repository used for the cwd, which may be in a parent  - directory. -} fromCwd :: IO (Maybe Repo)-fromCwd = R.getCurrentDirectory >>= seekUp+fromCwd = getCurrentDirectory >>= seekUp   where 	seekUp dir = do 		r <- checkForRepo dir@@ -59,31 +56,32 @@ 			Just loc -> pure $ Just $ newFrom loc  {- Local Repo constructor, accepts a relative or absolute path. -}-fromPath :: RawFilePath -> IO Repo+fromPath :: OsPath -> IO Repo fromPath dir 	-- When dir == "foo/.git", git looks for "foo/.git/.git", 	-- and failing that, uses "foo" as the repository.-	| (P.pathSeparator `B.cons` ".git") `B.isSuffixOf` canondir =-		ifM (doesDirectoryExist $ fromRawFilePath dir </> ".git")+	| (pathSeparator `OS.cons` dotgit) `OS.isSuffixOf` canondir =+		ifM (doesDirectoryExist $ dir </> dotgit) 			( ret dir-			, ret (P.takeDirectory canondir)+			, ret (takeDirectory canondir) 			)-	| otherwise = ifM (doesDirectoryExist (fromRawFilePath dir))+	| otherwise = ifM (doesDirectoryExist dir) 		( checkGitDirFile dir >>= maybe (ret dir) (pure . newFrom) 		-- git falls back to dir.git when dir doesn't 		-- exist, as long as dir didn't end with a 		-- path separator 		, if dir == canondir-			then ret (dir <> ".git")+			then ret (dir <> dotgit) 			else ret dir 		)   where+	dotgit = literalOsPath ".git" 	ret = pure . newFrom . LocalUnknown-	canondir = P.dropTrailingPathSeparator dir+	canondir = dropTrailingPathSeparator dir  {- Local Repo constructor, requires an absolute path to the repo be  - specified. -}-fromAbsPath :: RawFilePath -> IO Repo+fromAbsPath :: OsPath -> IO Repo fromAbsPath dir 	| absoluteGitPath dir = fromPath dir 	| otherwise =@@ -107,7 +105,7 @@ fromUrl' :: String -> IO Repo fromUrl' url 	| "file://" `isPrefixOf` url = case parseURIPortable url of-		Just u -> fromAbsPath $ toRawFilePath $ unEscapeString $ uriPath u+		Just u -> fromAbsPath $ toOsPath $ unEscapeString $ uriPath u 		Nothing -> pure $ newFrom $ UnparseableUrl url 	| otherwise = case parseURIPortable url of 		Just u -> pure $ newFrom $ Url u@@ -129,7 +127,7 @@ 				[ s 				, "//" 				, auth-				, fromRawFilePath (repoPath r)+				, fromOsPath (repoPath r) 				] 			in r { location = Url $ fromJust $ parseURIPortable absurl } 		_ -> r@@ -176,43 +174,43 @@ fromRemotePath :: FilePath -> Repo -> IO Repo fromRemotePath dir repo = do 	dir' <- expandTilde dir-	fromPath $ repoPath repo P.</> toRawFilePath dir'+	fromPath $ repoPath repo </> dir'  {- Git remotes can have a directory that is specified relative  - to the user's home directory, or that contains tilde expansions.  - This converts such a directory to an absolute path.  - Note that it has to run on the system where the remote is.  -}-repoAbsPath :: RawFilePath -> IO RawFilePath+repoAbsPath :: OsPath -> IO OsPath repoAbsPath d = do-	d' <- expandTilde (fromRawFilePath d)+	d' <- expandTilde (fromOsPath d) 	h <- myHomeDir-	return $ toRawFilePath $ h </> d'+	return $ toOsPath h </> d' -expandTilde :: FilePath -> IO FilePath+expandTilde :: FilePath -> IO OsPath #ifdef mingw32_HOST_OS-expandTilde = return+expandTilde = return . toOsPath #else expandTilde p = expandt True p 	-- If unable to expand a tilde, eg due to a user not existing, 	-- use the path as given.-	`catchNonAsync` (const (return p))+	`catchNonAsync` (const (return (toOsPath p)))   where-	expandt _ [] = return ""+	expandt _ [] = return $ literalOsPath "" 	expandt _ ('/':cs) = do 		v <- expandt True cs-		return ('/':v)+		return $ literalOsPath "/" <> v 	expandt True ('~':'/':cs) = do 		h <- myHomeDir-		return $ h </> cs-	expandt True "~" = myHomeDir+		return $ toOsPath h </> toOsPath cs+	expandt True "~" = toOsPath <$> myHomeDir 	expandt True ('~':cs) = do 		let (name, rest) = findname "" cs 		u <- getUserEntryForName name-		return $ homeDirectory u </> rest+		return $ toOsPath (homeDirectory u) </> toOsPath rest 	expandt _ (c:cs) = do 		v <- expandt False cs-		return (c:v)+		return $ toOsPath [c] <> v 	findname n [] = (n, "") 	findname n (c:cs) 		| c == '/' = (n, cs)@@ -221,11 +219,11 @@  {- Checks if a git repository exists in a directory. Does not find  - git repositories in parent directories. -}-checkForRepo :: RawFilePath -> IO (Maybe RepoLocation)+checkForRepo :: OsPath -> IO (Maybe RepoLocation) checkForRepo dir =  	check isRepo $ 		check (checkGitDirFile dir) $-			check (checkdir (isBareRepo dir')) $+			check (checkdir (isBareRepo dir)) $ 				return Nothing   where 	check test cont = maybe cont (return . Just) =<< test@@ -234,23 +232,22 @@ 		, return Nothing 		) 	isRepo = checkdir $ -		doesFileExist (dir' </> ".git" </> "config")+		doesFileExist (dir </> literalOsPath ".git" </> literalOsPath "config") 			<||> 		-- A git-worktree lacks .git/config, but has .git/gitdir. 		-- (Normally the .git is a file, not a symlink, but it can 		-- be converted to a symlink and git will still work; 		-- this handles that case.)-		doesFileExist (dir' </>  ".git" </> "gitdir")-	dir' = fromRawFilePath dir+		doesFileExist (dir </>  literalOsPath ".git" </> literalOsPath "gitdir") -isBareRepo :: FilePath -> IO Bool-isBareRepo dir = doesFileExist (dir </> "config")-	<&&> doesDirectoryExist (dir </> "objects")+isBareRepo :: OsPath -> IO Bool+isBareRepo dir = doesFileExist (dir </> literalOsPath "config")+	<&&> doesDirectoryExist (dir </> literalOsPath "objects")  -- Check for a .git file.-checkGitDirFile :: RawFilePath -> IO (Maybe RepoLocation)+checkGitDirFile :: OsPath -> IO (Maybe RepoLocation) checkGitDirFile dir = adjustGitDirFile' $ Local -	{ gitdir = dir P.</> ".git"+	{ gitdir = dir </> literalOsPath ".git" 	, worktree = Just dir 	} @@ -264,15 +261,13 @@ adjustGitDirFile' :: RepoLocation -> IO (Maybe RepoLocation) adjustGitDirFile' loc@(Local {}) = do 	let gd = gitdir loc-	c <- firstLine <$> catchDefaultIO "" (readFile (fromRawFilePath gd))+	c <- firstLine <$> catchDefaultIO "" (readFile (fromOsPath gd)) 	if gitdirprefix `isPrefixOf` c 		then do-			top <- fromRawFilePath . P.takeDirectory <$> absPath gd+			top <- takeDirectory <$> absPath gd 			return $ Just $ loc-				{ gitdir = absPathFrom -					(toRawFilePath top)-					(toRawFilePath -						(drop (length gitdirprefix) c))+				{ gitdir = absPathFrom top $ +					toOsPath $ drop (length gitdirprefix) c 				} 		else return Nothing  where
Git/CurrentRepo.hs view
@@ -16,10 +16,7 @@ import qualified Git.Config import Utility.Env import Utility.Env.Set-import qualified Utility.RawFilePath as R--import qualified Data.ByteString as B-import qualified System.FilePath.ByteString as P+import qualified Utility.OsString as OS  {- Gets the current git repository.  -@@ -49,9 +46,9 @@ 	case wt of 		Nothing -> relPath r 		Just d -> do-			curr <- R.getCurrentDirectory+			curr <- getCurrentDirectory 			unless (d `dirContains` curr) $-				setCurrentDirectory (fromRawFilePath d)+				setCurrentDirectory d 			relPath $ addworktree wt r   where 	getpathenv s = do@@ -59,22 +56,22 @@ 		case v of 			Just d -> do 				unsetEnv s-				return (Just (toRawFilePath d))+				return (Just (toOsPath d)) 			Nothing -> return Nothing 	-	getpathenvprefix s (Just prefix) | not (B.null prefix) =+	getpathenvprefix s (Just prefix) | not (OS.null prefix) = 		getpathenv s >>= \case 			Nothing -> return Nothing 			Just d-				| d == "." -> return (Just d)+				| d == literalOsPath "." -> return (Just d) 				| otherwise -> Just -					<$> absPath (prefix P.</> d)+					<$> absPath (prefix </> d) 	getpathenvprefix s _ = getpathenv s  	configure Nothing (Just r) = Git.Config.read r 	configure (Just d) _ = do 		absd <- absPath d-		curr <- R.getCurrentDirectory+		curr <- getCurrentDirectory 		loc <- adjustGitDirFile $ Local 			{ gitdir = absd 			, worktree = Just curr
Git/DiffTree.hs view
@@ -18,7 +18,6 @@ 	parseDiffRaw, ) where -import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as L import qualified Data.Attoparsec.ByteString.Lazy as A import qualified Data.Attoparsec.ByteString.Char8 as A8@@ -31,6 +30,7 @@ import Git.DiffTreeItem import qualified Git.Quote import qualified Git.Ref+import qualified Utility.OsString as OS import Utility.Attoparsec  {- Checks if the DiffTreeItem modifies a file with a given name@@ -38,7 +38,7 @@ isDiffOf :: DiffTreeItem -> TopFilePath -> Bool isDiffOf diff f =  	let f' = getTopFilePath f-	in if B.null f'+	in if OS.null f' 		then True -- top of repo contains all 		else f' `dirContains` getTopFilePath (file diff) @@ -133,6 +133,6 @@ 	<*> (maybe (fail "bad dstsha") return . extractSha =<< nextword) 	<* A8.char ' ' 	<*> A.takeByteString-	<*> pure (asTopFilePath $ fromInternalGitPath $ Git.Quote.unquote f)+	<*> pure (asTopFilePath $ fromInternalGitPath $ toOsPath $ Git.Quote.unquote f)   where 	nextword = A8.takeTill (== ' ')
Git/Env.hs view
@@ -30,9 +30,9 @@  - and a copy of the rest of the system environment. -} propGitEnv :: Repo -> IO [(String, String)] propGitEnv g = do-	g' <- addGitEnv g "GIT_DIR" (fromRawFilePath (localGitDir g))+	g' <- addGitEnv g "GIT_DIR" (fromOsPath (localGitDir g)) 	g'' <- maybe (pure g')-		(addGitEnv g' "GIT_WORK_TREE" . fromRawFilePath)+		(addGitEnv g' "GIT_WORK_TREE" . fromOsPath) 		(repoWorkTree g) 	return $ fromMaybe [] (gitEnv g'')
Git/FilePath.hs view
@@ -32,13 +32,11 @@ import Git import Git.Quote -import qualified System.FilePath.ByteString as P-import qualified System.FilePath.Posix.ByteString import GHC.Generics import Control.DeepSeq -{- A RawFilePath, relative to the top of the git repository. -}-newtype TopFilePath = TopFilePath { getTopFilePath :: RawFilePath }+{- A path relative to the top of the git repository. -}+newtype TopFilePath = TopFilePath { getTopFilePath :: OsPath } 	deriving (Show, Eq, Ord, Generic)  instance NFData TopFilePath@@ -53,16 +51,16 @@ 	UnquotedByteString (fromRef' b) <> ":" <> QuotedPath (getTopFilePath f)  {- Path to a TopFilePath, within the provided git repo. -}-fromTopFilePath :: TopFilePath -> Git.Repo -> RawFilePath-fromTopFilePath p repo = P.combine (repoPath repo) (getTopFilePath p)+fromTopFilePath :: TopFilePath -> Git.Repo -> OsPath+fromTopFilePath p repo = combine (repoPath repo) (getTopFilePath p)  {- The input FilePath can be absolute, or relative to the CWD. -}-toTopFilePath :: RawFilePath -> Git.Repo -> IO TopFilePath+toTopFilePath :: OsPath -> Git.Repo -> IO TopFilePath toTopFilePath file repo = TopFilePath <$> relPathDirToFile (repoPath repo) file -{- The input RawFilePath must already be relative to the top of the git+{- The input path must already be relative to the top of the git  - repository -}-asTopFilePath :: RawFilePath -> TopFilePath+asTopFilePath :: OsPath -> TopFilePath asTopFilePath file = TopFilePath file  {- Git may use a different representation of a path when storing@@ -72,25 +70,24 @@  - despite Windows using '\'.  -  -}-type InternalGitPath = RawFilePath+type InternalGitPath = OsPath -toInternalGitPath :: RawFilePath -> InternalGitPath+toInternalGitPath :: OsPath -> InternalGitPath #ifndef mingw32_HOST_OS toInternalGitPath = id #else-toInternalGitPath = encodeBS . replace "\\" "/" . decodeBS+toInternalGitPath = toOsPath . encodeBS . replace "\\" "/" . decodeBS . fromOsPath #endif -fromInternalGitPath :: InternalGitPath -> RawFilePath+fromInternalGitPath :: InternalGitPath -> OsPath #ifndef mingw32_HOST_OS fromInternalGitPath = id #else-fromInternalGitPath = encodeBS . replace "/" "\\" . decodeBS+fromInternalGitPath = toOsPath . encodeBS . replace "/" "\\" . decodeBS . fromOsPath #endif  {- isAbsolute on Windows does not think "/foo" or "\foo" is absolute,  - so try posix paths.  -}-absoluteGitPath :: RawFilePath -> Bool-absoluteGitPath p = P.isAbsolute p ||-	System.FilePath.Posix.ByteString.isAbsolute (toInternalGitPath p)+absoluteGitPath :: OsPath -> Bool+absoluteGitPath p = isAbsolute p || isAbsolute (toInternalGitPath p)
Git/FilterProcess.hs view
@@ -130,7 +130,7 @@ 	-- Delay capability is not implemented, so filter it out. 	filtercapabilities = filter (`elem` [Capability "smudge", Capability "clean"]) -data FilterRequest = Smudge FilePath | Clean FilePath+data FilterRequest = Smudge OsPath | Clean OsPath 	deriving (Show, Eq)  {- Waits for the next FilterRequest to be received. Does not read@@ -143,8 +143,8 @@ 	let cs = mapMaybe decodeConfigValue ps 	case (extractConfigValue cs "command", extractConfigValue cs "pathname") of 		(Just command, Just pathname)-			| command == "smudge" -> return $ Just $ Smudge pathname-			| command == "clean" -> return $ Just $ Clean pathname+			| command == "smudge" -> return $ Just $ Smudge $ toOsPath pathname+			| command == "clean" -> return $ Just $ Clean $ toOsPath pathname 			| otherwise -> return Nothing 		_ -> return Nothing
Git/HashObject.hs view
@@ -5,7 +5,7 @@  - Licensed under the GNU AGPL version 3 or higher.  -} -{-# LANGUAGE CPP #-}+{-# LANGUAGE OverloadedStrings #-}  module Git.HashObject where @@ -14,14 +14,14 @@ import Git.Sha import Git.Command import Git.Types-import qualified Utility.CoProcess as CoProcess import Utility.Tmp+import qualified Utility.CoProcess as CoProcess+import qualified Utility.OsString as OS  import qualified Data.ByteString as S import qualified Data.ByteString.Char8 as S8 import qualified Data.ByteString.Lazy as L import Data.ByteString.Builder-import Data.Char  data HashObjectHandle = HashObjectHandle CoProcess.CoProcessHandle Repo [CommandParam] @@ -40,7 +40,7 @@ hashObjectStop (HashObjectHandle h _ _) = CoProcess.stop h  {- Injects a file into git, returning the Sha of the object. -}-hashFile :: HashObjectHandle -> RawFilePath -> IO Sha+hashFile :: HashObjectHandle -> OsPath -> IO Sha hashFile hdl@(HashObjectHandle h _ _) file = do 	-- git hash-object chdirs to the top of the repository on 	-- start, so if the filename is relative, it will@@ -48,24 +48,24 @@ 	-- So, make the filename absolute, which will work now 	-- and also if git's behavior later changes. 	file' <- absPath file-	if newline `S.elem` file' || carriagereturn `S.elem` file+	if newline `OS.elem` file' || carriagereturn `OS.elem` file 		then hashFile' hdl file-		else CoProcess.query h (send file') receive+		else CoProcess.query h (send (fromOsPath file')) receive   where 	send file' to = S8.hPutStrLn to file' 	receive from = getSha "hash-object" $ S8.hGetLine from-	newline = fromIntegral (ord '\n')+	newline = unsafeFromChar '\n' 	-- git strips carriage return from the end of a line, out of some 	-- misplaced desire to support windows, so also use the newline 	-- fallback for those.-	carriagereturn = fromIntegral (ord '\r')+	carriagereturn = unsafeFromChar '\r'  {- Runs git hash-object once per call, rather than using a running  - one, so is slower. But, is able to handle newlines in the filepath,  - which --stdin-paths cannot. -}-hashFile' :: HashObjectHandle -> RawFilePath -> IO Sha+hashFile' :: HashObjectHandle -> OsPath -> IO Sha hashFile' (HashObjectHandle _ repo ps) file = getSha "hash-object" $-	pipeReadStrict (ps ++ [File (fromRawFilePath file)]) repo+	pipeReadStrict (ps ++ [File (fromOsPath file)]) repo  class HashableBlob t where 	hashableBlobToHandle :: Handle -> t -> IO ()@@ -82,10 +82,10 @@ {- Injects a blob into git. Unfortunately, the current git-hash-object  - interface does not allow batch hashing without using temp files. -} hashBlob :: HashableBlob b => HashObjectHandle -> b -> IO Sha-hashBlob h b = withTmpFile "hash" $ \tmp tmph -> do+hashBlob h b = withTmpFile (literalOsPath "hash") $ \tmp tmph -> do 	hashableBlobToHandle tmph b 	hClose tmph-	hashFile h (toRawFilePath tmp)+	hashFile h tmp  {- Injects some content into git, returning its Sha.  -
Git/Hook.hs view
@@ -6,6 +6,7 @@  -}  {-# LANGUAGE CPP #-}+{-# LANGUAGE OverloadedStrings #-}  module Git.Hook where @@ -14,15 +15,14 @@ import Utility.Tmp import Utility.Shell import Utility.FileMode+import qualified Utility.FileIO as F #ifndef mingw32_HOST_OS import qualified Utility.RawFilePath as R import System.PosixCompat.Files (fileMode) #endif -import qualified Data.ByteString as B- data Hook = Hook-	{ hookName :: FilePath+	{ hookName :: OsPath 	, hookScript :: String 	, hookOldScripts :: [String] 	}@@ -31,8 +31,8 @@ instance Eq Hook where 	a == b = hookName a == hookName b -hookFile :: Hook -> Repo -> FilePath-hookFile h r = fromRawFilePath (localGitDir r) </> "hooks" </> hookName h+hookFile :: Hook -> Repo -> OsPath+hookFile h r = localGitDir r </> literalOsPath "hooks" </> hookName h  {- Writes a hook. Returns False if the hook already exists with a different  - content. Upgrades old scripts.@@ -58,15 +58,13 @@   where 	f = hookFile h r 	go = do-		-- On Windows, using B.writeFile here avoids-		-- the newline translation done by writeFile.+		-- On Windows, using a ByteString as the file content+		-- avoids the newline translation done by writeFile. 		-- Hook scripts on Windows could use CRLF endings, but 		-- they typically use unix newlines, which does work there 		-- and makes the repository more portable.-		viaTmp B.writeFile f (encodeBS (hookScript h))-		void $ tryIO $ modifyFileMode-			(toRawFilePath f)-			(addModes executeModes)+		viaTmp F.writeFile' f (encodeBS (hookScript h))+		void $ tryIO $ modifyFileMode f (addModes executeModes) 		return True  {- Removes a hook. Returns False if the hook contained something else, and@@ -91,7 +89,7 @@ 	-- and so a hook file that has CRLF will be treated the same as one 	-- that has LF. That is intentional, since users may have a reason 	-- to prefer one or the other.-	content <- readFile $ hookFile h r+	content <- readFile $ fromOsPath $ hookFile h r 	return $ if content == hookScript h 		then ExpectedContent 		else if any (content ==) (hookOldScripts h)@@ -103,7 +101,7 @@ 	let f = hookFile h r 	catchBoolIO $ #ifndef mingw32_HOST_OS-		isExecutable . fileMode <$> R.getFileStatus (toRawFilePath f)+		isExecutable . fileMode <$> R.getFileStatus (fromOsPath f) #else 		doesFileExist f #endif
Git/Index.hs view
@@ -14,8 +14,6 @@ import Utility.Env import Utility.Env.Set -import qualified System.FilePath.ByteString as P- indexEnv :: String indexEnv = "GIT_INDEX_FILE" @@ -30,8 +28,8 @@  -  - So, an absolute path is the only safe option for this to return.  -}-indexEnvVal :: RawFilePath -> IO String-indexEnvVal p = fromRawFilePath <$> absPath p+indexEnvVal :: OsPath -> IO OsPath+indexEnvVal p = absPath p  {- Forces git to use the specified index file.  -@@ -40,11 +38,11 @@  -  - Warning: Not thread safe.  -}-override :: RawFilePath -> Repo -> IO (IO ())+override :: OsPath -> Repo -> IO (IO ()) override index _r = do 	res <- getEnv var 	val <- indexEnvVal index-	setEnv var val True+	setEnv var (fromOsPath val) True 	return $ reset res   where 	var = "GIT_INDEX_FILE"@@ -52,13 +50,13 @@ 	reset _ = unsetEnv var  {- The normal index file. Does not check GIT_INDEX_FILE. -}-indexFile :: Repo -> RawFilePath-indexFile r = localGitDir r P.</> "index"+indexFile :: Repo -> OsPath+indexFile r = localGitDir r </> literalOsPath "index"  {- The index file git will currently use, checking GIT_INDEX_FILE. -}-currentIndexFile :: Repo -> IO RawFilePath-currentIndexFile r = maybe (indexFile r) toRawFilePath <$> getEnv indexEnv+currentIndexFile :: Repo -> IO OsPath+currentIndexFile r = maybe (indexFile r) toOsPath <$> getEnv indexEnv  {- Git locks the index by creating this file. -}-indexFileLock :: RawFilePath -> RawFilePath-indexFileLock f = f <> ".lock"+indexFileLock :: OsPath -> OsPath+indexFileLock f = f <> literalOsPath ".lock"
Git/LockFile.hs view
@@ -21,9 +21,9 @@ #endif  #ifndef mingw32_HOST_OS-data LockHandle = LockHandle FilePath Fd+data LockHandle = LockHandle OsPath Fd #else-data LockHandle = LockHandle FilePath HANDLE+data LockHandle = LockHandle OsPath HANDLE #endif  {- Uses the same exclusive locking that git does.@@ -33,14 +33,14 @@  - a dangling lock can be left if a process is terminated at the wrong  - time.  -}-openLock :: FilePath -> IO LockHandle+openLock :: OsPath -> IO LockHandle openLock lck = openLock' lck `catchNonAsync` lckerr   where 	lckerr e = do 		-- Same error message displayed by git. 		whenM (doesFileExist lck) $ 			hPutStrLn stderr $ unlines-				[ "fatal: Unable to create '" ++ lck ++ "': " ++ show e+				[ "fatal: Unable to create '" ++ fromOsPath lck ++ "': " ++ show e 				, "" 				, "If no other git process is currently running, this probably means a" 				, "git process crashed in this repository earlier. Make sure no other git"@@ -48,11 +48,11 @@ 				] 		throwM e -openLock' :: FilePath -> IO LockHandle+openLock' :: OsPath -> IO LockHandle openLock' lck = do #ifndef mingw32_HOST_OS 	-- On unix, git simply uses O_EXCL-	h <- openFdWithMode (toRawFilePath lck) ReadWrite (Just 0O666)+	h <- openFdWithMode (fromOsPath lck) ReadWrite (Just 0O666) 		(defaultFileFlags { exclusive = True }) 	setFdOption h CloseOnExec True #else@@ -65,7 +65,7 @@ 	-- So, all that's needed is a way to open the file, that fails 	-- if the file already exists. Using CreateFile with CREATE_NEW  	-- accomplishes that.-	h <- createFile lck gENERIC_WRITE fILE_SHARE_NONE Nothing+	h <- createFile (fromOsPath lck) gENERIC_WRITE fILE_SHARE_NONE Nothing 		cREATE_NEW fILE_ATTRIBUTE_NORMAL Nothing #endif 	return (LockHandle lck h)
Git/Log.hs view
@@ -19,7 +19,7 @@ data LoggedFileChange t = LoggedFileChange 	{ changetime :: POSIXTime 	, changed :: t-	, changedfile :: FilePath+	, changedfile :: OsPath 	, oldref :: Ref 	, newref :: Ref 	}@@ -34,7 +34,7 @@ 	-> Maybe Ref 	-> [FilePath] 	-> [CommandParam]-	-> (Sha -> FilePath -> Maybe t)+	-> (Sha -> OsPath -> Maybe t) 	-> Repo 	-> IO ([LoggedFileChange t], IO Bool) getGitLog ref stopref fs os selector repo = do@@ -75,7 +75,7 @@ -- -- The commitinfo is not included before all changelines, so -- keep track of the most recently seen commitinfo.-parseGitRawLog :: (Ref -> FilePath -> Maybe t) -> [String] -> [LoggedFileChange t]+parseGitRawLog :: (Ref -> OsPath -> Maybe t) -> [String] -> [LoggedFileChange t] parseGitRawLog selector = parse (deleteSha, epoch)   where 	epoch = toEnum 0 :: POSIXTime@@ -91,11 +91,12 @@ 				_ -> (oldcommitsha, oldts, cl') 	  	mrc = do 			(old, new) <- parseRawChangeLine cl-			v <- selector commitsha c2+			let c2' = toOsPath c2+			v <- selector commitsha c2' 			return $ LoggedFileChange 				{ changetime = ts 				, changed = v-				, changedfile = c2+				, changedfile = c2' 				, oldref = old 				, newref = new 				}
Git/LsFiles.hs view
@@ -39,14 +39,13 @@ import Utility.InodeCache import Utility.TimeStamp import Utility.Attoparsec-import qualified Utility.RawFilePath as R+import qualified Utility.OsString as OS  import System.Posix.Types import qualified Data.Map as M import qualified Data.ByteString as S import qualified Data.Attoparsec.ByteString as A import qualified Data.Attoparsec.ByteString.Char8 as A8-import qualified System.FilePath.ByteString as P  {- It's only safe to use git ls-files on the current repo, not on a remote.  -@@ -78,20 +77,22 @@ {- Lists files that are checked into git's index at the specified paths.  - With no paths, all files are listed.  -}-inRepo :: [Options] -> [RawFilePath] -> Repo -> IO ([RawFilePath], IO Bool)+inRepo :: [Options] -> [OsPath] -> Repo -> IO ([OsPath], IO Bool) inRepo = inRepo' [Param "--cached"]  -inRepo' :: [CommandParam] -> [Options] -> [RawFilePath] -> Repo -> IO ([RawFilePath], IO Bool)-inRepo' ps os l repo = guardSafeForLsFiles repo $ pipeNullSplit' params repo+inRepo' :: [CommandParam] -> [Options] -> [OsPath] -> Repo -> IO ([OsPath], IO Bool)+inRepo' ps os l repo = guardSafeForLsFiles repo $ do+	(fs, cleanup) <- pipeNullSplit' params repo+	return (map toOsPath fs, cleanup)   where 	params =  		Param "ls-files" : 		Param "-z" : 		map opParam os ++ ps ++-		(Param "--" : map (File . fromRawFilePath) l)+		(Param "--" : map (File . fromOsPath) l)  {- Lists the same files inRepo does, but with sha and mode. -}-inRepoDetails :: [Options] -> [RawFilePath] -> Repo -> IO ([(RawFilePath, Sha, FileMode)], IO Bool)+inRepoDetails :: [Options] -> [OsPath] -> Repo -> IO ([(OsPath, Sha, FileMode)], IO Bool) inRepoDetails = stagedDetails' parser . map opParam   where 	parser s = case parseStagedDetails s of@@ -102,17 +103,17 @@  {- Files that are checked into the index or have been committed to a  - branch. -}-inRepoOrBranch :: Branch -> [Options] -> [RawFilePath] -> Repo -> IO ([RawFilePath], IO Bool)+inRepoOrBranch :: Branch -> [Options] -> [OsPath] -> Repo -> IO ([OsPath], IO Bool) inRepoOrBranch b = inRepo' 	[ Param "--cached" 	, Param ("--with-tree=" ++ fromRef b) 	]  {- Scans for files at the specified locations that are not checked into git. -}-notInRepo :: [Options] -> Bool -> [RawFilePath] -> Repo -> IO ([RawFilePath], IO Bool)+notInRepo :: [Options] -> Bool -> [OsPath] -> Repo -> IO ([OsPath], IO Bool) notInRepo = notInRepo' [] -notInRepo' :: [CommandParam] -> [Options] -> Bool -> [RawFilePath] -> Repo -> IO ([RawFilePath], IO Bool)+notInRepo' :: [CommandParam] -> [Options] -> Bool -> [OsPath] -> Repo -> IO ([OsPath], IO Bool) notInRepo' ps os include_ignored =  	inRepo' (Param "--others" : ps ++ exclude) os   where@@ -122,41 +123,42 @@  {- Scans for files at the specified locations that are not checked into  - git. Empty directories are included in the result. -}-notInRepoIncludingEmptyDirectories :: [Options] -> Bool -> [RawFilePath] -> Repo -> IO ([RawFilePath], IO Bool)+notInRepoIncludingEmptyDirectories :: [Options] -> Bool -> [OsPath] -> Repo -> IO ([OsPath], IO Bool) notInRepoIncludingEmptyDirectories = notInRepo' [Param "--directory"]  {- Finds all files in the specified locations, whether checked into git or  - not. -}-allFiles :: [Options] -> [RawFilePath] -> Repo -> IO ([RawFilePath], IO Bool)+allFiles :: [Options] -> [OsPath] -> Repo -> IO ([OsPath], IO Bool) allFiles = inRepo' [Param "--cached", Param "--others"]  {- Returns a list of files in the specified locations that have been  - deleted. -}-deleted :: [Options] -> [RawFilePath] -> Repo -> IO ([RawFilePath], IO Bool)+deleted :: [Options] -> [OsPath] -> Repo -> IO ([OsPath], IO Bool) deleted = inRepo' [Param "--deleted"]  {- Returns a list of files in the specified locations that have been  - modified. -}-modified :: [Options] -> [RawFilePath] -> Repo -> IO ([RawFilePath], IO Bool)+modified :: [Options] -> [OsPath] -> Repo -> IO ([OsPath], IO Bool) modified = inRepo' [Param "--modified"]  {- Returns a list of all files that are staged for commit. -}-staged :: [RawFilePath] -> Repo -> IO ([RawFilePath], IO Bool)+staged :: [OsPath] -> Repo -> IO ([OsPath], 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 :: [RawFilePath] -> Repo -> IO ([RawFilePath], IO Bool)+stagedNotDeleted :: [OsPath] -> Repo -> IO ([OsPath], IO Bool) stagedNotDeleted = staged' [Param "--diff-filter=ACMRT"] -staged' :: [CommandParam] -> [RawFilePath] -> Repo -> IO ([RawFilePath], IO Bool)-staged' ps l repo = guardSafeForLsFiles repo $-	pipeNullSplit' (prefix ++ ps ++ suffix) repo+staged' :: [CommandParam] -> [OsPath] -> Repo -> IO ([OsPath], IO Bool)+staged' ps l repo = guardSafeForLsFiles repo $ do+	(fs, cleanup) <- pipeNullSplit' (prefix ++ ps ++ suffix) repo+	return (map toOsPath fs, cleanup)   where 	prefix = [Param "diff", Param "--cached", Param "--name-only", Param "-z"]-	suffix = Param "--" : map (File . fromRawFilePath) l+	suffix = Param "--" : map (File . fromOsPath) l -type StagedDetails = (RawFilePath, Sha, FileMode, StageNum)+type StagedDetails = (OsPath, Sha, FileMode, StageNum)  type StageNum = Int @@ -174,16 +176,16 @@  - Note that, during a conflict, a file will appear in the list  - more than once with different stage numbers.  -}-stagedDetails :: [RawFilePath] -> Repo -> IO ([StagedDetails], IO Bool)+stagedDetails :: [OsPath] -> Repo -> IO ([StagedDetails], IO Bool) stagedDetails = stagedDetails' parseStagedDetails [] -stagedDetails' :: (S.ByteString -> Maybe t) -> [CommandParam] -> [RawFilePath] -> Repo -> IO ([t], IO Bool)+stagedDetails' :: (S.ByteString -> Maybe t) -> [CommandParam] -> [OsPath] -> Repo -> IO ([t], IO Bool) stagedDetails' parser ps l repo = guardSafeForLsFiles repo $ do 	(ls, cleanup) <- pipeNullSplit' params repo 	return (mapMaybe parser ls, cleanup)   where 	params = Param "ls-files" : Param "--stage" : Param "-z" : ps ++ -		Param "--" : map (File . fromRawFilePath) l+		Param "--" : map (File . fromOsPath) l  parseStagedDetails :: S.ByteString -> Maybe StagedDetails parseStagedDetails = eitherToMaybe . A.parseOnly parser@@ -196,28 +198,28 @@ 		stagenum <- A8.decimal 		void $ A8.char '\t' 		file <- A.takeByteString-		return (file, sha, mode, stagenum)+		return (toOsPath file, sha, mode, stagenum) 	 	nextword = A8.takeTill (== ' ')  {- Returns a list of the files in the specified locations that are staged  - for commit, and whose type has changed. -}-typeChangedStaged :: [RawFilePath] -> Repo -> IO ([RawFilePath], IO Bool)+typeChangedStaged :: [OsPath] -> Repo -> IO ([OsPath], 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 :: [RawFilePath] -> Repo -> IO ([RawFilePath], IO Bool)+typeChanged :: [OsPath] -> Repo -> IO ([OsPath], IO Bool) typeChanged = typeChanged' [] -typeChanged' :: [CommandParam] -> [RawFilePath] -> Repo -> IO ([RawFilePath], IO Bool)+typeChanged' :: [CommandParam] -> [OsPath] -> Repo -> IO ([OsPath], IO Bool) typeChanged' ps l repo = guardSafeForLsFiles 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 <- R.getCurrentDirectory-	return (map (\f -> relPathDirToFileAbs currdir $ top P.</> f) fs, cleanup)+	currdir <- getCurrentDirectory+	return (map (\f -> relPathDirToFileAbs currdir $ top </> toOsPath f) fs, cleanup)   where 	prefix =  		[ Param "diff"@@ -225,7 +227,7 @@ 		, Param "--diff-filter=T" 		, Param "-z" 		]-	suffix = Param "--" : (if null l then [File "."] else map (File . fromRawFilePath) l)+	suffix = Param "--" : (if null l then [File "."] else map (File . fromOsPath) l)  {- A item in conflict has two possible values.  - Either can be Nothing, when that side deleted the file. -}@@ -235,10 +237,10 @@ 	} deriving (Show)  data Unmerged = Unmerged-	{ unmergedFile :: RawFilePath+	{ unmergedFile :: OsPath 	, unmergedTreeItemType :: Conflicting TreeItemType 	, unmergedSha :: Conflicting Sha-	, unmergedSiblingFile :: Maybe RawFilePath+	, unmergedSiblingFile :: Maybe OsPath 	-- ^ Normally this is Nothing, because a 	-- merge conflict is represented as a single file with two 	-- stages. However, git resolvers sometimes choose to stage@@ -257,7 +259,7 @@  -   3 = them  - If line 2 or 3 is omitted, that side removed the file.  -}-unmerged :: [RawFilePath] -> Repo -> IO ([Unmerged], IO Bool)+unmerged :: [OsPath] -> Repo -> IO ([Unmerged], IO Bool) unmerged l repo = guardSafeForLsFiles repo $ do 	(fs, cleanup) <- pipeNullSplit params repo 	return (reduceUnmerged [] $ catMaybes $ map (parseUnmerged . decodeBL) fs, cleanup)@@ -267,11 +269,11 @@ 		Param "--unmerged" : 		Param "-z" : 		Param "--" :-		map (File . fromRawFilePath) l+		map (File . fromOsPath) l  data InternalUnmerged = InternalUnmerged 	{ isus :: Bool-	, ifile :: RawFilePath+	, ifile :: OsPath 	, itreeitemtype :: Maybe TreeItemType 	, isha :: Maybe Sha 	} deriving (Show)@@ -287,7 +289,7 @@ 				else do 					treeitemtype <- readTreeItemType (encodeBS rawtreeitemtype) 					sha <- extractSha (encodeBS rawsha)-					return $ InternalUnmerged (stage == 2) (toRawFilePath file)+					return $ InternalUnmerged (stage == 2) (toOsPath file) 						(Just treeitemtype) (Just sha) 		_ -> Nothing   where@@ -321,7 +323,7 @@ 	-- foo~<ref> are unmerged sibling files of foo 	-- Some versions or resolvers of git stage the sibling files, 	-- other versions or resolvers do not.-	issibfile x y = (ifile x <> "~") `S.isPrefixOf` ifile y+	issibfile x y = (ifile x <> literalOsPath "~") `OS.isPrefixOf` ifile y 		&& isus x || isus y 		&& not (isus x && isus y) @@ -330,7 +332,7 @@  - 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 :: [RawFilePath] -> Repo -> IO ([(FilePath, Maybe InodeCache)], IO Bool)+inodeCaches :: [OsPath] -> Repo -> IO ([(OsPath, Maybe InodeCache)], IO Bool) inodeCaches locs repo = guardSafeForLsFiles repo $ do 	(ls, cleanup) <- pipeNullSplit params repo 	return (parse Nothing (map decodeBL ls), cleanup)@@ -341,16 +343,16 @@ 		Param "-z" : 		Param "--debug" : 		Param "--" :-		map (File . fromRawFilePath) locs+		map (File . fromOsPath) locs 	 	parse Nothing (f:ls) = parse (Just f) ls 	parse (Just f) (s:[]) =  		let i = parsedebug s-		in (f, i) : []+		in (toOsPath f, i) : [] 	parse (Just f) (s:ls) = 		let (d, f') = splitdebug s 		    i = parsedebug d-		in (f, i) : parse (Just f') ls+		in (toOsPath f, i) : parse (Just f') ls 	parse _ _ = []  	-- First 5 lines are --debug output, remainder is the next filename.@@ -373,4 +375,4 @@ 		mkInodeCache 			<$> (readish =<< M.lookup "ino:" m) 			<*> (readish =<< M.lookup "size:" m)-			<*> (parsePOSIXTime =<< (replace ":" "." <$> M.lookup "mtime:" m))+			<*> (parsePOSIXTime =<< (encodeBS . replace ":" "." <$> M.lookup "mtime:" m))
Git/LsTree.hs view
@@ -137,7 +137,8 @@ 		-- sha 		<*> (Ref <$> A8.takeTill A8.isSpace) -	fileparser = asTopFilePath . Git.Quote.unquote <$> A.takeByteString+	fileparser = asTopFilePath . toOsPath . Git.Quote.unquote+		<$> A.takeByteString  	sizeparser = fmap Just A8.decimal @@ -152,4 +153,6 @@ 	[ encodeBS (showOct (mode ti) "") 	, typeobj ti 	, fromRef' (sha ti)-	] <> (S.cons (fromIntegral (ord '\t')) (getTopFilePath (file ti)))+	] +	<> (S.cons (fromIntegral (ord '\t'))+		(fromOsPath (getTopFilePath (file ti))))
Git/Objects.hs view
@@ -12,38 +12,47 @@ import Common import Git import Git.Sha+import qualified Utility.OsString as OS  import qualified Data.ByteString as B-import qualified System.FilePath.ByteString as P--objectsDir :: Repo -> RawFilePath-objectsDir r = localGitDir r P.</> "objects"+objectsDir :: Repo -> OsPath+objectsDir r = localGitDir r </> literalOsPath "objects" -packDir :: Repo -> RawFilePath-packDir r = objectsDir r P.</> "pack"+packDir :: Repo -> OsPath+packDir r = objectsDir r </> literalOsPath "pack" -packIdxFile :: RawFilePath -> RawFilePath-packIdxFile = flip P.replaceExtension "idx"+packIdxFile :: OsPath -> OsPath+packIdxFile = flip replaceExtension (literalOsPath "idx") -listPackFiles :: Repo -> IO [FilePath]-listPackFiles r = filter (".pack" `isSuffixOf`) -	<$> catchDefaultIO [] (dirContents $ fromRawFilePath $ packDir r)+listPackFiles :: Repo -> IO [OsPath]+listPackFiles r = filter (literalOsPath ".pack" `OS.isSuffixOf`) +	<$> catchDefaultIO [] (dirContents $ packDir r)  listLooseObjectShas :: Repo -> IO [Sha] listLooseObjectShas r = catchDefaultIO [] $-	mapMaybe (extractSha . encodeBS . concat . reverse . take 2 . reverse . splitDirectories)-		<$> emptyWhenDoesNotExist (dirContentsRecursiveSkipping (== "pack") True (fromRawFilePath (objectsDir r)))+	mapMaybe conv <$> emptyWhenDoesNotExist+		(dirContentsRecursiveSkipping ispackdir True (objectsDir r))+  where+	conv :: OsPath -> Maybe Sha+	conv = extractSha +		. fromOsPath+		. OS.concat+		. reverse+		. take 2+		. reverse+		. splitDirectories+	ispackdir f = f == literalOsPath "pack" -looseObjectFile :: Repo -> Sha -> RawFilePath-looseObjectFile r sha = objectsDir r P.</> prefix P.</> rest+looseObjectFile :: Repo -> Sha -> OsPath+looseObjectFile r sha = objectsDir r </> toOsPath prefix </> toOsPath rest   where 	(prefix, rest) = B.splitAt 2 (fromRef' sha)  listAlternates :: Repo -> IO [FilePath] listAlternates r = catchDefaultIO [] $-	lines <$> readFile (fromRawFilePath alternatesfile)+	lines <$> readFile (fromOsPath alternatesfile)   where-	alternatesfile = objectsDir r P.</> "info" P.</> "alternates"+	alternatesfile = objectsDir r </> literalOsPath "info" </> literalOsPath "alternates"  {- A repository recently cloned with --shared will have one or more  - alternates listed, and contain no loose objects or packs. -}
Git/Queue.hs view
@@ -53,11 +53,11 @@ 	 - those will be run before the FlushAction is. -} 	| FlushAction 		{ getFlushActionRunner :: FlushActionRunner m-		, getFlushActionFiles :: [RawFilePath]+		, getFlushActionFiles :: [OsPath] 		}  {- The String must be unique for each flush action. -}-data FlushActionRunner m = FlushActionRunner String (Repo -> [RawFilePath] -> m ())+data FlushActionRunner m = FlushActionRunner String (Repo -> [OsPath] -> m ())  instance Eq (FlushActionRunner m) where 	FlushActionRunner s1 _ == FlushActionRunner s2 _ = s1 == s2@@ -140,7 +140,7 @@ {- Adds an flush action to the queue. This can co-exist with anything else  - that gets added to the queue, and when the queue is eventually flushed,  - it will be run after the other things in the queue. -}-addFlushAction :: MonadIO m => FlushActionRunner m -> [RawFilePath] -> Queue m -> Repo -> m (Queue m)+addFlushAction :: MonadIO m => FlushActionRunner m -> [OsPath] -> Queue m -> Repo -> m (Queue m) addFlushAction runner files q repo = 	updateQueue action (const False) (length files) q repo   where
Git/Quote.hs view
@@ -7,6 +7,7 @@  -}  {-# LANGUAGE OverloadedStrings, TypeSynonymInstances #-}+{-# LANGUAGE CPP #-}  module Git.Quote ( 	unquote,@@ -71,17 +72,23 @@  	noquote = id +#ifdef WITH_OSPATH+instance Quoteable OsPath where+	quote qp f = quote qp (fromOsPath f :: RawFilePath)+	noquote = fromOsPath+#endif+ -- Allows building up a string that contains paths, which will get quoted. -- With OverloadedStrings, strings are passed through without quoting. -- Eg: QuotedPath f <> ": not found" data StringContainingQuotedPath 	= UnquotedString String  	| UnquotedByteString S.ByteString -	| QuotedPath RawFilePath+	| QuotedPath OsPath 	| StringContainingQuotedPath :+: StringContainingQuotedPath 	deriving (Show, Eq) -quotedPaths :: [RawFilePath] -> StringContainingQuotedPath+quotedPaths :: [OsPath] -> StringContainingQuotedPath quotedPaths [] = mempty quotedPaths (p:ps) = QuotedPath p <> if null ps 	then mempty@@ -90,12 +97,12 @@ instance Quoteable StringContainingQuotedPath where 	quote _ (UnquotedString s) = safeOutput (encodeBS s) 	quote _ (UnquotedByteString s) = safeOutput s-	quote qp (QuotedPath p) = quote qp p+	quote qp (QuotedPath p) = quote qp (fromOsPath p :: RawFilePath) 	quote qp (a :+: b) = quote qp a <> quote qp b  	noquote (UnquotedString s) = encodeBS s 	noquote (UnquotedByteString s) = s-	noquote (QuotedPath p) = p+	noquote (QuotedPath p) = fromOsPath p 	noquote (a :+: b) = noquote a <> noquote b  instance IsString StringContainingQuotedPath where
Git/Ref.hs view
@@ -15,6 +15,7 @@ import Git.Sha import Git.Types import Git.FilePath+import qualified Utility.FileIO as F  import Data.Char (chr, ord) import qualified Data.ByteString as S@@ -23,11 +24,12 @@ headRef :: Ref headRef = Ref "HEAD" -headFile :: Repo -> FilePath-headFile r = fromRawFilePath (localGitDir r) </> "HEAD"+headFile :: Repo -> OsPath+headFile r = localGitDir r </> literalOsPath "HEAD"  setHeadRef :: Ref -> Repo -> IO ()-setHeadRef ref r = S.writeFile (headFile r) ("ref: " <> fromRef' ref)+setHeadRef ref r = +	F.writeFile' (headFile r) ("ref: " <> fromRef' ref)  {- Converts a fully qualified git ref into a user-visible string. -} describe :: Ref -> String@@ -67,7 +69,7 @@  -   - If the input file is located outside the repository, returns Nothing.  -}-fileRef :: RawFilePath -> Repo -> IO (Maybe Ref)+fileRef :: OsPath -> Repo -> IO (Maybe Ref) fileRef f repo = do 	-- The filename could be absolute, or contain eg "../repo/file", 	-- neither of which work in a ref, so convert it to a minimal@@ -77,12 +79,13 @@  		-- Prefixing the file with ./ makes this work even when in a 		-- subdirectory of a repo. Eg, ./foo in directory bar refers 		-- to bar/foo, not to foo in the top of the repository.-		then Just $ Ref $ ":./" <> toInternalGitPath f'+		then Just $ Ref $ ":./" <> fromOsPath (toInternalGitPath f') 		else Nothing  {- A Ref that can be used to refer to a file in a particular branch. -}-branchFileRef :: Branch -> RawFilePath -> Ref-branchFileRef branch f = Ref $ fromRef' branch <> ":" <> toInternalGitPath f+branchFileRef :: Branch -> OsPath -> Ref+branchFileRef branch f = Ref $ fromOsPath $+	toOsPath (fromRef' branch) <> literalOsPath ":" <> toInternalGitPath f  {- Converts a Ref to refer to the content of the Ref on a given date. -} dateRef :: Ref -> RefDate -> Ref@@ -93,7 +96,7 @@  -  - If the file path is located outside the repository, returns Nothing.  -}-fileFromRef :: Ref -> RawFilePath -> Repo -> IO (Maybe Ref)+fileFromRef :: Ref -> OsPath -> Repo -> IO (Maybe Ref) fileFromRef r f repo = fileRef f repo >>= return . \case 	Just (Ref fr) -> Just (Ref (fromRef' r <> fr)) 	Nothing -> Nothing@@ -110,8 +113,8 @@  {- The file used to record a ref. (Git also stores some refs in a  - packed-refs file.) -}-file :: Ref -> Repo -> FilePath-file ref repo = fromRawFilePath (localGitDir repo) </> fromRef ref+file :: Ref -> Repo -> OsPath+file ref repo = localGitDir repo </> toOsPath (fromRef' ref)  {- Checks if HEAD exists. It generally will, except for in a repository  - that was just created. -}
Git/Remote.hs view
@@ -122,8 +122,8 @@ #ifdef mingw32_HOST_OS 	-- git on Windows will write a path to .git/config with "drive:", 	-- which is not to be confused with a "host:"-	dosstyle = hasDrive-	dospath = fromRawFilePath . fromInternalGitPath . toRawFilePath+	dosstyle = hasDrive . toOsPath+	dospath = fromOsPath . fromInternalGitPath . toOsPath #endif  insteadOfUrl :: String -> S.ByteString -> RepoFullConfig -> Maybe String
Git/Repair.hs view
@@ -43,11 +43,11 @@ import Utility.Tmp.Dir import Utility.Rsync import Utility.FileMode-import qualified Utility.RawFilePath as R+import qualified Utility.FileIO as F  import qualified Data.Set as S+import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as L-import qualified System.FilePath.ByteString as P  {- Given a set of bad objects found by git fsck, which may not  - be complete, finds and removes all corrupt objects. -}@@ -57,7 +57,7 @@ 	mapM_ removeLoose (S.toList $ knownMissing fsckresults) 	mapM_ removeBad =<< listLooseObjectShas r   where-	removeLoose s = removeWhenExistsWith R.removeLink (looseObjectFile r s)+	removeLoose s = removeWhenExistsWith removeFile $ looseObjectFile r s 	removeBad s = do 		void $ tryIO $ allowRead $ looseObjectFile r s 		whenM (isMissing s r) $@@ -78,29 +78,25 @@ explodePacks r = go =<< listPackFiles r   where 	go [] = return False-	go packs = withTmpDir "packs" $ \tmpdir -> do-		r' <- addGitEnv r "GIT_OBJECT_DIRECTORY" tmpdir+	go packs = withTmpDir (literalOsPath "packs") $ \tmpdir -> do+		r' <- addGitEnv r "GIT_OBJECT_DIRECTORY" (fromOsPath tmpdir) 		putStrLn "Unpacking all pack files." 		forM_ packs $ \packfile -> do 			-- Just in case permissions are messed up.-			allowRead (toRawFilePath packfile)+			allowRead packfile 			-- May fail, if pack file is corrupt. 			void $ tryIO $ 				pipeWrite [Param "unpack-objects", Param "-r"] r' $ \h ->-				L.hPut h =<< L.readFile packfile+				L.hPut h =<< F.readFile packfile 		objs <- emptyWhenDoesNotExist (dirContentsRecursive tmpdir) 		forM_ objs $ \objfile -> do-			f <- relPathDirToFile-				(toRawFilePath tmpdir)-				(toRawFilePath objfile)-			let dest = objectsDir r P.</> f-			createDirectoryIfMissing True-				(fromRawFilePath (parentDir dest))-			moveFile (toRawFilePath objfile) dest+			f <- relPathDirToFile tmpdir objfile+			let dest = objectsDir r </> f+			createDirectoryIfMissing True (parentDir dest)+			moveFile objfile dest 		forM_ packs $ \packfile -> do-			let f = toRawFilePath packfile-			removeWhenExistsWith R.removeLink f-			removeWhenExistsWith R.removeLink (packIdxFile f)+			removeWhenExistsWith removeFile packfile+			removeWhenExistsWith removeFile (packIdxFile packfile) 		return True  {- Try to retrieve a set of missing objects, from the remotes of a@@ -113,13 +109,13 @@ retrieveMissingObjects :: FsckResults -> Maybe FilePath -> Repo -> IO FsckResults retrieveMissingObjects missing referencerepo r 	| not (foundBroken missing) = return missing-	| otherwise = withTmpDir "tmprepo" $ \tmpdir -> do-		unlessM (boolSystem "git" [Param "init", File tmpdir]) $-			giveup $ "failed to create temp repository in " ++ tmpdir-		tmpr <- Config.read =<< Construct.fromPath (toRawFilePath tmpdir)-		let repoconfig r' = fromRawFilePath (localGitDir r' P.</> "config")+	| otherwise = withTmpDir (literalOsPath "tmprepo") $ \tmpdir -> do+		unlessM (boolSystem "git" [Param "init", File (fromOsPath tmpdir)]) $+			giveup $ "failed to create temp repository in " ++ fromOsPath tmpdir+		tmpr <- Config.read =<< Construct.fromPath tmpdir+		let repoconfig r' = localGitDir r' </> literalOsPath "config" 		whenM (doesFileExist (repoconfig r)) $-			L.readFile (repoconfig r) >>= L.writeFile (repoconfig tmpr)+			F.readFile (repoconfig r) >>= F.writeFile (repoconfig tmpr) 		rs <- Construct.fromRemotes r 		stillmissing <- pullremotes tmpr rs fetchrefstags missing 		if S.null (knownMissing stillmissing)@@ -180,8 +176,8 @@ copyObjects :: Repo -> Repo -> IO Bool copyObjects srcr destr = rsync 	[ Param "-qr"-	, File $ addTrailingPathSeparator $ fromRawFilePath $ objectsDir srcr-	, File $ addTrailingPathSeparator $ fromRawFilePath $ objectsDir destr+	, File $ fromOsPath $ addTrailingPathSeparator $ objectsDir srcr+	, File $ fromOsPath $ addTrailingPathSeparator $ objectsDir destr 	]  {- To deal with missing objects that cannot be recovered, resets any@@ -248,35 +244,35 @@  - Relies on packed refs being exploded before it's called.  -} getAllRefs :: Repo -> IO [Ref]-getAllRefs r = getAllRefs' (fromRawFilePath (localGitDir r) </> "refs")+getAllRefs r = getAllRefs' (localGitDir r </> literalOsPath "refs") -getAllRefs' :: FilePath -> IO [Ref]+getAllRefs' :: OsPath -> IO [Ref] getAllRefs' refdir = do 	let topsegs = length (splitPath refdir) - 1-	let toref = Ref . toInternalGitPath . encodeBS -		. joinPath . drop topsegs . splitPath+	let toref = Ref . fromOsPath . toInternalGitPath +		. joinPath . drop topsegs . splitPath  	map toref <$> emptyWhenDoesNotExist (dirContentsRecursive refdir)  explodePackedRefsFile :: Repo -> IO () explodePackedRefsFile r = do 	let f = packedRefsFile r-	let f' = toRawFilePath f 	whenM (doesFileExist f) $ do-		rs <- mapMaybe parsePacked . lines-			<$> catchDefaultIO "" (safeReadFile f')+		rs <- mapMaybe parsePacked+			. map decodeBS+			. fileLines'+			<$> catchDefaultIO "" (safeReadFile f) 		forM_ rs makeref-		removeWhenExistsWith R.removeLink f'+		removeWhenExistsWith removeFile f   where 	makeref (sha, ref) = do 		let gitd = localGitDir r-		let dest = gitd P.</> fromRef' ref-		let dest' = fromRawFilePath dest+		let dest = gitd </> toOsPath (fromRef' ref) 		createDirectoryUnder [gitd] (parentDir dest)-		unlessM (doesFileExist dest') $-			writeFile dest' (fromRef sha)+		unlessM (doesFileExist dest) $+			writeFile (fromOsPath dest) (fromRef sha) -packedRefsFile :: Repo -> FilePath-packedRefsFile r = fromRawFilePath (localGitDir r) </> "packed-refs"+packedRefsFile :: Repo -> OsPath+packedRefsFile r = localGitDir r </> literalOsPath "packed-refs"  parsePacked :: String -> Maybe (Sha, Ref) parsePacked l = case words l of@@ -288,7 +284,8 @@ {- git-branch -d cannot be used to remove a branch that is directly  - pointing to a corrupt commit. -} nukeBranchRef :: Branch -> Repo -> IO ()-nukeBranchRef b r = removeWhenExistsWith R.removeLink $ localGitDir r P.</> fromRef' b+nukeBranchRef b r = removeWhenExistsWith removeFile $+	localGitDir r </> toOsPath (fromRef' b)  {- Finds the most recent commit to a branch that does not need any  - of the missing objects. If the input branch is good as-is, returns it.@@ -407,7 +404,7 @@ 	length indexcontents `seq` cleanup  missingIndex :: Repo -> IO Bool-missingIndex r = not <$> doesFileExist (fromRawFilePath (localGitDir r) </> "index")+missingIndex r = not <$> doesFileExist (localGitDir r </> literalOsPath "index")  {- Finds missing and ok files staged in the index. -} partitionIndex :: Repo -> IO ([LsFiles.StagedDetails], [LsFiles.StagedDetails], IO Bool)@@ -426,11 +423,11 @@ 	| otherwise = do 		(bad, good, cleanup) <- partitionIndex r 		unless (null bad) $ do-			removeWhenExistsWith R.removeLink (indexFile r)+			removeWhenExistsWith removeFile (indexFile r) 			UpdateIndex.streamUpdateIndex r 				=<< (catMaybes <$> mapM reinject good) 		void cleanup-		return $ map (\(file,_, _, _) -> fromRawFilePath file) bad+		return $ map (\(file,_, _, _) -> fromOsPath file) bad   where 	reinject (file, sha, mode, _) = case toTreeItemType mode of 		Nothing -> return Nothing@@ -473,14 +470,14 @@  -} preRepair :: Repo -> IO () preRepair g = do-	unlessM (validhead <$> catchDefaultIO "" (safeReadFile headfile)) $ do-		removeWhenExistsWith R.removeLink headfile-		writeFile (fromRawFilePath headfile) "ref: refs/heads/master"+	unlessM (validhead <$> catchDefaultIO "" (decodeBS <$> safeReadFile headfile)) $ do+		removeWhenExistsWith removeFile headfile+		writeFile (fromOsPath headfile) "ref: refs/heads/master" 	explodePackedRefsFile g 	unless (repoIsLocalBare g) $ 		void $ tryIO $ allowWrite $ indexFile g   where-	headfile = localGitDir g P.</> "HEAD"+	headfile = localGitDir g </> literalOsPath "HEAD" 	validhead s = "ref: refs/" `isPrefixOf` s 		|| isJust (extractSha (encodeBS s)) @@ -607,7 +604,7 @@ 			else successfulfinish modifiedbranches  	corruptedindex = do-		removeWhenExistsWith R.removeLink (indexFile g)+		removeWhenExistsWith removeFile (indexFile g) 		-- The corrupted index can prevent fsck from finding other 		-- problems, so re-run repair. 		fsckresult' <- findBroken False False g@@ -651,7 +648,7 @@ successfulRepair :: (Bool, [Branch]) -> Bool successfulRepair = fst -safeReadFile :: RawFilePath -> IO String+safeReadFile :: OsPath -> IO B.ByteString safeReadFile f = do 	allowRead f-	readFileStrict (fromRawFilePath f)+	F.readFile' f
Git/Status.hs view
@@ -57,13 +57,13 @@ 					in go (v : c) xs' 		_ -> go c xs -	cparse 'M' f _ = (Just (Modified (asTopFilePath (toRawFilePath f))), Nothing)-	cparse 'A' f _ = (Just (Added (asTopFilePath (toRawFilePath f))), Nothing)-	cparse 'D' f _ = (Just (Deleted (asTopFilePath (toRawFilePath f))), Nothing)-	cparse 'T' f _ = (Just (TypeChanged (asTopFilePath (toRawFilePath f))), Nothing)-	cparse '?' f _ = (Just (Untracked (asTopFilePath (toRawFilePath f))), Nothing)+	cparse 'M' f _ = (Just (Modified (asTopFilePath (toOsPath f))), Nothing)+	cparse 'A' f _ = (Just (Added (asTopFilePath (toOsPath f))), Nothing)+	cparse 'D' f _ = (Just (Deleted (asTopFilePath (toOsPath f))), Nothing)+	cparse 'T' f _ = (Just (TypeChanged (asTopFilePath (toOsPath f))), Nothing)+	cparse '?' f _ = (Just (Untracked (asTopFilePath (toOsPath f))), Nothing) 	cparse 'R' f (oldf:xs) =-		(Just (Renamed (asTopFilePath (toRawFilePath oldf)) (asTopFilePath (toRawFilePath f))), Just xs)+		(Just (Renamed (asTopFilePath (toOsPath oldf)) (asTopFilePath (toOsPath f))), Just xs) 	cparse _ _ _ = (Nothing, Nothing)  getStatus :: [CommandParam] -> [FilePath] -> Repo -> IO ([StagedUnstaged Status], IO Bool)
Git/Tree.hs view
@@ -37,14 +37,13 @@ import Git.Sha import qualified Git.LsTree as LsTree import qualified Utility.CoProcess as CoProcess-import qualified System.FilePath.ByteString as P+import qualified Utility.OsString as OS  import Numeric import System.Posix.Types import Control.Monad.IO.Class import qualified Data.Set as S import qualified Data.Map as M-import qualified Data.ByteString as B import qualified Data.ByteString.Char8 as S8  newtype Tree = Tree [TreeContent]@@ -137,7 +136,7 @@ 	, " " 	, fromRef s 	, "\t"-	, takeFileName (fromRawFilePath (getTopFilePath f))+	, fromOsPath (takeFileName (getTopFilePath f)) 	, "\NUL" 	] @@ -181,7 +180,7 @@ 				go (addsubtree idir m (NewSubTree (asTopFilePath idir) [c])) is 	  where 		p = gitPath i-		idir = P.takeDirectory p+		idir = takeDirectory p 		c = treeItemToTreeContent i  	addsubtree d m t@@ -194,7 +193,7 @@ 				_ -> addsubtree parent m' (NewSubTree (asTopFilePath parent) [t]) 		| otherwise = M.insert d t m 	  where-		parent = P.takeDirectory d+		parent = takeDirectory d  {- Flattens the top N levels of a Tree. -} flattenTree :: Int -> Tree -> Tree@@ -285,9 +284,9 @@ 	addtreeitempathmap = mkPathMap addtreeitems 	addtreeitemprefixmap = mkSubTreePathPrefixMap addtreeitems -	removeset = S.fromList $ map (P.normalise . gitPath) removefiles-	removed (TreeBlob f _ _) = S.member (P.normalise (gitPath f)) removeset-	removed (TreeCommit f _ _) = S.member (P.normalise (gitPath f)) removeset+	removeset = S.fromList $ map (normalise . gitPath) removefiles+	removed (TreeBlob f _ _) = S.member (normalise (gitPath f)) removeset+	removed (TreeCommit f _ _) = S.member (normalise (gitPath f)) removeset 	removed (RecordedSubTree _ _ _) = False 	removed (NewSubTree _ _) = False @@ -303,7 +302,7 @@ 					addoldnew' (M.delete k oldm) ns 				Nothing -> n : addoldnew' oldm ns 	addoldnew' oldm [] = M.elems oldm-	mkk = P.normalise . gitPath+	mkk = normalise . gitPath  {- Grafts subtree into the basetree at the specified location, replacing  - anything that the basetree already had at that location.@@ -360,7 +359,7 @@ 		| d == graftloc = graftin' [] 		| otherwise = NewSubTree d [graftin' rest] -	subdirs = P.splitDirectories $ gitPath graftloc+	subdirs = splitDirectories $ gitPath graftloc  	graftdirs = map (asTopFilePath . toInternalGitPath) $ 		pathPrefixes subdirs@@ -392,13 +391,13 @@ 	parseerr = Left  class GitPath t where-	gitPath :: t -> RawFilePath+	gitPath :: t -> OsPath -instance GitPath RawFilePath where+instance GitPath OsPath where 	gitPath = id  instance GitPath FilePath where-	gitPath = toRawFilePath+	gitPath = toOsPath  instance GitPath TopFilePath where 	gitPath = getTopFilePath@@ -418,22 +417,22 @@ inTopTree :: GitPath t => t -> Bool inTopTree = inTree topTreePath -topTreePath :: RawFilePath-topTreePath = "."+topTreePath :: OsPath+topTreePath = literalOsPath "."  inTree :: (GitPath t, GitPath f) => t -> f -> Bool-inTree t f = gitPath t == P.takeDirectory (gitPath f)+inTree t f = gitPath t == takeDirectory (gitPath f)  beneathSubTree :: (GitPath t, GitPath f) => t -> f -> Bool-beneathSubTree t f = subTreePrefix t `B.isPrefixOf` subTreePath f+beneathSubTree t f = subTreePrefix t `OS.isPrefixOf` subTreePath f -subTreePath :: GitPath t => t -> RawFilePath-subTreePath = P.normalise . gitPath+subTreePath :: GitPath t => t -> OsPath+subTreePath = normalise . gitPath -subTreePrefix :: GitPath t => t -> RawFilePath+subTreePrefix :: GitPath t => t -> OsPath subTreePrefix t-	| B.null tp = tp-	| otherwise = P.addTrailingPathSeparator (P.normalise tp)+	| OS.null tp = tp+	| otherwise = addTrailingPathSeparator (normalise tp)   where 	tp = gitPath t @@ -443,23 +442,23 @@  - Values that are not in any subdirectory are placed in  - the topTreePath key.  -}-mkPathMap :: GitPath t => [t] -> M.Map RawFilePath [t]+mkPathMap :: GitPath t => [t] -> M.Map OsPath [t] mkPathMap l = M.fromListWith (++) $-	map (\ti -> (P.takeDirectory (gitPath ti), [ti])) l+	map (\ti -> (takeDirectory (gitPath ti), [ti])) l  {- Input is eg splitDirectories "foo/bar/baz",  - for which it will output ["foo", "foo/bar", "foo/bar/baz"] -}-pathPrefixes :: [RawFilePath] -> [RawFilePath]+pathPrefixes :: [OsPath] -> [OsPath] pathPrefixes = go []   where 	go _ [] = []-	go base (d:rest) = (P.joinPath base P.</> d) : go (base ++ [d]) rest+	go base (d:rest) = (joinPath base </> d) : go (base ++ [d]) rest  {- Makes a Map where the keys are all subtree path prefixes,   - and the values are items with that subtree path prefix.  -}-mkSubTreePathPrefixMap :: GitPath t => [t] -> M.Map RawFilePath [t]+mkSubTreePathPrefixMap :: GitPath t => [t] -> M.Map OsPath [t] mkSubTreePathPrefixMap l = M.fromListWith (++) $ concatMap go l   where 	go ti = map (\p -> (p, [ti]))-		(map subTreePrefix $ pathPrefixes $ P.splitDirectories $ subTreePath ti)+		(map subTreePrefix $ pathPrefixes $ splitDirectories $ subTreePath ti)
Git/Types.hs view
@@ -6,9 +6,14 @@  -}  {-# LANGUAGE OverloadedStrings, TypeSynonymInstances, FlexibleInstances #-}+{-# LANGUAGE CPP #-}  module Git.Types where +import Utility.SafeCommand+import Utility.FileSystemEncoding+import Utility.OsPath+ import Network.URI import Data.String import Data.Default@@ -16,8 +21,6 @@ import qualified Data.ByteString as S import qualified Data.List.NonEmpty as NE import System.Posix.Types-import Utility.SafeCommand-import Utility.FileSystemEncoding import qualified Data.Semigroup as Sem import Prelude @@ -32,8 +35,8 @@  - else known about it.  -} data RepoLocation-	= Local { gitdir :: RawFilePath, worktree :: Maybe RawFilePath }-	| LocalUnknown RawFilePath+	= Local { gitdir :: OsPath, worktree :: Maybe OsPath }+	| LocalUnknown OsPath 	| Url URI 	| UnparseableUrl String 	| Unknown@@ -105,6 +108,11 @@ instance FromConfigValue String where 	fromConfigValue = decodeBS . fromConfigValue +#ifdef WITH_OSPATH+instance FromConfigValue OsPath where+	fromConfigValue v = toOsPath (fromConfigValue v :: S.ByteString)+#endif+ instance Show ConfigValue where 	show = fromConfigValue @@ -137,7 +145,7 @@  {- Types of objects that can be stored in git. -} data ObjectType = BlobObject | CommitObject | TreeObject-	deriving (Show)+	deriving (Show, Eq)  readObjectType :: S.ByteString -> Maybe ObjectType readObjectType "blob" = Just BlobObject
Git/UnionMerge.hs view
@@ -76,14 +76,14 @@ 	void $ cleanup   where 	go [] = noop-	go (info:file:rest) = mergeFile info file hashhandle ch >>=+	go (info:file:rest) = mergeFile info (toOsPath file) hashhandle ch >>= 		maybe (go rest) (\l -> streamer l >> go rest) 	go (_:[]) = giveup $ "parse error " ++ show differ  {- 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 :: S.ByteString -> RawFilePath -> HashObjectHandle -> CatFileHandle -> IO (Maybe L.ByteString)+mergeFile :: S.ByteString -> OsPath -> HashObjectHandle -> CatFileHandle -> IO (Maybe L.ByteString) mergeFile info file hashhandle h = case S8.words info of 	[_colonmode, _bmode, asha, bsha, _status] ->  		case filter (`notElem` nullShas) [Ref asha, Ref bsha] of
Git/UpdateIndex.hs view
@@ -81,6 +81,7 @@ 	void $ cleanup   where 	params = map Param ["ls-tree", "-z", "-r", "--full-tree", decodeBS x]+ lsSubTree :: Ref -> FilePath -> Repo -> Streamer lsSubTree (Ref x) p repo streamer = do 	(s, cleanup) <- pipeNullSplit params repo@@ -97,15 +98,15 @@ 	<> " blob " 	<> fromRef' sha 	<> "\t"-	<> indexPath file+	<> fromOsPath (indexPath file) -stageFile :: Sha -> TreeItemType -> RawFilePath -> Repo -> IO Streamer+stageFile :: Sha -> TreeItemType -> OsPath -> Repo -> IO Streamer stageFile sha treeitemtype file repo = do 	p <- toTopFilePath file repo 	return $ pureStreamer $ updateIndexLine sha treeitemtype p  {- A streamer that removes a file from the index. -}-unstageFile :: RawFilePath -> Repo -> IO Streamer+unstageFile :: OsPath -> Repo -> IO Streamer unstageFile file repo = do 	p <- toTopFilePath file repo 	return $ unstageFile' p@@ -115,10 +116,10 @@ 	"0 " 	<> fromRef' deleteSha 	<> "\t"-	<> indexPath p+	<> fromOsPath (indexPath p)  {- A streamer that adds a symlink to the index. -}-stageSymlink :: RawFilePath -> Sha -> Repo -> IO Streamer+stageSymlink :: OsPath -> Sha -> Repo -> IO Streamer stageSymlink file sha repo = do 	!line <- updateIndexLine 		<$> pure sha@@ -141,7 +142,7 @@  - update-index. Sending Nothing will wait for update-index to finish  - updating the index.  -}-refreshIndex :: (MonadIO m, MonadMask m) => Repo -> ((Maybe RawFilePath -> IO ()) -> m ()) -> m ()+refreshIndex :: (MonadIO m, MonadMask m) => Repo -> ((Maybe OsPath -> IO ()) -> m ()) -> m () refreshIndex repo feeder = bracket 	(liftIO $ createProcess p) 	(liftIO . cleanupProcess)@@ -163,7 +164,7 @@ 			hClose h 			forceSuccessProcess p pid 		feeder $ \case-			Just f -> S.hPut h (S.snoc f 0)+			Just f -> S.hPut h (S.snoc (fromOsPath f) 0) 			Nothing -> closer 		liftIO $ closer 	go _ = error "internal"
Key.hs view
@@ -18,6 +18,7 @@ 	keyParser, 	serializeKey, 	serializeKey',+	serializeKey'', 	deserializeKey, 	deserializeKey', 	nonChunkKey,@@ -31,7 +32,7 @@  import qualified Data.Text as T import qualified Data.ByteString as S-import qualified Data.ByteString.Short as S (toShort, fromShort)+import Data.ByteString.Short (ShortByteString, toShort, fromShort) import qualified Data.Attoparsec.ByteString as A  import Common@@ -63,8 +64,11 @@ serializeKey = decodeBS . serializeKey'  serializeKey' :: Key -> S.ByteString-serializeKey' = S.fromShort . keySerialization+serializeKey' = fromShort . keySerialization +serializeKey'' :: Key -> ShortByteString+serializeKey'' = keySerialization+ deserializeKey :: String -> Maybe Key deserializeKey = deserializeKey' . encodeBS @@ -73,7 +77,7 @@  instance Arbitrary KeyData where 	arbitrary = Key-		<$> (S.toShort . encodeBS <$> (listOf1 $ elements $ ['A'..'Z'] ++ ['a'..'z'] ++ ['0'..'9'] ++ "-_\r\n \t"))+		<$> (toShort . encodeBS <$> (listOf1 $ elements $ ['A'..'Z'] ++ ['a'..'z'] ++ ['0'..'9'] ++ "-_\r\n \t")) 		<*> (parseKeyVariety . encodeBS <$> (listOf1 $ elements ['A'..'Z'])) -- BACKEND 		<*> ((abs <$>) <$> arbitrary) -- size cannot be negative 		<*> ((abs . fromInteger <$>) <$> arbitrary) -- mtime cannot be negative@@ -82,7 +86,7 @@  instance Arbitrary AssociatedFile where   	arbitrary = AssociatedFile-		. fmap (toRawFilePath . fromTestableFilePath)+		. fmap (toOsPath . fromTestableFilePath) 		<$> arbitrary  instance Arbitrary Key where
Limit.hs view
@@ -48,7 +48,6 @@ import Data.Time.Clock.POSIX import qualified Data.Set as S import qualified Data.Map as M-import qualified System.FilePath.ByteString as P import System.PosixCompat.Files (accessTime, isSymbolicLink)  {- Some limits can look at the current status of files on@@ -140,11 +139,12 @@ matchGlobFile glob = go   where 	cglob = compileGlob glob CaseSensitive (GlobFilePath True) -- memoized-	go (MatchingFile fi) = pure $ matchGlob cglob (fromRawFilePath (matchFile fi))+	go (MatchingFile fi) = pure $ matchGlob cglob (fromOsPath (matchFile fi)) 	go (MatchingInfo p) = pure $ case providedFilePath p of-		Just f -> matchGlob cglob (fromRawFilePath f)+		Just f -> matchGlob cglob (fromOsPath f) 		Nothing -> False-	go (MatchingUserInfo p) = matchGlob cglob <$> getUserInfo (userProvidedFilePath p)+	go (MatchingUserInfo p) = matchGlob cglob . fromOsPath+		<$> getUserInfo (userProvidedFilePath p)  {- Add a limit to skip files when there is no other file using the same  - content, with a name matching the glob. -}@@ -188,23 +188,22 @@ 		Just f -> check k f 		Nothing -> return False 	go (MatchingUserInfo p) k = -		check k . toRawFilePath-			=<< getUserInfo (userProvidedFilePath p)+		check k =<< getUserInfo (userProvidedFilePath p) 	 	cglob = compileGlob glob CaseSensitive (GlobFilePath True) -- memoized 	-	matchesglob f = matchGlob cglob (fromRawFilePath f)+	matchesglob f = matchGlob cglob (fromOsPath f) #ifdef mingw32_HOST_OS-		|| matchGlob cglob (fromRawFilePath (toInternalGitPath f))+		|| matchGlob cglob (fromOsPath (toInternalGitPath f)) #endif  	check k skipf = do 		-- Find other files with the same content, with filenames 		-- matching the glob. 		g <- Annex.gitRepo-		fs <- filter (/= P.normalise skipf)+		fs <- filter (/= normalise skipf) 			. filter matchesglob-			. map (\f -> P.normalise (fromTopFilePath f g))+			. map (\f -> normalise (fromTopFilePath f g)) 			<$> Database.Keys.getAssociatedFiles k 		-- Some associated files in the keys database may no longer 		-- correspond to files in the repository. This is checked@@ -219,7 +218,7 @@  addMagicLimit 	:: String-	-> (Magic -> FilePath -> Annex (Maybe String))+	-> (Magic -> OsPath -> Annex (Maybe String)) 	-> (ProvidedInfo -> Maybe String) 	-> (UserProvidedInfo -> UserInfo String) 	-> String@@ -228,20 +227,19 @@ 	magic <- liftIO initMagicMime 	addLimit $ matchMagic limitname querymagic' selectprovidedinfo selectuserprovidedinfo magic glob   where-	querymagic' magic f = liftIO (isPointerFile (toRawFilePath f)) >>= \case+	querymagic' magic f = liftIO (isPointerFile f) >>= \case 		-- Avoid getting magic of a pointer file, which would 		-- wrongly be detected as text. 		Just _ -> return Nothing 		-- When the file is an annex symlink, get magic of the 		-- object file.-		Nothing -> isAnnexLink (toRawFilePath f) >>= \case-			Just k -> withObjectLoc k $-				querymagic magic . fromRawFilePath+		Nothing -> isAnnexLink f >>= \case+			Just k -> withObjectLoc k (querymagic magic) 			Nothing -> querymagic magic f  matchMagic 	:: String-	-> (Magic -> FilePath -> Annex (Maybe String))+	-> (Magic -> OsPath -> Annex (Maybe String)) 	-> (ProvidedInfo -> Maybe String) 	-> (UserProvidedInfo -> UserInfo String) 	-> Maybe Magic@@ -261,7 +259,7 @@  	cglob = compileGlob glob CaseSensitive (GlobFilePath False) -- memoized 	go (MatchingFile fi) = catchBoolIO $ 		maybe False (matchGlob cglob)-			<$> querymagic magic (fromRawFilePath (contentFile fi))+			<$> querymagic magic (contentFile fi) 	go (MatchingInfo p) = maybe 		(usecontent (providedKey p)) 		(pure . matchGlob cglob)@@ -269,8 +267,7 @@ 	go (MatchingUserInfo p) = 		matchGlob cglob <$> getUserInfo (selectuserprovidedinfo p) 	usecontent (Just k) = withObjectLoc k $ \obj -> catchBoolIO $-		maybe False (matchGlob cglob)-			<$> querymagic magic (fromRawFilePath obj)+		maybe False (matchGlob cglob) <$> querymagic magic obj 	usecontent Nothing = pure False matchMagic limitname _ _ _ Nothing _ =  	Left $ "unable to load magic database; \""++limitname++"\" cannot be used"@@ -305,7 +302,7 @@ 	islocked <- isPointerFile f >>= \case 		Just _key -> return False 		Nothing -> isSymbolicLink-			<$> R.getSymbolicLinkStatus f+			<$> R.getSymbolicLinkStatus (fromOsPath f) 	return (islocked == wantlocked) matchLockStatus wantlocked (MatchingInfo p) =  	pure $ case providedLinkType p of@@ -388,7 +385,7 @@ 	}  {- Limit to content that is in a directory, anywhere in the repository tree -}-limitInDir :: FilePath -> String -> MatchFiles Annex+limitInDir :: OsPath -> String -> MatchFiles Annex limitInDir dir desc = MatchFiles  	{ matchAction = const $ const go 	, matchNeedsFileName = True@@ -400,8 +397,8 @@ 	, matchDesc = matchDescSimple desc 	}   where-	go (MatchingFile fi) = checkf $ fromRawFilePath $ matchFile fi-	go (MatchingInfo p) = maybe (pure False) (checkf . fromRawFilePath) (providedFilePath p)+	go (MatchingFile fi) = checkf $ matchFile fi+	go (MatchingInfo p) = maybe (pure False) checkf (providedFilePath p) 	go (MatchingUserInfo p) = checkf =<< getUserInfo (userProvidedFilePath p) 	checkf = return . elem dir . splitPath . takeDirectory @@ -867,7 +864,7 @@   where 	check now k = inAnnexCheck k $ \f -> 		liftIO $ catchDefaultIO False $ do-			s <- R.getSymbolicLinkStatus f+			s <- R.getSymbolicLinkStatus (fromOsPath f) 			let accessed = realToFrac (accessTime s) 			let delta = now - accessed 			return $ delta <= secs
Logs.hs view
@@ -11,9 +11,7 @@  import Annex.Common import Annex.DirHashes--import qualified Data.ByteString as S-import qualified System.FilePath.ByteString as P+import qualified Utility.OsString as OS  {- There are several varieties of log file formats. -} data LogVariety@@ -28,7 +26,7 @@  {- Converts a path from the git-annex branch into one of the varieties  - of logs used by git-annex, if it's a known path. -}-getLogVariety :: GitConfig -> RawFilePath -> Maybe LogVariety+getLogVariety :: GitConfig -> OsPath -> Maybe LogVariety getLogVariety config f 	| f `elem` topLevelOldUUIDBasedLogs = Just OldUUIDBasedLog 	| f `elem` topLevelNewUUIDBasedLogs = Just NewUUIDBasedLog@@ -63,7 +61,7 @@ logFilesToCache = 2  {- All the log files that might contain information about a key. -}-keyLogFiles :: GitConfig -> Key -> [RawFilePath]+keyLogFiles :: GitConfig -> Key -> [OsPath] keyLogFiles config k =  	[ locationLogFile config k 	, urlLogFile config k@@ -76,11 +74,11 @@ 	] ++ oldurlLogs config k  {- All uuid-based logs stored in the top of the git-annex branch. -}-topLevelUUIDBasedLogs :: [RawFilePath]+topLevelUUIDBasedLogs :: [OsPath] topLevelUUIDBasedLogs = topLevelNewUUIDBasedLogs ++ topLevelOldUUIDBasedLogs  {- All the old-format uuid-based logs stored in the top of the git-annex branch. -}-topLevelOldUUIDBasedLogs :: [RawFilePath]+topLevelOldUUIDBasedLogs :: [OsPath] topLevelOldUUIDBasedLogs = 	[ uuidLog 	, remoteLog@@ -95,7 +93,7 @@ 	]  {- All the new-format uuid-based logs stored in the top of the git-annex branch. -}-topLevelNewUUIDBasedLogs :: [RawFilePath]+topLevelNewUUIDBasedLogs :: [OsPath] topLevelNewUUIDBasedLogs = 	[ exportLog 	, proxyLog@@ -104,7 +102,7 @@ 	]  {- Other top-level logs. -}-otherTopLevelLogs :: [RawFilePath]+otherTopLevelLogs :: [OsPath] otherTopLevelLogs = 	[ numcopiesLog 	, mincopiesLog@@ -112,188 +110,188 @@ 	, groupPreferredContentLog 	] -uuidLog :: RawFilePath-uuidLog = "uuid.log"+uuidLog :: OsPath+uuidLog = literalOsPath "uuid.log" -numcopiesLog :: RawFilePath-numcopiesLog = "numcopies.log"+numcopiesLog :: OsPath+numcopiesLog = literalOsPath "numcopies.log" -mincopiesLog :: RawFilePath-mincopiesLog = "mincopies.log"+mincopiesLog :: OsPath+mincopiesLog = literalOsPath "mincopies.log" -configLog :: RawFilePath-configLog = "config.log"+configLog :: OsPath+configLog = literalOsPath "config.log" -remoteLog :: RawFilePath-remoteLog = "remote.log"+remoteLog :: OsPath+remoteLog = literalOsPath "remote.log" -trustLog :: RawFilePath-trustLog = "trust.log"+trustLog :: OsPath+trustLog = literalOsPath "trust.log" -groupLog :: RawFilePath-groupLog = "group.log"+groupLog :: OsPath+groupLog = literalOsPath "group.log" -preferredContentLog :: RawFilePath-preferredContentLog = "preferred-content.log"+preferredContentLog :: OsPath+preferredContentLog = literalOsPath "preferred-content.log" -requiredContentLog :: RawFilePath-requiredContentLog = "required-content.log"+requiredContentLog :: OsPath+requiredContentLog = literalOsPath "required-content.log" -groupPreferredContentLog :: RawFilePath-groupPreferredContentLog = "group-preferred-content.log"+groupPreferredContentLog :: OsPath+groupPreferredContentLog = literalOsPath "group-preferred-content.log" -scheduleLog :: RawFilePath-scheduleLog = "schedule.log"+scheduleLog :: OsPath+scheduleLog = literalOsPath "schedule.log" -activityLog :: RawFilePath-activityLog = "activity.log"+activityLog :: OsPath+activityLog = literalOsPath "activity.log" -differenceLog :: RawFilePath-differenceLog = "difference.log"+differenceLog :: OsPath+differenceLog = literalOsPath "difference.log" -multicastLog :: RawFilePath-multicastLog = "multicast.log"+multicastLog :: OsPath+multicastLog = literalOsPath "multicast.log" -exportLog :: RawFilePath-exportLog = "export.log"+exportLog :: OsPath+exportLog = literalOsPath "export.log" -proxyLog :: RawFilePath-proxyLog = "proxy.log"+proxyLog :: OsPath+proxyLog = literalOsPath "proxy.log" -clusterLog :: RawFilePath-clusterLog = "cluster.log"+clusterLog :: OsPath+clusterLog = literalOsPath "cluster.log" -maxSizeLog :: RawFilePath-maxSizeLog = "maxsize.log"+maxSizeLog :: OsPath+maxSizeLog = literalOsPath "maxsize.log"  {- This is not a log file, it's where exported treeishes get grafted into  - the git-annex branch. -}-exportTreeGraftPoint :: RawFilePath-exportTreeGraftPoint = "export.tree"+exportTreeGraftPoint :: OsPath+exportTreeGraftPoint = literalOsPath "export.tree"  {- This is not a log file, it's where migration treeishes get grafted into  - the git-annex branch. -}-migrationTreeGraftPoint :: RawFilePath-migrationTreeGraftPoint = "migrate.tree"+migrationTreeGraftPoint :: OsPath+migrationTreeGraftPoint = literalOsPath "migrate.tree"  {- The pathname of the location log file for a given key. -}-locationLogFile :: GitConfig -> Key -> RawFilePath+locationLogFile :: GitConfig -> Key -> OsPath locationLogFile config key =-	branchHashDir config key P.</> keyFile key <> locationLogExt+	branchHashDir config key </> keyFile key <> locationLogExt -locationLogExt :: S.ByteString-locationLogExt = ".log"+locationLogExt :: OsPath+locationLogExt = literalOsPath ".log"  {- The filename of the url log for a given key. -}-urlLogFile :: GitConfig -> Key -> RawFilePath+urlLogFile :: GitConfig -> Key -> OsPath urlLogFile config key = -	branchHashDir config key P.</> keyFile key <> urlLogExt+	branchHashDir config key </> keyFile key <> urlLogExt  {- Old versions stored the urls elsewhere. -}-oldurlLogs :: GitConfig -> Key -> [RawFilePath]+oldurlLogs :: GitConfig -> Key -> [OsPath] oldurlLogs config key =-	[ "remote/web" P.</> hdir P.</> serializeKey' key <> ".log"-	, "remote/web" P.</> hdir P.</> keyFile key <> ".log"+	[ literalOsPath "remote/web" </> hdir </> toOsPath (serializeKey'' key) <> literalOsPath ".log"+	, literalOsPath "remote/web" </> hdir </> keyFile key <> literalOsPath ".log" 	]   where 	hdir = branchHashDir config key -urlLogExt :: S.ByteString-urlLogExt = ".log.web"+urlLogExt :: OsPath+urlLogExt = literalOsPath ".log.web"  {- Does not work on oldurllogs. -}-isUrlLog :: RawFilePath -> Bool-isUrlLog file = urlLogExt `S.isSuffixOf` file+isUrlLog :: OsPath -> Bool+isUrlLog file = urlLogExt `OS.isSuffixOf` file  {- The filename of the remote state log for a given key. -}-remoteStateLogFile :: GitConfig -> Key -> RawFilePath+remoteStateLogFile :: GitConfig -> Key -> OsPath remoteStateLogFile config key = -	(branchHashDir config key P.</> keyFile key)+	(branchHashDir config key </> keyFile key) 		<> remoteStateLogExt -remoteStateLogExt :: S.ByteString-remoteStateLogExt = ".log.rmt"+remoteStateLogExt :: OsPath+remoteStateLogExt = literalOsPath ".log.rmt" -isRemoteStateLog :: RawFilePath -> Bool-isRemoteStateLog path = remoteStateLogExt `S.isSuffixOf` path+isRemoteStateLog :: OsPath -> Bool+isRemoteStateLog path = remoteStateLogExt `OS.isSuffixOf` path  {- The filename of the chunk log for a given key. -}-chunkLogFile :: GitConfig -> Key -> RawFilePath+chunkLogFile :: GitConfig -> Key -> OsPath chunkLogFile config key = -	(branchHashDir config key P.</> keyFile key)+	(branchHashDir config key </> keyFile key) 		<> chunkLogExt -chunkLogExt :: S.ByteString-chunkLogExt = ".log.cnk"+chunkLogExt :: OsPath+chunkLogExt = literalOsPath ".log.cnk"  {- The filename of the equivalent keys log for a given key. -}-equivilantKeysLogFile :: GitConfig -> Key -> RawFilePath+equivilantKeysLogFile :: GitConfig -> Key -> OsPath equivilantKeysLogFile config key = -	(branchHashDir config key P.</> keyFile key)+	(branchHashDir config key </> keyFile key) 		<> equivilantKeyLogExt -equivilantKeyLogExt :: S.ByteString-equivilantKeyLogExt = ".log.ek"+equivilantKeyLogExt :: OsPath+equivilantKeyLogExt = literalOsPath ".log.ek" -isEquivilantKeyLog :: RawFilePath -> Bool-isEquivilantKeyLog path = equivilantKeyLogExt `S.isSuffixOf` path+isEquivilantKeyLog :: OsPath -> Bool+isEquivilantKeyLog path = equivilantKeyLogExt `OS.isSuffixOf` path  {- The filename of the metadata log for a given key. -}-metaDataLogFile :: GitConfig -> Key -> RawFilePath+metaDataLogFile :: GitConfig -> Key -> OsPath metaDataLogFile config key =-	(branchHashDir config key P.</> keyFile key)+	(branchHashDir config key </> keyFile key) 		<> metaDataLogExt -metaDataLogExt :: S.ByteString-metaDataLogExt = ".log.met"+metaDataLogExt :: OsPath+metaDataLogExt = literalOsPath ".log.met" -isMetaDataLog :: RawFilePath -> Bool-isMetaDataLog path = metaDataLogExt `S.isSuffixOf` path+isMetaDataLog :: OsPath -> Bool+isMetaDataLog path = metaDataLogExt `OS.isSuffixOf` path  {- The filename of the remote metadata log for a given key. -}-remoteMetaDataLogFile :: GitConfig -> Key -> RawFilePath+remoteMetaDataLogFile :: GitConfig -> Key -> OsPath remoteMetaDataLogFile config key = -	(branchHashDir config key P.</> keyFile key)+	(branchHashDir config key </> keyFile key) 		<> remoteMetaDataLogExt -remoteMetaDataLogExt :: S.ByteString-remoteMetaDataLogExt = ".log.rmet"+remoteMetaDataLogExt :: OsPath+remoteMetaDataLogExt = literalOsPath ".log.rmet" -isRemoteMetaDataLog :: RawFilePath -> Bool-isRemoteMetaDataLog path = remoteMetaDataLogExt `S.isSuffixOf` path+isRemoteMetaDataLog :: OsPath -> Bool+isRemoteMetaDataLog path = remoteMetaDataLogExt `OS.isSuffixOf` path  {- The filename of the remote content identifier log for a given key. -}-remoteContentIdentifierLogFile :: GitConfig -> Key -> RawFilePath+remoteContentIdentifierLogFile :: GitConfig -> Key -> OsPath remoteContentIdentifierLogFile config key =-	(branchHashDir config key P.</> keyFile key)+	(branchHashDir config key </> keyFile key) 		<> remoteContentIdentifierExt -remoteContentIdentifierExt :: S.ByteString-remoteContentIdentifierExt = ".log.cid"+remoteContentIdentifierExt :: OsPath+remoteContentIdentifierExt = literalOsPath ".log.cid" -isRemoteContentIdentifierLog :: RawFilePath -> Bool-isRemoteContentIdentifierLog path = remoteContentIdentifierExt `S.isSuffixOf` path+isRemoteContentIdentifierLog :: OsPath -> Bool+isRemoteContentIdentifierLog path = remoteContentIdentifierExt `OS.isSuffixOf` path  {- From an extension and a log filename, get the key that it's a log for. -}-extLogFileKey :: S.ByteString -> RawFilePath -> Maybe Key+extLogFileKey :: OsPath -> OsPath -> Maybe Key extLogFileKey expectedext path 	| ext == expectedext = fileKey base 	| otherwise = Nothing   where-	file = P.takeFileName path-	(base, ext) = S.splitAt (S.length file - extlen) file-	extlen = S.length expectedext+	file = takeFileName path+	(base, ext) = OS.splitAt (OS.length file - extlen) file+	extlen = OS.length expectedext  {- Converts a url log file into a key.  - (Does not work on oldurlLogs.) -}-urlLogFileKey :: RawFilePath -> Maybe Key+urlLogFileKey :: OsPath -> Maybe Key urlLogFileKey = extLogFileKey urlLogExt  {- Converts a pathname into a key if it's a location log. -}-locationLogFileKey :: GitConfig -> RawFilePath -> Maybe Key+locationLogFileKey :: GitConfig -> OsPath -> Maybe Key locationLogFileKey config path-	| length (splitDirectories (fromRawFilePath path)) /= locationLogFileDepth config = Nothing-	| otherwise = extLogFileKey ".log" path+	| length (splitDirectories path) /= locationLogFileDepth config = Nothing+	| otherwise = extLogFileKey (literalOsPath ".log") path  {- Depth of location log files within the git-annex branch.  -
Logs/AdjustedBranchUpdate.hs view
@@ -80,5 +80,5 @@ 			"1" -> Just True 			"0" -> Just False 			_ -> Nothing-		t <- parsePOSIXTime ts+		t <- parsePOSIXTime (encodeBS ts) 		return (b, t)
Logs/EquivilantKeys.hs view
@@ -1,6 +1,6 @@ {- Logs listing keys that are equivalent to a key.  -- - Copyright 2024 Joey Hess <id@joeyh.name>+ - Copyright 2024-2025 Joey Hess <id@joeyh.name>  -  - Licensed under the GNU AGPL version 3 or higher.  -}@@ -10,6 +10,9 @@ module Logs.EquivilantKeys ( 	getEquivilantKeys, 	setEquivilantKey,+	updateEquivilantKeys,+	addEquivilantKey,+	generateEquivilantKey, ) where  import Annex.Common@@ -17,6 +20,11 @@ import Logs import Logs.Presence import qualified Annex.Branch+import qualified Backend.Hash+import Types.KeySource+import Types.Backend+import Types.Remote (Verification(..))+import Utility.Metered  getEquivilantKeys :: Key -> Annex [Key] getEquivilantKeys key = do@@ -29,3 +37,34 @@ 	config <- Annex.getGitConfig 	addLog (Annex.Branch.RegardingUUID []) (equivilantKeysLogFile config key) 		InfoPresent (LogInfo (serializeKey' equivkey))++-- This returns Verified when when an equivilant key has been added to the+-- log (or was already in the log). This is to avoid hashing the object+-- again later.+updateEquivilantKeys :: Backend -> OsPath -> Key -> [Key] -> Annex (Maybe Verification)+updateEquivilantKeys b obj key eks = generateEquivilantKey b obj >>= \case+	Nothing -> return Nothing+	Just ek -> do+		unless (ek `elem` eks) $+			setEquivilantKey key ek+		return (Just Verified)++addEquivilantKey :: Backend -> Key -> OsPath -> Annex (Maybe Verification)+addEquivilantKey b key obj = +	updateEquivilantKeys b obj key+		=<< getEquivilantKeys key++-- The Backend must use a cryptographically secure hash.+generateEquivilantKey :: Backend -> OsPath -> Annex (Maybe Key)+generateEquivilantKey b obj =+	case genKey b of+		Just genkey -> do+			showSideAction (UnquotedString Backend.Hash.descChecksum)+			Just <$> genkey source nullMeterUpdate+		Nothing -> return Nothing+  where+	source = KeySource+		{ keyFilename = mempty -- avoid adding any extension+		, contentLocation = obj+		, inodeCache = Nothing+		}
Logs/Export.hs view
@@ -34,6 +34,7 @@ import qualified Git.LsTree import qualified Git.Tree import Annex.UUID+import qualified Utility.FileIO as F  import qualified Data.Map as M import qualified Data.ByteString as B@@ -129,7 +130,7 @@ getExportExcluded u = do 	logf <- fromRepo $ gitAnnexExportExcludeLog u 	liftIO $ catchDefaultIO [] $ exportExcludedParser-		<$> L.readFile (fromRawFilePath logf)+		<$> F.readFile logf   where  exportExcludedParser :: L.ByteString -> [Git.Tree.TreeItem]
Logs/File.hs view
@@ -26,46 +26,43 @@ import Annex.LockFile import Annex.ReplaceFile import Utility.Tmp+import qualified Utility.FileIO as F -import qualified Data.ByteString as S-import qualified Data.ByteString.Char8 as S8 import qualified Data.ByteString.Lazy as L import qualified Data.ByteString.Lazy.Char8 as L8  -- | Writes content to a file, replacing the file atomically, and -- making the new file have whatever permissions the git repository is -- configured to use. Creates the parent directory when necessary.-writeLogFile :: RawFilePath -> String -> Annex ()-writeLogFile f c = createDirWhenNeeded f $ viaTmp writelog (fromRawFilePath f) c+writeLogFile :: OsPath -> String -> Annex ()+writeLogFile f c = createDirWhenNeeded f $ viaTmp writelog f c   where 	writelog tmp c' = do-		liftIO $ writeFile tmp c'-		setAnnexFilePerm (toRawFilePath tmp)+		liftIO $ writeFile (fromOsPath tmp) c'+		setAnnexFilePerm tmp  -- | Runs the action with a handle connected to a temp file. -- The temp file replaces the log file once the action succeeds.-withLogHandle :: RawFilePath -> (Handle -> Annex a) -> Annex a+withLogHandle :: OsPath -> (Handle -> Annex a) -> Annex a withLogHandle f a = do 	createAnnexDirectory (parentDir f)-	replaceGitAnnexDirFile (fromRawFilePath f) $ \tmp ->+	replaceGitAnnexDirFile f $ \tmp -> 		bracket (setup tmp) cleanup a   where 	setup tmp = do 		setAnnexFilePerm tmp-		liftIO $ openFile (fromRawFilePath tmp) WriteMode+		liftIO $ F.openFile tmp WriteMode 	cleanup h = liftIO $ hClose h  -- | Appends a line to a log file, first locking it to prevent -- concurrent writers.-appendLogFile :: RawFilePath -> RawFilePath -> L.ByteString -> Annex ()+appendLogFile :: OsPath -> OsPath -> L.ByteString -> Annex () appendLogFile f lck c =  	createDirWhenNeeded f $ 		withExclusiveLock lck $ do-			liftIO $ withFile f' AppendMode $+			liftIO $ F.withFile f AppendMode $ 				\h -> L8.hPutStrLn h c-			setAnnexFilePerm (toRawFilePath f')-  where-	f' = fromRawFilePath f+			setAnnexFilePerm f  -- | Modifies a log file. --@@ -75,43 +72,41 @@ -- -- The file is locked to prevent concurrent writers, and it is written -- atomically.-modifyLogFile :: RawFilePath -> RawFilePath -> ([L.ByteString] -> [L.ByteString]) -> Annex ()+modifyLogFile :: OsPath -> OsPath -> ([L.ByteString] -> [L.ByteString]) -> Annex () modifyLogFile f lck modf = withExclusiveLock lck $ do 	ls <- liftIO $ fromMaybe []-		<$> tryWhenExists (fileLines <$> L.readFile f')+		<$> tryWhenExists (fileLines <$> F.readFile f) 	let ls' = modf ls 	when (ls' /= ls) $ 		createDirWhenNeeded f $-			viaTmp writelog f' (L8.unlines ls')+			viaTmp writelog f (L8.unlines ls')   where-	f' = fromRawFilePath f 	writelog lf b = do-		liftIO $ L.writeFile lf b-		setAnnexFilePerm (toRawFilePath lf)+		liftIO $ F.writeFile lf b+		setAnnexFilePerm lf  -- | Checks the content of a log file to see if any line matches.-checkLogFile :: RawFilePath -> RawFilePath -> (L.ByteString -> Bool) -> Annex Bool+checkLogFile :: OsPath -> OsPath -> (L.ByteString -> Bool) -> Annex Bool checkLogFile f lck matchf = withSharedLock lck $ bracket setup cleanup go   where-	setup = liftIO $ tryWhenExists $ openFile f' ReadMode+	setup = liftIO $ tryWhenExists $ F.openFile f ReadMode 	cleanup Nothing = noop 	cleanup (Just h) = liftIO $ hClose h 	go Nothing = return False 	go (Just h) = do 		!r <- liftIO (any matchf . fileLines <$> L.hGetContents h) 		return r-	f' = fromRawFilePath f  -- | Folds a function over lines of a log file to calculate a value.-calcLogFile :: RawFilePath -> RawFilePath -> t -> (L.ByteString -> t -> t) -> Annex t+calcLogFile :: OsPath -> OsPath -> t -> (L.ByteString -> t -> t) -> Annex t calcLogFile f lck start update = 	withSharedLock lck $ calcLogFileUnsafe f start update  -- | Unsafe version that does not do locking.-calcLogFileUnsafe :: RawFilePath -> t -> (L.ByteString -> t -> t) -> Annex t+calcLogFileUnsafe :: OsPath -> t -> (L.ByteString -> t -> t) -> Annex t calcLogFileUnsafe f start update = bracket setup cleanup go   where-	setup = liftIO $ tryWhenExists $ openFile f' ReadMode+	setup = liftIO $ tryWhenExists $ F.openFile f ReadMode 	cleanup Nothing = noop 	cleanup (Just h) = liftIO $ hClose h 	go Nothing = return start@@ -120,7 +115,6 @@ 	go' v (l:ls) = do 		let !v' = update l v 		go' v' ls-	f' = fromRawFilePath f  -- | Streams lines from a log file, passing each line to the processor, -- and then empties the file at the end.@@ -134,19 +128,19 @@ --  -- Locking is used to prevent writes to to the log file while this -- is running.-streamLogFile :: FilePath -> RawFilePath -> Annex () -> (String -> Annex ()) -> Annex ()+streamLogFile :: OsPath -> OsPath -> Annex () -> (String -> Annex ()) -> Annex () streamLogFile f lck finalizer processor =  	withExclusiveLock lck $ do 		streamLogFileUnsafe f finalizer processor-		liftIO $ writeFile f ""-		setAnnexFilePerm (toRawFilePath f)+		liftIO $ F.writeFile' f mempty+		setAnnexFilePerm f  -- Unsafe version that does not do locking, and does not empty the file -- at the end.-streamLogFileUnsafe :: FilePath -> Annex () -> (String -> Annex ()) -> Annex ()+streamLogFileUnsafe :: OsPath -> Annex () -> (String -> Annex ()) -> Annex () streamLogFileUnsafe f finalizer processor = bracketOnError setup cleanup go   where-	setup = liftIO $ tryWhenExists $ openFile f ReadMode +	setup = liftIO $ tryWhenExists $ F.openFile f ReadMode  	cleanup Nothing = noop 	cleanup (Just h) = liftIO $ hClose h 	go Nothing = finalizer@@ -155,38 +149,9 @@ 		liftIO $ hClose h 		finalizer -createDirWhenNeeded :: RawFilePath -> Annex () -> Annex ()+createDirWhenNeeded :: OsPath -> Annex () -> Annex () createDirWhenNeeded f a = a `catchNonAsync` \_e -> do 	-- Most of the time, the directory will exist, so this is only 	-- done if writing the file fails. 	createAnnexDirectory (parentDir f) 	a---- On windows, readFile does NewlineMode translation,--- stripping CR before LF. When converting to ByteString,--- use this to emulate that.-fileLines :: L.ByteString -> [L.ByteString]-#ifdef mingw32_HOST_OS-fileLines = map stripCR . L8.lines-  where-	stripCR b = case L8.unsnoc b of-		Nothing -> b-		Just (b', e)-			| e == '\r' -> b'-			| otherwise -> b-#else-fileLines = L8.lines-#endif--fileLines' :: S.ByteString -> [S.ByteString]-#ifdef mingw32_HOST_OS-fileLines' = map stripCR . S8.lines-  where-	stripCR b = case S8.unsnoc b of-		Nothing -> b-		Just (b', e)-			| e == '\r' -> b'-			| otherwise -> b-#else-fileLines' = S8.lines-#endif
Logs/FsckResults.hs view
@@ -15,7 +15,6 @@ import Git.Fsck import Git.Types import Logs.File-import qualified Utility.RawFilePath as R  import qualified Data.Set as S @@ -25,7 +24,7 @@ 	case serializeFsckResults fsckresults of 		Just s -> store s logfile 		Nothing -> liftIO $-			removeWhenExistsWith R.removeLink logfile+			removeWhenExistsWith removeFile logfile   where 	store s logfile = writeLogFile logfile s @@ -46,7 +45,7 @@ readFsckResults u = do 	logfile <- fromRepo $ gitAnnexFsckResultsLog u 	liftIO $ catchDefaultIO (FsckFoundMissing S.empty False) $-		deserializeFsckResults <$> readFile (fromRawFilePath logfile)+		deserializeFsckResults <$> readFile (fromOsPath logfile)  deserializeFsckResults :: String -> FsckResults deserializeFsckResults = deserialize . lines@@ -58,6 +57,6 @@ 		in if S.null s then FsckFailed else FsckFoundMissing s t  clearFsckResults :: UUID -> Annex ()-clearFsckResults = liftIO . removeWhenExistsWith R.removeLink+clearFsckResults = liftIO . removeWhenExistsWith removeFile 	<=< fromRepo . gitAnnexFsckResultsLog
Logs/Location.hs view
@@ -124,7 +124,7 @@ 	map (toUUID . fromLogInfo . info) 		(filterPresent (parseLog l)) -getLoggedLocations :: (RawFilePath -> Annex [LogInfo]) -> Key -> Annex [UUID]+getLoggedLocations :: (OsPath -> Annex [LogInfo]) -> Key -> Annex [UUID] getLoggedLocations getter key = do 	config <- Annex.getGitConfig 	locs <- map (toUUID . fromLogInfo) <$> getter (locationLogFile config key)@@ -301,8 +301,8 @@ 	changedlocs _ _ _ Nothing = pure (S.empty, S.empty)  overLocationLogsHelper-	:: ((RawFilePath -> Maybe Key) -> (Annex (FileContents Key b) -> Annex v) -> Annex a)-	-> ((Maybe L.ByteString -> [UUID]) -> Key -> RawFilePath -> Maybe (L.ByteString, Maybe b) -> Annex u)+	:: ((OsPath -> Maybe Key) -> (Annex (FileContents Key b) -> Annex v) -> Annex a)+	-> ((Maybe L.ByteString -> [UUID]) -> Key -> OsPath -> Maybe (L.ByteString, Maybe b) -> Annex u) 	-> Bool 	-> v 	-> (Annex (FileContents Key b) -> Annex v -> Annex v)
Logs/MetaData.hs view
@@ -59,7 +59,7 @@ getCurrentMetaData :: Key -> Annex MetaData getCurrentMetaData = getCurrentMetaData' metaDataLogFile -getCurrentMetaData' :: (GitConfig -> Key -> RawFilePath) -> Key -> Annex MetaData+getCurrentMetaData' :: (GitConfig -> Key -> OsPath) -> Key -> Annex MetaData getCurrentMetaData' getlogfile k = do 	config <- Annex.getGitConfig 	parseCurrentMetaData <$> Annex.Branch.get (getlogfile config k)@@ -101,7 +101,7 @@ addMetaData :: Key -> MetaData -> Annex () addMetaData = addMetaData' (Annex.Branch.RegardingUUID []) metaDataLogFile -addMetaData' :: Annex.Branch.RegardingUUID -> (GitConfig -> Key -> RawFilePath) -> Key -> MetaData -> Annex ()+addMetaData' :: Annex.Branch.RegardingUUID -> (GitConfig -> Key -> OsPath) -> Key -> MetaData -> Annex () addMetaData' ru getlogfile k metadata =  	addMetaDataClocked' ru getlogfile k metadata =<< currentVectorClock @@ -112,7 +112,7 @@ addMetaDataClocked :: Key -> MetaData -> CandidateVectorClock -> Annex () addMetaDataClocked = addMetaDataClocked' (Annex.Branch.RegardingUUID []) metaDataLogFile -addMetaDataClocked' :: Annex.Branch.RegardingUUID -> (GitConfig -> Key -> RawFilePath) -> Key -> MetaData -> CandidateVectorClock -> Annex ()+addMetaDataClocked' :: Annex.Branch.RegardingUUID -> (GitConfig -> Key -> OsPath) -> Key -> MetaData -> CandidateVectorClock -> Annex () addMetaDataClocked' ru getlogfile k d@(MetaData m) c 	| d == emptyMetaData = noop 	| otherwise = do@@ -160,5 +160,5 @@ 					(const $ buildLog l) 				return True -readLog :: RawFilePath -> Annex (Log MetaData)+readLog :: OsPath -> Annex (Log MetaData) readLog = parseLog <$$> Annex.Branch.get
Logs/Migrate.hs view
@@ -56,11 +56,10 @@ import Logs.File import Logs import Annex.CatFile+import qualified Utility.OsString as OS -import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as L import Control.Concurrent.STM-import System.FilePath.ByteString as P  -- | What to use to record a migration. This should be the same Sha that is -- used to as the content of the annexed file in the HEAD branch.@@ -79,7 +78,7 @@ -- | Commits a migration to the git-annex branch. commitMigration :: Annex () commitMigration = do-	logf <- fromRawFilePath <$> fromRepo gitAnnexMigrateLog+	logf <- fromRepo gitAnnexMigrateLog 	lckf <- fromRepo gitAnnexMigrateLock 	nv <- liftIO $ newTVarIO (0 :: Integer) 	g <- Annex.gitRepo@@ -95,7 +94,7 @@ 				n <- readTVar nv 				let !n' = succ n 				writeTVar nv n'-				return (asTopFilePath (encodeBS (show n')))+				return (asTopFilePath (toOsPath (show n'))) 			let rec h r = liftIO $ sendMkTree h 				(fromTreeItemType TreeFile) 				BlobObject@@ -110,8 +109,8 @@ 		n <- liftIO $ atomically $ readTVar nv 		when (n > 0) $ do 			treesha <- liftIO $ flip recordTree g $ Tree-				[ RecordedSubTree (asTopFilePath "old") oldt []-				, RecordedSubTree (asTopFilePath "new") newt []+				[ RecordedSubTree (asTopFilePath (literalOsPath "old")) oldt []+				, RecordedSubTree (asTopFilePath (literalOsPath "new")) newt [] 				] 			commitsha <- Annex.Branch.rememberTreeish treesha 				(asTopFilePath migrationTreeGraftPoint)@@ -129,7 +128,7 @@ 	(stoppoint, toskip) <- getPerformedMigrations 	(l, cleanup) <- inRepo $ getGitLog branchsha 		(if incremental then stoppoint else Nothing)-		[fromRawFilePath migrationTreeGraftPoint]+		[fromOsPath migrationTreeGraftPoint] 		-- Need to follow because migrate.tree is grafted in  		-- and then deleted, and normally git log stops when a file 		-- gets deleted.@@ -142,7 +141,7 @@ 	go toskip c 		| newref c `elem` nullShas = return () 		| changed c `elem` toskip = return ()-		| not ("/new/" `B.isInfixOf` newfile) = return ()+		| not (literalOsPath "/new/" `OS.isInfixOf` newfile) = return () 		| otherwise =  			catKey (newref c) >>= \case 				Nothing -> return ()@@ -150,10 +149,10 @@ 					Nothing -> return () 					Just oldkey -> a oldkey newkey 	  where-		newfile = toRawFilePath (changedfile c)+		newfile = changedfile c 		oldfile = migrationTreeGraftPoint -			P.</> "old" -			P.</> P.takeBaseName (fromInternalGitPath newfile)+			</> literalOsPath "old" +			</> takeBaseName (fromInternalGitPath newfile) 		oldfileref = branchFileRef (changed c) oldfile  getPerformedMigrations :: Annex (Maybe Sha, [Sha])
Logs/PreferredContent/Raw.hs view
@@ -32,7 +32,7 @@ 	setLog requiredContentLog u expr 	Annex.changeState $ \st -> st { Annex.requiredcontentmap = Nothing } -setLog :: RawFilePath -> UUID -> PreferredContentExpression -> Annex ()+setLog :: OsPath -> UUID -> PreferredContentExpression -> Annex () setLog logfile uuid@(UUID _) val = do 	c <- currentVectorClock 	Annex.Branch.change (Annex.Branch.RegardingUUID [uuid]) logfile $
Logs/Presence.hs view
@@ -32,11 +32,11 @@ import qualified Data.ByteString.Lazy as L  {- Adds to the log, removing any LogLines that are obsoleted. -}-addLog :: Annex.Branch.RegardingUUID -> RawFilePath -> LogStatus -> LogInfo -> Annex ()+addLog :: Annex.Branch.RegardingUUID -> OsPath -> LogStatus -> LogInfo -> Annex () addLog ru file logstatus loginfo =  	addLog' ru file logstatus loginfo =<< currentVectorClock -addLog' :: Annex.Branch.RegardingUUID -> RawFilePath -> LogStatus -> LogInfo -> CandidateVectorClock -> Annex ()+addLog' :: Annex.Branch.RegardingUUID -> OsPath -> LogStatus -> LogInfo -> CandidateVectorClock -> Annex () addLog' ru file logstatus loginfo c =  	Annex.Branch.changeOrAppend ru file $ \b -> 		let old = parseLog b@@ -53,7 +53,7 @@  - When the log was changed, the onchange action is run (with the journal  - still locked to prevent any concurrent changes) and True is returned.  -}-maybeAddLog :: Annex.Branch.RegardingUUID -> RawFilePath -> LogStatus -> LogInfo -> Annex () -> Annex Bool+maybeAddLog :: Annex.Branch.RegardingUUID -> OsPath -> LogStatus -> LogInfo -> Annex () -> Annex Bool maybeAddLog ru file logstatus loginfo onchange = do 	c <- currentVectorClock 	let f = \b ->@@ -72,15 +72,15 @@  {- Reads a log file.  - Note that the LogLines returned may be in any order. -}-readLog :: RawFilePath -> Annex [LogLine]+readLog :: OsPath -> Annex [LogLine] readLog = parseLog <$$> Annex.Branch.get  {- Reads a log and returns only the info that is still present. -}-presentLogInfo :: RawFilePath -> Annex [LogInfo]+presentLogInfo :: OsPath -> Annex [LogInfo] presentLogInfo file = map info . filterPresent <$> readLog file  {- Reads a log and returns only the info that is no longer present. -}-notPresentLogInfo :: RawFilePath -> Annex [LogInfo]+notPresentLogInfo :: OsPath -> Annex [LogInfo] notPresentLogInfo file = map info . filterNotPresent <$> readLog file  {- Reads a historical version of a log and returns the info that was in@@ -88,7 +88,7 @@  -  - The date is formatted as shown in gitrevisions man page.  -}-historicalLogInfo :: RefDate -> RawFilePath -> Annex [LogInfo]+historicalLogInfo :: RefDate -> OsPath -> Annex [LogInfo] historicalLogInfo refdate file = parseLogInfo 	<$> Annex.Branch.getHistorical refdate file
Logs/Restage.hs view
@@ -14,10 +14,10 @@ import Logs.File import Utility.InodeCache import Annex.LockFile+import qualified Utility.FileIO as F  import qualified Data.ByteString as S import qualified Data.ByteString.Lazy as L-import qualified Utility.RawFilePath as R  -- | Log a file whose pointer needs to be restaged in git. -- The content of the file may not be a pointer, if it is populated with@@ -48,26 +48,25 @@ streamRestageLog finalizer processor = do 	logf <- fromRepo gitAnnexRestageLog 	oldf <- fromRepo gitAnnexRestageLogOld-	let oldf' = fromRawFilePath oldf 	lckf <- fromRepo gitAnnexRestageLock 	 	withExclusiveLock lckf $ liftIO $-		whenM (R.doesPathExist logf) $-			ifM (R.doesPathExist oldf)+		whenM (doesPathExist logf) $+			ifM (doesPathExist oldf) 				( do-					h <- openFile oldf' AppendMode-					hPutStr h =<< readFile (fromRawFilePath logf)+					h <- F.openFile oldf AppendMode+					hPutStr h =<< readFile (fromOsPath logf) 					hClose h-					liftIO $ removeWhenExistsWith R.removeLink logf+					liftIO $ removeWhenExistsWith removeFile logf 				, moveFile logf oldf 				) -	streamLogFileUnsafe oldf' finalizer $ \l -> +	streamLogFileUnsafe oldf finalizer $ \l ->  		case parseRestageLog l of 			Just (f, ic) -> processor f ic 			Nothing -> noop 	-	liftIO $ removeWhenExistsWith R.removeLink oldf+	liftIO $ removeWhenExistsWith removeFile oldf  -- | Calculate over both the current restage log, and also over the old -- one if it had started to be processed but did not get finished due@@ -86,11 +85,12 @@ 		Nothing -> v  formatRestageLog :: TopFilePath -> InodeCache -> S.ByteString-formatRestageLog f ic = encodeBS (showInodeCache ic) <> ":" <> getTopFilePath f+formatRestageLog f ic =+	encodeBS (showInodeCache ic) <> ":" <> fromOsPath (getTopFilePath f)  parseRestageLog :: String -> Maybe (TopFilePath, InodeCache) parseRestageLog l =  	let (ics, f) = separate (== ':') l 	in do 		ic <- readInodeCache ics-		return (asTopFilePath (toRawFilePath f), ic)+		return (asTopFilePath (toOsPath f), ic)
Logs/Schedule.hs view
@@ -63,7 +63,7 @@  getLastRunTimes :: Annex (M.Map ScheduledActivity LocalTime) getLastRunTimes = do-	f <- fromRawFilePath <$> fromRepo gitAnnexScheduleState+	f <- fromOsPath <$> fromRepo gitAnnexScheduleState 	liftIO $ fromMaybe M.empty 		<$> catchDefaultIO Nothing (readish <$> readFile f)
Logs/SingleValue.hs view
@@ -27,13 +27,13 @@  import qualified Data.Set as S -readLog :: (Ord v, SingleValueSerializable v) => RawFilePath -> Annex (Log v)+readLog :: (Ord v, SingleValueSerializable v) => OsPath -> Annex (Log v) readLog = parseLog <$$> Annex.Branch.get -getLog :: (Ord v, SingleValueSerializable v) => RawFilePath -> Annex (Maybe v)+getLog :: (Ord v, SingleValueSerializable v) => OsPath -> Annex (Maybe v) getLog = newestValue <$$> readLog -setLog :: (Ord v, SingleValueSerializable v) => Annex.Branch.RegardingUUID -> RawFilePath -> v -> Annex ()+setLog :: (Ord v, SingleValueSerializable v) => Annex.Branch.RegardingUUID -> OsPath -> v -> Annex () setLog ru f v = do 	c <- currentVectorClock 	Annex.Branch.change ru f $ \old ->
Logs/Smudge.hs view
@@ -21,7 +21,7 @@ 	logf <- fromRepo gitAnnexSmudgeLog 	lckf <- fromRepo gitAnnexSmudgeLock 	appendLogFile logf lckf $ L.fromStrict $-		serializeKey' k <> " " <> getTopFilePath f+		serializeKey' k <> " " <> fromOsPath (getTopFilePath f)  -- | Streams all smudged files, and then empties the log at the end. --@@ -34,7 +34,7 @@ streamSmudged a = do 	logf <- fromRepo gitAnnexSmudgeLog 	lckf <- fromRepo gitAnnexSmudgeLock-	streamLogFile (fromRawFilePath logf) lckf noop $ \l -> +	streamLogFile logf lckf noop $ \l ->  		case parse l of 			Nothing -> noop 			Just (k, f) -> a k f@@ -43,4 +43,4 @@ 		let (ks, f) = separate (== ' ') l 		in do 			k <- deserializeKey ks-			return (k, asTopFilePath (toRawFilePath f))+			return (k, asTopFilePath (toOsPath f))
Logs/Transfer.hs view
@@ -21,7 +21,8 @@ import Annex.LockPool import Utility.TimeStamp import Logs.File-import qualified Utility.RawFilePath as R+import qualified Utility.FileIO as F+import qualified Utility.OsString as OS #ifndef mingw32_HOST_OS import Annex.Perms #endif@@ -29,8 +30,6 @@ import Data.Time.Clock import Data.Time.Clock.POSIX import Control.Concurrent.STM-import qualified Data.ByteString.Char8 as B8-import qualified System.FilePath.ByteString as P  describeTransfer :: Git.Quote.QuotePath -> Transfer -> TransferInfo -> String describeTransfer qp t info = unwords@@ -60,20 +59,21 @@  - appropriate permissions, which should be run after locking the transfer  - lock file, but before using the callback, and a TVar that can be used to  - read the number of bytes processed so far. -}-mkProgressUpdater :: Transfer -> TransferInfo -> RawFilePath -> Annex (MeterUpdate, Annex (), TVar (Maybe BytesProcessed))+mkProgressUpdater :: Transfer -> TransferInfo -> OsPath -> Annex (MeterUpdate, Annex (), TVar (Maybe BytesProcessed)) mkProgressUpdater t info tfile = do-	let createtfile = void $ tryNonAsync $ writeTransferInfoFile info tfile+	let createtfile = void $ tryNonAsync $+		writeTransferInfoFile info tfile 	tvar <- liftIO $ newTVarIO Nothing 	loggedtvar <- liftIO $ newTVarIO 0-	return (liftIO . updater (fromRawFilePath tfile) tvar loggedtvar, createtfile, tvar)+	return (liftIO . updater tvar loggedtvar, createtfile, tvar)   where-	updater tfile' tvar loggedtvar new = do+	updater tvar loggedtvar new = do 		old <- atomically $ swapTVar tvar (Just new) 		let oldbytes = maybe 0 fromBytesProcessed old 		let newbytes = fromBytesProcessed new 		when (newbytes - oldbytes >= mindelta) $ do 			let info' = info { bytesComplete = Just newbytes }-			_ <- tryIO $ updateTransferInfoFile info' tfile'+			_ <- tryIO $ updateTransferInfoFile info' tfile 			atomically $ writeTVar loggedtvar newbytes  	{- The minimum change in bytesComplete that is worth@@ -107,9 +107,9 @@ checkTransfer t = debugLocks $ do 	(tfile, lck, moldlck) <- fromRepo $ transferFileAndLockFile t 	let deletestale = do-		void $ tryIO $ R.removeLink tfile-		void $ tryIO $ R.removeLink lck-		maybe noop (void . tryIO . R.removeLink) moldlck+		void $ tryIO $ removeFile tfile+		void $ tryIO $ removeFile lck+		maybe noop (void . tryIO . removeFile) moldlck #ifndef mingw32_HOST_OS 	v <- getLockStatus lck 	v' <- case (moldlck, v) of@@ -118,7 +118,7 @@ 		(Just oldlck, _) -> getLockStatus oldlck 	case v' of 		StatusLockedBy pid -> liftIO $ catchDefaultIO Nothing $-			readTransferInfoFile (Just pid) (fromRawFilePath tfile)+			readTransferInfoFile (Just pid) tfile 		_ -> do 			mode <- annexFileMode 			-- Ignore failure due to permissions, races, etc.@@ -139,7 +139,7 @@ 	v <- liftIO $ lockShared lck 	liftIO $ case v of 		Nothing -> catchDefaultIO Nothing $-			readTransferInfoFile Nothing (fromRawFilePath tfile)+			readTransferInfoFile Nothing tfile 		Just lockhandle -> do 			dropLock lockhandle 			deletestale@@ -157,7 +157,7 @@ 	infos <- mapM checkTransfer transfers 	return $ mapMaybe running $ zip transfers infos   where-	findfiles = liftIO . mapM (emptyWhenDoesNotExist . dirContentsRecursive . fromRawFilePath)+	findfiles = liftIO . mapM (emptyWhenDoesNotExist . dirContentsRecursive) 		=<< mapM (fromRepo . transferDir) dirs 	running (t, Just i) = Just (t, i) 	running (_, Nothing) = Nothing@@ -184,7 +184,7 @@ 		return $ case (mt, mi) of 			(Just t, Just i) -> Just (t, i) 			_ -> Nothing-	findfiles = liftIO . mapM (emptyWhenDoesNotExist . dirContentsRecursive . fromRawFilePath)+	findfiles = liftIO . mapM (emptyWhenDoesNotExist . dirContentsRecursive) 		=<< mapM (fromRepo . failedTransferDir u) [Download, Upload]  clearFailedTransfers :: UUID -> Annex [(Transfer, TransferInfo)]@@ -196,7 +196,7 @@ removeFailedTransfer :: Transfer -> Annex () removeFailedTransfer t = do 	f <- fromRepo $ failedTransferFile t-	liftIO $ void $ tryIO $ R.removeLink f+	liftIO $ void $ tryIO $ removeFile f  recordFailedTransfer :: Transfer -> TransferInfo -> Annex () recordFailedTransfer t info = do@@ -223,46 +223,47 @@  - At some point in the future, when old git-annex processes are no longer  - a concern, this complication can be removed.  -}-transferFileAndLockFile :: Transfer -> Git.Repo -> (RawFilePath, RawFilePath, Maybe RawFilePath)+transferFileAndLockFile :: Transfer -> Git.Repo -> (OsPath, OsPath, Maybe OsPath) transferFileAndLockFile (Transfer direction u kd) r = 	case direction of 		Upload -> (transferfile, uuidlockfile, Nothing) 		Download -> (transferfile, nouuidlockfile, Just uuidlockfile)   where 	td = transferDir direction r-	fu = B8.filter (/= '/') (fromUUID u)+	fu = OS.filter (/= unsafeFromChar '/') (fromUUID u) 	kf = keyFile (mkKey (const kd))-	lckkf = "lck." <> kf-	transferfile = td P.</> fu P.</> kf-	uuidlockfile = td P.</> fu P.</> lckkf-	nouuidlockfile = td P.</> "lck" P.</> lckkf+	lckkf = literalOsPath "lck." <> kf+	transferfile = td </> fu </> kf+	uuidlockfile = td </> fu </> lckkf+	nouuidlockfile = td </> literalOsPath "lck" </> lckkf  {- The transfer information file to use to record a failed Transfer -}-failedTransferFile :: Transfer -> Git.Repo -> RawFilePath+failedTransferFile :: Transfer -> Git.Repo -> OsPath failedTransferFile (Transfer direction u kd) r =  	failedTransferDir u direction r-		P.</> keyFile (mkKey (const kd))+		</> keyFile (mkKey (const kd))  {- Parses a transfer information filename to a Transfer. -}-parseTransferFile :: FilePath -> Maybe Transfer+parseTransferFile :: OsPath -> Maybe Transfer parseTransferFile file-	| "lck." `isPrefixOf` takeFileName file = Nothing+	| literalOsPath "lck." `OS.isPrefixOf` takeFileName file = Nothing 	| otherwise = case drop (length bits - 3) bits of 		[direction, u, key] -> Transfer-			<$> parseDirection direction+			<$> parseDirection (fromOsPath direction) 			<*> pure (toUUID u)-			<*> fmap (fromKey id) (fileKey (toRawFilePath key))+			<*> fmap (fromKey id) (fileKey key) 		_ -> Nothing   where 	bits = splitDirectories file -writeTransferInfoFile :: TransferInfo -> RawFilePath -> Annex ()+writeTransferInfoFile :: TransferInfo -> OsPath -> Annex () writeTransferInfoFile info tfile = writeLogFile tfile $ writeTransferInfo info  -- The file keeps whatever permissions it has, so should be used only -- after it's been created with the right perms by writeTransferInfoFile.-updateTransferInfoFile :: TransferInfo -> FilePath -> IO ()-updateTransferInfoFile info tfile = writeFile tfile $ writeTransferInfo info+updateTransferInfoFile :: TransferInfo -> OsPath -> IO ()+updateTransferInfoFile info tfile = +	writeFile (fromOsPath tfile) $ writeTransferInfo info  {- File format is a header line containing the startedTime and any  - bytesComplete value. Followed by a newline and the associatedFile.@@ -281,12 +282,12 @@ #endif 	-- comes last; arbitrary content 	, let AssociatedFile afile = associatedFile info-	  in maybe "" fromRawFilePath afile+	  in maybe "" fromOsPath afile 	] -readTransferInfoFile :: Maybe PID -> FilePath -> IO (Maybe TransferInfo)+readTransferInfoFile :: Maybe PID -> OsPath -> IO (Maybe TransferInfo) readTransferInfoFile mpid tfile = catchDefaultIO Nothing $-	readTransferInfo mpid <$> readFileStrict tfile+	readTransferInfo mpid . decodeBS <$> F.readFile' tfile  readTransferInfo :: Maybe PID -> String -> Maybe TransferInfo readTransferInfo mpid s = TransferInfo@@ -299,12 +300,18 @@ 	<*> pure Nothing 	<*> pure Nothing 	<*> bytes-	<*> pure (AssociatedFile (if null filename then Nothing else Just (toRawFilePath filename)))+	<*> pure af 	<*> pure False   where+	af = AssociatedFile $+		if null filename+			then Nothing+			else Just (toOsPath filename) #ifdef mingw32_HOST_OS-	(firstline, otherlines) = separate (== '\n') s-	(secondline, rest) = separate (== '\n') otherlines+	(firstliner, otherlines) = separate (== '\n') s+	(secondliner, rest) = separate (== '\n') otherlines+	firstline = dropWhileEnd (== '\r') firstliner+	secondline = dropWhileEnd (== '\r') secondliner 	mpid' = readish secondline #else 	(firstline, rest) = separate (== '\n') s@@ -315,23 +322,25 @@ 	bits = splitc ' ' firstline 	numbits = length bits 	time = if numbits > 0-		then Just <$> parsePOSIXTime =<< headMaybe bits+		then Just <$> parsePOSIXTime . encodeBS =<< headMaybe bits 		else pure Nothing -- not failure 	bytes = if numbits > 1 		then Just <$> readish =<< headMaybe (drop 1 bits) 		else pure Nothing -- not failure  {- The directory holding transfer information files for a given Direction. -}-transferDir :: Direction -> Git.Repo -> RawFilePath-transferDir direction r = gitAnnexTransferDir r P.</> formatDirection direction+transferDir :: Direction -> Git.Repo -> OsPath+transferDir direction r = +	gitAnnexTransferDir r+		</> toOsPath (formatDirection direction)  {- The directory holding failed transfer information files for a given  - Direction and UUID -}-failedTransferDir :: UUID -> Direction -> Git.Repo -> RawFilePath+failedTransferDir :: UUID -> Direction -> Git.Repo -> OsPath failedTransferDir u direction r = gitAnnexTransferDir r-	P.</> "failed"-	P.</> formatDirection direction-	P.</> B8.filter (/= '/') (fromUUID u)+	</> literalOsPath "failed"+	</> toOsPath (formatDirection direction)+	</> OS.filter (/= unsafeFromChar '/') (fromUUID u)  prop_read_write_transferinfo :: TransferInfo -> Bool prop_read_write_transferinfo info
Logs/Transitions.hs view
@@ -32,8 +32,8 @@ import qualified Data.Attoparsec.ByteString.Lazy as A import qualified Data.Attoparsec.ByteString.Char8 as A8 -transitionsLog :: RawFilePath-transitionsLog = "transitions.log"+transitionsLog :: OsPath+transitionsLog = literalOsPath "transitions.log"  data Transition 	= ForgetGitHistory@@ -102,7 +102,7 @@  {- Typically ran with Annex.Branch.change, but we can't import Annex.Branch  - here since it depends on this module. -}-recordTransitions :: (RawFilePath -> (L.ByteString -> Builder) -> Annex ()) -> Transitions -> Annex ()+recordTransitions :: (OsPath -> (L.ByteString -> Builder) -> Annex ()) -> Transitions -> Annex () recordTransitions changer t = changer transitionsLog $ 	buildTransitions . S.union t . parseTransitionsStrictly "local"
Logs/Trust.hs view
@@ -1,6 +1,6 @@ {- git-annex trust log  -- - Copyright 2010-2022 Joey Hess <id@joeyh.name>+ - Copyright 2010-2025 Joey Hess <id@joeyh.name>  -  - Licensed under the GNU AGPL version 3 or higher.  -}@@ -18,17 +18,14 @@ 	trustMapLoad, ) where -import qualified Data.Map as M-import Data.Default- import Annex.Common import Types.TrustLevel-import qualified Annex import Logs import Remote.List-import qualified Types.Remote import Logs.Trust.Basic as X +import qualified Data.Map as M+ {- Returns a list of UUIDs that the trustLog indicates have the  - specified trust level.  - Note that the list can be incomplete for SemiTrusted, since that's@@ -63,24 +60,8 @@ {- trustLog in a map, overridden with any values from forcetrust or  - the git config. The map is cached for speed. -} trustMap :: Annex TrustMap-trustMap = maybe trustMapLoad return =<< Annex.getState Annex.trustmap+trustMap = trustMap' =<< remoteList  {- Loads the map, updating the cache, -} trustMapLoad :: Annex TrustMap-trustMapLoad = do-	forceoverrides <- Annex.getState Annex.forcetrust-	l <- remoteList-	let untrustoverrides = M.fromList $-		map (\r -> (Types.Remote.uuid r, UnTrusted))-		(filter Types.Remote.untrustworthy l)-	logged <- trustMapRaw-	let configured = M.fromList $ mapMaybe configuredtrust l-	let m = M.unionWith min untrustoverrides $-		M.union forceoverrides $-		M.union configured logged-	Annex.changeState $ \s -> s { Annex.trustmap = Just m }-	return m-  where-	configuredtrust r = (\l -> Just (Types.Remote.uuid r, l))-		=<< readTrustLevel -		=<< remoteAnnexTrustLevel (Types.Remote.gitconfig r)+trustMapLoad = trustMapLoad' =<< remoteList
Logs/Trust/Basic.hs view
@@ -1,6 +1,6 @@ {- git-annex trust log, basics  -- - Copyright 2010-2012 Joey Hess <id@joeyh.name>+ - Copyright 2010-2025 Joey Hess <id@joeyh.name>  -  - Licensed under the GNU AGPL version 3 or higher.  -}@@ -9,16 +9,21 @@ 	module X, 	trustSet, 	trustMapRaw,+	trustMap',+	trustMapLoad', ) where  import Annex.Common import Types.TrustLevel import qualified Annex.Branch import qualified Annex+import qualified Types.Remote import Logs import Logs.UUIDBased import Logs.Trust.Pure as X +import qualified Data.Map as M+ {- Changes the trust level for a uuid in the trustLog. -} trustSet :: UUID -> TrustLevel -> Annex () trustSet uuid@(UUID _) level = do@@ -34,3 +39,24 @@  - log file. -} trustMapRaw :: Annex TrustMap trustMapRaw = calcTrustMap <$> Annex.Branch.get trustLog++trustMap' :: [Remote] -> Annex TrustMap+trustMap' l = maybe (trustMapLoad' l) return =<< Annex.getState Annex.trustmap++trustMapLoad' :: [Remote] -> Annex TrustMap+trustMapLoad' l = do+	forceoverrides <- Annex.getState Annex.forcetrust+	let untrustoverrides = M.fromList $+		map (\r -> (Types.Remote.uuid r, UnTrusted))+		(filter Types.Remote.untrustworthy l)+	logged <- trustMapRaw+	let configured = M.fromList $ mapMaybe configuredtrust l+	let m = M.unionWith min untrustoverrides $+		M.union forceoverrides $+		M.union configured logged+	Annex.changeState $ \s -> s { Annex.trustmap = Just m }+	return m+  where+	configuredtrust r = (\lvl -> Just (Types.Remote.uuid r, lvl))+		=<< readTrustLevel +		=<< remoteAnnexTrustLevel (Types.Remote.gitconfig r)
Logs/Unused.hs view
@@ -32,6 +32,7 @@ import qualified Data.Set as S import Data.Time.Clock.POSIX import Data.Time+import qualified Utility.FileIO as F  import Annex.Common import qualified Annex@@ -57,13 +58,13 @@   where 	oldts _old@(_, ts) _new@(int, _) = (int, ts) -updateUnusedLog :: RawFilePath -> UnusedMap -> Annex ()+updateUnusedLog :: OsPath -> UnusedMap -> Annex () updateUnusedLog prefix m = do 	oldl <- readUnusedLog prefix 	newl <- preserveTimestamps oldl . flip map2log m <$> liftIO getPOSIXTime 	writeUnusedLog prefix newl -writeUnusedLog :: RawFilePath -> UnusedLog -> Annex ()+writeUnusedLog :: OsPath -> UnusedLog -> Annex () writeUnusedLog prefix l = do 	logfile <- fromRepo $ gitAnnexUnusedLog prefix 	writeLogFile logfile $ unlines $ map format $ M.toList l@@ -71,16 +72,16 @@ 	format (k, (i, Just t)) = show i ++ " " ++ serializeKey k ++ " " ++ show t 	format (k, (i, Nothing)) = show i ++ " " ++ serializeKey k -readUnusedLog :: RawFilePath -> Annex UnusedLog+readUnusedLog :: OsPath -> Annex UnusedLog readUnusedLog prefix = do-	f <- fromRawFilePath <$> fromRepo (gitAnnexUnusedLog prefix)+	f <- fromRepo (gitAnnexUnusedLog prefix) 	ifM (liftIO $ doesFileExist f)-		( M.fromList . mapMaybe parse . lines-			<$> liftIO (readFileStrict f)+		( M.fromList . mapMaybe (parse . decodeBS) . fileLines'+			<$> liftIO (F.readFile' f) 		, return M.empty 		)   where-	parse line = case (readish sint, deserializeKey skey, parsePOSIXTime ts) of+	parse line = case (readish sint, deserializeKey skey, parsePOSIXTime (encodeBS ts)) of 		(Just int, Just key, mtimestamp) -> Just (key, (int, mtimestamp)) 		_ -> Nothing 	  where@@ -89,13 +90,13 @@ 		skey = reverse rskey 		ts = reverse rts -readUnusedMap :: RawFilePath -> Annex UnusedMap+readUnusedMap :: OsPath -> Annex UnusedMap readUnusedMap = log2map <$$> readUnusedLog -dateUnusedLog :: RawFilePath -> Annex (Maybe UTCTime)+dateUnusedLog :: OsPath -> Annex (Maybe UTCTime) dateUnusedLog prefix = do 	f <- fromRepo $ gitAnnexUnusedLog prefix-	liftIO $ catchMaybeIO $ getModificationTime $ fromRawFilePath f+	liftIO $ catchMaybeIO $ getModificationTime f  {- Set of unused keys. This is cached for speed. -} unusedKeys :: Annex (S.Set Key)@@ -103,7 +104,7 @@ 	=<< Annex.getState Annex.unusedkeys  unusedKeys' :: Annex [Key]-unusedKeys' = M.keys <$> readUnusedLog ""+unusedKeys' = M.keys <$> readUnusedLog (literalOsPath "")  setUnusedKeys :: [Key] -> Annex (S.Set Key) setUnusedKeys ks = do
Logs/Upgrade.hs view
@@ -19,6 +19,7 @@ import Utility.TimeStamp import Logs.File import Types.RepoVersion+import qualified Utility.FileIO as F  import Data.Time.Clock.POSIX @@ -31,14 +32,14 @@  readUpgradeLog :: Annex [(RepoVersion, POSIXTime)] readUpgradeLog = do-	logfile <- fromRawFilePath <$> fromRepo gitAnnexUpgradeLog+	logfile <- fromRepo gitAnnexUpgradeLog 	ifM (liftIO $ doesFileExist logfile)-		( mapMaybe parse . lines-			<$> liftIO (readFileStrict logfile)+		( mapMaybe (parse . decodeBS) . fileLines'+			<$> liftIO (F.readFile' logfile) 		, return [] 		)   where-	parse line = case (readish sint, parsePOSIXTime ts) of+	parse line = case (readish sint, parsePOSIXTime (encodeBS ts)) of 		(Just v, Just t) -> Just (RepoVersion v, t) 		_ -> Nothing 	  where
Logs/View.hs view
@@ -54,7 +54,7 @@  recentViews :: Annex [View] recentViews = do-	f <- fromRawFilePath <$> fromRepo gitAnnexViewLog+	f <- fromOsPath <$> fromRepo gitAnnexViewLog 	liftIO $ mapMaybe readish . lines <$> catchDefaultIO [] (readFile f)  {- Gets the currently checked out view, if there is one.
Messages.hs view
@@ -190,7 +190,7 @@ toplevelMsg :: (Semigroup t, IsString t) => t -> t toplevelMsg s = fromString "git-annex: " <> s -toplevelFileProblem :: Bool -> MessageId -> StringContainingQuotedPath -> String -> RawFilePath -> Maybe Key -> SeekInput -> Annex ()+toplevelFileProblem :: Bool -> MessageId -> StringContainingQuotedPath -> String -> OsPath -> Maybe Key -> SeekInput -> Annex () toplevelFileProblem makeway messageid msg action file mkey si = do 	maybeShowJSON' $ JSON.start action (Just file) mkey si 	maybeShowJSON' $ JSON.messageid messageid
Messages/JSON.hs view
@@ -34,6 +34,7 @@ import Control.Applicative import qualified Data.Map as M import qualified Data.Vector as V+import qualified Data.ByteString as S import qualified Data.ByteString.Lazy as L import qualified Data.Aeson.KeyMap as HM import System.IO@@ -50,7 +51,7 @@ import Utility.Metered import Utility.Percentage import Utility.Aeson-import Utility.FileSystemEncoding+import Utility.OsPath import Types.Messages  -- A global lock to avoid concurrent threads emitting json at the same time.@@ -76,7 +77,7 @@ none :: JSONBuilder none = id -start :: String -> Maybe RawFilePath -> Maybe Key -> SeekInput -> JSONBuilder+start :: String -> Maybe OsPath -> Maybe Key -> SeekInput -> JSONBuilder start command file key si _ = case j of 	Object o -> Just (o, False) 	_ -> Nothing@@ -84,7 +85,7 @@ 	j = toJSON' $ JSONActionItem 		{ itemCommand = Just command 		, itemKey = key-		, itemFile = fromRawFilePath <$> file+		, itemFile = file 		, itemUUID = Nothing 		, itemFields = Nothing :: Maybe Bool 		, itemSeekInput = si@@ -98,7 +99,7 @@ 	j = toJSON' $ JSONActionItem 		{ itemCommand = Just command 		, itemKey = actionItemKey ai-		, itemFile = fromRawFilePath <$> actionItemFile ai+		, itemFile = actionItemFile ai 		, itemUUID = actionItemUUID ai 		, itemFields = Nothing :: Maybe Bool 		, itemSeekInput = si@@ -206,7 +207,7 @@ data JSONActionItem a = JSONActionItem 	{ itemCommand :: Maybe String 	, itemKey :: Maybe Key-	, itemFile :: Maybe FilePath+	, itemFile :: Maybe OsPath 	, itemUUID :: Maybe UUID 	, itemFields :: Maybe a 	, itemSeekInput :: SeekInput@@ -220,7 +221,9 @@ 			Just k -> Just $ "key" .= toJSON' k 			Nothing -> Nothing 		, case itemFile i of-			Just f -> Just $ "file" .= toJSON' f+			Just f -> +				let f' = (fromOsPath f) :: S.ByteString+				in Just $ "file" .= toJSON' f' 			Nothing -> Nothing 		, case itemFields i of 			Just f -> Just $ "fields" .= toJSON' f@@ -235,7 +238,7 @@ 	parseJSON (Object v) = JSONActionItem 		<$> (v .:? "command") 		<*> (maybe (return Nothing) parseJSON =<< (v .:? "key"))-		<*> (v .:? "file")+		<*> (fmap stringToOsPath <$> (v .:? "file")) 		<*> (v .:? "uuid") 		<*> (v .:? "fields") 		-- ^ fields is used for metadata, which is currently the
Messages/Progress.hs view
@@ -55,7 +55,7 @@  - This allows uploads of keys without size to still have progress  - displayed.  -}-data KeySizer = KeySizer Key (Annex (Maybe RawFilePath))+data KeySizer = KeySizer Key (Annex (Maybe OsPath))  instance MeterSize KeySizer where 	getMeterSize (KeySizer k getsrcfile) = case fromKey keySize k of@@ -171,7 +171,7 @@ 	minratelimit = min consoleratelimit jsonratelimit 		 {- Poll file size to display meter. -}-meteredFile :: RawFilePath -> Maybe MeterUpdate -> Key -> (MeterUpdate -> Annex a) -> Annex a+meteredFile :: OsPath -> Maybe MeterUpdate -> Key -> (MeterUpdate -> Annex a) -> Annex a meteredFile file combinemeterupdate key a =  	metered combinemeterupdate key Nothing $ \_ p -> 		watchFileSize file p a
P2P/Address.hs view
@@ -5,6 +5,8 @@  - Licensed under the GNU AGPL version 3 or higher.  -} +{-# LANGUAGE OverloadedStrings #-}+ module P2P.Address where  import qualified Annex@@ -75,24 +77,24 @@ 	addrs <- loadP2PAddresses 	unless (addr `elem` addrs) $ do 		let s = unlines $ map formatP2PAddress (addr:addrs)-		let tmpnam = p2pAddressCredsFile ++ ".new"+		let tmpnam = p2pAddressCredsFile <> literalOsPath ".new" 		writeCreds s tmpnam 		tmpf <- credsFile tmpnam 		destf <- credsFile p2pAddressCredsFile 		-- This may be run by root, so make the creds file 		-- and directory have the same owner and group as 		-- the git repository directory has.-		st <- liftIO . R.getFileStatus . toRawFilePath-			=<< Annex.fromRepo repoLocation-		let fixowner f = R.setOwnerAndGroup (toRawFilePath f) (fileOwner st) (fileGroup st)+		st <- liftIO . R.getFileStatus . fromOsPath+			=<< Annex.fromRepo repoPath+		let fixowner f = R.setOwnerAndGroup (fromOsPath f) (fileOwner st) (fileGroup st) 		liftIO $ do 			fixowner tmpf 			fixowner (takeDirectory tmpf) 			fixowner (takeDirectory (takeDirectory tmpf)) 			renameFile tmpf destf -p2pAddressCredsFile :: FilePath-p2pAddressCredsFile = "p2paddrs"+p2pAddressCredsFile :: OsPath+p2pAddressCredsFile = literalOsPath "p2paddrs"  torAppName :: AppName torAppName = "tor-annex"
P2P/Annex.hs view
@@ -18,13 +18,14 @@ import Annex.Content import Annex.Transfer import Annex.ChangedRefs+import Annex.Verify import P2P.Protocol import P2P.IO import Logs.Location import Types.NumCopies import Utility.Metered import Utility.MonotonicClock-import Annex.Verify+import qualified Utility.FileIO as F  import Control.Monad.Free import Control.Concurrent.STM@@ -46,7 +47,7 @@ 		size <- liftIO $ catchDefaultIO 0 $ getFileSize tmp 		runner (next (Len size)) 	FileSize f next -> do-		size <- liftIO $ catchDefaultIO 0 $ getFileSize (toRawFilePath f)+		size <- liftIO $ catchDefaultIO 0 $ getFileSize f 		runner (next (Len size)) 	ContentSize k next -> do 		let getsize = liftIO . catchMaybeIO . getFileSize@@ -80,8 +81,8 @@ 			iv <- startVerifyKeyContentIncrementally DefaultVerify k 			let runtransfer ti =  				Right <$> transfer download' k af Nothing (\p ->-					logStatusAfter NoLiveUpdate k $ getViaTmp rsp DefaultVerify k af Nothing $ \tmp ->-						storefile (fromRawFilePath tmp) o l getb iv validitycheck p ti)+					logStatusAfter NoLiveUpdate k $ getViaTmp rsp DefaultVerify k Nothing $ \tmp ->+						storefile tmp o l getb iv validitycheck p ti) 			let fallback = return $ Left $ 				ProtoFailureMessage "transfer already in progress, or unable to take transfer lock" 			checktransfer runtransfer fallback@@ -194,13 +195,13 @@ 		v <- runner getb 		case v of 			Right b -> do-				liftIO $ withBinaryFile dest ReadWriteMode $ \h -> do+				liftIO $ F.withBinaryFile dest ReadWriteMode $ \h -> do 					p' <- resumeVerifyFromOffset o incrementalverifier p h 					meteredWrite p' (writeVerifyChunk incrementalverifier h) b 				indicatetransferred ti  				rightsize <- do-					sz <- liftIO $ getFileSize (toRawFilePath dest)+					sz <- liftIO $ getFileSize dest 					return (toInteger sz == l + o) 					 				runner validitycheck >>= \case@@ -210,7 +211,7 @@ 								Nothing -> return (True, UnVerified) 								Just True -> return (True, Verified) 								Just False -> do-									verificationOfContentFailed (toRawFilePath dest)+									verificationOfContentFailed dest 									return (False, UnVerified) 							| otherwise -> return (False, UnVerified) 						Nothing -> return (rightsize, UnVerified)@@ -232,7 +233,7 @@ 	 	sinkfile f (Offset o) checkchanged sender p ti = bracket setup cleanup go 	  where-		setup = liftIO $ openBinaryFile f ReadMode+		setup = liftIO $ F.openBinaryFile f ReadMode 		cleanup = liftIO . hClose 		go h = do 			let p' = offsetMeterUpdate p (toBytesProcessed o)
P2P/Auth.hs view
@@ -5,6 +5,8 @@  - Licensed under the GNU AGPL version 3 or higher.  -} +{-# LANGUAGE OverloadedStrings #-}+ module P2P.Auth where  import Annex.Common@@ -35,8 +37,8 @@ 		let d = unlines $ map (T.unpack . fromAuthToken) (t:ts) 		writeCreds d p2pAuthCredsFile -p2pAuthCredsFile :: FilePath-p2pAuthCredsFile = "p2pauth"+p2pAuthCredsFile :: OsPath+p2pAuthCredsFile = literalOsPath "p2pauth"  -- | Loads the AuthToken to use when connecting with a given P2P address. --@@ -59,8 +61,9 @@ 	(T.unpack $ fromAuthToken t) 	(addressCredsFile addr) -addressCredsFile :: P2PAddress -> FilePath+addressCredsFile :: P2PAddress -> OsPath -- We can omit the port and just use the onion address for the creds file, -- because any given tor hidden service runs on a single port and has a -- unique onion address.-addressCredsFile (TorAnnex (OnionAddress onionaddr) _port) = onionaddr+addressCredsFile (TorAnnex (OnionAddress onionaddr) _port) =+	toOsPath onionaddr
P2P/Http/Client.hs view
@@ -37,6 +37,7 @@ import Utility.Url (BasicAuth(..)) import Utility.HumanTime import Utility.STM+import qualified Utility.FileIO as F import qualified Git.Credential as Git  import Servant hiding (BasicAuthData(..))@@ -340,7 +341,7 @@ 	-> Key 	-> Maybe Offset 	-> AssociatedFile-	-> FilePath+	-> OsPath 	-> FileSize 	-> Annex Bool 	-- ^ Called after sending the file to check if it's valid.@@ -358,7 +359,7 @@ 			liftIO $ atomically $ takeTMVar checkv 			validitycheck >>= liftIO . atomically . putTMVar checkresultv 		checkerthread <- liftIO . async =<< forkState checker-		v <- liftIO $ withBinaryFile contentfile ReadMode $ \h -> do+		v <- liftIO $ F.withBinaryFile contentfile ReadMode $ \h -> do 			when (offset /= 0) $ 				hSeek h AbsoluteSeek offset 			withClientM (cli (stream h checkv checkresultv)) clientenv return
P2P/Http/Types.hs view
@@ -52,7 +52,7 @@ newtype B64Key = B64Key Key 	deriving (Show) -newtype B64FilePath = B64FilePath RawFilePath+newtype B64FilePath = B64FilePath OsPath 	deriving (Show)  associatedFileToB64FilePath :: AssociatedFile -> Maybe B64FilePath@@ -233,11 +233,11 @@ 		Left err -> Left err  instance ToHttpApiData B64FilePath where-	toUrlPiece (B64FilePath f) = encodeB64Text f+	toUrlPiece (B64FilePath f) = encodeB64Text (fromOsPath f)  instance FromHttpApiData B64FilePath where 	parseUrlPiece t = case decodeB64Text t of-		Right b -> Right (B64FilePath b)+		Right b -> Right (B64FilePath (toOsPath b)) 		Left err -> Left err  instance ToHttpApiData Offset where
P2P/IO.hs view
@@ -42,7 +42,6 @@ import Utility.MonotonicClock import Types.UUID import Annex.ChangedRefs-import qualified Utility.RawFilePath as R  import Control.Monad.Free import Control.Monad.IO.Class@@ -162,11 +161,11 @@ -- Note that while the callback is running, other connections won't be -- processed, so longterm work should be run in a separate thread by -- the callback.-serveUnixSocket :: FilePath -> (Handle -> IO ()) -> IO ()+serveUnixSocket :: OsPath -> (Handle -> IO ()) -> IO () serveUnixSocket unixsocket serveconn = do-	removeWhenExistsWith R.removeLink (toRawFilePath unixsocket)+	removeWhenExistsWith removeFile unixsocket 	soc <- S.socket S.AF_UNIX S.Stream S.defaultProtocol-	S.bind soc (S.SockAddrUnix unixsocket)+	S.bind soc (S.SockAddrUnix (fromOsPath unixsocket)) 	-- Allow everyone to read and write to the socket, 	-- so a daemon like tor, that is probably running as a different 	-- de sock $ addModes@@ -175,7 +174,7 @@         -- Connections have to authenticate to do anything,         -- so it's fine that other local users can connect to the         -- socket.-	modifyFileMode (toRawFilePath unixsocket) $ addModes+	modifyFileMode unixsocket $ addModes 		[groupReadMode, groupWriteMode, otherReadMode, otherWriteMode] 	S.listen soc 2 	forever $ do@@ -381,7 +380,7 @@ 	 	serviceproc repo = gitCreateProcess 		[ Param cmd-		, File (fromRawFilePath (repoPath repo))+		, File (fromOsPath (repoPath repo)) 		] repo 	serviceproc' repo = (serviceproc repo) 		{ std_out = CreatePipe
P2P/Protocol.hs view
@@ -10,6 +10,7 @@ {-# LANGUAGE DeriveFunctor, TemplateHaskell, FlexibleContexts #-} {-# LANGUAGE TypeSynonymInstances, FlexibleInstances, RankNTypes #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_GHC -fno-warn-orphans #-}  module P2P.Protocol where@@ -25,8 +26,9 @@ import Utility.Applicative import Utility.PartialPrelude import Utility.Metered-import Utility.FileSystemEncoding import Utility.MonotonicClock+import Utility.OsPath+import qualified Utility.OsString as OS import Git.FilePath import Annex.ChangedRefs (ChangedRefs) import Types.NumCopies@@ -37,8 +39,6 @@ import Control.Monad.Catch import System.Exit (ExitCode(..)) import System.IO-import qualified System.FilePath.ByteString as P-import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as L import qualified Data.Set as S import Data.Char@@ -224,17 +224,19 @@ instance Proto.Serializable ProtoAssociatedFile where 	serialize (ProtoAssociatedFile (AssociatedFile Nothing)) = "" 	serialize (ProtoAssociatedFile (AssociatedFile (Just af))) = -		decodeBS $ toInternalGitPath $ encodeBS $ concatMap esc $ fromRawFilePath af+		fromOsPath $ toInternalGitPath $+			OS.concat $ map esc $ OS.unpack af 	  where-		esc '%' = "%%"-		esc c -			| isSpace c = "%"-			| otherwise = [c]+	  	esc c = case OS.toChar c of+			'%' -> literalOsPath "%%"+			c' | isSpace c' -> literalOsPath "%"+			_ -> OS.singleton c 	-	deserialize s = case fromInternalGitPath $ toRawFilePath $ deesc [] s of+	deserialize s = case fromInternalGitPath $ toOsPath $ deesc [] s of 		f-			| B.null f -> Just $ ProtoAssociatedFile $ AssociatedFile Nothing-			| P.isRelative f -> Just $ ProtoAssociatedFile $ +			| OS.null f -> Just $ ProtoAssociatedFile $+				AssociatedFile Nothing+			| isRelative f -> Just $ ProtoAssociatedFile $  				AssociatedFile $ Just f 			| otherwise -> Nothing 	  where@@ -291,12 +293,12 @@ 	= TmpContentSize Key (Len -> c) 	-- ^ Gets size of the temp file where received content may have 	-- been stored. If not present, returns 0.-	| FileSize FilePath (Len -> c)+	| FileSize OsPath (Len -> c) 	-- ^ Gets size of the content of a file. If not present, returns 0. 	| ContentSize Key (Maybe Len -> c) 	-- ^ Gets size of the content of a key, when the full content is 	-- present.-	| ReadContent Key AssociatedFile (Maybe FilePath) Offset (L.ByteString -> Proto Validity -> Proto (Maybe [UUID])) (Maybe [UUID] -> c)+	| ReadContent Key AssociatedFile (Maybe OsPath) Offset (L.ByteString -> Proto Validity -> Proto (Maybe [UUID])) (Maybe [UUID] -> c) 	-- ^ Reads the content of a key and sends it to the callback. 	-- Must run the callback, or terminate the protocol connection. 	--@@ -321,7 +323,7 @@ 	-- Note: The ByteString may not contain the entire remaining content 	-- of the key. Only once the temp file size == Len has the whole 	-- content been transferred.-	| StoreContentTo FilePath (Maybe IncrementalVerifier) Offset Len (Proto L.ByteString) (Proto (Maybe Validity)) ((Bool, Verification) -> c)+	| StoreContentTo OsPath (Maybe IncrementalVerifier) Offset Len (Proto L.ByteString) (Proto (Maybe Validity)) ((Bool, Verification) -> c) 	-- ^ Like StoreContent, but stores the content to a temp file. 	| SendContentWith (L.ByteString -> Annex (Maybe Validity -> Annex Bool)) (Proto L.ByteString) (Proto (Maybe Validity)) (Bool -> c) 	-- ^ Reads content from the Proto L.ByteString and sends it to the@@ -479,7 +481,7 @@ 		REMOVE_BEFORE remoteendtime key 	checkSuccessFailurePlus	 -get :: FilePath -> Key -> Maybe IncrementalVerifier -> AssociatedFile -> Meter -> MeterUpdate -> Proto (Bool, Verification)+get :: OsPath -> Key -> Maybe IncrementalVerifier -> AssociatedFile -> Meter -> MeterUpdate -> Proto (Bool, Verification) get dest key iv af m p =  	receiveContent (Just m) p sizer storer noothermessages $ \offset -> 		GET offset (ProtoAssociatedFile af) key@@ -725,7 +727,7 @@ 		(ServeReadOnly, UploadPack) -> a Nothing 		(ServeReadOnly, ReceivePack) -> a (Just sendReadOnlyError) -sendContent :: Key -> AssociatedFile -> Maybe FilePath -> Offset -> MeterUpdate -> Proto (Maybe [UUID])+sendContent :: Key -> AssociatedFile -> Maybe OsPath -> Offset -> MeterUpdate -> Proto (Maybe [UUID]) sendContent key af o offset@(Offset n) p = go =<< local (contentSize key)   where 	go (Just (Len totallen)) = do
Remote.hs view
@@ -319,22 +319,11 @@ 		remotesChanged 		findinmap -{- Filters a list of remotes to ones that have the listed uuids. -}-remotesWithUUID :: [Remote] -> [UUID] -> [Remote]-remotesWithUUID rs us = filter (\r -> uuid r `elem` us) rs--{- Filters a list of remotes to ones that do not have the listed uuids. -}-remotesWithoutUUID :: [Remote] -> [UUID] -> [Remote]-remotesWithoutUUID rs us = filter (\r -> uuid r `notElem` us) rs- {- List of repository UUIDs that the location log indicates may have a key.  - Dead repositories are excluded. -} keyLocations :: Key -> Annex [UUID] keyLocations key = trustExclude DeadTrusted =<< loggedLocations key -{- Whether to include remotes that have annex-ignore set. -}-newtype IncludeIgnored = IncludeIgnored Bool- {- Cost ordered lists of remotes that the location log indicates  - may have a key.  -@@ -342,33 +331,16 @@  -} keyPossibilities :: IncludeIgnored -> Key -> Annex [Remote] keyPossibilities ii key = do-	u <- getUUID-	-- uuids of all remotes that are recorded to have the key-	locations <- filter (/= u) <$> keyLocations key-	speclocations <- map uuid-		. filter (remoteAnnexSpeculatePresent . gitconfig)-		<$> remoteList-	-- there are unlikely to be many speclocations, so building a Set-	-- is not worth the expense-	let locations' = speclocations ++ filter (`notElem` speclocations) locations-	fst <$> remoteLocations ii locations' []+	locations <- keyLocations key+	keyPossibilities' ii key locations =<< remoteList  {- Given a list of locations of a key, and a list of all  - trusted repositories, generates a cost-ordered list of  - remotes that contain the key, and a list of trusted locations of the key.  -} remoteLocations :: IncludeIgnored -> [UUID] -> [UUID] -> Annex ([Remote], [UUID])-remoteLocations (IncludeIgnored ii) locations trusted = do-	let validtrustedlocations = nub locations `intersect` trusted--	-- remotes that match uuids that have the key-	allremotes <- remoteList -		>>= if not ii-			then filterM (not <$$> liftIO . getDynamicConfig . remoteAnnexIgnore . gitconfig)-			else return-	let validremotes = remotesWithUUID allremotes locations--	return (sortBy (comparing cost) validremotes, validtrustedlocations)+remoteLocations ii locations trusted = +	remoteLocations' ii locations trusted =<< remoteList  {- Displays known locations of a key and helps the user take action  - to make them accessible. -}
Remote/Adb.hs view
@@ -25,6 +25,7 @@ import Types.ProposedAccepted import Annex.SpecialRemote.Config import Annex.Verify+import qualified Utility.OsString as OS  import qualified Data.Map as M import qualified System.FilePath.Posix as Posix@@ -34,7 +35,7 @@ 	deriving (Show, Eq)  -- | A location on an Android device. -newtype AndroidPath = AndroidPath { fromAndroidPath :: FilePath }+newtype AndroidPath = AndroidPath { fromAndroidPath :: Posix.FilePath }  remote :: RemoteType remote = specialRemoteType $ RemoteType@@ -182,20 +183,20 @@ 	in unlessM (store' serial dest src) $ 		giveup "adb failed" -store' :: AndroidSerial -> AndroidPath -> FilePath -> Annex Bool+store' :: AndroidSerial -> AndroidPath -> OsPath -> Annex Bool store' serial dest src = checkAdbInPath False $ do-	let destdir = takeDirectory $ fromAndroidPath dest+	let destdir = Posix.takeDirectory $ fromAndroidPath dest 	void $ adbShell serial [Param "mkdir", Param "-p", File destdir] 	showOutput -- make way for adb push output 	liftIO $ boolSystem "adb" $ mkAdbCommand serial-		[Param "push", File src, File (fromAndroidPath dest)]+		[Param "push", File (fromOsPath src), File (fromAndroidPath dest)]  retrieve :: AndroidSerial -> AndroidPath -> Retriever retrieve serial adir = fileRetriever $ \dest k _p -> 	let src = androidLocation adir k-	in retrieve' serial src (fromRawFilePath dest)+	in retrieve' serial src dest -retrieve' :: AndroidSerial -> AndroidPath -> FilePath -> Annex ()+retrieve' :: AndroidSerial -> AndroidPath -> OsPath -> Annex () retrieve' serial src dest = 	unlessM go $ 		giveup "adb pull failed"@@ -206,7 +207,7 @@ 			[ Param "pull" 			, Param "-a" 			, File $ fromAndroidPath src-			, File dest+			, File $ fromOsPath dest 			]  remove :: AndroidSerial -> AndroidPath -> Remover@@ -240,21 +241,22 @@  androidHashDir :: AndroidPath -> Key -> AndroidPath androidHashDir adir k = AndroidPath $ -	fromAndroidPath adir ++ "/" ++ hdir+	fromAndroidPath adir ++ "/" ++ fromOsPath hdir   where-	hdir = replace [pathSeparator] "/" (fromRawFilePath (hashDirLower def k))+	hdir = OS.intercalate (literalOsPath "/") $ OS.split pathSeparator $+		hashDirLower def k -storeExportM :: AndroidSerial -> AndroidPath -> FilePath -> Key -> ExportLocation -> MeterUpdate -> Annex ()+storeExportM :: AndroidSerial -> AndroidPath -> OsPath -> Key -> ExportLocation -> MeterUpdate -> Annex () storeExportM serial adir src _k loc _p =  	unlessM (store' serial dest src) $ 		giveup "adb failed"   where 	dest = androidExportLocation adir loc -retrieveExportM :: AndroidSerial -> AndroidPath -> Key -> ExportLocation -> FilePath -> MeterUpdate -> Annex Verification+retrieveExportM :: AndroidSerial -> AndroidPath -> Key -> ExportLocation -> OsPath -> MeterUpdate -> Annex Verification retrieveExportM serial adir k loc dest _p =  	verifyKeyContentIncrementally AlwaysVerify k $ \iv ->-		tailVerify iv (toRawFilePath dest) $+		tailVerify iv dest $ 			retrieve' serial src dest   where 	src = androidExportLocation adir loc@@ -342,7 +344,7 @@ 		let (stat, fn) = separate (== '\t') l 		    sz = fromMaybe 0 (readish (takeWhile (/= ' ') stat)) 		    cid = ContentIdentifier (encodeBS stat)-		    loc = mkImportLocation $ toRawFilePath $ +		    loc = mkImportLocation $ toOsPath $  		    	Posix.makeRelative (fromAndroidPath adir) fn 		in Just (loc, (cid, sz)) 	mk _ = Nothing@@ -351,7 +353,7 @@ -- connection is reasonably fast, it's probably as good as -- git's handling of similar situations with files being modified while -- it's updating the working tree for a merge.-retrieveExportWithContentIdentifierM :: AndroidSerial -> AndroidPath -> ExportLocation -> [ContentIdentifier] -> FilePath -> Either Key (Annex Key) -> MeterUpdate -> Annex (Key, Verification)+retrieveExportWithContentIdentifierM :: AndroidSerial -> AndroidPath -> ExportLocation -> [ContentIdentifier] -> OsPath -> Either Key (Annex Key) -> MeterUpdate -> Annex (Key, Verification) retrieveExportWithContentIdentifierM serial adir loc cids dest gk _p = do 	case gk of 		Right mkkey -> do@@ -360,7 +362,7 @@ 			return (k, UnVerified) 		Left k -> do 			v <- verifyKeyContentIncrementally DefaultVerify k-				(\iv -> tailVerify iv (toRawFilePath dest) go)+				(\iv -> tailVerify iv dest go) 			return (k, v)   where 	go = do@@ -371,7 +373,7 @@ 			_ -> giveup "the file on the android device has changed" 	src = androidExportLocation adir loc -storeExportWithContentIdentifierM :: AndroidSerial -> AndroidPath -> FilePath -> Key -> ExportLocation -> [ContentIdentifier] -> MeterUpdate -> Annex ContentIdentifier+storeExportWithContentIdentifierM :: AndroidSerial -> AndroidPath -> OsPath -> Key -> ExportLocation -> [ContentIdentifier] -> MeterUpdate -> Annex ContentIdentifier storeExportWithContentIdentifierM serial adir src _k loc overwritablecids _p = 	ifM checkcanoverwrite 		( ifM (store' serial dest src)@@ -410,7 +412,7 @@  androidExportLocation :: AndroidPath -> ExportLocation -> AndroidPath androidExportLocation adir loc = AndroidPath $-	fromAndroidPath adir ++ "/" ++ fromRawFilePath (fromExportLocation loc)+	fromAndroidPath adir ++ "/" ++ fromOsPath (fromExportLocation loc)  -- | List all connected Android devices. enumerateAdbConnected :: Annex [AndroidSerial]
Remote/BitTorrent.hs view
@@ -31,14 +31,12 @@ import qualified Annex.Url as Url import Remote.Helper.ExportImport import Annex.SpecialRemote.Config-import qualified Utility.RawFilePath as R+import qualified Utility.OsString as OS  import Network.URI-import qualified System.FilePath.ByteString as P- #ifdef WITH_TORRENTPARSER import Data.Torrent-import qualified Data.ByteString.Lazy as B+import qualified Utility.FileIO as F #endif  remote :: RemoteType@@ -100,7 +98,7 @@ 		, remoteStateHandle = rs 		} -downloadKey :: Key -> AssociatedFile -> FilePath -> MeterUpdate -> VerifyConfig -> Annex Verification+downloadKey :: Key -> AssociatedFile -> OsPath -> MeterUpdate -> VerifyConfig -> Annex Verification downloadKey key _file dest p _ = do 	get . map (torrentUrlNum . fst . getDownloader) =<< getBitTorrentUrls key 	-- While bittorrent verifies the hash in the torrent file,@@ -121,7 +119,7 @@ 		unless ok $ 			get [] -uploadKey :: Key -> AssociatedFile -> Maybe FilePath -> MeterUpdate -> Annex ()+uploadKey :: Key -> AssociatedFile -> Maybe OsPath -> MeterUpdate -> Annex () uploadKey _ _ _ _ = giveup "upload to bittorrent not supported"  dropKey :: Maybe SafeDropProof -> Key -> Annex ()@@ -179,7 +177,7 @@ torrentUrlKey u = return $ fromUrl (fst $ torrentUrlNum u) Nothing False  {- Temporary filename to use to store the torrent file. -}-tmpTorrentFile :: URLString -> Annex RawFilePath+tmpTorrentFile :: URLString -> Annex OsPath tmpTorrentFile u = fromRepo . gitAnnexTmpObjectLocation =<< torrentUrlKey u  {- A cleanup action is registered to delete the torrent file@@ -191,13 +189,13 @@  -} registerTorrentCleanup :: URLString -> Annex () registerTorrentCleanup u = Annex.addCleanupAction (TorrentCleanup u) $-	liftIO . removeWhenExistsWith R.removeLink =<< tmpTorrentFile u+	liftIO . removeWhenExistsWith removeFile =<< tmpTorrentFile u  {- Downloads the torrent file. (Not its contents.) -} downloadTorrentFile :: URLString -> Annex Bool downloadTorrentFile u = do 	torrent <- tmpTorrentFile u-	ifM (liftIO $ doesFileExist (fromRawFilePath torrent))+	ifM (liftIO $ doesFileExist torrent) 		( return True 		, do 			showAction "downloading torrent file"@@ -205,34 +203,31 @@ 			if isTorrentMagnetUrl u 				then withOtherTmp $ \othertmp -> do 					kf <- keyFile <$> torrentUrlKey u-					let metadir = othertmp P.</> "torrentmeta" P.</> kf+					let metadir = othertmp </> literalOsPath "torrentmeta" </> kf 					createAnnexDirectory metadir 					showOutput-					ok <- downloadMagnetLink u-						(fromRawFilePath metadir)-						(fromRawFilePath torrent)-					liftIO $ removeDirectoryRecursive-						(fromRawFilePath metadir)+					ok <- downloadMagnetLink u metadir torrent+					liftIO $ removeDirectoryRecursive metadir 					return ok 				else withOtherTmp $ \othertmp -> do-					withTmpFileIn (fromRawFilePath othertmp) "torrent" $ \f h -> do+					withTmpFileIn othertmp (literalOsPath "torrent") $ \f h -> do 						liftIO $ hClose h-						resetAnnexFilePerm (toRawFilePath f)+						resetAnnexFilePerm f 						ok <- Url.withUrlOptions $  							Url.download nullMeterUpdate Nothing u f 						when ok $-							liftIO $ moveFile (toRawFilePath f) torrent+							liftIO $ moveFile f torrent 						return ok 		) -downloadMagnetLink :: URLString -> FilePath -> FilePath -> Annex Bool+downloadMagnetLink :: URLString -> OsPath -> OsPath -> Annex Bool downloadMagnetLink u metadir dest = ifM download 	( liftIO $ do-		ts <- filter (".torrent" `isSuffixOf`)+		ts <- filter (literalOsPath ".torrent" `OS.isSuffixOf`) 			<$> dirContents metadir 		case ts of 			(t:[]) -> do-				moveFile (toRawFilePath t) (toRawFilePath dest)+				moveFile t dest 				return True 			_ -> return False 	, return False@@ -245,22 +240,22 @@ 		, Param "--seed-time=0" 		, Param "--summary-interval=0" 		, Param "-d"-		, File metadir+		, File (fromOsPath metadir) 		] -downloadTorrentContent :: Key -> URLString -> FilePath -> Int -> MeterUpdate -> Annex Bool+downloadTorrentContent :: Key -> URLString -> OsPath -> Int -> MeterUpdate -> Annex Bool downloadTorrentContent k u dest filenum p = do 	torrent <- tmpTorrentFile u 	withOtherTmp $ \othertmp -> do 		kf <- keyFile <$> torrentUrlKey u-		let downloaddir = othertmp P.</> "torrent" P.</> kf+		let downloaddir = othertmp </> literalOsPath "torrent" </> kf 		createAnnexDirectory downloaddir 		f <- wantedfile torrent-		let dlf = fromRawFilePath downloaddir </> f+		let dlf = downloaddir </> f 		showOutput 		ifM (download torrent downloaddir <&&> liftIO (doesFileExist dlf)) 			( do-				liftIO $ moveFile (toRawFilePath dlf) (toRawFilePath dest)+				liftIO $ moveFile dlf dest 				-- The downloaddir is not removed here, 				-- so if aria downloaded parts of other 				-- files, and this is called again, it will@@ -274,9 +269,9 @@   where 	download torrent tmpdir = ariaProgress (fromKey keySize k) p 		[ Param $ "--select-file=" ++ show filenum-		, File (fromRawFilePath torrent)+		, File (fromOsPath torrent) 		, Param "-d"-		, File (fromRawFilePath tmpdir)+		, File (fromOsPath tmpdir) 		, Param "--seed-time=0" 		, Param "--summary-interval=0" 		, Param "--file-allocation=none"@@ -363,11 +358,11 @@ {- Examines the torrent file and gets the list of files in it,  - and their sizes.  -}-torrentFileSizes :: RawFilePath -> IO [(FilePath, Integer)]+torrentFileSizes :: OsPath -> IO [(OsPath, Integer)] torrentFileSizes torrent = do #ifdef WITH_TORRENTPARSER-	let mkfile = joinPath . map (scrub . decodeBL)-	b <- B.readFile (fromRawFilePath torrent)+	let mkfile = joinPath . map (scrub . toOsPath)+	b <- F.readFile torrent 	return $ case readTorrent b of 		Left e -> giveup $ "failed to parse torrent: " ++ e 		Right t -> case tInfo t of@@ -383,19 +378,19 @@ 			fnl <- getfield "file name" 			szl <- map readish <$> getfield "file size" 			case (fnl, szl) of-				((fn:[]), (Just sz:[])) -> return [(scrub fn, sz)]+				((fn:[]), (Just sz:[])) -> return [(scrub (toOsPath fn), sz)] 		 		_ -> parsefailed (show (fnl, szl)) 		else do 			v <- getfield "directory name" 			case v of-				(d:[]) -> return $ map (splitsize d) files+				(d:[]) -> return $ map (splitsize (toOsPath d)) files 				_ -> parsefailed (show v)   where-	getfield = btshowmetainfo (fromRawFilePath torrent)+	getfield = btshowmetainfo (fromOsPath torrent) 	parsefailed s = giveup $ "failed to parse btshowmetainfo output for torrent file: " ++ show s  	-- btshowmetainfo outputs a list of "filename (size)"-	splitsize d l = (scrub (d </> fn), sz)+	splitsize d l = (scrub (d </> toOsPath fn), sz) 	  where 		sz = fromMaybe (parsefailed l) $ readish $  			reverse $ takeWhile (/= '(') $ dropWhile (== ')') $@@ -404,7 +399,7 @@ 			dropWhile (/= '(') $ dropWhile (== ')') $ reverse l #endif 	-- a malicious torrent file might try to do directory traversal-	scrub f = if isAbsolute f || any (== "..") (splitPath f)+	scrub f = if isAbsolute f || any (== literalOsPath "..") (splitPath f) 		then giveup "found unsafe filename in torrent!" 		else f
Remote/Borg.hs view
@@ -39,7 +39,6 @@ import qualified Data.Map as M import qualified Data.ByteString as S import qualified Data.ByteString.Lazy as L-import qualified System.FilePath.ByteString as P  newtype BorgRepo = BorgRepo { locBorgRepo :: String } @@ -156,18 +155,17 @@  absBorgRepo :: BorgRepo -> IO BorgRepo absBorgRepo r@(BorgRepo p)-	| borgLocal r = BorgRepo . fromRawFilePath-		<$> absPath (toRawFilePath p)+	| borgLocal r = BorgRepo . fromOsPath <$> absPath (toOsPath p) 	| otherwise = return r -borgRepoLocalPath :: BorgRepo -> Maybe FilePath+borgRepoLocalPath :: BorgRepo -> Maybe OsPath borgRepoLocalPath r@(BorgRepo p)-	| borgLocal r = Just p+	| borgLocal r = Just (toOsPath p) 	| otherwise = Nothing  checkAvailability :: BorgRepo -> Annex Availability checkAvailability borgrepo@(BorgRepo r) = -	checkPathAvailability (borgLocal borgrepo) r+	checkPathAvailability (borgLocal borgrepo) (toOsPath r)  listImportableContentsM :: UUID -> BorgRepo -> ParsedRemoteConfig -> Annex (Maybe (ImportableContentsChunkable Annex (ContentIdentifier, ByteSize))) listImportableContentsM u borgrepo c = prompt $ do@@ -218,7 +216,7 @@ 	parsefilelist archivename (bsz:f:extra:rest) = case readMaybe (fromRawFilePath bsz) of 		Nothing -> parsefilelist archivename rest 		Just sz ->-			let loc = genImportLocation f+			let loc = genImportLocation (toOsPath f) 			-- borg list reports hard links as 0 byte files, 			-- with the extra field set to " link to ". 			-- When the annex object is a hard link to@@ -270,7 +268,7 @@ borgContentIdentifier :: ContentIdentifier borgContentIdentifier = ContentIdentifier mempty --- Convert a path file a borg archive to a path that can be used as an +-- Convert a path from a borg archive to a path that can be used as an  -- ImportLocation. The archive name gets used as a subdirectory, -- which this path is inside. --@@ -279,25 +277,26 @@ -- -- This scheme also relies on the fact that paths in a borg archive are -- always relative, not absolute.-genImportLocation :: RawFilePath -> RawFilePath+genImportLocation :: OsPath -> OsPath genImportLocation = fromImportLocation . ThirdPartyPopulated.mkThirdPartyImportLocation  genImportChunkSubDir :: BorgArchiveName -> ImportChunkSubDir-genImportChunkSubDir = ImportChunkSubDir . fromImportLocation . ThirdPartyPopulated.mkThirdPartyImportLocation+genImportChunkSubDir = ImportChunkSubDir . fromImportLocation +	. ThirdPartyPopulated.mkThirdPartyImportLocation . toOsPath -extractImportLocation :: ImportLocation -> (BorgArchiveName, RawFilePath)-extractImportLocation loc = go $ P.splitDirectories $+extractImportLocation :: ImportLocation -> (BorgArchiveName, OsPath)+extractImportLocation loc = go $ splitDirectories $ 	ThirdPartyPopulated.fromThirdPartyImportLocation loc   where-	go (archivename:rest) = (archivename, P.joinPath rest)-	go _ = giveup $ "Unable to parse import location " ++ fromRawFilePath (fromImportLocation loc)+	go (archivename:rest) = (fromOsPath archivename, joinPath rest)+	go _ = giveup $ "Unable to parse import location " ++ fromOsPath (fromImportLocation loc)  -- Since the ImportLocation starts with the archive name, a list of all -- archive names we've already imported can be found by just listing the -- last imported tree. And the contents of those archives can be retrieved -- by listing the subtree recursively, which will likely be quite a lot -- faster than running borg.-getImported :: UUID -> Annex (M.Map BorgArchiveName (Annex [(RawFilePath, (ContentIdentifier, ByteSize))]))+getImported :: UUID -> Annex (M.Map BorgArchiveName (Annex [(OsPath, (ContentIdentifier, ByteSize))])) getImported u = M.unions <$> (mapM go . exportedTreeishes =<< getExport u)   where 	go t = M.fromList . mapMaybe mk@@ -305,7 +304,7 @@ 	 	mk ti 		| toTreeItemType (LsTree.mode ti) == Just TreeSubtree = Just-			( getTopFilePath (LsTree.file ti)+			( fromOsPath (getTopFilePath (LsTree.file ti)) 			, getcontents (LsTree.sha ti) 			) 		| otherwise = Nothing@@ -316,7 +315,7 @@ 	mkcontents ti = do 		let f = ThirdPartyPopulated.fromThirdPartyImportLocation $ 			mkImportLocation $ getTopFilePath $ LsTree.file ti-		k <- fileKey (P.takeFileName f)+		k <- fileKey (takeFileName f) 		return 			( genImportLocation f 			,@@ -341,7 +340,7 @@ 		, Param "--format" 		, Param "1" 		, Param (borgArchive borgrepo archivename)-		, File (fromRawFilePath archivefile)+		, File (fromOsPath archivefile) 		] 	-- borg list exits nonzero with an error message if an archive 	-- no longer exists. But, the user can delete archives at any@@ -377,7 +376,7 @@ 			, giveup $ "Unable to access borg repository " ++ locBorgRepo borgrepo 			) -retrieveExportWithContentIdentifierM :: BorgRepo -> ImportLocation -> [ContentIdentifier] -> FilePath -> Either Key (Annex Key) -> MeterUpdate -> Annex (Key, Verification)+retrieveExportWithContentIdentifierM :: BorgRepo -> ImportLocation -> [ContentIdentifier] -> OsPath -> Either Key (Annex Key) -> MeterUpdate -> Annex (Key, Verification) retrieveExportWithContentIdentifierM borgrepo loc _ dest gk _ = do 	showOutput 	case gk of@@ -387,7 +386,7 @@ 			return (k, UnVerified) 		Left k -> do 			v <- verifyKeyContentIncrementally DefaultVerify k -				(\iv -> tailVerify iv (toRawFilePath dest) go)+				(\iv -> tailVerify iv dest go) 			return (k, v)   where 	go = prompt $ withOtherTmp $ \othertmp -> liftIO $ do@@ -406,14 +405,14 @@ 			, Param "--noacls" 			, Param "--nobsdflags" 			, Param (borgArchive absborgrepo archivename)-			, File (fromRawFilePath archivefile)+			, File (fromOsPath archivefile) 			] 		(Nothing, Nothing, Nothing, pid) <- createProcess $ p-			{ cwd = Just (fromRawFilePath othertmp) }+			{ cwd = Just (fromOsPath othertmp) } 		forceSuccessProcess p pid 		-- Filepaths in borg archives are relative, so it's ok to 		-- combine with </>-		moveFile (othertmp P.</> archivefile) (toRawFilePath dest)-		removeDirectoryRecursive (fromRawFilePath othertmp)+		moveFile (othertmp </> archivefile) dest+		removeDirectoryRecursive othertmp  	(archivename, archivefile) = extractImportLocation loc
Remote/Bup.hs view
@@ -12,7 +12,6 @@ import qualified Data.Map as M import qualified Data.ByteString as S import qualified Data.ByteString.Lazy as L-import qualified System.FilePath.ByteString as P import Data.ByteString.Lazy.UTF8 (fromString) import Control.Concurrent.Async @@ -96,12 +95,12 @@ 		, getRepo = return r 		, gitconfig = gc 		, localpath = if bupLocal buprepo && not (null buprepo)-			then Just buprepo+			then Just (toOsPath buprepo) 			else Nothing 		, remotetype = remote 		, availability = if null buprepo 			then pure LocallyAvailable-			else checkPathAvailability (bupLocal buprepo) buprepo+			else checkPathAvailability (bupLocal buprepo) (toOsPath buprepo) 		, readonly = False 		, appendonly = False 		, untrustworthy = False@@ -270,7 +269,7 @@ 	(sshcmd, sshparams) <- Ssh.toRepo NoConsumeStdin r c remotecmd 	liftIO $ runner sshcmd sshparams   where-	path = fromRawFilePath $ Git.repoPath r+	path = fromOsPath $ Git.repoPath r 	base = fromMaybe path (stripPrefix "/~/" path) 	dir = shellEscape base @@ -299,11 +298,11 @@ bup2GitRemote "" = do 	-- bup -r "" operates on ~/.bup 	h <- myHomeDir-	Git.Construct.fromPath $ toRawFilePath $ h </> ".bup"+	Git.Construct.fromPath $ toOsPath h </> literalOsPath ".bup" bup2GitRemote r 	| bupLocal r =  		if "/" `isPrefixOf` r-			then Git.Construct.fromPath (toRawFilePath r)+			then Git.Construct.fromPath (toOsPath r) 			else giveup "please specify an absolute path" 	| otherwise = Git.Construct.fromUrl $ "ssh://" ++ host ++ slash dir   where@@ -335,10 +334,10 @@ lockBup :: Bool -> Remote -> Annex a -> Annex a lockBup writer r a = do 	dir <- fromRepo gitAnnexRemotesDir-	unlessM (liftIO $ doesDirectoryExist (fromRawFilePath dir)) $+	unlessM (liftIO $ doesDirectoryExist dir) $ 		createAnnexDirectory dir 	let remoteid = fromUUID (uuid r)-	let lck = dir P.</> remoteid <> ".lck"+	let lck = dir </> remoteid <> literalOsPath ".lck" 	if writer 		then withExclusiveLock lck a 		else withSharedLock lck a
+ Remote/Compute.hs view
@@ -0,0 +1,855 @@+{- Compute remote.+ -+ - Copyright 2025 Joey Hess <id@joeyh.name>+ -+ - Licensed under the GNU AGPL version 3 or higher.+ -}++{-# LANGUAGE OverloadedStrings #-}++module Remote.Compute (+	remote,+	isComputeRemote,+	ComputeState(..),+	setComputeState,+	getComputeState,+	computeStateUrl,+	ComputeProgram,+	getComputeProgram,+	runComputeProgram,+	ImmutableState(..),+	ComputeProgramResult(..),+	computationBehaviorChangeError,+	defaultComputeParams,+) where++import Annex.Common+import qualified Annex+import Types.Remote+import Types.ProposedAccepted+import Types.MetaData+import Types.Creds+import Types.TrustLevel+import Types.RemoteState+import Config+import Config.Cost+import Remote.Helper.Special+import Remote.Helper.ExportImport+import Remote.List.Util+import Annex.SpecialRemote.Config+import Annex.UUID+import Annex.Content+import Annex.Tmp+import Annex.GitShaKey+import Annex.CatFile+import Annex.RepoSize.LiveUpdate+import qualified Annex.Transfer+import Logs.MetaData+import Logs.EquivilantKeys+import Logs.Location+import Logs.Trust.Basic+import Logs.Remote+import Messages.Progress+import Utility.Metered+import Utility.TimeStamp+import Utility.Env+import Utility.Tmp.Dir+import Utility.Url+import Utility.MonotonicClock+import Utility.CopyFile+import Types.Key+import Backend+import qualified Git+import qualified Utility.OsString as OS+import qualified Utility.FileIO as F+import qualified Utility.RawFilePath as R+import qualified Utility.SimpleProtocol as Proto++import Network.HTTP.Types.URI+import Data.Time.Clock+import Text.Read+import Control.Concurrent.STM+import Control.Concurrent.Async+import System.PosixCompat.Files (isRegularFile)+import qualified Data.Map as M+import qualified Data.Set as S+import qualified Data.ByteString as B+import qualified Data.Text as T+import qualified Data.Text.Encoding as T++remote :: RemoteType+remote = RemoteType+	{ typename = "compute"+	, enumerate = const $ findSpecialRemotes "compute"+	, generate = gen+	, configParser = computeConfigParser+	, setup = setupInstance+	, exportSupported = exportUnsupported+	, importSupported = importUnsupported+	, thirdPartyPopulated = False+	}++isComputeRemote :: Remote -> Bool+isComputeRemote r = typename (remotetype r) == typename remote++isComputeRemote' :: RemoteConfig -> Bool+isComputeRemote' rc = case M.lookup typeField rc of+	Nothing -> False+	Just t -> fromProposedAccepted t == typename remote++gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> RemoteStateHandle -> Annex (Maybe Remote)+gen r u rc gc rs = case getComputeProgram' rc of+	Left _err -> return Nothing+	Right program -> do+		c <- parsedRemoteConfig remote rc+		cst <- remoteCost gc c veryExpensiveRemoteCost+		return $ Just $ mk program c cst+  where+	mk program c cst = Remote+		{ uuid = u+		, cost = cst+		, name = Git.repoDescribe r+		, storeKey = storeKeyUnsupported+ 		, retrieveKeyFile = computeKey rs program+		, retrieveKeyFileInOrder = pure True+		, retrieveKeyFileCheap = Nothing+		, retrievalSecurityPolicy = RetrievalAllKeysSecure+		, removeKey = dropKey rs+		, lockContent = Nothing+		, checkPresent = checkKey rs+		, checkPresentCheap = False+		, exportActions = exportUnsupported+		, importActions = importUnsupported+		, whereisKey = Nothing+		, remoteFsck = Nothing+		, repairRepo = Nothing+		, config = c+		, gitconfig = gc+		, localpath = Nothing+		, getRepo = return r+		, readonly = True+		, appendonly = False+		, untrustworthy = False+		, availability = pure LocallyAvailable+		, remotetype = remote+		, mkUnavailable = return Nothing+		, getInfo = return []+		, claimUrl = Nothing+		, checkUrl = Nothing+		, remoteStateHandle = rs+		}++setupInstance :: SetupStage -> Maybe UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, UUID)+setupInstance ss mu _ c _ = do+	ComputeProgram program <- either giveup return $ getComputeProgram' c+	allowedprograms <- maybe [] words . annexAllowedComputePrograms+		<$> Annex.getGitConfig+	case ss of+		Init -> noop+		_ -> unless (program `elem` allowedprograms) $ do+			let remotename = fromMaybe "(unknown)" (lookupName c)+			giveup $ unwords+				[ "Unable to enable compute special remote"+				, remotename+				, "because its compute program"+				, program+				, "is not listed in annex.security-allowed-compute-programs"+				]+	unlessM (liftIO $ inSearchPath program) $+		giveup $ "Cannot find " ++ program ++ " in PATH"+	u <- maybe (liftIO genUUID) return mu+	gitConfigSpecialRemote u c [("compute", "true")]+	return (c, u)++computeConfigParser :: RemoteConfig -> Annex RemoteConfigParser+computeConfigParser _ = return $ RemoteConfigParser+	{ remoteConfigFieldParsers = +		[ optionalStringParser programField+			(FieldDesc $ "compute program (must start with \"" ++ safetyPrefix ++ "\")")+		]+	-- Pass through all other params, which git-annex addcomputed adds+	-- to the input params.+	, remoteConfigRestPassthrough = Just+		( const True+		, [("*", FieldDesc "all other parameters are passed to compute program")]+		)+	}++defaultComputeParams :: Remote -> [String]+defaultComputeParams = map mk . M.toList . getRemoteConfigPassedThrough . config+  where+	mk (f, v) = fromProposedAccepted f ++ '=' : v++newtype ComputeProgram = ComputeProgram String+	deriving (Show)++getComputeProgram :: Remote -> Annex ComputeProgram+getComputeProgram r = +	case getComputeProgram' (unparsedRemoteConfig (config r)) of+		Right program -> return program+		Left err -> giveup $ +			"Problem with the configuration of compute remote " ++ name r ++ ": " ++ err++getComputeProgram' :: RemoteConfig -> Either String ComputeProgram+getComputeProgram' c = case fromProposedAccepted <$> M.lookup programField c of+	Just program+		| safetyPrefix `isPrefixOf` program ->+			Right (ComputeProgram program)+		| otherwise -> Left $+			"The program's name must begin with \"" ++ safetyPrefix ++ "\""+	Nothing -> Left "Specify program="++-- Limiting the program to "git-annex-compute-" prefix is important for+-- security, it prevents autoenabled compute remotes from running arbitrary+-- programs.+safetyPrefix :: String+safetyPrefix = "git-annex-compute-"++programField :: RemoteConfigField+programField = Accepted "program"++data ProcessCommand+	= ProcessInput FilePath+	| ProcessOutput FilePath+	| ProcessProgress PercentFloat+	| ProcessReproducible+	| ProcessSandbox+	| ProcessInputRequired FilePath+	deriving (Show, Eq)++instance Proto.Receivable ProcessCommand where+	parseCommand "INPUT" = Proto.parse1 ProcessInput+	parseCommand "OUTPUT" = Proto.parse1 ProcessOutput+	parseCommand "PROGRESS" = Proto.parse1 ProcessProgress+	parseCommand "REPRODUCIBLE" = Proto.parse0 ProcessReproducible+	parseCommand "SANDBOX" = Proto.parse0 ProcessSandbox+	parseCommand "INPUT-REQUIRED" = Proto.parse1 ProcessInputRequired+	parseCommand _ = Proto.parseFail++newtype PercentFloat = PercentFloat Float+	deriving (Show, Eq)++instance Proto.Serializable PercentFloat where+	serialize (PercentFloat p) = show p ++ "%"+	deserialize s = do+		s' <- reverse <$> stripPrefix "%" (reverse s)+		PercentFloat <$> readMaybe s'++data ComputeState = ComputeState+	{ computeParams :: [String]+	, computeInputs :: M.Map OsPath Key+	, computeOutputs :: M.Map OsPath (Maybe Key)+	, computeSubdir :: OsPath+	}+	deriving (Show, Eq)++{- Formats a ComputeState as an URL query string.+ -+ - Prefixes computeParams with 'p', computeInputs with 'i',+ - and computeOutputs with 'o'. Uses "d" for computeSubdir.+ -+ - When the passed Key is an output, rather than duplicate it+ - in the query string, that output has no value.+ -+ - Example: "psomefile&pdestfile&pbaz&isomefile=WORM--foo&odestfile=&d=subdir"+ -+ - The computeParams are in the order they were given. The computeInputs+ - and computeOutputs are sorted in ascending order for stability.+ -}+formatComputeState :: Key -> ComputeState -> B.ByteString+formatComputeState k = formatComputeState' (Just k)++formatComputeState' :: Maybe Key -> ComputeState -> B.ByteString+formatComputeState' mk st = renderQuery False $ concat+	[ map formatparam (computeParams st)+	, map formatinput (M.toAscList (computeInputs st))+	, mapMaybe formatoutput (M.toAscList (computeOutputs st))+	, [("d", Just (fromOsPath (computeSubdir st)))]+	]+  where+	formatparam p = ("p" <> encodeBS p, Nothing)+	formatinput (file, key) =+		("i" <> fromOsPath file, Just (serializeKey' key))+	formatoutput (file, (Just key)) = Just $+		("o" <> fromOsPath file,+			if Just key == mk+				then Nothing+				else Just (serializeKey' key)+		)+	formatoutput (_, Nothing) = Nothing++parseComputeState :: Key -> B.ByteString -> Maybe ComputeState+parseComputeState k b =+	let st = go emptycomputestate (parseQuery b)+	in if st == emptycomputestate || illegalComputeState st+		then Nothing+		else Just st+  where+	emptycomputestate = ComputeState +		{ computeParams = mempty+		, computeInputs = mempty+		, computeOutputs = mempty+		, computeSubdir = literalOsPath "."+		}+	+	go :: ComputeState -> [QueryItem] -> ComputeState+	go c [] = c { computeParams = reverse (computeParams c) }+	go c ((f, v):rest) = +		let c' = fromMaybe c $ case decodeBS f of+			('p':p) -> Just $ c+				{ computeParams = p : computeParams c+				}+			('i':i) -> do+				key <- deserializeKey' =<< v+				Just $ c+					{ computeInputs = +						M.insert (toOsPath i) key+							(computeInputs c)+					}+			('o':o) -> case v of+				Just kv -> do+					key <- deserializeKey' kv+					Just $ c+						{ computeOutputs =+							M.insert (toOsPath o)+								(Just key)+								(computeOutputs c)+						}+				Nothing -> Just $ c+					{ computeOutputs = +						M.insert (toOsPath o)+							(Just k)+							(computeOutputs c)+					}+			('d':[]) -> do+				subdir <- v+				Just $ c+					{ computeSubdir = toOsPath subdir+					}+			_ -> Nothing+		in go c' rest++{- This is used to avoid ComputeStates that should never happen,+ - but which could be injected into a repository by an attacker. -}+illegalComputeState :: ComputeState -> Bool+illegalComputeState st+	-- The protocol is line-based, so filenames used in it cannot+	-- contain newlines.+	| any containsnewline (M.keys (computeInputs st)) = True+	| any containsnewline (M.keys (computeOutputs st)) = True+	-- Just in case.+	| containsnewline (computeSubdir st) = True+	| otherwise = False+  where+	containsnewline p = unsafeFromChar '\n' `OS.elem` p++{- A compute: url for a given output file of a computation. -}+computeStateUrl :: Remote -> ComputeState -> OsPath -> URLString+computeStateUrl r st p = +	"annex-compute:" ++ fromUUID (uuid r) ++ "/" ++ fromOsPath p ++ "?" +		++ decodeBS (formatComputeState' Nothing st')+  where+	-- Omit computeOutputs, so this gives the same result whether+	-- it's called on a ComputeState with the computeOutputs +	-- Keys populated or not.+	st' = st { computeOutputs = mempty }++{- The per remote metadata is used to store ComputeState. This allows+ - recording multiple ComputeStates that generate the same key.+ -+ - The metadata fields are numbers (prefixed with "t" to make them legal+ - field names), which are estimates of how long it might take to run+ - the computation (in seconds).+ -+ - Avoids redundantly recording a ComputeState when the per remote metadata+ - already contains it.+ -}+setComputeState :: RemoteStateHandle -> Key -> NominalDiffTime -> ComputeState -> Annex ()+setComputeState rs k ts st = do+	l <- map snd <$> getComputeStatesUnsorted rs k+	unless (st `elem` l) go+  where+	go = addRemoteMetaData k rs $ MetaData $ M.singleton+		(mkMetaFieldUnchecked $ T.pack ('t':show (truncateResolution 1 ts)))+		(S.singleton (MetaValue (CurrentlySet True) (formatComputeState k st)))++{- When multiple ComputeStates have been recorded for the same key,+ - this returns one that is probably less expensive to compute,+ - based on the original time it took to compute it. -}+getComputeState :: RemoteStateHandle -> Key -> Annex (Maybe ComputeState)+getComputeState rs k = headMaybe . map snd . sortOn fst+	<$> getComputeStatesUnsorted rs k++getComputeStatesUnsorted :: RemoteStateHandle -> Key -> Annex [(NominalDiffTime, ComputeState)]+getComputeStatesUnsorted rs k = do+	RemoteMetaData _ (MetaData m) <- getCurrentRemoteMetaData rs k+	return $ go [] (M.toList m)+  where+	go c [] = concat c+	go c ((f, s) : rest) =+		let sts = mapMaybe (parseComputeState k . fromMetaValue)+			(S.toList s)+		in case parsePOSIXTime (T.encodeUtf8 (T.drop 1 (fromMetaField f))) of+			Just ts -> go (zip (repeat ts) sts : c) rest+			Nothing -> go c rest++computeProgramEnvironment :: ComputeState -> Annex [(String, String)]+computeProgramEnvironment st = do+	environ <- filter (caninherit . fst) <$> liftIO getEnvironment+	let addenv = mapMaybe go (computeParams st)+	return $ environ ++ addenv+  where+	envprefix = "ANNEX_COMPUTE_"+	caninherit v = not (envprefix `isPrefixOf` v)+	go p+		| '=' `elem` p =+			let (f, v) = separate (== '=') p+			in Just (envprefix ++ f, v)+		| otherwise = Nothing++newtype ImmutableState = ImmutableState Bool++data ComputeProgramResult = ComputeProgramResult+	{ computeState :: ComputeState+	, computeInputsUnavailable :: Bool+	, computeReproducible :: Bool+	, computeSandbox :: Bool+	}++runComputeProgram+	:: ComputeProgram+	-> ComputeState+	-> ImmutableState+	-> (OsPath -> Bool -> Annex (Key, Maybe (Either Git.Sha OsPath)))+	-- ^ Get input file's content, or Nothing the input file's+	-- content is not available. True is passed when the input content+	-- is required even for addcomputed --fast.+	-> Maybe (Key, MeterUpdate)+	-- ^ update meter for this key+	-> (ComputeProgramResult -> OsPath -> NominalDiffTime -> Annex v)+	-> Annex v+runComputeProgram (ComputeProgram program) state (ImmutableState immutablestate) getinputcontent meterkey cont =+	withOtherTmp $ \othertmpdir ->+		withTmpDirIn othertmpdir (literalOsPath "compute") go+  where+	go tmpdir = do+		environ <- computeProgramEnvironment state+		subdir <- liftIO $ getsubdir tmpdir+		let pr = (proc program (computeParams state))+			 { cwd = Just (fromOsPath subdir)+			 , std_in = CreatePipe+			 , std_out = CreatePipe+			 , env = Just environ+			 }+		showOutput+		starttime <- liftIO currentMonotonicTimestamp+		let startresult = ComputeProgramResult state False False False+		result <- withmeterfile $ \meterfile -> +			bracket+				(liftIO $ createProcess pr)+				(liftIO . cleanupProcess) $ \p -> +					withoutputv p $+						getinput tmpdir subdir startresult meterfile p+		endtime <- liftIO currentMonotonicTimestamp+		liftIO $ checkoutputs result subdir+		cont result subdir (calcduration starttime endtime)+		+	getsubdir tmpdir = do+		let subdir = tmpdir </> computeSubdir state+		ifM (dirContains <$> absPath tmpdir <*> absPath subdir)+			( do+				createDirectoryIfMissing True subdir+				return subdir+			-- Ignore unsafe value in state.+			, return tmpdir+			)+	+	getinput tmpdir subdir result meterfile p outputv = +		liftIO (hGetLineUntilExitOrEOF (processHandle p) (stdoutHandle p)) >>= \case+			Just l+				| null l -> getinput tmpdir subdir result meterfile p outputv+				| otherwise -> do+					fastDebug "Compute" ("< " ++ l)+					result' <- parseoutput outputv tmpdir subdir result meterfile l+					getinput tmpdir subdir result' meterfile p outputv+			Nothing -> do+				liftIO $ hClose (stdoutHandle p)+				liftIO $ hClose (stdinHandle p)+				unlessM (liftIO $ checkSuccessProcess (processHandle p)) $+					giveup $ program ++ " exited unsuccessfully"+				return result+	+	parseoutput outputv tmpdir subdir result meterfile l = case Proto.parseMessage l of+		Just (ProcessInput f) -> handleinput f False outputv tmpdir subdir result+		Just (ProcessInputRequired f) -> handleinput f True outputv tmpdir subdir result+		Just (ProcessOutput f) -> do+			let f' = toOsPath f+			checksafefile tmpdir subdir f' "output"+			-- Modify filename so eg "-foo" becomes "./-foo"+			sendresponse outputv $ toCommand' (File f)+			-- If the output file is in a subdirectory, make+			-- the directories so the compute program doesn't+			-- need to.+			liftIO $ createDirectoryIfMissing True $ +				takeDirectory (subdir </> f')+			knownoutput <- case M.lookup f' (computeOutputs $ computeState result) of+				Nothing -> return False+				Just mk -> do+					when (mk == fmap fst meterkey) $+						meterfile (subdir </> f')+					return True+			checkimmutable knownoutput "outputting" f' $ +				return $ if immutablestate+					then result+					else modresultstate result $ \s -> s+						{ computeOutputs = +							M.insert f' Nothing+								(computeOutputs s)+							}+		Just (ProcessProgress percent) -> do+			liftIO $ updatepercent percent+			return result+		Just ProcessReproducible ->+			return $ result { computeReproducible = True }+		Just ProcessSandbox -> do+			sandboxpath <- liftIO $ fromOsPath <$>+				relPathDirToFile subdir tmpdir+			sendresponse outputv $+				if null sandboxpath+					then "."+					else sandboxpath+			return $ result { computeSandbox = True }+		Nothing -> giveup $+			program ++ " output an unparseable line: \"" ++ l ++ "\""++	handleinput f required outputv tmpdir subdir result = do+		let f' = toOsPath f+		let knowninput = M.member f'+			(computeInputs (computeState result))+		checksafefile tmpdir subdir f' "input"+		checkimmutable knowninput "inputting" f' $ do+			(k, inputcontent) <- getinputcontent f' required+			let mkrel a = Just <$> +				(a >>= liftIO . relPathDirToFile subdir)+			mp <- case inputcontent of+				Nothing -> pure Nothing+				Just (Right obj)+					| computeSandbox result -> +						mkrel $ populatesandbox obj tmpdir+					| otherwise ->+						mkrel $ pure obj+				Just (Left gitsha) -> +					mkrel $ populategitsha gitsha tmpdir+			sendresponse outputv $+				maybe "" fromOsPath mp+			let result' = result+				{ computeInputsUnavailable = +					isNothing mp || computeInputsUnavailable result+				}+			return $ if immutablestate+				then result'+				else modresultstate result' $ \s -> s+					{ computeInputs = +						M.insert f' k+							(computeInputs s)+					}++	modresultstate result f = +		result { computeState = f (computeState result) }++	checksafefile tmpdir subdir f fileaction = do+		let err problem = giveup $+			program ++ " tried to " ++ fileaction ++ " a file that is " ++ problem ++ ": " ++ fromOsPath f+		unlessM (liftIO $ dirContains <$> absPath tmpdir <*> absPath (subdir </> f)) $+			err "outside the git repository"+		when (any (\p -> dropTrailingPathSeparator p == literalOsPath ".git") (splitPath f)) $+			err "inside the .git directory"++	-- Disallow any output files that are not regular files.+	-- This supports compute programs that run code in a sandboxed+	-- environment, which might let it eg make a symlink or device+	-- file that when read as an output file would expose data that+	-- the sandboxed code was not allowed to access itself.+	checkoutputs result subdir = +		forM_ (M.keys $ computeOutputs $ computeState result) $ \f ->+			let f' = subdir </> f+			in tryIO (R.getSymbolicLinkStatus (fromOsPath f')) >>= \case+				Right st | not (isRegularFile st) ->+					giveup $ program ++ " output file " ++ fromOsPath f ++ " is not a regular file, refusing to use it"+				_ -> noop++	checkimmutable True _ _ a = a+	checkimmutable False requestdesc p a+		| not immutablestate = a+		| otherwise = computationBehaviorChangeError (ComputeProgram program) requestdesc p+	+	calcduration (MonotonicTimestamp starttime) (MonotonicTimestamp endtime) =+		fromIntegral (endtime - starttime) :: NominalDiffTime++	-- Writes to a .git/objects/ file in the tmpdir, rather than+	-- using the input filename, to avoid exposing the input filename+	-- to the program as a parameter, which could parse it as a dashed+	-- option or other special parameter.+	populategitsha gitsha tmpdir = do+		let f = tmpdir </> literalOsPath ".git"+			</> literalOsPath "objects"+			</> toOsPath (Git.fromRef' gitsha)+		liftIO $ createDirectoryIfMissing True $ takeDirectory f+		liftIO . F.writeFile f =<< catObject gitsha+		return f++	populatesandbox annexobj tmpdir = do+		let f = tmpdir </> literalOsPath ".git"+			</> literalOsPath "annex"+			</> literalOsPath "objects"+			</> takeFileName annexobj+		liftIO $ createDirectoryIfMissing True $ takeDirectory f+		liftIO $ unlessM (createLinkOrCopy annexobj f) $+			giveup "Unable to populate compute sandbox directory"+		return f++	withmeterfile a = case meterkey of+		Nothing -> a (const noop)+		Just (_, progress) -> do+			filev <- liftIO newEmptyTMVarIO+			endv <- liftIO $ newEmptyTMVarIO+			let meterfile = void . liftIO +				. atomically . tryPutTMVar filev+			let endmeterfile = atomically $ putTMVar endv ()+			tid <- liftIO $ async $ do+				v <- liftIO $ atomically $ +					(Right <$> takeTMVar filev)+						`orElse`+					(Left <$> takeTMVar endv)+				case v of+					Right f -> watchFileSize f progress $ \_ ->+						void $ liftIO $ atomically $+							takeTMVar endv+					Left () -> return ()+			a meterfile +				`finally` liftIO (endmeterfile >> wait tid)+			+	updatepercent (PercentFloat percent) = case meterkey of+		Nothing -> noop+		Just (k, progress) -> case fromKey keySize k of+			Nothing -> noop+			Just sz ->+				progress $ BytesProcessed $ floor $ +					fromIntegral sz * percent / 100+	+	withoutputv p a = do+		outputv <- liftIO $ atomically newTQueue+		let cleanup pid = do+			atomically $ writeTQueue outputv Nothing+			wait pid+		bracket +			(liftIO $ async $ sendoutput' p outputv)+			(liftIO . cleanup)+			(const $ a outputv)++	sendoutput' p outputv =+		atomically (readTQueue outputv) >>= \case+			Nothing -> return ()+			Just s -> do+				liftIO $ hPutStrLn (stdinHandle p) s+				liftIO $ hFlush (stdinHandle p)+				sendoutput' p outputv++	sendresponse outputv s = do+		fastDebug "Compute" ("> " ++ s)+		liftIO $ atomically $ writeTQueue outputv (Just s)++computationBehaviorChangeError :: ComputeProgram -> String -> OsPath -> Annex a+computationBehaviorChangeError (ComputeProgram program) requestdesc p =+	giveup $ program ++ " is not behaving the same way it used to, now " ++ requestdesc ++ ": " ++ fromOsPath p++computeKey :: RemoteStateHandle -> ComputeProgram -> Key -> AssociatedFile -> OsPath -> MeterUpdate -> VerifyConfig -> Annex Verification+computeKey rs (ComputeProgram program) k _af dest meterupdate vc =+	getComputeState rs k >>= \case+		Just state ->+			case computeskey state of+				Just keyfile -> go state keyfile+				Nothing -> missingstate+		Nothing -> missingstate+  where+	missingstate = giveup "Missing compute state"++	go state keyfile = metered (Just meterupdate) k Nothing $ \_ p ->+		runComputeProgram (ComputeProgram program) state+			(ImmutableState True)+			(getinputcontent state)+			(Just (k, p))+			(postcompute keyfile)++	getinputcontent state f _required =+		case M.lookup f (computeInputs state) of+			Just inputkey -> case keyGitSha inputkey of+				Nothing -> +					let retkey = do+						obj <- calcRepo (gitAnnexLocation inputkey)+						return (inputkey, Just (Right obj))+					in ifM (inAnnex inputkey)+						( retkey+						, ifM (getinputcontent' f inputkey)+							( retkey+							, return (inputkey, Nothing)+							)+						)+				Just gitsha ->+					return (inputkey, Just (Left gitsha))+			Nothing -> error "internal"+	+	getinputcontent' f inputkey = do+		remotes <- avoidCycles [k] inputkey+			=<< keyPossibilities inputkey+		anyM (getinputcontentfrom f inputkey) remotes+	+	getinputcontentfrom f inputkey r = do+		showAction $ "getting input " <> QuotedPath f+			<> " from " <> UnquotedString (name r)+		lu <- prepareLiveUpdate Nothing inputkey AddingKey+		logStatusAfter lu inputkey $+			Annex.Transfer.download r inputkey (AssociatedFile (Just f))+				Annex.Transfer.stdRetry Annex.Transfer.noNotification++	computeskey state = +		case M.keys $ M.filter (== Just k) (computeOutputs state) of+			(keyfile : _) -> Just keyfile+			[] -> Nothing++	postcompute keyfile result tmpdir _ts+		| computeInputsUnavailable result = +			giveup "Input file(s) unavailable."+		| otherwise =+			postcompute' keyfile (computeState result) tmpdir++	postcompute' keyfile state tmpdir = do+		hb <- hashBackend+		let updatevurl key getobj = +			if (fromKey keyVariety key == VURLKey)+				then addEquivilantKey hb key =<< getobj+				else return Nothing++		let keyfile' = tmpdir </> keyfile+		unlessM (liftIO $ doesFileExist keyfile') $+			giveup $ program ++ " exited sucessfully, but failed to write the computed file"+		catchNonAsync (liftIO $ moveFile keyfile' dest)+			(\err -> giveup $ "failed to move the computed file: " ++ show err)+		mverification <- updatevurl k (pure dest)++		-- Try to move any other computed object files into the annex.+		forM_ (M.toList $ computeOutputs state) $ \case+			(file, (Just key)) ->+				when (k /= key) $ do+					let file' = tmpdir </> file+					whenM (liftIO $ doesFileExist file') $ do+						whenM (verifyKeyContentPostRetrieval RetrievalAllKeysSecure vc MustVerify key file') $ do+							moved <- moveAnnex key file' `catchNonAsync` const (pure False)+							when moved $+								void $ updatevurl key (calcRepo (gitAnnexLocation key))+			_ -> noop++		-- The program might not be reproducible,+		-- so require strong verification.+		return $ fromMaybe MustVerify mverification+		+keyPossibilities :: Key -> Annex [Remote]+keyPossibilities key = do+	-- This gets populated with a list of all remotes before this+	-- remote is used.+	remotelist <- Annex.getState Annex.remotes+	locs <- loggedLocations key+	keyPossibilities' (IncludeIgnored False) key locs remotelist++{- Filter out any remotes that, in order to compute the inputkey, would+ - need to get the outputkey from some remote.+ -+ - This only finds cycles of compute special remotes, not any other+ - similar type of special remote that might have its own input keys.+ - There are no other such special remotes in git-annex itself, so this+ - is the best that can be done.+ -+ - Note that, in a case where a compute special remote needs the outputkey+ - to compute the inputkey, but could get the outputkey from either this+ - remote, or some other, non-compute remote, that is filtered out as a+ - cycle because it's not possible to prevent that remote getting from this+ - remote.+ -}+avoidCycles :: [Key] -> Key -> [Remote] -> Annex [Remote]+avoidCycles outputkeys inputkey = filterM go+  where+	go r+		| iscomputeremote r = +			getComputeState (remoteStateHandle r) inputkey >>= \case+				Nothing -> return True+				Just state+					| inputsoutput state -> return False+					| otherwise -> checkdeeper state+		| otherwise = return True+	+	iscomputeremote r = remotetype r == remote++	inputsoutput state = not $ M.null $+		M.filter (`elem` outputkeys)+			(computeInputs state)+	+	checkdeeper state =+		flip allM (M.elems (computeInputs state)) $ \inputkey' -> do+			rs <- keyPossibilities inputkey'+			rs' <- avoidCycles (inputkey:outputkeys) inputkey' rs+			return (rs' == rs)++-- Make sure that the compute state exists, and that the input keys are+-- still available (are not dead, and are stored in some repository).+--+-- When an input key is itself stored in a compute remote, check that+-- its inputs are also still available.+checkKey :: RemoteStateHandle -> Key -> Annex Bool+checkKey rs k = do+	deadset <- getdeadset+	computeset <- getcomputeset+	availablecompute [] deadset computeset k rs+  where+	getdeadset = do+		-- Usually this will already be populated with all remotes,+		-- otherwise this compute remote would not be used. Check+		-- just in case, to avoid trustMap' caching bad inputs.+		remotelist <- Annex.getState Annex.remotes+		if null remotelist+			then error "internal"+			else S.fromList . M.keys . M.filter (== DeadTrusted)+				<$> trustMap' remotelist++	getcomputeset = S.fromList . M.keys . M.filter isComputeRemote'+		<$> remoteConfigMap++	availablecompute inputkeys deadset computeset k' rs'+		| k' `elem` inputkeys = return False -- avoid cycles+		| otherwise = +			anyM (hasinputs inputkeys deadset computeset . snd)+				=<< getComputeStatesUnsorted rs' k'++	hasinputs inputkeys deadset computeset state = do+		let ks = M.elems (computeInputs state)+		ifM (anyM checkDead ks)+			( return False+			, allM (available inputkeys deadset computeset) ks+			)+	+	available inputkeys deadset computeset k' = do+		(repolocs, computelocs) <- +			partition (flip S.notMember computeset)+				. filter (flip S.notMember deadset)+				<$> loggedLocations k'+		if not (null repolocs)+			then return True+			else anyM (availablecompute (k':inputkeys) deadset computeset k' . RemoteStateHandle) computelocs++-- Unsetting the compute state will prevent computing the key.+dropKey :: RemoteStateHandle -> Maybe SafeDropProof -> Key -> Annex ()+dropKey rs _ k = do+	RemoteMetaData _ old <- getCurrentRemoteMetaData rs k+	addRemoteMetaData k rs (modMeta old DelAllMeta)++storeKeyUnsupported :: Key -> AssociatedFile -> Maybe OsPath -> MeterUpdate -> Annex ()+storeKeyUnsupported _ _ _ _ = giveup "transfer to compute remote not supported; use git-annex addcomputed instead"
Remote/Ddar.hs view
@@ -97,12 +97,12 @@ 		, getRepo = return r 		, gitconfig = gc 		, localpath = if ddarLocal ddarrepo && not (null $ ddarRepoLocation ddarrepo)-			then Just $ ddarRepoLocation ddarrepo+			then Just $ toOsPath $ ddarRepoLocation ddarrepo 			else Nothing 		, remotetype = remote 		, availability = checkPathAvailability 			(ddarLocal ddarrepo && not (null $ ddarRepoLocation ddarrepo))-			(ddarRepoLocation ddarrepo)+			(toOsPath (ddarRepoLocation ddarrepo)) 		, readonly = False 		, appendonly = False 		, untrustworthy = False@@ -136,7 +136,7 @@ 		, Param "-N" 		, Param $ serializeKey k 		, Param $ ddarRepoLocation ddarrepo-		, File src+		, File $ fromOsPath src 		] 	unlessM (liftIO $ boolSystem "ddar" params) $ 		giveup "ddar failed"
Remote/Directory.hs view
@@ -15,10 +15,8 @@ 	removeDirGeneric, ) where -import qualified Data.ByteString.Lazy as L import qualified Data.Map as M import qualified Data.List.NonEmpty as NE-import qualified System.FilePath.ByteString as P import Data.Default import System.PosixCompat.Files (isRegularFile, deviceID) #ifndef mingw32_HOST_OS@@ -52,6 +50,7 @@ import Utility.FileMode import Utility.Directory.Create import qualified Utility.RawFilePath as R+import qualified Utility.FileIO as F #ifndef mingw32_HOST_OS import Utility.OpenFd #endif@@ -132,11 +131,11 @@ 			, config = c 			, getRepo = return r 			, gitconfig = gc-			, localpath = Just dir'+			, localpath = Just dir 			, readonly = False 			, appendonly = False 			, untrustworthy = False-			, availability = checkPathAvailability True dir'+			, availability = checkPathAvailability True dir 			, remotetype = remote 			, mkUnavailable = gen r u rc 				(gc { remoteAnnexDirectory = Just "/dev/null" }) rs@@ -146,8 +145,9 @@ 			, remoteStateHandle = rs 			}   where-	dir = toRawFilePath dir'-	dir' = fromMaybe (giveup "missing directory") (remoteAnnexDirectory gc)+	dir = toOsPath dir'+	dir' = fromMaybe (giveup "missing directory")+		(remoteAnnexDirectory gc)  directorySetup :: SetupStage -> Maybe UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, UUID) directorySetup _ mu _ c gc = do@@ -155,43 +155,41 @@ 	-- verify configuration is sane 	let dir = maybe (giveup "Specify directory=") fromProposedAccepted $ 		M.lookup directoryField c-	absdir <- liftIO $ fromRawFilePath <$> absPath (toRawFilePath dir)+	absdir <- liftIO $ absPath (toOsPath dir) 	liftIO $ unlessM (doesDirectoryExist absdir) $-		giveup $ "Directory does not exist: " ++ absdir+		giveup $ "Directory does not exist: " ++ fromOsPath absdir 	(c', _encsetup) <- encryptionSetup c gc  	-- The directory is stored in git config, not in this remote's 	-- persistent state, so it can vary between hosts.-	gitConfigSpecialRemote u c' [("directory", absdir)]+	gitConfigSpecialRemote u c' [("directory", fromOsPath absdir)] 	return (M.delete directoryField c', u)  {- Locations to try to access a given Key in the directory.  - We try more than one since we used to write to different hash  - directories. -}-locations :: RawFilePath -> Key -> NE.NonEmpty RawFilePath-locations d k = NE.map (d P.</>) (keyPaths k)+locations :: OsPath -> Key -> NE.NonEmpty OsPath+locations d k = NE.map (d </>) (keyPaths k) -locations' :: RawFilePath -> Key -> [RawFilePath]+locations' :: OsPath -> Key -> [OsPath] locations' d k = NE.toList (locations d k)  {- Returns the location of a Key in the directory. If the key is  - present, returns the location that is actually used, otherwise  - returns the first, default location. -}-getLocation :: RawFilePath -> Key -> IO RawFilePath+getLocation :: OsPath -> Key -> IO OsPath getLocation d k = do 	let locs = locations d k-	fromMaybe (NE.head locs)-		<$> firstM (doesFileExist . fromRawFilePath)-			(NE.toList locs)+	fromMaybe (NE.head locs) <$> firstM doesFileExist (NE.toList locs)  {- Directory where the file(s) for a key are stored. -}-storeDir :: RawFilePath -> Key -> RawFilePath-storeDir d k = P.addTrailingPathSeparator $-	d P.</> hashDirLower def k P.</> keyFile k+storeDir :: OsPath -> Key -> OsPath+storeDir d k = addTrailingPathSeparator $+	d </> hashDirLower def k </> keyFile k  {- Check if there is enough free disk space in the remote's directory to  - store the key. Note that the unencrypted key size is checked. -}-storeKeyM :: RawFilePath -> ChunkConfig -> CopyCoWTried -> Storer+storeKeyM :: OsPath -> ChunkConfig -> CopyCoWTried -> Storer storeKeyM d chunkconfig cow k c m =  	ifM (checkDiskSpaceDirectory d k) 		( do@@ -203,12 +201,12 @@ 	store = case chunkconfig of 		LegacyChunks chunksize ->  			let go _k b p = liftIO $ Legacy.store-				(fromRawFilePath d)+				(fromOsPath d) 				chunksize 				(finalizeStoreGeneric d) 				k b p-				(fromRawFilePath tmpdir)-				(fromRawFilePath destdir)+				(fromOsPath tmpdir)+				(fromOsPath destdir) 			in byteStorer go k c m 		NoChunks -> 			let go _k src p = liftIO $ do@@ -221,63 +219,59 @@ 				finalizeStoreGeneric d tmpdir destdir 			in byteStorer go k c m 	-	tmpdir = P.addTrailingPathSeparator $ d P.</> "tmp" P.</> kf-	tmpf = fromRawFilePath tmpdir </> fromRawFilePath kf+	tmpdir = addTrailingPathSeparator $ d </> literalOsPath "tmp" </> kf+	tmpf = tmpdir </> kf 	kf = keyFile k 	destdir = storeDir d k -checkDiskSpaceDirectory :: RawFilePath -> Key -> Annex Bool+checkDiskSpaceDirectory :: OsPath -> Key -> Annex Bool checkDiskSpaceDirectory d k = do 	annexdir <- fromRepo gitAnnexObjectDir 	samefilesystem <- liftIO $ catchDefaultIO False $  		(\a b -> deviceID a == deviceID b)-			<$> R.getSymbolicLinkStatus d-			<*> R.getSymbolicLinkStatus annexdir+			<$> R.getSymbolicLinkStatus (fromOsPath d)+			<*> R.getSymbolicLinkStatus (fromOsPath annexdir) 	checkDiskSpace Nothing (Just d) k 0 samefilesystem  {- Passed a temp directory that contains the files that should be placed  - in the dest directory, moves it into place. Anything already existing  - in the dest directory will be deleted. File permissions will be locked  - down. -}-finalizeStoreGeneric :: RawFilePath -> RawFilePath -> RawFilePath -> IO ()+finalizeStoreGeneric :: OsPath -> OsPath -> OsPath -> IO () finalizeStoreGeneric d tmp dest = do-	removeDirGeneric False (fromRawFilePath d) dest'+	removeDirGeneric False d dest 	createDirectoryUnder [d] (parentDir dest)-	renameDirectory (fromRawFilePath tmp) dest'+	renameDirectory tmp dest 	-- may fail on some filesystems 	void $ tryIO $ do-		mapM_ (preventWrite . toRawFilePath) =<< dirContents dest'+		mapM_ preventWrite =<< dirContents dest 		preventWrite dest-  where-	dest' = fromRawFilePath dest -retrieveKeyFileM :: RawFilePath -> ChunkConfig -> CopyCoWTried -> Retriever+retrieveKeyFileM :: OsPath -> ChunkConfig -> CopyCoWTried -> Retriever retrieveKeyFileM d (LegacyChunks _) _ = Legacy.retrieve locations' d retrieveKeyFileM d NoChunks cow = fileRetriever' $ \dest k p iv -> do-	src <- liftIO $ fromRawFilePath <$> getLocation d k-	void $ liftIO $ fileCopier cow src (fromRawFilePath dest) p iv+	src <- liftIO $ getLocation d k+	void $ liftIO $ fileCopier cow src dest p iv retrieveKeyFileM d _ _ = byteRetriever $ \k sink ->-	sink =<< liftIO (L.readFile . fromRawFilePath =<< getLocation d k)+	sink =<< liftIO (F.readFile =<< getLocation d k) -retrieveKeyFileCheapM :: RawFilePath -> ChunkConfig -> Maybe (Key -> AssociatedFile -> FilePath -> Annex ())+retrieveKeyFileCheapM :: OsPath -> ChunkConfig -> Maybe (Key -> AssociatedFile -> OsPath -> Annex ()) -- no cheap retrieval possible for chunks retrieveKeyFileCheapM _ (UnpaddedChunks _) = Nothing retrieveKeyFileCheapM _ (LegacyChunks _) = Nothing #ifndef mingw32_HOST_OS retrieveKeyFileCheapM d NoChunks = Just $ \k _af f -> liftIO $ do-	file <- fromRawFilePath <$> (absPath =<< getLocation d k)+	file <- absPath =<< getLocation d k 	ifM (doesFileExist file)-		( R.createSymbolicLink (toRawFilePath file) (toRawFilePath f)+		( R.createSymbolicLink (fromOsPath file) (fromOsPath f) 		, giveup "content file not present in remote" 		) #else retrieveKeyFileCheapM _ _ = Nothing #endif -removeKeyM :: RawFilePath -> Remover-removeKeyM d _proof k = liftIO $ removeDirGeneric True-	(fromRawFilePath d)-	(fromRawFilePath (storeDir d k))+removeKeyM :: OsPath -> Remover+removeKeyM d _proof k = liftIO $ removeDirGeneric True d (storeDir d k)  {- Removes the directory, which must be located under the topdir.  -@@ -293,13 +287,13 @@  - can also be removed. Failure to remove such a directory is not treated  - as an error.  -}-removeDirGeneric :: Bool -> FilePath -> FilePath -> IO ()+removeDirGeneric :: Bool -> OsPath -> OsPath -> IO () removeDirGeneric removeemptyparents topdir dir = do-	void $ tryIO $ allowWrite (toRawFilePath dir)+	void $ tryIO $ allowWrite dir #ifdef mingw32_HOST_OS 	{- Windows needs the files inside the directory to be writable 	 - before it can delete them. -}-	void $ tryIO $ mapM_ (allowWrite . toRawFilePath) =<< dirContents dir+	void $ tryIO $ mapM_ allowWrite =<< dirContents dir #endif 	tryNonAsync (removeDirectoryRecursive dir) >>= \case 		Right () -> return ()@@ -307,95 +301,94 @@ 			unlessM (doesDirectoryExist topdir <&&> (not <$> doesDirectoryExist dir)) $ 				throwM e 	when removeemptyparents $ do-		subdir <- relPathDirToFile (toRawFilePath topdir) (P.takeDirectory (toRawFilePath dir))-		goparents (Just (P.takeDirectory subdir)) (Right ())+		subdir <- relPathDirToFile topdir (takeDirectory dir)+		goparents (Just (takeDirectory subdir)) (Right ())   where 	goparents _ (Left _e) = return () 	goparents Nothing _ = return () 	goparents (Just subdir) _ = do-		let d = topdir </> fromRawFilePath subdir+		let d = topdir </> subdir 		goparents (upFrom subdir) =<< tryIO (removeDirectory d) -checkPresentM :: RawFilePath -> ChunkConfig -> CheckPresent+checkPresentM :: OsPath -> ChunkConfig -> CheckPresent checkPresentM d (LegacyChunks _) k = Legacy.checkKey d locations' k checkPresentM d _ k = checkPresentGeneric d (locations' d k) -checkPresentGeneric :: RawFilePath -> [RawFilePath] -> Annex Bool+checkPresentGeneric :: OsPath -> [OsPath] -> Annex Bool checkPresentGeneric d ps = checkPresentGeneric' d $-	liftIO $ anyM (doesFileExist . fromRawFilePath) ps+	liftIO $ anyM doesFileExist ps -checkPresentGeneric' :: RawFilePath -> Annex Bool -> Annex Bool+checkPresentGeneric' :: OsPath -> Annex Bool -> Annex Bool checkPresentGeneric' d check = ifM check 	( return True-	, ifM (liftIO $ doesDirectoryExist (fromRawFilePath d))+	, ifM (liftIO $ doesDirectoryExist d) 		( return False-		, giveup $ "directory " ++ fromRawFilePath d ++ " is not accessible"+		, giveup $ "directory " ++ fromOsPath d ++ " is not accessible" 		) 	) -storeExportM :: RawFilePath -> CopyCoWTried -> FilePath -> Key -> ExportLocation -> MeterUpdate -> Annex ()+storeExportM :: OsPath -> CopyCoWTried -> OsPath -> Key -> ExportLocation -> MeterUpdate -> Annex () storeExportM d cow src _k loc p = do-	liftIO $ createDirectoryUnder [d] (P.takeDirectory dest)+	liftIO $ createDirectoryUnder [d] (takeDirectory dest) 	-- Write via temp file so that checkPresentGeneric will not 	-- see it until it's fully stored.-	viaTmp go (fromRawFilePath dest) ()+	viaTmp go dest ()   where 	dest = exportPath d loc-	go tmp () = void $ liftIO $ fileCopier cow src tmp p Nothing+	go tmp () = void $ liftIO $+		fileCopier cow src tmp p Nothing -retrieveExportM :: RawFilePath -> CopyCoWTried -> Key -> ExportLocation -> FilePath -> MeterUpdate -> Annex Verification+retrieveExportM :: OsPath -> CopyCoWTried -> Key -> ExportLocation -> OsPath -> MeterUpdate -> Annex Verification retrieveExportM d cow k loc dest p =  	verifyKeyContentIncrementally AlwaysVerify k $ \iv ->  		void $ liftIO $ fileCopier cow src dest p iv   where-	src = fromRawFilePath $ exportPath d loc+	src = exportPath d loc -removeExportM :: RawFilePath -> Key -> ExportLocation -> Annex ()+removeExportM :: OsPath -> Key -> ExportLocation -> Annex () removeExportM d _k loc = liftIO $ do-	removeWhenExistsWith R.removeLink src+	removeWhenExistsWith removeFile src 	removeExportLocation d loc   where 	src = exportPath d loc -checkPresentExportM :: RawFilePath -> Key -> ExportLocation -> Annex Bool+checkPresentExportM :: OsPath -> Key -> ExportLocation -> Annex Bool checkPresentExportM d _k loc = 	checkPresentGeneric d [exportPath d loc] -renameExportM :: RawFilePath -> Key -> ExportLocation -> ExportLocation -> Annex (Maybe ())+renameExportM :: OsPath -> Key -> ExportLocation -> ExportLocation -> Annex (Maybe ()) renameExportM d _k oldloc newloc = liftIO $ do-	createDirectoryUnder [d] (P.takeDirectory dest)-	renameFile (fromRawFilePath src) (fromRawFilePath dest)+	createDirectoryUnder [d] (takeDirectory dest)+	renameFile src dest 	removeExportLocation d oldloc 	return (Just ())   where 	src = exportPath d oldloc 	dest = exportPath d newloc -exportPath :: RawFilePath -> ExportLocation -> RawFilePath-exportPath d loc = d P.</> fromExportLocation loc+exportPath :: OsPath -> ExportLocation -> OsPath+exportPath d loc = d </> fromExportLocation loc  {- Removes the ExportLocation's parent directory and its parents, so long as  - they're empty, up to but not including the topdir. -}-removeExportLocation :: RawFilePath -> ExportLocation -> IO ()+removeExportLocation :: OsPath -> ExportLocation -> IO () removeExportLocation topdir loc = -	go (Just $ P.takeDirectory $ fromExportLocation loc) (Right ())+	go (Just $ takeDirectory $ fromExportLocation loc) (Right ())   where 	go _ (Left _e) = return () 	go Nothing _ = return () 	go (Just loc') _ = -		let p = fromRawFilePath $ exportPath topdir $-			mkExportLocation loc'+		let p = exportPath topdir $ mkExportLocation loc' 		in go (upFrom loc') =<< tryIO (removeDirectory p) -listImportableContentsM :: IgnoreInodes -> RawFilePath -> Annex (Maybe (ImportableContentsChunkable Annex (ContentIdentifier, ByteSize)))+listImportableContentsM :: IgnoreInodes -> OsPath -> Annex (Maybe (ImportableContentsChunkable Annex (ContentIdentifier, ByteSize))) listImportableContentsM ii dir = liftIO $ do-	l <- dirContentsRecursiveSkipping (const False) False (fromRawFilePath dir)-	l' <- mapM (go . toRawFilePath) l+	l' <- mapM go =<< dirContentsRecursiveSkipping (const False) False dir 	return $ Just $ ImportableContentsComplete $ 		ImportableContents (catMaybes l') []   where 	go f = do-		st <- R.getSymbolicLinkStatus f+		st <- R.getSymbolicLinkStatus (fromOsPath f) 		mkContentIdentifier ii f st >>= \case 			Nothing -> return Nothing 			Just cid -> do@@ -409,7 +402,7 @@ -- and also normally the inode, unless ignoreinodes=yes. -- -- If the file is not a regular file, this will return Nothing.-mkContentIdentifier :: IgnoreInodes -> RawFilePath -> FileStatus -> IO (Maybe ContentIdentifier)+mkContentIdentifier :: IgnoreInodes -> OsPath -> FileStatus -> IO (Maybe ContentIdentifier) mkContentIdentifier (IgnoreInodes ii) f st = 	liftIO $ fmap (ContentIdentifier . encodeBS . showInodeCache) 		<$> if ii@@ -435,25 +428,25 @@ 				let ic' = replaceInode 0 ic 				in ContentIdentifier (encodeBS (showInodeCache ic')) -importKeyM :: IgnoreInodes -> RawFilePath -> ExportLocation -> ContentIdentifier -> ByteSize -> MeterUpdate -> Annex (Maybe Key)+importKeyM :: IgnoreInodes -> OsPath -> ExportLocation -> ContentIdentifier -> ByteSize -> MeterUpdate -> Annex (Maybe Key) importKeyM ii dir loc cid sz p = do 	backend <- chooseBackend f 	unsizedk <- fst <$> genKey ks p backend 	let k = alterKey unsizedk $ \kd -> kd 		{ keySize = keySize kd <|> Just sz } 	currcid <- liftIO $ mkContentIdentifier ii absf-		=<< R.getSymbolicLinkStatus absf+		=<< R.getSymbolicLinkStatus (fromOsPath absf) 	guardSameContentIdentifiers (return (Just k)) [cid] currcid   where 	f = fromExportLocation loc-	absf = dir P.</> f+	absf = dir </> f 	ks  = KeySource 		{ keyFilename = f 		, contentLocation = absf 		, inodeCache = Nothing 		} -retrieveExportWithContentIdentifierM :: IgnoreInodes -> RawFilePath -> CopyCoWTried -> ExportLocation -> [ContentIdentifier] -> FilePath -> Either Key (Annex Key) -> MeterUpdate -> Annex (Key, Verification)+retrieveExportWithContentIdentifierM :: IgnoreInodes -> OsPath -> CopyCoWTried -> ExportLocation -> [ContentIdentifier] -> OsPath -> Either Key (Annex Key) -> MeterUpdate -> Annex (Key, Verification) retrieveExportWithContentIdentifierM ii dir cow loc cids dest gk p = 	case gk of 		Right mkkey -> do@@ -465,11 +458,11 @@ 			return (k, v)   where 	f = exportPath dir loc-	f' = fromRawFilePath f-	+	f' = fromOsPath f+ 	go iv = precheck (docopy iv) -	docopy iv = ifM (liftIO $ tryCopyCoW cow f' dest p)+	docopy iv = ifM (liftIO $ tryCopyCoW cow f dest p) 		( postcheckcow (liftIO $ maybe noop unableIncrementalVerifier iv) 		, docopynoncow iv 		)@@ -478,7 +471,7 @@ #ifndef mingw32_HOST_OS 		let open = do 			-- Need a duplicate fd for the post check.-			fd <- openFdWithMode f ReadOnly Nothing defaultFileFlags+			fd <- openFdWithMode f' ReadOnly Nothing defaultFileFlags 			dupfd <- dup fd 			h <- fdToHandle fd 			return (h, dupfd)@@ -487,7 +480,7 @@ 			closeFd dupfd 		bracketIO open close $ \(h, dupfd) -> do #else-		let open = openBinaryFile f' ReadMode+		let open = F.openBinaryFile f ReadMode 		let close = hClose 		bracketIO open close $ \h -> do #endif@@ -502,7 +495,7 @@ 	-- content. 	precheck cont = guardSameContentIdentifiers cont cids 		=<< liftIO . mkContentIdentifier ii f-		=<< liftIO (R.getSymbolicLinkStatus f)+		=<< liftIO (R.getSymbolicLinkStatus f')  	-- Check after copy, in case the file was changed while it was 	-- being copied.@@ -526,7 +519,7 @@ #ifndef mingw32_HOST_OS 			=<< getFdStatus fd #else-			=<< R.getSymbolicLinkStatus f+			=<< R.getSymbolicLinkStatus f' #endif 		guardSameContentIdentifiers cont cids currcid @@ -537,37 +530,37 @@ 	-- restored to the original content before this check. 	postcheckcow cont = do 		currcid <- liftIO $ mkContentIdentifier ii f-			=<< R.getSymbolicLinkStatus f+			=<< R.getSymbolicLinkStatus f' 		guardSameContentIdentifiers cont cids currcid -storeExportWithContentIdentifierM :: IgnoreInodes -> RawFilePath -> CopyCoWTried -> FilePath -> Key -> ExportLocation -> [ContentIdentifier] -> MeterUpdate -> Annex ContentIdentifier+storeExportWithContentIdentifierM :: IgnoreInodes -> OsPath -> CopyCoWTried -> OsPath -> Key -> ExportLocation -> [ContentIdentifier] -> MeterUpdate -> Annex ContentIdentifier storeExportWithContentIdentifierM ii dir cow src _k loc overwritablecids p = do-	liftIO $ createDirectoryUnder [dir] (toRawFilePath destdir)+	liftIO $ createDirectoryUnder [dir] destdir 	withTmpFileIn destdir template $ \tmpf tmph -> do+		let tmpf' = fromOsPath tmpf 		liftIO $ hClose tmph 		void $ liftIO $ fileCopier cow src tmpf p Nothing-		let tmpf' = toRawFilePath tmpf-		resetAnnexFilePerm tmpf'-		liftIO (R.getSymbolicLinkStatus tmpf') >>= liftIO . mkContentIdentifier ii tmpf' >>= \case+		resetAnnexFilePerm tmpf+		liftIO (R.getSymbolicLinkStatus tmpf') >>= liftIO . mkContentIdentifier ii tmpf >>= \case 			Nothing -> giveup "unable to generate content identifier" 			Just newcid -> do 				checkExportContent ii dir loc 					overwritablecids 					(giveup "unsafe to overwrite file")-					(const $ liftIO $ R.rename tmpf' dest)+					(const $ liftIO $ R.rename tmpf' (fromOsPath dest)) 				return newcid   where 	dest = exportPath dir loc-	(destdir, base) = splitFileName (fromRawFilePath dest)-	template = relatedTemplate (base ++ ".tmp")+	(destdir, base) = splitFileName dest+	template = relatedTemplate (fromOsPath base <> ".tmp") -removeExportWithContentIdentifierM :: IgnoreInodes -> RawFilePath -> Key -> ExportLocation -> [ContentIdentifier] -> Annex ()+removeExportWithContentIdentifierM :: IgnoreInodes -> OsPath -> Key -> ExportLocation -> [ContentIdentifier] -> Annex () removeExportWithContentIdentifierM ii dir k loc removeablecids = 	checkExportContent ii dir loc removeablecids (giveup "unsafe to remove modified file") $ \case 		DoesNotExist -> return () 		KnownContentIdentifier -> removeExportM dir k loc -checkPresentExportWithContentIdentifierM :: IgnoreInodes -> RawFilePath -> Key -> ExportLocation -> [ContentIdentifier] -> Annex Bool+checkPresentExportWithContentIdentifierM :: IgnoreInodes -> OsPath -> Key -> ExportLocation -> [ContentIdentifier] -> Annex Bool checkPresentExportWithContentIdentifierM ii dir _k loc knowncids = 	checkPresentGeneric' dir $ 		checkExportContent ii dir loc knowncids (return False) $ \case@@ -591,9 +584,9 @@ -- -- So, it suffices to check if the destination file's current -- content is known, and immediately run the callback.-checkExportContent :: IgnoreInodes -> RawFilePath -> ExportLocation -> [ContentIdentifier] -> Annex a -> (CheckResult -> Annex a) -> Annex a+checkExportContent :: IgnoreInodes -> OsPath -> ExportLocation -> [ContentIdentifier] -> Annex a -> (CheckResult -> Annex a) -> Annex a checkExportContent ii dir loc knowncids unsafe callback = -	tryWhenExists (liftIO $ R.getSymbolicLinkStatus dest) >>= \case+	tryWhenExists (liftIO $ R.getSymbolicLinkStatus (fromOsPath dest)) >>= \case 		Just destst 			| not (isRegularFile destst) -> unsafe 			| otherwise -> catchDefaultIO Nothing (liftIO $ mkContentIdentifier ii dest destst) >>= \case
Remote/Directory/LegacyChunked.hs view
@@ -14,7 +14,6 @@  import qualified Data.ByteString.Lazy as L import qualified Data.ByteString as S-import qualified System.FilePath.ByteString as P  import Annex.Common import Utility.FileMode@@ -23,7 +22,7 @@ import Annex.Tmp import Utility.Metered import Utility.Directory.Create-import qualified Utility.RawFilePath as R+import qualified Utility.FileIO as F  withCheckedFiles :: (FilePath -> IO Bool) -> FilePath -> (FilePath -> Key -> [FilePath]) -> Key -> ([FilePath] -> IO Bool) -> IO Bool withCheckedFiles _ [] _locations _ _ = return False@@ -44,7 +43,7 @@ 					else a chunks 			) withStoredFiles :: FilePath -> (FilePath -> Key -> [FilePath]) -> Key -> ([FilePath] -> IO Bool) -> IO Bool-withStoredFiles = withCheckedFiles doesFileExist+withStoredFiles = withCheckedFiles (doesFileExist . toOsPath)  {- Splits a ByteString into chunks and writes to dests, obeying configured  - chunk size (not to be confused with the L.ByteString chunk size). -}@@ -76,20 +75,20 @@ 				feed bytes' (sz - s) ls h 			else return (l:ls) -storeHelper :: FilePath -> (RawFilePath -> RawFilePath -> IO ()) -> Key -> ([FilePath] -> IO [FilePath]) -> FilePath -> FilePath -> IO ()+storeHelper :: FilePath -> (OsPath -> OsPath -> IO ()) -> Key -> ([FilePath] -> IO [FilePath]) -> FilePath -> FilePath -> IO () storeHelper repotop finalizer key storer tmpdir destdir = do 	void $ liftIO $ tryIO $ createDirectoryUnder-		[toRawFilePath repotop]-		(toRawFilePath tmpdir)+		[toOsPath repotop]+		(toOsPath tmpdir) 	Legacy.storeChunks key tmpdir destdir storer recorder (legacyFinalizer finalizer)   where 	recorder f s = do-		let f' = toRawFilePath f+		let f' = toOsPath f 		void $ tryIO $ allowWrite f' 		writeFile f s 		void $ tryIO $ preventWrite f' -store :: FilePath -> ChunkSize -> (RawFilePath -> RawFilePath -> IO ()) -> Key -> L.ByteString -> MeterUpdate -> FilePath -> FilePath -> IO ()+store :: FilePath -> ChunkSize -> (OsPath -> OsPath -> IO ()) -> Key -> L.ByteString -> MeterUpdate -> FilePath -> FilePath -> IO () store repotop chunksize finalizer k b p = storeHelper repotop finalizer k $ \dests -> 	storeLegacyChunked p chunksize dests b @@ -97,30 +96,29 @@  - Done very innefficiently, by writing to a temp file.  - :/ This is legacy code..  -}-retrieve :: (RawFilePath -> Key -> [RawFilePath]) -> RawFilePath -> Retriever+retrieve :: (OsPath -> Key -> [OsPath]) -> OsPath -> Retriever retrieve locations d basek p _dest miv c = withOtherTmp $ \tmpdir -> do 	showLongNote "This remote uses the deprecated chunksize setting. So this will be quite slow."-	let tmp = tmpdir P.</> keyFile basek <> ".directorylegacy.tmp"-	let tmp' = fromRawFilePath tmp+	let tmp = tmpdir </> keyFile basek <> literalOsPath ".directorylegacy.tmp" 	let go = \k sink -> do-		liftIO $ void $ withStoredFiles (fromRawFilePath d) (legacyLocations locations) k $ \fs -> do+		liftIO $ void $ withStoredFiles (fromOsPath d) (legacyLocations locations) k $ \fs -> do 			forM_ fs $-				S.appendFile tmp' <=< S.readFile+				F.appendFile' tmp <=< S.readFile 			return True-		b <- liftIO $ L.readFile tmp'-		liftIO $ removeWhenExistsWith R.removeLink tmp+		b <- liftIO $ F.readFile tmp+		liftIO $ removeWhenExistsWith removeFile tmp 		sink b 	byteRetriever go basek p tmp miv c -checkKey :: RawFilePath -> (RawFilePath -> Key -> [RawFilePath]) -> Key -> Annex Bool+checkKey :: OsPath -> (OsPath -> Key -> [OsPath]) -> Key -> Annex Bool checkKey d locations k = liftIO $-	withStoredFiles (fromRawFilePath d) (legacyLocations locations) k $+	withStoredFiles (fromOsPath d) (legacyLocations locations) k $ 		-- withStoredFiles checked that it exists 		const $ return True -legacyFinalizer :: (RawFilePath -> RawFilePath -> IO ()) -> (FilePath -> FilePath -> IO ())-legacyFinalizer f = \a b -> f (toRawFilePath a) (toRawFilePath b)+legacyFinalizer :: (OsPath -> OsPath -> IO ()) -> (FilePath -> FilePath -> IO ())+legacyFinalizer f = \a b -> f (toOsPath a) (toOsPath b) -legacyLocations :: (RawFilePath -> Key -> [RawFilePath]) -> (FilePath -> Key -> [FilePath])+legacyLocations :: (OsPath -> Key -> [OsPath]) -> (FilePath -> Key -> [FilePath]) legacyLocations locations = \f k ->-	map fromRawFilePath $ locations (toRawFilePath f) k+	map fromOsPath $ locations (toOsPath f) k
Remote/External.hs view
@@ -237,9 +237,10 @@  storeKeyM :: External -> Storer storeKeyM external = fileStorer $ \k f p ->-	either giveup return =<< go k f p+	either giveup return =<< go k p+		(\sk -> TRANSFER Upload sk (fromOsPath f))   where-	go k f p = handleRequestKey external (\sk -> TRANSFER Upload sk f) k (Just p) $ \resp ->+	go k p mkreq = handleRequestKey external mkreq k (Just p) $ \resp -> 		case resp of 			TRANSFER_SUCCESS Upload k' | k == k' -> 				result (Right ())@@ -251,7 +252,7 @@ retrieveKeyFileM external = fileRetriever $ \d k p -> 	either giveup return =<< watchFileSize d p (go d k)   where-	go d k p = handleRequestKey external (\sk -> TRANSFER Download sk (fromRawFilePath d)) k (Just p) $ \resp ->+	go d k p = handleRequestKey external (\sk -> TRANSFER Download sk (fromOsPath d)) k (Just p) $ \resp -> 		case resp of 			TRANSFER_SUCCESS Download k' 				| k == k' -> result $ Right ()@@ -293,7 +294,7 @@ 	UNSUPPORTED_REQUEST -> result [] 	_ -> Nothing -storeExportM :: External -> FilePath -> Key -> ExportLocation -> MeterUpdate -> Annex ()+storeExportM :: External -> OsPath -> Key -> ExportLocation -> MeterUpdate -> Annex () storeExportM external f k loc p = either giveup return =<< go   where 	go = handleRequestExport external loc req k (Just p) $ \resp -> case resp of@@ -303,12 +304,12 @@ 		UNSUPPORTED_REQUEST ->  			result $ Left "TRANSFEREXPORT not implemented by external special remote" 		_ -> Nothing-	req sk = TRANSFEREXPORT Upload sk f+	req sk = TRANSFEREXPORT Upload sk (fromOsPath f) -retrieveExportM :: External -> Key -> ExportLocation -> FilePath -> MeterUpdate -> Annex Verification+retrieveExportM :: External -> Key -> ExportLocation -> OsPath -> MeterUpdate -> Annex Verification retrieveExportM external k loc dest p = do 	verifyKeyContentIncrementally AlwaysVerify k $ \iv ->-		tailVerify iv (toRawFilePath dest) $+		tailVerify iv dest $ 			either giveup return =<< go   where 	go = handleRequestExport external loc req k (Just p) $ \resp -> case resp of@@ -319,7 +320,7 @@ 		UNSUPPORTED_REQUEST -> 			result $ Left "TRANSFEREXPORT not implemented by external special remote" 		_ -> Nothing-	req sk = TRANSFEREXPORT Download sk dest+	req sk = TRANSFEREXPORT Download sk (fromOsPath dest)  checkPresentExportM :: External -> Key -> ExportLocation -> Annex Bool checkPresentExportM external k loc = either giveup id <$> go@@ -429,9 +430,9 @@ 	handleRemoteRequest (PROGRESS bytesprocessed) = 		maybe noop (\a -> liftIO $ a bytesprocessed) mp 	handleRemoteRequest (DIRHASH k) = -		send $ VALUE $ fromRawFilePath $ hashDirMixed def k+		send $ VALUE $ fromOsPath $ hashDirMixed def k 	handleRemoteRequest (DIRHASH_LOWER k) = -		send $ VALUE $ fromRawFilePath $ hashDirLower def k+		send $ VALUE $ fromOsPath $ hashDirLower def k 	handleRemoteRequest (SETCONFIG setting value) = 		liftIO $ atomically $ do 			ParsedRemoteConfig m c <- takeTMVar (externalConfig st)@@ -480,7 +481,7 @@ 		Just u -> send $ VALUE $ fromUUID u 		Nothing -> senderror "cannot send GETUUID here" 	handleRemoteRequest GETGITDIR = -		send . VALUE . fromRawFilePath =<< fromRepo Git.localGitDir+		send . VALUE . fromOsPath =<< fromRepo Git.localGitDir 	handleRemoteRequest GETGITREMOTENAME = 		case externalRemoteName external of 			Just n -> send $ VALUE n@@ -526,7 +527,7 @@ 	senderror = sendMessage st . ERROR   	credstorage setting u = CredPairStorage-		{ credPairFile = base+		{ credPairFile = toOsPath base 		, credPairEnvironment = (base ++ "login", base ++ "password") 		, credPairRemoteField = Accepted setting 		}@@ -824,19 +825,19 @@ checkUrlM external url =  	handleRequest external (CHECKURL url) Nothing $ \req -> case req of 		CHECKURL_CONTENTS sz f -> result $ UrlContents sz $-			if null f then Nothing else Just f+			if null f then Nothing else Just (toOsPath f) 		CHECKURL_MULTI l -> result $ UrlMulti $ map mkmulti l 		CHECKURL_FAILURE errmsg -> Just $ giveup $ 			respErrorMessage "CHECKURL" errmsg 		UNSUPPORTED_REQUEST -> giveup "CHECKURL not implemented by external special remote" 		_ -> Nothing   where-	mkmulti (u, s, f) = (u, s, f)+	mkmulti (u, s, f) = (u, s, toOsPath f)  retrieveUrl :: Retriever retrieveUrl = fileRetriever' $ \f k p iv -> do 	us <- getWebUrls k-	unlessM (withUrlOptions $ downloadUrl True k p iv us (fromRawFilePath f)) $+	unlessM (withUrlOptions $ downloadUrl True k p iv us f) $ 		giveup "failed to download content"  checkKeyUrl :: CheckPresent
Remote/External/Types.hs view
@@ -480,12 +480,12 @@ 	deserialize = parseURIPortable  instance Proto.Serializable ExportLocation where-	serialize = fromRawFilePath . fromExportLocation-	deserialize = Just . mkExportLocation . toRawFilePath+	serialize = fromOsPath . fromExportLocation+	deserialize = Just . mkExportLocation . toOsPath  instance Proto.Serializable ExportDirectory where-	serialize = fromRawFilePath . fromExportDirectory-	deserialize = Just . mkExportDirectory . toRawFilePath+	serialize = fromOsPath . fromExportDirectory+	deserialize = Just . mkExportDirectory . toOsPath  instance Proto.Serializable ExtensionList where 	serialize (ExtensionList l) = unwords l
Remote/GCrypt.hs view
@@ -20,8 +20,6 @@  import qualified Data.Map as M import qualified Data.ByteString as S-import qualified Data.ByteString.Lazy as L-import qualified System.FilePath.ByteString as P import Data.Default  import Annex.Common@@ -51,16 +49,17 @@ import Annex.UUID import Annex.Ssh import Annex.Perms+import Messages.Progress+import Types.ProposedAccepted+import Logs.Remote import qualified Remote.Rsync import qualified Remote.Directory import Utility.Rsync import Utility.Tmp-import Logs.Remote import Utility.Gpg import Utility.SshHost import Utility.Directory.Create-import Messages.Progress-import Types.ProposedAccepted+import qualified Utility.FileIO as F  remote :: RemoteType remote = specialRemoteType $ RemoteType@@ -304,10 +303,10 @@ 	 - which is needed for rsync of objects to it to work. 	 -} 	rsyncsetup = Remote.Rsync.withRsyncScratchDir $ \tmp -> do-		createAnnexDirectory (toRawFilePath tmp P.</> objectDir)+		createAnnexDirectory (tmp </> objectDir) 		dummycfg <- liftIO dummyRemoteGitConfig 		let (rsynctransport, rsyncurl, _) = rsyncTransport r dummycfg-		let tmpconfig = tmp </> "config"+		let tmpconfig = fromOsPath $ tmp </> literalOsPath "config" 		opts <- rsynctransport 		void $ liftIO $ rsync $ opts ++ 			[ Param $ rsyncurl ++ "/config"@@ -318,7 +317,7 @@ 			void $ Git.Config.changeFile tmpconfig denyNonFastForwards (Git.Config.boolConfig' False) 		ok <- liftIO $ rsync $ opts ++ 			[ Param "--recursive"-			, Param $ tmp ++ "/"+			, Param $ fromOsPath tmp ++ "/" 			, Param rsyncurl 			] 		unless ok $@@ -388,17 +387,18 @@ store' repo r rsyncopts accessmethod 	| not $ Git.repoIsUrl repo =  		byteStorer $ \k b p -> guardUsable repo (giveup "cannot access remote") $ liftIO $ do-			let tmpdir = Git.repoPath repo P.</> "tmp" P.</> keyFile k+			let tmpdir = Git.repoPath repo </> literalOsPath "tmp" </> keyFile k 			void $ tryIO $ createDirectoryUnder [Git.repoPath repo] tmpdir-			let tmpf = tmpdir P.</> keyFile k-			meteredWriteFile p (fromRawFilePath tmpf) b-			let destdir = parentDir $ toRawFilePath $ gCryptLocation repo k+			let tmpf = tmpdir </> keyFile k+			meteredWriteFile p tmpf b+			let destdir = parentDir $ gCryptLocation repo k 			Remote.Directory.finalizeStoreGeneric (Git.repoPath repo) tmpdir destdir 	| Git.repoIsSsh repo = if accessShell r 		then fileStorer $ \k f p -> do 			oh <- mkOutputHandler 			ok <- Ssh.rsyncHelper oh (Just p)-				=<< Ssh.rsyncParamsRemote r Upload k f+				=<< Ssh.rsyncParamsRemote r Upload k+					(fromOsPath f) 			unless ok $ 				giveup "rsync failed" 		else storersync@@ -416,11 +416,11 @@ retrieve' repo r rsyncopts accessmethod 	| not $ Git.repoIsUrl repo = byteRetriever $ \k sink -> 		guardUsable repo (giveup "cannot access remote") $-			sink =<< liftIO (L.readFile $ gCryptLocation repo k)+			sink =<< liftIO (F.readFile $ gCryptLocation repo k) 	| Git.repoIsSsh repo = if accessShell r 		then fileRetriever $ \f k p -> do 			ps <- Ssh.rsyncParamsRemote r Download k-				(fromRawFilePath f)+				(fromOsPath f) 			oh <- mkOutputHandler 			unlessM (Ssh.rsyncHelper oh (Just p) ps) $ 				giveup "rsync failed"@@ -440,7 +440,7 @@ 	| not $ Git.repoIsUrl repo = guardUsable repo (giveup "cannot access remote") $ 		liftIO $ Remote.Directory.removeDirGeneric True 			(gCryptTopDir repo)-			(fromRawFilePath (parentDir (toRawFilePath (gCryptLocation repo k))))+			(parentDir (gCryptLocation repo k)) 	| Git.repoIsSsh repo = shellOrRsync r removeshell removersync 	| accessmethod == AccessRsyncOverSsh = removersync 	| otherwise = unsupportedUrl@@ -465,14 +465,14 @@ 	checkrsync = Remote.Rsync.checkKey rsyncopts k 	checkshell = Ssh.inAnnex repo k -gCryptTopDir :: Git.Repo -> FilePath-gCryptTopDir repo = Git.repoLocation repo </> fromRawFilePath objectDir+gCryptTopDir :: Git.Repo -> OsPath+gCryptTopDir repo = toOsPath (Git.repoLocation repo) </> objectDir  {- Annexed objects are hashed using lower-case directories for max  - portability. -}-gCryptLocation :: Git.Repo -> Key -> FilePath+gCryptLocation :: Git.Repo -> Key -> OsPath gCryptLocation repo key = gCryptTopDir repo-	</> fromRawFilePath (keyPath key (hashDirLower def))+	</> keyPath key (hashDirLower def)  data AccessMethod = AccessRsyncOverSsh | AccessGitAnnexShell 	deriving (Eq)@@ -529,9 +529,10 @@ 	let (rsynctransport, rsyncurl, _) = rsyncTransport r gc 	opts <- rsynctransport 	liftIO $ do-		withTmpFile "tmpconfig" $ \tmpconfig _ -> do+		withTmpFile (literalOsPath "tmpconfig") $ \tmpconfig _ -> do+			let tmpconfig' = fromOsPath tmpconfig 			void $ rsync $ opts ++ 				[ Param $ rsyncurl ++ "/config"-				, Param tmpconfig+				, Param tmpconfig' 				]-			Git.Config.fromFile r tmpconfig+			Git.Config.fromFile r tmpconfig'
Remote/Git.hs view
@@ -49,6 +49,7 @@ import Utility.Metered import Utility.Env import Utility.Batch+import qualified Utility.FileIO as F import Remote.Helper.Git import Remote.Helper.Messages import Remote.Helper.ExportImport@@ -324,7 +325,7 @@  	geturlconfig = Url.withUrlOptionsPromptingCreds $ \uo -> do 		let url = Git.repoLocation r ++ "/config"-		v <- withTmpFile "git-annex.tmp" $ \tmpfile h -> do+		v <- withTmpFile (literalOsPath "git-annex.tmp") $ \tmpfile h -> do 			liftIO $ hClose h 			Url.download' nullMeterUpdate Nothing url tmpfile uo >>= \case 				Right () ->@@ -334,7 +335,7 @@ 						, Param "--null" 						, Param "--list" 						, Param "--file"-						, File tmpfile+						, File (fromOsPath tmpfile) 						] >>= return . \case 							Right r' -> Right r' 							Left exitcode -> Left $ "git config exited " ++ show exitcode@@ -469,9 +470,9 @@ 		| remoteAnnexBare remoteconfig == Just False = annexLocationsNonBare gc key 		| otherwise = annexLocationsBare gc key #ifndef mingw32_HOST_OS-	locs' = map fromRawFilePath locs+	locs' = map fromOsPath locs #else-	locs' = map (replace "\\" "/" . fromRawFilePath) locs+	locs' = map (replace "\\" "/" . fromOsPath) locs #endif 	remoteconfig = gitconfig r @@ -559,12 +560,12 @@ 	failedlock = giveup "can't lock content"  {- Tries to copy a key's content from a remote's annex to a file. -}-copyFromRemote :: Remote -> State -> Key -> AssociatedFile -> FilePath -> MeterUpdate -> VerifyConfig -> Annex Verification+copyFromRemote :: Remote -> State -> Key -> AssociatedFile -> OsPath -> MeterUpdate -> VerifyConfig -> Annex Verification copyFromRemote r st key file dest meterupdate vc = do 	repo <- getRepo r 	copyFromRemote'' repo r st key file dest meterupdate vc -copyFromRemote'' :: Git.Repo -> Remote -> State -> Key -> AssociatedFile -> FilePath -> MeterUpdate -> VerifyConfig -> Annex Verification+copyFromRemote'' :: Git.Repo -> Remote -> State -> Key -> AssociatedFile -> OsPath -> MeterUpdate -> VerifyConfig -> Annex Verification copyFromRemote'' repo r st@(State connpool _ _ _ _) key af dest meterupdate vc 	| isP2PHttp r = copyp2phttp 	| Git.repoIsHttp repo = verifyKeyContentIncrementally vc key $ \iv -> do@@ -602,9 +603,8 @@ 		<|> remoteAnnexBwLimit (gitconfig r) 		 	copyp2phttp = verifyKeyContentIncrementally vc key $ \iv -> do-		startsz <- liftIO $ tryWhenExists $-			getFileSize (toRawFilePath dest)-		bracketIO (openBinaryFile dest ReadWriteMode) (hClose) $ \h -> do+		startsz <- liftIO $ tryWhenExists $ getFileSize dest+		bracketIO (F.openBinaryFile dest ReadWriteMode) (hClose) $ \h -> do 			metered (Just meterupdate) key bwlimit $ \_ p -> do 				p' <- case startsz of 					Just startsz' -> liftIO $ do@@ -616,16 +616,18 @@ 					Valid -> return () 					Invalid -> giveup "Transfer failed" -copyFromRemoteCheap :: State -> Git.Repo -> Maybe (Key -> AssociatedFile -> FilePath -> Annex ())+copyFromRemoteCheap :: State -> Git.Repo -> Maybe (Key -> AssociatedFile -> OsPath -> Annex ()) #ifndef mingw32_HOST_OS copyFromRemoteCheap st repo 	| not $ Git.repoIsUrl repo = Just $ \key _af file -> guardUsable repo (giveup "cannot access remote") $ do 		gc <- getGitConfigFromState st 		loc <- liftIO $ gitAnnexLocation key repo gc-		liftIO $ ifM (R.doesPathExist loc)+		liftIO $ ifM (doesFileExist loc) 			( do 				absloc <- absPath loc-				R.createSymbolicLink absloc (toRawFilePath file)+				R.createSymbolicLink+					(fromOsPath absloc)+					(fromOsPath file) 			, giveup "remote does not contain key" 			) 	| otherwise = Nothing@@ -634,12 +636,12 @@ #endif  {- Tries to copy a key's content to a remote's annex. -}-copyToRemote :: Remote -> State -> Key -> AssociatedFile -> Maybe FilePath -> MeterUpdate -> Annex ()+copyToRemote :: Remote -> State -> Key -> AssociatedFile -> Maybe OsPath -> MeterUpdate -> Annex () copyToRemote r st key af o meterupdate = do 	repo <- getRepo r 	copyToRemote' repo r st key af o meterupdate -copyToRemote' :: Git.Repo -> Remote -> State -> Key -> AssociatedFile -> Maybe FilePath -> MeterUpdate -> Annex ()+copyToRemote' :: Git.Repo -> Remote -> State -> Key -> AssociatedFile -> Maybe OsPath -> MeterUpdate -> Annex () copyToRemote' repo r st@(State connpool duc _ _ _) key af o meterupdate 	| isP2PHttp r = prepsendwith copyp2phttp 	| not $ Git.repoIsUrl repo = ifM duc@@ -680,9 +682,9 @@ 				let checksuccess = liftIO checkio >>= \case 					Just err -> giveup err 					Nothing -> return True-				logStatusAfter NoLiveUpdate key $ Annex.Content.getViaTmp rsp verify key af (Just sz) $ \dest ->+				logStatusAfter NoLiveUpdate key $ Annex.Content.getViaTmp rsp verify key (Just sz) $ \dest -> 					metered (Just (combineMeterUpdate meterupdate p)) key bwlimit $ \_ p' -> -						copier object (fromRawFilePath dest) key p' checksuccess verify+						copier object dest key p' checksuccess verify 			) 		unless res $ 			failedsend@@ -718,10 +720,12 @@ 		r' <- Git.Config.read r 		environ <- getEnvironment 		let environ' = addEntries -			[ ("GIT_WORK_TREE", fromRawFilePath $ Git.repoPath r')-			, ("GIT_DIR", fromRawFilePath $ Git.localGitDir r')+			[ ("GIT_WORK_TREE", fromOsPath $ Git.repoPath r')+			, ("GIT_DIR", fromOsPath $ Git.localGitDir r') 			] environ-		batchCommandEnv program (Param "fsck" : params) (Just environ')+		batchCommandEnv (fromOsPath program)+			(Param "fsck" : params)+			(Just environ')  {- The passed repair action is run in the Annex monad of the remote. -} repairRemote :: Git.Repo -> Annex Bool -> Annex (IO Bool)@@ -815,7 +819,7 @@ 	-- because they can be modified at any time. 	<&&> (not <$> annexThin <$> Annex.getGitConfig) -type FileCopier = FilePath -> FilePath -> Key -> MeterUpdate -> Annex Bool -> VerifyConfig -> Annex (Bool, Verification)+type FileCopier = OsPath -> OsPath -> Key -> MeterUpdate -> Annex Bool -> VerifyConfig -> Annex (Bool, Verification)  -- If either the remote or local repository wants to use hard links, -- the copier will do so (falling back to copying if a hard link cannot be@@ -828,14 +832,14 @@ mkFileCopier :: Bool -> State -> Annex FileCopier mkFileCopier remotewanthardlink (State _ _ copycowtried _ _) = do 	localwanthardlink <- wantHardLink-	let linker = \src dest -> R.createLink (toRawFilePath src) (toRawFilePath dest) >> return True+	let linker = \src dest -> R.createLink (fromOsPath src) (fromOsPath dest) >> return True 	if remotewanthardlink || localwanthardlink 		then return $ \src dest k p check verifyconfig -> 			ifM (liftIO (catchBoolIO (linker src dest))) 				( ifM check 					( return (True, Verified) 					, do-						verificationOfContentFailed (toRawFilePath dest)+						verificationOfContentFailed dest 						return (False, UnVerified) 					) 				, copier src dest k p check verifyconfig@@ -848,7 +852,7 @@ 			Copied -> ifM check 				( finishVerifyKeyContentIncrementally iv 				, do-					verificationOfContentFailed (toRawFilePath dest)+					verificationOfContentFailed dest 					return (False, UnVerified) 				) 			CopiedCoW -> unVerified check
Remote/GitLFS.hs view
@@ -7,6 +7,7 @@  {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RankNTypes #-}+{-# LANGUAGE CPP #-}  module Remote.GitLFS (remote, gen, configKnownUrl) where @@ -20,6 +21,7 @@ import qualified Annex import qualified Git import qualified Git.Types as Git+import qualified Git.Config import qualified Git.Url import qualified Git.Remote import qualified Git.GCrypt@@ -36,12 +38,12 @@ import Annex.UUID import Crypto import Backend.Hash+import Logs.Remote+import Logs.RemoteState import Utility.Hash import Utility.SshHost import Utility.Url-import Logs.Remote-import Logs.RemoteState-import qualified Git.Config+import qualified Utility.FileIO as F  import qualified Network.GitLFS as LFS import Control.Concurrent.STM@@ -65,6 +67,8 @@ 	, configParser = mkRemoteConfigParser 		[ optionalStringParser urlField 			(FieldDesc "url of git-lfs repository")+		, optionalStringParser apiUrlField+			(FieldDesc "url of LFS API endpoint (when not specified derives from url)") 		] 	, setup = mySetup 	, exportSupported = exportUnsupported@@ -75,6 +79,9 @@ urlField :: RemoteConfigField urlField = Accepted "url" +apiUrlField :: RemoteConfigField+apiUrlField = Accepted "apiurl"+ gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> RemoteStateHandle -> Annex (Maybe Remote) gen r u rc gc rs = do 	c <- parsedRemoteConfig remote rc@@ -86,7 +93,7 @@ 			liftIO $ Git.GCrypt.encryptedRemote g r 		else pure r 	sem <- liftIO $ MSemN.new 1-	h <- liftIO $ newTVarIO $ LFSHandle Nothing Nothing sem r' gc+	h <- liftIO $ newTVarIO $ LFSHandle Nothing Nothing sem r' gc c 	cst <- remoteCost gc c expensiveRemoteCost 	let specialcfg = (specialRemoteCfg c) 		-- chunking would not improve git-lfs@@ -218,6 +225,7 @@ 	, getEndPointLock :: MSemN.MSemN Int  	, remoteRepo :: Git.Repo 	, remoteGitConfig :: RemoteGitConfig+	, remoteConfigs :: ParsedRemoteConfig 	}  -- Only let one thread at a time do endpoint discovery.@@ -229,10 +237,24 @@ 	l = getEndPointLock h  discoverLFSEndpoint :: LFS.TransferRequestOperation -> LFSHandle -> Annex (Maybe LFS.Endpoint)-discoverLFSEndpoint tro h-	| Git.repoIsSsh r = gossh-	| Git.repoIsHttp r = gohttp-	| otherwise = unsupportedurischeme+discoverLFSEndpoint tro h =+	case fmap fromProposedAccepted $ M.lookup apiUrlField (unparsedRemoteConfig (remoteConfigs h)) of+		Just apiurl | not (null apiurl) -> case parseURIRelaxed apiurl of+			Nothing -> unsupportedurischeme+#if MIN_VERSION_git_lfs(1,2,5)+			Just apiuri -> case LFS.mkEndpoint apiuri of+				Just endpoint -> checkhttpauth endpoint+				Nothing -> unsupportedurischeme+#else+#warning Building with old version of git-lfs, apiurl= will not be supported+			Just _ -> do+				warning $ "Unable to use configured apiurl because this git-annex is not built with version 1.2.5 of the haskell git-lfs library."+				return Nothing+#endif+		_+			| Git.repoIsSsh r -> gossh+			| Git.repoIsHttp r -> gohttp+			| otherwise -> unsupportedurischeme   where   	r = remoteRepo h 	lfsrepouri = case Git.location r of@@ -277,31 +299,33 @@ 						warning "unexpected response from git-lfs remote when doing ssh endpoint discovery" 						return Nothing 					Just endpoint -> return (Just endpoint)-	++	gohttp = case LFS.guessEndpoint lfsrepouri of+		Nothing -> unsupportedurischeme+		Just endpoint -> checkhttpauth endpoint+ 	-- The endpoint may or may not need http basic authentication, 	-- which involves using git-credential to prompt for the password. 	-- 	-- To determine if it does, make a download or upload request to 	-- it, not including any objects in the request, and see if 	-- the server requests authentication.-	gohttp = case LFS.guessEndpoint lfsrepouri of-		Nothing -> unsupportedurischeme-		Just endpoint -> do-			let testreq = LFS.startTransferRequest endpoint transfernothing-			flip catchNonAsync (const (returnendpoint endpoint)) $ do-				resp <- makeSmallAPIRequest testreq-				if needauth (responseStatus resp)-					then do-						cred <- prompt $ inRepo $ Git.getUrlCredential (show lfsrepouri)-						let endpoint' = addbasicauth (Git.credentialBasicAuth cred) endpoint-						let testreq' = LFS.startTransferRequest endpoint' transfernothing-						flip catchNonAsync (const (returnendpoint endpoint')) $ do-							resp' <- makeSmallAPIRequest testreq'-							inRepo $ if needauth (responseStatus resp')-								then Git.rejectUrlCredential cred-								else Git.approveUrlCredential cred-							returnendpoint endpoint'-					else returnendpoint endpoint+	checkhttpauth endpoint = do+		let testreq = LFS.startTransferRequest endpoint transfernothing+		flip catchNonAsync (const (returnendpoint endpoint)) $ do+			resp <- makeSmallAPIRequest testreq+			if needauth (responseStatus resp)+				then do+					cred <- prompt $ inRepo $ Git.getUrlCredential (show lfsrepouri)+					let endpoint' = addbasicauth (Git.credentialBasicAuth cred) endpoint+					let testreq' = LFS.startTransferRequest endpoint' transfernothing+					flip catchNonAsync (const (returnendpoint endpoint')) $ do+						resp' <- makeSmallAPIRequest testreq'+						inRepo $ if needauth (responseStatus resp')+							then Git.rejectUrlCredential cred+							else Git.approveUrlCredential cred+						returnendpoint endpoint'+				else returnendpoint endpoint 	  where 	  	transfernothing = LFS.TransferRequest 			{ LFS.req_operation = tro@@ -313,10 +337,10 @@  		needauth status = status == unauthorized401 -		addbasicauth (Just ba) endpoint =-			LFS.modifyEndpointRequest endpoint $+		addbasicauth (Just ba) endpoint' =+			LFS.modifyEndpointRequest endpoint' $ 				applyBasicAuth' ba-		addbasicauth Nothing endpoint = endpoint+		addbasicauth Nothing endpoint' = endpoint'  -- The endpoint is cached for later use. getLFSEndpoint :: LFS.TransferRequestOperation -> TVar LFSHandle -> Annex (Maybe LFS.Endpoint)@@ -380,7 +404,7 @@ 	| isEncKey k = Nothing 	| otherwise = fromKey keySize k -mkUploadRequest :: RemoteStateHandle -> Key -> FilePath -> Annex (LFS.TransferRequest, LFS.SHA256, Integer)+mkUploadRequest :: RemoteStateHandle -> Key -> OsPath -> Annex (LFS.TransferRequest, LFS.SHA256, Integer) mkUploadRequest rs k content = case (extractKeySha256 k, extractKeySize k) of 	(Just sha256, Just size) -> 		ret sha256 size@@ -390,11 +414,11 @@ 		ret sha256 size 	_ -> do 		sha256 <- calcsha256-		size <- liftIO $ getFileSize (toRawFilePath content)+		size <- liftIO $ getFileSize content 		rememberboth sha256 size 		ret sha256 size   where-	calcsha256 = liftIO $ T.pack . show . sha2_256 <$> L.readFile content+	calcsha256 = liftIO $ T.pack . show . sha2_256 <$> F.readFile content 	ret sha256 size = do 		let obj = LFS.TransferRequestObject 			{ LFS.req_oid = sha256@@ -497,7 +521,7 @@ 				Nothing -> giveup "unable to parse git-lfs server download url" 				Just req -> do 					uo <- getUrlOptions-					liftIO $ downloadConduit p iv req (fromRawFilePath dest) uo+					liftIO $ downloadConduit p iv req dest uo  -- Since git-lfs does not support removing content, nothing needs to be -- done to lock content in the remote, except for checking that the content
Remote/Glacier.hs view
@@ -178,7 +178,7 @@ 		forceSuccessProcess cmd pid 	go' _ _ _ _ _ = error "internal" -retrieve :: forall a. Remote -> Key -> MeterUpdate -> RawFilePath -> Maybe IncrementalVerifier -> (ContentSource -> Annex a) -> Annex a+retrieve :: forall a. Remote -> Key -> MeterUpdate -> OsPath -> Maybe IncrementalVerifier -> (ContentSource -> Annex a) -> Annex a retrieve = byteRetriever . retrieve'  retrieve' :: forall a. Remote -> Key -> (L.ByteString -> Annex a) -> Annex a
Remote/Helper/AWS.hs view
@@ -23,7 +23,7 @@  creds :: UUID -> CredPairStorage creds u = CredPairStorage-	{ credPairFile = fromUUID u+	{ credPairFile = literalOsPath (fromUUID u) 	, credPairEnvironment = ("AWS_ACCESS_KEY_ID", "AWS_SECRET_ACCESS_KEY") 	, credPairRemoteField = s3credsField 	}
Remote/Helper/Chunked.hs view
@@ -33,7 +33,7 @@ import Backend (isStableKey) import Annex.SpecialRemote.Config import Annex.Verify-import qualified Utility.RawFilePath as R+import qualified Utility.FileIO as F  import qualified Data.ByteString as S import qualified Data.ByteString.Lazy as L@@ -120,7 +120,7 @@ 	-> ChunkConfig 	-> EncKey 	-> Key-	-> FilePath+	-> OsPath 	-> MeterUpdate 	-> Maybe (Cipher, EncKey) 	-> encc@@ -135,7 +135,7 @@ 		-- possible without this check. 		(UnpaddedChunks chunksize) -> ifM (isStableKey k) 			( do-				h <- liftIO $ openBinaryFile f ReadMode+				h <- liftIO $ F.openBinaryFile f ReadMode 				go chunksize h 				liftIO $ hClose h 			, storechunk k (FileContent f) p@@ -257,7 +257,7 @@ 	-> ChunkConfig 	-> EncKey 	-> Key-	-> FilePath+	-> OsPath 	-> MeterUpdate 	-> Maybe (Cipher, EncKey) 	-> encc@@ -276,7 +276,7 @@   where 	go pe cks = do 		let ls = map chunkKeyList cks-		currsize <- liftIO $ catchMaybeIO $ getFileSize (toRawFilePath dest)+		currsize <- liftIO $ catchMaybeIO $ getFileSize dest 		let ls' = maybe ls (setupResume ls) currsize 		if any null ls' 			-- dest is already complete@@ -339,7 +339,7 @@ 			-- passing the whole file content to the 			-- incremental verifier though. 			Nothing -> do-				retriever (encryptor basek) basep (toRawFilePath dest) iv $+				retriever (encryptor basek) basep dest iv $ 					retrieved iv Nothing basep 				return $ case iv of 					Nothing -> Right iv@@ -347,13 +347,13 @@  	opennew = do 		iv <- startVerifyKeyContentIncrementally vc basek-		h <- liftIO $ openBinaryFile dest WriteMode+		h <- liftIO $ F.openBinaryFile dest WriteMode 		return (h, iv)  	-- Open the file and seek to the start point in order to resume. 	openresume startpoint = do 		-- ReadWriteMode allows seeking; AppendMode does not.-		h <- liftIO $ openBinaryFile dest ReadWriteMode+		h <- liftIO $ F.openBinaryFile dest ReadWriteMode 		liftIO $ hSeek h AbsoluteSeek startpoint 		-- No incremental verification when resuming, since that 		-- would need to read up to the startpoint.@@ -398,7 +398,7 @@  -} writeRetrievedContent 	:: LensEncParams encc-	=> FilePath+	=> OsPath 	-> Maybe (Cipher, EncKey) 	-> encc 	-> Maybe Handle@@ -409,7 +409,7 @@ writeRetrievedContent dest enc encc mh mp content miv = case (enc, mh, content) of 	(Nothing, Nothing, FileContent f) 		| f == dest -> noop-		| otherwise -> liftIO $ moveFile (toRawFilePath f) (toRawFilePath dest)+		| otherwise -> liftIO $ moveFile f dest 	(Just (cipher, _), _, ByteContent b) -> do 		cmd <- gpgCmd <$> Annex.getGitConfig 		decrypt cmd encc cipher (feedBytes b) $@@ -419,10 +419,10 @@ 		withBytes content $ \b -> 			decrypt cmd encc cipher (feedBytes b) $ 				readBytes write-		liftIO $ removeWhenExistsWith R.removeLink (toRawFilePath f)+		liftIO $ removeWhenExistsWith removeFile f 	(Nothing, _, FileContent f) -> do 		withBytes content write-		liftIO $ removeWhenExistsWith R.removeLink (toRawFilePath f)+		liftIO $ removeWhenExistsWith removeFile f 	(Nothing, _, ByteContent b) -> write b   where 	write b = case mh of@@ -437,7 +437,7 @@ 				Nothing -> S.hPut h 			in meteredWrite p writer b 		Nothing -> L.hPut h b-	opendest = openBinaryFile dest WriteMode+	opendest = F.openBinaryFile dest WriteMode  {- Can resume when the chunk's offset is at or before the end of  - the dest file. -}@@ -583,4 +583,4 @@  withBytes :: ContentSource -> (L.ByteString -> Annex a) -> Annex a withBytes (ByteContent b) a = a b-withBytes (FileContent f) a = a =<< liftIO (L.readFile f)+withBytes (FileContent f) a = a =<< liftIO (F.readFile f)
Remote/Helper/Chunked/Legacy.hs view
@@ -72,7 +72,7 @@ 	when (null stored) $ 		giveup "no chunks were stored"   where-	basef = tmp ++ fromRawFilePath (keyFile key)+	basef = tmp ++ fromOsPath (keyFile key) 	tmpdests = map (basef ++ ) chunkStream  {- Given a list of destinations to use, chunks the data according to the
Remote/Helper/Git.hs view
@@ -5,6 +5,8 @@  - Licensed under the GNU AGPL version 3 or higher.  -} +{-# LANGUAGE OverloadedStrings #-}+ module Remote.Helper.Git where  import Annex.Common@@ -25,10 +27,10 @@ repoCheap :: Git.Repo -> Bool repoCheap = not . Git.repoIsUrl -localpathCalc :: Git.Repo -> Maybe FilePath+localpathCalc :: Git.Repo -> Maybe OsPath localpathCalc r 	| not (Git.repoIsLocal r) && not (Git.repoIsLocalUnknown r) = Nothing-	| otherwise = Just $ fromRawFilePath $ Git.repoPath r+	| otherwise = Just $ Git.repoPath r  {- Checks relatively inexpensively if a repository is available for use. -} repoAvail :: Git.Repo -> Annex Availability@@ -59,9 +61,12 @@  gitRepoInfo :: Remote -> Annex [(String, String)] gitRepoInfo r = do-	d <- fromRawFilePath <$> fromRepo Git.localGitDir-	mtimes <- liftIO $ mapM (\p -> modificationTime <$> R.getFileStatus (toRawFilePath p))-		=<< emptyWhenDoesNotExist (dirContentsRecursive (d </> "refs" </> "remotes" </> Remote.name r))+	d <- fromRepo Git.localGitDir+	let refsdir = d </> literalOsPath "refs" +		</> literalOsPath "remotes" +		</> toOsPath (Remote.name r)+	mtimes <- liftIO $ mapM (\p -> modificationTime <$> R.getFileStatus (fromOsPath p))+		=<< emptyWhenDoesNotExist (dirContentsRecursive refsdir) 	let lastsynctime = case mtimes of 		[] -> "never" 		_ -> show $ posixSecondsToUTCTime $ realToFrac $ maximum mtimes
Remote/Helper/Hooks.hs view
@@ -11,7 +11,6 @@ module Remote.Helper.Hooks (addHooks) where  import qualified Data.Map as M-import qualified System.FilePath.ByteString as P  import Annex.Common import Types.Remote@@ -51,7 +50,7 @@ runHooks :: Remote -> Maybe String -> Maybe String -> Annex a -> Annex a runHooks r starthook stophook a = do 	dir <- fromRepo gitAnnexRemotesDir-	let lck = dir P.</> remoteid <> ".lck"+	let lck = dir </> remoteid <> literalOsPath ".lck" 	whenM (notElem lck . M.keys <$> getLockCache) $ do 		createAnnexDirectory dir 		firstrun lck
Remote/Helper/Http.hs view
@@ -14,6 +14,7 @@ import Remote.Helper.Special import Utility.Metered import Utility.Hash (IncrementalVerifier(..))+import qualified Utility.FileIO as F  import qualified Data.ByteString.Lazy as L import qualified Data.ByteString as S@@ -31,14 +32,14 @@  -- Reads the file and generates a streaming request body, that will update -- the meter as it's sent.-httpBodyStorer :: FilePath -> MeterUpdate -> IO RequestBody+httpBodyStorer :: OsPath -> MeterUpdate -> IO RequestBody httpBodyStorer src m = do-	size <- getFileSize (toRawFilePath src)+	size <- getFileSize src 	let streamer sink = withMeteredFile src m $ \b -> byteStringPopper b sink 	return $ RequestBodyStream (fromInteger size) streamer  -- Like httpBodyStorer, but generates a chunked request body.-httpBodyStorerChunked :: FilePath -> MeterUpdate -> RequestBody+httpBodyStorerChunked :: OsPath -> MeterUpdate -> RequestBody httpBodyStorerChunked src m = 	let streamer sink = withMeteredFile src m $ \b -> byteStringPopper b sink 	in RequestBodyStreamChunked streamer@@ -75,10 +76,10 @@  -- Reads the http body and stores it to the specified file, updating the -- meter and incremental verifier as it goes.-httpBodyRetriever :: FilePath -> MeterUpdate -> Maybe IncrementalVerifier -> Response BodyReader -> IO ()+httpBodyRetriever :: OsPath -> MeterUpdate -> Maybe IncrementalVerifier -> Response BodyReader -> IO () httpBodyRetriever dest meterupdate iv resp 	| responseStatus resp /= ok200 = giveup $ show $ responseStatus resp-	| otherwise = bracket (openBinaryFile dest WriteMode) hClose (go zeroBytesProcessed)+	| otherwise = bracket (F.openBinaryFile dest WriteMode) hClose (go zeroBytesProcessed)   where 	reader = responseBody resp 	go sofar h = do
Remote/Helper/P2P.hs view
@@ -36,9 +36,9 @@ -- the pool when done. type WithConn a c = (ClosableConnection c -> Annex (ClosableConnection c, a)) -> Annex a -store :: UUID -> RemoteGitConfig -> ProtoRunner (Maybe [UUID]) -> Key -> AssociatedFile -> Maybe FilePath -> MeterUpdate -> Annex ()+store :: UUID -> RemoteGitConfig -> ProtoRunner (Maybe [UUID]) -> Key -> AssociatedFile -> Maybe OsPath -> MeterUpdate -> Annex () store remoteuuid gc runner k af o p = do-	let sizer = KeySizer k (fmap (toRawFilePath . fst3) <$> prepSendAnnex k o)+	let sizer = KeySizer k (fmap fst3 <$> prepSendAnnex k o) 	let bwlimit = remoteAnnexBwLimitUpload gc <|> remoteAnnexBwLimit gc 	metered (Just p) sizer bwlimit $ \_ p' -> 		runner (P2P.put k af p') >>= \case@@ -53,7 +53,7 @@ 		when (u /= remoteuuid) $ 			logChange lu k u logstatus -retrieve :: RemoteGitConfig -> (ProtoRunner (Bool, Verification)) -> Key -> AssociatedFile -> FilePath -> MeterUpdate -> VerifyConfig -> Annex Verification+retrieve :: RemoteGitConfig -> (ProtoRunner (Bool, Verification)) -> Key -> AssociatedFile -> OsPath -> MeterUpdate -> VerifyConfig -> Annex Verification retrieve gc runner k af dest p verifyconfig = do 	iv <- startVerifyKeyContentIncrementally verifyconfig k 	let bwlimit = remoteAnnexBwLimitDownload gc <|> remoteAnnexBwLimit gc
Remote/Helper/Path.hs view
@@ -10,7 +10,7 @@ import Annex.Common import Types.Availability -checkPathAvailability :: Bool -> FilePath -> Annex Availability+checkPathAvailability :: Bool -> OsPath -> Annex Availability checkPathAvailability islocal d 	| not islocal = return GloballyAvailable 	| otherwise = ifM (liftIO $ doesDirectoryExist d)
Remote/Helper/ReadOnly.hs view
@@ -44,7 +44,7 @@ 		} 	| otherwise = r -readonlyStoreKey :: Key -> AssociatedFile -> Maybe FilePath -> MeterUpdate -> Annex ()+readonlyStoreKey :: Key -> AssociatedFile -> Maybe OsPath -> MeterUpdate -> Annex () readonlyStoreKey _ _ _ _ = readonlyFail  readonlyRemoveKey :: Maybe SafeDropProof -> Key -> Annex ()@@ -53,7 +53,7 @@ readonlyStorer :: Storer readonlyStorer _ _ _ = readonlyFail -readonlyStoreExport :: FilePath -> Key -> ExportLocation -> MeterUpdate -> Annex ()+readonlyStoreExport :: OsPath -> Key -> ExportLocation -> MeterUpdate -> Annex () readonlyStoreExport _ _ _ _ = readonlyFail  readonlyRemoveExport :: Key -> ExportLocation -> Annex ()@@ -62,7 +62,7 @@ readonlyRemoveExportDirectory :: ExportDirectory -> Annex () readonlyRemoveExportDirectory _ = readonlyFail -readonlyStoreExportWithContentIdentifier :: FilePath -> Key -> ExportLocation -> [ContentIdentifier] -> MeterUpdate -> Annex ContentIdentifier+readonlyStoreExportWithContentIdentifier :: OsPath -> Key -> ExportLocation -> [ContentIdentifier] -> MeterUpdate -> Annex ContentIdentifier readonlyStoreExportWithContentIdentifier _ _ _ _ _ = readonlyFail  readonlyRemoveExportWithContentIdentifier :: Key -> ExportLocation -> [ContentIdentifier] -> Annex ()
Remote/Helper/Special.hs view
@@ -53,6 +53,7 @@ import qualified Git import qualified Git.Construct import Git.Types+import qualified Utility.FileIO as F  import qualified Data.ByteString as S import qualified Data.ByteString.Lazy as L@@ -92,12 +93,11 @@  -- A Storer that expects to be provided with a file containing -- the content of the key to store.-fileStorer :: (Key -> FilePath -> MeterUpdate -> Annex ()) -> Storer+fileStorer :: (Key -> OsPath -> MeterUpdate -> Annex ()) -> Storer fileStorer a k (FileContent f) m = a k f m fileStorer a k (ByteContent b) m = withTmp k $ \f -> do-	let f' = fromRawFilePath f-	liftIO $ L.writeFile f' b-	a k f' m+	liftIO $ L.writeFile (fromOsPath f) b+	a k f m  -- A Storer that expects to be provided with a L.ByteString of -- the content to store.@@ -107,7 +107,7 @@ -- A Retriever that generates a lazy ByteString containing the Key's -- content, and passes it to a callback action which will fully consume it -- before returning.-byteRetriever :: (Key -> (L.ByteString -> Annex a) -> Annex a) -> Key -> MeterUpdate -> RawFilePath -> Maybe IncrementalVerifier -> (ContentSource -> Annex a) -> Annex a+byteRetriever :: (Key -> (L.ByteString -> Annex a) -> Annex a) -> Key -> MeterUpdate -> OsPath -> Maybe IncrementalVerifier -> (ContentSource -> Annex a) -> Annex a byteRetriever a k _m _dest _miv callback = a k (callback . ByteContent)  -- A Retriever that writes the content of a Key to a file.@@ -115,7 +115,7 @@ -- retrieves data. The incremental verifier is updated in the background as -- the action writes to the file, but may not be updated with the entire -- content of the file.-fileRetriever :: (RawFilePath -> Key -> MeterUpdate -> Annex ()) -> Retriever+fileRetriever :: (OsPath -> Key -> MeterUpdate -> Annex ()) -> Retriever fileRetriever a = fileRetriever' $ \f k m miv ->  	let retrieve = a f k m 	in tailVerify miv f retrieve@@ -124,20 +124,20 @@  - The action is responsible for updating the progress meter and the   - incremental verifier as it retrieves data.  -}-fileRetriever' :: (RawFilePath -> Key -> MeterUpdate -> Maybe IncrementalVerifier -> Annex ()) -> Retriever+fileRetriever' :: (OsPath -> Key -> MeterUpdate -> Maybe IncrementalVerifier -> Annex ()) -> Retriever fileRetriever' a k m dest miv callback = do 	createAnnexDirectory (parentDir dest) 	a dest k m miv-	pruneTmpWorkDirBefore dest (callback . FileContent . fromRawFilePath)+	pruneTmpWorkDirBefore dest (callback . FileContent)  {- The base Remote that is provided to specialRemote needs to have  - storeKey, retrieveKeyFile, removeKey, and checkPresent methods,  - but they are never actually used (since specialRemote replaces them).  - Here are some dummy ones.  -}-storeKeyDummy :: Key -> AssociatedFile -> Maybe FilePath -> MeterUpdate -> Annex ()+storeKeyDummy :: Key -> AssociatedFile -> Maybe OsPath -> MeterUpdate -> Annex () storeKeyDummy _ _ _ _ = error "missing storeKey implementation"-retrieveKeyFileDummy :: Key -> AssociatedFile -> FilePath -> MeterUpdate -> VerifyConfig -> Annex Verification+retrieveKeyFileDummy :: Key -> AssociatedFile -> OsPath -> MeterUpdate -> VerifyConfig -> Annex Verification retrieveKeyFileDummy _ _ _ _ _ = error "missing retrieveKeyFile implementation" removeKeyDummy :: Maybe SafeDropProof -> Key -> Annex () removeKeyDummy _ _ = error "missing removeKey implementation"@@ -258,9 +258,9 @@  	displayprogress bwlimit p k srcfile a 		| displayProgress cfg = do-			metered (Just p) (KeySizer k (pure (fmap toRawFilePath srcfile))) bwlimit (const a)+			metered (Just p) (KeySizer k (pure srcfile)) bwlimit (const a) 		| otherwise = a p  withBytes :: ContentSource -> (L.ByteString -> Annex a) -> Annex a withBytes (ByteContent b) a = a b-withBytes (FileContent f) a = a =<< liftIO (L.readFile f)+withBytes (FileContent f) a = a =<< liftIO (F.readFile f)
Remote/Helper/Ssh.hs view
@@ -66,7 +66,7 @@ 		let params' = case (debugenabled, debugselector) of 			(True, NoDebugSelector) -> Param "--debug" : params 			_ -> params-		return (Param command : File (fromRawFilePath dir) : params')+		return (Param command : File (fromOsPath dir) : params') 	uuidcheck NoUUID = [] 	uuidcheck u@(UUID _) = ["--uuid", fromUUID u] 	fieldopts
Remote/Helper/ThirdPartyPopulated.hs view
@@ -14,9 +14,7 @@ import Types.Import import Crypto (isEncKey) import Utility.Metered--import qualified System.FilePath.ByteString as P-import qualified Data.ByteString as S+import qualified Utility.OsString as OS  -- When a remote is thirdPartyPopulated, the files we want are probably -- in the .git directory. But, git does not really support .git in paths@@ -24,22 +22,22 @@ -- And so anything in .git is prevented from being imported. -- To work around that, this renames that directory when generating an -- ImportLocation.-mkThirdPartyImportLocation :: RawFilePath -> ImportLocation+mkThirdPartyImportLocation :: OsPath -> ImportLocation mkThirdPartyImportLocation =-	mkImportLocation . P.joinPath . map esc . P.splitDirectories+	mkImportLocation . joinPath . map esc . splitDirectories   where-	esc ".git" = "dotgit" 	esc x-		| "dotgit" `S.isSuffixOf` x = "dot" <> x+		| x == literalOsPath ".git" = literalOsPath "dotgit"+		| literalOsPath "dotgit" `OS.isSuffixOf` x = literalOsPath "dot" <> x 		| otherwise = x -fromThirdPartyImportLocation :: ImportLocation -> RawFilePath+fromThirdPartyImportLocation :: ImportLocation -> OsPath fromThirdPartyImportLocation =-	P.joinPath . map unesc . P.splitDirectories . fromImportLocation+	joinPath . map unesc . splitDirectories . fromImportLocation   where-	unesc "dotgit" = ".git" 	unesc x-		| "dotgit" `S.isSuffixOf` x = S.drop 3 x+		| x == literalOsPath "dotgit" = literalOsPath ".git"+		| literalOsPath "dotgit" `OS.isSuffixOf` x = OS.drop 3 x 		| otherwise = x  -- When a remote is thirdPartyPopulated, and contains a backup of a@@ -49,7 +47,7 @@ importKey :: ImportLocation -> ContentIdentifier -> ByteSize -> MeterUpdate -> Annex (Maybe Key) importKey loc _cid sz _ = return $ importKey' (fromImportLocation loc) (Just sz) -importKey' :: RawFilePath -> Maybe ByteSize -> Maybe Key+importKey' :: OsPath -> Maybe ByteSize -> Maybe Key importKey' p msz = case fileKey f of 	Just k 		-- Annex objects always are in a subdirectory with the same@@ -62,7 +60,7 @@ 		-- part of special remotes that don't use that layout. The most 		-- likely special remote to be in a backup, the directory 		-- special remote, does use that layout at least.)-		| lastMaybe (P.splitDirectories (P.dropFileName p)) /= Just f -> Nothing+		| lastMaybe (splitDirectories (dropFileName p)) /= Just f -> Nothing 		-- Chunked or encrypted keys used in special remotes are not 		-- supported. 		| isChunkKey k || isEncKey k -> Nothing@@ -82,4 +80,4 @@ 			_ -> Just k 	Nothing -> Nothing   where-	f = P.takeFileName p+	f = takeFileName p
Remote/Hook.hs view
@@ -118,8 +118,8 @@ 		] 	fileenv Nothing = [] 	fileenv (Just file) =  [envvar "FILE" file]-	hashbits = map takeDirectory $ splitPath $-		fromRawFilePath $ hashDirMixed def k+	hashbits = map (fromOsPath . takeDirectory) $+		splitPath $ hashDirMixed def k  lookupHook :: HookName -> Action -> Annex (Maybe String) lookupHook hookname action = do@@ -159,11 +159,11 @@ 			)  store :: HookName -> Storer-store h = fileStorer $ \k src _p -> runHook h "store" k (Just src)+store h = fileStorer $ \k src _p -> runHook h "store" k (Just (fromOsPath src))  retrieve :: HookName -> Retriever retrieve h = fileRetriever $ \d k _p ->-	unlessM (runHook' h "retrieve" k (Just (fromRawFilePath d)) $ return True) $+	unlessM (runHook' h "retrieve" k (Just (fromOsPath d)) $ return True) $ 		giveup "failed to retrieve content"  remove :: HookName -> Remover
Remote/HttpAlso.hs view
@@ -122,14 +122,14 @@  downloadKey :: Maybe URLString -> LearnedLayout -> Retriever downloadKey baseurl ll = fileRetriever' $ \dest key p iv ->-	downloadAction (fromRawFilePath dest) p iv (keyUrlAction baseurl ll key)+	downloadAction dest p iv (keyUrlAction baseurl ll key) -retriveExportHttpAlso :: Maybe URLString -> Key -> ExportLocation -> FilePath -> MeterUpdate -> Annex Verification+retriveExportHttpAlso :: Maybe URLString -> Key -> ExportLocation -> OsPath -> MeterUpdate -> Annex Verification retriveExportHttpAlso baseurl key loc dest p = do 	verifyKeyContentIncrementally AlwaysVerify key $ \iv -> 		downloadAction dest p iv (exportLocationUrlAction baseurl loc) -downloadAction :: FilePath -> MeterUpdate -> Maybe IncrementalVerifier -> ((URLString -> Annex (Either String ())) -> Annex (Either String ())) -> Annex ()+downloadAction :: OsPath -> MeterUpdate -> Maybe IncrementalVerifier -> ((URLString -> Annex (Either String ())) -> Annex (Either String ())) -> Annex () downloadAction dest p iv run = 	Url.withUrlOptions $ \uo -> 		run (\url -> Url.download' p iv url dest uo)@@ -192,7 +192,7 @@ 	-> (URLString -> Annex (Either String ())) 	-> Annex (Either String ()) exportLocationUrlAction (Just baseurl) loc a =-	a (baseurl P.</> fromRawFilePath (fromExportLocation loc))+	a (baseurl P.</> fromOsPath (fromExportLocation loc)) exportLocationUrlAction Nothing _ _ = noBaseUrlError  -- cannot normally happen@@ -228,5 +228,5 @@ 	  ] 	]   where-	mkurl k hasher = baseurl P.</> fromRawFilePath (hasher k) P.</> kf k-	kf k = fromRawFilePath (keyFile k)+	mkurl k hasher = baseurl P.</> fromOsPath (hasher k) P.</> kf k+	kf k = fromOsPath (keyFile k)
Remote/List.hs view
@@ -40,6 +40,7 @@ import qualified Remote.Rclone import qualified Remote.Hook import qualified Remote.External+import qualified Remote.Compute  remoteTypes :: [RemoteType] remoteTypes = map adjustExportImportRemoteType@@ -63,6 +64,7 @@ 	, Remote.Rclone.remote 	, Remote.Hook.remote 	, Remote.External.remote+	, Remote.Compute.remote 	]  {- Builds a list of all Remotes.
Remote/List/Util.hs view
@@ -1,6 +1,6 @@ {- git-annex remote list utils  -- - Copyright 2011-2020 Joey Hess <id@joeyh.name>+ - Copyright 2011-2025 Joey Hess <id@joeyh.name>  -  - Licensed under the GNU AGPL version 3 or higher.  -}@@ -10,7 +10,12 @@ import Annex.Common import qualified Annex import qualified Git.Config+import Annex.UUID+import Types.Remote+import Config.DynamicConfig +import Data.Ord+ {- Call when remotes have changed. Re-reads the git config, and  - invalidates the cache so the remoteList will be re-generated next time  - it's used. -}@@ -22,3 +27,44 @@ 		, Annex.gitremotes = Nothing 		, Annex.repo = newg 		}++{- Whether to include remotes that have annex-ignore set. -}+newtype IncludeIgnored = IncludeIgnored Bool++keyPossibilities'+	:: IncludeIgnored+	-> Key+	-> [UUID]+	-- ^ uuids of remotes that are recorded to have the key+	-> [Remote]+	-- ^ all remotes+	-> Annex [Remote]+keyPossibilities' ii _key remotelocations rs = do+	u <- getUUID+	let locations = filter (/= u) remotelocations+	let speclocations = map uuid+		$ filter (remoteAnnexSpeculatePresent . gitconfig) rs+	-- there are unlikely to be many speclocations, so building a Set+	-- is not worth the expense+	let locations' = speclocations ++ filter (`notElem` speclocations) locations+	fst <$> remoteLocations' ii locations' [] rs++remoteLocations' :: IncludeIgnored -> [UUID] -> [UUID] -> [Remote] -> Annex ([Remote], [UUID])+remoteLocations' (IncludeIgnored ii) locations trusted rs = do+	let validtrustedlocations = nub locations `intersect` trusted++	-- remotes that match uuids that have the key+	allremotes <- if not ii+		then filterM (not <$$> liftIO . getDynamicConfig . remoteAnnexIgnore . gitconfig) rs+		else return rs+	let validremotes = remotesWithUUID allremotes locations++	return (sortBy (comparing cost) validremotes, validtrustedlocations)++{- Filters a list of remotes to ones that have the listed uuids. -}+remotesWithUUID :: [Remote] -> [UUID] -> [Remote]+remotesWithUUID rs us = filter (\r -> uuid r `elem` us) rs++{- Filters a list of remotes to ones that do not have the listed uuids. -}+remotesWithoutUUID :: [Remote] -> [UUID] -> [Remote]+remotesWithoutUUID rs us = filter (\r -> uuid r `notElem` us) rs
Remote/Rsync.hs view
@@ -117,12 +117,13 @@ 			, getRepo = return r 			, gitconfig = gc 			, localpath = if islocal-				then Just $ rsyncUrl o+				then Just $ toOsPath $ rsyncUrl o 				else Nothing 			, readonly = False 			, appendonly = False 			, untrustworthy = False-			, availability = checkPathAvailability islocal (rsyncUrl o)+			, availability = checkPathAvailability islocal+				(toOsPath (rsyncUrl o)) 			, remotetype = remote 			, mkUnavailable = return Nothing 			, getInfo = return [("url", url)]@@ -221,45 +222,45 @@  - (When we have the right hash directory structure, we can just  - pass --include=X --include=X/Y --include=X/Y/file --exclude=*)  -}-store :: RsyncOpts -> Key -> FilePath -> MeterUpdate -> Annex ()+store :: RsyncOpts -> Key -> OsPath -> MeterUpdate -> Annex () store o k src meterupdate = storeGeneric o meterupdate basedest populatedest   where-	basedest = fromRawFilePath $ NE.head (keyPaths k)+	basedest = NE.head (keyPaths k) 	populatedest dest = liftIO $ if canrename 		then do-			R.rename (toRawFilePath src) (toRawFilePath dest)+			R.rename (fromOsPath src) (fromOsPath dest) 			return True-		else createLinkOrCopy (toRawFilePath src) (toRawFilePath dest)+		else createLinkOrCopy src dest 	{- If the key being sent is encrypted or chunked, the file 	 - containing its content is a temp file, and so can be 	 - renamed into place. Otherwise, the file is the annexed 	 - object file, and has to be copied or hard linked into place. -} 	canrename = isEncKey k || isChunkKey k -storeGeneric :: RsyncOpts -> MeterUpdate -> FilePath -> (FilePath -> Annex Bool) -> Annex ()+storeGeneric :: RsyncOpts -> MeterUpdate -> OsPath -> (OsPath -> Annex Bool) -> Annex () storeGeneric o meterupdate basedest populatedest =  	unlessM (storeGeneric' o meterupdate basedest populatedest) $ 		giveup "failed to rsync content" -storeGeneric' :: RsyncOpts -> MeterUpdate -> FilePath -> (FilePath -> Annex Bool) -> Annex Bool+storeGeneric' :: RsyncOpts -> MeterUpdate -> OsPath -> (OsPath -> Annex Bool) -> Annex Bool storeGeneric' o meterupdate basedest populatedest = withRsyncScratchDir $ \tmp -> do 	let dest = tmp </> basedest-	createAnnexDirectory (parentDir (toRawFilePath dest))+	createAnnexDirectory (parentDir dest) 	ok <- populatedest dest 	ps <- sendParams 	if ok 		then showResumable $ rsyncRemote Upload o (Just meterupdate) $ ps ++ 			Param "--recursive" : partialParams ++ 			-- tmp/ to send contents of tmp dir-			[ File $ addTrailingPathSeparator tmp+			[ File $ fromOsPath $ addTrailingPathSeparator tmp 			, Param $ rsyncUrl o 			] 		else return False -retrieve :: RsyncOpts -> RawFilePath -> Key -> MeterUpdate -> Annex ()-retrieve o f k p = rsyncRetrieveKey o k (fromRawFilePath f) (Just p)+retrieve :: RsyncOpts -> OsPath -> Key -> MeterUpdate -> Annex ()+retrieve o f k p = rsyncRetrieveKey o k f (Just p) -retrieveCheap :: RsyncOpts -> Key -> AssociatedFile -> FilePath -> Annex ()+retrieveCheap :: RsyncOpts -> Key -> AssociatedFile -> OsPath -> Annex () retrieveCheap o k _af f = ifM (preseedTmp k f) 	( rsyncRetrieveKey o k f Nothing 	, giveup "cannot preseed rsync with existing content"@@ -269,11 +270,11 @@ remove o _proof k = removeGeneric o includes   where 	includes = concatMap use dirHashes-	use h = let dir = fromRawFilePath (h def k) in-		[ fromRawFilePath (parentDir (toRawFilePath dir))-		, dir+	use h = let dir = h def k in+		[ fromOsPath (parentDir dir)+		, fromOsPath dir 		-- match content directory and anything in it-		, dir </> fromRawFilePath (keyFile k) </> "***"+		, fromOsPath $ dir </> keyFile k </> literalOsPath "***" 		]  {- An empty directory is rsynced to make it delete. Everything is excluded,@@ -291,7 +292,7 @@ 			[ Param "--exclude=*" -- exclude everything else 			, Param "--quiet", Param "--delete", Param "--recursive" 			] ++ partialParams ++ -			[ Param $ addTrailingPathSeparator tmp+			[ Param $ fromOsPath $ addTrailingPathSeparator tmp 			, Param $ rsyncUrl o 			] 	unless ok $@@ -313,43 +314,43 @@ 				} 			in withCreateProcess p $ \_ _ _ -> checkSuccessProcess -storeExportM :: RsyncOpts -> FilePath -> Key -> ExportLocation -> MeterUpdate -> Annex ()+storeExportM :: RsyncOpts -> OsPath -> Key -> ExportLocation -> MeterUpdate -> Annex () storeExportM o src _k loc meterupdate = 	storeGeneric o meterupdate basedest populatedest   where-	basedest = fromRawFilePath (fromExportLocation loc)-	populatedest = liftIO . createLinkOrCopy (toRawFilePath src) . toRawFilePath+	basedest = fromExportLocation loc+	populatedest = liftIO . createLinkOrCopy src -retrieveExportM :: RsyncOpts -> Key -> ExportLocation -> FilePath -> MeterUpdate -> Annex Verification+retrieveExportM :: RsyncOpts -> Key -> ExportLocation -> OsPath -> MeterUpdate -> Annex Verification retrieveExportM o k loc dest p = 	verifyKeyContentIncrementally AlwaysVerify k $ \iv ->-		tailVerify iv (toRawFilePath dest) $+		tailVerify iv dest $ 			rsyncRetrieve o [rsyncurl] dest (Just p)   where-	rsyncurl = mkRsyncUrl o (fromRawFilePath (fromExportLocation loc))+	rsyncurl = mkRsyncUrl o (fromOsPath (fromExportLocation loc))  checkPresentExportM :: RsyncOpts -> Key -> ExportLocation -> Annex Bool checkPresentExportM o _k loc = checkPresentGeneric o [rsyncurl]   where-	rsyncurl = mkRsyncUrl o (fromRawFilePath (fromExportLocation loc))+	rsyncurl = mkRsyncUrl o (fromOsPath (fromExportLocation loc))  removeExportM :: RsyncOpts -> Key -> ExportLocation -> Annex () removeExportM o _k loc =-	removeGeneric o $ map fromRawFilePath $-		includes $ fromExportLocation loc+	removeGeneric o $ map fromOsPath $ includes $ fromExportLocation loc   where 	includes f = f : case upFrom f of 		Nothing -> [] 		Just f' -> includes f'  removeExportDirectoryM :: RsyncOpts -> ExportDirectory -> Annex ()-removeExportDirectoryM o ed = removeGeneric o (allbelow d : includes d)+removeExportDirectoryM o ed = removeGeneric o $+	map fromOsPath (allbelow d : includes d)   where-	d = fromRawFilePath $ fromExportDirectory ed-	allbelow f = f </> "***"-	includes f = f : case upFrom (toRawFilePath f) of+	d = fromExportDirectory ed+	allbelow f = f </> literalOsPath "***"+	includes f = f : case upFrom f of 		Nothing -> []-		Just f' -> includes (fromRawFilePath f')+		Just f' -> includes f'  renameExportM :: RsyncOpts -> Key -> ExportLocation -> ExportLocation -> Annex (Maybe ()) renameExportM _ _ _ _ = return Nothing@@ -371,12 +372,12 @@  {- Runs an action in an empty scratch directory that can be used to build  - up trees for rsync. -}-withRsyncScratchDir :: (FilePath -> Annex a) -> Annex a+withRsyncScratchDir :: (OsPath -> Annex a) -> Annex a withRsyncScratchDir a = do-	t <- fromRawFilePath <$> fromRepo gitAnnexTmpObjectDir-	withTmpDirIn t "rsynctmp" a+	t <- fromRepo gitAnnexTmpObjectDir+	withTmpDirIn t (literalOsPath "rsynctmp") a -rsyncRetrieve :: RsyncOpts -> [RsyncUrl] -> FilePath -> Maybe MeterUpdate -> Annex ()+rsyncRetrieve :: RsyncOpts -> [RsyncUrl] -> OsPath -> Maybe MeterUpdate -> Annex () rsyncRetrieve o rsyncurls dest meterupdate =  	unlessM go $ 		giveup "rsync failed"@@ -385,10 +386,10 @@ 		-- use inplace when retrieving to support resuming 		[ Param "--inplace" 		, Param u-		, File dest+		, File (fromOsPath dest) 		] -rsyncRetrieveKey :: RsyncOpts -> Key -> FilePath -> Maybe MeterUpdate -> Annex ()+rsyncRetrieveKey :: RsyncOpts -> Key -> OsPath -> Maybe MeterUpdate -> Annex () rsyncRetrieveKey o k dest meterupdate = 	rsyncRetrieve o (rsyncUrls o k) dest meterupdate
Remote/Rsync/RsyncUrl.hs view
@@ -14,14 +14,14 @@ import Utility.Rsync import Utility.SafeCommand import Utility.ShellEscape-import Utility.FileSystemEncoding+import Utility.OsPath import Annex.DirHashes #ifdef mingw32_HOST_OS import Utility.Split #endif  import Data.Default-import System.FilePath.Posix+import qualified System.FilePath.Posix as Posix import qualified Data.List.NonEmpty as NE  type RsyncUrl = String@@ -40,15 +40,15 @@ 	| otherwise = u  mkRsyncUrl :: RsyncOpts -> FilePath -> RsyncUrl-mkRsyncUrl o f = rsyncUrl o </> rsyncEscape o f+mkRsyncUrl o f = rsyncUrl o Posix.</> rsyncEscape o f  rsyncUrls :: RsyncOpts -> Key -> [RsyncUrl] rsyncUrls o k = map use (NE.toList dirHashes)   where-	use h = rsyncUrl o </> hash h </> rsyncEscape o (f </> f)-	f = fromRawFilePath (keyFile k)+	use h = rsyncUrl o Posix.</> hash h Posix.</> rsyncEscape o (f Posix.</> f)+	f = fromOsPath (keyFile k) #ifndef mingw32_HOST_OS-	hash h = fromRawFilePath $ h def k+	hash h = fromOsPath $ h def k #else-	hash h = replace "\\" "/" $ fromRawFilePath $ h def k+	hash h = replace "\\" "/" $ fromOsPath $ h def k #endif
Remote/S3.hs view
@@ -68,6 +68,7 @@ import Annex.Url (getUserAgent, getUrlOptions, withUrlOptions, UrlOptions(..)) import Utility.Env import Annex.Verify+import qualified Utility.FileIO as F  type BucketName = String type BucketObject = String@@ -349,10 +350,10 @@ 	when (isIA info && not (isChunkKey k)) $ 		setUrlPresent k (iaPublicUrl info (bucketObject info k)) -storeHelper :: S3Info -> S3Handle -> Maybe Magic -> FilePath -> S3.Object -> MeterUpdate -> Annex (Maybe S3Etag, Maybe S3VersionID)+storeHelper :: S3Info -> S3Handle -> Maybe Magic -> OsPath -> S3.Object -> MeterUpdate -> Annex (Maybe S3Etag, Maybe S3VersionID) storeHelper info h magic f object p = liftIO $ case partSize info of 	Just partsz | partsz > 0 -> do-		fsz <- getFileSize (toRawFilePath f)+		fsz <- getFileSize f 		if fsz > partsz 			then multipartupload fsz partsz 			else singlepartupload@@ -385,7 +386,7 @@  		-- Send parts of the file, taking care to stream each part 		-- w/o buffering in memory, since the parts can be large.-		etags <- bracketIO (openBinaryFile f ReadMode) hClose $ \fh -> do+		etags <- bracketIO (F.openBinaryFile f ReadMode) hClose $ \fh -> do 			let sendparts meter etags partnum = do 				pos <- liftIO $ hTell fh 				if pos >= fsz@@ -420,24 +421,24 @@ 			Left failreason -> do 				warning (UnquotedString failreason) 				giveup "cannot download content"-			Right loc -> retrieveHelper info h loc (fromRawFilePath f) p iv+			Right loc -> retrieveHelper info h loc f p iv 	Left S3HandleNeedCreds -> 		getPublicWebUrls' rs info c k >>= \case 			Left failreason -> do 				warning (UnquotedString failreason) 				giveup "cannot download content"-			Right us -> unlessM (withUrlOptions $ downloadUrl False k p iv us (fromRawFilePath f)) $+			Right us -> unlessM (withUrlOptions $ downloadUrl False k p iv us f) $ 				giveup "failed to download content" 	Left S3HandleAnonymousOldAws -> giveupS3HandleProblem S3HandleAnonymousOldAws (uuid r) -retrieveHelper :: S3Info -> S3Handle -> (Either S3.Object S3VersionID) -> FilePath -> MeterUpdate -> Maybe IncrementalVerifier -> Annex ()+retrieveHelper :: S3Info -> S3Handle -> (Either S3.Object S3VersionID) -> OsPath -> MeterUpdate -> Maybe IncrementalVerifier -> Annex () retrieveHelper info h loc f p iv = retrieveHelper' h f p iv $ 	case loc of 		Left o -> S3.getObject (bucket info) o 		Right (S3VersionID o vid) -> (S3.getObject (bucket info) o) 			{ S3.goVersionId = Just vid } -retrieveHelper' :: S3Handle -> FilePath -> MeterUpdate -> Maybe IncrementalVerifier -> S3.GetObject -> Annex ()+retrieveHelper' :: S3Handle -> OsPath -> MeterUpdate -> Maybe IncrementalVerifier -> S3.GetObject -> Annex () retrieveHelper' h f p iv req = liftIO $ runResourceT $ do 	S3.GetObjectResponse { S3.gorResponse = rsp } <- sendS3Handle h req 	Url.sinkResponseFile p iv zeroBytesProcessed f WriteMode rsp@@ -495,10 +496,10 @@   where 	req = limit $ S3.headObject (bucket info) o -storeExportS3 :: S3HandleVar -> Remote -> RemoteStateHandle -> S3Info -> Maybe Magic -> FilePath -> Key -> ExportLocation -> MeterUpdate -> Annex ()+storeExportS3 :: S3HandleVar -> Remote -> RemoteStateHandle -> S3Info -> Maybe Magic -> OsPath -> Key -> ExportLocation -> MeterUpdate -> Annex () storeExportS3 hv r rs info magic f k loc p = void $ storeExportS3' hv r rs info magic f k loc p -storeExportS3' :: S3HandleVar -> Remote -> RemoteStateHandle -> S3Info -> Maybe Magic -> FilePath -> Key -> ExportLocation -> MeterUpdate -> Annex (Maybe S3Etag, Maybe S3VersionID)+storeExportS3' :: S3HandleVar -> Remote -> RemoteStateHandle -> S3Info -> Maybe Magic -> OsPath -> Key -> ExportLocation -> MeterUpdate -> Annex (Maybe S3Etag, Maybe S3VersionID) storeExportS3' hv r rs info magic f k loc p = withS3Handle hv $ \case 	Right h -> go h 	Left pr -> giveupS3HandleProblem pr (uuid r)@@ -509,7 +510,7 @@ 		setS3VersionID info rs k mvid 		return (metag, mvid) -retrieveExportS3 :: S3HandleVar -> Remote -> S3Info -> Key -> ExportLocation -> FilePath -> MeterUpdate -> Annex Verification+retrieveExportS3 :: S3HandleVar -> Remote -> S3Info -> Key -> ExportLocation -> OsPath -> MeterUpdate -> Annex Verification retrieveExportS3 hv r info k loc f p = verifyKeyContentIncrementally AlwaysVerify k $ \iv -> 	withS3Handle hv $ \case 		Right h -> retrieveHelper info h (Left (T.pack exportloc)) f p iv@@ -700,7 +701,7 @@ 		| otherwise = 			i : removemostrecent mtime rest -retrieveExportWithContentIdentifierS3 :: S3HandleVar -> Remote -> RemoteStateHandle -> S3Info -> ExportLocation -> [ContentIdentifier] -> FilePath -> Either Key (Annex Key) -> MeterUpdate -> Annex (Key, Verification)+retrieveExportWithContentIdentifierS3 :: S3HandleVar -> Remote -> RemoteStateHandle -> S3Info -> ExportLocation -> [ContentIdentifier] -> OsPath -> Either Key (Annex Key) -> MeterUpdate -> Annex (Key, Verification) retrieveExportWithContentIdentifierS3 hv r rs info loc (cid:_) dest gk p = 	case gk of 		Right _mkkey -> do@@ -744,7 +745,7 @@ -- -- When the bucket is not versioned, data loss can result. -- This is why that configuration requires --force to enable.-storeExportWithContentIdentifierS3 :: S3HandleVar -> Remote -> RemoteStateHandle -> S3Info -> Maybe Magic -> FilePath -> Key -> ExportLocation -> [ContentIdentifier] -> MeterUpdate -> Annex ContentIdentifier+storeExportWithContentIdentifierS3 :: S3HandleVar -> Remote -> RemoteStateHandle -> S3Info -> Maybe Magic -> OsPath -> Key -> ExportLocation -> [ContentIdentifier] -> MeterUpdate -> Annex ContentIdentifier storeExportWithContentIdentifierS3 hv r rs info magic src k loc _overwritablecids p 	| versioning info = go 	| otherwise = go@@ -835,7 +836,7 @@ 			giveup "Cannot reuse this bucket." 		_ -> void $ liftIO $ runResourceT $ sendS3Handle h mkobject   where-	file = T.pack $ uuidFile c+	file = T.pack $ fromOsPath $ uuidFile c 	uuidb = L.fromChunks [T.encodeUtf8 $ T.pack $ fromUUID u]  	mkobject = putObject info file (RequestBodyLBS uuidb)@@ -858,11 +859,11 @@ 	check (S3.GetObjectMemoryResponse _meta rsp) = 		responseStatus rsp == ok200 && responseBody rsp == uuidb -	file = T.pack $ uuidFile c+	file = T.pack $ fromOsPath $ uuidFile c 	uuidb = L.fromChunks [T.encodeUtf8 $ T.pack $ fromUUID u] -uuidFile :: ParsedRemoteConfig -> FilePath-uuidFile c = getFilePrefix c ++ "annex-uuid"+uuidFile :: ParsedRemoteConfig -> OsPath+uuidFile c = toOsPath (getFilePrefix c) <> literalOsPath "annex-uuid"  tryS3 :: ResourceT IO a -> ResourceT IO (Either S3.S3Error a) tryS3 a = (Right <$> a) `catch` (pure . Left)@@ -1090,16 +1091,16 @@  getBucketExportLocation :: ParsedRemoteConfig -> ExportLocation -> BucketObject getBucketExportLocation c loc =-	getFilePrefix c ++ fromRawFilePath (fromExportLocation loc)+	getFilePrefix c ++ fromOsPath (fromExportLocation loc)  getBucketImportLocation :: ParsedRemoteConfig -> BucketObject -> Maybe ImportLocation getBucketImportLocation c obj 	-- The uuidFile should not be imported.-	| obj == uuidfile = Nothing+	| obj == fromOsPath uuidfile = Nothing 	-- Only import files that are under the fileprefix, when 	-- one is configured. 	| prefix `isPrefixOf` obj = Just $ mkImportLocation $-		toRawFilePath $ drop prefixlen obj+		toOsPath $ drop prefixlen obj 	| otherwise = Nothing   where 	prefix = getFilePrefix c
Remote/Tahoe.hs view
@@ -49,7 +49,7 @@ {- The TMVar is left empty until tahoe has been verified to be running. -} data TahoeHandle = TahoeHandle TahoeConfigDir (TMVar ()) -type TahoeConfigDir = FilePath+type TahoeConfigDir = OsPath type SharedConvergenceSecret = String type IntroducerFurl = String type Capability = String@@ -81,7 +81,9 @@ 	c <- parsedRemoteConfig remote rc 	cst <- remoteCost gc c expensiveRemoteCost 	hdl <- liftIO $ TahoeHandle-		<$> maybe (defaultTahoeConfigDir u) return (remoteAnnexTahoe gc)+		<$> maybe (defaultTahoeConfigDir u)+			(return . toOsPath)+			(remoteAnnexTahoe gc) 		<*> newEmptyTMVarIO 	return $ Just $ Remote 		{ uuid = u@@ -136,18 +138,18 @@ 			, (scsField, Proposed scs) 			] 		else c-	gitConfigSpecialRemote u c' [("tahoe", configdir)]+	gitConfigSpecialRemote u c' [("tahoe", fromOsPath configdir)] 	return (c', u)   where 	missingfurl = giveup "Set TAHOE_FURL to the introducer furl to use." -store :: RemoteStateHandle -> TahoeHandle -> Key -> AssociatedFile -> Maybe FilePath -> MeterUpdate -> Annex ()+store :: RemoteStateHandle -> TahoeHandle -> Key -> AssociatedFile -> Maybe OsPath -> MeterUpdate -> Annex () store rs hdl k _af o _p = sendAnnex k o noop $ \src _sz ->-	parsePut <$> liftIO (readTahoe hdl "put" [File src]) >>= maybe+	parsePut <$> liftIO (readTahoe hdl "put" [File (fromOsPath src)]) >>= maybe 		(giveup "tahoe failed to store content") 		(\cap -> storeCapability rs k cap) -retrieve :: RemoteStateHandle -> TahoeHandle -> Key -> AssociatedFile -> FilePath -> MeterUpdate -> VerifyConfig -> Annex Verification+retrieve :: RemoteStateHandle -> TahoeHandle -> Key -> AssociatedFile -> OsPath -> MeterUpdate -> VerifyConfig -> Annex Verification retrieve rs hdl k _f d _p _ = do 	go =<< getCapability rs k 	-- Tahoe verifies the content it retrieves using cryptographically@@ -155,7 +157,7 @@ 	return Verified   where 	go Nothing = giveup "tahoe capability is not known"-	go (Just cap) = unlessM (liftIO $ requestTahoe hdl "get" [Param cap, File d]) $+	go (Just cap) = unlessM (liftIO $ requestTahoe hdl "get" [Param cap, File (fromOsPath d)]) $ 		giveup "tahoe failed to reteieve content"  remove :: Maybe SafeDropProof -> Key -> Annex ()@@ -185,7 +187,7 @@ defaultTahoeConfigDir :: UUID -> IO TahoeConfigDir defaultTahoeConfigDir u = do 	h <- myHomeDir -	return $ h </> ".tahoe-git-annex" </> fromUUID u+	return $ toOsPath h </> literalOsPath ".tahoe-git-annex" </> fromUUID u  tahoeConfigure :: TahoeConfigDir -> IntroducerFurl -> Maybe SharedConvergenceSecret -> IO SharedConvergenceSecret tahoeConfigure configdir furl mscs = do@@ -197,8 +199,7 @@  createClient :: TahoeConfigDir -> IntroducerFurl -> IO Bool createClient configdir furl = do-	createDirectoryIfMissing True $-		fromRawFilePath $ parentDir $ toRawFilePath configdir+	createDirectoryIfMissing True $ parentDir configdir 	boolTahoe configdir "create-client" 		[ Param "--nickname", Param "git-annex" 		, Param "--introducer", Param furl@@ -206,7 +207,8 @@  writeSharedConvergenceSecret :: TahoeConfigDir -> SharedConvergenceSecret -> IO () writeSharedConvergenceSecret configdir scs = -	writeFile (convergenceFile configdir) (unlines [scs])+	writeFile (fromOsPath (convergenceFile configdir))+		(unlines [scs])  {- The tahoe daemon writes the convergenceFile shortly after it starts  - (it does not need to connect to the network). So, try repeatedly to read@@ -215,7 +217,7 @@ getSharedConvergenceSecret :: TahoeConfigDir -> IO SharedConvergenceSecret getSharedConvergenceSecret configdir = go (60 :: Int)   where-	f = convergenceFile configdir+	f = fromOsPath $ convergenceFile configdir 	go n 		| n == 0 = giveup $ "tahoe did not write " ++ f ++ " after 1 minute. Perhaps the daemon failed to start?" 		| otherwise = do@@ -227,8 +229,9 @@ 					threadDelaySeconds (Seconds 1) 					go (n - 1) -convergenceFile :: TahoeConfigDir -> FilePath-convergenceFile configdir = configdir </> "private" </> "convergence"+convergenceFile :: TahoeConfigDir -> OsPath+convergenceFile configdir = +	configdir </> literalOsPath "private" </> literalOsPath "convergence"  startTahoeDaemon :: TahoeConfigDir -> IO () startTahoeDaemon configdir = void $ boolTahoe configdir "start" []@@ -267,7 +270,7 @@  tahoeParams :: TahoeConfigDir -> String -> [CommandParam] -> [CommandParam] tahoeParams configdir command params = -	Param "-d" : File configdir : Param command : params+	Param "-d" : File (fromOsPath configdir) : Param command : params  storeCapability :: RemoteStateHandle -> Key -> Capability -> Annex () storeCapability rs k cap = setRemoteState rs k cap
Remote/Web.hs view
@@ -30,7 +30,6 @@ import Logs.Remote import Logs.EquivilantKeys import Backend-import Backend.VURL.Utilities (generateEquivilantKey)  import qualified Data.Map as M @@ -116,7 +115,7 @@ 	gitConfigSpecialRemote u c [("web", "true")] 	return (c, u) -downloadKey :: UrlIncludeExclude -> Key -> AssociatedFile -> FilePath -> MeterUpdate -> VerifyConfig -> Annex Verification+downloadKey :: UrlIncludeExclude -> Key -> AssociatedFile -> OsPath -> MeterUpdate -> VerifyConfig -> Annex Verification downloadKey urlincludeexclude key _af dest p vc =  	go =<< getWebUrls' urlincludeexclude key   where@@ -169,20 +168,10 @@ 		| otherwise = return (Just v) 	 	recordvurlkey eks = do-		-- Make sure to pick a backend that is cryptographically-		-- secure.-		db <- defaultBackend-		let b = if isCryptographicallySecure db-			then db-			else defaultHashBackend-		generateEquivilantKey b (toRawFilePath dest) >>= \case-			Nothing -> return Nothing-			Just ek -> do-				unless (ek `elem` eks) $-					setEquivilantKey key ek-				return (Just Verified)+		b <- hashBackend+		updateEquivilantKeys b dest key eks -uploadKey :: Key -> AssociatedFile -> Maybe FilePath -> MeterUpdate -> Annex ()+uploadKey :: Key -> AssociatedFile -> Maybe OsPath -> MeterUpdate -> Annex () uploadKey _ _ _ _ = giveup "upload to web not supported"  dropKey :: UrlIncludeExclude -> Maybe SafeDropProof -> Key -> Annex ()
Remote/WebDAV.hs view
@@ -176,11 +176,11 @@ 		LegacyChunks _ -> do 			-- Not doing incremental verification for chunks. 			liftIO $ maybe noop unableIncrementalVerifier iv-			retrieveLegacyChunked (fromRawFilePath d) k p dav+			retrieveLegacyChunked (fromOsPath d) k p dav 		_ -> liftIO $ goDAV dav $-			retrieveHelper (keyLocation k) (fromRawFilePath d) p iv+			retrieveHelper (keyLocation k) d p iv -retrieveHelper :: DavLocation -> FilePath -> MeterUpdate -> Maybe IncrementalVerifier -> DAVT IO ()+retrieveHelper :: DavLocation -> OsPath -> MeterUpdate -> Maybe IncrementalVerifier -> DAVT IO () retrieveHelper loc d p iv = do 	debugDav $ "retrieve " ++ loc 	inLocation loc $@@ -213,14 +213,14 @@ 				existsDAV (keyLocation k) 			either giveup return v -storeExportDav :: DavHandleVar -> FilePath -> Key -> ExportLocation -> MeterUpdate -> Annex ()+storeExportDav :: DavHandleVar -> OsPath -> Key -> ExportLocation -> MeterUpdate -> Annex () storeExportDav hdl f k loc p = case exportLocation loc of 	Right dest -> withDavHandle hdl $ \h -> runExport h $ \dav -> do 		reqbody <- liftIO $ httpBodyStorer f p 		storeHelper dav (exportTmpLocation loc k) dest reqbody 	Left err -> giveup err -retrieveExportDav :: DavHandleVar -> Key -> ExportLocation -> FilePath -> MeterUpdate -> Annex Verification+retrieveExportDav :: DavHandleVar -> Key -> ExportLocation -> OsPath -> MeterUpdate -> Annex Verification retrieveExportDav hdl  k loc d p = case exportLocation loc of 	Right src -> verifyKeyContentIncrementally AlwaysVerify k  $ \iv -> 		withDavHandle hdl $ \h -> runExport h $ \_dav ->@@ -247,7 +247,7 @@  removeExportDirectoryDav :: DavHandleVar -> ExportDirectory -> Annex () removeExportDirectoryDav hdl dir = withDavHandle hdl $ \h -> runExport h $ \_dav -> do-	let d = fromRawFilePath $ fromExportDirectory dir+	let d = fromOsPath $ fromExportDirectory dir 	debugDav $ "delContent " ++ d 	inLocation d delContentM @@ -481,7 +481,7 @@ 	finalizer tmp' dest' = goDAV dav $  		finalizeStore dav tmp' (fromJust $ locationParent dest') -	tmp = addTrailingPathSeparator $ keyTmpLocation k+	tmp = fromOsPath $ addTrailingPathSeparator $ toOsPath $ keyTmpLocation k 	dest = keyLocation k  retrieveLegacyChunked :: FilePath -> Key -> MeterUpdate -> DavHandle -> Annex ()
Remote/WebDAV/DavLocation.hs view
@@ -17,9 +17,9 @@ #ifdef mingw32_HOST_OS import Utility.Split #endif-import Utility.FileSystemEncoding+import Utility.OsPath -import System.FilePath.Posix -- for manipulating url paths+import qualified System.FilePath.Posix as UrlPath import Network.Protocol.HTTP.DAV (inDAVLocation, DAVT) import Control.Monad.IO.Class (MonadIO) import Network.URI@@ -30,28 +30,29 @@  {- Runs action with a new location relative to the current location. -} inLocation :: (MonadIO m) => DavLocation -> DAVT m a -> DAVT m a-inLocation d = inDAVLocation (</> d')+inLocation d = inDAVLocation (UrlPath.</> d')   where 	d' = escapeURIString isUnescapedInURI d  {- The directory where files(s) for a key are stored. -} keyDir :: Key -> DavLocation-keyDir k = addTrailingPathSeparator $ hashdir </> fromRawFilePath (keyFile k)+keyDir k = UrlPath.addTrailingPathSeparator $ +	hashdir UrlPath.</> fromOsPath (keyFile k)   where #ifndef mingw32_HOST_OS-	hashdir = fromRawFilePath $ hashDirLower def k+	hashdir = fromOsPath $ hashDirLower def k #else-	hashdir = replace "\\" "/" (fromRawFilePath $ hashDirLower def k)+	hashdir = replace "\\" "/" (fromOsPath $ hashDirLower def k) #endif  keyLocation :: Key -> DavLocation-keyLocation k = keyDir k ++ fromRawFilePath (keyFile k)+keyLocation k = keyDir k ++ fromOsPath (keyFile k)  {- Paths containing # or ? cannot be represented in an url, so fails on  - those. -} exportLocation :: ExportLocation -> Either String DavLocation exportLocation l =-	let p = fromRawFilePath $ fromExportLocation l+	let p = fromOsPath $ fromExportLocation l 	in if any (`elem` p) illegalinurl 		then Left ("Cannot store file containing '#' or '?' on webdav: " ++ p) 		else Right p@@ -60,7 +61,7 @@  {- Where we store temporary data for a key as it's being uploaded. -} keyTmpLocation :: Key -> DavLocation-keyTmpLocation = tmpLocation . fromRawFilePath . keyFile+keyTmpLocation = tmpLocation . fromOsPath . keyFile  {- Where we store temporary data for a file as it's being exported.  -@@ -72,10 +73,11 @@  -} exportTmpLocation :: ExportLocation -> Key -> DavLocation exportTmpLocation l k-	| length (splitDirectories p) > 1 = takeDirectory p </> keyTmpLocation k+	| length (UrlPath.splitDirectories p) > 1 = +		UrlPath.takeDirectory p UrlPath.</> keyTmpLocation k 	| otherwise = keyTmpLocation k   where-	p = fromRawFilePath (fromExportLocation l)+	p = fromOsPath (fromExportLocation l)  tmpLocation :: FilePath -> DavLocation tmpLocation f = "git-annex-webdav-tmp-" ++ f@@ -86,7 +88,7 @@ 	| otherwise = Just parent   where 	tops = ["/", "", "."]-	parent = takeDirectory loc+	parent = UrlPath.takeDirectory loc  locationUrl :: URLString -> DavLocation -> URLString-locationUrl baseurl loc = baseurl </> loc+locationUrl baseurl loc = baseurl UrlPath.</> loc
RemoteDaemon/Transport/Tor.hs view
@@ -191,7 +191,7 @@ 			runBool [Param "fetch", Param $ Git.repoDescribe r] 		send (DONESYNCING url ok) -torSocketFile :: Annex.Annex (Maybe FilePath)+torSocketFile :: Annex.Annex (Maybe OsPath) torSocketFile = do 	u <- getUUID 	let ident = fromUUID u
Test.hs view
@@ -5,6 +5,7 @@  - Licensed under the GNU AGPL version 3 or higher.  -} +{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE CPP #-}  module Test where@@ -37,9 +38,9 @@ import qualified Git.Ref import qualified Git.LsTree import qualified Git.FilePath-import qualified Git.Bundle import qualified Annex.Locations #ifndef mingw32_HOST_OS+import qualified Git.Bundle import qualified Types.GitConfig #endif import qualified Types.TrustLevel@@ -89,6 +90,7 @@ import qualified Utility.StatelessOpenPGP import qualified Types.Remote #ifndef mingw32_HOST_OS+import qualified Utility.OsString as OS import qualified Remote.Helper.Encryptable import qualified Types.Crypto import qualified Utility.Gpg@@ -216,7 +218,7 @@  testDirectoryRemote :: TestTree testDirectoryRemote = testRemote True "directory" $ \remotename -> do-	createDirectory "remotedir"+	createDirectory (literalOsPath "remotedir") 	git_annex "initremote" 		[ remotename 		, "type=directory"@@ -437,7 +439,7 @@ 	runtest cfg populate = whenM Git.Bundle.versionSupported $  		intmpclonerepo $ do 			let cfg' = ["type=directory", "encryption=none", "directory=dir"] ++ cfg-			createDirectory "dir"+			createDirectory (literalOsPath "dir") 			git_annex "initremote" ("foo":("uuid=" ++ diruuid):cfg') "initremote" 			git_annex "get" [] "get failed" 			() <- populate@@ -452,7 +454,7 @@ 				git_annex "get" [annexedfile] "get from origin special remote" 	diruuid="89ddefa4-a04c-11ef-87b5-e880882a4f98" #else-test_git_remote_annex exporttree =+test_git_remote_annex _exporttree = 	-- git-remote-annex is not currently installed on Windows 	return () #endif@@ -461,14 +463,14 @@ test_add_moved = intmpclonerepo $ do 	git_annex "get" [annexedfile] "get failed" 	annexed_present annexedfile-	createDirectory subdir-	Utility.MoveFile.moveFile (toRawFilePath annexedfile) (toRawFilePath subfile)+	createDirectory (toOsPath subdir)+	Utility.MoveFile.moveFile (toOsPath annexedfile) subfile 	git_annex "add" [subdir] "add of moved annexed file" 	git "mv" [sha1annexedfile, sha1annexedfile ++ ".renamed"] "git mv" 	git_annex "add" [] "add does not fail on deleted file after move"   where 	subdir = "subdir"-	subfile = subdir </> "file"+	subfile = toOsPath subdir </> literalOsPath "file"  test_readonly_remote :: Assertion test_readonly_remote =@@ -494,7 +496,7 @@ test_ignore_deleted_files = intmpclonerepo $ do 	git_annex "get" [annexedfile] "get" 	git_annex_expectoutput "find" [] [annexedfile]-	removeWhenExistsWith R.removeLink (toRawFilePath annexedfile)+	removeWhenExistsWith removeFile (toOsPath annexedfile) 	-- A file that has been deleted, but the deletion not staged, 	-- is a special case; make sure git-annex skips these. 	git_annex_expectoutput "find" [] []@@ -554,27 +556,27 @@ 		"git-annex add with mimeencoding in largefiles" 	git_annex "sync" ["--no-content"] 		"git-annex sync"-	(isJust <$> annexeval (Annex.CatFile.catKeyFile (encodeBS "binary")))+	(isJust <$> annexeval (Annex.CatFile.catKeyFile (literalOsPath "binary"))) 		@? "binary file not added to annex despite mimeencoding config"-	(isNothing <$> annexeval (Annex.CatFile.catKeyFile (encodeBS "text")))+	(isNothing <$> annexeval (Annex.CatFile.catKeyFile (literalOsPath "text"))) 		@? "non-binary file got added to annex despite mimeencoding config" #else 	return () #endif  test_import :: Assertion-test_import = intmpclonerepo $ Utility.Tmp.Dir.withTmpDir "importtest" $ \importdir -> do-	(toimport1, importf1, imported1) <- mktoimport importdir "import1"+test_import = intmpclonerepo $ Utility.Tmp.Dir.withTmpDir (literalOsPath "importtest") $ \importdir -> do+	(toimport1, importf1, imported1) <- mktoimport importdir (literalOsPath "import1") 	git_annex "import" [toimport1] "import" 	annexed_present_imported imported1 	checkdoesnotexist importf1 -	(toimport2, importf2, imported2) <- mktoimport importdir "import2"+	(toimport2, importf2, imported2) <- mktoimport importdir (literalOsPath "import2") 	git_annex "import" [toimport2] "import of duplicate" 	annexed_present_imported imported2 	checkdoesnotexist importf2 -	(toimport3, importf3, imported3) <- mktoimport importdir "import3"+	(toimport3, importf3, imported3) <- mktoimport importdir (literalOsPath "import3") 	git_annex "import" ["--skip-duplicates", toimport3] 		"import of duplicate with --skip-duplicates" 	checkdoesnotexist imported3@@ -584,19 +586,19 @@ 	checkdoesnotexist imported3 	checkdoesnotexist importf3 	-	(toimport4, importf4, imported4) <- mktoimport importdir "import4"+	(toimport4, importf4, imported4) <- mktoimport importdir (literalOsPath "import4") 	git_annex "import" ["--deduplicate", toimport4] "import --deduplicate" 	checkdoesnotexist imported4 	checkdoesnotexist importf4 	-	(toimport5, importf5, imported5) <- mktoimport importdir "import5"+	(toimport5, importf5, imported5) <- mktoimport importdir (literalOsPath "import5") 	git_annex "import" ["--duplicate", toimport5] "import --duplicate" 	annexed_present_imported imported5 	checkexists importf5 	 	git_annex "drop" ["--force", imported1, imported2, imported5] "drop" 	annexed_notpresent_imported imported2-	(toimportdup, importfdup, importeddup) <- mktoimport importdir "importdup"+	(toimportdup, importfdup, importeddup) <- mktoimport importdir (literalOsPath "importdup") 	git_annex_shouldfail "import" ["--clean-duplicates", toimportdup]  		"import of missing duplicate with --clean-duplicates not allowed" 	checkdoesnotexist importeddup@@ -604,9 +606,14 @@   where 	mktoimport importdir subdir = do 		createDirectory (importdir </> subdir)-		let importf = subdir </> "f"-		writecontent (importdir </> importf) (content importf)-		return (importdir </> subdir, importdir </> importf, importf)+		let importf = subdir </> literalOsPath "f"+		writecontent (fromOsPath (importdir </> importf))+			(content (fromOsPath importf))+		return+			( fromOsPath (importdir </> subdir)+			, fromOsPath (importdir </> importf)+			, fromOsPath importf+			)  test_reinject :: Assertion test_reinject = intmpclonerepo $ do@@ -880,10 +887,10 @@ 	git_annex "get" [annexedfile] "get of file" 	git_annex "unlock" [annexedfile] "unlock" 	annexeval $ do-		Just k <- Annex.WorkTree.lookupKey (toRawFilePath annexedfile)+		Just k <- Annex.WorkTree.lookupKey (toOsPath annexedfile) 		Database.Keys.removeInodeCaches k 		Database.Keys.closeDb-		liftIO . removeWhenExistsWith R.removeLink+		liftIO . removeWhenExistsWith removeFile 			=<< Annex.calcRepo' Annex.Locations.gitAnnexKeysDbIndexCache 	writecontent annexedfile "test_lock_force content" 	git_annex_shouldfail "lock" [annexedfile] "lock of modified file should not be allowed"@@ -930,7 +937,7 @@ 	annexed_present annexedfile 	git_annex "fix" [annexedfile] "fix of present file" 	annexed_present annexedfile-	createDirectory subdir+	createDirectory (toOsPath subdir) 	git "mv" [annexedfile, subdir] "git mv" 	git_annex "fix" [newfile] "fix of moved file" 	runchecks [checklink, checkunwritable] newfile@@ -978,7 +985,7 @@   where 	corrupt f = do 		git_annex "get" [f] "get of file"-		Utility.FileMode.allowWrite (toRawFilePath f)+		Utility.FileMode.allowWrite (toOsPath f) 		writecontent f (changedcontent f) 		ifM (hasUnlockedFiles <$> getTestMode) 			( git_annex "fsck" []"fsck on unlocked file with changed file content"@@ -1119,10 +1126,12 @@ 		writecontent "unusedfile" "unusedcontent" 		git_annex "add" ["unusedfile"] "add of unusedfile" 		unusedfilekey <- getKey backendSHA256E "unusedfile"-		renameFile "unusedfile" "unusedunstagedfile"+		renameFile+			(literalOsPath "unusedfile")+			(literalOsPath "unusedunstagedfile") 		git "rm" ["-qf", "unusedfile"] "git rm" 		checkunused [] "with unstaged link"-		removeFile "unusedunstagedfile"+		removeFile (literalOsPath "unusedunstagedfile") 		checkunused [unusedfilekey] "with renamed link deleted"  	-- unused used to miss symlinks that were deleted or modified@@ -1141,7 +1150,7 @@ 	git_annex "add" ["unusedfile"] "add of unusedfile" 	git "add" ["unusedfile"] "git add" 	checkunused [] "with staged file"-	removeFile "unusedfile"+	removeFile (literalOsPath "unusedfile") 	checkunused [] "with staged deleted file"  	-- When an unlocked file is modified, git diff will cause git-annex@@ -1190,7 +1199,7 @@  	{- --include=* should match files in subdirectories too, 	 - and --exclude=* should exclude them. -}-	createDirectory "dir"+	createDirectory (literalOsPath "dir") 	writecontent "dir/subfile" "subfile" 	git_annex "add" ["dir"] "add of subdir" 	git_annex_expectoutput "find" ["--include", "*", "--exclude", annexedfile, "--exclude", sha1annexedfile] ["dir/subfile"]@@ -1258,8 +1267,11 @@ 	dupfile = annexedfile ++ "2" 	dupfile2 = annexedfile ++ "3" 	makedup f = do-		Utility.CopyFile.copyFileExternal Utility.CopyFile.CopyAllMetaData annexedfile f-			@? "copying annexed file failed"+		Utility.CopyFile.copyFileExternal+			Utility.CopyFile.CopyAllMetaData+			(toOsPath annexedfile)+			(toOsPath f)+				@? "copying annexed file failed" 		git "add" [f] "git add"  {- Regression test for union merge bug fixed in@@ -1345,7 +1357,7 @@ 	conflictor = "conflictor" 	variantprefix = conflictor ++ ".variant" 	checkmerge what d = do-		l <- getDirectoryContents d+		l <- map fromOsPath <$> getDirectoryContents (toOsPath d) 		let v = filter (variantprefix `isPrefixOf`) l 		length v == 2 			@? (what ++ " not exactly 2 variant files in: " ++ show l)@@ -1382,7 +1394,7 @@ 	conflictor = "conflictor" 	variantprefix = conflictor ++ ".variant" 	checkmerge what d = do-		l <- getDirectoryContents d+		l <- map fromOsPath <$> getDirectoryContents (toOsPath d) 		let v = filter (variantprefix `isPrefixOf`) l 		length v == 2 			@? (what ++ " not exactly 2 variant files in: " ++ show l)@@ -1407,7 +1419,7 @@ 				git_annex "sync" ["--no-content"] "sync in r1" 			intopdir r2 $ do 				disconnectOrigin-				createDirectory conflictor+				createDirectory (toOsPath conflictor) 				writecontent subfile "subfile" 				add_annex conflictor "add conflicter" 				git_annex "sync" ["--no-content"] "sync in r2"@@ -1418,19 +1430,19 @@ 			checkmerge "r1" r1 			checkmerge "r2" r2 	conflictor = "conflictor"-	subfile = conflictor </> "subfile"+	subfile = fromOsPath (toOsPath conflictor </> literalOsPath "subfile") 	checkmerge what d = do-		doesDirectoryExist (d </> conflictor) +		doesDirectoryExist (toOsPath d </> toOsPath conflictor)  			@? (d ++ " conflictor directory missing")-		l <- getDirectoryContents d-		let v = filter (Annex.VariantFile.variantMarker `isInfixOf`) l+		l <- map fromOsPath <$> getDirectoryContents (toOsPath d)+		let v = filter (fromOsPath Annex.VariantFile.variantMarker `isInfixOf`) l 		not (null v) 			@? (what ++ " conflictor variant file missing in: " ++ show l ) 		length v == 1 			@? (what ++ " too many variant files in: " ++ show v) 		intopdir d $ do 			git_annex "get" (conflictor:v) ("get  in " ++ what)-			git_annex_expectoutput "find" [conflictor] [fromRawFilePath (Git.FilePath.toInternalGitPath (toRawFilePath subfile))]+			git_annex_expectoutput "find" [conflictor] [fromOsPath (Git.FilePath.toInternalGitPath (toOsPath subfile))] 			git_annex_expectoutput "find" v v  {- Check merge conflict resolution when both repos start with an annexed@@ -1456,7 +1468,7 @@ 				git_annex "unlock" [conflictor] "unlock conflictor" 				writecontent conflictor "newconflictor" 			intopdir r1 $-				removeWhenExistsWith R.removeLink (toRawFilePath conflictor)+				removeWhenExistsWith removeFile (toOsPath conflictor) 			let l = if inr1 then [r1, r2, r1] else [r2, r1, r2] 			forM_ l $ \r -> intopdir r $ 				git_annex "sync" ["--no-content"] "sync"@@ -1465,7 +1477,7 @@ 	conflictor = "conflictor" 	variantprefix = conflictor ++ ".variant" 	checkmerge what d = do-		l <- getDirectoryContents d+		l <- map fromOsPath <$> getDirectoryContents (toOsPath d) 		let v = filter (variantprefix `isPrefixOf`) l 		not (null v) 			@? (what ++ " conflictor variant file missing in: " ++ show l )@@ -1506,14 +1518,15 @@ 	nonannexed_content = "nonannexed" 	variantprefix = conflictor ++ ".variant" 	checkmerge what d = do-		l <- getDirectoryContents d+		l <- map fromOsPath <$> getDirectoryContents (toOsPath d) 		let v = filter (variantprefix `isPrefixOf`) l 		not (null v) 			@? (what ++ " conflictor variant file missing in: " ++ show l ) 		length v == 1 			@? (what ++ " too many variant files in: " ++ show v) 		conflictor `elem` l @? (what ++ " conflictor file missing in: " ++ show l)-		s <- catchMaybeIO (readFile (d </> conflictor))+		s <- catchMaybeIO $ readFile $ fromOsPath $+			toOsPath d </> toOsPath conflictor 		s == Just nonannexed_content 			@? (what ++ " wrong content for nonannexed file: " ++ show s) @@ -1552,14 +1565,15 @@ 	symlinktarget = "dummy-target" 	variantprefix = conflictor ++ ".variant" 	checkmerge what d = do-		l <- getDirectoryContents d+		l <- map fromOsPath <$> getDirectoryContents (toOsPath d) 		let v = filter (variantprefix `isPrefixOf`) l 		not (null v) 			@? (what ++ " conflictor variant file missing in: " ++ show l ) 		length v == 1 			@? (what ++ " too many variant files in: " ++ show v) 		conflictor `elem` l @? (what ++ " conflictor file missing in: " ++ show l)-		s <- catchMaybeIO (R.readSymbolicLink (toRawFilePath (d </> conflictor)))+		s <- catchMaybeIO $ R.readSymbolicLink $ fromOsPath $+			toOsPath d </> toOsPath conflictor 		s == Just (toRawFilePath symlinktarget) 			@? (what ++ " wrong target for nonannexed symlink: " ++ show s) @@ -1575,13 +1589,13 @@ test_uncommitted_conflict_resolution :: Assertion test_uncommitted_conflict_resolution = do 	check conflictor-	check (conflictor </> "file")+	check (fromOsPath (toOsPath conflictor </> literalOsPath "file"))   where 	check remoteconflictor = withtmpclonerepo $ \r1 -> 		withtmpclonerepo $ \r2 -> do 			intopdir r1 $ do 				disconnectOrigin-				createDirectoryIfMissing True (fromRawFilePath (parentDir (toRawFilePath remoteconflictor)))+				createDirectoryIfMissing True (parentDir (toOsPath remoteconflictor)) 				writecontent remoteconflictor annexedcontent 				add_annex conflictor "add remoteconflicter" 				git_annex "sync" ["--no-content"] "sync in r1"@@ -1610,20 +1624,22 @@ 					git_annex "sync" ["--no-content"] "sync in r1" 					check_is_link conflictor "r1" 				intopdir r2 $ do-					createDirectory conflictor-					writecontent (conflictor </> "subfile") "subfile"+					createDirectory (toOsPath conflictor)+					writecontent conflictorsubfile "subfile" 					git_annex "add" [conflictor] "add conflicter" 					git_annex "sync" ["--no-content"] "sync in r2"-					check_is_link (conflictor </> "subfile") "r2"+					check_is_link conflictorsubfile "r2" 				intopdir r3 $ do 					writecontent conflictor "conflictor" 					git_annex "add" [conflictor] "add conflicter" 					git_annex "sync" ["--no-content"] "sync in r1"-					check_is_link (conflictor </> "subfile") "r3"+					check_is_link conflictorsubfile "r3"   where 	conflictor = "conflictor"+	conflictorsubfile = fromOsPath $+		toOsPath conflictor </> literalOsPath "subfile" 	check_is_link f what = do-		git_annex_expectoutput "find" ["--include=*", f] [fromRawFilePath (Git.FilePath.toInternalGitPath (toRawFilePath f))]+		git_annex_expectoutput "find" ["--include=*", f] [fromOsPath (Git.FilePath.toInternalGitPath (toOsPath f))] 		l <- annexeval $ Annex.inRepo $ Git.LsTree.lsTreeFiles (Git.LsTree.LsTreeLong False) Git.Ref.headRef [f] 		all (\i -> Git.Types.toTreeItemType (Git.LsTree.mode i) == Just Git.Types.TreeSymlink) l 			@? (what ++ " " ++ f ++ " lost symlink bit after merge: " ++ show l)@@ -1655,7 +1671,7 @@ 	conflictor = "conflictor" 	variantprefix = conflictor ++ ".variant" 	checkmerge what d = intopdir d $ do-		l <- getDirectoryContents "."+		l <- map fromOsPath <$> getDirectoryContents (literalOsPath ".") 		let v = filter (variantprefix `isPrefixOf`) l 		length v == 0 			@? (what ++ " not exactly 0 variant files in: " ++ show l)@@ -1688,7 +1704,7 @@ 		git_annex "sync" ["--no-content"] "sync" 	checkmerge what d = intopdir d $ whensupported $ do 		git_annex "sync" ["--no-content"] ("sync should not work in " ++ what)-		l <- getDirectoryContents "."+		l <- map fromOsPath <$> getDirectoryContents (literalOsPath ".") 		conflictor `elem` l 			@? ("conflictor not present after merge in " ++ what) 	-- Currently this fails on FAT, for unknown reasons not to@@ -1705,16 +1721,17 @@ 			origbranch <- annexeval origBranch 			git_annex "upgrade" [] "upgrade" 			git_annex "adjust" ["--unlock", "--force"] "adjust"-			createDirectoryIfMissing True "a/b/c"+			createDirectoryIfMissing True (literalOsPath "a/b/c") 			writecontent "a/b/c/d" "foo" 			git_annex "add" ["a/b/c"] "add a/b/c" 			git_annex "sync" ["--no-content"] "sync"-			createDirectoryIfMissing True "a/b/x"+			createDirectoryIfMissing True (literalOsPath "a/b/x") 			writecontent "a/b/x/y" "foo" 			git_annex "add" ["a/b/x"] "add a/b/x" 			git_annex "sync" ["--no-content"] "sync" 			git "checkout" [origbranch] "git checkout"-			doesFileExist "a/b/x/y" @? ("a/b/x/y missing from master after adjusted branch sync")+			doesFileExist (literalOsPath "a/b/x/y")+				@? ("a/b/x/y missing from master after adjusted branch sync")  test_map :: Assertion test_map = intmpclonerepo $ do@@ -1731,7 +1748,7 @@ 	-- any exit status is accepted; does abnormal exit 	git_annex'' (const True) (const True) "uninit" [] Nothing "uninit" 	checkregularfile annexedfile-	doesDirectoryExist ".git" @? ".git vanished in uninit"+	doesDirectoryExist (literalOsPath ".git") @? ".git vanished in uninit"  test_uninit_inbranch :: Assertion test_uninit_inbranch = intmpclonerepo $ do@@ -1760,7 +1777,7 @@ test_hook_remote = intmpclonerepo $ do #ifndef mingw32_HOST_OS 	git_annex "initremote" (words "foo type=hook encryption=none hooktype=foo") "initremote"-	createDirectory dir+	createDirectory (toOsPath dir) 	git_config "annex.foo-store-hook" $ 		"cp $ANNEX_FILE " ++ loc 	git_config "annex.foo-retrieve-hook" $@@ -1790,7 +1807,7 @@  test_directory_remote :: Assertion test_directory_remote = intmpclonerepo $ do-	createDirectory "dir"+	createDirectory (literalOsPath "dir") 	git_annex "initremote" (words "foo type=directory encryption=none directory=dir") "initremote" 	git_annex "get" [annexedfile] "get of file" 	annexed_present annexedfile@@ -1806,7 +1823,7 @@ test_rsync_remote :: Assertion test_rsync_remote = intmpclonerepo $ do #ifndef mingw32_HOST_OS-	createDirectory "dir"+	createDirectory (literalOsPath "dir") 	git_annex "initremote" (words "foo type=rsync encryption=none rsyncurl=dir") "initremote" 	git_annex "get" [annexedfile] "get of file" 	annexed_present annexedfile@@ -1825,9 +1842,9 @@ test_bup_remote :: Assertion test_bup_remote = intmpclonerepo $ when BuildInfo.bup $ do 	-- bup special remote needs an absolute path-	dir <- fromRawFilePath <$> absPath (toRawFilePath "dir")+	dir <- absPath (literalOsPath "dir") 	createDirectory dir-	git_annex "initremote" (words $ "foo type=bup encryption=none buprepo="++dir) "initremote"+	git_annex "initremote" (words $ "foo type=bup encryption=none buprepo="++fromOsPath dir) "initremote" 	git_annex "get" [annexedfile] "get of file" 	annexed_present annexedfile 	git_annex "copy" [annexedfile, "--to", "foo"] "copy --to bup remote"@@ -1841,8 +1858,8 @@  test_borg_remote :: Assertion test_borg_remote = when BuildInfo.borg $ do-	borgdirparent <- fromRawFilePath <$> (absPath . toRawFilePath =<< tmprepodir)-	let borgdir = borgdirparent </> "borgrepo"+	borgdirparent <- absPath . toOsPath =<< tmprepodir+	let borgdir = fromOsPath (borgdirparent </> literalOsPath "borgrepo") 	intmpclonerepo $ do 		testProcess "borg" ["init", borgdir, "-e", "none"] Nothing (== True) (const True) "borg init" 		testProcess "borg" ["create", borgdir++"::backup1", "."] Nothing (== True) (const True) "borg create"@@ -1894,27 +1911,27 @@ 	testscheme "pubkey"   where 	gpgcmd = Utility.Gpg.mkGpgCmd Nothing-	testscheme scheme = Utility.Tmp.Dir.withTmpDir "gpgtmp" $ \gpgtmp -> do+	testscheme scheme = Utility.Tmp.Dir.withTmpDir (literalOsPath "gpgtmp") $ \gpgtmp -> do 		-- Use the system temp directory as gpg temp directory because  		-- it needs to be able to store the agent socket there, 		-- which can be problematic when testing some filesystems.-		absgpgtmp <- fromRawFilePath <$> absPath (toRawFilePath gpgtmp)+		absgpgtmp <- absPath gpgtmp 		res <- testscheme' scheme absgpgtmp 		-- gpg may still be running and would prevent 		-- removeDirectoryRecursive from succeeding, so 		-- force removal of the temp directory.-		liftIO $ removeDirectoryForCleanup gpgtmp+		liftIO $ removeDirectoryForCleanup (fromOsPath gpgtmp) 		return res 	testscheme' scheme absgpgtmp = intmpclonerepo $ do 		-- Since gpg uses a unix socket, which is limited to a 		-- short path, use whichever is shorter of absolute 		-- or relative path.-		relgpgtmp <- fromRawFilePath <$> relPathCwdToFile (toRawFilePath absgpgtmp)-		let gpgtmp = if length relgpgtmp < length absgpgtmp+		relgpgtmp <- relPathCwdToFile absgpgtmp+		let gpgtmp = if OS.length relgpgtmp < OS.length absgpgtmp 			then relgpgtmp  			else absgpgtmp-		void $ Utility.Gpg.testHarness gpgtmp gpgcmd $ \environ -> do-			createDirectory "dir"+		void $ Utility.Gpg.testHarness (fromOsPath gpgtmp) gpgcmd $ \environ -> do+			createDirectory (literalOsPath "dir") 			let initps = 				[ "foo" 				, "type=directory"@@ -1934,7 +1951,7 @@ 			(c,k) <- annexeval $ do 				uuid <- Remote.nameToUUID "foo" 				rs <- Logs.Remote.readRemoteLog-				Just k <- Annex.WorkTree.lookupKey (toRawFilePath annexedfile)+				Just k <- Annex.WorkTree.lookupKey (toOsPath annexedfile) 				return (fromJust $ M.lookup uuid rs, k) 			let key = if scheme `elem` ["hybrid","pubkey"] 					then Just $ Utility.Gpg.KeyIds [Utility.Gpg.testKeyId]@@ -1971,12 +1988,12 @@ 			let encparams = (Types.Remote.ParsedRemoteConfig mempty mempty, dummycfg) 			cipher <- Crypto.decryptCipher' gpgcmd (Just environ) encparams cip 			files <- filterM doesFileExist $-				map ("dir" </>) $ concatMap (serializeKeys cipher) keys+				map (literalOsPath "dir" </>) $ concatMap (serializeKeys cipher) keys 			return (not $ null files) <&&> allM (checkFile mvariant) files 		checkFile mvariant filename =-			Utility.Gpg.checkEncryptionFile gpgcmd (Just environ) filename $+			Utility.Gpg.checkEncryptionFile gpgcmd (Just environ) (fromOsPath filename) $ 				if mvariant == Just Types.Crypto.PubKey then ks else Nothing-		serializeKeys cipher = map fromRawFilePath . NE.toList +		serializeKeys cipher = NE.toList  			. Annex.Locations.keyPaths 			. Crypto.encryptKey Types.Crypto.HmacSha1 cipher #else@@ -1985,8 +2002,9 @@  test_add_subdirs :: Assertion test_add_subdirs = intmpclonerepo $ do-	createDirectory "dir"-	writecontent ("dir" </> "foo") $ "dir/" ++ content annexedfile+	createDirectory (literalOsPath "dir")+	writecontent (fromOsPath (literalOsPath "dir" </> literalOsPath "foo"))+		("dir/" ++ content annexedfile) 	git_annex "add" ["dir"] "add of subdir"  	{- Regression test for Windows bug where symlinks were not@@ -1997,27 +2015,30 @@ 			<$> Annex.CatFile.catObject (Git.Types.Ref (encodeBS "HEAD:dir/foo")) 		"../.git/annex/" `isPrefixOf` l @? ("symlink from subdir to .git/annex is wrong: " ++ l) -	createDirectory "dir2"-	writecontent ("dir2" </> "foo") $ content annexedfile-	setCurrentDirectory "dir"-	git_annex "add" [".." </> "dir2"] "add of ../subdir"+	createDirectory (literalOsPath "dir2")+	writecontent (fromOsPath (literalOsPath "dir2" </> literalOsPath "foo"))+		(content annexedfile)+	setCurrentDirectory (literalOsPath "dir")+	git_annex "add" [fromOsPath (literalOsPath ".." </> literalOsPath "dir2")]+		"add of ../subdir"  test_addurl :: Assertion test_addurl = intmpclonerepo $ do 	-- file:// only; this test suite should not hit the network 	let filecmd c ps = git_annex c ("-cannex.security.allowed-url-schemes=file" : ps)-	f <- fromRawFilePath <$> absPath (toRawFilePath "myurl")-	let url = replace "\\" "/" ("file:///" ++ dropDrive f)-	writecontent f "foo"+	f <- absPath (literalOsPath "myurl")+	let url = replace "\\" "/" ("file:///" ++ fromOsPath (dropDrive f))+	writecontent (fromOsPath f) "foo" 	git_annex_shouldfail "addurl" [url] "addurl should not work on file url" 	filecmd "addurl" [url] ("addurl on " ++ url) 	let dest = "addurlurldest" 	filecmd "addurl" ["--file", dest, url] ("addurl on " ++ url ++ "  with --file")-	doesFileExist dest @? (dest ++ " missing after addurl --file")+	doesFileExist (toOsPath dest)+		@? (dest ++ " missing after addurl --file")  test_export_import :: Assertion test_export_import = intmpclonerepo $ do-	createDirectory "dir"+	createDirectory (literalOsPath "dir") 	git_annex "initremote" (words "foo type=directory encryption=none directory=dir exporttree=yes importtree=yes") "initremote" 	git_annex "get" [] "get of files" 	annexed_present annexedfile@@ -2035,7 +2056,7 @@ 	git_annex "merge" ["foo/" ++ origbranch] "git annex merge" 	annexed_present_imported "import" -	removeWhenExistsWith R.removeLink (toRawFilePath "import")+	removeWhenExistsWith removeFile (literalOsPath "import") 	writecontent "import" (content "newimport1") 	git_annex "add" ["import"] "add of import" 	commitchanges@@ -2044,7 +2065,7 @@  	-- verify that export refuses to overwrite modified file 	writedir "import" (content "newimport2")-	removeWhenExistsWith R.removeLink (toRawFilePath "import")+	removeWhenExistsWith removeFile (literalOsPath "import") 	writecontent "import" (content "newimport3") 	git_annex "add" ["import"] "add of import" 	commitchanges@@ -2054,17 +2075,18 @@ 	-- resolving import conflict 	git_annex "import" [origbranch, "--from", "foo"] "import from dir" 	git_shouldfail "merge" ["foo/master", "-mmerge"] "git merge of conflict should exit nonzero"-	removeWhenExistsWith R.removeLink (toRawFilePath "import")+	removeWhenExistsWith removeFile (literalOsPath "import") 	writecontent "import" (content "newimport3") 	git_annex "add" ["import"] "add of import" 	commitchanges 	git_annex "export" [origbranch, "--to", "foo"] "export after import conflict" 	dircontains "import" (content "newimport3")   where-	dircontains f v = -		((v==) <$> readFile ("dir" </> f))-			@? ("did not find expected content of " ++ "dir" </> f)-	writedir f = writecontent ("dir" </> f)+	dircontains f v = do+		let df = fromOsPath (literalOsPath "dir" </> stringToOsPath f)+		((v==) <$> readFile df)+			@? ("did not find expected content of " ++ df)+	writedir f = writecontent (fromOsPath (literalOsPath "dir" </> stringToOsPath f)) 	-- When on an adjusted branch, this updates the master branch 	-- to match it, which is necessary since the master branch is going 	-- to be exported.@@ -2072,12 +2094,12 @@  test_export_import_subdir :: Assertion test_export_import_subdir = intmpclonerepo $ do-	createDirectory "dir"+	createDirectory (literalOsPath "dir") 	git_annex "initremote" (words "foo type=directory encryption=none directory=dir exporttree=yes importtree=yes") "initremote" 	git_annex "get" [] "get of files" 	annexed_present annexedfile -	createDirectory subdir+	createDirectory (toOsPath subdir) 	git "mv" [annexedfile, subannexedfile] "git mv" 	git "commit" ["-m", "moved"] "git commit" 	@@ -2096,12 +2118,14 @@ 	testimport 	testexport   where-	dircontains f v = -		((v==) <$> readFile ("dir" </> f))-			@? ("did not find expected content of " ++ "dir" </> f)+	dircontains f v = do+		let df = fromOsPath (literalOsPath "dir" </> toOsPath f)+		((v==) <$> readFile df)+			@? ("did not find expected content of " ++ df) 	 	subdir = "subdir"-	subannexedfile = "subdir" </> annexedfile+	subannexedfile = fromOsPath $+		literalOsPath "subdir" </> toOsPath annexedfile 	 	testexport = do 		origbranch <- annexeval origBranch
Test/Framework.hs view
@@ -5,6 +5,8 @@  - Licensed under the GNU AGPL version 3 or higher.  -} +{-# LANGUAGE OverloadedStrings #-}+ module Test.Framework where  import Test.Tasty@@ -64,6 +66,7 @@ import qualified Utility.Metered import qualified Utility.HumanTime import qualified Command.Uninit+import qualified Utility.OsString as OS  -- Run a process. The output and stderr is captured, and is only -- displayed if the process does not return the expected value.@@ -121,13 +124,14 @@ 	let params' = if debug 		then "--debug":params 		else params-	testProcess pp (command:params') environ expectedret expectedtranscript faildesc+	testProcess (fromOsPath pp) (command:params') environ+		expectedret expectedtranscript faildesc  {- Runs git-annex and returns its standard output. -} git_annex_output :: String -> [String] -> IO String git_annex_output command params = do 	pp <- Annex.Path.programPath-	Utility.Process.readProcess pp (command:params)+	Utility.Process.readProcess (fromOsPath pp) (command:params)  git_annex_expectoutput :: String -> [String] -> [String] -> Assertion git_annex_expectoutput command params expected = do@@ -157,7 +161,7 @@ 	let v = Git.Types.ConfigValue (toRawFilePath "/dev/null") 	origindir <- absPath . Git.Types.fromConfigValue 		=<< annexeval (Config.getConfig k v)-	let originurl = "localhost:" ++ fromRawFilePath origindir+	let originurl = "localhost:" ++ fromOsPath origindir 	git "config" [config, originurl] "git config failed" 	a   where@@ -168,7 +172,7 @@  checkRepo :: Types.Annex a -> FilePath -> IO a checkRepo getval d = do-	s <- Annex.new =<< Git.Construct.fromPath (toRawFilePath d)+	s <- Annex.new =<< Git.Construct.fromPath (toOsPath d) 	Annex.eval s $ 		getval `finally` Annex.Action.stopCoProcesses @@ -216,7 +220,7 @@ 	-- any type of error and change back to currdir before 	-- rethrowing. 	r <- bracket_-		(setCurrentDirectory path)+		(setCurrentDirectory (toOsPath path)) 		(setCurrentDirectory currdir) 		(tryNonAsync a) 	case r of@@ -293,17 +297,18 @@  ensuredir :: FilePath -> IO () ensuredir d = do-	e <- doesDirectoryExist d+	let d' = toOsPath d+	e <- doesDirectoryExist d' 	unless e $-		createDirectory d+		createDirectory d'  {- This is the only place in the test suite that can use setEnv.  - Using it elsewhere can conflict with tasty's use of getEnv, which can  - happen concurrently with a test case running, and would be a problem  - since setEnv is not thread safe. This is run before tasty. -} setTestEnv :: IO a -> IO a-setTestEnv a = Utility.Tmp.Dir.withTmpDir "testhome" $ \tmphome -> do-	tmphomeabs <- fromRawFilePath <$> absPath (toRawFilePath tmphome)+setTestEnv a = Utility.Tmp.Dir.withTmpDir (literalOsPath "testhome") $ \tmphome -> do+	tmphomeabs <- fromOsPath <$> absPath tmphome 	{- Prevent global git configs from affecting the test suite. -} 	Utility.Env.Set.setEnv "HOME" tmphomeabs True 	Utility.Env.Set.setEnv "XDG_CONFIG_HOME" tmphomeabs True@@ -311,9 +316,11 @@ 	 	-- Ensure that the same git-annex binary that is running 	-- git-annex test is at the front of the PATH.-	p <- Utility.Env.getEnvDefault "PATH" "" 	pp <- Annex.Path.programPath-	Utility.Env.Set.setEnv "PATH" (takeDirectory pp ++ [searchPathSeparator] ++ p) True+	p <- Utility.Env.getEnvDefault "PATH" ""+	let p' = fromOsPath $+		takeDirectory pp <> OS.singleton searchPathSeparator <> toOsPath p+	Utility.Env.Set.setEnv "PATH" p' True 	 	-- Avoid git complaining if it cannot determine the user's 	-- email address, or exploding if it doesn't know the user's name.@@ -330,34 +337,34 @@  	-- Record top directory. 	currdir <- getCurrentDirectory-	Utility.Env.Set.setEnv "TOPDIR" currdir True+	Utility.Env.Set.setEnv "TOPDIR" (fromOsPath currdir) True 	 	a  removeDirectoryForCleanup :: FilePath -> IO ()-removeDirectoryForCleanup = removePathForcibly+removeDirectoryForCleanup = removePathForcibly . toOsPath  cleanup :: FilePath -> IO ()-cleanup dir = whenM (doesDirectoryExist dir) $ do-	Command.Uninit.prepareRemoveAnnexDir' dir+cleanup dir = whenM (doesDirectoryExist (toOsPath dir)) $ do+	Command.Uninit.prepareRemoveAnnexDir' (toOsPath dir) 	-- This can fail if files in the directory are still open by a 	-- subprocess. 	void $ tryIO $ removeDirectoryForCleanup dir  finalCleanup :: IO ()-finalCleanup = whenM (doesDirectoryExist tmpdir) $ do-	Command.Uninit.prepareRemoveAnnexDir' tmpdir+finalCleanup = whenM (doesDirectoryExist (toOsPath tmpdir)) $ do+	Command.Uninit.prepareRemoveAnnexDir' (toOsPath tmpdir) 	catchIO (removeDirectoryForCleanup tmpdir) $ \e -> do 		print e 		putStrLn "sleeping 10 seconds and will retry directory cleanup" 		Utility.ThreadScheduler.threadDelaySeconds $ 			Utility.ThreadScheduler.Seconds 10-		whenM (doesDirectoryExist tmpdir) $+		whenM (doesDirectoryExist (toOsPath tmpdir)) $ 			removeDirectoryForCleanup tmpdir  checklink :: FilePath -> Assertion checklink f = ifM (annexeval Config.crippledFileSystem)-	( (isJust <$> annexeval (Annex.Link.getAnnexLinkTarget (toRawFilePath f)))+	( (isJust <$> annexeval (Annex.Link.getAnnexLinkTarget (toOsPath f))) 		@? f ++ " is not a (crippled) symlink" 	, do 		s <- R.getSymbolicLinkStatus (toRawFilePath f)@@ -415,7 +422,7 @@ checklocationlog :: FilePath -> Bool -> Assertion checklocationlog f expected = do 	thisuuid <- annexeval Annex.UUID.getUUID-	r <- annexeval $ Annex.WorkTree.lookupKey (toRawFilePath f)+	r <- annexeval $ Annex.WorkTree.lookupKey (toOsPath f) 	case r of 		Just k -> do 			uuids <- annexeval $ Remote.keyLocations k@@ -425,12 +432,13 @@  checkbackend :: FilePath -> Types.Backend -> Assertion checkbackend file expected = do-	b <- annexeval $ maybe (return Nothing) (Backend.getBackend file) -		=<< Annex.WorkTree.lookupKey (toRawFilePath file)+	let file' = toOsPath file+	b <- annexeval $ maybe (return Nothing) (Backend.getBackend file')+		=<< Annex.WorkTree.lookupKey file' 	assertEqual ("backend for " ++ file) (Just expected) b  checkispointerfile :: FilePath -> Assertion-checkispointerfile f = unlessM (isJust <$> Annex.Link.isPointerFile (toRawFilePath f)) $+checkispointerfile f = unlessM (isJust <$> Annex.Link.isPointerFile (toOsPath f)) $ 	assertFailure $ f ++ " is not a pointer file"  inlocationlog :: FilePath -> Assertion@@ -499,7 +507,7 @@ unannexed_in_git :: FilePath -> Assertion unannexed_in_git f = do 	unannexed f-	r <- annexeval $ Annex.WorkTree.lookupKey (toRawFilePath f)+	r <- annexeval $ Annex.WorkTree.lookupKey (toOsPath f) 	case r of 		Just _k -> assertFailure $ f ++ " is annexed in git" 		Nothing -> return ()@@ -583,10 +591,10 @@   where 	go n = do 		let d = "main" ++ show n-		ifM (doesDirectoryExist d)+		ifM (doesDirectoryExist (toOsPath d)) 			( go $ n + 1 			, do-				createDirectory d+				createDirectory (toOsPath d) 				return d 			) @@ -595,7 +603,7 @@   where 	go n = do 		let d = "tmprepo" ++ show n-		ifM (doesDirectoryExist d)+		ifM (doesDirectoryExist (toOsPath d)) 			( go $ n + 1 			, return d 			)@@ -635,9 +643,9 @@ writecontent f c = go (10000000 :: Integer)   where 	go ticsleft = do-		oldmtime <- catchMaybeIO $ getModificationTime f+		oldmtime <- catchMaybeIO $ getModificationTime (toOsPath f) 		writeFile f c-		newmtime <- getModificationTime f+		newmtime <- getModificationTime (toOsPath f) 		if Just newmtime == oldmtime 			then do 				threadDelay 100000@@ -677,8 +685,8 @@ 	Nothing -> error "internal"   where 	ks = Types.KeySource.KeySource-		{ Types.KeySource.keyFilename = toRawFilePath f-		, Types.KeySource.contentLocation = toRawFilePath f+		{ Types.KeySource.keyFilename = toOsPath f+		, Types.KeySource.contentLocation = toOsPath f 		, Types.KeySource.inodeCache = Nothing 		} @@ -797,7 +805,7 @@ 	go Nothing = summarizeresults $ withConcurrentOutput $ do 		ensuredir tmpdir 		crippledfilesystem <- fst <$> Annex.Init.probeCrippledFileSystem'-			(toRawFilePath tmpdir)+			(toOsPath tmpdir) 			Nothing Nothing False 		adjustedbranchok <- Annex.AdjustedBranch.isGitVersionSupported 		let ts = mkts numparts crippledfilesystem adjustedbranchok opts@@ -807,13 +815,13 @@ 			mapM_ (hPutStrLn stderr) warnings 		environ <- Utility.Env.getEnvironment 		args <- getArgs-		pp <- Annex.Path.programPath+		pp <- fromOsPath <$> Annex.Path.programPath 		termcolor <- hSupportsANSIColor stdout 		let ps = if useColor (lookupOption tastyopts) termcolor 			then "--color=always":args 			else "--color=never":args 		let runone n = do-			let subdir = tmpdir </> show n+			let subdir = fromOsPath $ toOsPath tmpdir </> toOsPath (show n) 			ensuredir subdir 			let p = (proc pp ps) 				{ env = Just ((subenv, show (n, crippledfilesystem, adjustedbranchok)):environ)
Types/ActionItem.hs view
@@ -18,14 +18,14 @@ import Types.FileMatcher import Git.FilePath import Git.Quote (StringContainingQuotedPath(..))-import Utility.FileSystemEncoding+import Utility.OsPath  data ActionItem  	= ActionItemAssociatedFile AssociatedFile Key 	| ActionItemKey Key 	| ActionItemBranchFilePath BranchFilePath Key 	| ActionItemFailedTransfer Transfer TransferInfo-	| ActionItemTreeFile RawFilePath+	| ActionItemTreeFile OsPath 	| ActionItemUUID UUID StringContainingQuotedPath 	-- ^ UUID with a description or name of the repository 	| ActionItemOther (Maybe StringContainingQuotedPath)@@ -46,10 +46,10 @@ instance MkActionItem (Key, AssociatedFile) where 	mkActionItem = uncurry $ flip ActionItemAssociatedFile -instance MkActionItem (Key, RawFilePath) where+instance MkActionItem (Key, OsPath) where 	mkActionItem (key, file) = ActionItemAssociatedFile (AssociatedFile (Just file)) key -instance MkActionItem (RawFilePath, Key) where+instance MkActionItem (OsPath, Key) where 	mkActionItem (file, key) = mkActionItem (key, file)  instance MkActionItem Key where@@ -97,7 +97,7 @@ actionItemKey (ActionItemOther _) = Nothing actionItemKey (OnlyActionOn _ ai) = actionItemKey ai -actionItemFile :: ActionItem -> Maybe RawFilePath+actionItemFile :: ActionItem -> Maybe OsPath actionItemFile (ActionItemAssociatedFile (AssociatedFile af) _) = af actionItemFile (ActionItemTreeFile f) = Just f actionItemFile (ActionItemUUID _ _) = Nothing
Types/Backend.hs view
@@ -12,6 +12,7 @@ import Types.Key import Types.KeySource import Utility.Metered+import Utility.OsPath import Utility.FileSystemEncoding import Utility.Hash (IncrementalVerifier) @@ -20,7 +21,7 @@ 	, genKey :: Maybe (KeySource -> MeterUpdate -> a Key) 	-- Verifies the content of a key, stored in a file, using a hash. 	-- This does not need to be cryptographically secure.-	, verifyKeyContent :: Maybe (Key -> RawFilePath -> a Bool)+	, verifyKeyContent :: Maybe (Key -> OsPath -> a Bool) 	-- Incrementally verifies the content of a key, using the same 	-- hash as verifyKeyContent, but with the content provided 	-- incrementally a piece at a time, until finalized.
Types/BranchState.hs view
@@ -29,14 +29,14 @@ 	, unhandledTransitions :: [TransitionCalculator] 	-- ^ when the branch was not able to be updated due to permissions, 	-- this is transitions that need to be applied when making queries.-	, cachedFileContents :: [(RawFilePath, L.ByteString)]+	, cachedFileContents :: [(OsPath, L.ByteString)] 	-- ^ contents of a few files recently read from the branch 	, needInteractiveAccess :: Bool 	-- ^ do new changes written to the journal or branch by another 	-- process need to be noticed while the current process is running? 	-- (This makes the journal always be read, and avoids using the 	-- cache.)-	, alternateJournal :: Maybe RawFilePath+	, alternateJournal :: Maybe OsPath 	-- ^ use this directory for all journals, rather than the 	-- gitAnnexJournalDir and gitAnnexPrivateJournalDir. 	}
Types/Direction.hs view
@@ -9,16 +9,16 @@  module Types.Direction where -import qualified Data.ByteString as B+import Data.ByteString.Short  data Direction = Upload | Download 	deriving (Eq, Ord, Show, Read) -formatDirection :: Direction -> B.ByteString+formatDirection :: Direction -> ShortByteString formatDirection Upload = "upload" formatDirection Download = "download" -parseDirection :: String -> Maybe Direction+parseDirection :: ShortByteString -> Maybe Direction parseDirection "upload" = Just Upload parseDirection "download" = Just Download parseDirection _ = Nothing
Types/Distribution.hs view
@@ -40,10 +40,9 @@ formatInfoFile d = replace "keyVariant = " "keyBackendName = " (show d) ++ 	"\n" ++ formatGitAnnexDistribution d -parseInfoFile :: String -> Maybe GitAnnexDistribution-parseInfoFile s = case lines s of-	(_oldformat:rest) -> parseGitAnnexDistribution (unlines rest)-	_ -> Nothing+parseInfoFile :: [String] -> Maybe GitAnnexDistribution+parseInfoFile (_oldformat:rest) = parseGitAnnexDistribution (unlines rest)+parseInfoFile _ = Nothing  formatGitAnnexDistribution :: GitAnnexDistribution -> String formatGitAnnexDistribution d = unlines
Types/Export.hs view
@@ -1,11 +1,12 @@ {- git-annex export types  -- - Copyright 2017-2021 Joey Hess <id@joeyh.name>+ - Copyright 2017-2025 Joey Hess <id@joeyh.name>  -  - Licensed under the GNU AGPL version 3 or higher.  -}  {-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE CPP #-}  module Types.Export ( 	ExportLocation,@@ -19,48 +20,63 @@  import Git.FilePath import Utility.Split-import Utility.FileSystemEncoding+import Utility.OsPath -import qualified Data.ByteString.Short as S-import qualified System.FilePath.Posix as Posix import GHC.Generics import Control.DeepSeq+#ifdef WITH_OSPATH+import qualified System.OsPath.Posix as Posix+import System.OsString.Internal.Types+#else+import qualified System.FilePath.Posix as Posix+import Utility.FileSystemEncoding+#endif  -- A location such as a path on a remote, that a key can be exported to. -- The path is relative to the top of the remote, and uses unix-style -- path separators. ----- This uses a ShortByteString to avoid problems with ByteString getting--- PINNED in memory which caused memory fragmentation and excessive memory--- use.-newtype ExportLocation = ExportLocation S.ShortByteString+-- This must be a ShortByteString (which OsPath is) in order to to avoid+-- problems with ByteString getting PINNED in memory which caused memory+-- fragmentation and excessive memory use.+newtype ExportLocation = ExportLocation OsPath 	deriving (Show, Eq, Generic, Ord)  instance NFData ExportLocation -mkExportLocation :: RawFilePath -> ExportLocation-mkExportLocation = ExportLocation . S.toShort . toInternalGitPath+mkExportLocation :: OsPath -> ExportLocation+mkExportLocation = ExportLocation . toInternalGitPath -fromExportLocation :: ExportLocation -> RawFilePath-fromExportLocation (ExportLocation f) = S.fromShort f+fromExportLocation :: ExportLocation -> OsPath+fromExportLocation (ExportLocation f) = f -newtype ExportDirectory = ExportDirectory RawFilePath+newtype ExportDirectory = ExportDirectory OsPath 	deriving (Show, Eq) -mkExportDirectory :: RawFilePath -> ExportDirectory+mkExportDirectory :: OsPath -> ExportDirectory mkExportDirectory = ExportDirectory . toInternalGitPath -fromExportDirectory :: ExportDirectory -> RawFilePath+fromExportDirectory :: ExportDirectory -> OsPath fromExportDirectory (ExportDirectory f) = f  -- | All subdirectories down to the ExportLocation, with the deepest ones -- last. Does not include the top of the export. exportDirectories :: ExportLocation -> [ExportDirectory] exportDirectories (ExportLocation f) =-	map (ExportDirectory . encodeBS . Posix.joinPath . reverse) (subs [] dirs)+	map (ExportDirectory . fromposixpath . Posix.joinPath . reverse)+		(subs [] dirs)   where 	subs _ [] = [] 	subs ps (d:ds) = (d:ps) : subs (d:ps) ds +#ifdef WITH_OSPATH 	dirs = map Posix.dropTrailingPathSeparator $-		dropFromEnd 1 $ Posix.splitPath $ decodeBS $ S.fromShort f+		dropFromEnd 1 $ Posix.splitPath $ PosixString $ fromOsPath f++	fromposixpath = toOsPath . getPosixString+#else+	dirs = map Posix.dropTrailingPathSeparator $+		dropFromEnd 1 $ Posix.splitPath $ fromOsPath f++	fromposixpath = encodeBS+#endif
Types/FileMatcher.hs view
@@ -14,7 +14,7 @@ import Types.RepoSize (LiveUpdate) import Utility.Matcher (Matcher, Token, MatchDesc) import Utility.FileSize-import Utility.FileSystemEncoding+import Utility.OsPath  import Control.Monad.IO.Class import qualified Data.Map as M@@ -27,10 +27,10 @@ 	| MatchingUserInfo UserProvidedInfo  data FileInfo = FileInfo-	{ contentFile :: RawFilePath+	{ contentFile :: OsPath 	-- ^ path to a file containing the content, for operations 	-- that examine it-	, matchFile :: RawFilePath+	, matchFile :: OsPath 	-- ^ filepath to match on; may be relative to top of repo or cwd, 	-- depending on how globs in preferred content expressions 	-- are intended to be matched@@ -39,7 +39,7 @@ 	}  data ProvidedInfo = ProvidedInfo-	{ providedFilePath :: Maybe RawFilePath+	{ providedFilePath :: Maybe OsPath 	-- ^ filepath to match on, should not be accessed from disk. 	, providedKey :: Maybe Key 	, providedFileSize :: Maybe FileSize@@ -48,7 +48,7 @@ 	, providedLinkType :: Maybe LinkType 	} -keyMatchInfoWithoutContent :: Key -> RawFilePath -> MatchInfo+keyMatchInfoWithoutContent :: Key -> OsPath -> MatchInfo keyMatchInfoWithoutContent key file = MatchingInfo $ ProvidedInfo 	{ providedFilePath = Just file 	, providedKey = Just key@@ -61,7 +61,7 @@ -- This is used when testing a matcher, with values to match against -- provided by the user. data UserProvidedInfo = UserProvidedInfo-	{ userProvidedFilePath :: UserInfo FilePath+	{ userProvidedFilePath :: UserInfo OsPath 	, userProvidedKey :: UserInfo Key 	, userProvidedFileSize :: UserInfo FileSize 	, userProvidedMimeType :: UserInfo MimeType
Types/GitConfig.hs view
@@ -64,7 +64,6 @@ import qualified Data.Set as S import qualified Data.Map as M import qualified Data.ByteString as B-import qualified System.FilePath.ByteString as P  -- | A configurable value, that may not be fully determined yet because -- the global git config has not yet been loaded.@@ -138,7 +137,7 @@ 	, annexVerify :: Bool 	, annexPidLock :: Bool 	, annexPidLockTimeout :: Seconds-	, annexDbDir :: Maybe RawFilePath+	, annexDbDir :: Maybe OsPath 	, annexAddUnlocked :: GlobalConfigurable (Maybe String) 	, annexSecureHashesOnly :: Bool 	, annexRetry :: Maybe Integer@@ -147,6 +146,7 @@ 	, annexAllowedUrlSchemes :: S.Set Scheme 	, annexAllowedIPAddresses :: String 	, annexAllowUnverifiedDownloads :: Bool+	, annexAllowedComputePrograms :: Maybe String 	, annexMaxExtensionLength :: Maybe Int 	, annexMaxExtensions :: Maybe Int 	, annexJobs :: Concurrency@@ -244,7 +244,7 @@ 	, annexPidLock = getbool (annexConfig "pidlock") False 	, annexPidLockTimeout = Seconds $ fromMaybe 300 $ 		getmayberead (annexConfig "pidlocktimeout")-	, annexDbDir = (\d -> toRawFilePath d P.</> fromUUID hereuuid)+	, annexDbDir = (\d -> toOsPath d </> fromUUID hereuuid) 		<$> getmaybe (annexConfig "dbdir") 	, annexAddUnlocked = configurable Nothing $ 		fmap Just $ getmaybe (annexConfig "addunlocked")@@ -262,6 +262,8 @@ 		getmaybe (annexConfig "security.allowed-http-addresses") -- old name 	, annexAllowUnverifiedDownloads = (== Just "ACKTHPPT") $ 		getmaybe (annexConfig "security.allow-unverified-downloads")+	, annexAllowedComputePrograms =+		getmaybe (annexConfig "security.allowed-compute-programs") 	, annexMaxExtensionLength = getmayberead (annexConfig "maxextensionlength") 	, annexMaxExtensions = getmayberead (annexConfig "maxextensions") 	, annexJobs = fromMaybe NonConcurrent $
Types/Import.hs view
@@ -6,6 +6,7 @@  -}  {-# LANGUAGE DeriveGeneric, DeriveFunctor #-}+{-# LANGUAGE CPP #-}  module Types.Import where @@ -13,21 +14,27 @@ import Data.Char import Control.DeepSeq import GHC.Generics+#ifdef WITH_OSPATH+import qualified System.OsPath.Posix as Posix+import System.OsString.Internal.Types+#else import qualified System.FilePath.Posix.ByteString as Posix+#endif  import Types.Export import Utility.QuickCheck import Utility.FileSystemEncoding+import Utility.OsPath  {- Location of content on a remote that can be imported.   - This is just an alias to ExportLocation, because both are referring to a  - location on the remote. -} type ImportLocation = ExportLocation -mkImportLocation :: RawFilePath -> ImportLocation+mkImportLocation :: OsPath -> ImportLocation mkImportLocation = mkExportLocation -fromImportLocation :: ImportLocation -> RawFilePath+fromImportLocation :: ImportLocation -> OsPath fromImportLocation = fromExportLocation  {- An identifier for content stored on a remote that has been imported into@@ -87,7 +94,7 @@  - of the main tree. Nested subtrees are not allowed. -} data ImportableContentsChunk m info = ImportableContentsChunk 	{ importableContentsSubDir :: ImportChunkSubDir-	, importableContentsSubTree :: [(RawFilePath, info)]+	, importableContentsSubTree :: [(OsPath, info)] 	-- ^ locations are relative to importableContentsSubDir 	, importableContentsNextChunk :: m (Maybe (ImportableContentsChunk m info)) 	-- ^ Continuation to get the next chunk.@@ -95,11 +102,17 @@ 	} 	deriving (Functor) -newtype ImportChunkSubDir = ImportChunkSubDir { importChunkSubDir :: RawFilePath }+newtype ImportChunkSubDir = ImportChunkSubDir { importChunkSubDir :: OsPath }  importableContentsChunkFullLocation 	:: ImportChunkSubDir-	-> RawFilePath+	-> OsPath 	-> ImportLocation importableContentsChunkFullLocation (ImportChunkSubDir root) loc =+#ifdef WITH_OSPATH+	mkImportLocation $ toOsPath $ getPosixString $ Posix.combine +		(PosixString $ fromOsPath root)+		(PosixString $ fromOsPath loc)+#else 	mkImportLocation $ Posix.combine root loc+#endif
Types/Key.hs view
@@ -28,6 +28,8 @@ 	parseKeyVariety, ) where +import Utility.OsPath+ import qualified Data.ByteString as S import qualified Data.ByteString.Short as S (ShortByteString, toShort, fromShort) import qualified Data.ByteString.Char8 as S8@@ -36,7 +38,6 @@ import Data.ByteString.Builder.Extra import qualified Data.Attoparsec.ByteString as A import qualified Data.Attoparsec.ByteString.Char8 as A8-import Utility.FileSystemEncoding import Data.List import Data.Char import System.Posix.Types@@ -202,8 +203,8 @@ splitKeyNameExtension' keyname = S8.span (/= '.') keyname  {- A filename may be associated with a Key. -}-newtype AssociatedFile = AssociatedFile (Maybe RawFilePath)-	deriving (Show, Read, Eq, Ord)+newtype AssociatedFile = AssociatedFile (Maybe OsPath)+	deriving (Show, Eq, Ord)  {- There are several different varieties of keys. -} data KeyVariety
Types/KeySource.hs view
@@ -8,7 +8,7 @@ module Types.KeySource where  import Utility.InodeCache-import System.FilePath.ByteString (RawFilePath)+import Utility.OsPath  {- When content is in the process of being ingested into the annex,  - and a Key generated from it, this data type is used. @@ -23,8 +23,8 @@  - files that may be made while they're in the process of being ingested.  -} data KeySource = KeySource-	{ keyFilename :: RawFilePath-	, contentLocation :: RawFilePath+	{ keyFilename :: OsPath+	, contentLocation :: OsPath 	, inodeCache :: Maybe InodeCache 	} 	deriving (Show)
Types/LockCache.hs view
@@ -13,6 +13,6 @@ import Utility.LockPool (LockHandle)  import qualified Data.Map as M-import System.FilePath.ByteString (RawFilePath)+import Utility.OsPath -type LockCache = M.Map RawFilePath LockHandle+type LockCache = M.Map OsPath LockHandle
Types/Remote.hs view
@@ -31,6 +31,7 @@  import Data.Ord +import Common import qualified Git import Types.Key import Types.UUID@@ -47,7 +48,6 @@ import Config.Cost import Utility.Metered import Git.Types (RemoteName)-import Utility.SafeCommand import Utility.Url import Utility.DataUnits @@ -92,18 +92,18 @@ 	-- The key should not appear to be present on the remote until 	-- all of its contents have been transferred. 	-- Throws exception on failure.-	, storeKey :: Key -> AssociatedFile -> Maybe FilePath -> MeterUpdate -> a ()+	, storeKey :: Key -> AssociatedFile -> Maybe OsPath -> MeterUpdate -> a () 	-- Retrieves a key's contents to a file. 	-- (The MeterUpdate does not need to be used if it writes 	-- sequentially to the file.) 	-- Throws exception on failure.-	, retrieveKeyFile :: Key -> AssociatedFile -> FilePath -> MeterUpdate -> VerifyConfigA a -> a Verification+	, retrieveKeyFile :: Key -> AssociatedFile -> OsPath -> MeterUpdate -> VerifyConfigA a -> a Verification 	{- Will retrieveKeyFile write to the file in order? -} 	, retrieveKeyFileInOrder :: a Bool 	-- Retrieves a key's contents to a tmp file, if it can be done cheaply. 	-- It's ok to create a symlink or hardlink. 	-- Throws exception on failure.-	, retrieveKeyFileCheap :: Maybe (Key -> AssociatedFile -> FilePath -> a ())+	, retrieveKeyFileCheap :: Maybe (Key -> AssociatedFile -> OsPath -> a ()) 	-- Security policy for reteiving keys from this remote. 	, retrievalSecurityPolicy :: RetrievalSecurityPolicy 	-- Removes a key's contents (succeeds even the contents are not present)@@ -147,7 +147,7 @@ 	-- a Remote's configuration from git 	, gitconfig :: RemoteGitConfig 	-- a Remote can be associated with a specific local filesystem path-	, localpath :: Maybe FilePath+	, localpath :: Maybe OsPath 	-- a Remote can be known to be readonly 	, readonly :: Bool 	-- a Remote can allow writes but not have a way to delete content@@ -270,12 +270,12 @@ 	-- The exported file should not appear to be present on the remote 	-- until all of its contents have been transferred. 	-- Throws exception on failure.-	{ storeExport :: FilePath -> Key -> ExportLocation -> MeterUpdate -> a ()+	{ storeExport :: OsPath -> Key -> ExportLocation -> MeterUpdate -> a () 	-- Retrieves exported content to a file. 	-- (The MeterUpdate does not need to be used if it writes 	-- sequentially to the file.) 	-- Throws exception on failure.-	, retrieveExport :: Key -> ExportLocation -> FilePath -> MeterUpdate -> a Verification+	, retrieveExport :: Key -> ExportLocation -> OsPath -> MeterUpdate -> a Verification 	-- Removes an exported file (succeeds if the contents are not present) 	-- Can throw exception if unable to access remote, or if remote 	-- refuses to remove the content.@@ -351,7 +351,7 @@ 		:: ExportLocation 		-> [ContentIdentifier] 		-- file to write content to-		-> FilePath+		-> OsPath 		-- Either the key, or when it's not yet known, a callback 		-- that generates a key from the downloaded content. 		-> Either Key (a Key)@@ -376,7 +376,7 @@ 	-- 	-- Throws exception on failure. 	, storeExportWithContentIdentifier-		:: FilePath+		:: OsPath 		-> Key 		-> ExportLocation 		-- old content that it's safe to overwrite
Types/StoreRetrieve.hs view
@@ -18,7 +18,7 @@  -- A source of a Key's content. data ContentSource-	= FileContent FilePath+	= FileContent OsPath 	| ByteContent L.ByteString  isByteContent :: ContentSource -> Bool@@ -43,7 +43,7 @@ -- content to the verifier before running the callback. -- This should not be done when it retrieves ByteContent. type Retriever = forall a.-	Key -> MeterUpdate -> RawFilePath -> Maybe IncrementalVerifier+	Key -> MeterUpdate -> OsPath -> Maybe IncrementalVerifier 		-> (ContentSource -> Annex a) -> Annex a  -- Action that removes a Key's content from a remote.
Types/Transfer.hs view
@@ -19,7 +19,7 @@ import Utility.PID import Utility.QuickCheck import Utility.Url-import Utility.FileSystemEncoding+import Utility.OsPath  import Data.Time.Clock.POSIX import Control.Concurrent@@ -99,7 +99,7 @@ 	descTransfrerrable :: t -> Maybe String  instance Transferrable AssociatedFile where-	descTransfrerrable (AssociatedFile af) = fromRawFilePath <$> af+	descTransfrerrable (AssociatedFile af) = fromOsPath <$> af  instance Transferrable URLString where 	descTransfrerrable = Just
Types/Transferrer.hs view
@@ -153,10 +153,10 @@ 	-- Comes last, so whitespace is ok. But, in case the filename 	-- contains eg a newline, escape it. Use C-style encoding. 	serialize (TransferAssociatedFile (AssociatedFile (Just f))) =-		decodeBS (encode_c isUtf8Byte f)+		fromRawFilePath (encode_c isUtf8Byte (fromOsPath f)) 	serialize (TransferAssociatedFile (AssociatedFile Nothing)) = ""  	deserialize "" = Just $ TransferAssociatedFile $ 		AssociatedFile Nothing 	deserialize s = Just $ TransferAssociatedFile $-		AssociatedFile $ Just $ decode_c $ encodeBS s+		AssociatedFile $ Just $ toOsPath $ decode_c $ toRawFilePath s
Types/Transitions.hs view
@@ -7,7 +7,7 @@  module Types.Transitions where -import Utility.RawFilePath+import Utility.OsPath  import qualified Data.ByteString.Lazy as L import Data.ByteString.Builder@@ -16,4 +16,4 @@ 	= ChangeFile Builder 	| PreserveFile -type TransitionCalculator = RawFilePath -> L.ByteString -> FileTransition+type TransitionCalculator = OsPath -> L.ByteString -> FileTransition
Types/UUID.hs view
@@ -5,11 +5,14 @@  - Licensed under the GNU AGPL version 3 or higher.  -} -{-# LANGUAGE TypeSynonymInstances, FlexibleInstances, GeneralizedNewtypeDeriving #-}+{-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE CPP #-}  module Types.UUID where  import qualified Data.ByteString as B+import qualified Data.ByteString.Short as SB import qualified Data.Text as T import qualified Data.Map as M import qualified Data.UUID as U@@ -19,8 +22,8 @@ import Control.DeepSeq import qualified Data.Semigroup as Sem +import Common import Git.Types (ConfigValue(..))-import Utility.FileSystemEncoding import Utility.QuickCheck import Utility.Aeson import qualified Utility.SimpleProtocol as Proto@@ -53,6 +56,25 @@ 	toUUID b 		| B.null b = NoUUID 		| otherwise = UUID b++instance FromUUID SB.ShortByteString where+	fromUUID (UUID u) = SB.toShort u+	fromUUID NoUUID = SB.empty++instance ToUUID SB.ShortByteString where+	toUUID b+		| SB.null b = NoUUID+		| otherwise = UUID (SB.fromShort b)++#ifdef WITH_OSPATH+-- OsPath is a ShortByteString internally, so this is the most+-- efficient conversion.+instance FromUUID OsPath where+	fromUUID s = toOsPath (fromUUID s :: SB.ShortByteString)++instance ToUUID OsPath where+	toUUID s = toUUID (fromOsPath s :: SB.ShortByteString)+#endif  instance FromUUID String where 	fromUUID s = decodeBS (fromUUID s)
Types/UrlContents.hs view
@@ -10,11 +10,12 @@ ) where  import Utility.Url+import Utility.OsPath  data UrlContents 	-- An URL contains a file, whose size may be known. 	-- There might be a nicer filename to use.-	= UrlContents (Maybe Integer) (Maybe FilePath)+	= UrlContents (Maybe Integer) (Maybe OsPath) 	-- Sometimes an URL points to multiple files, each accessible 	-- by their own URL.-	| UrlMulti [(URLString, Maybe Integer, FilePath)]+	| UrlMulti [(URLString, Maybe Integer, OsPath)]
Upgrade.hs view
@@ -60,7 +60,7 @@ 		g <- Annex.gitRepo 		p <- liftIO $ absPath $ Git.repoPath g 		return $ Just $ unwords-			[ "Repository", fromRawFilePath p+			[ "Repository", fromOsPath p 			, "is at" 			, if v `elem` supportedVersions  				then "supported"@@ -117,7 +117,7 @@ 	-- This avoids complicating the upgrade code by needing to handle 	-- upgrading a git repo other than the current repo. 	upgraderemote = do-		rp <- fromRawFilePath <$> fromRepo Git.repoPath+		rp <- fromOsPath <$> fromRepo Git.repoPath 		ok <- gitAnnexChildProcess "upgrade" 			[ Param "--quiet" 			, Param "--autoonly"
Upgrade/V0.hs view
@@ -22,11 +22,10 @@ 	showAction "v0 to v1"  	-- do the reorganisation of the key files-	olddir <- fromRawFilePath <$> fromRepo gitAnnexDir+	olddir <- fromRepo gitAnnexDir 	keys <- getKeysPresent0 olddir 	forM_ keys $ \k ->-		moveAnnex k (AssociatedFile Nothing)-			(toRawFilePath $ olddir </> keyFile0 k)+		moveAnnex k (olddir </> toOsPath (keyFile0 k))  	-- update the symlinks to the key files 	-- No longer needed here; V1.upgrade does the same thing@@ -39,20 +38,18 @@ keyFile0 = Upgrade.V1.keyFile1 fileKey0 :: FilePath -> Key fileKey0 = Upgrade.V1.fileKey1-lookupKey0 :: FilePath -> Annex (Maybe (Key, Backend))-lookupKey0 = Upgrade.V1.lookupKey1 -getKeysPresent0 :: FilePath -> Annex [Key]+getKeysPresent0 :: OsPath -> Annex [Key] getKeysPresent0 dir = ifM (liftIO $ doesDirectoryExist dir)-	( liftIO $ map fileKey0+	( liftIO $ map (fileKey0 . fromOsPath) 		<$> (filterM present =<< getDirectoryContents dir) 	, return [] 	)   where 	present d = do 		result <- tryIO $-			R.getFileStatus $ toRawFilePath $-				dir ++ "/" ++ takeFileName d+			R.getFileStatus $ fromOsPath $+				dir <> literalOsPath "/" <> takeFileName d 		case result of 			Right s -> return $ isRegularFile s 			Left _ -> return False
Upgrade/V1.hs view
@@ -15,8 +15,6 @@ import Data.ByteString.Builder import qualified Data.ByteString as S import qualified Data.ByteString.Short as S (toShort, fromShort)-import qualified Data.ByteString.Lazy as L-import qualified System.FilePath.ByteString as P import System.PosixCompat.Files (isRegularFile) import Text.Read @@ -35,6 +33,7 @@ import Utility.Tmp import qualified Upgrade.V2 import qualified Utility.RawFilePath as R+import qualified Utility.FileIO as F  -- v2 adds hashing of filenames of content and location log files. -- Key information is encoded in filenames differently, so@@ -82,20 +81,19 @@ 	forM_ files move   where 	move f = do-		let f' = toRawFilePath f-		let k = fileKey1 (fromRawFilePath (P.takeFileName f'))-		let d = parentDir f'+		let k = fileKey1 (fromOsPath $ takeFileName f)+		let d = parentDir f 		liftIO $ allowWrite d-		liftIO $ allowWrite f'-		_ <- moveAnnex k (AssociatedFile Nothing) f'-		liftIO $ removeDirectory (fromRawFilePath d)+		liftIO $ allowWrite f+		_ <- moveAnnex k f+		liftIO $ removeDirectory d  updateSymlinks :: Annex () updateSymlinks = do 	showAction "updating symlinks" 	top <- fromRepo Git.repoPath 	(files, cleanup) <- inRepo $ LsFiles.inRepo [] [top]-	forM_ files (fixlink . fromRawFilePath)+	forM_ files fixlink 	void $ liftIO cleanup   where 	fixlink f = do@@ -103,11 +101,10 @@ 		case r of 			Nothing -> noop 			Just (k, _) -> do-				link <- fromRawFilePath-					<$> calcRepo (gitAnnexLink (toRawFilePath f) k)+				link <- calcRepo (gitAnnexLink f k) 				liftIO $ removeFile f-				liftIO $ R.createSymbolicLink (toRawFilePath link) (toRawFilePath f)-				Annex.Queue.addCommand [] "add" [Param "--"] [f]+				liftIO $ R.createSymbolicLink (fromOsPath link) (fromOsPath f)+				Annex.Queue.addCommand [] "add" [Param "--"] [(fromOsPath f)]  moveLocationLogs :: Annex () moveLocationLogs = do@@ -118,15 +115,15 @@ 	oldlocationlogs = do 		dir <- fromRepo Upgrade.V2.gitStateDir 		ifM (liftIO $ doesDirectoryExist dir)-			( mapMaybe oldlog2key+			( mapMaybe (oldlog2key . fromOsPath) 				<$> liftIO (getDirectoryContents dir) 			, return [] 			) 	move (l, k) = do 		dest <- fromRepo (logFile2 k) 		dir <- fromRepo Upgrade.V2.gitStateDir-		let f = dir </> l-		createWorkTreeDirectory (parentDir (toRawFilePath dest))+		let f = dir </> toOsPath l+		createWorkTreeDirectory (parentDir dest) 		-- could just git mv, but this way deals with 		-- log files that are not checked into git, 		-- as well as merging with already upgraded@@ -134,9 +131,9 @@ 		old <- liftIO $ readLog1 f 		new <- liftIO $ readLog1 dest 		liftIO $ writeLog1 dest (old++new)-		Annex.Queue.addCommand [] "add" [Param "--"] [dest]-		Annex.Queue.addCommand [] "add" [Param "--"] [f]-		Annex.Queue.addCommand [] "rm" [Param "--quiet", Param "-f", Param "--"] [f]+		Annex.Queue.addCommand [] "add" [Param "--"] [fromOsPath dest]+		Annex.Queue.addCommand [] "add" [Param "--"] [fromOsPath f]+		Annex.Queue.addCommand [] "rm" [Param "--quiet", Param "-f", Param "--"] [fromOsPath f]  oldlog2key :: FilePath -> Maybe (FilePath, Key) oldlog2key l@@ -197,68 +194,64 @@ fileKey1 file = readKey1 $ 	replace "&a" "&" $ replace "&s" "%" $ replace "%" "/" file -writeLog1 :: FilePath -> [LogLine] -> IO ()-writeLog1 file ls = viaTmp L.writeFile file (toLazyByteString $ buildLog ls)+writeLog1 :: OsPath -> [LogLine] -> IO ()+writeLog1 file ls = viaTmp F.writeFile file (toLazyByteString $ buildLog ls) -readLog1 :: FilePath -> IO [LogLine]-readLog1 file = catchDefaultIO [] $-	parseLog . encodeBL <$> readFileStrict file+readLog1 :: OsPath -> IO [LogLine]+readLog1 file = catchDefaultIO [] $ parseLog <$> F.readFile file -lookupKey1 :: FilePath -> Annex (Maybe (Key, Backend))+lookupKey1 :: OsPath -> Annex (Maybe (Key, Backend)) lookupKey1 file = do 	tl <- liftIO $ tryIO getsymlink 	case tl of 		Left _ -> return Nothing 		Right l -> makekey l   where-	getsymlink = takeFileName . fromRawFilePath-		<$> R.readSymbolicLink (toRawFilePath file)+	getsymlink :: IO OsPath+	getsymlink = takeFileName . toOsPath+		<$> R.readSymbolicLink (fromOsPath file) 	makekey l = maybeLookupBackendVariety (fromKey keyVariety k) >>= \case 		Nothing -> do 			unless (null kname || null bname ||-			        not (isLinkToAnnex (toRawFilePath l))) $+			        not (isLinkToAnnex (fromOsPath l))) $ 				warning (UnquotedString skip) 			return Nothing 		Just backend -> return $ Just (k, backend) 	  where-		k = fileKey1 l+		k = fileKey1 (fromOsPath l) 		bname = decodeBS (formatKeyVariety (fromKey keyVariety k)) 		kname = decodeBS (S.fromShort (fromKey keyName k))-		skip = "skipping " ++ file ++ +		skip = "skipping " ++ fromOsPath file ++  			" (unknown backend " ++ bname ++ ")" -getKeyFilesPresent1 :: Annex [FilePath]-getKeyFilesPresent1  = getKeyFilesPresent1' . fromRawFilePath-	=<< fromRepo gitAnnexObjectDir-getKeyFilesPresent1' :: FilePath -> Annex [FilePath]+getKeyFilesPresent1 :: Annex [OsPath]+getKeyFilesPresent1  = getKeyFilesPresent1' =<< fromRepo gitAnnexObjectDir+getKeyFilesPresent1' :: OsPath -> Annex [OsPath] getKeyFilesPresent1' dir = 	ifM (liftIO $ doesDirectoryExist dir) 		(  do 			dirs <- liftIO $ getDirectoryContents dir-			let files = map (\d -> dir ++ "/" ++ d ++ "/" ++ takeFileName d) dirs+			let files = map (\d -> dir <> literalOsPath "/" <> d <> literalOsPath "/" <> takeFileName d) dirs 			liftIO $ filterM present files 		, return [] 		)   where+	present :: OsPath -> IO Bool 	present f = do-		result <- tryIO $ R.getFileStatus (toRawFilePath f)+		result <- tryIO $ R.getFileStatus (fromOsPath f) 		case result of 			Right s -> return $ isRegularFile s 			Left _ -> return False -logFile1 :: Git.Repo -> Key -> String-logFile1 repo key = Upgrade.V2.gitStateDir repo ++ keyFile1 key ++ ".log"--logFile2 :: Key -> Git.Repo -> String+logFile2 :: Key -> Git.Repo -> OsPath logFile2 = logFile' (hashDirLower def) -logFile' :: (Key -> RawFilePath) -> Key -> Git.Repo -> String+logFile' :: (Key -> OsPath) -> Key -> Git.Repo -> OsPath logFile' hasher key repo =-	gitStateDir repo ++ fromRawFilePath (hasher key) ++ fromRawFilePath (keyFile key) ++ ".log"+	gitStateDir repo <> hasher key <> keyFile key <> literalOsPath ".log" -stateDir :: FilePath-stateDir = addTrailingPathSeparator ".git-annex"+stateDir :: OsPath+stateDir = addTrailingPathSeparator (literalOsPath ".git-annex") -gitStateDir :: Git.Repo -> FilePath-gitStateDir repo = addTrailingPathSeparator $-	fromRawFilePath (Git.repoPath repo) </> stateDir+gitStateDir :: Git.Repo -> OsPath+gitStateDir repo = addTrailingPathSeparator $ Git.repoPath repo </> stateDir
Upgrade/V2.hs view
@@ -20,11 +20,13 @@ import Utility.Tmp import Logs import Messages.Progress+import qualified Utility.FileIO as F+import qualified Utility.OsString as OS -olddir :: Git.Repo -> FilePath+olddir :: Git.Repo -> OsPath olddir g-	| Git.repoIsLocalBare g = ""-	| otherwise = ".git-annex"+	| Git.repoIsLocalBare g = literalOsPath ""+	| otherwise = literalOsPath ".git-annex"  {- .git-annex/ moved to a git-annex branch.  - @@ -53,14 +55,14 @@ 	e <- liftIO $ doesDirectoryExist old 	when e $ do 		config <- Annex.getGitConfig-		mapM_ (\(k, f) -> inject f $ fromRawFilePath $ locationLogFile config k) =<< locationLogs+		mapM_ (\(k, f) -> inject f $ locationLogFile config k) =<< locationLogs 		mapM_ (\f -> inject f f) =<< logFiles old  	saveState False 	showProgressDots  	when e $ do-		inRepo $ Git.Command.run [Param "rm", Param "-r", Param "-f", Param "-q", File old]+		inRepo $ Git.Command.run [Param "rm", Param "-r", Param "-f", Param "-q", File (fromOsPath old)] 		unless bare $ inRepo gitAttributesUnWrite 	showProgressDots @@ -68,7 +70,7 @@  	return UpgradeSuccess -locationLogs :: Annex [(Key, FilePath)]+locationLogs :: Annex [(Key, OsPath)] locationLogs = do 	config <- Annex.getGitConfig 	dir <- fromRepo gitStateDir@@ -80,17 +82,17 @@   where 	tryDirContents d = catchDefaultIO [] $ dirContents d 	islogfile config f = maybe Nothing (\k -> Just (k, f)) $-			locationLogFileKey config (toRawFilePath f)+			locationLogFileKey config f -inject :: FilePath -> FilePath -> Annex ()+inject :: OsPath -> OsPath -> Annex () inject source dest = do 	old <- fromRepo olddir-	new <- liftIO (readFile $ old </> source)-	Annex.Branch.change (Annex.Branch.RegardingUUID []) (toRawFilePath dest) $ \prev -> +	new <- liftIO (readFile $ fromOsPath $ old </> source)+	Annex.Branch.change (Annex.Branch.RegardingUUID []) dest $ \prev ->  		encodeBL $ unlines $ nub $ lines (decodeBL prev) ++ lines new -logFiles :: FilePath -> Annex [FilePath]-logFiles dir = return . filter (".log" `isSuffixOf`)+logFiles :: OsPath -> Annex [OsPath]+logFiles dir = return . filter (literalOsPath ".log" `OS.isSuffixOf`) 		<=< liftIO $ getDirectoryContents dir  push :: Annex ()@@ -129,22 +131,22 @@ {- Old .gitattributes contents, not needed anymore. -} attrLines :: [String] attrLines =-	[ stateDir </> "*.log merge=union"-	, stateDir </> "*/*/*.log merge=union"+	[ fromOsPath $ stateDir </> literalOsPath "*.log merge=union"+	, fromOsPath $ stateDir </> literalOsPath "*/*/*.log merge=union" 	]  gitAttributesUnWrite :: Git.Repo -> IO () gitAttributesUnWrite repo = do-	let attributes = fromRawFilePath (Git.attributes repo)+	let attributes = Git.attributes repo 	whenM (doesFileExist attributes) $ do-		c <- readFileStrict attributes-		liftIO $ viaTmp writeFile attributes $ unlines $-			filter (`notElem` attrLines) $ lines c-		Git.Command.run [Param "add", File attributes] repo+		c <- map decodeBS . fileLines'+			<$> F.readFile' attributes+		liftIO $ viaTmp (writeFile . fromOsPath) attributes +			(unlines $ filter (`notElem` attrLines) c)+		Git.Command.run [Param "add", File (fromOsPath attributes)] repo -stateDir :: FilePath-stateDir = addTrailingPathSeparator ".git-annex"+stateDir :: OsPath+stateDir = addTrailingPathSeparator (literalOsPath ".git-annex") -gitStateDir :: Git.Repo -> FilePath-gitStateDir repo = addTrailingPathSeparator $-	fromRawFilePath (Git.repoPath repo) </> stateDir+gitStateDir :: Git.Repo -> OsPath+gitStateDir repo = addTrailingPathSeparator $ Git.repoPath repo </> stateDir
Upgrade/V5.hs view
@@ -33,9 +33,7 @@ import Utility.InodeCache import Utility.DottedVersion import Annex.AdjustedBranch-import qualified Utility.RawFilePath as R--import qualified Data.ByteString as S+import qualified Utility.FileIO as F  upgrade :: Bool -> Annex UpgradeResult upgrade automatic = flip catchNonAsync onexception $ do@@ -130,8 +128,8 @@ 			Just k -> do 				stagePointerFile f Nothing =<< hashPointerFile k 				ifM (isJust <$> getAnnexLinkTarget f)-					( writepointer (fromRawFilePath f) k-					, fromdirect (fromRawFilePath f) k+					( writepointer f k+					, fromdirect f k 					) 				Database.Keys.addAssociatedFile k 					=<< inRepo (toTopFilePath f)@@ -139,14 +137,13 @@  	fromdirect f k = ifM (Direct.goodContent k f) 		( do-			let f' = toRawFilePath f 			-- If linkToAnnex fails for some reason, the work tree 			-- file still has the content; the annex object file 			-- is just not populated with it. Since the work tree 			-- file is recorded as an associated file, things will 			-- still work that way, it's just not ideal.-			ic <- withTSDelta (liftIO . genInodeCache f')-			void $ Content.linkToAnnex k f' ic+			ic <- withTSDelta (liftIO . genInodeCache f)+			void $ Content.linkToAnnex k f ic 		, unlessM (Content.inAnnex k) $ do 			-- Worktree file was deleted or modified; 			-- if there are no other copies of the content@@ -158,8 +155,8 @@ 		) 	 	writepointer f k = liftIO $ do-		removeWhenExistsWith R.removeLink (toRawFilePath f)-		S.writeFile f (formatPointer k)+		removeWhenExistsWith removeFile f+		F.writeFile' f (formatPointer k)  {- Remove all direct mode bookkeeping files. -} removeDirectCruft :: Annex ()
Upgrade/V5/Direct.hs view
@@ -28,7 +28,7 @@ import Annex.Perms import Utility.InodeCache import Annex.InodeSentinal-import qualified Utility.RawFilePath as R+import qualified Utility.FileIO as F  setIndirect :: Annex () setIndirect = do@@ -78,27 +78,27 @@ 			Nothing -> inRepo $ Git.Branch.checkout orighead  {- Absolute FilePaths of Files in the tree that are associated with a key. -}-associatedFiles :: Key -> Annex [FilePath]+associatedFiles :: Key -> Annex [OsPath] associatedFiles key = do 	files <- associatedFilesRelative key-	top <- fromRawFilePath <$> fromRepo Git.repoPath+	top <- fromRepo Git.repoPath 	return $ map (top </>) files  {- List of files in the tree that are associated with a key, relative to  - the top of the repo. -}-associatedFilesRelative :: Key -> Annex [FilePath] +associatedFilesRelative :: Key -> Annex [OsPath]  associatedFilesRelative key = do-	mapping <- fromRawFilePath <$> calcRepo (gitAnnexMapping key)-	liftIO $ catchDefaultIO [] $ withFile mapping ReadMode $ \h ->+	mapping <- calcRepo (gitAnnexMapping key)+	liftIO $ catchDefaultIO [] $ F.withFile mapping ReadMode $ \h -> 		-- Read strictly to ensure the file is closed promptly-		lines <$> hGetContentsStrict h+		map toOsPath . lines <$> hGetContentsStrict h  {- Removes the list of associated files. -} removeAssociatedFiles :: Key -> Annex () removeAssociatedFiles key = do 	mapping <- calcRepo $ gitAnnexMapping key 	modifyContentDir mapping $-		liftIO $ removeWhenExistsWith R.removeLink mapping+		liftIO $ removeWhenExistsWith removeFile mapping  {- Checks if a file in the tree, associated with a key, has not been modified.  -@@ -106,10 +106,8 @@  - expensive checksum, this relies on a cache that contains the file's  - expected mtime and inode.  -}-goodContent :: Key -> FilePath -> Annex Bool-goodContent key file =-	sameInodeCache (toRawFilePath file)-		=<< recordedInodeCache key+goodContent :: Key -> OsPath -> Annex Bool+goodContent key file = sameInodeCache file =<< recordedInodeCache key  {- Gets the recorded inode cache for a key.   -@@ -118,27 +116,26 @@ recordedInodeCache :: Key -> Annex [InodeCache] recordedInodeCache key = withInodeCacheFile key $ \f -> 	liftIO $ catchDefaultIO [] $-		mapMaybe readInodeCache . lines-			<$> readFileStrict (fromRawFilePath f)+		mapMaybe (readInodeCache . decodeBS) . fileLines'+			<$> F.readFile' f  {- Removes an inode cache. -} removeInodeCache :: Key -> Annex () removeInodeCache key = withInodeCacheFile key $ \f ->-	modifyContentDir f $-		liftIO $ removeWhenExistsWith R.removeLink f+	modifyContentDir f $ liftIO $ removeWhenExistsWith removeFile f -withInodeCacheFile :: Key -> (RawFilePath -> Annex a) -> Annex a+withInodeCacheFile :: Key -> (OsPath -> Annex a) -> Annex a withInodeCacheFile key a = a =<< calcRepo (gitAnnexInodeCache key)  {- File that maps from a key to the file(s) in the git repository. -}-gitAnnexMapping :: Key -> Git.Repo -> GitConfig -> IO RawFilePath+gitAnnexMapping :: Key -> Git.Repo -> GitConfig -> IO OsPath gitAnnexMapping key r c = do 	loc <- gitAnnexLocation key r c-	return $ loc <> ".map"+	return $ loc <> literalOsPath ".map"  {- File that caches information about a key's content, used to determine  - if a file has changed. -}-gitAnnexInodeCache :: Key -> Git.Repo -> GitConfig -> IO RawFilePath+gitAnnexInodeCache :: Key -> Git.Repo -> GitConfig -> IO OsPath gitAnnexInodeCache key r c = do 	loc <- gitAnnexLocation key r c-	return $ loc <> ".cache"+	return $ loc <> literalOsPath ".cache"
Upgrade/V7.hs view
@@ -22,8 +22,8 @@ import Git.FilePath import Config import qualified Utility.RawFilePath as R+import qualified Utility.FileIO as F -import qualified System.FilePath.ByteString as P import System.PosixCompat.Files (isSymbolicLink)  upgrade :: Bool -> Annex UpgradeResult@@ -39,48 +39,52 @@ 	-- The old content identifier database is deleted here, but the 	-- new database is not populated. It will be automatically 	-- populated from the git-annex branch the next time it is used.-	removeOldDb . fromRawFilePath =<< fromRepo gitAnnexContentIdentifierDbDirOld-	liftIO . removeWhenExistsWith R.removeLink+	removeOldDb =<< fromRepo gitAnnexContentIdentifierDbDirOld+	liftIO . removeWhenExistsWith removeFile 		=<< fromRepo gitAnnexContentIdentifierLockOld  	-- The export databases are deleted here. The new databases 	-- will be populated by the next thing that needs them, the same 	-- way as they would be in a fresh clone.-	removeOldDb . fromRawFilePath =<< calcRepo' gitAnnexExportDir+	removeOldDb =<< calcRepo' gitAnnexExportDir  	populateKeysDb-	removeOldDb . fromRawFilePath =<< fromRepo gitAnnexKeysDbOld-	liftIO . removeWhenExistsWith R.removeLink+	removeOldDb =<< fromRepo gitAnnexKeysDbOld+	liftIO . removeWhenExistsWith removeFile 		=<< fromRepo gitAnnexKeysDbIndexCacheOld-	liftIO . removeWhenExistsWith R.removeLink+	liftIO . removeWhenExistsWith removeFile 		=<< fromRepo gitAnnexKeysDbLockOld 	 	updateSmudgeFilter  	return UpgradeSuccess -gitAnnexKeysDbOld :: Git.Repo -> RawFilePath-gitAnnexKeysDbOld r = gitAnnexDir r P.</> "keys"+gitAnnexKeysDbOld :: Git.Repo -> OsPath+gitAnnexKeysDbOld r = gitAnnexDir r </> literalOsPath "keys" -gitAnnexKeysDbLockOld :: Git.Repo -> RawFilePath-gitAnnexKeysDbLockOld r = gitAnnexKeysDbOld r <> ".lck"+gitAnnexKeysDbLockOld :: Git.Repo -> OsPath+gitAnnexKeysDbLockOld r =+	gitAnnexKeysDbOld r <> literalOsPath ".lck" -gitAnnexKeysDbIndexCacheOld :: Git.Repo -> RawFilePath-gitAnnexKeysDbIndexCacheOld r = gitAnnexKeysDbOld r <> ".cache"+gitAnnexKeysDbIndexCacheOld :: Git.Repo -> OsPath+gitAnnexKeysDbIndexCacheOld r =+	gitAnnexKeysDbOld r <> literalOsPath ".cache" -gitAnnexContentIdentifierDbDirOld :: Git.Repo -> RawFilePath-gitAnnexContentIdentifierDbDirOld r = gitAnnexDir r P.</> "cids"+gitAnnexContentIdentifierDbDirOld :: Git.Repo -> OsPath+gitAnnexContentIdentifierDbDirOld r =+	gitAnnexDir r </> literalOsPath "cids" -gitAnnexContentIdentifierLockOld :: Git.Repo -> RawFilePath-gitAnnexContentIdentifierLockOld r = gitAnnexContentIdentifierDbDirOld r <> ".lck"+gitAnnexContentIdentifierLockOld :: Git.Repo -> OsPath+gitAnnexContentIdentifierLockOld r =+	gitAnnexContentIdentifierDbDirOld r <> literalOsPath ".lck" -removeOldDb :: FilePath -> Annex ()+removeOldDb :: OsPath -> Annex () removeOldDb db = 	whenM (liftIO $ doesDirectoryExist db) $ do 		v <- liftIO $ tryNonAsync $ 			removePathForcibly db 		case v of-			Left ex -> giveup $ "Failed removing old database directory " ++ db ++ " during upgrade (" ++ show ex ++ ") -- delete that and re-run git-annex to finish the upgrade."+			Left ex -> giveup $ "Failed removing old database directory " ++ fromOsPath db ++ " during upgrade (" ++ show ex ++ ") -- delete that and re-run git-annex to finish the upgrade." 			Right () -> return ()  -- Populate the new keys database with associated files and inode caches.@@ -107,11 +111,11 @@ 	(l, cleanup) <- inRepo $ LsFiles.inodeCaches [top] 	forM_ l $ \case 		(_f, Nothing) -> giveup "Unable to parse git ls-files --debug output while upgrading git-annex sqlite databases."-		(f, Just ic) -> unlessM (liftIO $ catchBoolIO $ isSymbolicLink <$> R.getSymbolicLinkStatus (toRawFilePath f)) $ do-			catKeyFile (toRawFilePath f) >>= \case+		(f, Just ic) -> unlessM (liftIO $ catchBoolIO $ isSymbolicLink <$> R.getSymbolicLinkStatus (fromOsPath f)) $ do+			catKeyFile f >>= \case 				Nothing -> noop 				Just k -> do-					topf <- inRepo $ toTopFilePath $ toRawFilePath f+					topf <- inRepo $ toTopFilePath f 					Database.Keys.runWriter AssociatedTable $ \h -> liftIO $ 						Database.Keys.SQL.addAssociatedFile k topf h 					Database.Keys.runWriter ContentTable $ \h -> liftIO $@@ -127,11 +131,12 @@ -- checked into the repository. updateSmudgeFilter :: Annex () updateSmudgeFilter = do-	lf <- fromRawFilePath <$> Annex.fromRepo Git.attributesLocal-	ls <- liftIO $ lines <$> catchDefaultIO "" (readFileStrict lf)+	lf <- Annex.fromRepo Git.attributesLocal+	ls <- liftIO $ map decodeBS . fileLines'+		<$> catchDefaultIO "" (F.readFile' lf) 	let ls' = removedotfilter ls 	when (ls /= ls') $-		liftIO $ writeFile lf (unlines ls')+		liftIO $ writeFile (fromOsPath lf) (unlines ls')   where 	removedotfilter ("* filter=annex":".* !filter":rest) = 		"* filter=annex" : removedotfilter rest
Upgrade/V9.hs view
@@ -55,7 +55,7 @@ 	 - run for an entire year and so predate the v9 upgrade. -} 	assistantrunning = do 		pidfile <- fromRepo gitAnnexPidFile-		isJust <$> liftIO (checkDaemon (fromRawFilePath pidfile))+		isJust <$> liftIO (checkDaemon pidfile) 	 	unsafeupgrade = 		[ "Not upgrading from v9 to v10, because there may be git-annex"
Utility/Aeson.hs view
@@ -8,6 +8,7 @@  -}  {-# LANGUAGE FlexibleInstances, TypeSynonymInstances #-}+{-# LANGUAGE CPP #-}  module Utility.Aeson ( 	module X,@@ -32,6 +33,9 @@ import Prelude  import Utility.FileSystemEncoding+#ifdef WITH_OSPATH+import Utility.OsPath+#endif  -- | Use this instead of Data.Aeson.encode to make sure that the -- below String instance is used.@@ -59,6 +63,11 @@ -- implementation. instance ToJSON' S.ByteString where 	toJSON' = toJSON . packByteString++#ifdef WITH_OSPATH+instance ToJSON' OsPath where+	toJSON' p = toJSON' (fromOsPath p :: S.ByteString)+#endif  -- | Pack a String to Text, correctly handling the filesystem encoding. --
Utility/CopyFile.hs view
@@ -44,12 +44,12 @@ {- The cp command is used, because I hate reinventing the wheel,  - and because this allows easy access to features like cp --reflink  - and preserving metadata. -}-copyFileExternal :: CopyMetaData -> FilePath -> FilePath -> IO Bool+copyFileExternal :: CopyMetaData -> OsPath -> OsPath -> IO Bool copyFileExternal meta src dest = do 	-- Delete any existing dest file because an unwritable file 	-- would prevent cp from working. 	void $ tryIO $ removeFile dest-	boolSystem "cp" $ params ++ [File src, File dest]+	boolSystem "cp" $ params ++ [File (fromOsPath src), File (fromOsPath dest)]   where 	params 		| BuildInfo.cp_reflink_supported =@@ -62,13 +62,13 @@  - The dest file must not exist yet, or it will fail to make a CoW copy,  - and will return False.  -}-copyCoW :: CopyMetaData -> FilePath -> FilePath -> IO Bool+copyCoW :: CopyMetaData -> OsPath -> OsPath -> IO Bool copyCoW meta src dest 	| BuildInfo.cp_reflink_supported = do 		-- When CoW is not supported, cp will complain to stderr, 		-- so have to discard its stderr. 		ok <- catchBoolIO $ withNullHandle $ \nullh ->-			let p = (proc "cp" $ toCommand $ params ++ [File src, File dest])+			let p = (proc "cp" $ toCommand $ params ++ [File (fromOsPath src), File (fromOsPath dest)]) 				{ std_out = UseHandle nullh 				, std_err = UseHandle nullh 				}@@ -87,10 +87,10 @@  {- Create a hard link if the filesystem allows it, and fall back to copying  - the file. -}-createLinkOrCopy :: RawFilePath -> RawFilePath -> IO Bool+createLinkOrCopy :: OsPath -> OsPath -> IO Bool createLinkOrCopy src dest = go `catchIO` const fallback   where 	go = do-		R.createLink src dest+		R.createLink (fromOsPath src) (fromOsPath dest) 		return True-	fallback = copyFileExternal CopyAllMetaData (fromRawFilePath src) (fromRawFilePath dest)+	fallback = copyFileExternal CopyAllMetaData src dest
Utility/Daemon.hs view
@@ -5,6 +5,7 @@  - License: BSD-2-clause  -} +{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE CPP #-}  module Utility.Daemon (@@ -25,6 +26,7 @@ #else import System.Win32.Process (terminateProcessById) import Utility.LockFile+import qualified Utility.OsString as OS #endif  #ifndef mingw32_HOST_OS@@ -42,7 +44,7 @@  - Instead, it runs the cmd with provided params, in the background,  - which the caller should arrange to run this again.  -}-daemonize :: String -> [CommandParam] -> IO Fd -> Maybe FilePath -> Bool -> IO () -> IO ()+daemonize :: String -> [CommandParam] -> IO Fd -> Maybe OsPath -> Bool -> IO () -> IO () daemonize cmd params openlogfd pidfile changedirectory a = do 	maybe noop checkalreadyrunning pidfile 	getEnv envvar >>= \case@@ -70,10 +72,10 @@  {- To run an action that is normally daemonized in the foreground. -} #ifndef mingw32_HOST_OS-foreground :: IO Fd -> Maybe FilePath -> IO () -> IO ()+foreground :: IO Fd -> Maybe OsPath -> IO () -> IO () foreground openlogfd pidfile a = do #else-foreground :: Maybe FilePath -> IO () -> IO ()+foreground :: Maybe OsPath -> IO () -> IO () foreground pidfile a = do #endif 	maybe noop lockPidFile pidfile@@ -93,12 +95,12 @@  -  - Writes the pid to the file, fully atomically.  - Fails if the pid file is already locked by another process. -}-lockPidFile :: FilePath -> IO ()+lockPidFile :: OsPath -> IO () lockPidFile pidfile = do #ifndef mingw32_HOST_OS-	fd <- openFdWithMode (toRawFilePath pidfile) ReadWrite (Just stdFileMode) defaultFileFlags+	fd <- openFdWithMode (fromOsPath pidfile) ReadWrite (Just stdFileMode) defaultFileFlags 	locked <- catchMaybeIO $ setLock fd (WriteLock, AbsoluteSeek, 0, 0)-	fd' <- openFdWithMode (toRawFilePath newfile) ReadWrite (Just stdFileMode) defaultFileFlags+	fd' <- openFdWithMode (fromOsPath newfile) ReadWrite (Just stdFileMode) defaultFileFlags 		{ trunc = True } 	locked' <- catchMaybeIO $ setLock fd' (WriteLock, AbsoluteSeek, 0, 0) 	case (locked, locked') of@@ -107,17 +109,17 @@ 		_ -> do 			_ <- fdWrite fd' =<< show <$> getPID 			closeFd fd-	rename newfile pidfile+	renameFile newfile pidfile   where-	newfile = pidfile ++ ".new"+	newfile = pidfile <> literalOsPath ".new" #else 	{- Not atomic on Windows, oh well. -} 	unlessM (isNothing <$> checkDaemon pidfile) 		alreadyRunning 	pid <- getPID-	writeFile pidfile (show pid)+	writeFile (fromOsPath pidfile) (show pid) 	lckfile <- winLockFile pid pidfile-	writeFile (fromRawFilePath lckfile) ""+	writeFile (fromOsPath lckfile) "" 	void $ lockExclusive lckfile #endif @@ -128,17 +130,17 @@  - is locked by the same process that is listed in the pid file.  -  - If it's running, returns its pid. -}-checkDaemon :: FilePath -> IO (Maybe PID)+checkDaemon :: OsPath -> IO (Maybe PID) #ifndef mingw32_HOST_OS checkDaemon pidfile = bracket setup cleanup go   where 	setup = catchMaybeIO $-		openFdWithMode (toRawFilePath pidfile) ReadOnly (Just stdFileMode) defaultFileFlags+		openFdWithMode (fromOsPath pidfile) ReadOnly (Just stdFileMode) defaultFileFlags 	cleanup (Just fd) = closeFd fd 	cleanup Nothing = return () 	go (Just fd) = catchDefaultIO Nothing $ do 		locked <- getLock fd (ReadLock, AbsoluteSeek, 0, 0)-		p <- readish <$> readFile pidfile+		p <- readish <$> readFile (fromOsPath pidfile) 		return (check locked p) 	go Nothing = return Nothing @@ -147,12 +149,12 @@ 	check (Just (pid, _)) (Just pid') 		| pid == pid' = Just pid 		| otherwise = giveup $-			"stale pid in " ++ pidfile ++ +			"stale pid in " ++ fromOsPath pidfile ++  			" (got " ++ show pid' ++  			"; expected " ++ show pid ++ " )" #else checkDaemon pidfile = maybe (return Nothing) (check . readish)-	=<< catchMaybeIO (readFile pidfile)+	=<< catchMaybeIO (readFile (fromOsPath pidfile))   where 	check Nothing = return Nothing 	check (Just pid) = do@@ -165,7 +167,7 @@ #endif  {- Stops the daemon, safely. -}-stopDaemon :: FilePath -> IO ()+stopDaemon :: OsPath -> IO () stopDaemon pidfile = go =<< checkDaemon pidfile   where 	go Nothing = noop@@ -181,14 +183,14 @@  - when eg, restarting the daemon.  -} #ifdef mingw32_HOST_OS-winLockFile :: PID -> FilePath -> IO RawFilePath+winLockFile :: PID -> OsPath -> IO OsPath winLockFile pid pidfile = do 	cleanstale-	return $ toRawFilePath $ prefix ++ show pid ++ suffix+	return $ prefix <> toOsPath (show pid) <> suffix   where-	prefix = pidfile ++ "."-	suffix = ".lck"+	prefix = pidfile <> literalOsPath "."+	suffix = literalOsPath ".lck" 	cleanstale = mapM_ (void . tryIO . removeFile) =<<-		(filter iswinlockfile <$> dirContents (fromRawFilePath (parentDir (toRawFilePath pidfile))))-	iswinlockfile f = suffix `isSuffixOf` f && prefix `isPrefixOf` f+		(filter iswinlockfile <$> dirContents (parentDir pidfile))+	iswinlockfile f = suffix `OS.isSuffixOf` f && prefix `OS.isPrefixOf` f #endif
Utility/DirWatcher.hs view
@@ -22,6 +22,7 @@ ) where  import Utility.DirWatcher.Types+import Utility.OsPath  #if WITH_INOTIFY import qualified Utility.DirWatcher.INotify as INotify@@ -40,7 +41,7 @@ import qualified System.Win32.Notify as Win32Notify #endif -type Pruner = FilePath -> Bool+type Pruner = OsPath -> Bool  canWatch :: Bool #if (WITH_INOTIFY || WITH_KQUEUE || WITH_FSEVENTS || WITH_WIN32NOTIFY)@@ -112,7 +113,7 @@  - to shutdown later. -} #if WITH_INOTIFY type DirWatcherHandle = INotify.INotify-watchDir :: FilePath -> Pruner -> Bool -> WatchHooks -> (IO () -> IO ()) -> IO DirWatcherHandle+watchDir :: OsPath -> Pruner -> Bool -> WatchHooks -> (IO () -> IO ()) -> IO DirWatcherHandle watchDir dir prune scanevents hooks runstartup = do 	i <- INotify.initINotify 	runstartup $ INotify.watchDir i dir prune scanevents hooks@@ -120,20 +121,20 @@ #else #if WITH_KQUEUE type DirWatcherHandle = ThreadId-watchDir :: FilePath -> Pruner -> Bool -> WatchHooks -> (IO Kqueue.Kqueue -> IO Kqueue.Kqueue) -> IO DirWatcherHandle+watchDir :: OsPath -> Pruner -> Bool -> WatchHooks -> (IO Kqueue.Kqueue -> IO Kqueue.Kqueue) -> IO DirWatcherHandle watchDir dir prune _scanevents hooks runstartup = do 	kq <- runstartup $ Kqueue.initKqueue dir prune 	forkIO $ Kqueue.runHooks kq hooks #else #if WITH_FSEVENTS type DirWatcherHandle = FSEvents.EventStream-watchDir :: FilePath -> Pruner -> Bool -> WatchHooks -> (IO FSEvents.EventStream -> IO FSEvents.EventStream) -> IO DirWatcherHandle+watchDir :: OsPath -> Pruner -> Bool -> WatchHooks -> (IO FSEvents.EventStream -> IO FSEvents.EventStream) -> IO DirWatcherHandle watchDir dir prune scanevents hooks runstartup = 	runstartup $ FSEvents.watchDir dir prune scanevents hooks #else #if WITH_WIN32NOTIFY type DirWatcherHandle = Win32Notify.WatchManager-watchDir :: FilePath -> Pruner -> Bool -> WatchHooks -> (IO Win32Notify.WatchManager -> IO Win32Notify.WatchManager) -> IO DirWatcherHandle+watchDir :: OsPath -> Pruner -> Bool -> WatchHooks -> (IO Win32Notify.WatchManager -> IO Win32Notify.WatchManager) -> IO DirWatcherHandle watchDir dir prune scanevents hooks runstartup = 	runstartup $ Win32Notify.watchDir dir prune scanevents hooks #else
Utility/DirWatcher/FSEvents.hs view
@@ -15,15 +15,15 @@ import qualified System.Posix.Files as Files import Data.Bits ((.&.)) -watchDir :: FilePath -> (FilePath -> Bool) -> Bool -> WatchHooks -> IO EventStream+watchDir :: OsPath -> (OsPath -> Bool) -> Bool -> WatchHooks -> IO EventStream watchDir dir ignored scanevents hooks = do 	unlessM fileLevelEventsSupported $ 		giveup "Need at least OSX 10.7.0 for file-level FSEvents" 	scan dir-	eventStreamCreate [dir] 1.0 True True True dispatch+	eventStreamCreate [fromOsPath dir] 1.0 True True True dispatch   where 	dispatch evt-		| ignoredPath ignored (eventPath evt) = noop+		| ignoredPath ignored (toOsPath (eventPath evt)) = noop 		| otherwise = do 			{- More than one flag may be set, if events occurred 			 - close together. @@ -45,8 +45,8 @@ 			 - received for both its old and its new name. -} 			when (hasflag eventFlagItemRenamed) $ 				if hasflag eventFlagItemIsDir-					then ifM (doesDirectoryExist $ eventPath evt)-						( scan $ eventPath evt+					then ifM (doesDirectoryExist $ toOsPath $ eventPath evt)+						( scan $ toOsPath $ eventPath evt 						, runhook delDirHook Nothing 						) 					else maybe (runhook delHook Nothing) handleadd@@ -61,7 +61,7 @@ 				runhook modifyHook ms 	  where 		hasflag f = eventFlags evt .&. f /= 0-		runhook h s = maybe noop (\a -> a (eventPath evt) s) (h hooks)+		runhook h s = maybe noop (\a -> a (toOsPath (eventPath evt)) s) (h hooks) 		handleadd s 			| Files.isSymbolicLink s = runhook addSymlinkHook $ Just s 			| Files.isRegularFile s = runhook addHook $ Just s@@ -70,12 +70,13 @@ 	scan d = unless (ignoredPath ignored d) $ 		-- Do not follow symlinks when scanning. 		-- This mirrors the inotify startup scan behavior.-		mapM_ go =<< emptyWhenDoesNotExist (dirContentsRecursiveSkipping (const False) False d)+		mapM_ go =<< emptyWhenDoesNotExist+			(dirContentsRecursiveSkipping (const False) False d) 	  where		 		go f 			| ignoredPath ignored f = noop 			| otherwise = do-				ms <- getstatus f+				ms <- getstatus (fromOsPath f) 				case ms of 					Nothing -> noop 					Just s@@ -93,5 +94,5 @@ 	getstatus = catchMaybeIO . R.getSymbolicLinkStatus . toRawFilePath  {- Check each component of the path to see if it's ignored. -}-ignoredPath :: (FilePath -> Bool) -> FilePath -> Bool+ignoredPath :: (OsPath -> Bool) -> OsPath -> Bool ignoredPath ignored = any ignored . map dropTrailingPathSeparator . splitPath
Utility/DirWatcher/INotify.hs view
@@ -47,7 +47,7 @@  - So this will fail if there are too many subdirectories. The  - errHook is called when this happens.  -}-watchDir :: INotify -> FilePath -> (FilePath -> Bool) -> Bool -> WatchHooks -> IO ()+watchDir :: INotify -> OsPath -> (OsPath -> Bool) -> Bool -> WatchHooks -> IO () watchDir i dir ignored scanevents hooks 	| ignored dir = noop 	| otherwise = do@@ -56,10 +56,10 @@ 		lock <- newLock 		let handler event = withLock lock (void $ go event) 		flip catchNonAsync failedwatch $ do-			void (addWatch i watchevents (toInternalFilePath dir) handler)+			void (addWatch i watchevents (fromOsPath dir) handler) 				`catchIO` failedaddwatch 			withLock lock $-				mapM_ scan =<< filter (not . dirCruft) <$>+				mapM_ scan =<< filter (`notElem` dirCruft) <$> 					getDirectoryContents dir   where 	recurse d = watchDir i d ignored scanevents hooks@@ -108,22 +108,21 @@ 							runhook addHook f ms 				_ -> noop 	  where-		f = fromInternalFilePath fi+		f = toOsPath fi  	-- Closing a file is assumed to mean it's done being written, 	-- so a new add event is sent. 	go (Closed { isDirectory = False, maybeFilePath = Just fi }) =-			checkfiletype Files.isRegularFile addHook $ -				fromInternalFilePath fi+			checkfiletype Files.isRegularFile addHook (toOsPath fi)  	-- When a file or directory is moved in, scan it to add new 	-- stuff.-	go (MovedIn { filePath = fi }) = scan $ fromInternalFilePath fi+	go (MovedIn { filePath = fi }) = scan (toOsPath fi) 	go (MovedOut { isDirectory = isd, filePath = fi }) 		| isd = runhook delDirHook f Nothing 		| otherwise = runhook delHook f Nothing 	  where-		f = fromInternalFilePath fi+		f = toOsPath fi  	-- Verify that the deleted item really doesn't exist, 	-- since there can be spurious deletion events for items@@ -134,11 +133,11 @@ 		| otherwise = guarded $ runhook delHook f Nothing 	  where 		guarded = unlessM (filetype (const True) f)-		f = fromInternalFilePath fi+		f = toOsPath fi  	go (Modified { isDirectory = isd, maybeFilePath = Just fi }) 		| isd = noop-		| otherwise = runhook modifyHook (fromInternalFilePath fi) Nothing+		| otherwise = runhook modifyHook (toOsPath fi) Nothing  	go _ = noop @@ -150,35 +149,36 @@  	indir f = dir </> f -	getstatus f = catchMaybeIO $ R.getSymbolicLinkStatus $ toRawFilePath $ indir f+	getstatus f = catchMaybeIO $ R.getSymbolicLinkStatus $ fromOsPath $ indir f+	 	checkfiletype check h f = do 		ms <- getstatus f 		case ms of 			Just s 				| check s -> runhook h f ms 			_ -> noop-	filetype t f = catchBoolIO $ t <$> R.getSymbolicLinkStatus (toRawFilePath (indir f))+	filetype t f = catchBoolIO $ t <$> R.getSymbolicLinkStatus (fromOsPath (indir f))  	failedaddwatch e 		-- Inotify fails when there are too many watches with a 		-- disk full error. 		| isFullError e = 			case errHook hooks of-				Nothing -> giveup $ "failed to add inotify watch on directory " ++ dir ++ " (" ++ show e ++ ")"+				Nothing -> giveup $ "failed to add inotify watch on directory " ++ fromOsPath dir ++ " (" ++ show e ++ ")" 				Just hook -> tooManyWatches hook dir 		-- The directory could have been deleted. 		| isDoesNotExistError e = return () 		| otherwise = throw e -	failedwatch e = hPutStrLn stderr $ "failed to add watch on directory " ++ dir ++ " (" ++ show e ++ ")"+	failedwatch e = hPutStrLn stderr $ "failed to add watch on directory " ++ fromOsPath dir ++ " (" ++ show e ++ ")" -tooManyWatches :: (String -> Maybe FileStatus -> IO ()) -> FilePath -> IO ()+tooManyWatches :: (String -> Maybe FileStatus -> IO ()) -> OsPath -> IO () tooManyWatches hook dir = do 	sysctlval <- querySysctl [Param maxwatches] :: IO (Maybe Integer) 	hook (unlines $ basewarning : maybe withoutsysctl withsysctl sysctlval) Nothing   where 	maxwatches = "fs.inotify.max_user_watches"-	basewarning = "Too many directories to watch! (Not watching " ++ dir ++")"+	basewarning = "Too many directories to watch! (Not watching " ++ fromOsPath dir ++")" 	withoutsysctl = ["Increase the value in /proc/sys/fs/inotify/max_user_watches"] 	withsysctl n = let new = n * 10 in 		[ "Increase the limit permanently by running:"@@ -197,9 +197,3 @@ 			Nothing -> return Nothing 			Just s -> return $ parsesysctl s 	parsesysctl s = readish =<< lastMaybe (words s)--toInternalFilePath :: FilePath -> RawFilePath-toInternalFilePath = toRawFilePath--fromInternalFilePath :: RawFilePath -> FilePath-fromInternalFilePath = fromRawFilePath
Utility/DirWatcher/Kqueue.hs view
@@ -77,7 +77,7 @@  getDirInfo :: FilePath -> IO DirInfo getDirInfo dir = do-	l <- filter (not . dirCruft) <$> getDirectoryContents dir+	l <- filter (not . dirCruft . toRawFilePath) <$> getDirectoryContents dir 	contents <- S.fromList . catMaybes <$> mapM getDirEnt l 	return $ DirInfo dir contents   where
Utility/DirWatcher/Types.hs view
@@ -16,12 +16,12 @@ type Hook a = Maybe (a -> Maybe FileStatus -> IO ())  data WatchHooks = WatchHooks-	{ addHook :: Hook FilePath-	, addSymlinkHook :: Hook FilePath-	, delHook :: Hook FilePath-	, delDirHook :: Hook FilePath+	{ addHook :: Hook OsPath+	, addSymlinkHook :: Hook OsPath+	, delHook :: Hook OsPath+	, delDirHook :: Hook OsPath 	, errHook :: Hook String -- error message-	, modifyHook :: Hook FilePath+	, modifyHook :: Hook OsPath 	}  mkWatchHooks :: WatchHooks
Utility/DirWatcher/Win32Notify.hs view
@@ -14,15 +14,15 @@ import System.Win32.Notify import System.PosixCompat.Files (isRegularFile) -watchDir :: FilePath -> (FilePath -> Bool) -> Bool -> WatchHooks -> IO WatchManager+watchDir :: OsPath -> (OsPath -> Bool) -> Bool -> WatchHooks -> IO WatchManager watchDir dir ignored scanevents hooks = do 	scan dir 	wm <- initWatchManager-	void $ watchDirectory wm dir True [Create, Delete, Modify, Move] dispatch+	void $ watchDirectory wm (fromOsPath dir) True [Create, Delete, Modify, Move] dispatch 	return wm   where 	dispatch evt-		| ignoredPath ignored (filePath evt) = noop+		| ignoredPath ignored (toOsPath (filePath evt)) = noop 		| otherwise = case evt of 			(Deleted _ _) 				| isDirectory evt -> runhook delDirHook Nothing@@ -40,10 +40,11 @@ 					runhook addHook Nothing 					runhook modifyHook Nothing 	  where-		runhook h s = maybe noop (\a -> a (filePath evt) s) (h hooks)+		runhook h s = maybe noop (\a -> a (toOsPath (filePath evt)) s) (h hooks)  	scan d = unless (ignoredPath ignored d) $-		mapM_ go =<< emptyWhenDoesNotExist (dirContentsRecursiveSkipping (const False) False d)+		mapM_ go =<< emptyWhenDoesNotExist+			(dirContentsRecursiveSkipping (const False) False d) 	  where		 		go f 			| ignoredPath ignored f = noop@@ -60,8 +61,8 @@ 		  where 			runhook h s = maybe noop (\a -> a f s) (h hooks) 		-	getstatus = catchMaybeIO . R.getFileStatus . toRawFilePath+	getstatus = catchMaybeIO . R.getFileStatus . fromOsPath  {- Check each component of the path to see if it's ignored. -}-ignoredPath :: (FilePath -> Bool) -> FilePath -> Bool+ignoredPath :: (OsPath -> Bool) -> OsPath -> Bool ignoredPath ignored = any ignored . map dropTrailingPathSeparator . splitPath
Utility/Directory.hs view
@@ -1,42 +1,42 @@ {- directory traversal and manipulation  -- - Copyright 2011-2023 Joey Hess <id@joeyh.name>+ - Copyright 2011-2025 Joey Hess <id@joeyh.name>  -  - License: BSD-2-clause  -}  {-# LANGUAGE CPP #-} {-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_GHC -fno-warn-tabs #-} -module Utility.Directory (-	module Utility.Directory,-	module Utility.SystemDirectory-) where+module Utility.Directory where +#ifdef WITH_OSPATH+import System.Directory.OsPath+#else+import Utility.SystemDirectory+#endif import Control.Monad-import System.FilePath import System.PosixCompat.Files (isDirectory, isSymbolicLink) import Control.Applicative import System.IO.Unsafe (unsafeInterleaveIO) import Data.Maybe import Prelude -import Utility.SystemDirectory+import Utility.OsPath import Utility.Exception import Utility.Monad-import Utility.FileSystemEncoding import qualified Utility.RawFilePath as R -dirCruft :: FilePath -> Bool-dirCruft "." = True-dirCruft ".." = True-dirCruft _ = False+dirCruft :: [OsPath]+dirCruft = [literalOsPath ".", literalOsPath ".."]  {- Lists the contents of a directory.  - Unlike getDirectoryContents, paths are not relative to the directory. -}-dirContents :: FilePath -> IO [FilePath]-dirContents d = map (d </>) . filter (not . dirCruft) <$> getDirectoryContents d+dirContents :: OsPath -> IO [OsPath]+dirContents d = map (d </>) . filter (`notElem` dirCruft)+	<$> getDirectoryContents d  {- Gets files in a directory, and then its subdirectories, recursively,  - and lazily.@@ -48,11 +48,11 @@  - be accessed (the use of unsafeInterleaveIO would make it difficult to  - trap such exceptions).  -}-dirContentsRecursive :: FilePath -> IO [FilePath]+dirContentsRecursive :: OsPath -> IO [OsPath] dirContentsRecursive = dirContentsRecursiveSkipping (const False) True  {- Skips directories whose basenames match the skipdir. -}-dirContentsRecursiveSkipping :: (FilePath -> Bool) -> Bool -> FilePath -> IO [FilePath]+dirContentsRecursiveSkipping :: (OsPath -> Bool) -> Bool -> OsPath -> IO [OsPath] dirContentsRecursiveSkipping skipdir followsubdirsymlinks topdir 	| skipdir (takeFileName topdir) = return [] 	| otherwise = do@@ -72,13 +72,15 @@ 				=<< catchDefaultIO [] (dirContents dir) 			files' <- go (dirs' ++ dirs) 			return (files ++ files')+	+	collect :: [OsPath] -> [OsPath] -> [OsPath] -> IO ([OsPath], [OsPath]) 	collect files dirs' [] = return (reverse files, reverse dirs') 	collect files dirs' (entry:entries)-		| dirCruft entry = collect files dirs' entries+		| entry `elem` dirCruft = collect files dirs' entries 		| otherwise = do 			let skip = collect (entry:files) dirs' entries 			let recurse = collect files (entry:dirs') entries-			ms <- catchMaybeIO $ R.getSymbolicLinkStatus (toRawFilePath entry)+			ms <- catchMaybeIO $ R.getSymbolicLinkStatus (fromOsPath entry) 			case ms of 				(Just s)  					| isDirectory s -> recurse@@ -98,7 +100,7 @@  - be accessed (the use of unsafeInterleaveIO would make it difficult to  - trap such exceptions).  -}-dirTreeRecursiveSkipping :: (FilePath -> Bool) -> FilePath -> IO [FilePath]+dirTreeRecursiveSkipping :: (OsPath -> Bool) -> OsPath -> IO [OsPath] dirTreeRecursiveSkipping skipdir topdir 	| skipdir (takeFileName topdir) = return [] 	| otherwise = do@@ -113,7 +115,7 @@ 				=<< filterM isdir 				=<< catchDefaultIO [] (dirContents dir) 			go (subdirs++dir:c) dirs-	isdir p = isDirectory <$> R.getSymbolicLinkStatus (toRawFilePath p)+	isdir p = isDirectory <$> R.getSymbolicLinkStatus (fromOsPath p)  {- When the action fails due to the directory not existing, returns []. -} emptyWhenDoesNotExist :: IO [a] -> IO [a]
Utility/Directory/Create.hs view
@@ -20,14 +20,12 @@ import Control.Monad.IfElse import System.IO.Error import Data.Maybe-import qualified System.FilePath.ByteString as P import Prelude  import Utility.SystemDirectory import Utility.Path.AbsRel import Utility.Exception-import Utility.FileSystemEncoding-import qualified Utility.RawFilePath as R+import Utility.OsPath import Utility.PartialPrelude  {- Like createDirectoryIfMissing True, but it will only create@@ -51,39 +49,39 @@  - Note that, the second FilePath, if relative, is relative to the current  - working directory.  -}-createDirectoryUnder :: [RawFilePath] -> RawFilePath -> IO ()+createDirectoryUnder :: [OsPath] -> OsPath -> IO () createDirectoryUnder topdirs dir =-	createDirectoryUnder' topdirs dir R.createDirectory+	createDirectoryUnder' topdirs dir createDirectory  createDirectoryUnder' 	:: (MonadIO m, MonadCatch m)-	=> [RawFilePath]-	-> RawFilePath-	-> (RawFilePath -> m ())+	=> [OsPath]+	-> OsPath+	-> (OsPath -> m ()) 	-> m () createDirectoryUnder' topdirs dir0 mkdir = do 	relps <- liftIO $ forM topdirs $ \topdir -> relPathDirToFile topdir dir0-	let relparts = map P.splitDirectories relps+	let relparts = map splitDirectories relps 	-- Catch cases where dir0 is not beneath a topdir. 	-- If the relative path between them starts with "..", 	-- it's not. And on Windows, if they are on different drives, 	-- the path will not be relative. 	let notbeneath = \(_topdir, (relp, dirs)) -> -		headMaybe dirs /= Just ".." && not (P.isAbsolute relp)+		headMaybe dirs /= Just (literalOsPath "..") && not (isAbsolute relp) 	case filter notbeneath $ zip topdirs (zip relps relparts) of 		((topdir, (_relp, dirs)):_) 			-- If dir0 is the same as the topdir, don't try to 			-- create it, but make sure it does exist. 			| null dirs ->-				liftIO $ unlessM (doesDirectoryExist (fromRawFilePath topdir)) $+				liftIO $ unlessM (doesDirectoryExist topdir) $ 					ioError $ customerror doesNotExistErrorType $-						"createDirectoryUnder: " ++ fromRawFilePath topdir ++ " does not exist"+						"createDirectoryUnder: " ++ fromOsPath topdir ++ " does not exist" 			| otherwise -> createdirs $-					map (topdir P.</>) (reverse (scanl1 (P.</>) dirs))+					map (topdir </>) (reverse (scanl1 (</>) dirs)) 		_ -> liftIO $ ioError $ customerror userErrorType-			("createDirectoryUnder: not located in " ++ unwords (map fromRawFilePath topdirs))+			("createDirectoryUnder: not located in " ++ unwords (map fromOsPath topdirs))   where-	customerror t s = mkIOError t s Nothing (Just (fromRawFilePath dir0))+	customerror t s = mkIOError t s Nothing (Just (fromOsPath dir0))  	createdirs [] = pure () 	createdirs (dir:[]) = createdir dir (liftIO . ioError)@@ -100,6 +98,6 @@ 		Left e 			| isDoesNotExistError e -> notexisthandler e 			| isAlreadyExistsError e || isPermissionError e ->-				liftIO $ unlessM (doesDirectoryExist (fromRawFilePath dir)) $+				liftIO $ unlessM (doesDirectoryExist dir) $ 					ioError e 			| otherwise -> liftIO $ ioError e
Utility/Directory/Stream.hs view
@@ -1,12 +1,13 @@-{- streaming directory traversal+{- streaming directory reading  -- - Copyright 2011-2018 Joey Hess <id@joeyh.name>+ - Copyright 2011-2025 Joey Hess <id@joeyh.name>  -  - License: BSD-2-clause  -}  {-# LANGUAGE CPP #-} {-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_GHC -fno-warn-tabs #-}  module Utility.Directory.Stream (@@ -14,11 +15,10 @@ 	openDirectory, 	closeDirectory, 	readDirectory,-	isDirectoryEmpty,+	isDirectoryPopulated, ) where  import Control.Monad-import System.FilePath import Control.Concurrent import Data.Maybe import Prelude@@ -26,11 +26,14 @@ #ifdef mingw32_HOST_OS import qualified System.Win32 as Win32 #else-import qualified System.Posix as Posix+import qualified Data.ByteString as B+import qualified System.Posix.Directory.ByteString as Posix #endif  import Utility.Directory import Utility.Exception+import Utility.FileSystemEncoding+import Utility.OsPath  #ifndef mingw32_HOST_OS data DirectoryHandle = DirectoryHandle IsOpen Posix.DirStream@@ -40,14 +43,14 @@  type IsOpen = MVar () -- full when the handle is open -openDirectory :: FilePath -> IO DirectoryHandle+openDirectory :: RawFilePath -> IO DirectoryHandle openDirectory path = do #ifndef mingw32_HOST_OS 	dirp <- Posix.openDirStream path 	isopen <- newMVar () 	return (DirectoryHandle isopen dirp) #else-	(h, fdat) <- Win32.findFirstFile (path </> "*")+	(h, fdat) <- Win32.findFirstFile (fromOsPath (toOsPath path </> literalOsPath "*")) 	-- Indicate that the fdat contains a filename that readDirectory 	-- has not yet returned, by making the MVar be full. 	-- (There's always at least a "." entry.)@@ -75,11 +78,11 @@  -- | Reads the next entry from the handle. Once the end of the directory -- is reached, returns Nothing and automatically closes the handle.-readDirectory :: DirectoryHandle -> IO (Maybe FilePath)+readDirectory :: DirectoryHandle -> IO (Maybe RawFilePath) #ifndef mingw32_HOST_OS readDirectory hdl@(DirectoryHandle _ dirp) = do 	e <- Posix.readDirStream dirp-	if null e+	if B.null e 		then do 			closeDirectory hdl 			return Nothing@@ -102,18 +105,18 @@   where 	getfn = do 		filename <- Win32.getFindDataFileName fdat-		return (Just filename)+		return (Just (toRawFilePath filename)) #endif --- | True only when directory exists and contains nothing.--- Throws exception if directory does not exist.-isDirectoryEmpty :: FilePath -> IO Bool-isDirectoryEmpty d = bracket (openDirectory d) closeDirectory check+-- | True only when directory exists and is not empty.+isDirectoryPopulated :: RawFilePath -> IO Bool+isDirectoryPopulated d = bracket (openDirectory d) closeDirectory check+	`catchIO` const (return False)   where 	check h = do 		v <- readDirectory h 		case v of-			Nothing -> return True+			Nothing -> return False 			Just f-				| not (dirCruft f) -> return False+				| not (toOsPath f `elem` dirCruft) -> return True 				| otherwise -> check h
+ Utility/FileIO.hs view
@@ -0,0 +1,153 @@+{- File IO on OsPaths.+ -+ - Since Prelude exports many of these as well, this needs to be imported+ - qualified.+ -+ - Copyright 2025 Joey Hess <id@joeyh.name>+ -+ - License: BSD-2-clause+ -}++{-# OPTIONS_GHC -fno-warn-tabs #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE NoImplicitPrelude #-}++module Utility.FileIO+(+	withFile,+	openFile,+	withBinaryFile,+	openBinaryFile,+	readFile,+	readFile',+	writeFile,+	writeFile',+	appendFile,+	appendFile',+	openTempFile,+) where++#ifdef WITH_OSPATH++#ifndef mingw32_HOST_OS+import System.File.OsPath+#else+-- On Windows, System.File.OsPath does not handle UNC-style conversion itself,+-- so that has to be done when calling it. See +-- https://github.com/haskell/file-io/issues/39+import Utility.Path.Windows+import Utility.OsPath+import System.IO (IO, Handle, IOMode)+import Prelude (return)+import qualified System.File.OsPath as O+import qualified Data.ByteString as B+import qualified Data.ByteString.Lazy as L+import Control.Applicative++withFile :: OsPath -> IOMode -> (Handle -> IO r) -> IO r +withFile f m a = do+	f' <- toOsPath <$> convertToWindowsNativeNamespace (fromOsPath f)+	O.withFile f' m a++openFile :: OsPath -> IOMode -> IO Handle+openFile f m = do+	f' <- toOsPath <$> convertToWindowsNativeNamespace (fromOsPath f)+	O.openFile f' m++withBinaryFile :: OsPath -> IOMode -> (Handle -> IO r) -> IO r +withBinaryFile f m a = do+	f' <- toOsPath <$> convertToWindowsNativeNamespace (fromOsPath f)+	O.withBinaryFile f' m a++openBinaryFile :: OsPath -> IOMode -> IO Handle+openBinaryFile f m = do+	f' <- toOsPath <$> convertToWindowsNativeNamespace (fromOsPath f)+	O.openBinaryFile f' m++readFile :: OsPath -> IO L.ByteString+readFile f = do+	f' <- toOsPath <$> convertToWindowsNativeNamespace (fromOsPath f)+	O.readFile f'++readFile' :: OsPath -> IO B.ByteString+readFile' f = do+	f' <- toOsPath <$> convertToWindowsNativeNamespace (fromOsPath f)+	O.readFile' f'++writeFile :: OsPath -> L.ByteString -> IO ()+writeFile f b = do+	f' <- toOsPath <$> convertToWindowsNativeNamespace (fromOsPath f)+	O.writeFile f' b++writeFile' :: OsPath -> B.ByteString -> IO ()+writeFile' f b = do+	f' <- toOsPath <$> convertToWindowsNativeNamespace (fromOsPath f)+	O.writeFile' f' b++appendFile :: OsPath -> L.ByteString -> IO ()+appendFile f b = do+	f' <- toOsPath <$> convertToWindowsNativeNamespace (fromOsPath f)+	O.appendFile f' b++appendFile' :: OsPath -> B.ByteString -> IO ()+appendFile' f b = do+	f' <- toOsPath <$> convertToWindowsNativeNamespace (fromOsPath f)+	O.appendFile' f' b++openTempFile :: OsPath -> OsPath -> IO (OsPath, Handle)+openTempFile p s = do+	p' <- toOsPath <$> convertToWindowsNativeNamespace (fromOsPath p)+	(t, h) <- O.openTempFile p' s+	-- Avoid returning mangled path from convertToWindowsNativeNamespace+	let t' = p </> takeFileName t+	return (t', h)+#endif++#else+-- When not building with OsPath, export RawFilePath versions+-- instead.+import Utility.OsPath+import Utility.FileSystemEncoding+import System.IO (IO, Handle, IOMode)+import Prelude ((.), return)+import qualified System.IO+import qualified Data.ByteString as B+import qualified Data.ByteString.Lazy as L++withFile :: OsPath -> IOMode -> (Handle -> IO r) -> IO r +withFile = System.IO.withFile . fromRawFilePath++openFile :: OsPath -> IOMode -> IO Handle+openFile = System.IO.openFile . fromRawFilePath++withBinaryFile :: OsPath -> IOMode -> (Handle -> IO r) -> IO r +withBinaryFile = System.IO.withBinaryFile . fromRawFilePath++openBinaryFile :: OsPath -> IOMode -> IO Handle+openBinaryFile = System.IO.openBinaryFile . fromRawFilePath++readFile :: OsPath -> IO L.ByteString+readFile = L.readFile . fromRawFilePath++readFile' :: OsPath -> IO B.ByteString+readFile' = B.readFile . fromRawFilePath++writeFile :: OsPath -> L.ByteString -> IO ()+writeFile = L.writeFile . fromRawFilePath++writeFile' :: OsPath -> B.ByteString -> IO ()+writeFile' = B.writeFile . fromRawFilePath++appendFile :: OsPath -> L.ByteString -> IO ()+appendFile = L.appendFile . fromRawFilePath++appendFile' :: OsPath -> B.ByteString -> IO ()+appendFile' = B.appendFile . fromRawFilePath++openTempFile :: OsPath -> OsPath -> IO (OsPath, Handle)+openTempFile p s = do+	(t, h) <- System.IO.openTempFile+		(fromRawFilePath p)+		(fromRawFilePath s)+	return (toRawFilePath t, h)+#endif
Utility/FileMode.hs view
@@ -25,24 +25,27 @@ import Control.Monad.Catch  import Utility.Exception-import Utility.FileSystemEncoding import qualified Utility.RawFilePath as R+import qualified Utility.FileIO as F+import Utility.OsPath  {- Applies a conversion function to a file's mode. -}-modifyFileMode :: RawFilePath -> (FileMode -> FileMode) -> IO ()+modifyFileMode :: OsPath -> (FileMode -> FileMode) -> IO () modifyFileMode f convert = void $ modifyFileMode' f convert -modifyFileMode' :: RawFilePath -> (FileMode -> FileMode) -> IO FileMode+modifyFileMode' :: OsPath -> (FileMode -> FileMode) -> IO FileMode modifyFileMode' f convert = do-	s <- R.getFileStatus f+	s <- R.getFileStatus f' 	let old = fileMode s 	let new = convert old 	when (new /= old) $-		R.setFileMode f new+		R.setFileMode f' new 	return old+  where+	f' = fromOsPath f  {- Runs an action after changing a file's mode, then restores the old mode. -}-withModifiedFileMode :: RawFilePath -> (FileMode -> FileMode) -> IO a -> IO a+withModifiedFileMode :: OsPath -> (FileMode -> FileMode) -> IO a -> IO a withModifiedFileMode file convert a = bracket setup cleanup go   where 	setup = modifyFileMode' file convert@@ -75,15 +78,15 @@ 	]  {- Removes the write bits from a file. -}-preventWrite :: RawFilePath -> IO ()+preventWrite :: OsPath -> IO () preventWrite f = modifyFileMode f $ removeModes writeModes  {- Turns a file's owner write bit back on. -}-allowWrite :: RawFilePath -> IO ()+allowWrite :: OsPath -> IO () allowWrite f = modifyFileMode f $ addModes [ownerWriteMode]  {- Turns a file's owner read bit back on. -}-allowRead :: RawFilePath -> IO ()+allowRead :: OsPath -> IO () allowRead f = modifyFileMode f $ addModes [ownerReadMode]  {- Allows owner and group to read and write to a file. -}@@ -93,7 +96,7 @@ 	, ownerReadMode, groupReadMode 	] -groupWriteRead :: RawFilePath -> IO ()+groupWriteRead :: OsPath -> IO () groupWriteRead f = modifyFileMode f $ addModes groupSharedModes  checkMode :: FileMode -> FileMode -> Bool@@ -103,13 +106,13 @@ isExecutable :: FileMode -> Bool isExecutable mode = combineModes executeModes `intersectFileModes` mode /= 0 -data ModeSetter = ModeSetter FileMode (RawFilePath -> IO ())+data ModeSetter = ModeSetter FileMode (OsPath -> IO ())  {- Runs an action which should create the file, passing it the desired  - initial file mode. Then runs the ModeSetter's action on the file, which  - can adjust the initial mode if umask prevented the file from being  - created with the right mode. -}-applyModeSetter :: Maybe ModeSetter -> RawFilePath -> (Maybe FileMode -> IO a) -> IO a+applyModeSetter :: Maybe ModeSetter -> OsPath -> (Maybe FileMode -> IO a) -> IO a applyModeSetter (Just (ModeSetter mode modeaction)) file a = do 	r <- a (Just mode) 	void $ tryIO $ modeaction file@@ -157,7 +160,7 @@ stickyMode :: FileMode stickyMode = 512 -setSticky :: RawFilePath -> IO ()+setSticky :: OsPath -> IO () setSticky f = modifyFileMode f $ addModes [stickyMode] #endif @@ -170,15 +173,15 @@  - On a filesystem that does not support file permissions, this is the same  - as writeFile.  -}-writeFileProtected :: RawFilePath -> String -> IO ()+writeFileProtected :: OsPath -> String -> IO () writeFileProtected file content = writeFileProtected' file  	(\h -> hPutStr h content) -writeFileProtected' :: RawFilePath -> (Handle -> IO ()) -> IO ()+writeFileProtected' :: OsPath -> (Handle -> IO ()) -> IO () writeFileProtected' file writer = bracket setup cleanup writer   where 	setup = do-		h <- protectedOutput $ openFile (fromRawFilePath file) WriteMode+		h <- protectedOutput $ F.openFile file WriteMode 		void $ tryIO $ modifyFileMode file $ removeModes otherGroupModes 		return h 	cleanup = hClose
Utility/FileSize.hs view
@@ -17,12 +17,13 @@ #ifdef mingw32_HOST_OS import Control.Exception (bracket) import System.IO-import Utility.FileSystemEncoding+import qualified Utility.FileIO as F #else import System.PosixCompat.Files (fileSize)+import qualified Utility.RawFilePath as R #endif import System.PosixCompat.Files (FileStatus)-import qualified Utility.RawFilePath as R+import Utility.OsPath  type FileSize = Integer @@ -32,18 +33,18 @@  - FileOffset which maxes out at 2 gb.  - See https://github.com/jystic/unix-compat/issues/16  -}-getFileSize :: R.RawFilePath -> IO FileSize+getFileSize :: OsPath -> IO FileSize #ifndef mingw32_HOST_OS-getFileSize f = fmap (fromIntegral . fileSize) (R.getFileStatus f)+getFileSize f = fmap (fromIntegral . fileSize) (R.getFileStatus (fromOsPath f)) #else-getFileSize f = bracket (openFile (fromRawFilePath f) ReadMode) hClose hFileSize+getFileSize f = bracket (F.openFile f ReadMode) hClose hFileSize #endif  {- Gets the size of the file, when its FileStatus is already known.  -  - On windows, uses getFileSize. Otherwise, the FileStatus contains the  - size, so this does not do any work. -}-getFileSize' :: R.RawFilePath -> FileStatus -> IO FileSize+getFileSize' :: OsPath -> FileStatus -> IO FileSize #ifndef mingw32_HOST_OS getFileSize' _ s = return $ fromIntegral $ fileSize s #else
Utility/FileSystemEncoding.hs view
@@ -23,7 +23,6 @@  import qualified GHC.IO.Encoding as Encoding import System.IO-import System.FilePath.ByteString (RawFilePath, encodeFilePath, decodeFilePath) import qualified Data.ByteString as S import qualified Data.ByteString.Lazy as L #ifdef mingw32_HOST_OS@@ -33,8 +32,13 @@ import qualified GHC.Foreign as GHC import System.IO.Unsafe import Data.ByteString.Unsafe (unsafePackMallocCStringLen)+import Data.Char+import Data.List #endif +-- | A literal file path+type RawFilePath = S.ByteString+ {- Makes all subsequent Handles that are opened, as well as stdio Handles,  - use the filesystem encoding, instead of the encoding of the current  - locale.@@ -88,9 +92,7 @@ decodeBS :: S.ByteString -> FilePath #ifndef mingw32_HOST_OS -- This does the same thing as System.FilePath.ByteString.decodeFilePath,--- with an identical implementation. However, older versions of that library--- truncated at NUL, which this must not do, because it may end up used on--- something other than a unix filepath.+-- with an identical implementation. {-# NOINLINE decodeBS #-} decodeBS b = unsafePerformIO $ do 	enc <- Encoding.getFileSystemEncoding@@ -102,9 +104,7 @@ encodeBS :: FilePath -> S.ByteString #ifndef mingw32_HOST_OS -- This does the same thing as System.FilePath.ByteString.encodeFilePath,--- with an identical implementation. However, older versions of that library--- truncated at NUL, which this must not do, because it may end up used on--- something other than a unix filepath.+-- with an identical implementation. {-# NOINLINE encodeBS #-} encodeBS f = unsafePerformIO $ do 	enc <- Encoding.getFileSystemEncoding@@ -114,10 +114,10 @@ #endif  fromRawFilePath :: RawFilePath -> FilePath-fromRawFilePath = decodeFilePath+fromRawFilePath = decodeBS  toRawFilePath :: FilePath -> RawFilePath-toRawFilePath = encodeFilePath+toRawFilePath = encodeBS  {- Truncates a FilePath to the given number of bytes (or less),  - as represented on disk.@@ -125,26 +125,43 @@  - Avoids returning an invalid part of a unicode byte sequence, at the  - cost of efficiency when running on a large FilePath.  -}-truncateFilePath :: Int -> FilePath -> FilePath+truncateFilePath :: Int -> RawFilePath -> RawFilePath #ifndef mingw32_HOST_OS-truncateFilePath n = go . reverse+{- On unix, do not assume a unicode locale, but does assume ascii+ - characters are a single byte. -}+truncateFilePath n b = +	let blen = S.length b+	in if blen <= n+		then b+		else go blen (reverse (fromRawFilePath b))   where-	go f =-		let b = encodeBS f-		in if S.length b <= n-			then reverse f-			else go (drop 1 f)+	go blen f = case uncons f of+		Just (c, f')+			| isAscii c ->+				let blen' = blen - 1+				in if blen' <= n+					then toRawFilePath (reverse f')+					else go blen' f'+			| otherwise ->+				let blen' = S.length (toRawFilePath f')+				in if blen' <= n +					then toRawFilePath (reverse f')+					else go blen' f'+		Nothing -> toRawFilePath (reverse f) #else {- On Windows, count the number of bytes used by each utf8 character. -}-truncateFilePath n = reverse . go [] n . L8.fromString+truncateFilePath n = toRawFilePath . reverse . go [] n   where 	go coll cnt bs 		| cnt <= 0 = coll-		| otherwise = case L8.decode bs of-			Just (c, x) | c /= L8.replacement_char ->-				let x' = fromIntegral x-				in if cnt - x' < 0-					then coll-					else go (c:coll) (cnt - x') (L8.drop 1 bs)+		| otherwise = case S8.decode bs of+			Just (c, x)+				| c /= S8.replacement_char ->+					let x' = fromIntegral x+					in if cnt - x' < 0+						then coll+						else go (c:coll) (cnt - x') (S8.drop 1 bs)+				| otherwise ->+					go ('_':coll) (cnt - 1) (S8.drop 1 bs) 			_ -> coll #endif
Utility/FreeDesktop.hs view
@@ -10,6 +10,7 @@  - License: BSD-2-clause  -} +{-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_GHC -fno-warn-tabs #-}  module Utility.FreeDesktop (@@ -28,17 +29,10 @@ 	userDesktopDir ) where -import Utility.Exception+import Common import Utility.UserInfo-import Utility.Process  import System.Environment-import System.FilePath-import System.Directory-import Data.List-import Data.Maybe-import Control.Applicative-import Prelude  type DesktopEntry = [(Key, Value)] @@ -78,53 +72,53 @@   where 	keyvalue (k, v) = k ++ "=" ++ toString v -writeDesktopMenuFile :: DesktopEntry -> String -> IO ()+writeDesktopMenuFile :: DesktopEntry -> OsPath -> IO () writeDesktopMenuFile d file = do 	createDirectoryIfMissing True (takeDirectory file)-	writeFile file $ buildDesktopMenuFile d+	writeFile (fromOsPath file) $ buildDesktopMenuFile d  {- Path to use for a desktop menu file, in either the systemDataDir or  - the userDataDir -}-desktopMenuFilePath :: String -> FilePath -> FilePath+desktopMenuFilePath :: String -> OsPath -> OsPath desktopMenuFilePath basename datadir = -	datadir </> "applications" </> desktopfile basename+	datadir </> literalOsPath "applications" </> desktopfile basename  {- Path to use for a desktop autostart file, in either the systemDataDir  - or the userDataDir -}-autoStartPath :: String -> FilePath -> FilePath+autoStartPath :: String -> OsPath -> OsPath autoStartPath basename configdir =-	configdir </> "autostart" </> desktopfile basename+	configdir </> literalOsPath "autostart" </> desktopfile basename  {- Base directory to install an icon file, in either the systemDataDir  - or the userDatadir. -}-iconDir :: FilePath -> FilePath-iconDir datadir = datadir </> "icons" </> "hicolor"+iconDir :: OsPath -> OsPath+iconDir datadir = datadir </> literalOsPath "icons" </> literalOsPath "hicolor"  {- Filename of an icon, given the iconDir to use.  -  - The resolution is something like "48x48" or "scalable". -}-iconFilePath :: FilePath -> String -> FilePath -> FilePath+iconFilePath :: OsPath -> String -> OsPath -> OsPath iconFilePath file resolution icondir =-	icondir </> resolution </> "apps" </> file+	icondir </> toOsPath resolution </> literalOsPath "apps" </> file -desktopfile :: FilePath -> FilePath-desktopfile f = f ++ ".desktop"+desktopfile :: FilePath -> OsPath+desktopfile f = toOsPath $ f ++ ".desktop"  {- Directory used for installation of system wide data files.. -}-systemDataDir :: FilePath-systemDataDir = "/usr/share"+systemDataDir :: OsPath+systemDataDir = literalOsPath "/usr/share"  {- Directory used for installation of system wide config files. -}-systemConfigDir :: FilePath-systemConfigDir = "/etc/xdg"+systemConfigDir :: OsPath+systemConfigDir = literalOsPath "/etc/xdg"  {- Directory for user data files. -}-userDataDir :: IO FilePath-userDataDir = xdgEnvHome "DATA_HOME" ".local/share"+userDataDir :: IO OsPath+userDataDir = toOsPath <$> xdgEnvHome "DATA_HOME" ".local/share"  {- Directory for user config files. -}-userConfigDir :: IO FilePath-userConfigDir = xdgEnvHome "CONFIG_HOME" ".config"+userConfigDir :: IO OsPath+userConfigDir = toOsPath <$> xdgEnvHome "CONFIG_HOME" ".config"  {- Directory for the user's Desktop, may be localized.   -@@ -142,6 +136,6 @@  xdgEnvHome :: String -> String -> IO String xdgEnvHome envbase homedef = do-	home <- myHomeDir-	catchDefaultIO (home </> homedef) $-		getEnv $ "XDG_" ++ envbase+	home <- toOsPath <$> myHomeDir+	catchDefaultIO (fromOsPath $ home </> toOsPath homedef) $+		getEnv ("XDG_" ++ envbase)
Utility/Gpg.hs view
@@ -179,10 +179,10 @@ 		go (passphrasefd ++ params) #else 	-- store the passphrase in a temp file for gpg-	withTmpFile "gpg" $ \tmpfile h -> do+	withTmpFile (literalOsPath "gpg") $ \tmpfile h -> do 		liftIO $ B.hPutStr h passphrase 		liftIO $ hClose h-		let passphrasefile = [Param "--passphrase-file", File tmpfile]+		let passphrasefile = [Param "--passphrase-file", File (fromOsPath tmpfile)] 		go $ passphrasefile ++ params #endif   where@@ -416,9 +416,9 @@ 	setup = do 		subdir <- makenewdir (1 :: Integer) 		origenviron <- getEnvironment-		let environ = addEntry var subdir origenviron+		let environ = addEntry var (fromOsPath subdir) origenviron 		-- gpg is picky about permissions on its home dir-		liftIO $ void $ tryIO $ modifyFileMode (toRawFilePath subdir) $+		liftIO $ void $ tryIO $ modifyFileMode subdir $ 			removeModes $ otherGroupModes 		-- For some reason, recent gpg needs a trustdb to be set up. 		_ <- pipeStrict' cmd [Param "--trust-model", Param "auto", Param "--update-trustdb"] (Just environ) mempty@@ -441,7 +441,7 @@ 	go Nothing = return Nothing          makenewdir n = do-		let subdir = tmpdir </> show n+		let subdir = toOsPath tmpdir </> toOsPath (show n) 		catchIOErrorType AlreadyExists (const $ makenewdir $ n + 1) $ do 			createDirectory subdir 			return subdir
Utility/HtmlDetect.hs view
@@ -13,6 +13,8 @@ ) where  import Author+import qualified Utility.FileIO as F+import Utility.OsPath  import Text.HTML.TagSoup import System.IO@@ -57,8 +59,8 @@ -- It would be equivalent to use isHtml <$> readFile file, -- but since that would not read all of the file, the handle -- would remain open until it got garbage collected sometime later.-isHtmlFile :: FilePath -> IO Bool-isHtmlFile file = withFile file ReadMode $ \h ->+isHtmlFile :: OsPath -> IO Bool+isHtmlFile file = F.withFile file ReadMode $ \h -> 	isHtmlBs <$> B.hGet h htmlPrefixLength  -- | How much of the beginning of a html document is needed to detect it.
Utility/InodeCache.hs view
@@ -49,6 +49,7 @@ import Utility.TimeStamp import Utility.QuickCheck import qualified Utility.RawFilePath as R+import qualified Utility.FileIO as F  import System.PosixCompat.Types import System.PosixCompat.Files (isRegularFile, fileID)@@ -185,24 +186,24 @@ 	(inode:size:mtime:mtimedecimal:_) -> do 		i <- readish inode 		sz <- readish size-		t <- parsePOSIXTime $ mtime ++ '.' : mtimedecimal+		t <- parsePOSIXTime $ encodeBS $ mtime ++ '.' : mtimedecimal 		return $ InodeCache $ InodeCachePrim i sz (MTimeHighRes t) 	_ -> Nothing -genInodeCache :: RawFilePath -> TSDelta -> IO (Maybe InodeCache)+genInodeCache :: OsPath -> TSDelta -> IO (Maybe InodeCache) genInodeCache f delta = catchDefaultIO Nothing $-	toInodeCache delta f =<< R.getSymbolicLinkStatus f+	toInodeCache delta f =<< R.getSymbolicLinkStatus (fromOsPath f) -toInodeCache :: TSDelta -> RawFilePath -> FileStatus -> IO (Maybe InodeCache)+toInodeCache :: TSDelta -> OsPath -> FileStatus -> IO (Maybe InodeCache) toInodeCache d f s = toInodeCache' d f s (fileID s) -toInodeCache' :: TSDelta -> RawFilePath -> FileStatus -> FileID -> IO (Maybe InodeCache)+toInodeCache' :: TSDelta -> OsPath -> FileStatus -> FileID -> IO (Maybe InodeCache) toInodeCache' (TSDelta getdelta) f s inode 	| isRegularFile s = do 		delta <- getdelta 		sz <- getFileSize' f s #ifdef mingw32_HOST_OS-		mtime <- utcTimeToPOSIXSeconds <$> getModificationTime (fromRawFilePath f)+		mtime <- utcTimeToPOSIXSeconds <$> getModificationTime f #else 		let mtime = Posix.modificationTimeHiRes s #endif@@ -214,8 +215,8 @@  - Its InodeCache at the time of its creation is written to the cache file,  - so changes can later be detected. -} data SentinalFile = SentinalFile-	{ sentinalFile :: RawFilePath-	, sentinalCacheFile :: RawFilePath+	{ sentinalFile :: OsPath+	, sentinalCacheFile :: OsPath 	} 	deriving (Show) @@ -232,8 +233,8 @@  writeSentinalFile :: SentinalFile -> IO () writeSentinalFile s = do-	writeFile (fromRawFilePath (sentinalFile s)) ""-	maybe noop (writeFile (fromRawFilePath (sentinalCacheFile s)) . showInodeCache)+	F.writeFile' (sentinalFile s) mempty+	maybe noop (writeFile (fromOsPath (sentinalCacheFile s)) . showInodeCache) 		=<< genInodeCache (sentinalFile s) noTSDelta  data SentinalStatus = SentinalStatus@@ -262,7 +263,7 @@ 				Just new -> return $ calc old new   where 	loadoldcache = catchDefaultIO Nothing $-		readInodeCache <$> readFile (fromRawFilePath (sentinalCacheFile s))+		readInodeCache <$> readFile (fromOsPath (sentinalCacheFile s)) 	gennewcache = genInodeCache (sentinalFile s) noTSDelta 	calc (InodeCache (InodeCachePrim oldinode oldsize oldmtime)) (InodeCache (InodeCachePrim newinode newsize newmtime)) = 		SentinalStatus (not unchanged) tsdelta@@ -287,7 +288,7 @@ 	dummy = SentinalStatus True noTSDelta  sentinalFileExists :: SentinalFile -> IO Bool-sentinalFileExists s = allM R.doesPathExist [sentinalCacheFile s, sentinalFile s]+sentinalFileExists s = allM doesPathExist [sentinalCacheFile s, sentinalFile s]  instance Arbitrary InodeCache where 	arbitrary =
Utility/LinuxMkLibs.hs view
@@ -18,18 +18,19 @@  import Utility.PartialPrelude import Utility.Directory+import Utility.SystemDirectory import Utility.Process import Utility.Monad import Utility.Path import Utility.Path.AbsRel import Utility.Split-import Utility.FileSystemEncoding import Utility.Env import Utility.Exception+import Utility.OsPath+import Utility.RawFilePath  import Data.Maybe-import System.FilePath-import System.Posix.Files+import System.Posix.Files (isSymbolicLink) import Data.Char import Control.Monad.IfElse import Control.Applicative@@ -37,42 +38,42 @@  {- Installs a library. If the library is a symlink to another file,  - install the file it links to, and update the symlink to be relative. -}-installLib :: (FilePath -> FilePath -> IO ()) -> FilePath -> FilePath -> IO (Maybe FilePath)+installLib :: (OsPath -> OsPath -> IO ()) -> OsPath -> OsPath -> IO (Maybe OsPath) installLib installfile top lib = ifM (doesFileExist lib) 	( do 		installfile top lib 		checksymlink lib-		return $ Just $ fromRawFilePath $ parentDir $ toRawFilePath lib+		return $ Just $ parentDir lib 	, return Nothing 	)   where-	checksymlink f = whenM (isSymbolicLink <$> getSymbolicLinkStatus (inTop top f)) $ do-		l <- readSymbolicLink (inTop top f)-		let absl = absPathFrom-			(parentDir (toRawFilePath f))-			(toRawFilePath l)-		target <- relPathDirToFile (toRawFilePath (takeDirectory f)) absl-		installfile top (fromRawFilePath absl)-		removeWhenExistsWith removeLink (top ++ f)-		createSymbolicLink (fromRawFilePath target) (inTop top f)-		checksymlink (fromRawFilePath absl)+	checksymlink f = whenM (isSymbolicLink <$> getSymbolicLinkStatus (fromOsPath (inTop top f))) $ do+		l <- readSymbolicLink (fromOsPath (inTop top f))+		let absl = absPathFrom (parentDir f) (toOsPath l)+		target <- relPathDirToFile (takeDirectory f) absl+		installfile top absl+		removeWhenExistsWith removeFile (inTop top f)+		createSymbolicLink (fromOsPath target) (fromOsPath (inTop top f))+		checksymlink absl  -- Note that f is not relative, so cannot use </>-inTop :: FilePath -> FilePath -> FilePath-inTop top f = top ++ f+inTop :: OsPath -> OsPath -> OsPath+inTop top f = top <> f  {- Parse ldd output, getting all the libraries that the input files  - link to. Note that some of the libraries may not exist   - (eg, linux-vdso.so) -}-parseLdd :: String -> [FilePath]-parseLdd = mapMaybe (getlib . dropWhile isSpace) . lines+parseLdd :: String -> [OsPath]+parseLdd = map toOsPath +	. mapMaybe (getlib . dropWhile isSpace)+	. lines   where 	getlib l = headMaybe . words =<< lastMaybe (split " => " l) 	-runLdd :: [String] -> IO [FilePath]+runLdd :: [OsPath] -> IO [OsPath] runLdd exes = concat <$> mapM go exes   where-	go exe = tryNonAsync (readProcess "ldd" [exe]) >>= \case+	go exe = tryNonAsync (readProcess "ldd" [fromOsPath exe]) >>= \case 		Right o -> return (parseLdd o) 		-- ldd for some reason segfaults when run in an arm64 		-- chroot on an amd64 host, on a binary produced by ghc.@@ -80,21 +81,21 @@ 		Left _e -> do 			environ <- getEnvironment 			let environ' =("LD_TRACE_LOADED_OBJECTS","1"):environ-			parseLdd <$> readProcessEnv exe [] (Just environ')+			parseLdd <$> readProcessEnv (fromOsPath exe) [] (Just environ')  {- Get all glibc libs, and also libgcc_s  -  - XXX Debian specific. -}-glibcLibs :: IO [FilePath]+glibcLibs :: IO [OsPath] glibcLibs = do 	ls <- lines <$> readProcess "sh" 		["-c", "dpkg -L libc6:$(dpkg --print-architecture) | egrep '\\.so' | grep -v /gconv/ | grep -v ld.so.conf | grep -v sotruss-lib"] 	ls2 <- lines <$> readProcess "sh" 		["-c", "(dpkg -L libgcc-s1:$(dpkg --print-architecture 2>/dev/null) || dpkg -L libgcc1:$(dpkg --print-architecture)) | egrep '\\.so'"]-	return (ls++ls2)+	return (map toOsPath (ls++ls2))  {- Get gblibc's gconv libs, which are handled specially.. -}-gconvLibs :: IO [FilePath]-gconvLibs = lines <$> readProcess "sh"+gconvLibs :: IO [OsPath]+gconvLibs = map toOsPath . lines <$> readProcess "sh" 	["-c", "dpkg -L libc6:$(dpkg --print-architecture) | grep /gconv/"]
Utility/LockFile/PidLock.hs view
@@ -27,6 +27,7 @@ import Utility.Exception import Utility.Applicative import Utility.Directory+import Utility.SystemDirectory import Utility.Monad import Utility.Path.AbsRel import Utility.FileMode@@ -38,6 +39,8 @@ import Utility.Env import Utility.Env.Set import Utility.Tmp+import Utility.RawFilePath+import Utility.OsPath import qualified Utility.LockFile.Posix as Posix  import System.IO@@ -47,21 +50,19 @@ import System.Posix.Process import Control.Monad import Control.Monad.IO.Class (liftIO, MonadIO)-import qualified System.FilePath.ByteString as P import Data.Maybe import Data.List import Network.BSD-import System.FilePath import Control.Applicative import Prelude -type PidLockFile = RawFilePath+type PidLockFile = OsPath  data LockHandle 	= LockHandle PidLockFile FileStatus SideLockHandle 	| ParentLocked -type SideLockHandle = Maybe (RawFilePath, Posix.LockHandle)+type SideLockHandle = Maybe (OsPath, Posix.LockHandle)  data PidLock = PidLock 	{ lockingPid :: ProcessID@@ -76,7 +77,7 @@  readPidLock :: PidLockFile -> IO (Maybe PidLock) readPidLock lockfile = (readish =<<)-	<$> catchMaybeIO (readFile (fromRawFilePath lockfile))+	<$> catchMaybeIO (readFile (fromOsPath lockfile))  -- To avoid races when taking over a stale pid lock, a side lock is used. -- This is a regular posix exclusive lock.@@ -109,25 +110,26 @@ 	-- to take the side lock will only succeed once the file is 	-- deleted, and so will be able to immediately see that it's taken 	-- a stale lock.-	_ <- tryIO $ removeFile (fromRawFilePath f)+	_ <- tryIO $ removeFile f 	Posix.dropLock h  -- The side lock is put in /dev/shm. This will work on most any -- Linux system, even if its whole root filesystem doesn't support posix -- locks. /tmp is used as a fallback.-sideLockFile :: PidLockFile -> IO RawFilePath+sideLockFile :: PidLockFile -> IO OsPath sideLockFile lockfile = do-	f <- fromRawFilePath <$> absPath lockfile-	let base = intercalate "_" (splitDirectories (makeRelative "/" f))+	f <- absPath lockfile+	let base = intercalate "_" $ map fromOsPath $+		splitDirectories $ makeRelative (literalOsPath "/") f 	let shortbase = reverse $ take 32 $ reverse base 	let md5sum = if base == shortbase 		then ""-		else toRawFilePath $ show (md5 (encodeBL base))-	dir <- ifM (doesDirectoryExist "/dev/shm")-		( return "/dev/shm"-		, return "/tmp"+		else show (md5 (encodeBL base))+	dir <- ifM (doesDirectoryExist (literalOsPath "/dev/shm"))+		( return (literalOsPath "/dev/shm")+		, return (literalOsPath "/tmp") 		)-	return $ dir P.</> md5sum <> toRawFilePath shortbase <> ".lck"+	return $ dir </> toOsPath md5sum <> toOsPath shortbase <> literalOsPath ".lck"  -- | Tries to take a lock; does not block when the lock is already held. --@@ -147,20 +149,21 @@ 		_ -> return (Just ParentLocked)   where 	go abslockfile sidelock = do-		let abslockfile' = fromRawFilePath abslockfile-		(tmp, h) <- openTmpFileIn (takeDirectory abslockfile') "locktmp"-		let tmp' = toRawFilePath tmp+		(tmp, h) <- openTmpFileIn +			(takeDirectory abslockfile)+			(literalOsPath "locktmp")+		let tmp' = fromOsPath tmp 		setFileMode tmp' (combineModes readModes) 		hPutStr h . show =<< mkPidLock 		hClose h 		let failedlock = do 			dropSideLock sidelock-			removeWhenExistsWith removeLink tmp'+			removeWhenExistsWith removeFile tmp 			return Nothing 		let tooklock st = return $ Just $ LockHandle abslockfile st sidelock-		linkToLock sidelock tmp' abslockfile >>= \case+		linkToLock sidelock tmp abslockfile >>= \case 			Just lckst -> do-				removeWhenExistsWith removeLink tmp'+				removeWhenExistsWith removeFile tmp 				tooklock lckst 			Nothing -> do 				v <- readPidLock abslockfile@@ -173,7 +176,7 @@ 						-- the pidlock was taken on, 						-- we know that the pidlock is 						-- stale, and can take it over.-						rename tmp' abslockfile+						rename tmp' (fromOsPath abslockfile) 						tooklock tmpst 					_ -> failedlock @@ -187,36 +190,38 @@ -- -- However, not all filesystems support hard links. So, first probe -- to see if they are supported. If not, use open with O_EXCL.-linkToLock :: SideLockHandle -> RawFilePath -> RawFilePath -> IO (Maybe FileStatus)+linkToLock :: SideLockHandle -> OsPath -> OsPath -> IO (Maybe FileStatus) linkToLock Nothing _ _ = return Nothing linkToLock (Just _) src dest = do-	let probe = src <> ".lnk"-	v <- tryIO $ createLink src probe-	removeWhenExistsWith removeLink probe+	let probe = src <> literalOsPath ".lnk"+	v <- tryIO $ createLink src' (fromOsPath probe)+	removeWhenExistsWith removeFile probe 	case v of 		Right _ -> do-			_ <- tryIO $ createLink src dest+			_ <- tryIO $ createLink src' dest' 			ifM (catchBoolIO checklinked) 				( ifM (catchBoolIO $ not <$> checkInsaneLustre dest)-					( catchMaybeIO $ getFileStatus dest+					( catchMaybeIO $ getFileStatus dest' 					, return Nothing 					) 				, return Nothing 				) 		Left _ -> catchMaybeIO $ do 			let setup = do-				fd <- openFdWithMode dest WriteOnly+				fd <- openFdWithMode dest' WriteOnly 					(Just $ combineModes readModes) 					(defaultFileFlags {exclusive = True}) 				fdToHandle fd 			let cleanup = hClose-			let go h = readFile (fromRawFilePath src) >>= hPutStr h+			let go h = readFile (fromOsPath src) >>= hPutStr h 			bracket setup cleanup go-			getFileStatus dest+			getFileStatus dest'   where+	src' = fromOsPath src+	dest' = fromOsPath dest 	checklinked = do-		x <- getSymbolicLinkStatus src-		y <- getSymbolicLinkStatus dest+		x <- getSymbolicLinkStatus src'+		y <- getSymbolicLinkStatus dest' 		return $ and 			[ deviceID x == deviceID y 			, fileID x == fileID y@@ -239,17 +244,16 @@ -- We can detect this insanity by getting the directory contents after -- making the link, and checking to see if 2 copies of the dest file, -- with the SAME FILENAME exist.-checkInsaneLustre :: RawFilePath -> IO Bool+checkInsaneLustre :: OsPath -> IO Bool checkInsaneLustre dest = do-	let dest' = fromRawFilePath dest-	fs <- dirContents (takeDirectory dest')-	case length (filter (== dest') fs) of+	fs <- dirContents (takeDirectory dest)+	case length (filter (== dest) fs) of 		1 -> return False -- whew! 		0 -> return True -- wtf? 		_ -> do 			-- Try to clean up the extra copy we made 			-- that has the same name. Egads.-			_ <- tryIO $ removeFile dest'+			_ <- tryIO $ removeFile dest 			return True  -- | Waits as necessary to take a lock.@@ -265,7 +269,7 @@ 		| n > 0 = liftIO (tryLock lockfile) >>= \case 			Nothing -> do 				when (n == pred timeout) $-					displaymessage $ "waiting for pid lock file " ++ fromRawFilePath lockfile ++ " which is held by another process (or may be stale)"+					displaymessage $ "waiting for pid lock file " ++ fromOsPath lockfile ++ " which is held by another process (or may be stale)" 				liftIO $ threadDelaySeconds (Seconds 1) 				go (pred n) 			Just lckh -> do@@ -277,15 +281,15 @@  waitedLock :: MonadIO m => Seconds -> PidLockFile -> (String -> m ()) -> m a waitedLock (Seconds timeout) lockfile displaymessage = do-	displaymessage $ show timeout ++ " second timeout exceeded while waiting for pid lock file " ++ fromRawFilePath lockfile-	giveup $ "Gave up waiting for pid lock file " ++ fromRawFilePath lockfile+	displaymessage $ show timeout ++ " second timeout exceeded while waiting for pid lock file " ++ fromOsPath lockfile+	giveup $ "Gave up waiting for pid lock file " ++ fromOsPath lockfile  -- | Use when the pid lock has already been taken by another thread of the -- same process. alreadyLocked :: MonadIO m => PidLockFile -> m LockHandle alreadyLocked lockfile = liftIO $ do 	abslockfile <- absPath lockfile-	st <- getFileStatus abslockfile+	st <- getFileStatus (fromOsPath abslockfile) 	return $ LockHandle abslockfile st Nothing  dropLock :: LockHandle -> IO ()@@ -293,7 +297,7 @@ 	-- Drop side lock first, at which point the pid lock will be 	-- considered stale. 	dropSideLock sidelock-	removeWhenExistsWith removeLink lockfile+	removeWhenExistsWith removeFile lockfile dropLock ParentLocked = return ()  getLockStatus :: PidLockFile -> IO LockStatus@@ -309,7 +313,7 @@ -- locked to get the LockHandle. checkSaneLock :: PidLockFile -> LockHandle -> IO Bool checkSaneLock lockfile (LockHandle _ st _) = -	go =<< catchMaybeIO (getFileStatus lockfile)+	go =<< catchMaybeIO (getFileStatus (fromOsPath lockfile))   where 	go Nothing = return False 	go (Just st') = return $@@ -324,9 +328,9 @@ -- The parent process should keep running as long as the child -- process is running, since the child inherits the environment and will -- not see unsetLockEnv.-pidLockEnv :: RawFilePath -> IO String+pidLockEnv :: OsPath -> IO String pidLockEnv lockfile = do-	abslockfile <- fromRawFilePath <$> absPath lockfile+	abslockfile <- fromOsPath <$> absPath lockfile 	return $ "PIDLOCK_" ++ filter legalInEnvVar abslockfile  pidLockEnvValue :: String
Utility/LockFile/Posix.hs view
@@ -25,15 +25,15 @@ import Utility.FileMode import Utility.LockFile.LockStatus import Utility.OpenFd+import Utility.OsPath  import System.IO import System.Posix.Types import System.Posix.IO.ByteString import System.Posix.Files.ByteString-import System.FilePath.ByteString (RawFilePath) import Data.Maybe -type LockFile = RawFilePath+type LockFile = OsPath  newtype LockHandle = LockHandle Fd @@ -76,7 +76,7 @@ openLockFile :: LockRequest -> Maybe ModeSetter -> LockFile -> IO Fd openLockFile lockreq filemode lockfile = do 	l <- applyModeSetter filemode lockfile $ \filemode' ->-		openFdWithMode lockfile openfor filemode' defaultFileFlags+		openFdWithMode (fromOsPath lockfile) openfor filemode' defaultFileFlags 	setFdOption l CloseOnExec True 	return l   where@@ -120,7 +120,7 @@ -- else. checkSaneLock :: LockFile -> LockHandle -> IO Bool checkSaneLock lockfile (LockHandle fd) =-	go =<< catchMaybeIO (getFileStatus lockfile)+	go =<< catchMaybeIO (getFileStatus (fromOsPath lockfile))   where 	go Nothing = return False 	go (Just st) = do
Utility/LockFile/Windows.hs view
@@ -21,11 +21,12 @@  import Utility.Path.Windows import Utility.FileSystemEncoding+import Utility.OsPath #if MIN_VERSION_Win32(2,13,4) import Common (tryNonAsync) #endif -type LockFile = RawFilePath+type LockFile = OsPath  type LockHandle = HANDLE @@ -60,7 +61,7 @@  -} openLock :: ShareMode -> LockFile -> IO (Maybe LockHandle) openLock sharemode f = do-	f' <- convertToWindowsNativeNamespace f+	f' <- convertToWindowsNativeNamespace (fromOsPath f) #if MIN_VERSION_Win32(2,13,4) 	r <- tryNonAsync $ createFile_NoRetry (fromRawFilePath f') gENERIC_READ sharemode  		Nothing oPEN_ALWAYS fILE_ATTRIBUTE_NORMAL@@ -70,14 +71,12 @@ 		Right h -> Just h #else 	h <- withTString (fromRawFilePath f') $ \c_f ->-		c_CreateFile c_f gENERIC_READ sharemode security_attributes+		c_CreateFile c_f gENERIC_READ sharemode (maybePtr Nothing) 			oPEN_ALWAYS fILE_ATTRIBUTE_NORMAL (maybePtr Nothing) 	return $ if h == iNVALID_HANDLE_VALUE 		then Nothing 		else Just h #endif-  where-	security_attributes = maybePtr Nothing  dropLock :: LockHandle -> IO () dropLock = closeHandle
Utility/LockPool/STM.hs view
@@ -23,14 +23,14 @@ ) where  import Utility.Monad+import Utility.OsPath  import System.IO.Unsafe (unsafePerformIO)-import System.FilePath.ByteString (RawFilePath) import qualified Data.Map.Strict as M import Control.Concurrent.STM import Control.Exception -type LockFile = RawFilePath+type LockFile = OsPath  data LockMode = LockExclusive | LockShared 	deriving (Eq)
Utility/LogFile.hs view
@@ -35,7 +35,7 @@   where 	go num 		| num > maxLogs = return ()-		| otherwise = whenM (doesFileExist currfile) $ do+		| otherwise = whenM (doesFileExist (toOsPath currfile)) $ do 			go (num + 1) 			rename (toRawFilePath currfile) (toRawFilePath nextfile) 	  where@@ -50,7 +50,7 @@  {- Lists most recent logs last. -} listLogs :: FilePath -> IO [FilePath]-listLogs logfile = filterM doesFileExist $ reverse $ +listLogs logfile = filterM (doesFileExist . toOsPath) $ reverse $  	logfile : map (rotatedLog logfile) [1..maxLogs]  maxLogs :: Int
Utility/Lsof.hs view
@@ -15,6 +15,7 @@ import Common import BuildInfo import Utility.Env.Set+import qualified Utility.OsString as OS  import System.Posix.Types @@ -30,12 +31,14 @@  - path where the program was found. Make sure at runtime that lsof is  - available, and if it's not in PATH, adjust PATH to contain it. -} setup :: IO ()-setup = do-	let cmd = fromMaybe "lsof" BuildInfo.lsof-	when (isAbsolute cmd) $ do-		path <- getSearchPath-		let path' = takeDirectory cmd : path-		setEnv "PATH" (intercalate [searchPathSeparator] path') True+setup = when (isAbsolute cmd) $ do+	path <- getSearchPath+	let path' = fromOsPath $ OS.intercalate sep $+		takeDirectory cmd : path+	setEnv "PATH" path' True+  where+	cmd = toOsPath $ fromMaybe "lsof" BuildInfo.lsof+	sep = OS.singleton searchPathSeparator  {- Checks each of the files in a directory to find open files.  - Note that this will find hard links to files elsewhere that are open. -}
Utility/Metered.hs view
@@ -55,6 +55,7 @@ import Utility.SimpleProtocol as Proto import Utility.ThreadScheduler import Utility.SafeOutput+import qualified Utility.FileIO as F  import qualified Data.ByteString.Lazy as L import qualified Data.ByteString as S@@ -121,8 +122,8 @@  {- Sends the content of a file to an action, updating the meter as it's  - consumed. -}-withMeteredFile :: FilePath -> MeterUpdate -> (L.ByteString -> IO a) -> IO a-withMeteredFile f meterupdate a = withBinaryFile f ReadMode $ \h ->+withMeteredFile :: OsPath -> MeterUpdate -> (L.ByteString -> IO a) -> IO a+withMeteredFile f meterupdate a = F.withBinaryFile f ReadMode $ \h -> 	hGetContentsMetered h meterupdate >>= a  {- Calls the action repeatedly with chunks from the lazy ByteString.@@ -140,8 +141,8 @@ 		meterupdate sofar' 		go sofar' cs -meteredWriteFile :: MeterUpdate -> FilePath -> L.ByteString -> IO ()-meteredWriteFile meterupdate f b = withBinaryFile f WriteMode $ \h ->+meteredWriteFile :: MeterUpdate -> OsPath -> L.ByteString -> IO ()+meteredWriteFile meterupdate f b = F.withBinaryFile f WriteMode $ \h -> 	meteredWrite meterupdate (S.hPut h) b  {- Applies an offset to a MeterUpdate. This can be useful when@@ -227,7 +228,7 @@  -} watchFileSize 	:: (MonadIO m, MonadMask m)-	=> RawFilePath+	=> OsPath 	-> MeterUpdate 	-> (MeterUpdate -> m a) 	-> m a
Utility/Misc.hs view
@@ -1,20 +1,24 @@ {- misc utility functions  -- - Copyright 2010-2011 Joey Hess <id@joeyh.name>+ - Copyright 2010-2025 Joey Hess <id@joeyh.name>  -  - License: BSD-2-clause  -} +{-# LANGUAGE CPP #-} {-# OPTIONS_GHC -fno-warn-tabs #-}  module Utility.Misc ( 	hGetContentsStrict,-	readFileStrict, 	separate, 	separate', 	separateEnd', 	firstLine, 	firstLine',+	fileLines,+	fileLines',+	linesFile,+	linesFile', 	segment, 	segmentDelim, 	massReplace,@@ -32,6 +36,9 @@ import System.Exit import Control.Applicative import qualified Data.ByteString as S+import qualified Data.ByteString.Char8 as S8+import qualified Data.ByteString.Lazy as L+import qualified Data.ByteString.Lazy.Char8 as L8 import Prelude  {- A version of hgetContents that is not lazy. Ensures file is @@ -39,10 +46,6 @@ hGetContentsStrict :: Handle -> IO String hGetContentsStrict = hGetContents >=> \s -> length s `seq` return s -{- A version of readFile that is not lazy. -}-readFileStrict :: FilePath -> IO String-readFileStrict = readFile >=> \s -> length s `seq` return s- {- Like break, but the item matching the condition is not included  - in the second result list.  -@@ -77,6 +80,51 @@ firstLine' = S.takeWhile (/= nl)   where 	nl = fromIntegral (ord '\n')++-- On windows, readFile does NewlineMode translation,+-- stripping CR before LF. When converting to ByteString,+-- use this to emulate that.+fileLines :: L.ByteString -> [L.ByteString]+#ifdef mingw32_HOST_OS+fileLines = map stripCR . L8.lines+  where+	stripCR b = case L8.unsnoc b of+		Nothing -> b+		Just (b', e)+			| e == '\r' -> b'+			| otherwise -> b+#else+fileLines = L8.lines+#endif++fileLines' :: S.ByteString -> [S.ByteString]+#ifdef mingw32_HOST_OS+fileLines' = map stripCR . S8.lines+  where+	stripCR b = case S8.unsnoc b of+		Nothing -> b+		Just (b', e)+			| e == '\r' -> b'+			| otherwise -> b+#else+fileLines' = S8.lines+#endif++-- One windows, writeFile does NewlineMode translation,+-- adding CR before LF. When converting to ByteString, use this to emulate that.+linesFile :: L.ByteString -> L.ByteString+#ifndef mingw32_HOST_OS+linesFile = id+#else+linesFile = L8.concat . concatMap (\x -> [x, L8.pack "\r\n"]) . fileLines+#endif++linesFile' :: S.ByteString -> S.ByteString+#ifndef mingw32_HOST_OS+linesFile' = id+#else+linesFile' = S8.concat . concatMap (\x -> [x, S8.pack "\r\n"]) . fileLines'+#endif  {- Splits a list into segments that are delimited by items matching  - a predicate. (The delimiters are not included in the segments.)
Utility/MoveFile.hs view
@@ -21,26 +21,26 @@ import System.PosixCompat.Files (isDirectory) import Control.Monad.IfElse import Utility.SafeCommand+import qualified Utility.RawFilePath as R #endif  import Utility.SystemDirectory import Utility.Tmp import Utility.Exception import Utility.Monad-import Utility.FileSystemEncoding-import qualified Utility.RawFilePath as R+import Utility.OsPath import Author  {- Moves one filename to another.  - First tries a rename, but falls back to moving across devices if needed. -}-moveFile :: RawFilePath -> RawFilePath -> IO ()-moveFile src dest = tryIO (R.rename src dest) >>= onrename+moveFile :: OsPath -> OsPath -> IO ()+moveFile src dest = tryIO (renamePath src dest) >>= onrename   where 	onrename (Right _) = noop 	onrename (Left e) 		| isPermissionError e = rethrow 		| isDoesNotExistError e = rethrow-		| otherwise = viaTmp mv (fromRawFilePath dest) ()+		| otherwise = viaTmp mv dest () 	  where 		rethrow = throwM e @@ -56,12 +56,12 @@ 			whenM (isdir dest) rethrow 			ok <- copyright =<< boolSystem "mv" 				[ Param "-f"-				, Param (fromRawFilePath src)-				, Param tmp+				, Param (fromOsPath src)+				, Param (fromOsPath tmp) 				] 			let e' = e #else-			r <- tryIO $ copyFile (fromRawFilePath src) tmp+			r <- tryIO $ copyFile src tmp 			let (ok, e') = case r of 				Left err -> (False, err) 				Right _ -> (True, e)@@ -73,11 +73,11 @@  #ifndef mingw32_HOST_OS	 	isdir f = do-		r <- tryIO $ R.getSymbolicLinkStatus f+		r <- tryIO $ R.getSymbolicLinkStatus (fromOsPath f) 		case r of 			(Left _) -> return False 			(Right s) -> return $ isDirectory s+#endif  copyright :: Copyright copyright = author JoeyHess (2022-11)-#endif
Utility/OSX.hs view
@@ -5,6 +5,7 @@  - License: BSD-2-clause  -} +{-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_GHC -fno-warn-tabs #-}  module Utility.OSX (@@ -14,20 +15,21 @@ 	genOSXAutoStartFile, ) where +import Common import Utility.UserInfo -import System.FilePath--autoStartBase :: String -> FilePath-autoStartBase label = "Library" </> "LaunchAgents" </> label ++ ".plist"+autoStartBase :: String -> OsPath+autoStartBase label = literalOsPath "Library" +	</> literalOsPath "LaunchAgents"+	</> toOsPath label <> literalOsPath ".plist" -systemAutoStart :: String -> FilePath-systemAutoStart label = "/" </> autoStartBase label+systemAutoStart :: String -> OsPath+systemAutoStart label = literalOsPath "/" </> autoStartBase label -userAutoStart :: String -> IO FilePath+userAutoStart :: String -> IO OsPath userAutoStart label = do 	home <- myHomeDir-	return $ home </> autoStartBase label+	return $ toOsPath home </> autoStartBase label  {- Generates an OSX autostart plist file with a given label, command, and  - params to run at boot or login. -}
Utility/OpenFd.hs view
@@ -14,7 +14,8 @@  import System.Posix.IO.ByteString import System.Posix.Types-import System.FilePath.ByteString (RawFilePath)++import Utility.RawFilePath  openFdWithMode :: RawFilePath -> OpenMode -> Maybe FileMode -> OpenFileFlags -> IO Fd #if MIN_VERSION_unix(2,8,0)
+ Utility/OsPath.hs view
@@ -0,0 +1,137 @@+{- OsPath utilities+ -+ - Copyright 2025 Joey Hess <id@joeyh.name>+ -+ - License: BSD-2-clause+ -}++{-# LANGUAGE CPP #-}+{-# LANGUAGE PackageImports #-}+{-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-}+{-# OPTIONS_GHC -fno-warn-tabs #-}++module Utility.OsPath (+	OsPath,+	OsString,+	literalOsPath,+	stringToOsPath,+	toOsPath,+	fromOsPath,+	module X,+	getSearchPath,+	unsafeFromChar,+) where++import Utility.FileSystemEncoding+import Data.ByteString.Short (ShortByteString)+import qualified Data.ByteString.Short as S+import qualified Data.ByteString.Lazy as L+#ifdef WITH_OSPATH+import System.OsPath as X hiding (OsPath, OsString, pack, unpack, unsafeFromChar)+import System.OsPath+import "os-string" System.OsString.Internal.Types+import qualified System.FilePath as PS+#if defined(mingw32_HOST_OS)+import GHC.IO (unsafePerformIO)+import System.OsString.Encoding.Internal (cWcharsToChars_UCS2)+import qualified System.OsString.Data.ByteString.Short.Word16 as BS16+#endif+#else+import System.FilePath.ByteString as X hiding (RawFilePath, getSearchPath)+import System.FilePath.ByteString (getSearchPath)+import Data.ByteString (ByteString)+import Data.Char+import Data.Word+#endif++class OsPathConv t where+	toOsPath :: t -> OsPath+	fromOsPath :: OsPath -> t++instance OsPathConv FilePath where+	toOsPath = toOsPath . toRawFilePath+	fromOsPath = fromRawFilePath . fromOsPath++#ifdef WITH_OSPATH+instance OsPathConv RawFilePath where+#if defined(mingw32_HOST_OS)+	toOsPath = bytesToOsPath+	fromOsPath = bytesFromOsPath+#else+	toOsPath = bytesToOsPath . S.toShort+	fromOsPath = S.fromShort . bytesFromOsPath+#endif++instance OsPathConv ShortByteString where+#if defined(mingw32_HOST_OS)+	toOsPath = bytesToOsPath . S.fromShort+	fromOsPath = S.toShort . bytesFromOsPath+#else+	toOsPath = bytesToOsPath+	fromOsPath = bytesFromOsPath+#endif++instance OsPathConv L.ByteString where+	toOsPath = toOsPath . L.toStrict+	fromOsPath = L.fromStrict . fromOsPath++#if defined(mingw32_HOST_OS)+-- On Windows, OsString contains a ShortByteString that is+-- utf-16 encoded. But the input RawFilePath is assumed to+-- be utf-8. So this is a relatively  expensive conversion.+bytesToOsPath :: RawFilePath -> OsPath+bytesToOsPath = unsafePerformIO . encodeFS . fromRawFilePath+#else+bytesToOsPath :: ShortByteString -> OsPath+bytesToOsPath = OsString . PosixString+#endif++#if defined(mingw32_HOST_OS)+bytesFromOsPath :: OsPath -> RawFilePath+-- On Windows, OsString contains a ShortByteString that is+-- utf-16 encoded, but RawFilePath is utf-8.+-- So this is relatively expensive conversion.+bytesFromOsPath = toRawFilePath . cWcharsToChars_UCS2 . BS16.unpack . getWindowsString . getOsString+#else+bytesFromOsPath :: OsPath -> ShortByteString+bytesFromOsPath = getPosixString . getOsString+#endif++{- For some reason not included in System.OsPath -}+getSearchPath :: IO [OsPath]+getSearchPath = map toOsPath <$> PS.getSearchPath++{- Used for string constants. Note that when using OverloadedStrings,+ - the IsString instance for ShortByteString only works properly with+ - ASCII characters. -}+literalOsPath :: ShortByteString -> OsPath+literalOsPath = toOsPath++#else+{- When not building with WITH_OSPATH, use RawFilePath.+ -}+type OsPath = RawFilePath++type OsString = ByteString++instance OsPathConv RawFilePath where+	toOsPath = id+	fromOsPath = id++instance OsPathConv ShortByteString where+	toOsPath = S.fromShort+	fromOsPath = S.toShort++instance OsPathConv L.ByteString where+	toOsPath = L.toStrict+	fromOsPath = L.fromStrict++unsafeFromChar :: Char -> Word8+unsafeFromChar = fromIntegral . ord++literalOsPath :: RawFilePath -> OsPath+literalOsPath = id+#endif++stringToOsPath :: String -> OsPath+stringToOsPath = toOsPath
+ Utility/OsString.hs view
@@ -0,0 +1,42 @@+{- OsString manipulation. Or ByteString when not built with OsString.+ - Import qualified.+ -+ - Copyright 2025 Joey Hess <id@joeyh.name>+ -+ - License: BSD-2-clause+ -}++{-# LANGUAGE CPP #-}+{-# LANGUAGE PackageImports #-}+{-# LANGUAGE NoImplicitPrelude #-}+{-# OPTIONS_GHC -fno-warn-tabs #-}++module Utility.OsString (+	module X,+	length,+#ifndef WITH_OSPATH+	toChar,+#endif+) where++#ifdef WITH_OSPATH+import System.OsString as X hiding (length)+import qualified System.OsString+import qualified Data.ByteString as B+import Utility.OsPath+import Prelude ((.), Int)++{- Avoid System.OsString.length, which returns the number of code points on+ - windows. This is the number of bytes. -}+length :: System.OsString.OsString -> Int+length = B.length . fromOsPath+#else+import Data.ByteString as X hiding (length)+import Data.ByteString (length)+import Data.Char+import Data.Word+import Prelude (fromIntegral, (.))++toChar :: Word8 -> Char+toChar = chr . fromIntegral+#endif
Utility/Path.hs view
@@ -27,8 +27,6 @@ 	searchPathContents, ) where -import System.FilePath.ByteString-import qualified System.FilePath as P import qualified Data.ByteString as B import Data.List import Data.Maybe@@ -40,10 +38,11 @@ import Utility.Monad import Utility.SystemDirectory import Utility.Exception+import Utility.OsPath+import qualified Utility.OsString as OS  #ifdef mingw32_HOST_OS import Data.Char-import Utility.FileSystemEncoding #endif  copyright :: Authored t => t@@ -53,15 +52,15 @@  - and removing the trailing path separator.  -  - On Windows, preserves whichever style of path separator might be used in- - the input RawFilePaths. This is done because some programs in Windows+ - the input paths. This is done because some programs in Windows  - demand a particular path separator -- and which one actually varies!  -  - This does not guarantee that two paths that refer to the same location,  - and are both relative to the same location (or both absolute) will- - yield the same result. Run both through normalise from System.RawFilePath+ - yield the same result. Run both through normalise from System.OsPath  - to ensure that.  -}-simplifyPath :: RawFilePath -> RawFilePath+simplifyPath :: OsPath -> OsPath simplifyPath path = dropTrailingPathSeparator $  	joinDrive drive $ joinPath $ norm [] $ splitPath path'   where@@ -69,39 +68,40 @@  	norm c [] = reverse c 	norm c (p:ps)-		| p' == ".." && not (null c) && dropTrailingPathSeparator (c !! 0) /= ".." = -			norm (drop 1 c) ps-		| p' == "." = norm c ps+		| p' == dotdot && not (null c) +			&& dropTrailingPathSeparator (c !! 0) /= dotdot = +				norm (drop 1 c) ps+		| p' == dot = norm c ps 		| otherwise = norm (p:c) ps 	  where 		p' = dropTrailingPathSeparator p  {- takeDirectory "foo/bar/" is "foo/bar". This instead yields "foo" -}-parentDir :: RawFilePath -> RawFilePath+parentDir :: OsPath -> OsPath parentDir = takeDirectory . dropTrailingPathSeparator  {- Just the parent directory of a path, or Nothing if the path has no - parent (ie for "/" or "." or "foo") -}-upFrom :: RawFilePath -> Maybe RawFilePath+upFrom :: OsPath -> Maybe OsPath upFrom dir 	| length dirs < 2 = Nothing 	| otherwise = Just $ joinDrive drive $-		B.intercalate (B.singleton pathSeparator) $ init dirs+		OS.intercalate (OS.singleton pathSeparator) $ init dirs   where 	-- on Unix, the drive will be "/" when the dir is absolute, 	-- otherwise "" 	(drive, path) = splitDrive dir-	dirs = filter (not . B.null) $ B.splitWith isPathSeparator path+	dirs = filter (not . OS.null) $ OS.splitWith isPathSeparator path -{- Checks if the first RawFilePath is, or could be said to contain the second.+{- Checks if the first path is, or could be said to contain the second.  - For example, "foo/" contains "foo/bar". Also, "foo", "./foo", "foo/" etc  - are all equivalent.  -}-dirContains :: RawFilePath -> RawFilePath -> Bool+dirContains :: OsPath -> OsPath -> Bool dirContains a b = a == b 	|| a' == b'-	|| (a'' `B.isPrefixOf` b' && avoiddotdotb)-	|| a' == "." && normalise ("." </> b') == b' && nodotdot b'+	|| (a'' `OS.isPrefixOf` b' && avoiddotdotb)+	|| a' == dot && normalise (dot </> b') == b' && nodotdot b' 	|| dotdotcontains   where 	a' = norm a@@ -119,11 +119,11 @@ 	 - a'' is a prefix of b', so all that needs to be done is drop 	 - that prefix, and check if the next path component is ".." 	 -}-	avoiddotdotb = nodotdot $ B.drop (B.length a'') b'+	avoiddotdotb = nodotdot $ OS.drop (OS.length a'') b'  	nodotdot p = all (not . isdotdot) (splitPath p) 	-	isdotdot s = dropTrailingPathSeparator s == ".."+	isdotdot s = dropTrailingPathSeparator s == dotdot  	{- This handles the case where a is ".." or "../.." etc, 	 - and b is "foo" or "../foo" etc. The rule is that when@@ -156,10 +156,10 @@  - we stop preserving ordering at that point. Presumably a user passing  - that many paths in doesn't care too much about order of the later ones.  -}-segmentPaths :: (a -> RawFilePath) -> [RawFilePath] -> [a] -> [[a]]+segmentPaths :: (a -> OsPath) -> [OsPath] -> [a] -> [[a]] segmentPaths = segmentPaths' (\_ r -> r) -segmentPaths' :: (Maybe RawFilePath -> a -> r) -> (a -> RawFilePath) -> [RawFilePath] -> [a] -> [[r]]+segmentPaths' :: (Maybe OsPath -> a -> r) -> (a -> OsPath) -> [OsPath] -> [a] -> [[r]] segmentPaths' f _ [] new = [map (f Nothing) new] segmentPaths' f _ [i] new = [map (f (Just i)) new] -- optimisation segmentPaths' f c (i:is) new = @@ -174,37 +174,37 @@  - than it would be to run the action separately with each path. In  - the case of git file list commands, that assumption tends to hold.  -}-runSegmentPaths :: (a -> RawFilePath) -> ([RawFilePath] -> IO [a]) -> [RawFilePath] -> IO [[a]]+runSegmentPaths :: (a -> OsPath) -> ([OsPath] -> IO [a]) -> [OsPath] -> IO [[a]] runSegmentPaths c a paths = segmentPaths c paths <$> a paths -runSegmentPaths' :: (Maybe RawFilePath -> a -> r) -> (a -> RawFilePath) -> ([RawFilePath] -> IO [a]) -> [RawFilePath] -> IO [[r]]+runSegmentPaths' :: (Maybe OsPath -> a -> r) -> (a -> OsPath) -> ([OsPath] -> IO [a]) -> [OsPath] -> IO [[r]] runSegmentPaths' si c a paths = segmentPaths' si c paths <$> a paths  {- Checks if a filename is a unix dotfile. All files inside dotdirs  - count as dotfiles. -}-dotfile :: RawFilePath -> Bool+dotfile :: OsPath -> Bool dotfile file-	| f == "." = False-	| f == ".." = False-	| f == "" = False-	| otherwise = "." `B.isPrefixOf` f || dotfile (takeDirectory file)+	| f == dot = False+	| f == dotdot = False+	| f == literalOsPath "" = False+	| otherwise = dot `OS.isPrefixOf` f || dotfile (takeDirectory file)   where 	f = takeFileName file -{- Similar to splitExtensions, but knows that some things in RawFilePaths+{- Similar to splitExtensions, but knows that some things in paths  - after a dot are too long to be extensions. -}-splitShortExtensions :: RawFilePath -> (RawFilePath, [B.ByteString])+splitShortExtensions :: OsPath -> (OsPath, [B.ByteString]) splitShortExtensions = splitShortExtensions' 5 -- enough for ".jpeg"-splitShortExtensions' :: Int -> RawFilePath -> (RawFilePath, [B.ByteString])+splitShortExtensions' :: Int -> OsPath -> (OsPath, [B.ByteString]) splitShortExtensions' maxextension = go []   where 	go c f-		| len > 0 && len <= maxextension && not (B.null base) = -			go (ext:c) base+		| len > 0 && len <= maxextension && not (OS.null base) = +			go (fromOsPath ext:c) base 		| otherwise = (f, c) 	  where 		(base, ext) = splitExtension f-		len = B.length ext+		len = OS.length ext  {- This requires both paths to be absolute and normalized.  -@@ -212,7 +212,7 @@  - a relative path is not possible and the path is simply  - returned as-is.  -}-relPathDirToFileAbs :: RawFilePath -> RawFilePath -> RawFilePath+relPathDirToFileAbs :: OsPath -> OsPath -> OsPath relPathDirToFileAbs from to #ifdef mingw32_HOST_OS 	| normdrive from /= normdrive to = to@@ -225,15 +225,15 @@ 	common = map fst $ takeWhile same $ zip pfrom pto 	same (c,d) = c == d 	uncommon = drop numcommon pto-	dotdots = replicate (length pfrom - numcommon) ".."+	dotdots = replicate (length pfrom - numcommon) dotdot 	numcommon = length common #ifdef mingw32_HOST_OS 	normdrive = map toLower+		. fromOsPath 		-- Get just the drive letter, removing any leading 		-- path separator, which takeDrive leaves on the drive 		-- letter.-		. dropWhileEnd (isPathSeparator . fromIntegral . ord)-		. fromRawFilePath +		. OS.dropWhileEnd isPathSeparator 		. takeDrive #endif @@ -251,15 +251,16 @@  -  - Note that this will find commands in PATH that are not executable.  -}-searchPath :: String -> IO (Maybe FilePath)+searchPath :: String -> IO (Maybe OsPath) searchPath command-	| P.isAbsolute command = copyright $ check command-	| otherwise = P.getSearchPath >>= getM indir+	| isAbsolute command' = copyright $ check command'+	| otherwise = getSearchPath >>= getM indir   where-	indir d = check $ d P.</> command+	command' = toOsPath command+	indir d = check (d </> command') 	check f = firstM doesFileExist #ifdef mingw32_HOST_OS-		[f, f ++ ".exe"]+		[f, f <> literalOsPath ".exe"] #else 		[f] #endif@@ -270,10 +271,17 @@  -  - Note that this will find commands in PATH that are not executable.  -}-searchPathContents :: (FilePath -> Bool) -> IO [FilePath]+searchPathContents :: (OsPath -> Bool) -> IO [OsPath] searchPathContents p = 	filterM doesFileExist -		=<< (concat <$> (P.getSearchPath >>= mapM go))+		=<< (concat <$> (getSearchPath >>= mapM go))   where-	go d = map (d P.</>) . filter p+	go d = map (d </>) . filter p 		<$> catchDefaultIO [] (getDirectoryContents d)++dot :: OsPath+dot = literalOsPath "."++dotdot :: OsPath+dotdot = literalOsPath ".."+
Utility/Path/AbsRel.hs view
@@ -17,15 +17,14 @@ 	relHome, ) where -import System.FilePath.ByteString import qualified Data.ByteString as B import Control.Applicative import Prelude  import Utility.Path import Utility.UserInfo-import Utility.FileSystemEncoding-import qualified Utility.RawFilePath as R+import Utility.OsPath+import Utility.SystemDirectory  {- Makes a path absolute.  -@@ -37,7 +36,7 @@  - Does not attempt to deal with edge cases or ensure security with  - untrusted inputs.  -}-absPathFrom :: RawFilePath -> RawFilePath -> RawFilePath+absPathFrom :: OsPath -> OsPath -> OsPath absPathFrom dir path = simplifyPath (combine dir path)  {- Converts a filename into an absolute path.@@ -46,14 +45,14 @@  -  - Unlike Directory.canonicalizePath, this does not require the path  - already exists. -}-absPath :: RawFilePath -> IO RawFilePath+absPath :: OsPath -> IO OsPath absPath file 	-- Avoid unnecessarily getting the current directory when the path 	-- is already absolute. absPathFrom uses simplifyPath 	-- so also used here for consistency. 	| isAbsolute file = return $ simplifyPath file 	| otherwise = do-		cwd <- R.getCurrentDirectory+		cwd <- getCurrentDirectory 		return $ absPathFrom cwd file  {- Constructs the minimal relative path from the CWD to a file.@@ -63,24 +62,23 @@  -    relPathCwdToFile "/tmp/foo/bar" == ""   -    relPathCwdToFile "../bar/baz" == "baz"  -}-relPathCwdToFile :: RawFilePath -> IO RawFilePath+relPathCwdToFile :: OsPath -> IO OsPath relPathCwdToFile f 	-- Optimisation: Avoid doing any IO when the path is relative 	-- and does not contain any ".." component.-	| isRelative f && not (".." `B.isInfixOf` f) = return f+	| isRelative f && not (".." `B.isInfixOf` fromOsPath f) = return f 	| otherwise = do-		c <- R.getCurrentDirectory+		c <- getCurrentDirectory 		relPathDirToFile c f  {- Constructs a minimal relative path from a directory to a file. -}-relPathDirToFile :: RawFilePath -> RawFilePath -> IO RawFilePath+relPathDirToFile :: OsPath -> OsPath -> IO OsPath relPathDirToFile from to = relPathDirToFileAbs <$> absPath from <*> absPath to  {- Converts paths in the home directory to use ~/ -}-relHome :: FilePath -> IO String+relHome :: OsPath -> IO OsPath relHome path = do-	let path' = toRawFilePath path-	home <- toRawFilePath <$> myHomeDir-	return $ if dirContains home path'-		then fromRawFilePath ("~/" <> relPathDirToFileAbs home path')+	home <- toOsPath <$> myHomeDir+	return $ if dirContains home path+		then literalOsPath "~/" <> relPathDirToFileAbs home path 		else path
Utility/Path/Tests.hs view
@@ -17,42 +17,39 @@ 	prop_dirContains_regressionTest, ) where -import System.FilePath.ByteString-import qualified Data.ByteString as B import Data.List import Data.Maybe-import Data.Char import Control.Applicative import Prelude -import Utility.Path-import Utility.FileSystemEncoding+import Common import Utility.QuickCheck+import qualified Utility.OsString as OS  prop_upFrom_basics :: TestableFilePath -> Bool prop_upFrom_basics tdir 	| dir == "/" = p == Nothing 	| otherwise = p /= Just dir   where-	p = fromRawFilePath <$> upFrom (toRawFilePath dir)+	p = fromOsPath <$> upFrom (toOsPath dir) 	dir = fromTestableFilePath tdir  prop_relPathDirToFileAbs_basics :: TestableFilePath -> Bool prop_relPathDirToFileAbs_basics pt = and-	[ relPathDirToFileAbs p (p </> "bar") == "bar"-	, relPathDirToFileAbs (p </> "bar") p == ".."-	, relPathDirToFileAbs p p == ""+	[ relPathDirToFileAbs p (p </> literalOsPath "bar") == literalOsPath "bar"+	, relPathDirToFileAbs (p </> literalOsPath "bar") p == literalOsPath ".."+	, relPathDirToFileAbs p p == literalOsPath "" 	]   where 	-- relPathDirToFileAbs needs absolute paths, so make the path 	-- absolute by adding a path separator to the front.-	p = pathSeparator `B.cons` relf+	p = pathSeparator `OS.cons` relf 	-- Make the input a relative path. On windows, make sure it does 	-- not contain anything that looks like a drive letter.-	relf = B.dropWhile isPathSeparator $-		B.filter (not . skipchar) $-		toRawFilePath (fromTestableFilePath pt)-	skipchar b = b == (fromIntegral (ord ':'))+	relf = OS.dropWhile isPathSeparator $+		OS.filter (not . skipchar) $+		toOsPath (fromTestableFilePath pt)+	skipchar b = b == unsafeFromChar ':'  prop_relPathDirToFileAbs_regressionTest :: Bool prop_relPathDirToFileAbs_regressionTest = same_dir_shortcurcuits_at_difference@@ -61,21 +58,25 @@ 	 - location, but it's not really the same directory. 	 - Code used to get this wrong. -} 	same_dir_shortcurcuits_at_difference =-		relPathDirToFileAbs (joinPath [pathSeparator `B.cons` "tmp", "r", "lll", "xxx", "yyy", "18"])-			(joinPath [pathSeparator `B.cons` "tmp", "r", ".git", "annex", "objects", "18", "gk", "SHA256-foo", "SHA256-foo"])-				== joinPath ["..", "..", "..", "..", ".git", "annex", "objects", "18", "gk", "SHA256-foo", "SHA256-foo"]+		relPathDirToFileAbs (mkp [fromOsPath (pathSeparator `OS.cons` literalOsPath "tmp"), "r", "lll", "xxx", "yyy", "18"])+			(mkp [fromOsPath (pathSeparator `OS.cons` literalOsPath "tmp"), "r", ".git", "annex", "objects", "18", "gk", "SHA256-foo", "SHA256-foo"])+				== mkp ["..", "..", "..", "..", ".git", "annex", "objects", "18", "gk", "SHA256-foo", "SHA256-foo"]+	  where+		mkp = joinPath . map literalOsPath  prop_dirContains_regressionTest :: Bool prop_dirContains_regressionTest = and-	[ not $ dirContains "." ".."-	, not $ dirContains ".." "../.."-	, dirContains "." "foo"-	, dirContains "." "."-	, dirContains ".." ".."-	, dirContains "../.." "../.."-	, dirContains "." "./foo"-	, dirContains ".." "../foo"-	, dirContains "../.." "../foo"-	, dirContains "../.." "../../foo"-	, not $ dirContains "../.." "../../.."+	[ not $ dc "." ".."+	, not $ dc ".." "../.."+	, dc "." "foo"+	, dc "." "."+	, dc ".." ".."+	, dc "../.." "../.."+	, dc "." "./foo"+	, dc ".." "../foo"+	, dc "../.." "../foo"+	, dc "../.." "../../foo"+	, not $ dc "../.." "../../.." 	]+  where+	dc x y = dirContains (literalOsPath x) (literalOsPath y)
Utility/Path/Windows.hs view
@@ -13,12 +13,13 @@ ) where  import Utility.Path+import Utility.OsPath+import qualified Utility.OsString as OS+import Utility.SystemDirectory import Utility.FileSystemEncoding -import System.FilePath.ByteString (combine) import qualified Data.ByteString as B-import qualified System.FilePath.Windows.ByteString as P-import System.Directory (getCurrentDirectory)+import qualified System.FilePath.Windows as WinPath  {- Convert a filepath to use Windows's native namespace.  - This avoids filesystem length limits.@@ -36,11 +37,17 @@ 	| otherwise = do 		-- Make absolute because any '.' and '..' in the path 		-- will not be resolved once it's converted.-		cwd <- toRawFilePath <$> getCurrentDirectory-		let p = simplifyPath (combine cwd f)+		cwd <- getCurrentDirectory+		let p = simplifyPath (combine cwd (toOsPath f))+		-- If the input path is absolute but does not include a drive,+		-- add the drive from the cwd, because a path in the native+		-- namespace must include a drive.+		let p' = if OS.null (takeDrive p)+			then joinDrive (takeDrive cwd) p+			else p 		-- Normalize slashes.-		let p' = P.normalise p-		return (win32_file_namespace <> p')+		let p'' = encodeBS $ WinPath.normalise $ fromOsPath p'+		return (win32_file_namespace <> p'')   where 	win32_dev_namespace = "\\\\.\\" 	win32_file_namespace = "\\\\?\\"
Utility/RawFilePath.hs view
@@ -22,12 +22,8 @@ 	readSymbolicLink, 	createSymbolicLink, 	createLink,-	removeLink, 	getFileStatus, 	getSymbolicLinkStatus,-	doesPathExist,-	getCurrentDirectory,-	createDirectory, 	setFileMode, 	setOwnerAndGroup, 	rename,@@ -38,19 +34,7 @@ #ifndef mingw32_HOST_OS import Utility.FileSystemEncoding (RawFilePath) import System.Posix.Files.ByteString-import qualified System.Posix.Directory.ByteString as D --- | Checks if a file or directory exists. Note that a dangling symlink--- will be false.-doesPathExist :: RawFilePath -> IO Bool-doesPathExist = fileExist--getCurrentDirectory :: IO RawFilePath-getCurrentDirectory = D.getWorkingDirectory--createDirectory :: RawFilePath -> IO ()-createDirectory p = D.createDirectory p 0o777- #else import System.PosixCompat (FileStatus, FileMode) -- System.PosixCompat does not handle UNC-style conversion itself,@@ -76,11 +60,6 @@ 	b' <- fromRawFilePath <$> convertToWindowsNativeNamespace b 	P.createLink a' b' -{- On windows, removeLink is not available, so only remove files,- - not symbolic links. -}-removeLink :: RawFilePath -> IO ()-removeLink = D.removeFile . fromRawFilePath- getFileStatus :: RawFilePath -> IO FileStatus getFileStatus p = P.getFileStatus . fromRawFilePath 	=<< convertToWindowsNativeNamespace p@@ -89,22 +68,13 @@ getSymbolicLinkStatus p = P.getSymbolicLinkStatus . fromRawFilePath 	=<< convertToWindowsNativeNamespace p -doesPathExist :: RawFilePath -> IO Bool-doesPathExist = D.doesPathExist . fromRawFilePath--getCurrentDirectory :: IO RawFilePath-getCurrentDirectory = toRawFilePath <$> D.getCurrentDirectory--createDirectory :: RawFilePath -> IO ()-createDirectory = D.createDirectory . fromRawFilePath- setFileMode :: RawFilePath -> FileMode -> IO ()  setFileMode p m = do 	p' <- fromRawFilePath <$> convertToWindowsNativeNamespace p 	P.setFileMode p' m  {- Using renamePath rather than the rename provided in unix-compat- - because of this bug https://github.com/jacobstanley/unix-compat/issues/56-}+ - because of this bug https://github.com/jacobstanley/unix-compat/issues/56 -} rename :: RawFilePath -> RawFilePath -> IO () rename a b = D.renamePath (fromRawFilePath a) (fromRawFilePath b)
Utility/Rsync.hs view
@@ -25,6 +25,7 @@  #ifdef mingw32_HOST_OS import qualified System.FilePath.Posix as Posix+import qualified Utility.OsString as OS #endif  import Data.Char@@ -102,7 +103,7 @@ rsyncUrlIsPath :: String -> Bool rsyncUrlIsPath s #ifdef mingw32_HOST_OS-	| not (null (takeDrive s)) = True+	| not (OS.null (takeDrive (toOsPath s))) = True #endif 	| rsyncUrlIsShell s = False 	| otherwise = ':' `notElem` s@@ -174,15 +175,15 @@ #ifdef mingw32_HOST_OS toMSYS2Path :: FilePath -> FilePath toMSYS2Path p-	| null drive = recombine parts-	| otherwise = recombine $ "/" : driveletter drive : parts+	| OS.null drive = recombine parts+	| otherwise = recombine $ "/" : driveletter (fromOsPath drive) : parts   where-	(drive, p') = splitDrive p-	parts = splitDirectories p'+	(drive, p') = splitDrive (toOsPath p)+	parts = map fromOsPath $ splitDirectories p' 	driveletter = map toLower . takeWhile (/= ':') 	recombine = fixtrailing . Posix.joinPath 	fixtrailing s-		| hasTrailingPathSeparator p = Posix.addTrailingPathSeparator s+		| hasTrailingPathSeparator (toOsPath p) = Posix.addTrailingPathSeparator s 		| otherwise = s #endif
Utility/SafeCommand.hs view
@@ -10,6 +10,7 @@ module Utility.SafeCommand ( 	CommandParam(..), 	toCommand,+	toCommand', 	boolSystem, 	boolSystem', 	boolSystemEnv,
Utility/SafeOutput.hs view
@@ -17,6 +17,11 @@ import Data.Char import qualified Data.ByteString as S +#ifdef WITH_OSPATH+import qualified Utility.OsString as OS+import Utility.OsPath+#endif+ class SafeOutputtable t where 	safeOutput :: t -> t @@ -25,6 +30,11 @@  instance SafeOutputtable S.ByteString where 	safeOutput = S.filter (safeOutputChar . chr . fromIntegral)++#ifdef WITH_OSPATH+instance SafeOutputtable OsString where+	safeOutput = OS.filter (safeOutputChar . toChar)+#endif  safeOutputChar :: Char -> Bool safeOutputChar c
Utility/Shell.hs view
@@ -13,6 +13,7 @@ 	findShellCommand, ) where +import Utility.OsPath import Utility.SafeCommand #ifdef mingw32_HOST_OS import Utility.Path@@ -20,10 +21,6 @@ import Utility.PartialPrelude #endif -#ifdef mingw32_HOST_OS-import System.FilePath-#endif- shellPath :: FilePath shellPath = "/bin/sh" @@ -35,24 +32,24 @@ -- parse it for shebang. -- -- This has no effect on Unix.-findShellCommand :: FilePath -> IO (FilePath, [CommandParam])+findShellCommand :: OsPath -> IO (FilePath, [CommandParam]) findShellCommand f = do #ifndef mingw32_HOST_OS 	defcmd #else-	l <- catchDefaultIO Nothing $ headMaybe . lines <$> readFile f+	l <- catchDefaultIO Nothing $ headMaybe . lines <$> readFile (fromOsPath f) 	case l of 		Just ('#':'!':rest) -> case words rest of 			[] -> defcmd 			(c:ps) -> do-				let ps' = map Param ps ++ [File f]+				let ps' = map Param ps ++ [File (fromOsPath f)] 				-- If the command is not inSearchPath, 				-- take the base of it, and run eg "sh" 				-- which in some cases on windows will work 				-- despite it not being inSearchPath. 				ok <- inSearchPath c-				return (if ok then c else takeFileName c, ps')+				return (if ok then c else fromOsPath (takeFileName (toOsPath c)), ps') 		_ -> defcmd #endif   where-	defcmd = return (f, [])+	defcmd = return (fromOsPath f, [])
Utility/SshConfig.hs view
@@ -5,6 +5,8 @@  - License: BSD-2-clause  -} +{-# LANGUAGE OverloadedStrings #-}+ module Utility.SshConfig ( 	SshConfig(..), 	Comment(..),@@ -28,11 +30,13 @@ import Utility.UserInfo import Utility.Tmp import Utility.FileMode+import qualified Utility.FileIO as F  import Data.Char import Data.Ord import Data.Either import System.PosixCompat.Files (groupWriteMode, otherWriteMode)+import qualified Data.ByteString.Char8 as S8  data SshConfig 	= GlobalConfig SshSetting@@ -132,9 +136,10 @@ changeUserSshConfig :: (String -> String) -> IO () changeUserSshConfig modifier = do 	sshdir <- sshDir-	let configfile = sshdir </> "config"+	let configfile = sshdir </> literalOsPath "config" 	whenM (doesFileExist configfile) $ do-		c <- readFileStrict configfile+		c <- decodeBS . S8.unlines . fileLines'+			<$> F.readFile' configfile 		let c' = modifier c 		when (c /= c') $ do 			-- If it's a symlink, replace the file it@@ -142,10 +147,10 @@ 			f <- catchDefaultIO configfile (canonicalizePath configfile) 			viaTmp writeSshConfig f c' -writeSshConfig :: FilePath -> String -> IO ()+writeSshConfig :: OsPath -> String -> IO () writeSshConfig f s = do-	writeFile f s-	setSshConfigMode (toRawFilePath f)+	F.writeFile' f (linesFile' (encodeBS s))+	setSshConfigMode f  {- Ensure that the ssh config file lacks any group or other write bits,   - since ssh is paranoid about not working if other users can write@@ -154,11 +159,11 @@  - If the chmod fails, ignore the failure, as it might be a filesystem like  - Android's that does not support file modes.  -}-setSshConfigMode :: RawFilePath -> IO ()+setSshConfigMode :: OsPath -> IO () setSshConfigMode f = void $ tryIO $ modifyFileMode f $ 	removeModes [groupWriteMode, otherWriteMode] -sshDir :: IO FilePath+sshDir :: IO OsPath sshDir = do 	home <- myHomeDir-	return $ home </> ".ssh"+	return $ toOsPath home </> literalOsPath ".ssh"
Utility/StatelessOpenPGP.hs view
@@ -70,7 +70,7 @@  - The directory does not really have to be empty, it just needs to be one  - that should not contain any files with names starting with "@".  -}-newtype EmptyDirectory = EmptyDirectory FilePath+newtype EmptyDirectory = EmptyDirectory OsPath  {- Encrypt using symmetric encryption with the specified password. -} encryptSymmetric@@ -112,7 +112,7 @@ {- Test a value round-trips through symmetric encryption and decryption. -} test_encrypt_decrypt_Symmetric :: SOPCmd -> SOPCmd -> Password -> Armoring -> B.ByteString -> IO Bool test_encrypt_decrypt_Symmetric a b password armoring v = catchBoolIO $-	withTmpDir "test" $ \d -> do+	withTmpDir (literalOsPath "test") $ \d -> do 		let ed = EmptyDirectory d 		enc <- encryptSymmetric a password ed Nothing armoring 			(`B.hPutStr` v) B.hGetContents@@ -159,10 +159,10 @@ 		go (Just emptydirectory) (passwordfd ++ params) #else 	-- store the password in a temp file-	withTmpFile "sop" $ \tmpfile h -> do+	withTmpFile (literalOsPath "sop") $ \tmpfile h -> do 		liftIO $ B.hPutStr h password 		liftIO $ hClose h-		let passwordfile = [Param $ "--with-password="++tmpfile]+		let passwordfile = [Param $ "--with-password=" ++ fromOsPath tmpfile] 		-- Don't need to pass emptydirectory since @FD is not used, 		-- and so tmpfile also does not need to be made absolute. 		case emptydirectory of@@ -188,7 +188,7 @@ 		, std_out = CreatePipe 		, std_err = Inherit 		, cwd = case med of-			Just (EmptyDirectory d) -> Just d+			Just (EmptyDirectory d) -> Just (fromOsPath d) 			Nothing -> Nothing 		} 	copyright =<< bracket (setup p) cleanup (go p)
Utility/Su.hs view
@@ -70,7 +70,7 @@ mkSuCommand :: String -> [CommandParam] -> IO (Maybe SuCommand) #ifndef mingw32_HOST_OS mkSuCommand cmd ps = do-	pwd <- getCurrentDirectory+	pwd <- fromOsPath <$> getCurrentDirectory 	firstM (\(SuCommand _ p _) -> inSearchPath p) =<< selectcmds pwd   where 	selectcmds pwd = ifM (inx <||> (not <$> atconsole))
Utility/SystemDirectory.hs view
@@ -1,16 +1,106 @@-{- System.Directory without its conflicting isSymbolicLink and getFileSize.+{- System.Directory wrapped to use OsPath.  -+ - getFileSize is omitted, use Utility.FileSize instead+ -  - Copyright 2016 Joey Hess <id@joeyh.name>  -  - License: BSD-2-clause  -} --- Disable warnings because only some versions of System.Directory export--- isSymbolicLink.-{-# OPTIONS_GHC -fno-warn-tabs -w #-}+{-# LANGUAGE CPP #-}+{-# OPTIONS_GHC -fno-warn-tabs #-}  module Utility.SystemDirectory (-	module System.Directory+	createDirectory,+	createDirectoryIfMissing,+	removeDirectory,+	removeDirectoryRecursive,+	removePathForcibly,+	renameDirectory,+	listDirectory,+	getDirectoryContents,+	getCurrentDirectory,+	setCurrentDirectory,+	withCurrentDirectory,+	getTemporaryDirectory,+	removeFile,+	renameFile,+	renamePath,+	copyFile,+	canonicalizePath,+	doesPathExist,+	doesFileExist,+	doesDirectoryExist,+	getModificationTime, ) where -import System.Directory hiding (isSymbolicLink, getFileSize)+#ifdef WITH_OSPATH+import System.Directory.OsPath+#else+import qualified System.Directory as X+import Data.Time.Clock (UTCTime)+import Utility.OsPath++createDirectory :: OsPath -> IO ()+createDirectory = X.createDirectory . fromOsPath++createDirectoryIfMissing :: Bool -> OsPath -> IO ()+createDirectoryIfMissing b = X.createDirectoryIfMissing b . fromOsPath++removeDirectory :: OsPath -> IO ()+removeDirectory = X.removeDirectory . fromOsPath++removeDirectoryRecursive :: OsPath -> IO ()+removeDirectoryRecursive = X.removeDirectoryRecursive . fromOsPath++removePathForcibly :: OsPath -> IO ()+removePathForcibly = X.removePathForcibly . fromOsPath++renameDirectory :: OsPath -> OsPath -> IO ()+renameDirectory a b = X.renameDirectory (fromOsPath a) (fromOsPath b)++listDirectory :: OsPath -> IO [OsPath]+listDirectory p = map toOsPath <$> X.listDirectory (fromOsPath p)++getDirectoryContents :: OsPath -> IO [OsPath]+getDirectoryContents p = map toOsPath <$> X.getDirectoryContents (fromOsPath p)++getCurrentDirectory :: IO OsPath+getCurrentDirectory = toOsPath <$> X.getCurrentDirectory++setCurrentDirectory :: OsPath -> IO ()+setCurrentDirectory = X.setCurrentDirectory . fromOsPath++withCurrentDirectory :: OsPath -> IO a -> IO a+withCurrentDirectory = X.withCurrentDirectory . fromOsPath++getTemporaryDirectory :: IO OsPath+getTemporaryDirectory = toOsPath <$> X.getTemporaryDirectory++removeFile :: OsPath -> IO ()+removeFile = X.removeFile . fromOsPath++renameFile :: OsPath -> OsPath -> IO ()+renameFile a b = X.renameFile (fromOsPath a) (fromOsPath b)++renamePath :: OsPath -> OsPath -> IO ()+renamePath a b = X.renamePath (fromOsPath a) (fromOsPath b)++copyFile :: OsPath -> OsPath -> IO ()+copyFile a b = X.copyFile (fromOsPath a) (fromOsPath b)++canonicalizePath :: OsPath -> IO OsPath+canonicalizePath p = toOsPath <$> X.canonicalizePath (fromOsPath p)++doesPathExist :: OsPath -> IO Bool+doesPathExist = X.doesPathExist . fromOsPath++doesFileExist :: OsPath -> IO Bool+doesFileExist = X.doesFileExist . fromOsPath++doesDirectoryExist :: OsPath -> IO Bool+doesDirectoryExist = X.doesDirectoryExist . fromOsPath++getModificationTime :: OsPath -> IO UTCTime+getModificationTime = X.getModificationTime . fromOsPath+#endif
Utility/TimeStamp.hs view
@@ -19,7 +19,6 @@ import Data.Ratio import Control.Applicative import qualified Data.ByteString as B-import qualified Data.ByteString.Char8 as B8 import qualified Data.Attoparsec.ByteString as A import Data.Attoparsec.ByteString.Char8 (char, decimal, signed, isDigit_w8) @@ -41,9 +40,9 @@ 			A.parseOnly (decimal <* A.endOfInput) b 		return (d, len) -parsePOSIXTime :: String -> Maybe POSIXTime-parsePOSIXTime s = eitherToMaybe $ -	A.parseOnly (parserPOSIXTime <* A.endOfInput) (B8.pack s)+parsePOSIXTime :: B.ByteString -> Maybe POSIXTime+parsePOSIXTime b = eitherToMaybe $ +	A.parseOnly (parserPOSIXTime <* A.endOfInput) b  {- This implementation allows for higher precision in a POSIXTime than  - supported by the system's Double, and avoids the complications of
Utility/Tmp.hs view
@@ -1,10 +1,11 @@ {- Temporary files.  -- - Copyright 2010-2020 Joey Hess <id@joeyh.name>+ - Copyright 2010-2025 Joey Hess <id@joeyh.name>  -  - License: BSD-2-clause  -} +{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE CPP #-} {-# OPTIONS_GHC -fno-warn-tabs #-} @@ -13,33 +14,39 @@ 	viaTmp, 	withTmpFile, 	withTmpFileIn,-	relatedTemplate, 	openTmpFileIn,+	relatedTemplate,+	relatedTemplate', ) where  import System.IO-import System.FilePath-import System.Directory import Control.Monad.IO.Class import System.IO.Error+#ifndef mingw32_HOST_OS+import Data.Char+import qualified Data.ByteString as B+#endif  import Utility.Exception import Utility.FileSystemEncoding import Utility.FileMode import qualified Utility.RawFilePath as R+import qualified Utility.FileIO as F+import Utility.OsPath+import Utility.SystemDirectory -type Template = String+type Template = OsString  {- This is the same as openTempFile, except when there is an  - error, it displays the template as well as the directory,  - to help identify what call was responsible.  -}-openTmpFileIn :: FilePath -> String -> IO (FilePath, Handle)-openTmpFileIn dir template = openTempFile dir template+openTmpFileIn :: OsPath -> Template -> IO (OsPath, Handle)+openTmpFileIn dir template = F.openTempFile dir template 	`catchIO` decoraterrror   where 	decoraterrror e = throwM $-		let loc = ioeGetLocation e ++ " template " ++ template+		let loc = ioeGetLocation e ++ " template " ++ decodeBS (fromOsPath template) 		in annotateIOError e loc Nothing Nothing  {- Runs an action like writeFile, writing to a temp file first and@@ -50,11 +57,11 @@  - mode as it would when using writeFile, unless the writer action changes  - it.  -}-viaTmp :: (MonadMask m, MonadIO m) => (FilePath -> v -> m ()) -> FilePath -> v -> m ()+viaTmp :: (MonadMask m, MonadIO m) => (OsPath -> v -> m ()) -> OsPath -> v -> m () viaTmp a file content = bracketIO setup cleanup use   where 	(dir, base) = splitFileName file-	template = relatedTemplate (base ++ ".tmp")+	template = relatedTemplate (fromOsPath base <> ".tmp") 	setup = do 		createDirectoryIfMissing True dir 		openTmpFileIn dir template@@ -62,21 +69,23 @@ 		_ <- tryIO $ hClose h 		tryIO $ removeFile tmpfile 	use (tmpfile, h) = do-		let tmpfile' = toRawFilePath tmpfile+		let tmpfile' = fromOsPath tmpfile 		-- Make mode the same as if the file were created usually, 		-- not as a temp file. (This may fail on some filesystems 		-- that don't support file modes well, so ignore 		-- exceptions.)-		_ <- liftIO $ tryIO $ R.setFileMode tmpfile' =<< defaultFileMode+		_ <- liftIO $ tryIO $+			R.setFileMode (fromOsPath tmpfile)+				=<< defaultFileMode 		liftIO $ hClose h 		a tmpfile content-		liftIO $ R.rename tmpfile' (toRawFilePath file)+		liftIO $ R.rename tmpfile' (fromOsPath file)  {- Runs an action with a tmp file located in the system's tmp directory  - (or in "." if there is none) then removes the file. -}-withTmpFile :: (MonadIO m, MonadMask m) => Template -> (FilePath -> Handle -> m a) -> m a+withTmpFile :: (MonadIO m, MonadMask m) => Template -> (OsPath -> Handle -> m a) -> m a withTmpFile template a = do-	tmpdir <- liftIO $ catchDefaultIO "." getTemporaryDirectory+	tmpdir <- liftIO $ catchDefaultIO (literalOsPath ".") getTemporaryDirectory 	withTmpFileIn tmpdir template a  {- Runs an action with a tmp file located in the specified directory,@@ -85,13 +94,13 @@  - Note that the tmp file will have a file mode that only allows the  - current user to access it.  -}-withTmpFileIn :: (MonadIO m, MonadMask m) => FilePath -> Template -> (FilePath -> Handle -> m a) -> m a+withTmpFileIn :: (MonadIO m, MonadMask m) => OsPath -> Template -> (OsPath -> Handle -> m a) -> m a withTmpFileIn tmpdir template a = bracket create remove use   where 	create = liftIO $ openTmpFileIn tmpdir template 	remove (name, h) = liftIO $ do 		hClose h-		catchBoolIO (removeFile name >> return True)+		tryIO $ removeFile name 	use (name, h) = a name h  {- It's not safe to use a FilePath of an existing file as the template@@ -99,18 +108,37 @@  - will be longer, and may exceed the maximum filename length.  -  - This generates a template that is never too long.- - (Well, it allocates 20 characters for use in making a unique temp file,- - anyway, which is enough for the current implementation and any- - likely implementation.)  -}-relatedTemplate :: FilePath -> FilePath-relatedTemplate f-	| len > 20 = +relatedTemplate :: RawFilePath -> Template+relatedTemplate = toOsPath . relatedTemplate'++relatedTemplate' :: RawFilePath -> RawFilePath+#ifndef mingw32_HOST_OS+relatedTemplate' f+	| len > templateAddedLength =  		{- Some filesystems like FAT have issues with filenames 		 - ending in ".", so avoid truncating a filename to end 		 - that way. -}-		reverse $ dropWhile (== '.') $ reverse $-			truncateFilePath (len - 20) f+		B.dropWhileEnd (== dot) $+			truncateFilePath (len - templateAddedLength) f 	| otherwise = f   where-	len = length f+	len = B.length f+	dot = fromIntegral (ord '.')+#else+-- Avoids a test suite failure on windows, reason unknown, but+-- best to keep paths short on windows anyway.+relatedTemplate' _ = "t"+#endif++{- When a Template is used to create a temporary file, some random bytes+ - are appended to it. This is how many such bytes can be added, maximum.+ -+ - This needs to be as long or longer than the current implementation+ - of openTempFile, and some extra has been added to make it longer+ - than any likely implementation.+ -}+#ifndef mingw32_HOST_OS+templateAddedLength :: Int+templateAddedLength = 20+#endif
Utility/Tmp/Dir.hs view
@@ -1,12 +1,13 @@ {- Temporary directories  -- - Copyright 2010-2022 Joey Hess <id@joeyh.name>+ - Copyright 2010-2025 Joey Hess <id@joeyh.name>  -  - License: BSD-2-clause  -}  {-# LANGUAGE CPP #-} {-# OPTIONS_GHC -fno-warn-tabs #-}+{-# LANGUAGE OverloadedStrings #-}  module Utility.Tmp.Dir ( 	withTmpDir,@@ -14,8 +15,6 @@ ) where  import Control.Monad.IfElse-import System.FilePath-import System.Directory import Control.Monad.IO.Class #ifndef mingw32_HOST_OS import System.Posix.Temp (mkdtemp)@@ -23,17 +22,21 @@  import Utility.Exception import Utility.Tmp (Template)+import Utility.OsPath+import Utility.SystemDirectory  {- Runs an action with a tmp directory located within the system's tmp  - directory (or within "." if there is none), then removes the tmp  - directory and all its contents. -}-withTmpDir :: (MonadMask m, MonadIO m) => Template -> (FilePath -> m a) -> m a+withTmpDir :: (MonadMask m, MonadIO m) => Template -> (OsPath -> m a) -> m a withTmpDir template a = do-	topleveltmpdir <- liftIO $ catchDefaultIO "." getTemporaryDirectory+	topleveltmpdir <- liftIO $+		catchDefaultIO (literalOsPath ".") getTemporaryDirectory #ifndef mingw32_HOST_OS+	let p = fromOsPath $ topleveltmpdir </> template 	-- Use mkdtemp to create a temp directory securely in /tmp. 	bracket-		(liftIO $ mkdtemp $ topleveltmpdir </> template)+		(liftIO $ toOsPath <$> mkdtemp p) 		removeTmpDir 		a #else@@ -42,21 +45,21 @@  {- Runs an action with a tmp directory located within a specified directory,  - then removes the tmp directory and all its contents. -}-withTmpDirIn :: (MonadMask m, MonadIO m) => FilePath -> Template -> (FilePath -> m a) -> m a+withTmpDirIn :: (MonadMask m, MonadIO m) => OsPath -> Template -> (OsPath -> m a) -> m a withTmpDirIn tmpdir template = bracketIO create removeTmpDir   where 	create = do 		createDirectoryIfMissing True tmpdir 		makenewdir (tmpdir </> template) (0 :: Int) 	makenewdir t n = do-		let dir = t ++ "." ++ show n+		let dir = t <> toOsPath ("." ++ show n) 		catchIOErrorType AlreadyExists (const $ makenewdir t $ n + 1) $ do 			createDirectory dir 			return dir  {- Deletes the entire contents of the the temporary directory, if it  - exists. -}-removeTmpDir :: MonadIO m => FilePath -> m ()+removeTmpDir :: MonadIO m => OsPath -> m () removeTmpDir tmpdir = liftIO $ whenM (doesDirectoryExist tmpdir) $ do #if mingw32_HOST_OS 	-- Windows will often refuse to delete a file
Utility/Tor.hs view
@@ -5,6 +5,8 @@  - Licensed under the GNU AGPL version 3 or higher.  -} +{-# LANGUAGE OverloadedStrings #-}+ module Utility.Tor ( 	OnionPort, 	OnionAddress(..),@@ -21,6 +23,7 @@ import Utility.ThreadScheduler import Utility.FileMode import Utility.RawFilePath (setOwnerAndGroup)+import qualified Utility.OsString as OS  import System.PosixCompat.Types import System.PosixCompat.Files (ownerReadMode, ownerWriteMode, ownerExecuteMode)@@ -35,7 +38,7 @@ newtype OnionAddress = OnionAddress String 	deriving (Show, Eq) -type OnionSocket = FilePath+type OnionSocket = OsPath  -- | A unique identifier for a hidden service. type UniqueIdent = String@@ -68,21 +71,21 @@ addHiddenService :: AppName -> UserID -> UniqueIdent -> IO (OnionAddress, OnionPort) addHiddenService appname uid ident = do 	prepHiddenServiceSocketDir appname uid ident-	ls <- lines <$> (readFile =<< findTorrc)+	ls <- lines <$> (readFile . fromOsPath =<< findTorrc) 	let portssocks = mapMaybe (parseportsock . separate isSpace) ls-	case filter (\(_, s) -> s == sockfile) portssocks of+	case filter (\(_, s) -> s == fromOsPath sockfile) portssocks of 		((p, _s):_) -> waithiddenservice 1 p 		_ -> do 			highports <- R.getStdRandom mkhighports 			let newport = fromMaybe (error "internal") $ headMaybe $ 				filter (`notElem` map fst portssocks) highports 			torrc <- findTorrc-			writeFile torrc $ unlines $+			writeFile (fromOsPath torrc) $ unlines $ 				ls ++ 				[ ""-				, "HiddenServiceDir " ++ hiddenServiceDir appname uid ident+				, "HiddenServiceDir " ++ fromOsPath (hiddenServiceDir appname uid ident) 				, "HiddenServicePort " ++ show newport ++ -					" unix:" ++ sockfile+					" unix:" ++ fromOsPath sockfile 				] 			-- Reload tor, so it will see the new hidden 			-- service and generate the hostname file for it.@@ -109,7 +112,8 @@ 	waithiddenservice :: Int -> OnionPort -> IO (OnionAddress, OnionPort) 	waithiddenservice 0 _ = giveup "tor failed to create hidden service, perhaps the tor service is not running" 	waithiddenservice n p = do-		v <- tryIO $ readFile $ hiddenServiceHostnameFile appname uid ident+		v <- tryIO $ readFile $ fromOsPath $+			hiddenServiceHostnameFile appname uid ident 		case v of 			Right s | ".onion\n" `isSuffixOf` s -> 				return (OnionAddress (takeWhile (/= '\n') s), p)@@ -122,11 +126,13 @@ -- Has to be inside the torLibDir so tor can create it. -- -- Has to end with "uid_ident" so getHiddenServiceSocketFile can find it.-hiddenServiceDir :: AppName -> UserID -> UniqueIdent -> FilePath-hiddenServiceDir appname uid ident = torLibDir </> appname ++ "_" ++ show uid ++ "_" ++ ident+hiddenServiceDir :: AppName -> UserID -> UniqueIdent -> OsPath+hiddenServiceDir appname uid ident = +	torLibDir </> toOsPath (appname ++ "_" ++ show uid ++ "_" ++ ident) -hiddenServiceHostnameFile :: AppName -> UserID -> UniqueIdent -> FilePath-hiddenServiceHostnameFile appname uid ident = hiddenServiceDir appname uid ident </> "hostname"+hiddenServiceHostnameFile :: AppName -> UserID -> UniqueIdent -> OsPath+hiddenServiceHostnameFile appname uid ident = +	hiddenServiceDir appname uid ident </> literalOsPath "hostname"  -- | Location of the socket for a hidden service. --@@ -136,33 +142,36 @@ -- Note that some unix systems limit socket paths to 92 bytes long. -- That should not be a problem if the UniqueIdent is around the length of -- a UUID, and the AppName is short.-hiddenServiceSocketFile :: AppName -> UserID -> UniqueIdent -> FilePath-hiddenServiceSocketFile appname uid ident = varLibDir </> appname </> show uid ++ "_" ++ ident </> "s"+hiddenServiceSocketFile :: AppName -> UserID -> UniqueIdent -> OsPath+hiddenServiceSocketFile appname uid ident = +	varLibDir </> toOsPath appname+		</> toOsPath (show uid ++ "_" ++ ident) </> literalOsPath "s"  -- | Parse torrc, to get the socket file used for a hidden service with -- the specified UniqueIdent.-getHiddenServiceSocketFile :: AppName -> UserID -> UniqueIdent -> IO (Maybe FilePath)+getHiddenServiceSocketFile :: AppName -> UserID -> UniqueIdent -> IO (Maybe OsPath) getHiddenServiceSocketFile _appname uid ident = -	parse . map words . lines <$> catchDefaultIO "" (readFile =<< findTorrc)+	parse . map words . lines <$> catchDefaultIO "" +		(readFile . fromOsPath =<< findTorrc)   where 	parse [] = Nothing 	parse (("HiddenServiceDir":hsdir:[]):("HiddenServicePort":_hsport:hsaddr:[]):rest)-		| "unix:" `isPrefixOf` hsaddr && hasident hsdir =-			Just (drop (length "unix:") hsaddr)+		| "unix:" `isPrefixOf` hsaddr && hasident (toOsPath hsdir) =+			Just $ toOsPath $ drop (length ("unix:" :: String)) hsaddr 		| otherwise = parse rest 	parse (_:rest) = parse rest  	-- Don't look for AppName in the hsdir, because it didn't used to 	-- be included.-	hasident hsdir = (show uid ++ "_" ++ ident) `isSuffixOf` takeFileName hsdir+	hasident hsdir = toOsPath (show uid ++ "_" ++ ident) `OS.isSuffixOf` takeFileName hsdir  -- | Sets up the directory for the socketFile, with appropriate -- permissions. Must run as root. prepHiddenServiceSocketDir :: AppName -> UserID -> UniqueIdent -> IO () prepHiddenServiceSocketDir appname uid ident = do 	createDirectoryIfMissing True d-	setOwnerAndGroup (toRawFilePath d) uid (-1)-	modifyFileMode (toRawFilePath d) $+	setOwnerAndGroup (fromOsPath d) uid (-1)+	modifyFileMode d $ 		addModes [ownerReadMode, ownerExecuteMode, ownerWriteMode]   where 	d = takeDirectory $ hiddenServiceSocketFile appname uid ident@@ -170,21 +179,23 @@ -- | Finds the system's torrc file, in any of the typical locations of it. -- Returns the first found. If there is no system torrc file, defaults to -- /etc/tor/torrc.-findTorrc :: IO FilePath-findTorrc = fromMaybe "/etc/tor/torrc" <$> firstM doesFileExist-	-- Debian-	[ "/etc/tor/torrc"+findTorrc :: IO OsPath+findTorrc = fromMaybe deftorrc <$> firstM doesFileExist+	[ deftorrc 	-- Some systems put it here instead.-	, "/etc/torrc"+	, literalOsPath "/etc/torrc" 	-- Default when installed from source-	, "/usr/local/etc/tor/torrc" +	, literalOsPath "/usr/local/etc/tor/torrc"  	]+  where+	-- Debian uses this+	deftorrc = literalOsPath "/etc/tor/torrc" -torLibDir :: FilePath-torLibDir = "/var/lib/tor"+torLibDir :: OsPath+torLibDir = literalOsPath "/var/lib/tor" -varLibDir :: FilePath-varLibDir = "/var/lib"+varLibDir :: OsPath+varLibDir = literalOsPath "/var/lib"  torIsInstalled :: IO Bool torIsInstalled = inSearchPath "tor"
Utility/Touch.hs view
@@ -14,9 +14,10 @@  #if ! defined(mingw32_HOST_OS) -import System.FilePath.ByteString (RawFilePath) import System.Posix.Files.ByteString import Data.Time.Clock.POSIX++import Utility.RawFilePath  {- Changes the access and modification times of an existing file.    Can follow symlinks, or not. -}
Utility/Url.hs view
@@ -50,6 +50,7 @@ import qualified Utility.RawFilePath as R import Utility.Hash (IncrementalVerifier(..)) import Utility.Url.Parse+import qualified Utility.FileIO as F  import Network.URI import Network.HTTP.Types@@ -311,8 +312,8 @@ 		=<< curlRestrictedParams r u defport (basecurlparams url')  	existsfile u = do-		let f = toRawFilePath (unEscapeString (uriPath u))-		s <- catchMaybeIO $ R.getSymbolicLinkStatus f+		let f = toOsPath (unEscapeString (uriPath u))+		s <- catchMaybeIO $ R.getSymbolicLinkStatus (fromOsPath f) 		case s of 			Just stat -> do 				sz <- getFileSize' f stat@@ -362,10 +363,10 @@  -  - When the download fails, returns an error message.  -}-download :: MeterUpdate -> Maybe IncrementalVerifier -> URLString -> FilePath -> UrlOptions -> IO (Either String ())+download :: MeterUpdate -> Maybe IncrementalVerifier -> URLString -> OsPath -> UrlOptions -> IO (Either String ()) download = download' False -download' :: Bool -> MeterUpdate -> Maybe IncrementalVerifier -> URLString -> FilePath -> UrlOptions -> IO (Either String ())+download' :: Bool -> MeterUpdate -> Maybe IncrementalVerifier -> URLString -> OsPath -> UrlOptions -> IO (Either String ()) download' nocurlerror meterupdate iv url file uo = 	catchJust matchHttpException go showhttpexception 		`catchNonAsync` (dlfailed . show)@@ -421,8 +422,8 @@ 		-- curl does not create destination file 		-- if the url happens to be empty, so pre-create. 		unlessM (doesFileExist file) $-			writeFile file ""-		ifM (boolSystem "curl" (curlparams ++ [Param "-o", File file, File rawurl]))+			F.writeFile file mempty+		ifM (boolSystem "curl" (curlparams ++ [Param "-o", File (fromOsPath file), File rawurl])) 			( return $ Right () 			, return $ Left "download failed" 			)@@ -432,9 +433,9 @@  	downloadfile u = do 		noverification-		let src = unEscapeString (uriPath u)+		let src = toOsPath $ unEscapeString (uriPath u) 		withMeteredFile src meterupdate $-			L.writeFile file+			F.writeFile file 		return $ Right ()  	-- Conduit does not support ftp, so will throw an exception on a@@ -461,9 +462,9 @@  - thrown for reasons other than http status codes will still be thrown  - as usual.)  -}-downloadConduit :: MeterUpdate -> Maybe IncrementalVerifier -> Request -> FilePath -> UrlOptions -> IO ()+downloadConduit :: MeterUpdate -> Maybe IncrementalVerifier -> Request -> OsPath -> UrlOptions -> IO () downloadConduit meterupdate iv req file uo =-	catchMaybeIO (getFileSize (toRawFilePath file)) >>= \case+	catchMaybeIO (getFileSize file) >>= \case 		Just sz | sz > 0 -> resumedownload sz 		_ -> join $ runResourceT $ do 			liftIO $ debug "Utility.Url" (show req')@@ -566,7 +567,7 @@ 	=> MeterUpdate 	-> Maybe IncrementalVerifier 	-> BytesProcessed-	-> FilePath+	-> OsPath 	-> IOMode 	-> Response (ConduitM () B8.ByteString m ()) 	-> m ()@@ -577,7 +578,7 @@ 			return (const noop) 		(Just iv', _) -> return (updateIncrementalVerifier iv') 		(Nothing, _) -> return (const noop)-	(fr, fh) <- allocate (openBinaryFile file mode) hClose+	(fr, fh) <- allocate (F.openBinaryFile file mode) hClose 	runConduit $ responseBody resp .| go ui initialp fh 	release fr   where
Utility/WebApp.hs view
@@ -185,9 +185,9 @@  {- Creates a html shim file that's used to redirect into the webapp,  - to avoid exposing the secret token when launching the web browser. -}-writeHtmlShim :: String -> String -> FilePath -> IO ()+writeHtmlShim :: String -> String -> OsPath -> IO () writeHtmlShim title url file = -	viaTmp (writeFileProtected . toRawFilePath) file $ genHtmlShim title url+	viaTmp (writeFileProtected) file (genHtmlShim title url)  genHtmlShim :: String -> String -> String genHtmlShim title url = unlines
git-annex.cabal view
@@ -1,5 +1,5 @@ Name: git-annex-Version: 10.20250115+Version: 10.20250320 Cabal-Version: 1.12 License: AGPL-3 Maintainer: Joey Hess <id@joeyh.name>@@ -159,7 +159,7 @@   Description: Enable production build (slower build; faster binary)  Flag ParallelBuild-  Description: Enable production build (slower build; faster binary)+  Description: Enable building in parallel   Default: False   Manual: True @@ -175,6 +175,9 @@ Flag Servant   Description: Use the servant library, enabling using annex+http urls and git-annex p2phttp +Flag OsPath+  Description: Use the os-string library and related libraries, for faster filename manipulation+ Flag Benchmark   Description: Enable benchmarking   Default: True@@ -227,7 +230,6 @@    directory (>= 1.2.7.0),    disk-free-space,    filepath,-   filepath-bytestring (>= 1.4.2.1.1),    IfElse,    monad-logger (>= 0.3.10),    free,@@ -329,6 +331,17 @@       P2P.Http.Server       P2P.Http.State +  if flag(OsPath)+    Build-Depends:+      os-string (>= 2.0.0),+      directory (>= 1.3.8.3),+      filepath (>= 1.5.2.0),+      file-io (>= 0.1.3)+    CPP-Options: -DWITH_OSPATH+  else+    Build-Depends:+      filepath-bytestring (>= 1.4.2.1.1)+   if (os(windows))     Build-Depends:       Win32 ((>= 2.6.1.0 && < 2.12.0.0) || >= 2.13.4.0),@@ -549,6 +562,7 @@     Annex.FileMatcher     Annex.Fixup     Annex.GitOverlay+    Annex.GitShaKey     Annex.HashObject     Annex.Hook     Annex.Import@@ -641,6 +655,7 @@     CmdLine.Usage     Command     Command.Add+    Command.AddComputed     Command.AddUnused     Command.AddUrl     Command.Adjust@@ -669,6 +684,7 @@     Command.FilterBranch     Command.FilterProcess     Command.Find+    Command.FindComputed     Command.FindKeys     Command.FindRef     Command.Fix@@ -714,6 +730,7 @@     Command.Proxy     Command.Pull     Command.Push+    Command.Recompute     Command.ReKey     Command.ReadPresentKey     Command.RecvKey@@ -917,6 +934,7 @@     Remote.BitTorrent     Remote.Borg     Remote.Bup+    Remote.Compute     Remote.Ddar     Remote.Directory     Remote.Directory.LegacyChunked@@ -1094,6 +1112,8 @@     Utility.OpenFile     Utility.OptParse     Utility.OSX+    Utility.OsPath+    Utility.OsString     Utility.PID     Utility.PartialPrelude     Utility.Path@@ -1123,6 +1143,7 @@     Utility.STM     Utility.Su     Utility.SystemDirectory+    Utility.FileIO     Utility.Terminal     Utility.TimeStamp     Utility.TList
stack.yaml view

file too large to diff