add VerifiedCopy data type

There should be no behavior changes in this commit, it just adds a more
expressive data type and adjusts code that had been passing around a [UUID]
or sometimes a Maybe Remote to instead use [VerifiedCopy].

Although, since some functions were taking two different [UUID] lists,
there's some potential for me to have gotten it horribly wrong.

Annex/Content.hs

@@ -67,6 +67,8 @@ import Messages.Progress
 import qualified Types.Remote
 import qualified Types.Backend
 import qualified Backend
+import Types.NumCopies
+import Annex.UUID
 
 {- Checks if a given key's content is currently present. -}
 inAnnex :: Key -> Annex Bool
@@ -178,8 +180,10 @@ contentLockFile key = Just <$> calcRepo (gitAnnexContentLock key)
  - Note that, in direct mode, nothing prevents the user from directly
  - editing or removing the content, even while it's locked by this.
  -}
-lockContentShared :: Key -> Annex a -> Annex a
-lockContentShared = lockContentUsing lock
+lockContentShared :: Key -> (VerifiedCopy -> Annex a) -> Annex a
+lockContentShared key a = lockContentUsing lock key $ do
+	u <- getUUID
+	a (VerifiedCopyLock u (return ()))
   where
 #ifndef mingw32_HOST_OS
 	lock contentfile Nothing = liftIO $ tryLockShared Nothing contentfile
@@ -195,7 +199,7 @@ newtype ContentLockExclusive = ContentLockExclusive Key
  -}
 lockContentExclusive :: Key -> (ContentLockExclusive -> Annex a) -> Annex a
 lockContentExclusive key a = lockContentUsing lock key $ 
-	a $ ContentLockExclusive key
+	a (ContentLockExclusive key)
   where
 #ifndef mingw32_HOST_OS
 	{- Since content files are stored with the write bit disabled, have
@@ -238,7 +242,7 @@ lockContentUsing locker key a = do
 	bracket
 		(lock contentfile lockfile)
 		(unlock lockfile)
-		(const $ a)
+		(const a)
   where
 	alreadylocked = error "content is locked"
 	failedtolock e = error $ "failed to lock content: " ++ show e

Annex/Drop.hs

@@ -32,9 +32,8 @@ type Reason = String
  - only ones that match the UUIDs will be dropped from.
  - If allowed to drop fromhere, that drop will be tried first.
  -
- - A remote can be specified that is known to have the key. This can be
- - used an an optimisation when eg, a key has just been uploaded to a
- - remote.
+ - A VerifiedCopy can be provided as an optimisation when eg, a key
+ - has just been uploaded to a remote.
  -
  - In direct mode, all associated files are checked, and only if all
  - of them are unwanted are they dropped.
@@ -42,8 +41,8 @@ type Reason = String
  - The runner is used to run commands, and so can be either callCommand
  - or commandAction.
  -}
-handleDropsFrom :: [UUID] -> [Remote] -> Reason -> Bool -> Key -> AssociatedFile -> Maybe Remote -> (CommandStart -> CommandCleanup) -> Annex ()
-handleDropsFrom locs rs reason fromhere key afile knownpresentremote runner = do
+handleDropsFrom :: [UUID] -> [Remote] -> Reason -> Bool -> Key -> AssociatedFile -> [VerifiedCopy] -> (CommandStart -> CommandCleanup) -> Annex ()
+handleDropsFrom locs rs reason fromhere key afile preverified runner = do
 	fs <- ifM isDirect
 		( do
 			l <- associatedFilesRelative key
@@ -112,7 +111,7 @@ handleDropsFrom locs rs reason fromhere key afile knownpresentremote runner = do
 			)
 
 	dropl fs n = checkdrop fs n Nothing $ \numcopies ->
-		Command.Drop.startLocal afile numcopies key knownpresentremote
+		Command.Drop.startLocal afile numcopies key preverified
 
 	dropr fs r n  = checkdrop fs n (Just $ Remote.uuid r) $ \numcopies ->
 		Command.Drop.startRemote afile numcopies key r

