hOpenPGP 0.5.2 → 0.6

raw patch · 14 files changed

+179/−200 lines, 14 filesdep +crypto-pubkeydep +hOpenPGPdep +ixsetdep −asn1-datadep −cryptocipherPVP ok

version bump matches the API change (PVP)

Dependencies added: crypto-pubkey, hOpenPGP, ixset, lens

Dependencies removed: asn1-data, cryptocipher

API changes (from Hackage documentation)

Files

• Codec/Encryption/OpenPGP/Compression.hs +11/−9
• Codec/Encryption/OpenPGP/Fingerprint.hs +2/−2
• Codec/Encryption/OpenPGP/Internal.hs +15/−52
• Codec/Encryption/OpenPGP/Serialize.hs +7/−18
• Codec/Encryption/OpenPGP/SerializeForSigs.hs +1/−1
• Codec/Encryption/OpenPGP/Types.hs +68/−61
• Codec/Encryption/OpenPGP/Verify.hs +25/−25
• Data/Conduit/OpenPGP/Compression.hs +1/−1
• Data/Conduit/OpenPGP/Keyring.hs +5/−15
• Data/Conduit/OpenPGP/Keyring/Instances.hs +28/−0
• Data/Conduit/OpenPGP/Verify.hs +1/−1
• LICENSE +1/−1
• hOpenPGP.cabal +11/−11
• tests/suite.hs +3/−3

@@ -1,5 +1,5 @@ -- Compression.hs: OpenPGP (RFC4880) compression and decompression--- Copyright © 2012  Clint Adams+-- Copyright © 2012-2013  Clint Adams -- This software is released under the terms of the ISC license. -- (See the LICENSE file). @@ -26,10 +26,11 @@                        Right packs -> unBlock packs     where         decompressPkt' :: CompressionAlgorithm -> ByteString -> BL.ByteString-        decompressPkt' ZIP bs = ZlibRaw.decompress $ BL.fromChunks [bs]-        decompressPkt' ZLIB bs = Zlib.decompress $ BL.fromChunks [bs]-        decompressPkt' BZip2 bs = BZip.decompress $ BL.fromChunks [bs]-        decompressPkt' _ _ = error "Compression algorithm not supported"+	decompressPkt' ca bs = dfunc ca (BL.fromChunks [bs])+        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@@ -39,7 +40,8 @@     CompressedDataPkt ca cbs     where         compressPkts' :: CompressionAlgorithm -> ByteString -> BL.ByteString-        compressPkts' ZIP bs = ZlibRaw.compress $ BL.fromChunks [bs]-        compressPkts' ZLIB bs = Zlib.compress $ BL.fromChunks [bs]-        compressPkts' BZip2 bs = BZip.compress $ BL.fromChunks [bs]-        compressPkts' _ _ = error "Compression algorithm not supported"+        compressPkts' ca bs = cfunc ca (BL.fromChunks [bs])+        cfunc ZIP = ZlibRaw.compress+        cfunc ZLIB = Zlib.compress+        cfunc BZip2 = BZip.compress+        cfunc _ = error "Compression algorithm not supported"

@@ -1,5 +1,5 @@ -- Fingerprint.hs: OpenPGP (RFC4880) fingerprinting methods--- Copyright © 2012  Clint Adams+-- Copyright © 2012-2013  Clint Adams -- This software is released under the terms of the ISC license. -- (See the LICENSE file). @@ -8,7 +8,7 @@  , fingerprint ) where -import qualified Crypto.Cipher.RSA as RSA+import qualified Crypto.PubKey.RSA as RSA import qualified Crypto.Hash.MD5 as MD5 import qualified Crypto.Hash.SHA1 as SHA1 import qualified Data.ByteString as B

