summaryrefslogtreecommitdiff
path: root/Data
diff options
context:
space:
mode:
Diffstat (limited to 'Data')
-rw-r--r--Data/OpenPGP/Util.hs12
-rw-r--r--Data/OpenPGP/Util/Base.hs83
-rw-r--r--Data/OpenPGP/Util/DecryptSecretKey.hs126
-rw-r--r--Data/OpenPGP/Util/Fingerprint.hs33
-rw-r--r--Data/OpenPGP/Util/Sign.hs170
-rw-r--r--Data/OpenPGP/Util/Verify.hs74
6 files changed, 498 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 @@
1module Data.OpenPGP.Util
2 ( fingerprint
3 , decryptSecretKey
4 , verify
5 , pgpSign
6 ) where
7
8import Data.OpenPGP.Util.Fingerprint
9import Data.OpenPGP.Util.Sign
10import Data.OpenPGP.Util.Verify
11import Data.OpenPGP.Util.DecryptSecretKey
12
diff --git a/Data/OpenPGP/Util/Base.hs b/Data/OpenPGP/Util/Base.hs
new file mode 100644
index 0000000..aaa02c7
--- /dev/null
+++ b/Data/OpenPGP/Util/Base.hs
@@ -0,0 +1,83 @@
1module Data.OpenPGP.Util.Base where
2
3import qualified Data.ByteString as BS
4import qualified Data.ByteString.Lazy as LZ
5import Data.Binary (encode)
6
7import Data.OpenPGP as OpenPGP
8import Crypto.Hash.MD5 as MD5
9import Crypto.Hash.SHA1 as SHA1
10import Crypto.Hash.SHA256 as SHA256
11import Crypto.Hash.SHA384 as SHA384
12import Crypto.Hash.SHA512 as SHA512
13import Crypto.Hash.SHA224 as SHA224
14import Crypto.Hash.RIPEMD160 as RIPEMD160
15import qualified Crypto.PubKey.RSA as Vincent.RSA
16import Crypto.PubKey.HashDescr as Vincent
17import qualified Crypto.Types.PubKey.ECC as Vincent.ECDSA
18import qualified Crypto.Types.PubKey.ECDSA as Vincent.ECDSA
19
20import Data.OpenPGP.Util.Fingerprint (fingerprint)
21
22hashBySymbol OpenPGP.MD5 = MD5.hashlazy
23hashBySymbol OpenPGP.SHA1 = SHA1.hashlazy
24hashBySymbol OpenPGP.SHA256 = SHA256.hashlazy
25hashBySymbol OpenPGP.SHA384 = SHA384.hashlazy
26hashBySymbol OpenPGP.SHA512 = SHA512.hashlazy
27hashBySymbol OpenPGP.SHA224 = SHA224.hashlazy
28hashBySymbol OpenPGP.RIPEMD160 = RIPEMD160.hashlazy
29
30curveFromOID :: Integer -> Vincent.ECDSA.Curve
31curveFromOID 0x2a8648ce3d030107 = Vincent.ECDSA.getCurveByName Vincent.ECDSA.SEC_p256r1 -- NIST P-256
32curveFromOID 0x2B81040022 = Vincent.ECDSA.getCurveByName Vincent.ECDSA.SEC_p384r1 -- NIST P-384
33curveFromOID 0x2B81040023 = Vincent.ECDSA.getCurveByName Vincent.ECDSA.SEC_p521r1 -- NIST P-521
34curveFromOID 0x2b8104000a = Vincent.ECDSA.getCurveByName Vincent.ECDSA.SEC_p256k1 -- bitcoin curve
35curveFromOID n = error $ "Unknown curve: "++ show n
36
37ecdsaKey k = Vincent.ECDSA.PublicKey curve (Vincent.ECDSA.Point x y)
38 where
39 x = keyParam 'x' k
40 y = keyParam 'y' k
41 curve = curveFromOID (keyParam 'c' k)
42
43
44toStrictBS :: LZ.ByteString -> BS.ByteString
45toStrictBS = BS.concat . LZ.toChunks
46
47toLazyBS :: BS.ByteString -> LZ.ByteString
48toLazyBS = LZ.fromChunks . (:[])
49
50find_key :: OpenPGP.Message -> String -> Maybe OpenPGP.Packet
51find_key = OpenPGP.find_key fingerprint
52
53
54
55keyParam :: Char -> OpenPGP.Packet -> Integer
56keyParam c k = fromJustMPI $ lookup c (OpenPGP.key k)
57 where
58 fromJustMPI :: Maybe OpenPGP.MPI -> Integer
59 fromJustMPI (Just (OpenPGP.MPI x)) = x
60 fromJustMPI _ = error "Not a Just MPI, Data.OpenPGP.CryptoAPI"
61
62integerBytesize :: Integer -> Int
63integerBytesize i = fromIntegral $ LZ.length (encode (OpenPGP.MPI i)) - 2
64
65rsaKey :: OpenPGP.Packet -> Vincent.RSA.PublicKey
66rsaKey k =
67 Vincent.RSA.PublicKey (integerBytesize n) n (keyParam 'e' k)
68 where
69 n = keyParam 'n' k
70
71-- http://tools.ietf.org/html/rfc3447#page-43
72-- http://tools.ietf.org/html/rfc4880#section-5.2.2
73hashAlgoDesc OpenPGP.MD5 = Vincent.hashDescrMD5
74hashAlgoDesc OpenPGP.SHA1 = Vincent.hashDescrSHA1
75hashAlgoDesc OpenPGP.RIPEMD160 = Vincent.hashDescrRIPEMD160
76hashAlgoDesc OpenPGP.SHA256 = Vincent.hashDescrSHA256
77hashAlgoDesc OpenPGP.SHA384 = Vincent.hashDescrSHA384
78hashAlgoDesc OpenPGP.SHA512 = Vincent.hashDescrSHA512
79hashAlgoDesc OpenPGP.SHA224 = Vincent.hashDescrSHA224
80hashAlgoDesc _ =
81 error "Unsupported HashAlgorithm in hashAlgoDesc"
82
83
diff --git a/Data/OpenPGP/Util/DecryptSecretKey.hs b/Data/OpenPGP/Util/DecryptSecretKey.hs
new file mode 100644
index 0000000..6bfc2af
--- /dev/null
+++ b/Data/OpenPGP/Util/DecryptSecretKey.hs
@@ -0,0 +1,126 @@
1{-# LANGUAGE CPP #-}
2module Data.OpenPGP.Util.DecryptSecretKey where
3
4import qualified Data.OpenPGP as OpenPGP
5import qualified Data.ByteString as BS
6import qualified Data.ByteString.Lazy as LZ
7import Data.Word (Word16)
8import Control.Monad (foldM)
9import Data.Binary (get,Binary,Get,encode)
10#if MIN_VERSION_binary(0,6,4)
11import Data.Binary.Get (runGetOrFail)
12#else
13import Control.Exception as Exception (handle,ErrorCall(..))
14import System.IO.Unsafe
15import Data.Binary.Get (runGet)
16#endif
17import Control.Applicative ( (<$>) )
18
19import Crypto.Hash.SHA1 as SHA1
20
21import qualified Crypto.Cipher.AES as Vincent
22import qualified Crypto.Cipher.Blowfish as Vincent
23
24import qualified Crypto.Cipher.Types as Vincent
25import qualified Data.Byteable as Vincent
26
27import Crypto.Cipher.Cast5 (CAST5_128)
28import Crypto.Cipher.ThomasToVincent
29import Data.OpenPGP.Util.Base (toStrictBS,toLazyBS,hashBySymbol)
30
31
32
33
34data Enciphered =
35 EncipheredWithIV !LZ.ByteString -- initial vector is appended to front of ByteString
36 | EncipheredZeroIV !LZ.ByteString -- initial vector is zero, ByteString contains only the block
37
38withIV :: (Vincent.BlockCipher k) => (Vincent.IV k -> LZ.ByteString -> LZ.ByteString) -> Enciphered -> LZ.ByteString
39withIV f (EncipheredWithIV s) = f iv bs
40 where
41 Just iv = Vincent.makeIV (toStrictBS ivbs)
42 (ivbs,bs) = LZ.splitAt (fromIntegral ivlen) s
43 ivlen = Vincent.byteableLength z
44 z = Vincent.nullIV
45 _ = Vincent.constEqBytes z iv
46withIV f (EncipheredZeroIV s) = f Vincent.nullIV s
47
48decryptSecretKey ::
49 BS.ByteString -- ^ Passphrase
50 -> OpenPGP.Packet -- ^ Encrypted SecretKeyPacket
51 -> Maybe OpenPGP.Packet -- ^ Decrypted SecretKeyPacket
52decryptSecretKey pass k@(OpenPGP.SecretKeyPacket {
53 OpenPGP.version = 4, OpenPGP.key_algorithm = kalgo,
54 OpenPGP.s2k = s2k, OpenPGP.symmetric_algorithm = salgo,
55 OpenPGP.key = existing, OpenPGP.encrypted_data = encd
56 }) | chkF material == toStrictBS chk =
57 fmap (\m -> k {
58 OpenPGP.s2k_useage = 0,
59 OpenPGP.symmetric_algorithm = OpenPGP.Unencrypted,
60 OpenPGP.encrypted_data = LZ.empty,
61 OpenPGP.key = m
62 }) parseMaterial
63 | otherwise = Nothing
64 where
65 parseMaterial = maybeGet
66 (foldM (\m f -> do {mpi <- get; return $ (f,mpi):m}) existing
67 (OpenPGP.secret_key_fields kalgo)) material
68 (material, chk) = LZ.splitAt (LZ.length decd - chkSize) decd
69 (chkSize, chkF)
70 | OpenPGP.s2k_useage k == 254 = (20, SHA1.hash . toStrictBS)
71 | otherwise = (2, toStrictBS . encode . checksum . toStrictBS)
72 -- Words16s are written as 2 bytes in big-endian (network) order
73 decd = string2sdecrypt salgo s2k (toLazyBS pass) (EncipheredWithIV encd)
74
75 checksum :: BS.ByteString -> Word16
76 checksum key = fromIntegral $
77 BS.foldl' (\x y -> x + fromIntegral y) (0::Integer) key `mod` 65536
78
79decryptSecretKey _ _ = Nothing
80
81
82#if MIN_VERSION_binary(0,6,4)
83maybeGet :: (Binary a) => Get a -> LZ.ByteString -> Maybe a
84maybeGet g bs = (\(_,_,x) -> x) <$> hush (runGetOrFail g bs)
85 where
86 hush :: Either a b -> Maybe b
87 hush (Left _) = Nothing
88 hush (Right x) = Just x
89#else
90maybeGet :: (Binary a) => Get a -> LZ.ByteString -> Maybe a
91maybeGet g bs = unsafePerformIO $
92 handle (\(ErrorCall _)-> return Nothing) $ return . Just $ runGet g bs
93#endif
94
95
96
97string2sdecrypt :: OpenPGP.SymmetricAlgorithm -> OpenPGP.S2K -> LZ.ByteString -> Enciphered -> LZ.ByteString
98string2sdecrypt OpenPGP.AES128 s2k s = withIV $ simpleUnCFB (string2key s2k s :: Vincent.AES128)
99string2sdecrypt OpenPGP.AES192 s2k s = withIV $ simpleUnCFB (string2key s2k s :: Vincent.AES192)
100string2sdecrypt OpenPGP.AES256 s2k s = withIV $ simpleUnCFB (string2key s2k s :: Vincent.AES256)
101string2sdecrypt OpenPGP.Blowfish s2k s = withIV $ simpleUnCFB (string2key s2k s :: Vincent.Blowfish128)
102string2sdecrypt OpenPGP.CAST5 s2k s = withIV $ simpleUnCFB (string2key s2k s :: ThomasToVincent CAST5_128)
103string2sdecrypt algo _ _ = error $ "Unsupported symmetric algorithm : " ++ show algo ++ " in Data.OpenPGP.CryptoAPI.string2sdecrypt"
104
105simpleUnCFB :: (Vincent.BlockCipher k) => k -> Vincent.IV k -> LZ.ByteString -> LZ.ByteString
106simpleUnCFB k iv = padThenUnpad k (toLazyBS . Vincent.cfbDecrypt k iv . toStrictBS)
107 where
108 padThenUnpad :: (Vincent.BlockCipher k) => k -> (LZ.ByteString -> LZ.ByteString) -> LZ.ByteString -> LZ.ByteString
109 padThenUnpad k f s = dropPadEnd (f padded)
110 where
111 dropPadEnd s = LZ.take (LZ.length s - padAmount) s
112 padded = s `LZ.append` LZ.replicate padAmount 0
113 padAmount = blksize - (LZ.length s `mod` blksize)
114 blksize = fromIntegral $ Vincent.blockSize k
115
116string2key :: (Vincent.BlockCipher k) => OpenPGP.S2K -> LZ.ByteString -> k
117string2key s2k s = cipher
118 where
119 cipher = Vincent.cipherInit k
120 Right k = Vincent.makeKey $ toStrictBS $
121 LZ.take ksize $ OpenPGP.string2key hashBySymbol s2k s
122 ksize = case Vincent.cipherKeySize cipher of
123 Vincent.KeySizeFixed n -> fromIntegral n
124 Vincent.KeySizeEnum xs -> error $ "Unknown key size in string2key"
125 Vincent.KeySizeRange min max -> error $ "Unknown key size range in string2key"
126
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 @@
1module Data.OpenPGP.Util.Fingerprint (fingerprint) where
2
3import qualified Data.OpenPGP as OpenPGP
4import qualified Data.ByteString as BS
5import qualified Data.ByteString.Lazy as LZ
6import Data.Char (toUpper)
7import Data.Word (Word8)
8import Numeric (showHex)
9
10import Crypto.Hash.MD5 as MD5
11import Crypto.Hash.SHA1 as SHA1
12
13-- | Generate a key fingerprint from a PublicKeyPacket or SecretKeyPacket
14-- <http://tools.ietf.org/html/rfc4880#section-12.2>
15fingerprint :: OpenPGP.Packet -> String
16fingerprint p
17 | OpenPGP.version p == 4 = hexify $ SHA1.hashlazy material
18 | OpenPGP.version p `elem` [2, 3] = hexify $ MD5.hashlazy material
19 | otherwise = error "Unsupported Packet version or type in fingerprint"
20 where
21 material = LZ.concat $ OpenPGP.fingerprint_material p
22
23 hexify = map toUpper . hexString . BS.unpack
24
25 hexString :: [Word8] -> String
26 hexString = foldr (pad `oo` showHex) ""
27 where
28 pad s | odd $ length s = '0':s
29 | otherwise = s
30
31 oo :: (b -> c) -> (a -> a1 -> b) -> a -> a1 -> c
32 oo = (.) . (.)
33
diff --git a/Data/OpenPGP/Util/Sign.hs b/Data/OpenPGP/Util/Sign.hs
new file mode 100644
index 0000000..4a6eb4f
--- /dev/null
+++ b/Data/OpenPGP/Util/Sign.hs
@@ -0,0 +1,170 @@
1{-# LANGUAGE ScopedTypeVariables #-}
2module Data.OpenPGP.Util.Sign where
3
4import qualified Data.OpenPGP as OpenPGP
5import Data.Maybe
6import Data.Binary (encode)
7import qualified Data.ByteString as BS
8import qualified Data.ByteString.Lazy as LZ
9import Data.Bits ( (.|.), shiftL )
10import Control.Applicative ( (<$>) )
11import Data.Time.Clock.POSIX
12import Control.Exception as Exception (IOException(..),catch)
13
14import Data.OpenPGP.Util.Fingerprint (fingerprint)
15
16import qualified Crypto.Random as Vincent
17import qualified Crypto.PubKey.DSA as Vincent.DSA
18import qualified Crypto.PubKey.RSA as Vincent.RSA
19import qualified Crypto.PubKey.RSA.PKCS15 as Vincent.RSA
20import qualified Crypto.PubKey.ECC.ECDSA as Vincent.ECDSA
21
22import Data.OpenPGP.Util.Base
23
24privateECDSAkey :: OpenPGP.Packet -> Vincent.ECDSA.PrivateKey
25privateECDSAkey k = Vincent.ECDSA.PrivateKey curve d
26 where
27 d = keyParam 'd' k
28 curve = curveFromOID (keyParam 'c' k)
29
30privateDSAkey :: OpenPGP.Packet -> Vincent.DSA.PrivateKey
31privateDSAkey k = Vincent.DSA.PrivateKey
32 (Vincent.DSA.Params (keyParam 'p' k) (keyParam 'g' k) (keyParam 'q' k))
33 (keyParam 'x' k)
34privateRSAkey :: OpenPGP.Packet -> Vincent.RSA.PrivateKey
35privateRSAkey k =
36 -- Invert p and q because u is pinv not qinv
37 Vincent.RSA.PrivateKey pubkey d q p
38 (d `mod` (q-1))
39 (d `mod` (p-1))
40 (keyParam 'u' k)
41 where
42 d = keyParam 'd' k
43 p = keyParam 'p' k
44 q = keyParam 'q' k
45 pubkey = rsaKey k
46
47
48
49-- | Make a signature
50--
51-- In order to set more options on a signature, pass in a signature packet.
52-- Operation is unsafe in that it silently re-uses "random" bytes when
53-- entropy runs out. Use pgpSign for a safer interface.
54unsafeSign :: (Vincent.CPRG g) => -- CryptoRandomGen g) =>
55 OpenPGP.Message -- ^ SecretKeys, one of which will be used
56 -> OpenPGP.SignatureOver -- ^ Data to sign, and optional signature packet
57 -> OpenPGP.HashAlgorithm -- ^ HashAlgorithm to use in signature
58 -> String -- ^ KeyID of key to choose
59 -> Integer -- ^ Timestamp for signature (unless sig supplied)
60 -> g -- ^ Random number generator
61 -> (OpenPGP.SignatureOver, g)
62unsafeSign keys over hsh keyid timestamp g = (over {OpenPGP.signatures_over = [sig]}, g')
63 where
64 (final, g') = case OpenPGP.key_algorithm sig of
65 OpenPGP.DSA -> ([dsaR, dsaS], dsaG)
66 OpenPGP.ECDSA -> ([ecdsaR,ecdsaS],ecdsaG)
67 kalgo | kalgo `elem` [OpenPGP.RSA,OpenPGP.RSA_S] -> ([toNum rsaFinal], g)
68 | otherwise ->
69 error ("Unsupported key algorithm " ++ show kalgo ++ " in sign")
70 (Vincent.DSA.Signature dsaR dsaS,dsaG) = let k' = privateDSAkey k in
71 Vincent.DSA.sign g k' (dsaTruncate k' . bhash) dta
72 (Vincent.ECDSA.Signature ecdsaR ecdsaS,ecdsaG) = let k' = privateECDSAkey k in
73 Vincent.ECDSA.sign g k' bhash dta
74 (Right rsaFinal,_) = Vincent.RSA.signSafer g desc (privateRSAkey k) dta
75 dsaTruncate (Vincent.DSA.PrivateKey (Vincent.DSA.Params _ _ q) _) = BS.take (integerBytesize q)
76 dta = toStrictBS $ encode over `LZ.append` OpenPGP.trailer sig
77 sig = findSigOrDefault (listToMaybe $ OpenPGP.signatures_over over)
78 -- padding = emsa_pkcs1_v1_5_hash_padding hsh
79 desc = hashAlgoDesc hsh
80 bhash = hashBySymbol hsh . toLazyBS
81 toNum = BS.foldl (\a b -> a `shiftL` 8 .|. fromIntegral b) 0
82 Just k = find_key keys keyid
83
84 -- Either a SignaturePacket was found, or we need to make one
85 findSigOrDefault (Just s) = OpenPGP.signaturePacket
86 (OpenPGP.version s)
87 (OpenPGP.signature_type s)
88 (OpenPGP.key_algorithm k) -- force to algo of key
89 hsh -- force hash algorithm
90 (OpenPGP.hashed_subpackets s)
91 (OpenPGP.unhashed_subpackets s)
92 (OpenPGP.hash_head s)
93 (map OpenPGP.MPI final)
94 findSigOrDefault Nothing = OpenPGP.signaturePacket
95 4
96 defaultStype
97 (OpenPGP.key_algorithm k) -- force to algo of key
98 hsh
99 ([
100 -- Do we really need to pass in timestamp just for the default?
101 OpenPGP.SignatureCreationTimePacket $ fromIntegral timestamp,
102 OpenPGP.IssuerPacket $ fingerprint k
103 ] ++ (case over of
104 OpenPGP.KeySignature {} -> [OpenPGP.KeyFlagsPacket {
105 OpenPGP.certify_keys = True,
106 OpenPGP.sign_data = True,
107 OpenPGP.encrypt_communication = False,
108 OpenPGP.encrypt_storage = False,
109 OpenPGP.split_key = False,
110 OpenPGP.authentication = False,
111 OpenPGP.group_key = False
112 }]
113 _ -> []
114 ))
115 []
116 0 -- TODO
117 (map OpenPGP.MPI final)
118
119 defaultStype = case over of
120 OpenPGP.DataSignature ld _
121 | OpenPGP.format ld == 'b' -> 0x00
122 | otherwise -> 0x01
123 OpenPGP.KeySignature {} -> 0x1F
124 OpenPGP.SubkeySignature {} -> 0x18
125 OpenPGP.CertificationSignature {} -> 0x13
126
127
128
129now = floor <$> Data.Time.Clock.POSIX.getPOSIXTime
130
131stampit timestamp sig = sig { OpenPGP.hashed_subpackets = hashed' }
132 where
133 hashed_stamps = filter isStamp (OpenPGP.hashed_subpackets sig)
134 unhashed_stamps = filter isStamp (OpenPGP.unhashed_subpackets sig)
135 hashed' = case hashed_stamps ++ unhashed_stamps of
136 [] -> OpenPGP.SignatureCreationTimePacket (fromIntegral timestamp)
137 : OpenPGP.hashed_subpackets sig
138 _ -> OpenPGP.hashed_subpackets sig
139 isStamp (OpenPGP.SignatureCreationTimePacket {}) = True
140 isStamp _ = False
141
142-- | Make a signature
143--
144-- In order to set more options on a signature, pass in a signature packet.
145pgpSign ::
146 OpenPGP.Message -- ^ SecretKeys, one of which will be used
147 -> OpenPGP.SignatureOver -- ^ Data to sign, and optional signature packet
148 -> OpenPGP.HashAlgorithm -- ^ HashAlgorithm to use in signature
149 -> String -- ^ KeyID of key to choose
150 -> IO (Maybe OpenPGP.SignatureOver)
151pgpSign seckeys dta hash_algo keyid =
152 handleIO_ (return Nothing) $ do
153 timestamp <- now
154 -- g <- Thomas.newGenIO :: IO Thomas.SystemRandom
155 g <- fmap Vincent.cprgCreate $ Vincent.createEntropyPool
156 let _ = g :: Vincent.SystemRNG
157 let sigs = map (stampit timestamp) $ OpenPGP.signatures_over dta
158 dta' = dta { OpenPGP.signatures_over = sigs }
159 let (r,g') = unsafeSign seckeys dta' hash_algo keyid timestamp g
160 return (Just r)
161
162catchIO_ :: IO a -> IO a -> IO a
163catchIO_ a h = Exception.catch a (\(_ :: IOException) -> h)
164
165catchIO :: IO a -> (IOException -> IO a) -> IO a
166catchIO body handler = Exception.catch body handler
167
168handleIO_ = flip catchIO_
169handleIO = flip catchIO
170
diff --git a/Data/OpenPGP/Util/Verify.hs b/Data/OpenPGP/Util/Verify.hs
new file mode 100644
index 0000000..b42e664
--- /dev/null
+++ b/Data/OpenPGP/Util/Verify.hs
@@ -0,0 +1,74 @@
1{-# LANGUAGE OverloadedStrings #-}
2module Data.OpenPGP.Util.Verify where
3
4import Debug.Trace
5import qualified Data.OpenPGP as OpenPGP
6import Data.Maybe
7import Data.Binary (encode)
8import Control.Monad
9import qualified Data.ByteString as BS
10import qualified Data.ByteString.Lazy as LZ
11
12import qualified Crypto.PubKey.DSA as Vincent.DSA
13import qualified Crypto.PubKey.RSA.PKCS15 as Vincent.RSA
14import qualified Crypto.PubKey.ECC.ECDSA as Vincent.ECDSA
15-- import Math.NumberTheory.Moduli
16
17import Data.OpenPGP.Util.Base
18
19
20dsaKey :: OpenPGP.Packet -> Vincent.DSA.PublicKey
21dsaKey k = Vincent.DSA.PublicKey
22 (Vincent.DSA.Params (keyParam 'p' k) (keyParam 'g' k) (keyParam 'q' k))
23 (keyParam 'y' k)
24
25
26{-
27applyCurve :: Vincent.ECDSA.CurveCommon -> Integer -> Integer
28applyCurve curve x = x*x*x + x*a + b
29 where
30 a = Vincent.ECDSA.ecc_a curve
31 b = Vincent.ECDSA.ecc_b curve
32-}
33
34-- | Verify a message signature
35verify ::
36 OpenPGP.Message -- ^ Keys that may have made the signature
37 -> OpenPGP.SignatureOver -- ^ Signatures to verify
38 -> OpenPGP.SignatureOver -- ^ Will only contain signatures that passed
39verify keys over =
40 over {OpenPGP.signatures_over = mapMaybe (uncurry $ verifyOne keys) sigs}
41 where
42 sigs = map (\s -> (s, toStrictBS $ encode over `LZ.append` OpenPGP.trailer s))
43 (OpenPGP.signatures_over over)
44
45verifyOne :: OpenPGP.Message -> OpenPGP.Packet -> BS.ByteString -> Maybe OpenPGP.Packet
46verifyOne keys sig over = fmap (const sig) $ maybeKey >>= verification >>= guard
47 where
48 verification = case OpenPGP.key_algorithm sig of
49 OpenPGP.DSA -> dsaVerify
50 OpenPGP.ECDSA -> ecdsaVerify
51 alg | alg `elem` [OpenPGP.RSA,OpenPGP.RSA_S] -> rsaVerify
52 | otherwise -> const Nothing
53 dsaVerify k = let k' = dsaKey k in
54 Just $ Vincent.DSA.verify (dsaTruncate k' . bhash) k' dsaSig over
55 ecdsaVerify k = let k' = ecdsaKey k
56 r = Just $ Vincent.ECDSA.verify bhash k' ecdsaSig over
57 in r -- trace ("ecdsaVerify: "++show r) r
58 rsaVerify k = Just $ Vincent.RSA.verify desc (rsaKey k) over rsaSig
59 [rsaSig] = map (toStrictBS . LZ.drop 2 . encode) (OpenPGP.signature sig)
60 dsaSig = let [OpenPGP.MPI r, OpenPGP.MPI s] = OpenPGP.signature sig in
61 Vincent.DSA.Signature r s
62 ecdsaSig = let [OpenPGP.MPI r, OpenPGP.MPI s] = OpenPGP.signature sig in
63 Vincent.ECDSA.Signature r s
64 dsaTruncate (Vincent.DSA.PublicKey (Vincent.DSA.Params _ _ q) _) = BS.take (integerBytesize q)
65 {-
66 ecdsaTruncate (Vincent.ECDSA.PublicKey _ (Vincent.ECDSA.Point x y)) = BS.take (integerBytesize x
67 + integerBytesize y )
68 -}
69 bhash = hashBySymbol hash_algo . toLazyBS
70 desc = hashAlgoDesc hash_algo
71 hash_algo = OpenPGP.hash_algorithm sig
72 maybeKey = OpenPGP.signature_issuer sig >>= find_key keys
73 -- in trace ("maybeKey="++show (fmap OpenPGP.key_algorithm r)) r
74