hOpenPGP 2.5.1 → 2.5.2
raw patch · 20 files changed
+99/−106 lines, 20 filesdep ~QuickCheck
Dependency ranges changed: QuickCheck
Files
- Codec/Encryption/OpenPGP/Arbitrary.hs +36/−33
- Codec/Encryption/OpenPGP/CFB.hs +1/−2
- Codec/Encryption/OpenPGP/Internal.hs +1/−1
- Codec/Encryption/OpenPGP/KeyInfo.hs +1/−1
- Codec/Encryption/OpenPGP/KeyringParser.hs +2/−2
- Codec/Encryption/OpenPGP/Ontology.hs +1/−1
- Codec/Encryption/OpenPGP/SecretKey.hs +7/−7
- Codec/Encryption/OpenPGP/Serialize.hs +8/−8
- Codec/Encryption/OpenPGP/Signatures.hs +1/−1
- Codec/Encryption/OpenPGP/Types.hs +7/−14
- Codec/Encryption/OpenPGP/Types/Internal/PKITypes.hs +4/−4
- Codec/Encryption/OpenPGP/Types/Internal/Pkt.hs +8/−8
- Data/Conduit/OpenPGP/Decrypt.hs +2/−2
- Data/Conduit/OpenPGP/Keyring.hs +3/−3
- Data/Conduit/OpenPGP/Keyring/Instances.hs +7/−7
- Data/Conduit/OpenPGP/Verify.hs +3/−3
- bench/mark.hs +4/−4
- hOpenPGP.cabal +2/−3
- tests/data/debian-keyring.gpg too large to diff
- tests/suite.hs +1/−2
Codec/Encryption/OpenPGP/Arbitrary.hs view
@@ -1,12 +1,13 @@ -- Arbitrary.hs: QuickCheck instances--- Copyright © 2014-2015 Clint Adams+-- Copyright © 2014-2016 Clint Adams -- This software is released under the terms of the Expat license. -- (See the LICENSE file). +{-# LANGUAGE CPP #-}+ module Codec.Encryption.OpenPGP.Arbitrary () where import Codec.Encryption.OpenPGP.Types-import Control.Monad (liftM) import qualified Data.ByteString.Lazy as BL import qualified Data.List.NonEmpty as NE import Data.Maybe (fromMaybe)@@ -22,10 +23,10 @@ return $ PKESK pv eoki pka mpis instance Arbitrary Signature where- arbitrary = liftM Signature arbitrary+ arbitrary = fmap Signature arbitrary instance Arbitrary UserId where- arbitrary = liftM UserId arbitrary+ arbitrary = fmap UserId arbitrary -- @@ -64,28 +65,28 @@ 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 {-, es -}, udss, oss] where- sct = liftM SigCreationTime arbitrary- set = liftM SigExpirationTime arbitrary- ec = liftM ExportableCertification arbitrary+ sct = fmap SigCreationTime arbitrary+ set = fmap SigExpirationTime arbitrary+ ec = fmap ExportableCertification arbitrary ts = arbitrary >>= \tl -> arbitrary >>= \ta -> return (TrustSignature tl ta)- re = liftM RegularExpression arbitrary- ket = liftM KeyExpirationTime arbitrary- psa = liftM PreferredSymmetricAlgorithms arbitrary+ 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 = liftM Issuer arbitrary+ i = fmap Issuer arbitrary nd = arbitrary >>= \nfs -> arbitrary >>= \nn -> arbitrary >>= \nv -> return (NotationData nfs nn nv)- phas = liftM PreferredHashAlgorithms arbitrary- pcas = liftM PreferredCompressionAlgorithms arbitrary- ksps = liftM KeyServerPreferences arbitrary- pks = liftM PreferredKeyServer arbitrary- puid = liftM PrimaryUserId arbitrary- purl = liftM (PolicyURL . URL . fromMaybe nullURI . parseURI) arbitrary- kfs = liftM KeyFlags arbitrary- suid = liftM SignersUserId arbitrary+ 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 = liftM Features arbitrary+ fs = fmap Features arbitrary st = arbitrary >>= \pka -> arbitrary >>= \ha -> arbitrary >>= \sh -> return (SignatureTarget pka ha sh)- es = liftM EmbeddedSignature arbitrary -- FIXME: figure out why EmbeddedSignature fails to serialize properly+ es = fmap EmbeddedSignature arbitrary -- FIXME: figure out why EmbeddedSignature fails to serialize properly 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 @@ -95,13 +96,13 @@ arbitrary = elements [RSA, DSA, ECDH, ECDSA, DH] instance Arbitrary EightOctetKeyId where- arbitrary = liftM (EightOctetKeyId . BL.pack) (vector 8)+ arbitrary = fmap (EightOctetKeyId . BL.pack) (vector 8) instance Arbitrary TwentyOctetFingerprint where- arbitrary = liftM (TwentyOctetFingerprint . BL.pack) (vector 20)+ arbitrary = fmap (TwentyOctetFingerprint . BL.pack) (vector 20) instance Arbitrary MPI where- arbitrary = liftM (MPI . getPositive) arbitrary+ 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]@@ -130,13 +131,13 @@ arbitrary = frequency [(9,srk),(1,rco)] where srk = return SensitiveRK- rco = liftM RClOther (choose (2,7))+ rco = fmap RClOther (choose (2,7)) instance Arbitrary NotationFlag where arbitrary = frequency [(9,hr),(1,onf)] where hr = return HumanReadable- onf = liftM OtherNF (choose (1,31))+ onf = fmap OtherNF (choose (1,31)) instance Arbitrary CompressionAlgorithm where arbitrary = elements [Uncompressed,ZIP,ZLIB,BZip2]@@ -145,7 +146,7 @@ arbitrary = frequency [(9,nm),(1,kspo)] where nm = return NoModify- kspo = liftM KSPOther (choose (2,63))+ kspo = fmap KSPOther (choose (2,63)) instance Arbitrary KeyFlag where arbitrary = elements [GroupKey, AuthKey, SplitKey, EncryptStorageKey, EncryptCommunicationsKey, SignDataKey, CertifyKeysKey]@@ -157,20 +158,22 @@ arbitrary = frequency [(9,md),(1,fo)] where md = return ModificationDetection- fo = liftM FeatureOther (choose (8,63))+ fo = fmap FeatureOther (choose (8,63)) instance Arbitrary ThirtyTwoBitTimeStamp where- arbitrary = liftM ThirtyTwoBitTimeStamp arbitrary+ arbitrary = fmap ThirtyTwoBitTimeStamp arbitrary instance Arbitrary ThirtyTwoBitDuration where- arbitrary = liftM ThirtyTwoBitDuration arbitrary+ arbitrary = fmap ThirtyTwoBitDuration arbitrary instance Arbitrary NotationName where- arbitrary = liftM NotationName arbitrary+ arbitrary = fmap NotationName arbitrary instance Arbitrary NotationValue where- arbitrary = liftM NotationValue arbitrary+ arbitrary = fmap NotationValue arbitrary +#if !MIN_VERSION_QuickCheck(2,9,0) -- FIXME: this should be elsewhere instance Arbitrary a => Arbitrary (NE.NonEmpty a) where- arbitrary = NE.fromList `liftM` listOf1 arbitrary+ arbitrary = NE.fromList `fmap` listOf1 arbitrary+#endif
Codec/Encryption/OpenPGP/CFB.hs view
@@ -19,7 +19,6 @@ #if !MIN_VERSION_base(4,8,0) import Control.Applicative ((<$>), (<*>)) #endif-import Control.Monad (liftM) import qualified Data.ByteString as B decryptOpenPGPCfb :: SymmetricAlgorithm -> B.ByteString -> B.ByteString -> Either String B.ByteString@@ -37,7 +36,7 @@ decrypt :: SymmetricAlgorithm -> B.ByteString -> B.ByteString -> Either String B.ByteString decrypt Plaintext ciphertext _ = return ciphertext decrypt sa ciphertext keydata = withSymmetricCipher sa keydata $ \bc -> do- (nonce, cleartext) <- liftM (B.splitAt (blockSize bc + 2)) (decrypt' ciphertext bc)+ (nonce, cleartext) <- fmap (B.splitAt (blockSize bc + 2)) (decrypt' ciphertext bc) if nonceCheck bc nonce then return cleartext else Left "Session key quickcheck failed" where decrypt' :: HOBlockCipher cipher => B.ByteString -> cipher -> Either String B.ByteString
Codec/Encryption/OpenPGP/Internal.hs view
@@ -73,7 +73,7 @@ ] where pkParams f = MPI . f . DSA.public_params $ k -pubkeyToMPIs (ElGamalPubKey k) = fmap MPI k+pubkeyToMPIs (ElGamalPubKey p g y) = [MPI p, MPI g, MPI y] multiplicativeInverse :: Integral a => a -> a -> a multiplicativeInverse _ 1 = 1
Codec/Encryption/OpenPGP/KeyInfo.hs view
@@ -18,7 +18,7 @@ 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 x) = Right (bitcount $ head x)+pubkeySize (ElGamalPubKey p _ _) = Right (bitcount p) pubkeySize x = Left $ "Unable to calculate size of " ++ show x bitcount = (*8) . length . unfoldr (\x -> if x == 0 then Nothing else Just (True, x `shiftR` 8))
Codec/Encryption/OpenPGP/KeyringParser.hs view
@@ -125,8 +125,8 @@ signature' = do [SignaturePkt sp] <- satisfy (isSP intolerant) return $! (if intolerant then id else filter isSP') [sp] brokensig' = const [] <$> broken 2- isSP True [SignaturePkt sp@(SigV3 {})] = isSP' sp- isSP True [SignaturePkt sp@(SigV4 {})] = isSP' sp+ 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
Codec/Encryption/OpenPGP/Ontology.hs view
@@ -74,7 +74,7 @@ isPHA _ = False isRevocationKeySSP :: SigSubPacket -> Bool-isRevocationKeySSP (SigSubPacket _ (RevocationKey {})) = True+isRevocationKeySSP (SigSubPacket _ RevocationKey{}) = True isRevocationKeySSP _ = False isSigCreationTime :: SigSubPacket -> Bool
Codec/Encryption/OpenPGP/SecretKey.hs view
@@ -32,10 +32,10 @@ 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+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@@ -67,9 +67,9 @@ -- |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 _ _ 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
Codec/Encryption/OpenPGP/Serialize.hs view
@@ -18,7 +18,7 @@ #endif import Control.Applicative (many, some) import Control.Lens ((^.), _1)-import Control.Monad (guard, liftM, replicateM, replicateM_)+import Control.Monad (guard, replicateM, replicateM_) import Crypto.Number.Basic (numBits) import Crypto.Number.Serialize (i2osp, os2ip) import qualified Crypto.PubKey.RSA as R@@ -56,19 +56,19 @@ -- put = putNotationFlagSet instance Binary CompressionAlgorithm where- get = liftM toFVal getWord8+ get = toFVal <$> getWord8 put = putWord8 . fromFVal instance Binary PubKeyAlgorithm where- get = liftM toFVal getWord8+ get = toFVal <$> getWord8 put = putWord8 . fromFVal instance Binary HashAlgorithm where- get = liftM toFVal getWord8+ get = toFVal <$> getWord8 put = putWord8 . fromFVal instance Binary SymmetricAlgorithm where- get = liftM toFVal getWord8+ get = toFVal <$> getWord8 put = putWord8 . fromFVal instance Binary MPI where@@ -76,7 +76,7 @@ put = putMPI instance Binary SigType where- get = liftM toFVal getWord8+ get = toFVal <$> getWord8 put = putWord8 . fromFVal instance Binary UserAttrSubPacket where@@ -782,7 +782,7 @@ getPubkey ForbiddenElgamal = do MPI p <- get MPI g <- get MPI y <- get- return $ ElGamalPubKey [p,g,y]+ return $ ElGamalPubKey p g y getPubkey _ = UnknownPKey <$> getRemainingLazyByteString putPubkey :: PKey -> Put@@ -805,7 +805,7 @@ return $ DSAPrivateKey (DSA_PrivateKey (D.PrivateKey (D.Params 0 0 0) x)) | _pkalgo pkp `elem` [ElgamalEncryptOnly,ForbiddenElgamal] = do MPI x <- get- return $ ElGamalPrivateKey [x]+ return $ ElGamalPrivateKey x putSKey :: SKey -> Put putSKey (RSAPrivateKey (RSA_PrivateKey (R.PrivateKey _ d p q _ _ _))) = put (MPI d) >> put (MPI p) >> put (MPI q) >> put (MPI u)
Codec/Encryption/OpenPGP/Signatures.hs view
@@ -154,5 +154,5 @@ where sigbit = runPut $ putPartialSigforSigning s trailer :: Pkt -> ByteString- trailer (SignaturePkt (SigV4 {})) = runPut $ putSigTrailer s+ trailer (SignaturePkt SigV4{}) = runPut $ putSigTrailer s trailer _ = BL.empty
Codec/Encryption/OpenPGP/Types.hs view
@@ -3,18 +3,11 @@ -- This software is released under the terms of the Expat license. -- (See the LICENSE file). -module Codec.Encryption.OpenPGP.Types (- module Codec.Encryption.OpenPGP.Types.Internal.Base- , module Codec.Encryption.OpenPGP.Types.Internal.CryptoniteNewtypes- , module Codec.Encryption.OpenPGP.Types.Internal.PacketClass- , module Codec.Encryption.OpenPGP.Types.Internal.PKITypes- , module Codec.Encryption.OpenPGP.Types.Internal.Pkt- , module Codec.Encryption.OpenPGP.Types.Internal.TK-) where+module Codec.Encryption.OpenPGP.Types (module X) where -import Codec.Encryption.OpenPGP.Types.Internal.Base-import Codec.Encryption.OpenPGP.Types.Internal.CryptoniteNewtypes-import Codec.Encryption.OpenPGP.Types.Internal.PacketClass-import Codec.Encryption.OpenPGP.Types.Internal.PKITypes-import Codec.Encryption.OpenPGP.Types.Internal.Pkt-import Codec.Encryption.OpenPGP.Types.Internal.TK+import Codec.Encryption.OpenPGP.Types.Internal.Base as X+import Codec.Encryption.OpenPGP.Types.Internal.CryptoniteNewtypes as X+import Codec.Encryption.OpenPGP.Types.Internal.PacketClass as X+import Codec.Encryption.OpenPGP.Types.Internal.PKITypes as X+import Codec.Encryption.OpenPGP.Types.Internal.Pkt as X+import Codec.Encryption.OpenPGP.Types.Internal.TK as X
Codec/Encryption/OpenPGP/Types/Internal/PKITypes.hs view
@@ -30,7 +30,7 @@ data PKey = RSAPubKey RSA_PublicKey | DSAPubKey DSA_PublicKey- | ElGamalPubKey [Integer]+ | ElGamalPubKey Integer Integer Integer | ECDHPubKey ECDSA_PublicKey HashAlgorithm SymmetricAlgorithm | ECDSAPubKey ECDSA_PublicKey | UnknownPKey ByteString@@ -41,7 +41,7 @@ instance Pretty PKey where pretty (RSAPubKey p) = text "RSA" <+> pretty p pretty (DSAPubKey p) = text "DSA" <+> pretty p- pretty (ElGamalPubKey p) = text "Elgamal" <+> pretty p+ pretty (ElGamalPubKey p g y) = text "Elgamal" <+> pretty p <+> pretty g <+> pretty y pretty (ECDHPubKey p ha sa) = text "ECDH" <+> pretty p <+> pretty ha <+> pretty sa pretty (ECDSAPubKey p) = text "ECDSA" <+> pretty p pretty (UnknownPKey bs) = text "unknown" <+> pretty bs@@ -49,14 +49,14 @@ instance A.ToJSON PKey where toJSON (RSAPubKey p) = A.toJSON p toJSON (DSAPubKey p) = A.toJSON p- toJSON (ElGamalPubKey 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 (UnknownPKey bs) = A.toJSON (BL.unpack bs) data SKey = RSAPrivateKey RSA_PrivateKey | DSAPrivateKey DSA_PrivateKey- | ElGamalPrivateKey [Integer]+ | ElGamalPrivateKey Integer | ECDHPrivateKey ECDSA_PrivateKey | ECDSAPrivateKey ECDSA_PrivateKey | UnknownSKey ByteString
Codec/Encryption/OpenPGP/Types/Internal/Pkt.hs view
@@ -109,22 +109,22 @@ toJSON (BrokenPacketPkt s t bs) = object [T.pack "brokenpacket" .= object [T.pack "error" .= s, T.pack "tag" .= t, T.pack "data" .= BL.unpack bs]] pktTag :: Pkt -> Word8-pktTag (PKESKPkt {}) = 1+pktTag PKESKPkt{} = 1 pktTag (SignaturePkt _) = 2-pktTag (SKESKPkt {}) = 3-pktTag (OnePassSignaturePkt {}) = 4-pktTag (SecretKeyPkt {}) = 5+pktTag SKESKPkt{} = 3+pktTag OnePassSignaturePkt{} = 4+pktTag SecretKeyPkt{} = 5 pktTag (PublicKeyPkt _) = 6-pktTag (SecretSubkeyPkt {}) = 7-pktTag (CompressedDataPkt {}) = 8+pktTag SecretSubkeyPkt{} = 7+pktTag CompressedDataPkt{} = 8 pktTag (SymEncDataPkt _) = 9 pktTag (MarkerPkt _) = 10-pktTag (LiteralDataPkt {}) = 11+pktTag LiteralDataPkt{} = 11 pktTag (TrustPkt _) = 12 pktTag (UserIdPkt _) = 13 pktTag (PublicSubkeyPkt _) = 14 pktTag (UserAttributePkt _) = 17-pktTag (SymEncIntegrityProtectedDataPkt {}) = 18+pktTag SymEncIntegrityProtectedDataPkt{} = 18 pktTag (ModificationDetectionCodePkt _) = 19 pktTag (OtherPacketPkt t _) = t pktTag (BrokenPacketPkt _ t _) = t -- is this the right thing to do?
Data/Conduit/OpenPGP/Decrypt.hs view
@@ -52,7 +52,7 @@ 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) }, [])+ SKESKPkt{} -> return (s { _lastSKESK = Just (fromPkt i) }, []) (SymEncDataPkt bs) -> do d <- decryptSEDP (_depth s) cb (fromJust . _lastSKESK $ s) bs return (processLDPs s d, d) (SymEncIntegrityProtectedDataPkt _ bs) -> do d <- decryptSEIPDP (_depth s) cb (fromJust . _lastSKESK $ s) bs@@ -62,7 +62,7 @@ return (s, [m]) p -> return (s, [p]) processLDPs s ds = S.execState (mapM_ ldpCheck ds) s- ldpCheck l@(LiteralDataPkt {}) = S.get >>= \o -> S.put o { _lastLDP = Just . fromPkt $ l }+ ldpCheck l@LiteralDataPkt{} = S.get >>= \o -> S.put o { _lastLDP = Just . fromPkt $ l } ldpCheck _ = return () decryptSEDP :: (MonadBaseControl IO m, MonadIO m, MonadThrow m) => Int -> InputCallback IO -> SKESK -> BL.ByteString -> m [Pkt]
Data/Conduit/OpenPGP/Keyring.hs view
@@ -1,5 +1,5 @@ -- Keyring.hs: OpenPGP (RFC4880) transferable keys parsing--- Copyright © 2012-2014 Clint Adams+-- Copyright © 2012-2016 Clint Adams -- This software is released under the terms of the Expat license. -- (See the LICENSE file). @@ -32,11 +32,11 @@ loop where loop accum =- await >>= maybe (Prelude.mapM_ yield (snd (finalizer accum))) go+ await >>= maybe (mapM_ yield (snd (finalizer accum))) go where go a = do let (accum', bs) = f a accum- Prelude.mapM_ yield bs+ mapM_ yield bs loop accum' conduitToTKs' :: Monad m => Bool -> Conduit Pkt m TK
Data/Conduit/OpenPGP/Keyring/Instances.hs view
@@ -1,5 +1,5 @@ -- Instances.hs: OpenPGP (RFC4880) additional types for transferable keys--- Copyright © 2012-2015 Clint Adams+-- Copyright © 2012-2016 Clint Adams -- This software is released under the terms of the Expat license. -- (See the LICENSE file). @@ -41,12 +41,12 @@ 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+ 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)
Data/Conduit/OpenPGP/Verify.hs view
@@ -1,5 +1,5 @@ -- Verify.hs: OpenPGP (RFC4880) signature verification--- Copyright © 2012-2014 Clint Adams+-- Copyright © 2012-2016 Clint Adams -- This software is released under the terms of the Expat license. -- (See the LICENSE file). @@ -18,14 +18,14 @@ conduitVerify :: Monad m => Keyring -> Maybe UTCTime -> Conduit Pkt m (Either String Verification) conduitVerify kr mt = CL.concatMapAccum (flip push) emptyPSC where- push state ld@(LiteralDataPkt {}) = (state { lastLD = ld }, [])+ 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 sig@(SignaturePkt SigV4{}) = (state { lastSig = sig }, [verifySigWith (verifyAgainstKeyring kr) sig state mt]) push state (OnePassSignaturePkt _ _ _ _ _ False) = (state, []) push state _ = (state, []) normLineEndings = id -- FIXME
bench/mark.hs view
@@ -21,10 +21,10 @@ main :: IO () main = defaultMain [- bgroup "keyring" [ bench "load keys" $ whnfIO (loadKeys "tests/data/debian-keyring.gpg")- , bench "load keyring" $ whnfIO (loadKeyring "tests/data/debian-keyring.gpg")- , bench "self-verify keys" $ whnfIO (selfVerifyKeys "tests/data/debian-keyring.gpg")- , bench "self-verify keyring" $ whnfIO (selfVerifyKeyring "tests/data/debian-keyring.gpg")+ 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
hOpenPGP.cabal view
@@ -1,5 +1,5 @@ Name: hOpenPGP-Version: 2.5.1+Version: 2.5.2 Synopsis: native Haskell implementation of OpenPGP (RFC4880) Description: native Haskell implementation of OpenPGP (RFC4880), plus Camellia (RFC5581) Homepage: http://floss.scru.org/hOpenPGP/@@ -145,7 +145,6 @@ , tests/data/expired.pubkey , tests/data/sigs-with-regexes , tests/data/gnu-dummy-s2k-101-secret-key.gpg- , tests/data/debian-keyring.gpg , tests/data/anibal-ed25519.gpg Cabal-version: >= 1.10@@ -337,4 +336,4 @@ source-repository this type: git location: git://git.debian.org/users/clint/hOpenPGP.git- tag: v2.5.1+ tag: v2.5.2
− tests/data/debian-keyring.gpg
file too large to diff
tests/suite.hs view
@@ -167,7 +167,7 @@ testParsePktsUtil fn = do let fpath = "tests/data/" ++ fn cp <- runResourceT $ CB.sourceFile fpath DC.$= conduitGet get DC.$$ CL.consume- pp <- BL.readFile fpath >>= return . parsePkts+ pp <- parsePkts `fmap` BL.readFile fpath assertEqual "parsePkts utility function gives same results as conduit pipeline" cp pp testParseTKsUtil :: FilePath -> Assertion@@ -287,7 +287,6 @@ , testCase "secring 7732CF988A63EA86" (testKeyringLookup "secring.gpg" "7732CF988A63EA86" True) , testCase "secring 123456789ABCDEF0" (testKeyringLookup "secring.gpg" "123456789ABCDEF0" False) , testCase "secsub AD992E9C24399832" (testKeyringLookup "secring.gpg" "AD992E9C24399832" True)- , testCase "d-k 94FA372B2DA8B985" (testKeyringLookup "debian-keyring.gpg" "0x94FA372B2DA8B985" False) -- FIXME: should count keys in rings ], testGroup "Message verification group" [