-- KeyringParser.hs: OpenPGP (RFC9580) transferable keys parsing
-- Copyright © 2012-2026  Clint Adams
-- This software is released under the terms of the Expat license.
-- (See the LICENSE file).
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE LambdaCase #-}

module Codec.Encryption.OpenPGP.KeyringParser
    ( -- * Parsers
      parseAChunk
    , parseAChunkEither
    , finalizeParsing
    , finalizeParsingEither
    , KeyringChunkParseError (..)
    , anyTK
    , anyTKWithWireRep
    , UidOrUat (..)
    , splitUs
    , publicTK
    , publicTKWithWireRep
    , secretTK
    , secretTKWithWireRep
    , brokenTK
    , brokenTKWithWireRep
    , pkPayload
    , pkPayloadWithWireRep
    , signature
    , signatureWithWireRep
    , signedUID
    , signedUIDWithWireRep
    , signedUAt
    , signedUAtWithWireRep
    , signedOrRevokedPubSubkey
    , signedOrRevokedPubSubkeyWithWireRep
    , brokenPubSubkey
    , brokenPubSubkeyWithWireRep
    , rawOrSignedOrRevokedSecSubkey
    , rawOrSignedOrRevokedSecSubkeyWithWireRep
    , brokenSecSubkey
    , brokenSecSubkeyWithWireRep
    , skPayload
    , skPayloadWithWireRep
    , broken
    , brokenWithWireRep

      -- * Utilities
    , parseUnknownTKs
    , parseTKsEither
    , parseTKs
    , parsePublicTKs
    , parseSecretTKs
    , parseTKsWithWireRep
    ) where

import Control.Applicative (many, (<|>))
import Control.Lens ((^.))
import Data.Either (rights)
import qualified Data.List.NonEmpty as NE
import Data.Maybe (catMaybes, mapMaybe)
import Data.Text (Text)
import Text.ParserCombinators.Incremental.LeftBiasedLocal
    ( Parser
    , concatMany
    , failure
    , feed
    , feedEof
    , inspect
    , satisfy
    )

import Codec.Encryption.OpenPGP.Ontology (isTrustPkt)
import Codec.Encryption.OpenPGP.Policy
    ( isAllowedPrimaryKeySigType
    , isAllowedSubkeySigType
    , isAllowedUIDSigType
    )
import Codec.Encryption.OpenPGP.SignatureQualities (sigType)
import Codec.Encryption.OpenPGP.Types
import Data.Conduit.OpenPGP.Keyring.Instances ()

data KeyringChunkParseError
    = ChunkFailureBeforeInput String
    | ChunkUnexpectedFinalizationFailure
    | ChunkParserFailure String
    deriving (KeyringChunkParseError -> KeyringChunkParseError -> Bool
(KeyringChunkParseError -> KeyringChunkParseError -> Bool)
-> (KeyringChunkParseError -> KeyringChunkParseError -> Bool)
-> Eq KeyringChunkParseError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: KeyringChunkParseError -> KeyringChunkParseError -> Bool
== :: KeyringChunkParseError -> KeyringChunkParseError -> Bool
$c/= :: KeyringChunkParseError -> KeyringChunkParseError -> Bool
/= :: KeyringChunkParseError -> KeyringChunkParseError -> Bool
Eq, Int -> KeyringChunkParseError -> ShowS
[KeyringChunkParseError] -> ShowS
KeyringChunkParseError -> String
(Int -> KeyringChunkParseError -> ShowS)
-> (KeyringChunkParseError -> String)
-> ([KeyringChunkParseError] -> ShowS)
-> Show KeyringChunkParseError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> KeyringChunkParseError -> ShowS
showsPrec :: Int -> KeyringChunkParseError -> ShowS
$cshow :: KeyringChunkParseError -> String
show :: KeyringChunkParseError -> String
$cshowList :: [KeyringChunkParseError] -> ShowS
showList :: [KeyringChunkParseError] -> ShowS
Show)

renderChunkParseError :: KeyringChunkParseError -> String
renderChunkParseError :: KeyringChunkParseError -> String
renderChunkParseError (ChunkFailureBeforeInput String
msg) = String
msg
renderChunkParseError KeyringChunkParseError
ChunkUnexpectedFinalizationFailure =
    String
"Unexpected finalization failure"
renderChunkParseError (ChunkParserFailure String
msg) = String
msg

collapseCompleted
    :: Monoid s
    => [(r, s)]
    -> ([r], s)
collapseCompleted :: forall s r. Monoid s => [(r, s)] -> ([r], s)
collapseCompleted [(r, s)]
rs =
    let ([r]
resultsRev, s
remainder) =
            (([r], s) -> (r, s) -> ([r], s))
-> ([r], s) -> [(r, s)] -> ([r], s)
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl'
                ( \([r]
accResults, s
accRemainder) (r
result, s
rest) ->
                    (r
result r -> [r] -> [r]
forall a. a -> [a] -> [a]
: [r]
accResults, s
accRemainder s -> s -> s
forall a. Semigroup a => a -> a -> a
<> s
rest)
                )
                ([], s
forall a. Monoid a => a
mempty)
                [(r, s)]
rs
     in ([r] -> [r]
forall a. [a] -> [a]
reverse [r]
resultsRev, s
remainder)

parseAChunk
    :: (Monoid s, Show s)
    => Parser s r
    -> s
    -> ([(r, s)], Maybe (Maybe (r -> r), Parser s r))
    -> (([(r, s)], Maybe (Maybe (r -> r), Parser s r)), [r])
parseAChunk :: forall s r.
(Monoid s, Show s) =>
Parser s r
-> s
-> ([(r, s)], Maybe (Maybe (r -> r), Parser s r))
-> (([(r, s)], Maybe (Maybe (r -> r), Parser s r)), [r])
parseAChunk Parser s r
op s
a ([(r, s)], Maybe (Maybe (r -> r), Parser s r))
st =
    (KeyringChunkParseError
 -> (([(r, s)], Maybe (Maybe (r -> r), Parser s r)), [r]))
-> ((([(r, s)], Maybe (Maybe (r -> r), Parser s r)), [r])
    -> (([(r, s)], Maybe (Maybe (r -> r), Parser s r)), [r]))
-> Either
     KeyringChunkParseError
     (([(r, s)], Maybe (Maybe (r -> r), Parser s r)), [r])
-> (([(r, s)], Maybe (Maybe (r -> r), Parser s r)), [r])
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
        (String -> (([(r, s)], Maybe (Maybe (r -> r), Parser s r)), [r])
forall a. HasCallStack => String -> a
error (String -> (([(r, s)], Maybe (Maybe (r -> r), Parser s r)), [r]))
-> (KeyringChunkParseError -> String)
-> KeyringChunkParseError
-> (([(r, s)], Maybe (Maybe (r -> r), Parser s r)), [r])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KeyringChunkParseError -> String
renderChunkParseError)
        (([(r, s)], Maybe (Maybe (r -> r), Parser s r)), [r])
-> (([(r, s)], Maybe (Maybe (r -> r), Parser s r)), [r])
forall a. a -> a
id
        (Parser s r
-> s
-> ([(r, s)], Maybe (Maybe (r -> r), Parser s r))
-> Either
     KeyringChunkParseError
     (([(r, s)], Maybe (Maybe (r -> r), Parser s r)), [r])
forall s r.
(Monoid s, Show s) =>
Parser s r
-> s
-> ([(r, s)], Maybe (Maybe (r -> r), Parser s r))
-> Either
     KeyringChunkParseError
     (([(r, s)], Maybe (Maybe (r -> r), Parser s r)), [r])
parseAChunkEither Parser s r
op s
a ([(r, s)], Maybe (Maybe (r -> r), Parser s r))
st)

parseAChunkEither
    :: (Monoid s, Show s)
    => Parser s r
    -> s
    -> ([(r, s)], Maybe (Maybe (r -> r), Parser s r))
    -> Either
        KeyringChunkParseError
        (([(r, s)], Maybe (Maybe (r -> r), Parser s r)), [r])
parseAChunkEither :: forall s r.
(Monoid s, Show s) =>
Parser s r
-> s
-> ([(r, s)], Maybe (Maybe (r -> r), Parser s r))
-> Either
     KeyringChunkParseError
     (([(r, s)], Maybe (Maybe (r -> r), Parser s r)), [r])
parseAChunkEither Parser s r
_ s
a ([], Maybe (Maybe (r -> r), Parser s r)
Nothing) =
    KeyringChunkParseError
-> Either
     KeyringChunkParseError
     (([(r, s)], Maybe (Maybe (r -> r), Parser s r)), [r])
forall a b. a -> Either a b
Left (String -> KeyringChunkParseError
ChunkFailureBeforeInput (String
"Failure before " String -> ShowS
forall a. [a] -> [a] -> [a]
++ s -> String
forall a. Show a => a -> String
show s
a))
parseAChunkEither Parser s r
op s
a ([(r, s)]
cr, Maybe (Maybe (r -> r), Parser s r)
Nothing) =
    let ([r]
completed, s
remainder) = [(r, s)] -> ([r], s)
forall s r. Monoid s => [(r, s)] -> ([r], s)
collapseCompleted [(r, s)]
cr
     in (\([(r, s)], Maybe (Maybe (r -> r), Parser s r))
x -> (([(r, s)], Maybe (Maybe (r -> r), Parser s r))
x, [r]
completed))
            (([(r, s)], Maybe (Maybe (r -> r), Parser s r))
 -> (([(r, s)], Maybe (Maybe (r -> r), Parser s r)), [r]))
-> Either
     KeyringChunkParseError
     ([(r, s)], Maybe (Maybe (r -> r), Parser s r))
-> Either
     KeyringChunkParseError
     (([(r, s)], Maybe (Maybe (r -> r), Parser s r)), [r])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String
 -> Either
      KeyringChunkParseError
      ([(r, s)], Maybe (Maybe (r -> r), Parser s r)))
-> (([(r, s)], Maybe (Maybe (r -> r), Parser s r))
    -> Either
         KeyringChunkParseError
         ([(r, s)], Maybe (Maybe (r -> r), Parser s r)))
-> Either String ([(r, s)], Maybe (Maybe (r -> r), Parser s r))
-> Either
     KeyringChunkParseError
     ([(r, s)], Maybe (Maybe (r -> r), Parser s r))
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
                (KeyringChunkParseError
-> Either
     KeyringChunkParseError
     ([(r, s)], Maybe (Maybe (r -> r), Parser s r))
forall a b. a -> Either a b
Left (KeyringChunkParseError
 -> Either
      KeyringChunkParseError
      ([(r, s)], Maybe (Maybe (r -> r), Parser s r)))
-> (String -> KeyringChunkParseError)
-> String
-> Either
     KeyringChunkParseError
     ([(r, s)], Maybe (Maybe (r -> r), Parser s r))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> KeyringChunkParseError
ChunkParserFailure)
                ([(r, s)], Maybe (Maybe (r -> r), Parser s r))
-> Either
     KeyringChunkParseError
     ([(r, s)], Maybe (Maybe (r -> r), Parser s r))
forall a b. b -> Either a b
Right
                (Parser s r
-> Either String ([(r, s)], Maybe (Maybe (r -> r), Parser s r))
forall t s r.
Parser t s r
-> Either String ([(r, s)], Maybe (Maybe (r -> r), Parser t s r))
inspect (s -> Parser s r -> Parser s r
forall s t r. Monoid s => s -> Parser t s r -> Parser t s r
feed (s
remainder s -> s -> s
forall a. Semigroup a => a -> a -> a
<> s
a) Parser s r
op))
parseAChunkEither Parser s r
_ s
a ([(r, s)]
_, Just (Maybe (r -> r)
_, Parser s r
p)) =
    (\([(r, s)], Maybe (Maybe (r -> r), Parser s r))
x -> (([(r, s)], Maybe (Maybe (r -> r), Parser s r))
x, []))
        (([(r, s)], Maybe (Maybe (r -> r), Parser s r))
 -> (([(r, s)], Maybe (Maybe (r -> r), Parser s r)), [r]))
-> Either
     KeyringChunkParseError
     ([(r, s)], Maybe (Maybe (r -> r), Parser s r))
-> Either
     KeyringChunkParseError
     (([(r, s)], Maybe (Maybe (r -> r), Parser s r)), [r])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String
 -> Either
      KeyringChunkParseError
      ([(r, s)], Maybe (Maybe (r -> r), Parser s r)))
-> (([(r, s)], Maybe (Maybe (r -> r), Parser s r))
    -> Either
         KeyringChunkParseError
         ([(r, s)], Maybe (Maybe (r -> r), Parser s r)))
-> Either String ([(r, s)], Maybe (Maybe (r -> r), Parser s r))
-> Either
     KeyringChunkParseError
     ([(r, s)], Maybe (Maybe (r -> r), Parser s r))
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (KeyringChunkParseError
-> Either
     KeyringChunkParseError
     ([(r, s)], Maybe (Maybe (r -> r), Parser s r))
forall a b. a -> Either a b
Left (KeyringChunkParseError
 -> Either
      KeyringChunkParseError
      ([(r, s)], Maybe (Maybe (r -> r), Parser s r)))
-> (String -> KeyringChunkParseError)
-> String
-> Either
     KeyringChunkParseError
     ([(r, s)], Maybe (Maybe (r -> r), Parser s r))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> KeyringChunkParseError
ChunkParserFailure) ([(r, s)], Maybe (Maybe (r -> r), Parser s r))
-> Either
     KeyringChunkParseError
     ([(r, s)], Maybe (Maybe (r -> r), Parser s r))
forall a b. b -> Either a b
Right (Parser s r
-> Either String ([(r, s)], Maybe (Maybe (r -> r), Parser s r))
forall t s r.
Parser t s r
-> Either String ([(r, s)], Maybe (Maybe (r -> r), Parser t s r))
inspect (s -> Parser s r -> Parser s r
forall s t r. Monoid s => s -> Parser t s r -> Parser t s r
feed s
a Parser s r
p))

