hOpenPGP-3.1: Codec/Encryption/OpenPGP/Types/Internal/Pkt.hs
-- Pkt.hs: OpenPGP (RFC9580) Pkt data types
-- Copyright © 2012-2026 Clint Adams
-- This software is released under the terms of the Expat license.
-- (See the LICENSE file).
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TemplateHaskell #-}
module Codec.Encryption.OpenPGP.Types.Internal.Pkt where
import Control.Lens (makeLenses)
import Data.Aeson (object, (.=))
import qualified Data.Aeson as A
import qualified Data.Aeson.Key as AK
import Data.ByteString.Lazy (ByteString)
import qualified Data.ByteString.Lazy as BL
import Data.Data
( Constr
, Data (..)
, Fixity (Prefix)
, mkConstr
, mkDataType
)
import qualified Data.Data as DD
import Data.Hashable (Hashable (..))
import Data.List.NonEmpty (NonEmpty)
import qualified Data.List.NonEmpty as NE
import Data.Ord (comparing)
import Data.Text (Text)
import Data.Time.Clock (UTCTime)
import Data.Typeable (Typeable)
import Data.Word (Word8)
import GHC.Generics (Generic)
import Prettyprinter (Pretty (..), (<+>))
import Codec.Encryption.OpenPGP.Types.Internal.Base
import Codec.Encryption.OpenPGP.Types.Internal.PKITypes
import Codec.Encryption.OpenPGP.Types.Internal.PrettyUtils
( prettyLBS
)
data PKESKPayloadVersion = PKESKV3 | PKESKV6
deriving (Data, Eq, Generic, Hashable, Ord, Show, Typeable)
data PKESKPayloadV3
= PKESKPayloadV3
PacketVersion
EightOctetKeyId
PubKeyAlgorithm
(NonEmpty MPI)
deriving (Data, Eq, Generic, Hashable, Ord, Show, Typeable)
data PKESKPayloadV6
= PKESKPayloadV6
BL.ByteString
PubKeyAlgorithm
BL.ByteString
deriving (Data, Eq, Generic, Hashable, Ord, Show, Typeable)
data PKESKPayload
= PKESKPayloadV3Packet PKESKPayloadV3
| PKESKPayloadV6Packet PKESKPayloadV6
deriving (Data, Eq, Generic, Hashable, Ord, Show, Typeable)
data SKESKPayloadVersion = SKESKV4 | SKESKV6
deriving (Data, Eq, Generic, Hashable, Ord, Show, Typeable)
data SKESKPayloadV4
= SKESKPayloadV4
SymmetricAlgorithm
S2K
(Maybe BL.ByteString)
deriving (Data, Eq, Generic, Hashable, Ord, Show, Typeable)
data SKESKPayloadV6
= SKESKPayloadV6
SymmetricAlgorithm
AEADAlgorithm
S2K
BL.ByteString
BL.ByteString
BL.ByteString
deriving (Data, Eq, Generic, Hashable, Ord, Show, Typeable)
data SKESKPayload
= SKESKPayloadV4Packet SKESKPayloadV4
| SKESKPayloadV6Packet SKESKPayloadV6
deriving (Data, Eq, Generic, Hashable, Ord, Show, Typeable)
data OnePassSignatureVersion = OPSV3 | OPSV6
deriving (Data, Eq, Generic, Hashable, Ord, Show, Typeable)
data OPSPayloadV3
= OPSPayloadV3
PacketVersion
SigType
HashAlgorithm
PubKeyAlgorithm
EightOctetKeyId
NestedFlag
deriving (Data, Eq, Generic, Hashable, Ord, Show, Typeable)
data OPSPayloadV6
= OPSPayloadV6
SigType
HashAlgorithm
PubKeyAlgorithm
SignatureSalt
BL.ByteString
NestedFlag
deriving (Data, Eq, Generic, Hashable, Ord, Show, Typeable)
data OnePassSignaturePayload
= OPSPayloadV3Packet OPSPayloadV3
| OPSPayloadV6Packet OPSPayloadV6
deriving (Data, Eq, Generic, Hashable, Ord, Show, Typeable)
data SEIPDPayload
= SEIPD1 PacketVersion BL.ByteString
| SEIPD2 SymmetricAlgorithm AEADAlgorithm Word8 Salt BL.ByteString
deriving (Data, Eq, Generic, Hashable, Ord, Show, Typeable)
data KeyPktKind
= PublicPkt
| SecretPkt
deriving (Data, Eq, Generic, Hashable, Ord, Show, Typeable)
data KeyPktRole
= KeyPktPrimary
| KeyPktSubkey
deriving (Data, Eq, Generic, Hashable, Ord, Show, Typeable)
data KeyPkt (k :: KeyPktKind) where
KeyPktPublicPrimary :: SomePKPayload -> KeyPkt 'PublicPkt
KeyPktPublicSubkey :: SomePKPayload -> KeyPkt 'PublicPkt
KeyPktSecretPrimary
:: SomePKPayload -> SKAddendum -> KeyPkt 'SecretPkt
KeyPktSecretSubkey
:: SomePKPayload -> SKAddendum -> KeyPkt 'SecretPkt
deriving instance Eq (KeyPkt k)
deriving instance Show (KeyPkt k)
instance Ord (KeyPkt k) where
compare = comparing keyPktToPkt
instance Hashable (KeyPkt k) where
hashWithSalt s kp = hashWithSalt s (keyPktToPkt kp)
instance Typeable k => Data (KeyPkt k) where
gfoldl f z (KeyPktPublicPrimary pkp) = z KeyPktPublicPrimary `f` pkp
gfoldl f z (KeyPktPublicSubkey pkp) = z KeyPktPublicSubkey `f` pkp
gfoldl f z (KeyPktSecretPrimary pkp ska) = z KeyPktSecretPrimary `f` pkp `f` ska
gfoldl f z (KeyPktSecretSubkey pkp ska) = z KeyPktSecretSubkey `f` pkp `f` ska
toConstr (KeyPktPublicPrimary _) = conKeyPktPublicPrimary
toConstr (KeyPktPublicSubkey _) = conKeyPktPublicSubkey
toConstr (KeyPktSecretPrimary _ _) = conKeyPktSecretPrimary
toConstr (KeyPktSecretSubkey _ _) = conKeyPktSecretSubkey
dataTypeOf _ = tyKeyPkt
gunfold _ _ _ = error "KeyPkt: gunfold not supported for GADT"
tyKeyPkt :: DD.DataType
tyKeyPkt =
mkDataType
"Codec.Encryption.OpenPGP.Types.Internal.Pkt.KeyPkt"
[ conKeyPktPublicPrimary
, conKeyPktPublicSubkey
, conKeyPktSecretPrimary
, conKeyPktSecretSubkey
]
conKeyPktPublicPrimary
, conKeyPktPublicSubkey
, conKeyPktSecretPrimary
, conKeyPktSecretSubkey
:: Constr
conKeyPktPublicPrimary = mkConstr tyKeyPkt "KeyPktPublicPrimary" [] Prefix
conKeyPktPublicSubkey = mkConstr tyKeyPkt "KeyPktPublicSubkey" [] Prefix
conKeyPktSecretPrimary = mkConstr tyKeyPkt "KeyPktSecretPrimary" [] Prefix
conKeyPktSecretSubkey = mkConstr tyKeyPkt "KeyPktSecretSubkey" [] Prefix
data SomeKeyPkt where
SomeKeyPkt :: KeyPkt k -> SomeKeyPkt
deriving instance Show SomeKeyPkt
instance Eq SomeKeyPkt where
SomeKeyPkt left == SomeKeyPkt right =
someKeyPktToPkt (SomeKeyPkt left)
== someKeyPktToPkt (SomeKeyPkt right)
data KeyPktCoercionError
= NotAKeyPacket Pkt
| ExpectedPublicKeyPacket Pkt
| ExpectedSecretKeyPacket Pkt
deriving (Eq, Show)
-- data Pkt = forall a. (Packet a, Show a, Eq a) => Pkt a
data Pkt
= PKESKPkt PKESKPayload
| SignaturePkt SignaturePayload
| SKESKPkt SKESKPayload
| OnePassSignaturePkt OnePassSignaturePayload
| SecretKeyPkt SomePKPayload SKAddendum
| PublicKeyPkt SomePKPayload
| SecretSubkeyPkt SomePKPayload SKAddendum
| CompressedDataPkt CompressionAlgorithm CompressedDataPayload
| SymEncDataPkt ByteString
| MarkerPkt ByteString
| LiteralDataPkt
LiteralDataType
FileName
ThirtyTwoBitTimeStamp
ByteString
| TrustPkt ByteString
| UserIdPkt Text
| PublicSubkeyPkt SomePKPayload
| UserAttributePkt [UserAttrSubPacket]
| SymEncIntegrityProtectedDataPkt SEIPDPayload
| ModificationDetectionCodePkt ByteString
| PaddingPkt ByteString
| OtherPacketPkt Word8 ByteString
| BrokenPacketPkt String Word8 ByteString
deriving (Data, Eq, Generic, Show, Typeable)
data PktWithWireRep
= PktWithWireRep
{ _pktWireRepRef :: WireRepRef
, _pktRange :: ByteRange
, _pktRaw :: ByteString
, _pktIndex :: Int
, _pktValue :: Pkt
}
deriving (Data, Eq, Generic, Show, Typeable)
instance Hashable Pkt
instance Ord Pkt where
compare p1 p2 = comparing pktTag p1 p2 <> compareFields p1 p2
where
compareFields (PKESKPkt pkesk1) (PKESKPkt pkesk2) = compare pkesk1 pkesk2
compareFields (SignaturePkt sp1) (SignaturePkt sp2) = compare sp1 sp2
compareFields (SKESKPkt skesk1) (SKESKPkt skesk2) = compare skesk1 skesk2
compareFields (OnePassSignaturePkt ops1) (OnePassSignaturePkt ops2) = compare ops1 ops2
compareFields (SecretKeyPkt pkp1 ska1) (SecretKeyPkt pkp2 ska2) =
compare pkp1 pkp2 <> compare ska1 ska2
compareFields (PublicKeyPkt pkp1) (PublicKeyPkt pkp2) = compare pkp1 pkp2
compareFields (SecretSubkeyPkt pkp1 ska1) (SecretSubkeyPkt pkp2 ska2) =
compare pkp1 pkp2 <> compare ska1 ska2
compareFields (CompressedDataPkt ca1 cdp1) (CompressedDataPkt ca2 cdp2) =
compare ca1 ca2 <> compare cdp1 cdp2
compareFields (SymEncDataPkt bs1) (SymEncDataPkt bs2) = compare bs1 bs2
compareFields (MarkerPkt bs1) (MarkerPkt bs2) = compare bs1 bs2
compareFields (LiteralDataPkt dt1 fn1 ts1 bs1) (LiteralDataPkt dt2 fn2 ts2 bs2) =
compare dt1 dt2
<> compare fn1 fn2
<> compare ts1 ts2
<> compare bs1 bs2
compareFields (TrustPkt bs1) (TrustPkt bs2) = compare bs1 bs2
compareFields (UserIdPkt u1) (UserIdPkt u2) = compare u1 u2
compareFields (PublicSubkeyPkt pkp1) (PublicSubkeyPkt pkp2) = compare pkp1 pkp2
compareFields (UserAttributePkt us1) (UserAttributePkt us2) = compare us1 us2
compareFields (SymEncIntegrityProtectedDataPkt seipd1) (SymEncIntegrityProtectedDataPkt seipd2) = compare seipd1 seipd2
compareFields (ModificationDetectionCodePkt bs1) (ModificationDetectionCodePkt bs2) = compare bs1 bs2
compareFields (OtherPacketPkt t1 bs1) (OtherPacketPkt t2 bs2) = compare t1 t2 <> compare bs1 bs2
compareFields (BrokenPacketPkt s1 t1 bs1) (BrokenPacketPkt s2 t2 bs2) =
compare s1 s2 <> compare t1 t2 <> compare bs1 bs2
compareFields _ _ = EQ
instance Ord PktWithWireRep where
compare p1 p2 =
comparing _pktValue p1 p2
<> comparing _pktRaw p1 p2
<> comparing _pktWireRepRef p1 p2
<> comparing _pktRange p1 p2
<> comparing _pktIndex p1 p2
wireRepOfPkt :: PktWithWireRep -> WireRepRef
wireRepOfPkt = _pktWireRepRef
packetsFromWireRep
:: WireRepRef -> [PktWithWireRep] -> [PktWithWireRep]
packetsFromWireRep src = filter ((== src) . wireRepOfPkt)
instance Pretty Pkt where
pretty (PKESKPkt (PKESKPayloadV3Packet (PKESKPayloadV3 pv eoki pka mpis))) =
pretty "PKESK v"
<> pretty pv
<> pretty ':'
<+> pretty eoki
<+> pretty pka
<+> (pretty . NE.toList) mpis
pretty
( PKESKPkt
( PKESKPayloadV6Packet
(PKESKPayloadV6 recipientKeyIdentifier pka esk)
)
) =
pretty "PKESK v6:"
<+> pretty "recipient key identifier"
<+> pretty (bsToHexUpper recipientKeyIdentifier)
<+> pretty pka
<+> pretty (bsToHexUpper esk)
pretty (SignaturePkt sp) = pretty sp
pretty (SKESKPkt (SKESKPayloadV4Packet (SKESKPayloadV4 sa s2k mbs))) =
pretty "SKESK v4:"
<+> pretty sa
<+> pretty s2k
<+> pretty (fmap bsToHexUpper mbs)
pretty
( SKESKPkt
(SKESKPayloadV6Packet (SKESKPayloadV6 sa aa s2k iv esk tag))
) =
pretty "SKESK v6:"
<+> pretty sa
<+> pretty aa
<+> pretty s2k
<+> pretty (bsToHexUpper iv)
<+> pretty (bsToHexUpper esk)
<+> pretty (bsToHexUpper tag)
pretty
( OnePassSignaturePkt
(OPSPayloadV3Packet (OPSPayloadV3 pv st ha pka eoki nestedflag))
) =
pretty "one-pass signature v"
<> pretty pv
<> pretty ':'
<+> pretty st
<+> pretty ha
<+> pretty pka
<+> pretty eoki
<+> pretty nestedflag
pretty
( OnePassSignaturePkt
( OPSPayloadV6Packet
(OPSPayloadV6 st ha pka salt signerFingerprint nestedflag)
)
) =
pretty "one-pass signature v6:"
<+> pretty st
<+> pretty ha
<+> pretty pka
<+> pretty salt
<+> pretty (bsToHexUpper signerFingerprint)
<+> pretty nestedflag
pretty (SecretKeyPkt pkp ska) =
pretty "secret key:" <+> pretty pkp <+> pretty ska
pretty (PublicKeyPkt pkp) = pretty "public key:" <+> pretty pkp
pretty (SecretSubkeyPkt pkp ska) =
pretty "secret subkey:" <+> pretty pkp <+> pretty ska
pretty (CompressedDataPkt ca cdp) =
pretty "compressed-data:" <+> pretty ca <+> prettyLBS cdp
pretty (SymEncDataPkt bs) =
pretty "symmetrically-encrypted-data:"
<+> pretty (bsToHexUpper bs)
pretty (MarkerPkt bs) = pretty "marker:" <+> pretty (bsToHexUpper bs)
pretty (LiteralDataPkt dt fn ts bs) =
pretty "literal-data"
<+> pretty dt
<+> prettyLBS fn
<+> pretty ts
<+> pretty (bsToHexUpper bs)
pretty (TrustPkt bs) = pretty "trust:" <+> pretty (BL.unpack bs)
pretty (UserIdPkt u) = pretty "user-ID:" <+> pretty u
pretty (PublicSubkeyPkt pkp) = pretty "public subkey:" <+> pretty pkp
pretty (UserAttributePkt us) = pretty "user-attribute:" <+> pretty us
pretty (SymEncIntegrityProtectedDataPkt (SEIPD1 pv bs)) =
pretty "symmetrically-encrypted-integrity-protected-data v"
<> pretty pv
<> pretty ':'
<+> pretty (bsToHexUpper bs)
pretty (SymEncIntegrityProtectedDataPkt (SEIPD2 sa aa chunkSize salt bs)) =
pretty "symmetrically-encrypted-integrity-protected-data v2:"
<+> pretty sa
<+> pretty aa
<+> pretty chunkSize
<+> pretty salt
<+> pretty (bsToHexUpper bs)
pretty (ModificationDetectionCodePkt bs) =
pretty "MDC:" <+> pretty (bsToHexUpper bs)
pretty (PaddingPkt bs) =
pretty "Padding:" <+> pretty (bsToHexUpper bs)
pretty (OtherPacketPkt t bs) =
pretty "unknown packet type"
<+> pretty t
<> pretty ':'
<+> pretty (bsToHexUpper bs)
pretty (BrokenPacketPkt s t bs) =
pretty "BROKEN packet ("
<> pretty s
<> pretty ')'
<+> pretty t
<> pretty ':'
<+> pretty (bsToHexUpper bs)
instance A.ToJSON Pkt where
toJSON (PKESKPkt (PKESKPayloadV3Packet (PKESKPayloadV3 pv eoki pka mpis))) =
object
[ AK.fromString "pkesk"
.= object
[ AK.fromString "version" .= pv
, AK.fromString "keyid" .= eoki
, AK.fromString "pkalgo" .= pka
, AK.fromString "mpis" .= NE.toList mpis
]
]
toJSON
( PKESKPkt
( PKESKPayloadV6Packet
(PKESKPayloadV6 recipientKeyIdentifier pka esk)
)
) =
object
[ AK.fromString "pkesk"
.= object
[ AK.fromString "version" .= (6 :: PacketVersion)
, AK.fromString "recipient_key_identifier"
.= BL.unpack recipientKeyIdentifier
, AK.fromString "pkalgo" .= pka
, AK.fromString "esk" .= BL.unpack esk
]
]
toJSON (SignaturePkt sp) = object [AK.fromString "signature" .= sp]
toJSON (SKESKPkt (SKESKPayloadV4Packet (SKESKPayloadV4 sa s2k mbs))) =
object
[ AK.fromString "skesk"
.= object
[ AK.fromString "version" .= (4 :: PacketVersion)
, AK.fromString "symalgo" .= sa
, AK.fromString "s2k" .= s2k
, AK.fromString "data" .= maybe mempty BL.unpack mbs
]
]
toJSON
( SKESKPkt
(SKESKPayloadV6Packet (SKESKPayloadV6 sa aa s2k iv esk tag))
) =
object
[ AK.fromString "skesk"
.= object
[ AK.fromString "version" .= (6 :: PacketVersion)
, AK.fromString "symalgo" .= sa
, AK.fromString "aead" .= aa
, AK.fromString "s2k" .= s2k
, AK.fromString "iv" .= BL.unpack iv
, AK.fromString "esk" .= BL.unpack esk
, AK.fromString "tag" .= BL.unpack tag
]
]
toJSON
( OnePassSignaturePkt
(OPSPayloadV3Packet (OPSPayloadV3 pv st ha pka eoki nestedflag))
) =
object
[ AK.fromString "onepasssignature"
.= object
[ AK.fromString "version" .= pv
, AK.fromString "sigtype" .= st
, AK.fromString "hashalgo" .= ha
, AK.fromString "pkalgo" .= pka
, AK.fromString "keyid" .= eoki
, AK.fromString "nested" .= nestedflag
]
]
toJSON
( OnePassSignaturePkt
( OPSPayloadV6Packet
(OPSPayloadV6 st ha pka salt signerFingerprint nestedflag)
)
) =
object
[ AK.fromString "onepasssignature"
.= object
[ AK.fromString "version" .= (6 :: Word8)
, AK.fromString "sigtype" .= st
, AK.fromString "hashalgo" .= ha
, AK.fromString "pkalgo" .= pka
, AK.fromString "salt" .= salt
, AK.fromString "fingerprint" .= BL.unpack signerFingerprint
, AK.fromString "nested" .= nestedflag
]
]
toJSON (SecretKeyPkt pkp ska) =
object
[ AK.fromString "secretkey"
.= object
[AK.fromString "public" .= pkp, AK.fromString "secret" .= ska]
]
toJSON (PublicKeyPkt pkp) = object [AK.fromString "publickey" .= pkp]
toJSON (SecretSubkeyPkt pkp ska) =
object
[ AK.fromString "secretsubkey"
.= object
[AK.fromString "public" .= pkp, AK.fromString "secret" .= ska]
]
toJSON (CompressedDataPkt ca cdp) =
object
[ AK.fromString "compresseddata"
.= object
[ AK.fromString "compressionalgo" .= ca
, AK.fromString "data" .= BL.unpack cdp
]
]
toJSON (SymEncDataPkt bs) = object [AK.fromString "symencdata" .= BL.unpack bs]
toJSON (MarkerPkt bs) = object [AK.fromString "marker" .= BL.unpack bs]
toJSON (LiteralDataPkt dt fn ts bs) =
object
[ AK.fromString "literaldata"
.= object
[ AK.fromString "dt" .= dt
, AK.fromString "filename" .= BL.unpack fn
, AK.fromString "ts" .= ts
, AK.fromString "data" .= BL.unpack bs
]
]
toJSON (TrustPkt bs) = object [AK.fromString "trust" .= BL.unpack bs]
toJSON (UserIdPkt u) = object [AK.fromString "userid" .= u]
toJSON (PublicSubkeyPkt pkp) = object [AK.fromString "publicsubkkey" .= pkp]
toJSON (UserAttributePkt us) = object [AK.fromString "userattribute" .= us]
toJSON (SymEncIntegrityProtectedDataPkt (SEIPD1 pv bs)) =
object
[ AK.fromString "symencipd"
.= object
[ AK.fromString "version" .= pv
, AK.fromString "data" .= BL.unpack bs
]
]
toJSON (SymEncIntegrityProtectedDataPkt (SEIPD2 sa aa chunkSize salt bs)) =
object
[ AK.fromString "symencipd"
.= object
[ AK.fromString "version" .= (2 :: PacketVersion)
, AK.fromString "symalgo" .= sa
, AK.fromString "aeadalgo" .= aa
, AK.fromString "chunksize" .= chunkSize
, AK.fromString "salt" .= salt
, AK.fromString "data" .= BL.unpack bs
]
]
toJSON (ModificationDetectionCodePkt bs) =
object [AK.fromString "mdc" .= BL.unpack bs]
toJSON (PaddingPkt bs) =
object [AK.fromString "padding" .= BL.unpack bs]
toJSON (OtherPacketPkt t bs) =
object
[ AK.fromString "otherpacket"
.= object
[AK.fromString "tag" .= t, AK.fromString "data" .= BL.unpack bs]
]
toJSON (BrokenPacketPkt s t bs) =
object
[ AK.fromString "brokenpacket"
.= object
[ AK.fromString "error" .= s
, AK.fromString "tag" .= t
, AK.fromString "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 (PaddingPkt _) = 21
pktTag (OtherPacketPkt t _) = t
pktTag (BrokenPacketPkt _ t _) = t -- is this the right thing to do?
renderKeyPktCoercionError :: KeyPktCoercionError -> String
renderKeyPktCoercionError (NotAKeyPacket pkt) =
"Expected a key packet, got tag " ++ show (pktTag pkt)
renderKeyPktCoercionError (ExpectedPublicKeyPacket pkt) =
"Expected a public key packet, got tag " ++ show (pktTag pkt)
renderKeyPktCoercionError (ExpectedSecretKeyPacket pkt) =
"Expected a secret key packet, got tag " ++ show (pktTag pkt)
keyPktRole :: KeyPkt k -> KeyPktRole
keyPktRole KeyPktPublicPrimary {} = KeyPktPrimary
keyPktRole KeyPktPublicSubkey {} = KeyPktSubkey
keyPktRole KeyPktSecretPrimary {} = KeyPktPrimary
keyPktRole KeyPktSecretSubkey {} = KeyPktSubkey
keyPktPKPayload :: KeyPkt k -> SomePKPayload
keyPktPKPayload (KeyPktPublicPrimary pkp) = pkp
keyPktPKPayload (KeyPktPublicSubkey pkp) = pkp
keyPktPKPayload (KeyPktSecretPrimary pkp _) = pkp
keyPktPKPayload (KeyPktSecretSubkey pkp _) = pkp
keyPktMaybeSKAddendum :: KeyPkt k -> Maybe SKAddendum
keyPktMaybeSKAddendum KeyPktPublicPrimary {} = Nothing
keyPktMaybeSKAddendum KeyPktPublicSubkey {} = Nothing
keyPktMaybeSKAddendum (KeyPktSecretPrimary _ ska) = Just ska
keyPktMaybeSKAddendum (KeyPktSecretSubkey _ ska) = Just ska
keyPktTKKey :: KeyPkt k -> (SomePKPayload, Maybe SKAddendum)
keyPktTKKey keyPkt = (keyPktPKPayload keyPkt, keyPktMaybeSKAddendum keyPkt)
secretKeyPktSKAddendum :: KeyPkt 'SecretPkt -> SKAddendum
secretKeyPktSKAddendum (KeyPktSecretPrimary _ ska) = ska
secretKeyPktSKAddendum (KeyPktSecretSubkey _ ska) = ska
mkPrimaryKeyPkt
:: SomePKPayload -> Maybe SKAddendum -> SomeKeyPkt
mkPrimaryKeyPkt pkp Nothing = SomeKeyPkt (KeyPktPublicPrimary pkp)
mkPrimaryKeyPkt pkp (Just ska) = SomeKeyPkt (KeyPktSecretPrimary pkp ska)
mkSubkeyKeyPkt :: SomePKPayload -> Maybe SKAddendum -> SomeKeyPkt
mkSubkeyKeyPkt pkp Nothing = SomeKeyPkt (KeyPktPublicSubkey pkp)
mkSubkeyKeyPkt pkp (Just ska) = SomeKeyPkt (KeyPktSecretSubkey pkp ska)
keyPktToPublicView :: KeyPkt 'SecretPkt -> KeyPkt 'PublicPkt
keyPktToPublicView (KeyPktSecretPrimary pkp _) = KeyPktPublicPrimary pkp
keyPktToPublicView (KeyPktSecretSubkey pkp _) = KeyPktPublicSubkey pkp
keyPktToPkt :: KeyPkt k -> Pkt
keyPktToPkt (KeyPktPublicPrimary pkp) = PublicKeyPkt pkp
keyPktToPkt (KeyPktPublicSubkey pkp) = PublicSubkeyPkt pkp
keyPktToPkt (KeyPktSecretPrimary pkp ska) = SecretKeyPkt pkp ska
keyPktToPkt (KeyPktSecretSubkey pkp ska) = SecretSubkeyPkt pkp ska
someKeyPktToPkt :: SomeKeyPkt -> Pkt
someKeyPktToPkt (SomeKeyPkt keyPkt) = keyPktToPkt keyPkt
pktToSomeKeyPktEither
:: Pkt -> Either KeyPktCoercionError SomeKeyPkt
pktToSomeKeyPktEither (PublicKeyPkt pkp) = Right (SomeKeyPkt (KeyPktPublicPrimary pkp))
pktToSomeKeyPktEither (PublicSubkeyPkt pkp) = Right (SomeKeyPkt (KeyPktPublicSubkey pkp))
pktToSomeKeyPktEither (SecretKeyPkt pkp ska) = Right (SomeKeyPkt (KeyPktSecretPrimary pkp ska))
pktToSomeKeyPktEither (SecretSubkeyPkt pkp ska) = Right (SomeKeyPkt (KeyPktSecretSubkey pkp ska))
pktToSomeKeyPktEither pkt = Left (NotAKeyPacket pkt)
pktToSomeKeyPkt :: Pkt -> Maybe SomeKeyPkt
pktToSomeKeyPkt = either (const Nothing) Just . pktToSomeKeyPktEither
pktToPublicKeyPktEither
:: Pkt -> Either KeyPktCoercionError (KeyPkt 'PublicPkt)
pktToPublicKeyPktEither (PublicKeyPkt pkp) = Right (KeyPktPublicPrimary pkp)
pktToPublicKeyPktEither (PublicSubkeyPkt pkp) = Right (KeyPktPublicSubkey pkp)
pktToPublicKeyPktEither pkt = Left (ExpectedPublicKeyPacket pkt)
pktToPublicKeyPkt :: Pkt -> Maybe (KeyPkt 'PublicPkt)
pktToPublicKeyPkt = either (const Nothing) Just . pktToPublicKeyPktEither
pktToSecretKeyPktEither
:: Pkt -> Either KeyPktCoercionError (KeyPkt 'SecretPkt)
pktToSecretKeyPktEither (SecretKeyPkt pkp ska) = Right (KeyPktSecretPrimary pkp ska)
pktToSecretKeyPktEither (SecretSubkeyPkt pkp ska) = Right (KeyPktSecretSubkey pkp ska)
pktToSecretKeyPktEither pkt = Left (ExpectedSecretKeyPacket pkt)
pktToSecretKeyPkt :: Pkt -> Maybe (KeyPkt 'SecretPkt)
pktToSecretKeyPkt = either (const Nothing) Just . pktToSecretKeyPktEither
{- | Convert secret key/subkey packets to their public-key packet forms.
Non-secret packets are returned unchanged.
-}
publicKeyPacketOf :: Pkt -> Pkt
publicKeyPacketOf pkt =
maybe
pkt
(keyPktToPkt . keyPktToPublicView)
(pktToSecretKeyPkt pkt)
data Verification
= Verification
{ _verificationSigner :: SomePKPayload
, _verificationSignature :: SignaturePayload
, _verificationWarnings :: [VerificationWarning]
}
data VerificationWarning
= MissingSubkeyBackSignatureWarning
| DeprecatedHashAlgorithmWarning HashAlgorithm
| UnsupportedHashAlgorithmWarning HashAlgorithm
| PkaMismatchWarning PubKeyAlgorithm PubKeyAlgorithm
| UnsupportedCriticalSubpacketWarning SigType
| LegacyIssuerKeyIdInV6Warning
| InvalidSignatureContextWarning SigType
| ExpiredSignatureWarning
deriving (Eq, Show)
data SOPVVerification
= SOPVVerification
{ _sopvvDateStamp :: UTCTime
, _sopvvFingerprint :: Fingerprint
, _sopvvPrimaryFingerprint :: Fingerprint
, _sopvvMode :: String
, _sopvvDescription :: String
}
$(makeLenses ''Verification)
$(makeLenses ''SOPVVerification)
$(makeLenses ''PktWithWireRep)