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 @@ -17,6 +17,7 @@ import Codec.Encryption.OpenPGP.Serialize (getSecretKey) import Codec.Encryption.OpenPGP.S2K (skesk2Key, string2Key) import qualified Crypto.Hash as CH +import Crypto.Number.ModArithmetic (inverse) import Crypto.Random.EntropyPool (createEntropyPool, getEntropyFrom) import qualified Data.ByteArray as BA import qualified Data.ByteString as B @@ -80,13 +81,8 @@ algospecific = runPut $ put (MPI d) >> put (MPI p) >> put (MPI q) >> put (MPI u) cksum = CH.hashlazy algospecific :: CH.Digest CH.SHA1 payload = algospecific `BL.append` BL.fromStrict (BA.convert cksum) - u = inverse q p + Just u = inverse p q encryptSKey _ _ _ _ = error "Non-RSA keytypes not handled yet" -- FIXME: do DSA and ElGamal - -inverse :: Integral a => a -> a -> a -inverse _ 1 = 1 -inverse q p = (n * q + 1) `div` p - where n = p - inverse p (q `mod` p) reencryptSecretKeyIO :: SecretKey -> BL.ByteString -> IO SecretKey reencryptSecretKeyIO sk pp = encryptPrivateKeyIO (_secretKeySKAddendum sk) pp >>= \n -> return sk { _secretKeySKAddendum = n } 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 @@ -5,8 +5,16 @@ 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 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 diff --git a/Codec/Encryption/OpenPGP/Types/Internal/Base.hs b/Codec/Encryption/OpenPGP/Types/Internal/Base.hs --- a/Codec/Encryption/OpenPGP/Types/Internal/Base.hs +++ b/Codec/Encryption/OpenPGP/Types/Internal/Base.hs @@ -24,9 +24,6 @@ import Control.Lens (makeLenses) import Control.Monad (mzero) import Control.Newtype (Newtype(..)) -import qualified Crypto.PubKey.RSA as RSA -import qualified Crypto.PubKey.DSA as DSA -import qualified Crypto.PubKey.ECC.ECDSA as ECDSA import Data.Aeson ((.=), object) import qualified Data.Aeson as A import Data.Byteable (Byteable) @@ -37,7 +34,6 @@ import Data.Char (toLower, toUpper) import Data.Data (Data) import Data.Hashable (Hashable(..)) -import Data.IxSet.Typed (IxSet) import Data.List (unfoldr) import Data.List.NonEmpty (NonEmpty) import qualified Data.List.NonEmpty as NE @@ -59,7 +55,7 @@ import Network.URI (URI(..), uriToString, nullURI, parseURI) import Numeric (readHex, showHex) import Data.Time.Locale.Compat (defaultTimeLocale) -import Text.PrettyPrint.Free (Pretty(..), (<+>), char, hsep, punctuate, space, text, tupled) +import Text.PrettyPrint.Free (Pretty(..), (<+>), char, hsep, punctuate, space, text) type Exportability = Bool type TrustLevel = Word8 @@ -740,24 +736,6 @@ instance A.ToJSON KeyVersion instance A.FromJSON KeyVersion -data PKPayload = PKPayload { - _keyVersion :: KeyVersion - , _timestamp :: ThirtyTwoBitTimeStamp - , _v3exp :: V3Expiration - , _pkalgo :: PubKeyAlgorithm - , _pubkey :: PKey - } deriving (Data, Eq, Generic, Show, Typeable) - -instance Ord PKPayload where - compare = comparing _keyVersion <> comparing _timestamp <> comparing _v3exp <> comparing _pkalgo <> comparing _pubkey - -instance Hashable PKPayload - -instance Pretty PKPayload where - pretty (PKPayload kv ts v3e pka p) = pretty kv <+> pretty ts <+> pretty v3e <+> pretty pka <+> pretty p - -instance A.ToJSON PKPayload - newtype IV = IV {unIV :: B.ByteString} deriving (Byteable, ByteArrayAccess, Data, Eq, Generic, Hashable, Monoid, Show, Typeable) @@ -771,29 +749,6 @@ instance A.ToJSON IV where toJSON = A.toJSON . show . unpack -data SKAddendum = SUS16bit SymmetricAlgorithm S2K IV ByteString - | SUSSHA1 SymmetricAlgorithm S2K IV ByteString - | SUSym SymmetricAlgorithm IV ByteString - | SUUnencrypted SKey Word16 - 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 - -instance Pretty SKAddendum where - pretty (SUS16bit sa s2k iv bs) = text "SUS16bit" <+> pretty sa <+> pretty s2k <+> pretty iv <+> pretty bs - pretty (SUSSHA1 sa s2k iv bs) = text "SUSSHA1" <+> pretty sa <+> pretty s2k <+> pretty iv <+> pretty bs - pretty (SUSym sa iv bs) = text "SUSym" <+> pretty sa <+> pretty iv <+> pretty bs - pretty (SUUnencrypted s ck) = text "SUUnencrypted" <+> pretty s <+> pretty ck - -instance A.ToJSON SKAddendum where - toJSON (SUS16bit sa s2k iv bs) = A.toJSON (sa, s2k, iv, BL.unpack bs) - toJSON (SUSSHA1 sa s2k iv bs) = A.toJSON (sa, s2k, iv, BL.unpack bs) - toJSON (SUSym sa iv bs) = A.toJSON (sa, iv, BL.unpack bs) - toJSON (SUUnencrypted s ck) = A.toJSON (s, ck) - data DataType = BinaryData | TextData | UTF8Data @@ -1016,70 +971,6 @@ instance A.ToJSON SigType instance A.FromJSON SigType -newtype DSA_PublicKey = DSA_PublicKey {unDSA_PublicKey :: DSA.PublicKey} - deriving (Data, Eq, Generic, Show, Typeable) -instance Ord DSA_PublicKey -instance A.ToJSON DSA_PublicKey where - toJSON (DSA_PublicKey (DSA.PublicKey p y)) = A.toJSON (DSA_Params p, y) -instance Pretty DSA_PublicKey where - pretty (DSA_PublicKey (DSA.PublicKey p y)) = pretty (DSA_Params p) <+> pretty y -newtype RSA_PublicKey = RSA_PublicKey {unRSA_PublicKey :: RSA.PublicKey} - deriving (Data, Eq, Generic, Show, Typeable) -instance Ord RSA_PublicKey -instance A.ToJSON RSA_PublicKey where - toJSON (RSA_PublicKey (RSA.PublicKey size n e)) = A.toJSON (size, n, e) -instance Pretty RSA_PublicKey where - pretty (RSA_PublicKey (RSA.PublicKey size n e)) = pretty size <+> pretty n <+> pretty e -newtype ECDSA_PublicKey = ECDSA_PublicKey {unECDSA_PublicKey :: ECDSA.PublicKey} - deriving (Data, Eq, Generic, Show, Typeable) -instance Ord ECDSA_PublicKey -instance A.ToJSON ECDSA_PublicKey where - toJSON (ECDSA_PublicKey (ECDSA.PublicKey curve q)) = A.toJSON (show curve, show q) -instance Pretty ECDSA_PublicKey where - pretty (ECDSA_PublicKey (ECDSA.PublicKey curve q)) = pretty (show curve, show q) -newtype DSA_PrivateKey = DSA_PrivateKey {unDSA_PrivateKey :: DSA.PrivateKey} - deriving (Data, Eq, Generic, Show, Typeable) -instance Ord DSA_PrivateKey -instance A.ToJSON DSA_PrivateKey where - toJSON (DSA_PrivateKey (DSA.PrivateKey p x)) = A.toJSON (DSA_Params p, x) -instance Pretty DSA_PrivateKey where - pretty (DSA_PrivateKey (DSA.PrivateKey p x)) = pretty (DSA_Params p, x) -newtype RSA_PrivateKey = RSA_PrivateKey {unRSA_PrivateKey :: RSA.PrivateKey} - deriving (Data, Eq, Generic, Show, Typeable) -instance Ord RSA_PrivateKey -instance A.ToJSON RSA_PrivateKey where - toJSON (RSA_PrivateKey (RSA.PrivateKey pub d p q dP dQ qinv)) = A.toJSON (RSA_PublicKey pub, d, p, q, dP, dQ, qinv) -instance Pretty RSA_PrivateKey where - pretty (RSA_PrivateKey (RSA.PrivateKey pub d p q dP dQ qinv)) = pretty (RSA_PublicKey pub) <+> tupled (map pretty [d, p, q, dP, dQ, qinv]) -newtype ECDSA_PrivateKey = ECDSA_PrivateKey {unECDSA_PrivateKey :: ECDSA.PrivateKey} - deriving (Data, Eq, Generic, Show, Typeable) -instance Ord ECDSA_PrivateKey -instance A.ToJSON ECDSA_PrivateKey where - toJSON (ECDSA_PrivateKey (ECDSA.PrivateKey curve d)) = A.toJSON (show curve, show d) -instance Pretty ECDSA_PrivateKey where - pretty (ECDSA_PrivateKey (ECDSA.PrivateKey curve d)) = pretty (show curve, show d) - -newtype DSA_Params = DSA_Params {unDSA_Params :: DSA.Params} - deriving (Data, Eq, Generic, Show, Typeable) -instance A.ToJSON DSA_Params where - toJSON (DSA_Params (DSA.Params p g q)) = A.toJSON (p, g, q) -instance Pretty DSA_Params where - pretty (DSA_Params (DSA.Params p g q)) = pretty (p, g, q) -instance Hashable DSA_Params where - hashWithSalt s (DSA_Params (DSA.Params p g q)) = s `hashWithSalt` p `hashWithSalt` g `hashWithSalt` q -instance Hashable DSA_PublicKey where - hashWithSalt s (DSA_PublicKey (DSA.PublicKey p y)) = s `hashWithSalt` DSA_Params p `hashWithSalt` y -instance Hashable DSA_PrivateKey where - hashWithSalt s (DSA_PrivateKey (DSA.PrivateKey p x)) = s `hashWithSalt` DSA_Params p `hashWithSalt` x -instance Hashable RSA_PublicKey where - hashWithSalt s (RSA_PublicKey (RSA.PublicKey size n e)) = s `hashWithSalt` size `hashWithSalt` n `hashWithSalt` e -instance Hashable RSA_PrivateKey where - hashWithSalt s (RSA_PrivateKey (RSA.PrivateKey pub d p q dP dQ qinv)) = s `hashWithSalt` RSA_PublicKey pub `hashWithSalt` d `hashWithSalt` p `hashWithSalt` q `hashWithSalt` dP `hashWithSalt` dQ `hashWithSalt` qinv -instance Hashable ECDSA_PublicKey where - hashWithSalt s (ECDSA_PublicKey (ECDSA.PublicKey curve q)) = s `hashWithSalt` show curve `hashWithSalt` show q -- FIXME: don't use show -instance Hashable ECDSA_PrivateKey where - hashWithSalt s (ECDSA_PrivateKey (ECDSA.PrivateKey curve d)) = s `hashWithSalt` show curve `hashWithSalt` show d -- FIXME: don't use show - data ECCCurve = BrokenNISTP256 | BrokenNISTP384 | BrokenNISTP521 @@ -1087,58 +978,6 @@ instance Hashable ECCCurve -data PKey = RSAPubKey RSA_PublicKey - | DSAPubKey DSA_PublicKey - | ElGamalPubKey [Integer] - | ECDHPubKey ECDSA_PublicKey HashAlgorithm SymmetricAlgorithm - | ECDSAPubKey ECDSA_PublicKey - | UnknownPKey ByteString - deriving (Data, Eq, Generic, Ord, Show, Typeable) - -instance Hashable PKey - -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 (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 - -instance A.ToJSON PKey where - toJSON (RSAPubKey p) = A.toJSON p - toJSON (DSAPubKey p) = A.toJSON p - toJSON (ElGamalPubKey p) = A.toJSON p - 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] - | ECDHPrivateKey ECDSA_PrivateKey - | ECDSAPrivateKey ECDSA_PrivateKey - | UnknownSKey ByteString - deriving (Data, Eq, Generic, Show, Typeable) - -instance Hashable SKey - -instance Pretty SKey where - pretty (RSAPrivateKey p) = text "RSA" <+> pretty p - pretty (DSAPrivateKey p) = text "DSA" <+> pretty p - pretty (ElGamalPrivateKey p) = text "Elgamal" <+> pretty p - pretty (ECDHPrivateKey p) = text "ECDH" <+> pretty p - pretty (ECDSAPrivateKey p) = text "ECDSA" <+> pretty p - pretty (UnknownSKey bs) = text "unknown" <+> pretty bs - -instance A.ToJSON SKey where - toJSON (RSAPrivateKey k) = A.toJSON k - toJSON (DSAPrivateKey k) = A.toJSON k - toJSON (ElGamalPrivateKey k) = A.toJSON k - toJSON (ECDHPrivateKey k) = A.toJSON k - toJSON (ECDSAPrivateKey k) = A.toJSON k - toJSON (UnknownSKey bs) = A.toJSON (BL.unpack bs) - newtype Block a = Block {unBlock :: [a]} -- so we can override cereal instance deriving (Show, Eq) @@ -1204,117 +1043,4 @@ hexToW8s :: ReadS Word8 hexToW8s = concatMap readHex . chunksOf 2 . map toLower -data TK = TK { - _tkKey :: (PKPayload, Maybe SKAddendum) - , _tkRevs :: [SignaturePayload] - , _tkUIDs :: [(Text, [SignaturePayload])] - , _tkUAts :: [([UserAttrSubPacket], [SignaturePayload])] - , _tkSubs :: [(Pkt, [SignaturePayload])] - } deriving (Data, Eq, Generic, Show, Typeable) - -instance Ord TK where - compare = comparing _tkKey -- FIXME: is this ridiculous? - -instance A.ToJSON TK - -type KeyringIxs = '[EightOctetKeyId, TwentyOctetFingerprint, Text] -type Keyring = IxSet KeyringIxs TK - --- data Pkt = forall a. (Packet a, Show a, Eq a) => Pkt a -data Pkt = PKESKPkt PacketVersion EightOctetKeyId PubKeyAlgorithm (NonEmpty MPI) - | SignaturePkt SignaturePayload - | SKESKPkt PacketVersion SymmetricAlgorithm S2K (Maybe BL.ByteString) - | OnePassSignaturePkt PacketVersion SigType HashAlgorithm PubKeyAlgorithm EightOctetKeyId NestedFlag - | SecretKeyPkt PKPayload SKAddendum - | PublicKeyPkt PKPayload - | SecretSubkeyPkt PKPayload SKAddendum - | CompressedDataPkt CompressionAlgorithm CompressedDataPayload - | SymEncDataPkt ByteString - | MarkerPkt ByteString - | LiteralDataPkt DataType FileName ThirtyTwoBitTimeStamp ByteString - | TrustPkt ByteString - | UserIdPkt Text - | PublicSubkeyPkt PKPayload - | UserAttributePkt [UserAttrSubPacket] - | SymEncIntegrityProtectedDataPkt PacketVersion ByteString - | ModificationDetectionCodePkt ByteString - | OtherPacketPkt Word8 ByteString - | BrokenPacketPkt String Word8 ByteString - deriving (Data, Eq, Generic, Show, Typeable) -- FIXME - -instance Hashable Pkt - -instance Ord Pkt where - compare = comparing pktTag <> comparing hash -- FIXME: is there something saner? - -instance Pretty Pkt where - pretty (PKESKPkt pv eoki pka mpis) = text "PKESK v" <> (text . show) pv <> char ':' <+> pretty eoki <+> pretty pka <+> (prettyList . NE.toList) mpis - pretty (SignaturePkt sp) = pretty sp - pretty (SKESKPkt pv sa s2k mbs) = text "SKESK v" <> (text . show) pv <> char ':' <+> pretty sa <+> pretty s2k <+> pretty mbs - pretty (OnePassSignaturePkt pv st ha pka eoki nestedflag) = text "one-pass signature v" <> (text . show) pv <> char ':' <+> pretty st <+> pretty ha <+> pretty pka <+> pretty eoki <+> pretty nestedflag - pretty (SecretKeyPkt pkp ska) = text "secret key:" <+> pretty pkp <+> pretty ska - pretty (PublicKeyPkt pkp) = text "public key:" <+> pretty pkp - pretty (SecretSubkeyPkt pkp ska) = text "secret subkey:" <+> pretty pkp <+> pretty ska - pretty (CompressedDataPkt ca cdp) = text "compressed-data:" <+> pretty ca <+> pretty cdp - pretty (SymEncDataPkt bs) = text "symmetrically-encrypted-data:" <+> pretty bs - pretty (MarkerPkt bs) = text "marker:" <+> pretty bs - pretty (LiteralDataPkt dt fn ts bs) = text "literal-data" <+> pretty dt <+> pretty fn <+> pretty ts <+> pretty bs - pretty (TrustPkt bs) = text "trust:" <+> pretty (BL.unpack bs) - pretty (UserIdPkt u) = text "user-ID:" <+> pretty u - pretty (PublicSubkeyPkt pkp) = text "public subkey:" <+> pretty pkp - pretty (UserAttributePkt us) = text "user-attribute:" <+> prettyList us - pretty (SymEncIntegrityProtectedDataPkt pv bs) = text "symmetrically-encrypted-integrity-protected-data v" <> (text . show) pv <> char ':' <+> pretty bs - pretty (ModificationDetectionCodePkt bs) = text "MDC:" <+> pretty bs - pretty (OtherPacketPkt t bs) = text "unknown packet type" <+> pretty t <> char ':' <+> pretty bs - pretty (BrokenPacketPkt s t bs) = text "BROKEN packet (" <> pretty s <> char ')' <+> pretty t <> char ':' <+> pretty bs - -instance A.ToJSON Pkt where - toJSON (PKESKPkt pv eoki pka mpis) = object [T.pack "pkesk" .= object [T.pack "version" .= pv, T.pack "keyid" .= eoki, T.pack "pkalgo" .= pka, T.pack "mpis" .= NE.toList mpis]] - toJSON (SignaturePkt sp) = object [T.pack "signature" .= sp] - toJSON (SKESKPkt pv sa s2k mbs) = object [T.pack "skesk" .= object [T.pack "version" .= pv, T.pack "symalgo" .= sa, T.pack "s2k" .= s2k, T.pack "data" .= maybe mempty BL.unpack mbs]] - toJSON (OnePassSignaturePkt pv st ha pka eoki nestedflag) = object [T.pack "onepasssignature" .= object [T.pack "version" .= pv, T.pack "sigtype" .= st, T.pack "hashalgo" .= ha, T.pack "pkalgo" .= pka, T.pack "keyid" .= eoki, T.pack "nested" .= nestedflag]] - toJSON (SecretKeyPkt pkp ska) = object [T.pack "secretkey" .= object [T.pack "public" .= pkp, T.pack "secret" .= ska]] - toJSON (PublicKeyPkt pkp) = object [T.pack "publickey" .= pkp] - toJSON (SecretSubkeyPkt pkp ska) = object [T.pack "secretsubkey" .= object [T.pack "public" .= pkp, T.pack "secret" .= ska]] - toJSON (CompressedDataPkt ca cdp) = object [T.pack "compresseddata" .= object [T.pack "compressionalgo" .= ca, T.pack "data" .= BL.unpack cdp]] - toJSON (SymEncDataPkt bs) = object [T.pack "symencdata" .= BL.unpack bs] - toJSON (MarkerPkt bs) = object [T.pack "marker" .= BL.unpack bs] - toJSON (LiteralDataPkt dt fn ts bs) = object [T.pack "literaldata" .= object [T.pack "dt" .= dt, T.pack "filename" .= BL.unpack fn, T.pack "ts" .= ts, T.pack "data" .= BL.unpack bs]] - toJSON (TrustPkt bs) = object [T.pack "trust" .= BL.unpack bs] - toJSON (UserIdPkt u) = object [T.pack "userid" .= u] - toJSON (PublicSubkeyPkt pkp) = object [T.pack "publicsubkkey" .= pkp] - toJSON (UserAttributePkt us) = object [T.pack "userattribute" .= us] - toJSON (SymEncIntegrityProtectedDataPkt pv bs) = object [T.pack "symencipd" .= object [T.pack "version" .= pv, T.pack "data" .= BL.unpack bs]] - toJSON (ModificationDetectionCodePkt bs) = object [T.pack "mdc" .= BL.unpack bs] - toJSON (OtherPacketPkt t bs) = object [T.pack "otherpacket" .= object [T.pack "tag" .= t, T.pack "data" .= BL.unpack bs]] - 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 (SignaturePkt _) = 2 -pktTag (SKESKPkt {}) = 3 -pktTag (OnePassSignaturePkt {}) = 4 -pktTag (SecretKeyPkt {}) = 5 -pktTag (PublicKeyPkt _) = 6 -pktTag (SecretSubkeyPkt {}) = 7 -pktTag (CompressedDataPkt {}) = 8 -pktTag (SymEncDataPkt _) = 9 -pktTag (MarkerPkt _) = 10 -pktTag (LiteralDataPkt {}) = 11 -pktTag (TrustPkt _) = 12 -pktTag (UserIdPkt _) = 13 -pktTag (PublicSubkeyPkt _) = 14 -pktTag (UserAttributePkt _) = 17 -pktTag (SymEncIntegrityProtectedDataPkt {}) = 18 -pktTag (ModificationDetectionCodePkt _) = 19 -pktTag (OtherPacketPkt t _) = t -pktTag (BrokenPacketPkt _ t _) = t -- is this the right thing to do? - -data Verification = Verification { - _verificationSigner :: PKPayload - , _verificationSignature :: SignaturePayload - } - -$(makeLenses ''TK) -$(makeLenses ''Verification) $(makeLenses ''SigSubPacket) diff --git a/Codec/Encryption/OpenPGP/Types/Internal/CryptoniteNewtypes.hs b/Codec/Encryption/OpenPGP/Types/Internal/CryptoniteNewtypes.hs new file mode 100644 --- /dev/null +++ b/Codec/Encryption/OpenPGP/Types/Internal/CryptoniteNewtypes.hs @@ -0,0 +1,86 @@ +-- CryptoniteNewtypes.hs: OpenPGP (RFC4880) newtype wrappers for some cryptonite types +-- Copyright © 2012-2016 Clint Adams +-- This software is released under the terms of the Expat license. +-- (See the LICENSE file). + +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} + +module Codec.Encryption.OpenPGP.Types.Internal.CryptoniteNewtypes where + +import GHC.Generics (Generic) + +import qualified Crypto.PubKey.RSA as RSA +import qualified Crypto.PubKey.DSA as DSA +import qualified Crypto.PubKey.ECC.ECDSA as ECDSA +import qualified Data.Aeson as A +import Data.Data (Data) +import Data.Hashable (Hashable(..)) +import Data.Typeable (Typeable) +import Text.PrettyPrint.Free (Pretty(..), (<+>), tupled) + +newtype DSA_PublicKey = DSA_PublicKey {unDSA_PublicKey :: DSA.PublicKey} + deriving (Data, Eq, Generic, Show, Typeable) +instance Ord DSA_PublicKey +instance A.ToJSON DSA_PublicKey where + toJSON (DSA_PublicKey (DSA.PublicKey p y)) = A.toJSON (DSA_Params p, y) +instance Pretty DSA_PublicKey where + pretty (DSA_PublicKey (DSA.PublicKey p y)) = pretty (DSA_Params p) <+> pretty y +newtype RSA_PublicKey = RSA_PublicKey {unRSA_PublicKey :: RSA.PublicKey} + deriving (Data, Eq, Generic, Show, Typeable) +instance Ord RSA_PublicKey +instance A.ToJSON RSA_PublicKey where + toJSON (RSA_PublicKey (RSA.PublicKey size n e)) = A.toJSON (size, n, e) +instance Pretty RSA_PublicKey where + pretty (RSA_PublicKey (RSA.PublicKey size n e)) = pretty size <+> pretty n <+> pretty e +newtype ECDSA_PublicKey = ECDSA_PublicKey {unECDSA_PublicKey :: ECDSA.PublicKey} + deriving (Data, Eq, Generic, Show, Typeable) +instance Ord ECDSA_PublicKey +instance A.ToJSON ECDSA_PublicKey where + toJSON (ECDSA_PublicKey (ECDSA.PublicKey curve q)) = A.toJSON (show curve, show q) +instance Pretty ECDSA_PublicKey where + pretty (ECDSA_PublicKey (ECDSA.PublicKey curve q)) = pretty (show curve, show q) +newtype DSA_PrivateKey = DSA_PrivateKey {unDSA_PrivateKey :: DSA.PrivateKey} + deriving (Data, Eq, Generic, Show, Typeable) +instance Ord DSA_PrivateKey +instance A.ToJSON DSA_PrivateKey where + toJSON (DSA_PrivateKey (DSA.PrivateKey p x)) = A.toJSON (DSA_Params p, x) +instance Pretty DSA_PrivateKey where + pretty (DSA_PrivateKey (DSA.PrivateKey p x)) = pretty (DSA_Params p, x) +newtype RSA_PrivateKey = RSA_PrivateKey {unRSA_PrivateKey :: RSA.PrivateKey} + deriving (Data, Eq, Generic, Show, Typeable) +instance Ord RSA_PrivateKey +instance A.ToJSON RSA_PrivateKey where + toJSON (RSA_PrivateKey (RSA.PrivateKey pub d p q dP dQ qinv)) = A.toJSON (RSA_PublicKey pub, d, p, q, dP, dQ, qinv) +instance Pretty RSA_PrivateKey where + pretty (RSA_PrivateKey (RSA.PrivateKey pub d p q dP dQ qinv)) = pretty (RSA_PublicKey pub) <+> tupled (map pretty [d, p, q, dP, dQ, qinv]) +newtype ECDSA_PrivateKey = ECDSA_PrivateKey {unECDSA_PrivateKey :: ECDSA.PrivateKey} + deriving (Data, Eq, Generic, Show, Typeable) +instance Ord ECDSA_PrivateKey +instance A.ToJSON ECDSA_PrivateKey where + toJSON (ECDSA_PrivateKey (ECDSA.PrivateKey curve d)) = A.toJSON (show curve, show d) +instance Pretty ECDSA_PrivateKey where + pretty (ECDSA_PrivateKey (ECDSA.PrivateKey curve d)) = pretty (show curve, show d) + +newtype DSA_Params = DSA_Params {unDSA_Params :: DSA.Params} + deriving (Data, Eq, Generic, Show, Typeable) +instance A.ToJSON DSA_Params where + toJSON (DSA_Params (DSA.Params p g q)) = A.toJSON (p, g, q) +instance Pretty DSA_Params where + pretty (DSA_Params (DSA.Params p g q)) = pretty (p, g, q) +instance Hashable DSA_Params where + hashWithSalt s (DSA_Params (DSA.Params p g q)) = s `hashWithSalt` p `hashWithSalt` g `hashWithSalt` q +instance Hashable DSA_PublicKey where + hashWithSalt s (DSA_PublicKey (DSA.PublicKey p y)) = s `hashWithSalt` DSA_Params p `hashWithSalt` y +instance Hashable DSA_PrivateKey where + hashWithSalt s (DSA_PrivateKey (DSA.PrivateKey p x)) = s `hashWithSalt` DSA_Params p `hashWithSalt` x +instance Hashable RSA_PublicKey where + hashWithSalt s (RSA_PublicKey (RSA.PublicKey size n e)) = s `hashWithSalt` size `hashWithSalt` n `hashWithSalt` e +instance Hashable RSA_PrivateKey where + hashWithSalt s (RSA_PrivateKey (RSA.PrivateKey pub d p q dP dQ qinv)) = s `hashWithSalt` RSA_PublicKey pub `hashWithSalt` d `hashWithSalt` p `hashWithSalt` q `hashWithSalt` dP `hashWithSalt` dQ `hashWithSalt` qinv +instance Hashable ECDSA_PublicKey where + hashWithSalt s (ECDSA_PublicKey (ECDSA.PublicKey curve q)) = s `hashWithSalt` show curve `hashWithSalt` show q -- FIXME: don't use show +instance Hashable ECDSA_PrivateKey where + hashWithSalt s (ECDSA_PrivateKey (ECDSA.PrivateKey curve d)) = s `hashWithSalt` show curve `hashWithSalt` show d -- FIXME: don't use show + diff --git a/Codec/Encryption/OpenPGP/Types/Internal/PKITypes.hs b/Codec/Encryption/OpenPGP/Types/Internal/PKITypes.hs new file mode 100644 --- /dev/null +++ b/Codec/Encryption/OpenPGP/Types/Internal/PKITypes.hs @@ -0,0 +1,120 @@ +-- PKITypes.hs: OpenPGP (RFC4880) data types for public/secret keys +-- Copyright © 2012-2016 Clint Adams +-- This software is released under the terms of the Expat license. +-- (See the LICENSE file). + +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} + +module Codec.Encryption.OpenPGP.Types.Internal.PKITypes where + +import GHC.Generics (Generic) + +import Codec.Encryption.OpenPGP.Types.Internal.Base +import Codec.Encryption.OpenPGP.Types.Internal.CryptoniteNewtypes + +import qualified Data.Aeson as A +import Data.ByteString.Lazy (ByteString) +import qualified Data.ByteString.Lazy as BL +import Data.Data (Data) +import Data.Hashable (Hashable(..)) +import Data.Monoid ((<>)) +import Data.Ord (comparing) +import Data.Typeable (Typeable) +import Data.Word (Word16) +import Text.PrettyPrint.Free (Pretty(..), (<+>), text) + +data PKey = RSAPubKey RSA_PublicKey + | DSAPubKey DSA_PublicKey + | ElGamalPubKey [Integer] + | ECDHPubKey ECDSA_PublicKey HashAlgorithm SymmetricAlgorithm + | ECDSAPubKey ECDSA_PublicKey + | UnknownPKey ByteString + deriving (Data, Eq, Generic, Ord, Show, Typeable) + +instance Hashable PKey + +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 (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 + +instance A.ToJSON PKey where + toJSON (RSAPubKey p) = A.toJSON p + toJSON (DSAPubKey p) = A.toJSON p + toJSON (ElGamalPubKey p) = A.toJSON p + 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] + | ECDHPrivateKey ECDSA_PrivateKey + | ECDSAPrivateKey ECDSA_PrivateKey + | UnknownSKey ByteString + deriving (Data, Eq, Generic, Show, Typeable) + +instance Hashable SKey + +instance Pretty SKey where + pretty (RSAPrivateKey p) = text "RSA" <+> pretty p + pretty (DSAPrivateKey p) = text "DSA" <+> pretty p + pretty (ElGamalPrivateKey p) = text "Elgamal" <+> pretty p + pretty (ECDHPrivateKey p) = text "ECDH" <+> pretty p + pretty (ECDSAPrivateKey p) = text "ECDSA" <+> pretty p + pretty (UnknownSKey bs) = text "unknown" <+> pretty bs + +instance A.ToJSON SKey where + toJSON (RSAPrivateKey k) = A.toJSON k + toJSON (DSAPrivateKey k) = A.toJSON k + toJSON (ElGamalPrivateKey k) = A.toJSON k + toJSON (ECDHPrivateKey k) = A.toJSON k + toJSON (ECDSAPrivateKey k) = A.toJSON k + toJSON (UnknownSKey bs) = A.toJSON (BL.unpack bs) + +data PKPayload = PKPayload { + _keyVersion :: KeyVersion + , _timestamp :: ThirtyTwoBitTimeStamp + , _v3exp :: V3Expiration + , _pkalgo :: PubKeyAlgorithm + , _pubkey :: PKey + } deriving (Data, Eq, Generic, Show, Typeable) + +instance Ord PKPayload where + compare = comparing _keyVersion <> comparing _timestamp <> comparing _v3exp <> comparing _pkalgo <> comparing _pubkey + +instance Hashable PKPayload + +instance Pretty PKPayload where + pretty (PKPayload kv ts v3e pka p) = pretty kv <+> pretty ts <+> pretty v3e <+> pretty pka <+> pretty p + +instance A.ToJSON PKPayload + +data SKAddendum = SUS16bit SymmetricAlgorithm S2K IV ByteString + | SUSSHA1 SymmetricAlgorithm S2K IV ByteString + | SUSym SymmetricAlgorithm IV ByteString + | SUUnencrypted SKey Word16 + 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 + +instance Pretty SKAddendum where + pretty (SUS16bit sa s2k iv bs) = text "SUS16bit" <+> pretty sa <+> pretty s2k <+> pretty iv <+> pretty bs + pretty (SUSSHA1 sa s2k iv bs) = text "SUSSHA1" <+> pretty sa <+> pretty s2k <+> pretty iv <+> pretty bs + pretty (SUSym sa iv bs) = text "SUSym" <+> pretty sa <+> pretty iv <+> pretty bs + pretty (SUUnencrypted s ck) = text "SUUnencrypted" <+> pretty s <+> pretty ck + +instance A.ToJSON SKAddendum where + toJSON (SUS16bit sa s2k iv bs) = A.toJSON (sa, s2k, iv, BL.unpack bs) + toJSON (SUSSHA1 sa s2k iv bs) = A.toJSON (sa, s2k, iv, BL.unpack bs) + toJSON (SUSym sa iv bs) = A.toJSON (sa, iv, BL.unpack bs) + toJSON (SUUnencrypted s ck) = A.toJSON (s, ck) diff --git a/Codec/Encryption/OpenPGP/Types/Internal/PacketClass.hs b/Codec/Encryption/OpenPGP/Types/Internal/PacketClass.hs --- a/Codec/Encryption/OpenPGP/Types/Internal/PacketClass.hs +++ b/Codec/Encryption/OpenPGP/Types/Internal/PacketClass.hs @@ -14,6 +14,8 @@ module Codec.Encryption.OpenPGP.Types.Internal.PacketClass where import Codec.Encryption.OpenPGP.Types.Internal.Base +import Codec.Encryption.OpenPGP.Types.Internal.PKITypes +import Codec.Encryption.OpenPGP.Types.Internal.Pkt import Control.Lens (makeLenses) import Data.ByteString.Lazy (ByteString) diff --git a/Codec/Encryption/OpenPGP/Types/Internal/Pkt.hs b/Codec/Encryption/OpenPGP/Types/Internal/Pkt.hs new file mode 100644 --- /dev/null +++ b/Codec/Encryption/OpenPGP/Types/Internal/Pkt.hs @@ -0,0 +1,137 @@ +-- Pkt.hs: OpenPGP (RFC4880) Pkt data types +-- Copyright © 2012-2016 Clint Adams +-- This software is released under the terms of the Expat license. +-- (See the LICENSE file). + +{-# LANGUAGE CPP #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE ExistentialQuantification #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE TemplateHaskell #-} + +module Codec.Encryption.OpenPGP.Types.Internal.Pkt where + +import GHC.Generics (Generic) + +import Codec.Encryption.OpenPGP.Types.Internal.Base +import Codec.Encryption.OpenPGP.Types.Internal.PKITypes + +import Control.Lens (makeLenses) +import Data.Aeson ((.=), object) +import qualified Data.Aeson as A +import Data.ByteString.Lazy (ByteString) +import qualified Data.ByteString.Lazy as BL +import Data.Data (Data) +import Data.Hashable (Hashable(..)) +import Data.List.NonEmpty (NonEmpty) +import qualified Data.List.NonEmpty as NE +#if !MIN_VERSION_base(4,8,0) +import Data.Monoid (mempty) +#endif +import Data.Monoid ((<>)) +import Data.Ord (comparing) +import Data.Text (Text) +import qualified Data.Text as T +import Data.Typeable (Typeable) +import Data.Word (Word8) +import Text.PrettyPrint.Free (Pretty(..), (<+>), char, text) + +-- data Pkt = forall a. (Packet a, Show a, Eq a) => Pkt a +data Pkt = PKESKPkt PacketVersion EightOctetKeyId PubKeyAlgorithm (NonEmpty MPI) + | SignaturePkt SignaturePayload + | SKESKPkt PacketVersion SymmetricAlgorithm S2K (Maybe BL.ByteString) + | OnePassSignaturePkt PacketVersion SigType HashAlgorithm PubKeyAlgorithm EightOctetKeyId NestedFlag + | SecretKeyPkt PKPayload SKAddendum + | PublicKeyPkt PKPayload + | SecretSubkeyPkt PKPayload SKAddendum + | CompressedDataPkt CompressionAlgorithm CompressedDataPayload + | SymEncDataPkt ByteString + | MarkerPkt ByteString + | LiteralDataPkt DataType FileName ThirtyTwoBitTimeStamp ByteString + | TrustPkt ByteString + | UserIdPkt Text + | PublicSubkeyPkt PKPayload + | UserAttributePkt [UserAttrSubPacket] + | SymEncIntegrityProtectedDataPkt PacketVersion ByteString + | ModificationDetectionCodePkt ByteString + | OtherPacketPkt Word8 ByteString + | BrokenPacketPkt String Word8 ByteString + deriving (Data, Eq, Generic, Show, Typeable) -- FIXME + +instance Hashable Pkt + +instance Ord Pkt where + compare = comparing pktTag <> comparing hash -- FIXME: is there something saner? + +instance Pretty Pkt where + pretty (PKESKPkt pv eoki pka mpis) = text "PKESK v" <> (text . show) pv <> char ':' <+> pretty eoki <+> pretty pka <+> (prettyList . NE.toList) mpis + pretty (SignaturePkt sp) = pretty sp + pretty (SKESKPkt pv sa s2k mbs) = text "SKESK v" <> (text . show) pv <> char ':' <+> pretty sa <+> pretty s2k <+> pretty mbs + pretty (OnePassSignaturePkt pv st ha pka eoki nestedflag) = text "one-pass signature v" <> (text . show) pv <> char ':' <+> pretty st <+> pretty ha <+> pretty pka <+> pretty eoki <+> pretty nestedflag + pretty (SecretKeyPkt pkp ska) = text "secret key:" <+> pretty pkp <+> pretty ska + pretty (PublicKeyPkt pkp) = text "public key:" <+> pretty pkp + pretty (SecretSubkeyPkt pkp ska) = text "secret subkey:" <+> pretty pkp <+> pretty ska + pretty (CompressedDataPkt ca cdp) = text "compressed-data:" <+> pretty ca <+> pretty cdp + pretty (SymEncDataPkt bs) = text "symmetrically-encrypted-data:" <+> pretty bs + pretty (MarkerPkt bs) = text "marker:" <+> pretty bs + pretty (LiteralDataPkt dt fn ts bs) = text "literal-data" <+> pretty dt <+> pretty fn <+> pretty ts <+> pretty bs + pretty (TrustPkt bs) = text "trust:" <+> pretty (BL.unpack bs) + pretty (UserIdPkt u) = text "user-ID:" <+> pretty u + pretty (PublicSubkeyPkt pkp) = text "public subkey:" <+> pretty pkp + pretty (UserAttributePkt us) = text "user-attribute:" <+> prettyList us + pretty (SymEncIntegrityProtectedDataPkt pv bs) = text "symmetrically-encrypted-integrity-protected-data v" <> (text . show) pv <> char ':' <+> pretty bs + pretty (ModificationDetectionCodePkt bs) = text "MDC:" <+> pretty bs + pretty (OtherPacketPkt t bs) = text "unknown packet type" <+> pretty t <> char ':' <+> pretty bs + pretty (BrokenPacketPkt s t bs) = text "BROKEN packet (" <> pretty s <> char ')' <+> pretty t <> char ':' <+> pretty bs + +instance A.ToJSON Pkt where + toJSON (PKESKPkt pv eoki pka mpis) = object [T.pack "pkesk" .= object [T.pack "version" .= pv, T.pack "keyid" .= eoki, T.pack "pkalgo" .= pka, T.pack "mpis" .= NE.toList mpis]] + toJSON (SignaturePkt sp) = object [T.pack "signature" .= sp] + toJSON (SKESKPkt pv sa s2k mbs) = object [T.pack "skesk" .= object [T.pack "version" .= pv, T.pack "symalgo" .= sa, T.pack "s2k" .= s2k, T.pack "data" .= maybe mempty BL.unpack mbs]] + toJSON (OnePassSignaturePkt pv st ha pka eoki nestedflag) = object [T.pack "onepasssignature" .= object [T.pack "version" .= pv, T.pack "sigtype" .= st, T.pack "hashalgo" .= ha, T.pack "pkalgo" .= pka, T.pack "keyid" .= eoki, T.pack "nested" .= nestedflag]] + toJSON (SecretKeyPkt pkp ska) = object [T.pack "secretkey" .= object [T.pack "public" .= pkp, T.pack "secret" .= ska]] + toJSON (PublicKeyPkt pkp) = object [T.pack "publickey" .= pkp] + toJSON (SecretSubkeyPkt pkp ska) = object [T.pack "secretsubkey" .= object [T.pack "public" .= pkp, T.pack "secret" .= ska]] + toJSON (CompressedDataPkt ca cdp) = object [T.pack "compresseddata" .= object [T.pack "compressionalgo" .= ca, T.pack "data" .= BL.unpack cdp]] + toJSON (SymEncDataPkt bs) = object [T.pack "symencdata" .= BL.unpack bs] + toJSON (MarkerPkt bs) = object [T.pack "marker" .= BL.unpack bs] + toJSON (LiteralDataPkt dt fn ts bs) = object [T.pack "literaldata" .= object [T.pack "dt" .= dt, T.pack "filename" .= BL.unpack fn, T.pack "ts" .= ts, T.pack "data" .= BL.unpack bs]] + toJSON (TrustPkt bs) = object [T.pack "trust" .= BL.unpack bs] + toJSON (UserIdPkt u) = object [T.pack "userid" .= u] + toJSON (PublicSubkeyPkt pkp) = object [T.pack "publicsubkkey" .= pkp] + toJSON (UserAttributePkt us) = object [T.pack "userattribute" .= us] + toJSON (SymEncIntegrityProtectedDataPkt pv bs) = object [T.pack "symencipd" .= object [T.pack "version" .= pv, T.pack "data" .= BL.unpack bs]] + toJSON (ModificationDetectionCodePkt bs) = object [T.pack "mdc" .= BL.unpack bs] + toJSON (OtherPacketPkt t bs) = object [T.pack "otherpacket" .= object [T.pack "tag" .= t, T.pack "data" .= BL.unpack bs]] + 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 (SignaturePkt _) = 2 +pktTag (SKESKPkt {}) = 3 +pktTag (OnePassSignaturePkt {}) = 4 +pktTag (SecretKeyPkt {}) = 5 +pktTag (PublicKeyPkt _) = 6 +pktTag (SecretSubkeyPkt {}) = 7 +pktTag (CompressedDataPkt {}) = 8 +pktTag (SymEncDataPkt _) = 9 +pktTag (MarkerPkt _) = 10 +pktTag (LiteralDataPkt {}) = 11 +pktTag (TrustPkt _) = 12 +pktTag (UserIdPkt _) = 13 +pktTag (PublicSubkeyPkt _) = 14 +pktTag (UserAttributePkt _) = 17 +pktTag (SymEncIntegrityProtectedDataPkt {}) = 18 +pktTag (ModificationDetectionCodePkt _) = 19 +pktTag (OtherPacketPkt t _) = t +pktTag (BrokenPacketPkt _ t _) = t -- is this the right thing to do? + +data Verification = Verification { + _verificationSigner :: PKPayload + , _verificationSignature :: SignaturePayload + } + +$(makeLenses ''Verification) diff --git a/Codec/Encryption/OpenPGP/Types/Internal/TK.hs b/Codec/Encryption/OpenPGP/Types/Internal/TK.hs new file mode 100644 --- /dev/null +++ b/Codec/Encryption/OpenPGP/Types/Internal/TK.hs @@ -0,0 +1,43 @@ +-- TK.hs: OpenPGP (RFC4880) transferable key data type +-- Copyright © 2012-2016 Clint Adams +-- This software is released under the terms of the Expat license. +-- (See the LICENSE file). + +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE TemplateHaskell #-} + +module Codec.Encryption.OpenPGP.Types.Internal.TK where + +import GHC.Generics (Generic) + +import Codec.Encryption.OpenPGP.Types.Internal.Base +import Codec.Encryption.OpenPGP.Types.Internal.PKITypes +import Codec.Encryption.OpenPGP.Types.Internal.Pkt + +import Control.Lens (makeLenses) +import qualified Data.Aeson as A +import Data.Data (Data) +import Data.IxSet.Typed (IxSet) +import Data.Ord (comparing) +import Data.Text (Text) +import Data.Typeable (Typeable) + +data TK = TK { + _tkKey :: (PKPayload, Maybe SKAddendum) + , _tkRevs :: [SignaturePayload] + , _tkUIDs :: [(Text, [SignaturePayload])] + , _tkUAts :: [([UserAttrSubPacket], [SignaturePayload])] + , _tkSubs :: [(Pkt, [SignaturePayload])] + } deriving (Data, Eq, Generic, Show, Typeable) + +instance Ord TK where + compare = comparing _tkKey -- FIXME: is this ridiculous? + +instance A.ToJSON TK + +type KeyringIxs = '[EightOctetKeyId, TwentyOctetFingerprint, Text] +type Keyring = IxSet KeyringIxs TK + +$(makeLenses ''TK) diff --git a/hOpenPGP.cabal b/hOpenPGP.cabal --- a/hOpenPGP.cabal +++ b/hOpenPGP.cabal @@ -1,5 +1,5 @@ Name: hOpenPGP -Version: 2.4.2 +Version: 2.4.3 Synopsis: native Haskell implementation of OpenPGP (RFC4880) Description: native Haskell implementation of OpenPGP (RFC4880), plus Camellia (RFC5581) Homepage: http://floss.scru.org/hOpenPGP/ @@ -178,7 +178,11 @@ , Codec.Encryption.OpenPGP.Internal.HOBlockCipher , Codec.Encryption.OpenPGP.SerializeForSigs , Codec.Encryption.OpenPGP.Types.Internal.Base + , Codec.Encryption.OpenPGP.Types.Internal.CryptoniteNewtypes , Codec.Encryption.OpenPGP.Types.Internal.PacketClass + , Codec.Encryption.OpenPGP.Types.Internal.PKITypes + , Codec.Encryption.OpenPGP.Types.Internal.Pkt + , Codec.Encryption.OpenPGP.Types.Internal.TK , Codec.Encryption.OpenPGP.BlockCipher Build-depends: aeson , attoparsec @@ -228,7 +232,7 @@ type: exitcode-stdio-1.0 main-is: tests/suite.hs other-modules: Codec.Encryption.OpenPGP.Arbitrary - Ghc-options: -Wall + Ghc-options: -Wall -with-rtsopts=-K1K Build-depends: hOpenPGP , aeson , attoparsec @@ -331,4 +335,4 @@ source-repository this type: git location: git://git.debian.org/users/clint/hOpenPGP.git - tag: v2.4.2 + tag: v2.4.3