New package openpgp-util as alternative to OpenPGP-CryptoAPI.

5 files changed, 507 insertions, 0 deletions

diff --git a/Data/OpenPGP/Util.hs b/Data/OpenPGP/Util.hs
new file mode 100644
index 0000000..c675ec2
--- /dev/null
+++ b/Data/OpenPGP/Util.hs
@@ -0,0 +1,12 @@
+module Data.OpenPGP.Util 
+    ( fingerprint
+    , decryptSecretKey
+    , verify
+    , pgpSign
+    ) where
+
+import Data.OpenPGP.Util.Fingerprint
+import Data.OpenPGP.Util.Sign
+import Data.OpenPGP.Util.Verify
+import Data.OpenPGP.Util.DecryptSecretKey
+
diff --git a/Data/OpenPGP/Util/DecryptSecretKey.hs b/Data/OpenPGP/Util/DecryptSecretKey.hs
new file mode 100644
index 0000000..0ba89d2
--- /dev/null
+++ b/Data/OpenPGP/Util/DecryptSecretKey.hs
@@ -0,0 +1,134 @@
+module Data.OpenPGP.Util.DecryptSecretKey where
+
+import qualified Data.OpenPGP as OpenPGP
+import qualified Data.ByteString as BS
+import qualified Data.ByteString.Lazy as LZ
+import Data.Word (Word16,Word8)
+import Data.Char (toUpper)
+import Control.Monad (foldM)
+import Numeric (showHex)
+import Data.Binary (get,Binary,Get)
+import Data.Binary.Get (runGetOrFail)
+import qualified Data.Serialize as Serialize
+import Control.Applicative ( (<$>) )
+
+import Crypto.Hash.MD5 as MD5
+import Crypto.Hash.SHA1 as SHA1
+import Crypto.Hash.SHA256 as SHA256
+import Crypto.Hash.SHA384 as SHA384
+import Crypto.Hash.SHA512 as SHA512
+import Crypto.Hash.SHA224 as SHA224
+import Crypto.Hash.RIPEMD160 as RIPEMD160
+
+import qualified Crypto.Cipher.AES as Vincent
+import qualified Crypto.Cipher.Blowfish as Vincent
+
+import qualified Crypto.Cipher.Types as Vincent
+import qualified Data.Byteable as Vincent
+
+import Crypto.Cipher.Cast5 (CAST5_128)
+import Crypto.Cipher.ThomasToVincent
+
+
+hashBySymbol OpenPGP.MD5 = MD5.hashlazy
+hashBySymbol OpenPGP.SHA1 = SHA1.hashlazy
+hashBySymbol OpenPGP.SHA256 = SHA256.hashlazy
+hashBySymbol OpenPGP.SHA384 = SHA384.hashlazy
+hashBySymbol OpenPGP.SHA512 = SHA512.hashlazy
+hashBySymbol OpenPGP.SHA224 = SHA224.hashlazy
+hashBySymbol OpenPGP.RIPEMD160 = RIPEMD160.hashlazy
+
+
+
+data Enciphered = 
+         EncipheredWithIV !LZ.ByteString -- initial vector is appended to front of ByteString
+       | EncipheredZeroIV !LZ.ByteString -- initial vector is zero, ByteString contains only the block
+
+withIV :: (Vincent.BlockCipher k) => (Vincent.IV k -> LZ.ByteString -> LZ.ByteString) -> Enciphered -> LZ.ByteString
+withIV f (EncipheredWithIV s) = f iv bs
+    where
+    Just iv = Vincent.makeIV (toStrictBS ivbs)
+    (ivbs,bs) = LZ.splitAt (fromIntegral ivlen) s
+    ivlen = Vincent.byteableLength z
+    z = Vincent.nullIV
+    _ = Vincent.constEqBytes z iv
+withIV f (EncipheredZeroIV s) = f Vincent.nullIV s
+
+decryptSecretKey ::
+    BS.ByteString           -- ^ Passphrase
+    -> OpenPGP.Packet       -- ^ Encrypted SecretKeyPacket
+    -> Maybe OpenPGP.Packet -- ^ Decrypted SecretKeyPacket
+decryptSecretKey pass k@(OpenPGP.SecretKeyPacket {
+        OpenPGP.version = 4, OpenPGP.key_algorithm = kalgo,
+        OpenPGP.s2k = s2k, OpenPGP.symmetric_algorithm = salgo,
+        OpenPGP.key = existing, OpenPGP.encrypted_data = encd
+    }) | chkF material == toStrictBS chk =
+        fmap (\m -> k {
+            OpenPGP.s2k_useage = 0,
+            OpenPGP.symmetric_algorithm = OpenPGP.Unencrypted,
+            OpenPGP.encrypted_data = LZ.empty,
+            OpenPGP.key = m
+        }) parseMaterial
+       | otherwise = Nothing
+    where
+    parseMaterial = maybeGet
+        (foldM (\m f -> do {mpi <- get; return $ (f,mpi):m}) existing
+        (OpenPGP.secret_key_fields kalgo)) material
+    (material, chk) = LZ.splitAt (LZ.length decd - chkSize) decd
+    (chkSize, chkF)
+        | OpenPGP.s2k_useage k == 254 = (20, SHA1.hash . toStrictBS)
+        | otherwise = (2, Serialize.encode . checksum . toStrictBS)
+    decd = string2sdecrypt salgo s2k (toLazyBS pass) (EncipheredWithIV encd)
+
+    checksum :: BS.ByteString -> Word16
+    checksum key = fromIntegral $
+        BS.foldl' (\x y -> x + fromIntegral y) (0::Integer) key `mod` 65536
+
+    maybeGet :: (Binary a) => Get a -> LZ.ByteString -> Maybe a
+    maybeGet g bs = (\(_,_,x) -> x) <$> hush (runGetOrFail g bs)
+
+    hush :: Either a b -> Maybe b
+    hush (Left _) = Nothing
+    hush (Right x) = Just x
+
+
+decryptSecretKey _ _ = Nothing
+
+toStrictBS :: LZ.ByteString -> BS.ByteString
+toStrictBS = BS.concat . LZ.toChunks
+
+toLazyBS :: BS.ByteString -> LZ.ByteString
+toLazyBS = LZ.fromChunks . (:[])
+
+
+
+string2sdecrypt :: OpenPGP.SymmetricAlgorithm -> OpenPGP.S2K -> LZ.ByteString -> Enciphered -> LZ.ByteString
+string2sdecrypt OpenPGP.AES128 s2k s = withIV $ simpleUnCFB (string2key s2k s :: Vincent.AES128)
+string2sdecrypt OpenPGP.AES192 s2k s = withIV $ simpleUnCFB (string2key s2k s :: Vincent.AES192)
+string2sdecrypt OpenPGP.AES256 s2k s = withIV $ simpleUnCFB (string2key s2k s :: Vincent.AES256)
+string2sdecrypt OpenPGP.Blowfish s2k s = withIV $ simpleUnCFB (string2key s2k s :: Vincent.Blowfish128)
+string2sdecrypt OpenPGP.CAST5 s2k s = withIV $ simpleUnCFB (string2key s2k s :: ThomasToVincent CAST5_128)
+string2sdecrypt algo _ _ = error $ "Unsupported symmetric algorithm : " ++ show algo ++ " in Data.OpenPGP.CryptoAPI.string2sdecrypt"
+
+simpleUnCFB :: (Vincent.BlockCipher k) => k -> Vincent.IV k -> LZ.ByteString -> LZ.ByteString
+simpleUnCFB k iv = padThenUnpad k (toLazyBS . Vincent.cfbDecrypt k iv . toStrictBS)
+    where
+    padThenUnpad :: (Vincent.BlockCipher k) => k -> (LZ.ByteString -> LZ.ByteString) -> LZ.ByteString -> LZ.ByteString
+    padThenUnpad k f s = dropPadEnd (f padded)
+        where
+        dropPadEnd s = LZ.take (LZ.length s - padAmount) s
+        padded = s `LZ.append` LZ.replicate padAmount 0
+        padAmount = blksize - (LZ.length s `mod` blksize)
+        blksize = fromIntegral $ Vincent.blockSize k
+
+string2key :: (Vincent.BlockCipher k) => OpenPGP.S2K -> LZ.ByteString -> k
+string2key s2k s = cipher
+    where
+    cipher = Vincent.cipherInit k
+    Right k = Vincent.makeKey $ toStrictBS $
+        LZ.take ksize $ OpenPGP.string2key hashBySymbol s2k s
+    ksize = case Vincent.cipherKeySize cipher of
+                Vincent.KeySizeFixed n -> fromIntegral n
+                Vincent.KeySizeEnum xs -> error $ "Unknown key size in string2key"
+                Vincent.KeySizeRange min max -> error $ "Unknown key size range in string2key"
+
diff --git a/Data/OpenPGP/Util/Fingerprint.hs b/Data/OpenPGP/Util/Fingerprint.hs
new file mode 100644
index 0000000..538688b
--- /dev/null
+++ b/Data/OpenPGP/Util/Fingerprint.hs
@@ -0,0 +1,33 @@
+module Data.OpenPGP.Util.Fingerprint (fingerprint) where
+
+import qualified Data.OpenPGP as OpenPGP
+import qualified Data.ByteString as BS
+import qualified Data.ByteString.Lazy as LZ
+import Data.Char (toUpper)
+import Data.Word (Word8)
+import Numeric (showHex)
+
+import Crypto.Hash.MD5 as MD5
+import Crypto.Hash.SHA1 as SHA1
+
+-- | Generate a key fingerprint from a PublicKeyPacket or SecretKeyPacket
+-- <http://tools.ietf.org/html/rfc4880#section-12.2>
+fingerprint :: OpenPGP.Packet -> String
+fingerprint p
+    | OpenPGP.version p == 4 = hexify $ SHA1.hashlazy material
+    | OpenPGP.version p `elem` [2, 3] = hexify $ MD5.hashlazy material
+    | otherwise = error "Unsupported Packet version or type in fingerprint"
+    where
+    material = LZ.concat $ OpenPGP.fingerprint_material p
+
+    hexify = map toUpper . hexString . BS.unpack
+
+    hexString :: [Word8] -> String
+    hexString = foldr (pad `oo` showHex) ""
+        where
+        pad s | odd $ length s = '0':s
+              | otherwise = s
+
+    oo :: (b -> c) -> (a -> a1 -> b) -> a -> a1 -> c
+    oo = (.) . (.)
+
diff --git a/Data/OpenPGP/Util/Sign.hs b/Data/OpenPGP/Util/Sign.hs
new file mode 100644
index 0000000..ef7d16b
--- /dev/null
+++ b/Data/OpenPGP/Util/Sign.hs
@@ -0,0 +1,213 @@
+{-# LANGUAGE ScopedTypeVariables #-}
+module Data.OpenPGP.Util.Sign where
+
+import qualified Data.OpenPGP as OpenPGP
+import Data.Maybe
+import Data.Binary (encode)
+import qualified Data.ByteString as BS
+import qualified Data.ByteString.Lazy as LZ
+import Data.Bits ( (.|.), shiftL )
+import Control.Applicative ( (<$>) )
+import Data.Time.Clock.POSIX
+import Control.Exception as Exception (IOException(..),catch)
+
+import Data.OpenPGP.Util.Fingerprint (fingerprint)
+
+import qualified Crypto.Random as Vincent
+import qualified Crypto.PubKey.DSA as Vincent.DSA
+import qualified Crypto.PubKey.RSA as Vincent.RSA
+import qualified Crypto.PubKey.RSA.PKCS15 as Vincent.RSA
+import Crypto.PubKey.HashDescr as Vincent
+
+import Crypto.Hash.MD5 as MD5
+import Crypto.Hash.SHA1 as SHA1
+import Crypto.Hash.SHA256 as SHA256
+import Crypto.Hash.SHA384 as SHA384
+import Crypto.Hash.SHA512 as SHA512
+import Crypto.Hash.SHA224 as SHA224
+import Crypto.Hash.RIPEMD160 as RIPEMD160
+
+hashAlgoDesc OpenPGP.MD5       = Vincent.hashDescrMD5
+hashAlgoDesc OpenPGP.SHA1      = Vincent.hashDescrSHA1
+hashAlgoDesc OpenPGP.RIPEMD160 = Vincent.hashDescrRIPEMD160
+hashAlgoDesc OpenPGP.SHA256    = Vincent.hashDescrSHA256
+hashAlgoDesc OpenPGP.SHA384    = Vincent.hashDescrSHA384
+hashAlgoDesc OpenPGP.SHA512    = Vincent.hashDescrSHA512
+hashAlgoDesc OpenPGP.SHA224    = Vincent.hashDescrSHA224
+hashAlgoDesc _ =
+       error "Unsupported HashAlgorithm in hashAlgoDesc"
+
+find_key :: OpenPGP.Message -> String -> Maybe OpenPGP.Packet
+find_key = OpenPGP.find_key fingerprint
+
+
+privateDSAkey :: OpenPGP.Packet -> Vincent.DSA.PrivateKey
+privateDSAkey k = Vincent.DSA.PrivateKey
+    (Vincent.DSA.Params (keyParam 'p' k) (keyParam 'g' k) (keyParam 'q' k))
+    (keyParam 'x' k)
+privateRSAkey :: OpenPGP.Packet -> Vincent.RSA.PrivateKey
+privateRSAkey k =
+    -- Invert p and q because u is pinv not qinv
+    Vincent.RSA.PrivateKey pubkey d q p
+        (d `mod` (q-1))
+        (d `mod` (p-1))
+        (keyParam 'u' k)
+    where
+    d = keyParam 'd' k
+    p = keyParam 'p' k
+    q = keyParam 'q' k
+    pubkey = rsaKey k
+
+rsaKey :: OpenPGP.Packet -> Vincent.RSA.PublicKey
+rsaKey k =
+    Vincent.RSA.PublicKey (integerBytesize n) n (keyParam 'e' k)
+    where
+    n = keyParam 'n' k
+
+integerBytesize :: Integer -> Int
+integerBytesize i = fromIntegral $ LZ.length (encode (OpenPGP.MPI i)) - 2
+
+
+toStrictBS :: LZ.ByteString -> BS.ByteString
+toStrictBS = BS.concat . LZ.toChunks
+
+toLazyBS :: BS.ByteString -> LZ.ByteString
+toLazyBS = LZ.fromChunks . (:[])
+
+
+keyParam :: Char -> OpenPGP.Packet -> Integer
+keyParam c k = fromJustMPI $ lookup c (OpenPGP.key k)
+fromJustMPI :: Maybe OpenPGP.MPI -> Integer
+fromJustMPI (Just (OpenPGP.MPI x)) = x
+fromJustMPI _ = error "Not a Just MPI, Data.OpenPGP.CryptoAPI"
+
+hashBySymbol OpenPGP.MD5 = MD5.hashlazy
+hashBySymbol OpenPGP.SHA1 = SHA1.hashlazy
+hashBySymbol OpenPGP.SHA256 = SHA256.hashlazy
+hashBySymbol OpenPGP.SHA384 = SHA384.hashlazy
+hashBySymbol OpenPGP.SHA512 = SHA512.hashlazy
+hashBySymbol OpenPGP.SHA224 = SHA224.hashlazy
+hashBySymbol OpenPGP.RIPEMD160 = RIPEMD160.hashlazy
+
+
+
+
+-- | Make a signature
+--
+-- In order to set more options on a signature, pass in a signature packet.
+-- Operation is unsafe in that it silently re-uses "random" bytes when
+-- entropy runs out.  Use pgpSign for a safer interface.
+unsafeSign :: (Vincent.CPRG g) => -- CryptoRandomGen g) =>
+        OpenPGP.Message          -- ^ SecretKeys, one of which will be used
+        -> OpenPGP.SignatureOver -- ^ Data to sign, and optional signature packet
+        -> OpenPGP.HashAlgorithm -- ^ HashAlgorithm to use in signature
+        -> String                -- ^ KeyID of key to choose
+        -> Integer               -- ^ Timestamp for signature (unless sig supplied)
+        -> g                     -- ^ Random number generator
+        -> (OpenPGP.SignatureOver, g)
+unsafeSign keys over hsh keyid timestamp g = (over {OpenPGP.signatures_over = [sig]}, g')
+        where
+        (final, g') = case OpenPGP.key_algorithm sig of
+                OpenPGP.DSA -> ([dsaR, dsaS], dsaG)
+                kalgo | kalgo `elem` [OpenPGP.RSA,OpenPGP.RSA_S] -> ([toNum rsaFinal], g)
+                      | otherwise ->
+                        error ("Unsupported key algorithm " ++ show kalgo ++ "in sign")
+        (Vincent.DSA.Signature dsaR dsaS,dsaG) = let k' = privateDSAkey k in
+                Vincent.DSA.sign g k' (dsaTruncate k' . bhash) dta
+        (Right rsaFinal,_) = Vincent.RSA.signSafer g desc (privateRSAkey k) dta
+        dsaTruncate (Vincent.DSA.PrivateKey (Vincent.DSA.Params _ _ q) _) = BS.take (integerBytesize q)
+        dta     = toStrictBS $ encode over `LZ.append` OpenPGP.trailer sig
+        sig     = findSigOrDefault (listToMaybe $ OpenPGP.signatures_over over)
+        -- padding = emsa_pkcs1_v1_5_hash_padding hsh
+        desc = hashAlgoDesc hsh
+        bhash   = hashBySymbol hsh . toLazyBS
+        toNum   = BS.foldl (\a b -> a `shiftL` 8 .|. fromIntegral b) 0
+        Just k  = find_key keys keyid
+
+        -- Either a SignaturePacket was found, or we need to make one
+        findSigOrDefault (Just s) = OpenPGP.signaturePacket
+                (OpenPGP.version s)
+                (OpenPGP.signature_type s)
+                (OpenPGP.key_algorithm k) -- force to algo of key
+                hsh -- force hash algorithm
+                (OpenPGP.hashed_subpackets s)
+                (OpenPGP.unhashed_subpackets s)
+                (OpenPGP.hash_head s)
+                (map OpenPGP.MPI final)
+        findSigOrDefault Nothing  = OpenPGP.signaturePacket
+                4
+                defaultStype
+                (OpenPGP.key_algorithm k) -- force to algo of key
+                hsh
+                ([
+                        -- Do we really need to pass in timestamp just for the default?
+                        OpenPGP.SignatureCreationTimePacket $ fromIntegral timestamp,
+                        OpenPGP.IssuerPacket $ fingerprint k
+                ] ++ (case over of
+                        OpenPGP.KeySignature  {} -> [OpenPGP.KeyFlagsPacket {
+                                        OpenPGP.certify_keys = True,
+                                        OpenPGP.sign_data = True,
+                                        OpenPGP.encrypt_communication = False,
+                                        OpenPGP.encrypt_storage = False,
+                                        OpenPGP.split_key = False,
+                                        OpenPGP.authentication = False,
+                                        OpenPGP.group_key = False
+                                }]
+                        _ -> []
+                ))
+                []
+                0 -- TODO
+                (map OpenPGP.MPI final)
+
+        defaultStype = case over of
+                OpenPGP.DataSignature ld _
+                        | OpenPGP.format ld == 'b'     -> 0x00
+                        | otherwise                    -> 0x01
+                OpenPGP.KeySignature {}           -> 0x1F
+                OpenPGP.SubkeySignature {}        -> 0x18
+                OpenPGP.CertificationSignature {} -> 0x13
+
+
+
+now = floor <$> Data.Time.Clock.POSIX.getPOSIXTime
+
+stampit timestamp sig = sig { OpenPGP.hashed_subpackets = hashed' }
+ where
+    hashed_stamps   = filter isStamp (OpenPGP.hashed_subpackets sig)
+    unhashed_stamps = filter isStamp (OpenPGP.unhashed_subpackets sig)
+    hashed' = case hashed_stamps ++ unhashed_stamps of
+                [] -> OpenPGP.SignatureCreationTimePacket (fromIntegral timestamp)
+                      : OpenPGP.hashed_subpackets sig
+                _  -> OpenPGP.hashed_subpackets sig
+    isStamp (OpenPGP.SignatureCreationTimePacket {}) = True
+    isStamp _                                        = False
+
+-- | Make a signature
+--
+-- In order to set more options on a signature, pass in a signature packet.
+pgpSign :: 
+    OpenPGP.Message          -- ^ SecretKeys, one of which will be used
+    -> OpenPGP.SignatureOver -- ^ Data to sign, and optional signature packet
+    -> OpenPGP.HashAlgorithm -- ^ HashAlgorithm to use in signature
+    -> String                -- ^ KeyID of key to choose
+    -> IO (Maybe OpenPGP.SignatureOver)
+pgpSign seckeys dta hash_algo keyid =
+    handleIO_ (return Nothing) $ do
+    timestamp <- now
+    -- g <- Thomas.newGenIO :: IO Thomas.SystemRandom
+    g <- fmap Vincent.cprgCreate $ Vincent.createEntropyPool
+    let _ = g :: Vincent.SystemRNG 
+    let sigs = map (stampit timestamp) $ OpenPGP.signatures_over dta
+        dta' = dta { OpenPGP.signatures_over = sigs }
+    let (r,g') = unsafeSign seckeys dta' hash_algo keyid timestamp g
+    return (Just r)
+
+catchIO_ :: IO a -> IO a -> IO a
+catchIO_ a h = Exception.catch a (\(_ :: IOException) -> h)
+
+catchIO :: IO a -> (IOException -> IO a)  -> IO a
+catchIO body handler = Exception.catch body handler
+
+handleIO_ = flip catchIO_
+handleIO = flip catchIO
+
diff --git a/Data/OpenPGP/Util/Verify.hs b/Data/OpenPGP/Util/Verify.hs
new file mode 100644
index 0000000..137c00f
--- /dev/null
+++ b/Data/OpenPGP/Util/Verify.hs
@@ -0,0 +1,115 @@
+module Data.OpenPGP.Util.Verify where
+
+import qualified Data.OpenPGP as OpenPGP
+import Data.Maybe
+import Data.Binary (encode)
+import Control.Monad
+import qualified Data.ByteString as BS
+import qualified Data.ByteString.Lazy as LZ
+import Data.Monoid ( (<>) )
+
+import Data.OpenPGP.Util.Fingerprint (fingerprint)
+
+import qualified Crypto.PubKey.DSA as Vincent.DSA
+import qualified Crypto.PubKey.RSA as Vincent.RSA
+import qualified Crypto.PubKey.RSA.PKCS15 as Vincent.RSA
+import Crypto.PubKey.HashDescr as Vincent
+
+import Crypto.Hash.MD5 as MD5
+import Crypto.Hash.SHA1 as SHA1
+import Crypto.Hash.SHA256 as SHA256
+import Crypto.Hash.SHA384 as SHA384
+import Crypto.Hash.SHA512 as SHA512
+import Crypto.Hash.SHA224 as SHA224
+import Crypto.Hash.RIPEMD160 as RIPEMD160
+
+hashBySymbol OpenPGP.MD5 = MD5.hashlazy
+hashBySymbol OpenPGP.SHA1 = SHA1.hashlazy
+hashBySymbol OpenPGP.SHA256 = SHA256.hashlazy
+hashBySymbol OpenPGP.SHA384 = SHA384.hashlazy
+hashBySymbol OpenPGP.SHA512 = SHA512.hashlazy
+hashBySymbol OpenPGP.SHA224 = SHA224.hashlazy
+hashBySymbol OpenPGP.RIPEMD160 = RIPEMD160.hashlazy
+
+
+toStrictBS :: LZ.ByteString -> BS.ByteString
+toStrictBS = BS.concat . LZ.toChunks
+
+toLazyBS :: BS.ByteString -> LZ.ByteString
+toLazyBS = LZ.fromChunks . (:[])
+
+hush :: Either a b -> Maybe b
+hush (Left _) = Nothing
+hush (Right x) = Just x
+
+fromJustMPI :: Maybe OpenPGP.MPI -> Integer
+fromJustMPI (Just (OpenPGP.MPI x)) = x
+fromJustMPI _ = error "Not a Just MPI, Data.OpenPGP.CryptoAPI"
+
+
+
+find_key :: OpenPGP.Message -> String -> Maybe OpenPGP.Packet
+find_key = OpenPGP.find_key fingerprint
+
+integerBytesize :: Integer -> Int
+integerBytesize i = fromIntegral $ LZ.length (encode (OpenPGP.MPI i)) - 2
+
+dsaKey :: OpenPGP.Packet -> Vincent.DSA.PublicKey
+dsaKey k = Vincent.DSA.PublicKey
+    (Vincent.DSA.Params (keyParam 'p' k) (keyParam 'g' k) (keyParam 'q' k))
+    (keyParam 'y' k)
+
+rsaKey :: OpenPGP.Packet -> Vincent.RSA.PublicKey
+rsaKey k =
+    Vincent.RSA.PublicKey (integerBytesize n) n (keyParam 'e' k)
+    where
+    n = keyParam 'n' k
+
+
+keyParam :: Char -> OpenPGP.Packet -> Integer
+keyParam c k = fromJustMPI $ lookup c (OpenPGP.key k)
+
+
+-- | Verify a message signature
+verify ::
+    OpenPGP.Message          -- ^ Keys that may have made the signature
+    -> OpenPGP.SignatureOver -- ^ Signatures to verify
+    -> OpenPGP.SignatureOver -- ^ Will only contain signatures that passed
+verify keys over =
+    over {OpenPGP.signatures_over = mapMaybe (uncurry $ verifyOne keys) sigs}
+    where
+    sigs = map (\s -> (s, toStrictBS $ encode over `LZ.append` OpenPGP.trailer s))
+        (OpenPGP.signatures_over over)
+
+verifyOne :: OpenPGP.Message -> OpenPGP.Packet -> BS.ByteString -> Maybe OpenPGP.Packet
+verifyOne keys sig over = fmap (const sig) $ maybeKey >>= verification >>= guard
+    where
+    verification = case OpenPGP.key_algorithm sig of
+        OpenPGP.DSA -> dsaVerify
+        alg | alg `elem` [OpenPGP.RSA,OpenPGP.RSA_S] -> rsaVerify
+            | otherwise -> const Nothing
+    dsaVerify k = let k' = dsaKey k in 
+        Just $ Vincent.DSA.verify (dsaTruncate k' . bhash) k' dsaSig over
+    rsaVerify k = Just $ Vincent.RSA.verify desc (rsaKey k) over rsaSig
+    [rsaSig] = map (toStrictBS . LZ.drop 2 . encode) (OpenPGP.signature sig)
+    dsaSig = let [OpenPGP.MPI r, OpenPGP.MPI s] = OpenPGP.signature sig in
+        Vincent.DSA.Signature r s
+    dsaTruncate (Vincent.DSA.PublicKey (Vincent.DSA.Params _ _ q) _) = BS.take (integerBytesize q)
+    bhash = hashBySymbol hash_algo . toLazyBS
+    desc = hashAlgoDesc hash_algo
+    hash_algo = OpenPGP.hash_algorithm sig
+    maybeKey = OpenPGP.signature_issuer sig >>= find_key keys
+
+-- http://tools.ietf.org/html/rfc3447#page-43
+-- http://tools.ietf.org/html/rfc4880#section-5.2.2
+hashAlgoDesc OpenPGP.MD5       = Vincent.hashDescrMD5
+hashAlgoDesc OpenPGP.SHA1      = Vincent.hashDescrSHA1
+hashAlgoDesc OpenPGP.RIPEMD160 = Vincent.hashDescrRIPEMD160
+hashAlgoDesc OpenPGP.SHA256    = Vincent.hashDescrSHA256
+hashAlgoDesc OpenPGP.SHA384    = Vincent.hashDescrSHA384
+hashAlgoDesc OpenPGP.SHA512    = Vincent.hashDescrSHA512
+hashAlgoDesc OpenPGP.SHA224    = Vincent.hashDescrSHA224
+hashAlgoDesc _ =
+       error "Unsupported HashAlgorithm in hashAlgoDesc"
+
+