From 8af91a4c92c586c0e41f40562f15f393ef9d72ab Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sun, 2 Feb 2025 14:03:43 -0400 Subject: [PATCH] more OsPath conversion Sponsored-by: Joshua Antonishen --- Annex/AdjustedBranch.hs | 18 +++--- Annex/Content.hs | 123 ++++++++++++++++++++-------------------- 2 files changed, 69 insertions(+), 72 deletions(-) diff --git a/Annex/AdjustedBranch.hs b/Annex/AdjustedBranch.hs index 5d5458fa82..99cd40e835 100644 --- a/Annex/AdjustedBranch.hs +++ b/Annex/AdjustedBranch.hs @@ -161,7 +161,7 @@ adjustToPointer ti@(TreeItem f _m s) = catKey s >>= \case Database.Keys.addAssociatedFile k f exe <- catchDefaultIO False $ (isExecutable . fileMode) <$> - (liftIO . R.getFileStatus + (liftIO . R.getFileStatus . fromOsPath =<< calcRepo (gitAnnexLocation k)) let mode = fromTreeItemType $ if exe then TreeExecutable else TreeFile @@ -171,13 +171,13 @@ adjustToPointer ti@(TreeItem f _m s) = catKey s >>= \case adjustToSymlink :: TreeItem -> Annex (Maybe TreeItem) adjustToSymlink = adjustToSymlink' gitAnnexLink -adjustToSymlink' :: (RawFilePath -> Key -> Git.Repo -> GitConfig -> IO RawFilePath) -> TreeItem -> Annex (Maybe TreeItem) +adjustToSymlink' :: (OsPath -> Key -> Git.Repo -> GitConfig -> IO OsPath) -> TreeItem -> Annex (Maybe TreeItem) adjustToSymlink' gitannexlink ti@(TreeItem f _m s) = catKey s >>= \case Just k -> do absf <- inRepo $ \r -> absPath $ fromTopFilePath f r linktarget <- calcRepo $ gitannexlink absf k Just . TreeItem f (fromTreeItemType TreeSymlink) - <$> hashSymlink linktarget + <$> hashSymlink (fromOsPath linktarget) Nothing -> return (Just ti) -- This is a hidden branch ref, that's used as the basis for the AdjBranch, @@ -269,7 +269,7 @@ updateAdjustedBranch adj (AdjBranch currbranch) origbranch -- origbranch. _ <- propigateAdjustedCommits' True origbranch adj commitlck - origheadfile <- inRepo $ F.readFile' . toOsPath . Git.Ref.headFile + origheadfile <- inRepo $ F.readFile' . Git.Ref.headFile origheadsha <- inRepo (Git.Ref.sha currbranch) b <- adjustBranch adj origbranch @@ -282,7 +282,7 @@ updateAdjustedBranch adj (AdjBranch currbranch) origbranch Just s -> do inRepo $ \r -> do let newheadfile = fromRef' s - F.writeFile' (toOsPath (Git.Ref.headFile r)) newheadfile + F.writeFile' (Git.Ref.headFile r) newheadfile return (Just newheadfile) _ -> return Nothing @@ -296,9 +296,9 @@ updateAdjustedBranch adj (AdjBranch currbranch) origbranch unless ok $ case newheadfile of Nothing -> noop Just v -> preventCommits $ \_commitlck -> inRepo $ \r -> do - v' <- F.readFile' (toOsPath (Git.Ref.headFile r)) + v' <- F.readFile' (Git.Ref.headFile r) when (v == v') $ - F.writeFile' (toOsPath (Git.Ref.headFile r)) origheadfile + F.writeFile' (Git.Ref.headFile r) origheadfile return ok | otherwise = preventCommits $ \commitlck -> do @@ -451,7 +451,7 @@ preventCommits = bracket setup cleanup where setup = do lck <- fromRepo $ indexFileLock . indexFile - liftIO $ Git.LockFile.openLock (fromRawFilePath lck) + liftIO $ Git.LockFile.openLock lck cleanup = liftIO . Git.LockFile.closeLock {- Commits a given adjusted tree, with the provided parent ref. @@ -631,7 +631,7 @@ reverseAdjustedTree basis adj csha = do where m = M.fromList $ map (\i@(TreeItem f' _ _) -> (norm f', i)) $ map diffTreeToTreeItem changes - norm = normalise . fromRawFilePath . getTopFilePath + norm = normalise . getTopFilePath diffTreeToTreeItem :: Git.DiffTree.DiffTreeItem -> TreeItem diffTreeToTreeItem dti = TreeItem diff --git a/Annex/Content.hs b/Annex/Content.hs index 3f26c0f0a8..42f33a64fd 100644 --- a/Annex/Content.hs +++ b/Annex/Content.hs @@ -110,7 +110,6 @@ import Utility.FileMode import qualified Utility.RawFilePath as R import qualified Utility.FileIO as F -import qualified System.FilePath.ByteString as P import System.PosixCompat.Files (isSymbolicLink, linkCount) import Data.Time.Clock.POSIX @@ -248,7 +247,7 @@ lockContentForRemoval key fallback a = lockContentUsing lock key fallback $ {- Passed the object content file, and maybe a separate lock file to use, - when the content file itself should not be locked. -} type ContentLocker - = RawFilePath + = OsPath -> Maybe LockFile -> ( Annex (Maybe LockHandle) @@ -260,7 +259,7 @@ type ContentLocker -- and prior to deleting the lock file, in order to -- ensure that no other processes also have a shared lock. #else - , Maybe (RawFilePath -> Annex ()) + , Maybe (OsPath -> Annex ()) -- ^ On Windows, this is called after the lock is dropped, -- but before the lock file is cleaned up. #endif @@ -278,7 +277,7 @@ winLocker takelock _ (Just lockfile) = let lck = do modifyContentDir lockfile $ void $ liftIO $ tryIO $ - writeFile (fromRawFilePath lockfile) "" + writeFile (fromOsPath lockfile) "" liftIO $ takelock lockfile in (lck, Nothing) -- never reached; windows always uses a separate lock file @@ -371,13 +370,13 @@ lockContentUsing contentlocker key fallback a = withContentLockFile key $ \mlock cleanuplockfile lockfile = void $ tryNonAsync $ do thawContentDir lockfile - liftIO $ removeWhenExistsWith R.removeLink lockfile + liftIO $ removeWhenExistsWith R.removeLink $ fromOsPath lockfile cleanObjectDirs lockfile {- Runs an action, passing it the temp file to get, - and if the action succeeds, verifies the file matches - the key and moves the file into the annex as a key's content. -} -getViaTmp :: RetrievalSecurityPolicy -> VerifyConfig -> Key -> AssociatedFile -> Maybe FileSize -> (RawFilePath -> Annex (Bool, Verification)) -> Annex Bool +getViaTmp :: RetrievalSecurityPolicy -> VerifyConfig -> Key -> AssociatedFile -> Maybe FileSize -> (OsPath -> Annex (Bool, Verification)) -> Annex Bool getViaTmp rsp v key af sz action = checkDiskSpaceToGet key sz False $ getViaTmpFromDisk rsp v key af action @@ -385,10 +384,10 @@ getViaTmp rsp v key af sz action = {- Like getViaTmp, but does not check that there is enough disk space - for the incoming key. For use when the key content is already on disk - and not being copied into place. -} -getViaTmpFromDisk :: RetrievalSecurityPolicy -> VerifyConfig -> Key -> AssociatedFile -> (RawFilePath -> Annex (Bool, Verification)) -> Annex Bool +getViaTmpFromDisk :: RetrievalSecurityPolicy -> VerifyConfig -> Key -> AssociatedFile -> (OsPath -> Annex (Bool, Verification)) -> Annex Bool getViaTmpFromDisk rsp v key af action = checkallowed $ do tmpfile <- prepTmp key - resuming <- liftIO $ R.doesPathExist tmpfile + resuming <- liftIO $ R.doesPathExist $ fromOsPath tmpfile (ok, verification) <- action tmpfile -- When the temp file already had content, we don't know if -- that content is good or not, so only trust if it the action @@ -434,11 +433,11 @@ getViaTmpFromDisk rsp v key af action = checkallowed $ do - left off, and so if the bad content were not deleted, repeated downloads - would continue to fail. -} -verificationOfContentFailed :: RawFilePath -> Annex () +verificationOfContentFailed :: OsPath -> Annex () verificationOfContentFailed tmpfile = do warning "Verification of content failed" pruneTmpWorkDirBefore tmpfile - (liftIO . removeWhenExistsWith R.removeLink) + (liftIO . removeWhenExistsWith R.removeLink . fromOsPath) {- Checks if there is enough free disk space to download a key - to its temp file. @@ -451,7 +450,7 @@ verificationOfContentFailed tmpfile = do checkDiskSpaceToGet :: Key -> Maybe FileSize -> a -> Annex a -> Annex a checkDiskSpaceToGet key sz unabletoget getkey = do tmp <- fromRepo (gitAnnexTmpObjectLocation key) - e <- liftIO $ doesFileExist (fromRawFilePath tmp) + e <- liftIO $ doesFileExist tmp alreadythere <- liftIO $ if e then getFileSize tmp else return 0 @@ -463,7 +462,7 @@ checkDiskSpaceToGet key sz unabletoget getkey = do , return unabletoget ) -prepTmp :: Key -> Annex RawFilePath +prepTmp :: Key -> Annex OsPath prepTmp key = do tmp <- fromRepo $ gitAnnexTmpObjectLocation key createAnnexDirectory (parentDir tmp) @@ -473,11 +472,11 @@ prepTmp key = do - the temp file. If the action throws an exception, the temp file is - left behind, which allows for resuming. -} -withTmp :: Key -> (RawFilePath -> Annex a) -> Annex a +withTmp :: Key -> (OsPath -> Annex a) -> Annex a withTmp key action = do tmp <- prepTmp key res <- action tmp - pruneTmpWorkDirBefore tmp (liftIO . removeWhenExistsWith R.removeLink) + pruneTmpWorkDirBefore tmp (liftIO . removeWhenExistsWith R.removeLink . fromOsPath) return res {- Moves a key's content into .git/annex/objects/ @@ -508,7 +507,7 @@ withTmp key action = do - accepted into the repository. Will display a warning message in this - case. May also throw exceptions in some cases. -} -moveAnnex :: Key -> AssociatedFile -> RawFilePath -> Annex Bool +moveAnnex :: Key -> AssociatedFile -> OsPath -> Annex Bool moveAnnex key af src = ifM (checkSecureHashes' key) ( do #ifdef mingw32_HOST_OS @@ -522,7 +521,7 @@ moveAnnex key af src = ifM (checkSecureHashes' key) , return False ) where - storeobject dest = ifM (liftIO $ R.doesPathExist dest) + storeobject dest = ifM (liftIO $ R.doesPathExist $ fromOsPath dest) ( alreadyhave , adjustedBranchRefresh af $ modifyContentDir dest $ do liftIO $ moveFile src dest @@ -540,7 +539,7 @@ moveAnnex key af src = ifM (checkSecureHashes' key) Database.Keys.addInodeCaches key (catMaybes (destic:ics)) ) - alreadyhave = liftIO $ R.removeLink src + alreadyhave = liftIO $ R.removeLink $ fromOsPath src checkSecureHashes :: Key -> Annex (Maybe String) checkSecureHashes key = ifM (Backend.isCryptographicallySecureKey key) @@ -563,7 +562,7 @@ data LinkAnnexResult = LinkAnnexOk | LinkAnnexFailed | LinkAnnexNoop {- Populates the annex object file by hard linking or copying a source - file to it. -} -linkToAnnex :: Key -> RawFilePath -> Maybe InodeCache -> Annex LinkAnnexResult +linkToAnnex :: Key -> OsPath -> Maybe InodeCache -> Annex LinkAnnexResult linkToAnnex key src srcic = ifM (checkSecureHashes' key) ( do dest <- calcRepo (gitAnnexLocation key) @@ -580,13 +579,13 @@ linkToAnnex key src srcic = ifM (checkSecureHashes' key) - afterwards. Note that a consequence of this is that, if the file - already exists, it will be overwritten. -} -linkFromAnnex :: Key -> RawFilePath -> Maybe FileMode -> Annex LinkAnnexResult +linkFromAnnex :: Key -> OsPath -> Maybe FileMode -> Annex LinkAnnexResult linkFromAnnex key dest destmode = replaceFile' (const noop) dest (== LinkAnnexOk) $ \tmp -> linkFromAnnex' key tmp destmode {- This is only safe to use when dest is not a worktree file. -} -linkFromAnnex' :: Key -> RawFilePath -> Maybe FileMode -> Annex LinkAnnexResult +linkFromAnnex' :: Key -> OsPath -> Maybe FileMode -> Annex LinkAnnexResult linkFromAnnex' key dest destmode = do src <- calcRepo (gitAnnexLocation key) srcic <- withTSDelta (liftIO . genInodeCache src) @@ -606,7 +605,7 @@ data FromTo = From | To - - Nothing is done if the destination file already exists. -} -linkAnnex :: FromTo -> Key -> RawFilePath -> Maybe InodeCache -> RawFilePath -> Maybe FileMode -> Annex LinkAnnexResult +linkAnnex :: FromTo -> Key -> OsPath -> Maybe InodeCache -> OsPath -> Maybe FileMode -> Annex LinkAnnexResult linkAnnex _ _ _ Nothing _ _ = return LinkAnnexFailed linkAnnex fromto key src (Just srcic) dest destmode = withTSDelta (liftIO . genInodeCache dest) >>= \case @@ -636,7 +635,7 @@ linkAnnex fromto key src (Just srcic) dest destmode = catMaybes [destic, Just srcic] return LinkAnnexOk _ -> do - liftIO $ removeWhenExistsWith R.removeLink dest + liftIO $ removeWhenExistsWith R.removeLink $ fromOsPath dest failed {- Removes the annex object file for a key. Lowlevel. -} @@ -645,7 +644,7 @@ unlinkAnnex key = do obj <- calcRepo (gitAnnexLocation key) modifyContentDir obj $ do secureErase obj - liftIO $ removeWhenExistsWith R.removeLink obj + liftIO $ removeWhenExistsWith R.removeLink $ fromOsPath obj {- Runs an action to transfer an object's content. The action is also - passed the size of the object. @@ -680,7 +679,7 @@ sendAnnex key o rollback sendobject = go =<< prepSendAnnex' key o prepSendAnnex :: Key -> Maybe FilePath -> Annex (Maybe (FilePath, FileSize, Annex Bool)) prepSendAnnex key Nothing = withObjectLoc key $ \f -> do let retval c cs = return $ Just - ( fromRawFilePath f + ( fromOsPath f , inodeCacheFileSize c , sameInodeCache f cs ) @@ -705,7 +704,7 @@ prepSendAnnex key Nothing = withObjectLoc key $ \f -> do Nothing -> return Nothing -- If the provided object file is the annex object file, handle as above. prepSendAnnex key (Just o) = withObjectLoc key $ \aof -> - let o' = toRawFilePath o + let o' = toOsPath o in if aof == o' then prepSendAnnex key Nothing else do @@ -751,7 +750,7 @@ cleanObjectLoc key cleaner = do - - Does nothing if the object directory is not empty, and does not - throw an exception if it's unable to remove a directory. -} -cleanObjectDirs :: RawFilePath -> Annex () +cleanObjectDirs :: OsPath -> Annex () cleanObjectDirs f = do HashLevels n <- objectHashLevels <$> Annex.getGitConfig liftIO $ go f (succ n) @@ -761,14 +760,14 @@ cleanObjectDirs f = do let dir = parentDir file maybe noop (const $ go dir (n-1)) <=< catchMaybeIO $ tryWhenExists $ - removeDirectory (fromRawFilePath dir) + removeDirectory dir {- Removes a key's file from .git/annex/objects/ -} removeAnnex :: ContentRemovalLock -> Annex () removeAnnex (ContentRemovalLock key) = withObjectLoc key $ \file -> cleanObjectLoc key $ do secureErase file - liftIO $ removeWhenExistsWith R.removeLink file + liftIO $ removeWhenExistsWith R.removeLink $ fromOsPath file g <- Annex.gitRepo mapM_ (\f -> void $ tryIO $ resetpointer $ fromTopFilePath f g) =<< Database.Keys.getAssociatedFiles key @@ -776,7 +775,7 @@ removeAnnex (ContentRemovalLock key) = withObjectLoc key $ \file -> where -- Check associated pointer file for modifications, and reset if -- it's unmodified. - resetpointer file = unlessM (liftIO $ isSymbolicLink <$> R.getSymbolicLinkStatus file) $ + resetpointer file = unlessM (liftIO $ isSymbolicLink <$> R.getSymbolicLinkStatus (fromOsPath file)) $ ifM (isUnmodified key file) ( adjustedBranchRefresh (AssociatedFile (Just file)) $ depopulatePointerFile key file @@ -789,11 +788,11 @@ removeAnnex (ContentRemovalLock key) = withObjectLoc key $ \file -> {- Moves a key out of .git/annex/objects/ into .git/annex/bad, and - returns the file it was moved to. -} -moveBad :: Key -> Annex RawFilePath +moveBad :: Key -> Annex OsPath moveBad key = do src <- calcRepo (gitAnnexLocation key) bad <- fromRepo gitAnnexBadDir - let dest = bad P. P.takeFileName src + let dest = bad takeFileName src createAnnexDirectory (parentDir dest) cleanObjectLoc key $ liftIO $ moveFile src dest @@ -826,7 +825,7 @@ listKeys' keyloc want = do then do contents' <- filterM present contents keys <- filterM (Annex.eval s . want) $ - mapMaybe (fileKey . P.takeFileName) contents' + mapMaybe (fileKey . takeFileName) contents' continue keys [] else do let deeper = walk s (depth - 1) @@ -844,8 +843,8 @@ listKeys' keyloc want = do present _ | inanywhere = pure True present d = presentInAnnex d - presentInAnnex = R.doesPathExist . contentfile - contentfile d = d P. P.takeFileName d + presentInAnnex = R.doesPathExist . fromOsPath . contentfile + contentfile d = d takeFileName d {- Things to do to record changes to content when shutting down. - @@ -868,11 +867,11 @@ saveState nocommit = doSideAction $ do - Otherwise, only displays one error message, from one of the urls - that failed. -} -downloadUrl :: Bool -> Key -> MeterUpdate -> Maybe IncrementalVerifier -> [Url.URLString] -> FilePath -> Url.UrlOptions -> Annex Bool +downloadUrl :: Bool -> Key -> MeterUpdate -> Maybe IncrementalVerifier -> [Url.URLString] -> OsPath -> Url.UrlOptions -> Annex Bool downloadUrl listfailedurls k p iv urls file uo = -- Poll the file to handle configurations where an external -- download command is used. - meteredFile (toRawFilePath file) (Just p) k (go urls []) + meteredFile file (Just p) k (go urls []) where go (u:us) errs p' = Url.download' p' iv u file uo >>= \case Right () -> return True @@ -898,18 +897,18 @@ downloadUrl listfailedurls k p iv urls file uo = {- Copies a key's content, when present, to a temp file. - This is used to speed up some rsyncs. -} -preseedTmp :: Key -> FilePath -> Annex Bool +preseedTmp :: Key -> OsPath -> Annex Bool preseedTmp key file = go =<< inAnnex key where go False = return False go True = do ok <- copy - when ok $ thawContent (toRawFilePath file) + when ok $ thawContent file return ok copy = ifM (liftIO $ doesFileExist file) ( return True , do - s <- fromRawFilePath <$> (calcRepo $ gitAnnexLocation key) + s <- calcRepo $ gitAnnexLocation key liftIO $ ifM (doesFileExist s) ( copyFileExternal CopyTimeStamps s file , return False @@ -918,15 +917,15 @@ preseedTmp key file = go =<< inAnnex key {- Finds files directly inside a directory like gitAnnexBadDir - (not in subdirectories) and returns the corresponding keys. -} -dirKeys :: (Git.Repo -> RawFilePath) -> Annex [Key] +dirKeys :: (Git.Repo -> OsPath) -> Annex [Key] dirKeys dirspec = do - dir <- fromRawFilePath <$> fromRepo dirspec + dir <- fromRepo dirspec ifM (liftIO $ doesDirectoryExist dir) ( do contents <- liftIO $ getDirectoryContents dir files <- liftIO $ filterM doesFileExist $ map (dir ) contents - return $ mapMaybe (fileKey . P.takeFileName . toRawFilePath) files + return $ mapMaybe (fileKey . takeFileName) files , return [] ) @@ -936,7 +935,7 @@ dirKeys dirspec = do - Also, stale keys that can be proven to have no value - (ie, their content is already present) are deleted. -} -staleKeysPrune :: (Git.Repo -> RawFilePath) -> Bool -> Annex [Key] +staleKeysPrune :: (Git.Repo -> OsPath) -> Bool -> Annex [Key] staleKeysPrune dirspec nottransferred = do contents <- dirKeys dirspec @@ -945,8 +944,8 @@ staleKeysPrune dirspec nottransferred = do dir <- fromRepo dirspec forM_ dups $ \k -> - pruneTmpWorkDirBefore (dir P. keyFile k) - (liftIO . R.removeLink) + pruneTmpWorkDirBefore (dir keyFile k) + (liftIO . R.removeLink . fromOsPath) if nottransferred then do @@ -961,9 +960,9 @@ staleKeysPrune dirspec nottransferred = do - This preserves the invariant that the workdir never exists without - the content file. -} -pruneTmpWorkDirBefore :: RawFilePath -> (RawFilePath -> Annex a) -> Annex a +pruneTmpWorkDirBefore :: OsPath -> (OsPath -> Annex a) -> Annex a pruneTmpWorkDirBefore f action = do - let workdir = fromRawFilePath $ gitAnnexTmpWorkDir f + let workdir = gitAnnexTmpWorkDir f liftIO $ whenM (doesDirectoryExist workdir) $ removeDirectoryRecursive workdir action f @@ -978,22 +977,21 @@ pruneTmpWorkDirBefore f action = do - the temporary work directory is retained (unless - empty), so anything in it can be used on resume. -} -withTmpWorkDir :: Key -> (RawFilePath -> Annex (Maybe a)) -> Annex (Maybe a) +withTmpWorkDir :: Key -> (OsPath -> Annex (Maybe a)) -> Annex (Maybe a) withTmpWorkDir key action = do -- Create the object file if it does not exist. This way, -- staleKeysPrune only has to look for object files, and can -- clean up gitAnnexTmpWorkDir for those it finds. obj <- prepTmp key - let obj' = fromRawFilePath obj - unlessM (liftIO $ doesFileExist obj') $ do - liftIO $ writeFile obj' "" + unlessM (liftIO $ doesFileExist obj) $ do + liftIO $ writeFile (fromOsPath obj) "" setAnnexFilePerm obj let tmpdir = gitAnnexTmpWorkDir obj createAnnexDirectory tmpdir res <- action tmpdir case res of - Just _ -> liftIO $ removeDirectoryRecursive (fromRawFilePath tmpdir) - Nothing -> liftIO $ void $ tryIO $ removeDirectory (fromRawFilePath tmpdir) + Just _ -> liftIO $ removeDirectoryRecursive tmpdir + Nothing -> liftIO $ void $ tryIO $ removeDirectory tmpdir return res {- Finds items in the first, smaller list, that are not @@ -1028,12 +1026,12 @@ getKeyStatus :: Key -> Annex KeyStatus getKeyStatus key = catchDefaultIO KeyMissing $ do afs <- not . null <$> Database.Keys.getAssociatedFiles key obj <- calcRepo (gitAnnexLocation key) - multilink <- ((> 1) . linkCount <$> liftIO (R.getFileStatus obj)) + multilink <- ((> 1) . linkCount <$> liftIO (R.getFileStatus (fromOsPath obj))) return $ if multilink && afs then KeyUnlockedThin else KeyPresent -getKeyFileStatus :: Key -> RawFilePath -> Annex KeyStatus +getKeyFileStatus :: Key -> OsPath -> Annex KeyStatus getKeyFileStatus key file = do s <- getKeyStatus key case s of @@ -1071,23 +1069,22 @@ contentSize key = catchDefaultIO Nothing $ - timestamp. The file is written atomically, so when it contained an - earlier timestamp, a reader will always see one or the other timestamp. -} -writeContentRetentionTimestamp :: Key -> RawFilePath -> POSIXTime -> Annex () +writeContentRetentionTimestamp :: Key -> OsPath -> POSIXTime -> Annex () writeContentRetentionTimestamp key rt t = do lckfile <- calcRepo (gitAnnexContentRetentionTimestampLock key) modifyContentDirWhenExists lckfile $ bracket (lock lckfile) unlock $ \_ -> readContentRetentionTimestamp rt >>= \case Just ts | ts >= t -> return () _ -> replaceFile (const noop) rt $ \tmp -> - liftIO $ writeFile (fromRawFilePath tmp) $ show t + liftIO $ writeFile (fromOsPath tmp) $ show t where lock = takeExclusiveLock unlock = liftIO . dropLock {- Does not need locking because the file is written atomically. -} -readContentRetentionTimestamp :: RawFilePath -> Annex (Maybe POSIXTime) +readContentRetentionTimestamp :: OsPath -> Annex (Maybe POSIXTime) readContentRetentionTimestamp rt = - liftIO $ join <$> tryWhenExists - (parsePOSIXTime <$> F.readFile' (toOsPath rt)) + liftIO $ join <$> tryWhenExists (parsePOSIXTime <$> F.readFile' rt) {- Checks if the retention timestamp is in the future, if so returns - Nothing. @@ -1118,8 +1115,8 @@ checkRetentionTimestamp key locker = do {- Remove the retention timestamp and its lock file. Another lock must - be held, that prevents anything else writing to the file at the same - time. -} -removeRetentionTimeStamp :: Key -> RawFilePath -> Annex () +removeRetentionTimeStamp :: Key -> OsPath -> Annex () removeRetentionTimeStamp key rt = modifyContentDirWhenExists rt $ do - liftIO $ removeWhenExistsWith R.removeLink rt + liftIO $ removeWhenExistsWith R.removeLink $ fromOsPath rt rtl <- calcRepo (gitAnnexContentRetentionTimestampLock key) - liftIO $ removeWhenExistsWith R.removeLink rtl + liftIO $ removeWhenExistsWith R.removeLink $ fromOsPath rtl