toward SafeDropProof expiry checking

Added Maybe POSIXTime to SafeDropProof, which gets set when the proof is
based on a LockedCopy. If there are several LockedCopies, it uses the
closest expiry time. That is not optimal, it may be that the proof
expires based on one LockedCopy but another one has not expired. But
that seems unlikely to really happen, and anyway the user can just
re-run a drop if it fails due to expiry.

Pass the SafeDropProof to removeKey, which is responsible for checking
it for expiry in situations where that could be a problem. Which really
only means in Remote.Git.

Made Remote.Git check expiry when dropping from a local remote.

Checking expiry when dropping from a P2P remote is not yet implemented.
P2P.Protocol.remove has SafeDropProof plumbed through to it for that
purpose.

Fixing the remaining 2 build warnings should complete this work.

Note that the use of a POSIXTime here means that if the clock gets set
forward while git-annex is in the middle of a drop, it may say that
dropping took too long. That seems ok. Less ok is that if the clock gets
turned back a sufficient amount (eg 5 minutes), proof expiry won't be
noticed. It might be better to use the Monotonic clock, but that doesn't
advance when a laptop is suspended, and while there is the linux
Boottime clock, that is not available on other systems. Perhaps a
combination of POSIXTime and the Monotonic clock could detect laptop
suspension and also detect clock being turned back?

There is a potential future flag day where
p2pDefaultLockContentRetentionDuration is not assumed, but is probed
using the P2P protocol, and peers that don't support it can no longer
produce a LockedCopy. Until that happens, when git-annex is
communicating with older peers there is a risk of data loss when
a ssh connection closes during LOCKCONTENT.

Types/NumCopies.hs

@@ -1,6 +1,6 @@
 {- git-annex numcopies types
  -
- - Copyright 2014-2022 Joey Hess <id@joeyh.name>
+ - Copyright 2014-2024 Joey Hess <id@joeyh.name>
  -
  - Licensed under the GNU AGPL version 3 or higher.
  -}
@@ -22,20 +22,24 @@ module Types.NumCopies (
 	withVerifiedCopy,
 	isSafeDrop,
 	SafeDropProof,
+	safeDropProofEndTime,
 	mkSafeDropProof,
 	ContentRemovalLock(..),
+	p2pDefaultLockContentRetentionDuration,
 ) where
 
 import Types.UUID
 import Types.Key
 import Utility.Exception (bracketIO)
 import Utility.Monad
+import Utility.HumanTime
 
 import qualified Data.Map as M
+import Data.Either
 import Control.Concurrent.MVar
 import Control.Monad.Catch (MonadMask)
 import Control.Monad.IO.Class (MonadIO)
-import Control.Monad
+import Data.Time.Clock.POSIX (POSIXTime)
 
 newtype NumCopies = NumCopies Int
 	deriving (Ord, Eq, Show)
@@ -77,14 +81,16 @@ data VerifiedCopy
 	| TrustedCopy V
  	{- The strongest proof of the existence of a copy.
 	 - Until its associated action is called to unlock it,
+	 - or connection with a remote repository is lost,
 	 - the copy is locked in the repository and is guaranteed
-	 - not to be removed by any git-annex process. -}
+	 - not to be removed by any git-annex process. Use
+	 - checkVerifiedCopy to detect loss of connection. -}
 	| LockedCopy V
 	deriving (Show)
 
 data V = V
 	{ _getUUID :: UUID
-	, _checkVerifiedCopy :: IO Bool
+	, _checkVerifiedCopy :: IO (Either POSIXTime Bool)
 	, _invalidateVerifiedCopy :: IO ()
 	}
 
@@ -99,8 +105,19 @@ toV (TrustedCopy v) = v
 toV (RecentlyVerifiedCopy v) = v
 toV (LockedCopy v) = v
 
--- Checks that it's still valid.
-checkVerifiedCopy :: VerifiedCopy -> IO Bool
+-- Checks that the VerifiedCopy is still valid.
+--
+-- Invalidation of the VerifiedCopy will make this return False.
+-- 
+-- When the key is being kept locked by a connection to a remote
+-- repository, a detected loss of connection will make this
+-- return False. 
+--
+-- When the connection could possibly break without being detected
+-- immediately, this will return a POSIXTime that is how long the
+-- content is guaranteed to remain locked on the remote even if the
+-- connection has broken.
+checkVerifiedCopy :: VerifiedCopy -> IO (Either POSIXTime Bool)
 checkVerifiedCopy = _checkVerifiedCopy . toV
 
 invalidateVerifiedCopy :: VerifiedCopy -> IO ()
