-- 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 CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE LambdaCase #-}

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

import Control.Applicative ((<|>), many)
import Data.Either (rights)
import Data.List (foldl')
import Data.Maybe (catMaybes, mapMaybe)
import qualified Data.List.NonEmpty as NE

import Data.Text (Text)

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 ()
import Text.ParserCombinators.Incremental.LeftBiasedLocal
  ( Parser
  , concatMany
  , failure
  , feed
  , feedEof
  , inspect
  , satisfy
  )

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

pkPayloadWithWireRep ::
     Parser [PktWithWireRep] ((SomePKPayload, Maybe SKAddendum), [PktWithWireRep])
pkPayloadWithWireRep :: Parser
  [PktWithWireRep]
  ((SomePKPayload, Maybe SKAddendum), [PktWithWireRep])
pkPayloadWithWireRep = do
  pkpkts <- ([PktWithWireRep] -> Bool)
-> Parser LeftBiasedLocal [PktWithWireRep] [PktWithWireRep]
forall s t. FactorialMonoid s => (s -> Bool) -> Parser t s s
satisfy [PktWithWireRep] -> Bool
isPKPWS
  case pkpkts of
    [PktWithWireRep
pktWithSource] ->
      case Pkt -> Maybe (KeyPkt 'PublicPkt)
pktToPublicKeyPkt (PktWithWireRep -> Pkt
_pktValue PktWithWireRep
pktWithSource) 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 -> Pkt
_pktValue PktWithWireRep
pktWithSource) 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 -> Pkt
_pktValue PktWithWireRep
pktWithSource 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 -> Pkt
_pktValue PktWithWireRep
pktWithSource of
        SignaturePkt SignaturePayload
sp -> SignaturePayload -> Bool
isSP' SignaturePayload
sp
        Pkt
_ -> Bool
False
    isSPWS Bool
False [PktWithWireRep
pktWithSource] =
      case PktWithWireRep -> Pkt
_pktValue PktWithWireRep
pktWithSource 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 -> Pkt
_pktValue PktWithWireRep
pktWithSource 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 -> Pkt
_pktValue PktWithWireRep
pktWithSource 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 -> Pkt
_pktValue PktWithWireRep
pktWithSource 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 -> Pkt
_pktValue PktWithWireRep
pktWithSource of
        UserAttributePkt [UserAttrSubPacket]
_ -> Bool
True
        Pkt
_ -> Bool
False
    isUAtWS [PktWithWireRep]
_ = Bool
False

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

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

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

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

skPayloadWithWireRep ::
     Parser [PktWithWireRep] ((SomePKPayload, Maybe SKAddendum), [PktWithWireRep])
skPayloadWithWireRep :: Parser
  [PktWithWireRep]
  ((SomePKPayload, Maybe SKAddendum), [PktWithWireRep])
skPayloadWithWireRep = do
  spkts <- ([PktWithWireRep] -> Bool)
-> Parser LeftBiasedLocal [PktWithWireRep] [PktWithWireRep]
forall s t. FactorialMonoid s => (s -> Bool) -> Parser t s s
satisfy [PktWithWireRep] -> Bool
isSKPWS
  case spkts of
    [PktWithWireRep
pktWithSource] ->
      case Pkt -> Maybe (KeyPkt 'SecretPkt)
pktToSecretKeyPkt (PktWithWireRep -> Pkt
_pktValue PktWithWireRep
pktWithSource) 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 -> Pkt
_pktValue PktWithWireRep
pktWithSource) 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 -> Pkt
_pktValue PktWithWireRep
pktWithSource of
        BrokenPacketPkt String
_ Word8
a ByteString
_ -> Int
t Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
a
        Pkt
_ -> Bool
False
    isBrokenWS [PktWithWireRep]
_ = Bool
False

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

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

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