avoid verification when hard linking to objects in shared repository

Such a repository is implicitly trusted, so there's no point.

Annex/Content.hs

@@ -268,10 +268,11 @@ verifyKeyContent v k f = verifysize <&&> verifycontent
 		, return True
 		)
 
-data Verify = AlwaysVerify | RemoteVerify Remote | DefaultVerify
+data Verify = AlwaysVerify | NoVerify | RemoteVerify Remote | DefaultVerify
 
 shouldVerify :: Verify -> Annex Bool
 shouldVerify AlwaysVerify = return True
+shouldVerify NoVerify = return False
 shouldVerify DefaultVerify = annexVerify <$> Annex.getGitConfig
 shouldVerify (RemoteVerify r) = shouldVerify DefaultVerify
 	<&&> pure (remoteAnnexVerify (Types.Remote.gitconfig r))

Remote/Git.hs

@@ -376,9 +376,10 @@ copyFromRemote' r key file dest meterupdate
 			case v of
 				Nothing -> return False
 				Just (object, checksuccess) -> do
-					copier <- mkCopier hardlink params object dest
+					copier <- mkCopier hardlink params
 					runTransfer (Transfer Download u key)
-						file noRetry noObserver copier
+						file noRetry noObserver 
+						(callCopier copier object dest)
 						<&&> checksuccess
 	| Git.repoIsSsh (repo r) = feedprogressback $ \feeder -> do
 		direct <- isDirect
@@ -500,10 +501,14 @@ copyToRemote' r key file p
 			( return True
 			, do
 				ensureInitialized
+				copier <- mkCopier hardlink params
+				let verify = if isHardLinker copier
+					then Annex.Content.NoVerify
+					else Annex.Content.RemoteVerify r
 				runTransfer (Transfer Download u key) file noRetry noObserver $ const $
 					Annex.Content.saveState True `after`
-						Annex.Content.getViaTmp (Annex.Content.RemoteVerify r) key
+						Annex.Content.getViaTmp verify key
-							(\dest -> mkCopier hardlink params object dest >>= \a -> a p <&&> liftIO checksuccessio)
+							(\dest -> callCopier copier object dest p <&&> liftIO checksuccessio)
 			)
 
 fsckOnRemote :: Git.Repo -> [CommandParam] -> Annex (IO Bool)
@@ -615,19 +620,32 @@ commitOnCleanup r a = go `after` a
 wantHardLink :: Annex Bool
 wantHardLink = (annexHardLink <$> Annex.getGitConfig) <&&> (not <$> isDirect)
 
+data Copier
+	= Copier (FilePath -> FilePath -> MeterUpdate -> Annex Bool) 
+	| HardLinker (FilePath -> FilePath -> MeterUpdate -> Annex Bool)
+
+isHardLinker :: Copier -> Bool
+isHardLinker (Copier _) = False
+isHardLinker (HardLinker _) = True
+
+callCopier :: Copier -> FilePath -> FilePath -> MeterUpdate -> Annex Bool
+callCopier (Copier a) = a
+callCopier (HardLinker a) = a
+
 -- If either the remote or local repository wants to use hard links,
 -- the copier will do so, falling back to copying.
-mkCopier :: Bool -> [CommandParam] -> FilePath -> FilePath -> Annex (MeterUpdate -> Annex Bool)
+mkCopier :: Bool -> [CommandParam] -> Annex Copier
-mkCopier remotewanthardlink rsyncparams object dest = do
+mkCopier remotewanthardlink rsyncparams = do
-	let copier = rsyncOrCopyFile rsyncparams object dest
+	let copier = rsyncOrCopyFile rsyncparams
 #ifndef mingw32_HOST_OS
 	localwanthardlink <- wantHardLink
-	let linker = createLink object dest >> return True
+	let linker = \object dest -> createLink object dest >> return True
 	ifM (pure (remotewanthardlink || localwanthardlink) <&&> not <$> isDirect)
-		( return $ \m -> liftIO (catchBoolIO linker)
+		( return $ HardLinker $ \object dest p ->
-			<||> copier m
+			liftIO (catchBoolIO (linker object dest))
-		, return copier
+				<||> copier object dest p
+		, return $ Copier copier
 		)
 #else
-	return copier
+	return $ Copier copier
 #endif