make removeKey throw exceptions

Remote/Helper/Chunked.hs

@@ -199,19 +199,14 @@ seekResume h encryptor chunkkeys checker = do
 {- Removes all chunks of a key from a remote, by calling a remover
  - action on each.
  -
- - The remover action should succeed even if asked to
- - remove a key that is not present on the remote.
- -
  - This action may be called on a chunked key. It will simply remove it.
  -}
-removeChunks :: (Key -> Annex Bool) -> UUID -> ChunkConfig -> EncKey -> Key -> Annex Bool
+removeChunks :: Remover -> UUID -> ChunkConfig -> EncKey -> Key -> Annex ()
 removeChunks remover u chunkconfig encryptor k = do
 	ls <- chunkKeys u chunkconfig k
-	ok <- allM (remover . encryptor) (concat ls)
-	when ok $ do
-		let chunksizes = catMaybes $ map (fromKey keyChunkSize <=< headMaybe) ls
-		forM_ chunksizes $ chunksRemoved u k . FixedSizeChunks . fromIntegral
-	return ok
+	mapM_ (remover . encryptor) (concat ls)
+	let chunksizes = catMaybes $ map (fromKey keyChunkSize <=< headMaybe) ls
+	forM_ chunksizes $ chunksRemoved u k . FixedSizeChunks . fromIntegral
 
 {- Retrieves a key from a remote, using a retriever action.
  -

Remote/Helper/ExportImport.hs

@@ -214,9 +214,7 @@ adjustExportImport r rs = case getRemoteConfigValue exportTreeField (config r) o
 		-- files would not be dealt with correctly.
 		-- There does not seem to be a good use case for
 		-- removing a key from an export in any case.
-		, removeKey = \_k -> do
-			warning "dropping content from an export is not supported; use `git annex export` to export a tree that lacks the files you want to remove"
-			return False
+		, removeKey = \_k -> giveup "dropping content from an export is not supported; use `git annex export` to export a tree that lacks the files you want to remove"
 		-- Can't lock content on exports, since they're
 		-- not key/value stores, and someone else could
 		-- change what's exported to a file at any time.

Remote/Helper/P2P.hs

@@ -1,6 +1,6 @@
 {- Helpers for remotes using the git-annex P2P protocol.
  -
- - Copyright 2016-2018 Joey Hess <id@joeyh.name>
+ - Copyright 2016-2020 Joey Hess <id@joeyh.name>
  -
  - Licensed under the GNU AGPL version 3 or higher.
  -}
@@ -37,7 +37,7 @@ store runner k af p = do
 		runner p' (P2P.put k af p') >>= \case
 			Just True -> return ()
 			Just False -> giveup "transfer failed"
-			Nothing -> giveup "can't connect to remote"
+			Nothing -> remoteUnavail
 
 retrieve :: (MeterUpdate -> ProtoRunner (Bool, Verification)) -> Key -> AssociatedFile -> FilePath -> MeterUpdate -> Annex Verification
 retrieve runner k af dest p =
@@ -45,15 +45,16 @@ retrieve runner k af dest p =
 		runner p' (P2P.get dest k af m p') >>= \case
 			Just (True, v) -> return v
 			Just (False, _) -> giveup "transfer failed"
-			Nothing -> giveup "can't connec to remote"
+			Nothing -> remoteUnavail
 
-remove :: ProtoRunner Bool -> Key -> Annex Bool
-remove runner k = fromMaybe False <$> runner (P2P.remove k)
+remove :: ProtoRunner Bool -> Key -> Annex ()
+remove runner k = runner (P2P.remove k) >>= \case
+	Just True -> return ()
+	Just False -> giveup "removing content from remote failed"
+	Nothing -> remoteUnavail
 
 checkpresent :: ProtoRunner Bool -> Key -> Annex Bool
-checkpresent runner k = maybe unavail return =<< runner (P2P.checkPresent k)
-  where
-	unavail = giveup "can't connect to remote"
+checkpresent runner k = maybe remoteUnavail return =<< runner (P2P.checkPresent k)
 
 lock :: WithConn a c -> ProtoConnRunner c -> UUID -> Key -> (VerifiedCopy -> Annex a) -> Annex a
 lock withconn connrunner u k callback = withconn $ \conn -> do
@@ -69,3 +70,6 @@ lock withconn connrunner u k callback = withconn $ \conn -> do
   where
 	go False = giveup "can't lock content"
 	go True = withVerifiedCopy LockedCopy u (return True) callback
+
+remoteUnavail :: a
+remoteUnavail = giveup "can't connect to remote"

Remote/Helper/ReadOnly.hs

@@ -47,8 +47,8 @@ adjustReadOnly r
 readonlyStoreKey :: Key -> AssociatedFile -> MeterUpdate -> Annex ()
 readonlyStoreKey _ _ _ = readonlyFail
 
-readonlyRemoveKey :: Key -> Annex Bool
-readonlyRemoveKey _ = readonlyFail'
+readonlyRemoveKey :: Key -> Annex ()
+readonlyRemoveKey _ = readonlyFail
 
 readonlyStorer :: Storer
 readonlyStorer _ _ _ = readonlyFail

Remote/Helper/Special.hs

@@ -124,8 +124,8 @@ storeKeyDummy :: Key -> AssociatedFile -> MeterUpdate -> Annex ()
 storeKeyDummy _ _ _ = error "missing storeKey implementation"
 retrieveKeyFileDummy :: Key -> AssociatedFile -> FilePath -> MeterUpdate -> Annex Verification
 retrieveKeyFileDummy _ _ _ _ = error "missing retrieveKeyFile implementation"
-removeKeyDummy :: Key -> Annex Bool
-removeKeyDummy _ = return False
+removeKeyDummy :: Key -> Annex ()
+removeKeyDummy _ = error "missing removeKey implementation"
 checkPresentDummy :: Key -> Annex Bool
 checkPresentDummy _ = error "missing checkPresent implementation"
 
@@ -207,8 +207,6 @@ specialRemote' cfg c storer retriever remover checkpresent baser = encr
 	cip = cipherKey c (gitconfig baser)
 	isencrypted = isEncrypted c
 
-	safely a = catchNonAsync a (\e -> warning (show e) >> return False)
-
 	-- chunk, then encrypt, then feed to the storer
 	storeKeyGen k p enc = sendAnnex k rollback $ \src ->
 		displayprogress p k (Just src) $ \p' ->
@@ -236,7 +234,7 @@ specialRemote' cfg c storer retriever remover checkpresent baser = encr
 	  where
 		enck = maybe id snd enc
 
-	removeKeyGen k enc = safely $
+	removeKeyGen k enc = 
 		removeChunks remover (uuid baser) chunkconfig enck k
 	  where
 		enck = maybe id snd enc

Remote/Helper/Ssh.hs

@@ -106,8 +106,12 @@ inAnnex r k = do
 	dispatch _ = cantCheck r
 
 {- Removes a key from a remote. -}
-dropKey :: Git.Repo -> Key -> Annex Bool
-dropKey r key = onRemote NoConsumeStdin r (\f p -> liftIO (boolSystem f p), return False) "dropkey"
+dropKey :: Git.Repo -> Key -> Annex ()
+dropKey r key = unlessM (dropKey' r key) $
+	giveup "unable to remove key from remote"
+
+dropKey' :: Git.Repo -> Key -> Annex Bool
+dropKey' r key = onRemote NoConsumeStdin r (\f p -> liftIO (boolSystem f p), return False) "dropkey"
 	[ Param "--quiet", Param "--force"
 	, Param $ serializeKey key
 	]