finalizeParsing
    :: Monoid s
    => ([(r, s)], Maybe (Maybe (r -> r), Parser s r))
    -> (([(r, s)], Maybe (Maybe (r -> r), Parser s r)), [r])
finalizeParsing :: forall s r.
Monoid s =>
([(r, s)], Maybe (Maybe (r -> r), Parser s r))
-> (([(r, s)], Maybe (Maybe (r -> r), Parser s r)), [r])
finalizeParsing ([(r, s)], Maybe (Maybe (r -> r), Parser s r))
st =
    (KeyringChunkParseError
 -> (([(r, s)], Maybe (Maybe (r -> r), Parser s r)), [r]))
-> ((([(r, s)], Maybe (Maybe (r -> r), Parser s r)), [r])
    -> (([(r, s)], Maybe (Maybe (r -> r), Parser s r)), [r]))
-> Either
     KeyringChunkParseError
     (([(r, s)], Maybe (Maybe (r -> r), Parser s r)), [r])
-> (([(r, s)], Maybe (Maybe (r -> r), Parser s r)), [r])
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
        (String -> (([(r, s)], Maybe (Maybe (r -> r), Parser s r)), [r])
forall a. HasCallStack => String -> a
error (String -> (([(r, s)], Maybe (Maybe (r -> r), Parser s r)), [r]))
-> (KeyringChunkParseError -> String)
-> KeyringChunkParseError
-> (([(r, s)], Maybe (Maybe (r -> r), Parser s r)), [r])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KeyringChunkParseError -> String
renderChunkParseError)
        (([(r, s)], Maybe (Maybe (r -> r), Parser s r)), [r])
-> (([(r, s)], Maybe (Maybe (r -> r), Parser s r)), [r])
forall a. a -> a
id
        (([(r, s)], Maybe (Maybe (r -> r), Parser s r))
-> Either
     KeyringChunkParseError
     (([(r, s)], Maybe (Maybe (r -> r), Parser s r)), [r])
forall s r.
Monoid s =>
([(r, s)], Maybe (Maybe (r -> r), Parser s r))
-> Either
     KeyringChunkParseError
     (([(r, s)], Maybe (Maybe (r -> r), Parser s r)), [r])
finalizeParsingEither ([(r, s)], Maybe (Maybe (r -> r), Parser s r))
st)

finalizeParsingEither
    :: Monoid s
    => ([(r, s)], Maybe (Maybe (r -> r), Parser s r))
    -> Either
        KeyringChunkParseError
        (([(r, s)], Maybe (Maybe (r -> r), Parser s r)), [r])
finalizeParsingEither :: forall s r.
Monoid s =>
([(r, s)], Maybe (Maybe (r -> r), Parser s r))
-> Either
     KeyringChunkParseError
     (([(r, s)], Maybe (Maybe (r -> r), Parser s r)), [r])
finalizeParsingEither ([], Maybe (Maybe (r -> r), Parser s r)
Nothing) = KeyringChunkParseError
-> Either
     KeyringChunkParseError
     (([(r, s)], Maybe (Maybe (r -> r), Parser s r)), [r])
forall a b. a -> Either a b
Left KeyringChunkParseError
ChunkUnexpectedFinalizationFailure
finalizeParsingEither ([(r, s)]
cr, Maybe (Maybe (r -> r), Parser s r)
Nothing) =
    let ([r]
completed, s
_) = [(r, s)] -> ([r], s)
forall s r. Monoid s => [(r, s)] -> ([r], s)
collapseCompleted [(r, s)]
cr
     in (([(r, s)], Maybe (Maybe (r -> r), Parser s r)), [r])
-> Either
     KeyringChunkParseError
     (([(r, s)], Maybe (Maybe (r -> r), Parser s r)), [r])
forall a b. b -> Either a b
Right (([], Maybe (Maybe (r -> r), Parser s r)
forall a. Maybe a
Nothing), [r]
completed)
finalizeParsingEither ([(r, s)]
_, Just (Maybe (r -> r)
_, Parser s r
p)) =
    (String
 -> Either
      KeyringChunkParseError
      (([(r, s)], Maybe (Maybe (r -> r), Parser s r)), [r]))
-> (([(r, s)], Maybe (Maybe (r -> r), Parser s r))
    -> Either
         KeyringChunkParseError
         (([(r, s)], Maybe (Maybe (r -> r), Parser s r)), [r]))
-> Either String ([(r, s)], Maybe (Maybe (r -> r), Parser s r))
-> Either
     KeyringChunkParseError
     (([(r, s)], Maybe (Maybe (r -> r), Parser s r)), [r])
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
        (KeyringChunkParseError
-> Either
     KeyringChunkParseError
     (([(r, s)], Maybe (Maybe (r -> r), Parser s r)), [r])
forall a b. a -> Either a b
Left (KeyringChunkParseError
 -> Either
      KeyringChunkParseError
      (([(r, s)], Maybe (Maybe (r -> r), Parser s r)), [r]))
-> (String -> KeyringChunkParseError)
-> String
-> Either
     KeyringChunkParseError
     (([(r, s)], Maybe (Maybe (r -> r), Parser s r)), [r])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> KeyringChunkParseError
ChunkParserFailure)
        ([(r, s)], Maybe (Maybe (r -> r), Parser s r))
-> Either
     KeyringChunkParseError
     (([(r, s)], Maybe (Maybe (r -> r), Parser s r)), [r])
forall s r.
Monoid s =>
([(r, s)], Maybe (Maybe (r -> r), Parser s r))
-> Either
     KeyringChunkParseError
     (([(r, s)], Maybe (Maybe (r -> r), Parser s r)), [r])
finalizeParsingEither
        (Parser s r
-> Either String ([(r, s)], Maybe (Maybe (r -> r), Parser s r))
forall t s r.
Parser t s r
-> Either String ([(r, s)], Maybe (Maybe (r -> r), Parser t s r))
inspect (Parser s r -> Parser s r
forall s t r. Monoid s => Parser t s r -> Parser t s r
feedEof Parser s r
p))

anyTK :: Bool -> Parser [Pkt] (Maybe TKUnknown)
anyTK :: Bool -> Parser [Pkt] (Maybe TKUnknown)
anyTK Bool
True = Bool -> Parser [Pkt] (Maybe TKUnknown)
publicTK Bool
True Parser [Pkt] (Maybe TKUnknown)
-> Parser [Pkt] (Maybe TKUnknown) -> Parser [Pkt] (Maybe TKUnknown)
forall a.
Parser LeftBiasedLocal [Pkt] a
-> Parser LeftBiasedLocal [Pkt] a -> Parser LeftBiasedLocal [Pkt] a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Bool -> Parser [Pkt] (Maybe TKUnknown)
secretTK Bool
True
anyTK Bool
False =
    Bool -> Parser [Pkt] (Maybe TKUnknown)
publicTK Bool
False Parser [Pkt] (Maybe TKUnknown)
-> Parser [Pkt] (Maybe TKUnknown) -> Parser [Pkt] (Maybe TKUnknown)
forall a.
Parser LeftBiasedLocal [Pkt] a
-> Parser LeftBiasedLocal [Pkt] a -> Parser LeftBiasedLocal [Pkt] a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Bool -> Parser [Pkt] (Maybe TKUnknown)
secretTK Bool
False Parser [Pkt] (Maybe TKUnknown)
-> Parser [Pkt] (Maybe TKUnknown) -> Parser [Pkt] (Maybe TKUnknown)
forall a.
Parser LeftBiasedLocal [Pkt] a
-> Parser LeftBiasedLocal [Pkt] a -> Parser LeftBiasedLocal [Pkt] a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Int -> Parser [Pkt] (Maybe TKUnknown)
brokenTK Int
6 Parser [Pkt] (Maybe TKUnknown)
-> Parser [Pkt] (Maybe TKUnknown) -> Parser [Pkt] (Maybe TKUnknown)
forall a.
Parser LeftBiasedLocal [Pkt] a
-> Parser LeftBiasedLocal [Pkt] a -> Parser LeftBiasedLocal [Pkt] a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Int -> Parser [Pkt] (Maybe TKUnknown)
brokenTK Int
5

data UidOrUat
    = I Text
    | A [UserAttrSubPacket]
    deriving (Int -> UidOrUat -> ShowS
[UidOrUat] -> ShowS
UidOrUat -> String
(Int -> UidOrUat -> ShowS)
-> (UidOrUat -> String) -> ([UidOrUat] -> ShowS) -> Show UidOrUat
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UidOrUat -> ShowS
showsPrec :: Int -> UidOrUat -> ShowS
$cshow :: UidOrUat -> String
show :: UidOrUat -> String
$cshowList :: [UidOrUat] -> ShowS
showList :: [UidOrUat] -> ShowS
Show)

splitUs
    :: [(UidOrUat, [SignaturePayload])]
    -> ( [(Text, [SignaturePayload])]
       , [([UserAttrSubPacket], [SignaturePayload])]
       )
splitUs :: [(UidOrUat, [SignaturePayload])]
-> ([(Text, [SignaturePayload])],
    [([UserAttrSubPacket], [SignaturePayload])])
splitUs [(UidOrUat, [SignaturePayload])]
us = ([(Text, [SignaturePayload])]
is, [([UserAttrSubPacket], [SignaturePayload])]
as)
  where
    is :: [(Text, [SignaturePayload])]
is = ((UidOrUat, [SignaturePayload]) -> (Text, [SignaturePayload]))
-> [(UidOrUat, [SignaturePayload])] -> [(Text, [SignaturePayload])]
forall a b. (a -> b) -> [a] -> [b]
map (UidOrUat, [SignaturePayload]) -> (Text, [SignaturePayload])
forall {b}. Show b => (UidOrUat, b) -> (Text, b)
unI (((UidOrUat, [SignaturePayload]) -> Bool)
-> [(UidOrUat, [SignaturePayload])]
-> [(UidOrUat, [SignaturePayload])]
forall a. (a -> Bool) -> [a] -> [a]
filter (UidOrUat, [SignaturePayload]) -> Bool
forall {b}. (UidOrUat, b) -> Bool
isI [(UidOrUat, [SignaturePayload])]
us)
    as :: [([UserAttrSubPacket], [SignaturePayload])]
as = ((UidOrUat, [SignaturePayload])
 -> ([UserAttrSubPacket], [SignaturePayload]))
-> [(UidOrUat, [SignaturePayload])]
-> [([UserAttrSubPacket], [SignaturePayload])]
forall a b. (a -> b) -> [a] -> [b]
map (UidOrUat, [SignaturePayload])
-> ([UserAttrSubPacket], [SignaturePayload])
forall {b}. Show b => (UidOrUat, b) -> ([UserAttrSubPacket], b)
unA (((UidOrUat, [SignaturePayload]) -> Bool)
-> [(UidOrUat, [SignaturePayload])]
-> [(UidOrUat, [SignaturePayload])]
forall a. (a -> Bool) -> [a] -> [a]
filter (UidOrUat, [SignaturePayload]) -> Bool
forall {b}. (UidOrUat, b) -> Bool
isA [(UidOrUat, [SignaturePayload])]
us)
    isI :: (UidOrUat, b) -> Bool
isI (I Text
_, b
_) = Bool
True
    isI (UidOrUat, b)
_ = Bool
False
    isA :: (UidOrUat, b) -> Bool
isA (A [UserAttrSubPacket]
_, b
_) = Bool
True
    isA (UidOrUat, b)
_ = Bool
False
    unI :: (UidOrUat, b) -> (Text, b)
unI (I Text
x, b
y) = (Text
x, b
y)
    unI (UidOrUat, b)
x = String -> (Text, b)
forall a. HasCallStack => String -> a
error (String -> (Text, b)) -> String -> (Text, b)
forall a b. (a -> b) -> a -> b
$ String
"unI should never be called on " String -> ShowS
forall a. [a] -> [a] -> [a]
++ (UidOrUat, b) -> String
forall a. Show a => a -> String
show (UidOrUat, b)
x
    unA :: (UidOrUat, b) -> ([UserAttrSubPacket], b)
unA (A [UserAttrSubPacket]
x, b
y) = ([UserAttrSubPacket]
x, b
y)
    unA (UidOrUat, b)
x = String -> ([UserAttrSubPacket], b)
forall a. HasCallStack => String -> a
error (String -> ([UserAttrSubPacket], b))
-> String -> ([UserAttrSubPacket], b)
forall a b. (a -> b) -> a -> b
$ String
"unA should never be called on " String -> ShowS
forall a. [a] -> [a] -> [a]
++ (UidOrUat, b) -> String
forall a. Show a => a -> String
show (UidOrUat, b)
x

publicTK, secretTK :: Bool -> Parser [Pkt] (Maybe TKUnknown)
publicTK :: Bool -> Parser [Pkt] (Maybe TKUnknown)
publicTK Bool
intolerant = do
    pkp <- Parser [Pkt] (SomePKPayload, Maybe SKAddendum)
pkPayload
    pkpsigs <-
        concatMany
            (signatureWithPredicate intolerant isAllowedPrimaryKeySigType)
    (uids, uats) <-
        fmap
            splitUs
            (many (signedUID intolerant <|> signedUAt intolerant))
    subs <- concatMany (pubsub intolerant)
    return $ Just (TKUnknown pkp pkpsigs uids uats subs)
  where
    pubsub :: Bool -> Parser LeftBiasedLocal [Pkt] [(Pkt, [SignaturePayload])]
pubsub Bool
True = Bool -> Parser LeftBiasedLocal [Pkt] [(Pkt, [SignaturePayload])]
signedOrRevokedPubSubkey Bool
True
    pubsub Bool
False = Bool -> Parser LeftBiasedLocal [Pkt] [(Pkt, [SignaturePayload])]
signedOrRevokedPubSubkey Bool
False Parser LeftBiasedLocal [Pkt] [(Pkt, [SignaturePayload])]
-> Parser LeftBiasedLocal [Pkt] [(Pkt, [SignaturePayload])]
-> Parser LeftBiasedLocal [Pkt] [(Pkt, [SignaturePayload])]
forall a.
Parser LeftBiasedLocal [Pkt] a
-> Parser LeftBiasedLocal [Pkt] a -> Parser LeftBiasedLocal [Pkt] a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser LeftBiasedLocal [Pkt] [(Pkt, [SignaturePayload])]
brokenPubSubkey
secretTK :: Bool -> Parser [Pkt] (Maybe TKUnknown)
secretTK Bool
intolerant = do
    skp <- Parser [Pkt] (SomePKPayload, Maybe SKAddendum)
