git-annex/Logs/Restage.hs

{- git-annex restage log file
 -
 - Copyright 2022 Joey Hess <id@joeyh.name>
 -
 - Licensed under the GNU AGPL version 3 or higher.
 -}

{-# LANGUAGE OverloadedStrings #-}

module Logs.Restage where

import Annex.Common
import Git.FilePath
import Logs.File
import Utility.InodeCache
import Annex.LockFile

import qualified Data.ByteString as S
import qualified Data.ByteString.Lazy as L
import qualified Utility.RawFilePath as R

-- | Log a file whose pointer needs to be restaged in git.
-- The content of the file may not be a pointer, if it is populated with
-- the annex content. The InodeCache is used to verify that the file
-- still contains the content, and it's still safe to restage its pointer.
writeRestageLog :: TopFilePath -> InodeCache -> Annex ()
writeRestageLog f ic = do
	logf <- fromRepo gitAnnexRestageLog
	lckf <- fromRepo gitAnnexRestageLock
	appendLogFile logf lckf $ L.fromStrict $ formatRestageLog f ic

-- | Streams the content of the restage log.
--
-- First, the content of the log file is moved to the restage.old file.
-- If that file already exists, the content is appended, otherwise it's
-- renamed to that.
--
-- The log file is kept locked during that, but the lock is then
-- released. The processor may do something that itself needs to take the
-- lock, so it's important that the lock not be held while running it.
--
-- The content of restage.old file is then streamed to the processor, 
-- and then the finalizer is run, ending with emptying restage.old.
--
-- If the processor or finalizer is interrupted or throws an exception,
-- restage.old is left populated to be processed later.
streamRestageLog :: Annex () -> (TopFilePath -> InodeCache -> Annex ()) -> Annex ()
streamRestageLog finalizer processor = do
	logf <- fromRepo gitAnnexRestageLog
	oldf <- fromRepo gitAnnexRestageLogOld
	let oldf' = fromRawFilePath oldf
	lckf <- fromRepo gitAnnexRestageLock
	
	withExclusiveLock lckf $ liftIO $
		whenM (R.doesPathExist logf) $
			ifM (R.doesPathExist oldf)
				( do
					h <- openFile oldf' AppendMode
					hPutStr h =<< readFile (fromRawFilePath logf)
					hClose h
					liftIO $ removeWhenExistsWith R.removeLink logf
				, moveFile logf oldf
				)

	streamLogFileUnsafe oldf' finalizer $ \l -> 
		case parseRestageLog l of
			Just (f, ic) -> processor f ic
			Nothing -> noop
	
	liftIO $ removeWhenExistsWith R.removeLink oldf

-- | Calculate over both the current restage log, and also over the old
-- one if it had started to be processed but did not get finished due
-- to an interruption.
calcRestageLog :: t -> ((TopFilePath, InodeCache) -> t -> t) -> Annex t
calcRestageLog start update = do
	logf <- fromRepo gitAnnexRestageLog
	oldf <- fromRepo gitAnnexRestageLogOld
	lckf <- fromRepo gitAnnexRestageLock
	withSharedLock lckf $ do
		mid <- calcLogFileUnsafe logf start process
		calcLogFileUnsafe oldf mid process
  where
	process l v = case parseRestageLog (decodeBL l) of
		Just pl -> update pl v
		Nothing -> v

formatRestageLog :: TopFilePath -> InodeCache -> S.ByteString
formatRestageLog f ic = encodeBS (showInodeCache ic) <> ":" <> getTopFilePath f

parseRestageLog :: String -> Maybe (TopFilePath, InodeCache)
parseRestageLog l = 
	let (ics, f) = separate (== ':') l
	in do
		ic <- readInodeCache ics
		return (asTopFilePath (toRawFilePath f), ic)