hOpenPGP 2.4.1 → 2.4.2
raw patch · 21 files changed
+1780/−1667 lines, 21 filesbinary-added
Files
- Codec/Encryption/OpenPGP/Arbitrary.hs +15/−1
- Codec/Encryption/OpenPGP/BlockCipher.hs +7/−1
- Codec/Encryption/OpenPGP/CFB.hs +10/−16
- Codec/Encryption/OpenPGP/Internal.hs +2/−2
- Codec/Encryption/OpenPGP/KeySelection.hs +6/−2
- Codec/Encryption/OpenPGP/KeyringParser.hs +13/−3
- Codec/Encryption/OpenPGP/S2K.hs +9/−10
- Codec/Encryption/OpenPGP/SecretKey.hs +1/−1
- Codec/Encryption/OpenPGP/Serialize.hs +19/−11
- Codec/Encryption/OpenPGP/SerializeForSigs.hs +1/−1
- Codec/Encryption/OpenPGP/Signatures.hs +5/−1
- Codec/Encryption/OpenPGP/Types.hs +7/−1609
- Codec/Encryption/OpenPGP/Types/Internal/Base.hs +1320/−0
- Codec/Encryption/OpenPGP/Types/Internal/PacketClass.hs +341/−0
- bench/mark.hs +6/−6
- hOpenPGP.cabal +9/−3
- tests/data/encryption-sym-camellia128-s2k0.gpg binary
- tests/data/encryption-sym-camellia128.gpg +2/−0
- tests/data/encryption-sym-camellia192.gpg +3/−0
- tests/data/encryption-sym-camellia256.gpg binary
- tests/suite.hs +4/−0
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")