packages feed

hOpenPGP 2.4.1 → 2.4.2

raw patch · 21 files changed

+1780/−1667 lines, 21 filesbinary-added

Files

Codec/Encryption/OpenPGP/Arbitrary.hs view
@@ -110,7 +110,21 @@     arbitrary = elements [DeprecatedMD5, SHA1, RIPEMD160, SHA256, SHA384, SHA512, SHA224]  instance Arbitrary SymmetricAlgorithm where-    arbitrary = elements [Plaintext, IDEA, TripleDES, CAST5, Blowfish, ReservedSAFER, ReservedDES, AES128, AES192, AES256, Twofish]+    arbitrary = elements [Plaintext+                         , IDEA+                         , TripleDES+                         , CAST5+                         , Blowfish+                         , ReservedSAFER+                         , ReservedDES+                         , AES128+                         , AES192+                         , AES256+                         , Twofish+                         , Camellia128+                         , Camellia192+                         , Camellia256+                         ]  instance Arbitrary RevocationClass where     arbitrary = frequency [(9,srk),(1,rco)]
Codec/Encryption/OpenPGP/BlockCipher.hs view
@@ -10,7 +10,6 @@   , withSymmetricCipher ) where -import Codec.Encryption.OpenPGP.Internal import Codec.Encryption.OpenPGP.Internal.CryptoCipherTypes (HOWrappedOldCCT(..)) import Codec.Encryption.OpenPGP.Internal.Cryptonite (HOWrappedCCT(..)) import Codec.Encryption.OpenPGP.Internal.HOBlockCipher@@ -19,6 +18,7 @@ import qualified Crypto.Cipher.Blowfish as Blowfish import qualified Crypto.Cipher.TripleDES as TripleDES import qualified Crypto.Cipher.AES as AES+import qualified Crypto.Cipher.Camellia as Camellia import qualified Crypto.Nettle.Ciphers as CNC import qualified Data.ByteString as B @@ -37,6 +37,9 @@ withSymmetricCipher AES128 key f = (cipherInit key :: Either String (HOWrappedCCT AES.AES128)) >>= f withSymmetricCipher AES192 key f = (cipherInit key :: Either String (HOWrappedCCT AES.AES192)) >>= f withSymmetricCipher AES256 key f = (cipherInit key :: Either String (HOWrappedCCT AES.AES256)) >>= f+withSymmetricCipher Camellia128 key f = (cipherInit key :: Either String (HOWrappedCCT Camellia.Camellia128)) >>= f+withSymmetricCipher Camellia192 key f = (cipherInit key :: Either String (HOWrappedOldCCT CNC.Camellia192)) >>= f+withSymmetricCipher Camellia256 key f = (cipherInit key :: Either String (HOWrappedOldCCT CNC.Camellia256)) >>= f  -- in octets; FIXME: co-opt Cipher's cipherKeySize or not? keySize :: SymmetricAlgorithm -> Int@@ -51,4 +54,7 @@ keySize AES192 = 24 keySize AES256 = 32 keySize Twofish = 32+keySize Camellia128 = 16+keySize Camellia192 = 24+keySize Camellia256 = 32 keySize (OtherSA _) = undefined
Codec/Encryption/OpenPGP/CFB.hs view
@@ -4,6 +4,8 @@ -- This software is released under the terms of the Expat license. -- (See the LICENSE file). +{-# LANGUAGE CPP #-}+ module Codec.Encryption.OpenPGP.CFB (    decrypt  , decryptNoNonce@@ -12,18 +14,12 @@ ) where  import Codec.Encryption.OpenPGP.BlockCipher (withSymmetricCipher)-import Codec.Encryption.OpenPGP.Internal-import Codec.Encryption.OpenPGP.Internal.CryptoCipherTypes-import Codec.Encryption.OpenPGP.Internal.Cryptonite import Codec.Encryption.OpenPGP.Internal.HOBlockCipher import Codec.Encryption.OpenPGP.Types+#if !MIN_VERSION_base(4,8,0) import Control.Applicative ((<$>), (<*>))-import Control.Error.Util (note)-import qualified Crypto.Cipher.AES as CCA-import qualified Crypto.Cipher.Blowfish as CCB-import qualified Crypto.Cipher.TripleDES as CC3-import qualified Crypto.Nettle.Ciphers as CNC-import Data.ByteArray (ByteArray)+#endif+import Control.Monad (liftM) import qualified Data.ByteString as B  decryptOpenPGPCfb :: SymmetricAlgorithm -> B.ByteString -> B.ByteString -> Either String B.ByteString@@ -36,12 +32,12 @@         decrypt1 :: HOBlockCipher cipher => B.ByteString -> cipher -> Either String B.ByteString         decrypt1 ct cipher = paddedCfbDecrypt cipher (B.replicate (blockSize cipher) 0) (B.take (blockSize cipher + 2) ct)         decrypt2 :: HOBlockCipher cipher => B.ByteString -> cipher -> Either String B.ByteString-        decrypt2 ct cipher = let i = B.take (blockSize cipher) (B.drop 2 ct) in (paddedCfbDecrypt cipher i (B.drop (blockSize cipher + 2) ct))+        decrypt2 ct cipher = let i = B.take (blockSize cipher) (B.drop 2 ct) in paddedCfbDecrypt cipher i (B.drop (blockSize cipher + 2) ct)  decrypt :: SymmetricAlgorithm -> B.ByteString -> B.ByteString -> Either String B.ByteString decrypt Plaintext ciphertext _ = return ciphertext decrypt sa ciphertext keydata = withSymmetricCipher sa keydata $ \bc -> do-    (nonce, cleartext) <- decrypt' ciphertext bc >>= return . (B.splitAt (blockSize bc + 2))+    (nonce, cleartext) <- liftM (B.splitAt (blockSize bc + 2)) (decrypt' ciphertext bc)     if nonceCheck bc nonce then return cleartext else Left "Session key quickcheck failed"     where         decrypt' :: HOBlockCipher cipher => B.ByteString -> cipher -> Either String B.ByteString@@ -49,8 +45,7 @@  decryptNoNonce :: SymmetricAlgorithm -> IV -> B.ByteString -> B.ByteString -> Either String B.ByteString decryptNoNonce Plaintext _ ciphertext _ = return ciphertext-decryptNoNonce sa iv ciphertext keydata = do-    withSymmetricCipher sa keydata (decrypt' ciphertext)+decryptNoNonce sa iv ciphertext keydata = withSymmetricCipher sa keydata (decrypt' ciphertext)     where         decrypt' :: HOBlockCipher cipher => B.ByteString -> cipher -> Either String B.ByteString         decrypt' ct cipher = paddedCfbDecrypt cipher (unIV iv) ct@@ -59,9 +54,8 @@ nonceCheck bc = (==) <$> B.take 2 . B.drop (blockSize bc - 2) <*> B.drop (blockSize bc)  encryptNoNonce :: SymmetricAlgorithm -> S2K -> IV -> B.ByteString -> B.ByteString -> Either String B.ByteString-encryptNoNonce Plaintext _ _ payload keydata = return payload-encryptNoNonce sa s2k iv payload keydata = do-    withSymmetricCipher sa keydata (encrypt' payload)+encryptNoNonce Plaintext _ _ payload _ = return payload+encryptNoNonce sa s2k iv payload keydata = withSymmetricCipher sa keydata (encrypt' payload)     where         encrypt' :: HOBlockCipher cipher => B.ByteString -> cipher -> Either String B.ByteString         encrypt' ct cipher = paddedCfbEncrypt cipher (unIV iv) ct
Codec/Encryption/OpenPGP/Internal.hs view
@@ -117,6 +117,6 @@           w       = fromJust $ inverse s q           u1      = (hm*w) `mod` q           u2      = (r*w) `mod` q-          v       = ((expFast g u1 p) * (expFast y u2 p)) `mod` p `mod` q+          v       = (expFast g u1 p * expFast y u2 p) `mod` p `mod` q           dsaTruncate bs = let lbs = BL.fromStrict bs in if countBits lbs > fromIntegral dsaQLen then B.take (dsaQLen `div` 8) bs else bs -- FIXME: uneven bits-          dsaQLen = numBits $ q+          dsaQLen = numBits q
Codec/Encryption/OpenPGP/KeySelection.hs view
@@ -1,8 +1,9 @@ -- KeySelection.hs: OpenPGP (RFC4880) ways to ask for keys--- Copyright © 2014-2015  Clint Adams+-- Copyright © 2014-2016  Clint Adams -- This software is released under the terms of the Expat license. -- (See the LICENSE file). +{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-}  module Codec.Encryption.OpenPGP.KeySelection (@@ -11,7 +12,10 @@ ) where  import Codec.Encryption.OpenPGP.Types-import Control.Applicative (optional, (<$>), (*>))+#if !MIN_VERSION_base(4,8,0)+import Control.Applicative ((<$>), (*>))+#endif+import Control.Applicative (optional) import Control.Monad ((<=<)) import Crypto.Number.Serialize (i2osp) import Data.Attoparsec.Text (asciiCI, count, hexadecimal, inClass, parseOnly, Parser, satisfy)
Codec/Encryption/OpenPGP/KeyringParser.hs view
@@ -1,8 +1,10 @@ -- KeyringParser.hs: OpenPGP (RFC4880) transferable keys parsing--- Copyright © 2012-2015  Clint Adams+-- Copyright © 2012-2016  Clint Adams -- This software is released under the terms of the Expat license. -- (See the LICENSE file). +{-# LANGUAGE CPP #-}+ module Codec.Encryption.OpenPGP.KeyringParser (    parseAChunk  , finalizeParsing@@ -24,8 +26,16 @@  , broken ) where -import Control.Applicative (many, (<$>), (<|>))-import Data.Monoid (Monoid, (<>), mconcat)+import Control.Applicative (many, (<|>))+#if !MIN_VERSION_base(4,8,0)+import Control.Applicative ((<$>))+#endif++#if !MIN_VERSION_base(4,8,0)+import Data.Monoid (Monoid, mconcat)+#endif+import Data.Monoid ((<>))+ import Data.Text (Text)  import Codec.Encryption.OpenPGP.Types
Codec/Encryption/OpenPGP/S2K.hs view
@@ -12,30 +12,29 @@ import Codec.Encryption.OpenPGP.Types import Control.Monad.Loops (untilM_) import Control.Monad.Trans.State.Lazy (execState, get, put)-import Crypto.Hash (hashlazy) import qualified Crypto.Hash as CH import qualified Data.ByteArray as BA import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as BL  string2Key :: S2K -> Int -> BL.ByteString -> B.ByteString-string2Key (Simple ha) ksz bs = B.take (fromIntegral ksz) $ hashpp (hf ha) ksz bs+string2Key (Simple ha) ksz bs = B.take (fromIntegral ksz) $ hashpp ha ksz bs string2Key (Salted ha salt) ksz bs = string2Key (Simple ha) ksz (BL.append (BL.fromStrict (unSalt salt)) bs) string2Key (IteratedSalted ha salt cnt) ksz bs = string2Key (Simple ha) ksz (BL.take (fromIntegral cnt) . BL.cycle $ BL.append (BL.fromStrict (unSalt salt)) bs) string2Key _ _ _ = error "FIXME: unimplemented S2K type" -hf :: HashAlgorithm -> BL.ByteString -> B.ByteString-hf SHA1 bs = BA.convert (CH.hashlazy bs :: CH.Digest CH.SHA1)-hf SHA512 bs = BA.convert (CH.hashlazy bs :: CH.Digest CH.SHA512)-hf _ _ = error "FIXME: unimplemented S2K hash"- skesk2Key :: SKESK -> BL.ByteString -> B.ByteString skesk2Key (SKESK 4 sa s2k Nothing) pass = string2Key s2k (keySize sa) pass skesk2Key _ _ = error "FIXME" -hashpp :: (BL.ByteString -> B.ByteString) -> Int -> BL.ByteString -> B.ByteString-hashpp hf keysize pp = snd (execState (hashround `untilM_` bigEnough) (0, B.empty))+hashpp :: HashAlgorithm -> Int -> BL.ByteString -> B.ByteString+hashpp ha keysize pp = snd (execState (hashround `untilM_` bigEnough) (0, B.empty))     where-        hashround = get >>= \(ctr, bs) -> put (ctr + 1, bs `B.append` hf (nulpad ctr `BL.append` pp))+        hashround = get >>= \(ctr, bs) -> put (ctr + 1, bs `B.append` hf ha (nulpad ctr `BL.append` pp))         nulpad = BL.pack . flip replicate 0         bigEnough = get >>= \(_, bs) -> return (B.length bs >= keysize)+        hf :: HashAlgorithm -> BL.ByteString -> B.ByteString+        hf SHA1 bs = BA.convert (CH.hashlazy bs :: CH.Digest CH.SHA1)+        hf SHA512 bs = BA.convert (CH.hashlazy bs :: CH.Digest CH.SHA512)+        hf _ _ = error "FIXME: unimplemented S2K hash"+
Codec/Encryption/OpenPGP/SecretKey.hs view
@@ -17,7 +17,6 @@ import Codec.Encryption.OpenPGP.Serialize (getSecretKey) import Codec.Encryption.OpenPGP.S2K (skesk2Key, string2Key) import qualified Crypto.Hash as CH-import qualified Crypto.Hash.Algorithms as CHA import Crypto.Random.EntropyPool (createEntropyPool, getEntropyFrom) import qualified Data.ByteArray as BA import qualified Data.ByteString as B@@ -28,6 +27,7 @@ import Data.Bifunctor (bimap) import qualified Crypto.PubKey.RSA as R +saBlockSize :: SymmetricAlgorithm -> Int saBlockSize sa = either (const 0) id (withSymmetricCipher sa B.empty (Right . blockSize))  decryptPrivateKey :: (PKPayload, SKAddendum) -> BL.ByteString -> SKAddendum
Codec/Encryption/OpenPGP/Serialize.hs view
@@ -3,12 +3,17 @@ -- This software is released under the terms of the Expat license. -- (See the LICENSE file). +{-# LANGUAGE CPP #-}+ module Codec.Encryption.OpenPGP.Serialize (    putSKAddendum  , getSecretKey ) where -import Control.Applicative ((<$>), many, some)+#if !MIN_VERSION_base(4,8,0)+import Control.Applicative ((<$>))+#endif+import Control.Applicative (many, some) import Control.Lens ((^.), _1) import Control.Monad (guard, liftM, replicateM, replicateM_) import Crypto.Number.Basic (numBits)@@ -25,7 +30,9 @@ import Data.Binary.Get (Get, getByteString, getLazyByteString, getRemainingLazyByteString, getWord8, getWord16be, getWord32be, getWord16le, runGetOrFail, ByteOffset) import Data.Binary.Put (Put, putWord8, putWord16be, putWord32be, putByteString, putLazyByteString, putWord16le, runPut) import qualified Data.Foldable as F+#if !MIN_VERSION_base(4,8,0) import Data.Monoid (mempty)+#endif import Data.Set (Set) import qualified Data.Set as Set import qualified Data.Text as T@@ -35,7 +42,7 @@ import Data.Maybe (fromMaybe) import Network.URI (nullURI, parseURI, uriToString) -import Codec.Encryption.OpenPGP.Internal (countBits, pubkeyToMPIs, multiplicativeInverse)+import Codec.Encryption.OpenPGP.Internal (pubkeyToMPIs, multiplicativeInverse) import Codec.Encryption.OpenPGP.Types  instance Binary SigSubPacket where@@ -875,15 +882,16 @@ putSKAddendum _ = fail "Type not supported"  symEncBlockSize :: SymmetricAlgorithm -> Int-symEncBlockSize (Plaintext) = 0-symEncBlockSize (IDEA) = 8-symEncBlockSize (TripleDES) = 8-symEncBlockSize (CAST5) = 8-symEncBlockSize (Blowfish) = 8-symEncBlockSize (AES128) = 16-symEncBlockSize (AES192) = 16-symEncBlockSize (AES256) = 16-symEncBlockSize (Twofish) = 16+symEncBlockSize Plaintext = 0+symEncBlockSize IDEA = 8+symEncBlockSize TripleDES = 8+symEncBlockSize CAST5 = 8+symEncBlockSize Blowfish = 8+symEncBlockSize AES128 = 16+symEncBlockSize AES192 = 16+symEncBlockSize AES256 = 16+symEncBlockSize Twofish = 16+symEncBlockSize Camellia128 = 16 symEncBlockSize _ = 8 -- FIXME  decodeIterationCount :: Word8 -> IterationCount
Codec/Encryption/OpenPGP/SerializeForSigs.hs view
@@ -20,7 +20,7 @@ import Data.ByteString.Lazy (ByteString) import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as BL-import Data.Binary (Binary, put)+import Data.Binary (put) import Data.Binary.Put (Put, putWord8, putWord16be, putWord32be, putByteString, putLazyByteString, runPut) import Data.Text.Encoding (encodeUtf8) 
Codec/Encryption/OpenPGP/Signatures.hs view
@@ -3,6 +3,8 @@ -- This software is released under the terms of the Expat license. -- (See the LICENSE file). +{-# LANGUAGE CPP #-}+ module Codec.Encryption.OpenPGP.Signatures (    verifySigWith  , verifyAgainstKeyring@@ -10,7 +12,9 @@  , verifyTKWith ) where -import Control.Applicative ((<$>),(<*>))+#if !MIN_VERSION_base(4,8,0)+import Control.Applicative ((<$>), (<*>))+#endif import Control.Error.Util (hush) import Control.Lens ((^.), _1) import Control.Monad (liftM2)
Codec/Encryption/OpenPGP/Types.hs view
@@ -3,1612 +3,10 @@ -- This software is released under the terms of the Expat license. -- (See the LICENSE file). -{-# LANGUAGE DataKinds #-}-{-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE ExistentialQuantification #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE TemplateHaskell #-}-{-# LANGUAGE TypeFamilies #-}--module Codec.Encryption.OpenPGP.Types where--import GHC.Generics (Generic)--import Control.Applicative ((<$>), (<|>))-import Control.Arrow ((***))-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)-import Data.ByteArray (ByteArrayAccess)-import Data.ByteString.Lazy (ByteString)-import qualified Data.ByteString as B-import qualified Data.ByteString.Lazy as BL-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-import Data.List.Split (chunksOf)-import Data.Maybe (fromMaybe)-import Data.Monoid ((<>), Monoid, mempty)-import Data.Ord (comparing)-import Data.Set (Set)-import qualified Data.Set as Set-import Data.Text (Text)-import qualified Data.Text as T-import Data.Time.Clock.POSIX (posixSecondsToUTCTime)-import Data.Time.Format (formatTime)-import Data.Typeable (Typeable)-import Data.Word (Word8, Word16, Word32)-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)--type Exportability = Bool-type TrustLevel = Word8-type TrustAmount = Word8-type AlmostPublicDomainRegex = ByteString-type Revocability = Bool-type RevocationReason = Text-type KeyServer = ByteString-type SignatureHash = ByteString-type PacketVersion = Word8-type V3Expiration = Word16-type CompressedDataPayload = ByteString-type FileName = ByteString-type ImageData = ByteString-type NestedFlag = Bool--data SymmetricAlgorithm = Plaintext-                        | IDEA-                        | TripleDES-                        | CAST5-                        | Blowfish-                        | ReservedSAFER-                        | ReservedDES-                        | AES128-                        | AES192-                        | AES256-                        | Twofish-                        | OtherSA Word8-     deriving (Data, Generic, Show, Typeable)--instance Eq SymmetricAlgorithm where-    (==) a b = fromFVal a == fromFVal b--instance Ord SymmetricAlgorithm where-    compare = comparing fromFVal--instance FutureVal SymmetricAlgorithm where-    fromFVal Plaintext = 0-    fromFVal IDEA = 1-    fromFVal TripleDES = 2-    fromFVal CAST5 = 3-    fromFVal Blowfish = 4-    fromFVal ReservedSAFER = 5-    fromFVal ReservedDES = 6-    fromFVal AES128 = 7-    fromFVal AES192 = 8-    fromFVal AES256 = 9-    fromFVal Twofish = 10-    fromFVal (OtherSA o) = o-    toFVal 0 = Plaintext-    toFVal 1 = IDEA-    toFVal 2 = TripleDES-    toFVal 3 = CAST5-    toFVal 4 = Blowfish-    toFVal 5 = ReservedSAFER-    toFVal 6 = ReservedDES-    toFVal 7 = AES128-    toFVal 8 = AES192-    toFVal 9 = AES256-    toFVal 10 = Twofish-    toFVal o = OtherSA o--instance Hashable SymmetricAlgorithm--instance Pretty SymmetricAlgorithm where-    pretty Plaintext = text "plaintext"-    pretty IDEA = text "IDEA"-    pretty TripleDES = text "3DES"-    pretty CAST5 = text "CAST-128"-    pretty Blowfish = text "Blowfish"-    pretty ReservedSAFER = text "(reserved) SAFER"-    pretty ReservedDES = text "(reserved) DES"-    pretty AES128 = text "AES-128"-    pretty AES192 = text "AES-192"-    pretty AES256 = text "AES-256"-    pretty Twofish = text "Twofish"-    pretty (OtherSA sa) = text "unknown symmetric algorithm" <+> (text . show) sa--instance A.ToJSON SymmetricAlgorithm-instance A.FromJSON SymmetricAlgorithm--data NotationFlag = HumanReadable-                  | OtherNF Word8 -- FIXME: this should be constrained to 4 bits?-     deriving (Data, Generic, Show, Typeable)--instance Eq NotationFlag where-    (==) a b = fromFFlag a == fromFFlag b--instance Ord NotationFlag where-    compare = comparing fromFFlag--instance FutureFlag NotationFlag where-    fromFFlag HumanReadable = 0-    fromFFlag (OtherNF o) = fromIntegral o--    toFFlag 0 = HumanReadable-    toFFlag o = OtherNF (fromIntegral o)--instance Hashable NotationFlag--instance Pretty NotationFlag where-    pretty HumanReadable = text "human-readable"-    pretty (OtherNF o) = text "unknown notation flag type" <+> pretty o--instance A.ToJSON NotationFlag-instance A.FromJSON NotationFlag--data SigSubPacket = SigSubPacket {-    _sspCriticality :: Bool-  , _sspPayload :: SigSubPacketPayload-  } deriving (Data, Eq, Generic, Show, Typeable)--instance Pretty SigSubPacket where-    pretty x = (if _sspCriticality x then char '*' else mempty) <> (pretty . _sspPayload) x--instance Hashable SigSubPacket--instance A.ToJSON SigSubPacket-instance A.FromJSON SigSubPacket--newtype ThirtyTwoBitTimeStamp = ThirtyTwoBitTimeStamp {unThirtyTwoBitTimeStamp :: Word32}-    deriving (Bounded, Data, Enum, Eq, Generic, Hashable, Integral, Num, Ord, Real, Show, Typeable)--instance Newtype ThirtyTwoBitTimeStamp Word32 where-    pack = ThirtyTwoBitTimeStamp-    unpack (ThirtyTwoBitTimeStamp o) = o--instance Pretty ThirtyTwoBitTimeStamp where-    pretty = text . formatTime defaultTimeLocale "%Y%m%d-%H%M%S" . posixSecondsToUTCTime . realToFrac--instance A.ToJSON ThirtyTwoBitTimeStamp-instance A.FromJSON ThirtyTwoBitTimeStamp--newtype ThirtyTwoBitDuration = ThirtyTwoBitDuration {unThirtyTwoBitDuration :: Word32}-    deriving (Bounded, Data, Enum, Eq, Generic, Hashable, Integral, Num, Ord, Real, Show, Typeable)--instance Newtype ThirtyTwoBitDuration Word32 where-    pack = ThirtyTwoBitDuration-    unpack (ThirtyTwoBitDuration o) = o--instance Pretty ThirtyTwoBitDuration where-    pretty = text . concat . unfoldr durU . unpack--instance A.ToJSON ThirtyTwoBitDuration-instance A.FromJSON ThirtyTwoBitDuration--durU :: (Integral a, Show a) => a -> Maybe (String, a)-durU x-  | x >= 31557600 = Just ((++"y") . show $ x `div` 31557600, x `mod` 31557600)-  | x >= 2629800 = Just ((++"m") . show $ x `div` 2629800, x `mod` 2629800)-  | x >= 86400 = Just ((++"d") . show $ x `div` 86400, x `mod` 86400)-  | x > 0 = Just ((++"s") . show $ x, 0)-  | otherwise = Nothing--newtype URL = URL {unURL :: URI}-    deriving (Data, Eq, Generic, Ord, Show, Typeable)--instance Newtype URL URI where-    pack = URL-    unpack (URL o) = o--instance Hashable URL where-    hashWithSalt salt (URL (URI s a p q f)) = salt `hashWithSalt` s `hashWithSalt` show a `hashWithSalt` p `hashWithSalt` q `hashWithSalt` f--instance Pretty URL where-    pretty = pretty . (\uri -> uriToString id uri "") . unpack--instance A.ToJSON URL where-    toJSON u = object [T.pack "uri" .= (\uri -> uriToString id uri "") (unpack u)]-instance A.FromJSON URL where-    parseJSON (A.Object v) = URL . fromMaybe nullURI . parseURI <$>-                                      v A..: T.pack "uri"-    parseJSON _            = mzero--newtype NotationName = NotationName {unNotationName :: ByteString}-    deriving (Data, Eq, Generic, Hashable, Ord, Pretty, Show, Typeable)--instance Newtype NotationName ByteString where-    pack = NotationName-    unpack (NotationName nn) = nn--instance A.ToJSON NotationName where-    toJSON nn = object [T.pack "notationname" .= show (unpack nn)]-instance A.FromJSON NotationName where-    parseJSON (A.Object v) = NotationName . read <$>-                                      v A..: T.pack "notationname"-    parseJSON _            = mzero--newtype NotationValue = NotationValue {unNotationValue :: ByteString}-    deriving (Data, Eq, Generic, Hashable, Ord, Pretty, Show, Typeable)--instance Newtype NotationValue ByteString where-    pack = NotationValue-    unpack (NotationValue nv) = nv--instance A.ToJSON NotationValue where-    toJSON nv = object [T.pack "notationvalue" .= show (unpack nv)]-instance A.FromJSON NotationValue where-    parseJSON (A.Object v) = NotationValue . read <$>-                                      v A..: T.pack "notationvalue"-    parseJSON _            = mzero--data SigSubPacketPayload = SigCreationTime ThirtyTwoBitTimeStamp-                  | SigExpirationTime ThirtyTwoBitDuration-                  | ExportableCertification Exportability-                  | TrustSignature TrustLevel TrustAmount-                  | RegularExpression AlmostPublicDomainRegex-                  | Revocable Revocability-                  | KeyExpirationTime ThirtyTwoBitDuration-                  | PreferredSymmetricAlgorithms [SymmetricAlgorithm]-                  | RevocationKey (Set RevocationClass) PubKeyAlgorithm TwentyOctetFingerprint-                  | Issuer EightOctetKeyId-                  | NotationData (Set NotationFlag) NotationName NotationValue-                  | PreferredHashAlgorithms [HashAlgorithm]-                  | PreferredCompressionAlgorithms [CompressionAlgorithm]-                  | KeyServerPreferences (Set KSPFlag)-                  | PreferredKeyServer KeyServer-                  | PrimaryUserId Bool-                  | PolicyURL URL-                  | KeyFlags (Set KeyFlag)-                  | SignersUserId Text-                  | ReasonForRevocation RevocationCode RevocationReason-                  | Features (Set FeatureFlag)-                  | SignatureTarget PubKeyAlgorithm HashAlgorithm SignatureHash-                  | EmbeddedSignature SignaturePayload-                  | UserDefinedSigSub Word8 ByteString-                  | OtherSigSub Word8 ByteString-    deriving (Data, Eq, Generic, Show, Typeable) -- FIXME--instance Hashable SigSubPacketPayload--instance Pretty SigSubPacketPayload where-    pretty (SigCreationTime ts) = text "creation-time" <+> pretty ts-    pretty (SigExpirationTime d) = text "sig expiration time" <+> pretty d-    pretty (ExportableCertification e) = text "exportable certification" <+> pretty e-    pretty (TrustSignature tl ta) = text "trust signature" <+> pretty tl <+> pretty ta-    pretty (RegularExpression apdre) = text "regular expression" <+> pretty apdre-    pretty (Revocable r) = text "revocable" <+> pretty r-    pretty (KeyExpirationTime d) = text "key expiration time" <+> pretty d-    pretty (PreferredSymmetricAlgorithms sas) = text "preferred symmetric algorithms" <+> prettyList sas-    pretty (RevocationKey rcs pka tof) = text "revocation key" <+> prettyList (Set.toList rcs) <+> pretty pka <+> pretty tof-    pretty (Issuer eoki) = text "issuer" <+> pretty eoki-    pretty (NotationData nfs nn nv) = text "notation data" <+> prettyList (Set.toList nfs) <+> pretty nn <+> pretty nv-    pretty (PreferredHashAlgorithms phas) = text "preferred hash algorithms" <+> prettyList phas-    pretty (PreferredCompressionAlgorithms pcas) = text "preferred compression algorithms" <+> pretty pcas-    pretty (KeyServerPreferences kspfs) = text "keyserver preferences" <+> prettyList (Set.toList kspfs)-    pretty (PreferredKeyServer ks) = text "preferred keyserver" <+> pretty ks-    pretty (PrimaryUserId p) = (if p then mempty else text "NOT ") <> text "primary user-ID"-    pretty (PolicyURL u) = text "policy URL" <+> pretty u-    pretty (KeyFlags kfs) = text "key flags" <+> prettyList (Set.toList kfs)-    pretty (SignersUserId u) = text "signer's user-ID" <+> pretty u-    pretty (ReasonForRevocation rc rr) = text "reason for revocation" <+> pretty rc <+> pretty rr-    pretty (Features ffs) = text "features" <+> prettyList (Set.toList ffs)-    pretty (SignatureTarget pka ha sh) = text "signature target" <+> pretty pka <+> pretty ha <+> pretty sh-    pretty (EmbeddedSignature sp) = text "embedded signature" <+> pretty sp-    pretty (UserDefinedSigSub t bs) = text "user-defined signature subpacket type" <+> pretty t <+> pretty (BL.unpack bs)-    pretty (OtherSigSub t bs) = text "unknown signature subpacket type" <+> pretty t <+> pretty bs--instance A.ToJSON SigSubPacketPayload where-    toJSON (SigCreationTime ts) = object [T.pack "sigCreationTime" .= ts]-    toJSON (SigExpirationTime d) = object [T.pack "sigExpirationTime" .= d]-    toJSON (ExportableCertification e) = object [T.pack "exportableCertification" .= e]-    toJSON (TrustSignature tl ta) = object [T.pack "trustSignature" .= (tl, ta)]-    toJSON (RegularExpression apdre) = object [T.pack "regularExpression" .= (BL.unpack apdre)]-    toJSON (Revocable r) = object [T.pack "revocable" .= r]-    toJSON (KeyExpirationTime d) = object [T.pack "keyExpirationTime" .= d]-    toJSON (PreferredSymmetricAlgorithms sas) = object [T.pack "preferredSymmetricAlgorithms" .= sas]-    toJSON (RevocationKey rcs pka tof) = object [T.pack "revocationKey" .= (rcs, pka, tof)]-    toJSON (Issuer eoki) = object [T.pack "issuer" .= eoki]-    toJSON (NotationData nfs (NotationName nn) (NotationValue nv)) = object [T.pack "notationData" .= (nfs, BL.unpack nn, BL.unpack nv)]-    toJSON (PreferredHashAlgorithms phas) = object [T.pack "preferredHashAlgorithms" .= phas]-    toJSON (PreferredCompressionAlgorithms pcas) = object [T.pack "preferredCompressionAlgorithms" .=  pcas]-    toJSON (KeyServerPreferences kspfs) = object [T.pack "keyServerPreferences" .= kspfs]-    toJSON (PreferredKeyServer ks) = object [T.pack "preferredKeyServer" .= (show ks)]-    toJSON (PrimaryUserId p) = object [T.pack "primaryUserId" .= p]-    toJSON (PolicyURL u) = object [T.pack "policyURL" .= u]-    toJSON (KeyFlags kfs) = object [T.pack "keyFlags" .= kfs]-    toJSON (SignersUserId u) = object [T.pack "signersUserId" .= u]-    toJSON (ReasonForRevocation rc rr) = object [T.pack "reasonForRevocation" .= (rc, rr)]-    toJSON (Features ffs) = object [T.pack "features" .= ffs]-    toJSON (SignatureTarget pka ha sh) = object [T.pack "signatureTarget" .= (pka, ha, BL.unpack sh)]-    toJSON (EmbeddedSignature sp) = object [T.pack "embeddedSignature" .= sp]-    toJSON (UserDefinedSigSub t bs) = object [T.pack "userDefinedSigSub" .= (t, BL.unpack bs)]-    toJSON (OtherSigSub t bs) = object [T.pack "otherSigSub" .= (t, BL.unpack bs)]--instance A.FromJSON SigSubPacketPayload where-    parseJSON (A.Object v) = (SigCreationTime <$> v A..: T.pack "sigCreationTime")-                         <|> (SigExpirationTime <$> v A..: T.pack "sigExpirationTime")-                         <|> (ExportableCertification <$> v A..: T.pack "exportableCertification")-                         <|> (uncurry TrustSignature <$> v A..: T.pack "trustSignature")-                         <|> (RegularExpression . BL.pack <$> v A..: T.pack "regularExpression")-                         <|> (Revocable <$> v A..: T.pack "revocable")-                         <|> (KeyExpirationTime <$> v A..: T.pack "keyExpirationTime")-                         <|> (PreferredSymmetricAlgorithms <$> v A..: T.pack "preferredSymmetricAlgorithms")-                         <|> (uc3 RevocationKey <$> v A..: T.pack "revocationKey")-                         <|> (Issuer <$> v A..: T.pack "issuer")-                         <|> (uc3 NotationData <$> v A..: T.pack "notationData")-    parseJSON _            = mzero--uc3 :: (a -> b -> c -> d) -> ((a, b, c) -> d)-uc3 f ~(a,b,c) = f a b c--data HashAlgorithm = DeprecatedMD5-                   | SHA1-                   | RIPEMD160-                   | SHA256-                   | SHA384-                   | SHA512-                   | SHA224-                   | OtherHA Word8-    deriving (Data, Generic, Show, Typeable)--instance Eq HashAlgorithm where-    (==) a b = fromFVal a == fromFVal b--instance Ord HashAlgorithm where-    compare = comparing fromFVal--instance FutureVal HashAlgorithm where-    fromFVal DeprecatedMD5 = 1-    fromFVal SHA1 = 2-    fromFVal RIPEMD160 = 3-    fromFVal SHA256 = 8-    fromFVal SHA384 = 9-    fromFVal SHA512 = 10-    fromFVal SHA224 = 11-    fromFVal (OtherHA o) = o-    toFVal 1 = DeprecatedMD5-    toFVal 2 = SHA1-    toFVal 3 = RIPEMD160-    toFVal 8 = SHA256-    toFVal 9 = SHA384-    toFVal 10 = SHA512-    toFVal 11 = SHA224-    toFVal o = OtherHA o--instance Hashable HashAlgorithm--instance Pretty HashAlgorithm where-    pretty DeprecatedMD5 = text "(deprecated) MD5"-    pretty SHA1 = text "SHA-1"-    pretty RIPEMD160 = text "RIPEMD-160"-    pretty SHA256 = text "SHA-256"-    pretty SHA384 = text "SHA-384"-    pretty SHA512 = text "SHA-512"-    pretty SHA224 = text "SHA-224"-    pretty (OtherHA ha) = text "unknown hash algorithm type" <+> (text . show) ha--instance A.ToJSON HashAlgorithm-instance A.FromJSON HashAlgorithm--data CompressionAlgorithm = Uncompressed-                          | ZIP-                          | ZLIB-                          | BZip2-                          | OtherCA Word8-    deriving (Show, Data, Generic, Typeable)--instance Eq CompressionAlgorithm where-    (==) a b = fromFVal a == fromFVal b--instance Ord CompressionAlgorithm where-    compare = comparing fromFVal--instance FutureVal CompressionAlgorithm where-    fromFVal Uncompressed = 0-    fromFVal ZIP = 1-    fromFVal ZLIB = 2-    fromFVal BZip2 = 3-    fromFVal (OtherCA o) = o-    toFVal 0 = Uncompressed-    toFVal 1 = ZIP-    toFVal 2 = ZLIB-    toFVal 3 = BZip2-    toFVal o = OtherCA o--instance Hashable CompressionAlgorithm--instance Pretty CompressionAlgorithm where-    pretty Uncompressed = text "uncompressed"-    pretty ZIP = text "ZIP"-    pretty ZLIB = text "zlib"-    pretty BZip2 = text "bzip2"-    pretty (OtherCA ca) = text "unknown compression algorithm type" <+> (text . show) ca--instance A.ToJSON CompressionAlgorithm-instance A.FromJSON CompressionAlgorithm--class (Eq a, Ord a) => FutureVal a where-   fromFVal :: a -> Word8-   toFVal :: Word8 -> a--data PubKeyAlgorithm = RSA-                     | DeprecatedRSAEncryptOnly-                     | DeprecatedRSASignOnly-                     | ElgamalEncryptOnly-                     | DSA-                     | ECDH-                     | ECDSA-                     | ForbiddenElgamal-                     | DH-                     | OtherPKA Word8-    deriving (Show, Data, Generic, Typeable)--instance Eq PubKeyAlgorithm where-    (==) a b = fromFVal a == fromFVal b--instance Ord PubKeyAlgorithm where-    compare = comparing fromFVal--instance FutureVal PubKeyAlgorithm where-    fromFVal RSA = 1-    fromFVal DeprecatedRSAEncryptOnly = 2-    fromFVal DeprecatedRSASignOnly = 3-    fromFVal ElgamalEncryptOnly = 16-    fromFVal DSA = 17-    fromFVal ECDH = 18-    fromFVal ECDSA = 19-    fromFVal ForbiddenElgamal = 20-    fromFVal DH = 21-    fromFVal (OtherPKA o) = o-    toFVal 1 = RSA-    toFVal 2 = DeprecatedRSAEncryptOnly-    toFVal 3 = DeprecatedRSASignOnly-    toFVal 16 = ElgamalEncryptOnly-    toFVal 17 = DSA-    toFVal 18 = ECDH-    toFVal 19 = ECDSA-    toFVal 20 = ForbiddenElgamal-    toFVal 21 = DH-    toFVal o = OtherPKA o--instance Hashable PubKeyAlgorithm--instance Pretty PubKeyAlgorithm where-    pretty RSA = text "RSA"-    pretty DeprecatedRSAEncryptOnly = text "(deprecated) RSA encrypt-only"-    pretty DeprecatedRSASignOnly = text "(deprecated) RSA sign-only"-    pretty ElgamalEncryptOnly = text "Elgamal encrypt-only"-    pretty DSA = text "DSA"-    pretty ECDH = text "ECDH"-    pretty ECDSA = text "ECDSA"-    pretty ForbiddenElgamal = text "(forbidden) Elgamal"-    pretty DH = text "DH"-    pretty pka = text "unknown pubkey algorithm type" <+> (text . show) pka--instance A.ToJSON PubKeyAlgorithm-instance A.FromJSON PubKeyAlgorithm--class (Eq a, Ord a) => FutureFlag a where-    fromFFlag :: a -> Int-    toFFlag :: Int -> a--data KSPFlag = NoModify-             | KSPOther Int-    deriving (Data, Generic, Show, Typeable)--instance Eq KSPFlag where-    (==) a b = fromFFlag a == fromFFlag b--instance Ord KSPFlag where-    compare = comparing fromFFlag--instance FutureFlag KSPFlag where-    fromFFlag NoModify = 0-    fromFFlag (KSPOther i) = fromIntegral i--    toFFlag 0 = NoModify-    toFFlag i = KSPOther (fromIntegral i)--instance Hashable KSPFlag--instance Pretty KSPFlag where-    pretty NoModify = text "no-modify"-    pretty (KSPOther o) = text "unknown keyserver preference flag type" <+> pretty o--instance A.ToJSON KSPFlag-instance A.FromJSON KSPFlag--data KeyFlag = GroupKey-             | AuthKey-             | SplitKey-             | EncryptStorageKey-             | EncryptCommunicationsKey-             | SignDataKey-             | CertifyKeysKey-             | KFOther Int-    deriving (Data, Generic, Show, Typeable)--instance Eq KeyFlag where-    (==) a b = fromFFlag a == fromFFlag b--instance Ord KeyFlag where-    compare = comparing fromFFlag--instance FutureFlag KeyFlag where-    fromFFlag GroupKey = 0-    fromFFlag AuthKey = 2-    fromFFlag SplitKey = 3-    fromFFlag EncryptStorageKey = 4-    fromFFlag EncryptCommunicationsKey = 5-    fromFFlag SignDataKey = 6-    fromFFlag CertifyKeysKey = 7-    fromFFlag (KFOther i) = fromIntegral i--    toFFlag 0 = GroupKey-    toFFlag 2 = AuthKey-    toFFlag 3 = SplitKey-    toFFlag 4 = EncryptStorageKey-    toFFlag 5 = EncryptCommunicationsKey-    toFFlag 6 = SignDataKey-    toFFlag 7 = CertifyKeysKey-    toFFlag i = KFOther (fromIntegral i)--instance Hashable KeyFlag--instance Pretty KeyFlag where-    pretty GroupKey = text "group"-    pretty AuthKey = text "auth"-    pretty SplitKey = text "split"-    pretty EncryptStorageKey = text "encrypt-storage"-    pretty EncryptCommunicationsKey = text "encrypt-communications"-    pretty SignDataKey = text "sign-data"-    pretty CertifyKeysKey = text "certify-keys"-    pretty (KFOther o) = text "unknown key flag type" <+> pretty o--instance A.ToJSON KeyFlag-instance A.FromJSON KeyFlag--data RevocationClass = SensitiveRK-                     | RClOther Word8 -- FIXME: this should be constrained to 3 bits-    deriving (Data, Generic, Show, Typeable)--instance Eq RevocationClass where-    (==) a b = fromFFlag a == fromFFlag b--instance Ord RevocationClass where-    compare = comparing fromFFlag--instance FutureFlag RevocationClass where-    fromFFlag SensitiveRK = 1-    fromFFlag (RClOther i) = fromIntegral i--    toFFlag 1 = SensitiveRK-    toFFlag i = RClOther (fromIntegral i)--instance Hashable RevocationClass--instance Pretty RevocationClass where-    pretty SensitiveRK = text "sensitive"-    pretty (RClOther o) = text "unknown revocation class" <+> pretty o--instance A.ToJSON RevocationClass-instance A.FromJSON RevocationClass--data RevocationCode = NoReason-                    | KeySuperseded-                    | KeyMaterialCompromised-                    | KeyRetiredAndNoLongerUsed-                    | UserIdInfoNoLongerValid-                    | RCoOther Word8-    deriving (Data, Generic, Show, Typeable)--instance Eq RevocationCode where-    (==) a b = fromFVal a == fromFVal b--instance Ord RevocationCode where-    compare = comparing fromFVal--instance FutureVal RevocationCode where-    fromFVal NoReason = 0-    fromFVal KeySuperseded = 1-    fromFVal KeyMaterialCompromised = 2-    fromFVal KeyRetiredAndNoLongerUsed = 3-    fromFVal UserIdInfoNoLongerValid = 32-    fromFVal (RCoOther o) = o-    toFVal 0 = NoReason-    toFVal 1 = KeySuperseded-    toFVal 2 = KeyMaterialCompromised-    toFVal 3 = KeyRetiredAndNoLongerUsed-    toFVal 32 = UserIdInfoNoLongerValid-    toFVal o = RCoOther o--instance Hashable RevocationCode--instance Pretty RevocationCode where-    pretty NoReason = text "no reason"-    pretty KeySuperseded = text "key superseded"-    pretty KeyMaterialCompromised = text "key material compromised"-    pretty KeyRetiredAndNoLongerUsed = text "key retired and no longer used"-    pretty UserIdInfoNoLongerValid = text "user-ID info no longer valid"-    pretty (RCoOther o) = text "unknown revocation code" <+> pretty o--instance A.ToJSON RevocationCode-instance A.FromJSON RevocationCode--data FeatureFlag = ModificationDetection-                 | FeatureOther Int-    deriving (Data, Generic, Show, Typeable)--instance Eq FeatureFlag where-    (==) a b = fromFFlag a == fromFFlag b--instance Ord FeatureFlag where-    compare = comparing fromFFlag--instance FutureFlag FeatureFlag where-    fromFFlag ModificationDetection = 7-    fromFFlag (FeatureOther i) = fromIntegral i--    toFFlag 7 = ModificationDetection-    toFFlag i = FeatureOther (fromIntegral i)--instance Hashable FeatureFlag-instance Hashable a => Hashable (Set a) where-    hashWithSalt salt = hashWithSalt salt . Set.toList--instance Pretty FeatureFlag where-    pretty ModificationDetection = text "modification-detection"-    pretty (FeatureOther o) = text "unknown feature flag type" <+> pretty o--instance A.ToJSON FeatureFlag-instance A.FromJSON FeatureFlag--newtype MPI = MPI {unMPI :: Integer}-    deriving (Data, Eq, Generic, Show, Typeable)--instance Newtype MPI Integer where-    pack = MPI-    unpack (MPI o) = o--instance Hashable MPI--instance Pretty MPI where-    pretty = pretty . unpack--instance A.ToJSON MPI-instance A.FromJSON MPI--data SignaturePayload = SigV3 SigType ThirtyTwoBitTimeStamp EightOctetKeyId PubKeyAlgorithm HashAlgorithm Word16 (NonEmpty MPI)-                      | SigV4 SigType PubKeyAlgorithm HashAlgorithm [SigSubPacket] [SigSubPacket] Word16 (NonEmpty MPI)-                      | SigVOther Word8 ByteString-    deriving (Data, Eq, Generic, Show, Typeable)--instance Hashable SignaturePayload--instance Pretty SignaturePayload where-    pretty (SigV3 st ts eoki pka ha w16 mpis) = text "signature v3" <> char ':' <+> pretty st <+> pretty ts <+> pretty eoki <+> pretty pka <+> pretty ha <+> pretty w16 <+> (prettyList . NE.toList) mpis-    pretty (SigV4 st pka ha hsps usps w16 mpis) = text "signature v4" <> char ':' <+> pretty st <+> pretty pka <+> pretty ha <+> prettyList hsps <+> prettyList usps <+> pretty w16 <+> (prettyList . NE.toList) mpis-    pretty (SigVOther t bs) = text "unknown signature v" <> pretty t <> char ':' <+> pretty (BL.unpack bs)--instance A.ToJSON SignaturePayload where-    toJSON (SigV3 st ts eoki pka ha w16 mpis) = A.toJSON (st, ts, eoki, pka, ha, w16, NE.toList mpis)-    toJSON (SigV4 st pka ha hsps usps w16 mpis) = A.toJSON (st, pka, ha, hsps, usps, w16, NE.toList mpis)-    toJSON (SigVOther t bs) = A.toJSON (t, BL.unpack bs)--data KeyVersion = DeprecatedV3 | V4-    deriving (Data, Eq, Generic, Ord, Show, Typeable)--instance Hashable KeyVersion--instance Pretty KeyVersion where-    pretty DeprecatedV3 = text "(deprecated) v3"-    pretty V4 = text "v4"--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)--instance Newtype IV B.ByteString where-    pack = IV-    unpack (IV o) = o--instance Pretty IV where-    pretty = pretty . unpack--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-              | OtherData Word8-    deriving (Show, Data, Generic, Typeable)--instance Hashable DataType--instance Eq DataType where-    (==) a b = fromFVal a == fromFVal b--instance Ord DataType where-    compare = comparing fromFVal--instance FutureVal DataType where-    fromFVal BinaryData = fromIntegral . fromEnum $ 'b'-    fromFVal TextData = fromIntegral . fromEnum $ 't'-    fromFVal UTF8Data = fromIntegral . fromEnum $ 'u'-    fromFVal (OtherData o) = o--    toFVal 0x62 = BinaryData-    toFVal 0x74 = TextData-    toFVal 0x75 = UTF8Data-    toFVal o = OtherData o--instance Pretty DataType where-    pretty BinaryData = text "binary"-    pretty TextData = text "text"-    pretty UTF8Data = text "UTF-8"-    pretty (OtherData o) = text "other data type " <+> (text . show) o--instance A.ToJSON DataType-instance A.FromJSON DataType--newtype Salt = Salt {unSalt :: B.ByteString}-    deriving (Byteable, Data, Eq, Generic, Hashable, Show, Typeable)--instance Newtype Salt B.ByteString where-    pack = Salt-    unpack (Salt o) = o--instance Pretty Salt where-    pretty = pretty . unpack--instance A.ToJSON Salt where-    toJSON = A.toJSON . show . unpack--newtype IterationCount = IterationCount {unIterationCount :: Int}-    deriving (Bounded, Data, Enum, Eq, Generic, Hashable, Integral, Num, Ord, Real, Show, Typeable)--instance Newtype IterationCount Int where-    pack = IterationCount-    unpack (IterationCount o) = o--instance Pretty IterationCount where-    pretty = pretty . unpack--instance A.ToJSON IterationCount-instance A.FromJSON IterationCount--data S2K = Simple HashAlgorithm-         | Salted HashAlgorithm Salt-         | IteratedSalted HashAlgorithm Salt IterationCount-         | OtherS2K Word8 ByteString-    deriving (Data, Eq, Generic, Show, Typeable)--instance Hashable S2K--instance Pretty S2K where-    pretty (Simple ha) = text "simple S2K," <+> pretty ha-    pretty (Salted ha salt) = text "simple S2K," <+> pretty ha <+> pretty salt-    pretty (IteratedSalted ha salt icount) = text "simple S2K," <+> pretty ha <+> pretty salt <+> pretty icount-    pretty (OtherS2K t bs) = text "unknown S2K type" <+> pretty t <+> pretty bs--instance A.ToJSON S2K where-    toJSON (Simple ha) = A.toJSON ha-    toJSON (Salted ha salt) = A.toJSON (ha, salt)-    toJSON (IteratedSalted ha salt icount) = A.toJSON (ha, salt, icount)-    toJSON (OtherS2K t bs) = A.toJSON (t, BL.unpack bs)--data UserAttrSubPacket = ImageAttribute ImageHeader ImageData-                       | OtherUASub Word8 ByteString-    deriving (Data, Eq, Generic, Show, Typeable)--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--instance Pretty UserAttrSubPacket where-    pretty (ImageAttribute ih d) = text "image-attribute" <+> pretty ih <+> pretty (BL.unpack d)-    pretty (OtherUASub t bs) = text "unknown attribute type" <> (text . show) t <+> pretty (BL.unpack bs)--instance A.ToJSON UserAttrSubPacket where-    toJSON (ImageAttribute ih d) = A.toJSON (ih, BL.unpack d)-    toJSON (OtherUASub t bs) = A.toJSON (t, BL.unpack bs)--data ImageHeader = ImageHV1 ImageFormat-    deriving (Data, Eq, Generic, Show, Typeable)--instance Ord ImageHeader where-    compare (ImageHV1 a) (ImageHV1 b) = compare a b--instance Hashable ImageHeader--instance Pretty ImageHeader where-    pretty (ImageHV1 f) = text "imghdr v1" <+> pretty f--instance A.ToJSON ImageHeader-instance A.FromJSON ImageHeader--data ImageFormat = JPEG-                 | OtherImage Word8-    deriving (Data, Generic, Show, Typeable)--instance Eq ImageFormat where-    (==) a b = fromFVal a == fromFVal b--instance Ord ImageFormat where-    compare = comparing fromFVal--instance FutureVal ImageFormat where-    fromFVal JPEG = 1-    fromFVal (OtherImage o) = o--    toFVal 1 = JPEG-    toFVal o = OtherImage o--instance Hashable ImageFormat--instance Pretty ImageFormat where-    pretty JPEG = text "JPEG"-    pretty (OtherImage o) = text "unknown image format" <+> pretty o--instance A.ToJSON ImageFormat-instance A.FromJSON ImageFormat--data SigType = BinarySig-             | CanonicalTextSig-             | StandaloneSig-             | GenericCert-             | PersonaCert-             | CasualCert-             | PositiveCert-             | SubkeyBindingSig-             | PrimaryKeyBindingSig-             | SignatureDirectlyOnAKey-             | KeyRevocationSig-             | SubkeyRevocationSig-             | CertRevocationSig-             | TimestampSig-             | ThirdPartyConfirmationSig-             | OtherSig Word8-    deriving (Data, Generic, Show, Typeable)--instance Eq SigType where-    (==) a b = fromFVal a == fromFVal b--instance Ord SigType where-    compare = comparing fromFVal--instance FutureVal SigType where-    fromFVal BinarySig = 0x00-    fromFVal CanonicalTextSig = 0x01-    fromFVal StandaloneSig = 0x02-    fromFVal GenericCert = 0x10-    fromFVal PersonaCert = 0x11-    fromFVal CasualCert = 0x12-    fromFVal PositiveCert = 0x13-    fromFVal SubkeyBindingSig = 0x18-    fromFVal PrimaryKeyBindingSig = 0x19-    fromFVal SignatureDirectlyOnAKey = 0x1F-    fromFVal KeyRevocationSig = 0x20-    fromFVal SubkeyRevocationSig = 0x28-    fromFVal CertRevocationSig = 0x30-    fromFVal TimestampSig = 0x40-    fromFVal ThirdPartyConfirmationSig = 0x50-    fromFVal (OtherSig o) = o--    toFVal 0x00 = BinarySig-    toFVal 0x01 = CanonicalTextSig-    toFVal 0x02 = StandaloneSig-    toFVal 0x10 = GenericCert-    toFVal 0x11 = PersonaCert-    toFVal 0x12 = CasualCert-    toFVal 0x13 = PositiveCert-    toFVal 0x18 = SubkeyBindingSig-    toFVal 0x19 = PrimaryKeyBindingSig-    toFVal 0x1F = SignatureDirectlyOnAKey-    toFVal 0x20 = KeyRevocationSig-    toFVal 0x28 = SubkeyRevocationSig-    toFVal 0x30 = CertRevocationSig-    toFVal 0x40 = TimestampSig-    toFVal 0x50 = ThirdPartyConfirmationSig-    toFVal o = OtherSig o--instance Hashable SigType--instance Pretty SigType where-    pretty BinarySig = text "binary"-    pretty CanonicalTextSig = text "canonical-text"-    pretty StandaloneSig = text "standalone"-    pretty GenericCert = text "generic"-    pretty PersonaCert = text "persona"-    pretty CasualCert = text "casual"-    pretty PositiveCert = text "positive"-    pretty SubkeyBindingSig = text "subkey-binding"-    pretty PrimaryKeyBindingSig = text "primary-key-binding"-    pretty SignatureDirectlyOnAKey = text "signature directly on a key"-    pretty KeyRevocationSig = text "key-revocation"-    pretty SubkeyRevocationSig = text "subkey-revocation"-    pretty CertRevocationSig = text "cert-revocation"-    pretty TimestampSig = text "timestamp"-    pretty ThirdPartyConfirmationSig = text "third-party-confirmation"-    pretty (OtherSig o) = text "unknown signature type" <+> pretty o--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-    deriving (Data, Eq, Generic, Ord, Show, Typeable)--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)--newtype EightOctetKeyId = EightOctetKeyId {unEOKI :: ByteString}-    deriving (Data, Eq, Generic, Ord, Show, Typeable)--instance Newtype EightOctetKeyId ByteString where-    pack = EightOctetKeyId-    unpack (EightOctetKeyId o) = o--instance Pretty EightOctetKeyId where-    pretty = text . w8sToHex . BL.unpack . unpack---- FIXME: read-show-instance Read EightOctetKeyId where-    readsPrec _ = map ((EightOctetKeyId . BL.pack *** concat) . unzip) . chunksOf 8 . hexToW8s--instance Hashable EightOctetKeyId--instance A.ToJSON EightOctetKeyId where-    toJSON e = object [T.pack "eoki" .= (w8sToHex . BL.unpack . unpack) e]--instance A.FromJSON EightOctetKeyId where-    parseJSON (A.Object v) = EightOctetKeyId . read <$>-                                      v A..: T.pack "eoki"-    parseJSON _            = mzero--newtype TwentyOctetFingerprint = TwentyOctetFingerprint {unTOF :: ByteString}-    deriving (Data, Eq, Generic, Ord, Show, Typeable)--instance Newtype TwentyOctetFingerprint ByteString where-    pack = TwentyOctetFingerprint-    unpack (TwentyOctetFingerprint o) = o---- FIXME: read-show-instance Read TwentyOctetFingerprint where-    readsPrec _ = map ((TwentyOctetFingerprint . BL.pack *** concat) . unzip) . chunksOf 20 . hexToW8s . filter (/= ' ')--instance Hashable TwentyOctetFingerprint--instance Pretty TwentyOctetFingerprint where-    pretty = text . take 40 . w8sToHex . BL.unpack . unTOF--instance A.ToJSON TwentyOctetFingerprint where-    toJSON e = object [T.pack "fpr" .= (A.toJSON . show . pretty) e]-instance A.FromJSON TwentyOctetFingerprint where-    parseJSON (A.Object v) = TwentyOctetFingerprint . read <$>-                                      v A..: T.pack "fpr"-    parseJSON _            = mzero--newtype SpacedFingerprint = SpacedFingerprint { unSpacedFingerprint :: TwentyOctetFingerprint }--instance Newtype SpacedFingerprint TwentyOctetFingerprint where-    pack = SpacedFingerprint-    unpack (SpacedFingerprint o) = o--instance Pretty SpacedFingerprint where-    pretty = hsep . punctuate space . map hsep . chunksOf 5 . map text . chunksOf 4 . take 40 . w8sToHex . BL.unpack . unTOF . unpack--w8sToHex :: [Word8] -> String-w8sToHex = map toUpper . concatMap ((\x -> if length x == 1 then '0':x else x) . flip showHex "")--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--class Packet a where-    data PacketType a :: *-    packetType :: a -> PacketType a-    packetCode :: PacketType a -> Word8-    toPkt :: a -> Pkt-    fromPkt :: Pkt -> a---- 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--data PKESK = PKESK-    { _pkeskPacketVersion :: PacketVersion-    , _pkeskEightOctetKeyId :: EightOctetKeyId-    , _pkeskPubKeyAlgorithm :: PubKeyAlgorithm-    , _pkeskMPIs :: NonEmpty MPI-    } deriving (Data, Eq, Show, Typeable)-instance Packet PKESK where-    data PacketType PKESK = PKESKType deriving (Show, Eq)-    packetType _ = PKESKType-    packetCode _ = 1-    toPkt (PKESK a b c d) = PKESKPkt a b c d-    fromPkt (PKESKPkt a b c d) = PKESK a b c d-    fromPkt _ = error "Cannot coerce non-PKESK packet"--instance Pretty PKESK where-    pretty = pretty . toPkt--data Signature = Signature   -- FIXME?-    { _signaturePayload :: SignaturePayload-    } deriving (Data, Eq, Show, Typeable)-instance Packet Signature where-    data PacketType Signature = SignatureType deriving (Show, Eq)-    packetType _ = SignatureType-    packetCode _ = 2-    toPkt (Signature a) = SignaturePkt a-    fromPkt (SignaturePkt a) = Signature a-    fromPkt _ = error "Cannot coerce non-Signature packet"--instance Pretty Signature where-    pretty = pretty . toPkt--data SKESK = SKESK-    { _skeskPacketVersion :: PacketVersion-    , _skeskSymmetricAlgorithm :: SymmetricAlgorithm-    , _skeskS2K :: S2K-    , _skeskESK :: Maybe BL.ByteString-    } deriving (Data, Eq, Show, Typeable)-instance Packet SKESK where-    data PacketType SKESK = SKESKType deriving (Show, Eq)-    packetType _ = SKESKType-    packetCode _ = 3-    toPkt (SKESK a b c d) = SKESKPkt a b c d-    fromPkt (SKESKPkt a b c d) = SKESK a b c d-    fromPkt _ = error "Cannot coerce non-SKESK packet"--instance Pretty SKESK where-    pretty = pretty . toPkt--data OnePassSignature = OnePassSignature-    { _onePassSignaturePacketVersion :: PacketVersion-    , _onePassSignatureSigType :: SigType-    , _onePassSignatureHashAlgorithm :: HashAlgorithm-    , _onePassSignaturePubKeyAlgorithm :: PubKeyAlgorithm-    , _onePassSignatureEightOctetKeyId :: EightOctetKeyId-    , _onePassSignatureNestedFlag :: NestedFlag-    } deriving (Data, Eq, Show, Typeable)-instance Packet OnePassSignature where-    data PacketType OnePassSignature = OnePassSignatureType deriving (Show, Eq)-    packetType _ = OnePassSignatureType-    packetCode _ = 4-    toPkt (OnePassSignature a b c d e f) = OnePassSignaturePkt a b c d e f-    fromPkt (OnePassSignaturePkt a b c d e f) = OnePassSignature a b c d e f-    fromPkt _ = error "Cannot coerce non-OnePassSignature packet"--instance Pretty OnePassSignature where-    pretty = pretty . toPkt--data SecretKey = SecretKey-    { _secretKeyPKPayload :: PKPayload-    , _secretKeySKAddendum :: SKAddendum-    } deriving (Data, Eq, Show, Typeable)-instance Packet SecretKey where-    data PacketType SecretKey = SecretKeyType deriving (Show, Eq)-    packetType _ = SecretKeyType-    packetCode _ = 5-    toPkt (SecretKey a b) = SecretKeyPkt a b-    fromPkt (SecretKeyPkt a b) = SecretKey a b-    fromPkt _ = error "Cannot coerce non-SecretKey packet"--instance Pretty SecretKey where-    pretty = pretty . toPkt--data PublicKey = PublicKey-    { _publicKeyPKPayload :: PKPayload-    } deriving (Data, Eq, Show, Typeable)-instance Packet PublicKey where-    data PacketType PublicKey = PublicKeyType deriving (Show, Eq)-    packetType _ = PublicKeyType-    packetCode _ = 6-    toPkt (PublicKey a) = PublicKeyPkt a-    fromPkt (PublicKeyPkt a) = PublicKey a-    fromPkt _ = error "Cannot coerce non-PublicKey packet"--instance Pretty PublicKey where-    pretty = pretty . toPkt--data SecretSubkey = SecretSubkey-    { _secretSubkeyPKPayload :: PKPayload-    , _secretSubkeySKAddendum :: SKAddendum-    } deriving (Data, Eq, Show, Typeable)-instance Packet SecretSubkey where-    data PacketType SecretSubkey = SecretSubkeyType deriving (Show, Eq)-    packetType _ = SecretSubkeyType-    packetCode _ = 7-    toPkt (SecretSubkey a b) = SecretSubkeyPkt a b-    fromPkt (SecretSubkeyPkt a b) = SecretSubkey a b-    fromPkt _ = error "Cannot coerce non-SecretSubkey packet"--instance Pretty SecretSubkey where-    pretty = pretty . toPkt--data CompressedData = CompressedData-    { _compressedDataCompressionAlgorithm :: CompressionAlgorithm-    , _compressedDataPayload :: CompressedDataPayload-    } deriving (Data, Eq, Show, Typeable)-instance Packet CompressedData where-    data PacketType CompressedData = CompressedDataType deriving (Show, Eq)-    packetType _ = CompressedDataType-    packetCode _ = 8-    toPkt (CompressedData a b) = CompressedDataPkt a b-    fromPkt (CompressedDataPkt a b) = CompressedData a b-    fromPkt _ = error "Cannot coerce non-CompressedData packet"--instance Pretty CompressedData where-    pretty = pretty . toPkt--data SymEncData = SymEncData-    { _symEncDataPayload :: ByteString-    } deriving (Data, Eq, Show, Typeable)-instance Packet SymEncData where-    data PacketType SymEncData = SymEncDataType deriving (Show, Eq)-    packetType _ = SymEncDataType-    packetCode _ = 9-    toPkt (SymEncData a) = SymEncDataPkt a-    fromPkt (SymEncDataPkt a) = SymEncData a-    fromPkt _ = error "Cannot coerce non-SymEncData packet"--instance Pretty SymEncData where-    pretty = pretty . toPkt--data Marker = Marker-    { _markerPayload :: ByteString-    } deriving (Data, Eq, Show, Typeable)-instance Packet Marker where-    data PacketType Marker = MarkerType deriving (Show, Eq)-    packetType _ = MarkerType-    packetCode _ = 10-    toPkt (Marker a) = MarkerPkt a-    fromPkt (MarkerPkt a) = Marker a-    fromPkt _ = error "Cannot coerce non-Marker packet"--instance Pretty Marker where-    pretty = pretty . toPkt--data LiteralData = LiteralData-    { _literalDataDataType :: DataType-    , _literalDataFileName :: FileName-    , _literalDataTimeStamp :: ThirtyTwoBitTimeStamp-    , _literalDataPayload :: ByteString-    } deriving (Data, Eq, Show, Typeable)-instance Packet LiteralData where-    data PacketType LiteralData = LiteralDataType deriving (Show, Eq)-    packetType _ = LiteralDataType-    packetCode _ = 11-    toPkt (LiteralData a b c d) = LiteralDataPkt a b c d-    fromPkt (LiteralDataPkt a b c d) = LiteralData a b c d-    fromPkt _ = error "Cannot coerce non-LiteralData packet"--instance Pretty LiteralData where-    pretty = pretty . toPkt--data Trust = Trust-    { _trustPayload :: ByteString-    } deriving (Data, Eq, Show, Typeable)-instance Packet Trust where-    data PacketType Trust = TrustType deriving (Show, Eq)-    packetType _ = TrustType-    packetCode _ = 12-    toPkt (Trust a) = TrustPkt a-    fromPkt (TrustPkt a) = Trust a-    fromPkt _ = error "Cannot coerce non-Trust packet"--instance Pretty Trust where-    pretty = pretty . toPkt--data UserId = UserId-    { _userIdPayload :: Text-    } deriving (Data, Eq, Show, Typeable)-instance Packet UserId where-    data PacketType UserId = UserIdType deriving (Show, Eq)-    packetType _ = UserIdType-    packetCode _ = 13-    toPkt (UserId a) = UserIdPkt a-    fromPkt (UserIdPkt a) = UserId a-    fromPkt _ = error "Cannot coerce non-UserId packet"--instance Pretty UserId where-    pretty = pretty . toPkt--data PublicSubkey = PublicSubkey-    { _publicSubkeyPKPayload :: PKPayload-    } deriving (Data, Eq, Show, Typeable)-instance Packet PublicSubkey where-    data PacketType PublicSubkey = PublicSubkeyType deriving (Show, Eq)-    packetType _ = PublicSubkeyType-    packetCode _ = 14-    toPkt (PublicSubkey a) = PublicSubkeyPkt a-    fromPkt (PublicSubkeyPkt a) = PublicSubkey a-    fromPkt _ = error "Cannot coerce non-PublicSubkey packet"--instance Pretty PublicSubkey where-    pretty = pretty . toPkt--data UserAttribute = UserAttribute-    { _userAttributeSubPackets :: [UserAttrSubPacket]-    } deriving (Data, Eq, Show, Typeable)-instance Packet UserAttribute where-    data PacketType UserAttribute = UserAttributeType deriving (Show, Eq)-    packetType _ = UserAttributeType-    packetCode _ = 17-    toPkt (UserAttribute a) = UserAttributePkt a-    fromPkt (UserAttributePkt a) = UserAttribute a-    fromPkt _ = error "Cannot coerce non-UserAttribute packet"--instance Pretty UserAttribute where-    pretty = pretty . toPkt--data SymEncIntegrityProtectedData = SymEncIntegrityProtectedData-    { _symEncIntegrityProtectedDataPacketVersion :: PacketVersion-    , _symEncIntegrityProtectedDataPayload :: ByteString-    } deriving (Data, Eq, Show, Typeable)-instance Packet SymEncIntegrityProtectedData where-    data PacketType SymEncIntegrityProtectedData = SymEncIntegrityProtectedDataType deriving (Show, Eq)-    packetType _ = SymEncIntegrityProtectedDataType-    packetCode _ = 18-    toPkt (SymEncIntegrityProtectedData a b) = SymEncIntegrityProtectedDataPkt a b-    fromPkt (SymEncIntegrityProtectedDataPkt a b) = SymEncIntegrityProtectedData a b-    fromPkt _ = error "Cannot coerce non-SymEncIntegrityProtectedData packet"--instance Pretty SymEncIntegrityProtectedData where-    pretty = pretty . toPkt--data ModificationDetectionCode = ModificationDetectionCode-    { _modificationDetectionCodePayload :: ByteString-    } deriving (Data, Eq, Show, Typeable)-instance Packet ModificationDetectionCode where-    data PacketType ModificationDetectionCode = ModificationDetectionCodeType deriving (Show, Eq)-    packetType _ = ModificationDetectionCodeType-    packetCode _ = 19-    toPkt (ModificationDetectionCode a) = ModificationDetectionCodePkt a-    fromPkt (ModificationDetectionCodePkt a) = ModificationDetectionCode a-    fromPkt _ = error "Cannot coerce non-ModificationDetectionCode packet"--instance Pretty ModificationDetectionCode where-    pretty = pretty . toPkt--data OtherPacket = OtherPacket-    { _otherPacketType :: Word8-    , _otherPacketPayload :: ByteString-    } deriving (Data, Eq, Show, Typeable)-instance Packet OtherPacket where-    data PacketType OtherPacket = OtherPacketType deriving (Show, Eq)-    packetType _ = OtherPacketType-    packetCode _ = undefined -- FIXME-    toPkt (OtherPacket a b) = OtherPacketPkt a b-    fromPkt (OtherPacketPkt a b) = OtherPacket a b-    fromPkt _ = error "Cannot coerce non-OtherPacket packet"--instance Pretty OtherPacket where-    pretty = pretty . toPkt--data BrokenPacket = BrokenPacket-    { _brokenPacketParseError :: String-    , _brokenPacketType :: Word8-    , _brokenPacketPayload :: ByteString-    } deriving (Data, Eq, Show, Typeable)-instance Packet BrokenPacket where-    data PacketType BrokenPacket = BrokenPacketType deriving (Show, Eq)-    packetType _ = BrokenPacketType-    packetCode _ = undefined-    toPkt (BrokenPacket a b c) = BrokenPacketPkt a b c-    fromPkt (BrokenPacketPkt a b c) = BrokenPacket a b c-    fromPkt _ = error "Cannot coerce non-BrokenPacket packet"--instance Pretty BrokenPacket where-    pretty = pretty . toPkt--data Verification = Verification {-      _verificationSigner :: PKPayload-    , _verificationSignature :: SignaturePayload-    }--$(makeLenses ''PKESK)-$(makeLenses ''Signature)-$(makeLenses ''SKESK)-$(makeLenses ''OnePassSignature)-$(makeLenses ''SecretKey)-$(makeLenses ''PKPayload)-$(makeLenses ''PublicKey)-$(makeLenses ''SecretSubkey)-$(makeLenses ''CompressedData)-$(makeLenses ''SymEncData)-$(makeLenses ''Marker)-$(makeLenses ''LiteralData)-$(makeLenses ''Trust)-$(makeLenses ''UserId)-$(makeLenses ''PublicSubkey)-$(makeLenses ''UserAttribute)-$(makeLenses ''SymEncIntegrityProtectedData)-$(makeLenses ''ModificationDetectionCode)-$(makeLenses ''OtherPacket)-$(makeLenses ''TK)-$(makeLenses ''Verification)-$(makeLenses ''SigSubPacket)+module Codec.Encryption.OpenPGP.Types (+    module Codec.Encryption.OpenPGP.Types.Internal.Base+  , module Codec.Encryption.OpenPGP.Types.Internal.PacketClass+) where++import Codec.Encryption.OpenPGP.Types.Internal.Base+import Codec.Encryption.OpenPGP.Types.Internal.PacketClass
+ Codec/Encryption/OpenPGP/Types/Internal/Base.hs view
@@ -0,0 +1,1320 @@+-- Base.hs: OpenPGP (RFC4880) 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.Base where++import GHC.Generics (Generic)++#if !MIN_VERSION_base(4,8,0)+import Control.Applicative ((<$>))+#endif+import Control.Applicative ((<|>))+import Control.Arrow ((***))+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)+import Data.ByteArray (ByteArrayAccess)+import Data.ByteString.Lazy (ByteString)+import qualified Data.ByteString as B+import qualified Data.ByteString.Lazy as BL+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+import Data.List.Split (chunksOf)+import Data.Maybe (fromMaybe)+#if !MIN_VERSION_base(4,8,0)+import Data.Monoid (Monoid, mempty)+#endif+import Data.Monoid ((<>))+import Data.Ord (comparing)+import Data.Set (Set)+import qualified Data.Set as Set+import Data.Text (Text)+import qualified Data.Text as T+import Data.Time.Clock.POSIX (posixSecondsToUTCTime)+import Data.Time.Format (formatTime)+import Data.Typeable (Typeable)+import Data.Word (Word8, Word16, Word32)+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)++type Exportability = Bool+type TrustLevel = Word8+type TrustAmount = Word8+type AlmostPublicDomainRegex = ByteString+type Revocability = Bool+type RevocationReason = Text+type KeyServer = ByteString+type SignatureHash = ByteString+type PacketVersion = Word8+type V3Expiration = Word16+type CompressedDataPayload = ByteString+type FileName = ByteString+type ImageData = ByteString+type NestedFlag = Bool++data SymmetricAlgorithm = Plaintext+                        | IDEA+                        | TripleDES+                        | CAST5+                        | Blowfish+                        | ReservedSAFER+                        | ReservedDES+                        | AES128+                        | AES192+                        | AES256+                        | Twofish+                        | Camellia128+                        | Camellia192+                        | Camellia256+                        | OtherSA Word8+     deriving (Data, Generic, Show, Typeable)++instance Eq SymmetricAlgorithm where+    (==) a b = fromFVal a == fromFVal b++instance Ord SymmetricAlgorithm where+    compare = comparing fromFVal++instance FutureVal SymmetricAlgorithm where+    fromFVal Plaintext = 0+    fromFVal IDEA = 1+    fromFVal TripleDES = 2+    fromFVal CAST5 = 3+    fromFVal Blowfish = 4+    fromFVal ReservedSAFER = 5+    fromFVal ReservedDES = 6+    fromFVal AES128 = 7+    fromFVal AES192 = 8+    fromFVal AES256 = 9+    fromFVal Twofish = 10+    fromFVal Camellia128 = 11+    fromFVal Camellia192 = 12+    fromFVal Camellia256 = 13+    fromFVal (OtherSA o) = o+    toFVal 0 = Plaintext+    toFVal 1 = IDEA+    toFVal 2 = TripleDES+    toFVal 3 = CAST5+    toFVal 4 = Blowfish+    toFVal 5 = ReservedSAFER+    toFVal 6 = ReservedDES+    toFVal 7 = AES128+    toFVal 8 = AES192+    toFVal 9 = AES256+    toFVal 10 = Twofish+    toFVal 11 = Camellia128+    toFVal 12 = Camellia192+    toFVal 13 = Camellia256+    toFVal o = OtherSA o++instance Hashable SymmetricAlgorithm++instance Pretty SymmetricAlgorithm where+    pretty Plaintext = text "plaintext"+    pretty IDEA = text "IDEA"+    pretty TripleDES = text "3DES"+    pretty CAST5 = text "CAST-128"+    pretty Blowfish = text "Blowfish"+    pretty ReservedSAFER = text "(reserved) SAFER"+    pretty ReservedDES = text "(reserved) DES"+    pretty AES128 = text "AES-128"+    pretty AES192 = text "AES-192"+    pretty AES256 = text "AES-256"+    pretty Twofish = text "Twofish"+    pretty Camellia128 = text "Camellia-128"+    pretty Camellia192 = text "Camellia-192"+    pretty Camellia256 = text "Camellia-256"+    pretty (OtherSA sa) = text "unknown symmetric algorithm" <+> (text . show) sa++instance A.ToJSON SymmetricAlgorithm+instance A.FromJSON SymmetricAlgorithm++data NotationFlag = HumanReadable+                  | OtherNF Word8 -- FIXME: this should be constrained to 4 bits?+     deriving (Data, Generic, Show, Typeable)++instance Eq NotationFlag where+    (==) a b = fromFFlag a == fromFFlag b++instance Ord NotationFlag where+    compare = comparing fromFFlag++instance FutureFlag NotationFlag where+    fromFFlag HumanReadable = 0+    fromFFlag (OtherNF o) = fromIntegral o++    toFFlag 0 = HumanReadable+    toFFlag o = OtherNF (fromIntegral o)++instance Hashable NotationFlag++instance Pretty NotationFlag where+    pretty HumanReadable = text "human-readable"+    pretty (OtherNF o) = text "unknown notation flag type" <+> pretty o++instance A.ToJSON NotationFlag+instance A.FromJSON NotationFlag++data SigSubPacket = SigSubPacket {+    _sspCriticality :: Bool+  , _sspPayload :: SigSubPacketPayload+  } deriving (Data, Eq, Generic, Show, Typeable)++instance Pretty SigSubPacket where+    pretty x = (if _sspCriticality x then char '*' else mempty) <> (pretty . _sspPayload) x++instance Hashable SigSubPacket++instance A.ToJSON SigSubPacket+instance A.FromJSON SigSubPacket++newtype ThirtyTwoBitTimeStamp = ThirtyTwoBitTimeStamp {unThirtyTwoBitTimeStamp :: Word32}+    deriving (Bounded, Data, Enum, Eq, Generic, Hashable, Integral, Num, Ord, Real, Show, Typeable)++instance Newtype ThirtyTwoBitTimeStamp Word32 where+    pack = ThirtyTwoBitTimeStamp+    unpack (ThirtyTwoBitTimeStamp o) = o++instance Pretty ThirtyTwoBitTimeStamp where+    pretty = text . formatTime defaultTimeLocale "%Y%m%d-%H%M%S" . posixSecondsToUTCTime . realToFrac++instance A.ToJSON ThirtyTwoBitTimeStamp+instance A.FromJSON ThirtyTwoBitTimeStamp++newtype ThirtyTwoBitDuration = ThirtyTwoBitDuration {unThirtyTwoBitDuration :: Word32}+    deriving (Bounded, Data, Enum, Eq, Generic, Hashable, Integral, Num, Ord, Real, Show, Typeable)++instance Newtype ThirtyTwoBitDuration Word32 where+    pack = ThirtyTwoBitDuration+    unpack (ThirtyTwoBitDuration o) = o++instance Pretty ThirtyTwoBitDuration where+    pretty = text . concat . unfoldr durU . unpack++instance A.ToJSON ThirtyTwoBitDuration+instance A.FromJSON ThirtyTwoBitDuration++durU :: (Integral a, Show a) => a -> Maybe (String, a)+durU x+  | x >= 31557600 = Just ((++"y") . show $ x `div` 31557600, x `mod` 31557600)+  | x >= 2629800 = Just ((++"m") . show $ x `div` 2629800, x `mod` 2629800)+  | x >= 86400 = Just ((++"d") . show $ x `div` 86400, x `mod` 86400)+  | x > 0 = Just ((++"s") . show $ x, 0)+  | otherwise = Nothing++newtype URL = URL {unURL :: URI}+    deriving (Data, Eq, Generic, Ord, Show, Typeable)++instance Newtype URL URI where+    pack = URL+    unpack (URL o) = o++instance Hashable URL where+    hashWithSalt salt (URL (URI s a p q f)) = salt `hashWithSalt` s `hashWithSalt` show a `hashWithSalt` p `hashWithSalt` q `hashWithSalt` f++instance Pretty URL where+    pretty = pretty . (\uri -> uriToString id uri "") . unpack++instance A.ToJSON URL where+    toJSON u = object [T.pack "uri" .= (\uri -> uriToString id uri "") (unpack u)]+instance A.FromJSON URL where+    parseJSON (A.Object v) = URL . fromMaybe nullURI . parseURI <$>+                                      v A..: T.pack "uri"+    parseJSON _            = mzero++newtype NotationName = NotationName {unNotationName :: ByteString}+    deriving (Data, Eq, Generic, Hashable, Ord, Pretty, Show, Typeable)++instance Newtype NotationName ByteString where+    pack = NotationName+    unpack (NotationName nn) = nn++instance A.ToJSON NotationName where+    toJSON nn = object [T.pack "notationname" .= show (unpack nn)]+instance A.FromJSON NotationName where+    parseJSON (A.Object v) = NotationName . read <$>+                                      v A..: T.pack "notationname"+    parseJSON _            = mzero++newtype NotationValue = NotationValue {unNotationValue :: ByteString}+    deriving (Data, Eq, Generic, Hashable, Ord, Pretty, Show, Typeable)++instance Newtype NotationValue ByteString where+    pack = NotationValue+    unpack (NotationValue nv) = nv++instance A.ToJSON NotationValue where+    toJSON nv = object [T.pack "notationvalue" .= show (unpack nv)]+instance A.FromJSON NotationValue where+    parseJSON (A.Object v) = NotationValue . read <$>+                                      v A..: T.pack "notationvalue"+    parseJSON _            = mzero++data SigSubPacketPayload = SigCreationTime ThirtyTwoBitTimeStamp+                  | SigExpirationTime ThirtyTwoBitDuration+                  | ExportableCertification Exportability+                  | TrustSignature TrustLevel TrustAmount+                  | RegularExpression AlmostPublicDomainRegex+                  | Revocable Revocability+                  | KeyExpirationTime ThirtyTwoBitDuration+                  | PreferredSymmetricAlgorithms [SymmetricAlgorithm]+                  | RevocationKey (Set RevocationClass) PubKeyAlgorithm TwentyOctetFingerprint+                  | Issuer EightOctetKeyId+                  | NotationData (Set NotationFlag) NotationName NotationValue+                  | PreferredHashAlgorithms [HashAlgorithm]+                  | PreferredCompressionAlgorithms [CompressionAlgorithm]+                  | KeyServerPreferences (Set KSPFlag)+                  | PreferredKeyServer KeyServer+                  | PrimaryUserId Bool+                  | PolicyURL URL+                  | KeyFlags (Set KeyFlag)+                  | SignersUserId Text+                  | ReasonForRevocation RevocationCode RevocationReason+                  | Features (Set FeatureFlag)+                  | SignatureTarget PubKeyAlgorithm HashAlgorithm SignatureHash+                  | EmbeddedSignature SignaturePayload+                  | UserDefinedSigSub Word8 ByteString+                  | OtherSigSub Word8 ByteString+    deriving (Data, Eq, Generic, Show, Typeable) -- FIXME++instance Hashable SigSubPacketPayload++instance Pretty SigSubPacketPayload where+    pretty (SigCreationTime ts) = text "creation-time" <+> pretty ts+    pretty (SigExpirationTime d) = text "sig expiration time" <+> pretty d+    pretty (ExportableCertification e) = text "exportable certification" <+> pretty e+    pretty (TrustSignature tl ta) = text "trust signature" <+> pretty tl <+> pretty ta+    pretty (RegularExpression apdre) = text "regular expression" <+> pretty apdre+    pretty (Revocable r) = text "revocable" <+> pretty r+    pretty (KeyExpirationTime d) = text "key expiration time" <+> pretty d+    pretty (PreferredSymmetricAlgorithms sas) = text "preferred symmetric algorithms" <+> prettyList sas+    pretty (RevocationKey rcs pka tof) = text "revocation key" <+> prettyList (Set.toList rcs) <+> pretty pka <+> pretty tof+    pretty (Issuer eoki) = text "issuer" <+> pretty eoki+    pretty (NotationData nfs nn nv) = text "notation data" <+> prettyList (Set.toList nfs) <+> pretty nn <+> pretty nv+    pretty (PreferredHashAlgorithms phas) = text "preferred hash algorithms" <+> prettyList phas+    pretty (PreferredCompressionAlgorithms pcas) = text "preferred compression algorithms" <+> pretty pcas+    pretty (KeyServerPreferences kspfs) = text "keyserver preferences" <+> prettyList (Set.toList kspfs)+    pretty (PreferredKeyServer ks) = text "preferred keyserver" <+> pretty ks+    pretty (PrimaryUserId p) = (if p then mempty else text "NOT ") <> text "primary user-ID"+    pretty (PolicyURL u) = text "policy URL" <+> pretty u+    pretty (KeyFlags kfs) = text "key flags" <+> prettyList (Set.toList kfs)+    pretty (SignersUserId u) = text "signer's user-ID" <+> pretty u+    pretty (ReasonForRevocation rc rr) = text "reason for revocation" <+> pretty rc <+> pretty rr+    pretty (Features ffs) = text "features" <+> prettyList (Set.toList ffs)+    pretty (SignatureTarget pka ha sh) = text "signature target" <+> pretty pka <+> pretty ha <+> pretty sh+    pretty (EmbeddedSignature sp) = text "embedded signature" <+> pretty sp+    pretty (UserDefinedSigSub t bs) = text "user-defined signature subpacket type" <+> pretty t <+> pretty (BL.unpack bs)+    pretty (OtherSigSub t bs) = text "unknown signature subpacket type" <+> pretty t <+> pretty bs++instance A.ToJSON SigSubPacketPayload where+    toJSON (SigCreationTime ts) = object [T.pack "sigCreationTime" .= ts]+    toJSON (SigExpirationTime d) = object [T.pack "sigExpirationTime" .= d]+    toJSON (ExportableCertification e) = object [T.pack "exportableCertification" .= e]+    toJSON (TrustSignature tl ta) = object [T.pack "trustSignature" .= (tl, ta)]+    toJSON (RegularExpression apdre) = object [T.pack "regularExpression" .= BL.unpack apdre]+    toJSON (Revocable r) = object [T.pack "revocable" .= r]+    toJSON (KeyExpirationTime d) = object [T.pack "keyExpirationTime" .= d]+    toJSON (PreferredSymmetricAlgorithms sas) = object [T.pack "preferredSymmetricAlgorithms" .= sas]+    toJSON (RevocationKey rcs pka tof) = object [T.pack "revocationKey" .= (rcs, pka, tof)]+    toJSON (Issuer eoki) = object [T.pack "issuer" .= eoki]+    toJSON (NotationData nfs (NotationName nn) (NotationValue nv)) = object [T.pack "notationData" .= (nfs, BL.unpack nn, BL.unpack nv)]+    toJSON (PreferredHashAlgorithms phas) = object [T.pack "preferredHashAlgorithms" .= phas]+    toJSON (PreferredCompressionAlgorithms pcas) = object [T.pack "preferredCompressionAlgorithms" .=  pcas]+    toJSON (KeyServerPreferences kspfs) = object [T.pack "keyServerPreferences" .= kspfs]+    toJSON (PreferredKeyServer ks) = object [T.pack "preferredKeyServer" .= show ks]+    toJSON (PrimaryUserId p) = object [T.pack "primaryUserId" .= p]+    toJSON (PolicyURL u) = object [T.pack "policyURL" .= u]+    toJSON (KeyFlags kfs) = object [T.pack "keyFlags" .= kfs]+    toJSON (SignersUserId u) = object [T.pack "signersUserId" .= u]+    toJSON (ReasonForRevocation rc rr) = object [T.pack "reasonForRevocation" .= (rc, rr)]+    toJSON (Features ffs) = object [T.pack "features" .= ffs]+    toJSON (SignatureTarget pka ha sh) = object [T.pack "signatureTarget" .= (pka, ha, BL.unpack sh)]+    toJSON (EmbeddedSignature sp) = object [T.pack "embeddedSignature" .= sp]+    toJSON (UserDefinedSigSub t bs) = object [T.pack "userDefinedSigSub" .= (t, BL.unpack bs)]+    toJSON (OtherSigSub t bs) = object [T.pack "otherSigSub" .= (t, BL.unpack bs)]++instance A.FromJSON SigSubPacketPayload where+    parseJSON (A.Object v) = (SigCreationTime <$> v A..: T.pack "sigCreationTime")+                         <|> (SigExpirationTime <$> v A..: T.pack "sigExpirationTime")+                         <|> (ExportableCertification <$> v A..: T.pack "exportableCertification")+                         <|> (uncurry TrustSignature <$> v A..: T.pack "trustSignature")+                         <|> (RegularExpression . BL.pack <$> v A..: T.pack "regularExpression")+                         <|> (Revocable <$> v A..: T.pack "revocable")+                         <|> (KeyExpirationTime <$> v A..: T.pack "keyExpirationTime")+                         <|> (PreferredSymmetricAlgorithms <$> v A..: T.pack "preferredSymmetricAlgorithms")+                         <|> (uc3 RevocationKey <$> v A..: T.pack "revocationKey")+                         <|> (Issuer <$> v A..: T.pack "issuer")+                         <|> (uc3 NotationData <$> v A..: T.pack "notationData")+    parseJSON _            = mzero++uc3 :: (a -> b -> c -> d) -> (a, b, c) -> d+uc3 f ~(a,b,c) = f a b c++data HashAlgorithm = DeprecatedMD5+                   | SHA1+                   | RIPEMD160+                   | SHA256+                   | SHA384+                   | SHA512+                   | SHA224+                   | OtherHA Word8+    deriving (Data, Generic, Show, Typeable)++instance Eq HashAlgorithm where+    (==) a b = fromFVal a == fromFVal b++instance Ord HashAlgorithm where+    compare = comparing fromFVal++instance FutureVal HashAlgorithm where+    fromFVal DeprecatedMD5 = 1+    fromFVal SHA1 = 2+    fromFVal RIPEMD160 = 3+    fromFVal SHA256 = 8+    fromFVal SHA384 = 9+    fromFVal SHA512 = 10+    fromFVal SHA224 = 11+    fromFVal (OtherHA o) = o+    toFVal 1 = DeprecatedMD5+    toFVal 2 = SHA1+    toFVal 3 = RIPEMD160+    toFVal 8 = SHA256+    toFVal 9 = SHA384+    toFVal 10 = SHA512+    toFVal 11 = SHA224+    toFVal o = OtherHA o++instance Hashable HashAlgorithm++instance Pretty HashAlgorithm where+    pretty DeprecatedMD5 = text "(deprecated) MD5"+    pretty SHA1 = text "SHA-1"+    pretty RIPEMD160 = text "RIPEMD-160"+    pretty SHA256 = text "SHA-256"+    pretty SHA384 = text "SHA-384"+    pretty SHA512 = text "SHA-512"+    pretty SHA224 = text "SHA-224"+    pretty (OtherHA ha) = text "unknown hash algorithm type" <+> (text . show) ha++instance A.ToJSON HashAlgorithm+instance A.FromJSON HashAlgorithm++data CompressionAlgorithm = Uncompressed+                          | ZIP+                          | ZLIB+                          | BZip2+                          | OtherCA Word8+    deriving (Show, Data, Generic, Typeable)++instance Eq CompressionAlgorithm where+    (==) a b = fromFVal a == fromFVal b++instance Ord CompressionAlgorithm where+    compare = comparing fromFVal++instance FutureVal CompressionAlgorithm where+    fromFVal Uncompressed = 0+    fromFVal ZIP = 1+    fromFVal ZLIB = 2+    fromFVal BZip2 = 3+    fromFVal (OtherCA o) = o+    toFVal 0 = Uncompressed+    toFVal 1 = ZIP+    toFVal 2 = ZLIB+    toFVal 3 = BZip2+    toFVal o = OtherCA o++instance Hashable CompressionAlgorithm++instance Pretty CompressionAlgorithm where+    pretty Uncompressed = text "uncompressed"+    pretty ZIP = text "ZIP"+    pretty ZLIB = text "zlib"+    pretty BZip2 = text "bzip2"+    pretty (OtherCA ca) = text "unknown compression algorithm type" <+> (text . show) ca++instance A.ToJSON CompressionAlgorithm+instance A.FromJSON CompressionAlgorithm++class (Eq a, Ord a) => FutureVal a where+   fromFVal :: a -> Word8+   toFVal :: Word8 -> a++data PubKeyAlgorithm = RSA+                     | DeprecatedRSAEncryptOnly+                     | DeprecatedRSASignOnly+                     | ElgamalEncryptOnly+                     | DSA+                     | ECDH+                     | ECDSA+                     | ForbiddenElgamal+                     | DH+                     | OtherPKA Word8+    deriving (Show, Data, Generic, Typeable)++instance Eq PubKeyAlgorithm where+    (==) a b = fromFVal a == fromFVal b++instance Ord PubKeyAlgorithm where+    compare = comparing fromFVal++instance FutureVal PubKeyAlgorithm where+    fromFVal RSA = 1+    fromFVal DeprecatedRSAEncryptOnly = 2+    fromFVal DeprecatedRSASignOnly = 3+    fromFVal ElgamalEncryptOnly = 16+    fromFVal DSA = 17+    fromFVal ECDH = 18+    fromFVal ECDSA = 19+    fromFVal ForbiddenElgamal = 20+    fromFVal DH = 21+    fromFVal (OtherPKA o) = o+    toFVal 1 = RSA+    toFVal 2 = DeprecatedRSAEncryptOnly+    toFVal 3 = DeprecatedRSASignOnly+    toFVal 16 = ElgamalEncryptOnly+    toFVal 17 = DSA+    toFVal 18 = ECDH+    toFVal 19 = ECDSA+    toFVal 20 = ForbiddenElgamal+    toFVal 21 = DH+    toFVal o = OtherPKA o++instance Hashable PubKeyAlgorithm++instance Pretty PubKeyAlgorithm where+    pretty RSA = text "RSA"+    pretty DeprecatedRSAEncryptOnly = text "(deprecated) RSA encrypt-only"+    pretty DeprecatedRSASignOnly = text "(deprecated) RSA sign-only"+    pretty ElgamalEncryptOnly = text "Elgamal encrypt-only"+    pretty DSA = text "DSA"+    pretty ECDH = text "ECDH"+    pretty ECDSA = text "ECDSA"+    pretty ForbiddenElgamal = text "(forbidden) Elgamal"+    pretty DH = text "DH"+    pretty pka = text "unknown pubkey algorithm type" <+> (text . show) pka++instance A.ToJSON PubKeyAlgorithm+instance A.FromJSON PubKeyAlgorithm++class (Eq a, Ord a) => FutureFlag a where+    fromFFlag :: a -> Int+    toFFlag :: Int -> a++data KSPFlag = NoModify+             | KSPOther Int+    deriving (Data, Generic, Show, Typeable)++instance Eq KSPFlag where+    (==) a b = fromFFlag a == fromFFlag b++instance Ord KSPFlag where+    compare = comparing fromFFlag++instance FutureFlag KSPFlag where+    fromFFlag NoModify = 0+    fromFFlag (KSPOther i) = fromIntegral i++    toFFlag 0 = NoModify+    toFFlag i = KSPOther (fromIntegral i)++instance Hashable KSPFlag++instance Pretty KSPFlag where+    pretty NoModify = text "no-modify"+    pretty (KSPOther o) = text "unknown keyserver preference flag type" <+> pretty o++instance A.ToJSON KSPFlag+instance A.FromJSON KSPFlag++data KeyFlag = GroupKey+             | AuthKey+             | SplitKey+             | EncryptStorageKey+             | EncryptCommunicationsKey+             | SignDataKey+             | CertifyKeysKey+             | KFOther Int+    deriving (Data, Generic, Show, Typeable)++instance Eq KeyFlag where+    (==) a b = fromFFlag a == fromFFlag b++instance Ord KeyFlag where+    compare = comparing fromFFlag++instance FutureFlag KeyFlag where+    fromFFlag GroupKey = 0+    fromFFlag AuthKey = 2+    fromFFlag SplitKey = 3+    fromFFlag EncryptStorageKey = 4+    fromFFlag EncryptCommunicationsKey = 5+    fromFFlag SignDataKey = 6+    fromFFlag CertifyKeysKey = 7+    fromFFlag (KFOther i) = fromIntegral i++    toFFlag 0 = GroupKey+    toFFlag 2 = AuthKey+    toFFlag 3 = SplitKey+    toFFlag 4 = EncryptStorageKey+    toFFlag 5 = EncryptCommunicationsKey+    toFFlag 6 = SignDataKey+    toFFlag 7 = CertifyKeysKey+    toFFlag i = KFOther (fromIntegral i)++instance Hashable KeyFlag++instance Pretty KeyFlag where+    pretty GroupKey = text "group"+    pretty AuthKey = text "auth"+    pretty SplitKey = text "split"+    pretty EncryptStorageKey = text "encrypt-storage"+    pretty EncryptCommunicationsKey = text "encrypt-communications"+    pretty SignDataKey = text "sign-data"+    pretty CertifyKeysKey = text "certify-keys"+    pretty (KFOther o) = text "unknown key flag type" <+> pretty o++instance A.ToJSON KeyFlag+instance A.FromJSON KeyFlag++data RevocationClass = SensitiveRK+                     | RClOther Word8 -- FIXME: this should be constrained to 3 bits+    deriving (Data, Generic, Show, Typeable)++instance Eq RevocationClass where+    (==) a b = fromFFlag a == fromFFlag b++instance Ord RevocationClass where+    compare = comparing fromFFlag++instance FutureFlag RevocationClass where+    fromFFlag SensitiveRK = 1+    fromFFlag (RClOther i) = fromIntegral i++    toFFlag 1 = SensitiveRK+    toFFlag i = RClOther (fromIntegral i)++instance Hashable RevocationClass++instance Pretty RevocationClass where+    pretty SensitiveRK = text "sensitive"+    pretty (RClOther o) = text "unknown revocation class" <+> pretty o++instance A.ToJSON RevocationClass+instance A.FromJSON RevocationClass++data RevocationCode = NoReason+                    | KeySuperseded+                    | KeyMaterialCompromised+                    | KeyRetiredAndNoLongerUsed+                    | UserIdInfoNoLongerValid+                    | RCoOther Word8+    deriving (Data, Generic, Show, Typeable)++instance Eq RevocationCode where+    (==) a b = fromFVal a == fromFVal b++instance Ord RevocationCode where+    compare = comparing fromFVal++instance FutureVal RevocationCode where+    fromFVal NoReason = 0+    fromFVal KeySuperseded = 1+    fromFVal KeyMaterialCompromised = 2+    fromFVal KeyRetiredAndNoLongerUsed = 3+    fromFVal UserIdInfoNoLongerValid = 32+    fromFVal (RCoOther o) = o+    toFVal 0 = NoReason+    toFVal 1 = KeySuperseded+    toFVal 2 = KeyMaterialCompromised+    toFVal 3 = KeyRetiredAndNoLongerUsed+    toFVal 32 = UserIdInfoNoLongerValid+    toFVal o = RCoOther o++instance Hashable RevocationCode++instance Pretty RevocationCode where+    pretty NoReason = text "no reason"+    pretty KeySuperseded = text "key superseded"+    pretty KeyMaterialCompromised = text "key material compromised"+    pretty KeyRetiredAndNoLongerUsed = text "key retired and no longer used"+    pretty UserIdInfoNoLongerValid = text "user-ID info no longer valid"+    pretty (RCoOther o) = text "unknown revocation code" <+> pretty o++instance A.ToJSON RevocationCode+instance A.FromJSON RevocationCode++data FeatureFlag = ModificationDetection+                 | FeatureOther Int+    deriving (Data, Generic, Show, Typeable)++instance Eq FeatureFlag where+    (==) a b = fromFFlag a == fromFFlag b++instance Ord FeatureFlag where+    compare = comparing fromFFlag++instance FutureFlag FeatureFlag where+    fromFFlag ModificationDetection = 7+    fromFFlag (FeatureOther i) = fromIntegral i++    toFFlag 7 = ModificationDetection+    toFFlag i = FeatureOther (fromIntegral i)++instance Hashable FeatureFlag+instance Hashable a => Hashable (Set a) where+    hashWithSalt salt = hashWithSalt salt . Set.toList++instance Pretty FeatureFlag where+    pretty ModificationDetection = text "modification-detection"+    pretty (FeatureOther o) = text "unknown feature flag type" <+> pretty o++instance A.ToJSON FeatureFlag+instance A.FromJSON FeatureFlag++newtype MPI = MPI {unMPI :: Integer}+    deriving (Data, Eq, Generic, Show, Typeable)++instance Newtype MPI Integer where+    pack = MPI+    unpack (MPI o) = o++instance Hashable MPI++instance Pretty MPI where+    pretty = pretty . unpack++instance A.ToJSON MPI+instance A.FromJSON MPI++data SignaturePayload = SigV3 SigType ThirtyTwoBitTimeStamp EightOctetKeyId PubKeyAlgorithm HashAlgorithm Word16 (NonEmpty MPI)+                      | SigV4 SigType PubKeyAlgorithm HashAlgorithm [SigSubPacket] [SigSubPacket] Word16 (NonEmpty MPI)+                      | SigVOther Word8 ByteString+    deriving (Data, Eq, Generic, Show, Typeable)++instance Hashable SignaturePayload++instance Pretty SignaturePayload where+    pretty (SigV3 st ts eoki pka ha w16 mpis) = text "signature v3" <> char ':' <+> pretty st <+> pretty ts <+> pretty eoki <+> pretty pka <+> pretty ha <+> pretty w16 <+> (prettyList . NE.toList) mpis+    pretty (SigV4 st pka ha hsps usps w16 mpis) = text "signature v4" <> char ':' <+> pretty st <+> pretty pka <+> pretty ha <+> prettyList hsps <+> prettyList usps <+> pretty w16 <+> (prettyList . NE.toList) mpis+    pretty (SigVOther t bs) = text "unknown signature v" <> pretty t <> char ':' <+> pretty (BL.unpack bs)++instance A.ToJSON SignaturePayload where+    toJSON (SigV3 st ts eoki pka ha w16 mpis) = A.toJSON (st, ts, eoki, pka, ha, w16, NE.toList mpis)+    toJSON (SigV4 st pka ha hsps usps w16 mpis) = A.toJSON (st, pka, ha, hsps, usps, w16, NE.toList mpis)+    toJSON (SigVOther t bs) = A.toJSON (t, BL.unpack bs)++data KeyVersion = DeprecatedV3 | V4+    deriving (Data, Eq, Generic, Ord, Show, Typeable)++instance Hashable KeyVersion++instance Pretty KeyVersion where+    pretty DeprecatedV3 = text "(deprecated) v3"+    pretty V4 = text "v4"++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)++instance Newtype IV B.ByteString where+    pack = IV+    unpack (IV o) = o++instance Pretty IV where+    pretty = pretty . unpack++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+              | OtherData Word8+    deriving (Show, Data, Generic, Typeable)++instance Hashable DataType++instance Eq DataType where+    (==) a b = fromFVal a == fromFVal b++instance Ord DataType where+    compare = comparing fromFVal++instance FutureVal DataType where+    fromFVal BinaryData = fromIntegral . fromEnum $ 'b'+    fromFVal TextData = fromIntegral . fromEnum $ 't'+    fromFVal UTF8Data = fromIntegral . fromEnum $ 'u'+    fromFVal (OtherData o) = o++    toFVal 0x62 = BinaryData+    toFVal 0x74 = TextData+    toFVal 0x75 = UTF8Data+    toFVal o = OtherData o++instance Pretty DataType where+    pretty BinaryData = text "binary"+    pretty TextData = text "text"+    pretty UTF8Data = text "UTF-8"+    pretty (OtherData o) = text "other data type " <+> (text . show) o++instance A.ToJSON DataType+instance A.FromJSON DataType++newtype Salt = Salt {unSalt :: B.ByteString}+    deriving (Byteable, Data, Eq, Generic, Hashable, Show, Typeable)++instance Newtype Salt B.ByteString where+    pack = Salt+    unpack (Salt o) = o++instance Pretty Salt where+    pretty = pretty . unpack++instance A.ToJSON Salt where+    toJSON = A.toJSON . show . unpack++newtype IterationCount = IterationCount {unIterationCount :: Int}+    deriving (Bounded, Data, Enum, Eq, Generic, Hashable, Integral, Num, Ord, Real, Show, Typeable)++instance Newtype IterationCount Int where+    pack = IterationCount+    unpack (IterationCount o) = o++instance Pretty IterationCount where+    pretty = pretty . unpack++instance A.ToJSON IterationCount+instance A.FromJSON IterationCount++data S2K = Simple HashAlgorithm+         | Salted HashAlgorithm Salt+         | IteratedSalted HashAlgorithm Salt IterationCount+         | OtherS2K Word8 ByteString+    deriving (Data, Eq, Generic, Show, Typeable)++instance Hashable S2K++instance Pretty S2K where+    pretty (Simple ha) = text "simple S2K," <+> pretty ha+    pretty (Salted ha salt) = text "simple S2K," <+> pretty ha <+> pretty salt+    pretty (IteratedSalted ha salt icount) = text "simple S2K," <+> pretty ha <+> pretty salt <+> pretty icount+    pretty (OtherS2K t bs) = text "unknown S2K type" <+> pretty t <+> pretty bs++instance A.ToJSON S2K where+    toJSON (Simple ha) = A.toJSON ha+    toJSON (Salted ha salt) = A.toJSON (ha, salt)+    toJSON (IteratedSalted ha salt icount) = A.toJSON (ha, salt, icount)+    toJSON (OtherS2K t bs) = A.toJSON (t, BL.unpack bs)++data UserAttrSubPacket = ImageAttribute ImageHeader ImageData+                       | OtherUASub Word8 ByteString+    deriving (Data, Eq, Generic, Show, Typeable)++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++instance Pretty UserAttrSubPacket where+    pretty (ImageAttribute ih d) = text "image-attribute" <+> pretty ih <+> pretty (BL.unpack d)+    pretty (OtherUASub t bs) = text "unknown attribute type" <> (text . show) t <+> pretty (BL.unpack bs)++instance A.ToJSON UserAttrSubPacket where+    toJSON (ImageAttribute ih d) = A.toJSON (ih, BL.unpack d)+    toJSON (OtherUASub t bs) = A.toJSON (t, BL.unpack bs)++data ImageHeader = ImageHV1 ImageFormat+    deriving (Data, Eq, Generic, Show, Typeable)++instance Ord ImageHeader where+    compare (ImageHV1 a) (ImageHV1 b) = compare a b++instance Hashable ImageHeader++instance Pretty ImageHeader where+    pretty (ImageHV1 f) = text "imghdr v1" <+> pretty f++instance A.ToJSON ImageHeader+instance A.FromJSON ImageHeader++data ImageFormat = JPEG+                 | OtherImage Word8+    deriving (Data, Generic, Show, Typeable)++instance Eq ImageFormat where+    (==) a b = fromFVal a == fromFVal b++instance Ord ImageFormat where+    compare = comparing fromFVal++instance FutureVal ImageFormat where+    fromFVal JPEG = 1+    fromFVal (OtherImage o) = o++    toFVal 1 = JPEG+    toFVal o = OtherImage o++instance Hashable ImageFormat++instance Pretty ImageFormat where+    pretty JPEG = text "JPEG"+    pretty (OtherImage o) = text "unknown image format" <+> pretty o++instance A.ToJSON ImageFormat+instance A.FromJSON ImageFormat++data SigType = BinarySig+             | CanonicalTextSig+             | StandaloneSig+             | GenericCert+             | PersonaCert+             | CasualCert+             | PositiveCert+             | SubkeyBindingSig+             | PrimaryKeyBindingSig+             | SignatureDirectlyOnAKey+             | KeyRevocationSig+             | SubkeyRevocationSig+             | CertRevocationSig+             | TimestampSig+             | ThirdPartyConfirmationSig+             | OtherSig Word8+    deriving (Data, Generic, Show, Typeable)++instance Eq SigType where+    (==) a b = fromFVal a == fromFVal b++instance Ord SigType where+    compare = comparing fromFVal++instance FutureVal SigType where+    fromFVal BinarySig = 0x00+    fromFVal CanonicalTextSig = 0x01+    fromFVal StandaloneSig = 0x02+    fromFVal GenericCert = 0x10+    fromFVal PersonaCert = 0x11+    fromFVal CasualCert = 0x12+    fromFVal PositiveCert = 0x13+    fromFVal SubkeyBindingSig = 0x18+    fromFVal PrimaryKeyBindingSig = 0x19+    fromFVal SignatureDirectlyOnAKey = 0x1F+    fromFVal KeyRevocationSig = 0x20+    fromFVal SubkeyRevocationSig = 0x28+    fromFVal CertRevocationSig = 0x30+    fromFVal TimestampSig = 0x40+    fromFVal ThirdPartyConfirmationSig = 0x50+    fromFVal (OtherSig o) = o++    toFVal 0x00 = BinarySig+    toFVal 0x01 = CanonicalTextSig+    toFVal 0x02 = StandaloneSig+    toFVal 0x10 = GenericCert+    toFVal 0x11 = PersonaCert+    toFVal 0x12 = CasualCert+    toFVal 0x13 = PositiveCert+    toFVal 0x18 = SubkeyBindingSig+    toFVal 0x19 = PrimaryKeyBindingSig+    toFVal 0x1F = SignatureDirectlyOnAKey+    toFVal 0x20 = KeyRevocationSig+    toFVal 0x28 = SubkeyRevocationSig+    toFVal 0x30 = CertRevocationSig+    toFVal 0x40 = TimestampSig+    toFVal 0x50 = ThirdPartyConfirmationSig+    toFVal o = OtherSig o++instance Hashable SigType++instance Pretty SigType where+    pretty BinarySig = text "binary"+    pretty CanonicalTextSig = text "canonical-text"+    pretty StandaloneSig = text "standalone"+    pretty GenericCert = text "generic"+    pretty PersonaCert = text "persona"+    pretty CasualCert = text "casual"+    pretty PositiveCert = text "positive"+    pretty SubkeyBindingSig = text "subkey-binding"+    pretty PrimaryKeyBindingSig = text "primary-key-binding"+    pretty SignatureDirectlyOnAKey = text "signature directly on a key"+    pretty KeyRevocationSig = text "key-revocation"+    pretty SubkeyRevocationSig = text "subkey-revocation"+    pretty CertRevocationSig = text "cert-revocation"+    pretty TimestampSig = text "timestamp"+    pretty ThirdPartyConfirmationSig = text "third-party-confirmation"+    pretty (OtherSig o) = text "unknown signature type" <+> pretty o++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+    deriving (Data, Eq, Generic, Ord, Show, Typeable)++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)++newtype EightOctetKeyId = EightOctetKeyId {unEOKI :: ByteString}+    deriving (Data, Eq, Generic, Ord, Show, Typeable)++instance Newtype EightOctetKeyId ByteString where+    pack = EightOctetKeyId+    unpack (EightOctetKeyId o) = o++instance Pretty EightOctetKeyId where+    pretty = text . w8sToHex . BL.unpack . unpack++-- FIXME: read-show+instance Read EightOctetKeyId where+    readsPrec _ = map ((EightOctetKeyId . BL.pack *** concat) . unzip) . chunksOf 8 . hexToW8s++instance Hashable EightOctetKeyId++instance A.ToJSON EightOctetKeyId where+    toJSON e = object [T.pack "eoki" .= (w8sToHex . BL.unpack . unpack) e]++instance A.FromJSON EightOctetKeyId where+    parseJSON (A.Object v) = EightOctetKeyId . read <$>+                                      v A..: T.pack "eoki"+    parseJSON _            = mzero++newtype TwentyOctetFingerprint = TwentyOctetFingerprint {unTOF :: ByteString}+    deriving (Data, Eq, Generic, Ord, Show, Typeable)++instance Newtype TwentyOctetFingerprint ByteString where+    pack = TwentyOctetFingerprint+    unpack (TwentyOctetFingerprint o) = o++-- FIXME: read-show+instance Read TwentyOctetFingerprint where+    readsPrec _ = map ((TwentyOctetFingerprint . BL.pack *** concat) . unzip) . chunksOf 20 . hexToW8s . filter (/= ' ')++instance Hashable TwentyOctetFingerprint++instance Pretty TwentyOctetFingerprint where+    pretty = text . take 40 . w8sToHex . BL.unpack . unTOF++instance A.ToJSON TwentyOctetFingerprint where+    toJSON e = object [T.pack "fpr" .= (A.toJSON . show . pretty) e]+instance A.FromJSON TwentyOctetFingerprint where+    parseJSON (A.Object v) = TwentyOctetFingerprint . read <$>+                                      v A..: T.pack "fpr"+    parseJSON _            = mzero++newtype SpacedFingerprint = SpacedFingerprint { unSpacedFingerprint :: TwentyOctetFingerprint }++instance Newtype SpacedFingerprint TwentyOctetFingerprint where+    pack = SpacedFingerprint+    unpack (SpacedFingerprint o) = o++instance Pretty SpacedFingerprint where+    pretty = hsep . punctuate space . map hsep . chunksOf 5 . map text . chunksOf 4 . take 40 . w8sToHex . BL.unpack . unTOF . unpack++w8sToHex :: [Word8] -> String+w8sToHex = map toUpper . concatMap ((\x -> if length x == 1 then '0':x else x) . flip showHex "")++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)
+ Codec/Encryption/OpenPGP/Types/Internal/PacketClass.hs view
@@ -0,0 +1,341 @@+-- PacketClass.hs: OpenPGP (RFC4880) data types+-- 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 ExistentialQuantification #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeFamilies #-}++module Codec.Encryption.OpenPGP.Types.Internal.PacketClass where++import Codec.Encryption.OpenPGP.Types.Internal.Base++import Control.Lens (makeLenses)+import Data.ByteString.Lazy (ByteString)+import qualified Data.ByteString.Lazy as BL+import Data.Data (Data)+import Data.List.NonEmpty (NonEmpty)+import Data.Text (Text)+import Data.Typeable (Typeable)+import Data.Word (Word8)+import Text.PrettyPrint.Free (Pretty(..))++class Packet a where+    data PacketType a :: *+    packetType :: a -> PacketType a+    packetCode :: PacketType a -> Word8+    toPkt :: a -> Pkt+    fromPkt :: Pkt -> a++data PKESK = PKESK+    { _pkeskPacketVersion :: PacketVersion+    , _pkeskEightOctetKeyId :: EightOctetKeyId+    , _pkeskPubKeyAlgorithm :: PubKeyAlgorithm+    , _pkeskMPIs :: NonEmpty MPI+    } deriving (Data, Eq, Show, Typeable)+instance Packet PKESK where+    data PacketType PKESK = PKESKType deriving (Show, Eq)+    packetType _ = PKESKType+    packetCode _ = 1+    toPkt (PKESK a b c d) = PKESKPkt a b c d+    fromPkt (PKESKPkt a b c d) = PKESK a b c d+    fromPkt _ = error "Cannot coerce non-PKESK packet"++instance Pretty PKESK where+    pretty = pretty . toPkt++data Signature = Signature   -- FIXME?+    { _signaturePayload :: SignaturePayload+    } deriving (Data, Eq, Show, Typeable)+instance Packet Signature where+    data PacketType Signature = SignatureType deriving (Show, Eq)+    packetType _ = SignatureType+    packetCode _ = 2+    toPkt (Signature a) = SignaturePkt a+    fromPkt (SignaturePkt a) = Signature a+    fromPkt _ = error "Cannot coerce non-Signature packet"++instance Pretty Signature where+    pretty = pretty . toPkt++data SKESK = SKESK+    { _skeskPacketVersion :: PacketVersion+    , _skeskSymmetricAlgorithm :: SymmetricAlgorithm+    , _skeskS2K :: S2K+    , _skeskESK :: Maybe BL.ByteString+    } deriving (Data, Eq, Show, Typeable)+instance Packet SKESK where+    data PacketType SKESK = SKESKType deriving (Show, Eq)+    packetType _ = SKESKType+    packetCode _ = 3+    toPkt (SKESK a b c d) = SKESKPkt a b c d+    fromPkt (SKESKPkt a b c d) = SKESK a b c d+    fromPkt _ = error "Cannot coerce non-SKESK packet"++instance Pretty SKESK where+    pretty = pretty . toPkt++data OnePassSignature = OnePassSignature+    { _onePassSignaturePacketVersion :: PacketVersion+    , _onePassSignatureSigType :: SigType+    , _onePassSignatureHashAlgorithm :: HashAlgorithm+    , _onePassSignaturePubKeyAlgorithm :: PubKeyAlgorithm+    , _onePassSignatureEightOctetKeyId :: EightOctetKeyId+    , _onePassSignatureNestedFlag :: NestedFlag+    } deriving (Data, Eq, Show, Typeable)+instance Packet OnePassSignature where+    data PacketType OnePassSignature = OnePassSignatureType deriving (Show, Eq)+    packetType _ = OnePassSignatureType+    packetCode _ = 4+    toPkt (OnePassSignature a b c d e f) = OnePassSignaturePkt a b c d e f+    fromPkt (OnePassSignaturePkt a b c d e f) = OnePassSignature a b c d e f+    fromPkt _ = error "Cannot coerce non-OnePassSignature packet"++instance Pretty OnePassSignature where+    pretty = pretty . toPkt++data SecretKey = SecretKey+    { _secretKeyPKPayload :: PKPayload+    , _secretKeySKAddendum :: SKAddendum+    } deriving (Data, Eq, Show, Typeable)+instance Packet SecretKey where+    data PacketType SecretKey = SecretKeyType deriving (Show, Eq)+    packetType _ = SecretKeyType+    packetCode _ = 5+    toPkt (SecretKey a b) = SecretKeyPkt a b+    fromPkt (SecretKeyPkt a b) = SecretKey a b+    fromPkt _ = error "Cannot coerce non-SecretKey packet"++instance Pretty SecretKey where+    pretty = pretty . toPkt++data PublicKey = PublicKey+    { _publicKeyPKPayload :: PKPayload+    } deriving (Data, Eq, Show, Typeable)+instance Packet PublicKey where+    data PacketType PublicKey = PublicKeyType deriving (Show, Eq)+    packetType _ = PublicKeyType+    packetCode _ = 6+    toPkt (PublicKey a) = PublicKeyPkt a+    fromPkt (PublicKeyPkt a) = PublicKey a+    fromPkt _ = error "Cannot coerce non-PublicKey packet"++instance Pretty PublicKey where+    pretty = pretty . toPkt++data SecretSubkey = SecretSubkey+    { _secretSubkeyPKPayload :: PKPayload+    , _secretSubkeySKAddendum :: SKAddendum+    } deriving (Data, Eq, Show, Typeable)+instance Packet SecretSubkey where+    data PacketType SecretSubkey = SecretSubkeyType deriving (Show, Eq)+    packetType _ = SecretSubkeyType+    packetCode _ = 7+    toPkt (SecretSubkey a b) = SecretSubkeyPkt a b+    fromPkt (SecretSubkeyPkt a b) = SecretSubkey a b+    fromPkt _ = error "Cannot coerce non-SecretSubkey packet"++instance Pretty SecretSubkey where+    pretty = pretty . toPkt++data CompressedData = CompressedData+    { _compressedDataCompressionAlgorithm :: CompressionAlgorithm+    , _compressedDataPayload :: CompressedDataPayload+    } deriving (Data, Eq, Show, Typeable)+instance Packet CompressedData where+    data PacketType CompressedData = CompressedDataType deriving (Show, Eq)+    packetType _ = CompressedDataType+    packetCode _ = 8+    toPkt (CompressedData a b) = CompressedDataPkt a b+    fromPkt (CompressedDataPkt a b) = CompressedData a b+    fromPkt _ = error "Cannot coerce non-CompressedData packet"++instance Pretty CompressedData where+    pretty = pretty . toPkt++data SymEncData = SymEncData+    { _symEncDataPayload :: ByteString+    } deriving (Data, Eq, Show, Typeable)+instance Packet SymEncData where+    data PacketType SymEncData = SymEncDataType deriving (Show, Eq)+    packetType _ = SymEncDataType+    packetCode _ = 9+    toPkt (SymEncData a) = SymEncDataPkt a+    fromPkt (SymEncDataPkt a) = SymEncData a+    fromPkt _ = error "Cannot coerce non-SymEncData packet"++instance Pretty SymEncData where+    pretty = pretty . toPkt++data Marker = Marker+    { _markerPayload :: ByteString+    } deriving (Data, Eq, Show, Typeable)+instance Packet Marker where+    data PacketType Marker = MarkerType deriving (Show, Eq)+    packetType _ = MarkerType+    packetCode _ = 10+    toPkt (Marker a) = MarkerPkt a+    fromPkt (MarkerPkt a) = Marker a+    fromPkt _ = error "Cannot coerce non-Marker packet"++instance Pretty Marker where+    pretty = pretty . toPkt++data LiteralData = LiteralData+    { _literalDataDataType :: DataType+    , _literalDataFileName :: FileName+    , _literalDataTimeStamp :: ThirtyTwoBitTimeStamp+    , _literalDataPayload :: ByteString+    } deriving (Data, Eq, Show, Typeable)+instance Packet LiteralData where+    data PacketType LiteralData = LiteralDataType deriving (Show, Eq)+    packetType _ = LiteralDataType+    packetCode _ = 11+    toPkt (LiteralData a b c d) = LiteralDataPkt a b c d+    fromPkt (LiteralDataPkt a b c d) = LiteralData a b c d+    fromPkt _ = error "Cannot coerce non-LiteralData packet"++instance Pretty LiteralData where+    pretty = pretty . toPkt++data Trust = Trust+    { _trustPayload :: ByteString+    } deriving (Data, Eq, Show, Typeable)+instance Packet Trust where+    data PacketType Trust = TrustType deriving (Show, Eq)+    packetType _ = TrustType+    packetCode _ = 12+    toPkt (Trust a) = TrustPkt a+    fromPkt (TrustPkt a) = Trust a+    fromPkt _ = error "Cannot coerce non-Trust packet"++instance Pretty Trust where+    pretty = pretty . toPkt++data UserId = UserId+    { _userIdPayload :: Text+    } deriving (Data, Eq, Show, Typeable)+instance Packet UserId where+    data PacketType UserId = UserIdType deriving (Show, Eq)+    packetType _ = UserIdType+    packetCode _ = 13+    toPkt (UserId a) = UserIdPkt a+    fromPkt (UserIdPkt a) = UserId a+    fromPkt _ = error "Cannot coerce non-UserId packet"++instance Pretty UserId where+    pretty = pretty . toPkt++data PublicSubkey = PublicSubkey+    { _publicSubkeyPKPayload :: PKPayload+    } deriving (Data, Eq, Show, Typeable)+instance Packet PublicSubkey where+    data PacketType PublicSubkey = PublicSubkeyType deriving (Show, Eq)+    packetType _ = PublicSubkeyType+    packetCode _ = 14+    toPkt (PublicSubkey a) = PublicSubkeyPkt a+    fromPkt (PublicSubkeyPkt a) = PublicSubkey a+    fromPkt _ = error "Cannot coerce non-PublicSubkey packet"++instance Pretty PublicSubkey where+    pretty = pretty . toPkt++data UserAttribute = UserAttribute+    { _userAttributeSubPackets :: [UserAttrSubPacket]+    } deriving (Data, Eq, Show, Typeable)+instance Packet UserAttribute where+    data PacketType UserAttribute = UserAttributeType deriving (Show, Eq)+    packetType _ = UserAttributeType+    packetCode _ = 17+    toPkt (UserAttribute a) = UserAttributePkt a+    fromPkt (UserAttributePkt a) = UserAttribute a+    fromPkt _ = error "Cannot coerce non-UserAttribute packet"++instance Pretty UserAttribute where+    pretty = pretty . toPkt++data SymEncIntegrityProtectedData = SymEncIntegrityProtectedData+    { _symEncIntegrityProtectedDataPacketVersion :: PacketVersion+    , _symEncIntegrityProtectedDataPayload :: ByteString+    } deriving (Data, Eq, Show, Typeable)+instance Packet SymEncIntegrityProtectedData where+    data PacketType SymEncIntegrityProtectedData = SymEncIntegrityProtectedDataType deriving (Show, Eq)+    packetType _ = SymEncIntegrityProtectedDataType+    packetCode _ = 18+    toPkt (SymEncIntegrityProtectedData a b) = SymEncIntegrityProtectedDataPkt a b+    fromPkt (SymEncIntegrityProtectedDataPkt a b) = SymEncIntegrityProtectedData a b+    fromPkt _ = error "Cannot coerce non-SymEncIntegrityProtectedData packet"++instance Pretty SymEncIntegrityProtectedData where+    pretty = pretty . toPkt++data ModificationDetectionCode = ModificationDetectionCode+    { _modificationDetectionCodePayload :: ByteString+    } deriving (Data, Eq, Show, Typeable)+instance Packet ModificationDetectionCode where+    data PacketType ModificationDetectionCode = ModificationDetectionCodeType deriving (Show, Eq)+    packetType _ = ModificationDetectionCodeType+    packetCode _ = 19+    toPkt (ModificationDetectionCode a) = ModificationDetectionCodePkt a+    fromPkt (ModificationDetectionCodePkt a) = ModificationDetectionCode a+    fromPkt _ = error "Cannot coerce non-ModificationDetectionCode packet"++instance Pretty ModificationDetectionCode where+    pretty = pretty . toPkt++data OtherPacket = OtherPacket+    { _otherPacketType :: Word8+    , _otherPacketPayload :: ByteString+    } deriving (Data, Eq, Show, Typeable)+instance Packet OtherPacket where+    data PacketType OtherPacket = OtherPacketType deriving (Show, Eq)+    packetType _ = OtherPacketType+    packetCode _ = undefined -- FIXME+    toPkt (OtherPacket a b) = OtherPacketPkt a b+    fromPkt (OtherPacketPkt a b) = OtherPacket a b+    fromPkt _ = error "Cannot coerce non-OtherPacket packet"++instance Pretty OtherPacket where+    pretty = pretty . toPkt++data BrokenPacket = BrokenPacket+    { _brokenPacketParseError :: String+    , _brokenPacketType :: Word8+    , _brokenPacketPayload :: ByteString+    } deriving (Data, Eq, Show, Typeable)+instance Packet BrokenPacket where+    data PacketType BrokenPacket = BrokenPacketType deriving (Show, Eq)+    packetType _ = BrokenPacketType+    packetCode _ = undefined+    toPkt (BrokenPacket a b c) = BrokenPacketPkt a b c+    fromPkt (BrokenPacketPkt a b c) = BrokenPacket a b c+    fromPkt _ = error "Cannot coerce non-BrokenPacket packet"++instance Pretty BrokenPacket where+    pretty = pretty . toPkt++$(makeLenses ''PKESK)+$(makeLenses ''Signature)+$(makeLenses ''SKESK)+$(makeLenses ''OnePassSignature)+$(makeLenses ''SecretKey)+$(makeLenses ''PKPayload)+$(makeLenses ''PublicKey)+$(makeLenses ''SecretSubkey)+$(makeLenses ''CompressedData)+$(makeLenses ''SymEncData)+$(makeLenses ''Marker)+$(makeLenses ''LiteralData)+$(makeLenses ''Trust)+$(makeLenses ''UserId)+$(makeLenses ''PublicSubkey)+$(makeLenses ''UserAttribute)+$(makeLenses ''SymEncIntegrityProtectedData)+$(makeLenses ''ModificationDetectionCode)+$(makeLenses ''OtherPacket)+$(makeLenses ''BrokenPacket)
bench/mark.hs view
@@ -19,12 +19,6 @@ import qualified Data.Conduit.Binary as CB import qualified Data.Conduit.List as CL -loadKeys fp = runResourceT $ CB.sourceFile fp DC.$= conduitGet get DC.$= conduitToTKs DC.$$ CL.consume-loadKeyring fp = runResourceT $ CB.sourceFile fp DC.$= conduitGet get DC.$= conduitToTKs DC.$$ sinkKeyringMap--selfVerifyKeys fp = fmap (\ks -> mapM (verifyTKWith (verifySigWith (verifyAgainstKeys ks)) Nothing) ks) (loadKeys fp)-selfVerifyKeyring fp = fmap (\kr -> mapM (verifyTKWith (verifySigWith (verifyAgainstKeyring kr)) Nothing) (IxSet.toList kr)) (loadKeyring fp)- main :: IO () main = defaultMain [   bgroup "keyring" [ bench "load keys"  $ whnfIO (loadKeys "tests/data/debian-keyring.gpg")@@ -33,3 +27,9 @@                    , bench "self-verify keyring" $ whnfIO (selfVerifyKeyring "tests/data/debian-keyring.gpg")                    ]                ]+  where+    loadKeys fp = runResourceT $ CB.sourceFile fp DC.$= conduitGet get DC.$= conduitToTKs DC.$$ CL.consume+    loadKeyring fp = runResourceT $ CB.sourceFile fp DC.$= conduitGet get DC.$= conduitToTKs DC.$$ sinkKeyringMap++    selfVerifyKeys fp = fmap (\ks -> mapM (verifyTKWith (verifySigWith (verifyAgainstKeys ks)) Nothing) ks) (loadKeys fp)+    selfVerifyKeyring fp = fmap (\kr -> mapM (verifyTKWith (verifySigWith (verifyAgainstKeyring kr)) Nothing) (IxSet.toList kr)) (loadKeyring fp)
hOpenPGP.cabal view
@@ -1,7 +1,7 @@ Name:                hOpenPGP-Version:             2.4.1+Version:             2.4.2 Synopsis:            native Haskell implementation of OpenPGP (RFC4880)-Description:         native Haskell implementation of OpenPGP (RFC4880)+Description:         native Haskell implementation of OpenPGP (RFC4880), plus Camellia (RFC5581) Homepage:            http://floss.scru.org/hOpenPGP/ License:             MIT License-file:        LICENSE@@ -133,6 +133,10 @@   , tests/data/encryption-sym-3des-mdc.gpg   , tests/data/encryption-sym-cast5.gpg   , tests/data/encryption-sym-cast5-s2k0.gpg+  , tests/data/encryption-sym-camellia128.gpg+  , tests/data/encryption-sym-camellia128-s2k0.gpg+  , tests/data/encryption-sym-camellia192.gpg+  , tests/data/encryption-sym-camellia256.gpg   , tests/data/16bitcksum.seckey   , tests/data/aes256-sha512.seckey   , tests/data/unencrypted.seckey@@ -173,6 +177,8 @@                , Codec.Encryption.OpenPGP.Internal.Cryptonite                , Codec.Encryption.OpenPGP.Internal.HOBlockCipher                , Codec.Encryption.OpenPGP.SerializeForSigs+               , Codec.Encryption.OpenPGP.Types.Internal.Base+               , Codec.Encryption.OpenPGP.Types.Internal.PacketClass                , Codec.Encryption.OpenPGP.BlockCipher   Build-depends: aeson                , attoparsec@@ -325,4 +331,4 @@ source-repository this   type:     git   location: git://git.debian.org/users/clint/hOpenPGP.git-  tag:      v2.4.1+  tag:      v2.4.2
+ tests/data/encryption-sym-camellia128-s2k0.gpg view

binary file changed (absent → 70 bytes)

+ tests/data/encryption-sym-camellia128.gpg view
@@ -0,0 +1,2 @@+ƒe°×Þ*ü`Ò>Öz¬6Å­ý­ûÔ0²¸ðž_¿Có$ÐÊÚ:8·‘ÈR»A5¢8ùžTMý¯ÛGµéè˜ó¡ßN¯9л
+ tests/data/encryption-sym-camellia192.gpg view
@@ -0,0 +1,3 @@+ßüfŠºS
`Ò>új1ZÁHW{þ1³Ò¾‚ðĽŠFA$ÅÛýr2q
°´¾‡l1+Gð¬SçCÐY0ÏÀt+÷3Fwi:
+ tests/data/encryption-sym-camellia256.gpg view

binary file changed (absent → 79 bytes)

tests/suite.hs view
@@ -335,6 +335,10 @@    , testCase "Symmetric Encryption iterated-salted S2K SHA1 AES256" (testSymmetricEncryption "encryption-sym-aes256.gpg" "symmetric-password.txt" "test\n")    , testCase "Symmetric Encryption simple S2K SHA1 Twofish" (testSymmetricEncryption "encryption-sym-twofish-s2k0.gpg" "symmetric-password.txt" "test\n")    , testCase "Symmetric Encryption iterated-salted S2K SHA1 Twofish" (testSymmetricEncryption "encryption-sym-twofish.gpg" "symmetric-password.txt" "test\n")+   , testCase "Symmetric Encryption simple Camellia128" (testSymmetricEncryption "encryption-sym-camellia128-s2k0.gpg" "symmetric-password.txt" "test\n")+   , testCase "Symmetric Encryption iterated-salted Camellia128" (testSymmetricEncryption "encryption-sym-camellia128.gpg" "symmetric-password.txt" "test\n")+   , testCase "Symmetric Encryption iterated-salted Camellia192" (testSymmetricEncryption "encryption-sym-camellia192.gpg" "symmetric-password.txt" "test\n")+   , testCase "Symmetric Encryption iterated-salted Camellia256" (testSymmetricEncryption "encryption-sym-camellia256.gpg" "symmetric-password.txt" "test\n")    ],   testGroup "Encrypted secret keys" [      testCase "SUSSHA1 CAST5 IteratedSalted SHA1 RSA" (testSecretKeyDecryption "simple.seckey" "pki-password.txt")