mirrors/git-annex
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages 1 Wiki Activity Actions

more OsPath conversion

Browse source 
keyFile has a nice improvement; since a Key is a ShortByteString, it can
be converted to an OsPath without needing the copy that was done before.

Unfortunately, fileKey has to convert from a ShortByteString to a
ByteString in order to use attoparsec, and then the results get
converted back to an OsPath, so there are now 2 copies.
Maybe attoparsec will eventually get a ShortByteString API,
see https://github.com/haskell/attoparsec/issues/225

Sponsored-by: Joshua Antonishen
This commit is contained in:
Joey Hess 2025-01-27 16:55:07 -04:00
parent 98a0a9ddff
commit 7ebef6cd1b
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
5 changed files with 249 additions and 215 deletions
Download patch file Download diff file Expand all files Collapse all files

436
Annex/Locations.hs
View file

@ -120,7 +120,7 @@ import Data.Char
import Data.Default import Data.Default
import qualified Data.List.NonEmpty as NE import qualified Data.List.NonEmpty as NE
import qualified Data.ByteString.Char8 as S8 import qualified Data.ByteString.Char8 as S8
import qualified System.FilePath.ByteString as P import qualified Data.ByteString.Short as SB
import Common import Common
import Key import Key
@ -134,7 +134,6 @@ import qualified Git.Types as Git
import Git.FilePath import Git.FilePath
import Annex.DirHashes import Annex.DirHashes
import Annex.Fixup import Annex.Fixup
import qualified Utility.RawFilePath as R
{- Conventions: {- Conventions:
- -
@ -170,7 +169,7 @@ annexLocationsNonBare config key =
map (annexLocation config key) [hashDirMixed, hashDirLower] map (annexLocation config key) [hashDirMixed, hashDirLower]
{- Annexed file's possible locations relative to a bare repository. -} {- Annexed file's possible locations relative to a bare repository. -}
annexLocationsBare :: GitConfig -> Key -> [RawFilePath] annexLocationsBare :: GitConfig -> Key -> [OsPath]
annexLocationsBare config key = annexLocationsBare config key =
map (annexLocation config key) [hashDirLower, hashDirMixed] map (annexLocation config key) [hashDirLower, hashDirMixed]
@ -182,7 +181,7 @@ annexLocation config key hasher = objectDir </> keyPath key (hasher $ objectHash
exportAnnexObjectLocation :: GitConfig -> Key -> ExportLocation exportAnnexObjectLocation :: GitConfig -> Key -> ExportLocation
exportAnnexObjectLocation gc k = exportAnnexObjectLocation gc k =
mkExportLocation $ mkExportLocation $
literalOsPath ".git" P.</> annexLocation gc k hashDirLower literalOsPath ".git" </> annexLocation gc k hashDirLower
{- Number of subdirectories from the gitAnnexObjectDir {- Number of subdirectories from the gitAnnexObjectDir
- to the gitAnnexLocation. -} - to the gitAnnexLocation. -}
@ -199,17 +198,17 @@ gitAnnexLocationDepth config = hashlevels + 1
- When the file is not present, returns the location where the file should - When the file is not present, returns the location where the file should
- be stored. - be stored.
-} -}
gitAnnexLocation :: Key -> Git.Repo -> GitConfig -> IO RawFilePath gitAnnexLocation :: Key -> Git.Repo -> GitConfig -> IO OsPath
gitAnnexLocation = gitAnnexLocation' R.doesPathExist 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 gitAnnexLocation' checker key r config = gitAnnexLocation'' key r config
(annexCrippledFileSystem config) (annexCrippledFileSystem config)
(coreSymlinks config) (coreSymlinks config)
checker checker
(Git.localGitDir r) (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 gitAnnexLocation'' key r config crippled symlinkssupported checker gitdir
{- Bare repositories default to hashDirLower for new {- Bare repositories default to hashDirLower for new
- content, as it's more portable. But check all locations. -} - content, as it's more portable. But check all locations. -}
@ -228,14 +227,14 @@ gitAnnexLocation'' key r config crippled symlinkssupported checker gitdir
only = return . inrepo . annexLocation config key only = return . inrepo . annexLocation config key
checkall f = check $ map inrepo $ f 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 locs@(l:_) = fromMaybe l <$> firstM checker locs
check [] = error "internal" check [] = error "internal"
{- Calculates a symlink target to link a file to an annexed object. -} {- 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 gitAnnexLink file key r config = do
currdir <- R.getCurrentDirectory currdir <- getCurrentDirectory
let absfile = absNormPathUnix currdir file let absfile = absNormPathUnix currdir file
let gitdir = getgitdir currdir let gitdir = getgitdir currdir
loc <- gitAnnexLocation'' key r config False False (\_ -> return True) gitdir loc <- gitAnnexLocation'' key r config False False (\_ -> return True) gitdir
@ -246,19 +245,19 @@ gitAnnexLink file key r config = do
- supporting symlinks; generate link target that will - supporting symlinks; generate link target that will
- work portably. -} - work portably. -}
| not (coreSymlinks config) && needsSubmoduleFixup r = | not (coreSymlinks config) && needsSubmoduleFixup r =
absNormPathUnix currdir (Git.repoPath r P.</> ".git") absNormPathUnix currdir (Git.repoPath r </> literalOsPath ".git")
| otherwise = Git.localGitDir r | otherwise = Git.localGitDir r
absNormPathUnix d p = toInternalGitPath $ absNormPathUnix d p = toInternalGitPath $
absPathFrom (toInternalGitPath d) (toInternalGitPath p) absPathFrom (toInternalGitPath d) (toInternalGitPath p)
{- Calculates a symlink target as would be used in a typical git {- Calculates a symlink target as would be used in a typical git
- repository, with .git in the top of the work tree. -} - 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' gitAnnexLinkCanonical file key r config = gitAnnexLink file key r' config'
where where
r' = case r of r' = case r of
Git.Repo { Git.location = l@Git.Local { Git.worktree = Just wt } } -> 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 _ -> r
config' = config config' = config
{ annexCrippledFileSystem = False { annexCrippledFileSystem = False
@ -266,23 +265,23 @@ gitAnnexLinkCanonical file key r config = gitAnnexLink file key r' config'
} }
{- File used to lock a key's content. -} {- 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 gitAnnexContentLock key r config = do
loc <- gitAnnexLocation key r config 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 {- File used to indicate a key's content should not be dropped until after
- a specified time. -} - a specified time. -}
gitAnnexContentRetentionTimestamp :: Key -> Git.Repo -> GitConfig -> IO RawFilePath gitAnnexContentRetentionTimestamp :: Key -> Git.Repo -> GitConfig -> IO OsPath
gitAnnexContentRetentionTimestamp key r config = do gitAnnexContentRetentionTimestamp key r config = do
loc <- gitAnnexLocation key r config loc <- gitAnnexLocation key r config
return $ loc <> ".rtm" return $ loc <> literalOsPath ".rtm"
{- Lock file for gitAnnexContentRetentionTimestamp -} {- Lock file for gitAnnexContentRetentionTimestamp -}
gitAnnexContentRetentionTimestampLock :: Key -> Git.Repo -> GitConfig -> IO RawFilePath gitAnnexContentRetentionTimestampLock :: Key -> Git.Repo -> GitConfig -> IO OsPath
gitAnnexContentRetentionTimestampLock key r config = do gitAnnexContentRetentionTimestampLock key r config = do
loc <- gitAnnexLocation key r config loc <- gitAnnexLocation key r config
return $ loc <> ".rtl" return $ loc <> literalOsPath ".rtl"
{- Lock that is held when taking the gitAnnexContentLock to support the v10 {- Lock that is held when taking the gitAnnexContentLock to support the v10
- upgrade. - upgrade.
@ -292,52 +291,52 @@ gitAnnexContentRetentionTimestampLock key r config = do
- is mounted read-only. The gitAnnexInodeSentinal is created by git-annex - is mounted read-only. The gitAnnexInodeSentinal is created by git-annex
- init, so should already exist. - init, so should already exist.
-} -}
gitAnnexContentLockLock :: Git.Repo -> RawFilePath gitAnnexContentLockLock :: Git.Repo -> OsPath
gitAnnexContentLockLock = gitAnnexInodeSentinal gitAnnexContentLockLock = gitAnnexInodeSentinal
gitAnnexInodeSentinal :: Git.Repo -> RawFilePath gitAnnexInodeSentinal :: Git.Repo -> OsPath
gitAnnexInodeSentinal r = gitAnnexDir r P.</> "sentinal" gitAnnexInodeSentinal r = gitAnnexDir r </> literalOsPath "sentinal"
gitAnnexInodeSentinalCache :: Git.Repo -> RawFilePath gitAnnexInodeSentinalCache :: Git.Repo -> OsPath
gitAnnexInodeSentinalCache r = gitAnnexInodeSentinal r <> ".cache" gitAnnexInodeSentinalCache r = gitAnnexInodeSentinal r <> literalOsPath ".cache"
{- The annex directory of a repository. -} {- The annex directory of a repository. -}
gitAnnexDir :: Git.Repo -> RawFilePath gitAnnexDir :: Git.Repo -> OsPath
gitAnnexDir r = P.addTrailingPathSeparator $ Git.localGitDir r P.</> annexDir gitAnnexDir r = addTrailingPathSeparator $ Git.localGitDir r </> 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 -> RawFilePath gitAnnexObjectDir :: Git.Repo -> OsPath
gitAnnexObjectDir r = P.addTrailingPathSeparator $ gitAnnexObjectDir r = addTrailingPathSeparator $
Git.localGitDir r P.</> objectDir Git.localGitDir r </> 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 -> RawFilePath gitAnnexTmpObjectDir :: Git.Repo -> OsPath
gitAnnexTmpObjectDir r = P.addTrailingPathSeparator $ gitAnnexTmpObjectDir r = addTrailingPathSeparator $
gitAnnexDir r P.</> "tmp" gitAnnexDir r </> literalOsPath "tmp"
{- .git/annex/othertmp/ is used for other temp files -} {- .git/annex/othertmp/ is used for other temp files -}
gitAnnexTmpOtherDir :: Git.Repo -> RawFilePath gitAnnexTmpOtherDir :: Git.Repo -> OsPath
gitAnnexTmpOtherDir r = P.addTrailingPathSeparator $ gitAnnexTmpOtherDir r = addTrailingPathSeparator $
gitAnnexDir r P.</> "othertmp" gitAnnexDir r </> literalOsPath "othertmp"
{- Lock file for gitAnnexTmpOtherDir. -} {- Lock file for gitAnnexTmpOtherDir. -}
gitAnnexTmpOtherLock :: Git.Repo -> RawFilePath gitAnnexTmpOtherLock :: Git.Repo -> OsPath
gitAnnexTmpOtherLock r = gitAnnexDir r P.</> "othertmp.lck" gitAnnexTmpOtherLock r = gitAnnexDir r </> literalOsPath "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 -> RawFilePath gitAnnexTmpOtherDirOld :: Git.Repo -> OsPath
gitAnnexTmpOtherDirOld r = P.addTrailingPathSeparator $ gitAnnexTmpOtherDirOld r = addTrailingPathSeparator $
gitAnnexDir r P.</> "misctmp" gitAnnexDir r </> literalOsPath "misctmp"
{- .git/annex/watchtmp/ is used by the watcher and assistant -} {- .git/annex/watchtmp/ is used by the watcher and assistant -}
gitAnnexTmpWatcherDir :: Git.Repo -> RawFilePath gitAnnexTmpWatcherDir :: Git.Repo -> OsPath
gitAnnexTmpWatcherDir r = P.addTrailingPathSeparator $ gitAnnexTmpWatcherDir r = addTrailingPathSeparator $
gitAnnexDir r P.</> "watchtmp" gitAnnexDir r </> literalOsPath "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 -> RawFilePath gitAnnexTmpObjectLocation :: Key -> Git.Repo -> OsPath
gitAnnexTmpObjectLocation key r = gitAnnexTmpObjectDir r P.</> keyFile key gitAnnexTmpObjectLocation key r = gitAnnexTmpObjectDir r </> 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
@ -346,339 +345,353 @@ gitAnnexTmpObjectLocation key r = gitAnnexTmpObjectDir r P.</> keyFile key
- There are ordering requirements for creating these directories; - There are ordering requirements for creating these directories;
- use Annex.Content.withTmpWorkDir to set them up. - use Annex.Content.withTmpWorkDir to set them up.
-} -}
gitAnnexTmpWorkDir :: RawFilePath -> RawFilePath gitAnnexTmpWorkDir :: OsPath -> OsPath
gitAnnexTmpWorkDir p = gitAnnexTmpWorkDir p =
let (dir, f) = P.splitFileName p let (dir, f) = splitFileName p
-- Using a prefix avoids name conflict with any other keys. -- 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 -} {- .git/annex/bad/ is used for bad files found during fsck -}
gitAnnexBadDir :: Git.Repo -> RawFilePath gitAnnexBadDir :: Git.Repo -> OsPath
gitAnnexBadDir r = P.addTrailingPathSeparator $ gitAnnexDir r P.</> "bad" gitAnnexBadDir r = addTrailingPathSeparator $
gitAnnexDir r </> literalOsPath "bad"
{- The bad file to use for a given key. -} {- The bad file to use for a given key. -}
gitAnnexBadLocation :: Key -> Git.Repo -> RawFilePath gitAnnexBadLocation :: Key -> Git.Repo -> OsPath
gitAnnexBadLocation key r = gitAnnexBadDir r P.</> keyFile key gitAnnexBadLocation key r = gitAnnexBadDir r </> keyFile key
{- .git/annex/foounused is used to number possibly unused keys -} {- .git/annex/foounused is used to number possibly unused keys -}
gitAnnexUnusedLog :: RawFilePath -> Git.Repo -> RawFilePath gitAnnexUnusedLog :: OsPath -> Git.Repo -> OsPath
gitAnnexUnusedLog prefix r = gitAnnexDir r P.</> (prefix <> "unused") gitAnnexUnusedLog prefix r =
gitAnnexDir r </> (prefix <> literalOsPath "unused")
{- .git/annex/keysdb/ contains a database of information about keys. -} {- .git/annex/keysdb/ contains a database of information about keys. -}
gitAnnexKeysDbDir :: Git.Repo -> GitConfig -> RawFilePath gitAnnexKeysDbDir :: Git.Repo -> GitConfig -> OsPath
gitAnnexKeysDbDir r c = fromMaybe (gitAnnexDir r) (annexDbDir c) P.</> "keysdb" gitAnnexKeysDbDir r c =
fromMaybe (gitAnnexDir r) (annexDbDir c) </> literalOsPath "keysdb"
{- Lock file for the keys database. -} {- Lock file for the keys database. -}
gitAnnexKeysDbLock :: Git.Repo -> GitConfig -> RawFilePath gitAnnexKeysDbLock :: Git.Repo -> GitConfig -> OsPath
gitAnnexKeysDbLock r c = gitAnnexKeysDbDir r c <> ".lck" gitAnnexKeysDbLock r c = gitAnnexKeysDbDir r c <> literalOsPath ".lck"
{- Contains the stat of the last index file that was {- Contains the stat of the last index file that was
- reconciled with the keys database. -} - reconciled with the keys database. -}
gitAnnexKeysDbIndexCache :: Git.Repo -> GitConfig -> RawFilePath gitAnnexKeysDbIndexCache :: Git.Repo -> GitConfig -> OsPath
gitAnnexKeysDbIndexCache r c = gitAnnexKeysDbDir r c <> ".cache" gitAnnexKeysDbIndexCache r c =
gitAnnexKeysDbDir r c <> literalOsPath ".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 -> Maybe GitConfig -> RawFilePath gitAnnexFsckDir :: UUID -> Git.Repo -> Maybe GitConfig -> OsPath
gitAnnexFsckDir u r mc = case annexDbDir =<< mc of gitAnnexFsckDir u r mc = case annexDbDir =<< mc of
Nothing -> go (gitAnnexDir r) Nothing -> go (gitAnnexDir r)
Just d -> go d Just d -> go d
where where
go d = d P.</> "fsck" P.</> fromUUID u go d = d </> literalOsPath "fsck" </> uuidPath u
{- used to store information about incremental fscks. -} {- used to store information about incremental fscks. -}
gitAnnexFsckState :: UUID -> Git.Repo -> RawFilePath gitAnnexFsckState :: UUID -> Git.Repo -> OsPath
gitAnnexFsckState u r = gitAnnexFsckDir u r Nothing P.</> "state" gitAnnexFsckState u r = gitAnnexFsckDir u r Nothing </> literalOsPath "state"
{- Directory containing database used to record fsck info. -} {- Directory containing database used to record fsck info. -}
gitAnnexFsckDbDir :: UUID -> Git.Repo -> GitConfig -> RawFilePath gitAnnexFsckDbDir :: UUID -> Git.Repo -> GitConfig -> OsPath
gitAnnexFsckDbDir u r c = gitAnnexFsckDir u r (Just c) P.</> "fsckdb" gitAnnexFsckDbDir u r c = gitAnnexFsckDir u r (Just c) </> literalOsPath "fsckdb"
{- Directory containing old database used to record fsck info. -} {- Directory containing old database used to record fsck info. -}
gitAnnexFsckDbDirOld :: UUID -> Git.Repo -> GitConfig -> RawFilePath gitAnnexFsckDbDirOld :: UUID -> Git.Repo -> GitConfig -> OsPath
gitAnnexFsckDbDirOld u r c = gitAnnexFsckDir u r (Just c) P.</> "db" gitAnnexFsckDbDirOld u r c = gitAnnexFsckDir u r (Just c) </> literalOsPath "db"
{- Lock file for the fsck database. -} {- Lock file for the fsck database. -}
gitAnnexFsckDbLock :: UUID -> Git.Repo -> GitConfig -> RawFilePath gitAnnexFsckDbLock :: UUID -> Git.Repo -> GitConfig -> OsPath
gitAnnexFsckDbLock u r c = gitAnnexFsckDir u r (Just c) P.</> "fsck.lck" gitAnnexFsckDbLock u r c = gitAnnexFsckDir u r (Just c) </> literalOsPath "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 -> RawFilePath gitAnnexFsckResultsLog :: UUID -> Git.Repo -> OsPath
gitAnnexFsckResultsLog u r = gitAnnexFsckResultsLog u r =
gitAnnexDir r P.</> "fsckresults" P.</> fromUUID u gitAnnexDir r </> literalOsPath "fsckresults" </> uuidPath u
{- .git/annex/upgrade.log is used to record repository version upgrades. -} {- .git/annex/upgrade.log is used to record repository version upgrades. -}
gitAnnexUpgradeLog :: Git.Repo -> RawFilePath gitAnnexUpgradeLog :: Git.Repo -> OsPath
gitAnnexUpgradeLog r = gitAnnexDir r P.</> "upgrade.log" gitAnnexUpgradeLog r = gitAnnexDir r </> literalOsPath "upgrade.log"
gitAnnexUpgradeLock :: Git.Repo -> RawFilePath gitAnnexUpgradeLock :: Git.Repo -> OsPath
gitAnnexUpgradeLock r = gitAnnexDir r P.</> "upgrade.lck" gitAnnexUpgradeLock r = gitAnnexDir r </> literalOsPath "upgrade.lck"
{- .git/annex/smudge.log is used to log smudged worktree files that need to {- .git/annex/smudge.log is used to log smudged worktree files that need to
- be updated. -} - be updated. -}
gitAnnexSmudgeLog :: Git.Repo -> RawFilePath gitAnnexSmudgeLog :: Git.Repo -> OsPath
gitAnnexSmudgeLog r = gitAnnexDir r P.</> "smudge.log" gitAnnexSmudgeLog r = gitAnnexDir r </> literalOsPath "smudge.log"
gitAnnexSmudgeLock :: Git.Repo -> RawFilePath gitAnnexSmudgeLock :: Git.Repo -> OsPath
gitAnnexSmudgeLock r = gitAnnexDir r P.</> "smudge.lck" gitAnnexSmudgeLock r = gitAnnexDir r </> literalOsPath "smudge.lck"
{- .git/annex/restage.log is used to log worktree files that need to be {- .git/annex/restage.log is used to log worktree files that need to be
- restaged in git -} - restaged in git -}
gitAnnexRestageLog :: Git.Repo -> RawFilePath gitAnnexRestageLog :: Git.Repo -> OsPath
gitAnnexRestageLog r = gitAnnexDir r P.</> "restage.log" gitAnnexRestageLog r = gitAnnexDir r </> literalOsPath "restage.log"
{- .git/annex/restage.old is used while restaging files in git -} {- .git/annex/restage.old is used while restaging files in git -}
gitAnnexRestageLogOld :: Git.Repo -> RawFilePath gitAnnexRestageLogOld :: Git.Repo -> OsPath
gitAnnexRestageLogOld r = gitAnnexDir r P.</> "restage.old" gitAnnexRestageLogOld r = gitAnnexDir r </> literalOsPath "restage.old"
gitAnnexRestageLock :: Git.Repo -> RawFilePath gitAnnexRestageLock :: Git.Repo -> OsPath
gitAnnexRestageLock r = gitAnnexDir r P.</> "restage.lck" gitAnnexRestageLock r = gitAnnexDir r </> literalOsPath "restage.lck"
{- .git/annex/adjust.log is used to log when the adjusted branch needs to {- .git/annex/adjust.log is used to log when the adjusted branch needs to
- be updated. -} - be updated. -}
gitAnnexAdjustedBranchUpdateLog :: Git.Repo -> RawFilePath gitAnnexAdjustedBranchUpdateLog :: Git.Repo -> OsPath
gitAnnexAdjustedBranchUpdateLog r = gitAnnexDir r P.</> "adjust.log" gitAnnexAdjustedBranchUpdateLog r = gitAnnexDir r </> literalOsPath "adjust.log"
gitAnnexAdjustedBranchUpdateLock :: Git.Repo -> RawFilePath gitAnnexAdjustedBranchUpdateLock :: Git.Repo -> OsPath
gitAnnexAdjustedBranchUpdateLock r = gitAnnexDir r P.</> "adjust.lck" gitAnnexAdjustedBranchUpdateLock r = gitAnnexDir r </> literalOsPath "adjust.lck"
{- .git/annex/migrate.log is used to log migrations before committing them. -} {- .git/annex/migrate.log is used to log migrations before committing them. -}
gitAnnexMigrateLog :: Git.Repo -> RawFilePath gitAnnexMigrateLog :: Git.Repo -> OsPath
gitAnnexMigrateLog r = gitAnnexDir r P.</> "migrate.log" gitAnnexMigrateLog r = gitAnnexDir r </> literalOsPath "migrate.log"
gitAnnexMigrateLock :: Git.Repo -> RawFilePath gitAnnexMigrateLock :: Git.Repo -> OsPath
gitAnnexMigrateLock r = gitAnnexDir r P.</> "migrate.lck" gitAnnexMigrateLock r = gitAnnexDir r </> literalOsPath "migrate.lck"
{- .git/annex/migrations.log is used to log committed migrations. -} {- .git/annex/migrations.log is used to log committed migrations. -}
gitAnnexMigrationsLog :: Git.Repo -> RawFilePath gitAnnexMigrationsLog :: Git.Repo -> OsPath
gitAnnexMigrationsLog r = gitAnnexDir r P.</> "migrations.log" gitAnnexMigrationsLog r = gitAnnexDir r </> literalOsPath "migrations.log"
gitAnnexMigrationsLock :: Git.Repo -> RawFilePath gitAnnexMigrationsLock :: Git.Repo -> OsPath
gitAnnexMigrationsLock r = gitAnnexDir r P.</> "migrations.lck" gitAnnexMigrationsLock r = gitAnnexDir r </> literalOsPath "migrations.lck"
{- .git/annex/move.log is used to log moves that are in progress, {- .git/annex/move.log is used to log moves that are in progress,
- to better support resuming an interrupted move. -} - to better support resuming an interrupted move. -}
gitAnnexMoveLog :: Git.Repo -> RawFilePath gitAnnexMoveLog :: Git.Repo -> OsPath
gitAnnexMoveLog r = gitAnnexDir r P.</> "move.log" gitAnnexMoveLog r = gitAnnexDir r </> literalOsPath "move.log"
gitAnnexMoveLock :: Git.Repo -> RawFilePath gitAnnexMoveLock :: Git.Repo -> OsPath
gitAnnexMoveLock r = gitAnnexDir r P.</> "move.lck" gitAnnexMoveLock r = gitAnnexDir r </> literalOsPath "move.lck"
{- .git/annex/export/ is used to store information about {- .git/annex/export/ is used to store information about
- exports to special remotes. -} - exports to special remotes. -}
gitAnnexExportDir :: Git.Repo -> GitConfig -> RawFilePath gitAnnexExportDir :: Git.Repo -> GitConfig -> OsPath
gitAnnexExportDir r c = fromMaybe (gitAnnexDir r) (annexDbDir c) P.</> "export" gitAnnexExportDir r c = fromMaybe (gitAnnexDir r) (annexDbDir c)
</> literalOsPath "export"
{- Directory containing database used to record export info. -} {- Directory containing database used to record export info. -}
gitAnnexExportDbDir :: UUID -> Git.Repo -> GitConfig -> RawFilePath gitAnnexExportDbDir :: UUID -> Git.Repo -> GitConfig -> OsPath
gitAnnexExportDbDir u r c = gitAnnexExportDbDir u r c =
gitAnnexExportDir r c P.</> fromUUID u P.</> "exportdb" gitAnnexExportDir r c </> uuidPath u </> literalOsPath "exportdb"
{- Lock file for export database. -} {- Lock file for export database. -}
gitAnnexExportLock :: UUID -> Git.Repo -> GitConfig -> RawFilePath gitAnnexExportLock :: UUID -> Git.Repo -> GitConfig -> OsPath
gitAnnexExportLock u r c = gitAnnexExportDbDir u r c <> ".lck" gitAnnexExportLock u r c = gitAnnexExportDbDir u r c <> literalOsPath ".lck"
{- Lock file for updating the export database with information from the {- Lock file for updating the export database with information from the
- repository. -} - repository. -}
gitAnnexExportUpdateLock :: UUID -> Git.Repo -> GitConfig -> RawFilePath gitAnnexExportUpdateLock :: UUID -> Git.Repo -> GitConfig -> OsPath
gitAnnexExportUpdateLock u r c = gitAnnexExportDbDir u r c <> ".upl" 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 {- 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 -> RawFilePath gitAnnexExportExcludeLog :: UUID -> Git.Repo -> OsPath
gitAnnexExportExcludeLog u r = gitAnnexDir r P.</> "export.ex" P.</> fromUUID u gitAnnexExportExcludeLog u r = gitAnnexDir r
</> literalOsPath "export.ex" </> uuidPath u
{- Directory containing database used to record remote content ids. {- Directory containing database used to record remote content ids.
- -
- (This used to be "cid", but a problem with the database caused it to - (This used to be "cid", but a problem with the database caused it to
- need to be rebuilt with a new name.) - need to be rebuilt with a new name.)
-} -}
gitAnnexContentIdentifierDbDir :: Git.Repo -> GitConfig -> RawFilePath gitAnnexContentIdentifierDbDir :: Git.Repo -> GitConfig -> OsPath
gitAnnexContentIdentifierDbDir r c = 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. -} {- Lock file for writing to the content id database. -}
gitAnnexContentIdentifierLock :: Git.Repo -> GitConfig -> RawFilePath gitAnnexContentIdentifierLock :: Git.Repo -> GitConfig -> OsPath
gitAnnexContentIdentifierLock r c = gitAnnexContentIdentifierDbDir r c <> ".lck" gitAnnexContentIdentifierLock r c =
gitAnnexContentIdentifierDbDir r c <> literalOsPath ".lck"
{- .git/annex/import/ is used to store information about {- .git/annex/import/ is used to store information about
- imports from special remotes. -} - imports from special remotes. -}
gitAnnexImportDir :: Git.Repo -> GitConfig -> RawFilePath gitAnnexImportDir :: Git.Repo -> GitConfig -> OsPath
gitAnnexImportDir r c = fromMaybe (gitAnnexDir r) (annexDbDir c) P.</> "import" gitAnnexImportDir r c =
fromMaybe (gitAnnexDir r) (annexDbDir c) </> literalOsPath "import"
{- File containing state about the last import done from a remote. -} {- File containing state about the last import done from a remote. -}
gitAnnexImportLog :: UUID -> Git.Repo -> GitConfig -> RawFilePath gitAnnexImportLog :: UUID -> Git.Repo -> GitConfig -> OsPath
gitAnnexImportLog u r c = gitAnnexImportLog u r c =
gitAnnexImportDir r c P.</> fromUUID u P.</> "log" gitAnnexImportDir r c </> uuidPath u </> literalOsPath "log"
{- Directory containing database used by importfeed. -} {- Directory containing database used by importfeed. -}
gitAnnexImportFeedDbDir :: Git.Repo -> GitConfig -> RawFilePath gitAnnexImportFeedDbDir :: Git.Repo -> GitConfig -> OsPath
gitAnnexImportFeedDbDir r c = 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. -} {- Lock file for writing to the importfeed database. -}
gitAnnexImportFeedDbLock :: Git.Repo -> GitConfig -> RawFilePath gitAnnexImportFeedDbLock :: Git.Repo -> GitConfig -> OsPath
gitAnnexImportFeedDbLock r c = gitAnnexImportFeedDbDir r c <> ".lck" gitAnnexImportFeedDbLock r c =
gitAnnexImportFeedDbDir r c <> literalOsPath ".lck"
{- Directory containing reposize database. -} {- Directory containing reposize database. -}
gitAnnexRepoSizeDbDir :: Git.Repo -> GitConfig -> RawFilePath gitAnnexRepoSizeDbDir :: Git.Repo -> GitConfig -> OsPath
gitAnnexRepoSizeDbDir r c = 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. -} {- Lock file for the reposize database. -}
gitAnnexRepoSizeDbLock :: Git.Repo -> GitConfig -> RawFilePath gitAnnexRepoSizeDbLock :: Git.Repo -> GitConfig -> OsPath
gitAnnexRepoSizeDbLock r c = 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. -} {- Directory containing liveness pid files. -}
gitAnnexRepoSizeLiveDir :: Git.Repo -> GitConfig -> RawFilePath gitAnnexRepoSizeLiveDir :: Git.Repo -> GitConfig -> OsPath
gitAnnexRepoSizeLiveDir r c = 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 {- .git/annex/schedulestate is used to store information about when
- scheduled jobs were last run. -} - scheduled jobs were last run. -}
gitAnnexScheduleState :: Git.Repo -> RawFilePath gitAnnexScheduleState :: Git.Repo -> OsPath
gitAnnexScheduleState r = gitAnnexDir r P.</> "schedulestate" gitAnnexScheduleState r = gitAnnexDir r </> literalOsPath "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 -> RawFilePath gitAnnexCredsDir :: Git.Repo -> OsPath
gitAnnexCredsDir r = P.addTrailingPathSeparator $ gitAnnexDir r P.</> "creds" gitAnnexCredsDir r = addTrailingPathSeparator $
gitAnnexDir r </> literalOsPath "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 = fromRawFilePath $ gitAnnexDir r P.</> "certificate.pem" gitAnnexWebCertificate r = fromOsPath $
gitAnnexDir r </> literalOsPath "certificate.pem"
gitAnnexWebPrivKey :: Git.Repo -> FilePath gitAnnexWebPrivKey :: Git.Repo -> FilePath
gitAnnexWebPrivKey r = fromRawFilePath $ gitAnnexDir r P.</> "privkey.pem" gitAnnexWebPrivKey r = fromOsPath $
gitAnnexDir r </> literalOsPath "privkey.pem"
{- .git/annex/feeds/ is used to record per-key (url) state by importfeed -} {- .git/annex/feeds/ is used to record per-key (url) state by importfeed -}
gitAnnexFeedStateDir :: Git.Repo -> RawFilePath gitAnnexFeedStateDir :: Git.Repo -> OsPath
gitAnnexFeedStateDir r = P.addTrailingPathSeparator $ gitAnnexFeedStateDir r = addTrailingPathSeparator $
gitAnnexDir r P.</> "feedstate" gitAnnexDir r </> literalOsPath "feedstate"
gitAnnexFeedState :: Key -> Git.Repo -> RawFilePath gitAnnexFeedState :: Key -> Git.Repo -> OsPath
gitAnnexFeedState k r = gitAnnexFeedStateDir r P.</> keyFile k gitAnnexFeedState k r = gitAnnexFeedStateDir r </> keyFile k
{- .git/annex/merge/ is used as a empty work tree for merges in {- .git/annex/merge/ is used as a empty work tree for merges in
- adjusted branches. -} - adjusted branches. -}
gitAnnexMergeDir :: Git.Repo -> FilePath gitAnnexMergeDir :: Git.Repo -> FilePath
gitAnnexMergeDir r = fromRawFilePath $ gitAnnexMergeDir r = fromOsPath $
P.addTrailingPathSeparator $ gitAnnexDir r P.</> "merge" addTrailingPathSeparator $ gitAnnexDir r </> literalOsPath "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 -> RawFilePath gitAnnexTransferDir :: Git.Repo -> OsPath
gitAnnexTransferDir r = 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 {- .git/annex/journal/ is used to journal changes made to the git-annex
- branch -} - branch -}
gitAnnexJournalDir :: BranchState -> Git.Repo -> RawFilePath gitAnnexJournalDir :: BranchState -> Git.Repo -> OsPath
gitAnnexJournalDir st r = P.addTrailingPathSeparator $ gitAnnexJournalDir st r = addTrailingPathSeparator $
case alternateJournal st of case alternateJournal st of
Nothing -> gitAnnexDir r P.</> "journal" Nothing -> gitAnnexDir r </> literalOsPath "journal"
Just d -> d Just d -> d
{- .git/annex/journal.private/ is used to journal changes regarding private {- .git/annex/journal.private/ is used to journal changes regarding private
- repositories. -} - repositories. -}
gitAnnexPrivateJournalDir :: BranchState -> Git.Repo -> RawFilePath gitAnnexPrivateJournalDir :: BranchState -> Git.Repo -> OsPath
gitAnnexPrivateJournalDir st r = P.addTrailingPathSeparator $ gitAnnexPrivateJournalDir st r = addTrailingPathSeparator $
case alternateJournal st of case alternateJournal st of
Nothing -> gitAnnexDir r P.</> "journal-private" Nothing -> gitAnnexDir r </> literalOsPath "journal-private"
Just d -> d Just d -> d
{- Lock file for the journal. -} {- Lock file for the journal. -}
gitAnnexJournalLock :: Git.Repo -> RawFilePath gitAnnexJournalLock :: Git.Repo -> OsPath
gitAnnexJournalLock r = gitAnnexDir r P.</> "journal.lck" gitAnnexJournalLock r = gitAnnexDir r </> literalOsPath "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 -> RawFilePath gitAnnexGitQueueLock :: Git.Repo -> OsPath
gitAnnexGitQueueLock r = gitAnnexDir r P.</> "gitqueue.lck" gitAnnexGitQueueLock r = gitAnnexDir r </> literalOsPath "gitqueue.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 -> RawFilePath gitAnnexIndex :: Git.Repo -> OsPath
gitAnnexIndex r = gitAnnexDir r P.</> "index" gitAnnexIndex r = gitAnnexDir r </> literalOsPath "index"
{- .git/annex/index-private is used to store information that is not to {- .git/annex/index-private is used to store information that is not to
- be exposed to the git-annex branch. -} - be exposed to the git-annex branch. -}
gitAnnexPrivateIndex :: Git.Repo -> RawFilePath gitAnnexPrivateIndex :: Git.Repo -> OsPath
gitAnnexPrivateIndex r = gitAnnexDir r P.</> "index-private" gitAnnexPrivateIndex r = gitAnnexDir r </> literalOsPath "index-private"
{- Holds the sha of the git-annex branch that the index was last updated to. {- 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 - The .lck in the name is a historical accident; this is not used as a
- lock. -} - lock. -}
gitAnnexIndexStatus :: Git.Repo -> RawFilePath gitAnnexIndexStatus :: Git.Repo -> OsPath
gitAnnexIndexStatus r = gitAnnexDir r P.</> "index.lck" gitAnnexIndexStatus r = gitAnnexDir r </> literalOsPath "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 -> RawFilePath gitAnnexViewIndex :: Git.Repo -> OsPath
gitAnnexViewIndex r = gitAnnexDir r P.</> "viewindex" gitAnnexViewIndex r = gitAnnexDir r </> literalOsPath "viewindex"
{- File containing a log of recently accessed views. -} {- File containing a log of recently accessed views. -}
gitAnnexViewLog :: Git.Repo -> RawFilePath gitAnnexViewLog :: Git.Repo -> OsPath
gitAnnexViewLog r = gitAnnexDir r P.</> "viewlog" gitAnnexViewLog r = gitAnnexDir r </> literalOsPath "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 -> RawFilePath gitAnnexMergedRefs :: Git.Repo -> OsPath
gitAnnexMergedRefs r = gitAnnexDir r P.</> "mergedrefs" gitAnnexMergedRefs r = gitAnnexDir r </> literalOsPath "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 -> RawFilePath gitAnnexIgnoredRefs :: Git.Repo -> OsPath
gitAnnexIgnoredRefs r = gitAnnexDir r P.</> "ignoredrefs" gitAnnexIgnoredRefs r = gitAnnexDir r </> literalOsPath "ignoredrefs"
{- Pid file for daemon mode. -} {- Pid file for daemon mode. -}
gitAnnexPidFile :: Git.Repo -> RawFilePath gitAnnexPidFile :: Git.Repo -> OsPath
gitAnnexPidFile r = gitAnnexDir r P.</> "daemon.pid" gitAnnexPidFile r = gitAnnexDir r </> literalOsPath "daemon.pid"
{- Pid lock file for pidlock mode -} {- Pid lock file for pidlock mode -}
gitAnnexPidLockFile :: Git.Repo -> RawFilePath gitAnnexPidLockFile :: Git.Repo -> OsPath
gitAnnexPidLockFile r = gitAnnexDir r P.</> "pidlock" gitAnnexPidLockFile r = gitAnnexDir r </> literalOsPath "pidlock"
{- Status file for daemon mode. -} {- Status file for daemon mode. -}
gitAnnexDaemonStatusFile :: Git.Repo -> FilePath gitAnnexDaemonStatusFile :: Git.Repo -> FilePath
gitAnnexDaemonStatusFile r = fromRawFilePath $ gitAnnexDaemonStatusFile r = fromOsPath $
gitAnnexDir r P.</> "daemon.status" gitAnnexDir r </> literalOsPath "daemon.status"
{- Log file for daemon mode. -} {- Log file for daemon mode. -}
gitAnnexDaemonLogFile :: Git.Repo -> RawFilePath gitAnnexDaemonLogFile :: Git.Repo -> OsPath
gitAnnexDaemonLogFile r = gitAnnexDir r P.</> "daemon.log" gitAnnexDaemonLogFile r = gitAnnexDir r </> literalOsPath "daemon.log"
{- Log file for fuzz test. -} {- Log file for fuzz test. -}
gitAnnexFuzzTestLogFile :: Git.Repo -> FilePath gitAnnexFuzzTestLogFile :: Git.Repo -> FilePath
gitAnnexFuzzTestLogFile r = fromRawFilePath $ gitAnnexFuzzTestLogFile r = fromOsPath $
gitAnnexDir r P.</> "fuzztest.log" gitAnnexDir r </> literalOsPath "fuzztest.log"
{- Html shim file used to launch the webapp. -} {- Html shim file used to launch the webapp. -}
gitAnnexHtmlShim :: Git.Repo -> RawFilePath gitAnnexHtmlShim :: Git.Repo -> OsPath
gitAnnexHtmlShim r = gitAnnexDir r P.</> "webapp.html" gitAnnexHtmlShim r = gitAnnexDir r </> literalOsPath "webapp.html"
{- File containing the url to the webapp. -} {- File containing the url to the webapp. -}
gitAnnexUrlFile :: Git.Repo -> RawFilePath gitAnnexUrlFile :: Git.Repo -> OsPath
gitAnnexUrlFile r = gitAnnexDir r P.</> "url" gitAnnexUrlFile r = gitAnnexDir r </> literalOsPath "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 -> RawFilePath gitAnnexTmpCfgFile :: Git.Repo -> OsPath
gitAnnexTmpCfgFile r = gitAnnexDir r P.</> "config.tmp" gitAnnexTmpCfgFile r = gitAnnexDir r </> literalOsPath "config.tmp"
{- .git/annex/ssh/ is used for ssh connection caching -} {- .git/annex/ssh/ is used for ssh connection caching -}
gitAnnexSshDir :: Git.Repo -> RawFilePath gitAnnexSshDir :: Git.Repo -> OsPath
gitAnnexSshDir r = P.addTrailingPathSeparator $ gitAnnexDir r P.</> "ssh" gitAnnexSshDir r = addTrailingPathSeparator $
gitAnnexDir r </> literalOsPath "ssh"
{- .git/annex/remotes/ is used for remote-specific state. -} {- .git/annex/remotes/ is used for remote-specific state. -}
gitAnnexRemotesDir :: Git.Repo -> RawFilePath gitAnnexRemotesDir :: Git.Repo -> OsPath
gitAnnexRemotesDir r = gitAnnexRemotesDir r = addTrailingPathSeparator $
P.addTrailingPathSeparator $ gitAnnexDir r P.</> "remotes" gitAnnexDir r </> literalOsPath "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. -}
gitAnnexAssistantDefaultDir :: FilePath gitAnnexAssistantDefaultDir :: FilePath
gitAnnexAssistantDefaultDir = "annex" gitAnnexAssistantDefaultDir = "annex"
gitAnnexSimDir :: Git.Repo -> RawFilePath gitAnnexSimDir :: Git.Repo -> OsPath
gitAnnexSimDir r = P.addTrailingPathSeparator $ gitAnnexDir r P.</> "sim" gitAnnexSimDir r = addTrailingPathSeparator $
gitAnnexDir r </> literalOsPath "sim"
{- Sanitizes a String that will be used as part of a Key's keyName, {- Sanitizes a String that will be used as part of a Key's keyName,
- dealing with characters that cause problems. - dealing with characters that cause problems.
@ -730,23 +743,26 @@ 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 -> RawFilePath keyFile :: Key -> OsPath
keyFile k = keyFile k =
let b = serializeKey' k let b = serializeKey'' k
in if S8.any (`elem` ['&', '%', ':', '/']) b in toOsPath $ if SB.any (`elem` needesc) b
then S8.concatMap esc b then SB.concat $ map esc (SB.unpack b)
else b else b
where where
esc '&' = "&a" esc w = case chr (fromIntegral w) of
esc '%' = "&s" '&' -> "&a"
esc ':' = "&c" '%' -> "&s"
esc '/' = "%" ':' -> "&c"
esc c = S8.singleton c '/' -> "%"
_ -> SB.singleton w
needesc = map (fromIntegral . ord) ['&', '%', ':', '/']
{- 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 :: RawFilePath -> Maybe Key fileKey :: OsPath -> Maybe Key
fileKey = deserializeKey' . S8.intercalate "/" . map go . S8.split '%' fileKey = deserializeKey' . S8.intercalate "/" . map go . S8.split '%' . fromOsPath
where where
go = S8.concat . unescafterfirst . S8.split '&' go = S8.concat . unescafterfirst . S8.split '&'
unescafterfirst [] = [] unescafterfirst [] = []
@ -765,8 +781,8 @@ fileKey = deserializeKey' . S8.intercalate "/" . map go . S8.split '%'
- The file is put in a directory with the same name, this allows - The file is put in a directory with the same name, this allows
- write-protecting the directory to avoid accidental deletion of the file. - write-protecting the directory to avoid accidental deletion of the file.
-} -}
keyPath :: Key -> Hasher -> RawFilePath keyPath :: Key -> Hasher -> OsPath
keyPath key hasher = hasher key P.</> f P.</> f keyPath key hasher = hasher key </> f </> f
where where
f = keyFile key f = keyFile key
@ -776,5 +792,9 @@ keyPath key hasher = hasher key P.</> f P.</> f
- This is compatible with the annexLocationsNonBare and annexLocationsBare, - This is compatible with the annexLocationsNonBare and annexLocationsBare,
- for interoperability between special remotes and git-annex repos. - 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 keyPaths key = NE.map (\h -> keyPath key (h def)) dirHashes
uuidPath :: UUID -> OsPath
uuidPath u = toOsPath (fromUUID u :: SB.ShortByteString)

