hOpenPGP 1.3 → 1.4

raw patch · 4 files changed

+159/−37 lines, 4 filesdep +hashabledep +semigroupsdep +unordered-containersPVP ok

version bump matches the API change (PVP)

Dependencies added: hashable, semigroups, unordered-containers

API changes (from Hackage documentation)

Files

• Codec/Encryption/OpenPGP/Internal.hs +11/−0
• Codec/Encryption/OpenPGP/Types.hs +115/−32
• Data/Conduit/OpenPGP/Keyring/Instances.hs +25/−3
• hOpenPGP.cabal +8/−2

@@ -18,6 +18,7 @@  , sigType  , sigPKA  , sigHA+ , sigCT ) where  import Crypto.PubKey.HashDescr (HashDescr(..), hashDescrMD5, hashDescrSHA1, hashDescrSHA224, hashDescrSHA256, hashDescrSHA384, hashDescrSHA512, hashDescrRIPEMD160)@@ -105,3 +106,13 @@ sigHA (SigV3 _ _ _ _ ha _ _) = Just ha sigHA (SigV4 _ _ ha _ _ _ _) = Just ha sigHA _ = Nothing -- this includes v2 sigs, which don't seem to be specified in the RFCs but exist in the wild++sigCT :: SignaturePayload -> Maybe TimeStamp+sigCT (SigV3 _ ct _ _ _ _ _) = Just ct+sigCT (SigV4 _ _ _ hsubs _ _ _) = fmap (\(SigSubPacket _ (SigCreationTime i)) -> i) (find isSigCreationTime hsubs)+    where+        isSigCreationTime (SigSubPacket _ (SigCreationTime _)) = True+        isSigCreationTime _ = False+sigCT _ = Nothing++

