-- | This is a wrapper around -- that currently does fingerprint generation and signature verification. -- -- The recommended way to import this module is: -- -- > import qualified Data.OpenPGP.Crypto as OpenPGP module Data.OpenPGP.Crypto (sign, verify, fingerprint) where import Data.Word import Data.List (find) import Data.Map ((!)) import qualified Data.ByteString.Lazy as LZ import Data.Binary import Codec.Utils (fromOctets) import qualified Codec.Encryption.RSA as RSA import qualified Data.Digest.MD5 as MD5 import qualified Data.Digest.SHA1 as SHA1 import qualified Data.Digest.SHA256 as SHA256 import qualified Data.Digest.SHA384 as SHA384 import qualified Data.Digest.SHA512 as SHA512 import qualified Data.OpenPGP as OpenPGP import qualified Data.BaseConvert as BaseConvert -- | Generate a key fingerprint from a PublicKeyPacket or SecretKeyPacket -- fingerprint :: OpenPGP.Packet -> String fingerprint p | OpenPGP.version p == 4 = BaseConvert.toString 16 $ SHA1.toInteger $ SHA1.hash $ LZ.unpack (LZ.concat (OpenPGP.fingerprint_material p)) fingerprint p | OpenPGP.version p `elem` [2, 3] = concatMap (BaseConvert.toString 16) $ MD5.hash $ LZ.unpack (LZ.concat (OpenPGP.fingerprint_material p)) fingerprint _ = error "Unsupported Packet version or type in fingerprint." find_key :: OpenPGP.Message -> String -> Maybe OpenPGP.Packet find_key (OpenPGP.Message (x@(OpenPGP.PublicKeyPacket {}):xs)) keyid = find_key_ x xs keyid find_key (OpenPGP.Message (x@(OpenPGP.SecretKeyPacket {}):xs)) keyid = find_key_ x xs keyid find_key _ _ = Nothing find_key_ :: OpenPGP.Packet -> [OpenPGP.Packet] -> String -> Maybe OpenPGP.Packet find_key_ x xs keyid = if thisid == keyid then Just x else find_key (OpenPGP.Message xs) keyid where thisid = reverse $ take (length keyid) (reverse (fingerprint x)) keyfield_as_octets :: OpenPGP.Packet -> Char -> [Word8] keyfield_as_octets k f = LZ.unpack $ LZ.drop 2 (encode (k' ! f)) where k' = OpenPGP.key k -- http://tools.ietf.org/html/rfc3447#page-43 emsa_pkcs1_v1_5_hash_padding :: OpenPGP.HashAlgorithm -> [Word8] emsa_pkcs1_v1_5_hash_padding OpenPGP.MD5 = [0x30, 0x20, 0x30, 0x0c, 0x06, 0x08, 0x2a, 0x86, 0x48, 0x86, 0xf7, 0x0d, 0x02, 0x05, 0x05, 0x00, 0x04, 0x10] emsa_pkcs1_v1_5_hash_padding OpenPGP.SHA1 = [0x30, 0x21, 0x30, 0x09, 0x06, 0x05, 0x2b, 0x0e, 0x03, 0x02, 0x1a, 0x05, 0x00, 0x04, 0x14] emsa_pkcs1_v1_5_hash_padding OpenPGP.SHA256 = [0x30, 0x31, 0x30, 0x0d, 0x06, 0x09, 0x60, 0x86, 0x48, 0x01, 0x65, 0x03, 0x04, 0x02, 0x01, 0x05, 0x00, 0x04, 0x20] emsa_pkcs1_v1_5_hash_padding OpenPGP.SHA384 = [0x30, 0x41, 0x30, 0x0d, 0x06, 0x09, 0x60, 0x86, 0x48, 0x01, 0x65, 0x03, 0x04, 0x02, 0x02, 0x05, 0x00, 0x04, 0x30] emsa_pkcs1_v1_5_hash_padding OpenPGP.SHA512 = [0x30, 0x51, 0x30, 0x0d, 0x06, 0x09, 0x60, 0x86, 0x48, 0x01, 0x65, 0x03, 0x04, 0x02, 0x03, 0x05, 0x00, 0x04, 0x40] emsa_pkcs1_v1_5_hash_padding _ = error "Unsupported HashAlgorithm in emsa_pkcs1_v1_5_hash_padding." hash :: OpenPGP.HashAlgorithm -> [Word8] -> [Word8] hash OpenPGP.MD5 = MD5.hash hash OpenPGP.SHA1 = reverse . drop 2 . LZ.unpack . encode . OpenPGP.MPI . SHA1.toInteger . SHA1.hash hash OpenPGP.SHA256 = SHA256.hash hash OpenPGP.SHA384 = SHA384.hash hash OpenPGP.SHA512 = SHA512.hash hash _ = error "Unsupported HashAlgorithm in hash." emsa_pkcs1_v1_5_encode :: [Word8] -> Int -> OpenPGP.HashAlgorithm -> [Word8] emsa_pkcs1_v1_5_encode m emLen algo = [0, 1] ++ replicate (emLen - length t - 3) 0xff ++ [0] ++ t where t = emsa_pkcs1_v1_5_hash_padding algo ++ hash algo m -- | Verify a message signature. Only supports RSA keys for now. verify :: OpenPGP.Message -- ^ Keys that may have made the signature -> OpenPGP.Message -- ^ Message containing data and signature packet -> Int -- ^ Index of signature to verify (0th, 1st, etc) -> Bool verify keys message sigidx = encoded == RSA.encrypt (n, e) raw_sig where raw_sig = LZ.unpack $ LZ.drop 2 $ encode (OpenPGP.signature sig) encoded = emsa_pkcs1_v1_5_encode signature_over (length n) (OpenPGP.hash_algorithm sig) signature_over = LZ.unpack $ dta `LZ.append` OpenPGP.trailer sig (n, e) = (keyfield_as_octets k 'n', keyfield_as_octets k 'e') Just k = find_key keys issuer Just issuer = OpenPGP.signature_issuer sig sig = sigs !! sigidx (sigs, (OpenPGP.LiteralDataPacket {OpenPGP.content = dta}):_) = OpenPGP.signatures_and_data message -- | Sign a message. Only supports RSA keys for now. sign :: OpenPGP.Message -- ^ SecretKeys, one of which will be used -> OpenPGP.Message -- ^ Message containing LiteralData to sign -> OpenPGP.HashAlgorithm -- ^ HashAlgorithm to use is signature -> String -- ^ KeyID of key to choose or @[]@ for first -> Integer -- ^ Timestamp to put in signature -> OpenPGP.Message sign keys message hsh keyid timestamp = OpenPGP.Message $ (sig' { OpenPGP.signature = OpenPGP.MPI $ toNum $ reverse final, OpenPGP.hash_head = toNum $ take 2 final }):m where -- toNum has explicit param so that it can remain polymorphic toNum l = fromOctets (256::Integer) l final = RSA.decrypt (n, d) encoded encoded = emsa_pkcs1_v1_5_encode dta (length n) hsh (n, d) = (keyfield_as_octets k 'n', keyfield_as_octets k 'd') dta = LZ.unpack $ LZ.append (OpenPGP.content dataP) (OpenPGP.trailer sig') sig' = sig { OpenPGP.trailer = OpenPGP.calculate_signature_trailer sig } sig = OpenPGP.SignaturePacket { OpenPGP.version = 4, OpenPGP.key_algorithm = OpenPGP.RSA, OpenPGP.hash_algorithm = hsh, OpenPGP.signature_type = stype, OpenPGP.hashed_subpackets = [ OpenPGP.SignatureCreationTimePacket $ fromIntegral timestamp, OpenPGP.IssuerPacket keyid' ], OpenPGP.unhashed_subpackets = [], OpenPGP.signature = undefined, OpenPGP.trailer = undefined, OpenPGP.hash_head = undefined } keyid' = reverse $ take 16 $ reverse $ fingerprint k stype = if OpenPGP.format dataP == 'b' then 0x00 else 0x01 Just k = find_key keys keyid Just dataP = find isLiteralData m OpenPGP.Message m = message isLiteralData (OpenPGP.LiteralDataPacket {}) = True isLiteralData _ = False