hOpenPGP 2.7.1 → 2.7.2
raw patch · 2 files changed
+45/−4 lines, 2 files
Files
- Codec/Encryption/OpenPGP/Signatures.hs +43/−2
- hOpenPGP.cabal +2/−2
Codec/Encryption/OpenPGP/Signatures.hs view
@@ -8,6 +8,8 @@ , verifyAgainstKeyring , verifyAgainstKeys , verifyTKWith+ , signUserIDwithRSA+ , crossSignSubkeyWithRSA ) where import Control.Error.Util (hush)@@ -15,17 +17,21 @@ import Control.Monad (liftM2) import qualified Crypto.Hash.Algorithms as CHA-import Crypto.Number.Serialize (i2osp)+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.RSA.PKCS15 as P15+import qualified Crypto.PubKey.RSA.Types as RSATypes +import Data.Bifunctor (first)+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.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)@@ -35,7 +41,7 @@ import Codec.Encryption.OpenPGP.Internal (PktStreamContext(..), issuer, emptyPSC) import Codec.Encryption.OpenPGP.Ontology (isRevokerP, isRevocationKeySSP, isSubkeyBindingSig, isSubkeyRevocation) -import Codec.Encryption.OpenPGP.SerializeForSigs (putPartialSigforSigning, putSigTrailer, payloadForSig)+import Codec.Encryption.OpenPGP.SerializeForSigs (putPartialSigforSigning, putSigTrailer, payloadForSig, putKeyforSigning, putUforSigning) import Codec.Encryption.OpenPGP.Types import Data.Conduit.OpenPGP.Keyring.Instances () @@ -153,3 +159,38 @@ 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 user ID being signed+ -> PKPayload -- ^ user ID 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)])
hOpenPGP.cabal view
@@ -1,5 +1,5 @@ Name: hOpenPGP-Version: 2.7.1+Version: 2.7.2 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@@ -338,4 +338,4 @@ source-repository this type: git location: https://salsa.debian.org/clint/hOpenPGP.git- tag: v2.7.1+ tag: v2.7.2