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
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)
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
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
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
instance Hashable ECDSA_PrivateKey where
hashWithSalt s (ECDSA_PrivateKey (ECDSA.PrivateKey curve d)) = s `hashWithSalt` show curve `hashWithSalt` show d
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]}
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
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
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
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 = 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)
instance Hashable Pkt
instance Ord Pkt where
compare = comparing pktTag <> comparing hash
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
{ _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
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)