@@ -119,15 +136,18 @@ deDupVerifiedCopies l = M.elems $
 	M.fromListWith strongestVerifiedCopy (zip (map toUUID l) l)
 
 mkVerifiedCopy :: ToUUID u => (V -> VerifiedCopy) -> u -> VerifiedCopy
-mkVerifiedCopy mk u = mk $ V (toUUID u) (return True) (return ())
+mkVerifiedCopy mk u = mk $ V (toUUID u) (return (Right True)) (return ())
 
-invalidatableVerifiedCopy :: ToUUID u => (V -> VerifiedCopy) -> u -> IO Bool -> IO VerifiedCopy
+invalidatableVerifiedCopy :: ToUUID u => (V -> VerifiedCopy) -> u -> IO (Either POSIXTime Bool) -> IO VerifiedCopy
 invalidatableVerifiedCopy mk u check = do
 	v <- newEmptyMVar
 	let invalidate = do
 		_ <- tryPutMVar v ()
 		return ()
-	let check' = isEmptyMVar v <&&> check
+	let check' = ifM (isEmptyMVar v)
+		( check
+		, pure (Right False)
+		)
 	return $ mk $ V (toUUID u) check' invalidate
 
 -- Constructs a VerifiedCopy, and runs the action, ensuring that the
@@ -136,7 +156,7 @@ withVerifiedCopy
 	:: (MonadMask m, MonadIO m, ToUUID u)
 	=> (V -> VerifiedCopy)
 	-> u
-	-> IO Bool
+	-> IO (Either POSIXTime Bool)
 	-> (VerifiedCopy -> m a)
 	-> m a
 withVerifiedCopy mk u check = bracketIO setup cleanup
@@ -155,13 +175,26 @@ withVerifiedCopy mk u check = bracketIO setup cleanup
  - to fall below NumCopies, but it will never fall below MinCopies.
  -}
 isSafeDrop :: NumCopies -> MinCopies -> [VerifiedCopy] -> Maybe ContentRemovalLock -> Bool
+isSafeDrop n m l lck = case safeDropAnalysis n m l lck of
+	UnsafeDrop -> False
+	SafeDrop -> True
+	SafeDropCheckTime -> True
+
+data SafeDropAnalysis
+	= UnsafeDrop
+	| SafeDrop
+	| SafeDropCheckTime
+
+safeDropAnalysis :: NumCopies -> MinCopies -> [VerifiedCopy] -> Maybe ContentRemovalLock -> SafeDropAnalysis
 {- When a ContentRemovalLock is provided, the content is being
  - dropped from the local repo. That lock will prevent other git repos
  - that are concurrently dropping from using the local copy as a VerifiedCopy.
  - So, no additional locking is needed; all we need is verifications
  - of any kind of enough other copies of the content. -}
-isSafeDrop (NumCopies n) (MinCopies m) l (Just (ContentRemovalLock _)) = 
-	length (deDupVerifiedCopies l) >= max n m
+safeDropAnalysis (NumCopies n) (MinCopies m) l (Just (ContentRemovalLock _)) =
+	if length (deDupVerifiedCopies l) >= max n m
+		then SafeDrop
+		else UnsafeDrop
 {- Dropping from a remote repo.
  -
  - To guarantee MinCopies is never violated, at least that many LockedCopy
@@ -174,27 +207,49 @@ isSafeDrop (NumCopies n) (MinCopies m) l (Just (ContentRemovalLock _)) =
  - violated, this is the best that can be done without requiring that 
  - all special remotes support locking.
  -}
-isSafeDrop (NumCopies n) (MinCopies m) l Nothing
-	| n == 0 && m == 0 = True
-	| otherwise = and
-		[ length (deDupVerifiedCopies l) >= n
-		, length (filter fullVerification l) >= m
-		]
+safeDropAnalysis (NumCopies n) (MinCopies m) l Nothing
+	| n == 0 && m == 0 = SafeDrop
+	| length (deDupVerifiedCopies l) >= n 
+		&& length (filter fullVerification l) >= m =
+			SafeDropCheckTime
+	| otherwise = UnsafeDrop
 
 fullVerification :: VerifiedCopy -> Bool
 fullVerification (LockedCopy _) = True
 fullVerification (TrustedCopy _) = True
 fullVerification (RecentlyVerifiedCopy _) = False
 