@@ -3,24 +3,27 @@ -- This software is released under the terms of the Expat license. -- (See the LICENSE file). -{-# LANGUAGE DeriveDataTypeable, ExistentialQuantification, TemplateHaskell, TypeFamilies #-}+{-# LANGUAGE DeriveDataTypeable, DeriveGeneric, ExistentialQuantification, TemplateHaskell, TypeFamilies #-}  module Codec.Encryption.OpenPGP.Types where -import qualified Crypto.PubKey.RSA as RSA-import qualified Crypto.PubKey.DSA as DSA+import GHC.Generics (Generic)  import Control.Arrow ((***)) import Control.Lens (makeLenses)+import qualified Crypto.PubKey.RSA as RSA+import qualified Crypto.PubKey.DSA as DSA import Data.ByteString (ByteString) import qualified Data.ByteString as B import Data.Char (toLower, toUpper) import Data.Data (Data)+import Data.Hashable (Hashable(..)) import Data.IxSet (IxSet) import Data.List.Split (chunksOf) import Data.Monoid ((<>)) import Data.Ord (comparing) import Data.Set (Set)+import qualified Data.Set as Set import Data.Typeable (Typeable) import Data.Word (Word8, Word16, Word32) import Numeric (readHex, showHex)@@ -59,7 +62,7 @@                         | AES256                         | Twofish                         | OtherSA Word8-     deriving (Data, Show, Typeable)+     deriving (Data, Generic, Show, Typeable)  instance Eq SymmetricAlgorithm where     (==) a b = fromFVal a == fromFVal b@@ -93,9 +96,11 @@     toFVal 10 = Twofish     toFVal o = OtherSA o +instance Hashable SymmetricAlgorithm+ data NotationFlag = HumanReadable                   | OtherNF Word8 -- FIXME: this should be constrained to 4 bits?-     deriving (Data, Show, Typeable)+     deriving (Data, Generic, Show, Typeable)  instance Eq NotationFlag where     (==) a b = fromFFlag a == fromFFlag b@@ -110,14 +115,18 @@     toFFlag 0 = HumanReadable     toFFlag o = OtherNF (fromIntegral o) +instance Hashable NotationFlag+ data SigSubPacket = SigSubPacket {     _sspCriticality :: Bool   , _sspPayload :: SigSubPacketPayload-  } deriving (Data, Eq, Typeable)+  } deriving (Data, Eq, Generic, Typeable)  instance Show SigSubPacket where     show x = (if _sspCriticality x then "*" else "") ++ (show . _sspPayload) x +instance Hashable SigSubPacket+ data SigSubPacketPayload = SigCreationTime TimeStamp                   | SigExpirationTime TimeStamp                   | ExportableCertification Exportability@@ -143,8 +152,10 @@                   | EmbeddedSignature SignaturePayload                   | UserDefinedSigSub Word8 ByteString                   | OtherSigSub Word8 ByteString-    deriving (Data, Eq, Show, Typeable) -- FIXME+    deriving (Data, Eq, Generic, Show, Typeable) -- FIXME +instance Hashable SigSubPacketPayload+ data HashAlgorithm = DeprecatedMD5                    | SHA1                    | RIPEMD160@@ -153,7 +164,7 @@                    | SHA512                    | SHA224                    | OtherHA Word8-    deriving (Data, Show, Typeable)+    deriving (Data, Generic, Show, Typeable)  instance Eq HashAlgorithm where     (==) a b = fromFVal a == fromFVal b@@ -179,12 +190,14 @@     toFVal 11 = SHA224     toFVal o = OtherHA o +instance Hashable HashAlgorithm+ data CompressionAlgorithm = Uncompressed                           | ZIP                           | ZLIB                           | BZip2                           | OtherCA Word8-    deriving (Show, Data, Typeable)+    deriving (Show, Data, Generic, Typeable)  instance Eq CompressionAlgorithm where     (==) a b = fromFVal a == fromFVal b@@ -204,6 +217,8 @@     toFVal 3 = BZip2     toFVal o = OtherCA o +instance Hashable CompressionAlgorithm+ class (Eq a, Ord a) => FutureVal a where    fromFVal :: a -> Word8    toFVal :: Word8 -> a@@ -218,7 +233,7 @@                      | ForbiddenElgamal                      | DH                      | OtherPKA Word8-    deriving (Show, Data, Typeable)+    deriving (Show, Data, Generic, Typeable)  instance Eq PubKeyAlgorithm where     (==) a b = fromFVal a == fromFVal b@@ -248,13 +263,15 @@     toFVal 21 = DH     toFVal o = OtherPKA o +instance Hashable PubKeyAlgorithm+ class (Eq a, Ord a) => FutureFlag a where     fromFFlag :: a -> Int     toFFlag :: Int -> a  data KSPFlag = NoModify              | KSPOther Int-    deriving (Data, Show, Typeable)+    deriving (Data, Generic, Show, Typeable)  instance Eq KSPFlag where     (==) a b = fromFFlag a == fromFFlag b@@ -269,6 +286,8 @@     toFFlag 0 = NoModify     toFFlag i = KSPOther (fromIntegral i) +instance Hashable KSPFlag+ data KeyFlag = GroupKey              | AuthKey              | SplitKey@@ -277,7 +296,7 @@              | SignDataKey              | CertifyKeysKey              | KFOther Int-    deriving (Data, Show, Typeable)+    deriving (Data, Generic, Show, Typeable)  instance Eq KeyFlag where     (==) a b = fromFFlag a == fromFFlag b@@ -304,9 +323,11 @@     toFFlag 7 = CertifyKeysKey     toFFlag i = KFOther (fromIntegral i) +instance Hashable KeyFlag+ data RevocationClass = SensitiveRK                      | RClOther Word8 -- FIXME: this should be constrained to 3 bits-    deriving (Data, Show, Typeable)+    deriving (Data, Generic, Show, Typeable)  instance Eq RevocationClass where     (==) a b = fromFFlag a == fromFFlag b@@ -321,13 +342,15 @@     toFFlag 1 = SensitiveRK     toFFlag i = RClOther (fromIntegral i) +instance Hashable RevocationClass+ data RevocationCode = NoReason                     | KeySuperseded                     | KeyMaterialCompromised                     | KeyRetiredAndNoLongerUsed                     | UserIdInfoNoLongerValid                     | RCoOther Word8-    deriving (Show, Data, Typeable)+    deriving (Data, Generic, Show, Typeable)  instance Eq RevocationCode where     (==) a b = fromFVal a == fromFVal b@@ -349,9 +372,11 @@     toFVal 32 = UserIdInfoNoLongerValid     toFVal o = RCoOther o +instance Hashable RevocationCode+ data FeatureFlag = ModificationDetection                  | FeatureOther Int-    deriving (Show, Data, Typeable)+    deriving (Data, Generic, Show, Typeable)  instance Eq FeatureFlag where     (==) a b = fromFFlag a == fromFFlag b@@ -366,43 +391,59 @@     toFFlag 7 = ModificationDetection     toFFlag i = FeatureOther (fromIntegral i) +instance Hashable FeatureFlag+instance Hashable a => Hashable (Set a) where+    hashWithSalt salt = hashWithSalt salt . Set.toList+ newtype MPI = MPI {unMPI :: Integer}-    deriving (Data, Eq, Show, Typeable)+    deriving (Data, Eq, Generic, Show, Typeable) +instance Hashable MPI+ data SignaturePayload = SigV3 SigType Word32 EightOctetKeyId PubKeyAlgorithm HashAlgorithm Word16 [MPI]                       | SigV4 SigType PubKeyAlgorithm HashAlgorithm [SigSubPacket] [SigSubPacket] Word16 [MPI]                       | SigVOther Word8 ByteString-    deriving (Data, Eq, Show, Typeable) -- FIXME+    deriving (Data, Eq, Generic, Show, Typeable) -- FIXME +instance Hashable SignaturePayload+ data KeyVersion = DeprecatedV3 | V4-    deriving (Data, Eq, Ord, Show, Typeable)+    deriving (Data, Eq, Generic, Ord, Show, Typeable) +instance Hashable KeyVersion+ data PKPayload = PKPayload {       _keyVersion :: KeyVersion     , _timestamp :: TimeStamp     , _v3exp :: V3Expiration     , _pkalgo :: PubKeyAlgorithm     , _pubkey :: PKey-    } deriving (Data, Eq, Show, Typeable)+    } deriving (Data, Eq, Generic, Show, Typeable)  instance Ord PKPayload where-    compare a b = show a `compare` show b -- FIXME: this is ridiculous+    compare = comparing _keyVersion <> comparing _timestamp <> comparing _v3exp <> comparing _pkalgo <> comparing (show . _pubkey) -- FIXME: this is suboptimal +instance Hashable PKPayload+ data SKAddendum = SUS16bit SymmetricAlgorithm S2K IV ByteString                 | SUSSHA1 SymmetricAlgorithm S2K IV ByteString                 | SUSym SymmetricAlgorithm IV ByteString                 | SUUnencrypted SKey Word16-    deriving (Data, Eq, Show, Typeable)+    deriving (Data, Eq, Generic, Show, Typeable)  instance Ord SKAddendum where     compare a b = show a `compare` show b -- FIXME: this is ridiculous +instance Hashable SKAddendum+ data DataType = BinaryData               | TextData               | UTF8Data               | OtherData Word8-    deriving (Show, Data, Typeable)+    deriving (Show, Data, Generic, Typeable) +instance Hashable DataType+ instance Eq DataType where     (==) a b = fromFVal a == fromFVal b @@ -424,18 +465,33 @@          | Salted HashAlgorithm Salt          | IteratedSalted HashAlgorithm Salt Count          | OtherS2K Word8 ByteString-    deriving (Data, Eq, Show, Typeable) -- FIXME+    deriving (Data, Eq, Generic, Show, Typeable) -- FIXME +instance Hashable S2K+ data UserAttrSubPacket = ImageAttribute ImageHeader ImageData                        | OtherUASub Word8 ByteString-    deriving (Data, Eq, Show, Typeable) -- FIXME+    deriving (Data, Eq, Generic, Show, Typeable) -- FIXME +instance Hashable UserAttrSubPacket++instance Ord UserAttrSubPacket where+    compare (ImageAttribute h1 d1) (ImageAttribute h2 d2) = compare h1 h2 <> compare d1 d2+    compare (ImageAttribute _ _) (OtherUASub _ _) = LT+    compare (OtherUASub _ _) (ImageAttribute _ _) = GT+    compare (OtherUASub t1 b1) (OtherUASub t2 b2) = compare t1 t2 <> compare b1 b2+ data ImageHeader = ImageHV1 ImageFormat-    deriving (Data, Eq, Show, Typeable)+    deriving (Data, Eq, Generic, Show, Typeable) +instance Ord ImageHeader where+    compare (ImageHV1 a) (ImageHV1 b) = compare a b++instance Hashable ImageHeader+ data ImageFormat = JPEG                  | OtherImage Word8-    deriving (Data, Show, Typeable)+    deriving (Data, Generic, Show, Typeable)  instance Eq ImageFormat where     (==) a b = fromFVal a == fromFVal b@@ -450,6 +506,8 @@     toFVal 1 = JPEG     toFVal o = OtherImage o +instance Hashable ImageFormat+ data SigType = BinarySig              | CanonicalTextSig              | StandaloneSig@@ -466,7 +524,7 @@              | TimestampSig              | ThirdPartyConfirmationSig              | OtherSig Word8-    deriving (Data, Show, Typeable)+    deriving (Data, Generic, Show, Typeable)  instance Eq SigType where     (==) a b = fromFVal a == fromFVal b@@ -509,26 +567,45 @@     toFVal 0x50 = ThirdPartyConfirmationSig     toFVal o = OtherSig o +instance Hashable SigType+ instance Ord DSA.PublicKey instance Ord RSA.PublicKey+instance Ord DSA.PrivateKey+instance Ord RSA.PrivateKey +instance Hashable DSA.Params where+    hashWithSalt s (DSA.Params p g q) = s `hashWithSalt` p `hashWithSalt` g `hashWithSalt` q+instance Hashable DSA.PublicKey where+    hashWithSalt s (DSA.PublicKey p y) = s `hashWithSalt` p `hashWithSalt` y+instance Hashable DSA.PrivateKey where+    hashWithSalt s (DSA.PrivateKey p x) = s `hashWithSalt` p `hashWithSalt` x+instance Hashable RSA.PublicKey where+    hashWithSalt s (RSA.PublicKey size n e) = s `hashWithSalt` size `hashWithSalt` n `hashWithSalt` e+instance Hashable RSA.PrivateKey where+    hashWithSalt s (RSA.PrivateKey pub d p q dP dQ qinv) = s `hashWithSalt` pub `hashWithSalt` d `hashWithSalt` p `hashWithSalt` q `hashWithSalt` dP `hashWithSalt` dQ `hashWithSalt` qinv+ data PKey = RSAPubKey RSA.PublicKey           | DSAPubKey DSA.PublicKey           | ElGamalPubKey [Integer] 	  | UnknownPKey ByteString-    deriving (Data, Eq, Ord, Show, Typeable)+    deriving (Data, Eq, Generic, Ord, Show, Typeable) +instance Hashable PKey+ data SKey = RSAPrivateKey RSA.PrivateKey           | DSAPrivateKey DSA.PrivateKey           | ElGamalPrivateKey [Integer] 	  | UnknownSKey ByteString-    deriving (Data, Eq, Show, Typeable)+    deriving (Data, Eq, Generic, Show, Typeable) +instance Hashable SKey+ newtype Block a = Block {unBlock :: [a]} -- so we can override cereal instance     deriving (Show, Eq)  newtype EightOctetKeyId = EightOctetKeyId {unEOKI :: ByteString}-    deriving (Eq, Ord, Data, Typeable) -- FIXME+    deriving (Eq, Ord, Data, Generic, Typeable) -- FIXME  instance Show EightOctetKeyId where     show = w8sToHex . B.unpack . unEOKI@@ -536,8 +613,10 @@ instance Read EightOctetKeyId where     readsPrec _ = map ((EightOctetKeyId . B.pack *** concat) . unzip) . chunksOf 8 . hexToW8s +instance Hashable EightOctetKeyId+ newtype TwentyOctetFingerprint = TwentyOctetFingerprint {unTOF :: ByteString}-    deriving (Eq, Ord, Data, Typeable)+    deriving (Data, Eq, Generic, Ord, Typeable)  instance Show TwentyOctetFingerprint where     show = take 50 . concatMap (++" ") . concatMap (++[""]) . chunksOf 5 . chunksOf 4 . w8sToHex . B.unpack . unTOF@@ -545,6 +624,8 @@ instance Read TwentyOctetFingerprint where     readsPrec _ = map ((TwentyOctetFingerprint . B.pack *** concat) . unzip) . chunksOf 20 . hexToW8s . filter (/= ' ') +instance Hashable TwentyOctetFingerprint+ w8sToHex :: [Word8] -> String w8sToHex = map toUpper . concatMap ((\x -> if length x == 1 then '0':x else x) . flip showHex "") @@ -591,7 +672,9 @@          | ModificationDetectionCodePkt ByteString          | OtherPacketPkt Word8 ByteString          | BrokenPacketPkt String Word8 ByteString-    deriving (Data, Eq, Show, Typeable) -- FIXME+    deriving (Data, Eq, Generic, Show, Typeable) -- FIXME++instance Hashable Pkt  pktTag :: Pkt -> Word8 pktTag (PKESKPkt {}) = 1

@@ -6,14 +6,18 @@ 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.Internal (issuer, sigCT) import Codec.Encryption.OpenPGP.Types- import Control.Lens ((^.), (^..), _1, folded) import Data.Data.Lens (biplate) import Data.Either (rights)+import Data.Function (on)+import qualified Data.HashMap.Lazy as HashMap+import Data.IxSet (Proxy(..), Indexable(..), ixSet, ixGen, ixFun)+import Data.List (nub, sort)+import qualified Data.Map as Map+import Data.Semigroup ((<>), Semigroup)  instance Indexable TK where     empty = ixSet@@ -29,3 +33,21 @@ getTOFs tk = map fingerprint (tk ^.. biplate :: [PKPayload]) getUIDs :: TK -> [String] getUIDs tk = (tk^.tkUIDs)^..folded._1++instance Ord SignaturePayload where+    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++instance Semigroup TK where+    (<>) a b = TK (_tkKey a) (nub . sort $ _tkRevs a ++ _tkRevs b) ((kvmerge `on` _tkUIDs) a b) ((kvmerge `on` _tkUAts) a b) ((ukvmerge `on` _tkSubs) a b)+      where+        kvmerge x y = Map.toList (Map.unionWith nsa (Map.fromList x) (Map.fromList y))+        ukvmerge x y = HashMap.toList (HashMap.unionWith nsa (HashMap.fromList x) (HashMap.fromList y))+        nsa x y = nub . sort $ x ++ y

@@ -1,5 +1,5 @@ Name:                hOpenPGP-Version:             1.3+Version:             1.4 Synopsis:            native Haskell implementation of OpenPGP (RFC4880) Description:         native Haskell implementation of OpenPGP (RFC4880) Homepage:            http://floss.scru.org/hOpenPGP/@@ -183,6 +183,7 @@                , cryptohash                , data-default                , errors+               , hashable                , incremental-parser                , ixset                 >= 1.0                , lens                  >= 3.0@@ -192,10 +193,12 @@                , openpgp-asciiarmor                 >= 0.1                , resourcet              > 0.4                , securemem+               , semigroups                , split                , text                , time                               >= 1.1                , transformers+               , unordered-containers                , zlib   default-language: Haskell2010 @@ -222,6 +225,7 @@                , cryptohash                , data-default                , errors+               , hashable                , incremental-parser                , ixset                 >= 1.0                , lens                  >= 3.0@@ -229,10 +233,12 @@                , mtl                , nettle                , securemem+               , semigroups                , split                , text                , time                               >= 1.1                , transformers+               , unordered-containers                , zlib                , tasty                , tasty-hunit@@ -249,4 +255,4 @@ source-repository this   type:     git   location: git://git.debian.org/users/clint/hOpenPGP.git-  tag:      v1.3+  tag:      v1.4