support invalidating existing VerifiedCopys

3 files changed, 63 insertions, 17 deletions

diff --git a/Types/NumCopies.hs b/Types/NumCopies.hs
index 732c928d2..0acb7cc3b 100644
--- a/Types/NumCopies.hs
+++ b/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
+	
+toV :: VerifiedCopy -> V
+toV (TrustedCopy v) = v
+toV (RecentlyVerifiedCopy v) = v
+toV (VerifiedCopyLock v) = v
 
-instance Show VerifiedCopy where
-	show (TrustedCopy u) = "TrustedCopy " ++ show u
-	show (VerifiedCopy u) = "VerifiedCopy " ++ show u
-	show (VerifiedCopyLock u _) = "VerifiedCopyLock " ++ show u
+-- 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
diff --git a/Types/Remote.hs b/Types/Remote.hs
index 1bf79a81e..9e5f9f735 100644
--- a/Types/Remote.hs
+++ b/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
diff --git a/Types/UUID.hs b/Types/UUID.hs
index 27d82b86c..4212eaa7f 100644
--- a/Types/UUID.hs
+++ b/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