skPayload
    skpsigs <-
        concatMany
            (signatureWithPredicate intolerant isAllowedPrimaryKeySigType)
    (uids, uats) <-
        fmap
            splitUs
            (many (signedUID intolerant <|> signedUAt intolerant))
    subs <- concatMany (secsub intolerant)
    return $ Just (TKUnknown skp skpsigs uids uats subs)
  where
    secsub :: Bool -> Parser LeftBiasedLocal [Pkt] [(Pkt, [SignaturePayload])]
secsub Bool
True = Bool -> Parser LeftBiasedLocal [Pkt] [(Pkt, [SignaturePayload])]
rawOrSignedOrRevokedSecSubkey Bool
True
    secsub Bool
False = Bool -> Parser LeftBiasedLocal [Pkt] [(Pkt, [SignaturePayload])]
rawOrSignedOrRevokedSecSubkey Bool
False Parser LeftBiasedLocal [Pkt] [(Pkt, [SignaturePayload])]
-> Parser LeftBiasedLocal [Pkt] [(Pkt, [SignaturePayload])]
-> Parser LeftBiasedLocal [Pkt] [(Pkt, [SignaturePayload])]
forall a.
Parser LeftBiasedLocal [Pkt] a
-> Parser LeftBiasedLocal [Pkt] a -> Parser LeftBiasedLocal [Pkt] a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser LeftBiasedLocal [Pkt] [(Pkt, [SignaturePayload])]
brokenSecSubkey

brokenTK :: Int -> Parser [Pkt] (Maybe TKUnknown)
brokenTK :: Int -> Parser [Pkt] (Maybe TKUnknown)
brokenTK Int
6 = do
    _ <- Int -> Parser [Pkt] Pkt
broken Int
6
    _ <-
        many
            (signature False [KeyRevocationSig, SignatureDirectlyOnAKey])
    _ <- many (signedUID False <|> signedUAt False)
    _ <-
        concatMany (signedOrRevokedPubSubkey False <|> brokenPubSubkey)
    return Nothing
brokenTK Int
5 = do
    _ <- Int -> Parser [Pkt] Pkt
broken Int
5
    _ <-
        many
            (signature False [KeyRevocationSig, SignatureDirectlyOnAKey])
    _ <- many (signedUID False <|> signedUAt False)
    _ <-
        concatMany
            (rawOrSignedOrRevokedSecSubkey False <|> brokenSecSubkey)
    return Nothing
brokenTK Int
_ = String -> Parser [Pkt] (Maybe TKUnknown)
forall a. String -> Parser LeftBiasedLocal [Pkt] a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Unexpected broken packet type"

pkPayload :: Parser [Pkt] (SomePKPayload, Maybe SKAddendum)
pkPayload :: Parser [Pkt] (SomePKPayload, Maybe SKAddendum)
pkPayload = do
    pkpkts <- ([Pkt] -> Bool) -> Parser LeftBiasedLocal [Pkt] [Pkt]
