Allow revocation of OpenPGP keys.

/!\ It is to be noted that revoking a key does NOT necessarily prevent
the owner of its private part from accessing data on the remote /!\

The only sound use of `keyid-=` is probably to replace a (sub-)key by
another, where the private part of both is owned by the same
person/entity:

    git annex enableremote myremote keyid-=2512E3C7 keyid+=788A3F4C

Reference: http://git-annex.branchable.com/bugs/Using_a_revoked_GPG_key/

* Other change introduced by this patch:

New keys now need to be added with option `keyid+=`, and the scheme
specified (upon initremote only) with `encryption=`. The motivation for
this change is to open for new schemes, e.g., strict asymmetric
encryption.

    git annex initremote myremote encryption=hybrid keyid=2512E3C7
    git annex enableremote myremote keyid+=788A3F4C

1 files changed, 14 insertions, 7 deletions

diff --git a/Crypto.hs b/Crypto.hs
index 21b1ae41b..a86f9f976 100644
--- a/Crypto.hs
+++ b/Crypto.hs
@@ -78,15 +78,22 @@ genSharedCipher :: Bool -> IO StorableCipher
 genSharedCipher highQuality =
 	SharedCipher <$> Gpg.genRandom highQuality cipherSize
 
-{- Updates an existing Cipher, re-encrypting it to add a keyid. -}
-updateEncryptedCipher :: String -> StorableCipher -> IO StorableCipher
-updateEncryptedCipher _ (SharedCipher _) = undefined
-updateEncryptedCipher keyid encipher@(EncryptedCipher _ ks) = do
-	ks' <- Gpg.findPubKeys keyid
+{- Updates an existing Cipher, re-encrypting it to add or remove keyids,
+ - depending on whether the first component is True or False. -}
+updateEncryptedCipher :: [(Bool, String)] -> StorableCipher -> IO StorableCipher
+updateEncryptedCipher _ SharedCipher{} = undefined
+updateEncryptedCipher [] encipher = return encipher
+updateEncryptedCipher newkeys encipher@(EncryptedCipher _ (KeyIds ks)) = do
+	dropKeys <- listKeyIds [ k | (False, k) <- newkeys ]
+	forM_ dropKeys $ \k -> unless (k `elem` ks) $
+		error $ "Key " ++ k ++ " is not granted access."
+	addKeys <- listKeyIds [ k | (True, k) <- newkeys ]
+	let ks' = (addKeys ++ ks) \\ dropKeys
+	when (null ks') $ error "The new access list would become empty."
 	cipher <- decryptCipher encipher
-	encryptCipher cipher (merge ks ks')
+	encryptCipher cipher $ KeyIds ks'
   where
-	merge (KeyIds a) (KeyIds b) = KeyIds $ a ++ b
+	listKeyIds = mapM (Gpg.findPubKeys >=*> keyIds) >=*> concat
 
 describeCipher :: StorableCipher -> String
 describeCipher (SharedCipher _) = "shared cipher"