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 @@ -10,6 +10,7 @@ , verifyTKWith , signUserIDwithRSA , crossSignSubkeyWithRSA + , signDataWithRSA ) where import Control.Error.Util (hush) @@ -188,8 +189,8 @@ 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 user ID being signed - -> PKPayload -- ^ user ID being signed +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 @@ -208,3 +209,9 @@ 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)]) diff --git a/Data/Conduit/OpenPGP/Filter.hs b/Data/Conduit/OpenPGP/Filter.hs --- a/Data/Conduit/OpenPGP/Filter.hs +++ b/Data/Conduit/OpenPGP/Filter.hs @@ -1,5 +1,5 @@ -- Filter.hs: OpenPGP (RFC4880) packet filtering --- Copyright © 2014-2018 Clint Adams +-- Copyright © 2014-2019 Clint Adams -- This software is released under the terms of the Expat license. -- (See the LICENSE file). @@ -7,6 +7,7 @@ module Data.Conduit.OpenPGP.Filter ( conduitPktFilter + , conduitPktWithExtraFilter , conduitTKFilter , FilterPredicates(..) ) where @@ -14,24 +15,33 @@ 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 = +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 -> ConduitT Pkt Pkt m () +conduitPktFilter :: Monad m => FilterPredicates Void Pkt -> ConduitT Pkt Pkt m () conduitPktFilter = CL.filter . superPredicate -superPredicate :: FilterPredicates -> Pkt -> Bool +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 -> ConduitT TK TK m () +conduitTKFilter :: Monad m => FilterPredicates Void TK -> ConduitT TK TK m () conduitTKFilter = CL.filter . superTKPredicate -superTKPredicate :: FilterPredicates -> TK -> Bool +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) diff --git a/hOpenPGP.cabal b/hOpenPGP.cabal --- a/hOpenPGP.cabal +++ b/hOpenPGP.cabal @@ -1,5 +1,5 @@ Name: hOpenPGP -Version: 2.8 +Version: 2.8.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 @@ -218,13 +218,13 @@ , monad-loops , nettle , newtype - , openpgp-asciiarmor >= 0.1 + , openpgp-asciiarmor >= 0.1 , prettyprinter - , resourcet > 0.4 + , resourcet > 0.4 , semigroups , split , text - , time >= 1.1 + , time >= 1.1 , time-locale-compat , transformers , unliftio-core @@ -271,7 +271,7 @@ , semigroups , split , text - , time >= 1.1 + , time >= 1.1 , time-locale-compat , transformers , unliftio-core @@ -280,9 +280,9 @@ , tasty , tasty-hunit , tasty-quickcheck - , QuickCheck > 2.9 + , QuickCheck > 2.9 , quickcheck-instances - , resourcet > 0.4 + , resourcet > 0.4 if flag(network-uri) build-depends: network-uri >= 2.6, network >= 2.6 else @@ -317,13 +317,13 @@ , monad-loops , nettle , newtype - , openpgp-asciiarmor >= 0.1 + , openpgp-asciiarmor >= 0.1 , prettyprinter - , resourcet > 0.4 + , resourcet > 0.4 , semigroups , split , text - , time >= 1.1 + , time >= 1.1 , time-locale-compat , transformers , unliftio-core @@ -343,4 +343,4 @@ source-repository this type: git location: https://salsa.debian.org/clint/hOpenPGP.git - tag: v2.8 + tag: v2.8.1