Annex/NumCopies.hs

@@ -96,11 +96,11 @@ verifyEnoughCopies
 	-> Key
 	-> NumCopies
 	-> [UUID] -- repos to skip considering (generally untrusted remotes)
-	-> [UUID] -- repos that are trusted or already verified to have it
+	-> [VerifiedCopy] -- already known verifications
 	-> [Remote] -- remotes to check to see if they have it
 	-> Annex Bool
-verifyEnoughCopies nolocmsg key need skip trusted tocheck = 
-	helper [] [] (nub trusted) (nub tocheck)
+verifyEnoughCopies nolocmsg key need skip preverified tocheck = 
+	helper [] [] (deDupVerifiedCopies preverified) (nub tocheck)
   where
 	helper bad missing have []
 		| NumCopies (length have) >= need = return True
@@ -109,17 +109,17 @@ verifyEnoughCopies nolocmsg key need skip trusted tocheck =
 			return False
 	helper bad missing have (r:rs)
 		| NumCopies (length have) >= need = return True
+		| any (== u) (map toUUID have) = helper bad missing have rs
 		| otherwise = do
-			let u = Remote.uuid r
-			let duplicate = u `elem` have
 			haskey <- Remote.hasKey r key
-			case (duplicate, haskey) of
-				(False, Right True)  -> helper bad missing (u:have) rs
-				(False, Left _)      -> helper (r:bad) missing have rs
-				(False, Right False) -> helper bad (u:missing) have rs
-				_                    -> helper bad missing have rs
+			case haskey of
+				Right True  -> helper bad missing (VerifiedCopy u:have) rs
+				Left _      -> helper (r:bad) missing have rs
+				Right False -> helper bad (u:missing) have rs
+	   where
+		u = Remote.uuid r
 
-notEnoughCopies :: Key -> NumCopies -> [UUID] -> [UUID] -> [Remote] -> String -> Annex ()
+notEnoughCopies :: Key -> NumCopies -> [VerifiedCopy] -> [UUID] -> [Remote] -> String -> Annex ()
 notEnoughCopies key need have skip bad nolocmsg = do
 	showNote "unsafe"
 	showLongNote $
@@ -127,7 +127,7 @@ notEnoughCopies key need have skip bad nolocmsg = do
 		show (length have) ++ " out of " ++ show (fromNumCopies need) ++ 
 		" necessary copies"
 	Remote.showTriedRemotes bad