--- A proof that it's currently safe to drop an object.
-data SafeDropProof = SafeDropProof NumCopies MinCopies [VerifiedCopy] (Maybe ContentRemovalLock)
+-- Content locked using the P2P protocol defaults to being retained,
+-- still locked, for 10 minutes after a connection loss.
+-- 
+-- This is only the case since git-annex 10.20240704, but currently
+-- this is used even for older remotes, to avoid a disruptive behavior
+-- change when used with remotes running an old version of git-annex.
+p2pDefaultLockContentRetentionDuration :: Duration
+p2pDefaultLockContentRetentionDuration = Duration (60*10)
+
+-- A proof that it's safe to drop an object.
+--
+-- It may only be safe up until a given POSIXTime.
+data SafeDropProof = SafeDropProof NumCopies MinCopies [VerifiedCopy] (Maybe POSIXTime) (Maybe ContentRemovalLock)
 	deriving (Show)
 
+safeDropProofEndTime :: SafeDropProof -> Maybe POSIXTime
+safeDropProofEndTime (SafeDropProof _ _ _ t _) = t
+
 -- Makes sure that none of the VerifiedCopies have become invalidated
--- before constructing proof.
+-- before constructing the proof.
 mkSafeDropProof :: NumCopies -> MinCopies -> [VerifiedCopy] -> Maybe ContentRemovalLock -> IO (Either [VerifiedCopy] SafeDropProof)
 mkSafeDropProof need mincopies have removallock = do
-	stillhave <- filterM checkVerifiedCopy have
-	return $ if isSafeDrop need mincopies stillhave removallock
-		then Right (SafeDropProof need mincopies stillhave removallock)
-		else Left stillhave
+	l <- mapM checkVerifiedCopy have
+	let stillhave = map fst $ 
+		filter (either (const True) id . snd) (zip have l)
+	return $ case safeDropAnalysis need mincopies stillhave removallock of
+		SafeDrop -> Right $
+			SafeDropProof need mincopies stillhave Nothing removallock
+		SafeDropCheckTime -> Right $
+			let endtime = case lefts l of
+				[] -> Nothing
+				ts -> Just (minimum ts)
+			in SafeDropProof need mincopies stillhave endtime removallock
+		UnsafeDrop -> Left stillhave

Types/Remote.hs

@@ -2,7 +2,7 @@
  -
  - Most things should not need this, using Types instead
  -
- - Copyright 2011-2021 Joey Hess <id@joeyh.name>
+ - Copyright 2011-2024 Joey Hess <id@joeyh.name>
  -
  - Licensed under the GNU AGPL version 3 or higher.
  -}
@@ -25,6 +25,7 @@ module Types.Remote
 	, ExportActions(..)
 	, ImportActions(..)
 	, ByteSize
+	, SafeDropProof
 	)
 	where
 
@@ -105,8 +106,14 @@ data RemoteA a = Remote
 	, retrievalSecurityPolicy :: RetrievalSecurityPolicy
 	-- Removes a key's contents (succeeds even the contents are not present)
 	-- Can throw exception if unable to access remote, or if remote
-	-- refuses to remove the content.
-	, removeKey :: Key -> a ()
+	-- refuses to remove the content, or if the proof is expired.
+	--
+	-- The proof is verified not to have expired shortly
+	-- before calling this. But, if the remote's lockContent returns
+	-- LockedCopy, the proof's expiry should be checked on the remote,
+	-- so that a delay in communicating with the remote does not
+	-- cause the removal to happen after the proof expires.
+	, removeKey :: Maybe SafeDropProof -> Key -> a ()
 	-- Uses locking to prevent removal of a key's contents,
 	-- thus producing a VerifiedCopy, which is passed to the callback.
 	-- If unable to lock, does not run the callback, and throws an

Types/StoreRetrieve.hs

@@ -10,6 +10,7 @@
 module Types.StoreRetrieve where
 
 import Annex.Common
+import Types.NumCopies
 import Utility.Metered
 import Utility.Hash (IncrementalVerifier)
 
@@ -44,8 +45,9 @@ type Retriever = forall a.
 
 -- Action that removes a Key's content from a remote.
 -- Succeeds if key is already not present.
--- Throws an exception if the remote is not accessible.
-type Remover = Key -> Annex ()
+-- Throws an exception if the remote is not accessible
+-- or the proof has expired.
+type Remover = Maybe SafeDropProof -> Key -> Annex ()
 
 -- Checks if a Key's content is present on a remote.
 -- Throws an exception if the remote is not accessible.