forall s t. FactorialMonoid s => (s -> Bool) -> Parser t s s
satisfy [Pkt] -> Bool
isPKP
    case pkpkts of
        [Pkt
pkt] ->
            case Pkt -> Maybe (KeyPkt 'PublicPkt)
pktToPublicKeyPkt Pkt
pkt of
                Just KeyPkt 'PublicPkt
keyPkt
                    | KeyPkt 'PublicPkt -> KeyPktRole
forall (k :: KeyPktKind). KeyPkt k -> KeyPktRole
keyPktRole KeyPkt 'PublicPkt
keyPkt KeyPktRole -> KeyPktRole -> Bool
forall a. Eq a => a -> a -> Bool
== KeyPktRole
KeyPktPrimary ->
                        (SomePKPayload, Maybe SKAddendum)
-> Parser [Pkt] (SomePKPayload, Maybe SKAddendum)
forall a. a -> Parser LeftBiasedLocal [Pkt] a
forall (m :: * -> *) a. Monad m => a -> m a
return (KeyPkt 'PublicPkt -> (SomePKPayload, Maybe SKAddendum)
forall (k :: KeyPktKind).
KeyPkt k -> (SomePKPayload, Maybe SKAddendum)
keyPktTKKey KeyPkt 'PublicPkt
keyPkt)
                Maybe (KeyPkt 'PublicPkt)
_ -> Parser [Pkt] (SomePKPayload, Maybe SKAddendum)
forall t s r. Parser t s r
failure
        [Pkt]
_ -> Parser [Pkt] (SomePKPayload, Maybe SKAddendum)
forall t s r. Parser t s r
failure
  where
    isPKP :: [Pkt] -> Bool
isPKP [Pkt
pkt] =
        case Pkt -> Maybe (KeyPkt 'PublicPkt)
pktToPublicKeyPkt Pkt
pkt of
            Just KeyPkt 'PublicPkt
keyPkt -> KeyPkt 'PublicPkt -> KeyPktRole
forall (k :: KeyPktKind). KeyPkt k -> KeyPktRole
keyPktRole KeyPkt 'PublicPkt
keyPkt KeyPktRole -> KeyPktRole -> Bool
forall a. Eq a => a -> a -> Bool
== KeyPktRole
KeyPktPrimary
            Maybe (KeyPkt 'PublicPkt)
Nothing -> Bool
False
    isPKP [Pkt]
_ = Bool
False

signature :: Bool -> [SigType] -> Parser [Pkt] [SignaturePayload]
signature :: Bool
-> [SigType] -> Parser LeftBiasedLocal [Pkt] [SignaturePayload]
signature Bool
intolerant [SigType]
rts = Bool
-> (SigType -> Bool)
-> Parser LeftBiasedLocal [Pkt] [SignaturePayload]
signatureWithPredicate Bool
intolerant (\SigType
st -> SigType
st SigType -> [SigType] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [SigType]
rts)

{- | RFC9580-aware signature parser that validates context using a predicate
The predicate operates on SigType to determine if the signature is allowed
in this context (e.g., isAllowedPrimaryKeySigType for primary keys).
-}
signatureWithPredicate
    :: Bool -> (SigType -> Bool) -> Parser [Pkt] [SignaturePayload]
signatureWithPredicate :: Bool
-> (SigType -> Bool)
-> Parser LeftBiasedLocal [Pkt] [SignaturePayload]
signatureWithPredicate Bool
intolerant SigType -> Bool
predicate =
    if Bool
intolerant
        then Parser LeftBiasedLocal [Pkt] [SignaturePayload]
forall {t}. Parser t [Pkt] [SignaturePayload]
signature'
        else Parser LeftBiasedLocal [Pkt] [SignaturePayload]
forall {t}. Parser t [Pkt] [SignaturePayload]
signature' Parser LeftBiasedLocal [Pkt] [SignaturePayload]
-> Parser LeftBiasedLocal [Pkt] [SignaturePayload]
-> Parser LeftBiasedLocal [Pkt] [SignaturePayload]
forall a.
Parser LeftBiasedLocal [Pkt] a
-> Parser LeftBiasedLocal [Pkt] a -> Parser LeftBiasedLocal [Pkt] a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser LeftBiasedLocal [Pkt] [SignaturePayload]
forall {a}. Parser LeftBiasedLocal [Pkt] [a]
brokensig'
  where
    signature' :: Parser t [Pkt] [SignaturePayload]
signature' = do
        spks <- ([Pkt] -> Bool) -> Parser t [Pkt] [Pkt]
forall s t. FactorialMonoid s => (s -> Bool) -> Parser t s s
satisfy (Bool -> [Pkt] -> Bool
isSP Bool
intolerant)
        case spks of
            [SignaturePkt SignaturePayload
sp] ->
                [SignaturePayload] -> Parser t [Pkt] [SignaturePayload]
forall a. a -> Parser t [Pkt] a
forall (m :: * -> *) a. Monad m => a -> m a
return ([SignaturePayload] -> Parser t [Pkt] [SignaturePayload])
-> [SignaturePayload] -> Parser t [Pkt] [SignaturePayload]
forall a b. (a -> b) -> a -> b
$!
                    ( if Bool
intolerant
                        then [SignaturePayload] -> [SignaturePayload]
forall a. a -> a
id
                        else (SignaturePayload -> Bool)
-> [SignaturePayload] -> [SignaturePayload]
forall a. (a -> Bool) -> [a] -> [a]
filter SignaturePayload -> Bool
isSP'
                    )
                        [SignaturePayload
sp]
            [Pkt]
_ -> Parser t [Pkt] [SignaturePayload]
forall t s r. Parser t s r
failure
    brokensig' :: Parser LeftBiasedLocal [Pkt] [a]
brokensig' = [a] -> Pkt -> [a]
forall a b. a -> b -> a
const [] (Pkt -> [a])
-> Parser [Pkt] Pkt -> Parser LeftBiasedLocal [Pkt] [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Parser [Pkt] Pkt
broken Int
2
    isSP :: Bool -> [Pkt] -> Bool
isSP Bool
True [SignaturePkt SignaturePayload
sp] = SignaturePayload -> Bool
isSP' SignaturePayload
sp
    isSP Bool
False [SignaturePkt SignaturePayload
_] = Bool
True
    isSP Bool
_ [Pkt]
_ = Bool
False
    isSP' :: SignaturePayload -> Bool
isSP' SignaturePayload
sigPayload = Bool -> (SigType -> Bool) -> Maybe SigType -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False SigType -> Bool
predicate (SignaturePayload -> Maybe SigType
sigType SignaturePayload
sigPayload)

signedUID :: Bool -> Parser [Pkt] (UidOrUat, [SignaturePayload])
signedUID :: Bool -> Parser LeftBiasedLocal [Pkt] (UidOrUat, [SignaturePayload])
signedUID Bool
intolerant = do
    upkts <- ([Pkt] -> Bool) -> Parser LeftBiasedLocal [Pkt] [Pkt]
forall s t. FactorialMonoid s => (s -> Bool) -> Parser t s s
satisfy [Pkt] -> Bool
isUID
    case upkts of
        [UserIdPkt Text
u] -> do
            sigs <-
                Parser LeftBiasedLocal [Pkt] [SignaturePayload]
-> Parser LeftBiasedLocal [Pkt] [SignaturePayload]
forall a.
(Semigroup a, Monoid a) =>
Parser LeftBiasedLocal [Pkt] a -> Parser LeftBiasedLocal [Pkt] a
forall (f :: * -> *) a.
(MonoidAlternative f, Semigroup a, Monoid a) =>
f a -> f a
concatMany
                    (Bool
-> (SigType -> Bool)
-> Parser LeftBiasedLocal [Pkt] [SignaturePayload]
signatureWithPredicate Bool
intolerant SigType -> Bool
isAllowedUIDSigType)
            return (I u, sigs)
        [Pkt]
_ -> Parser LeftBiasedLocal [Pkt] (UidOrUat, [SignaturePayload])
forall t s r. Parser t s r
failure
  where
    isUID :: [Pkt] -> Bool
isUID [UserIdPkt Text
_] = Bool
True
    isUID [Pkt]
_ = Bool
False

signedUAt :: Bool -> Parser [Pkt] (UidOrUat, [SignaturePayload])
signedUAt :: Bool -> Parser LeftBiasedLocal [Pkt] (UidOrUat, [SignaturePayload])
signedUAt Bool
intolerant = do
    uapkts <- ([Pkt] -> Bool) -> Parser LeftBiasedLocal [Pkt] [Pkt]
forall s t. FactorialMonoid s => (s -> Bool) -> Parser t s s
satisfy [Pkt] -> Bool
isUAt
    case uapkts of
        [UserAttributePkt [UserAttrSubPacket]
us] -> do
            sigs <-
                Parser LeftBiasedLocal [Pkt] [SignaturePayload]
-> Parser LeftBiasedLocal [Pkt] [SignaturePayload]
forall a.
(Semigroup a, Monoid a) =>
Parser LeftBiasedLocal [Pkt] a -> Parser LeftBiasedLocal [Pkt] a
forall (f :: * -> *) a.
(MonoidAlternative f, Semigroup a, Monoid a) =>
f a -> f a
concatMany
                    (Bool
-> (SigType -> Bool)
-> Parser LeftBiasedLocal [Pkt] [SignaturePayload]
signatureWithPredicate Bool
intolerant SigType -> Bool
isAllowedUIDSigType)
            return (A us, sigs)
        [Pkt]
_ -> Parser LeftBiasedLocal [Pkt] (UidOrUat, [SignaturePayload])
forall t s r. Parser t s r
failure
  where
    isUAt :: [Pkt] -> Bool
isUAt [UserAttributePkt [UserAttrSubPacket]
_] = Bool
True
    isUAt [Pkt]
_ = Bool
False

signedOrRevokedPubSubkey
    :: Bool -> Parser [Pkt] [(Pkt, [SignaturePayload])]
signedOrRevokedPubSubkey :: Bool -> Parser LeftBiasedLocal [Pkt] [(Pkt, [SignaturePayload])]
signedOrRevokedPubSubkey Bool
intolerant = do
    pskpkts <- ([Pkt] -> Bool) -> Parser LeftBiasedLocal [Pkt] [Pkt]
forall s t. FactorialMonoid s => (s -> Bool) -> Parser t s s
satisfy [Pkt] -> Bool
isPSKP
    case pskpkts of
        [Pkt
p] -> do
            sigs <-
                Parser LeftBiasedLocal [Pkt] [SignaturePayload]
-> Parser LeftBiasedLocal [Pkt] [SignaturePayload]
forall a.
(Semigroup a, Monoid a) =>
Parser LeftBiasedLocal [Pkt] a -> Parser LeftBiasedLocal [Pkt] a
forall (f :: * -> *) a.
(MonoidAlternative f, Semigroup a, Monoid a) =>
f a -> f a
concatMany
                    (Bool
-> (SigType -> Bool)
-> Parser LeftBiasedLocal [Pkt] [SignaturePayload]
signatureWithPredicate Bool
intolerant SigType -> Bool
isAllowedSubkeySigType)
            return [(p, sigs)]
        [Pkt]
_ -> Parser LeftBiasedLocal [Pkt] [(Pkt, [SignaturePayload])]
forall t s r. Parser t s r
failure
  where
    isPSKP :: [Pkt] -> Bool
isPSKP [Pkt
pkt] =
        case Pkt -> Maybe (KeyPkt 'PublicPkt)
pktToPublicKeyPkt Pkt
pkt of
            Just KeyPkt 'PublicPkt
keyPkt -> KeyPkt 'PublicPkt -> KeyPktRole
forall (k :: KeyPktKind). KeyPkt k -> KeyPktRole
keyPktRole KeyPkt 'PublicPkt
keyPkt KeyPktRole -> KeyPktRole -> Bool
forall a. Eq a => a -> a -> Bool
== KeyPktRole
KeyPktSubkey
            Maybe (KeyPkt 'PublicPkt)
Nothing -> Bool
False
    isPSKP [Pkt]
_ = Bool
False

brokenPubSubkey :: Parser [Pkt] [(Pkt, [SignaturePayload])]
brokenPubSubkey :: Parser LeftBiasedLocal [Pkt] [(Pkt, [SignaturePayload])]
brokenPubSubkey = do
    _ <- Int -> Parser [Pkt] Pkt
broken Int
14
    _ <-
        concatMany (signatureWithPredicate False isAllowedSubkeySigType)
    return []

rawOrSignedOrRevokedSecSubkey
    :: Bool -> Parser [Pkt] [(Pkt, [SignaturePayload])]
rawOrSignedOrRevokedSecSubkey :: Bool -> Parser LeftBiasedLocal [Pkt] [(Pkt, [SignaturePayload])]
rawOrSignedOrRevokedSecSubkey Bool
intolerant = do
    sskpkts <- ([Pkt] -> Bool) -> Parser LeftBiasedLocal [Pkt] [Pkt]
forall s t. FactorialMonoid s => (s -> Bool) -> Parser t s s
satisfy [Pkt] -> Bool
isSSKP
    case sskpkts of
        [Pkt
p] -> do
            sigs <-
                Parser LeftBiasedLocal [Pkt] [SignaturePayload]
-> Parser LeftBiasedLocal [Pkt] [SignaturePayload]
forall a.
(Semigroup a, Monoid a) =>
Parser LeftBiasedLocal [Pkt] a -> Parser LeftBiasedLocal [Pkt] a
forall (f :: * -> *) a.
(MonoidAlternative f, Semigroup a, Monoid a) =>
f a -> f a
concatMany
                    (Bool
-> (SigType -> Bool)
-> Parser LeftBiasedLocal [Pkt] [SignaturePayload]
signatureWithPredicate Bool
intolerant SigType -> Bool
isAllowedSubkeySigType)
            return [(p, sigs)]
        [Pkt]
_ -> Parser LeftBiasedLocal [Pkt] [(Pkt, [SignaturePayload])]
forall t s r. Parser t s r
failure
  where
    isSSKP :: [Pkt] -> Bool
isSSKP [Pkt
pkt] =
        case Pkt -> Maybe (KeyPkt 'SecretPkt)
pktToSecretKeyPkt Pkt
pkt of
            Just KeyPkt 'SecretPkt
keyPkt -> KeyPkt 'SecretPkt -> KeyPktRole
forall (k :: KeyPktKind). KeyPkt k -> KeyPktRole
keyPktRole KeyPkt 'SecretPkt
keyPkt KeyPktRole -> KeyPktRole -> Bool
forall a. Eq a => a -> a -> Bool
== KeyPktRole
KeyPktSubkey
            Maybe (KeyPkt 'SecretPkt)
Nothing -> Bool
False
    isSSKP [Pkt]
_ = Bool
False

brokenSecSubkey :: Parser [Pkt] [(Pkt, [SignaturePayload])]
brokenSecSubkey :: Parser LeftBiasedLocal [Pkt] [(Pkt, [SignaturePayload])]
brokenSecSubkey = do
    _ <- Int -> Parser [Pkt] Pkt
broken Int
7
    _ <-
        concatMany (signatureWithPredicate False isAllowedSubkeySigType)
    return []

skPayload :: Parser [Pkt] (SomePKPayload, Maybe SKAddendum)
skPayload :: Parser [Pkt] (SomePKPayload, Maybe SKAddendum)
skPayload = do
    spkts <- ([Pkt] -> Bool) -> Parser LeftBiasedLocal [Pkt] [Pkt]
forall s t. FactorialMonoid s => (s -> Bool) -> Parser t s s
satisfy [Pkt] -> Bool
isSKP
    case spkts of
        [Pkt
pkt] ->
            case Pkt -> Maybe (KeyPkt 'SecretPkt)
pktToSecretKeyPkt Pkt
pkt of
                Just KeyPkt 'SecretPkt
keyPkt
                    | KeyPkt 'SecretPkt -> KeyPktRole
forall (k :: KeyPktKind). KeyPkt k -> KeyPktRole
keyPktRole KeyPkt 'SecretPkt
keyPkt KeyPktRole -> KeyPktRole -> Bool
forall a. Eq a => a -> a -> Bool
== KeyPktRole
KeyPktPrimary ->
                        (SomePKPayload, Maybe SKAddendum)
-> Parser [Pkt] (SomePKPayload, Maybe SKAddendum)
forall a. a -> Parser LeftBiasedLocal [Pkt] a
forall (m :: * -> *) a. Monad m => a -> m a
return (KeyPkt 'SecretPkt -> (SomePKPayload, Maybe SKAddendum)
forall (k :: KeyPktKind).
KeyPkt k -> (SomePKPayload, Maybe SKAddendum)
keyPktTKKey KeyPkt 'SecretPkt
keyPkt)
                Maybe (KeyPkt 'SecretPkt)
_ -> Parser [Pkt] (SomePKPayload, Maybe SKAddendum)
forall t s r. Parser t s r
failure
        [Pkt]
_ -> Parser [Pkt] (SomePKPayload, Maybe SKAddendum)
forall t s r. Parser t s r
failure
  where
    isSKP :: [Pkt] -> Bool
isSKP [Pkt
pkt] =
        case Pkt -> Maybe (KeyPkt 'SecretPkt)
pktToSecretKeyPkt Pkt
pkt of
            Just KeyPkt 'SecretPkt
keyPkt -> KeyPkt 'SecretPkt -> KeyPktRole
forall (k :: KeyPktKind). KeyPkt k -> KeyPktRole
keyPktRole KeyPkt 'SecretPkt
keyPkt KeyPktRole -> KeyPktRole -> Bool
forall a. Eq a => a -> a -> Bool
== KeyPktRole
KeyPktPrimary
            Maybe (KeyPkt 'SecretPkt)
Nothing -> Bool
False
    isSKP [Pkt]
_ = Bool
False

broken :: Int -> Parser [Pkt] Pkt
broken :: Int -> Parser [Pkt] Pkt
broken Int
t = do
    bpkts <- ([Pkt] -> Bool) -> Parser LeftBiasedLocal [Pkt] [Pkt]
forall s t. FactorialMonoid s => (s -> Bool) -> Parser t s s
satisfy [Pkt] -> Bool
isBroken
    case bpkts of
        [Pkt
bp] -> Pkt -> Parser [Pkt] Pkt
forall a. a -> Parser LeftBiasedLocal [Pkt] a
forall (m :: * -> *) a. Monad m => a -> m a
return Pkt
bp
        [Pkt]
_ -> Parser [Pkt] Pkt
forall t s r. Parser t s r
failure
  where
    isBroken :: [Pkt] -> Bool
isBroken [BrokenPacketPkt String
_ Word8
a ByteString
_] = Int
t Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
a
    isBroken [Pkt]
_ = Bool
False

{-# DEPRECATED parseUnknownTKs "Use parsePublicTKs or parseSecretTKs instead" #-}

-- | parse TKs from packets
parseUnknownTKs :: Bool -> [Pkt] -> [TKUnknown]
parseUnknownTKs :: Bool -> [Pkt] -> [TKUnknown]
parseUnknownTKs Bool
intolerant [Pkt]
ps =
    [Maybe TKUnknown] -> [TKUnknown]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe TKUnknown] -> [TKUnknown])
-> [Maybe TKUnknown] -> [TKUnknown]
forall a b. (a -> b) -> a -> b
$
        Parser [Pkt] (Maybe TKUnknown) -> [[Pkt]] -> [Maybe TKUnknown]
forall s r. (Monoid s, Show s) => Parser s r -> [s] -> [r]
runIncrementalParser
            (Bool -> Parser [Pkt] (Maybe TKUnknown)
anyTK Bool
intolerant)
            ((Pkt -> [Pkt]) -> [Pkt] -> [[Pkt]]
forall a b. (a -> b) -> [a] -> [b]
map (Pkt -> [Pkt] -> [Pkt]
forall a. a -> [a] -> [a]
: []) ((Pkt -> Bool) -> [Pkt] -> [Pkt]
forall a. (a -> Bool) -> [a] -> [a]
filter Pkt -> Bool
notTrustPacket [Pkt]
ps))
  where
    notTrustPacket :: Pkt -> Bool
notTrustPacket = Bool -> Bool
not (Bool -> Bool) -> (Pkt -> Bool) -> Pkt -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pkt -> Bool
isTrustPkt

parseTKsEither
    :: Bool -> [Pkt] -> [Either TKConversionError SomeTK]
parseTKsEither :: Bool -> [Pkt] -> [Either TKConversionError SomeTK]
parseTKsEither Bool
intolerant =
    (TKUnknown -> Either TKConversionError SomeTK)
-> [TKUnknown] -> [Either TKConversionError SomeTK]
forall a b. (a -> b) -> [a] -> [b]
map TKUnknown -> Either TKConversionError SomeTK
fromUnknownToTKEither ([TKUnknown] -> [Either TKConversionError SomeTK])
-> ([Pkt] -> [TKUnknown])
-> [Pkt]
-> [Either TKConversionError SomeTK]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> [Pkt] -> [TKUnknown]
parseUnknownTKs Bool
intolerant

parseTKs :: Bool -> [Pkt] -> [SomeTK]
parseTKs :: Bool -> [Pkt] -> [SomeTK]
parseTKs Bool
intolerant [Pkt]
packets = [Either TKConversionError SomeTK] -> [SomeTK]
forall a b. [Either a b] -> [b]
rights (Bool -> [Pkt] -> [Either TKConversionError SomeTK]
parseTKsEither Bool
intolerant [Pkt]
packets)

parsePublicTKs :: Bool -> [Pkt] -> [TK 'PublicTK]
parsePublicTKs :: Bool -> [Pkt] -> [TK 'PublicTK]
parsePublicTKs Bool
intolerant [Pkt]
packets =
    (SomeTK -> Maybe (TK 'PublicTK)) -> [SomeTK] -> [TK 'PublicTK]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe SomeTK -> Maybe (TK 'PublicTK)
someTKToPublicTK (Bool -> [Pkt] -> [SomeTK]
parseTKs Bool
intolerant [Pkt]
packets)

parseSecretTKs :: Bool -> [Pkt] -> [TK 'SecretTK]
parseSecretTKs :: Bool -> [Pkt] -> [TK 'SecretTK]
parseSecretTKs Bool
intolerant [Pkt]
packets =
    (SomeTK -> Maybe (TK 'SecretTK)) -> [SomeTK] -> [TK 'SecretTK]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe SomeTK -> Maybe (TK 'SecretTK)
someTKToSecretTK (Bool -> [Pkt] -> [SomeTK]
parseTKs Bool
intolerant [Pkt]
packets)

anyTKWithWireRep
    :: Bool -> Parser [PktWithWireRep] (Maybe TKWithWireRep)
anyTKWithWireRep :: Bool -> Parser [PktWithWireRep] (Maybe TKWithWireRep)
anyTKWithWireRep Bool
True = Bool -> Parser [PktWithWireRep] (Maybe TKWithWireRep)
publicTKWithWireRep Bool
True Parser [PktWithWireRep] (Maybe TKWithWireRep)
-> Parser [PktWithWireRep] (Maybe TKWithWireRep)
-> Parser [PktWithWireRep] (Maybe TKWithWireRep)
forall a.
Parser LeftBiasedLocal [PktWithWireRep] a
-> Parser LeftBiasedLocal [PktWithWireRep] a
-> Parser LeftBiasedLocal [PktWithWireRep] a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Bool -> Parser [PktWithWireRep] (Maybe TKWithWireRep)
secretTKWithWireRep Bool
True
anyTKWithWireRep Bool
False =
    Bool -> Parser [PktWithWireRep] (Maybe TKWithWireRep)
publicTKWithWireRep Bool
False
        Parser [PktWithWireRep] (Maybe TKWithWireRep)
-> Parser [PktWithWireRep] (Maybe TKWithWireRep)
-> Parser [PktWithWireRep] (Maybe TKWithWireRep)
forall a.
Parser LeftBiasedLocal [PktWithWireRep] a
-> Parser LeftBiasedLocal [PktWithWireRep] a
-> Parser LeftBiasedLocal [PktWithWireRep] a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Bool -> Parser [PktWithWireRep] (Maybe TKWithWireRep)
secretTKWithWireRep Bool
False
        Parser [PktWithWireRep] (Maybe TKWithWireRep)
-> Parser [PktWithWireRep] (Maybe TKWithWireRep)
-> Parser [PktWithWireRep] (Maybe TKWithWireRep)
forall a.
Parser LeftBiasedLocal [PktWithWireRep] a
-> Parser LeftBiasedLocal [PktWithWireRep] a
-> Parser LeftBiasedLocal [PktWithWireRep] a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Int -> Parser [PktWithWireRep] (Maybe TKWithWireRep)
brokenTKWithWireRep Int
6
        Parser [PktWithWireRep] (Maybe TKWithWireRep)
-> Parser [PktWithWireRep] (Maybe TKWithWireRep)
-> Parser [PktWithWireRep] (Maybe TKWithWireRep)
forall a.
Parser LeftBiasedLocal [PktWithWireRep] a
-> Parser LeftBiasedLocal [PktWithWireRep] a
-> Parser LeftBiasedLocal [PktWithWireRep] a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Int -> Parser [PktWithWireRep] (Maybe TKWithWireRep)
brokenTKWithWireRep Int
5

publicTKWithWireRep
    , secretTKWithWireRep
        :: Bool -> Parser [PktWithWireRep] (Maybe TKWithWireRep)
publicTKWithWireRep :: Bool -> Parser [PktWithWireRep] (Maybe TKWithWireRep)
publicTKWithWireRep Bool
intolerant = do
    (pkp, pkps) <- Parser
  [PktWithWireRep]
  ((SomePKPayload, Maybe SKAddendum), [PktWithWireRep])
pkPayloadWithWireRep
    (pkpsigs, pkpsigrefs) <-
        concatMany
            ( signatureWithWireRepPredicate
                intolerant
                isAllowedPrimaryKeySigType
            )
    uidResults <-
        many
            ( signedUIDWithWireRep intolerant
                <|> signedUAtWithWireRep intolerant
            )
    subResults <- concatMany (pubsub intolerant)
    let semanticUs = (((UidOrUat, [SignaturePayload]), [PktWithWireRep])
 -> (UidOrUat, [SignaturePayload]))
-> [((UidOrUat, [SignaturePayload]), [PktWithWireRep])]
-> [(UidOrUat, [SignaturePayload])]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((UidOrUat, [SignaturePayload]), [PktWithWireRep])
-> (UidOrUat, [SignaturePayload])
forall a b. (a, b) -> a
fst [((UidOrUat, [SignaturePayload]), [PktWithWireRep])]
uidResults
        (uids, uats) = splitUs semanticUs
        uidrefs = (((UidOrUat, [SignaturePayload]), [PktWithWireRep])
 -> [PktWithWireRep])
-> [((UidOrUat, [SignaturePayload]), [PktWithWireRep])]
-> [PktWithWireRep]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((UidOrUat, [SignaturePayload]), [PktWithWireRep])
-> [PktWithWireRep]
forall a b. (a, b) -> b
snd [((UidOrUat, [SignaturePayload]), [PktWithWireRep])]
uidResults
        subs = (((Pkt, [SignaturePayload]), [PktWithWireRep])
 -> (Pkt, [SignaturePayload]))
-> [((Pkt, [SignaturePayload]), [PktWithWireRep])]
-> [(Pkt, [SignaturePayload])]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Pkt, [SignaturePayload]), [PktWithWireRep])
-> (Pkt, [SignaturePayload])
forall a b. (a, b) -> a
fst [((Pkt, [SignaturePayload]), [PktWithWireRep])]
subResults
        subrefs = (((Pkt, [SignaturePayload]), [PktWithWireRep]) -> [PktWithWireRep])
-> [((Pkt, [SignaturePayload]), [PktWithWireRep])]
-> [PktWithWireRep]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((Pkt, [SignaturePayload]), [PktWithWireRep]) -> [PktWithWireRep]
forall a b. (a, b) -> b
snd [((Pkt, [SignaturePayload]), [PktWithWireRep])]
subResults
        tk = (SomePKPayload, Maybe SKAddendum)
-> [SignaturePayload]
-> [(Text, [SignaturePayload])]
-> [([UserAttrSubPacket], [SignaturePayload])]
-> [(Pkt, [SignaturePayload])]
-> TKUnknown
TKUnknown (SomePKPayload, Maybe SKAddendum)
pkp [SignaturePayload]
pkpsigs [(Text, [SignaturePayload])]
uids [([UserAttrSubPacket], [SignaturePayload])]
uats [(Pkt, [SignaturePayload])]
subs
        refs = [PktWithWireRep]
pkps [PktWithWireRep] -> [PktWithWireRep] -> [PktWithWireRep]
forall a. [a] -> [a] -> [a]
++ [PktWithWireRep]
pkpsigrefs [PktWithWireRep] -> [PktWithWireRep] -> [PktWithWireRep]
forall a. [a] -> [a] -> [a]
++ [PktWithWireRep]
uidrefs [PktWithWireRep] -> [PktWithWireRep] -> [PktWithWireRep]
forall a. [a] -> [a] -> [a]
++ [PktWithWireRep]
subrefs
    return $ Just (mkTKWithWireRep tk refs)
  where
    pubsub :: Bool
-> Parser
     LeftBiasedLocal
     [PktWithWireRep]
     [((Pkt, [SignaturePayload]), [PktWithWireRep])]
pubsub Bool
True = Bool
-> Parser
     LeftBiasedLocal
     [PktWithWireRep]
     [((Pkt, [SignaturePayload]), [PktWithWireRep])]
signedOrRevokedPubSubkeyWithWireRep Bool
True
    pubsub Bool
False =
        Bool
-> Parser
     LeftBiasedLocal
     [PktWithWireRep]
     [((Pkt, [SignaturePayload]), [PktWithWireRep])]
signedOrRevokedPubSubkeyWithWireRep Bool
False
            Parser
  LeftBiasedLocal
  [PktWithWireRep]
  [((Pkt, [SignaturePayload]), [PktWithWireRep])]
-> Parser
     LeftBiasedLocal
     [PktWithWireRep]
     [((Pkt, [SignaturePayload]), [PktWithWireRep])]
-> Parser
     LeftBiasedLocal
     [PktWithWireRep]
     [((Pkt, [SignaturePayload]), [PktWithWireRep])]
forall a.
Parser LeftBiasedLocal [PktWithWireRep] a
-> Parser LeftBiasedLocal [PktWithWireRep] a
-> Parser LeftBiasedLocal [PktWithWireRep] a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser
  LeftBiasedLocal
  [PktWithWireRep]
  [((Pkt, [SignaturePayload]), [PktWithWireRep])]
brokenPubSubkeyWithWireRep
secretTKWithWireRep :: Bool -> Parser [PktWithWireRep] (Maybe TKWithWireRep)
secretTKWithWireRep Bool
intolerant = do
    (skp, skps) <- Parser
  [PktWithWireRep]
  ((SomePKPayload, Maybe SKAddendum), [PktWithWireRep])
skPayloadWithWireRep
    (skpsigs, skpsigrefs) <-
        concatMany
            ( signatureWithWireRepPredicate
                intolerant
                isAllowedPrimaryKeySigType
            )
    uidResults <-
        many
            ( signedUIDWithWireRep intolerant
                <|> signedUAtWithWireRep intolerant
            )
    subResults <- concatMany (secsub intolerant)
    let semanticUs = (((UidOrUat, [SignaturePayload]), [PktWithWireRep])
 -> (UidOrUat, [SignaturePayload]))
-> [((UidOrUat, [SignaturePayload]), [PktWithWireRep])]
-> [(UidOrUat, [SignaturePayload])]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((UidOrUat, [SignaturePayload]), [PktWithWireRep])
-> (UidOrUat, [SignaturePayload])
forall a b. (a, b) -> a
fst [((UidOrUat, [SignaturePayload]), [PktWithWireRep])]
uidResults
        (uids, uats) = splitUs semanticUs
        uidrefs = (((UidOrUat, [SignaturePayload]), [PktWithWireRep])
 -> [PktWithWireRep])
-> [((UidOrUat, [SignaturePayload]), [PktWithWireRep])]
-> [PktWithWireRep]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((UidOrUat, [SignaturePayload]), [PktWithWireRep])
-> [PktWithWireRep]
forall a b. (a, b) -> b
snd [((UidOrUat, [SignaturePayload]), [PktWithWireRep])]
uidResults
        subs = (((Pkt, [SignaturePayload]), [PktWithWireRep])
 -> (Pkt, [SignaturePayload]))
-> [((Pkt, [SignaturePayload]), [PktWithWireRep])]
-> [(Pkt, [SignaturePayload])]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Pkt, [SignaturePayload]), [PktWithWireRep])
-> (Pkt, [SignaturePayload])
forall a b. (a, b) -> a
fst [((Pkt, [SignaturePayload]), [PktWithWireRep])]
subResults
        subrefs = (((Pkt, [SignaturePayload]), [PktWithWireRep]) -> [PktWithWireRep])
-> [((Pkt, [SignaturePayload]), [PktWithWireRep])]
-> [PktWithWireRep]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((Pkt, [SignaturePayload]), [PktWithWireRep]) -> [PktWithWireRep]
forall a b. (a, b) -> b
snd [((Pkt, [SignaturePayload]), [PktWithWireRep])]
subResults
        tk = (SomePKPayload, Maybe SKAddendum)
-> [SignaturePayload]
-> [(Text, [SignaturePayload])]
-> [([UserAttrSubPacket], [SignaturePayload])]
-> [(Pkt, [SignaturePayload])]
-> TKUnknown
TKUnknown (SomePKPayload, Maybe SKAddendum)
skp [SignaturePayload]
skpsigs [(Text, [SignaturePayload])]
uids [([UserAttrSubPacket], [SignaturePayload])]
uats [(Pkt, [SignaturePayload])]
subs
        refs = [PktWithWireRep]
skps [PktWithWireRep] -> [PktWithWireRep] -> [PktWithWireRep]
forall a. [a] -> [a] -> [a]
++ [PktWithWireRep]
skpsigrefs [PktWithWireRep] -> [PktWithWireRep] -> [PktWithWireRep]
forall a. [a] -> [a] -> [a]
++ [PktWithWireRep]
uidrefs [PktWithWireRep] -> [PktWithWireRep] -> [PktWithWireRep]
forall a. [a] -> [a] -> [a]
++ [PktWithWireRep]
subrefs
    return $ Just (mkTKWithWireRep tk refs)
  where
    secsub :: Bool
-> Parser
     LeftBiasedLocal
     [PktWithWireRep]
     [((Pkt, [SignaturePayload]), [PktWithWireRep])]
secsub Bool
True = Bool
-> Parser
     LeftBiasedLocal
     [PktWithWireRep]
     [((Pkt, [SignaturePayload]), [PktWithWireRep])]
rawOrSignedOrRevokedSecSubkeyWithWireRep Bool
True
    secsub Bool
False =
        Bool
-> Parser
     LeftBiasedLocal
     [PktWithWireRep]
     [((Pkt, [SignaturePayload]), [PktWithWireRep])]
rawOrSignedOrRevokedSecSubkeyWithWireRep Bool
False
            Parser
  LeftBiasedLocal
  [PktWithWireRep]
  [((Pkt, [SignaturePayload]), [PktWithWireRep])]
-> Parser
     LeftBiasedLocal
     [PktWithWireRep]
     [((Pkt, [SignaturePayload]), [PktWithWireRep])]
-> Parser
     LeftBiasedLocal
     [PktWithWireRep]
     [((Pkt, [SignaturePayload]), [PktWithWireRep])]
forall a.
Parser LeftBiasedLocal [PktWithWireRep] a
-> Parser LeftBiasedLocal [PktWithWireRep] a
-> Parser LeftBiasedLocal [PktWithWireRep] a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser
  LeftBiasedLocal
  [PktWithWireRep]
  [((Pkt, [SignaturePayload]), [PktWithWireRep])]
brokenSecSubkeyWithWireRep

brokenTKWithWireRep
    :: Int -> Parser [PktWithWireRep] (Maybe TKWithWireRep)
brokenTKWithWireRep :: Int -> Parser [PktWithWireRep] (Maybe TKWithWireRep)
brokenTKWithWireRep Int
6 = do
    _ <- Int -> Parser [PktWithWireRep] PktWithWireRep
brokenWithWireRep Int
6
    _ <-
        many
            (signatureWithWireRepPredicate False isAllowedPrimaryKeySigType)
    _ <-
        many (signedUIDWithWireRep False <|> signedUAtWithWireRep False)
    _ <-
        concatMany
            ( signedOrRevokedPubSubkeyWithWireRep False
                <|> brokenPubSubkeyWithWireRep
            )
    return Nothing
brokenTKWithWireRep Int
5 = do
    _ <- Int -> Parser [PktWithWireRep] PktWithWireRep
brokenWithWireRep Int
5
    _ <-
        many
            (signatureWithWireRepPredicate False isAllowedPrimaryKeySigType)
    _ <-
        many (signedUIDWithWireRep False <|> signedUAtWithWireRep False)
    _ <-
        concatMany
            ( rawOrSignedOrRevokedSecSubkeyWithWireRep False
                <|> brokenSecSubkeyWithWireRep
            )
    return Nothing
brokenTKWithWireRep Int
_ = String -> Parser [PktWithWireRep] (Maybe TKWithWireRep)
forall a. String -> Parser LeftBiasedLocal [PktWithWireRep] a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Unexpected broken packet type"

pkPayloadWithWireRep
    :: Parser
        [PktWithWireRep]
        ((SomePKPayload, Maybe SKAddendum), [PktWithWireRep])
pkPayloadWithWireRep :: Parser
  [PktWithWireRep]
  ((SomePKPayload, Maybe SKAddendum), [PktWithWireRep])
pkPayloadWithWireRep = do
    pkpkts <- ([PktWithWireRep] -> Bool)
-> Parser LeftBiasedLocal [PktWithWireRep] [PktWithWireRep]
forall s t. FactorialMonoid s => (s -> Bool) -> Parser t s s
satisfy [PktWithWireRep] -> Bool
isPKPWS
    case pkpkts of
        [PktWithWireRep
pktWithSource] ->
            case Pkt -> Maybe (KeyPkt 'PublicPkt)
pktToPublicKeyPkt (PktWithWireRep
pktWithSource PktWithWireRep -> Getting Pkt PktWithWireRep Pkt -> Pkt
forall s a. s -> Getting a s a -> a
^. (PktWithBytes -> Const Pkt PktWithBytes)
-> PktWithWireRep -> Const Pkt PktWithWireRep
Lens' PktWithWireRep PktWithBytes
pktWireRep ((PktWithBytes -> Const Pkt PktWithBytes)
 -> PktWithWireRep -> Const Pkt PktWithWireRep)
-> ((Pkt -> Const Pkt Pkt)
    -> PktWithBytes -> Const Pkt PktWithBytes)
-> Getting Pkt PktWithWireRep Pkt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Pkt -> Const Pkt Pkt) -> PktWithBytes -> Const Pkt PktWithBytes
Lens' PktWithBytes Pkt
pktValue) of
                Just KeyPkt 'PublicPkt
keyPkt
                    | KeyPkt 'PublicPkt -> KeyPktRole
forall (k :: KeyPktKind). KeyPkt k -> KeyPktRole
keyPktRole KeyPkt 'PublicPkt
keyPkt KeyPktRole -> KeyPktRole -> Bool
forall a. Eq a => a -> a -> Bool
== KeyPktRole
KeyPktPrimary ->
                        ((SomePKPayload, Maybe SKAddendum), [PktWithWireRep])
-> Parser
     [PktWithWireRep]
     ((SomePKPayload, Maybe SKAddendum), [PktWithWireRep])
forall a. a -> Parser LeftBiasedLocal [PktWithWireRep] a
forall (m :: * -> *) a. Monad m => a -> m a
return (KeyPkt 'PublicPkt -> (SomePKPayload, Maybe SKAddendum)
forall (k :: KeyPktKind).
KeyPkt k -> (SomePKPayload, Maybe SKAddendum)
keyPktTKKey KeyPkt 'PublicPkt
keyPkt, [PktWithWireRep
pktWithSource])
                Maybe (KeyPkt 'PublicPkt)
_ -> Parser
  [PktWithWireRep]
  ((SomePKPayload, Maybe SKAddendum), [PktWithWireRep])
forall t s r. Parser t s r
failure
        [PktWithWireRep]
_ -> Parser
  [PktWithWireRep]
  ((SomePKPayload, Maybe SKAddendum), [PktWithWireRep])
forall t s r. Parser t s r
failure
  where
    isPKPWS :: [PktWithWireRep] -> Bool
isPKPWS [PktWithWireRep
pktWithSource] =
        case Pkt -> Maybe (KeyPkt 'PublicPkt)
pktToPublicKeyPkt (PktWithWireRep
pktWithSource PktWithWireRep -> Getting Pkt PktWithWireRep Pkt -> Pkt
forall s a. s -> Getting a s a -> a
^. (PktWithBytes -> Const Pkt PktWithBytes)
-> PktWithWireRep -> Const Pkt PktWithWireRep
Lens' PktWithWireRep PktWithBytes
pktWireRep ((PktWithBytes -> Const Pkt PktWithBytes)
 -> PktWithWireRep -> Const Pkt PktWithWireRep)
-> ((Pkt -> Const Pkt Pkt)
    -> PktWithBytes -> Const Pkt PktWithBytes)
-> Getting Pkt PktWithWireRep Pkt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Pkt -> Const Pkt Pkt) -> PktWithBytes -> Const Pkt PktWithBytes
Lens' PktWithBytes Pkt
pktValue) of
            Just KeyPkt 'PublicPkt
keyPkt -> KeyPkt 'PublicPkt -> KeyPktRole
forall (k :: KeyPktKind). KeyPkt k -> KeyPktRole
keyPktRole KeyPkt 'PublicPkt
keyPkt KeyPktRole -> KeyPktRole -> Bool
forall a. Eq a => a -> a -> Bool
== KeyPktRole
KeyPktPrimary
            Maybe (KeyPkt 'PublicPkt)
_ -> Bool
False
    isPKPWS [PktWithWireRep]
_ = Bool
False

signatureWithWireRep
    :: Bool
    -> [SigType]
    -> Parser [PktWithWireRep] ([SignaturePayload], [PktWithWireRep])
signatureWithWireRep :: Bool
-> [SigType]
-> Parser
     LeftBiasedLocal
     [PktWithWireRep]
     ([SignaturePayload], [PktWithWireRep])
signatureWithWireRep Bool
intolerant [SigType]
rts =
    Bool
-> (SigType -> Bool)
-> Parser
     LeftBiasedLocal
     [PktWithWireRep]
     ([SignaturePayload], [PktWithWireRep])
signatureWithWireRepPredicate Bool
intolerant (\SigType
st -> SigType
st SigType -> [SigType] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [SigType]
rts)

-- | RFC9580-aware signature parser with wire representation support
signatureWithWireRepPredicate
    :: Bool
    -> (SigType -> Bool)
    -> Parser [PktWithWireRep] ([SignaturePayload], [PktWithWireRep])
signatureWithWireRepPredicate :: Bool
-> (SigType -> Bool)
-> Parser
     LeftBiasedLocal
     [PktWithWireRep]
     ([SignaturePayload], [PktWithWireRep])
signatureWithWireRepPredicate Bool
intolerant SigType -> Bool
predicate =
    if Bool
intolerant
        then Parser
  LeftBiasedLocal
  [PktWithWireRep]
  ([SignaturePayload], [PktWithWireRep])
forall {t}.
Parser t [PktWithWireRep] ([SignaturePayload], [PktWithWireRep])
signature'
        else Parser
  LeftBiasedLocal
  [PktWithWireRep]
  ([SignaturePayload], [PktWithWireRep])
forall {t}.
Parser t [PktWithWireRep] ([SignaturePayload], [PktWithWireRep])
signature' Parser
  LeftBiasedLocal
  [PktWithWireRep]
  ([SignaturePayload], [PktWithWireRep])
-> Parser
     LeftBiasedLocal
     [PktWithWireRep]
     ([SignaturePayload], [PktWithWireRep])
-> Parser
     LeftBiasedLocal
     [PktWithWireRep]
     ([SignaturePayload], [PktWithWireRep])
forall a.
Parser LeftBiasedLocal [PktWithWireRep] a
-> Parser LeftBiasedLocal [PktWithWireRep] a
-> Parser LeftBiasedLocal [PktWithWireRep] a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser
  LeftBiasedLocal
  [PktWithWireRep]
  ([SignaturePayload], [PktWithWireRep])
forall {a} {a}. Parser LeftBiasedLocal [PktWithWireRep] ([a], [a])
brokensig'
  where
    signature' :: Parser t [PktWithWireRep] ([SignaturePayload], [PktWithWireRep])
signature' = do
        spks <- ([PktWithWireRep] -> Bool)
-> Parser t [PktWithWireRep] [PktWithWireRep]
forall s t. FactorialMonoid s => (s -> Bool) -> Parser t s s
satisfy (Bool -> [PktWithWireRep] -> Bool
isSPWS Bool
intolerant)
        case spks of
            [PktWithWireRep
pktWithSource] ->
                case PktWithWireRep
pktWithSource PktWithWireRep -> Getting Pkt PktWithWireRep Pkt -> Pkt
forall s a. s -> Getting a s a -> a
^. (PktWithBytes -> Const Pkt PktWithBytes)
-> PktWithWireRep -> Const Pkt PktWithWireRep
Lens' PktWithWireRep PktWithBytes
pktWireRep ((PktWithBytes -> Const Pkt PktWithBytes)
 -> PktWithWireRep -> Const Pkt PktWithWireRep)
-> ((Pkt -> Const Pkt Pkt)
    -> PktWithBytes -> Const Pkt PktWithBytes)
-> Getting Pkt PktWithWireRep Pkt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Pkt -> Const Pkt Pkt) -> PktWithBytes -> Const Pkt PktWithBytes
Lens' PktWithBytes Pkt
pktValue of
                    SignaturePkt SignaturePayload
sp ->
                        let sigs :: [SignaturePayload]
sigs =
                                ( if Bool
intolerant
                                    then [SignaturePayload] -> [SignaturePayload]
forall a. a -> a
id
                                    else (SignaturePayload -> Bool)
-> [SignaturePayload] -> [SignaturePayload]
forall a. (a -> Bool) -> [a] -> [a]
filter SignaturePayload -> Bool
isSP'
                                )
                                    [SignaturePayload
sp]
                         in ([SignaturePayload], [PktWithWireRep])
-> Parser t [PktWithWireRep] ([SignaturePayload], [PktWithWireRep])
forall a. a -> Parser t [PktWithWireRep] a
forall (m :: * -> *) a. Monad m => a -> m a
return ([SignaturePayload]
sigs, if [SignaturePayload] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [SignaturePayload]
sigs then [] else [PktWithWireRep
pktWithSource])
                    Pkt
_ -> Parser t [PktWithWireRep] ([SignaturePayload], [PktWithWireRep])
forall t s r. Parser t s r
failure
            [PktWithWireRep]
_ -> Parser t [PktWithWireRep] ([SignaturePayload], [PktWithWireRep])
forall t s r. Parser t s r
failure
    brokensig' :: Parser LeftBiasedLocal [PktWithWireRep] ([a], [a])
brokensig' = ([a], [a]) -> PktWithWireRep -> ([a], [a])
forall a b. a -> b -> a
const ([], []) (PktWithWireRep -> ([a], [a]))
-> Parser [PktWithWireRep] PktWithWireRep
-> Parser LeftBiasedLocal [PktWithWireRep] ([a], [a])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Parser [PktWithWireRep] PktWithWireRep
brokenWithWireRep Int
2
    isSPWS :: Bool -> [PktWithWireRep] -> Bool
isSPWS Bool
True [PktWithWireRep
pktWithSource] =
        case PktWithWireRep
pktWithSource PktWithWireRep -> Getting Pkt PktWithWireRep Pkt -> Pkt
forall s a. s -> Getting a s a -> a
^. (PktWithBytes -> Const Pkt PktWithBytes)
-> PktWithWireRep -> Const Pkt PktWithWireRep
Lens' PktWithWireRep PktWithBytes
pktWireRep ((PktWithBytes -> Const Pkt PktWithBytes)
 -> PktWithWireRep -> Const Pkt PktWithWireRep)
-> ((Pkt -> Const Pkt Pkt)
    -> PktWithBytes -> Const Pkt PktWithBytes)
-> Getting Pkt PktWithWireRep Pkt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Pkt -> Const Pkt Pkt) -> PktWithBytes -> Const Pkt PktWithBytes
Lens' PktWithBytes Pkt
pktValue of
            SignaturePkt SignaturePayload
sp -> SignaturePayload -> Bool
isSP' SignaturePayload
sp
            Pkt
_ -> Bool
False
    isSPWS Bool
False [PktWithWireRep
pktWithSource] =
        case PktWithWireRep
pktWithSource PktWithWireRep -> Getting Pkt PktWithWireRep Pkt -> Pkt
forall s a. s -> Getting a s a -> a
^. (PktWithBytes -> Const Pkt PktWithBytes)
-> PktWithWireRep -> Const Pkt PktWithWireRep
Lens' PktWithWireRep PktWithBytes
pktWireRep ((PktWithBytes -> Const Pkt PktWithBytes)
 -> PktWithWireRep -> Const Pkt PktWithWireRep)
-> ((Pkt -> Const Pkt Pkt)
    -> PktWithBytes -> Const Pkt PktWithBytes)
-> Getting Pkt PktWithWireRep Pkt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Pkt -> Const Pkt Pkt) -> PktWithBytes -> Const Pkt PktWithBytes
Lens' PktWithBytes Pkt
pktValue of
            SignaturePkt SignaturePayload
_ -> Bool
True
            Pkt
_ -> Bool
False
    isSPWS Bool
_ [PktWithWireRep]
_ = Bool
False
    isSP' :: SignaturePayload -> Bool
isSP' SignaturePayload
sigPayload = Bool -> (SigType -> Bool) -> Maybe SigType -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False SigType -> Bool
predicate (SignaturePayload -> Maybe SigType
sigType SignaturePayload
sigPayload)

signedUIDWithWireRep
    :: Bool
    -> Parser
        [PktWithWireRep]
        ((UidOrUat, [SignaturePayload]), [PktWithWireRep])
signedUIDWithWireRep :: Bool
-> Parser
     LeftBiasedLocal
     [PktWithWireRep]
     ((UidOrUat, [SignaturePayload]), [PktWithWireRep])
signedUIDWithWireRep Bool
intolerant = do
    upkts <- ([PktWithWireRep] -> Bool)
-> Parser LeftBiasedLocal [PktWithWireRep] [PktWithWireRep]
forall s t. FactorialMonoid s => (s -> Bool) -> Parser t s s
satisfy [PktWithWireRep] -> Bool
isUIDWS
    case upkts of
        [PktWithWireRep
pktWithSource] ->
            case PktWithWireRep
pktWithSource PktWithWireRep -> Getting Pkt PktWithWireRep Pkt -> Pkt
forall s a. s -> Getting a s a -> a
^. (PktWithBytes -> Const Pkt PktWithBytes)
-> PktWithWireRep -> Const Pkt PktWithWireRep
Lens' PktWithWireRep PktWithBytes
pktWireRep ((PktWithBytes -> Const Pkt PktWithBytes)
 -> PktWithWireRep -> Const Pkt PktWithWireRep)
-> ((Pkt -> Const Pkt Pkt)
    -> PktWithBytes -> Const Pkt PktWithBytes)
-> Getting Pkt PktWithWireRep Pkt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Pkt -> Const Pkt Pkt) -> PktWithBytes -> Const Pkt PktWithBytes
Lens' PktWithBytes Pkt
pktValue of
                UserIdPkt Text
u -> do
                    (sigs, sigrefs) <-
                        Parser
  LeftBiasedLocal
  [PktWithWireRep]
  ([SignaturePayload], [PktWithWireRep])
-> Parser
     LeftBiasedLocal
     [PktWithWireRep]
     ([SignaturePayload], [PktWithWireRep])
forall a.
(Semigroup a, Monoid a) =>
Parser LeftBiasedLocal [PktWithWireRep] a
-> Parser LeftBiasedLocal [PktWithWireRep] a
forall (f :: * -> *) a.
(MonoidAlternative f, Semigroup a, Monoid a) =>
f a -> f a
concatMany
                            (Bool
-> (SigType -> Bool)
-> Parser
     LeftBiasedLocal
     [PktWithWireRep]
     ([SignaturePayload], [PktWithWireRep])
signatureWithWireRepPredicate Bool
intolerant SigType -> Bool
isAllowedUIDSigType)
                    return ((I u, sigs), pktWithSource : sigrefs)
                Pkt
_ -> Parser
  LeftBiasedLocal
  [PktWithWireRep]
  ((UidOrUat, [SignaturePayload]), [PktWithWireRep])
forall t s r. Parser t s r
failure
        [PktWithWireRep]
_ -> Parser
  LeftBiasedLocal
  [PktWithWireRep]
  ((UidOrUat, [SignaturePayload]), [PktWithWireRep])
forall t s r. Parser t s r
failure
  where
    isUIDWS :: [PktWithWireRep] -> Bool
isUIDWS [PktWithWireRep
pktWithSource] =
        case PktWithWireRep
pktWithSource PktWithWireRep -> Getting Pkt PktWithWireRep Pkt -> Pkt
forall s a. s -> Getting a s a -> a
^. (PktWithBytes -> Const Pkt PktWithBytes)
-> PktWithWireRep -> Const Pkt PktWithWireRep
Lens' PktWithWireRep PktWithBytes
pktWireRep ((PktWithBytes -> Const Pkt PktWithBytes)
 -> PktWithWireRep -> Const Pkt PktWithWireRep)
-> ((Pkt -> Const Pkt Pkt)
    -> PktWithBytes -> Const Pkt PktWithBytes)
-> Getting Pkt PktWithWireRep Pkt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Pkt -> Const Pkt Pkt) -> PktWithBytes -> Const Pkt PktWithBytes
Lens' PktWithBytes Pkt
pktValue of
            UserIdPkt Text
_ -> Bool
True
            Pkt
_ -> Bool
False
    isUIDWS [PktWithWireRep]
_ = Bool
False

signedUAtWithWireRep
    :: Bool
    -> Parser
        [PktWithWireRep]
        ((UidOrUat, [SignaturePayload]), [PktWithWireRep])
signedUAtWithWireRep :: Bool
-> Parser
     LeftBiasedLocal
     [PktWithWireRep]
     ((UidOrUat, [SignaturePayload]), [PktWithWireRep])
signedUAtWithWireRep Bool
intolerant = do
    uapkts <- ([PktWithWireRep] -> Bool)
-> Parser LeftBiasedLocal [PktWithWireRep] [PktWithWireRep]
forall s t. FactorialMonoid s => (s -> Bool) -> Parser t s s
satisfy [PktWithWireRep] -> Bool
isUAtWS
    case uapkts of
        [PktWithWireRep
pktWithSource] ->
            case PktWithWireRep
pktWithSource PktWithWireRep -> Getting Pkt PktWithWireRep Pkt -> Pkt
forall s a. s -> Getting a s a -> a
^. (PktWithBytes -> Const Pkt PktWithBytes)
-> PktWithWireRep -> Const Pkt PktWithWireRep
Lens' PktWithWireRep PktWithBytes
pktWireRep ((PktWithBytes -> Const Pkt PktWithBytes)
 -> PktWithWireRep -> Const Pkt PktWithWireRep)
-> ((Pkt -> Const Pkt Pkt)
    -> PktWithBytes -> Const Pkt PktWithBytes)
-> Getting Pkt PktWithWireRep Pkt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Pkt -> Const Pkt Pkt) -> PktWithBytes -> Const Pkt PktWithBytes
Lens' PktWithBytes Pkt
pktValue of
                UserAttributePkt [UserAttrSubPacket]
us -> do
                    (sigs, sigrefs) <-
                        Parser
  LeftBiasedLocal
  [PktWithWireRep]
  ([SignaturePayload], [PktWithWireRep])
-> Parser
     LeftBiasedLocal
     [PktWithWireRep]
     ([SignaturePayload], [PktWithWireRep])
forall a.
(Semigroup a, Monoid a) =>
Parser LeftBiasedLocal [PktWithWireRep] a
-> Parser LeftBiasedLocal [PktWithWireRep] a
forall (f :: * -> *) a.
(MonoidAlternative f, Semigroup a, Monoid a) =>
f a -> f a
concatMany
                            (Bool
-> (SigType -> Bool)
-> Parser
     LeftBiasedLocal
     [PktWithWireRep]
     ([SignaturePayload], [PktWithWireRep])
signatureWithWireRepPredicate Bool
intolerant SigType -> Bool
isAllowedUIDSigType)
                    return ((A us, sigs), pktWithSource : sigrefs)
                Pkt
_ -> Parser
  LeftBiasedLocal
  [PktWithWireRep]
  ((UidOrUat, [SignaturePayload]), [PktWithWireRep])
forall t s r. Parser t s r
failure
        [PktWithWireRep]
_ -> Parser
  LeftBiasedLocal
  [PktWithWireRep]
  ((UidOrUat, [SignaturePayload]), [PktWithWireRep])
forall t s r. Parser t s r
failure
  where
    isUAtWS :: [PktWithWireRep] -> Bool
isUAtWS [PktWithWireRep
pktWithSource] =
        case PktWithWireRep
pktWithSource PktWithWireRep -> Getting Pkt PktWithWireRep Pkt -> Pkt
forall s a. s -> Getting a s a -> a
^. (PktWithBytes -> Const Pkt PktWithBytes)
-> PktWithWireRep -> Const Pkt PktWithWireRep
Lens' PktWithWireRep PktWithBytes
pktWireRep ((PktWithBytes -> Const Pkt PktWithBytes)
 -> PktWithWireRep -> Const Pkt PktWithWireRep)
-> ((Pkt -> Const Pkt Pkt)
    -> PktWithBytes -> Const Pkt PktWithBytes)
-> Getting Pkt PktWithWireRep Pkt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Pkt -> Const Pkt Pkt) -> PktWithBytes -> Const Pkt PktWithBytes
Lens' PktWithBytes Pkt
pktValue of
            UserAttributePkt [UserAttrSubPacket]
_ -> Bool
True
            Pkt
_ -> Bool
False
    isUAtWS [PktWithWireRep]
_ = Bool
False

signedOrRevokedPubSubkeyWithWireRep
    :: Bool
    -> Parser
        [PktWithWireRep]
        [((Pkt, [SignaturePayload]), [PktWithWireRep])]
signedOrRevokedPubSubkeyWithWireRep :: Bool
-> Parser
     LeftBiasedLocal
     [PktWithWireRep]
     [((Pkt, [SignaturePayload]), [PktWithWireRep])]
signedOrRevokedPubSubkeyWithWireRep Bool
intolerant = do
    pskpkts <- ([PktWithWireRep] -> Bool)
-> Parser LeftBiasedLocal [PktWithWireRep] [PktWithWireRep]
forall s t. FactorialMonoid s => (s -> Bool) -> Parser t s s
satisfy [PktWithWireRep] -> Bool
isPSKPWS
    case pskpkts of
        [PktWithWireRep
pktWithSource] -> do
            (sigs, sigrefs) <-
                Parser
  LeftBiasedLocal
  [PktWithWireRep]
  ([SignaturePayload], [PktWithWireRep])
-> Parser
     LeftBiasedLocal
     [PktWithWireRep]
     ([SignaturePayload], [PktWithWireRep])
forall a.
(Semigroup a, Monoid a) =>
Parser LeftBiasedLocal [PktWithWireRep] a
-> Parser LeftBiasedLocal [PktWithWireRep] a
forall (f :: * -> *) a.
(MonoidAlternative f, Semigroup a, Monoid a) =>
f a -> f a
concatMany
                    (Bool
-> (SigType -> Bool)
-> Parser
     LeftBiasedLocal
     [PktWithWireRep]
     ([SignaturePayload], [PktWithWireRep])
signatureWithWireRepPredicate Bool
intolerant SigType -> Bool
isAllowedSubkeySigType)
            return
                [
                    ( (pktWithSource ^. pktWireRep . pktValue, sigs)
                    , pktWithSource : sigrefs
                    )
                ]
        [PktWithWireRep]
_ -> Parser
  LeftBiasedLocal
  [PktWithWireRep]
  [((Pkt, [SignaturePayload]), [PktWithWireRep])]
forall t s r. Parser t s r
failure
  where
    isPSKPWS :: [PktWithWireRep] -> Bool
isPSKPWS [PktWithWireRep
pktWithSource] =
        case Pkt -> Maybe (KeyPkt 'PublicPkt)
pktToPublicKeyPkt (PktWithWireRep
pktWithSource PktWithWireRep -> Getting Pkt PktWithWireRep Pkt -> Pkt
forall s a. s -> Getting a s a -> a
^. (PktWithBytes -> Const Pkt PktWithBytes)
-> PktWithWireRep -> Const Pkt PktWithWireRep
Lens' PktWithWireRep PktWithBytes
pktWireRep ((PktWithBytes -> Const Pkt PktWithBytes)
 -> PktWithWireRep -> Const Pkt PktWithWireRep)
-> ((Pkt -> Const Pkt Pkt)
    -> PktWithBytes -> Const Pkt PktWithBytes)
-> Getting Pkt PktWithWireRep Pkt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Pkt -> Const Pkt Pkt) -> PktWithBytes -> Const Pkt PktWithBytes
Lens' PktWithBytes Pkt
pktValue) of
            Just KeyPkt 'PublicPkt
keyPkt -> KeyPkt 'PublicPkt -> KeyPktRole
forall (k :: KeyPktKind). KeyPkt k -> KeyPktRole
keyPktRole KeyPkt 'PublicPkt
keyPkt KeyPktRole -> KeyPktRole -> Bool
forall a. Eq a => a -> a -> Bool
== KeyPktRole
KeyPktSubkey
            Maybe (KeyPkt 'PublicPkt)
_ -> Bool
False
    isPSKPWS [PktWithWireRep]
_ = Bool
False

brokenPubSubkeyWithWireRep
    :: Parser
        [PktWithWireRep]
        [((Pkt, [SignaturePayload]), [PktWithWireRep])]
brokenPubSubkeyWithWireRep :: Parser
  LeftBiasedLocal
  [PktWithWireRep]
  [((Pkt, [SignaturePayload]), [PktWithWireRep])]
brokenPubSubkeyWithWireRep = do
    _ <- Int -> Parser [PktWithWireRep] PktWithWireRep
brokenWithWireRep Int
14
    _ <-
        concatMany
            (signatureWithWireRepPredicate False isAllowedSubkeySigType)
    return []

rawOrSignedOrRevokedSecSubkeyWithWireRep
    :: Bool
    -> Parser
        [PktWithWireRep]
        [((Pkt, [SignaturePayload]), [PktWithWireRep])]
rawOrSignedOrRevokedSecSubkeyWithWireRep :: Bool
-> Parser
     LeftBiasedLocal
     [PktWithWireRep]
     [((Pkt, [SignaturePayload]), [PktWithWireRep])]
rawOrSignedOrRevokedSecSubkeyWithWireRep Bool
intolerant = do
    sskpkts <- ([PktWithWireRep] -> Bool)
-> Parser LeftBiasedLocal [PktWithWireRep] [PktWithWireRep]
forall s t. FactorialMonoid s => (s -> Bool) -> Parser t s s
satisfy [PktWithWireRep] -> Bool
isSSKPWS
    case sskpkts of
        [PktWithWireRep
pktWithSource] -> do
            (sigs, sigrefs) <-
                Parser
  LeftBiasedLocal
  [PktWithWireRep]
  ([SignaturePayload], [PktWithWireRep])
-> Parser
     LeftBiasedLocal
     [PktWithWireRep]
     ([SignaturePayload], [PktWithWireRep])
forall a.
(Semigroup a, Monoid a) =>
Parser LeftBiasedLocal [PktWithWireRep] a
-> Parser LeftBiasedLocal [PktWithWireRep] a
forall (f :: * -> *) a.
(MonoidAlternative f, Semigroup a, Monoid a) =>
f a -> f a
concatMany
                    (Bool
-> (SigType -> Bool)
-> Parser
     LeftBiasedLocal
     [PktWithWireRep]
     ([SignaturePayload], [PktWithWireRep])
signatureWithWireRepPredicate Bool
intolerant SigType -> Bool
isAllowedSubkeySigType)
            return
                [
                    ( (pktWithSource ^. pktWireRep . pktValue, sigs)
                    , pktWithSource : sigrefs
                    )
                ]
        [PktWithWireRep]
_ -> Parser
  LeftBiasedLocal
  [PktWithWireRep]
  [((Pkt, [SignaturePayload]), [PktWithWireRep])]
forall t s r. Parser t s r
failure
  where
    isSSKPWS :: [PktWithWireRep] -> Bool
isSSKPWS [PktWithWireRep
pktWithSource] =
        case Pkt -> Maybe (KeyPkt 'SecretPkt)
pktToSecretKeyPkt (PktWithWireRep
pktWithSource PktWithWireRep -> Getting Pkt PktWithWireRep Pkt -> Pkt
forall s a. s -> Getting a s a -> a
^. (PktWithBytes -> Const Pkt PktWithBytes)
-> PktWithWireRep -> Const Pkt PktWithWireRep
Lens' PktWithWireRep PktWithBytes
pktWireRep ((PktWithBytes -> Const Pkt PktWithBytes)
 -> PktWithWireRep -> Const Pkt PktWithWireRep)
-> ((Pkt -> Const Pkt Pkt)
    -> PktWithBytes -> Const Pkt PktWithBytes)
-> Getting Pkt PktWithWireRep Pkt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Pkt -> Const Pkt Pkt) -> PktWithBytes -> Const Pkt PktWithBytes
Lens' PktWithBytes Pkt
pktValue) of
            Just KeyPkt 'SecretPkt
keyPkt -> KeyPkt 'SecretPkt -> KeyPktRole
forall (k :: KeyPktKind). KeyPkt k -> KeyPktRole
keyPktRole KeyPkt 'SecretPkt
keyPkt KeyPktRole -> KeyPktRole -> Bool
forall a. Eq a => a -> a -> Bool
== KeyPktRole
KeyPktSubkey
            Maybe (KeyPkt 'SecretPkt)
_ -> Bool
False
    isSSKPWS [PktWithWireRep]
_ = Bool
False

brokenSecSubkeyWithWireRep
    :: Parser
        [PktWithWireRep]
        [((Pkt, [SignaturePayload]), [PktWithWireRep])]
brokenSecSubkeyWithWireRep :: Parser
  LeftBiasedLocal
  [PktWithWireRep]
  [((Pkt, [SignaturePayload]), [PktWithWireRep])]
brokenSecSubkeyWithWireRep = do
    _ <- Int -> Parser [PktWithWireRep] PktWithWireRep
brokenWithWireRep Int
7
    _ <-
        concatMany
            (signatureWithWireRepPredicate False isAllowedSubkeySigType)
    return []

skPayloadWithWireRep
    :: Parser
        [PktWithWireRep]
        ((SomePKPayload, Maybe SKAddendum), [PktWithWireRep])
skPayloadWithWireRep :: Parser
  [PktWithWireRep]
  ((SomePKPayload, Maybe SKAddendum), [PktWithWireRep])
skPayloadWithWireRep = do
    spkts <- ([PktWithWireRep] -> Bool)
-> Parser LeftBiasedLocal [PktWithWireRep] [PktWithWireRep]
forall s t. FactorialMonoid s => (s -> Bool) -> Parser t s s
satisfy [PktWithWireRep] -> Bool
isSKPWS
    case spkts of
        [PktWithWireRep
pktWithSource] ->
            case Pkt -> Maybe (KeyPkt 'SecretPkt)
pktToSecretKeyPkt (PktWithWireRep
pktWithSource PktWithWireRep -> Getting Pkt PktWithWireRep Pkt -> Pkt
forall s a. s -> Getting a s a -> a
^. (PktWithBytes -> Const Pkt PktWithBytes)
-> PktWithWireRep -> Const Pkt PktWithWireRep
Lens' PktWithWireRep PktWithBytes
pktWireRep ((PktWithBytes -> Const Pkt PktWithBytes)
 -> PktWithWireRep -> Const Pkt PktWithWireRep)
-> ((Pkt -> Const Pkt Pkt)
    -> PktWithBytes -> Const Pkt PktWithBytes)
-> Getting Pkt PktWithWireRep Pkt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Pkt -> Const Pkt Pkt) -> PktWithBytes -> Const Pkt PktWithBytes
Lens' PktWithBytes Pkt
pktValue) of
                Just KeyPkt 'SecretPkt
keyPkt
                    | KeyPkt 'SecretPkt -> KeyPktRole
forall (k :: KeyPktKind). KeyPkt k -> KeyPktRole
keyPktRole KeyPkt 'SecretPkt
keyPkt KeyPktRole -> KeyPktRole -> Bool
forall a. Eq a => a -> a -> Bool
== KeyPktRole
KeyPktPrimary ->
                        ((SomePKPayload, Maybe SKAddendum), [PktWithWireRep])
-> Parser
     [PktWithWireRep]
     ((SomePKPayload, Maybe SKAddendum), [PktWithWireRep])
forall a. a -> Parser LeftBiasedLocal [PktWithWireRep] a
forall (m :: * -> *) a. Monad m => a -> m a
return (KeyPkt 'SecretPkt -> (SomePKPayload, Maybe SKAddendum)
forall (k :: KeyPktKind).
KeyPkt k -> (SomePKPayload, Maybe SKAddendum)
keyPktTKKey KeyPkt 'SecretPkt
keyPkt, [PktWithWireRep
pktWithSource])
                Maybe (KeyPkt 'SecretPkt)
_ -> Parser
  [PktWithWireRep]
  ((SomePKPayload, Maybe SKAddendum), [PktWithWireRep])
forall t s r. Parser t s r
failure
        [PktWithWireRep]
_ -> Parser
  [PktWithWireRep]
  ((SomePKPayload, Maybe SKAddendum), [PktWithWireRep])
forall t s r. Parser t s r
failure
  where
    isSKPWS :: [PktWithWireRep] -> Bool
isSKPWS [PktWithWireRep
pktWithSource] =
        case Pkt -> Maybe (KeyPkt 'SecretPkt)
pktToSecretKeyPkt (PktWithWireRep
pktWithSource PktWithWireRep -> Getting Pkt PktWithWireRep Pkt -> Pkt
forall s a. s -> Getting a s a -> a
^. (PktWithBytes -> Const Pkt PktWithBytes)
-> PktWithWireRep -> Const Pkt PktWithWireRep
Lens' PktWithWireRep PktWithBytes
pktWireRep ((PktWithBytes -> Const Pkt PktWithBytes)
 -> PktWithWireRep -> Const Pkt PktWithWireRep)
-> ((Pkt -> Const Pkt Pkt)
    -> PktWithBytes -> Const Pkt PktWithBytes)
-> Getting Pkt PktWithWireRep Pkt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Pkt -> Const Pkt Pkt) -> PktWithBytes -> Const Pkt PktWithBytes
Lens' PktWithBytes Pkt
pktValue) of
            Just KeyPkt 'SecretPkt
keyPkt -> KeyPkt 'SecretPkt -> KeyPktRole
forall (k :: KeyPktKind). KeyPkt k -> KeyPktRole
keyPktRole KeyPkt 'SecretPkt
keyPkt KeyPktRole -> KeyPktRole -> Bool
forall a. Eq a => a -> a -> Bool
== KeyPktRole
KeyPktPrimary
            Maybe (KeyPkt 'SecretPkt)
_ -> Bool
False
    isSKPWS [PktWithWireRep]
_ = Bool
False

brokenWithWireRep
    :: Int -> Parser [PktWithWireRep] PktWithWireRep
brokenWithWireRep :: Int -> Parser [PktWithWireRep] PktWithWireRep
brokenWithWireRep Int
t = do
    bpkts <- ([PktWithWireRep] -> Bool)
-> Parser LeftBiasedLocal [PktWithWireRep] [PktWithWireRep]
forall s t. FactorialMonoid s => (s -> Bool) -> Parser t s s
satisfy [PktWithWireRep] -> Bool
isBrokenWS
    case bpkts of
        [PktWithWireRep
bp] -> PktWithWireRep -> Parser [PktWithWireRep] PktWithWireRep
forall a. a -> Parser LeftBiasedLocal [PktWithWireRep] a
forall (m :: * -> *) a. Monad m => a -> m a
return PktWithWireRep
bp
        [PktWithWireRep]
_ -> Parser [PktWithWireRep] PktWithWireRep
forall t s r. Parser t s r
failure
  where
    isBrokenWS :: [PktWithWireRep] -> Bool
isBrokenWS [PktWithWireRep
pktWithSource] =
        case PktWithWireRep
pktWithSource PktWithWireRep -> Getting Pkt PktWithWireRep Pkt -> Pkt
forall s a. s -> Getting a s a -> a
^. (PktWithBytes -> Const Pkt PktWithBytes)
-> PktWithWireRep -> Const Pkt PktWithWireRep
Lens' PktWithWireRep PktWithBytes
pktWireRep ((PktWithBytes -> Const Pkt PktWithBytes)
 -> PktWithWireRep -> Const Pkt PktWithWireRep)
-> ((Pkt -> Const Pkt Pkt)
    -> PktWithBytes -> Const Pkt PktWithBytes)
-> Getting Pkt PktWithWireRep Pkt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Pkt -> Const Pkt Pkt) -> PktWithBytes -> Const Pkt PktWithBytes
Lens' PktWithBytes Pkt
pktValue of
            BrokenPacketPkt String
_ Word8
a ByteString
_ -> Int
t Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
a
            Pkt
_ -> Bool
False
    isBrokenWS [PktWithWireRep]
_ = Bool
False

parseTKsWithWireRep
    :: Bool -> [PktWithWireRep] -> [TKWithWireRep]
parseTKsWithWireRep :: Bool -> [PktWithWireRep] -> [TKWithWireRep]
parseTKsWithWireRep Bool
intolerant [PktWithWireRep]
ps =
    [Maybe TKWithWireRep] -> [TKWithWireRep]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe TKWithWireRep] -> [TKWithWireRep])
-> [Maybe TKWithWireRep] -> [TKWithWireRep]
forall a b. (a -> b) -> a -> b
$
        Parser [PktWithWireRep] (Maybe TKWithWireRep)
-> [[PktWithWireRep]] -> [Maybe TKWithWireRep]
forall s r. (Monoid s, Show s) => Parser s r -> [s] -> [r]
runIncrementalParser
            (Bool -> Parser [PktWithWireRep] (Maybe TKWithWireRep)
anyTKWithWireRep Bool
intolerant)
            ((PktWithWireRep -> [PktWithWireRep])
-> [PktWithWireRep] -> [[PktWithWireRep]]
forall a b. (a -> b) -> [a] -> [b]
map (PktWithWireRep -> [PktWithWireRep] -> [PktWithWireRep]
forall a. a -> [a] -> [a]
: []) ((PktWithWireRep -> Bool) -> [PktWithWireRep] -> [PktWithWireRep]
forall a. (a -> Bool) -> [a] -> [a]
filter PktWithWireRep -> Bool
notTrustPacketWithWireRep [PktWithWireRep]
ps))
  where
    notTrustPacketWithWireRep :: PktWithWireRep -> Bool
notTrustPacketWithWireRep = Bool -> Bool
not (Bool -> Bool)
-> (PktWithWireRep -> Bool) -> PktWithWireRep -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pkt -> Bool
isTrustPkt (Pkt -> Bool) -> (PktWithWireRep -> Pkt) -> PktWithWireRep -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PktWithWireRep -> Getting Pkt PktWithWireRep Pkt -> Pkt
forall s a. s -> Getting a s a -> a
^. (PktWithBytes -> Const Pkt PktWithBytes)
-> PktWithWireRep -> Const Pkt PktWithWireRep
Lens' PktWithWireRep PktWithBytes
pktWireRep ((PktWithBytes -> Const Pkt PktWithBytes)
 -> PktWithWireRep -> Const Pkt PktWithWireRep)
-> ((Pkt -> Const Pkt Pkt)
    -> PktWithBytes -> Const Pkt PktWithBytes)
-> Getting Pkt PktWithWireRep Pkt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Pkt -> Const Pkt Pkt) -> PktWithBytes -> Const Pkt PktWithBytes
Lens' PktWithBytes Pkt
pktValue)

runIncrementalParser
    :: (Monoid s, Show s)
    => Parser s r
    -> [s]
    -> [r]
runIncrementalParser :: forall s r. (Monoid s, Show s) => Parser s r -> [s] -> [r]
runIncrementalParser Parser s r
parser [s]
chunks = ([(r, s)], Maybe (Maybe (r -> r), Parser s r)) -> [s] -> [r]
go ([], (Maybe (r -> r), Parser s r) -> Maybe (Maybe (r -> r), Parser s r)
forall a. a -> Maybe a
Just (Maybe (r -> r)
forall a. Maybe a
Nothing, Parser s r
parser)) [s]
chunks
  where
    go :: ([(r, s)], Maybe (Maybe (r -> r), Parser s r)) -> [s] -> [r]
go ([(r, s)], Maybe (Maybe (r -> r), Parser s r))
st [] = (([(r, s)], Maybe (Maybe (r -> r), Parser s r)), [r]) -> [r]
forall a b. (a, b) -> b
snd (([(r, s)], Maybe (Maybe (r -> r), Parser s r))
-> (([(r, s)], Maybe (Maybe (r -> r), Parser s r)), [r])
forall s r.
Monoid s =>
([(r, s)], Maybe (Maybe (r -> r), Parser s r))
-> (([(r, s)], Maybe (Maybe (r -> r), Parser s r)), [r])
finalizeParsing ([(r, s)], Maybe (Maybe (r -> r), Parser s r))
st)
    go ([(r, s)], Maybe (Maybe (r -> r), Parser s r))
st (s
chunk : [s]
rest) =
        let (([(r, s)], Maybe (Maybe (r -> r), Parser s r))
st', [r]
out) = Parser s r
-> s
-> ([(r, s)], Maybe (Maybe (r -> r), Parser s r))
-> (([(r, s)], Maybe (Maybe (r -> r), Parser s r)), [r])
forall s r.
(Monoid s, Show s) =>
Parser s r
-> s
-> ([(r, s)], Maybe (Maybe (r -> r), Parser s r))
-> (([(r, s)], Maybe (Maybe (r -> r), Parser s r)), [r])
parseAChunk Parser s r
parser s
chunk ([(r, s)], Maybe (Maybe (r -> r), Parser s r))
st
         in [r]
out [r] -> [r] -> [r]
forall a. Semigroup a => a -> a -> a
<> ([(r, s)], Maybe (Maybe (r -> r), Parser s r)) -> [s] -> [r]
go ([(r, s)], Maybe (Maybe (r -> r), Parser s r))
st' [s]
rest

mkTKWithWireRep :: TKUnknown -> [PktWithWireRep] -> TKWithWireRep
mkTKWithWireRep :: TKUnknown -> [PktWithWireRep] -> TKWithWireRep
mkTKWithWireRep TKUnknown
tk [PktWithWireRep]
refs =
    case [PktWithWireRep]
refs of
        [] ->
            String -> TKWithWireRep
forall a. HasCallStack => String -> a
error String
"mkTKWithWireRep requires at least one packet reference"
        (PktWithWireRep
pktWithSource : [PktWithWireRep]
_) ->
            WireRepRefs
-> Maybe ByteRange
-> [PktWithWireRep]
-> TKUnknown
-> TKWithWireRep
TKWithWireRep
                (WireRepRef -> WireRepRefs
forall a. a -> NonEmpty a
NE.singleton (PktWithWireRep -> WireRepRef
wireRepOfPkt PktWithWireRep
pktWithSource))
                ([ByteRange] -> Maybe ByteRange
spanByteRanges ((PktWithWireRep -> ByteRange) -> [PktWithWireRep] -> [ByteRange]
forall a b. (a -> b) -> [a] -> [b]
map PktWithWireRep -> ByteRange
_pktRange [PktWithWireRep]
refs))
                [PktWithWireRep]
refs
                TKUnknown
tk