support invalidating existing VerifiedCopys

Annex/Content.hs

@@ -183,7 +183,10 @@ contentLockFile key = Just <$> calcRepo (gitAnnexContentLock key)
 lockContentShared :: Key -> (VerifiedCopy -> Annex a) -> Annex a
 lockContentShared key a = lockContentUsing lock key $ do
 	u <- getUUID
-	a (VerifiedCopyLock u (return ()))
+	bracketIO 
+		(invalidatableVerifiedCopy VerifiedCopyLock u) 
+		invalidateVerifiedCopy
+		a
   where
 #ifndef mingw32_HOST_OS
 	lock contentfile Nothing = liftIO $ tryLockShared Nothing contentfile

Annex/NumCopies.hs

@@ -113,7 +113,7 @@ verifyEnoughCopies nolocmsg key need skip preverified tocheck =
 		| otherwise = do
 			haskey <- Remote.hasKey r key
 			case haskey of
-				Right True  -> helper bad missing (VerifiedCopy u:have) rs
+				Right True  -> helper bad missing (mkVerifiedCopy RecentlyVerifiedCopy u : have) rs
 				Left _      -> helper (r:bad) missing have rs
 				Right False -> helper bad (u:missing) have rs
 	   where

Assistant/TransferSlots.hs

@@ -161,7 +161,7 @@ genTransfer t info = case transferRemote info of
 					("object uploaded to " ++ show remote)
 					True (transferKey t)
 					(associatedFile info)
-					[VerifiedCopy (Remote.uuid remote)]
+					[mkVerifiedCopy RecentlyVerifiedCopy remote]
 			void recordCommit
 		, whenM (liftAnnex $ isNothing <$> checkTransfer t) $
 			void $ removeTransfer t

Command/Drop.hs

@@ -95,7 +95,7 @@ startRemote afile numcopies key remote = do
 performLocal :: Key -> AssociatedFile -> NumCopies -> [VerifiedCopy] -> CommandPerform
 performLocal key afile numcopies preverified = lockContentExclusive key $ \contentlock -> do
 	(remotes, trusteduuids) <- Remote.keyPossibilitiesTrusted key
-	let preverified' = preverified ++ map TrustedCopy trusteduuids
+	let preverified' = preverified ++ map (mkVerifiedCopy TrustedCopy) trusteduuids
 	untrusteduuids <- trustGet UnTrusted
 	let tocheck = Remote.remotesWithoutUUID remotes (map toUUID preverified'++untrusteduuids)
 	u <- getUUID
@@ -117,10 +117,11 @@ performRemote key afile numcopies remote = do
 	-- as long as the local repo is not untrusted.
 	(remotes, trusteduuids) <- knownCopies key
 	let trusted = filter (/= uuid) trusteduuids
+	let preverified = map (mkVerifiedCopy TrustedCopy) trusted
 	untrusteduuids <- trustGet UnTrusted
 	let tocheck = filter (/= remote) $
 		Remote.remotesWithoutUUID remotes (trusted++untrusteduuids)
-	stopUnless (canDrop uuid key afile numcopies [uuid] (map TrustedCopy trusted) tocheck) $ do
+	stopUnless (canDrop uuid key afile numcopies [uuid] preverified tocheck) $ do
 		ok <- Remote.removeKey remote key
 		next $ cleanupRemote key remote ok
   where

Command/Import.hs

@@ -143,4 +143,4 @@ verifiedExisting key destfile = do
 	(remotes, trusteduuids) <- knownCopies key
 	untrusteduuids <- trustGet UnTrusted
 	let tocheck = Remote.remotesWithoutUUID remotes (trusteduuids++untrusteduuids)
-	verifyEnoughCopies [] key need [] (map TrustedCopy trusteduuids) tocheck
+	verifyEnoughCopies [] key need [] (map (mkVerifiedCopy TrustedCopy) trusteduuids) tocheck

Types/NumCopies.hs

@@ -5,11 +5,22 @@
  - Licensed under the GNU GPL version 3 or higher.
  -}
 
-module Types.NumCopies where
+module Types.NumCopies (
+	NumCopies(..),
+	fromNumCopies,
+	VerifiedCopy(..),
+	checkVerifiedCopy,
+	invalidateVerifiedCopy,
+	strongestVerifiedCopy,
+	deDupVerifiedCopies,
+	mkVerifiedCopy,
+	invalidatableVerifiedCopy,
+) where
 
 import Types.UUID
 
 import qualified Data.Map as M
+import Control.Concurrent.MVar
 
 newtype NumCopies = NumCopies Int
 	deriving (Ord, Eq)
