more RawFilePath

Remove dup definitions and just use the RawFilePath one. </> etc are
enough faster that it's probably faster than building a String directly,
although I have not benchmarked.
This commit is contained in:
Joey Hess 2019-12-18 16:45:03 -04:00
parent 9e9def2dc0
commit 686791c4ed
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
26 changed files with 140 additions and 120 deletions

View file

@ -91,6 +91,8 @@ import Annex.Concurrent
import Types.WorkerPool import Types.WorkerPool
import qualified Utility.RawFilePath as R import qualified Utility.RawFilePath as R
import qualified System.FilePath.ByteString as P
{- Checks if a given key's content is currently present. -} {- Checks if a given key's content is currently present. -}
inAnnex :: Key -> Annex Bool inAnnex :: Key -> Annex Bool
inAnnex key = inAnnexCheck key $ liftIO . R.doesPathExist inAnnex key = inAnnexCheck key $ liftIO . R.doesPathExist
@ -742,7 +744,7 @@ listKeys keyloc = do
if depth < 2 if depth < 2
then do then do
contents' <- filterM (present s) contents contents' <- filterM (present s) contents
let keys = mapMaybe (fileKey . takeFileName) contents' let keys = mapMaybe (fileKey . P.takeFileName . toRawFilePath) contents'
continue keys [] continue keys []
else do else do
let deeper = walk s (depth - 1) let deeper = walk s (depth - 1)
@ -816,7 +818,7 @@ dirKeys dirspec = do
contents <- liftIO $ getDirectoryContents dir contents <- liftIO $ getDirectoryContents dir
files <- liftIO $ filterM doesFileExist $ files <- liftIO $ filterM doesFileExist $
map (dir </>) contents map (dir </>) contents
return $ mapMaybe (fileKey . takeFileName) files return $ mapMaybe (fileKey . P.takeFileName . toRawFilePath) files
, return [] , return []
) )
@ -835,7 +837,8 @@ staleKeysPrune dirspec nottransferred = do
dir <- fromRepo dirspec dir <- fromRepo dirspec
forM_ dups $ \k -> forM_ dups $ \k ->
pruneTmpWorkDirBefore (dir </> keyFile k) (liftIO . removeFile) pruneTmpWorkDirBefore (dir </> fromRawFilePath (keyFile k))
(liftIO . removeFile)
if nottransferred if nottransferred
then do then do

View file

@ -128,7 +128,7 @@ checkDiskSpace' need destdir key alreadythere samefilesystem = ifM (Annex.getSta
_ -> return True _ -> return True
) )
where where
dir = maybe (fromRepo gitAnnexDir) return destdir dir = maybe (fromRawFilePath <$> fromRepo gitAnnexDir) return destdir
needMoreDiskSpace :: Integer -> String needMoreDiskSpace :: Integer -> String
needMoreDiskSpace n = "not enough free space, need " ++ needMoreDiskSpace n = "not enough free space, need " ++

View file