-	Remote.showLocations True key (have++skip) nolocmsg
+	Remote.showLocations True key (map toUUID have++skip) nolocmsg
 
 {- Cost ordered lists of remotes that the location log indicates
  - may have a key.

Assistant/Drop.hs

@@ -15,11 +15,12 @@ import Assistant.DaemonStatus
 import Annex.Drop (handleDropsFrom, Reason)
 import Logs.Location
 import CmdLine.Action
+import Types.NumCopies
 
 {- Drop from local and/or remote when allowed by the preferred content and
  - numcopies settings. -}
-handleDrops :: Reason -> Bool -> Key -> AssociatedFile -> Maybe Remote -> Assistant ()
-handleDrops reason fromhere key f knownpresentremote = do
+handleDrops :: Reason -> Bool -> Key -> AssociatedFile -> [VerifiedCopy] -> Assistant ()
+handleDrops reason fromhere key f preverified = do
 	syncrs <- syncDataRemotes <$> getDaemonStatus
 	locs <- liftAnnex $ loggedLocations key
-	liftAnnex $ handleDropsFrom locs syncrs reason fromhere key f knownpresentremote callCommandAction
+	liftAnnex $ handleDropsFrom locs syncrs reason fromhere key f preverified callCommandAction

Assistant/Threads/Committer.hs

@@ -479,7 +479,7 @@ checkChangeContent change@(Change { changeInfo = i }) =
 			void $ if present
 				then queueTransfers "new file created" Next k (Just f) Upload
 				else queueTransfers "new or renamed file wanted" Next k (Just f) Download
-			handleDrops "file renamed" present k (Just f) Nothing
+			handleDrops "file renamed" present k (Just f) []
   where
 	f = changeFile change
 checkChangeContent _ = noop

Assistant/Threads/SanityChecker.hs

@@ -191,7 +191,7 @@ dailyCheck urlrenderer = do
 	void $ liftAnnex $ setUnusedKeys unused
 	forM_ unused $ \k -> do
 		unlessM (queueTransfers "unused" Later k Nothing Upload) $
-			handleDrops "unused" True k Nothing Nothing
+			handleDrops "unused" True k Nothing []
 
 	return True
   where

Assistant/Threads/TransferScanner.hs

@@ -157,7 +157,7 @@ expensiveScan urlrenderer rs = batch <~> do
 		present <- liftAnnex $ inAnnex key
 		liftAnnex $ handleDropsFrom locs syncrs
 			"expensive scan found too many copies of object"
-			present key (Just f) Nothing callCommandAction
+			present key (Just f) [] callCommandAction
 		liftAnnex $ do
 			let slocs = S.fromList locs
 			let use a = return $ mapMaybe (a key slocs) syncrs

Assistant/TransferSlots.hs

@@ -30,6 +30,7 @@ import Annex.Content
 import Annex.Wanted
 import Annex.Path
 import Utility.Batch
+import Types.NumCopies
 
 import qualified Data.Map as M 
 import qualified Control.Exception as E
@@ -160,7 +161,7 @@ genTransfer t info = case transferRemote info of
 					("object uploaded to " ++ show remote)
 					True (transferKey t)
 					(associatedFile info)
-					(Just remote)
+					[VerifiedCopy (Remote.uuid remote)]
 			void recordCommit
 		, whenM (liftAnnex $ isNothing <$> checkTransfer t) $
 			void $ removeTransfer t
@@ -225,7 +226,7 @@ finishedTransfer t (Just info)
   where
 	dodrops fromhere = handleDrops
 		("drop wanted after " ++ describeTransfer t info)
-		fromhere (transferKey t) (associatedFile info) Nothing
+		fromhere (transferKey t) (associatedFile info) []
 finishedTransfer _ _ = noop
 
 {- Pause a running transfer. -}

Command/Drop.hs

@@ -64,11 +64,11 @@ start' o key afile = do
 	checkDropAuto (autoMode o) from afile key $ \numcopies ->
 		stopUnless (want from) $
 			case from of
-				Nothing -> startLocal afile numcopies key Nothing
+				Nothing -> startLocal afile numcopies key []
 				Just remote -> do
 					u <- getUUID
 					if Remote.uuid remote == u
-						then startLocal afile numcopies key Nothing
+						then startLocal afile numcopies key []
 						else startRemote afile numcopies key remote
 	  where
 		want from
@@ -78,10 +78,10 @@ start' o key afile = do
 startKeys :: DropOptions -> Key -> CommandStart
 startKeys o key = start' o key Nothing
 
-startLocal :: AssociatedFile -> NumCopies -> Key -> Maybe Remote -> CommandStart
-startLocal afile numcopies key knownpresentremote = stopUnless (inAnnex key) $ do
+startLocal :: AssociatedFile -> NumCopies -> Key -> [VerifiedCopy] -> CommandStart
+startLocal afile numcopies key preverified = stopUnless (inAnnex key) $ do
 	showStart' "drop" key afile
-	next $ performLocal key afile numcopies knownpresentremote
+	next $ performLocal key afile numcopies preverified
 
 startRemote :: AssociatedFile -> NumCopies -> Key -> Remote -> CommandStart
 startRemote afile numcopies key remote = do
@@ -92,16 +92,14 @@ startRemote afile numcopies key remote = do
 -- present on enough remotes to allow removal. This avoids a scenario where two
 -- or more remotes are trying to remove a key at the same time, and each
 -- sees the key is present on the other.
-performLocal :: Key -> AssociatedFile -> NumCopies -> Maybe Remote -> CommandPerform
-performLocal key afile numcopies knownpresentremote = lockContentExclusive key $ \contentlock -> do
+performLocal :: Key -> AssociatedFile -> NumCopies -> [VerifiedCopy] -> CommandPerform
+performLocal key afile numcopies preverified = lockContentExclusive key $ \contentlock -> do
 	(remotes, trusteduuids) <- Remote.keyPossibilitiesTrusted key
-	let trusteduuids' = case knownpresentremote of
-		Nothing -> trusteduuids
-		Just r -> Remote.uuid r:trusteduuids
+	let preverified' = preverified ++ map TrustedCopy trusteduuids
 	untrusteduuids <- trustGet UnTrusted
-	let tocheck = Remote.remotesWithoutUUID remotes (trusteduuids'++untrusteduuids)
+	let tocheck = Remote.remotesWithoutUUID remotes (map toUUID preverified'++untrusteduuids)
 	u <- getUUID
-	ifM (canDrop u key afile numcopies trusteduuids' tocheck [])
+	ifM (canDrop u key afile numcopies [] preverified' tocheck)
 		( do
 			removeAnnex contentlock
 			notifyDrop afile True
@@ -118,11 +116,11 @@ performRemote key afile numcopies remote = do
 	-- When the local repo has the key, that's one additional copy,
 	-- as long as the local repo is not untrusted.
 	(remotes, trusteduuids) <- knownCopies key
-	let have = filter (/= uuid) trusteduuids
+	let trusted = filter (/= uuid) trusteduuids
 	untrusteduuids <- trustGet UnTrusted
 	let tocheck = filter (/= remote) $
-		Remote.remotesWithoutUUID remotes (have++untrusteduuids)
-	stopUnless (canDrop uuid key afile numcopies have tocheck [uuid]) $ do
+		Remote.remotesWithoutUUID remotes (trusted++untrusteduuids)
+	stopUnless (canDrop uuid key afile numcopies [uuid] (map TrustedCopy trusted) tocheck) $ do
 		ok <- Remote.removeKey remote key
 		next $ cleanupRemote key remote ok
   where
@@ -140,19 +138,18 @@ cleanupRemote key remote ok = do
 	return ok
 
 {- Checks specified remotes to verify that enough copies of a key exist to
- - allow it to be safely removed (with no data loss). Can be provided with
- - some locations where the key is known/assumed to be present.
+ - allow it to be safely removed (with no data loss).
  -
  - Also checks if it's required content, and refuses to drop if so.
  -
  - --force overrides and always allows dropping.
  -}
-canDrop :: UUID -> Key -> AssociatedFile -> NumCopies -> [UUID] -> [Remote] -> [UUID] -> Annex Bool
-canDrop dropfrom key afile numcopies have check skip = 
+canDrop :: UUID -> Key -> AssociatedFile -> NumCopies -> [UUID] -> [VerifiedCopy] -> [Remote] -> Annex Bool
+canDrop dropfrom key afile numcopies skip preverified check = 
 	ifM (Annex.getState Annex.force)
 		( return True
 			, ifM (checkRequiredContent dropfrom key afile
-				<&&> verifyEnoughCopies nolocmsg key numcopies skip have check
+				<&&> verifyEnoughCopies nolocmsg key numcopies skip preverified check
 				)
 				( return True
 				, do

Command/DropUnused.hs

@@ -44,7 +44,7 @@ perform from numcopies key = case from of
 	Just r -> do
 		showAction $ "from " ++ Remote.name r
 		Command.Drop.performRemote key Nothing numcopies r
-	Nothing -> Command.Drop.performLocal key Nothing numcopies Nothing
+	Nothing -> Command.Drop.performLocal key Nothing numcopies []
 
 performOther :: (Key -> Git.Repo -> FilePath) -> Key -> CommandPerform
 performOther filespec key = do

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 [] trusteduuids tocheck
+	verifyEnoughCopies [] key need [] (map TrustedCopy trusteduuids) tocheck

Command/LockContent.hs

@@ -27,7 +27,7 @@ seek = withWords start
 -- dropping the lock.
 start :: [String] -> CommandStart
 start [ks] = do
-	ok <- lockContentShared k locksuccess
+	ok <- lockContentShared k (const locksuccess)
 		`catchNonAsync` (const $ return False)
 	liftIO $ if ok
 		then exitSuccess

Command/Mirror.hs

@@ -65,7 +65,7 @@ startKey o afile key = case fromToOptions o of
 			Right False -> ifM (inAnnex key)
 				( do
 					numcopies <- getnumcopies
-					Command.Drop.startLocal afile numcopies key Nothing
+					Command.Drop.startLocal afile numcopies key []
 				, stop
 				)
   where

Command/Sync.hs

@@ -460,8 +460,8 @@ syncFile ebloom rs af k = do
 		-- includeCommandAction for drops,
 		-- because a failure to drop does not mean
 		-- the sync failed.
-		handleDropsFrom locs' rs "unwanted" True k af
-			Nothing callCommandAction
+		handleDropsFrom locs' rs "unwanted" True k af []
+			callCommandAction
 	
 	return (got || not (null putrs))
   where

Types/NumCopies.hs

@@ -1,4 +1,4 @@
-{- git-annex numcopies type
+{- git-annex numcopies types
  -
  - Copyright 2014 Joey Hess <id@joeyh.name>
  -
@@ -7,8 +7,48 @@
 
 module Types.NumCopies where
 
+import Types.UUID
+
+import qualified Data.Map as M
+
 newtype NumCopies = NumCopies Int
 	deriving (Ord, Eq)
 
 fromNumCopies :: NumCopies -> Int
 fromNumCopies (NumCopies n) = n
+
+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
+	{- Represents a recent verification that a copy of an
+	 - object exists in a repository with the given UUID. -}
+	| VerifiedCopy UUID
+ 	{- 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 ())
+
+instance ToUUID VerifiedCopy where
+	toUUID (VerifiedCopy u) = u
+	toUUID (VerifiedCopyLock u _) = u
+	toUUID (TrustedCopy u) = u
+
+instance Show VerifiedCopy where
+	show (TrustedCopy u) = "TrustedCopy " ++ show u
+	show (VerifiedCopy u) = "VerifiedCopy " ++ show u
+	show (VerifiedCopyLock u _) = "VerifiedCopyLock " ++ show u
+
+strongestVerifiedCopy :: VerifiedCopy -> VerifiedCopy -> VerifiedCopy
+strongestVerifiedCopy a@(VerifiedCopyLock _ _) _ = a
+strongestVerifiedCopy _ b@(VerifiedCopyLock _ _) = b
+strongestVerifiedCopy a@(VerifiedCopy _) _ = a
+strongestVerifiedCopy _ b@(VerifiedCopy _) = 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)

Types/UUID.hs

@@ -5,6 +5,8 @@
  - Licensed under the GNU GPL version 3 or higher.
  -}
 
+{-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-}
+
 module Types.UUID where
 
 import qualified Data.Map as M
@@ -19,9 +21,12 @@ fromUUID :: UUID -> String
 fromUUID (UUID u) = u
 fromUUID NoUUID = ""
 
-toUUID :: String -> UUID
-toUUID [] = NoUUID
-toUUID s = UUID s
+class ToUUID a where
+	toUUID :: a -> UUID
+
+instance ToUUID String where
+	toUUID [] = NoUUID
+	toUUID s = UUID s
 
 isUUID :: String -> Bool
 isUUID = isJust . U.fromString