refactor

Command/AddUrl.hs

@@ -190,11 +190,7 @@ downloadRemoteFile addunlockedmatcher r o uri file sz = checkCanAdd file $ do
 			-- should use to download it.
 			setTempUrl urlkey loguri
 			let downloader = \dest p ->
-				tryNonAsync (Remote.retrieveKeyFile r urlkey af dest p) >>= \case
+				fst <$> Remote.verifiedAction (Remote.retrieveKeyFile r urlkey af dest p)
-					Right _ -> return True
-					Left e -> do
-						warning (show e)
-						return False
 			ret <- downloadWith addunlockedmatcher downloader urlkey (Remote.uuid r) loguri file
 			removeTempUrl urlkey
 			return ret

Command/Drop.hs

@@ -131,11 +131,7 @@ performRemote key afile numcopies remote = do
 				, "proof:"
 				, show proof
 				]
-			ok <- tryNonAsync (Remote.removeKey remote key) >>= \case
+			ok <- Remote.action (Remote.removeKey remote key)
-				Right () -> return True
-				Left e -> do
-					warning (show e)
-					return False
 			next $ cleanupRemote key remote ok
 		, stop
 		)

Command/Get.hs

@@ -112,9 +112,5 @@ getKey' key afile = dispatch
 		download (Remote.uuid r) key afile stdRetry
 			(\p -> do
 				showAction $ "from " ++ Remote.name r
-				tryNonAsync (Remote.retrieveKeyFile r key afile dest p) >>= \case
+				Remote.verifiedAction (Remote.retrieveKeyFile r key afile dest p)
-					Right v -> return (True, v)
-					Left e -> do
-						warning (show e)
-						return (False, UnVerified)
 			) witness

Command/Move.hs

@@ -126,12 +126,8 @@ toPerform dest removewhen key afile fastcheck isthere =
 		Right False -> do
 			showAction $ "to " ++ Remote.name dest
 			ok <- notifyTransfer Upload afile $
-				upload (Remote.uuid dest) key afile stdRetry $ \p ->
+				upload (Remote.uuid dest) key afile stdRetry $
-					tryNonAsync (Remote.storeKey dest key afile p) >>= \case
+					Remote.action . Remote.storeKey dest key afile
-						Left e -> do
-							warning (show e)
-							return False
-						Right () -> return True
 			if ok
 				then finish False $
 					Remote.logStatus dest key InfoPresent
@@ -207,11 +203,7 @@ fromPerform src removewhen key afile = do
 	go = notifyTransfer Download afile $ 
 		download (Remote.uuid src) key afile stdRetry $ \p ->
 			getViaTmp (Remote.retrievalSecurityPolicy src) (RemoteVerify src) key $ \t ->
-				tryNonAsync (Remote.retrieveKeyFile src key afile t p) >>= \case
+				Remote.verifiedAction $ Remote.retrieveKeyFile src key afile t p
-					Right v -> return (True, v)
-					Left e -> do
-						warning (show e)
-						return (False, UnVerified)
 	dispatch _ _ False = stop -- failed
 	dispatch RemoveNever _ True = next $ return True -- copy complete
 	dispatch RemoveSafe deststartedwithcopy True = lockContentShared key $ \_lck -> do
@@ -232,11 +224,7 @@ fromPerform src removewhen key afile = do
 			, show src
 			, "(" ++ reason ++ ")"
 			]
-		ok <- tryNonAsync (Remote.removeKey src key) >>= \case
+		ok <- Remote.action (Remote.removeKey src key)
-			Right () -> return True
-			Left e -> do
-				warning (show e)
-				return False
 		next $ Command.Drop.cleanupRemote key src ok
 	faileddropremote = do
 		showLongNote "(Use --force to override this check, or adjust numcopies.)"

Remote.hs

@@ -11,6 +11,8 @@ module Remote (
 	Remote,
 	uuid,
 	name,
+	action,
+	verifiedAction,
 	storeKey,
 	retrieveKeyFile,
 	retrieveKeyFileCheap,
@@ -77,6 +79,21 @@ import Config.DynamicConfig
 import Git.Types (RemoteName, ConfigKey(..), fromConfigValue)
 import Utility.Aeson
 
+{- Runs an action that may throw exceptions, catching and displaying them. -}
+action :: Annex () -> Annex Bool
+action a = tryNonAsync a >>= \case
+	Right () -> return True
+	Left e -> do
+		warning (show e)
+		return False
+
+verifiedAction :: Annex Verification -> Annex (Bool, Verification)
+verifiedAction a = tryNonAsync a >>= \case
+	Right v -> return (True, v)
+	Left e -> do
+		warning (show e)
+		return (False, UnVerified)
+
 {- Map from UUIDs of Remotes to a calculated value. -}
 remoteMap :: (Remote -> v) -> Annex (M.Map UUID v)
 remoteMap mkv = remoteMap' mkv (pure . mkk)