10
Key.hs
View file

@ -18,6 +18,7 @@ module Key (
keyParser, keyParser,
serializeKey, serializeKey,
serializeKey', serializeKey',
serializeKey'',
deserializeKey, deserializeKey,
deserializeKey', deserializeKey',
nonChunkKey, nonChunkKey,
@ -31,7 +32,7 @@ module Key (
import qualified Data.Text as T import qualified Data.Text as T
import qualified Data.ByteString as S 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 qualified Data.Attoparsec.ByteString as A
import Common import Common
@ -63,7 +64,10 @@ serializeKey :: Key -> String
serializeKey = decodeBS . serializeKey' serializeKey = decodeBS . serializeKey'
serializeKey' :: Key -> S.ByteString serializeKey' :: Key -> S.ByteString
serializeKey' = S.fromShort . keySerialization serializeKey' = fromShort . keySerialization
serializeKey'' :: Key -> ShortByteString
serializeKey'' = keySerialization
deserializeKey :: String -> Maybe Key deserializeKey :: String -> Maybe Key
deserializeKey = deserializeKey' . encodeBS deserializeKey = deserializeKey' . encodeBS
@ -73,7 +77,7 @@ deserializeKey' = eitherToMaybe . A.parseOnly keyParser
instance Arbitrary KeyData where instance Arbitrary KeyData where
arbitrary = Key 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 <*> (parseKeyVariety . encodeBS <$> (listOf1 $ elements ['A'..'Z'])) -- BACKEND
<*> ((abs <$>) <$> arbitrary) -- size cannot be negative <*> ((abs <$>) <$> arbitrary) -- size cannot be negative
<*> ((abs . fromInteger <$>) <$> arbitrary) -- mtime cannot be negative <*> ((abs . fromInteger <$>) <$> arbitrary) -- mtime cannot be negative

4
Types/BranchState.hs
View file

@ -29,14 +29,14 @@ data BranchState = BranchState
, unhandledTransitions :: [TransitionCalculator] , unhandledTransitions :: [TransitionCalculator]
-- ^ when the branch was not able to be updated due to permissions, -- ^ when the branch was not able to be updated due to permissions,
-- this is transitions that need to be applied when making queries. -- 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 -- ^ contents of a few files recently read from the branch
, needInteractiveAccess :: Bool , needInteractiveAccess :: Bool
-- ^ do new changes written to the journal or branch by another -- ^ do new changes written to the journal or branch by another
-- process need to be noticed while the current process is running? -- process need to be noticed while the current process is running?
-- (This makes the journal always be read, and avoids using the -- (This makes the journal always be read, and avoids using the
-- cache.) -- cache.)
, alternateJournal :: Maybe RawFilePath , alternateJournal :: Maybe OsPath
-- ^ use this directory for all journals, rather than the -- ^ use this directory for all journals, rather than the
-- gitAnnexJournalDir and gitAnnexPrivateJournalDir. -- gitAnnexJournalDir and gitAnnexPrivateJournalDir.
} }