@@ -1,5 +1,5 @@ -- Internal.hs: private utility functions--- Copyright © 2012  Clint Adams+-- Copyright © 2012-2013  Clint Adams -- This software is released under the terms of the ISC license. -- (See the LICENSE file). @@ -8,31 +8,21 @@  , beBSToInteger  , integerToBEBS  , PktStreamContext(..)- , asn1Prefix- , hash+ , hashDescr  , issuer  , emptyPSC  , pubkeyToMPIs ) where -import qualified Crypto.Cipher.DSA as DSA-import qualified Crypto.Cipher.RSA as RSA--import qualified Crypto.Hash.MD5 as MD5 import qualified Crypto.Hash.RIPEMD160 as RIPEMD160-import qualified Crypto.Hash.SHA1 as SHA1-import qualified Crypto.Hash.SHA224 as SHA224-import qualified Crypto.Hash.SHA256 as SHA256-import qualified Crypto.Hash.SHA384 as SHA384-import qualified Crypto.Hash.SHA512 as SHA512+import Crypto.PubKey.HashDescr (HashDescr(..), hashDescrMD5, hashDescrSHA1, hashDescrSHA224, hashDescrSHA256, hashDescrSHA384, hashDescrSHA512)+import qualified Crypto.PubKey.DSA as DSA+import qualified Crypto.PubKey.RSA as RSA -import qualified Data.ASN1.BinaryEncoding as ASN1BE-import qualified Data.ASN1.Encoding as ASN1E-import qualified Data.ASN1.Stream as ASN1S import Data.Bits (testBit, shiftL, shiftR, (.&.)) import Data.ByteString (ByteString) import qualified Data.ByteString as B-import qualified Data.ByteString.Lazy as BL+import qualified Data.ByteString.Char8 as BC8 import Data.List (find, mapAccumR, unfoldr) import Data.Word (Word8, Word16) @@ -68,42 +58,15 @@         isIssuer _ = False issuer _ = Nothing -hash :: HashAlgorithm -> ByteString -> ByteString-hash SHA1 = SHA1.hash-hash RIPEMD160 = RIPEMD160.hash-hash SHA256 = SHA256.hash-hash SHA384 = SHA384.hash-hash SHA512 = SHA512.hash-hash SHA224 = SHA224.hash-hash DeprecatedMD5 = MD5.hash-hash _ = id -- FIXME--asn1Prefix :: HashAlgorithm -> ByteString-asn1Prefix ha = do-    let start = ASN1S.Start ASN1S.Sequence-    let (blen, oid) = (bitLength ha, hashOid ha)-    let numpty = ASN1S.Null-    let end = ASN1S.End ASN1S.Sequence-    let fakeint = ASN1S.OctetString (BL.pack (replicate ((blen `div` 8) - 1) 0 ++ [1]))-    B.concat . BL.toChunks $ getPrefix (ASN1E.encodeASN1 ASN1BE.DER [start,start,oid,numpty,end,fakeint,end])-    where-        getPrefix = BL.reverse . BL.dropWhile (==0) . BL.drop 1 . BL.reverse-        bitLength DeprecatedMD5 = 128-        bitLength SHA1 = 160-        bitLength RIPEMD160 = 160-        bitLength SHA256 = 256-        bitLength SHA384 = 384-        bitLength SHA512 = 512-        bitLength SHA224 = 224-        bitLength _ = 0-        hashOid DeprecatedMD5 = ASN1S.OID [1,2,840,113549,2,5]-        hashOid RIPEMD160 = ASN1S.OID [1,3,36,3,2,1]-        hashOid SHA1 = ASN1S.OID [1,3,14,3,2,26]-        hashOid SHA224 = ASN1S.OID [2,16,840,1,101,3,4,2,4]-        hashOid SHA256 = ASN1S.OID [2,16,840,1,101,3,4,2,1]-        hashOid SHA384 = ASN1S.OID [2,16,840,1,101,3,4,2,2]-        hashOid SHA512 = ASN1S.OID [2,16,840,1,101,3,4,2,3]-        hashOid _ = ASN1S.OID []+hashDescr :: HashAlgorithm -> HashDescr+hashDescr SHA1 = hashDescrSHA1+hashDescr RIPEMD160 = HashDescr (RIPEMD160.hash) (B.append (BC8.pack "\x30\x21\x30\x09\x06\x05\x2b\x24\x03\x02\x01\x05\x00\x04\x14"))+hashDescr SHA256 = hashDescrSHA256+hashDescr SHA384 = hashDescrSHA384+hashDescr SHA512 = hashDescrSHA512+hashDescr SHA224 = hashDescrSHA224+hashDescr DeprecatedMD5 = hashDescrMD5+hashDescr _ = error "Hash problem" -- FIXME  pubkeyToMPIs :: PKey -> [MPI] pubkeyToMPIs (RSAPubKey k) = [MPI (RSA.public_n k), MPI (RSA.public_e k)]

@@ -1,5 +1,5 @@ -- Serialize.hs: OpenPGP (RFC4880) serialization (using cereal)--- Copyright © 2012  Clint Adams+-- Copyright © 2012-2013  Clint Adams -- This software is released under the terms of the ISC license. -- (See the LICENSE file). @@ -8,10 +8,10 @@ ) where  import Control.Applicative ((<$>),(<*>))-import Control.Monad (replicateM, mplus)-import qualified Crypto.Cipher.RSA as R-import qualified Crypto.Cipher.DSA as D-import Data.Bits ((.&.), (.|.), shiftL, shiftR)+import Control.Monad (guard, mplus, replicateM)+import qualified Crypto.PubKey.RSA as R+import qualified Crypto.PubKey.DSA as D+import Data.Bits ((.&.), (.|.), shiftL, shiftR, testBit) import Data.ByteString (ByteString) import qualified Data.ByteString as B import qualified Data.ByteString.Char8 as BC8@@ -471,7 +471,8 @@  getPacketTypeAndPayload :: Get (Word8, ByteString) getPacketTypeAndPayload = do-    tag <- getWord8 -- FIXME: bit 7 must be 1, check?+    tag <- getWord8+    guard (testBit tag 7)     case tag .&. 0x40 of         0x00 -> do                    let t = shiftR (tag .&. 0x3c) 2@@ -784,22 +785,10 @@         do MPI x <- get            return $ ElGamalPrivateKey [x] --- indefiniteMPIs :: ByteString -> [MPI]--- indefiniteMPIs bs = do---     case runGet (many getMPI) bs of---         Left e -> error e---         Right mpis -> mpis- putMPI :: MPI -> Put putMPI (MPI i) = do let bs = integerToBEBS i                     putWord16be . countBits $ bs                     putByteString bs---- getPackets :: Get (Block Pkt)--- getPackets = Block `fmap` many getPkt---- putPackets :: Block Pkt -> Put--- putPackets = mapM_ putPkt . unBlock  getPKPayload :: Get PKPayload getPKPayload = do

@@ -1,5 +1,5 @@ -- SerializeForSigs.hs: OpenPGP (RFC4880) special serialization for signature purposes--- Copyright © 2012  Clint Adams+-- Copyright © 2012-2013  Clint Adams -- This software is released under the terms of the ISC license. -- (See the LICENSE file). 

