diff --git a/Codec/Encryption/OpenPGP/Arbitrary.hs b/Codec/Encryption/OpenPGP/Arbitrary.hs --- a/Codec/Encryption/OpenPGP/Arbitrary.hs +++ b/Codec/Encryption/OpenPGP/Arbitrary.hs @@ -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 diff --git a/Codec/Encryption/OpenPGP/CFB.hs b/Codec/Encryption/OpenPGP/CFB.hs --- a/Codec/Encryption/OpenPGP/CFB.hs +++ b/Codec/Encryption/OpenPGP/CFB.hs @@ -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 diff --git a/Codec/Encryption/OpenPGP/Internal.hs b/Codec/Encryption/OpenPGP/Internal.hs --- a/Codec/Encryption/OpenPGP/Internal.hs +++ b/Codec/Encryption/OpenPGP/Internal.hs @@ -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 diff --git a/Codec/Encryption/OpenPGP/KeyInfo.hs b/Codec/Encryption/OpenPGP/KeyInfo.hs --- a/Codec/Encryption/OpenPGP/KeyInfo.hs +++ b/Codec/Encryption/OpenPGP/KeyInfo.hs @@ -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)) diff --git a/Codec/Encryption/OpenPGP/KeyringParser.hs b/Codec/Encryption/OpenPGP/KeyringParser.hs --- a/Codec/Encryption/OpenPGP/KeyringParser.hs +++ b/Codec/Encryption/OpenPGP/KeyringParser.hs @@ -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 diff --git a/Codec/Encryption/OpenPGP/Ontology.hs b/Codec/Encryption/OpenPGP/Ontology.hs --- a/Codec/Encryption/OpenPGP/Ontology.hs +++ b/Codec/Encryption/OpenPGP/Ontology.hs @@ -74,7 +74,7 @@ isPHA _ = False isRevocationKeySSP :: SigSubPacket -> Bool -isRevocationKeySSP (SigSubPacket _ (RevocationKey {})) = True +isRevocationKeySSP (SigSubPacket _ RevocationKey{}) = True isRevocationKeySSP _ = False isSigCreationTime :: SigSubPacket -> Bool diff --git a/Codec/Encryption/OpenPGP/SecretKey.hs b/Codec/Encryption/OpenPGP/SecretKey.hs --- a/Codec/Encryption/OpenPGP/SecretKey.hs +++ b/Codec/Encryption/OpenPGP/SecretKey.hs @@ -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 diff --git a/Codec/Encryption/OpenPGP/Serialize.hs b/Codec/Encryption/OpenPGP/Serialize.hs --- a/Codec/Encryption/OpenPGP/Serialize.hs +++ b/Codec/Encryption/OpenPGP/Serialize.hs @@ -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) diff --git a/Codec/Encryption/OpenPGP/Signatures.hs b/Codec/Encryption/OpenPGP/Signatures.hs --- a/Codec/Encryption/OpenPGP/Signatures.hs +++ b/Codec/Encryption/OpenPGP/Signatures.hs @@ -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 diff --git a/Codec/Encryption/OpenPGP/Types.hs b/Codec/Encryption/OpenPGP/Types.hs --- a/Codec/Encryption/OpenPGP/Types.hs +++ b/Codec/Encryption/OpenPGP/Types.hs @@ -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 diff --git a/Codec/Encryption/OpenPGP/Types/Internal/PKITypes.hs b/Codec/Encryption/OpenPGP/Types/Internal/PKITypes.hs --- a/Codec/Encryption/OpenPGP/Types/Internal/PKITypes.hs +++ b/Codec/Encryption/OpenPGP/Types/Internal/PKITypes.hs @@ -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 diff --git a/Codec/Encryption/OpenPGP/Types/Internal/Pkt.hs b/Codec/Encryption/OpenPGP/Types/Internal/Pkt.hs --- a/Codec/Encryption/OpenPGP/Types/Internal/Pkt.hs +++ b/Codec/Encryption/OpenPGP/Types/Internal/Pkt.hs @@ -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? diff --git a/Data/Conduit/OpenPGP/Decrypt.hs b/Data/Conduit/OpenPGP/Decrypt.hs --- a/Data/Conduit/OpenPGP/Decrypt.hs +++ b/Data/Conduit/OpenPGP/Decrypt.hs @@ -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] diff --git a/Data/Conduit/OpenPGP/Keyring.hs b/Data/Conduit/OpenPGP/Keyring.hs --- a/Data/Conduit/OpenPGP/Keyring.hs +++ b/Data/Conduit/OpenPGP/Keyring.hs @@ -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 diff --git a/Data/Conduit/OpenPGP/Keyring/Instances.hs b/Data/Conduit/OpenPGP/Keyring/Instances.hs --- a/Data/Conduit/OpenPGP/Keyring/Instances.hs +++ b/Data/Conduit/OpenPGP/Keyring/Instances.hs @@ -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) diff --git a/Data/Conduit/OpenPGP/Verify.hs b/Data/Conduit/OpenPGP/Verify.hs --- a/Data/Conduit/OpenPGP/Verify.hs +++ b/Data/Conduit/OpenPGP/Verify.hs @@ -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 diff --git a/bench/mark.hs b/bench/mark.hs --- a/bench/mark.hs +++ b/bench/mark.hs @@ -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 diff --git a/hOpenPGP.cabal b/hOpenPGP.cabal --- a/hOpenPGP.cabal +++ b/hOpenPGP.cabal @@ -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 diff --git a/tests/data/debian-keyring.gpg b/tests/data/debian-keyring.gpg deleted file mode 100644 # file too large to diff: tests/data/debian-keyring.gpg diff --git a/tests/suite.hs b/tests/suite.hs --- a/tests/suite.hs +++ b/tests/suite.hs @@ -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" [