-- 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
    , anyTK
    , anyTKWithWireRep
    , UidOrUat (..)
    , splitUs
    , publicTK
    , publicTKWithWireRep
    , secretTK
    , secretTKWithWireRep
    , mixedTKWithWireRep
    , brokenTK
    , brokenTKWithWireRep
    , pkPayload
    , pkPayloadWithWireRep
    , signature
    , signatureWithWireRep
    , signedUID
    , signedUIDWithWireRep
    , signedUAt
    , signedUAtWithWireRep
    , signedOrRevokedPubSubkey
    , signedOrRevokedPubSubkeyWithWireRep
    , brokenPubSubkey
    , brokenPubSubkeyWithWireRep
    , rawOrSignedOrRevokedSecSubkey
    , rawOrSignedOrRevokedSecSubkeyWithWireRep
    , brokenSecSubkey
    , brokenSecSubkeyWithWireRep
    , skPayload
    , skPayloadWithWireRep
    , broken
    , brokenWithWireRep

      -- * Utilities
    , parseTKsEither
    , parseTKs
    , parsePublicTKs
    , parseSecretTKs
    , parseMixedTKs
    , parseTKsWithWireRep
    , parseMixedTKsWithWireRep
    ) 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 ()

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
        ([Char] -> (([(r, s)], Maybe (Maybe (r -> r), Parser s r)), [r])
forall a. HasCallStack => [Char] -> a
error ([Char] -> (([(r, s)], Maybe (Maybe (r -> r), Parser s r)), [r]))
-> (KeyringChunkParseError -> [Char])
-> KeyringChunkParseError
-> (([(r, s)], Maybe (Maybe (r -> r), Parser s r)), [r])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KeyringChunkParseError -> [Char]
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 ([Char] -> KeyringChunkParseError
ChunkFailureBeforeInput ([Char]
"Failure before " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ s -> [Char]
forall a. Show a => a -> [Char]
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
<$> ([Char]
 -> 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 [Char] ([(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)))
-> ([Char] -> KeyringChunkParseError)
-> [Char]
-> Either
     KeyringChunkParseError
     ([(r, s)], Maybe (Maybe (r -> r), Parser s r))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> 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 [Char] ([(r, s)], Maybe (Maybe (r -> r), Parser s r))
forall t s r.
Parser t s r
-> Either [Char] ([(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
<$> ([Char]
 -> 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 [Char] ([(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)))
-> ([Char] -> KeyringChunkParseError)
-> [Char]
-> Either
     KeyringChunkParseError
     ([(r, s)], Maybe (Maybe (r -> r), Parser s r))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> 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 [Char] ([(r, s)], Maybe (Maybe (r -> r), Parser s r))
forall t s r.
Parser t s r
-> Either [Char] ([(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
        ([Char] -> (([(r, s)], Maybe (Maybe (r -> r), Parser s r)), [r])
forall a. HasCallStack => [Char] -> a
error ([Char] -> (([(r, s)], Maybe (Maybe (r -> r), Parser s r)), [r]))
-> (KeyringChunkParseError -> [Char])
-> KeyringChunkParseError
-> (([(r, s)], Maybe (Maybe (r -> r), Parser s r)), [r])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KeyringChunkParseError -> [Char]
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)) =
    ([Char]
 -> 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 [Char] ([(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]))
-> ([Char] -> KeyringChunkParseError)
-> [Char]
-> Either
     KeyringChunkParseError
     (([(r, s)], Maybe (Maybe (r -> r), Parser s r)), [r])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> 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 [Char] ([(r, s)], Maybe (Maybe (r -> r), Parser s r))
forall t s r.
Parser t s r
-> Either [Char] ([(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 SomeTK)
anyTK :: Bool -> Parser [Pkt] (Maybe SomeTK)
anyTK Bool
intolerant = Bool -> Parser [Pkt] (Maybe SomeTK)
publicTK Bool
intolerant Parser [Pkt] (Maybe SomeTK)
-> Parser [Pkt] (Maybe SomeTK) -> Parser [Pkt] (Maybe SomeTK)
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 SomeTK)
secretTK Bool
intolerant

data UidOrUat
    = I Text
    | A [UserAttrSubPacket]
    deriving (Int -> UidOrUat -> [Char] -> [Char]
[UidOrUat] -> [Char] -> [Char]
UidOrUat -> [Char]
(Int -> UidOrUat -> [Char] -> [Char])
-> (UidOrUat -> [Char])
-> ([UidOrUat] -> [Char] -> [Char])
-> Show UidOrUat
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
$cshowsPrec :: Int -> UidOrUat -> [Char] -> [Char]
showsPrec :: Int -> UidOrUat -> [Char] -> [Char]
$cshow :: UidOrUat -> [Char]
show :: UidOrUat -> [Char]
$cshowList :: [UidOrUat] -> [Char] -> [Char]
showList :: [UidOrUat] -> [Char] -> [Char]
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 = [Char] -> (Text, b)
forall a. HasCallStack => [Char] -> a
error ([Char] -> (Text, b)) -> [Char] -> (Text, b)
forall a b. (a -> b) -> a -> b
$ [Char]
"unI should never be called on " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ (UidOrUat, b) -> [Char]
forall a. Show a => a -> [Char]
show (UidOrUat, b)
x
    unA :: (UidOrUat, b) -> ([UserAttrSubPacket], b)
unA (A [UserAttrSubPacket]
x, b
y) = ([UserAttrSubPacket]
x, b
y)
    unA (UidOrUat, b)
x = [Char] -> ([UserAttrSubPacket], b)
forall a. HasCallStack => [Char] -> a
error ([Char] -> ([UserAttrSubPacket], b))
-> [Char] -> ([UserAttrSubPacket], b)
forall a b. (a -> b) -> a -> b
$ [Char]
"unA should never be called on " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ (UidOrUat, b) -> [Char]
forall a. Show a => a -> [Char]
show (UidOrUat, b)
x

publicTK :: Bool -> Parser [Pkt] (Maybe SomeTK)
publicTK :: Bool -> Parser [Pkt] (Maybe SomeTK)
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))
    rawSubs <- concatMany (pubsub intolerant)
    let revs = (SignaturePayload -> Bool)
-> [SignaturePayload] -> [SignaturePayload]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Maybe SigType -> Maybe SigType -> Bool
forall a. Eq a => a -> a -> Bool
== SigType -> Maybe SigType
forall a. a -> Maybe a
Just SigType
KeyRevocationSig) (Maybe SigType -> Bool)
-> (SignaturePayload -> Maybe SigType) -> SignaturePayload -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SignaturePayload -> Maybe SigType
sigType) [SignaturePayload]
pkpsigs
        directKeySigs = (SignaturePayload -> Bool)
-> [SignaturePayload] -> [SignaturePayload]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Maybe SigType -> Maybe SigType -> Bool
forall a. Eq a => a -> a -> Bool
== SigType -> Maybe SigType
forall a. a -> Maybe a
Just SigType
DirectKeySignature) (Maybe SigType -> Bool)
-> (SignaturePayload -> Maybe SigType) -> SignaturePayload -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SignaturePayload -> Maybe SigType
sigType) [SignaturePayload]
pkpsigs
        subs = ((Pkt, [SignaturePayload])
 -> Maybe (KeyPkt 'PublicPkt, [SignaturePayload]))
-> [(Pkt, [SignaturePayload])]
-> [(KeyPkt 'PublicPkt, [SignaturePayload])]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Pkt, [SignaturePayload])
-> Maybe (KeyPkt 'PublicPkt, [SignaturePayload])
forall {b}. (Pkt, b) -> Maybe (KeyPkt 'PublicPkt, b)
subToPublic [(Pkt, [SignaturePayload])]
rawSubs
        typed =
            TK
                { _tkPrimaryKey :: TKKeyPkt 'PublicTK
_tkPrimaryKey = SomePKPayload -> KeyPkt 'PublicPkt
KeyPktPublicPrimary SomePKPayload
pkp
                , _tkRevs :: [SignaturePayload]
_tkRevs = [SignaturePayload]
revs
                , _tkDirectKeySigs :: [SignaturePayload]
_tkDirectKeySigs = [SignaturePayload]
directKeySigs
                , _tkUIDs :: [(Text, [SignaturePayload])]
_tkUIDs = [(Text, [SignaturePayload])]
uids
                , _tkUAts :: [([UserAttrSubPacket], [SignaturePayload])]
_tkUAts = [([UserAttrSubPacket], [SignaturePayload])]
uats
                , _tkSubs :: [(TKKeyPkt 'PublicTK, [SignaturePayload])]
_tkSubs = [(KeyPkt 'PublicPkt, [SignaturePayload])]
[(TKKeyPkt 'PublicTK, [SignaturePayload])]
subs
                }
    return (Just (SomePublicTK typed))
  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
    subToPublic :: (Pkt, b) -> Maybe (KeyPkt 'PublicPkt, b)
subToPublic (Pkt
pkt, b
sigs) = (KeyPkt 'PublicPkt -> (KeyPkt 'PublicPkt, b))
-> Maybe (KeyPkt 'PublicPkt) -> Maybe (KeyPkt 'PublicPkt, b)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\KeyPkt 'PublicPkt
kp -> (KeyPkt 'PublicPkt
kp, b
sigs)) (Pkt -> Maybe (KeyPkt 'PublicPkt)
pktToPublicKeyPkt Pkt
pkt)

secretTK :: Bool -> Parser [Pkt] (Maybe SomeTK)
secretTK :: Bool -> Parser [Pkt] (Maybe SomeTK)
secretTK Bool
intolerant = do
    (pkp, maybeSka) <- Parser [Pkt] (SomePKPayload, Maybe SKAddendum)
skPayload
    case maybeSka of
        Just SKAddendum
ska -> do
            skpsigs <-
                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
isAllowedPrimaryKeySigType)
            (uids, uats) <-
                fmap
                    splitUs
                    (many (signedUID intolerant <|> signedUAt intolerant))
            rawSubs <- concatMany (secsub intolerant)
            let revs = (SignaturePayload -> Bool)
-> [SignaturePayload] -> [SignaturePayload]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Maybe SigType -> Maybe SigType -> Bool
forall a. Eq a => a -> a -> Bool
== SigType -> Maybe SigType
forall a. a -> Maybe a
Just SigType
KeyRevocationSig) (Maybe SigType -> Bool)
-> (SignaturePayload -> Maybe SigType) -> SignaturePayload -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SignaturePayload -> Maybe SigType
sigType) [SignaturePayload]
skpsigs
                directKeySigs = (SignaturePayload -> Bool)
-> [SignaturePayload] -> [SignaturePayload]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Maybe SigType -> Maybe SigType -> Bool
forall a. Eq a => a -> a -> Bool
== SigType -> Maybe SigType
forall a. a -> Maybe a
Just SigType
DirectKeySignature) (Maybe SigType -> Bool)
-> (SignaturePayload -> Maybe SigType) -> SignaturePayload -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SignaturePayload -> Maybe SigType
sigType) [SignaturePayload]
skpsigs
                subs = ((Pkt, [SignaturePayload])
 -> Maybe (KeyPkt 'SecretPkt, [SignaturePayload]))
-> [(Pkt, [SignaturePayload])]
-> [(KeyPkt 'SecretPkt, [SignaturePayload])]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Pkt, [SignaturePayload])
-> Maybe (KeyPkt 'SecretPkt, [SignaturePayload])
forall {b}. (Pkt, b) -> Maybe (KeyPkt 'SecretPkt, b)
subToSecret [(Pkt, [SignaturePayload])]
rawSubs
                typed =
                    TK
                        { _tkPrimaryKey :: TKKeyPkt 'SecretTK
_tkPrimaryKey = SomePKPayload -> SKAddendum -> KeyPkt 'SecretPkt
KeyPktSecretPrimary SomePKPayload
pkp SKAddendum
ska
                        , _tkRevs :: [SignaturePayload]
_tkRevs = [SignaturePayload]
revs
                        , _tkDirectKeySigs :: [SignaturePayload]
_tkDirectKeySigs = [SignaturePayload]
directKeySigs
                        , _tkUIDs :: [(Text, [SignaturePayload])]
_tkUIDs = [(Text, [SignaturePayload])]
uids
                        , _tkUAts :: [([UserAttrSubPacket], [SignaturePayload])]
_tkUAts = [([UserAttrSubPacket], [SignaturePayload])]
uats
                        , _tkSubs :: [(TKKeyPkt 'SecretTK, [SignaturePayload])]
_tkSubs = [(KeyPkt 'SecretPkt, [SignaturePayload])]
[(TKKeyPkt 'SecretTK, [SignaturePayload])]
subs
                        }
            return (Just (SomeSecretTK typed))
          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
            subToSecret :: (Pkt, b) -> Maybe (KeyPkt 'SecretPkt, b)
subToSecret (Pkt
pkt, b
sigs) = (KeyPkt 'SecretPkt -> (KeyPkt 'SecretPkt, b))
-> Maybe (KeyPkt 'SecretPkt) -> Maybe (KeyPkt 'SecretPkt, b)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\KeyPkt 'SecretPkt
kp -> (KeyPkt 'SecretPkt
kp, b
sigs)) (Pkt -> Maybe (KeyPkt 'SecretPkt)
pktToSecretKeyPkt Pkt
pkt)
        Maybe SKAddendum
Nothing -> [Char] -> Parser [Pkt] (Maybe SomeTK)
forall a. [Char] -> Parser LeftBiasedLocal [Pkt] a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"secret primary key missing secret addendum"

brokenTK :: Int -> Parser [Pkt] (Maybe SomeTK)
brokenTK :: Int -> Parser [Pkt] (Maybe SomeTK)
brokenTK Int
6 = do
    _ <- Int -> Parser [Pkt] Pkt
broken Int
6
    _ <-
        many
            (signature False [KeyRevocationSig, DirectKeySignature])
    _ <- 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, DirectKeySignature])
    _ <- many (signedUID False <|> signedUAt False)
    _ <-
        concatMany
            (rawOrSignedOrRevokedSecSubkey False <|> brokenSecSubkey)
    return Nothing
brokenTK Int
_ = [Char] -> Parser [Pkt] (Maybe SomeTK)
forall a. [Char] -> Parser LeftBiasedLocal [Pkt] a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"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 [Char]
_ 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

parseTKsEither
    :: Bool -> [Pkt] -> [Either TKConversionError SomeTK]
parseTKsEither :: Bool -> [Pkt] -> [Either TKConversionError SomeTK]
parseTKsEither Bool
intolerant [Pkt]
ps =
    (SomeTK -> Either TKConversionError SomeTK)
-> [SomeTK] -> [Either TKConversionError SomeTK]
forall a b. (a -> b) -> [a] -> [b]
map SomeTK -> Either TKConversionError SomeTK
forall a b. b -> Either a b
Right ([SomeTK] -> [Either TKConversionError SomeTK])
-> [SomeTK] -> [Either TKConversionError SomeTK]
forall a b. (a -> b) -> a -> b
$
        [Maybe SomeTK] -> [SomeTK]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe SomeTK] -> [SomeTK]) -> [Maybe SomeTK] -> [SomeTK]
forall a b. (a -> b) -> a -> b
$
            Parser [Pkt] (Maybe SomeTK) -> [[Pkt]] -> [Maybe SomeTK]
forall s r. (Monoid s, Show s) => Parser s r -> [s] -> [r]
runIncrementalParser
                (Bool -> Parser [Pkt] (Maybe SomeTK)
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

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)

parseMixedTKs :: Bool -> [Pkt] -> [TK 'MixedTK]
parseMixedTKs :: Bool -> [Pkt] -> [TK 'MixedTK]
parseMixedTKs Bool
intolerant [Pkt]
packets =
    (SomeTK -> Maybe (TK 'MixedTK)) -> [SomeTK] -> [TK 'MixedTK]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe SomeTK -> Maybe (TK 'MixedTK)
someTKToMixedTK (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 = (((SomeKeyPkt, [SignaturePayload]), [PktWithWireRep])
 -> (SomeKeyPkt, [SignaturePayload]))
-> [((SomeKeyPkt, [SignaturePayload]), [PktWithWireRep])]
-> [(SomeKeyPkt, [SignaturePayload])]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((SomeKeyPkt, [SignaturePayload]), [PktWithWireRep])
-> (SomeKeyPkt, [SignaturePayload])
forall a b. (a, b) -> a
fst [((SomeKeyPkt, [SignaturePayload]), [PktWithWireRep])]
subResults
        subrefs = (((SomeKeyPkt, [SignaturePayload]), [PktWithWireRep])
 -> [PktWithWireRep])
-> [((SomeKeyPkt, [SignaturePayload]), [PktWithWireRep])]
-> [PktWithWireRep]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((SomeKeyPkt, [SignaturePayload]), [PktWithWireRep])
-> [PktWithWireRep]
forall a b. (a, b) -> b
snd [((SomeKeyPkt, [SignaturePayload]), [PktWithWireRep])]
subResults
        revs = (SignaturePayload -> Bool)
-> [SignaturePayload] -> [SignaturePayload]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Maybe SigType -> Maybe SigType -> Bool
forall a. Eq a => a -> a -> Bool
== SigType -> Maybe SigType
forall a. a -> Maybe a
Just SigType
KeyRevocationSig) (Maybe SigType -> Bool)
-> (SignaturePayload -> Maybe SigType) -> SignaturePayload -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SignaturePayload -> Maybe SigType
sigType) [SignaturePayload]
pkpsigs
        directKeySigs = (SignaturePayload -> Bool)
-> [SignaturePayload] -> [SignaturePayload]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Maybe SigType -> Maybe SigType -> Bool
forall a. Eq a => a -> a -> Bool
== SigType -> Maybe SigType
forall a. a -> Maybe a
Just SigType
DirectKeySignature) (Maybe SigType -> Bool)
-> (SignaturePayload -> Maybe SigType) -> SignaturePayload -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SignaturePayload -> Maybe SigType
sigType) [SignaturePayload]
pkpsigs
        tk =
            TK
                { _tkPrimaryKey :: TKKeyPkt 'MixedTK
_tkPrimaryKey = KeyPkt 'PublicPkt -> SomeKeyPkt
forall (k :: KeyPktKind). KeyPkt k -> SomeKeyPkt
SomeKeyPkt (SomePKPayload -> KeyPkt 'PublicPkt
KeyPktPublicPrimary SomePKPayload
pkp)
                , _tkRevs :: [SignaturePayload]
_tkRevs = [SignaturePayload]
revs
                , _tkDirectKeySigs :: [SignaturePayload]
_tkDirectKeySigs = [SignaturePayload]
directKeySigs
                , _tkUIDs :: [(Text, [SignaturePayload])]
_tkUIDs = [(Text, [SignaturePayload])]
uids
                , _tkUAts :: [([UserAttrSubPacket], [SignaturePayload])]
_tkUAts = [([UserAttrSubPacket], [SignaturePayload])]
uats
                , _tkSubs :: [(TKKeyPkt 'MixedTK, [SignaturePayload])]
_tkSubs = [(SomeKeyPkt, [SignaturePayload])]
[(TKKeyPkt 'MixedTK, [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]
     [((SomeKeyPkt, [SignaturePayload]), [PktWithWireRep])]
pubsub Bool
True = Bool
-> Parser
     LeftBiasedLocal
     [PktWithWireRep]
     [((SomeKeyPkt, [SignaturePayload]), [PktWithWireRep])]
signedOrRevokedPubSubkeyWithWireRep Bool
True
    pubsub Bool
False =
        Bool
-> Parser
     LeftBiasedLocal
     [PktWithWireRep]
     [((SomeKeyPkt, [SignaturePayload]), [PktWithWireRep])]
signedOrRevokedPubSubkeyWithWireRep Bool
False
            Parser
  LeftBiasedLocal
  [PktWithWireRep]
  [((SomeKeyPkt, [SignaturePayload]), [PktWithWireRep])]
-> Parser
     LeftBiasedLocal
     [PktWithWireRep]
     [((SomeKeyPkt, [SignaturePayload]), [PktWithWireRep])]
-> Parser
     LeftBiasedLocal
     [PktWithWireRep]
     [((SomeKeyPkt, [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]
  [((SomeKeyPkt, [SignaturePayload]), [PktWithWireRep])]
brokenPubSubkeyWithWireRep
secretTKWithWireRep :: Bool -> Parser [PktWithWireRep] (Maybe TKWithWireRep)
secretTKWithWireRep Bool
intolerant = do
    ((pkp, maybeSka), skps) <- Parser
  [PktWithWireRep]
  ((SomePKPayload, Maybe SKAddendum), [PktWithWireRep])
skPayloadWithWireRep
    case maybeSka of
        Just SKAddendum
ska -> do
            (skpsigs, skpsigrefs) <-
                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
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 = (((SomeKeyPkt, [SignaturePayload]), [PktWithWireRep])
 -> (SomeKeyPkt, [SignaturePayload]))
-> [((SomeKeyPkt, [SignaturePayload]), [PktWithWireRep])]
-> [(SomeKeyPkt, [SignaturePayload])]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((SomeKeyPkt, [SignaturePayload]), [PktWithWireRep])
-> (SomeKeyPkt, [SignaturePayload])
forall a b. (a, b) -> a
fst [((SomeKeyPkt, [SignaturePayload]), [PktWithWireRep])]
subResults
                subrefs = (((SomeKeyPkt, [SignaturePayload]), [PktWithWireRep])
 -> [PktWithWireRep])
-> [((SomeKeyPkt, [SignaturePayload]), [PktWithWireRep])]
-> [PktWithWireRep]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((SomeKeyPkt, [SignaturePayload]), [PktWithWireRep])
-> [PktWithWireRep]
forall a b. (a, b) -> b
snd [((SomeKeyPkt, [SignaturePayload]), [PktWithWireRep])]
subResults
                revs = (SignaturePayload -> Bool)
-> [SignaturePayload] -> [SignaturePayload]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Maybe SigType -> Maybe SigType -> Bool
forall a. Eq a => a -> a -> Bool
== SigType -> Maybe SigType
forall a. a -> Maybe a
Just SigType
KeyRevocationSig) (Maybe SigType -> Bool)
-> (SignaturePayload -> Maybe SigType) -> SignaturePayload -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SignaturePayload -> Maybe SigType
sigType) [SignaturePayload]
skpsigs
                directKeySigs = (SignaturePayload -> Bool)
-> [SignaturePayload] -> [SignaturePayload]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Maybe SigType -> Maybe SigType -> Bool
forall a. Eq a => a -> a -> Bool
== SigType -> Maybe SigType
forall a. a -> Maybe a
Just SigType
DirectKeySignature) (Maybe SigType -> Bool)
-> (SignaturePayload -> Maybe SigType) -> SignaturePayload -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SignaturePayload -> Maybe SigType
sigType) [SignaturePayload]
skpsigs
                tk =
                    TK
                        { _tkPrimaryKey :: TKKeyPkt 'MixedTK
_tkPrimaryKey = KeyPkt 'SecretPkt -> SomeKeyPkt
forall (k :: KeyPktKind). KeyPkt k -> SomeKeyPkt
SomeKeyPkt (SomePKPayload -> SKAddendum -> KeyPkt 'SecretPkt
KeyPktSecretPrimary SomePKPayload
pkp SKAddendum
ska)
                        , _tkRevs :: [SignaturePayload]
_tkRevs = [SignaturePayload]
revs
                        , _tkDirectKeySigs :: [SignaturePayload]
_tkDirectKeySigs = [SignaturePayload]
directKeySigs
                        , _tkUIDs :: [(Text, [SignaturePayload])]
_tkUIDs = [(Text, [SignaturePayload])]
uids
                        , _tkUAts :: [([UserAttrSubPacket], [SignaturePayload])]
_tkUAts = [([UserAttrSubPacket], [SignaturePayload])]
uats
                        , _tkSubs :: [(TKKeyPkt 'MixedTK, [SignaturePayload])]
_tkSubs = [(SomeKeyPkt, [SignaturePayload])]
[(TKKeyPkt 'MixedTK, [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]
     [((SomeKeyPkt, [SignaturePayload]), [PktWithWireRep])]
secsub Bool
True = Bool
-> Parser
     LeftBiasedLocal
     [PktWithWireRep]
     [((SomeKeyPkt, [SignaturePayload]), [PktWithWireRep])]
rawOrSignedOrRevokedSecSubkeyWithWireRep Bool
True
            secsub Bool
False =
                Bool
-> Parser
     LeftBiasedLocal
     [PktWithWireRep]
     [((SomeKeyPkt, [SignaturePayload]), [PktWithWireRep])]
rawOrSignedOrRevokedSecSubkeyWithWireRep Bool
False
                    Parser
  LeftBiasedLocal
  [PktWithWireRep]
  [((SomeKeyPkt, [SignaturePayload]), [PktWithWireRep])]
-> Parser
     LeftBiasedLocal
     [PktWithWireRep]
     [((SomeKeyPkt, [SignaturePayload]), [PktWithWireRep])]
-> Parser
     LeftBiasedLocal
     [PktWithWireRep]
     [((SomeKeyPkt, [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]
  [((SomeKeyPkt, [SignaturePayload]), [PktWithWireRep])]
brokenSecSubkeyWithWireRep
        Maybe SKAddendum
Nothing -> [Char] -> Parser [PktWithWireRep] (Maybe TKWithWireRep)
forall a. [Char] -> Parser LeftBiasedLocal [PktWithWireRep] a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"secret primary key missing secret addendum"

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
_ = [Char] -> Parser [PktWithWireRep] (Maybe TKWithWireRep)
forall a. [Char] -> Parser LeftBiasedLocal [PktWithWireRep] a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"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]
        [((SomeKeyPkt, [SignaturePayload]), [PktWithWireRep])]
signedOrRevokedPubSubkeyWithWireRep :: Bool
-> Parser
     LeftBiasedLocal
     [PktWithWireRep]
     [((SomeKeyPkt, [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)
            let Just keyPkt = pktToPublicKeyPkt (pktWithSource ^. pktWireRep . pktValue)
            return
                [
                    ( (SomeKeyPkt keyPkt, sigs)
                    , pktWithSource : sigrefs
                    )
                ]
        [PktWithWireRep]
_ -> Parser
  LeftBiasedLocal
  [PktWithWireRep]
  [((SomeKeyPkt, [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]
        [((SomeKeyPkt, [SignaturePayload]), [PktWithWireRep])]
brokenPubSubkeyWithWireRep :: Parser
  LeftBiasedLocal
  [PktWithWireRep]
  [((SomeKeyPkt, [SignaturePayload]), [PktWithWireRep])]
brokenPubSubkeyWithWireRep = do
    _ <- Int -> Parser [PktWithWireRep] PktWithWireRep
brokenWithWireRep Int
14
    _ <-
        concatMany
            (signatureWithWireRepPredicate False isAllowedSubkeySigType)
    return []

rawOrSignedOrRevokedSecSubkeyWithWireRep
    :: Bool
    -> Parser
        [PktWithWireRep]
        [((SomeKeyPkt, [SignaturePayload]), [PktWithWireRep])]
rawOrSignedOrRevokedSecSubkeyWithWireRep :: Bool
-> Parser
     LeftBiasedLocal
     [PktWithWireRep]
     [((SomeKeyPkt, [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)
            let Just keyPkt = pktToSecretKeyPkt (pktWithSource ^. pktWireRep . pktValue)
            return
                [
                    ( (SomeKeyPkt keyPkt, sigs)
                    , pktWithSource : sigrefs
                    )
                ]
        [PktWithWireRep]
_ -> Parser
  LeftBiasedLocal
  [PktWithWireRep]
  [((SomeKeyPkt, [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]
        [((SomeKeyPkt, [SignaturePayload]), [PktWithWireRep])]
brokenSecSubkeyWithWireRep :: Parser
  LeftBiasedLocal
  [PktWithWireRep]
  [((SomeKeyPkt, [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 [Char]
_ 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

mixedPrimaryWithWireRep
    :: Parser [PktWithWireRep] (SomeKeyPkt, [PktWithWireRep])
mixedPrimaryWithWireRep :: Parser [PktWithWireRep] (SomeKeyPkt, [PktWithWireRep])
mixedPrimaryWithWireRep = do
    pkpkts <- ([PktWithWireRep] -> Bool)
-> Parser LeftBiasedLocal [PktWithWireRep] [PktWithWireRep]
forall s t. FactorialMonoid s => (s -> Bool) -> Parser t s s
satisfy [PktWithWireRep] -> Bool
isMixedPrimaryWS
    case pkpkts of
        [PktWithWireRep
pktWithSource] ->
            case Pkt -> Maybe SomeKeyPkt
pktToSomeKeyPkt (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 SomeKeyPkt
keyPkt
                    | SomeKeyPkt -> KeyPktRole
someKeyPktRole SomeKeyPkt
keyPkt KeyPktRole -> KeyPktRole -> Bool
forall a. Eq a => a -> a -> Bool
== KeyPktRole
KeyPktPrimary ->
                        (SomeKeyPkt, [PktWithWireRep])
-> Parser [PktWithWireRep] (SomeKeyPkt, [PktWithWireRep])
forall a. a -> Parser LeftBiasedLocal [PktWithWireRep] a
forall (m :: * -> *) a. Monad m => a -> m a
return (SomeKeyPkt
keyPkt, [PktWithWireRep
pktWithSource])
                Maybe SomeKeyPkt
_ -> Parser [PktWithWireRep] (SomeKeyPkt, [PktWithWireRep])
forall t s r. Parser t s r
failure
        [PktWithWireRep]
_ -> Parser [PktWithWireRep] (SomeKeyPkt, [PktWithWireRep])
forall t s r. Parser t s r
failure
  where
    isMixedPrimaryWS :: [PktWithWireRep] -> Bool
isMixedPrimaryWS [PktWithWireRep
pktWithSource] =
        case Pkt -> Maybe SomeKeyPkt
pktToSomeKeyPkt (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 SomeKeyPkt
keyPkt -> SomeKeyPkt -> KeyPktRole
someKeyPktRole SomeKeyPkt
keyPkt KeyPktRole -> KeyPktRole -> Bool
forall a. Eq a => a -> a -> Bool
== KeyPktRole
KeyPktPrimary
            Maybe SomeKeyPkt
Nothing -> Bool
False
    isMixedPrimaryWS [PktWithWireRep]
_ = Bool
False

mixedSubkeyWithWireRep
    :: Bool
    -> Parser
        [PktWithWireRep]
        [((SomeKeyPkt, [SignaturePayload]), [PktWithWireRep])]
mixedSubkeyWithWireRep :: Bool
-> Parser
     LeftBiasedLocal
     [PktWithWireRep]
     [((SomeKeyPkt, [SignaturePayload]), [PktWithWireRep])]
mixedSubkeyWithWireRep Bool
intolerant = do
    pskpkts <- ([PktWithWireRep] -> Bool)
-> Parser LeftBiasedLocal [PktWithWireRep] [PktWithWireRep]
forall s t. FactorialMonoid s => (s -> Bool) -> Parser t s s
satisfy [PktWithWireRep] -> Bool
isMixedSubkeyWS
    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)
            let Just keyPkt = pktToSomeKeyPkt (pktWithSource ^. pktWireRep . pktValue)
            return
                [
                    ( (keyPkt, sigs)
                    , pktWithSource : sigrefs
                    )
                ]
        [PktWithWireRep]
_ -> Parser
  LeftBiasedLocal
  [PktWithWireRep]
  [((SomeKeyPkt, [SignaturePayload]), [PktWithWireRep])]
forall t s r. Parser t s r
failure
  where
    isMixedSubkeyWS :: [PktWithWireRep] -> Bool
isMixedSubkeyWS [PktWithWireRep
pktWithSource] =
        case Pkt -> Maybe SomeKeyPkt
pktToSomeKeyPkt (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 SomeKeyPkt
keyPkt -> SomeKeyPkt -> KeyPktRole
someKeyPktRole SomeKeyPkt
keyPkt KeyPktRole -> KeyPktRole -> Bool
forall a. Eq a => a -> a -> Bool
== KeyPktRole
KeyPktSubkey
            Maybe SomeKeyPkt
_ -> Bool
False
    isMixedSubkeyWS [PktWithWireRep]
_ = Bool
False

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

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

mixedTKWithWireRep
    :: Bool
    -> Parser [PktWithWireRep] (Maybe (TK 'MixedTK, [PktWithWireRep]))
mixedTKWithWireRep :: Bool
-> Parser [PktWithWireRep] (Maybe (TK 'MixedTK, [PktWithWireRep]))
mixedTKWithWireRep Bool
intolerant = do
    (pkp, pkps) <- Parser [PktWithWireRep] (SomeKeyPkt, [PktWithWireRep])
mixedPrimaryWithWireRep
    (pkpsigs, pkpsigrefs) <-
        concatMany
            ( signatureWithWireRepPredicate
                intolerant
                isAllowedPrimaryKeySigType
            )
    uidResults <-
        many
            ( signedUIDWithWireRep intolerant
                <|> signedUAtWithWireRep intolerant
            )
    subResults <- concatMany (mixedSub 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 = (((SomeKeyPkt, [SignaturePayload]), [PktWithWireRep])
 -> (SomeKeyPkt, [SignaturePayload]))
-> [((SomeKeyPkt, [SignaturePayload]), [PktWithWireRep])]
-> [(SomeKeyPkt, [SignaturePayload])]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((SomeKeyPkt, [SignaturePayload]), [PktWithWireRep])
-> (SomeKeyPkt, [SignaturePayload])
forall a b. (a, b) -> a
fst [((SomeKeyPkt, [SignaturePayload]), [PktWithWireRep])]
subResults
        subrefs = (((SomeKeyPkt, [SignaturePayload]), [PktWithWireRep])
 -> [PktWithWireRep])
-> [((SomeKeyPkt, [SignaturePayload]), [PktWithWireRep])]
-> [PktWithWireRep]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((SomeKeyPkt, [SignaturePayload]), [PktWithWireRep])
-> [PktWithWireRep]
forall a b. (a, b) -> b
snd [((SomeKeyPkt, [SignaturePayload]), [PktWithWireRep])]
subResults
        revs = (SignaturePayload -> Bool)
-> [SignaturePayload] -> [SignaturePayload]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Maybe SigType -> Maybe SigType -> Bool
forall a. Eq a => a -> a -> Bool
== SigType -> Maybe SigType
forall a. a -> Maybe a
Just SigType
KeyRevocationSig) (Maybe SigType -> Bool)
-> (SignaturePayload -> Maybe SigType) -> SignaturePayload -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SignaturePayload -> Maybe SigType
sigType) [SignaturePayload]
pkpsigs
        directKeySigs = (SignaturePayload -> Bool)
-> [SignaturePayload] -> [SignaturePayload]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Maybe SigType -> Maybe SigType -> Bool
forall a. Eq a => a -> a -> Bool
== SigType -> Maybe SigType
forall a. a -> Maybe a
Just SigType
DirectKeySignature) (Maybe SigType -> Bool)
-> (SignaturePayload -> Maybe SigType) -> SignaturePayload -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SignaturePayload -> Maybe SigType
sigType) [SignaturePayload]
pkpsigs
        tk =
            TK
                { _tkPrimaryKey :: TKKeyPkt 'MixedTK
_tkPrimaryKey = SomeKeyPkt
TKKeyPkt 'MixedTK
pkp
                , _tkRevs :: [SignaturePayload]
_tkRevs = [SignaturePayload]
revs
                , _tkDirectKeySigs :: [SignaturePayload]
_tkDirectKeySigs = [SignaturePayload]
directKeySigs
                , _tkUIDs :: [(Text, [SignaturePayload])]
_tkUIDs = [(Text, [SignaturePayload])]
uids
                , _tkUAts :: [([UserAttrSubPacket], [SignaturePayload])]
_tkUAts = [([UserAttrSubPacket], [SignaturePayload])]
uats
                , _tkSubs :: [(TKKeyPkt 'MixedTK, [SignaturePayload])]
_tkSubs = [(SomeKeyPkt, [SignaturePayload])]
[(TKKeyPkt 'MixedTK, [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 (tk, refs)
  where
    mixedSub :: Bool
-> Parser
     LeftBiasedLocal
     [PktWithWireRep]
     [((SomeKeyPkt, [SignaturePayload]), [PktWithWireRep])]
mixedSub Bool
True = Bool
-> Parser
     LeftBiasedLocal
     [PktWithWireRep]
     [((SomeKeyPkt, [SignaturePayload]), [PktWithWireRep])]
mixedSubkeyWithWireRep Bool
True
    mixedSub Bool
False =
        Bool
-> Parser
     LeftBiasedLocal
     [PktWithWireRep]
     [((SomeKeyPkt, [SignaturePayload]), [PktWithWireRep])]
mixedSubkeyWithWireRep Bool
False
            Parser
  LeftBiasedLocal
  [PktWithWireRep]
  [((SomeKeyPkt, [SignaturePayload]), [PktWithWireRep])]
-> Parser
     LeftBiasedLocal
     [PktWithWireRep]
     [((SomeKeyPkt, [SignaturePayload]), [PktWithWireRep])]
-> Parser
     LeftBiasedLocal
     [PktWithWireRep]
     [((SomeKeyPkt, [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]
  [((SomeKeyPkt, [SignaturePayload]), [PktWithWireRep])]
mixedBrokenPubSubkeyWithWireRep
            Parser
  LeftBiasedLocal
  [PktWithWireRep]
  [((SomeKeyPkt, [SignaturePayload]), [PktWithWireRep])]
-> Parser
     LeftBiasedLocal
     [PktWithWireRep]
     [((SomeKeyPkt, [SignaturePayload]), [PktWithWireRep])]
-> Parser
     LeftBiasedLocal
     [PktWithWireRep]
     [((SomeKeyPkt, [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]
  [((SomeKeyPkt, [SignaturePayload]), [PktWithWireRep])]
mixedBrokenSecSubkeyWithWireRep

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)

parseMixedTKsWithWireRep
    :: Bool -> [PktWithWireRep] -> [TK 'MixedTK]
parseMixedTKsWithWireRep :: Bool -> [PktWithWireRep] -> [TK 'MixedTK]
parseMixedTKsWithWireRep Bool
intolerant [PktWithWireRep]
ps =
    ((TK 'MixedTK, [PktWithWireRep]) -> TK 'MixedTK)
-> [(TK 'MixedTK, [PktWithWireRep])] -> [TK 'MixedTK]
forall a b. (a -> b) -> [a] -> [b]
map (TK 'MixedTK, [PktWithWireRep]) -> TK 'MixedTK
forall a b. (a, b) -> a
fst ([(TK 'MixedTK, [PktWithWireRep])] -> [TK 'MixedTK])
-> [(TK 'MixedTK, [PktWithWireRep])] -> [TK 'MixedTK]
forall a b. (a -> b) -> a -> b
$
        [Maybe (TK 'MixedTK, [PktWithWireRep])]
-> [(TK 'MixedTK, [PktWithWireRep])]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe (TK 'MixedTK, [PktWithWireRep])]
 -> [(TK 'MixedTK, [PktWithWireRep])])
-> [Maybe (TK 'MixedTK, [PktWithWireRep])]
-> [(TK 'MixedTK, [PktWithWireRep])]
forall a b. (a -> b) -> a -> b
$
            Parser [PktWithWireRep] (Maybe (TK 'MixedTK, [PktWithWireRep]))
-> [[PktWithWireRep]] -> [Maybe (TK 'MixedTK, [PktWithWireRep])]
forall s r. (Monoid s, Show s) => Parser s r -> [s] -> [r]
runIncrementalParser
                (Bool
-> Parser [PktWithWireRep] (Maybe (TK 'MixedTK, [PktWithWireRep]))
mixedTKWithWireRep 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
    :: TK 'MixedTK -> [PktWithWireRep] -> TKWithWireRep
mkTKWithWireRep :: TK 'MixedTK -> [PktWithWireRep] -> TKWithWireRep
mkTKWithWireRep TK 'MixedTK
tk [PktWithWireRep]
refs =
    case [PktWithWireRep]
refs of
        [] ->
            [Char] -> TKWithWireRep
forall a. HasCallStack => [Char] -> a
error [Char]
"mkTKWithWireRep requires at least one packet reference"
        (PktWithWireRep
pktWithSource : [PktWithWireRep]
_) ->
            WireRepRefs
-> Maybe ByteRange
-> [PktWithWireRep]
-> TK 'MixedTK
-> 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
                TK 'MixedTK
tk