hOpenPGP-2.10.1/0000755000000000000000000000000007346545000011404 5ustar0000000000000000hOpenPGP-2.10.1/Codec/Encryption/OpenPGP/0000755000000000000000000000000007346545000016023 5ustar0000000000000000hOpenPGP-2.10.1/Codec/Encryption/OpenPGP/Arbitrary.hs0000644000000000000000000001523307346545000020322 0ustar0000000000000000-- Arbitrary.hs: QuickCheck instances -- Copyright © 2014-2019 Clint Adams -- This software is released under the terms of the Expat license. -- (See the LICENSE file). module Codec.Encryption.OpenPGP.Arbitrary ( ) where import Codec.Encryption.OpenPGP.Types import qualified Data.ByteString.Lazy as BL import qualified Data.List.NonEmpty as NE import Data.Maybe (fromMaybe) import Network.URI (nullURI, parseURI) import Test.QuickCheck ( Arbitrary(..) , choose , elements , frequency , getPositive , listOf1 , oneof , vector ) import Test.QuickCheck.Instances () instance Arbitrary PKESK where arbitrary = do pv <- arbitrary eoki <- arbitrary pka <- arbitrary PKESK pv eoki pka <$> arbitrary instance Arbitrary Signature where arbitrary = fmap Signature arbitrary instance Arbitrary UserId where arbitrary = fmap UserId arbitrary -- instance Arbitrary SignaturePayload where arbitrary = frequency [(2, three), (3, four), (1, other)] where three = do st <- arbitrary w32 <- arbitrary eoki <- arbitrary pka <- arbitrary ha <- arbitrary w16 <- arbitrary SigV3 st w32 eoki pka ha w16 <$> arbitrary four = do st <- arbitrary pka <- arbitrary ha <- arbitrary has <- arbitrary uhas <- arbitrary w16 <- arbitrary SigV4 st pka ha has uhas w16 <$> arbitrary other = do v <- choose (5, maxBound) SigVOther v <$> arbitrary instance Arbitrary SigSubPacket where arbitrary = do crit <- arbitrary SigSubPacket crit <$> arbitrary instance Arbitrary SigSubPacketPayload where arbitrary = oneof [ sct , set , ec , ts , re , ket , psa , rk , i , nd , phas , pcas , ksps , pks , puid , purl , kfs , suid , rfr , fs , st , udss , oss , ifp ] {-, es -} where sct = fmap SigCreationTime arbitrary set = fmap SigExpirationTime arbitrary ec = fmap ExportableCertification arbitrary ts = arbitrary >>= \tl -> arbitrary >>= \ta -> return (TrustSignature tl ta) re = fmap RegularExpression arbitrary ket = fmap KeyExpirationTime arbitrary psa = fmap PreferredSymmetricAlgorithms arbitrary rk = arbitrary >>= \rcs -> arbitrary >>= \pka -> arbitrary >>= \tof -> return (RevocationKey rcs pka tof) i = fmap Issuer arbitrary nd = arbitrary >>= \nfs -> arbitrary >>= \nn -> arbitrary >>= \nv -> return (NotationData nfs nn nv) phas = fmap PreferredHashAlgorithms arbitrary pcas = fmap PreferredCompressionAlgorithms arbitrary ksps = fmap KeyServerPreferences arbitrary pks = fmap PreferredKeyServer arbitrary puid = fmap PrimaryUserId arbitrary purl = fmap (PolicyURL . URL . fromMaybe nullURI . parseURI) arbitrary kfs = fmap KeyFlags arbitrary suid = fmap SignersUserId arbitrary rfr = arbitrary >>= \rc -> arbitrary >>= \rr -> return (ReasonForRevocation rc rr) fs = fmap Features arbitrary st = arbitrary >>= \pka -> arbitrary >>= \ha -> arbitrary >>= \sh -> return (SignatureTarget pka ha sh) es = fmap EmbeddedSignature arbitrary -- FIXME: figure out why EmbeddedSignature fails to serialize properly ifp = choose (4, 5) >>= \v -> fmap (IssuerFingerprint v) (if v == 4 then arbitrary else fmap (TwentyOctetFingerprint . BL.pack) (vector 32)) udss = choose (100, 110) >>= \a -> arbitrary >>= \b -> return (UserDefinedSigSub a b) oss = choose (111, 127) >>= \a -> arbitrary >>= \b -> return (OtherSigSub a b) -- FIXME: more comprehensive range -- instance Arbitrary PubKeyAlgorithm where arbitrary = elements [RSA, DSA, ECDH, ECDSA, DH, EdDSA] instance Arbitrary EightOctetKeyId where arbitrary = fmap (EightOctetKeyId . BL.pack) (vector 8) instance Arbitrary TwentyOctetFingerprint where arbitrary = fmap (TwentyOctetFingerprint . BL.pack) (vector 20) instance Arbitrary MPI where arbitrary = fmap (MPI . getPositive) arbitrary instance Arbitrary SigType where arbitrary = elements [ BinarySig , CanonicalTextSig , StandaloneSig , GenericCert , PersonaCert , CasualCert , PositiveCert , SubkeyBindingSig , PrimaryKeyBindingSig , SignatureDirectlyOnAKey , KeyRevocationSig , SubkeyRevocationSig , CertRevocationSig , TimestampSig , ThirdPartyConfirmationSig ] instance Arbitrary HashAlgorithm where arbitrary = elements [DeprecatedMD5, SHA1, RIPEMD160, SHA256, SHA384, SHA512, SHA224] instance Arbitrary SymmetricAlgorithm where arbitrary = elements [ Plaintext , IDEA , TripleDES , CAST5 , Blowfish , ReservedSAFER , ReservedDES , AES128 , AES192 , AES256 , Twofish , Camellia128 , Camellia192 , Camellia256 ] instance Arbitrary RevocationClass where arbitrary = frequency [(9, srk), (1, rco)] where srk = return SensitiveRK rco = fmap RClOther (choose (2, 7)) instance Arbitrary NotationFlag where arbitrary = frequency [(9, hr), (1, onf)] where hr = return HumanReadable onf = fmap OtherNF (choose (1, 31)) instance Arbitrary CompressionAlgorithm where arbitrary = elements [Uncompressed, ZIP, ZLIB, BZip2] instance Arbitrary KSPFlag where arbitrary = frequency [(9, nm), (1, kspo)] where nm = return NoModify kspo = fmap KSPOther (choose (2, 63)) instance Arbitrary KeyFlag where arbitrary = elements [ GroupKey , AuthKey , SplitKey , EncryptStorageKey , EncryptCommunicationsKey , SignDataKey , CertifyKeysKey ] instance Arbitrary RevocationCode where arbitrary = elements [ NoReason , KeySuperseded , KeyMaterialCompromised , KeyRetiredAndNoLongerUsed , UserIdInfoNoLongerValid ] instance Arbitrary FeatureFlag where arbitrary = frequency [(9, md), (1, fo)] where md = return ModificationDetection fo = fmap FeatureOther (choose (8, 63)) instance Arbitrary ThirtyTwoBitTimeStamp where arbitrary = fmap ThirtyTwoBitTimeStamp arbitrary instance Arbitrary ThirtyTwoBitDuration where arbitrary = fmap ThirtyTwoBitDuration arbitrary instance Arbitrary NotationName where arbitrary = fmap NotationName arbitrary instance Arbitrary NotationValue where arbitrary = fmap NotationValue arbitrary hOpenPGP-2.10.1/Codec/Encryption/OpenPGP/BlockCipher.hs0000644000000000000000000000621607346545000020551 0ustar0000000000000000-- BlockCipher.hs: OpenPGP (RFC4880) block cipher stuff -- Copyright © 2013-2024 Clint Adams -- This software is released under the terms of the Expat license. -- (See the LICENSE file). {-# LANGUAGE RankNTypes #-} module Codec.Encryption.OpenPGP.BlockCipher ( keySize , withSymmetricCipher ) where import Codec.Encryption.OpenPGP.Internal.CryptoCipherTypes (HOWrappedOldCCT(..)) import Codec.Encryption.OpenPGP.Internal.Crypton (HOWrappedCCT(..)) import Codec.Encryption.OpenPGP.Internal.HOBlockCipher import Codec.Encryption.OpenPGP.Types import qualified Crypto.Cipher.AES as AES import qualified Crypto.Cipher.Blowfish as Blowfish import qualified Crypto.Cipher.Camellia as Camellia import qualified Crypto.Cipher.TripleDES as TripleDES import qualified Crypto.Nettle.Ciphers as CNC import qualified Data.ByteString as B type HOCipher a = forall cipher. HOBlockCipher cipher => cipher -> Either String a withSymmetricCipher :: SymmetricAlgorithm -> B.ByteString -> HOCipher a -> Either String a withSymmetricCipher Plaintext _ _ = Left "this shouldn't have happened" -- FIXME: orphan instance? withSymmetricCipher IDEA _ _ = Left "IDEA not yet implemented" -- FIXME: IDEA withSymmetricCipher ReservedSAFER _ _ = Left "SAFER not implemented" -- FIXME: or not? withSymmetricCipher ReservedDES _ _ = Left "DES not implemented" -- FIXME: or not? withSymmetricCipher (OtherSA _) _ _ = Left "Unknown, unimplemented symmetric algorithm" withSymmetricCipher CAST5 key f = (cipherInit key :: Either String (HOWrappedOldCCT CNC.CAST128)) >>= f withSymmetricCipher Twofish key f = (cipherInit key :: Either String (HOWrappedOldCCT CNC.TWOFISH)) >>= f withSymmetricCipher TripleDES key f = (cipherInit key :: Either String (HOWrappedCCT TripleDES.DES_EDE3)) >>= f withSymmetricCipher Blowfish key f = (cipherInit key :: Either String (HOWrappedCCT Blowfish.Blowfish128)) >>= f withSymmetricCipher AES128 key f = (cipherInit key :: Either String (HOWrappedCCT AES.AES128)) >>= f withSymmetricCipher AES192 key f = (cipherInit key :: Either String (HOWrappedCCT AES.AES192)) >>= f withSymmetricCipher AES256 key f = (cipherInit key :: Either String (HOWrappedCCT AES.AES256)) >>= f withSymmetricCipher Camellia128 key f = (cipherInit key :: Either String (HOWrappedCCT Camellia.Camellia128)) >>= f withSymmetricCipher Camellia192 key f = (cipherInit key :: Either String (HOWrappedOldCCT CNC.Camellia192)) >>= f withSymmetricCipher Camellia256 key f = (cipherInit key :: Either String (HOWrappedOldCCT CNC.Camellia256)) >>= f -- in octets; FIXME: co-opt Cipher's cipherKeySize or not? keySize :: SymmetricAlgorithm -> Int keySize Plaintext = 0 keySize IDEA = 16 -- according to https://en.wikipedia.org/wiki/International_Data_Encryption_Algorithm keySize TripleDES = 24 -- RFC 4880 says 168 bits (derived from 192 bits) but we don't know who does the derivation keySize CAST5 = 16 keySize Blowfish = 16 keySize ReservedSAFER = undefined keySize ReservedDES = undefined keySize AES128 = 16 keySize AES192 = 24 keySize AES256 = 32 keySize Twofish = 32 keySize Camellia128 = 16 keySize Camellia192 = 24 keySize Camellia256 = 32 keySize (OtherSA _) = undefined hOpenPGP-2.10.1/Codec/Encryption/OpenPGP/CFB.hs0000644000000000000000000000674107346545000016761 0ustar0000000000000000-- CFB.hs: OpenPGP (RFC4880) CFB mode -- Copyright © 2013-2019 Clint Adams -- Copyright © 2013 Daniel Kahn Gillmor -- This software is released under the terms of the Expat license. -- (See the LICENSE file). module Codec.Encryption.OpenPGP.CFB ( decrypt , decryptPreservingNonce , decryptNoNonce , decryptOpenPGPCfb , encryptNoNonce ) where import Codec.Encryption.OpenPGP.BlockCipher (withSymmetricCipher) import Codec.Encryption.OpenPGP.Internal.HOBlockCipher import Codec.Encryption.OpenPGP.Types import qualified Data.ByteString as B decryptOpenPGPCfb :: SymmetricAlgorithm -> B.ByteString -> B.ByteString -> Either String B.ByteString decryptOpenPGPCfb Plaintext ciphertext _ = return ciphertext decryptOpenPGPCfb sa ciphertext keydata = withSymmetricCipher sa keydata $ \bc -> do nonce <- decrypt1 ciphertext bc cleartext <- decrypt2 ciphertext bc if nonceCheck bc nonce then return cleartext else Left "Session key quickcheck failed" where decrypt1 :: HOBlockCipher cipher => B.ByteString -> cipher -> Either String B.ByteString decrypt1 ct cipher = paddedCfbDecrypt cipher (B.replicate (blockSize cipher) 0) (B.take (blockSize cipher + 2) ct) decrypt2 :: HOBlockCipher cipher => B.ByteString -> cipher -> Either String B.ByteString decrypt2 ct cipher = let i = B.take (blockSize cipher) (B.drop 2 ct) in paddedCfbDecrypt cipher i (B.drop (blockSize cipher + 2) ct) -- should deprecate this? decrypt :: SymmetricAlgorithm -> B.ByteString -> B.ByteString -> Either String B.ByteString decrypt x y z = snd <$> (decryptPreservingNonce x y z) decryptPreservingNonce :: SymmetricAlgorithm -> B.ByteString -> B.ByteString -> Either String (B.ByteString, B.ByteString) decryptPreservingNonce Plaintext ciphertext _ = return (mempty, ciphertext) decryptPreservingNonce sa ciphertext keydata = withSymmetricCipher sa keydata $ \bc -> do (nonce, cleartext) <- fmap (B.splitAt (blockSize bc + 2)) (decrypt' ciphertext bc) if nonceCheck bc nonce then return (nonce, cleartext) else Left "Session key quickcheck failed" where decrypt' :: HOBlockCipher cipher => B.ByteString -> cipher -> Either String B.ByteString decrypt' ct cipher = paddedCfbDecrypt cipher (B.replicate (blockSize cipher) 0) ct decryptNoNonce :: SymmetricAlgorithm -> IV -> B.ByteString -> B.ByteString -> Either String B.ByteString decryptNoNonce Plaintext _ ciphertext _ = return ciphertext decryptNoNonce sa iv ciphertext keydata = withSymmetricCipher sa keydata (decrypt' ciphertext) where decrypt' :: HOBlockCipher cipher => B.ByteString -> cipher -> Either String B.ByteString decrypt' ct cipher = paddedCfbDecrypt cipher (unIV iv) ct nonceCheck :: HOBlockCipher cipher => cipher -> B.ByteString -> Bool nonceCheck bc = (==) <$> B.take 2 . B.drop (blockSize bc - 2) <*> B.drop (blockSize bc) encryptNoNonce :: SymmetricAlgorithm -> S2K -> IV -> B.ByteString -> B.ByteString -> Either String B.ByteString encryptNoNonce Plaintext _ _ payload _ = return payload encryptNoNonce sa s2k iv payload keydata = withSymmetricCipher sa keydata (encrypt' payload) where encrypt' :: HOBlockCipher cipher => B.ByteString -> cipher -> Either String B.ByteString encrypt' ct cipher = paddedCfbEncrypt cipher (unIV iv) ct hOpenPGP-2.10.1/Codec/Encryption/OpenPGP/Compression.hs0000644000000000000000000000245307346545000020664 0ustar0000000000000000-- Compression.hs: OpenPGP (RFC4880) compression and decompression -- Copyright © 2012-2015 Clint Adams -- This software is released under the terms of the Expat license. -- (See the LICENSE file). module Codec.Encryption.OpenPGP.Compression ( decompressPkt , compressPkts ) where import qualified Codec.Compression.BZip as BZip import qualified Codec.Compression.Zlib as Zlib import qualified Codec.Compression.Zlib.Raw as ZlibRaw import Codec.Encryption.OpenPGP.Serialize () import Codec.Encryption.OpenPGP.Types import Data.Binary (get, put) import Data.Binary.Get (runGetOrFail) import Data.Binary.Put (runPut) decompressPkt :: Pkt -> [Pkt] decompressPkt (CompressedDataPkt algo bs) = case runGetOrFail get (dfunc algo bs) of Left _ -> [] Right (_, _, packs) -> unBlock packs where dfunc ZIP = ZlibRaw.decompress dfunc ZLIB = Zlib.decompress dfunc BZip2 = BZip.decompress dfunc _ = error "Compression algorithm not supported" decompressPkt p = [p] compressPkts :: CompressionAlgorithm -> [Pkt] -> Pkt compressPkts ca packs = let bs = runPut $ put (Block packs) cbs = cfunc ca bs in CompressedDataPkt ca cbs where cfunc ZIP = ZlibRaw.compress cfunc ZLIB = Zlib.compress cfunc BZip2 = BZip.compress cfunc _ = error "Compression algorithm not supported" hOpenPGP-2.10.1/Codec/Encryption/OpenPGP/Expirations.hs0000644000000000000000000000252407346545000020667 0ustar0000000000000000-- Expirations.hs: OpenPGP (RFC4880) expiration checking -- Copyright © 2014-2015 Clint Adams -- This software is released under the terms of the Expat license. -- (See the LICENSE file). module Codec.Encryption.OpenPGP.Expirations ( isTKTimeValid , getKeyExpirationTimesFromSignature ) where import Control.Lens ((&), (^.), _1) import Data.Time.Clock (UTCTime) import Data.Time.Clock.POSIX (posixSecondsToUTCTime) import Codec.Encryption.OpenPGP.Ontology (isKET) import Codec.Encryption.OpenPGP.Types -- this assumes that all key expiration time subpackets are valid isTKTimeValid :: UTCTime -> TK -> Bool isTKTimeValid ct key = ct >= keyCreationTime && ct < keyExpirationTime where keyCreationTime = key ^. tkKey . _1 . timestamp & posixSecondsToUTCTime . realToFrac keyExpirationTime = posixSecondsToUTCTime . realToFrac . ((key ^. tkKey . _1 . timestamp & unThirtyTwoBitTimeStamp) +) . unThirtyTwoBitDuration . newest . concatMap getKeyExpirationTimesFromSignature $ (concatMap snd (key ^. tkUIDs) ++ concatMap snd (key ^. tkUAts)) newest [] = maxBound newest xs = maximum xs getKeyExpirationTimesFromSignature :: SignaturePayload -> [ThirtyTwoBitDuration] getKeyExpirationTimesFromSignature (SigV4 _ _ _ xs _ _ _) = map (\(SigSubPacket _ (KeyExpirationTime x)) -> x) $ filter isKET xs hOpenPGP-2.10.1/Codec/Encryption/OpenPGP/Fingerprint.hs0000644000000000000000000000401007346545000020641 0ustar0000000000000000-- Fingerprint.hs: OpenPGP (RFC4880) fingerprinting methods -- Copyright © 2012-2016 Clint Adams -- This software is released under the terms of the Expat license. -- (See the LICENSE file). module Codec.Encryption.OpenPGP.Fingerprint ( eightOctetKeyID , fingerprint ) where import Crypto.Hash (Digest, hashlazy) import Crypto.Hash.Algorithms (MD5, SHA1) import Crypto.Number.Serialize (i2osp) import qualified Crypto.PubKey.RSA as RSA import Data.Binary.Put (runPut) import qualified Data.ByteArray as BA import qualified Data.ByteString.Lazy as BL import Codec.Encryption.OpenPGP.SerializeForSigs (putPKPforFingerprinting) import Codec.Encryption.OpenPGP.Types eightOctetKeyID :: PKPayload -> Either String EightOctetKeyId eightOctetKeyID (PKPayload DeprecatedV3 _ _ RSA (RSAPubKey (RSA_PublicKey rp))) = (Right . EightOctetKeyId . BL.reverse . BL.take 4 . BL.reverse . BL.fromStrict . i2osp . RSA.public_n) rp eightOctetKeyID (PKPayload DeprecatedV3 _ _ DeprecatedRSAEncryptOnly (RSAPubKey (RSA_PublicKey rp))) = (Right . EightOctetKeyId . BL.reverse . BL.take 4 . BL.reverse . BL.fromStrict . i2osp . RSA.public_n) rp eightOctetKeyID (PKPayload DeprecatedV3 _ _ DeprecatedRSASignOnly (RSAPubKey (RSA_PublicKey rp))) = (Right . EightOctetKeyId . BL.reverse . BL.take 4 . BL.reverse . BL.fromStrict . i2osp . RSA.public_n) rp eightOctetKeyID (PKPayload DeprecatedV3 _ _ _ _) = Left "Cannot calculate the key ID of a non-RSA V3 key" eightOctetKeyID p4@(PKPayload V4 _ _ _ _) = (Right . EightOctetKeyId . BL.drop 12 . unTOF . fingerprint) p4 fingerprint :: PKPayload -> TwentyOctetFingerprint fingerprint p3@(PKPayload DeprecatedV3 _ _ _ _) = (TwentyOctetFingerprint . BL.fromStrict . BA.convert . (hashlazy :: BL.ByteString -> Digest MD5)) (runPut $ putPKPforFingerprinting (PublicKeyPkt p3)) fingerprint p4@(PKPayload V4 _ _ _ _) = (TwentyOctetFingerprint . BL.fromStrict . BA.convert . (hashlazy :: BL.ByteString -> Digest SHA1)) (runPut $ putPKPforFingerprinting (PublicKeyPkt p4)) hOpenPGP-2.10.1/Codec/Encryption/OpenPGP/Internal.hs0000644000000000000000000001242707346545000020141 0ustar0000000000000000-- Internal.hs: private utility functions and such -- Copyright © 2012-2019 Clint Adams -- This software is released under the terms of the Expat license. -- (See the LICENSE file). {-# LANGUAGE OverloadedStrings #-} module Codec.Encryption.OpenPGP.Internal ( countBits , PktStreamContext(..) , issuer , issuerFP , emptyPSC , pubkeyToMPIs , multiplicativeInverse , curveoidBSToCurve , curveToCurveoidBS , point2BS , curveoidBSToEdSigningCurve , edSigningCurveToCurveoidBS , curve2Curve , curveFromCurve ) where import Crypto.Number.Serialize (i2osp, os2ip) import qualified Crypto.PubKey.DSA as DSA import qualified Crypto.PubKey.ECC.ECDSA as ECDSA import qualified Crypto.PubKey.ECC.Types as ECCT import qualified Crypto.PubKey.RSA as RSA import Data.Bits (testBit) import qualified Data.ByteString as B import Data.ByteString.Lazy (ByteString) import qualified Data.ByteString.Lazy as BL import Data.List (find) import Data.Word (Word16, Word8) import Codec.Encryption.OpenPGP.Ontology (isIssuerSSP, isIssuerFPSSP, isSigCreationTime) import Codec.Encryption.OpenPGP.Types countBits :: ByteString -> Word16 countBits bs | BL.null bs = 0 | otherwise = fromIntegral (BL.length bs * 8) - fromIntegral (go (BL.head bs) 7) where go :: Word8 -> Int -> Word8 go _ 0 = 7 go n b = if testBit n b then 7 - fromIntegral b else go n (b - 1) data PktStreamContext = PktStreamContext { lastLD :: Pkt , lastUIDorUAt :: Pkt , lastSig :: Pkt , lastPrimaryKey :: Pkt , lastSubkey :: Pkt } emptyPSC :: PktStreamContext emptyPSC = PktStreamContext (OtherPacketPkt 0 "lastLD placeholder") (OtherPacketPkt 0 "lastUIDorUAt placeholder") (OtherPacketPkt 0 "lastSig placeholder") (OtherPacketPkt 0 "lastPrimaryKey placeholder") (OtherPacketPkt 0 "lastSubkey placeholder") issuer :: Pkt -> Maybe EightOctetKeyId issuer (SignaturePkt (SigV4 _ _ _ _ usubs _ _)) = fmap (\(SigSubPacket _ (Issuer i)) -> i) (find isIssuerSSP usubs) issuer _ = Nothing issuerFP :: Pkt -> Maybe TwentyOctetFingerprint issuerFP (SignaturePkt (SigV4 _ _ _ hsubs _ _ _)) = fmap (\(SigSubPacket _ (IssuerFingerprint _ i)) -> i) (find isIssuerFPSSP hsubs) issuerFP _ = Nothing pubkeyToMPIs :: PKey -> [MPI] pubkeyToMPIs (RSAPubKey (RSA_PublicKey k)) = [MPI (RSA.public_n k), MPI (RSA.public_e k)] pubkeyToMPIs (DSAPubKey (DSA_PublicKey k)) = [ pkParams DSA.params_p , pkParams DSA.params_q , pkParams DSA.params_g , MPI . DSA.public_y $ k ] where pkParams f = MPI . f . DSA.public_params $ k pubkeyToMPIs (ElGamalPubKey p g y) = [MPI p, MPI g, MPI y] pubkeyToMPIs (ECDHPubKey (ECDSAPubKey (ECDSA_PublicKey (ECDSA.PublicKey _ q))) _ _) = [MPI (os2ip (point2BS q))] pubkeyToMPIs (ECDHPubKey (EdDSAPubKey _ (EPoint x)) _ _) = [MPI x] pubkeyToMPIs (ECDSAPubKey ((ECDSA_PublicKey (ECDSA.PublicKey _ q)))) = [MPI (os2ip (point2BS q))] pubkeyToMPIs (EdDSAPubKey _ (EPoint x)) = [MPI x] multiplicativeInverse :: Integral a => a -> a -> a multiplicativeInverse _ 1 = 1 multiplicativeInverse q p = (n * q + 1) `div` p where n = p - multiplicativeInverse p (q `mod` p) curveoidBSToCurve :: B.ByteString -> Either String ECCCurve curveoidBSToCurve oidbs | B.pack [0x2A, 0x86, 0x48, 0xCE, 0x3D, 0x03, 0x01, 0x07] == oidbs = Right $ NISTP256 -- ECCT.getCurveByName ECCT.SEC_p256r1 | B.pack [0x2B, 0x81, 0x04, 0x00, 0x22] == oidbs = Right $ NISTP384 -- ECCT.getCurveByName ECCT.SEC_p384r1 | B.pack [0x2B, 0x81, 0x04, 0x00, 0x23] == oidbs = Right $ NISTP521 -- ECCT.getCurveByName ECCT.SEC_p521r1 | B.pack [0x2B, 0x06, 0x01, 0x04, 0x01, 0x97, 0x55, 0x01, 0x05, 0x01] == oidbs = Right Curve25519 | otherwise = Left $ concat ["unknown curve (...", show (B.unpack oidbs), ")"] curveToCurveoidBS :: ECCCurve -> Either String B.ByteString curveToCurveoidBS NISTP256 = Right $ B.pack [0x2A, 0x86, 0x48, 0xCE, 0x3D, 0x03, 0x01, 0x07] curveToCurveoidBS NISTP384 = Right $ B.pack [0x2B, 0x81, 0x04, 0x00, 0x22] curveToCurveoidBS NISTP521 = Right $ B.pack [0x2B, 0x81, 0x04, 0x00, 0x23] curveToCurveoidBS Curve25519 = Right $ B.pack [0x2B, 0x06, 0x01, 0x04, 0x01, 0x97, 0x55, 0x01, 0x05, 0x01] curveToCurveoidBS _ = Left "unknown curve" point2BS :: ECCT.PublicPoint -> B.ByteString point2BS (ECCT.Point x y) = B.concat [B.singleton 0x04, i2osp x, i2osp y] -- FIXME: check for length equality? point2BS ECCT.PointO = error "FIXME: point at infinity" curveoidBSToEdSigningCurve :: B.ByteString -> Either String EdSigningCurve curveoidBSToEdSigningCurve oidbs | B.pack [0x2B, 0x06, 0x01, 0x04, 0x01, 0xDA, 0x47, 0x0F, 0x01] == oidbs = Right Ed25519 | otherwise = Left $ concat ["unknown Edwards signing curve (...", show (B.unpack oidbs), ")"] edSigningCurveToCurveoidBS :: EdSigningCurve -> Either String B.ByteString edSigningCurveToCurveoidBS Ed25519 = Right $ B.pack [0x2B, 0x06, 0x01, 0x04, 0x01, 0xDA, 0x47, 0x0F, 0x01] curve2Curve :: ECCCurve -> ECCT.Curve curve2Curve NISTP256 = ECCT.getCurveByName ECCT.SEC_p256r1 curve2Curve NISTP384 = ECCT.getCurveByName ECCT.SEC_p384r1 curve2Curve NISTP521 = ECCT.getCurveByName ECCT.SEC_p521r1 curveFromCurve :: ECCT.Curve -> ECCCurve curveFromCurve c | c == ECCT.getCurveByName ECCT.SEC_p256r1 = NISTP256 | c == ECCT.getCurveByName ECCT.SEC_p384r1 = NISTP384 | c == ECCT.getCurveByName ECCT.SEC_p521r1 = NISTP521 hOpenPGP-2.10.1/Codec/Encryption/OpenPGP/Internal/0000755000000000000000000000000007346545000017577 5ustar0000000000000000hOpenPGP-2.10.1/Codec/Encryption/OpenPGP/Internal/CryptoCipherTypes.hs0000644000000000000000000000407107346545000023575 0ustar0000000000000000-- CryptoCipherTypes.hs: shim for crypto-cipher-types stuff (current nettle) -- Copyright © 2016-2024 Clint Adams -- This software is released under the terms of the Expat license. -- (See the LICENSE file). {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE PackageImports #-} {-# LANGUAGE UndecidableInstances #-} module Codec.Encryption.OpenPGP.Internal.CryptoCipherTypes ( HOWrappedOldCCT(..) ) where import Control.Error.Util (note) import qualified "crypto-cipher-types" Crypto.Cipher.Types as OldCCT import qualified "crypton" Crypto.Cipher.Types as CCT import qualified Data.ByteString as B import Codec.Encryption.OpenPGP.Internal.HOBlockCipher newtype HOWrappedOldCCT a = HWOCCT a instance OldCCT.BlockCipher cipher => HOBlockCipher (HOWrappedOldCCT cipher) where cipherInit = fmap HWOCCT . either (const (Left "nettle invalid key")) (Right . OldCCT.cipherInit) . OldCCT.makeKey cipherName (HWOCCT c) = OldCCT.cipherName c cipherKeySize (HWOCCT c) = convertKSS . OldCCT.cipherKeySize $ c blockSize (HWOCCT c) = OldCCT.blockSize c cfbEncrypt (HWOCCT c) iv bs = hammerIV iv >>= \i -> return (OldCCT.cfbEncrypt c i bs) cfbDecrypt (HWOCCT c) iv bs = hammerIV iv >>= \i -> return (OldCCT.cfbDecrypt c i bs) paddedCfbEncrypt _ _ _ = Left "padding for nettle-encryption not implemented yet" paddedCfbDecrypt (HWOCCT cipher) iv ciphertext = hammerIV iv >>= \i -> return (B.take (B.length ciphertext) (OldCCT.cfbDecrypt cipher i padded)) where padded = ciphertext `B.append` B.pack (replicate (OldCCT.blockSize cipher - (B.length ciphertext `mod` OldCCT.blockSize cipher)) 0) convertKSS :: OldCCT.KeySizeSpecifier -> CCT.KeySizeSpecifier convertKSS (OldCCT.KeySizeRange a b) = CCT.KeySizeRange a b convertKSS (OldCCT.KeySizeEnum as) = CCT.KeySizeEnum as convertKSS (OldCCT.KeySizeFixed a) = CCT.KeySizeFixed a hammerIV :: OldCCT.BlockCipher cipher => B.ByteString -> Either String (OldCCT.IV cipher) hammerIV = note "nettle bad IV" . OldCCT.makeIV hOpenPGP-2.10.1/Codec/Encryption/OpenPGP/Internal/Crypton.hs0000644000000000000000000000235607346545000021577 0ustar0000000000000000-- Crypton.hs: shim for crypton -- Copyright © 2016-2024 Clint Adams -- This software is released under the terms of the Expat license. -- (See the LICENSE file). {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PackageImports #-} {-# LANGUAGE UndecidableInstances #-} module Codec.Encryption.OpenPGP.Internal.Crypton ( HOWrappedCCT(..) ) where import Control.Error.Util (note) import qualified "crypton" Crypto.Cipher.Types as CCT import qualified Crypto.Error as CE import Data.Bifunctor (bimap) import qualified Data.ByteString as B import Codec.Encryption.OpenPGP.Internal.HOBlockCipher newtype HOWrappedCCT a = HWCCT a instance CCT.BlockCipher cipher => HOBlockCipher (HOWrappedCCT cipher) where cipherInit = bimap show HWCCT . CE.eitherCryptoError . CCT.cipherInit cipherName (HWCCT c) = CCT.cipherName c cipherKeySize (HWCCT c) = CCT.cipherKeySize c blockSize (HWCCT c) = CCT.blockSize c cfbEncrypt (HWCCT c) iv bs = hammerIV iv >>= \i -> return (CCT.cfbEncrypt c i bs) cfbDecrypt (HWCCT c) iv bs = hammerIV iv >>= \i -> return (CCT.cfbDecrypt c i bs) hammerIV :: CCT.BlockCipher cipher => B.ByteString -> Either String (CCT.IV cipher) hammerIV = note "crypton bad IV" . CCT.makeIV hOpenPGP-2.10.1/Codec/Encryption/OpenPGP/Internal/HOBlockCipher.hs0000644000000000000000000000210007346545000022540 0ustar0000000000000000-- HOBlockCipher.hs: abstraction for the different BlockCipher classes, plus crazy CFB mode stuff -- Copyright © 2016-2024 Clint Adams -- This software is released under the terms of the Expat license. -- (See the LICENSE file). {-# LANGUAGE PackageImports #-} module Codec.Encryption.OpenPGP.Internal.HOBlockCipher ( HOBlockCipher(..) ) where import qualified "crypton" Crypto.Cipher.Types as CCT import qualified Data.ByteString as B class HOBlockCipher cipher where cipherInit :: B.ByteString -> Either String cipher cipherName :: cipher -> String cipherKeySize :: cipher -> CCT.KeySizeSpecifier blockSize :: cipher -> Int cfbEncrypt :: cipher -> B.ByteString -> B.ByteString -> Either String B.ByteString cfbDecrypt :: cipher -> B.ByteString -> B.ByteString -> Either String B.ByteString paddedCfbEncrypt :: cipher -> B.ByteString -> B.ByteString -> Either String B.ByteString paddedCfbEncrypt = cfbEncrypt paddedCfbDecrypt :: cipher -> B.ByteString -> B.ByteString -> Either String B.ByteString paddedCfbDecrypt = cfbDecrypt hOpenPGP-2.10.1/Codec/Encryption/OpenPGP/KeyInfo.hs0000644000000000000000000000343607346545000017731 0ustar0000000000000000-- KeyInfo.hs: OpenPGP (RFC4880) fingerprinting methods -- Copyright © 2012-2018 Clint Adams -- This software is released under the terms of the Expat license. -- (See the LICENSE file). module Codec.Encryption.OpenPGP.KeyInfo ( pubkeySize , pkalgoAbbrev ) where import qualified Crypto.PubKey.DSA as DSA import qualified Crypto.PubKey.ECC.ECDSA as ECDSA import qualified Crypto.PubKey.ECC.Types as ECCT import qualified Crypto.PubKey.RSA as RSA import Data.Bits (shiftR) import Data.List (unfoldr) import Codec.Encryption.OpenPGP.Types pubkeySize :: PKey -> Either String Int pubkeySize (RSAPubKey (RSA_PublicKey x)) = Right (RSA.public_size x * 8) pubkeySize (DSAPubKey (DSA_PublicKey x)) = Right (bitcount . DSA.params_p . DSA.public_params $ x) pubkeySize (ElGamalPubKey p _ _) = Right (bitcount p) pubkeySize (ECDSAPubKey (ECDSA_PublicKey (ECDSA.PublicKey curve _))) = Right (fromIntegral (ECCT.curveSizeBits curve)) pubkeySize (ECDHPubKey (ECDSAPubKey (ECDSA_PublicKey (ECDSA.PublicKey curve _))) _ _) = Right (fromIntegral (ECCT.curveSizeBits curve)) pubkeySize (ECDHPubKey (EdDSAPubKey Ed25519 _) _ _) = Right 256 pubkeySize (EdDSAPubKey Ed25519 _) = Right 256 pubkeySize x = Left $ "Unable to calculate size of " ++ show x bitcount :: Integer -> Int bitcount = (* 8) . length . unfoldr (\x -> if x == 0 then Nothing else Just (True, x `shiftR` 8)) -- FIXME: redo these for hOpenPGP 3 pkalgoAbbrev :: PubKeyAlgorithm -> String pkalgoAbbrev RSA = "R" pkalgoAbbrev DSA = "D" pkalgoAbbrev ElgamalEncryptOnly = "g" pkalgoAbbrev DeprecatedRSAEncryptOnly = "-" pkalgoAbbrev DeprecatedRSASignOnly = "_" pkalgoAbbrev ECDH = "e" pkalgoAbbrev ECDSA = "E" pkalgoAbbrev ForbiddenElgamal = "f" pkalgoAbbrev DH = "d" pkalgoAbbrev EdDSA = "w" pkalgoAbbrev (OtherPKA _) = "." hOpenPGP-2.10.1/Codec/Encryption/OpenPGP/KeySelection.hs0000644000000000000000000000243307346545000020757 0ustar0000000000000000-- KeySelection.hs: OpenPGP (RFC4880) ways to ask for keys -- Copyright © 2014-2018 Clint Adams -- This software is released under the terms of the Expat license. -- (See the LICENSE file). {-# LANGUAGE OverloadedStrings #-} module Codec.Encryption.OpenPGP.KeySelection ( parseEightOctetKeyId , parseFingerprint ) where import Codec.Encryption.OpenPGP.Types import Control.Applicative (optional) import Control.Monad ((<=<)) import Crypto.Number.Serialize (i2osp) import Data.Attoparsec.Text ( Parser , asciiCI , count , hexadecimal , inClass , parseOnly , satisfy ) import qualified Data.ByteString.Lazy as BL import Data.Text (Text, toUpper) import qualified Data.Text as T parseEightOctetKeyId :: Text -> Either String EightOctetKeyId parseEightOctetKeyId = fmap EightOctetKeyId . (parseOnly hexes <=< parseOnly (hexPrefix *> hexen 16)) . toUpper parseFingerprint :: Text -> Either String TwentyOctetFingerprint parseFingerprint = fmap TwentyOctetFingerprint . (parseOnly hexes <=< parseOnly (hexen 40)) . toUpper . T.filter (/= ' ') hexPrefix :: Parser (Maybe Text) hexPrefix = optional (asciiCI "0x") hexen :: Int -> Parser Text hexen n = T.pack <$> count n (satisfy (inClass "A-F0-9")) hexes :: Parser BL.ByteString hexes = BL.fromStrict . i2osp <$> hexadecimal hOpenPGP-2.10.1/Codec/Encryption/OpenPGP/KeyringParser.hs0000644000000000000000000002032007346545000021141 0ustar0000000000000000-- KeyringParser.hs: OpenPGP (RFC4880) transferable keys parsing -- Copyright © 2012-2020 Clint Adams -- This software is released under the terms of the Expat license. -- (See the LICENSE file). {-# LANGUAGE CPP #-} module Codec.Encryption.OpenPGP.KeyringParser ( -- * Parsers parseAChunk , finalizeParsing , anyTK , UidOrUat(..) , splitUs , publicTK , secretTK , brokenTK , pkPayload , signature , signedUID , signedUAt , signedOrRevokedPubSubkey , brokenPubSubkey , rawOrSignedOrRevokedSecSubkey , brokenSecSubkey , skPayload , broken -- * Utilities , parseTKs ) where import Control.Applicative ((<|>), many) import Data.Maybe (catMaybes) import Data.Text (Text) import Codec.Encryption.OpenPGP.Ontology (isTrustPkt) import Codec.Encryption.OpenPGP.Types import Data.Conduit.OpenPGP.Keyring.Instances () import Text.ParserCombinators.Incremental.LeftBiasedLocal ( Parser , completeResults , concatMany , failure , feed , feedEof , inspect , satisfy ) parseAChunk :: (Monoid s, Show s) => Parser s r -> s -> ([(r, s)], Maybe (Maybe (r -> r), Parser s r)) -> (([(r, s)], Maybe (Maybe (r -> r), Parser s r)), [r]) parseAChunk _ a ([], Nothing) = error $ "Failure before " ++ show a parseAChunk op a (cr, Nothing) = #if MIN_VERSION_incremental_parser(0,4,0) either error (\x -> (x, map fst cr)) (inspect (feed (mconcat (map snd cr) <> a) op)) parseAChunk _ a (_, Just (_, p)) = either error (\x -> (x, [])) (inspect (feed a p)) #else (inspect (feed (mconcat (map snd cr) <> a) op), map fst cr) parseAChunk _ a (_, Just (_, p)) = (inspect (feed a p), []) #endif finalizeParsing :: Monoid s => ([(r, s)], Maybe (Maybe (r -> r), Parser s r)) -> (([(r, s)], Maybe (Maybe (r -> r), Parser s r)), [r]) finalizeParsing ([], Nothing) = error "Unexpected finalization failure" finalizeParsing (cr, Nothing) = (([], Nothing), map fst cr) #if MIN_VERSION_incremental_parser(0,4,0) finalizeParsing (_, Just (_, p)) = either error finalizeParsing (inspect (feedEof p)) #else finalizeParsing (_, Just (_, p)) = finalizeParsing (inspect (feedEof p)) #endif anyTK :: Bool -> Parser [Pkt] (Maybe TK) anyTK True = publicTK True <|> secretTK True anyTK False = publicTK False <|> secretTK False <|> brokenTK 6 <|> brokenTK 5 data UidOrUat = I Text | A [UserAttrSubPacket] deriving (Show) splitUs :: [(UidOrUat, [SignaturePayload])] -> ([(Text, [SignaturePayload])], [([UserAttrSubPacket], [SignaturePayload])]) splitUs us = (is, as) where is = map unI (filter isI us) as = map unA (filter isA us) isI (I _, _) = True isI _ = False isA (A _, _) = True isA _ = False unI (I x, y) = (x, y) unI x = error $ "unI should never be called on " ++ show x unA (A x, y) = (x, y) unA x = error $ "unA should never be called on " ++ show x publicTK, secretTK :: Bool -> Parser [Pkt] (Maybe TK) publicTK intolerant = do pkp <- pkPayload pkpsigs <- concatMany (signature intolerant [KeyRevocationSig, SignatureDirectlyOnAKey]) (uids, uats) <- fmap splitUs (many (signedUID intolerant <|> signedUAt intolerant)) -- FIXME: require >=1 uid if intolerant subs <- concatMany (pubsub intolerant) return $ Just (TK pkp pkpsigs uids uats subs) where pubsub True = signedOrRevokedPubSubkey True pubsub False = signedOrRevokedPubSubkey False <|> brokenPubSubkey secretTK intolerant = do skp <- skPayload skpsigs <- concatMany (signature intolerant [KeyRevocationSig, SignatureDirectlyOnAKey]) (uids, uats) <- fmap splitUs (many (signedUID intolerant <|> signedUAt intolerant)) -- FIXME: require >=1 uid if intolerant? subs <- concatMany (secsub intolerant) return $ Just (TK skp skpsigs uids uats subs) where secsub True = rawOrSignedOrRevokedSecSubkey True secsub False = rawOrSignedOrRevokedSecSubkey False <|> brokenSecSubkey brokenTK :: Int -> Parser [Pkt] (Maybe TK) brokenTK 6 = do _ <- broken 6 _ <- many (signature False [KeyRevocationSig, SignatureDirectlyOnAKey]) _ <- many (signedUID False <|> signedUAt False) _ <- concatMany (signedOrRevokedPubSubkey False <|> brokenPubSubkey) return Nothing brokenTK 5 = do _ <- broken 5 _ <- many (signature False [KeyRevocationSig, SignatureDirectlyOnAKey]) _ <- many (signedUID False <|> signedUAt False) _ <- concatMany (rawOrSignedOrRevokedSecSubkey False <|> brokenSecSubkey) return Nothing brokenTK _ = fail "Unexpected broken packet type" pkPayload :: Parser [Pkt] (PKPayload, Maybe SKAddendum) pkPayload = do pkpkts <- satisfy isPKP case pkpkts of [PublicKeyPkt p] -> return (p, Nothing) _ -> failure where isPKP [PublicKeyPkt _] = True isPKP _ = False signature :: Bool -> [SigType] -> Parser [Pkt] [SignaturePayload] signature intolerant rts = if intolerant then signature' else signature' <|> brokensig' where signature' = do spks <- satisfy (isSP intolerant) case spks of [SignaturePkt sp] -> return $! (if intolerant then id else filter isSP') [sp] _ -> failure brokensig' = const [] <$> broken 2 isSP True [SignaturePkt sp@SigV3 {}] = isSP' sp isSP True [SignaturePkt sp@SigV4 {}] = isSP' sp isSP False [SignaturePkt _] = True isSP _ _ = False isSP' (SigV3 st _ _ _ _ _ _) = st `elem` rts isSP' (SigV4 st _ _ _ _ _ _) = st `elem` rts isSP' _ = False signedUID :: Bool -> Parser [Pkt] (UidOrUat, [SignaturePayload]) signedUID intolerant = do upkts <- satisfy isUID case upkts of [UserIdPkt u] -> do sigs <- concatMany (signature intolerant [ GenericCert , PersonaCert , CasualCert , PositiveCert , CertRevocationSig ]) return (I u, sigs) _ -> failure where isUID [UserIdPkt _] = True isUID _ = False signedUAt :: Bool -> Parser [Pkt] (UidOrUat, [SignaturePayload]) signedUAt intolerant = do uapkts <- satisfy isUAt case uapkts of [UserAttributePkt us] -> do sigs <- concatMany (signature intolerant [ GenericCert , PersonaCert , CasualCert , PositiveCert , CertRevocationSig ]) return (A us, sigs) _ -> failure where isUAt [UserAttributePkt _] = True isUAt _ = False signedOrRevokedPubSubkey :: Bool -> Parser [Pkt] [(Pkt, [SignaturePayload])] signedOrRevokedPubSubkey intolerant = do pskpkts <- satisfy isPSKP case pskpkts of [p] -> do sigs <- concatMany (signature intolerant [SubkeyBindingSig, SubkeyRevocationSig]) return [(p, sigs)] _ -> failure where isPSKP [PublicSubkeyPkt _] = True isPSKP _ = False brokenPubSubkey :: Parser [Pkt] [(Pkt, [SignaturePayload])] brokenPubSubkey = do _ <- broken 14 _ <- concatMany (signature False [SubkeyBindingSig, SubkeyRevocationSig]) return [] rawOrSignedOrRevokedSecSubkey :: Bool -> Parser [Pkt] [(Pkt, [SignaturePayload])] rawOrSignedOrRevokedSecSubkey intolerant = do sskpkts <- satisfy isSSKP case sskpkts of [p] -> do sigs <- concatMany (signature intolerant [SubkeyBindingSig, SubkeyRevocationSig]) return [(p, sigs)] _ -> failure where isSSKP [SecretSubkeyPkt _ _] = True isSSKP _ = False brokenSecSubkey :: Parser [Pkt] [(Pkt, [SignaturePayload])] brokenSecSubkey = do _ <- broken 7 _ <- concatMany (signature False [SubkeyBindingSig, SubkeyRevocationSig]) return [] skPayload :: Parser [Pkt] (PKPayload, Maybe SKAddendum) skPayload = do spkts <- satisfy isSKP case spkts of [SecretKeyPkt p ska] -> return (p, Just ska) _ -> failure where isSKP [SecretKeyPkt _ _] = True isSKP _ = False broken :: Int -> Parser [Pkt] Pkt broken t = do bpkts <- satisfy isBroken case bpkts of [bp] -> return bp _ -> failure where isBroken [BrokenPacketPkt _ a _] = t == fromIntegral a isBroken _ = False -- | parse TKs from packets parseTKs :: Bool -> [Pkt] -> [TK] parseTKs intolerant ps = catMaybes (concatMap fst (completeResults (feedEof (feed (filter notTrustPacket ps) (many (anyTK intolerant)))))) where notTrustPacket = not . isTrustPkt hOpenPGP-2.10.1/Codec/Encryption/OpenPGP/Ontology.hs0000644000000000000000000000455107346545000020176 0ustar0000000000000000-- Ontology.hs: OpenPGP (RFC4880) "is" functions -- Copyright © 2012-2019 Clint Adams -- This software is released under the terms of the Expat license. -- (See the LICENSE file). module Codec.Encryption.OpenPGP.Ontology ( -- * for signature payloads isCertRevocationSig , isRevokerP , isPKBindingSig , isSKBindingSig , isSubkeyBindingSig , isSubkeyRevocation , isTrustPkt -- * for signature subpackets , isCT , isIssuerSSP , isIssuerFPSSP , isKET , isKUF , isPHA , isRevocationKeySSP , isSigCreationTime ) where import Codec.Encryption.OpenPGP.Types isCertRevocationSig :: SignaturePayload -> Bool isCertRevocationSig (SigV4 CertRevocationSig _ _ _ _ _ _) = True isCertRevocationSig _ = False isRevokerP :: SignaturePayload -> Bool isRevokerP (SigV4 SignatureDirectlyOnAKey _ _ h u _ _) = any isRevocationKeySSP h && any isIssuerSSP u isRevokerP _ = False isPKBindingSig :: SignaturePayload -> Bool isPKBindingSig (SigV4 PrimaryKeyBindingSig _ _ _ _ _ _) = True isPKBindingSig _ = False isSKBindingSig :: SignaturePayload -> Bool isSKBindingSig (SigV4 SubkeyBindingSig _ _ _ _ _ _) = True isSKBindingSig _ = False isSubkeyRevocation :: SignaturePayload -> Bool isSubkeyRevocation (SigV4 SubkeyRevocationSig _ _ _ _ _ _) = True isSubkeyRevocation _ = False isSubkeyBindingSig :: SignaturePayload -> Bool isSubkeyBindingSig (SigV4 SubkeyBindingSig _ _ _ _ _ _) = True isSubkeyBindingSig _ = False isTrustPkt :: Pkt -> Bool isTrustPkt (TrustPkt _) = True isTrustPkt _ = False isCT :: SigSubPacket -> Bool isCT (SigSubPacket _ (SigCreationTime _)) = True isCT _ = False isIssuerSSP :: SigSubPacket -> Bool isIssuerSSP (SigSubPacket _ (Issuer _)) = True isIssuerSSP _ = False isIssuerFPSSP :: SigSubPacket -> Bool isIssuerFPSSP (SigSubPacket _ (IssuerFingerprint _ _)) = True isIssuerFPSSP _ = False isKET :: SigSubPacket -> Bool isKET (SigSubPacket _ (KeyExpirationTime _)) = True isKET _ = False isKUF :: SigSubPacket -> Bool isKUF (SigSubPacket _ (KeyFlags _)) = True isKUF _ = False isPHA :: SigSubPacket -> Bool isPHA (SigSubPacket _ (PreferredHashAlgorithms _)) = True isPHA _ = False isRevocationKeySSP :: SigSubPacket -> Bool isRevocationKeySSP (SigSubPacket _ RevocationKey {}) = True isRevocationKeySSP _ = False isSigCreationTime :: SigSubPacket -> Bool isSigCreationTime (SigSubPacket _ (SigCreationTime _)) = True isSigCreationTime _ = False hOpenPGP-2.10.1/Codec/Encryption/OpenPGP/S2K.hs0000644000000000000000000000352307346545000016761 0ustar0000000000000000-- S2K.hs: OpenPGP (RFC4880) string-to-key conversion -- Copyright © 2013-2016 Clint Adams -- This software is released under the terms of the Expat license. -- (See the LICENSE file). module Codec.Encryption.OpenPGP.S2K ( string2Key , skesk2Key ) where import Codec.Encryption.OpenPGP.BlockCipher (keySize) import Codec.Encryption.OpenPGP.Types import Control.Monad.Loops (untilM_) import Control.Monad.Trans.State.Lazy (execState, get, put) import qualified Crypto.Hash as CH import qualified Data.ByteArray as BA import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as BL string2Key :: S2K -> Int -> BL.ByteString -> B.ByteString string2Key (Simple ha) ksz bs = B.take (fromIntegral ksz) $ hashpp ha ksz bs string2Key (Salted ha salt) ksz bs = string2Key (Simple ha) ksz (BL.append (BL.fromStrict (unSalt salt)) bs) string2Key (IteratedSalted ha salt cnt) ksz bs = string2Key (Simple ha) ksz (BL.take (fromIntegral cnt) . BL.cycle $ BL.append (BL.fromStrict (unSalt salt)) bs) string2Key _ _ _ = error "FIXME: unimplemented S2K type" skesk2Key :: SKESK -> BL.ByteString -> B.ByteString skesk2Key (SKESK 4 sa s2k Nothing) pass = string2Key s2k (keySize sa) pass skesk2Key _ _ = error "FIXME" hashpp :: HashAlgorithm -> Int -> BL.ByteString -> B.ByteString hashpp ha keysize pp = snd (execState (hashround `untilM_` bigEnough) (0, B.empty)) where hashround = get >>= \(ctr, bs) -> put (ctr + 1, bs `B.append` hf ha (nulpad ctr `BL.append` pp)) nulpad = BL.pack . flip replicate 0 bigEnough = get >>= \(_, bs) -> return (B.length bs >= keysize) hf :: HashAlgorithm -> BL.ByteString -> B.ByteString hf SHA1 bs = BA.convert (CH.hashlazy bs :: CH.Digest CH.SHA1) hf SHA512 bs = BA.convert (CH.hashlazy bs :: CH.Digest CH.SHA512) hf _ _ = error "FIXME: unimplemented S2K hash" hOpenPGP-2.10.1/Codec/Encryption/OpenPGP/SecretKey.hs0000644000000000000000000001127707346545000020265 0ustar0000000000000000-- SecretKey.hs: OpenPGP (RFC4880) secret key encryption/decryption -- Copyright © 2013-2018 Clint Adams -- This software is released under the terms of the Expat license. -- (See the LICENSE file). module Codec.Encryption.OpenPGP.SecretKey ( decryptPrivateKey , encryptPrivateKey , encryptPrivateKeyIO , reencryptSecretKeyIO ) where import Codec.Encryption.OpenPGP.BlockCipher (keySize, withSymmetricCipher) import Codec.Encryption.OpenPGP.CFB (decryptNoNonce, encryptNoNonce) import Codec.Encryption.OpenPGP.Internal.HOBlockCipher import Codec.Encryption.OpenPGP.S2K (skesk2Key, string2Key) import Codec.Encryption.OpenPGP.Serialize (getSecretKey) import Codec.Encryption.OpenPGP.Types import qualified Crypto.Hash as CH import Crypto.Number.ModArithmetic (inverse) import qualified Crypto.PubKey.RSA as R import Crypto.Random.EntropyPool (createEntropyPool, getEntropyFrom) import Data.Bifunctor (bimap) import Data.Binary (put) import Data.Binary.Get (getRemainingLazyByteString, getWord16be, runGetOrFail) import Data.Binary.Put (runPut) import qualified Data.ByteArray as BA import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as BL saBlockSize :: SymmetricAlgorithm -> Int saBlockSize sa = either (const 0) id (withSymmetricCipher sa B.empty (Right . blockSize)) decryptPrivateKey :: (PKPayload, SKAddendum) -> BL.ByteString -> SKAddendum decryptPrivateKey (pkp, ska@SUS16bit {}) pp = either (error "could not decrypt SUS16bit") id (decryptSKA (pkp, ska) pp) decryptPrivateKey (pkp, ska@SUSSHA1 {}) pp = either (error "could not decrypt SUSSHA1") id (decryptSKA (pkp, ska) pp) decryptPrivateKey (_, SUSym {}) _ = error "SUSym key decryption not implemented" decryptPrivateKey (_, ska@SUUnencrypted {}) _ = ska decryptSKA :: (PKPayload, SKAddendum) -> BL.ByteString -> Either String SKAddendum decryptSKA (pkp, SUS16bit sa s2k iv payload) pp = do let key = skesk2Key (SKESK 4 sa s2k Nothing) pp p <- decryptNoNonce sa iv (BL.toStrict payload) key (s, cksum) <- getSecretKeyAndChecksum p -- FIXME: check the 16bit hash let checksum = cksum return $ SUUnencrypted s checksum -- FIXME: is this the correct checksum? where getSecretKeyAndChecksum p = bimap (\(_, _, x) -> x) (\(_, _, x) -> x) (runGetOrFail (getSecretKey pkp >>= \sk -> getWord16be >>= \csum -> return (sk, csum)) (BL.fromStrict p)) -- FIXME: check the 16bit hash decryptSKA (pkp, SUSSHA1 sa s2k iv payload) pp = do let key = skesk2Key (SKESK 4 sa s2k Nothing) pp p <- decryptNoNonce sa iv (BL.toStrict payload) key (s, cksum) <- getSecretKeyAndChecksum p -- FIXME: check the SHA1 hash let checksum = sum . map fromIntegral . B.unpack . B.take (B.length p - 20) $ p return $ SUUnencrypted s checksum -- FIXME: is this the correct checksum? where getSecretKeyAndChecksum p = bimap (\(_, _, x) -> x) (\(_, _, x) -> x) (runGetOrFail (getSecretKey pkp >>= \sk -> getRemainingLazyByteString >>= \csum -> return (sk, csum)) (BL.fromStrict p)) decryptSKA _ _ = Left "Unexpected codepath" -- |generates pseudo-random salt and IV encryptPrivateKeyIO :: SKAddendum -> BL.ByteString -> IO SKAddendum encryptPrivateKeyIO ska pp = saltiv >>= \(s, i) -> return (encryptPrivateKey s (IV i) ska pp) where saltiv = do ep <- createEntropyPool bb <- getEntropyFrom ep (8 + saBlockSize AES256) return $ B.splitAt 8 bb -- |8-octet salt, IV must be length of cipher blocksize encryptPrivateKey :: B.ByteString -> IV -> SKAddendum -> BL.ByteString -> SKAddendum encryptPrivateKey _ _ ska@SUS16bit {} _ = ska encryptPrivateKey _ _ ska@SUSSHA1 {} _ = ska encryptPrivateKey _ _ ska@SUSym {} _ = ska encryptPrivateKey salt iv (SUUnencrypted skey _) pp = SUSSHA1 AES256 s2k iv (BL.fromStrict (encryptSKey skey s2k iv pp)) where s2k = IteratedSalted SHA512 (Salt salt) 12058624 encryptSKey :: SKey -> S2K -> IV -> BL.ByteString -> B.ByteString encryptSKey (RSAPrivateKey (RSA_PrivateKey (R.PrivateKey _ d p q _ _ _))) s2k iv pp = either error id (encryptNoNonce AES256 s2k iv (BL.toStrict payload) key) where key = string2Key s2k (keySize AES256) pp algospecific = runPut $ put (MPI d) >> put (MPI p) >> put (MPI q) >> put (MPI u) cksum = CH.hashlazy algospecific :: CH.Digest CH.SHA1 payload = algospecific `BL.append` BL.fromStrict (BA.convert cksum) Just u = inverse p q encryptSKey _ _ _ _ = error "Non-RSA keytypes not handled yet" -- FIXME: do DSA and ElGamal reencryptSecretKeyIO :: SecretKey -> BL.ByteString -> IO SecretKey reencryptSecretKeyIO sk pp = encryptPrivateKeyIO (_secretKeySKAddendum sk) pp >>= \n -> return sk {_secretKeySKAddendum = n} hOpenPGP-2.10.1/Codec/Encryption/OpenPGP/Serialize.hs0000644000000000000000000014016607346545000020316 0ustar0000000000000000-- Serialize.hs: OpenPGP (RFC4880) serialization (using cereal) -- Copyright © 2012-2025 Clint Adams -- This software is released under the terms of the Expat license. -- (See the LICENSE file). module Codec.Encryption.OpenPGP.Serialize ( -- * Serialization functions putSKAddendum , getSecretKey -- * Utilities , parsePkts ) where import Control.Applicative (many, some) import Control.Lens ((^.), _1) import Control.Monad (guard, replicateM, replicateM_) import Crypto.Number.Basic (numBits) import Crypto.Number.Serialize (i2osp, os2ip) import qualified Crypto.PubKey.DSA as D import qualified Crypto.PubKey.ECC.ECDSA as ECDSA import qualified Crypto.PubKey.ECC.Types as ECCT import qualified Crypto.PubKey.RSA as R import Data.Bifunctor (bimap) import Data.Binary (Binary, get, put) import Data.Binary.Get ( ByteOffset , Get , getByteString , getLazyByteString , getRemainingLazyByteString , getWord16be , getWord16le , getWord32be , getWord8 , runGetOrFail ) import Data.Binary.Put ( Put , putByteString , putLazyByteString , putWord16be , putWord16le , putWord32be , putWord8 , runPut ) import Data.Bits ((.&.), (.|.), shiftL, shiftR, testBit) import qualified Data.ByteString as B import Data.ByteString.Lazy (ByteString) import qualified Data.ByteString.Lazy as BL import qualified Data.Foldable as F import Data.List (mapAccumL) import qualified Data.List.NonEmpty as NE import Data.Maybe (fromMaybe) import Data.Set (Set) import qualified Data.Set as Set import qualified Data.Text as T import Data.Text.Encoding (decodeUtf8With, encodeUtf8) import Data.Text.Encoding.Error (lenientDecode) import Data.Word (Word16, Word32, Word8) import Network.URI (nullURI, parseURI, uriToString) import Codec.Encryption.OpenPGP.Internal ( curve2Curve , curveFromCurve , curveToCurveoidBS , curveoidBSToCurve , curveoidBSToEdSigningCurve , edSigningCurveToCurveoidBS , multiplicativeInverse , pubkeyToMPIs ) import Codec.Encryption.OpenPGP.Types instance Binary SigSubPacket where get = getSigSubPacket put = putSigSubPacket -- instance Binary (Set NotationFlag) where -- put = putNotationFlagSet instance Binary CompressionAlgorithm where get = toFVal <$> getWord8 put = putWord8 . fromFVal instance Binary PubKeyAlgorithm where get = toFVal <$> getWord8 put = putWord8 . fromFVal instance Binary HashAlgorithm where get = toFVal <$> getWord8 put = putWord8 . fromFVal instance Binary SymmetricAlgorithm where get = toFVal <$> getWord8 put = putWord8 . fromFVal instance Binary MPI where get = getMPI put = putMPI instance Binary SigType where get = toFVal <$> getWord8 put = putWord8 . fromFVal instance Binary UserAttrSubPacket where get = getUserAttrSubPacket put = putUserAttrSubPacket instance Binary S2K where get = getS2K put = putS2K instance Binary PKESK where get = fmap fromPkt getPkt put = putPkt . toPkt instance Binary Signature where get = fmap fromPkt getPkt put = putPkt . toPkt instance Binary SKESK where get = fmap fromPkt getPkt put = putPkt . toPkt instance Binary OnePassSignature where get = fmap fromPkt getPkt put = putPkt . toPkt instance Binary SecretKey where get = fmap fromPkt getPkt put = putPkt . toPkt instance Binary PublicKey where get = fmap fromPkt getPkt put = putPkt . toPkt instance Binary SecretSubkey where get = fmap fromPkt getPkt put = putPkt . toPkt instance Binary CompressedData where get = fmap fromPkt getPkt put = putPkt . toPkt instance Binary SymEncData where get = fmap fromPkt getPkt put = putPkt . toPkt instance Binary Marker where get = fmap fromPkt getPkt put = putPkt . toPkt instance Binary LiteralData where get = fmap fromPkt getPkt put = putPkt . toPkt instance Binary Trust where get = fmap fromPkt getPkt put = putPkt . toPkt instance Binary UserId where get = fmap fromPkt getPkt put = putPkt . toPkt instance Binary PublicSubkey where get = fmap fromPkt getPkt put = putPkt . toPkt instance Binary UserAttribute where get = fmap fromPkt getPkt put = putPkt . toPkt instance Binary SymEncIntegrityProtectedData where get = fmap fromPkt getPkt put = putPkt . toPkt instance Binary ModificationDetectionCode where get = fmap fromPkt getPkt put = putPkt . toPkt instance Binary OtherPacket where get = fmap fromPkt getPkt put = putPkt . toPkt instance Binary Pkt where get = getPkt put = putPkt instance Binary a => Binary (Block a) where get = Block `fmap` many get put = mapM_ put . unBlock instance Binary PKPayload where get = getPKPayload put = putPKPayload instance Binary SignaturePayload where get = getSignaturePayload put = putSignaturePayload instance Binary TK where get = undefined put = putTK getSigSubPacket :: Get SigSubPacket getSigSubPacket = do l <- fmap fromIntegral getSubPacketLength (crit, pt) <- getSigSubPacketType getSigSubPacket' pt crit l where getSigSubPacket' :: Word8 -> Bool -> ByteOffset -> Get SigSubPacket getSigSubPacket' pt crit l | pt == 2 = do et <- fmap ThirtyTwoBitTimeStamp getWord32be return $ SigSubPacket crit (SigCreationTime et) | pt == 3 = do et <- fmap ThirtyTwoBitDuration getWord32be return $ SigSubPacket crit (SigExpirationTime et) | pt == 4 = do e <- get return $ SigSubPacket crit (ExportableCertification e) | pt == 5 = do tl <- getWord8 ta <- getWord8 return $ SigSubPacket crit (TrustSignature tl ta) | pt == 6 = do apdre <- getLazyByteString (l - 2) nul <- getWord8 guard (nul == 0) return $ SigSubPacket crit (RegularExpression (BL.copy apdre)) | pt == 7 = do r <- get return $ SigSubPacket crit (Revocable r) | pt == 9 = do et <- fmap ThirtyTwoBitDuration getWord32be return $ SigSubPacket crit (KeyExpirationTime et) | pt == 11 = do sa <- replicateM (fromIntegral (l - 1)) get return $ SigSubPacket crit (PreferredSymmetricAlgorithms sa) | pt == 12 = do rclass <- getWord8 guard (testBit rclass 7) algid <- get fp <- getLazyByteString 20 return $ SigSubPacket crit (RevocationKey (bsToFFSet . BL.singleton $ rclass .&. 0x7f) algid (TwentyOctetFingerprint fp)) | pt == 16 = do keyid <- getLazyByteString (l - 1) return $ SigSubPacket crit (Issuer (EightOctetKeyId keyid)) | pt == 20 = do flags <- getLazyByteString 4 nl <- getWord16be vl <- getWord16be nn <- getLazyByteString (fromIntegral nl) nv <- getLazyByteString (fromIntegral vl) return $ SigSubPacket crit (NotationData (bsToFFSet flags) (NotationName nn) (NotationValue nv)) | pt == 21 = do ha <- replicateM (fromIntegral (l - 1)) get return $ SigSubPacket crit (PreferredHashAlgorithms ha) | pt == 22 = do ca <- replicateM (fromIntegral (l - 1)) get return $ SigSubPacket crit (PreferredCompressionAlgorithms ca) | pt == 23 = do ksps <- getLazyByteString (l - 1) return $ SigSubPacket crit (KeyServerPreferences (bsToFFSet ksps)) | pt == 24 = do pks <- getLazyByteString (l - 1) return $ SigSubPacket crit (PreferredKeyServer pks) | pt == 25 = do primacy <- get return $ SigSubPacket crit (PrimaryUserId primacy) | pt == 26 = do url <- fmap (URL . fromMaybe nullURI . parseURI . T.unpack . decodeUtf8With lenientDecode) (getByteString (fromIntegral (l - 1))) return $ SigSubPacket crit (PolicyURL url) | pt == 27 = do kfs <- getLazyByteString (l - 1) return $ SigSubPacket crit (KeyFlags (bsToFFSet kfs)) | pt == 28 = do uid <- getByteString (fromIntegral (l - 1)) return $ SigSubPacket crit (SignersUserId (decodeUtf8With lenientDecode uid)) | pt == 29 = do rcode <- getWord8 rreason <- fmap (decodeUtf8With lenientDecode) (getByteString (fromIntegral (l - 2))) return $ SigSubPacket crit (ReasonForRevocation (toFVal rcode) rreason) | pt == 30 = do fbs <- getLazyByteString (l - 1) return $ SigSubPacket crit (Features (bsToFFSet fbs)) | pt == 31 = do pka <- get ha <- get hash <- getLazyByteString (l - 3) return $ SigSubPacket crit (SignatureTarget pka ha hash) | pt == 32 = do spbs <- getLazyByteString (l - 1) case runGetOrFail get spbs of Left (_, _, e) -> fail ("embedded signature subpacket " ++ e) Right (_, _, sp) -> return $ SigSubPacket crit (EmbeddedSignature sp) | pt == 33 = do kv <- getWord8 fp <- getLazyByteString (if kv == 4 then 20 else 32) return $ SigSubPacket crit (IssuerFingerprint kv (TwentyOctetFingerprint fp)) | pt > 99 && pt < 111 = do payload <- getLazyByteString (l - 1) return $ SigSubPacket crit (UserDefinedSigSub pt payload) | otherwise = do payload <- getLazyByteString (l - 1) return $ SigSubPacket crit (OtherSigSub pt payload) putSigSubPacket :: SigSubPacket -> Put putSigSubPacket (SigSubPacket crit (SigCreationTime et)) = do putSubPacketLength 5 putSigSubPacketType crit 2 putWord32be . unThirtyTwoBitTimeStamp $ et putSigSubPacket (SigSubPacket crit (SigExpirationTime et)) = do putSubPacketLength 5 putSigSubPacketType crit 3 putWord32be . unThirtyTwoBitDuration $ et putSigSubPacket (SigSubPacket crit (ExportableCertification e)) = do putSubPacketLength 2 putSigSubPacketType crit 4 put e putSigSubPacket (SigSubPacket crit (TrustSignature tl ta)) = do putSubPacketLength 3 putSigSubPacketType crit 5 put tl put ta putSigSubPacket (SigSubPacket crit (RegularExpression apdre)) = do putSubPacketLength . fromIntegral $ (2 + BL.length apdre) putSigSubPacketType crit 6 putLazyByteString apdre putWord8 0 putSigSubPacket (SigSubPacket crit (Revocable r)) = do putSubPacketLength 2 putSigSubPacketType crit 7 put r putSigSubPacket (SigSubPacket crit (KeyExpirationTime et)) = do putSubPacketLength 5 putSigSubPacketType crit 9 putWord32be . unThirtyTwoBitDuration $ et putSigSubPacket (SigSubPacket crit (PreferredSymmetricAlgorithms ess)) = do putSubPacketLength . fromIntegral $ (1 + length ess) putSigSubPacketType crit 11 mapM_ put ess putSigSubPacket (SigSubPacket crit (RevocationKey rclass algid fp)) = do putSubPacketLength 23 putSigSubPacketType crit 12 putLazyByteString . ffSetToFixedLengthBS (1 :: Int) $ Set.insert (RClOther 0) rclass put algid putLazyByteString (unTOF fp) -- 20 octets putSigSubPacket (SigSubPacket crit (Issuer keyid)) = do putSubPacketLength 9 putSigSubPacketType crit 16 putLazyByteString (unEOKI keyid) -- 8 octets putSigSubPacket (SigSubPacket crit (NotationData nfs (NotationName nn) (NotationValue nv))) = do putSubPacketLength . fromIntegral $ (9 + BL.length nn + BL.length nv) putSigSubPacketType crit 20 putLazyByteString . ffSetToFixedLengthBS (4 :: Int) $ nfs putWord16be . fromIntegral . BL.length $ nn putWord16be . fromIntegral . BL.length $ nv putLazyByteString nn putLazyByteString nv putSigSubPacket (SigSubPacket crit (PreferredHashAlgorithms ehs)) = do putSubPacketLength . fromIntegral $ (1 + length ehs) putSigSubPacketType crit 21 mapM_ put ehs putSigSubPacket (SigSubPacket crit (PreferredCompressionAlgorithms ecs)) = do putSubPacketLength . fromIntegral $ (1 + length ecs) putSigSubPacketType crit 22 mapM_ put ecs putSigSubPacket (SigSubPacket crit (KeyServerPreferences ksps)) = do let kbs = ffSetToBS ksps putSubPacketLength . fromIntegral $ (1 + BL.length kbs) putSigSubPacketType crit 23 putLazyByteString kbs putSigSubPacket (SigSubPacket crit (PreferredKeyServer ks)) = do putSubPacketLength . fromIntegral $ (1 + BL.length ks) putSigSubPacketType crit 24 putLazyByteString ks putSigSubPacket (SigSubPacket crit (PrimaryUserId primacy)) = do putSubPacketLength 2 putSigSubPacketType crit 25 put primacy putSigSubPacket (SigSubPacket crit (PolicyURL (URL uri))) = do let bs = encodeUtf8 (T.pack (uriToString id uri "")) putSubPacketLength . fromIntegral $ (1 + B.length bs) putSigSubPacketType crit 26 putByteString bs putSigSubPacket (SigSubPacket crit (KeyFlags kfs)) = do let kbs = ffSetToBS kfs putSubPacketLength . fromIntegral $ (1 + BL.length kbs) putSigSubPacketType crit 27 putLazyByteString kbs putSigSubPacket (SigSubPacket crit (SignersUserId userid)) = do let bs = encodeUtf8 userid putSubPacketLength . fromIntegral $ (1 + B.length bs) putSigSubPacketType crit 28 putByteString bs putSigSubPacket (SigSubPacket crit (ReasonForRevocation rcode rreason)) = do let reasonbs = encodeUtf8 rreason putSubPacketLength . fromIntegral $ (2 + B.length reasonbs) putSigSubPacketType crit 29 putWord8 . fromFVal $ rcode putByteString reasonbs putSigSubPacket (SigSubPacket crit (Features fs)) = do let fbs = ffSetToBS fs putSubPacketLength . fromIntegral $ (1 + BL.length fbs) putSigSubPacketType crit 30 putLazyByteString fbs putSigSubPacket (SigSubPacket crit (SignatureTarget pka ha hash)) = do putSubPacketLength . fromIntegral $ (3 + BL.length hash) putSigSubPacketType crit 31 put pka put ha putLazyByteString hash putSigSubPacket (SigSubPacket crit (EmbeddedSignature sp)) = do let spb = runPut (put sp) putSubPacketLength . fromIntegral $ (1 + BL.length spb) putSigSubPacketType crit 32 putLazyByteString spb putSigSubPacket (SigSubPacket crit (IssuerFingerprint kv fp)) = do let fpb = unTOF fp putSubPacketLength . fromIntegral $ (2 + BL.length fpb) putSigSubPacketType crit 33 putWord8 kv putLazyByteString fpb putSigSubPacket (SigSubPacket crit (UserDefinedSigSub ptype payload)) = putSigSubPacket (SigSubPacket crit (OtherSigSub ptype payload)) putSigSubPacket (SigSubPacket crit (OtherSigSub ptype payload)) = do putSubPacketLength . fromIntegral $ (1 + BL.length payload) putSigSubPacketType crit ptype putLazyByteString payload getSubPacketLength :: Get Word32 getSubPacketLength = getSubPacketLength' =<< getWord8 where getSubPacketLength' :: Integral a => Word8 -> Get a getSubPacketLength' f | f < 192 = return . fromIntegral $ f | f < 224 = do secondOctet <- getWord8 return . fromIntegral $ shiftL (fromIntegral (f - 192) :: Int) 8 + (fromIntegral secondOctet :: Int) + 192 | f == 255 = do len <- getWord32be return . fromIntegral $ len | otherwise = fail "Partial body length invalid." putSubPacketLength :: Word32 -> Put putSubPacketLength l | l < 192 = putWord8 (fromIntegral l) | l < 8384 = putWord8 (fromIntegral ((fromIntegral (l - 192) `shiftR` 8) + 192 :: Int)) >> putWord8 (fromIntegral (l - 192) .&. 0xff) | l <= 0xffffffff = putWord8 255 >> putWord32be (fromIntegral l) | otherwise = error ("too big (" ++ show l ++ ")") getSigSubPacketType :: Get (Bool, Word8) getSigSubPacketType = do x <- getWord8 return (if x .&. 128 == 128 then (True, x .&. 127) else (False, x)) putSigSubPacketType :: Bool -> Word8 -> Put putSigSubPacketType False sst = putWord8 sst putSigSubPacketType True sst = putWord8 (sst .|. 0x80) bsToFFSet :: FutureFlag a => ByteString -> Set a bsToFFSet bs = Set.fromAscList . concat . snd $ mapAccumL (\acc y -> (acc + 8, concatMap (shifty acc y) [0 .. 7])) 0 (BL.unpack bs) where shifty acc y x = [toFFlag (acc + x) | y .&. shiftR 128 x == shiftR 128 x] ffSetToFixedLengthBS :: (Integral a, FutureFlag b) => a -> Set b -> ByteString ffSetToFixedLengthBS len ffs = BL.take (fromIntegral len) (BL.append (ffSetToBS ffs) (BL.pack (replicate 5 0))) ffSetToBS :: FutureFlag a => Set a -> ByteString ffSetToBS = BL.pack . ffSetToBS' where ffSetToBS' :: FutureFlag a => Set a -> [Word8] ffSetToBS' ks | Set.null ks = [] -- FIXME: should this be [0]? | otherwise = map ((foldl (.|.) 0 . map (shiftR 128 . flip mod 8 . fromFFlag) . Set.toAscList) . (\x -> Set.filter (\y -> fromFFlag y `div` 8 == x) ks)) [0 .. fromFFlag (Set.findMax ks) `div` 8] fromS2K :: S2K -> ByteString fromS2K (Simple hashalgo) = BL.pack [0, fromIntegral . fromFVal $ hashalgo] fromS2K (Salted hashalgo salt) | B.length (unSalt salt) == 8 = BL.pack [1, fromIntegral . fromFVal $ hashalgo] `BL.append` (BL.fromStrict . unSalt) salt | otherwise = error "Confusing salt size" fromS2K (IteratedSalted hashalgo salt count) | B.length (unSalt salt) == 8 = BL.pack [3, fromIntegral . fromFVal $ hashalgo] `BL.append` (BL.fromStrict . unSalt) salt `BL.snoc` encodeIterationCount count | otherwise = error "Confusing salt size" fromS2K (OtherS2K _ bs) = bs getPacketLength :: Get Integer getPacketLength = do firstOctet <- getWord8 getPacketLength' firstOctet where getPacketLength' :: Integral a => Word8 -> Get a getPacketLength' f | f < 192 = return . fromIntegral $ f | f < 224 = do secondOctet <- getWord8 return . fromIntegral $ shiftL (fromIntegral (f - 192) :: Int) 8 + (fromIntegral secondOctet :: Int) + 192 | f == 255 = do len <- getWord32be return . fromIntegral $ len | otherwise = fail "Partial body length support missing." --FIXME putPacketLength :: Integer -> Put putPacketLength l | l < 192 = putWord8 (fromIntegral l) | l < 8384 = putWord8 (fromIntegral ((fromIntegral (l - 192) `shiftR` 8) + 192 :: Int)) >> putWord8 (fromIntegral (l - 192) .&. 0xff) | l < 0x100000000 = putWord8 255 >> putWord32be (fromIntegral l) | otherwise = error "partial body length support needed" -- FIXME getS2K :: Get S2K getS2K = getS2K' =<< getWord8 where getS2K' :: Word8 -> Get S2K getS2K' t | t == 0 = do ha <- getWord8 return $ Simple (toFVal ha) | t == 1 = do ha <- getWord8 salt <- getByteString 8 return $ Salted (toFVal ha) (Salt salt) | t == 3 = do ha <- getWord8 salt <- getByteString 8 count <- getWord8 return $ IteratedSalted (toFVal ha) (Salt salt) (decodeIterationCount count) | otherwise = do bs <- getRemainingLazyByteString return $ OtherS2K t bs putS2K :: S2K -> Put putS2K (Simple hashalgo) = error ("confused by simple" ++ show hashalgo) putS2K (Salted hashalgo salt) = error ("confused by salted" ++ show hashalgo ++ " by " ++ show salt) putS2K (IteratedSalted ha salt count) = do putWord8 3 put ha putByteString (unSalt salt) putWord8 $ encodeIterationCount count putS2K (OtherS2K t bs) = putWord8 t >> putLazyByteString bs getPacketTypeAndPayload :: Get (Word8, ByteString) getPacketTypeAndPayload = do tag <- getWord8 guard (testBit tag 7) case tag .&. 0x40 of 0x00 -> do let t = shiftR (tag .&. 0x3c) 2 case tag .&. 0x03 of 0 -> do len <- getWord8 bs <- getLazyByteString (fromIntegral len) return (t, bs) 1 -> do len <- getWord16be bs <- getLazyByteString (fromIntegral len) return (t, bs) 2 -> do len <- getWord32be bs <- getLazyByteString (fromIntegral len) return (t, bs) 3 -> do bs <- getRemainingLazyByteString return (t, bs) _ -> error "This should never happen (getPacketTypeAndPayload/0x00)." 0x40 -> do len <- fmap fromIntegral getPacketLength bs <- getLazyByteString len return (tag .&. 0x3f, bs) _ -> error "This should never happen (getPacketTypeAndPayload/???)." getPkt :: Get Pkt getPkt = do (t, pl) <- getPacketTypeAndPayload case runGetOrFail (getPkt' t (BL.length pl)) pl of Left (_, _, e) -> return $! BrokenPacketPkt e t pl Right (_, _, p) -> return p where getPkt' :: Word8 -> ByteOffset -> Get Pkt getPkt' t len | t == 1 = do pv <- getWord8 eokeyid <- getLazyByteString 8 pka <- getWord8 mpib <- getRemainingLazyByteString case runGetOrFail (some getMPI) mpib of Left (_, _, e) -> fail ("PKESK MPIs " ++ e) Right (_, _, sk) -> return $ PKESKPkt pv (EightOctetKeyId eokeyid) (toFVal pka) (NE.fromList sk) | t == 2 = do bs <- getRemainingLazyByteString case runGetOrFail get bs of Left (_, _, e) -> fail ("signature packet " ++ e) Right (_, _, sp) -> return $ SignaturePkt sp | t == 3 = do pv <- getWord8 symalgo <- getWord8 s2k <- getS2K esk <- getRemainingLazyByteString return $ SKESKPkt pv (toFVal symalgo) s2k (if BL.null esk then Nothing else Just esk) | t == 4 = do pv <- getWord8 sigtype <- getWord8 ha <- getWord8 pka <- getWord8 skeyid <- getLazyByteString 8 nested <- getWord8 return $ OnePassSignaturePkt pv (toFVal sigtype) (toFVal ha) (toFVal pka) (EightOctetKeyId skeyid) (nested == 0) | t == 5 = do bs <- getLazyByteString len let ps = flip runGetOrFail bs $ do pkp <- getPKPayload ska <- getSKAddendum pkp return $ SecretKeyPkt pkp ska case ps of Left (_, _, err) -> fail ("secret key " ++ err) Right (_, _, key) -> return key | t == 6 = do pkp <- getPKPayload return $ PublicKeyPkt pkp | t == 7 = do bs <- getLazyByteString len let ps = flip runGetOrFail bs $ do pkp <- getPKPayload ska <- getSKAddendum pkp return $ SecretSubkeyPkt pkp ska case ps of Left (_, _, err) -> fail ("secret subkey " ++ err) Right (_, _, key) -> return key | t == 8 = do ca <- getWord8 cdata <- getLazyByteString (len - 1) return $ CompressedDataPkt (toFVal ca) cdata | t == 9 = do sdata <- getLazyByteString len return $ SymEncDataPkt sdata | t == 10 = do marker <- getLazyByteString len return $ MarkerPkt marker | t == 11 = do dt <- getWord8 flen <- getWord8 fn <- getLazyByteString (fromIntegral flen) ts <- fmap ThirtyTwoBitTimeStamp getWord32be ldata <- getLazyByteString (len - (6 + fromIntegral flen)) return $ LiteralDataPkt (toFVal dt) fn ts ldata | t == 12 = do tdata <- getLazyByteString len return $ TrustPkt tdata | t == 13 = do udata <- getByteString (fromIntegral len) return . UserIdPkt . decodeUtf8With lenientDecode $ udata | t == 14 = do bs <- getLazyByteString len let ps = flip runGetOrFail bs $ do pkp <- getPKPayload return $ PublicSubkeyPkt pkp case ps of Left (_, _, err) -> fail ("public subkey " ++ err) Right (_, _, key) -> return key | t == 17 = do bs <- getLazyByteString len case runGetOrFail (many getUserAttrSubPacket) bs of Left (_, _, err) -> fail ("user attribute " ++ err) Right (_, _, uas) -> return $ UserAttributePkt uas | t == 18 = do pv <- getWord8 -- should be 1 b <- getLazyByteString (len - 1) return $ SymEncIntegrityProtectedDataPkt pv b | t == 19 = do hash <- getLazyByteString 20 return $ ModificationDetectionCodePkt hash | otherwise = do payload <- getLazyByteString len return $ OtherPacketPkt t payload getUserAttrSubPacket :: Get UserAttrSubPacket getUserAttrSubPacket = do l <- fmap fromIntegral getSubPacketLength t <- getWord8 getUserAttrSubPacket' t l where getUserAttrSubPacket' :: Word8 -> ByteOffset -> Get UserAttrSubPacket getUserAttrSubPacket' t l | t == 1 = do _ <- getWord16le -- ihlen hver <- getWord8 -- should be 1 iformat <- getWord8 nuls <- getLazyByteString 12 -- should be NULs bs <- getLazyByteString (l - 17) if hver /= 1 || nuls /= BL.pack (replicate 12 0) then fail "Corrupt UAt subpacket" else return $ ImageAttribute (ImageHV1 (toFVal iformat)) bs | otherwise = do bs <- getLazyByteString (l - 1) return $ OtherUASub t bs putUserAttrSubPacket :: UserAttrSubPacket -> Put putUserAttrSubPacket ua = do let sp = runPut $ putUserAttrSubPacket' ua putSubPacketLength . fromIntegral . BL.length $ sp putLazyByteString sp where putUserAttrSubPacket' (ImageAttribute (ImageHV1 iformat) idata) = do putWord8 1 putWord16le 16 putWord8 1 putWord8 (fromFVal iformat) replicateM_ 12 $ putWord8 0 putLazyByteString idata putUserAttrSubPacket' (OtherUASub t bs) = do putWord8 t putLazyByteString bs putPkt :: Pkt -> Put putPkt (PKESKPkt pv eokeyid pka mpis) = do putWord8 (0xc0 .|. 1) let bsk = runPut $ F.mapM_ put mpis putPacketLength . fromIntegral $ 10 + BL.length bsk putWord8 pv -- must be 3 putLazyByteString (unEOKI eokeyid) -- must be 8 octets putWord8 $ fromIntegral . fromFVal $ pka putLazyByteString bsk putPkt (SignaturePkt sp) = do putWord8 (0xc0 .|. 2) let bs = runPut $ put sp putLengthThenPayload bs putPkt (SKESKPkt pv symalgo s2k mesk) = do putWord8 (0xc0 .|. 3) let bs2k = fromS2K s2k let bsk = fromMaybe BL.empty mesk putPacketLength . fromIntegral $ 2 + BL.length bs2k + BL.length bsk putWord8 pv -- should be 4 putWord8 $ fromIntegral . fromFVal $ symalgo putLazyByteString bs2k putLazyByteString bsk putPkt (OnePassSignaturePkt pv sigtype ha pka skeyid nested) = do putWord8 (0xc0 .|. 4) let bs = runPut $ do putWord8 pv -- should be 3 putWord8 $ fromIntegral . fromFVal $ sigtype putWord8 $ fromIntegral . fromFVal $ ha putWord8 $ fromIntegral . fromFVal $ pka putLazyByteString (unEOKI skeyid) putWord8 . fromIntegral . fromEnum $ not nested -- FIXME: what do other values mean? putLengthThenPayload bs putPkt (SecretKeyPkt pkp ska) = do putWord8 (0xc0 .|. 5) let bs = runPut (putPKPayload pkp >> putSKAddendum ska) putLengthThenPayload bs putPkt (PublicKeyPkt pkp) = do putWord8 (0xc0 .|. 6) let bs = runPut $ putPKPayload pkp putLengthThenPayload bs putPkt (SecretSubkeyPkt pkp ska) = do putWord8 (0xc0 .|. 7) let bs = runPut (putPKPayload pkp >> putSKAddendum ska) putLengthThenPayload bs putPkt (CompressedDataPkt ca cdata) = do putWord8 (0xc0 .|. 8) let bs = runPut $ do putWord8 $ fromIntegral . fromFVal $ ca putLazyByteString cdata putLengthThenPayload bs putPkt (SymEncDataPkt b) = do putWord8 (0xc0 .|. 9) putLengthThenPayload b putPkt (MarkerPkt b) = do putWord8 (0xc0 .|. 10) putLengthThenPayload b putPkt (LiteralDataPkt dt fn ts b) = do putWord8 (0xc0 .|. 11) let bs = runPut $ do putWord8 $ fromIntegral . fromFVal $ dt putWord8 $ fromIntegral . BL.length $ fn putLazyByteString fn putWord32be . unThirtyTwoBitTimeStamp $ ts putLazyByteString b putLengthThenPayload bs putPkt (TrustPkt b) = do putWord8 (0xc0 .|. 12) putLengthThenPayload b putPkt (UserIdPkt u) = do putWord8 (0xc0 .|. 13) let bs = encodeUtf8 u putPacketLength . fromIntegral $ B.length bs putByteString bs putPkt (PublicSubkeyPkt pkp) = do putWord8 (0xc0 .|. 14) let bs = runPut $ putPKPayload pkp putLengthThenPayload bs putPkt (UserAttributePkt us) = do putWord8 (0xc0 .|. 17) let bs = runPut $ mapM_ put us putLengthThenPayload bs putPkt (SymEncIntegrityProtectedDataPkt pv b) = do putWord8 (0xc0 .|. 18) putPacketLength . fromIntegral $ BL.length b + 1 putWord8 pv -- should be 1 putLazyByteString b putPkt (ModificationDetectionCodePkt hash) = do putWord8 (0xc0 .|. 19) putLengthThenPayload hash putPkt (OtherPacketPkt t payload) = do putWord8 (0xc0 .|. t) -- FIXME: restrict t putLengthThenPayload payload putPkt (BrokenPacketPkt _ t payload) = putPkt (OtherPacketPkt t payload) putLengthThenPayload :: ByteString -> Put putLengthThenPayload bs = do putPacketLength . fromIntegral $ BL.length bs putLazyByteString bs getMPI :: Get MPI getMPI = do mpilen <- getWord16be bs <- getByteString (fromIntegral (mpilen + 7) `div` 8) return $ MPI (os2ip bs) getPubkey :: PubKeyAlgorithm -> Get PKey getPubkey RSA = do MPI n <- get MPI e <- get return $ RSAPubKey (RSA_PublicKey (R.PublicKey (fromIntegral . B.length . i2osp $ n) n e)) getPubkey DeprecatedRSAEncryptOnly = getPubkey RSA getPubkey DeprecatedRSASignOnly = getPubkey RSA getPubkey DSA = do MPI p <- get MPI q <- get MPI g <- get MPI y <- get return $ DSAPubKey (DSA_PublicKey (D.PublicKey (D.Params p g q) y)) getPubkey ElgamalEncryptOnly = getPubkey ForbiddenElgamal getPubkey ForbiddenElgamal = do MPI p <- get MPI g <- get MPI y <- get return $ ElGamalPubKey p g y getPubkey ECDSA = do curvelength <- getWord8 -- FIXME: test for 0 or 0xFF as they are reserved curveoid <- getByteString (fromIntegral curvelength) MPI mpi <- getMPI -- FIXME: check length against curve type? case curveoidBSToCurve curveoid of Left e -> fail e Right Curve25519 -> return $ EdDSAPubKey Ed25519 (EPoint mpi) Right curve -> case bs2Point (i2osp mpi) of Left e -> fail e Right point -> return . ECDSAPubKey . ECDSA_PublicKey . ECDSA.PublicKey (curve2Curve curve) $ point getPubkey ECDH = do ed <- getPubkey ECDSA -- could be an ECDSA or an EdDSA kdflen <- getWord8 -- FIXME: should be 3, test for 0 or 0xFF as they are reserved one <- getWord8 -- FIXME: should be 1 kdfHA <- get kdfSA <- get return $ ECDHPubKey ed kdfHA kdfSA getPubkey EdDSA = do curvelength <- getWord8 -- FIXME: test for 0 or 0xFF as they are reserved curveoid <- getByteString (fromIntegral curvelength) MPI mpi <- getMPI -- FIXME: check length against curve type? case curveoidBSToEdSigningCurve curveoid of Left e -> fail e Right Ed25519 -> return . EdDSAPubKey Ed25519 $ EPoint mpi getPubkey _ = UnknownPKey <$> getRemainingLazyByteString bs2Point :: B.ByteString -> Either String ECDSA.PublicPoint bs2Point bs = let xy = B.drop 1 bs in let l = B.length xy in if B.head bs == 0x04 then return (uncurry ECCT.Point (bimap os2ip os2ip (B.splitAt (div l 2) xy))) else Left $ "unknown type of point: " ++ show (B.unpack bs) putPubkey :: PKey -> Put putPubkey (UnknownPKey bs) = putLazyByteString bs putPubkey p@(ECDSAPubKey (ECDSA_PublicKey (ECDSA.PublicKey curve _))) = let Right curveoidbs = curveToCurveoidBS (curveFromCurve curve) in putWord8 (fromIntegral (B.length curveoidbs)) >> putByteString curveoidbs >> mapM_ put (pubkeyToMPIs p) -- FIXME: do not output length 0 or 0xff putPubkey p@(ECDHPubKey (ECDSAPubKey (ECDSA_PublicKey (ECDSA.PublicKey curve _))) kha ksa) = let Right curveoidbs = curveToCurveoidBS (curveFromCurve curve) in putWord8 (fromIntegral (B.length curveoidbs)) >> putByteString curveoidbs >> mapM_ put (pubkeyToMPIs p) >> putWord8 0x03 >> putWord8 0x01 >> put kha >> put ksa -- FIXME: do not output length 0 or 0xff putPubkey p@(ECDHPubKey (EdDSAPubKey curve _) kha ksa) = let Right curveoidbs = curveToCurveoidBS (ed2ec curve) in putWord8 (fromIntegral (B.length curveoidbs)) >> putByteString curveoidbs >> mapM_ put (pubkeyToMPIs p) >> putWord8 0x03 >> putWord8 0x01 >> put kha >> put ksa -- FIXME: do not output length 0 or 0xff where ed2ec Ed25519 = Curve25519 putPubkey p@(EdDSAPubKey curve _) = let Right curveoidbs = edSigningCurveToCurveoidBS curve in putWord8 (fromIntegral (B.length curveoidbs)) >> putByteString curveoidbs >> mapM_ put (pubkeyToMPIs p) -- FIXME: do not output length 0 or 0xff putPubkey p = mapM_ put (pubkeyToMPIs p) getSecretKey :: PKPayload -> Get SKey getSecretKey pkp | _pkalgo pkp `elem` [RSA, DeprecatedRSAEncryptOnly, DeprecatedRSASignOnly] = do MPI d <- get MPI p <- get MPI q <- get MPI _ <- get -- u let dP = 0 dQ = 0 qinv = 0 pub = (\(RSAPubKey (RSA_PublicKey x)) -> x) (pkp ^. pubkey) return $ RSAPrivateKey (RSA_PrivateKey (R.PrivateKey pub d p q dP dQ qinv)) | _pkalgo pkp == DSA = do MPI x <- get return $ DSAPrivateKey (DSA_PrivateKey (D.PrivateKey (D.Params 0 0 0) x)) | _pkalgo pkp `elem` [ElgamalEncryptOnly, ForbiddenElgamal] = do MPI x <- get return $ ElGamalPrivateKey x | _pkalgo pkp == ECDSA = do MPI pn <- get let pubcurve = (\(ECDSAPubKey (ECDSA_PublicKey p)) -> ECDSA.public_curve p) (pkp ^. pubkey) return $ ECDSAPrivateKey (ECDSA_PrivateKey (ECDSA.PrivateKey pubcurve pn)) | _pkalgo pkp == ECDH -- FIXME: deduplicate this and above = do MPI pn <- get let pubcurve = (\(ECDSAPubKey (ECDSA_PublicKey p)) -> ECDSA.public_curve p) (pkp ^. pubkey) return $ ECDHPrivateKey (ECDSA_PrivateKey (ECDSA.PrivateKey pubcurve pn)) putSKey :: SKey -> Put putSKey (RSAPrivateKey (RSA_PrivateKey (R.PrivateKey _ d p q _ _ _))) = put (MPI d) >> put (MPI p) >> put (MPI q) >> put (MPI u) where u = multiplicativeInverse q p putMPI :: MPI -> Put putMPI (MPI i) = do let bs = i2osp i putWord16be . fromIntegral . numBits $ i putByteString bs getPKPayload :: Get PKPayload getPKPayload = do version <- getWord8 ctime <- fmap ThirtyTwoBitTimeStamp getWord32be if version `elem` [2, 3] then do v3e <- getWord16be pka <- get pk <- getPubkey pka return $! PKPayload DeprecatedV3 ctime v3e pka pk else do pka <- get pk <- getPubkey pka return $! PKPayload V4 ctime 0 pka pk putPKPayload :: PKPayload -> Put putPKPayload (PKPayload DeprecatedV3 ctime v3e pka pk) = do putWord8 3 putWord32be . unThirtyTwoBitTimeStamp $ ctime putWord16be v3e put pka putPubkey pk putPKPayload (PKPayload V4 ctime _ pka pk) = do putWord8 4 putWord32be . unThirtyTwoBitTimeStamp $ ctime put pka putPubkey pk getSKAddendum :: PKPayload -> Get SKAddendum getSKAddendum pkp = do s2kusage <- getWord8 case s2kusage of 0 -> do sk <- getSecretKey pkp checksum <- getWord16be -- FIXME: validate checksum? return $ SUUnencrypted sk checksum 255 -> do symenc <- getWord8 s2k <- getS2K case s2k -- FIXME: this is a mess of OtherS2K _ _ -> return $ SUS16bit (toFVal symenc) s2k mempty BL.empty _ -> do iv <- getByteString (symEncBlockSize . toFVal $ symenc) encryptedblock <- getRemainingLazyByteString return $ SUS16bit (toFVal symenc) s2k (IV iv) encryptedblock 254 -> do symenc <- getWord8 s2k <- getS2K case s2k -- FIXME: this is a mess of OtherS2K _ _ -> return $ SUSSHA1 (toFVal symenc) s2k mempty BL.empty _ -> do iv <- getByteString (symEncBlockSize . toFVal $ symenc) encryptedblock <- getRemainingLazyByteString return $ SUSSHA1 (toFVal symenc) s2k (IV iv) encryptedblock symenc -> do iv <- getByteString (symEncBlockSize . toFVal $ symenc) encryptedblock <- getRemainingLazyByteString return $ SUSym (toFVal symenc) (IV iv) encryptedblock putSKAddendum :: SKAddendum -> Put putSKAddendum (SUSSHA1 symenc s2k iv encryptedblock) = do putWord8 254 put symenc put s2k putByteString (unIV iv) putLazyByteString encryptedblock putSKAddendum (SUUnencrypted sk checksum) = do putWord8 0 let skb = runPut (putSKey sk) putLazyByteString skb putWord16be (if checksum == 0 then BL.foldl (\a b -> mod (a + fromIntegral b) 0xffff) (0 :: Word16) skb else checksum) -- FIXME: be saner putSKAddendum _ = error "Type not supported" symEncBlockSize :: SymmetricAlgorithm -> Int symEncBlockSize Plaintext = 0 symEncBlockSize IDEA = 8 symEncBlockSize TripleDES = 8 symEncBlockSize CAST5 = 8 symEncBlockSize Blowfish = 8 symEncBlockSize AES128 = 16 symEncBlockSize AES192 = 16 symEncBlockSize AES256 = 16 symEncBlockSize Twofish = 16 symEncBlockSize Camellia128 = 16 symEncBlockSize _ = 8 -- FIXME decodeIterationCount :: Word8 -> IterationCount decodeIterationCount c = IterationCount ((16 + (fromIntegral c .&. 15)) `shiftL` ((fromIntegral c `shiftR` 4) + 6)) encodeIterationCount :: IterationCount -> Word8 -- should this really be a lookup table? encodeIterationCount 1024 = 0 encodeIterationCount 1088 = 1 encodeIterationCount 1152 = 2 encodeIterationCount 1216 = 3 encodeIterationCount 1280 = 4 encodeIterationCount 1344 = 5 encodeIterationCount 1408 = 6 encodeIterationCount 1472 = 7 encodeIterationCount 1536 = 8 encodeIterationCount 1600 = 9 encodeIterationCount 1664 = 10 encodeIterationCount 1728 = 11 encodeIterationCount 1792 = 12 encodeIterationCount 1856 = 13 encodeIterationCount 1920 = 14 encodeIterationCount 1984 = 15 encodeIterationCount 2048 = 16 encodeIterationCount 2176 = 17 encodeIterationCount 2304 = 18 encodeIterationCount 2432 = 19 encodeIterationCount 2560 = 20 encodeIterationCount 2688 = 21 encodeIterationCount 2816 = 22 encodeIterationCount 2944 = 23 encodeIterationCount 3072 = 24 encodeIterationCount 3200 = 25 encodeIterationCount 3328 = 26 encodeIterationCount 3456 = 27 encodeIterationCount 3584 = 28 encodeIterationCount 3712 = 29 encodeIterationCount 3840 = 30 encodeIterationCount 3968 = 31 encodeIterationCount 4096 = 32 encodeIterationCount 4352 = 33 encodeIterationCount 4608 = 34 encodeIterationCount 4864 = 35 encodeIterationCount 5120 = 36 encodeIterationCount 5376 = 37 encodeIterationCount 5632 = 38 encodeIterationCount 5888 = 39 encodeIterationCount 6144 = 40 encodeIterationCount 6400 = 41 encodeIterationCount 6656 = 42 encodeIterationCount 6912 = 43 encodeIterationCount 7168 = 44 encodeIterationCount 7424 = 45 encodeIterationCount 7680 = 46 encodeIterationCount 7936 = 47 encodeIterationCount 8192 = 48 encodeIterationCount 8704 = 49 encodeIterationCount 9216 = 50 encodeIterationCount 9728 = 51 encodeIterationCount 10240 = 52 encodeIterationCount 10752 = 53 encodeIterationCount 11264 = 54 encodeIterationCount 11776 = 55 encodeIterationCount 12288 = 56 encodeIterationCount 12800 = 57 encodeIterationCount 13312 = 58 encodeIterationCount 13824 = 59 encodeIterationCount 14336 = 60 encodeIterationCount 14848 = 61 encodeIterationCount 15360 = 62 encodeIterationCount 15872 = 63 encodeIterationCount 16384 = 64 encodeIterationCount 17408 = 65 encodeIterationCount 18432 = 66 encodeIterationCount 19456 = 67 encodeIterationCount 20480 = 68 encodeIterationCount 21504 = 69 encodeIterationCount 22528 = 70 encodeIterationCount 23552 = 71 encodeIterationCount 24576 = 72 encodeIterationCount 25600 = 73 encodeIterationCount 26624 = 74 encodeIterationCount 27648 = 75 encodeIterationCount 28672 = 76 encodeIterationCount 29696 = 77 encodeIterationCount 30720 = 78 encodeIterationCount 31744 = 79 encodeIterationCount 32768 = 80 encodeIterationCount 34816 = 81 encodeIterationCount 36864 = 82 encodeIterationCount 38912 = 83 encodeIterationCount 40960 = 84 encodeIterationCount 43008 = 85 encodeIterationCount 45056 = 86 encodeIterationCount 47104 = 87 encodeIterationCount 49152 = 88 encodeIterationCount 51200 = 89 encodeIterationCount 53248 = 90 encodeIterationCount 55296 = 91 encodeIterationCount 57344 = 92 encodeIterationCount 59392 = 93 encodeIterationCount 61440 = 94 encodeIterationCount 63488 = 95 encodeIterationCount 65536 = 96 encodeIterationCount 69632 = 97 encodeIterationCount 73728 = 98 encodeIterationCount 77824 = 99 encodeIterationCount 81920 = 100 encodeIterationCount 86016 = 101 encodeIterationCount 90112 = 102 encodeIterationCount 94208 = 103 encodeIterationCount 98304 = 104 encodeIterationCount 102400 = 105 encodeIterationCount 106496 = 106 encodeIterationCount 110592 = 107 encodeIterationCount 114688 = 108 encodeIterationCount 118784 = 109 encodeIterationCount 122880 = 110 encodeIterationCount 126976 = 111 encodeIterationCount 131072 = 112 encodeIterationCount 139264 = 113 encodeIterationCount 147456 = 114 encodeIterationCount 155648 = 115 encodeIterationCount 163840 = 116 encodeIterationCount 172032 = 117 encodeIterationCount 180224 = 118 encodeIterationCount 188416 = 119 encodeIterationCount 196608 = 120 encodeIterationCount 204800 = 121 encodeIterationCount 212992 = 122 encodeIterationCount 221184 = 123 encodeIterationCount 229376 = 124 encodeIterationCount 237568 = 125 encodeIterationCount 245760 = 126 encodeIterationCount 253952 = 127 encodeIterationCount 262144 = 128 encodeIterationCount 278528 = 129 encodeIterationCount 294912 = 130 encodeIterationCount 311296 = 131 encodeIterationCount 327680 = 132 encodeIterationCount 344064 = 133 encodeIterationCount 360448 = 134 encodeIterationCount 376832 = 135 encodeIterationCount 393216 = 136 encodeIterationCount 409600 = 137 encodeIterationCount 425984 = 138 encodeIterationCount 442368 = 139 encodeIterationCount 458752 = 140 encodeIterationCount 475136 = 141 encodeIterationCount 491520 = 142 encodeIterationCount 507904 = 143 encodeIterationCount 524288 = 144 encodeIterationCount 557056 = 145 encodeIterationCount 589824 = 146 encodeIterationCount 622592 = 147 encodeIterationCount 655360 = 148 encodeIterationCount 688128 = 149 encodeIterationCount 720896 = 150 encodeIterationCount 753664 = 151 encodeIterationCount 786432 = 152 encodeIterationCount 819200 = 153 encodeIterationCount 851968 = 154 encodeIterationCount 884736 = 155 encodeIterationCount 917504 = 156 encodeIterationCount 950272 = 157 encodeIterationCount 983040 = 158 encodeIterationCount 1015808 = 159 encodeIterationCount 1048576 = 160 encodeIterationCount 1114112 = 161 encodeIterationCount 1179648 = 162 encodeIterationCount 1245184 = 163 encodeIterationCount 1310720 = 164 encodeIterationCount 1376256 = 165 encodeIterationCount 1441792 = 166 encodeIterationCount 1507328 = 167 encodeIterationCount 1572864 = 168 encodeIterationCount 1638400 = 169 encodeIterationCount 1703936 = 170 encodeIterationCount 1769472 = 171 encodeIterationCount 1835008 = 172 encodeIterationCount 1900544 = 173 encodeIterationCount 1966080 = 174 encodeIterationCount 2031616 = 175 encodeIterationCount 2097152 = 176 encodeIterationCount 2228224 = 177 encodeIterationCount 2359296 = 178 encodeIterationCount 2490368 = 179 encodeIterationCount 2621440 = 180 encodeIterationCount 2752512 = 181 encodeIterationCount 2883584 = 182 encodeIterationCount 3014656 = 183 encodeIterationCount 3145728 = 184 encodeIterationCount 3276800 = 185 encodeIterationCount 3407872 = 186 encodeIterationCount 3538944 = 187 encodeIterationCount 3670016 = 188 encodeIterationCount 3801088 = 189 encodeIterationCount 3932160 = 190 encodeIterationCount 4063232 = 191 encodeIterationCount 4194304 = 192 encodeIterationCount 4456448 = 193 encodeIterationCount 4718592 = 194 encodeIterationCount 4980736 = 195 encodeIterationCount 5242880 = 196 encodeIterationCount 5505024 = 197 encodeIterationCount 5767168 = 198 encodeIterationCount 6029312 = 199 encodeIterationCount 6291456 = 200 encodeIterationCount 6553600 = 201 encodeIterationCount 6815744 = 202 encodeIterationCount 7077888 = 203 encodeIterationCount 7340032 = 204 encodeIterationCount 7602176 = 205 encodeIterationCount 7864320 = 206 encodeIterationCount 8126464 = 207 encodeIterationCount 8388608 = 208 encodeIterationCount 8912896 = 209 encodeIterationCount 9437184 = 210 encodeIterationCount 9961472 = 211 encodeIterationCount 10485760 = 212 encodeIterationCount 11010048 = 213 encodeIterationCount 11534336 = 214 encodeIterationCount 12058624 = 215 encodeIterationCount 12582912 = 216 encodeIterationCount 13107200 = 217 encodeIterationCount 13631488 = 218 encodeIterationCount 14155776 = 219 encodeIterationCount 14680064 = 220 encodeIterationCount 15204352 = 221 encodeIterationCount 15728640 = 222 encodeIterationCount 16252928 = 223 encodeIterationCount 16777216 = 224 encodeIterationCount 17825792 = 225 encodeIterationCount 18874368 = 226 encodeIterationCount 19922944 = 227 encodeIterationCount 20971520 = 228 encodeIterationCount 22020096 = 229 encodeIterationCount 23068672 = 230 encodeIterationCount 24117248 = 231 encodeIterationCount 25165824 = 232 encodeIterationCount 26214400 = 233 encodeIterationCount 27262976 = 234 encodeIterationCount 28311552 = 235 encodeIterationCount 29360128 = 236 encodeIterationCount 30408704 = 237 encodeIterationCount 31457280 = 238 encodeIterationCount 32505856 = 239 encodeIterationCount 33554432 = 240 encodeIterationCount 35651584 = 241 encodeIterationCount 37748736 = 242 encodeIterationCount 39845888 = 243 encodeIterationCount 41943040 = 244 encodeIterationCount 44040192 = 245 encodeIterationCount 46137344 = 246 encodeIterationCount 48234496 = 247 encodeIterationCount 50331648 = 248 encodeIterationCount 52428800 = 249 encodeIterationCount 54525952 = 250 encodeIterationCount 56623104 = 251 encodeIterationCount 58720256 = 252 encodeIterationCount 60817408 = 253 encodeIterationCount 62914560 = 254 encodeIterationCount 65011712 = 255 encodeIterationCount n = error ("invalid iteration count" ++ show n) getSignaturePayload :: Get SignaturePayload getSignaturePayload = do pv <- getWord8 case pv of 3 -> do hashlen <- getWord8 guard (hashlen == 5) st <- getWord8 ctime <- fmap ThirtyTwoBitTimeStamp getWord32be eok <- getLazyByteString 8 pka <- get ha <- get left16 <- getWord16be mpib <- getRemainingLazyByteString case runGetOrFail (some getMPI) mpib of Left (_, _, e) -> fail ("v3 sig MPIs " ++ e) Right (_, _, mpis) -> return $ SigV3 (toFVal st) ctime (EightOctetKeyId eok) (toFVal pka) (toFVal ha) left16 (NE.fromList mpis) 4 -> do st <- getWord8 pka <- get ha <- get hlen <- getWord16be hb <- getLazyByteString (fromIntegral hlen) let hashed = case runGetOrFail (many getSigSubPacket) hb of Left (_, _, err) -> fail ("v4 sig hasheds " ++ err) Right (_, _, h) -> h ulen <- getWord16be ub <- getLazyByteString (fromIntegral ulen) let unhashed = case runGetOrFail (many getSigSubPacket) ub of Left (_, _, err) -> fail ("v4 sig unhasheds " ++ err) Right (_, _, u) -> u left16 <- getWord16be mpib <- getRemainingLazyByteString case runGetOrFail (some getMPI) mpib of Left (_, _, e) -> fail ("v4 sig MPIs " ++ e) Right (_, _, mpis) -> return $ SigV4 (toFVal st) (toFVal pka) (toFVal ha) hashed unhashed left16 (NE.fromList mpis) _ -> do bs <- getRemainingLazyByteString return $ SigVOther pv bs putSignaturePayload :: SignaturePayload -> Put putSignaturePayload (SigV3 st ctime eok pka ha left16 mpis) = do putWord8 3 putWord8 5 -- hashlen put st putWord32be . unThirtyTwoBitTimeStamp $ ctime putLazyByteString (unEOKI eok) put pka put ha putWord16be left16 F.mapM_ put mpis putSignaturePayload (SigV4 st pka ha hashed unhashed left16 mpis) = do putWord8 4 put st put pka put ha let hb = runPut $ mapM_ put hashed putWord16be . fromIntegral . BL.length $ hb putLazyByteString hb let ub = runPut $ mapM_ put unhashed putWord16be . fromIntegral . BL.length $ ub putLazyByteString ub putWord16be left16 F.mapM_ put mpis putSignaturePayload (SigVOther pv bs) = do putWord8 pv putLazyByteString bs putTK :: TK -> Put putTK key = do let pkp = key ^. tkKey . _1 maybe (put (PublicKey pkp)) (\ska -> put (SecretKey pkp ska)) (snd (key ^. tkKey)) mapM_ (put . Signature) (_tkRevs key) mapM_ putUid' (_tkUIDs key) mapM_ putUat' (_tkUAts key) mapM_ putSub' (_tkSubs key) where putUid' (u, sps) = put (UserId u) >> mapM_ (put . Signature) sps putUat' (us, sps) = put (UserAttribute us) >> mapM_ (put . Signature) sps putSub' (p, sps) = put p >> mapM_ (put . Signature) sps -- | Parse the packets from a ByteString, with no error reporting parsePkts :: ByteString -> [Pkt] parsePkts lbs = case runGetOrFail (some getPkt) lbs of Left (_, _, e) -> [] Right (_, _, p) -> p hOpenPGP-2.10.1/Codec/Encryption/OpenPGP/SerializeForSigs.hs0000644000000000000000000001243007346545000021603 0ustar0000000000000000-- SerializeForSigs.hs: OpenPGP (RFC4880) special serialization for signature purposes -- Copyright © 2012-2020 Clint Adams -- This software is released under the terms of the Expat license. -- (See the LICENSE file). module Codec.Encryption.OpenPGP.SerializeForSigs ( putPKPforFingerprinting , putPartialSigforSigning , putSigTrailer , putUforSigning , putUIDforSigning , putUAtforSigning , putKeyforSigning , putSigforSigning , payloadForSig ) where import Control.Lens ((^.)) import Crypto.Number.Serialize (i2osp) import Data.Binary (put) import Data.Binary.Put ( Put , putByteString , putLazyByteString , putWord16be , putWord32be , putWord8 , runPut ) import qualified Data.ByteString as B import Data.ByteString.Lazy (ByteString) import qualified Data.ByteString.Lazy as BL import Data.Text.Encoding (encodeUtf8) import Codec.Encryption.OpenPGP.Internal (PktStreamContext(..), pubkeyToMPIs) import Codec.Encryption.OpenPGP.Serialize () import Codec.Encryption.OpenPGP.Types putPKPforFingerprinting :: Pkt -> Put putPKPforFingerprinting (PublicKeyPkt (PKPayload DeprecatedV3 _ _ _ pk)) = mapM_ putMPIforFingerprinting (pubkeyToMPIs pk) putPKPforFingerprinting (PublicKeyPkt pkp@(PKPayload V4 _ _ _ _)) = do putWord8 0x99 let bs = runPut $ put pkp putWord16be . fromIntegral $ BL.length bs putLazyByteString bs putPKPforFingerprinting _ = error "This should never happen (putPKPforFingerprinting)" putMPIforFingerprinting :: MPI -> Put putMPIforFingerprinting (MPI i) = let bs = i2osp i in putByteString bs putPartialSigforSigning :: Pkt -> Put putPartialSigforSigning (SignaturePkt (SigV4 st pka ha hashed _ _ _)) = do putWord8 4 put st put pka put ha let hb = runPut $ mapM_ put hashed putWord16be . fromIntegral . BL.length $ hb putLazyByteString hb putPartialSigforSigning _ = error "This should never happen (putPartialSigforSigning)" putSigTrailer :: Pkt -> Put putSigTrailer (SignaturePkt (SigV4 _ _ _ hs _ _ _)) = do putWord8 0x04 putWord8 0xff putWord32be . fromIntegral . (+ 6) . BL.length $ runPut $ mapM_ put hs -- this +6 seems like a bug in RFC4880 putSigTrailer _ = error "This should never happen (putSigTrailer)" putUforSigning :: Pkt -> Put putUforSigning u@(UserIdPkt _) = putUIDforSigning u putUforSigning u@(UserAttributePkt _) = putUAtforSigning u putUforSigning _ = error "This should never happen (putUforSigning)" putUIDforSigning :: Pkt -> Put putUIDforSigning (UserIdPkt u) = do putWord8 0xB4 let bs = encodeUtf8 u putWord32be . fromIntegral . B.length $ bs putByteString bs putUIDforSigning _ = error "This should never happen (putUIDforSigning)" putUAtforSigning :: Pkt -> Put putUAtforSigning (UserAttributePkt us) = do putWord8 0xD1 let bs = runPut (mapM_ put us) putWord32be . fromIntegral . BL.length $ bs putLazyByteString bs putUAtforSigning _ = error "This should never happen (putUAtforSigning)" putSigforSigning :: Pkt -> Put putSigforSigning (SignaturePkt (SigV4 st pka ha hashed _ left16 mpis)) = do putWord8 0x88 let bs = runPut $ put (SigV4 st pka ha hashed [] left16 mpis) putWord32be . fromIntegral . BL.length $ bs putLazyByteString bs putSigforSigning _ = error "Non-V4 not implemented." putKeyforSigning :: Pkt -> Put putKeyforSigning (PublicKeyPkt pkp) = putKeyForSigning' pkp putKeyforSigning (PublicSubkeyPkt pkp) = putKeyForSigning' pkp putKeyforSigning (SecretKeyPkt pkp _) = putKeyForSigning' pkp putKeyforSigning (SecretSubkeyPkt pkp _) = putKeyForSigning' pkp putKeyforSigning x = error ("This should never happen (putKeyforSigning) " ++ show (pktTag x) ++ "/" ++ show x) putKeyForSigning' :: PKPayload -> Put putKeyForSigning' pkp = do putWord8 0x99 let bs = runPut $ put pkp putWord16be . fromIntegral . BL.length $ bs putLazyByteString bs payloadForSig :: SigType -> PktStreamContext -> ByteString payloadForSig BinarySig state = fromPkt (lastLD state) ^. literalDataPayload payloadForSig CanonicalTextSig state = payloadForSig BinarySig state payloadForSig StandaloneSig _ = BL.empty payloadForSig GenericCert state = kandUPayload (lastPrimaryKey state) (lastUIDorUAt state) payloadForSig PersonaCert state = payloadForSig GenericCert state payloadForSig CasualCert state = payloadForSig GenericCert state payloadForSig PositiveCert state = payloadForSig GenericCert state payloadForSig SubkeyBindingSig state = kandKPayload (lastPrimaryKey state) (lastSubkey state) -- FIXME: embedded primary key binding sig should be verified as well payloadForSig PrimaryKeyBindingSig state = kandKPayload (lastPrimaryKey state) (lastSubkey state) payloadForSig SignatureDirectlyOnAKey state = runPut (putKeyforSigning (lastPrimaryKey state)) payloadForSig KeyRevocationSig state = payloadForSig SignatureDirectlyOnAKey state payloadForSig SubkeyRevocationSig state = kandKPayload (lastPrimaryKey state) (lastSubkey state) payloadForSig CertRevocationSig state = kandUPayload (lastPrimaryKey state) (lastUIDorUAt state) -- FIXME: this doesn't handle revocation of direct key signatures payloadForSig st _ = error ("I dunno how to " ++ show st) kandUPayload :: Pkt -> Pkt -> ByteString kandUPayload k u = runPut (sequence_ [putKeyforSigning k, putUforSigning u]) kandKPayload :: Pkt -> Pkt -> ByteString kandKPayload k1 k2 = runPut (sequence_ [putKeyforSigning k1, putKeyforSigning k2]) hOpenPGP-2.10.1/Codec/Encryption/OpenPGP/SignatureQualities.hs0000644000000000000000000000256307346545000022207 0ustar0000000000000000-- SignatureQualities.hs: OpenPGP (RFC4880) signature qualities -- Copyright © 2012-2019 Clint Adams -- This software is released under the terms of the Expat license. -- (See the LICENSE file). module Codec.Encryption.OpenPGP.SignatureQualities ( sigType , sigPKA , sigHA , sigCT ) where import Data.List (find) import Codec.Encryption.OpenPGP.Ontology (isSigCreationTime) import Codec.Encryption.OpenPGP.Types sigType :: SignaturePayload -> Maybe SigType sigType (SigV3 st _ _ _ _ _ _) = Just st sigType (SigV4 st _ _ _ _ _ _) = Just st sigType _ = Nothing -- this includes v2 sigs, which don't seem to be specified in the RFCs but exist in the wild sigPKA :: SignaturePayload -> Maybe PubKeyAlgorithm sigPKA (SigV3 _ _ _ pka _ _ _) = Just pka sigPKA (SigV4 _ pka _ _ _ _ _) = Just pka sigPKA _ = Nothing -- this includes v2 sigs, which don't seem to be specified in the RFCs but exist in the wild sigHA :: SignaturePayload -> Maybe HashAlgorithm sigHA (SigV3 _ _ _ _ ha _ _) = Just ha sigHA (SigV4 _ _ ha _ _ _ _) = Just ha sigHA _ = Nothing -- this includes v2 sigs, which don't seem to be specified in the RFCs but exist in the wild sigCT :: SignaturePayload -> Maybe ThirtyTwoBitTimeStamp sigCT (SigV3 _ ct _ _ _ _ _) = Just ct sigCT (SigV4 _ _ _ hsubs _ _ _) = fmap (\(SigSubPacket _ (SigCreationTime i)) -> i) (find isSigCreationTime hsubs) sigCT _ = Nothing hOpenPGP-2.10.1/Codec/Encryption/OpenPGP/Signatures.hs0000644000000000000000000004140107346545000020503 0ustar0000000000000000-- Signatures.hs: OpenPGP (RFC4880) signature verification -- Copyright © 2012-2020 Clint Adams -- This software is released under the terms of the Expat license. -- (See the LICENSE file). module Codec.Encryption.OpenPGP.Signatures ( verifySigWith , verifyAgainstKeyring , verifyAgainstKeys , verifyTKWith , signUserIDwithRSA , crossSignSubkeyWithRSA , signDataWithRSA ) where import Control.Applicative ((<|>)) import Control.Error.Util (hush) import Control.Lens ((^.), _1) import Control.Monad (liftM2) import Crypto.Error (eitherCryptoError) import Crypto.Hash (hashWith) import qualified Crypto.Hash.Algorithms as CHA import Crypto.Number.Serialize (i2osp, os2ip) import qualified Crypto.PubKey.DSA as DSA import qualified Crypto.PubKey.ECC.ECDSA as ECDSA import qualified Crypto.PubKey.Ed25519 as Ed25519 import qualified Crypto.PubKey.RSA.PKCS15 as P15 import qualified Crypto.PubKey.RSA.Types as RSATypes import Data.Bifunctor (first) import Data.Binary.Put (runPut) import qualified Data.ByteArray as BA import qualified Data.ByteString as B import Data.ByteString.Lazy (ByteString) import qualified Data.ByteString.Lazy as BL import Data.Either (isRight, lefts, rights) import Data.Function (on) import Data.IxSet.Typed ((@=)) import qualified Data.IxSet.Typed as IxSet import Data.List.NonEmpty (NonEmpty(..)) import qualified Data.List.NonEmpty as NE import Data.Text (Text) import Data.Time.Clock (UTCTime(..), diffUTCTime) import Data.Time.Clock.POSIX (posixSecondsToUTCTime) import Codec.Encryption.OpenPGP.Fingerprint (eightOctetKeyID, fingerprint) import Codec.Encryption.OpenPGP.Internal ( PktStreamContext(..) , emptyPSC , issuer , issuerFP ) import Codec.Encryption.OpenPGP.Ontology ( isRevocationKeySSP , isRevokerP , isSubkeyBindingSig , isSubkeyRevocation ) import Codec.Encryption.OpenPGP.SerializeForSigs ( payloadForSig , putKeyforSigning , putPartialSigforSigning , putSigTrailer , putUforSigning ) import Codec.Encryption.OpenPGP.Types import Data.Conduit.OpenPGP.Keyring.Instances () verifySigWith :: (Pkt -> Maybe UTCTime -> ByteString -> Either String Verification) -> Pkt -> PktStreamContext -> Maybe UTCTime -> Either String Verification -- FIXME: check expiration here? verifySigWith vf sig@(SignaturePkt (SigV4 st _ _ hs _ _ _)) state mt = do v <- vf sig mt (payloadForSig st state) mapM_ (checkI (v ^. verificationSigner) . _sspPayload) hs return v where checkI s i@Issuer {} = checkIssuer (eightOctetKeyID s) i checkI s i@IssuerFingerprint {} = checkIssuerFP (fingerprint s) i checkI _ _ = Right True checkIssuer :: Either String EightOctetKeyId -> SigSubPacketPayload -> Either String Bool checkIssuer (Right signer) (Issuer i) = if signer == i then Right True else Left "issuer subpacket does not match" checkIssuer (Left err) (Issuer _) = Left $ "issuer subpacket cannot be checked (" ++ err ++ ")" checkIssuer _ _ = Right True checkIssuerFP :: TwentyOctetFingerprint -> SigSubPacketPayload -> Either String Bool checkIssuerFP signer (IssuerFingerprint _ i) = if signer == i then Right True else Left "issuer fingerprint subpacket does not match" checkIssuerFP _ _ = Right True verifySigWith _ _ _ _ = Left "This should never happen (verifySigWith)." verifyTKWith :: (Pkt -> PktStreamContext -> Maybe UTCTime -> Either String Verification) -> Maybe UTCTime -> TK -> Either String TK verifyTKWith vsf mt key = do revokers <- checkRevokers key revs <- checkKeyRevocations revokers key let uids = filter (not . null . snd) . checkUidSigs $ key ^. tkUIDs -- FIXME: check revocations here? let uats = filter (not . null . snd) . checkUAtSigs $ key ^. tkUAts -- FIXME: check revocations here? let subs = concatMap checkSub $ key ^. tkSubs -- FIXME: check revocations here? return (TK (key ^. tkKey) revs uids uats subs) where checkRevokers = Right . concat . rights . map verifyRevoker . filter isRevokerP . _tkRevs checkKeyRevocations :: [(PubKeyAlgorithm, TwentyOctetFingerprint)] -> TK -> Either String [SignaturePayload] checkKeyRevocations rs k = Prelude.sequence . concatMap (filterRevs rs) . rights . map (liftM2 fmap (,) vSig) $ k ^. tkRevs checkUidSigs :: [(Text, [SignaturePayload])] -> [(Text, [SignaturePayload])] checkUidSigs = map (\(uid, sps) -> (uid, (rights . map (\sp -> fmap (const sp) (vUid (uid, sp)))) sps)) checkUAtSigs :: [([UserAttrSubPacket], [SignaturePayload])] -> [([UserAttrSubPacket], [SignaturePayload])] checkUAtSigs = map (\(uat, sps) -> (uat, (rights . map (\sp -> fmap (const sp) (vUAt (uat, sp)))) sps)) checkSub :: (Pkt, [SignaturePayload]) -> [(Pkt, [SignaturePayload])] checkSub (pkt, sps) = if revokedSub pkt sps then [] else checkSub' pkt sps revokedSub :: Pkt -> [SignaturePayload] -> Bool revokedSub _ [] = False revokedSub p sigs = any (vSubSig p) (filter isSubkeyRevocation sigs) checkSub' :: Pkt -> [SignaturePayload] -> [(Pkt, [SignaturePayload])] checkSub' p sps = let goodsigs = filter (vSubSig p) (filter isSubkeyBindingSig sps) in if null goodsigs then [] else [(p, goodsigs)] getHasheds (SigV4 _ _ _ ha _ _ _) = ha getHasheds _ = [] filterRevs :: [(PubKeyAlgorithm, TwentyOctetFingerprint)] -> (SignaturePayload, Verification) -> [Either String SignaturePayload] filterRevs vokers spv = case spv of (s@(SigV4 SignatureDirectlyOnAKey _ _ _ _ _ _), _) -> [Right s] (s@(SigV4 KeyRevocationSig pka _ _ _ _ _), v) -> if (v ^. verificationSigner == key ^. tkKey . _1) || any (\(p, f) -> p == pka && f == fingerprint (v ^. verificationSigner)) vokers then [Left "Key revoked"] else [Right s] _ -> [] vUid :: (Text, SignaturePayload) -> Either String Verification vUid (uid, sp) = vsf (SignaturePkt sp) emptyPSC { lastPrimaryKey = PublicKeyPkt (key ^. tkKey . _1) , lastUIDorUAt = UserIdPkt uid } mt vUAt :: ([UserAttrSubPacket], SignaturePayload) -> Either String Verification vUAt (uat, sp) = vsf (SignaturePkt sp) emptyPSC { lastPrimaryKey = PublicKeyPkt (key ^. tkKey . _1) , lastUIDorUAt = UserAttributePkt uat } mt vSig :: SignaturePayload -> Either String Verification vSig sp = vsf (SignaturePkt sp) emptyPSC {lastPrimaryKey = PublicKeyPkt (key ^. tkKey . _1)} mt vSubSig :: Pkt -> SignaturePayload -> Bool vSubSig sk sp = isRight (vsf (SignaturePkt sp) emptyPSC { lastPrimaryKey = PublicKeyPkt (key ^. tkKey . _1) , lastSubkey = sk } mt) verifyRevoker :: SignaturePayload -> Either String [(PubKeyAlgorithm, TwentyOctetFingerprint)] verifyRevoker sp = do _ <- vSig sp return (map (\(SigSubPacket _ (RevocationKey _ pka fp)) -> (pka, fp)) . filter isRevocationKeySSP $ getHasheds sp) verifyAgainstKeyring :: Keyring -> Pkt -> Maybe UTCTime -> ByteString -> Either String Verification verifyAgainstKeyring kr sig mt payload = do let ikeys = (kr @=) <$> issuer sig ifpkeys = (kr @=) <$> issuerFP sig keyset <- maybe (Left "issuer not found") Right (ifpkeys <|> ikeys) potentialmatches <- if IxSet.null keyset then Left "pubkey not found" else Right keyset verifyAgainstKeys (IxSet.toList potentialmatches) sig mt payload verifyAgainstKeys :: [TK] -> Pkt -> Maybe UTCTime -> ByteString -> Either String Verification verifyAgainstKeys ks sig mt payload = do let allrelevantpkps = filter (\x -> (((fingerprint x ==) <$> issuerFP sig) == Just True) || ((==) <$> issuer sig <*> hush (eightOctetKeyID x)) == Just True) (concatMap (\x -> (x ^. tkKey . _1) : map subPKP (_tkSubs x)) ks) let results = map (\pkp -> verifyAgainstKey' pkp sig mt payload) allrelevantpkps case rights results of [] -> Left (concatMap (++ "/") (lefts results)) [r] -> do _ <- isSignatureExpired sig mt return r _ -> Left "multiple successes; unexpected condition" where subPKP (pack, _) = subPKP' pack subPKP' (PublicSubkeyPkt p) = p subPKP' (SecretSubkeyPkt p _) = p subPKP' _ = error "This should never happen (subPKP')" verifyAgainstKey' :: PKPayload -> Pkt -> Maybe UTCTime -> ByteString -> Either String Verification verifyAgainstKey' pkp sig mt payload = do -- FIXME: check flags -- FIXME: check expiration time r <- verify' sig pkp (hashalgo sig) (BL.toStrict (finalPayload sig payload)) -- FIXME: check signature hash against policy -- FIXME: check pka against policy return (Verification r ((_signaturePayload . fromPkt) sig)) where verify' (SignaturePkt s) pub@(PKPayload V4 _ _ _ pkey) SHA1 pl = verify'' (pkaAndMPIs s) CHA.SHA1 pub pkey pl verify' (SignaturePkt s) pub@(PKPayload V4 _ _ _ pkey) RIPEMD160 pl = verify'' (pkaAndMPIs s) CHA.RIPEMD160 pub pkey pl verify' (SignaturePkt s) pub@(PKPayload V4 _ _ _ pkey) SHA256 pl = verify'' (pkaAndMPIs s) CHA.SHA256 pub pkey pl verify' (SignaturePkt s) pub@(PKPayload V4 _ _ _ pkey) SHA384 pl = verify'' (pkaAndMPIs s) CHA.SHA384 pub pkey pl verify' (SignaturePkt s) pub@(PKPayload V4 _ _ _ pkey) SHA512 pl = verify'' (pkaAndMPIs s) CHA.SHA512 pub pkey pl verify' (SignaturePkt s) pub@(PKPayload V4 _ _ _ pkey) SHA224 pl = verify'' (pkaAndMPIs s) CHA.SHA224 pub pkey pl verify' (SignaturePkt s) pub@(PKPayload V4 _ _ _ pkey) DeprecatedMD5 pl = verify'' (pkaAndMPIs s) CHA.MD5 pub pkey pl verify' _ _ _ _ = error "This should never happen (verify')." verify'' (DSA, mpis) hd pub (DSAPubKey (DSA_PublicKey pkey)) bs = dsaVerify pub mpis hd pkey bs verify'' (ECDSA, mpis) hd pub (ECDSAPubKey (ECDSA_PublicKey pkey)) bs = ecdsaVerify pub mpis hd pkey bs verify'' (EdDSA, mpis) hd pub (EdDSAPubKey Ed25519 pkey) bs = ed25519Verify pub mpis hd (i2osp (unEPoint pkey)) bs verify'' (RSA, mpis) hd pub (RSAPubKey (RSA_PublicKey pkey)) bs = rsaVerify pub mpis hd pkey bs verify'' _ _ _ _ _ = Left "unimplemented key type" dsaVerify pub (r :| [s]) hd pkey bs = if DSA.verify hd pkey (dsaMPIsToSig r s) bs then Right pub else Left ("DSA verification failed: " ++ show (hd, pkey, r, s, bs)) dsaVerify _ _ _ _ _ = Left "cannot verify DSA signature of wrong shape" ecdsaVerify pub (r :| [s]) hd pkey bs = if ECDSA.verify hd pkey (ecdsaMPIsToSig r s) bs then Right pub else Left ("ECDSA verification failed: " ++ show (hd, pkey, r, s, bs)) ecdsaVerify _ _ _ _ _ = Left "cannot verify ECDSA signature of wrong shape" ed25519Verify pub (r :| [s]) hd pkey bs = either (Left . (("Ed25519 verification failed: " ++ show (hd, pkey, r, s, bs) ++ ": ") ++) . show) return $ do ep <- cf2es (Ed25519.publicKey (B.drop 1 pkey)) -- drop the 0x40 es <- cf2es (Ed25519.signature ((B.append `on` i2osp . unMPI) r s)) let prehash = crazyHash hd bs :: B.ByteString if Ed25519.verify ep prehash es then Right pub else Left "does not verify" ed25519Verify _ _ _ _ _ = Left "cannot verify Ed25519 signature of wrong shape" cf2es = either (Left . show) return . eitherCryptoError rsaVerify pub mpis hd pkey bs = if P15.verify (Just hd) pkey bs (rsaMPItoSig mpis) then Right pub else Left ("DSA verification failed: " ++ show (hd, pkey, mpis, bs)) dsaMPIsToSig r s = DSA.Signature (unMPI r) (unMPI s) ecdsaMPIsToSig r s = ECDSA.Signature (unMPI r) (unMPI s) rsaMPItoSig (s :| []) = i2osp (unMPI s) hashalgo :: Pkt -> HashAlgorithm hashalgo (SignaturePkt (SigV4 _ _ ha _ _ _ _)) = ha hashalgo _ = error "This should never happen (hashalgo)." pkaAndMPIs (SigV4 _ pka _ _ _ _ mpis) = (pka, mpis) pkaAndMPIs _ = error "This should never happen (pkaAndMPIs)." crazyHash h = BA.convert . hashWith h isSignatureExpired :: Pkt -> Maybe UTCTime -> Either String Bool isSignatureExpired _ Nothing = return False isSignatureExpired s (Just t) = if any (expiredBefore t) ((\(SigV4 _ _ _ h _ _ _) -> h) . _signaturePayload . fromPkt $ s) then Left "signature expired" else return True where expiredBefore :: UTCTime -> SigSubPacket -> Bool expiredBefore ct (SigSubPacket _ (SigExpirationTime et)) = fromEnum ((posixSecondsToUTCTime . toEnum . fromEnum) et `diffUTCTime` ct) < 0 expiredBefore _ _ = False finalPayload :: Pkt -> ByteString -> ByteString finalPayload s pl = BL.concat [pl, sigbit, trailer s] where sigbit = runPut $ putPartialSigforSigning s trailer :: Pkt -> ByteString trailer (SignaturePkt SigV4 {}) = runPut $ putSigTrailer s trailer _ = BL.empty signUserIDwithRSA :: PKPayload -- ^ public key "payload" of user ID being signed -> UserId -- ^ user ID being signed -> [SigSubPacket] -- ^ hashed signature subpackets -> [SigSubPacket] -- ^ unhashed signature subpackets -> RSATypes.PrivateKey -- ^ RSA signing key -> Either String SignaturePayload signUserIDwithRSA pkp uid hsigsubs usigsubs prv = do uidsig <- first show (P15.sign Nothing (Just CHA.SHA512) prv (BL.toStrict (finalPayload (SignaturePkt uidsigp) uidpayload))) return (uidsigp' uidsig) where uidpayload = runPut (sequence_ [putKeyforSigning (PublicKeyPkt pkp), putUforSigning (toPkt uid)]) uidsigp = SigV4 PositiveCert RSA SHA512 hsigsubs usigsubs 0 (NE.fromList [MPI 0]) uidsigp' us = SigV4 PositiveCert RSA SHA512 hsigsubs usigsubs (fromIntegral (os2ip (B.take 2 us))) (NE.fromList [MPI (os2ip us)]) crossSignSubkeyWithRSA :: PKPayload -- ^ public key "payload" of key being signed -> PKPayload -- ^ public subkey "payload" of key being signed -> [SigSubPacket] -- ^ hashed signature subpackets for binding sig -> [SigSubPacket] -- ^ unhashed signature subpackets for binding sig -> [SigSubPacket] -- ^ hashed signature subpackets for embedded sig -> [SigSubPacket] -- ^ unhashed signature subpackets for embedded sig -> RSATypes.PrivateKey -- ^ RSA signing key -> RSATypes.PrivateKey -- ^ RSA signing subkey -> Either String SignaturePayload crossSignSubkeyWithRSA pkp subpkp subhsigsubs subusigsubs embhsigsubs embusigsubs prv ssb = do embsig <- first show (P15.sign Nothing (Just CHA.SHA512) ssb (BL.toStrict (finalPayload (SignaturePkt embsigp) subkeypayload))) subsig <- first show (P15.sign Nothing (Just CHA.SHA512) prv (BL.toStrict (finalPayload (SignaturePkt subsigp) subkeypayload))) return (subsigp' (embsigp' embsig) subsig) where subkeypayload = runPut (sequence_ [ putKeyforSigning (PublicKeyPkt pkp) , putKeyforSigning (PublicSubkeyPkt subpkp) ]) embsigp = SigV4 PrimaryKeyBindingSig RSA SHA512 embhsigsubs embusigsubs 0 (NE.fromList [MPI 0]) embsigp' es = SigV4 PrimaryKeyBindingSig RSA SHA512 embhsigsubs embusigsubs (fromIntegral (os2ip (B.take 2 es))) (NE.fromList [MPI (os2ip es)]) subsigp = SigV4 SubkeyBindingSig RSA SHA512 subhsigsubs [] 0 (NE.fromList [MPI 0]) sspes es = SigSubPacket False (EmbeddedSignature es) subsigp' es ss = SigV4 SubkeyBindingSig RSA SHA512 subhsigsubs (sspes es : subusigsubs) (fromIntegral (os2ip (B.take 2 ss))) (NE.fromList [MPI (os2ip ss)]) signDataWithRSA :: SigType -> RSATypes.PrivateKey -> [SigSubPacket] -> [SigSubPacket] -> ByteString -> Either String SignaturePayload signDataWithRSA st prv has uhas payload = sp st <$> first show (P15.sign Nothing (Just CHA.SHA512) prv (BL.toStrict (finalPayload (SignaturePkt (sp0 st)) payload))) where sp0 st = SigV4 st RSA SHA512 has [] 0 (NE.fromList [MPI 0]) sp st ss = SigV4 st RSA SHA512 has uhas (fromIntegral (os2ip (B.take 2 ss))) (NE.fromList [MPI (os2ip ss)]) hOpenPGP-2.10.1/Codec/Encryption/OpenPGP/Types.hs0000644000000000000000000000112607346545000017463 0ustar0000000000000000-- Types.hs: OpenPGP (RFC4880) data types -- Copyright © 2012-2024 Clint Adams -- This software is released under the terms of the Expat license. -- (See the LICENSE file). module Codec.Encryption.OpenPGP.Types ( module X ) where import Codec.Encryption.OpenPGP.Types.Internal.Base as X import Codec.Encryption.OpenPGP.Types.Internal.CryptonNewtypes as X import Codec.Encryption.OpenPGP.Types.Internal.PKITypes as X import Codec.Encryption.OpenPGP.Types.Internal.PacketClass as X import Codec.Encryption.OpenPGP.Types.Internal.Pkt as X import Codec.Encryption.OpenPGP.Types.Internal.TK as X hOpenPGP-2.10.1/Codec/Encryption/OpenPGP/Types/Internal/0000755000000000000000000000000007346545000020703 5ustar0000000000000000hOpenPGP-2.10.1/Codec/Encryption/OpenPGP/Types/Internal/Base.hs0000644000000000000000000010553307346545000022120 0ustar0000000000000000-- Base.hs: OpenPGP (RFC4880) data types -- Copyright © 2012-2022 Clint Adams -- This software is released under the terms of the Expat license. -- (See the LICENSE file). {-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE TemplateHaskell #-} module Codec.Encryption.OpenPGP.Types.Internal.Base where import GHC.Generics (Generic) import Codec.Encryption.OpenPGP.Types.Internal.PrettyUtils (prettyLBS) import Control.Applicative ((<|>)) import Control.Arrow ((***)) import Control.Lens (makeLenses, op, Wrapped) import Control.Monad (mzero) import Data.Aeson ((.=), object) import qualified Data.Aeson as A #if MIN_VERSION_aeson(2,0,0) import qualified Data.Aeson.Key as AK #endif import qualified Data.Aeson.TH as ATH import Data.ByteArray (ByteArrayAccess) import qualified Data.ByteString as B import qualified Data.ByteString.Base16.Lazy as B16L import Data.ByteString.Lazy (ByteString) import qualified Data.ByteString.Lazy as BL import qualified Data.ByteString.Lazy.Char8 as BLC8 import Data.Char (toLower, toUpper) import Data.Data (Data) import Data.Hashable (Hashable(..)) import Data.List (unfoldr) import Data.List.NonEmpty (NonEmpty) import qualified Data.List.NonEmpty as NE import Data.List.Split (chunksOf) import Data.Maybe (fromMaybe) import Data.Ord (comparing) import Data.Set (Set) import qualified Data.Set as Set import Data.Text (Text) import qualified Data.Text as T import Data.Time.Clock.POSIX (posixSecondsToUTCTime) import Data.Time.Format (formatTime) import Data.Time.Locale.Compat (defaultTimeLocale) import Data.Typeable (Typeable) import Data.Word (Word16, Word32, Word8) import Network.URI (URI(..), nullURI, parseURI, uriToString) import Numeric (readHex) import Prettyprinter (Pretty(..), (<+>), hsep, punctuate, space) type Exportability = Bool type TrustLevel = Word8 type TrustAmount = Word8 type AlmostPublicDomainRegex = ByteString type Revocability = Bool type RevocationReason = Text type KeyServer = ByteString type SignatureHash = ByteString type PacketVersion = Word8 type V3Expiration = Word16 type CompressedDataPayload = ByteString type FileName = ByteString type ImageData = ByteString type NestedFlag = Bool class (Eq a, Ord a) => FutureFlag a where fromFFlag :: a -> Int toFFlag :: Int -> a class (Eq a, Ord a) => FutureVal a where fromFVal :: a -> Word8 toFVal :: Word8 -> a data SymmetricAlgorithm = Plaintext | IDEA | TripleDES | CAST5 | Blowfish | ReservedSAFER | ReservedDES | AES128 | AES192 | AES256 | Twofish | Camellia128 | Camellia192 | Camellia256 | OtherSA Word8 deriving (Data, Generic, Show, Typeable) instance Eq SymmetricAlgorithm where (==) a b = fromFVal a == fromFVal b instance Ord SymmetricAlgorithm where compare = comparing fromFVal instance FutureVal SymmetricAlgorithm where fromFVal Plaintext = 0 fromFVal IDEA = 1 fromFVal TripleDES = 2 fromFVal CAST5 = 3 fromFVal Blowfish = 4 fromFVal ReservedSAFER = 5 fromFVal ReservedDES = 6 fromFVal AES128 = 7 fromFVal AES192 = 8 fromFVal AES256 = 9 fromFVal Twofish = 10 fromFVal Camellia128 = 11 fromFVal Camellia192 = 12 fromFVal Camellia256 = 13 fromFVal (OtherSA o) = o toFVal 0 = Plaintext toFVal 1 = IDEA toFVal 2 = TripleDES toFVal 3 = CAST5 toFVal 4 = Blowfish toFVal 5 = ReservedSAFER toFVal 6 = ReservedDES toFVal 7 = AES128 toFVal 8 = AES192 toFVal 9 = AES256 toFVal 10 = Twofish toFVal 11 = Camellia128 toFVal 12 = Camellia192 toFVal 13 = Camellia256 toFVal o = OtherSA o instance Hashable SymmetricAlgorithm instance Pretty SymmetricAlgorithm where pretty Plaintext = pretty "plaintext" pretty IDEA = pretty "IDEA" pretty TripleDES = pretty "3DES" pretty CAST5 = pretty "CAST-128" pretty Blowfish = pretty "Blowfish" pretty ReservedSAFER = pretty "(reserved) SAFER" pretty ReservedDES = pretty "(reserved) DES" pretty AES128 = pretty "AES-128" pretty AES192 = pretty "AES-192" pretty AES256 = pretty "AES-256" pretty Twofish = pretty "Twofish" pretty Camellia128 = pretty "Camellia-128" pretty Camellia192 = pretty "Camellia-192" pretty Camellia256 = pretty "Camellia-256" pretty (OtherSA sa) = pretty "unknown symmetric algorithm" <+> pretty sa $(ATH.deriveJSON ATH.defaultOptions ''SymmetricAlgorithm) data NotationFlag = HumanReadable | OtherNF Word8 -- FIXME: this should be constrained to 4 bits? deriving (Data, Generic, Show, Typeable) instance Eq NotationFlag where (==) a b = fromFFlag a == fromFFlag b instance Ord NotationFlag where compare = comparing fromFFlag instance FutureFlag NotationFlag where fromFFlag HumanReadable = 0 fromFFlag (OtherNF o) = fromIntegral o toFFlag 0 = HumanReadable toFFlag o = OtherNF (fromIntegral o) instance Hashable NotationFlag instance Pretty NotationFlag where pretty HumanReadable = pretty "human-readable" pretty (OtherNF o) = pretty "unknown notation flag type" <+> pretty o $(ATH.deriveJSON ATH.defaultOptions ''NotationFlag) newtype ThirtyTwoBitTimeStamp = ThirtyTwoBitTimeStamp { unThirtyTwoBitTimeStamp :: Word32 } deriving ( Bounded , Data , Enum , Eq , Generic , Hashable , Integral , Num , Ord , Real , Show , Typeable ) instance Wrapped ThirtyTwoBitTimeStamp instance Pretty ThirtyTwoBitTimeStamp where pretty = pretty . formatTime defaultTimeLocale "%Y%m%d-%H%M%S" . posixSecondsToUTCTime . realToFrac $(ATH.deriveJSON ATH.defaultOptions ''ThirtyTwoBitTimeStamp) durU :: (Integral a, Show a) => a -> Maybe (String, a) durU x | x >= 31557600 = Just ((++ "y") . show $ x `div` 31557600, x `mod` 31557600) | x >= 2629800 = Just ((++ "m") . show $ x `div` 2629800, x `mod` 2629800) | x >= 86400 = Just ((++ "d") . show $ x `div` 86400, x `mod` 86400) | x > 0 = Just ((++ "s") . show $ x, 0) | otherwise = Nothing newtype ThirtyTwoBitDuration = ThirtyTwoBitDuration { unThirtyTwoBitDuration :: Word32 } deriving ( Bounded , Data , Enum , Eq , Generic , Hashable , Integral , Num , Ord , Real , Show , Typeable ) instance Wrapped ThirtyTwoBitDuration instance Pretty ThirtyTwoBitDuration where pretty = pretty . concat . unfoldr durU . op ThirtyTwoBitDuration $(ATH.deriveJSON ATH.defaultOptions ''ThirtyTwoBitDuration) data RevocationClass = SensitiveRK | RClOther Word8 -- FIXME: this should be constrained to 3 bits deriving (Data, Generic, Show, Typeable) instance Eq RevocationClass where (==) a b = fromFFlag a == fromFFlag b instance Ord RevocationClass where compare = comparing fromFFlag instance FutureFlag RevocationClass where fromFFlag SensitiveRK = 1 fromFFlag (RClOther i) = fromIntegral i toFFlag 1 = SensitiveRK toFFlag i = RClOther (fromIntegral i) instance Hashable RevocationClass instance Pretty RevocationClass where pretty SensitiveRK = pretty "sensitive" pretty (RClOther o) = pretty "unknown revocation class" <+> pretty o $(ATH.deriveJSON ATH.defaultOptions ''RevocationClass) data PubKeyAlgorithm = RSA | DeprecatedRSAEncryptOnly | DeprecatedRSASignOnly | ElgamalEncryptOnly | DSA | ECDH | ECDSA | ForbiddenElgamal | DH | EdDSA | OtherPKA Word8 deriving (Show, Data, Generic, Typeable) instance Eq PubKeyAlgorithm where (==) a b = fromFVal a == fromFVal b instance Ord PubKeyAlgorithm where compare = comparing fromFVal instance FutureVal PubKeyAlgorithm where fromFVal RSA = 1 fromFVal DeprecatedRSAEncryptOnly = 2 fromFVal DeprecatedRSASignOnly = 3 fromFVal ElgamalEncryptOnly = 16 fromFVal DSA = 17 fromFVal ECDH = 18 fromFVal ECDSA = 19 fromFVal ForbiddenElgamal = 20 fromFVal DH = 21 fromFVal EdDSA = 22 fromFVal (OtherPKA o) = o toFVal 1 = RSA toFVal 2 = DeprecatedRSAEncryptOnly toFVal 3 = DeprecatedRSASignOnly toFVal 16 = ElgamalEncryptOnly toFVal 17 = DSA toFVal 18 = ECDH toFVal 19 = ECDSA toFVal 20 = ForbiddenElgamal toFVal 21 = DH toFVal 22 = EdDSA toFVal o = OtherPKA o instance Hashable PubKeyAlgorithm instance Pretty PubKeyAlgorithm where pretty RSA = pretty "RSA" pretty DeprecatedRSAEncryptOnly = pretty "(deprecated) RSA encrypt-only" pretty DeprecatedRSASignOnly = pretty "(deprecated) RSA sign-only" pretty ElgamalEncryptOnly = pretty "Elgamal encrypt-only" pretty DSA = pretty "DSA" pretty ECDH = pretty "ECDH" pretty ECDSA = pretty "ECDSA" pretty ForbiddenElgamal = pretty "(forbidden) Elgamal" pretty DH = pretty "DH" pretty EdDSA = pretty "EdDSA" pretty (OtherPKA pka) = pretty "unknown pubkey algorithm type" <+> pretty pka $(ATH.deriveJSON ATH.defaultOptions ''PubKeyAlgorithm) newtype TwentyOctetFingerprint = TwentyOctetFingerprint { unTOF :: ByteString } deriving (Data, Eq, Generic, Ord, Show, Typeable) instance Wrapped TwentyOctetFingerprint -- FIXME: read-show instance Read TwentyOctetFingerprint where readsPrec _ = map ((TwentyOctetFingerprint . BL.pack *** concat) . unzip) . chunksOf 20 . hexToW8s . filter (/= ' ') instance Hashable TwentyOctetFingerprint instance Pretty TwentyOctetFingerprint where pretty = pretty . take 40 . bsToHexUpper . unTOF #if MIN_VERSION_aeson(2,0,0) key :: String -> AK.Key key = AK.fromText . T.pack #else key = T.pack #endif instance A.ToJSON TwentyOctetFingerprint where toJSON e = object [key "fpr" .= (A.toJSON . show . pretty) e] instance A.FromJSON TwentyOctetFingerprint where parseJSON (A.Object v) = TwentyOctetFingerprint . read <$> v A..: key "fpr" parseJSON _ = mzero newtype SpacedFingerprint = SpacedFingerprint { unSpacedFingerprint :: TwentyOctetFingerprint } deriving (Data, Eq, Generic, Ord, Show, Typeable) instance Wrapped SpacedFingerprint instance Pretty SpacedFingerprint where pretty = hsep . punctuate space . map hsep . chunksOf 5 . map pretty . chunksOf 4 . take 40 . bsToHexUpper . unTOF . op SpacedFingerprint bsToHexUpper :: ByteString -> String bsToHexUpper = map toUpper . BLC8.unpack . B16L.encode hexToW8s :: ReadS Word8 hexToW8s = concatMap readHex . chunksOf 2 . map toLower newtype EightOctetKeyId = EightOctetKeyId { unEOKI :: ByteString } deriving (Data, Eq, Generic, Ord, Show, Typeable) instance Wrapped EightOctetKeyId instance Pretty EightOctetKeyId where pretty = pretty . bsToHexUpper . op EightOctetKeyId -- FIXME: read-show instance Read EightOctetKeyId where readsPrec _ = map ((EightOctetKeyId . BL.pack *** concat) . unzip) . chunksOf 8 . hexToW8s instance Hashable EightOctetKeyId instance A.ToJSON EightOctetKeyId where toJSON e = object [key "eoki" .= (bsToHexUpper . op EightOctetKeyId) e] instance A.FromJSON EightOctetKeyId where parseJSON (A.Object v) = EightOctetKeyId . read <$> v A..: key "eoki" parseJSON _ = mzero newtype NotationName = NotationName { unNotationName :: ByteString } deriving (Data, Eq, Generic, Hashable, Ord, Show, Typeable) instance Pretty NotationName where pretty = prettyLBS . unNotationName instance Wrapped NotationName instance A.ToJSON NotationName where toJSON nn = object [key "notationname" .= show (op NotationName nn)] instance A.FromJSON NotationName where parseJSON (A.Object v) = NotationName . read <$> v A..: key "notationname" parseJSON _ = mzero newtype NotationValue = NotationValue { unNotationValue :: ByteString } deriving (Data, Eq, Generic, Hashable, Ord, Show, Typeable) instance Pretty NotationValue where pretty = prettyLBS . unNotationValue instance Wrapped NotationValue instance A.ToJSON NotationValue where toJSON nv = object [key "notationvalue" .= show (op NotationValue nv)] instance A.FromJSON NotationValue where parseJSON (A.Object v) = NotationValue . read <$> v A..: key "notationvalue" parseJSON _ = mzero data HashAlgorithm = DeprecatedMD5 | SHA1 | RIPEMD160 | SHA256 | SHA384 | SHA512 | SHA224 | OtherHA Word8 deriving (Data, Generic, Show, Typeable) instance Eq HashAlgorithm where (==) a b = fromFVal a == fromFVal b instance Ord HashAlgorithm where compare = comparing fromFVal instance FutureVal HashAlgorithm where fromFVal DeprecatedMD5 = 1 fromFVal SHA1 = 2 fromFVal RIPEMD160 = 3 fromFVal SHA256 = 8 fromFVal SHA384 = 9 fromFVal SHA512 = 10 fromFVal SHA224 = 11 fromFVal (OtherHA o) = o toFVal 1 = DeprecatedMD5 toFVal 2 = SHA1 toFVal 3 = RIPEMD160 toFVal 8 = SHA256 toFVal 9 = SHA384 toFVal 10 = SHA512 toFVal 11 = SHA224 toFVal o = OtherHA o instance Hashable HashAlgorithm instance Pretty HashAlgorithm where pretty DeprecatedMD5 = pretty "(deprecated) MD5" pretty SHA1 = pretty "SHA-1" pretty RIPEMD160 = pretty "RIPEMD-160" pretty SHA256 = pretty "SHA-256" pretty SHA384 = pretty "SHA-384" pretty SHA512 = pretty "SHA-512" pretty SHA224 = pretty "SHA-224" pretty (OtherHA ha) = pretty "unknown hash algorithm type" <+> pretty ha $(ATH.deriveJSON ATH.defaultOptions ''HashAlgorithm) data CompressionAlgorithm = Uncompressed | ZIP | ZLIB | BZip2 | OtherCA Word8 deriving (Show, Data, Generic, Typeable) instance Eq CompressionAlgorithm where (==) a b = fromFVal a == fromFVal b instance Ord CompressionAlgorithm where compare = comparing fromFVal instance FutureVal CompressionAlgorithm where fromFVal Uncompressed = 0 fromFVal ZIP = 1 fromFVal ZLIB = 2 fromFVal BZip2 = 3 fromFVal (OtherCA o) = o toFVal 0 = Uncompressed toFVal 1 = ZIP toFVal 2 = ZLIB toFVal 3 = BZip2 toFVal o = OtherCA o instance Hashable CompressionAlgorithm instance Pretty CompressionAlgorithm where pretty Uncompressed = pretty "uncompressed" pretty ZIP = pretty "ZIP" pretty ZLIB = pretty "zlib" pretty BZip2 = pretty "bzip2" pretty (OtherCA ca) = pretty "unknown compression algorithm type" <+> pretty ca $(ATH.deriveJSON ATH.defaultOptions ''CompressionAlgorithm) data KSPFlag = NoModify | KSPOther Int deriving (Data, Generic, Show, Typeable) instance Eq KSPFlag where (==) a b = fromFFlag a == fromFFlag b instance Ord KSPFlag where compare = comparing fromFFlag instance FutureFlag KSPFlag where fromFFlag NoModify = 0 fromFFlag (KSPOther i) = fromIntegral i toFFlag 0 = NoModify toFFlag i = KSPOther (fromIntegral i) instance Hashable KSPFlag instance Pretty KSPFlag where pretty NoModify = pretty "no-modify" pretty (KSPOther o) = pretty "unknown keyserver preference flag type" <+> pretty o $(ATH.deriveJSON ATH.defaultOptions ''KSPFlag) data KeyFlag = GroupKey | AuthKey | SplitKey | EncryptStorageKey | EncryptCommunicationsKey | SignDataKey | CertifyKeysKey | KFOther Int deriving (Data, Generic, Show, Typeable) instance Eq KeyFlag where (==) a b = fromFFlag a == fromFFlag b instance Ord KeyFlag where compare = comparing fromFFlag instance FutureFlag KeyFlag where fromFFlag GroupKey = 0 fromFFlag AuthKey = 2 fromFFlag SplitKey = 3 fromFFlag EncryptStorageKey = 4 fromFFlag EncryptCommunicationsKey = 5 fromFFlag SignDataKey = 6 fromFFlag CertifyKeysKey = 7 fromFFlag (KFOther i) = fromIntegral i toFFlag 0 = GroupKey toFFlag 2 = AuthKey toFFlag 3 = SplitKey toFFlag 4 = EncryptStorageKey toFFlag 5 = EncryptCommunicationsKey toFFlag 6 = SignDataKey toFFlag 7 = CertifyKeysKey toFFlag i = KFOther (fromIntegral i) instance Hashable KeyFlag instance Pretty KeyFlag where pretty GroupKey = pretty "group" pretty AuthKey = pretty "auth" pretty SplitKey = pretty "split" pretty EncryptStorageKey = pretty "encrypt-storage" pretty EncryptCommunicationsKey = pretty "encrypt-communications" pretty SignDataKey = pretty "sign-data" pretty CertifyKeysKey = pretty "certify-keys" pretty (KFOther o) = pretty "unknown key flag type" <+> pretty o $(ATH.deriveJSON ATH.defaultOptions ''KeyFlag) data RevocationCode = NoReason | KeySuperseded | KeyMaterialCompromised | KeyRetiredAndNoLongerUsed | UserIdInfoNoLongerValid | RCoOther Word8 deriving (Data, Generic, Show, Typeable) instance Eq RevocationCode where (==) a b = fromFVal a == fromFVal b instance Ord RevocationCode where compare = comparing fromFVal instance FutureVal RevocationCode where fromFVal NoReason = 0 fromFVal KeySuperseded = 1 fromFVal KeyMaterialCompromised = 2 fromFVal KeyRetiredAndNoLongerUsed = 3 fromFVal UserIdInfoNoLongerValid = 32 fromFVal (RCoOther o) = o toFVal 0 = NoReason toFVal 1 = KeySuperseded toFVal 2 = KeyMaterialCompromised toFVal 3 = KeyRetiredAndNoLongerUsed toFVal 32 = UserIdInfoNoLongerValid toFVal o = RCoOther o instance Hashable RevocationCode instance Pretty RevocationCode where pretty NoReason = pretty "no reason" pretty KeySuperseded = pretty "key superseded" pretty KeyMaterialCompromised = pretty "key material compromised" pretty KeyRetiredAndNoLongerUsed = pretty "key retired and no longer used" pretty UserIdInfoNoLongerValid = pretty "user-ID info no longer valid" pretty (RCoOther o) = pretty "unknown revocation code" <+> pretty o $(ATH.deriveJSON ATH.defaultOptions ''RevocationCode) data FeatureFlag = ModificationDetection | FeatureOther Int deriving (Data, Generic, Show, Typeable) instance Eq FeatureFlag where (==) a b = fromFFlag a == fromFFlag b instance Ord FeatureFlag where compare = comparing fromFFlag instance FutureFlag FeatureFlag where fromFFlag ModificationDetection = 7 fromFFlag (FeatureOther i) = fromIntegral i toFFlag 7 = ModificationDetection toFFlag i = FeatureOther (fromIntegral i) instance Hashable FeatureFlag #if !MIN_VERSION_hashable(1,3,4) instance Hashable a => Hashable (Set a) where hashWithSalt salt = hashWithSalt salt . Set.toList #endif instance Pretty FeatureFlag where pretty ModificationDetection = pretty "modification-detection" pretty (FeatureOther o) = pretty "unknown feature flag type" <+> pretty o $(ATH.deriveJSON ATH.defaultOptions ''FeatureFlag) newtype URL = URL { unURL :: URI } deriving (Data, Eq, Generic, Ord, Show, Typeable) instance Wrapped URL instance Hashable URL where hashWithSalt salt (URL (URI s a p q f)) = salt `hashWithSalt` s `hashWithSalt` show a `hashWithSalt` p `hashWithSalt` q `hashWithSalt` f instance Pretty URL where pretty = pretty . (\uri -> uriToString id uri "") . op URL instance A.ToJSON URL where toJSON u = object [key "uri" .= (\uri -> uriToString id uri "") (op URL u)] instance A.FromJSON URL where parseJSON (A.Object v) = URL . fromMaybe nullURI . parseURI <$> v A..: key "uri" parseJSON _ = mzero data SigType = BinarySig | CanonicalTextSig | StandaloneSig | GenericCert | PersonaCert | CasualCert | PositiveCert | SubkeyBindingSig | PrimaryKeyBindingSig | SignatureDirectlyOnAKey | KeyRevocationSig | SubkeyRevocationSig | CertRevocationSig | TimestampSig | ThirdPartyConfirmationSig | OtherSig Word8 deriving (Data, Generic, Show, Typeable) instance Eq SigType where (==) a b = fromFVal a == fromFVal b instance Ord SigType where compare = comparing fromFVal instance FutureVal SigType where fromFVal BinarySig = 0x00 fromFVal CanonicalTextSig = 0x01 fromFVal StandaloneSig = 0x02 fromFVal GenericCert = 0x10 fromFVal PersonaCert = 0x11 fromFVal CasualCert = 0x12 fromFVal PositiveCert = 0x13 fromFVal SubkeyBindingSig = 0x18 fromFVal PrimaryKeyBindingSig = 0x19 fromFVal SignatureDirectlyOnAKey = 0x1F fromFVal KeyRevocationSig = 0x20 fromFVal SubkeyRevocationSig = 0x28 fromFVal CertRevocationSig = 0x30 fromFVal TimestampSig = 0x40 fromFVal ThirdPartyConfirmationSig = 0x50 fromFVal (OtherSig o) = o toFVal 0x00 = BinarySig toFVal 0x01 = CanonicalTextSig toFVal 0x02 = StandaloneSig toFVal 0x10 = GenericCert toFVal 0x11 = PersonaCert toFVal 0x12 = CasualCert toFVal 0x13 = PositiveCert toFVal 0x18 = SubkeyBindingSig toFVal 0x19 = PrimaryKeyBindingSig toFVal 0x1F = SignatureDirectlyOnAKey toFVal 0x20 = KeyRevocationSig toFVal 0x28 = SubkeyRevocationSig toFVal 0x30 = CertRevocationSig toFVal 0x40 = TimestampSig toFVal 0x50 = ThirdPartyConfirmationSig toFVal o = OtherSig o instance Hashable SigType instance Pretty SigType where pretty BinarySig = pretty "binary" pretty CanonicalTextSig = pretty "canonical-pretty" pretty StandaloneSig = pretty "standalone" pretty GenericCert = pretty "generic" pretty PersonaCert = pretty "persona" pretty CasualCert = pretty "casual" pretty PositiveCert = pretty "positive" pretty SubkeyBindingSig = pretty "subkey-binding" pretty PrimaryKeyBindingSig = pretty "primary-key-binding" pretty SignatureDirectlyOnAKey = pretty "signature directly on a key" pretty KeyRevocationSig = pretty "key-revocation" pretty SubkeyRevocationSig = pretty "subkey-revocation" pretty CertRevocationSig = pretty "cert-revocation" pretty TimestampSig = pretty "timestamp" pretty ThirdPartyConfirmationSig = pretty "third-party-confirmation" pretty (OtherSig o) = pretty "unknown signature type" <+> pretty o $(ATH.deriveJSON ATH.defaultOptions ''SigType) newtype MPI = MPI { unMPI :: Integer } deriving (Data, Eq, Generic, Show, Typeable) instance Wrapped MPI instance Hashable MPI instance Pretty MPI where pretty = pretty . op MPI $(ATH.deriveJSON ATH.defaultOptions ''MPI) data SignaturePayload = SigV3 SigType ThirtyTwoBitTimeStamp EightOctetKeyId PubKeyAlgorithm HashAlgorithm Word16 (NonEmpty MPI) | SigV4 SigType PubKeyAlgorithm HashAlgorithm [SigSubPacket] [SigSubPacket] Word16 (NonEmpty MPI) | SigVOther Word8 ByteString deriving (Data, Eq, Generic, Show, Typeable) instance Hashable SignaturePayload instance Pretty SignaturePayload where pretty (SigV3 st ts eoki pka ha w16 mpis) = pretty "signature v3" <> pretty ':' <+> pretty st <+> pretty ts <+> pretty eoki <+> pretty pka <+> pretty ha <+> pretty w16 <+> (pretty . NE.toList) mpis pretty (SigV4 st pka ha hsps usps w16 mpis) = pretty "signature v4" <> pretty ':' <+> pretty st <+> pretty pka <+> pretty ha <+> pretty hsps <+> pretty usps <+> pretty w16 <+> (pretty . NE.toList) mpis pretty (SigVOther t bs) = pretty "unknown signature v" <> pretty t <> pretty ':' <+> pretty (BL.unpack bs) instance A.ToJSON SignaturePayload where toJSON (SigV3 st ts eoki pka ha w16 mpis) = A.toJSON (st, ts, eoki, pka, ha, w16, NE.toList mpis) toJSON (SigV4 st pka ha hsps usps w16 mpis) = A.toJSON (st, pka, ha, hsps, usps, w16, NE.toList mpis) toJSON (SigVOther t bs) = A.toJSON (t, BL.unpack bs) data SigSubPacketPayload = SigCreationTime ThirtyTwoBitTimeStamp | SigExpirationTime ThirtyTwoBitDuration | ExportableCertification Exportability | TrustSignature TrustLevel TrustAmount | RegularExpression AlmostPublicDomainRegex | Revocable Revocability | KeyExpirationTime ThirtyTwoBitDuration | PreferredSymmetricAlgorithms [SymmetricAlgorithm] | RevocationKey (Set RevocationClass) PubKeyAlgorithm TwentyOctetFingerprint | Issuer EightOctetKeyId | NotationData (Set NotationFlag) NotationName NotationValue | PreferredHashAlgorithms [HashAlgorithm] | PreferredCompressionAlgorithms [CompressionAlgorithm] | KeyServerPreferences (Set KSPFlag) | PreferredKeyServer KeyServer | PrimaryUserId Bool | PolicyURL URL | KeyFlags (Set KeyFlag) | SignersUserId Text | ReasonForRevocation RevocationCode RevocationReason | Features (Set FeatureFlag) | SignatureTarget PubKeyAlgorithm HashAlgorithm SignatureHash | EmbeddedSignature SignaturePayload | IssuerFingerprint Word8 TwentyOctetFingerprint | UserDefinedSigSub Word8 ByteString | OtherSigSub Word8 ByteString deriving (Data, Eq, Generic, Show, Typeable) -- FIXME instance Hashable SigSubPacketPayload instance Pretty SigSubPacketPayload where pretty (SigCreationTime ts) = pretty "creation-time" <+> pretty ts pretty (SigExpirationTime d) = pretty "sig expiration time" <+> pretty d pretty (ExportableCertification e) = pretty "exportable certification" <+> pretty e pretty (TrustSignature tl ta) = pretty "trust signature" <+> pretty tl <+> pretty ta pretty (RegularExpression apdre) = pretty "regular expression" <+> prettyLBS apdre pretty (Revocable r) = pretty "revocable" <+> pretty r pretty (KeyExpirationTime d) = pretty "key expiration time" <+> pretty d pretty (PreferredSymmetricAlgorithms sas) = pretty "preferred symmetric algorithms" <+> pretty sas pretty (RevocationKey rcs pka tof) = pretty "revocation key" <+> pretty (Set.toList rcs) <+> pretty pka <+> pretty tof pretty (Issuer eoki) = pretty "issuer" <+> pretty eoki pretty (NotationData nfs nn nv) = pretty "notation data" <+> pretty (Set.toList nfs) <+> pretty nn <+> pretty nv pretty (PreferredHashAlgorithms phas) = pretty "preferred hash algorithms" <+> pretty phas pretty (PreferredCompressionAlgorithms pcas) = pretty "preferred compression algorithms" <+> pretty pcas pretty (KeyServerPreferences kspfs) = pretty "keyserver preferences" <+> pretty (Set.toList kspfs) pretty (PreferredKeyServer ks) = pretty "preferred keyserver" <+> prettyLBS ks pretty (PrimaryUserId p) = (if p then mempty else pretty "NOT ") <> pretty "primary user-ID" pretty (PolicyURL u) = pretty "policy URL" <+> pretty u pretty (KeyFlags kfs) = pretty "key flags" <+> pretty (Set.toList kfs) pretty (SignersUserId u) = pretty "signer's user-ID" <+> pretty u pretty (ReasonForRevocation rc rr) = pretty "reason for revocation" <+> pretty rc <+> pretty rr pretty (Features ffs) = pretty "features" <+> pretty (Set.toList ffs) pretty (SignatureTarget pka ha sh) = pretty "signature target" <+> pretty pka <+> pretty ha <+> prettyLBS sh pretty (EmbeddedSignature sp) = pretty "embedded signature" <+> pretty sp pretty (IssuerFingerprint kv ifp) = pretty "issuer fingerprint (v" <> pretty kv <> pretty ")" <+> pretty ifp pretty (UserDefinedSigSub t bs) = pretty "user-defined signature subpacket type" <+> pretty t <+> pretty (BL.unpack bs) pretty (OtherSigSub t bs) = pretty "unknown signature subpacket type" <+> pretty t <+> prettyLBS bs instance A.ToJSON SigSubPacketPayload where toJSON (SigCreationTime ts) = object [key "sigCreationTime" .= ts] toJSON (SigExpirationTime d) = object [key "sigExpirationTime" .= d] toJSON (ExportableCertification e) = object [key "exportableCertification" .= e] toJSON (TrustSignature tl ta) = object [key "trustSignature" .= (tl, ta)] toJSON (RegularExpression apdre) = object [key "regularExpression" .= BL.unpack apdre] toJSON (Revocable r) = object [key "revocable" .= r] toJSON (KeyExpirationTime d) = object [key "keyExpirationTime" .= d] toJSON (PreferredSymmetricAlgorithms sas) = object [key "preferredSymmetricAlgorithms" .= sas] toJSON (RevocationKey rcs pka tof) = object [key "revocationKey" .= (rcs, pka, tof)] toJSON (Issuer eoki) = object [key "issuer" .= eoki] toJSON (NotationData nfs (NotationName nn) (NotationValue nv)) = object [key "notationData" .= (nfs, BL.unpack nn, BL.unpack nv)] toJSON (PreferredHashAlgorithms phas) = object [key "preferredHashAlgorithms" .= phas] toJSON (PreferredCompressionAlgorithms pcas) = object [key "preferredCompressionAlgorithms" .= pcas] toJSON (KeyServerPreferences kspfs) = object [key "keyServerPreferences" .= kspfs] toJSON (PreferredKeyServer ks) = object [key "preferredKeyServer" .= show ks] toJSON (PrimaryUserId p) = object [key "primaryUserId" .= p] toJSON (PolicyURL u) = object [key "policyURL" .= u] toJSON (KeyFlags kfs) = object [key "keyFlags" .= kfs] toJSON (SignersUserId u) = object [key "signersUserId" .= u] toJSON (ReasonForRevocation rc rr) = object [key "reasonForRevocation" .= (rc, rr)] toJSON (Features ffs) = object [key "features" .= ffs] toJSON (SignatureTarget pka ha sh) = object [key "signatureTarget" .= (pka, ha, BL.unpack sh)] toJSON (EmbeddedSignature sp) = object [key "embeddedSignature" .= sp] toJSON (IssuerFingerprint kv ifp) = object [key "issuerFingerprint" .= (kv, ifp)] toJSON (UserDefinedSigSub t bs) = object [key "userDefinedSigSub" .= (t, BL.unpack bs)] toJSON (OtherSigSub t bs) = object [key "otherSigSub" .= (t, BL.unpack bs)] uc3 :: (a -> b -> c -> d) -> (a, b, c) -> d uc3 f ~(a, b, c) = f a b c instance A.FromJSON SigSubPacketPayload where parseJSON (A.Object v) = (SigCreationTime <$> v A..: key "sigCreationTime") <|> (SigExpirationTime <$> v A..: key "sigExpirationTime") <|> (ExportableCertification <$> v A..: key "exportableCertification") <|> (uncurry TrustSignature <$> v A..: key "trustSignature") <|> (RegularExpression . BL.pack <$> v A..: key "regularExpression") <|> (Revocable <$> v A..: key "revocable") <|> (KeyExpirationTime <$> v A..: key "keyExpirationTime") <|> (PreferredSymmetricAlgorithms <$> v A..: key "preferredSymmetricAlgorithms") <|> (uc3 RevocationKey <$> v A..: key "revocationKey") <|> (Issuer <$> v A..: key "issuer") <|> (uc3 NotationData <$> v A..: key "notationData") parseJSON _ = mzero data SigSubPacket = SigSubPacket { _sspCriticality :: Bool , _sspPayload :: SigSubPacketPayload } deriving (Data, Eq, Generic, Show, Typeable) instance Pretty SigSubPacket where pretty x = (if _sspCriticality x then pretty '*' else mempty) <> (pretty . _sspPayload) x instance Hashable SigSubPacket instance A.ToJSON SigSubPacket instance A.FromJSON SigSubPacket $(makeLenses ''SigSubPacket) data KeyVersion = DeprecatedV3 | V4 deriving (Data, Eq, Generic, Ord, Show, Typeable) instance Hashable KeyVersion instance Pretty KeyVersion where pretty DeprecatedV3 = pretty "(deprecated) v3" pretty V4 = pretty "v4" $(ATH.deriveJSON ATH.defaultOptions ''KeyVersion) newtype IV = IV { unIV :: B.ByteString } deriving ( ByteArrayAccess , Data , Eq , Generic , Hashable , Semigroup , Monoid , Show , Typeable ) instance Wrapped IV instance Pretty IV where pretty = pretty . ("iv:" ++) . bsToHexUpper . BL.fromStrict . op IV instance A.ToJSON IV where toJSON = A.toJSON . show . op IV data DataType = BinaryData | TextData | UTF8Data | OtherData Word8 deriving (Show, Data, Generic, Typeable) instance Hashable DataType instance Eq DataType where (==) a b = fromFVal a == fromFVal b instance Ord DataType where compare = comparing fromFVal instance FutureVal DataType where fromFVal BinaryData = fromIntegral . fromEnum $ 'b' fromFVal TextData = fromIntegral . fromEnum $ 't' fromFVal UTF8Data = fromIntegral . fromEnum $ 'u' fromFVal (OtherData o) = o toFVal 0x62 = BinaryData toFVal 0x74 = TextData toFVal 0x75 = UTF8Data toFVal o = OtherData o instance Pretty DataType where pretty BinaryData = pretty "binary" pretty TextData = pretty "text" pretty UTF8Data = pretty "UTF-8" pretty (OtherData o) = pretty "other data type " <+> pretty o $(ATH.deriveJSON ATH.defaultOptions ''DataType) newtype Salt = Salt { unSalt :: B.ByteString } deriving (Data, Eq, Generic, Hashable, Show, Typeable) instance Wrapped Salt instance Pretty Salt where pretty = pretty . ("salt:" ++) . bsToHexUpper . BL.fromStrict . op Salt instance A.ToJSON Salt where toJSON = A.toJSON . show . op Salt newtype IterationCount = IterationCount { unIterationCount :: Int } deriving ( Bounded , Data , Enum , Eq , Generic , Hashable , Integral , Num , Ord , Real , Show , Typeable ) instance Wrapped IterationCount instance Pretty IterationCount where pretty = pretty . op IterationCount $(ATH.deriveJSON ATH.defaultOptions ''IterationCount) data S2K = Simple HashAlgorithm | Salted HashAlgorithm Salt | IteratedSalted HashAlgorithm Salt IterationCount | OtherS2K Word8 ByteString deriving (Data, Eq, Generic, Show, Typeable) instance Hashable S2K instance Pretty S2K where pretty (Simple ha) = pretty "simple S2K," <+> pretty ha pretty (Salted ha salt) = pretty "salted S2K," <+> pretty ha <+> pretty salt pretty (IteratedSalted ha salt icount) = pretty "iterated-salted S2K," <+> pretty ha <+> pretty salt <+> pretty icount pretty (OtherS2K t bs) = pretty "unknown S2K type" <+> pretty t <+> pretty (bsToHexUpper bs) instance A.ToJSON S2K where toJSON (Simple ha) = A.toJSON ha toJSON (Salted ha salt) = A.toJSON (ha, salt) toJSON (IteratedSalted ha salt icount) = A.toJSON (ha, salt, icount) toJSON (OtherS2K t bs) = A.toJSON (t, BL.unpack bs) data ImageFormat = JPEG | OtherImage Word8 deriving (Data, Generic, Show, Typeable) instance Eq ImageFormat where (==) a b = fromFVal a == fromFVal b instance Ord ImageFormat where compare = comparing fromFVal instance FutureVal ImageFormat where fromFVal JPEG = 1 fromFVal (OtherImage o) = o toFVal 1 = JPEG toFVal o = OtherImage o instance Hashable ImageFormat instance Pretty ImageFormat where pretty JPEG = pretty "JPEG" pretty (OtherImage o) = pretty "unknown image format" <+> pretty o $(ATH.deriveJSON ATH.defaultOptions ''ImageFormat) newtype ImageHeader = ImageHV1 ImageFormat deriving (Data, Eq, Generic, Show, Typeable) instance Ord ImageHeader where compare (ImageHV1 a) (ImageHV1 b) = compare a b instance Hashable ImageHeader instance Pretty ImageHeader where pretty (ImageHV1 f) = pretty "imghdr v1" <+> pretty f $(ATH.deriveJSON ATH.defaultOptions ''ImageHeader) data UserAttrSubPacket = ImageAttribute ImageHeader ImageData | OtherUASub Word8 ByteString deriving (Data, Eq, Generic, Show, Typeable) instance Hashable UserAttrSubPacket instance Ord UserAttrSubPacket where compare (ImageAttribute h1 d1) (ImageAttribute h2 d2) = compare h1 h2 <> compare d1 d2 compare (ImageAttribute _ _) (OtherUASub _ _) = LT compare (OtherUASub _ _) (ImageAttribute _ _) = GT compare (OtherUASub t1 b1) (OtherUASub t2 b2) = compare t1 t2 <> compare b1 b2 instance Pretty UserAttrSubPacket where pretty (ImageAttribute ih d) = pretty "image-attribute" <+> pretty ih <+> pretty (BL.unpack d) pretty (OtherUASub t bs) = pretty "unknown attribute type" <> pretty t <+> pretty (BL.unpack bs) instance A.ToJSON UserAttrSubPacket where toJSON (ImageAttribute ih d) = A.toJSON (ih, BL.unpack d) toJSON (OtherUASub t bs) = A.toJSON (t, BL.unpack bs) data ECCCurve = NISTP256 | NISTP384 | NISTP521 | Curve25519 deriving (Data, Eq, Generic, Ord, Show, Typeable) instance Pretty ECCCurve where pretty NISTP256 = pretty "NIST P-256" pretty NISTP384 = pretty "NIST P-384" pretty NISTP521 = pretty "NIST P-521" pretty Curve25519 = pretty "Curve25519" instance Hashable ECCCurve newtype Block a = Block { unBlock :: [a] } -- so we can override cereal instance deriving (Show, Eq) hOpenPGP-2.10.1/Codec/Encryption/OpenPGP/Types/Internal/CryptonNewtypes.hs0000644000000000000000000001225307346545000024437 0ustar0000000000000000-- CryptonNewtypes.hs: OpenPGP (RFC4880) newtype wrappers for some crypton types -- Copyright © 2012-2024 Clint Adams -- This software is released under the terms of the Expat license. -- (See the LICENSE file). {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} module Codec.Encryption.OpenPGP.Types.Internal.CryptonNewtypes where import GHC.Generics (Generic) import Control.Monad (mzero) import qualified Crypto.PubKey.DSA as DSA import qualified Crypto.PubKey.ECC.ECDSA as ECDSA import qualified Crypto.PubKey.ECC.Types as ECCT import qualified Crypto.PubKey.RSA as RSA import qualified Data.Aeson as A import Data.Data (Data) import Data.Hashable (Hashable(..)) import Data.Typeable (Typeable) import Prettyprinter (Pretty(..), (<+>), tupled) newtype DSA_PublicKey = DSA_PublicKey { unDSA_PublicKey :: DSA.PublicKey } deriving (Data, Eq, Generic, Show, Typeable) instance Ord DSA_PublicKey instance A.ToJSON DSA_PublicKey where toJSON (DSA_PublicKey (DSA.PublicKey p y)) = A.toJSON (DSA_Params p, y) instance Pretty DSA_PublicKey where pretty (DSA_PublicKey (DSA.PublicKey p y)) = pretty (DSA_Params p) <+> pretty y newtype RSA_PublicKey = RSA_PublicKey { unRSA_PublicKey :: RSA.PublicKey } deriving (Data, Eq, Generic, Show, Typeable) instance Ord RSA_PublicKey instance A.ToJSON RSA_PublicKey where toJSON (RSA_PublicKey (RSA.PublicKey size n e)) = A.toJSON (size, n, e) instance Pretty RSA_PublicKey where pretty (RSA_PublicKey (RSA.PublicKey size n e)) = pretty size <+> pretty n <+> pretty e newtype ECDSA_PublicKey = ECDSA_PublicKey { unECDSA_PublicKey :: ECDSA.PublicKey } deriving (Data, Eq, Generic, Show, Typeable) instance Ord ECDSA_PublicKey instance A.ToJSON ECDSA_PublicKey where toJSON (ECDSA_PublicKey (ECDSA.PublicKey curve q)) = A.toJSON (show curve, show q) instance Pretty ECDSA_PublicKey where pretty (ECDSA_PublicKey (ECDSA.PublicKey curve q)) = pretty (show curve, show q) newtype DSA_PrivateKey = DSA_PrivateKey { unDSA_PrivateKey :: DSA.PrivateKey } deriving (Data, Eq, Generic, Show, Typeable) instance Ord DSA_PrivateKey instance A.ToJSON DSA_PrivateKey where toJSON (DSA_PrivateKey (DSA.PrivateKey p x)) = A.toJSON (DSA_Params p, x) instance Pretty DSA_PrivateKey where pretty (DSA_PrivateKey (DSA.PrivateKey p x)) = pretty (DSA_Params p, x) newtype RSA_PrivateKey = RSA_PrivateKey { unRSA_PrivateKey :: RSA.PrivateKey } deriving (Data, Eq, Generic, Show, Typeable) instance Ord RSA_PrivateKey instance A.ToJSON RSA_PrivateKey where toJSON (RSA_PrivateKey (RSA.PrivateKey pub d p q dP dQ qinv)) = A.toJSON (RSA_PublicKey pub, d, p, q, dP, dQ, qinv) instance Pretty RSA_PrivateKey where pretty (RSA_PrivateKey (RSA.PrivateKey pub d p q dP dQ qinv)) = pretty (RSA_PublicKey pub) <+> tupled (map pretty [d, p, q, dP, dQ, qinv]) newtype ECDSA_PrivateKey = ECDSA_PrivateKey { unECDSA_PrivateKey :: ECDSA.PrivateKey } deriving (Data, Eq, Generic, Show, Typeable) instance Ord ECDSA_PrivateKey instance A.ToJSON ECDSA_PrivateKey where toJSON (ECDSA_PrivateKey (ECDSA.PrivateKey curve d)) = A.toJSON (show curve, show d) instance Pretty ECDSA_PrivateKey where pretty (ECDSA_PrivateKey (ECDSA.PrivateKey curve d)) = pretty (show curve, show d) newtype DSA_Params = DSA_Params { unDSA_Params :: DSA.Params } deriving (Data, Eq, Generic, Show, Typeable) instance A.ToJSON DSA_Params where toJSON (DSA_Params (DSA.Params p g q)) = A.toJSON (p, g, q) instance Pretty DSA_Params where pretty (DSA_Params (DSA.Params p g q)) = pretty (p, g, q) instance Hashable DSA_Params where hashWithSalt s (DSA_Params (DSA.Params p g q)) = s `hashWithSalt` p `hashWithSalt` g `hashWithSalt` q instance Hashable DSA_PublicKey where hashWithSalt s (DSA_PublicKey (DSA.PublicKey p y)) = s `hashWithSalt` DSA_Params p `hashWithSalt` y instance Hashable DSA_PrivateKey where hashWithSalt s (DSA_PrivateKey (DSA.PrivateKey p x)) = s `hashWithSalt` DSA_Params p `hashWithSalt` x instance Hashable RSA_PublicKey where hashWithSalt s (RSA_PublicKey (RSA.PublicKey size n e)) = s `hashWithSalt` size `hashWithSalt` n `hashWithSalt` e instance Hashable RSA_PrivateKey where hashWithSalt s (RSA_PrivateKey (RSA.PrivateKey pub d p q dP dQ qinv)) = s `hashWithSalt` RSA_PublicKey pub `hashWithSalt` d `hashWithSalt` p `hashWithSalt` q `hashWithSalt` dP `hashWithSalt` dQ `hashWithSalt` qinv instance Hashable ECDSA_PublicKey where hashWithSalt s (ECDSA_PublicKey (ECDSA.PublicKey curve q)) = s `hashWithSalt` show curve `hashWithSalt` show q -- FIXME: don't use show instance Hashable ECDSA_PrivateKey where hashWithSalt s (ECDSA_PrivateKey (ECDSA.PrivateKey curve d)) = s `hashWithSalt` show curve `hashWithSalt` show d -- FIXME: don't use show newtype ECurvePoint = ECurvePoint { unECurvepoint :: ECCT.Point } deriving (Data, Eq, Generic, Show, Typeable) instance A.ToJSON ECurvePoint where toJSON (ECurvePoint (ECCT.Point x y)) = A.toJSON (x, y) toJSON (ECurvePoint ECCT.PointO) = A.toJSON "point at infinity" instance A.FromJSON ECurvePoint where parseJSON (A.Object v) = error "FIXME: whatsit" parseJSON _ = mzero hOpenPGP-2.10.1/Codec/Encryption/OpenPGP/Types/Internal/PKITypes.hs0000644000000000000000000001263407346545000022715 0ustar0000000000000000-- PKITypes.hs: OpenPGP (RFC4880) data types for public/secret keys -- Copyright © 2012-2024 Clint Adams -- This software is released under the terms of the Expat license. -- (See the LICENSE file). {-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE TemplateHaskell #-} module Codec.Encryption.OpenPGP.Types.Internal.PKITypes where import GHC.Generics (Generic) import Codec.Encryption.OpenPGP.Types.Internal.Base import Codec.Encryption.OpenPGP.Types.Internal.CryptonNewtypes import qualified Data.Aeson as A import qualified Data.Aeson.TH as ATH import qualified Data.ByteString as B import Data.ByteString.Lazy (ByteString) import qualified Data.ByteString.Lazy as BL import Data.Data (Data) import Data.Hashable (Hashable(..)) import Data.Ord (comparing) import Data.Typeable (Typeable) import Data.Word (Word16) import Prettyprinter (Pretty(..), (<+>)) data EdSigningCurve = Ed25519 deriving (Data, Eq, Generic, Ord, Show, Typeable) instance Hashable EdSigningCurve instance Pretty EdSigningCurve where pretty Ed25519 = pretty "Ed25519" instance A.FromJSON EdSigningCurve instance A.ToJSON EdSigningCurve newtype EPoint = EPoint { unEPoint :: Integer } deriving (Data, Eq, Generic, Ord, Pretty, Show, Typeable) instance Hashable EPoint instance A.FromJSON EPoint instance A.ToJSON EPoint data PKey = RSAPubKey RSA_PublicKey | DSAPubKey DSA_PublicKey | ElGamalPubKey Integer Integer Integer | ECDHPubKey PKey HashAlgorithm SymmetricAlgorithm | ECDSAPubKey ECDSA_PublicKey | EdDSAPubKey EdSigningCurve EPoint | UnknownPKey ByteString deriving (Data, Eq, Generic, Ord, Show, Typeable) instance Hashable PKey instance Pretty PKey where pretty (RSAPubKey p) = pretty "RSA" <+> pretty p pretty (DSAPubKey p) = pretty "DSA" <+> pretty p pretty (ElGamalPubKey p g y) = pretty "Elgamal" <+> pretty p <+> pretty g <+> pretty y pretty (ECDHPubKey p ha sa) = pretty "ECDH" <+> pretty p <+> pretty ha <+> pretty sa pretty (ECDSAPubKey p) = pretty "ECDSA" <+> pretty p pretty (EdDSAPubKey c ep) = pretty c <+> pretty ep pretty (UnknownPKey bs) = pretty "" <+> pretty (bsToHexUpper bs) instance A.ToJSON PKey where toJSON (RSAPubKey p) = A.toJSON p toJSON (DSAPubKey p) = A.toJSON p toJSON (ElGamalPubKey p g y) = A.toJSON (p, g, y) toJSON (ECDHPubKey p ha sa) = A.toJSON (p, ha, sa) toJSON (ECDSAPubKey p) = A.toJSON p toJSON (EdDSAPubKey c ep) = A.toJSON (c, ep) toJSON (UnknownPKey bs) = A.toJSON (BL.unpack bs) data SKey = RSAPrivateKey RSA_PrivateKey | DSAPrivateKey DSA_PrivateKey | ElGamalPrivateKey Integer | ECDHPrivateKey ECDSA_PrivateKey | ECDSAPrivateKey ECDSA_PrivateKey | EdDSAPrivateKey EdSigningCurve B.ByteString | UnknownSKey ByteString deriving (Data, Eq, Generic, Show, Typeable) instance Hashable SKey instance Pretty SKey where pretty (RSAPrivateKey p) = pretty "RSA" <+> pretty p pretty (DSAPrivateKey p) = pretty "DSA" <+> pretty p pretty (ElGamalPrivateKey p) = pretty "Elgamal" <+> pretty p pretty (ECDHPrivateKey p) = pretty "ECDH" <+> pretty p pretty (ECDSAPrivateKey p) = pretty "ECDSA" <+> pretty p pretty (EdDSAPrivateKey c bs) = pretty c <+> pretty (bsToHexUpper (BL.fromStrict bs)) pretty (UnknownSKey bs) = pretty "" <+> pretty (bsToHexUpper bs) instance A.ToJSON SKey where toJSON (RSAPrivateKey k) = A.toJSON k toJSON (DSAPrivateKey k) = A.toJSON k toJSON (ElGamalPrivateKey k) = A.toJSON k toJSON (ECDHPrivateKey k) = A.toJSON k toJSON (ECDSAPrivateKey k) = A.toJSON k toJSON (EdDSAPrivateKey c bs) = A.toJSON (c, B.unpack bs) toJSON (UnknownSKey bs) = A.toJSON (BL.unpack bs) data PKPayload = PKPayload { _keyVersion :: KeyVersion , _timestamp :: ThirtyTwoBitTimeStamp , _v3exp :: V3Expiration , _pkalgo :: PubKeyAlgorithm , _pubkey :: PKey } deriving (Data, Eq, Generic, Show, Typeable) instance Ord PKPayload where compare = comparing _keyVersion <> comparing _timestamp <> comparing _v3exp <> comparing _pkalgo <> comparing _pubkey instance Hashable PKPayload instance Pretty PKPayload where pretty (PKPayload kv ts v3e pka p) = pretty kv <+> pretty ts <+> pretty v3e <+> pretty pka <+> pretty p $(ATH.deriveToJSON ATH.defaultOptions ''PKPayload) data SKAddendum = SUS16bit SymmetricAlgorithm S2K IV ByteString | SUSSHA1 SymmetricAlgorithm S2K IV ByteString | SUSym SymmetricAlgorithm IV ByteString | SUUnencrypted SKey Word16 deriving (Data, Eq, Generic, Show, Typeable) instance Ord SKAddendum where compare a b = show a `compare` show b -- FIXME: this is ridiculous instance Hashable SKAddendum instance Pretty SKAddendum where pretty (SUS16bit sa s2k iv bs) = pretty "SUS16bit" <+> pretty sa <+> pretty s2k <+> pretty iv <+> pretty (bsToHexUpper bs) pretty (SUSSHA1 sa s2k iv bs) = pretty "SUSSHA1" <+> pretty sa <+> pretty s2k <+> pretty iv <+> pretty (bsToHexUpper bs) pretty (SUSym sa iv bs) = pretty "SUSym" <+> pretty sa <+> pretty iv <+> pretty (bsToHexUpper bs) pretty (SUUnencrypted s ck) = pretty "SUUnencrypted" <+> pretty s <+> pretty ck instance A.ToJSON SKAddendum where toJSON (SUS16bit sa s2k iv bs) = A.toJSON (sa, s2k, iv, BL.unpack bs) toJSON (SUSSHA1 sa s2k iv bs) = A.toJSON (sa, s2k, iv, BL.unpack bs) toJSON (SUSym sa iv bs) = A.toJSON (sa, iv, BL.unpack bs) toJSON (SUUnencrypted s ck) = A.toJSON (s, ck) hOpenPGP-2.10.1/Codec/Encryption/OpenPGP/Types/Internal/PacketClass.hs0000644000000000000000000003106607346545000023442 0ustar0000000000000000-- PacketClass.hs: OpenPGP (RFC4880) data types -- Copyright © 2012-2022 Clint Adams -- This software is released under the terms of the Expat license. -- (See the LICENSE file). {-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} module Codec.Encryption.OpenPGP.Types.Internal.PacketClass where import Codec.Encryption.OpenPGP.Types.Internal.Base import Codec.Encryption.OpenPGP.Types.Internal.PKITypes import Codec.Encryption.OpenPGP.Types.Internal.Pkt import Control.Lens (makeLenses) import Data.ByteString.Lazy (ByteString) import qualified Data.ByteString.Lazy as BL import Data.Data (Data) import Data.List.NonEmpty (NonEmpty) import Data.Text (Text) import Data.Typeable (Typeable) import Data.Word (Word8) import qualified Data.Kind import Prettyprinter (Pretty(..)) class Packet a where data PacketType a :: Data.Kind.Type packetType :: a -> PacketType a packetCode :: PacketType a -> Word8 toPkt :: a -> Pkt fromPkt :: Pkt -> a data PKESK = PKESK { _pkeskPacketVersion :: PacketVersion , _pkeskEightOctetKeyId :: EightOctetKeyId , _pkeskPubKeyAlgorithm :: PubKeyAlgorithm , _pkeskMPIs :: NonEmpty MPI } deriving (Data, Eq, Show, Typeable) instance Packet PKESK where data PacketType PKESK = PKESKType deriving (Show, Eq) packetType _ = PKESKType packetCode _ = 1 toPkt (PKESK a b c d) = PKESKPkt a b c d fromPkt (PKESKPkt a b c d) = PKESK a b c d fromPkt _ = error "Cannot coerce non-PKESK packet" instance Pretty PKESK where pretty = pretty . toPkt newtype Signature = Signature -- FIXME? { _signaturePayload :: SignaturePayload } deriving (Data, Eq, Show, Typeable) instance Packet Signature where data PacketType Signature = SignatureType deriving (Show, Eq) packetType _ = SignatureType packetCode _ = 2 toPkt (Signature a) = SignaturePkt a fromPkt (SignaturePkt a) = Signature a fromPkt _ = error "Cannot coerce non-Signature packet" instance Pretty Signature where pretty = pretty . toPkt data SKESK = SKESK { _skeskPacketVersion :: PacketVersion , _skeskSymmetricAlgorithm :: SymmetricAlgorithm , _skeskS2K :: S2K , _skeskESK :: Maybe BL.ByteString } deriving (Data, Eq, Show, Typeable) instance Packet SKESK where data PacketType SKESK = SKESKType deriving (Show, Eq) packetType _ = SKESKType packetCode _ = 3 toPkt (SKESK a b c d) = SKESKPkt a b c d fromPkt (SKESKPkt a b c d) = SKESK a b c d fromPkt _ = error "Cannot coerce non-SKESK packet" instance Pretty SKESK where pretty = pretty . toPkt data OnePassSignature = OnePassSignature { _onePassSignaturePacketVersion :: PacketVersion , _onePassSignatureSigType :: SigType , _onePassSignatureHashAlgorithm :: HashAlgorithm , _onePassSignaturePubKeyAlgorithm :: PubKeyAlgorithm , _onePassSignatureEightOctetKeyId :: EightOctetKeyId , _onePassSignatureNestedFlag :: NestedFlag } deriving (Data, Eq, Show, Typeable) instance Packet OnePassSignature where data PacketType OnePassSignature = OnePassSignatureType deriving (Show, Eq) packetType _ = OnePassSignatureType packetCode _ = 4 toPkt (OnePassSignature a b c d e f) = OnePassSignaturePkt a b c d e f fromPkt (OnePassSignaturePkt a b c d e f) = OnePassSignature a b c d e f fromPkt _ = error "Cannot coerce non-OnePassSignature packet" instance Pretty OnePassSignature where pretty = pretty . toPkt data SecretKey = SecretKey { _secretKeyPKPayload :: PKPayload , _secretKeySKAddendum :: SKAddendum } deriving (Data, Eq, Show, Typeable) instance Packet SecretKey where data PacketType SecretKey = SecretKeyType deriving (Show, Eq) packetType _ = SecretKeyType packetCode _ = 5 toPkt (SecretKey a b) = SecretKeyPkt a b fromPkt (SecretKeyPkt a b) = SecretKey a b fromPkt _ = error "Cannot coerce non-SecretKey packet" instance Pretty SecretKey where pretty = pretty . toPkt newtype PublicKey = PublicKey { _publicKeyPKPayload :: PKPayload } deriving (Data, Eq, Show, Typeable) instance Packet PublicKey where data PacketType PublicKey = PublicKeyType deriving (Show, Eq) packetType _ = PublicKeyType packetCode _ = 6 toPkt (PublicKey a) = PublicKeyPkt a fromPkt (PublicKeyPkt a) = PublicKey a fromPkt _ = error "Cannot coerce non-PublicKey packet" instance Pretty PublicKey where pretty = pretty . toPkt data SecretSubkey = SecretSubkey { _secretSubkeyPKPayload :: PKPayload , _secretSubkeySKAddendum :: SKAddendum } deriving (Data, Eq, Show, Typeable) instance Packet SecretSubkey where data PacketType SecretSubkey = SecretSubkeyType deriving (Show, Eq) packetType _ = SecretSubkeyType packetCode _ = 7 toPkt (SecretSubkey a b) = SecretSubkeyPkt a b fromPkt (SecretSubkeyPkt a b) = SecretSubkey a b fromPkt _ = error "Cannot coerce non-SecretSubkey packet" instance Pretty SecretSubkey where pretty = pretty . toPkt data CompressedData = CompressedData { _compressedDataCompressionAlgorithm :: CompressionAlgorithm , _compressedDataPayload :: CompressedDataPayload } deriving (Data, Eq, Show, Typeable) instance Packet CompressedData where data PacketType CompressedData = CompressedDataType deriving (Show, Eq) packetType _ = CompressedDataType packetCode _ = 8 toPkt (CompressedData a b) = CompressedDataPkt a b fromPkt (CompressedDataPkt a b) = CompressedData a b fromPkt _ = error "Cannot coerce non-CompressedData packet" instance Pretty CompressedData where pretty = pretty . toPkt newtype SymEncData = SymEncData { _symEncDataPayload :: ByteString } deriving (Data, Eq, Show, Typeable) instance Packet SymEncData where data PacketType SymEncData = SymEncDataType deriving (Show, Eq) packetType _ = SymEncDataType packetCode _ = 9 toPkt (SymEncData a) = SymEncDataPkt a fromPkt (SymEncDataPkt a) = SymEncData a fromPkt _ = error "Cannot coerce non-SymEncData packet" instance Pretty SymEncData where pretty = pretty . toPkt newtype Marker = Marker { _markerPayload :: ByteString } deriving (Data, Eq, Show, Typeable) instance Packet Marker where data PacketType Marker = MarkerType deriving (Show, Eq) packetType _ = MarkerType packetCode _ = 10 toPkt (Marker a) = MarkerPkt a fromPkt (MarkerPkt a) = Marker a fromPkt _ = error "Cannot coerce non-Marker packet" instance Pretty Marker where pretty = pretty . toPkt data LiteralData = LiteralData { _literalDataDataType :: DataType , _literalDataFileName :: FileName , _literalDataTimeStamp :: ThirtyTwoBitTimeStamp , _literalDataPayload :: ByteString } deriving (Data, Eq, Show, Typeable) instance Packet LiteralData where data PacketType LiteralData = LiteralDataType deriving (Show, Eq) packetType _ = LiteralDataType packetCode _ = 11 toPkt (LiteralData a b c d) = LiteralDataPkt a b c d fromPkt (LiteralDataPkt a b c d) = LiteralData a b c d fromPkt _ = error "Cannot coerce non-LiteralData packet" instance Pretty LiteralData where pretty = pretty . toPkt newtype Trust = Trust { _trustPayload :: ByteString } deriving (Data, Eq, Show, Typeable) instance Packet Trust where data PacketType Trust = TrustType deriving (Show, Eq) packetType _ = TrustType packetCode _ = 12 toPkt (Trust a) = TrustPkt a fromPkt (TrustPkt a) = Trust a fromPkt _ = error "Cannot coerce non-Trust packet" instance Pretty Trust where pretty = pretty . toPkt newtype UserId = UserId { _userIdPayload :: Text } deriving (Data, Eq, Show, Typeable) instance Packet UserId where data PacketType UserId = UserIdType deriving (Show, Eq) packetType _ = UserIdType packetCode _ = 13 toPkt (UserId a) = UserIdPkt a fromPkt (UserIdPkt a) = UserId a fromPkt _ = error "Cannot coerce non-UserId packet" instance Pretty UserId where pretty = pretty . toPkt newtype PublicSubkey = PublicSubkey { _publicSubkeyPKPayload :: PKPayload } deriving (Data, Eq, Show, Typeable) instance Packet PublicSubkey where data PacketType PublicSubkey = PublicSubkeyType deriving (Show, Eq) packetType _ = PublicSubkeyType packetCode _ = 14 toPkt (PublicSubkey a) = PublicSubkeyPkt a fromPkt (PublicSubkeyPkt a) = PublicSubkey a fromPkt _ = error "Cannot coerce non-PublicSubkey packet" instance Pretty PublicSubkey where pretty = pretty . toPkt newtype UserAttribute = UserAttribute { _userAttributeSubPackets :: [UserAttrSubPacket] } deriving (Data, Eq, Show, Typeable) instance Packet UserAttribute where data PacketType UserAttribute = UserAttributeType deriving (Show, Eq) packetType _ = UserAttributeType packetCode _ = 17 toPkt (UserAttribute a) = UserAttributePkt a fromPkt (UserAttributePkt a) = UserAttribute a fromPkt _ = error "Cannot coerce non-UserAttribute packet" instance Pretty UserAttribute where pretty = pretty . toPkt data SymEncIntegrityProtectedData = SymEncIntegrityProtectedData { _symEncIntegrityProtectedDataPacketVersion :: PacketVersion , _symEncIntegrityProtectedDataPayload :: ByteString } deriving (Data, Eq, Show, Typeable) instance Packet SymEncIntegrityProtectedData where data PacketType SymEncIntegrityProtectedData = SymEncIntegrityProtectedDataType deriving (Show, Eq) packetType _ = SymEncIntegrityProtectedDataType packetCode _ = 18 toPkt (SymEncIntegrityProtectedData a b) = SymEncIntegrityProtectedDataPkt a b fromPkt (SymEncIntegrityProtectedDataPkt a b) = SymEncIntegrityProtectedData a b fromPkt _ = error "Cannot coerce non-SymEncIntegrityProtectedData packet" instance Pretty SymEncIntegrityProtectedData where pretty = pretty . toPkt newtype ModificationDetectionCode = ModificationDetectionCode { _modificationDetectionCodePayload :: ByteString } deriving (Data, Eq, Show, Typeable) instance Packet ModificationDetectionCode where data PacketType ModificationDetectionCode = ModificationDetectionCodeType deriving (Show, Eq) packetType _ = ModificationDetectionCodeType packetCode _ = 19 toPkt (ModificationDetectionCode a) = ModificationDetectionCodePkt a fromPkt (ModificationDetectionCodePkt a) = ModificationDetectionCode a fromPkt _ = error "Cannot coerce non-ModificationDetectionCode packet" instance Pretty ModificationDetectionCode where pretty = pretty . toPkt data OtherPacket = OtherPacket { _otherPacketType :: Word8 , _otherPacketPayload :: ByteString } deriving (Data, Eq, Show, Typeable) instance Packet OtherPacket where data PacketType OtherPacket = OtherPacketType deriving (Show, Eq) packetType _ = OtherPacketType packetCode _ = undefined -- FIXME toPkt (OtherPacket a b) = OtherPacketPkt a b fromPkt (OtherPacketPkt a b) = OtherPacket a b fromPkt _ = error "Cannot coerce non-OtherPacket packet" instance Pretty OtherPacket where pretty = pretty . toPkt data BrokenPacket = BrokenPacket { _brokenPacketParseError :: String , _brokenPacketType :: Word8 , _brokenPacketPayload :: ByteString } deriving (Data, Eq, Show, Typeable) instance Packet BrokenPacket where data PacketType BrokenPacket = BrokenPacketType deriving (Show, Eq) packetType _ = BrokenPacketType packetCode _ = undefined toPkt (BrokenPacket a b c) = BrokenPacketPkt a b c fromPkt (BrokenPacketPkt a b c) = BrokenPacket a b c fromPkt _ = error "Cannot coerce non-BrokenPacket packet" instance Pretty BrokenPacket where pretty = pretty . toPkt $(makeLenses ''PKESK) $(makeLenses ''Signature) $(makeLenses ''SKESK) $(makeLenses ''OnePassSignature) $(makeLenses ''SecretKey) $(makeLenses ''PKPayload) $(makeLenses ''PublicKey) $(makeLenses ''SecretSubkey) $(makeLenses ''CompressedData) $(makeLenses ''SymEncData) $(makeLenses ''Marker) $(makeLenses ''LiteralData) $(makeLenses ''Trust) $(makeLenses ''UserId) $(makeLenses ''PublicSubkey) $(makeLenses ''UserAttribute) $(makeLenses ''SymEncIntegrityProtectedData) $(makeLenses ''ModificationDetectionCode) $(makeLenses ''OtherPacket) $(makeLenses ''BrokenPacket) hOpenPGP-2.10.1/Codec/Encryption/OpenPGP/Types/Internal/Pkt.hs0000644000000000000000000002003307346545000021773 0ustar0000000000000000-- Pkt.hs: OpenPGP (RFC4880) Pkt data types -- Copyright © 2012-2022 Clint Adams -- This software is released under the terms of the Expat license. -- (See the LICENSE file). {-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE TemplateHaskell #-} module Codec.Encryption.OpenPGP.Types.Internal.Pkt where import GHC.Generics (Generic) import Codec.Encryption.OpenPGP.Types.Internal.Base import Codec.Encryption.OpenPGP.Types.Internal.PKITypes import Codec.Encryption.OpenPGP.Types.Internal.PrettyUtils (prettyLBS) import Control.Lens (makeLenses) import Data.Aeson ((.=), object) import qualified Data.Aeson as A import Data.ByteString.Lazy (ByteString) import qualified Data.ByteString.Lazy as BL import Data.Data (Data) import Data.Hashable (Hashable(..)) import Data.List.NonEmpty (NonEmpty) import qualified Data.List.NonEmpty as NE import Data.Ord (comparing) import Data.Text (Text) import qualified Data.Text as T import Data.Time.Clock (UTCTime) import Data.Typeable (Typeable) import Data.Word (Word8) import Prettyprinter (Pretty(..), (<+>)) -- data Pkt = forall a. (Packet a, Show a, Eq a) => Pkt a data Pkt = PKESKPkt PacketVersion EightOctetKeyId PubKeyAlgorithm (NonEmpty MPI) | SignaturePkt SignaturePayload | SKESKPkt PacketVersion SymmetricAlgorithm S2K (Maybe BL.ByteString) | OnePassSignaturePkt PacketVersion SigType HashAlgorithm PubKeyAlgorithm EightOctetKeyId NestedFlag | SecretKeyPkt PKPayload SKAddendum | PublicKeyPkt PKPayload | SecretSubkeyPkt PKPayload SKAddendum | CompressedDataPkt CompressionAlgorithm CompressedDataPayload | SymEncDataPkt ByteString | MarkerPkt ByteString | LiteralDataPkt DataType FileName ThirtyTwoBitTimeStamp ByteString | TrustPkt ByteString | UserIdPkt Text | PublicSubkeyPkt PKPayload | UserAttributePkt [UserAttrSubPacket] | SymEncIntegrityProtectedDataPkt PacketVersion ByteString | ModificationDetectionCodePkt ByteString | OtherPacketPkt Word8 ByteString | BrokenPacketPkt String Word8 ByteString deriving (Data, Eq, Generic, Show, Typeable) -- FIXME instance Hashable Pkt instance Ord Pkt where compare = comparing pktTag <> comparing hash -- FIXME: is there something saner? instance Pretty Pkt where pretty (PKESKPkt pv eoki pka mpis) = pretty "PKESK v" <> pretty pv <> pretty ':' <+> pretty eoki <+> pretty pka <+> (pretty . NE.toList) mpis pretty (SignaturePkt sp) = pretty sp pretty (SKESKPkt pv sa s2k mbs) = pretty "SKESK v" <> pretty pv <> pretty ':' <+> pretty sa <+> pretty s2k <+> pretty (fmap bsToHexUpper mbs) pretty (OnePassSignaturePkt pv st ha pka eoki nestedflag) = pretty "one-pass signature v" <> pretty pv <> pretty ':' <+> pretty st <+> pretty ha <+> pretty pka <+> pretty eoki <+> pretty nestedflag pretty (SecretKeyPkt pkp ska) = pretty "secret key:" <+> pretty pkp <+> pretty ska pretty (PublicKeyPkt pkp) = pretty "public key:" <+> pretty pkp pretty (SecretSubkeyPkt pkp ska) = pretty "secret subkey:" <+> pretty pkp <+> pretty ska pretty (CompressedDataPkt ca cdp) = pretty "compressed-data:" <+> pretty ca <+> prettyLBS cdp pretty (SymEncDataPkt bs) = pretty "symmetrically-encrypted-data:" <+> pretty (bsToHexUpper bs) pretty (MarkerPkt bs) = pretty "marker:" <+> pretty (bsToHexUpper bs) pretty (LiteralDataPkt dt fn ts bs) = pretty "literal-data" <+> pretty dt <+> prettyLBS fn <+> pretty ts <+> pretty (bsToHexUpper bs) pretty (TrustPkt bs) = pretty "trust:" <+> pretty (BL.unpack bs) pretty (UserIdPkt u) = pretty "user-ID:" <+> pretty u pretty (PublicSubkeyPkt pkp) = pretty "public subkey:" <+> pretty pkp pretty (UserAttributePkt us) = pretty "user-attribute:" <+> pretty us pretty (SymEncIntegrityProtectedDataPkt pv bs) = pretty "symmetrically-encrypted-integrity-protected-data v" <> pretty pv <> pretty ':' <+> pretty (bsToHexUpper bs) pretty (ModificationDetectionCodePkt bs) = pretty "MDC:" <+> pretty (bsToHexUpper bs) pretty (OtherPacketPkt t bs) = pretty "unknown packet type" <+> pretty t <> pretty ':' <+> pretty (bsToHexUpper bs) pretty (BrokenPacketPkt s t bs) = pretty "BROKEN packet (" <> pretty s <> pretty ')' <+> pretty t <> pretty ':' <+> pretty (bsToHexUpper bs) instance A.ToJSON Pkt where toJSON (PKESKPkt pv eoki pka mpis) = object [ key "pkesk" .= object [ key "version" .= pv , key "keyid" .= eoki , key "pkalgo" .= pka , key "mpis" .= NE.toList mpis ] ] toJSON (SignaturePkt sp) = object [key "signature" .= sp] toJSON (SKESKPkt pv sa s2k mbs) = object [ key "skesk" .= object [ key "version" .= pv , key "symalgo" .= sa , key "s2k" .= s2k , key "data" .= maybe mempty BL.unpack mbs ] ] toJSON (OnePassSignaturePkt pv st ha pka eoki nestedflag) = object [ key "onepasssignature" .= object [ key "version" .= pv , key "sigtype" .= st , key "hashalgo" .= ha , key "pkalgo" .= pka , key "keyid" .= eoki , key "nested" .= nestedflag ] ] toJSON (SecretKeyPkt pkp ska) = object [ key "secretkey" .= object [key "public" .= pkp, key "secret" .= ska] ] toJSON (PublicKeyPkt pkp) = object [key "publickey" .= pkp] toJSON (SecretSubkeyPkt pkp ska) = object [ key "secretsubkey" .= object [key "public" .= pkp, key "secret" .= ska] ] toJSON (CompressedDataPkt ca cdp) = object [ key "compresseddata" .= object [key "compressionalgo" .= ca, key "data" .= BL.unpack cdp] ] toJSON (SymEncDataPkt bs) = object [key "symencdata" .= BL.unpack bs] toJSON (MarkerPkt bs) = object [key "marker" .= BL.unpack bs] toJSON (LiteralDataPkt dt fn ts bs) = object [ key "literaldata" .= object [ key "dt" .= dt , key "filename" .= BL.unpack fn , key "ts" .= ts , key "data" .= BL.unpack bs ] ] toJSON (TrustPkt bs) = object [key "trust" .= BL.unpack bs] toJSON (UserIdPkt u) = object [key "userid" .= u] toJSON (PublicSubkeyPkt pkp) = object [key "publicsubkkey" .= pkp] toJSON (UserAttributePkt us) = object [key "userattribute" .= us] toJSON (SymEncIntegrityProtectedDataPkt pv bs) = object [ key "symencipd" .= object [key "version" .= pv, key "data" .= BL.unpack bs] ] toJSON (ModificationDetectionCodePkt bs) = object [key "mdc" .= BL.unpack bs] toJSON (OtherPacketPkt t bs) = object [ key "otherpacket" .= object [key "tag" .= t, key "data" .= BL.unpack bs] ] toJSON (BrokenPacketPkt s t bs) = object [ key "brokenpacket" .= object [ key "error" .= s , key "tag" .= t , key "data" .= BL.unpack bs ] ] pktTag :: Pkt -> Word8 pktTag PKESKPkt {} = 1 pktTag (SignaturePkt _) = 2 pktTag SKESKPkt {} = 3 pktTag OnePassSignaturePkt {} = 4 pktTag SecretKeyPkt {} = 5 pktTag (PublicKeyPkt _) = 6 pktTag SecretSubkeyPkt {} = 7 pktTag CompressedDataPkt {} = 8 pktTag (SymEncDataPkt _) = 9 pktTag (MarkerPkt _) = 10 pktTag LiteralDataPkt {} = 11 pktTag (TrustPkt _) = 12 pktTag (UserIdPkt _) = 13 pktTag (PublicSubkeyPkt _) = 14 pktTag (UserAttributePkt _) = 17 pktTag SymEncIntegrityProtectedDataPkt {} = 18 pktTag (ModificationDetectionCodePkt _) = 19 pktTag (OtherPacketPkt t _) = t pktTag (BrokenPacketPkt _ t _) = t -- is this the right thing to do? data Verification = Verification { _verificationSigner :: PKPayload , _verificationSignature :: SignaturePayload } data SOPVVerification = SOPVVerification { _sopvvDateStamp :: UTCTime , _sopvvFingerprint :: TwentyOctetFingerprint , _sopvvPrimaryFingerprint :: TwentyOctetFingerprint , _sopvvMode :: String , _sopvvDescription :: String } $(makeLenses ''Verification) $(makeLenses ''SOPVVerification) hOpenPGP-2.10.1/Codec/Encryption/OpenPGP/Types/Internal/PrettyUtils.hs0000644000000000000000000000120107346545000023541 0ustar0000000000000000-- PrettyUtils.hs: prettyprinter helpers -- Copyright © 2018-2022 Clint Adams -- This software is released under the terms of the Expat license. -- (See the LICENSE file). module Codec.Encryption.OpenPGP.Types.Internal.PrettyUtils where import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as BL import Data.Text.Encoding (decodeUtf8With) import Data.Text.Encoding.Error (lenientDecode) import Prettyprinter (Doc, Pretty(..)) prettyBS :: B.ByteString -> Doc ann prettyBS = pretty . decodeUtf8With lenientDecode prettyLBS :: BL.ByteString -> Doc ann prettyLBS = pretty . decodeUtf8With lenientDecode . BL.toStrict hOpenPGP-2.10.1/Codec/Encryption/OpenPGP/Types/Internal/TK.hs0000644000000000000000000000246207346545000021561 0ustar0000000000000000-- TK.hs: OpenPGP (RFC4880) transferable key data type -- Copyright © 2012-2016 Clint Adams -- This software is released under the terms of the Expat license. -- (See the LICENSE file). {-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE TemplateHaskell #-} module Codec.Encryption.OpenPGP.Types.Internal.TK where import GHC.Generics (Generic) import Codec.Encryption.OpenPGP.Types.Internal.Base import Codec.Encryption.OpenPGP.Types.Internal.PKITypes import Codec.Encryption.OpenPGP.Types.Internal.Pkt import Control.Lens (makeLenses) import qualified Data.Aeson.TH as ATH import Data.Data (Data) import Data.IxSet.Typed (IxSet) import Data.Ord (comparing) import Data.Text (Text) import Data.Typeable (Typeable) data TK = TK { _tkKey :: (PKPayload, Maybe SKAddendum) , _tkRevs :: [SignaturePayload] , _tkUIDs :: [(Text, [SignaturePayload])] , _tkUAts :: [([UserAttrSubPacket], [SignaturePayload])] , _tkSubs :: [(Pkt, [SignaturePayload])] } deriving (Data, Eq, Generic, Show, Typeable) instance Ord TK where compare = comparing _tkKey -- FIXME: is this ridiculous? $(ATH.deriveToJSON ATH.defaultOptions ''TK) type KeyringIxs = '[ EightOctetKeyId, TwentyOctetFingerprint, Text] type Keyring = IxSet KeyringIxs TK $(makeLenses ''TK) hOpenPGP-2.10.1/Codec/Encryption/OpenPGP/Version.hs0000644000000000000000000000055707346545000020013 0ustar0000000000000000-- Version.hs: static hOpenPGP version string -- Copyright © 2024 Clint Adams -- This software is released under the terms of the Expat license. -- (See the LICENSE file). module Codec.Encryption.OpenPGP.Version ( version ) where import Data.Version (showVersion) import qualified Paths_hOpenPGP as Paths version :: String version = showVersion Paths.version hOpenPGP-2.10.1/Data/Conduit/OpenPGP/0000755000000000000000000000000007346545000015132 5ustar0000000000000000hOpenPGP-2.10.1/Data/Conduit/OpenPGP/Compression.hs0000644000000000000000000000134307346545000017770 0ustar0000000000000000-- Compression.hs: OpenPGP (RFC4880) compression conduits -- Copyright © 2012-2018 Clint Adams -- This software is released under the terms of the Expat license. -- (See the LICENSE file). module Data.Conduit.OpenPGP.Compression ( conduitCompress , conduitDecompress ) where import Codec.Encryption.OpenPGP.Compression import Codec.Encryption.OpenPGP.Types import Control.Monad.Trans.Resource (MonadThrow) import Data.Conduit import qualified Data.Conduit.List as CL conduitCompress :: MonadThrow m => CompressionAlgorithm -> ConduitT Pkt Pkt m () conduitCompress algo = CL.consume >>= \ps -> yield (compressPkts algo ps) conduitDecompress :: MonadThrow m => ConduitT Pkt Pkt m () conduitDecompress = CL.concatMap decompressPkt hOpenPGP-2.10.1/Data/Conduit/OpenPGP/Decrypt.hs0000644000000000000000000001177507346545000017113 0ustar0000000000000000-- Decrypt.hs: OpenPGP (RFC4880) recursive packet decryption -- Copyright © 2013-2020 Clint Adams -- This software is released under the terms of the Expat license. -- (See the LICENSE file). {-# LANGUAGE FlexibleContexts #-} module Data.Conduit.OpenPGP.Decrypt ( conduitDecrypt ) where import Control.Monad (when) import Control.Monad.Fail (MonadFail) import Control.Monad.IO.Class (MonadIO(..)) import Control.Monad.IO.Unlift (MonadUnliftIO) import Control.Monad.Trans.Resource (MonadResource, MonadThrow) import qualified Crypto.Hash as CH import qualified Crypto.Hash.Algorithms as CHA import Data.Binary (get) import qualified Data.ByteArray as BA import qualified Data.ByteString as B import qualified Data.ByteString.Base16.Lazy as B16L import qualified Data.ByteString.Lazy as BL import Data.Conduit import qualified Data.Conduit.Binary as CB import qualified Data.Conduit.Combinators as CC import qualified Data.Conduit.List as CL import Data.Conduit.OpenPGP.Compression (conduitDecompress) import Data.Conduit.Serialization.Binary (conduitGet) import Data.Maybe (fromJust, isNothing) import Codec.Encryption.OpenPGP.CFB (decryptOpenPGPCfb, decryptPreservingNonce) import Codec.Encryption.OpenPGP.S2K (skesk2Key) import Codec.Encryption.OpenPGP.Types data RecursorState = RecursorState { _depth :: Int , _lastPKESK :: Maybe PKESK , _lastSKESK :: Maybe SKESK , _lastNonce :: Maybe B.ByteString , _lastClearText :: Maybe B.ByteString } deriving (Eq, Show) def :: RecursorState def = RecursorState 0 Nothing Nothing Nothing Nothing type InputCallback m = String -> m BL.ByteString conduitDecrypt :: (MonadFail m, MonadUnliftIO m, MonadResource m, MonadThrow m) => InputCallback IO -> ConduitT Pkt Pkt m () conduitDecrypt = conduitDecrypt' def conduitDecrypt' :: (MonadFail m, MonadUnliftIO m, MonadResource m, MonadThrow m) => RecursorState -> InputCallback IO -> ConduitT Pkt Pkt m () conduitDecrypt' rs cb = CC.concatMapAccumM push rs where push :: (MonadFail m, MonadUnliftIO m, MonadResource m, MonadThrow m) => Pkt -> RecursorState -> m (RecursorState, [Pkt]) push i s | _depth s > 42 = fail "I think we've been quine-attacked" | otherwise = case i of SKESKPkt {} -> return (s {_lastSKESK = Just (fromPkt i)}, []) (SymEncDataPkt bs) -> do d <- decryptSEDP s cb (fromJust . _lastSKESK $ s) bs return (s, d) (SymEncIntegrityProtectedDataPkt _ bs) -> do d <- decryptSEIPDP s cb (fromJust . _lastSKESK $ s) bs return (s, d) m@(ModificationDetectionCodePkt mdc) -> do when (isNothing (_lastClearText s)) $ fail "MDC with no referent" let mcalculated = calculateMDC <$> _lastNonce s <*> _lastClearText s when (mcalculated /= Just mdc) $ fail $ "MDC indicates tampering: " ++ show (B16L.encode mdc) ++ " versus " ++ maybe "" (show . B16L.encode) mcalculated ++ " ... " ++ show (_lastNonce s) ++ " / " ++ show (_lastClearText s) return (s, [m]) p -> return (s, [p]) decryptSEDP :: (MonadFail m, MonadUnliftIO m, MonadIO m, MonadThrow m) => RecursorState -> InputCallback IO -> SKESK -> BL.ByteString -> m [Pkt] decryptSEDP rs cb skesk bs -- FIXME: this shouldn't pass the whole SKESK = do passphrase <- liftIO $ cb "Input the passphrase I want" let key = skesk2Key skesk passphrase decrypted = case decryptOpenPGPCfb (_skeskSymmetricAlgorithm skesk) (BL.toStrict bs) key of Left e -> error e Right x -> x runConduitRes $ CB.sourceLbs (BL.fromStrict decrypted) .| conduitGet get .| conduitDecompress .| conduitDecrypt' rs {_depth = _depth rs + 1} cb .| CL.consume decryptSEIPDP :: (MonadFail m, MonadUnliftIO m, MonadIO m, MonadThrow m) => RecursorState -> InputCallback IO -> SKESK -> BL.ByteString -> m [Pkt] decryptSEIPDP rs cb skesk bs -- FIXME: this shouldn't pass the whole SKESK = do passphrase <- liftIO $ cb "Input the passphrase I want" let key = skesk2Key skesk passphrase (nonce, decrypted) = case decryptPreservingNonce (_skeskSymmetricAlgorithm skesk) (BL.toStrict bs) key of Left e -> error e Right x -> x runConduitRes $ CB.sourceLbs (BL.fromStrict decrypted) .| conduitGet get .| conduitDecompress .| conduitDecrypt' rs { _depth = _depth rs + 1 , _lastNonce = Just nonce , _lastClearText = Just decrypted } cb .| CL.consume calculateMDC :: B.ByteString -> B.ByteString -> BL.ByteString calculateMDC nonce garbage | B.length garbage < 23 = mempty -- FIXME: this is horrible | otherwise = BL.fromStrict . BA.convert . (CH.hash :: B.ByteString -> CH.Digest CHA.SHA1) $ nonce <> B.take (B.length garbage - 22) garbage <> B.pack [211, 20] hOpenPGP-2.10.1/Data/Conduit/OpenPGP/Filter.hs0000644000000000000000000000345607346545000016723 0ustar0000000000000000-- Filter.hs: OpenPGP (RFC4880) packet filtering -- Copyright © 2014-2020 Clint Adams -- This software is released under the terms of the Expat license. -- (See the LICENSE file). {-# LANGUAGE GADTs #-} module Data.Conduit.OpenPGP.Filter ( conduitPktFilter , conduitPktWithExtraFilter , conduitTKFilter , FilterPredicates(..) ) where import Control.Monad.Trans.Reader (Reader, runReader) import Data.Conduit (ConduitT) import qualified Data.Conduit.List as CL import Data.Void (Void) import Codec.Encryption.OpenPGP.Types data FilterPredicates r a = RTKFilterPredicate (Reader TK Bool) -- ^ fp for transferable keys | RPFilterPredicate (Reader Pkt Bool) -- ^ fp for context-less packets | RFilterPredicate (Reader a Bool) -- ^ generic filter predicate | RPairFilterPredicate (Reader (r, a) Bool) -- ^ generic filter predicate with additional context conduitPktFilter :: Monad m => FilterPredicates Void Pkt -> ConduitT Pkt Pkt m () conduitPktFilter = CL.filter . superPredicate superPredicate :: FilterPredicates Void Pkt -> Pkt -> Bool superPredicate (RPFilterPredicate e) p = runReader e p superPredicate (RFilterPredicate e) p = runReader e p superPredicate _ _ = False -- do not match incorrect type of packet conduitTKFilter :: Monad m => FilterPredicates Void TK -> ConduitT TK TK m () conduitTKFilter = CL.filter . superTKPredicate superTKPredicate :: FilterPredicates Void TK -> TK -> Bool superTKPredicate (RTKFilterPredicate e) = runReader e superTKPredicate (RFilterPredicate e) = runReader e conduitPktWithExtraFilter :: Monad m => r -> FilterPredicates r Pkt -> ConduitT Pkt Pkt m () conduitPktWithExtraFilter extra = CL.filter . superPairPredicate extra superPairPredicate :: r -> FilterPredicates r a -> a -> Bool superPairPredicate r (RPairFilterPredicate e) p = runReader e (r, p) hOpenPGP-2.10.1/Data/Conduit/OpenPGP/Keyring.hs0000644000000000000000000000323707346545000017103 0ustar0000000000000000-- Keyring.hs: OpenPGP (RFC4880) transferable keys parsing -- Copyright © 2012-2018 Clint Adams -- This software is released under the terms of the Expat license. -- (See the LICENSE file). module Data.Conduit.OpenPGP.Keyring ( conduitToTKs , conduitToTKsDropping , sinkKeyringMap ) where import Data.Conduit import qualified Data.Conduit.List as CL import Data.IxSet.Typed (empty, insert) import Codec.Encryption.OpenPGP.KeyringParser ( anyTK , finalizeParsing , parseAChunk ) import Codec.Encryption.OpenPGP.Ontology (isTrustPkt) import Codec.Encryption.OpenPGP.Types import Data.Conduit.OpenPGP.Keyring.Instances () data Phase = MainKey | Revs | Uids | UAts | Subs | SkippingBroken deriving (Eq, Ord, Show) conduitToTKs :: Monad m => ConduitT Pkt TK m () conduitToTKs = conduitToTKs' True conduitToTKsDropping :: Monad m => ConduitT Pkt TK m () conduitToTKsDropping = conduitToTKs' False fakecmAccum :: Monad m => (accum -> (accum, [b])) -> (a -> accum -> (accum, [b])) -> accum -> ConduitT a b m () fakecmAccum finalizer f = loop where loop accum = await >>= maybe (mapM_ yield (snd (finalizer accum))) go where go a = do let (accum', bs) = f a accum mapM_ yield bs loop accum' conduitToTKs' :: Monad m => Bool -> ConduitT Pkt TK m () conduitToTKs' intolerant = CL.filter notTrustPacket .| CL.map (: []) .| fakecmAccum finalizeParsing (parseAChunk (anyTK intolerant)) ([], Just (Nothing, anyTK intolerant)) .| CL.catMaybes where notTrustPacket = not . isTrustPkt sinkKeyringMap :: Monad m => ConduitT TK Void m Keyring sinkKeyringMap = CL.fold (flip insert) empty hOpenPGP-2.10.1/Data/Conduit/OpenPGP/Keyring/0000755000000000000000000000000007346545000016542 5ustar0000000000000000hOpenPGP-2.10.1/Data/Conduit/OpenPGP/Keyring/Instances.hs0000644000000000000000000000511607346545000021030 0ustar0000000000000000-- Instances.hs: OpenPGP (RFC4880) additional types for transferable keys -- Copyright © 2012-2019 Clint Adams -- This software is released under the terms of the Expat license. -- (See the LICENSE file). {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE TypeSynonymInstances #-} module Data.Conduit.OpenPGP.Keyring.Instances ( ) where import Codec.Encryption.OpenPGP.Fingerprint (eightOctetKeyID, fingerprint) import Codec.Encryption.OpenPGP.Internal (issuer) import Codec.Encryption.OpenPGP.SignatureQualities (sigCT) import Codec.Encryption.OpenPGP.Types import Control.Lens ((^.), (^..), _1, folded) import Data.Data.Lens (biplate) import Data.Either (rights) import Data.Function (on) import qualified Data.HashMap.Lazy as HashMap import Data.IxSet.Typed (Indexable(..), ixFun, ixList) import Data.List (nub, sort) import qualified Data.Map as Map import Data.Semigroup (Semigroup, (<>)) import Data.Text (Text) instance Indexable KeyringIxs TK where indices = ixList (ixFun getEOKIs) (ixFun getTOFs) (ixFun getUIDs) getEOKIs :: TK -> [EightOctetKeyId] getEOKIs tk = rights (map eightOctetKeyID (tk ^.. biplate :: [PKPayload])) getTOFs :: TK -> [TwentyOctetFingerprint] getTOFs tk = map fingerprint (tk ^.. biplate :: [PKPayload]) getUIDs :: TK -> [Text] getUIDs tk = (tk ^. tkUIDs) ^.. folded . _1 instance Ord SignaturePayload where compare s1@(SigV3 st1 ct1 eoki1 pka1 ha1 left16_1 mpis1) s2@(SigV3 st2 ct2 eoki2 pka2 ha2 left16_2 mpis2) = compare ct1 ct2 <> compare st1 st2 <> compare eoki1 eoki2 -- FIXME: nondeterministic compare s1@(SigV4 st1 pka1 ha1 has1 uhas1 left16_1 mpis1) s2@(SigV4 st2 pka2 ha2 has2 uhas2 left16_2 mpis2) = compare (sigCT s1) (sigCT s2) <> compare st1 st2 <> compare (issuer (SignaturePkt s1)) (issuer (SignaturePkt s2)) -- FIXME: nondeterministic compare s1@(SigVOther sv1 bs1) s2@(SigVOther sv2 bs2) = compare sv1 sv2 <> compare bs1 bs2 compare SigV3 {} SigV4 {} = LT compare SigV3 {} SigVOther {} = LT compare SigV4 {} SigV3 {} = GT compare SigV4 {} SigVOther {} = LT compare SigVOther {} SigV3 {} = GT compare SigVOther {} SigV4 {} = GT instance Semigroup TK where (<>) a b = TK (_tkKey a) (nub . sort $ _tkRevs a ++ _tkRevs b) ((kvmerge `on` _tkUIDs) a b) ((kvmerge `on` _tkUAts) a b) ((ukvmerge `on` _tkSubs) a b) where kvmerge x y = Map.toList (Map.unionWith nsa (Map.fromList x) (Map.fromList y)) ukvmerge x y = HashMap.toList (HashMap.unionWith nsa (HashMap.fromList x) (HashMap.fromList y)) nsa x y = nub . sort $ x ++ y hOpenPGP-2.10.1/Data/Conduit/OpenPGP/Verify.hs0000644000000000000000000000272007346545000016733 0ustar0000000000000000-- Verify.hs: OpenPGP (RFC4880) signature verification -- Copyright © 2012-2016 Clint Adams -- This software is released under the terms of the Expat license. -- (See the LICENSE file). module Data.Conduit.OpenPGP.Verify ( conduitVerify ) where import Data.Conduit import Data.Time.Clock (UTCTime) import Codec.Encryption.OpenPGP.Internal (PktStreamContext(..), emptyPSC) import Codec.Encryption.OpenPGP.Signatures (verifyAgainstKeyring, verifySigWith) import Codec.Encryption.OpenPGP.Types import qualified Data.Conduit.List as CL conduitVerify :: Monad m => Keyring -> Maybe UTCTime -> ConduitT Pkt (Either String Verification) m () conduitVerify kr mt = CL.concatMapAccum (flip push) emptyPSC where push state ld@LiteralDataPkt {} = (state {lastLD = ld}, []) push state uid@(UserIdPkt _) = (state {lastUIDorUAt = uid}, []) push state uat@(UserAttributePkt _) = (state {lastUIDorUAt = uat}, []) push state pk@(PublicKeyPkt _) = (state {lastPrimaryKey = pk}, []) push state pk@(PublicSubkeyPkt _) = (state {lastSubkey = pk}, []) push state sk@(SecretKeyPkt _ _) = (state {lastPrimaryKey = sk}, []) push state sk@(SecretSubkeyPkt _ _) = (state {lastSubkey = sk}, []) push state sig@(SignaturePkt SigV4 {}) = ( state {lastSig = sig} , [verifySigWith (verifyAgainstKeyring kr) sig state mt]) push state (OnePassSignaturePkt _ _ _ _ _ False) = (state, []) push state _ = (state, []) normLineEndings = id -- FIXME hOpenPGP-2.10.1/LICENSE0000644000000000000000000000207607346545000012416 0ustar0000000000000000Copyright © 2012-2014 Clint Adams Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. hOpenPGP-2.10.1/Setup.hs0000644000000000000000000000005607346545000013041 0ustar0000000000000000import Distribution.Simple main = defaultMain hOpenPGP-2.10.1/bench/0000755000000000000000000000000007346545000012463 5ustar0000000000000000hOpenPGP-2.10.1/bench/mark.hs0000644000000000000000000000330007346545000013745 0ustar0000000000000000-- mark.hs: hOpenPGP benchmark suite -- Copyright © 2014-2018 Clint Adams -- This software is released under the terms of the Expat license. -- (See the LICENSE file). {-# LANGUAGE FlexibleContexts #-} import Criterion.Main import Codec.Encryption.OpenPGP.Signatures ( verifyAgainstKeyring , verifyAgainstKeys , verifySigWith , verifyTKWith ) import Data.Binary (get) import Data.Conduit.OpenPGP.Keyring (conduitToTKs, sinkKeyringMap) import Data.Conduit.Serialization.Binary (conduitGet) import qualified Data.IxSet.Typed as IxSet import qualified Data.Conduit as DC import qualified Data.Conduit.Binary as CB import qualified Data.Conduit.List as CL main :: IO () main = defaultMain [ bgroup "keyring" [ bench "load keys" $ whnfIO (loadKeys "tests/data/pubring.gpg") , bench "load keyring" $ whnfIO (loadKeyring "tests/data/pubring.gpg") , bench "self-verify keys" $ whnfIO (selfVerifyKeys "tests/data/pubring.gpg") , bench "self-verify keyring" $ whnfIO (selfVerifyKeyring "tests/data/pubring.gpg") ] ] where loadKeys fp = DC.runConduitRes $ CB.sourceFile fp DC..| conduitGet get DC..| conduitToTKs DC..| CL.consume loadKeyring fp = DC.runConduitRes $ CB.sourceFile fp DC..| conduitGet get DC..| conduitToTKs DC..| sinkKeyringMap selfVerifyKeys fp = fmap (\ks -> mapM (verifyTKWith (verifySigWith (verifyAgainstKeys ks)) Nothing) ks) (loadKeys fp) selfVerifyKeyring fp = fmap (\kr -> mapM (verifyTKWith (verifySigWith (verifyAgainstKeyring kr)) Nothing) (IxSet.toList kr)) (loadKeyring fp) hOpenPGP-2.10.1/hOpenPGP.cabal0000644000000000000000000002614207346545000014015 0ustar0000000000000000Cabal-version: 3.4 Name: hOpenPGP Version: 2.10.1 Synopsis: native Haskell implementation of OpenPGP (RFC4880) Description: native Haskell implementation of OpenPGP (RFC4880), plus Camellia (RFC5581), plus ECC (RFC6637) Homepage: https://salsa.debian.org/clint/hOpenPGP License: MIT License-file: LICENSE Author: Clint Adams Maintainer: Clint Adams Copyright: 2012-2025 Clint Adams Category: Codec, Data Build-type: Simple Extra-source-files: tests/suite.hs , tests/data/000001-006.public_key , tests/data/000002-013.user_id , tests/data/000003-002.sig , tests/data/000004-012.ring_trust , tests/data/000005-002.sig , tests/data/000006-012.ring_trust , tests/data/000007-002.sig , tests/data/000008-012.ring_trust , tests/data/000009-002.sig , tests/data/000010-012.ring_trust , tests/data/000011-002.sig , tests/data/000012-012.ring_trust , tests/data/000013-014.public_subkey , tests/data/000014-002.sig , tests/data/000015-012.ring_trust , tests/data/000016-006.public_key , tests/data/000017-002.sig , tests/data/000018-012.ring_trust , tests/data/000019-013.user_id , tests/data/000020-002.sig , tests/data/000021-012.ring_trust , tests/data/000022-002.sig , tests/data/000023-012.ring_trust , tests/data/000024-014.public_subkey , tests/data/000025-002.sig , tests/data/000026-012.ring_trust , tests/data/000027-006.public_key , tests/data/000028-002.sig , tests/data/000029-012.ring_trust , tests/data/000030-013.user_id , tests/data/000031-002.sig , tests/data/000032-012.ring_trust , tests/data/000033-002.sig , tests/data/000034-012.ring_trust , tests/data/000035-006.public_key , tests/data/000036-013.user_id , tests/data/000037-002.sig , tests/data/000038-012.ring_trust , tests/data/000039-002.sig , tests/data/000040-012.ring_trust , tests/data/000041-017.attribute , tests/data/000042-002.sig , tests/data/000043-012.ring_trust , tests/data/000044-014.public_subkey , tests/data/000045-002.sig , tests/data/000046-012.ring_trust , tests/data/000047-005.secret_key , tests/data/000048-013.user_id , tests/data/000049-002.sig , tests/data/000050-012.ring_trust , tests/data/000051-007.secret_subkey , tests/data/000052-002.sig , tests/data/000053-012.ring_trust , tests/data/000054-005.secret_key , tests/data/000055-002.sig , tests/data/000056-012.ring_trust , tests/data/000057-013.user_id , tests/data/000058-002.sig , tests/data/000059-012.ring_trust , tests/data/000060-007.secret_subkey , tests/data/000061-002.sig , tests/data/000062-012.ring_trust , tests/data/000063-005.secret_key , tests/data/000064-002.sig , tests/data/000065-012.ring_trust , tests/data/000066-013.user_id , tests/data/000067-002.sig , tests/data/000068-012.ring_trust , tests/data/000069-005.secret_key , tests/data/000070-013.user_id , tests/data/000071-002.sig , tests/data/000072-012.ring_trust , tests/data/000073-017.attribute , tests/data/000074-002.sig , tests/data/000075-012.ring_trust , tests/data/000076-007.secret_subkey , tests/data/000077-002.sig , tests/data/000078-012.ring_trust , tests/data/pubring.gpg , tests/data/secring.gpg , tests/data/compressedsig.gpg , tests/data/msg1.asc , tests/data/uncompressed-ops-rsa.gpg , tests/data/uncompressed-ops-dsa.gpg , tests/data/uncompressed-ops-dsa-sha384.txt.gpg , tests/data/encryption.gpg , tests/data/compressedsig-zlib.gpg , tests/data/compressedsig-bzip2.gpg , tests/data/onepass_sig , tests/data/simple.seckey , tests/data/minimized.gpg , tests/data/subkey.gpg , tests/data/signing-subkey.gpg , tests/data/uat.gpg , tests/data/prikey-rev.gpg , tests/data/subkey-rev.gpg , tests/data/6F87040E.pubkey , tests/data/6F87040E-cr.pubkey , tests/data/v3.key , tests/data/primary-binding.gpg , tests/data/pki-password.txt , tests/data/symmetric-password.txt , tests/data/encryption-sym-aes256-s2k0.gpg , tests/data/encryption-sym-aes128-s2k0.gpg , tests/data/encryption-sym-aes128.gpg , tests/data/encryption-sym-aes256.gpg , tests/data/encryption-sym-3des-s2k0.gpg , tests/data/encryption-sym-3des.gpg , tests/data/encryption-sym-aes192-s2k0.gpg , tests/data/encryption-sym-aes192.gpg , tests/data/encryption-sym-blowfish-s2k0.gpg , tests/data/encryption-sym-blowfish.gpg , tests/data/encryption-sym-twofish-s2k0.gpg , tests/data/encryption-sym-twofish.gpg , tests/data/encryption-sym-cast5-mdc-s2k0.gpg , tests/data/encryption-sym-cast5-mdc.gpg , tests/data/encryption-sym-blowfish-mdc-s2k0.gpg , tests/data/encryption-sym-blowfish-mdc.gpg , tests/data/encryption-sym-3des-mdc-s2k0.gpg , tests/data/encryption-sym-3des-mdc.gpg , tests/data/encryption-sym-cast5.gpg , tests/data/encryption-sym-cast5-s2k0.gpg , tests/data/encryption-sym-camellia128.gpg , tests/data/encryption-sym-camellia128-s2k0.gpg , tests/data/encryption-sym-camellia192.gpg , tests/data/encryption-sym-camellia256.gpg , tests/data/16bitcksum.seckey , tests/data/aes256-sha512.seckey , tests/data/unencrypted.seckey , tests/data/v3-genericcert.sig , tests/data/revoked.pubkey , tests/data/expired.pubkey , tests/data/sigs-with-regexes , tests/data/gnu-dummy-s2k-101-secret-key.gpg , tests/data/anibal-ed25519.gpg , tests/data/nist_p-256_key.gpg , tests/data/nist_p-256_secretkey.gpg , tests/data/ecdsa-key-without-ecdh.pubkey , tests/data/sample-eddsa.pubkey , tests/data/ed25519-without-curve25519.pubkey , tests/data/ed25519.pubkey , tests/data/ed25519.secretkey , tests/data/encryption-sym-pgcrypto.pgp , tests/data/pgcrypto-passphrase.txt common deps build-depends: aeson , attoparsec , base > 4.9 && < 5 , base16-bytestring , bifunctors , bytestring , binary >= 0.6.4.0 , binary-conduit >= 1.3 , bz2 , conduit >= 1.3.0 , conduit-extra >= 1.1 , containers , crypton , crypto-cipher-types , errors , hashable , incremental-parser >= 0.5.1 , ixset-typed , lens >= 3.0 , memory , monad-loops , nettle , network-uri >= 2.6 , prettyprinter >= 1.7.0 , resourcet > 0.4 , split , text , time >= 1.1 , time-locale-compat , transformers , unliftio-core , unordered-containers , zlib common publicmods other-modules: Codec.Encryption.OpenPGP.Types , Codec.Encryption.OpenPGP.CFB , Codec.Encryption.OpenPGP.Compression , Codec.Encryption.OpenPGP.Expirations , Codec.Encryption.OpenPGP.Fingerprint , Codec.Encryption.OpenPGP.KeyInfo , Codec.Encryption.OpenPGP.KeyringParser , Codec.Encryption.OpenPGP.KeySelection , Codec.Encryption.OpenPGP.Ontology , Codec.Encryption.OpenPGP.S2K , Codec.Encryption.OpenPGP.SecretKey , Codec.Encryption.OpenPGP.Serialize , Codec.Encryption.OpenPGP.Signatures , Codec.Encryption.OpenPGP.SignatureQualities , Data.Conduit.OpenPGP.Compression , Data.Conduit.OpenPGP.Decrypt , Data.Conduit.OpenPGP.Filter , Data.Conduit.OpenPGP.Keyring , Data.Conduit.OpenPGP.Keyring.Instances , Data.Conduit.OpenPGP.Verify common internalmods other-modules: Codec.Encryption.OpenPGP.Internal , Codec.Encryption.OpenPGP.Internal.CryptoCipherTypes , Codec.Encryption.OpenPGP.Internal.Crypton , Codec.Encryption.OpenPGP.Internal.HOBlockCipher , Codec.Encryption.OpenPGP.Types.Internal.Base , Codec.Encryption.OpenPGP.Types.Internal.CryptonNewtypes , Codec.Encryption.OpenPGP.Types.Internal.PKITypes , Codec.Encryption.OpenPGP.Types.Internal.PacketClass , Codec.Encryption.OpenPGP.Types.Internal.Pkt , Codec.Encryption.OpenPGP.Types.Internal.PrettyUtils , Codec.Encryption.OpenPGP.Types.Internal.TK , Codec.Encryption.OpenPGP.BlockCipher , Codec.Encryption.OpenPGP.SerializeForSigs , Paths_hOpenPGP autogen-modules: Paths_hOpenPGP Library import: deps, internalmods Exposed-modules: Codec.Encryption.OpenPGP.Types , Codec.Encryption.OpenPGP.CFB , Codec.Encryption.OpenPGP.Compression , Codec.Encryption.OpenPGP.Expirations , Codec.Encryption.OpenPGP.Fingerprint , Codec.Encryption.OpenPGP.KeyInfo , Codec.Encryption.OpenPGP.KeyringParser , Codec.Encryption.OpenPGP.KeySelection , Codec.Encryption.OpenPGP.Ontology , Codec.Encryption.OpenPGP.S2K , Codec.Encryption.OpenPGP.SecretKey , Codec.Encryption.OpenPGP.Serialize , Codec.Encryption.OpenPGP.Signatures , Codec.Encryption.OpenPGP.SignatureQualities , Codec.Encryption.OpenPGP.Version , Data.Conduit.OpenPGP.Compression , Data.Conduit.OpenPGP.Decrypt , Data.Conduit.OpenPGP.Filter , Data.Conduit.OpenPGP.Keyring , Data.Conduit.OpenPGP.Keyring.Instances , Data.Conduit.OpenPGP.Verify Build-depends: asn1-encoding , openpgp-asciiarmor >= 0.1 default-language: Haskell2010 Test-Suite tests import: deps, publicmods, internalmods type: exitcode-stdio-1.0 main-is: tests/suite.hs other-modules: Codec.Encryption.OpenPGP.Arbitrary Ghc-options: -Wall -with-rtsopts=-K1K Build-depends: hOpenPGP , tasty , tasty-hunit , tasty-quickcheck , QuickCheck > 2.9 , quickcheck-instances default-language: Haskell2010 Benchmark benchmark import: deps, publicmods, internalmods type: exitcode-stdio-1.0 main-is: bench/mark.hs Ghc-options: -Wall Build-depends: hOpenPGP , criterion > 0.8 default-language: Haskell2010 source-repository head type: git location: https://salsa.debian.org/clint/hOpenPGP.git source-repository this type: git location: https://salsa.debian.org/clint/hOpenPGP.git tag: v2.10.1 hOpenPGP-2.10.1/tests/data/0000755000000000000000000000000007346545000013457 5ustar0000000000000000hOpenPGP-2.10.1/tests/data/000001-006.public_key0000644000000000000000000000025307346545000016552 0ustar0000000000000000Ow$G4r㪼v#X5[r 6TlS) >꬙ߗGK )ϒYJJa"tuw?#4`h)PVs5U\v!J&lmI  VC4󠮀kcnT~hOpenPGP-2.10.1/tests/data/000003-002.sig0000644000000000000000000000016107346545000015202 0ustar0000000000000000o0OwITesting revsig ^#A2biBV#WY#-B>,[> $x yfu 38#hOpenPGP-2.10.1/tests/data/000004-012.ring_trust0000644000000000000000000000000407346545000016616 0ustar0000000000000000hOpenPGP-2.10.1/tests/data/000005-002.sig0000644000000000000000000000016107346545000015204 0ustar0000000000000000o0OwIDtesting revsig ^#A2b>+ #1ѽ^Qmz6!$W+6+TQeL[3Gl/hOpenPGP-2.10.1/tests/data/000006-012.ring_trust0000644000000000000000000000000407346545000016620 0ustar0000000000000000hOpenPGP-2.10.1/tests/data/000007-002.sig0000644000000000000000000000033407346545000015210 0ustar0000000000000000(Ow$ π   No=8 \-97Ed;|̙j%`9^a M~U3pѰuhxᶱ[WkSfB)C3 %C ]h,x-fɗI Q]-liuCa$`ml5e1ΥnhOpenPGP-2.10.1/tests/data/000008-012.ring_trust0000644000000000000000000000000407346545000016622 0ustar0000000000000000hOpenPGP-2.10.1/tests/data/000009-002.sig0000644000000000000000000000023607346545000015213 0ustar0000000000000000OwHw >hm´#pBjH t_%*Y/V;k.Yy7%;z(Pvn*_7JD+&*,il)c Y3n]U}aD|"[N#ahOpenPGP-2.10.1/tests/data/000010-012.ring_trust0000644000000000000000000000000407346545000016613 0ustar0000000000000000hOpenPGP-2.10.1/tests/data/000011-002.sig0000644000000000000000000000014007346545000015176 0ustar0000000000000000^OwI5 ^#A2bQ>&P{k-aعl nqaѡ0!Y꾹gkv0HjhOpenPGP-2.10.1/tests/data/000012-012.ring_trust0000644000000000000000000000000407346545000016615 0ustar0000000000000000hOpenPGP-2.10.1/tests/data/000013-014.public_subkey0000644000000000000000000000025307346545000017266 0ustar0000000000000000Ow$ພo# \X" l9Nv`x]pBA hzSX[s'S4~#{T V`;~ 'o]3U.-Psڮ>S}%Nbx%9mˣ^l":C*=hOpenPGP-2.10.1/tests/data/000014-002.sig0000644000000000000000000000030307346545000015202 0ustar0000000000000000Ow$  π No9R \R^mNʖlysQ%x=ӿbG"lf!%F*w͎gL#!^_ql5qWe/< 0k)sL34ʺmEy$éH#TP.f\w=j4akhOpenPGP-2.10.1/tests/data/000015-012.ring_trust0000644000000000000000000000000407346545000016620 0ustar0000000000000000hOpenPGP-2.10.1/tests/data/000016-006.public_key0000644000000000000000000000226107346545000016561 0ustar0000000000000000Ow m] yayT*p}GLE!SH)䃉4ŷQ,lŖF!b 4ދj;R  4<ްoz})Q6\R2y俓ܣ%}U|n;[ m @t9N\ߊW 4d*\ #KP E6)R߶l#0ӚBD`^.{{m#}gGV+ 6!b7Fa'Y J-`L4cWM9[E}U+0'3/HKfxpΞ{E*DQ:j oB&mK&_ S2B_"#0NEuFrV5m`sm렖}X4/H R-;548[,_zk\6"WLR ׁ*PieK6d*e5ͰF2HƩm&ވ0MO3e*5<*hp;gv-SIJZ8xRaZܗQDY,css9AO5 `]BQayl9J r t7sKamK . eDH Dqœ;B=zDky[dwz-ůnga5uTjgat̑LL]hOpenPGP-2.10.1/tests/data/000017-002.sig0000644000000000000000000000017307346545000015212 0ustar0000000000000000y!OwJ  /Z\þw2Ϙc ^#A2b& bta=0)Ҷ?9pɼRORͤ[L]ڳ,}pcï-`+LѰhOpenPGP-2.10.1/tests/data/000018-012.ring_trust0000644000000000000000000000000407346545000016623 0ustar0000000000000000hOpenPGP-2.10.1/tests/data/000019-013.user_id0000644000000000000000000000004607346545000016065 0ustar0000000000000000$Test Key (DSA) hOpenPGP-2.10.1/tests/data/000020-002.sig0000644000000000000000000000020207346545000015175 0ustar0000000000000000(Ow    ^#A2bܯgi\Q$`;! 873?wNj*rK%% Aý~uhOpenPGP-2.10.1/tests/data/000021-012.ring_trust0000644000000000000000000000000407346545000016615 0ustar0000000000000000hOpenPGP-2.10.1/tests/data/000022-002.sig0000644000000000000000000000027207346545000015206 0ustar0000000000000000OwH4 NowMy/]GYjZU8{Sc!Q'VJ""[zT|ĽX]`qdD+Ւ !BwR'+iDm@ (ǘQصf.^3mw8P*}(Qwrdx')mqVP2g wa mG >\$B6C;i^4RhOpenPGP-2.10.1/tests/data/000025-002.sig0000644000000000000000000000015107346545000015205 0ustar0000000000000000gOw   ^#A2b)$[OX`J`6\I[o?u<wGkt˨\A]gM^"߶/HhOpenPGP-2.10.1/tests/data/000026-012.ring_trust0000644000000000000000000000000407346545000016622 0ustar0000000000000000hOpenPGP-2.10.1/tests/data/000027-006.public_key0000644000000000000000000000064507346545000016567 0ustar0000000000000000Ow3!$}9 W̳us<,?#/ `N["cgU[In?60tw&U8j,K|7[Cb|p6.oaV1aS"oՍ)6W.=='%WgDڤDAmiԚr8h>$B/'tMZ ַk(Txg^;?Q#׻HD?HgQW-i|rKHA B,GO>G9ٓfp',6n?טYT/ ?XvT:`p/y){0ϜFw7νyV_3v }yNi[͙\zC?9A$YhOpenPGP-2.10.1/tests/data/000028-002.sig0000644000000000000000000000014307346545000015211 0ustar0000000000000000a!OwJ y3EY >hm w2ϘcnA_-]joyp&e2r ؠXhOpenPGP-2.10.1/tests/data/000029-012.ring_trust0000644000000000000000000000000407346545000016625 0ustar0000000000000000hOpenPGP-2.10.1/tests/data/000030-013.user_id0000644000000000000000000000005507346545000016056 0ustar0000000000000000+Test Key (DSA sign-only) hOpenPGP-2.10.1/tests/data/000031-002.sig0000644000000000000000000000020407346545000015201 0ustar0000000000000000B   OwItesting@notation w2Ϙcꆸ-&iDš$)`Sg<hOpenPGP-2.10.1/tests/data/000032-012.ring_trust0000644000000000000000000000000407346545000016617 0ustar0000000000000000hOpenPGP-2.10.1/tests/data/000033-002.sig0000644000000000000000000000014007346545000015202 0ustar0000000000000000^OwHT ^#A2b0$LM ɑ(;濂X/t+2f]9"W=O!}co*(:UhOpenPGP-2.10.1/tests/data/000034-012.ring_trust0000644000000000000000000000000407346545000016621 0ustar0000000000000000hOpenPGP-2.10.1/tests/data/000035-006.public_key0000644000000000000000000000021707346545000016561 0ustar0000000000000000Ow!ž%Jo_-0=!t֤70#M\d&KnHyI Qm PG;RLjF!"N$9t98wvW"I%/̈LNСz Ny hOpenPGP-2.10.1/tests/data/000036-013.user_id0000644000000000000000000000006007346545000016060 0ustar0000000000000000.Test Key (RSA sign-only) hOpenPGP-2.10.1/tests/data/000037-002.sig0000644000000000000000000000030007346545000015204 0ustar0000000000000000(Ow! hmAD&5Ԝjmg^y]bnKA;x˲BT[DwQ%2rwEB b;ʴY;n@%̓fZ~qᏦ8ۋjxUB*__N~v׏qk#ĸ*:` `†?'FJt)n:StƢ5Nllj::^61 6NB |]\Idg=TD@VTDŽ?S֤~O?Z{tf¢uU9uRąCH 9A̭ă_]N)0Tuڞ\_Z|Q_O>t|Tp7 ۏq@ L_mMQCQb_$$((`_Up Taohqe3d"kH& LVO"=7*R(q7JJ!q{yE+"1Rf#ĥK JE@Mԑs:\>;QZېs 6= 28`zޭXRxY;w$$-Lş6KITAQFʧ5=4 (6{ e]`"YmXqu4rj2\YFJB tB6ꞡjrTit0BUtsȹ~;v;^qRQ5->o!IH! M4vn f"d\\SfJB/S/$=RA~ܲfiuErYtw!@ ˂>NU{pVQUee R%7Zl1㟞*liuovo|c{["*QrߓC@1'ZA~mf˶<'pL؋p$Hh* %@$ň#j۲UD6ֶ$$n4hګ VTs@39yF5YN!Ч\[FuqtVorF~Q1LhS.ڊMqt ?sFoUS$3tupѧSȆE- 6ZĤ8LzjQ,_B]BIQDs4hMLOs3>d3kpS(?71<\S~8ԾNKTw@āv-NcP'S ̑][`T \ƦKOҢTT\((*$H!FXm'2` G)&cW4aKMqlE3ٲ( uАQL\Jo_~ +­Dx:sTj_hOpenPGP-2.10.1/tests/data/000042-002.sig0000644000000000000000000000030007346545000015200 0ustar0000000000000000(OwL hmdi!Սyǜ+d1A(}=M4 BvSu [TXq, %f8o; m *At'|Fg0]%]%yޡ UVC~d:+5 uhOpenPGP-2.10.1/tests/data/000043-012.ring_trust0000644000000000000000000000000407346545000016621 0ustar0000000000000000hOpenPGP-2.10.1/tests/data/000044-014.public_subkey0000644000000000000000000000042007346545000017266 0ustar0000000000000000 OwJGgC!_ZGk렂=KsxH-!*nLvXFw|#W,l;qfO^>3(@ 8hm߰yb)Qx0+G7ld:`c/ ~ڶTG̔Cr=0n~83aQ_zIN\|Sa8e`dqr#dW>}P끩hOpenPGP-2.10.1/tests/data/000046-012.ring_trust0000644000000000000000000000000407346545000016624 0ustar0000000000000000hOpenPGP-2.10.1/tests/data/000047-005.secret_key0000644000000000000000000000114207346545000016570 0ustar0000000000000000_Ow$G4r㪼v#X5[r 6TlS) >꬙ߗGK )ϒYJJa"tuw?#4`h)PVs5U\v!J&lmI  VC4󠮀kcnT~mW3W%O:`X~8%d\ٺ§'hOpenPGP-2.10.1/tests/data/000048-013.user_id0000644000000000000000000000004607346545000016067 0ustar0000000000000000$Test Key (RSA) hOpenPGP-2.10.1/tests/data/000049-002.sig0000644000000000000000000000033407346545000015216 0ustar0000000000000000(Ow$ π   No=8 \-97Ed;|̙j%`9^a M~U3pѰuhxᶱ[WkSfB)C3 %C ]h,x-fɗI Q]-liuCa$`ml5e1ΥnhOpenPGP-2.10.1/tests/data/000050-012.ring_trust0000644000000000000000000000000407346545000016617 0ustar0000000000000000hOpenPGP-2.10.1/tests/data/000051-007.secret_subkey0000644000000000000000000000114307346545000017300 0ustar0000000000000000`Ow$ພo# \X" l9Nv`x]pBA hzSX[s'S4~#{T V`;~ 'o]3U.-Psڮ>S}%Nbx%9mˣ^l":C*=emGM`A]Q$VamQX&nySRw!+ˑk^IW!4HX`5yKh4nQ?ՙthSM]$f/\Ts,FJwJ^Il2k0!xU;/̶̪a}>F7AL}ΚtP6n|iqq«VWzjkv-iV $=d/B9KʋTp%a *' : r$4* @OM2Whu}Va v< YG="ӱRf Q/swn 7 ưUl4ߕ,jLv)DÎyhl4YhOpenPGP-2.10.1/tests/data/000052-002.sig0000644000000000000000000000030307346545000015204 0ustar0000000000000000Ow$  π No9R \R^mNʖlysQ%x=ӿbG"lf!%F*w͎gL#!^_ql5qWe/< 0k)sL34ʺmEy$éH#TP.f\w=j4akhOpenPGP-2.10.1/tests/data/000053-012.ring_trust0000644000000000000000000000000407346545000016622 0ustar0000000000000000hOpenPGP-2.10.1/tests/data/000054-005.secret_key0000644000000000000000000000237307346545000016575 0ustar0000000000000000Ow m] yayT*p}GLE!SH)䃉4ŷQ,lŖF!b 4ދj;R  4<ްoz})Q6\R2y俓ܣ%}U|n;[ m @t9N\ߊW 4d*\ #KP E6)R߶l#0ӚBD`^.{{m#}gGV+ 6!b7Fa'Y J-`L4cWM9[E}U+0'3/HKfxpΞ{E*DQ:j oB&mK&_ S2B_"#0NEuFrV5m`sm렖}X4/H R-;548[,_zk\6"WLR ׁ*PieK6d*e5ͰF2HƩm&ވ0MO3e*5<*hp;gv-SIJZ8xRaZܗQDY,css9AO5 `]BQayl9J r t7sKamK . eDH Dqœ;B=zDky[dwz-ůnga5uTjgat̑LL]gׁ`vE%nOqaWqrn!`i}lw!B&{b]+GQ hOpenPGP-2.10.1/tests/data/000055-002.sig0000644000000000000000000000017307346545000015214 0ustar0000000000000000y!OwJ  /Z\þw2Ϙc ^#A2b& bta=0)Ҷ?9pɼRORͤ[L]ڳ,}pcï-`+LѰhOpenPGP-2.10.1/tests/data/000056-012.ring_trust0000644000000000000000000000000407346545000016625 0ustar0000000000000000hOpenPGP-2.10.1/tests/data/000057-013.user_id0000644000000000000000000000004607346545000016067 0ustar0000000000000000$Test Key (DSA) hOpenPGP-2.10.1/tests/data/000058-002.sig0000644000000000000000000000020207346545000015210 0ustar0000000000000000(Ow    ^#A2bܯgi\Q$`;! 873?wNj*rK%% Aý~uhOpenPGP-2.10.1/tests/data/000059-012.ring_trust0000644000000000000000000000000407346545000016630 0ustar0000000000000000hOpenPGP-2.10.1/tests/data/000060-007.secret_subkey0000644000000000000000000000127207346545000017303 0ustar0000000000000000Ow @7la Ua?a`K䠳q{Ü@H2{'2i0  D+=6h8k]NmY\}]X+%T|T̠ =%VubD;^`钘/hĢfFj㬒vA$_,G]aNz5ͽ w?

(ǘQصf.^3mw8P*}(Qwrdx')mqVP2g wa mG >\$B6C;i^4Rgׁ`A0ʭerT$fJ{y!TM{2XIסtWaʞ+hOpenPGP-2.10.1/tests/data/000061-002.sig0000644000000000000000000000015007346545000015204 0ustar0000000000000000fOw   ^#A2b)$ ::y!cƋI3b;@{S?bSZV9ިPMhOpenPGP-2.10.1/tests/data/000062-012.ring_trust0000644000000000000000000000000407346545000016622 0ustar0000000000000000hOpenPGP-2.10.1/tests/data/000063-005.secret_key0000644000000000000000000000074407346545000016575 0ustar0000000000000000Ow3!$}9 W̳us<,?#/ `N["cgU[In?60tw&U8j,K|7[Cb|p6.oaV1aS"oՍ)6W.=='%WgDڤDAmiԚr8h>$B/'tMZ ַk(Txg^;?Q#׻HD?HgQW-i|rKHA B,GO>G9ٓfp',6n?טYT/ ?XvT:`p/y){0ϜFw7νyV_3v }yNi[͙\zC?9A$YZ".ܵh``(S -lNwF5B`l m)hOpenPGP-2.10.1/tests/data/000064-002.sig0000644000000000000000000000014307346545000015211 0ustar0000000000000000a!OwJ y3EY >hm w2ϘcnA_-]joyp&e2r ؠXhOpenPGP-2.10.1/tests/data/000065-012.ring_trust0000644000000000000000000000000407346545000016625 0ustar0000000000000000hOpenPGP-2.10.1/tests/data/000066-013.user_id0000644000000000000000000000005507346545000016067 0ustar0000000000000000+Test Key (DSA sign-only) hOpenPGP-2.10.1/tests/data/000067-002.sig0000644000000000000000000000015207346545000015214 0ustar0000000000000000h(Ow    w2ϘczHm5YDBT!.ADs48$Q9H>jhOpenPGP-2.10.1/tests/data/000068-012.ring_trust0000644000000000000000000000000407346545000016630 0ustar0000000000000000hOpenPGP-2.10.1/tests/data/000069-005.secret_key0000644000000000000000000000100107346545000016566 0ustar0000000000000000Ow!ž%Jo_-0=!t֤70#M\d&KnHyI Qm PG;RLjF!"N$9t98wvW"I%/̈LNСz Ny  WA/`++oXbN,9KpPwR,l&p<ǻ\n>+;I Sl Xr Ju#ʶK&Λ_o7HBߙAzHkWp`4dl LJ"`H.lۏ'O4]4,X3܉O'q)u]hhHi'KI>1/L,ڀT R6Z7VA,,&|yrXh,@@D:7k=0sD2އFcOq~8gU;[U 4AT}G J6>?9by$(A\vծ:Qe`0*(hOpenPGP-2.10.1/tests/data/000070-013.user_id0000644000000000000000000000006007346545000016056 0ustar0000000000000000.Test Key (RSA sign-only) hOpenPGP-2.10.1/tests/data/000071-002.sig0000644000000000000000000000030007346545000015202 0ustar0000000000000000(Ow! hmAD&5Ԝjmg^y]bnKA;x˲BT[DwQ%2rwEB b;ʴY;n@%̓fZ~qᏦ8ۋjxUB*__N~v׏qk#ĸ*:` `†?'FJt)n:StƢ5Nllj::^61 6NB |]\Idg=TD@VTDŽ?S֤~O?Z{tf¢uU9uRąCH 9A̭ă_]N)0Tuڞ\_Z|Q_O>t|Tp7 ۏq@ L_mMQCQb_$$((`_Up Taohqe3d"kH& LVO"=7*R(q7JJ!q{yE+"1Rf#ĥK JE@Mԑs:\>;QZېs 6= 28`zޭXRxY;w$$-Lş6KITAQFʧ5=4 (6{ e]`"YmXqu4rj2\YFJB tB6ꞡjrTit0BUtsȹ~;v;^qRQ5->o!IH! M4vn f"d\\SfJB/S/$=RA~ܲfiuErYtw!@ ˂>NU{pVQUee R%7Zl1㟞*liuovo|c{["*QrߓC@1'ZA~mf˶<'pL؋p$Hh* %@$ň#j۲UD6ֶ$$n4hګ VTs@39yF5YN!Ч\[FuqtVorF~Q1LhS.ڊMqt ?sFoUS$3tupѧSȆE- 6ZĤ8LzjQ,_B]BIQDs4hMLOs3>d3kpS(?71<\S~8ԾNKTw@āv-NcP'S ̑][`T \ƦKOҢTT\((*$H!FXm'2` G)&cW4aKMqlE3ٲ( uАQL\Jo_~ +­Dx:sTj_hOpenPGP-2.10.1/tests/data/000074-002.sig0000644000000000000000000000030007346545000015205 0ustar0000000000000000(OwL hmdi!Սyǜ+d1A(}=M4 BvSu [TXq, %f8o; m *At'|Fg0]%]%yޡ UVC~d:+5 uhOpenPGP-2.10.1/tests/data/000075-012.ring_trust0000644000000000000000000000000407346545000016626 0ustar0000000000000000hOpenPGP-2.10.1/tests/data/000076-007.secret_subkey0000644000000000000000000000170107346545000017307 0ustar0000000000000000OwJGgC!_ZGk렂=KsxH-!*nLvXFw|#W,l;qfO^>3(@ 8A ̇کv4'gb2R!e.}񀙱ltM?E-]5ds1\Z7_MեZC)'MB4gȇIİLJ3JX< |4NW~AG}5[BaCrj/"͒u6 t=pjZ}Eh2:ZN<NcIVPDaP6Sd ׶P(sQ+'Jy!ڿ`{? bh5׽ OaD\2Vޖtr#'dWB_'<{ O,L , hd(&%/{3F){٬m5_YStuCCb̐hOpenPGP-2.10.1/tests/data/000077-002.sig0000644000000000000000000000024107346545000015214 0ustar0000000000000000 OwJ >hm߰yb)Qx0+G7ld:`c/ ~ڶTG̔Cr=0n~83aQ_zIN\|Sa8e`dqr#dW>}P끩hOpenPGP-2.10.1/tests/data/000078-012.ring_trust0000644000000000000000000000000407346545000016631 0ustar0000000000000000hOpenPGP-2.10.1/tests/data/16bitcksum.seckey0000644000000000000000000000152607346545000016660 0ustar0000000000000000MOw$G4r㪼v#X5[r 6TlS) >꬙ߗGK )ϒYJJa"tuw?#4`h)PVs5U\v!J&lmI  VC4󠮀kcnT~"w)So%cܵw @p m63"ّ 9f32o;e`S(wˢnù(Ow$ π   No=8 \-97Ed;|̙j%`9^a M~U3pѰuhxᶱ[WkSfB)C3 %C ]h,x-fɗI Q]-liuCa$`ml5e1ΥnhOpenPGP-2.10.1/tests/data/6F87040E-cr.pubkey0000644000000000000000000000161507346545000016270 0ustar0000000000000000Ow$G4r㪼v#X5[r 6TlS) >꬙ߗGK )ϒYJJa"tuw?#4`h)PVs5U\v!J&lmI  VC4󠮀kcnT~o0OwITesting revsig ^#A2biBV#WY#-B>,[> $x yfu 38#o0OwIDtesting revsig ^#A2b>+ #1ѽ^Qmz6!$W+6+TQeL[3Gl/(Ow$ π   No=8 \-97Ed;|̙j%`9^a M~U3pѰuhxᶱ[WkSfB)C3 %C ]h,x-fɗI Q]-liuCa$`ml5e1ΥnOwHw >hm´#pBjH t_%*Y/V;k.Yy7%;z(Pvn*_7JD+&*,il)c Y3n]U}aD|"[N#a^OwI5 ^#A2bQ>&P{k-aعl nqaѡ0!Y꾹gkv0HjhOpenPGP-2.10.1/tests/data/6F87040E.pubkey0000644000000000000000000000125307346545000015664 0ustar0000000000000000Ow$G4r㪼v#X5[r 6TlS) >꬙ߗGK )ϒYJJa"tuw?#4`h)PVs5U\v!J&lmI  VC4󠮀kcnT~(Ow$ π   No=8 \-97Ed;|̙j%`9^a M~U3pѰuhxᶱ[WkSfB)C3 %C ]h,x-fɗI Q]-liuCa$`ml5e1ΥnOwHw >hm´#pBjH t_%*Y/V;k.Yy7%;z(Pvn*_7JD+&*,il)c Y3n]U}aD|"[N#a^OwI5 ^#A2bQ>&P{k-aعl nqaѡ0!Y꾹gkv0HjhOpenPGP-2.10.1/tests/data/aes256-sha512.seckey0000644000000000000000000000156007346545000016674 0ustar0000000000000000gOw$G4r㪼v#X5[r 6TlS) >꬙ߗGK )ϒYJJa"tuw?#4`h)PVs5U\v!J&lmI  VC4󠮀kcnT~;ʹ jaVGvKޤa4CL0TyʝeL Tv1ꨃ`lumQo6ĈI~$iPsαAtz$1k:OQ-b  *YJ М1]fMȻ`r~ ڜd68џղKc77 gGݬ(s,Y YrO-FQ cE)RYgAڌhy8ܞ4Q!,t؝6(de(A=z(M\ tKjTtS i;h FSeZT5 . o6j(JpЍ }Z8])zyGsc8b'}Lc jq_X gW>(ڃ$Test Key (RSA) (Ow$ π   No=8 \-97Ed;|̙j%`9^a M~U3pѰuhxᶱ[WkSfB)C3 %C ]h,x-fɗI Q]-liuCa$`ml5e1ΥnhOpenPGP-2.10.1/tests/data/anibal-ed25519.gpg0000644000000000000000000000060507346545000016401 0ustar00000000000000003Uſ +G@ޒnT0_ Yx́h7`+Anibal Monsalve Salazar y !Uſ    )@s^ =?fNK"q "!؆Mt0kA!&I-9lDx#sfc{+Anibal Monsalve Salazar y !Uſ    )@s^ Ny/}j/_lOiJ?(EE"V-;:qcbUhOpenPGP-2.10.1/tests/data/compressedsig-bzip2.gpg0000644000000000000000000000067207346545000020056 0ustar0000000000000000BZh61AY&SYVmns{E"ZPf(1ŷKU0LTѴFL4`Li 1CL H`ISzHt20M0`G00TD= dFFOHd4i4 cD$HAP%~":(X;.;)6Lތ̖jH0D>ḽO&BD`;M*E8 nfoeuueFdYz Y#K,H.B4hNf'0 Jg~PIr#{,RHUG#/G:[~WkUY, #JٷDp"#e'"(H+67hOpenPGP-2.10.1/tests/data/compressedsig-zlib.gpg0000644000000000000000000000050207346545000017760 0ustar0000000000000000xxv>5IU9Iz%%dd+Qz~f^BIBRBqfz^jBb^Bnr~nAQjq1P,3$1O!?'E7-(7D 19;D<$$SW\ T^ձ d%=1,/D]=ûu!n;,TlﯞC+Z4]кX]y/52zbQC^/XAmS$cj}ȏ%=ل)Բ(~`Rͧ~@NTnN5IE%9z%%! @PPPZ_[PKSI&($&g(gddJ R32sRK2:v00212e,\?oMbbJ?+&=K査ŭw=ySOUj9gCVb뷭Z2)vnH ޥ8M 3Ϛ՞J?:Z8]"#ӧ>]H1uMWo wQ?uug~CeJnbhOpenPGP-2.10.1/tests/data/ecdsa-key-without-ecdh.pubkey0000644000000000000000000000040207346545000021143 0ustar0000000000000000ROwM<*H=m-a&"4PkW Uvp;P!E쇷`RKO2dwpD)s+Test Key (NIST P-256) 'OwM< f   p2$6t1;$,ߴ k<~nr~¢MҶ>Z %edghOpenPGP-2.10.1/tests/data/ed25519-without-curve25519.pubkey0000644000000000000000000000034307346545000021127 0ustar00000000000000003OwMg +G@TȄ|QGh<},oF0S=E+Test Key (Curve25519) 'OwMg f   _`YnÔU4PQ&|& Wi̱UF{H/tЄz[hM hOpenPGP-2.10.1/tests/data/ed25519.pubkey0000644000000000000000000000060607346545000015700 0ustar00000000000000003OwMg +G@TȄ|QGh<},oF0S=E+Test Key (Curve25519) 'OwMg f   _`YnÔU4PQ&|& Wi̱UF{H/tЄz[hM 8OwMg +U@i Uyus*9% o<=w-gOwMg  f _`Y"vPU2?zA{P='$?OJavA90s۠/@hOpenPGP-2.10.1/tests/data/ed25519.secretkey0000644000000000000000000000105407346545000016375 0ustar0000000000000000OwMg +G@TȄ|QGh<},oF0S=ECֱT\<~W6*YK\ %M8a\'OwMg f   _`YnÔU4PQ&|& Wi̱UF{H/tЄz[hM OwMg +U@i Uyus*9% o<=w-Z"Kl$')>_J!~)yVi^@YG0F$DžG7m]8הs3YuɈgOwMg  f _`Y"vPU2?zA{P='$?OJavA90s۠/@hOpenPGP-2.10.1/tests/data/encryption-sym-3des-mdc-s2k0.gpg0000644000000000000000000000010307346545000021322 0ustar0000000000000000;zc^ȳEƌE%A^/JS EG~٬yn>ۼv;hOpenPGP-2.10.1/tests/data/encryption-sym-3des-mdc.gpg0000644000000000000000000000011407346545000020547 0ustar0000000000000000 R_(`; =]o7FJ2-O">_1"Lg <ݸ )"e0 _!ݻ CNx)hOpenPGP-2.10.1/tests/data/encryption-sym-3des-s2k0.gpg0000644000000000000000000000005407346545000020566 0ustar0000000000000000$3˕,A^a[#cGI\hOpenPGP-2.10.1/tests/data/encryption-sym-3des.gpg0000644000000000000000000000006507346545000020013 0ustar0000000000000000 H-Z%`$ל{; }:rvf2oLx coJrulh{3lhOpenPGP-2.10.1/tests/data/encryption-sym-aes256-s2k0.gpg0000644000000000000000000000010207346545000020727 0ustar0000000000000000 :'.-D2tl"kVBdty(f}E;| hOpenPGP-2.10.1/tests/data/encryption-sym-aes256.gpg0000644000000000000000000000011307346545000020154 0ustar0000000000000000  ZC(`:pdT3 Ll6~d5-}Sp~=/Nt+FOh8֢hOpenPGP-2.10.1/tests/data/encryption-sym-blowfish-mdc-s2k0.gpg0000644000000000000000000000010307346545000022301 0ustar0000000000000000;99ayO%d.E M˳D='D!3hOpenPGP-2.10.1/tests/data/encryption-sym-blowfish-mdc.gpg0000644000000000000000000000011407346545000021526 0ustar0000000000000000 K`;PRtW,!mp ɄX_TsdzH8*Z^Xccݟd17Gqr hOpenPGP-2.10.1/tests/data/encryption-sym-blowfish-s2k0.gpg0000644000000000000000000000005407346545000021545 0ustar0000000000000000$ćEe(U@3jl0mUp phOpenPGP-2.10.1/tests/data/encryption-sym-blowfish.gpg0000644000000000000000000000006507346545000020772 0ustar0000000000000000 3wR+`$.X(ē"+}Q跗mק:Mw_hOpenPGP-2.10.1/tests/data/encryption-sym-camellia128-s2k0.gpg0000644000000000000000000000010607346545000021730 0ustar0000000000000000 >E)%NSRA9%pʤ%J_bB\z3߃'ͧ-`Dzp|,ҳ%؂hOpenPGP-2.10.1/tests/data/encryption-sym-camellia128.gpg0000644000000000000000000000011707346545000021155 0ustar0000000000000000   e°*`>z6ŭ0_C$:8RA58TMGN9hOpenPGP-2.10.1/tests/data/encryption-sym-camellia192.gpg0000644000000000000000000000011707346545000021156 0ustar0000000000000000   fS `>j1ZHW{1ҾĽFA$r2q l1+GSCY0t 3Fwi:hOpenPGP-2.10.1/tests/data/encryption-sym-camellia256.gpg0000644000000000000000000000011707346545000021157 0ustar0000000000000000   ek?`>_uO:I5HTor%Dy9K\ao)v%Gv{ ahOpenPGP-2.10.1/tests/data/encryption-sym-cast5-mdc-s2k0.gpg0000644000000000000000000000010307346545000021503 0ustar0000000000000000;7DmsΈɘXHAF O2O*QBtrᄠxF:`]hOpenPGP-2.10.1/tests/data/encryption-sym-cast5-mdc.gpg0000644000000000000000000000011407346545000020730 0ustar0000000000000000 HwԒX`;enu-7P :dDYoB%L!MX5!J_{LȷhOpenPGP-2.10.1/tests/data/encryption-sym-cast5-s2k0.gpg0000644000000000000000000000004307346545000020745 0ustar0000000000000000䞴;K<֭E'hOpenPGP-2.10.1/tests/data/encryption-sym-cast5.gpg0000644000000000000000000000005407346545000020172 0ustar0000000000000000 m]`ڗy2@nf<;ʪF`ODhOpenPGP-2.10.1/tests/data/encryption-sym-pgcrypto.pgp0000644000000000000000000000011607346545000021032 0ustar0000000000000000  ZvWi=CҲ|l+(TƉ+U.M%E4Y7nSrGpZ hOpenPGP-2.10.1/tests/data/encryption-sym-twofish-s2k0.gpg0000644000000000000000000000011307346545000021407 0ustar0000000000000000 Cė"D%: ]@7 E72&9v41;] ِtXIjqdɘEkUfshOpenPGP-2.10.1/tests/data/encryption-sym-twofish.gpg0000644000000000000000000000012407346545000020634 0ustar0000000000000000  ӻ"`C_–'3:=8HlY*-I4y%ss]!̾+q?3hOpenPGP-2.10.1/tests/data/encryption.gpg0000644000000000000000000000153407346545000016353 0ustar0000000000000000^.$92 ="TRxB`]3gܽ:QGHh9y#o +qWG\{Pj17ƃ@m. ˎrC~9fq8BpC5vV*݌B? ts~FE wέ\Y<:ʙ=X1\Z[7BBb\ W+x bNy<oO=rɐE) îWw;gSo'   J ^eGPG ~*]*6- F;+rYlQpC{腵en!Micah Anderson o'   J ^eGPG ~*]*|J0~Ȏ.t9-Ngl8U2$Micah Anderson l$   J ^eGPG ~*]*8?#î~vg @zZҡp~w.(p'Micah Johan Anderson d$   J ^ ~*]*Oy `o8VkK'(oM .ͺUO<3Æ1Micah Anderson (no comment) l$   J ^eGPG ~*]**mu{'%p{U=  H"౤M\GR |N;\oEΦa&ߋwb8?ŦcsYV-BЁrr~sJd) lc#u+~-X{LYL)"lKI G ~*]*;la!xQ/%@HtF1zwV!^D?X(Hƻsmartcard broke ~*]*{8>6Cmȅi؋?+8 WΉnhGR%Oio Zlne\ =Ii[BIaم4,ήX I ;(!O+HШ&-Ydӻ#>yFϏ'JmnI G ~*]*bRˎrKȚiڣ>[ HE!˜QY/X(Hƻwsmartcard broke ~*]* vFdY@@>T?L)~B+c'GIQ5> 6F3?mW/%"H<춰=(V )X vnA<{Y≔ffi{^=cT`S!,FкGhrm*X"|g's_xI GI ~*]*pT6QUu:mv +}q~%cZ(HAopenpgp key broke ~*]* .*KU53m.yӿykߩʉ\Da HP5 !t<xn Qj~3to #c7 2!_(?9  7+IP;tjsO+R(7jr:j\0`e6Dﶢh 䎛c]I HP5 ~*]*k8 zAA#!Gj7Pu:j-'X(Hksmartcard broke ~*]* c^s&1Gbk1e yöe UָGaC"ǩy\hӦXDk4XZR$Ol}&tܵHεž/HVpvܷquf do#J&%v OT7fv?HR_* }I G ~*]*a4l_QW(.CX5;1Z9umX(H&smartcard broke ~*]*FX4W^sY~ a.:% BOΛt| a=B%\ $7,,;?}BEUW-'ͥ+ O1w SOr(2H+Replaced subkey due to smartcard breakage ~*]*LX_rsI1?XGIyê/ M6zU/k[o2$Ů俐hW ܫ6cZˤ}b8vCyRRT7`zRFBzDW24*JDz+y@3Uke<8~ ![(HAyopenpgp card broke ~*]*PWVT7TJ-TpK6WJE0zvGX> GIz ~*]* GIz t\E_M5(2!sşN\=tƢ:ܕ >Lkge<ʤ4]7A=?GFXf5`$Sk71~Ĺ,pW꒖ 3`IFC`jENA"s޸T*SWj=V3< >HP5`P%**o)/Gp~CEervPyw/evq!Y͏vܸR 0cO-~T"fz/_ui>#&<)R|:Ă꺙mp{ J_г 6qI HP5` ~*]*/UwX"تE/^JAy~*cgNX(Hsmartcard broke ~*]*ЯG|@q&.p=b3U2up۩f$ cHP5eGxy&ERČ{s[3eCw]q2!?*6vQ w8'qn-+WꨁK&9ptAw(oaę2sk<ċ۠Htb'UQqmAWDj9=u m@^WI(S /Cw0eza_%mӓ&3d@ugKvp=y5t 9]R#4jJ?v+,Rԍ; i: $!,;BevE̿-}Áx RJAtcmЋA:/rQF#$喙9ZKFPȆnT:mV<rFxP@B|B+a,**3ʡC`5R 3x%:;,seilm{U=rQ1N9] ~*]*eGPG H>ƌ2N< G8DsР>2S_8*{( ;J8$4Please see: http://micah.riseup.net/key_transition ~*]*vEqjE)r?c^OpKV r:XhOpenPGP-2.10.1/tests/data/gnu-dummy-s2k-101-secret-key.gpg0000644000000000000000000000043007346545000021142 0ustar0000000000000000T6@^'Wd(\!M:W HE|P8h+؈m]OchLcͻ)~{B"Ы*,eY2R U9\2H}b$:WFZeA[ h6-x*;k Au.޼ІUyyGCx@IsmᗙܢQ1>=Ȳ}`!~[Q@B4Ȏ-`)0rVbUfѨeGNUhOpenPGP-2.10.1/tests/data/minimized.gpg0000644000000000000000000000065507346545000016151 0ustar0000000000000000Ow$G4r㪼v#X5[r 6TlS) >꬙ߗGK )ϒYJJa"tuw?#4`h)PVs5U\v!J&lmI  VC4󠮀kcnT~(Ow$ π   No=8 \-97Ed;|̙j%`9^a M~U3pѰuhxᶱ[WkSfB)C3 %C ]h,x-fɗI Q]-liuCa$`ml5e1ΥnhOpenPGP-2.10.1/tests/data/msg1.asc0000644000000000000000000000025107346545000015014 0ustar0000000000000000-----BEGIN PGP MESSAGE----- Version: OpenPrivacy 0.99 yDgBO22WxBHv7O8X7O/jygAEzol56iUKiXmV+XmpCtmpqQUKiQrFqclFqUDBovzS vBSFjNSiVHsuAA== =njUN -----END PGP MESSAGE----- hOpenPGP-2.10.1/tests/data/nist_p-256_key.gpg0000644000000000000000000000070307346545000016634 0ustar0000000000000000ROwM<*H=m-a&"4PkW Uvp;P!E쇷`RKO2dwpD)s+Test Key (NIST P-256) 'OwM< f   p2$6t1;$,ߴ k<~nr~¢MҶ>Z %edgVOwM<*H=U7Q>o(}/%|[RТ=\9"-"r%nC_=]+5gOwM<  f p2$RZ;eT .7W; ԒcD_{`ɪ]DJmWXDb&J ԼhOpenPGP-2.10.1/tests/data/nist_p-256_secretkey.gpg0000644000000000000000000000115107346545000020040 0ustar0000000000000000OwM<*H=m-a&"4PkW Uvp;P!E쇷`RKO2dwpD)s(RaIg(nZֳxorEP `q1E),HiYp/+Test Key (NIST P-256) 'OwM< f   p2$6t1;$,ߴ k<~nr~¢MҶ>Z %edgOwM<*H=U7Q>o(}/%|[RТ=\9"-"r%nC_=]+5([օ -?hNODߦ66tnӘ#3S=HWQt'+Qt?gOwM<  f p2$RZ;eT .7W; ԒcD_{`ɪ]DJmWXDb&J ԼhOpenPGP-2.10.1/tests/data/onepass_sig0000644000000000000000000000001707346545000015712 0ustar0000000000000000 NohOpenPGP-2.10.1/tests/data/pgcrypto-passphrase.txt0000644000000000000000000000000607346545000020232 0ustar0000000000000000blockshOpenPGP-2.10.1/tests/data/pki-password.txt0000644000000000000000000000000407346545000016635 0ustar0000000000000000testhOpenPGP-2.10.1/tests/data/prikey-rev.gpg0000644000000000000000000000057007346545000016255 0ustar0000000000000000Ow$G4r㪼v#X5[r 6TlS) >꬙ߗGK )ϒYJJa"tuw?#4`h)PVs5U\v!J&lmI  VC4󠮀kcnT~꬙ߗGK )ϒYJJa"tuw?#4`h)PVs5U\v!J&lmI  VC4󠮀kcnT~EXVE+m*8QSCp x]P 0ăcas:f&`\R!tϪ3οxa_|Xq?gщʋS<꬙ߗGK )ϒYJJa"tuw?#4`h)PVs5U\v!J&lmI  VC4󠮀kcnT~o0OwITesting revsig ^#A2biBV#WY#-B>,[> $x yfu 38#o0OwIDtesting revsig ^#A2b>+ #1ѽ^Qmz6!$W+6+TQeL[3Gl/(Ow$ π   No=8 \-97Ed;|̙j%`9^a M~U3pѰuhxᶱ[WkSfB)C3 %C ]h,x-fɗI Q]-liuCa$`ml5e1ΥnOwHw >hm´#pBjH t_%*Y/V;k.Yy7%;z(Pvn*_7JD+&*,il)c Y3n]U}aD|"[N#a^OwI5 ^#A2bQ>&P{k-aعl nqaѡ0!Y꾹gkv0HjOw$ພo# \X" l9Nv`x]pBA hzSX[s'S4~#{T V`;~ 'o]3U.-Psڮ>S}%Nbx%9mˣ^l":C*=Ow$  π No9R \R^mNʖlysQ%x=ӿbG"lf!%F*w͎gL#!^_ql5qWe/< 0k)sL34ʺmEy$éH#TP.f\w=j4akOw m] yayT*p}GLE!SH)䃉4ŷQ,lŖF!b 4ދj;R  4<ްoz})Q6\R2y俓ܣ%}U|n;[ m @t9N\ߊW 4d*\ #KP E6)R߶l#0ӚBD`^.{{m#}gGV+ 6!b7Fa'Y J-`L4cWM9[E}U+0'3/HKfxpΞ{E*DQ:j oB&mK&_ S2B_"#0NEuFrV5m`sm렖}X4/H R-;548[,_zk\6"WLR ׁ*PieK6d*e5ͰF2HƩm&ވ0MO3e*5<*hp;gv-SIJZ8xRaZܗQDY,css9AO5 `]BQayl9J r t7sKamK . eDH Dqœ;B=zDky[dwz-ůnga5uTjgat̑LL]y!OwJ  /Z\þw2Ϙc ^#A2b& bta=0)Ҷ?9pɼRORͤ[L]ڳ,}pcï-`+LѰ$Test Key (DSA) (Ow    ^#A2bܯgi\Q$`;! 873?wNj*rK%% Aý~uOwH4 NowMy/]GYjZU8{Sc!Q'VJ""[zT|ĽX]`qdD+Ւ !BwR'+iDm@ (ǘQصf.^3mw8P*}(Qwrdx')mqVP2g wa mG >\$B6C;i^4RgOw   ^#A2b)$[OX`J`6\I[o?u<wGkt˨\A]gM^"߶/HOw3!$}9 W̳us<,?#/ `N["cgU[In?60tw&U8j,K|7[Cb|p6.oaV1aS"oՍ)6W.=='%WgDڤDAmiԚr8h>$B/'tMZ ַk(Txg^;?Q#׻HD?HgQW-i|rKHA B,GO>G9ٓfp',6n?טYT/ ?XvT:`p/y){0ϜFw7νyV_3v }yNi[͙\zC?9A$Ya!OwJ y3EY >hm w2ϘcnA_-]joyp&e2r ؠXŰ+Test Key (DSA sign-only) B   OwItesting@notation w2Ϙcꆸ-&iDš$)`Sg<°^OwHT ^#A2b0$LM ɑ(;濂X/t+2f]9"W=O!}co*(:UOw!ž%Jo_-0=!t֤70#M\d&KnHyI Qm PG;RLjF!"N$9t98wvW"I%/̈LNСz Ny .Test Key (RSA sign-only) (Ow! hmAD&5Ԝjmg^y]bnKA;x˲BT[DwQ%2rwEB b;ʴY;n@%̓fZ~qᏦ8ۋjxUB*__N~v׏qk#ĸ*:` `†?'FJt)n:StƢ5Nllj::^61 6NB |]\Idg=TD@VTDŽ?S֤~O?Z{tf¢uU9uRąCH 9A̭ă_]N)0Tuڞ\_Z|Q_O>t|Tp7 ۏq@ L_mMQCQb_$$((`_Up Taohqe3d"kH& LVO"=7*R(q7JJ!q{yE+"1Rf#ĥK JE@Mԑs:\>;QZېs 6= 28`zޭXRxY;w$$-Lş6KITAQFʧ5=4 (6{ e]`"YmXqu4rj2\YFJB tB6ꞡjrTit0BUtsȹ~;v;^qRQ5->o!IH! M4vn f"d\\SfJB/S/$=RA~ܲfiuErYtw!@ ˂>NU{pVQUee R%7Zl1㟞*liuovo|c{["*QrߓC@1'ZA~mf˶<'pL؋p$Hh* %@$ň#j۲UD6ֶ$$n4hګ VTs@39yF5YN!Ч\[FuqtVorF~Q1LhS.ڊMqt ?sFoUS$3tupѧSȆE- 6ZĤ8LzjQ,_B]BIQDs4hMLOs3>d3kpS(?71<\S~8ԾNKTw@āv-NcP'S ̑][`T \ƦKOҢTT\((*$H!FXm'2` G)&cW4aKMqlE3ٲ( uАQL\Jo_~ +­Dx:sTj_و(OwL hmdi!Սyǜ+d1A(}=M4 BvSu [TXq, %f8o; m *At'|Fg0]%]%yޡ UVC~d:+5 u OwJGgC!_ZGk렂=KsxH-!*nLvXFw|#W,l;qfO^>3(@ 8hm߰yb)Qx0+G7ld:`c/ ~ڶTG̔Cr=0n~83aQ_zIN\|Sa8e`dqr#dW>}P끩hOpenPGP-2.10.1/tests/data/revoked.pubkey0000644000000000000000000000631607346545000016345 0ustar00000000000000008oM!v7w~!~$?p(QH(P5i-9όM|rhٮ @#!slm8  on5<`E2ŏxjd\ޜ'уگ\1$:dQgg!9_H>V nw`7>w C-?$Joڅ ܏ua1*SW/p$Sߥ`d91z4IC GubEּWw}RZWl ƥ|_xN"E,2G?iຆ\aeu\iekyLCVԼf~+IK&iZկ W͇hޢtK J#Jh3+ʼn-tpɁڈ MRQFsuperseded by key 4900 707D DC5C 07F2 DECB 0283 9C31 503C 6D86 6396 ʛ#PqFW `}/f64  y gʹ$Stefano Zacchiroli 0UIWN I don't use the @bononia.it address anymore, and it will bounce anytime soon ʛ#bZ+.c^Ђ(#-Y]_Ϳ1"IYk0$Stefano Zacchiroli _:@   ʛ#eGPG[> S>sUn9o*=$Stefano Zacchiroli c# Gwa/ ʛ#NӝHU![SMNB*3_aO9%Stefano Zacchiroli ` H۾  ʛ#5|,wG^of+ y]Xulv 0+.O(Stefano Zacchiroli ` H  ʛ#} ]1Æ^>jwYSfH%ǭr;7_+蜴,Stefano Zacchiroli (Zack) r02If2+getting rid of the bogus "(Zack)" comment ʛ#l'h C&:3.ԠXD-0Stefano Zacchiroli (Zack) r02If2+getting rid of the bogus "(Zack)" comment ʛ#." &h@S~i@m*+ 8Eg%tI8Pq,\хj7֪; `6zxRHN1$)O7֬pŀE |E,nitLSkJ[|szn(]0-쀖(NރgsOKu8s$=Pi멙E%KMpWϼ.{ꡙdNi;_mik CLrH΄R)qPA6,%x7bf_ i N8 ʛ#eGPG2(>KXy&0p@X[BK0?jJP*LA 7q(qH^jI've switched to a longer subkey for encryption; the ID of the new key is E5B57D13, it is 4096 bit long. ʛ#92 Bs׫8 @~;#_l8||7Om#ݜ H GT鴙Jtf`^7}se"X E RYʨJ3mgW8uOg['mbNbn&ϷN&6ʊs17/eHQqd sz*Tԉ =%Uy@q2ĥz!OI <~]Y vs tҽGK A(zK)4ǖ_\+yPgu(FɊ#HN8 {L& ٥OĤӓ!W6) +-gkD3V~I0&*DX' /ϥecE,F]އJl|F8e{OU\V@OmHb [W9"B#?I!#' u22jh?cWahWd6s <mND 7yS$82]oa$_JsI6ZkrA=͵k8שe#yֆ @nZ)RVy}Wm b;D Ot#͌(m?&2@e1B#~`I4;SCPȚ.=C< {PԷƂ(ڠ2w=nCK&7%F}d"2Hcn%"ӌ30`Shu}?Bc`h*=J]VI H ʛ#Bіl{ר\5ˏ5KNlb 6ųv2ۏIhOpenPGP-2.10.1/tests/data/sample-eddsa.pubkey0000644000000000000000000000006507346545000017240 0ustar00000000000000003S_  +G@? @Sy4|s:/.C;$hOpenPGP-2.10.1/tests/data/secring.gpg0000644000000000000000000002070407346545000015613 0ustar0000000000000000_Ow$G4r㪼v#X5[r 6TlS) >꬙ߗGK )ϒYJJa"tuw?#4`h)PVs5U\v!J&lmI  VC4󠮀kcnT~mW3W%O:`X~8%d\ٺ§'$Test Key (RSA) (Ow$ π   No=8 \-97Ed;|̙j%`9^a M~U3pѰuhxᶱ[WkSfB)C3 %C ]h,x-fɗI Q]-liuCa$`ml5e1Υn`Ow$ພo# \X" l9Nv`x]pBA hzSX[s'S4~#{T V`;~ 'o]3U.-Psڮ>S}%Nbx%9mˣ^l":C*=emGM`A]Q$VamQX&nySRw!+ˑk^IW!4HX`5yKh4nQ?ՙthSM]$f/\Ts,FJwJ^Il2k0!xU;/̶̪a}>F7AL}ΚtP6n|iqq«VWzjkv-iV $=d/B9KʋTp%a *' : r$4* @OM2Whu}Va v< YG="ӱRf Q/swn 7 ưUl4ߕ,jLv)DÎyhl4YOw$  π No9R \R^mNʖlysQ%x=ӿbG"lf!%F*w͎gL#!^_ql5qWe/< 0k)sL34ʺmEy$éH#TP.f\w=j4akOw m] yayT*p}GLE!SH)䃉4ŷQ,lŖF!b 4ދj;R  4<ްoz})Q6\R2y俓ܣ%}U|n;[ m @t9N\ߊW 4d*\ #KP E6)R߶l#0ӚBD`^.{{m#}gGV+ 6!b7Fa'Y J-`L4cWM9[E}U+0'3/HKfxpΞ{E*DQ:j oB&mK&_ S2B_"#0NEuFrV5m`sm렖}X4/H R-;548[,_zk\6"WLR ׁ*PieK6d*e5ͰF2HƩm&ވ0MO3e*5<*hp;gv-SIJZ8xRaZܗQDY,css9AO5 `]BQayl9J r t7sKamK . eDH Dqœ;B=zDky[dwz-ůnga5uTjgat̑LL]gׁ`vE%nOqaWqrn!`i}lw!B&{b]+GQ y!OwJ  /Z\þw2Ϙc ^#A2b& bta=0)Ҷ?9pɼRORͤ[L]ڳ,}pcï-`+LѰ$Test Key (DSA) (Ow    ^#A2bܯgi\Q$`;! 873?wNj*rK%% Aý~uOw @7la Ua?a`K䠳q{Ü@H2{'2i0  D+=6h8k]NmY\}]X+%T|T̠ =%VubD;^`钘/hĢfFj㬒vA$_,G]aNz5ͽ w?

(ǘQصf.^3mw8P*}(Qwrdx')mqVP2g wa mG >\$B6C;i^4Rgׁ`A0ʭerT$fJ{y!TM{2XIסtWaʞ+fOw   ^#A2b)$ ::y!cƋI3b;@{S?bSZV9ިPMOw3!$}9 W̳us<,?#/ `N["cgU[In?60tw&U8j,K|7[Cb|p6.oaV1aS"oՍ)6W.=='%WgDڤDAmiԚr8h>$B/'tMZ ַk(Txg^;?Q#׻HD?HgQW-i|rKHA B,GO>G9ٓfp',6n?טYT/ ?XvT:`p/y){0ϜFw7νyV_3v }yNi[͙\zC?9A$YZ".ܵh``(S -lNwF5B`l m)a!OwJ y3EY >hm w2ϘcnA_-]joyp&e2r ؠXŰ+Test Key (DSA sign-only) h(Ow    w2ϘczHm5YDBT!.ADs48$Q9H>jOw!ž%Jo_-0=!t֤70#M\d&KnHyI Qm PG;RLjF!"N$9t98wvW"I%/̈LNСz Ny  WA/`++oXbN,9KpPwR,l&p<ǻ\n>+;I Sl Xr Ju#ʶK&Λ_o7HBߙAzHkWp`4dl LJ"`H.lۏ'O4]4,X3܉O'q)u]hhHi'KI>1/L,ڀT R6Z7VA,,&|yrXh,@@D:7k=0sD2އFcOq~8gU;[U 4AT}G J6>?9by$(A\vծ:Qe`0*(ƴ.Test Key (RSA sign-only) (Ow! hmAD&5Ԝjmg^y]bnKA;x˲BT[DwQ%2rwEB b;ʴY;n@%̓fZ~qᏦ8ۋjxUB*__N~v׏qk#ĸ*:` `†?'FJt)n:StƢ5Nllj::^61 6NB |]\Idg=TD@VTDŽ?S֤~O?Z{tf¢uU9uRąCH 9A̭ă_]N)0Tuڞ\_Z|Q_O>t|Tp7 ۏq@ L_mMQCQb_$$((`_Up Taohqe3d"kH& LVO"=7*R(q7JJ!q{yE+"1Rf#ĥK JE@Mԑs:\>;QZېs 6= 28`zޭXRxY;w$$-Lş6KITAQFʧ5=4 (6{ e]`"YmXqu4rj2\YFJB tB6ꞡjrTit0BUtsȹ~;v;^qRQ5->o!IH! M4vn f"d\\SfJB/S/$=RA~ܲfiuErYtw!@ ˂>NU{pVQUee R%7Zl1㟞*liuovo|c{["*QrߓC@1'ZA~mf˶<'pL؋p$Hh* %@$ň#j۲UD6ֶ$$n4hګ VTs@39yF5YN!Ч\[FuqtVorF~Q1LhS.ڊMqt ?sFoUS$3tupѧSȆE- 6ZĤ8LzjQ,_B]BIQDs4hMLOs3>d3kpS(?71<\S~8ԾNKTw@āv-NcP'S ̑][`T \ƦKOҢTT\((*$H!FXm'2` G)&cW4aKMqlE3ٲ( uАQL\Jo_~ +­Dx:sTj_و(OwL hmdi!Սyǜ+d1A(}=M4 BvSu [TXq, %f8o; m *At'|Fg0]%]%yޡ UVC~d:+5 uOwJGgC!_ZGk렂=KsxH-!*nLvXFw|#W,l;qfO^>3(@ 8A ̇کv4'gb2R!e.}񀙱ltM?E-]5ds1\Z7_MեZC)'MB4gȇIİLJ3JX< |4NW~AG}5[BaCrj/"͒u6 t=pjZ}Eh2:ZN<NcIVPDaP6Sd ׶P(sQ+'Jy!ڿ`{? bh5׽ OaD\2Vޖtr#'dWB_'<{ O,L , hd(&%/{3F){٬m5_YStuCCb̐ OwJ >hm߰yb)Qx0+G7ld:`c/ ~ڶTG̔Cr=0n~83aQ_zIN\|Sa8e`dqr#dW>}P끩hOpenPGP-2.10.1/tests/data/signing-subkey.gpg0000644000000000000000000000172007346545000017114 0ustar0000000000000000Ow$G4r㪼v#X5[r 6TlS) >꬙ߗGK )ϒYJJa"tuw?#4`h)PVs5U\v!J&lmI  VC4󠮀kcnT~(Ow$ π   No=8 \-97Ed;|̙j%`9^a M~U3pѰuhxᶱ[WkSfB)C3 %C ]h,x-fɗI Q]-liuCa$`ml5e1ΥnPZl;yh}6DDdBn RVNv$.o/YP-ȑsB/blͅ &l)Fmm.z\ąU;?,<6銁>EXVE+m*8QSCp x]u P No P 0ăcas:f&`\R!tϪ3οxa_|Xq?gщʋS<9S.upr{>mBy"5n}6`}Ҍ/|,lcIyդ8iI4_l e3t%1~hOpenPGP-2.10.1/tests/data/sigs-with-regexes0000644000000000000000000000040007346545000016752 0ustar0000000000000000L 9 all 5zN][x(ZyqbR3|s?O{QHZc#8+The cat sat on the big mat c;(Qx0EhgqW] +7e}S%"LK >yf.* g\/[L|[hrfKiA&p` ^G+hOpenPGP-2.10.1/tests/data/simple.seckey0000644000000000000000000000154407346545000016161 0ustar0000000000000000_Ow$G4r㪼v#X5[r 6TlS) >꬙ߗGK )ϒYJJa"tuw?#4`h)PVs5U\v!J&lmI  VC4󠮀kcnT~mW3W%O:`X~8%d\ٺ§'$Test Key (RSA) (Ow$ π   No=8 \-97Ed;|̙j%`9^a M~U3pѰuhxᶱ[WkSfB)C3 %C ]h,x-fɗI Q]-liuCa$`ml5e1ΥnhOpenPGP-2.10.1/tests/data/subkey-rev.gpg0000644000000000000000000000104307346545000016250 0ustar0000000000000000Ow$G4r㪼v#X5[r 6TlS) >꬙ߗGK )ϒYJJa"tuw?#4`h)PVs5U\v!J&lmI  VC4󠮀kcnT~S}%Nbx%9mˣ^l":C*=(PhOpenPGP testing NoKT‚͘^Xw+Zoݙ6ݕO%^m(9)7`Wzh2꬙ߗGK )ϒYJJa"tuw?#4`h)PVs5U\v!J&lmI  VC4󠮀kcnT~Ow$ພo# \X" l9Nv`x]pBA hzSX[s'S4~#{T V`;~ 'o]3U.-Psڮ>S}%Nbx%9mˣ^l":C*=Ow$  π No9R \R^mNʖlysQ%x=ӿbG"lf!%F*w͎gL#!^_ql5qWe/< 0k)sL34ʺmEy$éH#TP.f\w=j4akhOpenPGP-2.10.1/tests/data/symmetric-password.txt0000644000000000000000000000000607346545000020070 0ustar0000000000000000abc123hOpenPGP-2.10.1/tests/data/uat.gpg0000644000000000000000000000130707346545000014750 0ustar0000000000000000Ow$G4r㪼v#X5[r 6TlS) >꬙ߗGK )ϒYJJa"tuw?#4`h)PVs5U\v!J&lmI  VC4󠮀kcnT~BHJNON/;V\UL[FMNKC $$K2+2KKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKK  ?و(Py π   No~v?l̨\&]^hts|pkE)ENR&ie [ƑP<&|(PѡGZYe@L'U:-cPHį뺑0eU2G_%--by9;s-zlhOpenPGP-2.10.1/tests/data/uncompressed-ops-dsa-sha384.txt.gpg0000644000000000000000000000022607346545000022057 0ustar0000000000000000  w2Ϙc=buncompressed-ops.txtO Uncompressed one-pass sig message. F O w2Ϙc*'iOYY' Kf/oXmhOpenPGP-2.10.1/tests/data/uncompressed-ops-dsa.gpg0000644000000000000000000000022607346545000020231 0ustar0000000000000000 w2Ϙc=buncompressed-ops.txtOz4}Uncompressed one-pass sig message. FOz4} w2Ϙc$hk-A^jYΔ0hm=buncompressed-ops.txtOz4Uncompressed one-pass sig message. Oz4 >hmu2X;DwHsP|(E\D\h]AIK FSxl o[(,s+g&T KX~.EbQ;Y"8E9Z!`_x?MMhOpenPGP-2.10.1/tests/data/unencrypted.seckey0000644000000000000000000000150207346545000017222 0ustar00000000000000009Ow$G4r㪼v#X5[r 6TlS) >꬙ߗGK )ϒYJJa"tuw?#4`h)PVs5U\v!J&lmI  VC4󠮀kcnT~%U k"_ٸuȲ}\``ukAIh G@5$Nn8:7qtbBwD}q͏AĤ ppb )_[ pXw yů,7ȅN`Lu$k뺻n_"ύs_h^"|ߴ2R3{ kp$-r@0Z>c$2]s g? _F0{jgD=:N(z^ }'LU. `Ju+gn$*i%9  -ppWL$Ce9PY:өw}pÁ$Test Key (RSA) (Ow$ π   No=8 \-97Ed;|̙j%`9^a M~U3pѰuhxᶱ[WkSfB)C3 %C ]h,x-fɗI Q]-liuCa$`ml5e1ΥnhOpenPGP-2.10.1/tests/data/v3-genericcert.sig0000644000000000000000000000023007346545000016776 0ustar0000000000000000;ޢ !V=ItAy@9&$^8 ](-1fg. Xv:PǽHG|ގq mNPBjCDD)ۮ|[Ӏu #Qu*mŀ&hOpenPGP-2.10.1/tests/0000755000000000000000000000000007346545000012546 5ustar0000000000000000hOpenPGP-2.10.1/tests/suite.hs0000644000000000000000000010674607346545000014251 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} -- suite.hs: hOpenPGP test suite -- Copyright © 2012-2019 Clint Adams -- This software is released under the terms of the Expat license. -- (See the LICENSE file). import Test.Tasty (TestTree, defaultMain, testGroup) import Test.Tasty.HUnit (Assertion, assertEqual, assertFailure, testCase) import Test.Tasty.QuickCheck as QC import Codec.Encryption.OpenPGP.Arbitrary () import Codec.Encryption.OpenPGP.Compression (compressPkts, decompressPkt) import Codec.Encryption.OpenPGP.Expirations (isTKTimeValid) import Codec.Encryption.OpenPGP.Fingerprint (eightOctetKeyID, fingerprint) import Codec.Encryption.OpenPGP.KeyInfo (pkalgoAbbrev, pubkeySize) import Codec.Encryption.OpenPGP.KeySelection (parseFingerprint) import Codec.Encryption.OpenPGP.KeyringParser (parseTKs) import Codec.Encryption.OpenPGP.SecretKey (decryptPrivateKey, encryptPrivateKey) import Codec.Encryption.OpenPGP.Serialize (parsePkts) import Codec.Encryption.OpenPGP.Signatures ( verifyAgainstKeys , verifySigWith , verifyTKWith ) import Codec.Encryption.OpenPGP.Types import Control.Error.Util (isRight) import Control.Exception.Base (SomeException, catch) import Control.Monad.Trans.Resource (ResourceT) import qualified Crypto.PubKey.ECC.ECDSA as ECDSA import qualified Crypto.PubKey.RSA as RSA import Data.Bifunctor (bimap) import Data.Binary (get, put) import Data.Binary.Get (Get, runGetOrFail) import Data.Binary.Put (runPut) import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as BL import Data.Conduit.OpenPGP.Compression (conduitCompress, conduitDecompress) import Data.Conduit.OpenPGP.Decrypt (conduitDecrypt) import Data.Conduit.OpenPGP.Keyring ( conduitToTKs , conduitToTKsDropping , sinkKeyringMap ) import Data.Conduit.OpenPGP.Verify (conduitVerify) import Data.Conduit.Serialization.Binary (conduitGet) import Data.IxSet.Typed ((@=), getOne) import Data.Maybe (isJust) import Data.Text (Text) import Data.Text.Prettyprint.Doc (pretty) import Data.Time.Clock.POSIX (posixSecondsToUTCTime) import qualified Data.Conduit as DC import qualified Data.Conduit.Binary as CB import qualified Data.Conduit.List as CL -- this needs a better name runGet :: Get a -> BL.ByteString -> Either String a runGet g bs = bimap (\(_, _, x) -> x) (\(_, _, x) -> x) (runGetOrFail g bs) -- FIXME: nothing tests serialization of TKs testSerialization :: FilePath -> Assertion testSerialization fpr = do bs <- BL.readFile $ "tests/data/" ++ fpr let firstpass = runGet get bs case fmap unBlock firstpass of Left _ -> assertFailure $ "First pass failed on " ++ fpr Right [] -> assertFailure $ "First pass of " ++ fpr ++ " decoded to nothing." Right packs -> do let roundtrip = runPut $ put (Block packs) let secondpass = runGet (get :: Get (Block Pkt)) roundtrip if fmap unBlock secondpass == Right [] then assertFailure $ "Second pass of " ++ fpr ++ " decoded to nothing." else assertEqual ("for " ++ fpr) firstpass secondpass testCompression :: FilePath -> Assertion testCompression fpr = do bs <- BL.readFile $ "tests/data/" ++ fpr let firstpass = fmap (concatMap decompressPkt . unBlock) . runGet get $ bs case firstpass of Left _ -> assertFailure $ "First pass failed on " ++ fpr Right [] -> assertFailure $ "First pass of " ++ fpr ++ " decoded to nothing." Right packs -> do let roundtrip = runPut $ put . Block $ [compressPkts ZIP packs] let secondpass = fmap (concatMap decompressPkt . unBlock) . runGet get $ roundtrip if secondpass == Right [] then assertFailure $ "Second pass of " ++ fpr ++ " decoded to nothing." else assertEqual ("for " ++ fpr) firstpass secondpass counter :: (Monad m) => DC.ConduitT a DC.Void m Int counter = CL.fold (const . (1 +)) 0 testConduitOutputLength :: FilePath -> DC.ConduitT B.ByteString b (ResourceT IO) () -> Int -> Assertion testConduitOutputLength fpr c target = do len <- DC.runConduitRes $ CB.sourceFile ("tests/data/" ++ fpr) DC..| c DC..| counter assertEqual ("expected length " ++ show target) target len testPKAandSizeAndKeyIDandFingerprint :: FilePath -> String -> Assertion testPKAandSizeAndKeyIDandFingerprint fpr kf = do bs <- BL.readFile $ "tests/data/" ++ fpr case runGet (get :: Get Pkt) bs of Left _ -> assertFailure $ "Decoding of " ++ fpr ++ " broke." Right (PublicKeyPkt pkp) -> do let pref = concat [ pkalgoAbbrev (_pkalgo pkp) , either (const "unknown") show (pubkeySize (_pubkey pkp)) , ":" , either (const "unknown") (show . pretty) (eightOctetKeyID pkp) , "/" ] assertEqual ("for " ++ fpr ++ " (spaceless)") (spaceless kf) (pref ++ show (pretty (fingerprint pkp))) assertEqual ("for " ++ fpr ++ " (spaced)") kf (pref ++ show (pretty (SpacedFingerprint (fingerprint pkp)))) _ -> assertFailure "Expected public key, got something else." where spaceless = filter (/= ' ') testKeyringLookup :: FilePath -> String -> Bool -> Assertion testKeyringLookup fpr eok expected = do kr <- DC.runConduitRes $ CB.sourceFile ("tests/data/" ++ fpr) DC..| conduitGet get DC..| conduitToTKs DC..| sinkKeyringMap let key = getOne (kr @= (read eok :: EightOctetKeyId)) assertEqual (eok ++ " in " ++ fpr) expected (isJust key) testVerifyMessage :: FilePath -> FilePath -> [TwentyOctetFingerprint] -> Assertion testVerifyMessage keyring message issuers = do kr <- DC.runConduitRes $ CB.sourceFile ("tests/data/" ++ keyring) DC..| conduitGet get DC..| conduitToTKs DC..| sinkKeyringMap verification <- DC.runConduitRes $ CB.sourceFile ("tests/data/" ++ message) DC..| conduitGet get DC..| conduitDecompress DC..| conduitVerify kr Nothing DC..| CL.consume let verification' = map (fmap (fingerprint . _verificationSigner)) verification assertEqual (keyring ++ " for " ++ message) (map Right issuers) verification' testKeysSelfVerification :: Bool -> FilePath -> Assertion testKeysSelfVerification expectsuccess keyfile = do ks <- DC.runConduitRes $ CB.sourceFile ("tests/data/" ++ keyfile) DC..| conduitGet get DC..| conduitToTKs DC..| CL.consume let verifieds = mapM (verifyTKWith (verifySigWith (verifyAgainstKeys ks)) Nothing) ks assertEqual (keyfile ++ " self-verification") expectsuccess (isRight verifieds) -- FIXME: testKeysExpiration :: Bool -> FilePath -> Assertion testKeysExpiration expectsuccess keyfile = do ks <- DC.runConduitRes $ CB.sourceFile ("tests/data/" ++ keyfile) DC..| conduitGet get DC..| conduitToTKs DC..| CL.consume let Right verifieds = mapM (verifyTKWith (verifySigWith (verifyAgainstKeys ks)) Nothing) ks tvalid = all (isTKTimeValid (posixSecondsToUTCTime (realToFrac (1400000000 :: Integer)))) verifieds assertEqual (keyfile ++ " key expiration") expectsuccess tvalid -- This needs a lot of work testSymmetricEncryption :: FilePath -> FilePath -> BL.ByteString -> Assertion testSymmetricEncryption encfile passfile cleartext = do passphrase <- BL.readFile $ "tests/data/" ++ passfile -- get parse tree pt <- DC.runConduitRes $ CB.sourceFile ("tests/data/" ++ encfile) DC..| conduitGet get DC..| CL.consume -- assert parse tree has exactly two packets: skesk, encdata assertEqual "wrong number of packets" 2 (length pt) let skesk = fromPkt . head $ pt d = fromPkt . last $ pt -- FIXME: these assertions don't currently do anything properly, -- because haskell notices the _-prefixed accessor invocations below -- and the type system chokes before we hit them: assertEqual "first packet should be SKESK" SKESKType (packetType skesk) assertEqual "second packet should be encrypted data" SymEncIntegrityProtectedDataType (packetType d) decrypted <- catch (DC.runConduitRes $ CL.sourceList pt DC..| conduitDecrypt (fakeCallback passphrase) DC..| CL.consume) (\e -> do let err = show (e :: SomeException) assertFailure ("decryption threw exception: " ++ err)) let payload = _literalDataPayload . fromPkt . head $ decrypted assertEqual ("cleartext for " ++ encfile) cleartext payload where fakeCallback :: BL.ByteString -> String -> IO BL.ByteString fakeCallback = const . return testSecretKeyDecryption :: FilePath -> FilePath -> Assertion testSecretKeyDecryption keyfile passfile = do passphrase <- BL.readFile $ "tests/data/" ++ passfile kr <- DC.runConduitRes $ CB.sourceFile ("tests/data/" ++ keyfile) DC..| conduitGet get DC..| CL.consume let SecretKey pkp ska = fromPkt . head $ kr SUUnencrypted skey _ = decryptPrivateKey (pkp, ska) passphrase doPkeyAndSkeyMatch (_pubkey pkp) skey -- FIXME: this should be reworked either with tasty-golden or some other form of sanity testSecretKeyEncryption :: FilePath -> FilePath -> Assertion testSecretKeyEncryption keyfile passfile = do passphrase <- BL.readFile $ "tests/data/" ++ passfile kr <- DC.runConduitRes $ CB.sourceFile ("tests/data/" ++ keyfile) DC..| conduitGet get DC..| CL.consume gkr <- DC.runConduitRes $ CB.sourceFile ("tests/data/" ++ "aes256-sha512.seckey") DC..| conduitGet get DC..| CL.consume let SecretKey pkp ska = fromPkt . head $ kr newska = encryptPrivateKey "\226~\197\a\202#\"G" (IV "\187\219\253I\236\204\t5D\196\NAK>;\202\185\t") ska passphrase newtruck = toPkt (SecretKey pkp newska) : tail kr assertEqual "encrypted private key matches golden file" gkr newtruck testParsePktsUtil :: FilePath -> Assertion testParsePktsUtil fn = do let fpath = "tests/data/" ++ fn cp <- DC.runConduitRes $ CB.sourceFile fpath DC..| conduitGet get DC..| CL.consume pp <- parsePkts `fmap` BL.readFile fpath assertEqual "parsePkts utility function gives same results as conduit pipeline" cp pp testParseTKsUtil :: FilePath -> Assertion testParseTKsUtil fn = do let fpath = "tests/data/" ++ fn lbs <- BL.readFile fpath cp <- DC.runConduitRes $ CB.sourceLbs lbs DC..| conduitGet get DC..| conduitToTKs DC..| CL.consume let pt = parseTKs True . parsePkts $ lbs assertEqual "parsePkts utility function gives same results as conduit pipeline" cp pt tests :: TestTree tests = testGroup "Tests" [properties, unitTests] unitTests :: TestTree unitTests = testGroup "Unit Tests" [ testGroup "Serialization group" [ testCase "000001-006.public_key" (testSerialization "000001-006.public_key") , testCase "000002-013.user_id" (testSerialization "000002-013.user_id") , testCase "000003-002.sig" (testSerialization "000003-002.sig") , testCase "000004-012.ring_trust" (testSerialization "000004-012.ring_trust") , testCase "000005-002.sig" (testSerialization "000005-002.sig") , testCase "000006-012.ring_trust" (testSerialization "000006-012.ring_trust") , testCase "000007-002.sig" (testSerialization "000007-002.sig") , testCase "000008-012.ring_trust" (testSerialization "000008-012.ring_trust") , testCase "000009-002.sig" (testSerialization "000009-002.sig") , testCase "000010-012.ring_trust" (testSerialization "000010-012.ring_trust") , testCase "000011-002.sig" (testSerialization "000011-002.sig") , testCase "000012-012.ring_trust" (testSerialization "000012-012.ring_trust") , testCase "000013-014.public_subkey" (testSerialization "000013-014.public_subkey") , testCase "000014-002.sig" (testSerialization "000014-002.sig") , testCase "000015-012.ring_trust" (testSerialization "000015-012.ring_trust") , testCase "000016-006.public_key" (testSerialization "000016-006.public_key") , testCase "000017-002.sig" (testSerialization "000017-002.sig") , testCase "000018-012.ring_trust" (testSerialization "000018-012.ring_trust") , testCase "000019-013.user_id" (testSerialization "000019-013.user_id") , testCase "000020-002.sig" (testSerialization "000020-002.sig") , testCase "000021-012.ring_trust" (testSerialization "000021-012.ring_trust") , testCase "000022-002.sig" (testSerialization "000022-002.sig") , testCase "000023-012.ring_trust" (testSerialization "000023-012.ring_trust") , testCase "000024-014.public_subkey" (testSerialization "000024-014.public_subkey") , testCase "000025-002.sig" (testSerialization "000025-002.sig") , testCase "000026-012.ring_trust" (testSerialization "000026-012.ring_trust") , testCase "000027-006.public_key" (testSerialization "000027-006.public_key") , testCase "000028-002.sig" (testSerialization "000028-002.sig") , testCase "000029-012.ring_trust" (testSerialization "000029-012.ring_trust") , testCase "000030-013.user_id" (testSerialization "000030-013.user_id") , testCase "000031-002.sig" (testSerialization "000031-002.sig") , testCase "000032-012.ring_trust" (testSerialization "000032-012.ring_trust") , testCase "000033-002.sig" (testSerialization "000033-002.sig") , testCase "000034-012.ring_trust" (testSerialization "000034-012.ring_trust") , testCase "000035-006.public_key" (testSerialization "000035-006.public_key") , testCase "000036-013.user_id" (testSerialization "000036-013.user_id") , testCase "000037-002.sig" (testSerialization "000037-002.sig") , testCase "000038-012.ring_trust" (testSerialization "000038-012.ring_trust") , testCase "000039-002.sig" (testSerialization "000039-002.sig") , testCase "000040-012.ring_trust" (testSerialization "000040-012.ring_trust") , testCase "000041-017.attribute" (testSerialization "000041-017.attribute") , testCase "000042-002.sig" (testSerialization "000042-002.sig") , testCase "000043-012.ring_trust" (testSerialization "000043-012.ring_trust") , testCase "000044-014.public_subkey" (testSerialization "000044-014.public_subkey") , testCase "000045-002.sig" (testSerialization "000045-002.sig") , testCase "000046-012.ring_trust" (testSerialization "000046-012.ring_trust") , testCase "000047-005.secret_key" (testSerialization "000047-005.secret_key") , testCase "000048-013.user_id" (testSerialization "000048-013.user_id") , testCase "000049-002.sig" (testSerialization "000049-002.sig") , testCase "000050-012.ring_trust" (testSerialization "000050-012.ring_trust") , testCase "000051-007.secret_subkey" (testSerialization "000051-007.secret_subkey") , testCase "000052-002.sig" (testSerialization "000052-002.sig") , testCase "000053-012.ring_trust" (testSerialization "000053-012.ring_trust") , testCase "000054-005.secret_key" (testSerialization "000054-005.secret_key") , testCase "000055-002.sig" (testSerialization "000055-002.sig") , testCase "000056-012.ring_trust" (testSerialization "000056-012.ring_trust") , testCase "000057-013.user_id" (testSerialization "000057-013.user_id") , testCase "000058-002.sig" (testSerialization "000058-002.sig") , testCase "000059-012.ring_trust" (testSerialization "000059-012.ring_trust") , testCase "000060-007.secret_subkey" (testSerialization "000060-007.secret_subkey") , testCase "000061-002.sig" (testSerialization "000061-002.sig") , testCase "000062-012.ring_trust" (testSerialization "000062-012.ring_trust") , testCase "000063-005.secret_key" (testSerialization "000063-005.secret_key") , testCase "000064-002.sig" (testSerialization "000064-002.sig") , testCase "000065-012.ring_trust" (testSerialization "000065-012.ring_trust") , testCase "000066-013.user_id" (testSerialization "000066-013.user_id") , testCase "000067-002.sig" (testSerialization "000067-002.sig") , testCase "000068-012.ring_trust" (testSerialization "000068-012.ring_trust") , testCase "000069-005.secret_key" (testSerialization "000069-005.secret_key") , testCase "000070-013.user_id" (testSerialization "000070-013.user_id") , testCase "000071-002.sig" (testSerialization "000071-002.sig") , testCase "000072-012.ring_trust" (testSerialization "000072-012.ring_trust") , testCase "000073-017.attribute" (testSerialization "000073-017.attribute") , testCase "000074-002.sig" (testSerialization "000074-002.sig") , testCase "000075-012.ring_trust" (testSerialization "000075-012.ring_trust") , testCase "000076-007.secret_subkey" (testSerialization "000076-007.secret_subkey") , testCase "000077-002.sig" (testSerialization "000077-002.sig") , testCase "000078-012.ring_trust" (testSerialization "000078-012.ring_trust") , testCase "pubring.gpg" (testSerialization "pubring.gpg") , testCase "secring.gpg" (testSerialization "secring.gpg") , testCase "compressedsig.gpg" (testSerialization "compressedsig.gpg") , testCase "compressedsig-zlib.gpg" (testSerialization "compressedsig-zlib.gpg") , testCase "compressedsig-bzip2.gpg" (testSerialization "compressedsig-bzip2.gpg") , testCase "onepass_sig" (testSerialization "onepass_sig") , testCase "uncompressed-ops-dsa.gpg" (testSerialization "uncompressed-ops-dsa.gpg") , testCase "uncompressed-ops-rsa.gpg" (testSerialization "uncompressed-ops-rsa.gpg") , testCase "simple.seckey" (testSerialization "simple.seckey") , testCase "v3-genericcert.sig" (testSerialization "v3-genericcert.sig") , testCase "sigs-with-regexes" (testSerialization "sigs-with-regexes") , testCase "gnu-dummy-s2k-101-secret-key.gpg" (testSerialization "gnu-dummy-s2k-101-secret-key.gpg") , testCase "anibal-ed25519.gpg" (testSerialization "anibal-ed25519.gpg") , testCase "nist_p-256_key.gpg" (testSerialization "nist_p-256_key.gpg") , testCase "nist_p-256_secretkey.gpg" (testSerialization "nist_p-256_secretkey.gpg") , testCase "sample-eddsa.pubkey" (testSerialization "sample-eddsa.pubkey") ] , testGroup "PKA/Size/KeyID/fingerprint group" [ testCase "v3 key" (testPKAandSizeAndKeyIDandFingerprint "v3.key" "R1024:C7261095/CBD9 F412 6807 E405 CC2D 2712 1DF5 E86E") , testCase "v4 key" (testPKAandSizeAndKeyIDandFingerprint "000001-006.public_key" "R1248:D4D54EA16F87040E/421F 28FE AAD2 22F8 56C8 FFD5 D4D5 4EA1 6F87 040E") , testCase "ECDSA key" (testPKAandSizeAndKeyIDandFingerprint "nist_p-256_key.gpg" "E256:F7708BADD6063224/174C CF12 C571 6D0E 527F B50E F770 8BAD D606 3224") , testCase "EdDSA key" (testPKAandSizeAndKeyIDandFingerprint "sample-eddsa.pubkey" "w256:8CFDE12197965A9A/C959 BDBA FA32 A2F8 9A15 3B67 8CFD E121 9796 5A9A") ] , testGroup "Keyring group" [ testCase "pubring 7732CF988A63EA86" (testKeyringLookup "pubring.gpg" "7732CF988A63EA86" True) , testCase "pubring 123456789ABCDEF0" (testKeyringLookup "pubring.gpg" "123456789ABCDEF0" False) , testCase "pubsub AD992E9C24399832" (testKeyringLookup "pubring.gpg" "AD992E9C24399832" True) , testCase "secring 7732CF988A63EA86" (testKeyringLookup "secring.gpg" "7732CF988A63EA86" True) , testCase "secring 123456789ABCDEF0" (testKeyringLookup "secring.gpg" "123456789ABCDEF0" False) , testCase "secsub AD992E9C24399832" (testKeyringLookup "secring.gpg" "AD992E9C24399832" True) -- FIXME: should count keys in rings ] , testGroup "Message verification group" [ testCase "uncompressed-ops-dsa" (testVerifyMessage "pubring.gpg" "uncompressed-ops-dsa.gpg" [fp "1EB2 0B2F 5A5C C3BE AFD6 E5CB 7732 CF98 8A63 EA86"]) , testCase "uncompressed-ops-dsa-sha384" (testVerifyMessage "pubring.gpg" "uncompressed-ops-dsa-sha384.txt.gpg" [fp "1EB2 0B2F 5A5C C3BE AFD6 E5CB 7732 CF98 8A63 EA86"]) , testCase "uncompressed-ops-rsa" (testVerifyMessage "pubring.gpg" "uncompressed-ops-rsa.gpg" [fp "CB79 3345 9F59 C70D F1C3 FBEE DEDC 3ECF 689A F56D"]) , testCase "compressedsig" (testVerifyMessage "pubring.gpg" "compressedsig.gpg" [fp "421F 28FE AAD2 22F8 56C8 FFD5 D4D5 4EA1 6F87 040E"]) , testCase "compressedsig-zlib" (testVerifyMessage "pubring.gpg" "compressedsig-zlib.gpg" [fp "421F 28FE AAD2 22F8 56C8 FFD5 D4D5 4EA1 6F87 040E"]) , testCase "compressedsig-bzip2" (testVerifyMessage "pubring.gpg" "compressedsig-bzip2.gpg" [fp "421F 28FE AAD2 22F8 56C8 FFD5 D4D5 4EA1 6F87 040E"]) ] , testGroup "Certificate verification group" [ testCase "userid" (testVerifyMessage "pubring.gpg" "minimized.gpg" [fp "421F 28FE AAD2 22F8 56C8 FFD5 D4D5 4EA1 6F87 040E"]) , testCase "subkey" (testVerifyMessage "pubring.gpg" "subkey.gpg" [fp "421F 28FE AAD2 22F8 56C8 FFD5 D4D5 4EA1 6F87 040E"]) , testCase "primary key binding" (testVerifyMessage "signing-subkey.gpg" "primary-binding.gpg" [fp "ED1B D216 F70E 5D5F 4444 48F9 B830 F2C4 83A9 9AE5"]) , testCase "attribute" (testVerifyMessage "pubring.gpg" "uat.gpg" [fp "421F 28FE AAD2 22F8 56C8 FFD5 D4D5 4EA1 6F87 040E"]) , testCase "primary key revocation" (testVerifyMessage "pubring.gpg" "prikey-rev.gpg" [fp "421F 28FE AAD2 22F8 56C8 FFD5 D4D5 4EA1 6F87 040E"]) , testCase "subkey revocation" (testVerifyMessage "pubring.gpg" "subkey-rev.gpg" [fp "421F 28FE AAD2 22F8 56C8 FFD5 D4D5 4EA1 6F87 040E"]) , testCase "6F87040E" (testVerifyMessage "pubring.gpg" "6F87040E.pubkey" [ fp "421F 28FE AAD2 22F8 56C8 FFD5 D4D5 4EA1 6F87 040E" , fp "CB79 3345 9F59 C70D F1C3 FBEE DEDC 3ECF 689A F56D" , fp "AF95 E4D7 BAC5 21EE 9740 BED7 5E9F 1523 4132 62DC" ]) , testCase "6F87040E-cr" (testVerifyMessage "pubring.gpg" "6F87040E-cr.pubkey" [ fp "AF95 E4D7 BAC5 21EE 9740 BED7 5E9F 1523 4132 62DC" , fp "AF95 E4D7 BAC5 21EE 9740 BED7 5E9F 1523 4132 62DC" , fp "421F 28FE AAD2 22F8 56C8 FFD5 D4D5 4EA1 6F87 040E" , fp "CB79 3345 9F59 C70D F1C3 FBEE DEDC 3ECF 689A F56D" , fp "AF95 E4D7 BAC5 21EE 9740 BED7 5E9F 1523 4132 62DC" ]) , testCase "simple RSA secret key" (testVerifyMessage "pubring.gpg" "simple.seckey" [fp "421F 28FE AAD2 22F8 56C8 FFD5 D4D5 4EA1 6F87 040E"]) , testCase "simple ECDSA public key" (testVerifyMessage "ecdsa-key-without-ecdh.pubkey" "ecdsa-key-without-ecdh.pubkey" [fp "174C CF12 C571 6D0E 527F B50E F770 8BAD D606 3224"]) ] , testGroup "Key verification group" [ testCase "6F87040E pubkey" (testKeysSelfVerification True "6F87040E.pubkey") , testCase "revoked pubkey" (testKeysSelfVerification False "revoked.pubkey") , testCase "expired pubkey" (testKeysSelfVerification True "expired.pubkey") , testCase "nist_p-256 pubkey" (testKeysSelfVerification True "nist_p-256_key.gpg") , testCase "ed25519 pubkey" (testKeysSelfVerification True "ed25519.pubkey") ] , testGroup "Key expiration group" [ testCase "6F87040E pubkey" (testKeysExpiration True "6F87040E.pubkey") , testCase "expired pubkey" (testKeysExpiration False "expired.pubkey") , testCase "nist_p-256 pubkey" (testKeysExpiration True "nist_p-256_key.gpg") , testCase "ed25519-without-curve25519.pubkey" (testKeysExpiration True "ed25519-without-curve25519.pubkey") , testCase "ed25519.pubkey" (testKeysExpiration True "ed25519.pubkey") ] , testGroup "Compression group" [ testCase "compressedsig.gpg" (testCompression "compressedsig.gpg") , testCase "compressedsig-zlib.gpg" (testCompression "compressedsig-zlib.gpg") , testCase "compressedsig-bzip2.gpg" (testCompression "compressedsig-bzip2.gpg") ] , testGroup "Conduit length group" [ testCase "conduitCompress (ZIP)" (testConduitOutputLength "pubring.gpg" (cgp DC..| conduitCompress ZIP) 1) , testCase "conduitCompress (Zlib)" (testConduitOutputLength "pubring.gpg" (cgp DC..| conduitCompress ZLIB) 1) , testCase "conduitCompress (BZip2)" (testConduitOutputLength "pubring.gpg" (cgp DC..| conduitCompress BZip2) 1) , testCase "conduitToTKs" (testConduitOutputLength "pubring.gpg" (cgp DC..| conduitToTKs) 4) , testCase "conduitToTKsDropping" (testConduitOutputLength "pubring.gpg" (cgp DC..| conduitToTKsDropping) 4) ] , testGroup "Encrypted data" [ testCase "Symmetric Encryption simple S2K SHA1 3DES, no MDC" (testSymmetricEncryption "encryption-sym-3des-s2k0.gpg" "symmetric-password.txt" "test\n") , testCase "Symmetric Encryption iterated-salted S2K SHA1 3DES, no MDC" (testSymmetricEncryption "encryption-sym-3des.gpg" "symmetric-password.txt" "test\n") , testCase "Symmetric Encryption simple S2K SHA1 3DES" (testSymmetricEncryption "encryption-sym-3des-mdc-s2k0.gpg" "symmetric-password.txt" "test\n") , testCase "Symmetric Encryption iterated-salted S2K SHA1 3DES" (testSymmetricEncryption "encryption-sym-3des-mdc.gpg" "symmetric-password.txt" "test\n") , testCase "Symmetric Encryption simple S2K SHA1 CAST5, no MDC" (testSymmetricEncryption "encryption-sym-cast5-s2k0.gpg" "symmetric-password.txt" "test\n") , testCase "Symmetric Encryption iterated-salted S2K SHA1 CAST5, no MDC" (testSymmetricEncryption "encryption-sym-cast5.gpg" "symmetric-password.txt" "test\n") , testCase "Symmetric Encryption simple S2K SHA1 CAST5" (testSymmetricEncryption "encryption-sym-cast5-mdc-s2k0.gpg" "symmetric-password.txt" "test\n") , testCase "Symmetric Encryption iterated-salted S2K SHA1 CAST5" (testSymmetricEncryption "encryption-sym-cast5-mdc.gpg" "symmetric-password.txt" "test\n") , testCase "Symmetric Encryption simple S2K SHA1 Blowfish, no MDC" (testSymmetricEncryption "encryption-sym-blowfish-s2k0.gpg" "symmetric-password.txt" "test\n") , testCase "Symmetric Encryption iterated-salted S2K SHA1 Blowfish, no MDC" (testSymmetricEncryption "encryption-sym-blowfish.gpg" "symmetric-password.txt" "test\n") , testCase "Symmetric Encryption simple S2K SHA1 Blowfish" (testSymmetricEncryption "encryption-sym-blowfish-mdc-s2k0.gpg" "symmetric-password.txt" "test\n") , testCase "Symmetric Encryption iterated-salted S2K SHA1 Blowfish" (testSymmetricEncryption "encryption-sym-blowfish-mdc.gpg" "symmetric-password.txt" "test\n") , testCase "Symmetric Encryption simple S2K SHA1 AES128" (testSymmetricEncryption "encryption-sym-aes128-s2k0.gpg" "symmetric-password.txt" "test\n") , testCase "Symmetric Encryption iterated-salted S2K SHA1 AES128" (testSymmetricEncryption "encryption-sym-aes128.gpg" "symmetric-password.txt" "test\n") , testCase "Symmetric Encryption simple S2K SHA1 AES192" (testSymmetricEncryption "encryption-sym-aes192-s2k0.gpg" "symmetric-password.txt" "test\n") , testCase "Symmetric Encryption iterated-salted S2K SHA1 AES192" (testSymmetricEncryption "encryption-sym-aes192.gpg" "symmetric-password.txt" "test\n") , testCase "Symmetric Encryption simple S2K SHA1 AES256" (testSymmetricEncryption "encryption-sym-aes256-s2k0.gpg" "symmetric-password.txt" "test\n") , testCase "Symmetric Encryption iterated-salted S2K SHA1 AES256" (testSymmetricEncryption "encryption-sym-aes256.gpg" "symmetric-password.txt" "test\n") , testCase "Symmetric Encryption simple S2K SHA1 Twofish" (testSymmetricEncryption "encryption-sym-twofish-s2k0.gpg" "symmetric-password.txt" "test\n") , testCase "Symmetric Encryption iterated-salted S2K SHA1 Twofish" (testSymmetricEncryption "encryption-sym-twofish.gpg" "symmetric-password.txt" "test\n") , testCase "Symmetric Encryption simple Camellia128" (testSymmetricEncryption "encryption-sym-camellia128-s2k0.gpg" "symmetric-password.txt" "test\n") , testCase "Symmetric Encryption iterated-salted Camellia128" (testSymmetricEncryption "encryption-sym-camellia128.gpg" "symmetric-password.txt" "test\n") , testCase "Symmetric Encryption iterated-salted Camellia192" (testSymmetricEncryption "encryption-sym-camellia192.gpg" "symmetric-password.txt" "test\n") , testCase "Symmetric Encryption iterated-salted Camellia256" (testSymmetricEncryption "encryption-sym-camellia256.gpg" "symmetric-password.txt" "test\n") , testCase "Symmetric Encryption pgcrypto" (testSymmetricEncryption "encryption-sym-pgcrypto.pgp" "pgcrypto-passphrase.txt" "{\"t\":\"plus\"}") ] , testGroup "Encrypted secret keys" [ testCase "SUSSHA1 CAST5 IteratedSalted SHA1 RSA" (testSecretKeyDecryption "simple.seckey" "pki-password.txt") , testCase "SUS16bit CAST5 IteratedSalted SHA1 RSA" (testSecretKeyDecryption "16bitcksum.seckey" "pki-password.txt") , testCase "SUSSHA1 AES256 IteratedSalted SHA512 RSA" (testSecretKeyDecryption "aes256-sha512.seckey" "pki-password.txt") , testCase "SUSSHA1 AES128 IteratedSalted SHA256 ECDSA" (testSecretKeyDecryption "nist_p-256_secretkey.gpg" "pki-password.txt") ] , testGroup "Encrypting secret keys" [ testCase "SUSSHA1 AES256 IteratedSalted SHA512 RSA" (testSecretKeyEncryption "unencrypted.seckey" "pki-password.txt") ] , testGroup "Utility function group" [ testCase "pubring as packets" (testParsePktsUtil "pubring.gpg") , testCase "pubring as TKs" (testParseTKsUtil "pubring.gpg") ] ] properties :: TestTree properties = testGroup "Properties" [qcProps] qcProps :: TestTree qcProps = testGroup "(checked by QuickCheck)" [ QC.testProperty "PKESK packet serialization-deserialization" $ \pkesk -> Right (pkesk :: PKESK) == runGet get (runPut (put pkesk)) , QC.testProperty "Signature packet serialization-deserialization" $ \sig -> Right (sig :: Signature) == runGet get (runPut (put sig)) , QC.testProperty "UserId packet serialization-deserialization" $ \uid -> Right (uid :: UserId) == runGet get (runPut (put uid)) ] cgp :: DC.ConduitT B.ByteString Pkt (ResourceT IO) () cgp = conduitGet (get :: Get Pkt) fp :: Text -> TwentyOctetFingerprint fp = either error id . parseFingerprint doPkeyAndSkeyMatch :: PKey -> SKey -> Assertion doPkeyAndSkeyMatch (RSAPubKey (RSA_PublicKey rpub)) (RSAPrivateKey (RSA_PrivateKey rpriv)) = assertEqual "RSA private key matches RSA public key" rpub (RSA.private_pub rpriv) doPkeyAndSkeyMatch (ECDSAPubKey (ECDSA_PublicKey ecpub)) (ECDSAPrivateKey (ECDSA_PrivateKey ecpriv)) = assertEqual "ECDSA private key curve matches ECDSA public key curve" (ECDSA.public_curve ecpub) (ECDSA.private_curve ecpriv) doPkeyAndSkeyMatch _ _ = assertFailure "matching unimplemented" main :: IO () main = defaultMain tests