@@ -17,38 +28,67 @@ newtype NumCopies = NumCopies Int
 fromNumCopies :: NumCopies -> Int
 fromNumCopies (NumCopies n) = n
 
+-- A verification that a copy of a key exists in a repository.
 data VerifiedCopy
 	{- Use when a repository cannot be accessed, but it's
-	 - a trusted repository, which is presumably not going to
-	 - lose a copy. This is the weakest level of verification. -}
-	= TrustedCopy UUID
+	 - a trusted repository, which is on record as containing a key
+	 - and is presumably not going to lose its copy. 
+	 - This is the weakest level of verification. -}
+	= TrustedCopy V
 	{- Represents a recent verification that a copy of an
 	 - object exists in a repository with the given UUID. -}
-	| VerifiedCopy UUID
+	| RecentlyVerifiedCopy V
  	{- The strongest proof of the existence of a copy.
 	 - Until its associated action is called to unlock it,
 	 - the copy is locked in the repository and is guaranteed
 	 - not to be dropped by any git-annex process. -}
-	| VerifiedCopyLock UUID (IO ())
+	| VerifiedCopyLock V
+	deriving (Show)
 
 instance ToUUID VerifiedCopy where
-	toUUID (VerifiedCopy u) = u
-	toUUID (VerifiedCopyLock u _) = u
-	toUUID (TrustedCopy u) = u
+	toUUID = _getUUID . toV
 	
-instance Show VerifiedCopy where
-	show (TrustedCopy u) = "TrustedCopy " ++ show u
-	show (VerifiedCopy u) = "VerifiedCopy " ++ show u
-	show (VerifiedCopyLock u _) = "VerifiedCopyLock " ++ show u
+toV :: VerifiedCopy -> V
+toV (TrustedCopy v) = v
+toV (RecentlyVerifiedCopy v) = v
+toV (VerifiedCopyLock v) = v
+
+-- Checks that it's still valid.
+checkVerifiedCopy :: VerifiedCopy -> IO Bool
+checkVerifiedCopy = _checkVerifiedCopy . toV
+
+invalidateVerifiedCopy :: VerifiedCopy -> IO ()
+invalidateVerifiedCopy = _invalidateVerifiedCopy . toV
+
+data V = V
+	{ _getUUID :: UUID
+	, _checkVerifiedCopy :: IO Bool
+	, _invalidateVerifiedCopy :: IO ()
+	}
+
+instance Show V where
+	show v = show (_getUUID v)
 
 strongestVerifiedCopy :: VerifiedCopy -> VerifiedCopy -> VerifiedCopy
-strongestVerifiedCopy a@(VerifiedCopyLock _ _) _ = a
-strongestVerifiedCopy _ b@(VerifiedCopyLock _ _) = b
-strongestVerifiedCopy a@(VerifiedCopy _) _ = a
-strongestVerifiedCopy _ b@(VerifiedCopy _) = b
+strongestVerifiedCopy a@(VerifiedCopyLock _) _ = a
+strongestVerifiedCopy _ b@(VerifiedCopyLock _) = b
+strongestVerifiedCopy a@(RecentlyVerifiedCopy _) _ = a
+strongestVerifiedCopy _ b@(RecentlyVerifiedCopy _) = b
 strongestVerifiedCopy a@(TrustedCopy _) _  = a
 
 -- Retains stronger verifications over weaker for the same uuid.
 deDupVerifiedCopies :: [VerifiedCopy] -> [VerifiedCopy]
 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 ())
+
+invalidatableVerifiedCopy :: ToUUID u => (V -> VerifiedCopy) -> u -> IO VerifiedCopy
+invalidatableVerifiedCopy mk u = do
+	v <- newEmptyMVar
+	let invalidate = do
+		_ <- tryPutMVar v ()
+		return ()
+	let check = isEmptyMVar v
+	return $ mk $ V (toUUID u) check invalidate

Types/Remote.hs

@@ -131,6 +131,9 @@ instance Eq (RemoteA a) where
 instance Ord (RemoteA a) where
 	compare = comparing uuid
 
+instance ToUUID (RemoteA a) where
+	toUUID = uuid
+
 -- Use Verified when the content of a key is verified as part of a
 -- transfer, and so a separate verification step is not needed.
 data Verification = UnVerified | Verified

Types/UUID.hs

@@ -24,6 +24,9 @@ fromUUID NoUUID = ""
 class ToUUID a where
 	toUUID :: a -> UUID
 
+instance ToUUID UUID where
+	toUUID = id
+
 instance ToUUID String where
 	toUUID [] = NoUUID
 	toUUID s = UUID s