@@ -1,9 +1,9 @@ -- Types.hs: OpenPGP (RFC4880) data types--- Copyright © 2012  Clint Adams+-- Copyright © 2012-2013  Clint Adams -- This software is released under the terms of the ISC license. -- (See the LICENSE file). -{-# LANGUAGE ExistentialQuantification, TypeFamilies #-}+{-# LANGUAGE DeriveDataTypeable, ExistentialQuantification, TemplateHaskell, TypeFamilies #-}  module Codec.Encryption.OpenPGP.Types (    SigSubPacket(..)@@ -61,16 +61,19 @@  , Verification(..) ) where -import qualified Crypto.Cipher.RSA as RSA-import qualified Crypto.Cipher.DSA as DSA+import qualified Crypto.PubKey.RSA as RSA+import qualified Crypto.PubKey.DSA as DSA  import Control.Arrow ((***))+import Control.Lens (makeLenses) import Data.ByteString (ByteString)-import Data.Char (toLower, toUpper) import qualified Data.ByteString as B+import Data.Char (toLower, toUpper)+import Data.Data (Data)+import Data.IxSet (IxSet) import Data.List.Split (chunksOf)-import Data.Map (Map) import Data.Set (Set)+import Data.Typeable (Typeable) import Data.Word (Word8, Word16, Word32) import Numeric (readHex, showHex) @@ -108,7 +111,7 @@                         | AES256                         | Twofish                         | OtherSA Word8-     deriving (Show)+     deriving (Data, Show, Typeable)  instance Eq SymmetricAlgorithm where     (==) a b = fromFVal a == fromFVal b@@ -144,7 +147,7 @@  data NotationFlag = HumanReadable                   | OtherNF Int-     deriving (Show)+     deriving (Data, Show, Typeable)  instance Eq NotationFlag where     (==) a b = fromFFlag a == fromFFlag b@@ -162,7 +165,7 @@ data SigSubPacket = SigSubPacket {     sspCriticality :: Bool   , sspPayload :: SigSubPacketPayload-  } deriving Eq+  } deriving (Data, Eq, Typeable)  instance Show SigSubPacket where     show x = (if sspCriticality x then "*" else "") ++ (show . sspPayload) x@@ -192,7 +195,7 @@                   | EmbeddedSignature SignaturePayload                   | UserDefinedSigSub Word8 ByteString                   | OtherSigSub Word8 ByteString-    deriving (Show, Eq) -- FIXME+    deriving (Data, Eq, Show, Typeable) -- FIXME  data HashAlgorithm = DeprecatedMD5                    | SHA1@@ -202,7 +205,7 @@                    | SHA512                    | SHA224                    | OtherHA Word8-    deriving (Show)+    deriving (Data, Show, Typeable)  instance Eq HashAlgorithm where     (==) a b = fromFVal a == fromFVal b@@ -233,7 +236,7 @@                           | ZLIB                           | BZip2                           | OtherCA Word8-    deriving (Show)+    deriving (Show, Data, Typeable)  instance Eq CompressionAlgorithm where     (==) a b = fromFVal a == fromFVal b@@ -267,7 +270,7 @@                      | Elgamal                      | DH                      | OtherPKA Word8-    deriving (Show)+    deriving (Show, Data, Typeable)  instance Eq PubKeyAlgorithm where     (==) a b = fromFVal a == fromFVal b@@ -303,7 +306,7 @@  data KSPFlag = NoModify              | KSPOther Int-    deriving (Show)+    deriving (Data, Show, Typeable)  instance Eq KSPFlag where     (==) a b = fromFFlag a == fromFFlag b@@ -326,7 +329,7 @@              | SignDataKey              | CertifyKeysKey              | KFOther Int-    deriving (Show)+    deriving (Data, Show, Typeable)  instance Eq KeyFlag where     (==) a b = fromFFlag a == fromFFlag b@@ -355,7 +358,7 @@  data RevocationClass = SensitiveRK                      | RClOther Int-    deriving (Show)+    deriving (Data, Show, Typeable)  instance Eq RevocationClass where     (==) a b = fromFFlag a == fromFFlag b@@ -376,7 +379,7 @@                     | KeyRetiredAndNoLongerUsed                     | UserIdInfoNoLongerValid                     | RCoOther Word8-    deriving (Show)+    deriving (Show, Data, Typeable)  instance Eq RevocationCode where     (==) a b = fromFVal a == fromFVal b@@ -400,7 +403,7 @@  data FeatureFlag = ModificationDetection                  | FeatureOther Int-    deriving (Show)+    deriving (Show, Data, Typeable)  instance Eq FeatureFlag where     (==) a b = fromFFlag a == fromFFlag b@@ -416,28 +419,31 @@     toFFlag i = FeatureOther (fromIntegral i)  newtype MPI = MPI {unMPI :: Integer}-    deriving (Show, Eq)+    deriving (Data, Eq, Show, Typeable)  data SignaturePayload = SigV3 SigType Word32 EightOctetKeyId PubKeyAlgorithm HashAlgorithm Word16 [MPI]                       | SigV4 SigType PubKeyAlgorithm HashAlgorithm [SigSubPacket] [SigSubPacket] Word16 [MPI]                       | SigVOther Word8 ByteString-    deriving (Show, Eq) -- FIXME+    deriving (Data, Eq, Show, Typeable) -- FIXME  data PKPayload = DeprecatedPubV3 TimeStamp V3Expiration PubKeyAlgorithm PKey                | PubV4 TimeStamp PubKeyAlgorithm PKey-    deriving (Show, Eq)+    deriving (Data, Eq, Show, Typeable) +instance Ord PKPayload where+    compare a b = show a `compare` show b -- FIXME: this is ridiculous+ data SKAddendum = SUS16bit SymmetricAlgorithm S2K IV ByteString                 | SUSSHA1 SymmetricAlgorithm S2K IV ByteString                 | SUSym SymmetricAlgorithm IV ByteString                 | SUUnencrypted SKey Word16-    deriving (Show, Eq)+    deriving (Data, Eq, Show, Typeable)  data DataType = BinaryData               | TextData               | UTF8Data               | OtherData Word8-    deriving (Show)+    deriving (Show, Data, Typeable)  instance Eq DataType where     (==) a b = fromFVal a == fromFVal b@@ -460,18 +466,18 @@          | Salted HashAlgorithm Salt          | IteratedSalted HashAlgorithm Salt Count          | OtherS2K Word8 ByteString-    deriving (Show, Eq) -- FIXME+    deriving (Data, Eq, Show, Typeable) -- FIXME  data UserAttrSubPacket = ImageAttribute ImageHeader ImageData                        | OtherUASub Word8 ByteString-    deriving (Show, Eq) -- FIXME+    deriving (Data, Eq, Show, Typeable) -- FIXME  data ImageHeader = ImageHV1 ImageFormat-    deriving (Show, Eq)+    deriving (Data, Eq, Show, Typeable)  data ImageFormat = JPEG                  | OtherImage Word8-    deriving (Show)+    deriving (Data, Show, Typeable)  instance Eq ImageFormat where     (==) a b = fromFVal a == fromFVal b@@ -502,7 +508,7 @@              | TimestampSig              | ThirdPartyConfirmationSig              | OtherSig Word8-    deriving (Show)+    deriving (Data, Show, Typeable)  instance Eq SigType where     (==) a b = fromFVal a == fromFVal b@@ -548,18 +554,18 @@ data PKey = RSAPubKey RSA.PublicKey           | DSAPubKey DSA.PublicKey           | ElGamalPubKey [Integer]-    deriving (Show, Eq)+    deriving (Data, Eq, Show, Typeable)  data SKey = RSAPrivateKey RSA.PrivateKey           | DSAPrivateKey DSA.PrivateKey           | ElGamalPrivateKey [Integer]-    deriving (Show, Eq)+    deriving (Data, Eq, Show, Typeable)  newtype Block a = Block {unBlock :: [a]} -- so we can override cereal instance     deriving (Show, Eq)  newtype EightOctetKeyId = EightOctetKeyId {unEOKI :: ByteString}-    deriving (Eq, Ord) -- FIXME+    deriving (Eq, Ord, Data, Typeable) -- FIXME  instance Show EightOctetKeyId where     show = w8sToHex . B.unpack . unEOKI@@ -568,7 +574,7 @@     readsPrec _ = map ((EightOctetKeyId . B.pack *** concat) . unzip) . chunksOf 8 . hexToW8s  newtype TwentyOctetFingerprint = TwentyOctetFingerprint {unTOF :: ByteString}-    deriving (Eq)+    deriving (Eq, Ord, Data, Typeable)  instance Show TwentyOctetFingerprint where     show = take 50 . concatMap (++" ") . concatMap (++[""]) . chunksOf 5 . chunksOf 4 . w8sToHex . B.unpack . unTOF@@ -583,24 +589,23 @@ hexToW8s = concatMap readHex . chunksOf 2 . map toLower  data TK = TK {-    tkPKP :: PKPayload-  , tkmSKA :: Maybe SKAddendum-  , tkRevs :: [SignaturePayload]-  , tkUIDs :: [(String, [SignaturePayload])]-  , tkUAts :: [([UserAttrSubPacket], [SignaturePayload])]-  , tkSubs :: [(Pkt, SignaturePayload, Maybe SignaturePayload)]-  }-    deriving (Eq, Show)+    _tkPKP :: PKPayload+  , _tkmSKA :: Maybe SKAddendum+  , _tkRevs :: [SignaturePayload]+  , _tkUIDs :: [(String, [SignaturePayload])]+  , _tkUAts :: [([UserAttrSubPacket], [SignaturePayload])]+  , _tkSubs :: [(Pkt, SignaturePayload, Maybe SignaturePayload)]+  } deriving (Data, Eq, Show, Typeable)  instance Ord TK where     compare a b = show a `compare` show b -- FIXME: this is ridiculous -type Keyring = Map EightOctetKeyId (Set TK)+type Keyring = IxSet TK  class Packet a where     data PacketType a :: *     packetType :: a -> PacketType a-    packetCode :: PacketType a -> Word8+    packetCode :: PacketType a -> Word8     toPkt :: a -> Pkt     fromPkt :: Pkt -> a @@ -623,14 +628,14 @@          | SymEncIntegrityProtectedDataPkt PacketVersion ByteString          | ModificationDetectionCodePkt ByteString          | OtherPacketPkt Word8 ByteString-    deriving (Show, Eq) -- FIXME+    deriving (Show, Eq, Data, Typeable) -- FIXME  data PKESK = PKESK     { pkeskPacketVersion :: PacketVersion     , pkeskEightOctetKeyId :: EightOctetKeyId     , pkeskPubKeyAlgorithm :: PubKeyAlgorithm     , pkeskMPIs :: [MPI]-    } deriving (Show, Eq)+    } deriving (Data, Eq, Show, Typeable) instance Packet PKESK where     data PacketType PKESK = PKESKType     packetType _ = PKESKType@@ -640,7 +645,7 @@  data Signature = Signature   -- FIXME?     { signaturePayload :: SignaturePayload-    } deriving (Show, Eq)+    } deriving (Data, Eq, Show, Typeable) instance Packet Signature where     data PacketType Signature = SignatureType     packetType _ = SignatureType@@ -653,7 +658,7 @@     , skeskSymmetricAlgorithm :: SymmetricAlgorithm     , skeskS2K :: S2K     , skeskMPIs :: [MPI]-    } deriving (Show, Eq)+    } deriving (Data, Eq, Show, Typeable) instance Packet SKESK where     data PacketType SKESK = SKESKType     packetType _ = SKESKType@@ -668,7 +673,7 @@     , onePassSignaturePubKeyAlgorithm :: PubKeyAlgorithm     , onePassSignatureEightOctetKeyId :: EightOctetKeyId     , onePassSignatureNestedFlag :: NestedFlag-    } deriving (Show, Eq)+    } deriving (Data, Eq, Show, Typeable) instance Packet OnePassSignature where     data PacketType OnePassSignature = OnePassSignatureType     packetType _ = OnePassSignatureType@@ -679,7 +684,7 @@ data SecretKey = SecretKey     { secretKeyPKPayload :: PKPayload     , secretKeySKAddendum :: SKAddendum-    } deriving (Show, Eq)+    } deriving (Data, Eq, Show, Typeable) instance Packet SecretKey where     data PacketType SecretKey = SecretKeyType     packetType _ = SecretKeyType@@ -689,7 +694,7 @@  data PublicKey = PublicKey     { publicKeyPKPayload :: PKPayload-    } deriving (Show, Eq)+    } deriving (Data, Eq, Show, Typeable) instance Packet PublicKey where     data PacketType PublicKey = PublicKeyType     packetType _ = PublicKeyType@@ -700,7 +705,7 @@ data SecretSubkey = SecretSubkey     { secretSubkeyPKPayload :: PKPayload     , secretSubkeySKAddendum :: SKAddendum-    } deriving (Show, Eq)+    } deriving (Data, Eq, Show, Typeable) instance Packet SecretSubkey where     data PacketType SecretSubkey = SecretSubkeyType     packetType _ = SecretSubkeyType@@ -711,7 +716,7 @@ data CompressedData = CompressedData     { compressedDataCompressionAlgorithm :: CompressionAlgorithm     , compressedDataPayload :: CompressedDataPayload-    } deriving (Show, Eq)+    } deriving (Data, Eq, Show, Typeable) instance Packet CompressedData where     data PacketType CompressedData = CompressedDataType     packetType _ = CompressedDataType@@ -721,7 +726,7 @@  data SymEncData = SymEncData     { symEncDataPayload :: ByteString-    } deriving (Show, Eq)+    } deriving (Data, Eq, Show, Typeable) instance Packet SymEncData where     data PacketType SymEncData = SymEncDataType     packetType _ = SymEncDataType@@ -731,7 +736,7 @@  data Marker = Marker     { markerPayload :: ByteString-    } deriving (Show, Eq)+    } deriving (Data, Eq, Show, Typeable) instance Packet Marker where     data PacketType Marker = MarkerType     packetType _ = MarkerType@@ -744,7 +749,7 @@     , literalDataFileName :: FileName     , literalDataTimeStamp :: TimeStamp     , literalDataPayload :: ByteString-    } deriving (Show, Eq)+    } deriving (Data, Eq, Show, Typeable) instance Packet LiteralData where     data PacketType LiteralData = LiteralDataType     packetType _ = LiteralDataType@@ -754,7 +759,7 @@  data Trust = Trust     { trustPayload :: ByteString-    } deriving (Show, Eq)+    } deriving (Data, Eq, Show, Typeable) instance Packet Trust where     data PacketType Trust = TrustType     packetType _ = TrustType@@ -764,7 +769,7 @@  data UserId = UserId     { userIdPayload :: String-    } deriving (Show, Eq)+    } deriving (Data, Eq, Show, Typeable) instance Packet UserId where     data PacketType UserId = UserIdType     packetType _ = UserIdType@@ -774,7 +779,7 @@  data PublicSubkey = PublicSubkey     { publicSubkeyPKPayload :: PKPayload-    } deriving (Show, Eq)+    } deriving (Data, Eq, Show, Typeable) instance Packet PublicSubkey where     data PacketType PublicSubkey = PublicSubkeyType     packetType _ = PublicSubkeyType@@ -784,7 +789,7 @@  data UserAttribute = UserAttribute     { userAttributeSubPackets :: [UserAttrSubPacket]-    } deriving (Show, Eq)+    } deriving (Data, Eq, Show, Typeable) instance Packet UserAttribute where     data PacketType UserAttribute = UserAttributeType     packetType _ = UserAttributeType@@ -795,7 +800,7 @@ data SymEncIntegrityProtectedData = SymEncIntegrityProtectedData     { symEncIntegrityProtectedDataPacketVersion :: PacketVersion     , symEncIntegrityProtectedDataPayload :: ByteString-    } deriving (Show, Eq)+    } deriving (Data, Eq, Show, Typeable) instance Packet SymEncIntegrityProtectedData where     data PacketType SymEncIntegrityProtectedData = SymEncIntegrityProtectedDataType     packetType _ = SymEncIntegrityProtectedDataType@@ -805,7 +810,7 @@  data ModificationDetectionCode = ModificationDetectionCode     { modificationDetectionCodePayload :: ByteString-    } deriving (Show, Eq)+    } deriving (Data, Eq, Show, Typeable) instance Packet ModificationDetectionCode where     data PacketType ModificationDetectionCode = ModificationDetectionCodeType     packetType _ = ModificationDetectionCodeType@@ -816,7 +821,7 @@ data OtherPacket = OtherPacket     { otherPacketType :: Word8     , otherPacketPayload :: ByteString-    } deriving (Show, Eq)+    } deriving (Data, Eq, Show, Typeable) instance Packet OtherPacket where     data PacketType OtherPacket = OtherPacketType     packetType _ = OtherPacketType@@ -828,3 +833,5 @@       verificationSigner :: PKPayload     , verificationSignature :: SignaturePayload     }++$(makeLenses ''TK)

@@ -1,5 +1,5 @@ -- Verify.hs: OpenPGP (RFC4880) signature verification--- Copyright © 2012  Clint Adams+-- Copyright © 2012-2013  Clint Adams -- This software is released under the terms of the ISC license. -- (See the LICENSE file). @@ -11,22 +11,25 @@  import Control.Monad (guard, liftM2) -import qualified Crypto.Cipher.DSA as DSA-import qualified Crypto.Cipher.RSA as RSA+import Crypto.PubKey.HashDescr (HashDescr(..))+import qualified Crypto.PubKey.DSA as DSA+import qualified Crypto.PubKey.RSA as RSA+import qualified Crypto.PubKey.RSA.PKCS15 as P15  import Data.ByteString (ByteString) import qualified Data.ByteString as B import Data.Either (lefts, rights)-import qualified Data.Map as Map-import qualified Data.Set as Set+import Data.IxSet ((@=))+import qualified Data.IxSet as IxSet import Data.Time.Clock (UTCTime(..), diffUTCTime) import Data.Time.Clock.POSIX (posixSecondsToUTCTime) import Data.Serialize.Put (runPut)  import Codec.Encryption.OpenPGP.Fingerprint (eightOctetKeyID, fingerprint)-import Codec.Encryption.OpenPGP.Internal (countBits, integerToBEBS, PktStreamContext(..), hash, issuer, emptyPSC, asn1Prefix)+import Codec.Encryption.OpenPGP.Internal (countBits, integerToBEBS, PktStreamContext(..), issuer, emptyPSC, hashDescr) import Codec.Encryption.OpenPGP.SerializeForSigs (putPartialSigforSigning, putSigTrailer, payloadForSig) import Codec.Encryption.OpenPGP.Types+import Data.Conduit.OpenPGP.Keyring.Instances ()  verifySig :: Keyring -> Pkt -> PktStreamContext -> Maybe UTCTime -> Either String Verification -- FIXME: check expiration here? verifySig kr sig@(SignaturePkt (SigV4 st _ _ hs _ _ _)) state mt = do@@ -43,14 +46,14 @@ verifyTK kr mt key = do     revokers <- checkRevokers key     revs <- checkKeyRevocations revokers key-    let uids = filter (\(_, sps) -> sps == []) . checkUidSigs $ tkUIDs key -- FIXME: check revocations here?-    let uats = filter (\(_, sps) -> sps == []) . checkUAtSigs $ tkUAts key -- FIXME: check revocations here?-    let subs = concatMap checkSub $ tkSubs key -- FIXME: check revocations here?-    return (TK (tkPKP key) (tkmSKA key) revs uids uats subs)+    let uids = filter (\(_, sps) -> sps /= []) . checkUidSigs $ _tkUIDs key -- FIXME: check revocations here?+    let uats = filter (\(_, sps) -> sps /= []) . checkUAtSigs $ _tkUAts key -- FIXME: check revocations here?+    let subs = concatMap checkSub $ _tkSubs key -- FIXME: check revocations here?+    return (TK (_tkPKP key) (_tkmSKA key) revs uids uats subs)     where-        checkRevokers = Right . concat . rights . map verifyRevoker . filter isRevokerP . tkRevs+        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 kr)) . tkRevs $ k+        checkKeyRevocations rs k = Prelude.sequence . concatMap (filterRevs rs) . rights . map (liftM2 fmap (,) (vSig kr)) . _tkRevs $ k         checkUidSigs :: [(String, [SignaturePayload])] -> [(String, [SignaturePayload])]         checkUidSigs = map (\(uid, sps) -> (uid, (rights . map (\sp -> fmap (const sp) (vUid kr (uid, sp)))) sps))         checkUAtSigs :: [([UserAttrSubPacket], [SignaturePayload])] -> [([UserAttrSubPacket], [SignaturePayload])]@@ -78,13 +81,13 @@         isIssuerSSP (SigSubPacket _ (Issuer _)) = True         isIssuerSSP _ = False         vUid :: Keyring -> (String, SignaturePayload) -> Either String Verification-        vUid keyring (uid, sp) = verifySig keyring (SignaturePkt sp) emptyPSC { lastPrimaryKey = PublicKeyPkt (tkPKP key), lastUIDorUAt = UserIdPkt uid } mt+        vUid keyring (uid, sp) = verifySig keyring (SignaturePkt sp) emptyPSC { lastPrimaryKey = PublicKeyPkt (_tkPKP key), lastUIDorUAt = UserIdPkt uid } mt         vUAt :: Keyring -> ([UserAttrSubPacket], SignaturePayload) -> Either String Verification-        vUAt keyring (uat, sp) = verifySig keyring (SignaturePkt sp) emptyPSC { lastPrimaryKey = PublicKeyPkt (tkPKP key), lastUIDorUAt = UserAttributePkt uat } mt+        vUAt keyring (uat, sp) = verifySig keyring (SignaturePkt sp) emptyPSC { lastPrimaryKey = PublicKeyPkt (_tkPKP key), lastUIDorUAt = UserAttributePkt uat } mt         vSig :: Keyring -> SignaturePayload -> Either String Verification-        vSig keyring sp = verifySig keyring (SignaturePkt sp) emptyPSC { lastPrimaryKey = PublicKeyPkt (tkPKP key) } mt+        vSig keyring sp = verifySig keyring (SignaturePkt sp) emptyPSC { lastPrimaryKey = PublicKeyPkt (_tkPKP key) } mt         vSubSig :: Keyring -> Pkt -> SignaturePayload -> Bool-        vSubSig keyring sk sp = case verifySig keyring (SignaturePkt sp) emptyPSC { lastPrimaryKey = PublicKeyPkt (tkPKP key), lastSubkey = sk} mt of+        vSubSig keyring sk sp = case verifySig keyring (SignaturePkt sp) emptyPSC { lastPrimaryKey = PublicKeyPkt (_tkPKP key), lastSubkey = sk} mt of                                 Left _ -> False 				Right _ -> True         verifyRevoker :: SignaturePayload -> Either String [(PubKeyAlgorithm, TwentyOctetFingerprint)]@@ -95,8 +98,8 @@ verify :: Keyring -> Pkt -> Maybe UTCTime -> ByteString -> Either String Verification verify kr sig mt payload = do     i <- maybe (Left "issuer not found") Right (issuer sig)-    tpkset <- maybe (Left "pubkey not found") Right (Map.lookup i kr)-    let allrelevantpkps = filter (\x -> issuer sig == Just (eightOctetKeyID x)) (concatMap (\x -> tkPKP x:map subPKP (tkSubs x)) (Set.toAscList tpkset))+    potentialmatches <- if IxSet.null (kr @= i) then Left "pubkey not found" else Right (kr @= i)+    let allrelevantpkps = filter (\x -> issuer sig == Just (eightOctetKeyID x)) (concatMap (\x -> _tkPKP x:map subPKP (_tkSubs x)) (IxSet.toList potentialmatches))     let results = map (\pkp -> verify' sig pkp (hashalgo sig) (finalPayload sig payload)) allrelevantpkps     case rights results of         [] -> Left (concatMap (++"/") (lefts results))@@ -112,12 +115,9 @@         verify'' (DSA,mpis) ha pub (DSAPubKey pkey) bs = verify''' (dsaVerify mpis ha pkey bs) pub         verify'' (RSA,mpis) ha pub (RSAPubKey pkey) bs = verify''' (rsaVerify mpis ha pkey bs) pub         verify'' _ _ _ _ _ = Left "unimplemented key type"-	verify''' f pub = case f of-                               Left _ -> Left "invalid signature"-                               Right False -> Left "verification failed"-                               Right True -> Right pub-	dsaVerify mpis ha pkey bs = DSA.verify (dsaMPIsToSig mpis) (dsaTruncate pkey . hash ha) pkey bs-	rsaVerify mpis ha pkey bs = RSA.verify (hash ha) (asn1Prefix ha) pkey bs (rsaMPItoSig mpis)+	verify''' f pub = if f then Right pub else Left "verification failed"+	dsaVerify mpis ha pkey bs = DSA.verify (dsaTruncate pkey . hashFunction (hashDescr ha)) pkey (dsaMPIsToSig mpis) bs+	rsaVerify mpis ha pkey bs = P15.verify (hashDescr ha) pkey bs (rsaMPItoSig mpis)         dsaMPIsToSig mpis = (unMPI (mpis !! 0), unMPI (mpis !! 1))         rsaMPItoSig mpis = integerToBEBS (unMPI (head mpis))         finalPayload s pl = B.concat [pl, sigbit s, trailer s]@@ -137,4 +137,4 @@         isSignatureExpired s (Just t) = if any (expiredBefore t) ((\(SigV4 _ _ _ h _ _ _) -> h) . signaturePayload . fromPkt $ s) then Left "signature expired" else return True         expiredBefore :: UTCTime -> SigSubPacket -> Bool         expiredBefore ct (SigSubPacket _ (SigExpirationTime et)) = fromEnum ((posixSecondsToUTCTime . toEnum . fromEnum) et `diffUTCTime` ct) < 0-        expiredBefore ct _ = False+        expiredBefore _ _ = False

@@ -1,5 +1,5 @@ -- Compression.hs: OpenPGP (RFC4880) compression conduits--- Copyright © 2012  Clint Adams+-- Copyright © 2012-2013  Clint Adams -- This software is released under the terms of the ISC license. -- (See the LICENSE file). 

@@ -1,5 +1,5 @@ -- Keyring.hs: OpenPGP (RFC4880) transferable keys parsing--- Copyright © 2012  Clint Adams+-- Copyright © 2012-2013  Clint Adams -- This software is released under the terms of the ISC license. -- (See the LICENSE file). @@ -11,13 +11,12 @@  import qualified Data.ByteString as B import Data.Conduit+import qualified Data.Conduit.List as CL import qualified Data.Conduit.Util as CU--import qualified Data.Map as Map-import qualified Data.Set as Set+import Data.IxSet (empty, insert) -import Codec.Encryption.OpenPGP.Fingerprint (eightOctetKeyID) import Codec.Encryption.OpenPGP.Types+import Data.Conduit.OpenPGP.Keyring.Instances ()  data Phase = MainKey | Revs | Uids | UAts | Subs     deriving (Eq, Ord, Show)@@ -86,13 +85,4 @@         dropOrError False s _ = CU.StateProducing s []  sinkKeyringMap :: MonadResource m => Sink TK m Keyring-sinkKeyringMap = CU.sinkState Map.empty push close-    where-        push :: MonadResource m => Keyring -> TK -> m (CU.SinkStateResult Keyring TK Keyring)-        push state input = return . CU.StateProcessing $ foldl (\m x -> Map.insert x (newset x input m) m) state (eoks input)-        close = return-        eoks (TK pkp _ _ _ _ subs) = eightOctetKeyID pkp:map (eightOctetKeyID . pl . \(x,_,_) -> x) subs-        pl (PublicSubkeyPkt pkp) = pkp-        pl (SecretSubkeyPkt pkp _) = pkp-        newset eok i s = Set.insert i (oldset eok s)-        oldset = Map.findWithDefault Set.empty+sinkKeyringMap = CL.fold (flip insert) empty

@@ -0,0 +1,28 @@+-- Instances.hs: OpenPGP (RFC4880) additional types for transferable keys+-- Copyright © 2012-2013  Clint Adams+-- This software is released under the terms of the ISC license.+-- (See the LICENSE file).++module Data.Conduit.OpenPGP.Keyring.Instances (+) where++import Data.IxSet (Proxy(..), Indexable(..), ixSet, ixGen, ixFun)++import Codec.Encryption.OpenPGP.Fingerprint (eightOctetKeyID, fingerprint)+import Codec.Encryption.OpenPGP.Types++import Control.Lens ((^..))+import Data.Data.Lens (biplate)++instance Indexable TK where+    empty = ixSet+                [ ixGen (Proxy :: Proxy PKPayload)+                , ixFun getEOKIs+                , ixFun getTOFs+                ]++getEOKIs :: TK -> [EightOctetKeyId]+getEOKIs tk = map eightOctetKeyID (tk ^.. biplate :: [PKPayload])+getTOFs :: TK -> [TwentyOctetFingerprint]+getTOFs tk = map fingerprint (tk ^.. biplate :: [PKPayload])+

@@ -1,5 +1,5 @@ -- Verify.hs: OpenPGP (RFC4880) signature verification--- Copyright © 2012  Clint Adams+-- Copyright © 2012-2013  Clint Adams -- This software is released under the terms of the ISC license. -- (See the LICENSE file). 

@@ -1,4 +1,4 @@-Copyright © 2012 Clint Adams <clint@debian.org>+Copyright © 2012-2013 Clint Adams <clint@debian.org>  Permission to use, copy, modify, and/or distribute this software for any  purpose with or without fee is hereby granted, provided that the above 

@@ -1,5 +1,5 @@ Name:                hOpenPGP-Version:             0.5.2+Version:             0.6 Synopsis:            native Haskell implementation of OpenPGP (RFC4880) Description:         native Haskell implementation of OpenPGP (RFC4880) Homepage:            http://floss.scru.org/hOpenPGP/@@ -7,7 +7,7 @@ License-file:        LICENSE Author:              Clint Adams Maintainer:          Clint Adams <clint@debian.org>-Copyright:           2012, Clint Adams+Copyright:           2012-2013  Clint Adams Category:            Codec, Data Build-type:          Simple Extra-source-files: tests/suite.hs@@ -123,11 +123,11 @@                      , Codec.Encryption.OpenPGP.Verify                      , Data.Conduit.OpenPGP.Compression                      , Data.Conduit.OpenPGP.Keyring+                     , Data.Conduit.OpenPGP.Keyring.Instances                      , Data.Conduit.OpenPGP.Verify   Other-Modules: Codec.Encryption.OpenPGP.Internal                , Codec.Encryption.OpenPGP.SerializeForSigs-  Build-depends: asn1-data             > 0.7-               , attoparsec+  Build-depends: attoparsec                , base                  > 4       && < 5                , base64-bytestring                , bytestring@@ -136,8 +136,10 @@                , cereal-conduit        >= 0.6    && < 0.7                , conduit               >= 0.5    && < 0.6                , containers-               , cryptocipher          >= 0.3.6+               , crypto-pubkey         >= 0.1.1                , cryptohash+               , ixset                 >= 1.0+               , lens                  >= 3.0                , mtl                , openpgp-asciiarmor                 >= 0.1                , split@@ -150,20 +152,18 @@   type:       exitcode-stdio-1.0   main-is:    tests/suite.hs   Ghc-options: -Wall-  Build-depends: asn1-data             > 0.7-               , attoparsec+  Build-depends: hOpenPGP                , base                  > 4       && < 5-               , base64-bytestring                , bytestring                , bzlib                , cereal                , cereal-conduit        >= 0.6    && < 0.7                , conduit               >= 0.5    && < 0.6                , containers-               , cryptocipher          >= 0.3.6+               , crypto-pubkey         >= 0.1.1                , cryptohash-               , mtl-               , openpgp-asciiarmor                 >= 0.1+               , ixset                 >= 1.0+               , lens                  >= 3.0                , split                , time                               >= 1.1                , zlib

@@ -1,7 +1,7 @@ {-# LANGUAGE OverloadedStrings #-}  -- suite.hs: hOpenPGP test suite--- Copyright © 2012  Clint Adams+-- Copyright © 2012-2013  Clint Adams -- This software is released under the terms of the ISC license. -- (See the LICENSE file). @@ -20,7 +20,7 @@ import Data.Conduit.OpenPGP.Verify (conduitVerify)  import qualified Data.ByteString as B-import qualified Data.Map as Map+import Data.IxSet ((@=), getOne) import Data.Maybe (isJust) import Data.Serialize (get, put) import Data.Serialize.Get (runGet, Get)@@ -77,7 +77,7 @@ testKeyringLookup :: FilePath -> String -> Bool -> Assertion testKeyringLookup fpr eok expected = do     kr <- DC.runResourceT $ CB.sourceFile ("tests/data/" ++ fpr) DC.$= conduitGet get DC.$= conduitToTKs DC.$$ sinkKeyringMap-    let key = (Map.lookup (read eok) kr)+    let key = getOne (kr @= (read eok :: EightOctetKeyId))     assertEqual (eok ++ " in " ++ fpr) expected (isJust key)  testVerifyMessage :: FilePath -> FilePath -> [TwentyOctetFingerprint] -> Assertion