4
Types/GitConfig.hs
View file

@ -138,7 +138,7 @@ data GitConfig = GitConfig
, annexVerify :: Bool , annexVerify :: Bool
, annexPidLock :: Bool , annexPidLock :: Bool
, annexPidLockTimeout :: Seconds , annexPidLockTimeout :: Seconds
, annexDbDir :: Maybe RawFilePath , annexDbDir :: Maybe OsPath
, annexAddUnlocked :: GlobalConfigurable (Maybe String) , annexAddUnlocked :: GlobalConfigurable (Maybe String)
, annexSecureHashesOnly :: Bool , annexSecureHashesOnly :: Bool
, annexRetry :: Maybe Integer , annexRetry :: Maybe Integer
@ -244,7 +244,7 @@ extractGitConfig configsource r = GitConfig
, annexPidLock = getbool (annexConfig "pidlock") False , annexPidLock = getbool (annexConfig "pidlock") False
, annexPidLockTimeout = Seconds $ fromMaybe 300 $ , annexPidLockTimeout = Seconds $ fromMaybe 300 $
getmayberead (annexConfig "pidlocktimeout") getmayberead (annexConfig "pidlocktimeout")
, annexDbDir = (\d -> toRawFilePath d P.</> fromUUID hereuuid) , annexDbDir = (\d -> toOsPath (toRawFilePath d P.</> fromUUID hereuuid))
<$> getmaybe (annexConfig "dbdir") <$> getmaybe (annexConfig "dbdir")
, annexAddUnlocked = configurable Nothing $ , annexAddUnlocked = configurable Nothing $
fmap Just $ getmaybe (annexConfig "addunlocked") fmap Just $ getmaybe (annexConfig "addunlocked")

10
Types/UUID.hs
View file

@ -10,6 +10,7 @@
module Types.UUID where module Types.UUID where
import qualified Data.ByteString as B import qualified Data.ByteString as B
import qualified Data.ByteString.Short as SB
import qualified Data.Text as T import qualified Data.Text as T
import qualified Data.Map as M import qualified Data.Map as M
import qualified Data.UUID as U import qualified Data.UUID as U
@ -54,6 +55,15 @@ instance ToUUID B.ByteString where
| B.null b = NoUUID | B.null b = NoUUID
| otherwise = UUID b | 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)
instance FromUUID String where instance FromUUID String where
fromUUID s = decodeBS (fromUUID s) fromUUID s = decodeBS (fromUUID s)