@ -253,7 +253,7 @@ parseLinkTargetOrPointerLazy b =
{- Parses a symlink target to a Key. -} {- Parses a symlink target to a Key. -}
parseLinkTarget :: S.ByteString -> Maybe Key parseLinkTarget :: S.ByteString -> Maybe Key
parseLinkTarget l parseLinkTarget l
| isLinkToAnnex l = fileKey' $ snd $ S8.breakEnd pathsep l | isLinkToAnnex l = fileKey $ snd $ S8.breakEnd pathsep l
| otherwise = Nothing | otherwise = Nothing
where where
pathsep '/' = True pathsep '/' = True
@ -263,9 +263,9 @@ parseLinkTarget l
pathsep _ = False pathsep _ = False
formatPointer :: Key -> S.ByteString formatPointer :: Key -> S.ByteString
formatPointer k = prefix <> keyFile' k <> nl formatPointer k = prefix <> keyFile k <> nl
where where
prefix = toInternalGitPath $ toRawFilePath (pathSeparator:objectDir) prefix = toInternalGitPath $ P.pathSeparator `S.cons` objectDir'
nl = S8.singleton '\n' nl = S8.singleton '\n'
{- Maximum size of a file that could be a pointer to a key. {- Maximum size of a file that could be a pointer to a key.

View file

@ -9,9 +9,7 @@
module Annex.Locations ( module Annex.Locations (
keyFile, keyFile,
keyFile',
fileKey, fileKey,
fileKey',
keyPaths, keyPaths,
keyPath, keyPath,
annexDir, annexDir,
@ -124,19 +122,16 @@ import qualified Utility.RawFilePath as R
{- The directory git annex uses for local state, relative to the .git {- The directory git annex uses for local state, relative to the .git
- directory -} - directory -}
annexDir :: FilePath annexDir :: RawFilePath
annexDir = addTrailingPathSeparator "annex" annexDir = P.addTrailingPathSeparator "annex"
annexDir' :: RawFilePath
annexDir' = P.addTrailingPathSeparator "annex"
{- The directory git annex uses for locally available object content, {- The directory git annex uses for locally available object content,
- relative to the .git directory -} - relative to the .git directory -}
objectDir :: FilePath objectDir :: FilePath
objectDir = addTrailingPathSeparator $ annexDir </> "objects" objectDir = fromRawFilePath objectDir'
objectDir' :: RawFilePath objectDir' :: RawFilePath
objectDir' = P.addTrailingPathSeparator $ annexDir' P.</> "objects" objectDir' = P.addTrailingPathSeparator $ annexDir P.</> "objects"
{- Annexed file's possible locations relative to the .git directory. {- Annexed file's possible locations relative to the .git directory.
- There are two different possibilities, using different hashes. - There are two different possibilities, using different hashes.
@ -260,46 +255,51 @@ gitAnnexInodeCache key r config = do
return $ fromRawFilePath loc ++ ".cache" return $ fromRawFilePath loc ++ ".cache"
gitAnnexInodeSentinal :: Git.Repo -> RawFilePath gitAnnexInodeSentinal :: Git.Repo -> RawFilePath
gitAnnexInodeSentinal r = gitAnnexDir' r P.</> "sentinal" gitAnnexInodeSentinal r = gitAnnexDir r P.</> "sentinal"
gitAnnexInodeSentinalCache :: Git.Repo -> RawFilePath gitAnnexInodeSentinalCache :: Git.Repo -> RawFilePath
gitAnnexInodeSentinalCache r = gitAnnexInodeSentinal r <> ".cache" gitAnnexInodeSentinalCache r = gitAnnexInodeSentinal r <> ".cache"
{- The annex directory of a repository. -} {- The annex directory of a repository. -}
gitAnnexDir :: Git.Repo -> FilePath gitAnnexDir :: Git.Repo -> RawFilePath
gitAnnexDir r = addTrailingPathSeparator $ fromRawFilePath (Git.localGitDir r) </> annexDir gitAnnexDir r = P.addTrailingPathSeparator $ Git.localGitDir r P.</> annexDir
gitAnnexDir' :: Git.Repo -> RawFilePath
gitAnnexDir' r = P.addTrailingPathSeparator $ Git.localGitDir r P.</> annexDir'
{- The part of the annex directory where file contents are stored. -} {- The part of the annex directory where file contents are stored. -}
gitAnnexObjectDir :: Git.Repo -> FilePath gitAnnexObjectDir :: Git.Repo -> FilePath
gitAnnexObjectDir r = addTrailingPathSeparator $ fromRawFilePath (Git.localGitDir r) </> objectDir gitAnnexObjectDir r = fromRawFilePath $
P.addTrailingPathSeparator $ Git.localGitDir r P.</> objectDir'
{- .git/annex/tmp/ is used for temp files for key's contents -} {- .git/annex/tmp/ is used for temp files for key's contents -}
gitAnnexTmpObjectDir :: Git.Repo -> FilePath gitAnnexTmpObjectDir :: Git.Repo -> FilePath
gitAnnexTmpObjectDir r = addTrailingPathSeparator $ gitAnnexDir r </> "tmp" gitAnnexTmpObjectDir = fromRawFilePath . gitAnnexTmpObjectDir'
gitAnnexTmpObjectDir' :: Git.Repo -> RawFilePath
gitAnnexTmpObjectDir' r = P.addTrailingPathSeparator $ gitAnnexDir r P.</> "tmp"
{- .git/annex/othertmp/ is used for other temp files -} {- .git/annex/othertmp/ is used for other temp files -}
gitAnnexTmpOtherDir :: Git.Repo -> FilePath gitAnnexTmpOtherDir :: Git.Repo -> FilePath
gitAnnexTmpOtherDir r = addTrailingPathSeparator $ gitAnnexDir r </> "othertmp" gitAnnexTmpOtherDir r = fromRawFilePath $
P.addTrailingPathSeparator $ gitAnnexDir r P.</> "othertmp"
{- Lock file for gitAnnexTmpOtherDir. -} {- Lock file for gitAnnexTmpOtherDir. -}
gitAnnexTmpOtherLock :: Git.Repo -> FilePath gitAnnexTmpOtherLock :: Git.Repo -> FilePath
gitAnnexTmpOtherLock r = gitAnnexDir r </> "othertmp.lck" gitAnnexTmpOtherLock r = fromRawFilePath $ gitAnnexDir r P.</> "othertmp.lck"
{- .git/annex/misctmp/ was used by old versions of git-annex and is still {- .git/annex/misctmp/ was used by old versions of git-annex and is still
- used during initialization -} - used during initialization -}
gitAnnexTmpOtherDirOld :: Git.Repo -> FilePath gitAnnexTmpOtherDirOld :: Git.Repo -> FilePath
gitAnnexTmpOtherDirOld r = addTrailingPathSeparator $ gitAnnexDir r </> "misctmp" gitAnnexTmpOtherDirOld r = fromRawFilePath $
P.addTrailingPathSeparator $ gitAnnexDir r P.</> "misctmp"
{- .git/annex/watchtmp/ is used by the watcher and assistant -} {- .git/annex/watchtmp/ is used by the watcher and assistant -}
gitAnnexTmpWatcherDir :: Git.Repo -> FilePath gitAnnexTmpWatcherDir :: Git.Repo -> FilePath
gitAnnexTmpWatcherDir r = addTrailingPathSeparator $ gitAnnexDir r </> "watchtmp" gitAnnexTmpWatcherDir r = fromRawFilePath $
P.addTrailingPathSeparator $ gitAnnexDir r P.</> "watchtmp"
{- The temp file to use for a given key's content. -} {- The temp file to use for a given key's content. -}
gitAnnexTmpObjectLocation :: Key -> Git.Repo -> FilePath gitAnnexTmpObjectLocation :: Key -> Git.Repo -> FilePath
gitAnnexTmpObjectLocation key r = gitAnnexTmpObjectDir r </> keyFile key gitAnnexTmpObjectLocation key r = fromRawFilePath $
gitAnnexTmpObjectDir' r P.</> keyFile key
{- Given a temp file such as gitAnnexTmpObjectLocation, makes a name for a {- 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 - subdirectory in the same location, that can be used as a work area
@ -316,19 +316,21 @@ gitAnnexTmpWorkDir p =
{- .git/annex/bad/ is used for bad files found during fsck -} {- .git/annex/bad/ is used for bad files found during fsck -}
gitAnnexBadDir :: Git.Repo -> FilePath gitAnnexBadDir :: Git.Repo -> FilePath
gitAnnexBadDir r = addTrailingPathSeparator $ gitAnnexDir r </> "bad" gitAnnexBadDir r = fromRawFilePath $
P.addTrailingPathSeparator $ gitAnnexDir r P.</> "bad"
{- The bad file to use for a given key. -} {- The bad file to use for a given key. -}
gitAnnexBadLocation :: Key -> Git.Repo -> FilePath gitAnnexBadLocation :: Key -> Git.Repo -> FilePath
gitAnnexBadLocation key r = gitAnnexBadDir r </> keyFile key gitAnnexBadLocation key r = gitAnnexBadDir r </> fromRawFilePath (keyFile key)
{- .git/annex/foounused is used to number possibly unused keys -} {- .git/annex/foounused is used to number possibly unused keys -}
gitAnnexUnusedLog :: FilePath -> Git.Repo -> FilePath gitAnnexUnusedLog :: FilePath -> Git.Repo -> FilePath
gitAnnexUnusedLog prefix r = gitAnnexDir r </> (prefix ++ "unused") gitAnnexUnusedLog prefix r =
fromRawFilePath (gitAnnexDir r) </> (prefix ++ "unused")
{- .git/annex/keys/ contains a database of information about keys. -} {- .git/annex/keys/ contains a database of information about keys. -}
gitAnnexKeysDb :: Git.Repo -> FilePath gitAnnexKeysDb :: Git.Repo -> FilePath
gitAnnexKeysDb r = gitAnnexDir r </> "keys" gitAnnexKeysDb r = fromRawFilePath $ gitAnnexDir r P.</> "keys"
{- Lock file for the keys database. -} {- Lock file for the keys database. -}
gitAnnexKeysDbLock :: Git.Repo -> FilePath gitAnnexKeysDbLock :: Git.Repo -> FilePath
@ -342,7 +344,8 @@ gitAnnexKeysDbIndexCache r = gitAnnexKeysDb r ++ ".cache"
{- .git/annex/fsck/uuid/ is used to store information about incremental {- .git/annex/fsck/uuid/ is used to store information about incremental
- fscks. -} - fscks. -}
gitAnnexFsckDir :: UUID -> Git.Repo -> FilePath gitAnnexFsckDir :: UUID -> Git.Repo -> FilePath
gitAnnexFsckDir u r = gitAnnexDir r </> "fsck" </> fromUUID u gitAnnexFsckDir u r = fromRawFilePath $
gitAnnexDir r P.</> "fsck" P.</> fromUUID u
{- used to store information about incremental fscks. -} {- used to store information about incremental fscks. -}
gitAnnexFsckState :: UUID -> Git.Repo -> FilePath gitAnnexFsckState :: UUID -> Git.Repo -> FilePath
@ -358,20 +361,21 @@ gitAnnexFsckDbLock u r = gitAnnexFsckDir u r </> "fsck.lck"
{- .git/annex/fsckresults/uuid is used to store results of git fscks -} {- .git/annex/fsckresults/uuid is used to store results of git fscks -}
gitAnnexFsckResultsLog :: UUID -> Git.Repo -> FilePath gitAnnexFsckResultsLog :: UUID -> Git.Repo -> FilePath
gitAnnexFsckResultsLog u r = gitAnnexDir r </> "fsckresults" </> fromUUID u gitAnnexFsckResultsLog u r = fromRawFilePath $
gitAnnexDir r P.</> "fsckresults" P.</> fromUUID u
{- .git/annex/smudge.log is used to log smudges worktree files that need to {- .git/annex/smudge.log is used to log smudges worktree files that need to
- be updated. -} - be updated. -}
gitAnnexSmudgeLog :: Git.Repo -> FilePath gitAnnexSmudgeLog :: Git.Repo -> FilePath
gitAnnexSmudgeLog r = gitAnnexDir r </> "smudge.log" gitAnnexSmudgeLog r = fromRawFilePath $ gitAnnexDir r P.</> "smudge.log"
gitAnnexSmudgeLock :: Git.Repo -> FilePath gitAnnexSmudgeLock :: Git.Repo -> FilePath
gitAnnexSmudgeLock r = gitAnnexDir r </> "smudge.lck" gitAnnexSmudgeLock r = fromRawFilePath $ gitAnnexDir r P.</> "smudge.lck"
{- .git/annex/export/uuid/ is used to store information about {- .git/annex/export/uuid/ is used to store information about
- exports to special remotes. -} - exports to special remotes. -}
gitAnnexExportDir :: UUID -> Git.Repo -> FilePath gitAnnexExportDir :: UUID -> Git.Repo -> FilePath
gitAnnexExportDir u r = gitAnnexDir r </> "export" </> fromUUID u gitAnnexExportDir u r = fromRawFilePath (gitAnnexDir r) </> "export" </> fromUUID u
{- Directory containing database used to record export info. -} {- Directory containing database used to record export info. -}
gitAnnexExportDbDir :: UUID -> Git.Repo -> FilePath gitAnnexExportDbDir :: UUID -> Git.Repo -> FilePath
@ -388,7 +392,8 @@ gitAnnexExportUpdateLock u r = gitAnnexExportDbDir u r ++ ".upl"
{- Log file used to keep track of files that were in the tree exported to a {- 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. -} - remote, but were excluded by its preferred content settings. -}
gitAnnexExportExcludeLog :: UUID -> Git.Repo -> FilePath gitAnnexExportExcludeLog :: UUID -> Git.Repo -> FilePath
gitAnnexExportExcludeLog u r = gitAnnexDir r </> "export.ex" </> fromUUID u gitAnnexExportExcludeLog u r = fromRawFilePath $
gitAnnexDir r P.</> "export.ex" P.</> fromUUID u
{- Directory containing database used to record remote content ids. {- Directory containing database used to record remote content ids.
- -
@ -396,7 +401,7 @@ gitAnnexExportExcludeLog u r = gitAnnexDir r </> "export.ex" </> fromUUID u
- need to be rebuilt with a new name.) - need to be rebuilt with a new name.)
-} -}
gitAnnexContentIdentifierDbDir :: Git.Repo -> FilePath gitAnnexContentIdentifierDbDir :: Git.Repo -> FilePath
gitAnnexContentIdentifierDbDir r = gitAnnexDir r </> "cids" gitAnnexContentIdentifierDbDir r = fromRawFilePath $ gitAnnexDir r P.</> "cids"
{- Lock file for writing to the content id database. -} {- Lock file for writing to the content id database. -}
gitAnnexContentIdentifierLock :: Git.Repo -> FilePath gitAnnexContentIdentifierLock :: Git.Repo -> FilePath
@ -405,128 +410,137 @@ gitAnnexContentIdentifierLock r = gitAnnexContentIdentifierDbDir r ++ ".lck"
{- .git/annex/schedulestate is used to store information about when {- .git/annex/schedulestate is used to store information about when
- scheduled jobs were last run. -} - scheduled jobs were last run. -}
gitAnnexScheduleState :: Git.Repo -> FilePath gitAnnexScheduleState :: Git.Repo -> FilePath
gitAnnexScheduleState r = gitAnnexDir r </> "schedulestate" gitAnnexScheduleState r = fromRawFilePath $ gitAnnexDir r P.</> "schedulestate"
{- .git/annex/creds/ is used to store credentials to access some special {- .git/annex/creds/ is used to store credentials to access some special
- remotes. -} - remotes. -}
gitAnnexCredsDir :: Git.Repo -> FilePath gitAnnexCredsDir :: Git.Repo -> FilePath
gitAnnexCredsDir r = addTrailingPathSeparator $ gitAnnexDir r </> "creds" gitAnnexCredsDir r = fromRawFilePath $
P.addTrailingPathSeparator $ gitAnnexDir r P.</> "creds"
{- .git/annex/certificate.pem and .git/annex/key.pem are used by the webapp {- .git/annex/certificate.pem and .git/annex/key.pem are used by the webapp
- when HTTPS is enabled -} - when HTTPS is enabled -}
gitAnnexWebCertificate :: Git.Repo -> FilePath gitAnnexWebCertificate :: Git.Repo -> FilePath
gitAnnexWebCertificate r = gitAnnexDir r </> "certificate.pem" gitAnnexWebCertificate r = fromRawFilePath $ gitAnnexDir r P.</> "certificate.pem"
gitAnnexWebPrivKey :: Git.Repo -> FilePath gitAnnexWebPrivKey :: Git.Repo -> FilePath
gitAnnexWebPrivKey r = gitAnnexDir r </> "privkey.pem" gitAnnexWebPrivKey r = fromRawFilePath $ gitAnnexDir r P.</> "privkey.pem"
{- .git/annex/feeds/ is used to record per-key (url) state by importfeeds -} {- .git/annex/feeds/ is used to record per-key (url) state by importfeeds -}
gitAnnexFeedStateDir :: Git.Repo -> FilePath gitAnnexFeedStateDir :: Git.Repo -> FilePath
gitAnnexFeedStateDir r = addTrailingPathSeparator $ gitAnnexDir r </> "feedstate" gitAnnexFeedStateDir r = fromRawFilePath $
P.addTrailingPathSeparator $ gitAnnexDir r P.</> "feedstate"
gitAnnexFeedState :: Key -> Git.Repo -> FilePath gitAnnexFeedState :: Key -> Git.Repo -> FilePath
gitAnnexFeedState k r = gitAnnexFeedStateDir r </> keyFile k gitAnnexFeedState k r = gitAnnexFeedStateDir r </> fromRawFilePath (keyFile k)
{- .git/annex/merge/ is used as a empty work tree for direct mode merges and {- .git/annex/merge/ is used as a empty work tree for direct mode merges and
- merges in adjusted branches. -} - merges in adjusted branches. -}
gitAnnexMergeDir :: Git.Repo -> FilePath gitAnnexMergeDir :: Git.Repo -> FilePath
gitAnnexMergeDir r = addTrailingPathSeparator $ gitAnnexDir r </> "merge" gitAnnexMergeDir r = fromRawFilePath $
P.addTrailingPathSeparator $ gitAnnexDir r P.</> "merge"
{- .git/annex/transfer/ is used to record keys currently {- .git/annex/transfer/ is used to record keys currently
- being transferred, and other transfer bookkeeping info. -} - being transferred, and other transfer bookkeeping info. -}
gitAnnexTransferDir :: Git.Repo -> FilePath gitAnnexTransferDir :: Git.Repo -> FilePath
gitAnnexTransferDir r = addTrailingPathSeparator $ gitAnnexDir r </> "transfer" gitAnnexTransferDir r = fromRawFilePath $
P.addTrailingPathSeparator $ gitAnnexDir r P.</> "transfer"
{- .git/annex/journal/ is used to journal changes made to the git-annex {- .git/annex/journal/ is used to journal changes made to the git-annex
- branch -} - branch -}
gitAnnexJournalDir :: Git.Repo -> FilePath gitAnnexJournalDir :: Git.Repo -> FilePath
gitAnnexJournalDir r = addTrailingPathSeparator $ gitAnnexDir r </> "journal" gitAnnexJournalDir r = fromRawFilePath $
P.addTrailingPathSeparator $ gitAnnexDir r P.</> "journal"
gitAnnexJournalDir' :: Git.Repo -> RawFilePath gitAnnexJournalDir' :: Git.Repo -> RawFilePath
gitAnnexJournalDir' r = P.addTrailingPathSeparator $ gitAnnexDir' r P.</> "journal" gitAnnexJournalDir' r = P.addTrailingPathSeparator $ gitAnnexDir r P.</> "journal"
{- Lock file for the journal. -} {- Lock file for the journal. -}
gitAnnexJournalLock :: Git.Repo -> FilePath gitAnnexJournalLock :: Git.Repo -> FilePath
gitAnnexJournalLock r = gitAnnexDir r </> "journal.lck" gitAnnexJournalLock r = fromRawFilePath $ gitAnnexDir r P.</> "journal.lck"
{- Lock file for flushing a git queue that writes to the git index or {- 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. -} - other git state that should only have one writer at a time. -}
gitAnnexGitQueueLock :: Git.Repo -> FilePath gitAnnexGitQueueLock :: Git.Repo -> FilePath
gitAnnexGitQueueLock r = gitAnnexDir r </> "gitqueue.lck" gitAnnexGitQueueLock r = fromRawFilePath $ gitAnnexDir r P.</> "gitqueue.lck"
{- Lock file for the pre-commit hook. -} {- Lock file for the pre-commit hook. -}
gitAnnexPreCommitLock :: Git.Repo -> FilePath gitAnnexPreCommitLock :: Git.Repo -> FilePath
gitAnnexPreCommitLock r = gitAnnexDir r </> "precommit.lck" gitAnnexPreCommitLock r = fromRawFilePath $ gitAnnexDir r P.</> "precommit.lck"
{- Lock file for direct mode merge. -} {- Lock file for direct mode merge. -}
gitAnnexMergeLock :: Git.Repo -> FilePath gitAnnexMergeLock :: Git.Repo -> FilePath
gitAnnexMergeLock r = gitAnnexDir r </> "merge.lck" gitAnnexMergeLock r = fromRawFilePath $ gitAnnexDir r P.</> "merge.lck"
{- .git/annex/index is used to stage changes to the git-annex branch -} {- .git/annex/index is used to stage changes to the git-annex branch -}
gitAnnexIndex :: Git.Repo -> FilePath gitAnnexIndex :: Git.Repo -> FilePath
gitAnnexIndex r = gitAnnexDir r </> "index" gitAnnexIndex r = fromRawFilePath $ gitAnnexDir r P.</> "index"
{- Holds the ref of the git-annex branch that the index was last updated to. {- Holds the ref 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 - The .lck in the name is a historical accident; this is not used as a
- lock. -} - lock. -}
gitAnnexIndexStatus :: Git.Repo -> FilePath gitAnnexIndexStatus :: Git.Repo -> FilePath
gitAnnexIndexStatus r = gitAnnexDir r </> "index.lck" gitAnnexIndexStatus r = fromRawFilePath $ gitAnnexDir r P.</> "index.lck"
{- The index file used to generate a filtered branch view._-} {- The index file used to generate a filtered branch view._-}
gitAnnexViewIndex :: Git.Repo -> FilePath gitAnnexViewIndex :: Git.Repo -> FilePath
gitAnnexViewIndex r = gitAnnexDir r </> "viewindex" gitAnnexViewIndex r = fromRawFilePath $ gitAnnexDir r P.</> "viewindex"
{- File containing a log of recently accessed views. -} {- File containing a log of recently accessed views. -}
gitAnnexViewLog :: Git.Repo -> FilePath gitAnnexViewLog :: Git.Repo -> FilePath
gitAnnexViewLog r = gitAnnexDir r </> "viewlog" gitAnnexViewLog r = fromRawFilePath $ gitAnnexDir r P.</> "viewlog"
{- List of refs that have already been merged into the git-annex branch. -} {- List of refs that have already been merged into the git-annex branch. -}
gitAnnexMergedRefs :: Git.Repo -> FilePath gitAnnexMergedRefs :: Git.Repo -> FilePath
gitAnnexMergedRefs r = gitAnnexDir r </> "mergedrefs" gitAnnexMergedRefs r = fromRawFilePath $ gitAnnexDir r P.</> "mergedrefs"
{- List of refs that should not be merged into the git-annex branch. -} {- List of refs that should not be merged into the git-annex branch. -}
gitAnnexIgnoredRefs :: Git.Repo -> FilePath gitAnnexIgnoredRefs :: Git.Repo -> FilePath
gitAnnexIgnoredRefs r = gitAnnexDir r </> "ignoredrefs" gitAnnexIgnoredRefs r = fromRawFilePath $ gitAnnexDir r P.</> "ignoredrefs"
{- Pid file for daemon mode. -} {- Pid file for daemon mode. -}
gitAnnexPidFile :: Git.Repo -> FilePath gitAnnexPidFile :: Git.Repo -> FilePath
gitAnnexPidFile r = gitAnnexDir r </> "daemon.pid" gitAnnexPidFile r = fromRawFilePath $ gitAnnexDir r P.</> "daemon.pid"
{- Pid lock file for pidlock mode -} {- Pid lock file for pidlock mode -}
gitAnnexPidLockFile :: Git.Repo -> FilePath gitAnnexPidLockFile :: Git.Repo -> FilePath
gitAnnexPidLockFile r = gitAnnexDir r </> "pidlock" gitAnnexPidLockFile r = fromRawFilePath $ gitAnnexDir r P.</> "pidlock"
{- Status file for daemon mode. -} {- Status file for daemon mode. -}
gitAnnexDaemonStatusFile :: Git.Repo -> FilePath gitAnnexDaemonStatusFile :: Git.Repo -> FilePath
gitAnnexDaemonStatusFile r = gitAnnexDir r </> "daemon.status" gitAnnexDaemonStatusFile r = fromRawFilePath $
gitAnnexDir r P.</> "daemon.status"
{- Log file for daemon mode. -} {- Log file for daemon mode. -}
gitAnnexLogFile :: Git.Repo -> FilePath gitAnnexLogFile :: Git.Repo -> FilePath
gitAnnexLogFile r = gitAnnexDir r </> "daemon.log" gitAnnexLogFile r = fromRawFilePath $ gitAnnexDir r P.</> "daemon.log"
{- Log file for fuzz test. -} {- Log file for fuzz test. -}
gitAnnexFuzzTestLogFile :: Git.Repo -> FilePath gitAnnexFuzzTestLogFile :: Git.Repo -> FilePath
gitAnnexFuzzTestLogFile r = gitAnnexDir r </> "fuzztest.log" gitAnnexFuzzTestLogFile r = fromRawFilePath $
gitAnnexDir r P.</> "fuzztest.log"
{- Html shim file used to launch the webapp. -} {- Html shim file used to launch the webapp. -}
gitAnnexHtmlShim :: Git.Repo -> FilePath gitAnnexHtmlShim :: Git.Repo -> FilePath
gitAnnexHtmlShim r = gitAnnexDir r </> "webapp.html" gitAnnexHtmlShim r = fromRawFilePath $ gitAnnexDir r P.</> "webapp.html"
{- File containing the url to the webapp. -} {- File containing the url to the webapp. -}
gitAnnexUrlFile :: Git.Repo -> FilePath gitAnnexUrlFile :: Git.Repo -> FilePath
gitAnnexUrlFile r = gitAnnexDir r </> "url" gitAnnexUrlFile r = fromRawFilePath $ gitAnnexDir r P.</> "url"
{- Temporary file used to edit configuriation from the git-annex branch. -} {- Temporary file used to edit configuriation from the git-annex branch. -}
gitAnnexTmpCfgFile :: Git.Repo -> FilePath gitAnnexTmpCfgFile :: Git.Repo -> FilePath
gitAnnexTmpCfgFile r = gitAnnexDir r </> "config.tmp" gitAnnexTmpCfgFile r = fromRawFilePath $ gitAnnexDir r P.</> "config.tmp"
{- .git/annex/ssh/ is used for ssh connection caching -} {- .git/annex/ssh/ is used for ssh connection caching -}
gitAnnexSshDir :: Git.Repo -> FilePath gitAnnexSshDir :: Git.Repo -> FilePath
gitAnnexSshDir r = addTrailingPathSeparator $ gitAnnexDir r </> "ssh" gitAnnexSshDir r = fromRawFilePath $
P.addTrailingPathSeparator $ gitAnnexDir r P.</> "ssh"
{- .git/annex/remotes/ is used for remote-specific state. -} {- .git/annex/remotes/ is used for remote-specific state. -}
gitAnnexRemotesDir :: Git.Repo -> FilePath gitAnnexRemotesDir :: Git.Repo -> FilePath
gitAnnexRemotesDir r = addTrailingPathSeparator $ gitAnnexDir r </> "remotes" gitAnnexRemotesDir r = fromRawFilePath $
P.addTrailingPathSeparator $ gitAnnexDir r P.</> "remotes"
{- This is the base directory name used by the assistant when making {- This is the base directory name used by the assistant when making
- repositories, by default. -} - repositories, by default. -}
@ -583,11 +597,8 @@ reSanitizeKeyName = preSanitizeKeyName' True
- Changing what this function escapes and how is not a good idea, as it - Changing what this function escapes and how is not a good idea, as it
- can cause existing objects to get lost. - can cause existing objects to get lost.
-} -}
keyFile :: Key -> FilePath keyFile :: Key -> RawFilePath
keyFile = fromRawFilePath . keyFile' keyFile k =
keyFile' :: Key -> RawFilePath
keyFile' k =
let b = serializeKey' k let b = serializeKey' k
in if S8.any (`elem` ['&', '%', ':', '/']) b in if S8.any (`elem` ['&', '%', ':', '/']) b
then S8.concatMap esc b then S8.concatMap esc b
@ -602,11 +613,8 @@ keyFile' k =
{- Reverses keyFile, converting a filename fragment (ie, the basename of {- Reverses keyFile, converting a filename fragment (ie, the basename of
- the symlink target) into a key. -} - the symlink target) into a key. -}
fileKey :: FilePath -> Maybe Key fileKey :: RawFilePath -> Maybe Key
fileKey = fileKey' . toRawFilePath fileKey = deserializeKey' . S8.intercalate "/" . map go . S8.split '%'
fileKey' :: RawFilePath -> Maybe Key
fileKey' = deserializeKey' . S8.intercalate "/" . map go . S8.split '%'
where where
go = S8.concat . unescafterfirst . S8.split '&' go = S8.concat . unescafterfirst . S8.split '&'
unescafterfirst [] = [] unescafterfirst [] = []
@ -628,7 +636,7 @@ fileKey' = deserializeKey' . S8.intercalate "/" . map go . S8.split '%'
keyPath :: Key -> Hasher -> RawFilePath keyPath :: Key -> Hasher -> RawFilePath
keyPath key hasher = hasher key P.</> f P.</> f keyPath key hasher = hasher key P.</> f P.</> f
where where
f = keyFile' key f = keyFile key
{- All possibile locations to store a key in a special remote {- All possibile locations to store a key in a special remote
- using different directory hashes. - using different directory hashes.

View file

@ -70,7 +70,7 @@ annexFileMode = withShared $ return . go
createAnnexDirectory :: FilePath -> Annex () createAnnexDirectory :: FilePath -> Annex ()
createAnnexDirectory dir = walk dir [] =<< top createAnnexDirectory dir = walk dir [] =<< top
where where
top = parentDir <$> fromRepo gitAnnexDir top = parentDir . fromRawFilePath <$> fromRepo gitAnnexDir
walk d below stop walk d below stop
| d `equalFilePath` stop = done | d `equalFilePath` stop = done
| otherwise = ifM (liftIO $ doesDirectoryExist d) | otherwise = ifM (liftIO $ doesDirectoryExist d)

View file

@ -36,7 +36,7 @@ mkVariant file variant = takeDirectory file
-} -}
variantFile :: FilePath -> Key -> FilePath variantFile :: FilePath -> Key -> FilePath
variantFile file key variantFile file key
| doubleconflict = mkVariant file (keyFile key) | doubleconflict = mkVariant file (fromRawFilePath (keyFile key))
| otherwise = mkVariant file (shortHash $ serializeKey' key) | otherwise = mkVariant file (shortHash $ serializeKey' key)
where where
doubleconflict = variantMarker `isInfixOf` file doubleconflict = variantMarker `isInfixOf` file

View file

@ -130,7 +130,7 @@ repairStaleGitLocks r = do
repairStaleLocks lockfiles repairStaleLocks lockfiles
return $ not $ null lockfiles return $ not $ null lockfiles
where where
findgitfiles = dirContentsRecursiveSkipping (== dropTrailingPathSeparator annexDir) True . fromRawFilePath . Git.localGitDir findgitfiles = dirContentsRecursiveSkipping (== dropTrailingPathSeparator (fromRawFilePath annexDir)) True . fromRawFilePath . Git.localGitDir
islock f islock f
| "gc.pid" `isInfixOf` f = False | "gc.pid" `isInfixOf` f = False
| ".lock" `isSuffixOf` f = True | ".lock" `isSuffixOf` f = True

View file

@ -31,7 +31,7 @@ perform key = next $ do
addLink file key Nothing addLink file key Nothing
return True return True
where where
file = "unused." ++ keyFile key file = "unused." ++ fromRawFilePath (keyFile key)
{- The content is not in the annex, but in another directory, and {- The content is not in the annex, but in another directory, and
- it seems better to error out, rather than moving bad/tmp content into - it seems better to error out, rather than moving bad/tmp content into

View file

@ -164,7 +164,7 @@ performRemote key afile backend numcopies remote =
pid <- liftIO getPID pid <- liftIO getPID
t <- fromRepo gitAnnexTmpObjectDir t <- fromRepo gitAnnexTmpObjectDir
createAnnexDirectory t createAnnexDirectory t
let tmp = t </> "fsck" ++ show pid ++ "." ++ keyFile key let tmp = t </> "fsck" ++ show pid ++ "." ++ fromRawFilePath (keyFile key)
let cleanup = liftIO $ catchIO (removeFile tmp) (const noop) let cleanup = liftIO $ catchIO (removeFile tmp) (const noop)
cleanup cleanup
cleanup `after` a tmp cleanup `after` a tmp
@ -516,7 +516,7 @@ badContent key = do
badContentRemote :: Remote -> FilePath -> Key -> Annex String badContentRemote :: Remote -> FilePath -> Key -> Annex String
badContentRemote remote localcopy key = do badContentRemote remote localcopy key = do
bad <- fromRepo gitAnnexBadDir bad <- fromRepo gitAnnexBadDir
let destbad = bad </> keyFile key let destbad = bad </> fromRawFilePath (keyFile key)
movedbad <- ifM (inAnnex key <||> liftIO (doesFileExist destbad)) movedbad <- ifM (inAnnex key <||> liftIO (doesFileExist destbad))
( return False ( return False
, do , do

View file

@ -454,7 +454,7 @@ disk_size :: Stat
disk_size = simpleStat "available local disk space" $ disk_size = simpleStat "available local disk space" $
calcfree calcfree
<$> (lift $ annexDiskReserve <$> Annex.getGitConfig) <$> (lift $ annexDiskReserve <$> Annex.getGitConfig)
<*> (lift $ inRepo $ getDiskFree . gitAnnexDir) <*> (lift $ inRepo $ getDiskFree . fromRawFilePath . gitAnnexDir)
<*> mkSizer <*> mkSizer
where where
calcfree reserve (Just have) sizer = unwords calcfree reserve (Just have) sizer = unwords
@ -674,7 +674,7 @@ staleSize label dirspec = go =<< lift (dirKeys dirspec)
keysizes keys = do keysizes keys = do
dir <- lift $ fromRepo dirspec dir <- lift $ fromRepo dirspec
liftIO $ forM keys $ \k -> catchDefaultIO 0 $ liftIO $ forM keys $ \k -> catchDefaultIO 0 $
getFileSize (dir </> keyFile k) getFileSize (dir </> fromRawFilePath (keyFile k))
aside :: String -> String aside :: String -> String
aside s = " (" ++ s ++ ")" aside s = " (" ++ s ++ ")"

View file

@ -46,7 +46,9 @@ start = startingNoMessage (ActionItemOther Nothing) $ do
umap <- uuidDescMap umap <- uuidDescMap
trustmap <- trustMapLoad trustmap <- trustMapLoad
file <- (</>) <$> fromRepo gitAnnexDir <*> pure "map.dot" file <- (</>)
<$> fromRepo (fromRawFilePath . gitAnnexDir)
<*> pure "map.dot"
liftIO $ writeFile file (drawMap rs trustmap umap) liftIO $ writeFile file (drawMap rs trustmap umap)
next $ next $

View file

@ -58,7 +58,7 @@ startCheckIncomplete file _ = giveup $ unlines
finish :: Annex () finish :: Annex ()
finish = do finish = do
annexdir <- fromRepo gitAnnexDir annexdir <- fromRawFilePath <$> fromRepo gitAnnexDir
annexobjectdir <- fromRepo gitAnnexObjectDir annexobjectdir <- fromRepo gitAnnexObjectDir
leftovers <- removeUnannexed =<< listKeys InAnnex leftovers <- removeUnannexed =<< listKeys InAnnex
prepareRemoveAnnexDir annexdir prepareRemoveAnnexDir annexdir

View file

@ -43,6 +43,9 @@ import Git.Command
import Git.Types import Git.Types
import Git.Index import Git.Index
import qualified Data.ByteString as S
import qualified System.FilePath.ByteString as P
{- Runs an action that reads from the database. {- Runs an action that reads from the database.
- -
- If the database doesn't already exist, it's not created; mempty is - If the database doesn't already exist, it's not created; mempty is
@ -263,7 +266,7 @@ reconcileStaged qh = do
-- pointer file. And a pointer file that is replaced with -- pointer file. And a pointer file that is replaced with
-- a non-pointer file will match this. -- a non-pointer file will match this.
, Param $ "-G^" ++ fromRawFilePath (toInternalGitPath $ , Param $ "-G^" ++ fromRawFilePath (toInternalGitPath $
toRawFilePath (pathSeparator:objectDir)) P.pathSeparator `S.cons` objectDir')
-- Don't include files that were deleted, because this only -- Don't include files that were deleted, because this only
-- wants to update information for files that are present -- wants to update information for files that are present
-- in the index. -- in the index.

18
Logs.hs
View file

@ -119,18 +119,18 @@ exportLog = "export.log"
{- The pathname of the location log file for a given key. -} {- The pathname of the location log file for a given key. -}
locationLogFile :: GitConfig -> Key -> RawFilePath locationLogFile :: GitConfig -> Key -> RawFilePath
locationLogFile config key = locationLogFile config key =
branchHashDir config key P.</> keyFile' key <> ".log" branchHashDir config key P.</> keyFile key <> ".log"
{- The filename of the url log for a given key. -} {- The filename of the url log for a given key. -}
urlLogFile :: GitConfig -> Key -> RawFilePath urlLogFile :: GitConfig -> Key -> RawFilePath
urlLogFile config key = urlLogFile config key =
branchHashDir config key P.</> keyFile' key <> urlLogExt branchHashDir config key P.</> keyFile key <> urlLogExt
{- Old versions stored the urls elsewhere. -} {- Old versions stored the urls elsewhere. -}
oldurlLogs :: GitConfig -> Key -> [RawFilePath] oldurlLogs :: GitConfig -> Key -> [RawFilePath]
oldurlLogs config key = oldurlLogs config key =
[ "remote/web" P.</> hdir P.</> serializeKey' key <> ".log" [ "remote/web" P.</> hdir P.</> serializeKey' key <> ".log"
, "remote/web" P.</> hdir P.</> keyFile' key <> ".log" , "remote/web" P.</> hdir P.</> keyFile key <> ".log"
] ]
where where
hdir = branchHashDir config key hdir = branchHashDir config key
@ -145,7 +145,7 @@ isUrlLog file = urlLogExt `S.isSuffixOf` file
{- The filename of the remote state log for a given key. -} {- The filename of the remote state log for a given key. -}
remoteStateLogFile :: GitConfig -> Key -> RawFilePath remoteStateLogFile :: GitConfig -> Key -> RawFilePath
remoteStateLogFile config key = remoteStateLogFile config key =
(branchHashDir config key P.</> keyFile' key) (branchHashDir config key P.</> keyFile key)
<> remoteStateLogExt <> remoteStateLogExt
remoteStateLogExt :: S.ByteString remoteStateLogExt :: S.ByteString
@ -157,7 +157,7 @@ isRemoteStateLog path = remoteStateLogExt `S.isSuffixOf` path
{- The filename of the chunk log for a given key. -} {- The filename of the chunk log for a given key. -}
chunkLogFile :: GitConfig -> Key -> RawFilePath chunkLogFile :: GitConfig -> Key -> RawFilePath
chunkLogFile config key = chunkLogFile config key =
(branchHashDir config key P.</> keyFile' key) (branchHashDir config key P.</> keyFile key)
<> chunkLogExt <> chunkLogExt
chunkLogExt :: S.ByteString chunkLogExt :: S.ByteString
@ -169,7 +169,7 @@ isChunkLog path = chunkLogExt `S.isSuffixOf` path
{- The filename of the metadata log for a given key. -} {- The filename of the metadata log for a given key. -}
metaDataLogFile :: GitConfig -> Key -> RawFilePath metaDataLogFile :: GitConfig -> Key -> RawFilePath
metaDataLogFile config key = metaDataLogFile config key =
(branchHashDir config key P.</> keyFile' key) (branchHashDir config key P.</> keyFile key)
<> metaDataLogExt <> metaDataLogExt
metaDataLogExt :: S.ByteString metaDataLogExt :: S.ByteString
@ -181,7 +181,7 @@ isMetaDataLog path = metaDataLogExt `S.isSuffixOf` path
{- The filename of the remote metadata log for a given key. -} {- The filename of the remote metadata log for a given key. -}
remoteMetaDataLogFile :: GitConfig -> Key -> RawFilePath remoteMetaDataLogFile :: GitConfig -> Key -> RawFilePath
remoteMetaDataLogFile config key = remoteMetaDataLogFile config key =
(branchHashDir config key P.</> keyFile' key) (branchHashDir config key P.</> keyFile key)
<> remoteMetaDataLogExt <> remoteMetaDataLogExt
remoteMetaDataLogExt :: S.ByteString remoteMetaDataLogExt :: S.ByteString
@ -193,7 +193,7 @@ isRemoteMetaDataLog path = remoteMetaDataLogExt `S.isSuffixOf` path
{- The filename of the remote content identifier log for a given key. -} {- The filename of the remote content identifier log for a given key. -}
remoteContentIdentifierLogFile :: GitConfig -> Key -> RawFilePath remoteContentIdentifierLogFile :: GitConfig -> Key -> RawFilePath
remoteContentIdentifierLogFile config key = remoteContentIdentifierLogFile config key =
(branchHashDir config key P.</> keyFile' key) (branchHashDir config key P.</> keyFile key)
<> remoteContentIdentifierExt <> remoteContentIdentifierExt
remoteContentIdentifierExt :: S.ByteString remoteContentIdentifierExt :: S.ByteString
@ -205,7 +205,7 @@ isRemoteContentIdentifierLog path = remoteContentIdentifierExt `S.isSuffixOf` pa
{- From an extension and a log filename, get the key that it's a log for. -} {- From an extension and a log filename, get the key that it's a log for. -}
extLogFileKey :: S.ByteString -> RawFilePath -> Maybe Key extLogFileKey :: S.ByteString -> RawFilePath -> Maybe Key
extLogFileKey expectedext path extLogFileKey expectedext path
| encodeBS' ext == expectedext = fileKey base | encodeBS' ext == expectedext = fileKey (toRawFilePath base)
| otherwise = Nothing | otherwise = Nothing
where where
file = takeFileName (fromRawFilePath path) file = takeFileName (fromRawFilePath path)

View file

@ -195,12 +195,12 @@ recordFailedTransfer t info = do
transferFile :: Transfer -> Git.Repo -> FilePath transferFile :: Transfer -> Git.Repo -> FilePath
transferFile (Transfer direction u kd) r = transferDir direction r transferFile (Transfer direction u kd) r = transferDir direction r
</> filter (/= '/') (fromUUID u) </> filter (/= '/') (fromUUID u)
</> keyFile (mkKey (const kd)) </> fromRawFilePath (keyFile (mkKey (const kd)))
{- The transfer information file to use to record a failed Transfer -} {- The transfer information file to use to record a failed Transfer -}
failedTransferFile :: Transfer -> Git.Repo -> FilePath failedTransferFile :: Transfer -> Git.Repo -> FilePath
failedTransferFile (Transfer direction u kd) r = failedTransferDir u direction r failedTransferFile (Transfer direction u kd) r = failedTransferDir u direction r
</> keyFile (mkKey (const kd)) </> fromRawFilePath (keyFile (mkKey (const kd)))
{- The transfer lock file corresponding to a given transfer info file. -} {- The transfer lock file corresponding to a given transfer info file. -}
transferLockFile :: FilePath -> FilePath transferLockFile :: FilePath -> FilePath
@ -215,7 +215,7 @@ parseTransferFile file
[direction, u, key] -> Transfer [direction, u, key] -> Transfer
<$> parseDirection direction <$> parseDirection direction
<*> pure (toUUID u) <*> pure (toUUID u)
<*> fmap (fromKey id) (fileKey key) <*> fmap (fromKey id) (fileKey (toRawFilePath key))
_ -> Nothing _ -> Nothing
where where
bits = splitDirectories file bits = splitDirectories file

View file

@ -195,7 +195,7 @@ downloadTorrentFile u = do
createAnnexDirectory (parentDir torrent) createAnnexDirectory (parentDir torrent)
if isTorrentMagnetUrl u if isTorrentMagnetUrl u
then withOtherTmp $ \othertmp -> do then withOtherTmp $ \othertmp -> do
kf <- keyFile <$> torrentUrlKey u kf <- fromRawFilePath . keyFile <$> torrentUrlKey u
let metadir = othertmp </> "torrentmeta" </> kf let metadir = othertmp </> "torrentmeta" </> kf
createAnnexDirectory metadir createAnnexDirectory metadir
showOutput showOutput
@ -239,7 +239,7 @@ downloadTorrentContent :: Key -> URLString -> FilePath -> Int -> MeterUpdate ->
downloadTorrentContent k u dest filenum p = do downloadTorrentContent k u dest filenum p = do
torrent <- tmpTorrentFile u torrent <- tmpTorrentFile u
withOtherTmp $ \othertmp -> do withOtherTmp $ \othertmp -> do
kf <- keyFile <$> torrentUrlKey u kf <- fromRawFilePath . keyFile <$> torrentUrlKey u
let downloaddir = othertmp </> "torrent" </> kf let downloaddir = othertmp </> "torrent" </> kf
createAnnexDirectory downloaddir createAnnexDirectory downloaddir
f <- wantedfile torrent f <- wantedfile torrent

View file

@ -140,7 +140,7 @@ getLocation d k = do
{- Directory where the file(s) for a key are stored. -} {- Directory where the file(s) for a key are stored. -}
storeDir :: FilePath -> Key -> FilePath storeDir :: FilePath -> Key -> FilePath
storeDir d k = addTrailingPathSeparator $ storeDir d k = addTrailingPathSeparator $
d </> fromRawFilePath (hashDirLower def k) </> keyFile k d </> fromRawFilePath (hashDirLower def k) </> fromRawFilePath (keyFile k)
{- Check if there is enough free disk space in the remote's directory to {- 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. -} - store the key. Note that the unencrypted key size is checked. -}
@ -164,12 +164,13 @@ store d chunkconfig k b p = liftIO $ do
case chunkconfig of case chunkconfig of
LegacyChunks chunksize -> Legacy.store chunksize finalizeStoreGeneric k b p tmpdir destdir LegacyChunks chunksize -> Legacy.store chunksize finalizeStoreGeneric k b p tmpdir destdir
_ -> do _ -> do
let tmpf = tmpdir </> keyFile k let tmpf = tmpdir </> kf
meteredWriteFile p tmpf b meteredWriteFile p tmpf b
finalizeStoreGeneric tmpdir destdir finalizeStoreGeneric tmpdir destdir
return True return True
where where
tmpdir = addTrailingPathSeparator $ d </> "tmp" </> keyFile k tmpdir = addTrailingPathSeparator $ d </> "tmp" </> kf
kf = fromRawFilePath (keyFile k)
destdir = storeDir d k destdir = storeDir d k
{- Passed a temp directory that contains the files that should be placed {- Passed a temp directory that contains the files that should be placed

View file

@ -91,7 +91,7 @@ store chunksize finalizer k b p = storeHelper finalizer k $ \dests ->
retrieve :: (FilePath -> Key -> [FilePath]) -> FilePath -> Preparer Retriever retrieve :: (FilePath -> Key -> [FilePath]) -> FilePath -> Preparer Retriever
retrieve locations d basek a = withOtherTmp $ \tmpdir -> do retrieve locations d basek a = withOtherTmp $ \tmpdir -> do
showLongNote "This remote uses the deprecated chunksize setting. So this will be quite slow." showLongNote "This remote uses the deprecated chunksize setting. So this will be quite slow."
let tmp = tmpdir </> keyFile basek ++ ".directorylegacy.tmp" let tmp = tmpdir </> fromRawFilePath (keyFile basek) ++ ".directorylegacy.tmp"
a $ Just $ byteRetriever $ \k sink -> do a $ Just $ byteRetriever $ \k sink -> do
liftIO $ void $ withStoredFiles d locations k $ \fs -> do liftIO $ void $ withStoredFiles d locations k $ \fs -> do
forM_ fs $ forM_ fs $

View file

@ -351,9 +351,9 @@ store' :: Git.Repo -> Remote -> Remote.Rsync.RsyncOpts -> Storer
store' repo r rsyncopts store' repo r rsyncopts
| not $ Git.repoIsUrl repo = | not $ Git.repoIsUrl repo =
byteStorer $ \k b p -> guardUsable repo (return False) $ liftIO $ do byteStorer $ \k b p -> guardUsable repo (return False) $ liftIO $ do
let tmpdir = Git.repoLocation repo </> "tmp" </> keyFile k let tmpdir = Git.repoLocation repo </> "tmp" </> fromRawFilePath (keyFile k)
void $ tryIO $ createDirectoryIfMissing True tmpdir void $ tryIO $ createDirectoryIfMissing True tmpdir
let tmpf = tmpdir </> keyFile k let tmpf = tmpdir </> fromRawFilePath (keyFile k)
meteredWriteFile p tmpf b meteredWriteFile p tmpf b
let destdir = parentDir $ gCryptLocation repo k let destdir = parentDir $ gCryptLocation repo k
Remote.Directory.finalizeStoreGeneric tmpdir destdir Remote.Directory.finalizeStoreGeneric tmpdir destdir

View file

@ -77,7 +77,7 @@ storeChunks key tmp dest storer recorder finalizer = either onerr return
warningIO (show e) warningIO (show e)
return False return False
basef = tmp ++ keyFile key basef = tmp ++ fromRawFilePath (keyFile key)
tmpdests = map (basef ++ ) chunkStream tmpdests = map (basef ++ ) chunkStream
{- Given a list of destinations to use, chunks the data according to the {- Given a list of destinations to use, chunks the data according to the

View file

@ -226,7 +226,7 @@ remove o k = removeGeneric o includes
[ parentDir dir [ parentDir dir
, dir , dir
-- match content directory and anything in it -- match content directory and anything in it
, dir </> keyFile k </> "***" , dir </> fromRawFilePath (keyFile k) </> "***"
] ]
{- An empty directory is rsynced to make it delete. Everything is excluded, {- An empty directory is rsynced to make it delete. Everything is excluded,

View file

@ -44,7 +44,7 @@ rsyncUrls :: RsyncOpts -> Key -> [RsyncUrl]
rsyncUrls o k = map use dirHashes rsyncUrls o k = map use dirHashes
where where
use h = rsyncUrl o </> fromRawFilePath (hash h) </> rsyncEscape o (f </> f) use h = rsyncUrl o </> fromRawFilePath (hash h) </> rsyncEscape o (f </> f)
f = keyFile k f = fromRawFilePath (keyFile k)
#ifndef mingw32_HOST_OS #ifndef mingw32_HOST_OS
hash h = h def k hash h = h def k
#else #else

View file

@ -36,7 +36,7 @@ inLocation d = inDAVLocation (</> d')
{- The directory where files(s) for a key are stored. -} {- The directory where files(s) for a key are stored. -}
keyDir :: Key -> DavLocation keyDir :: Key -> DavLocation
keyDir k = addTrailingPathSeparator $ hashdir </> keyFile k keyDir k = addTrailingPathSeparator $ hashdir </> fromRawFilePath (keyFile k)
where where
#ifndef mingw32_HOST_OS #ifndef mingw32_HOST_OS
hashdir = fromRawFilePath $ hashDirLower def k hashdir = fromRawFilePath $ hashDirLower def k
@ -45,7 +45,7 @@ keyDir k = addTrailingPathSeparator $ hashdir </> keyFile k
#endif #endif
keyLocation :: Key -> DavLocation keyLocation :: Key -> DavLocation
keyLocation k = keyDir k ++ keyFile k keyLocation k = keyDir k ++ fromRawFilePath (keyFile k)
{- Paths containing # or ? cannot be represented in an url, so fails on {- Paths containing # or ? cannot be represented in an url, so fails on
- those. -} - those. -}
@ -60,7 +60,7 @@ exportLocation l =
{- Where we store temporary data for a key as it's being uploaded. -} {- Where we store temporary data for a key as it's being uploaded. -}
keyTmpLocation :: Key -> DavLocation keyTmpLocation :: Key -> DavLocation
keyTmpLocation = tmpLocation . keyFile keyTmpLocation = tmpLocation . fromRawFilePath . keyFile
tmpLocation :: FilePath -> DavLocation tmpLocation :: FilePath -> DavLocation
tmpLocation f = "git-annex-webdav-tmp-" ++ f tmpLocation f = "git-annex-webdav-tmp-" ++ f

View file

@ -16,7 +16,7 @@ upgrade = do
showAction "v0 to v1" showAction "v0 to v1"
-- do the reorganisation of the key files -- do the reorganisation of the key files
olddir <- fromRepo gitAnnexDir olddir <- fromRawFilePath <$> fromRepo gitAnnexDir
keys <- getKeysPresent0 olddir keys <- getKeysPresent0 olddir
forM_ keys $ \k -> moveAnnex k $ olddir </> keyFile0 k forM_ keys $ \k -> moveAnnex k $ olddir </> keyFile0 k

View file

@ -238,7 +238,7 @@ logFile2 = logFile' (hashDirLower def)
logFile' :: (Key -> RawFilePath) -> Key -> Git.Repo -> String logFile' :: (Key -> RawFilePath) -> Key -> Git.Repo -> String
logFile' hasher key repo = logFile' hasher key repo =
gitStateDir repo ++ fromRawFilePath (hasher key) ++ keyFile key ++ ".log" gitStateDir repo ++ fromRawFilePath (hasher key) ++ fromRawFilePath (keyFile key) ++ ".log"
stateDir :: FilePath stateDir :: FilePath
stateDir = addTrailingPathSeparator ".git-annex" stateDir = addTrailingPathSeparator ".git-annex"

View file

@ -0,0 +1,3 @@
Profiling of `git annex find --not --in web` suggests that converting Ref
to contain a ByteString, rather than a String, would eliminate a
fromRawFilePath that uses about 1% of runtime.