    -- Keyring.hs: OpenPGP (RFC4880) transferable keys parsing
    -- Copyright © 2012-2018  Clint Adams
    -- This software is released under the terms of the Expat license.
    -- (See the LICENSE file).
    module Data.Conduit.OpenPGP.Keyring
      ( conduitToTKs
      , conduitToTKsDropping
      , sinkKeyringMap
      ) where

    import Data.Conduit
    import qualified Data.Conduit.List as CL
    import Data.IxSet.Typed (empty, insert)

    import Codec.Encryption.OpenPGP.KeyringParser
      ( anyTK
      , finalizeParsing
      , parseAChunk
      )
    import Codec.Encryption.OpenPGP.Ontology (isTrustPkt)
    import Codec.Encryption.OpenPGP.Types
    import Data.Conduit.OpenPGP.Keyring.Instances ()

    data Phase
      = MainKey
      | Revs
      | Uids
      | UAts
      | Subs
      | SkippingBroken
      deriving (Eq, Ord, Show)

    conduitToTKs :: Monad m => ConduitT Pkt TK m ()
    conduitToTKs = conduitToTKs' True

    conduitToTKsDropping :: Monad m => ConduitT Pkt TK m ()
    conduitToTKsDropping = conduitToTKs' False

    fakecmAccum ::
         Monad m
      => (accum -> (accum, [b]))
      -> (a -> accum -> (accum, [b]))
      -> accum
      -> ConduitT a b m ()
    fakecmAccum finalizer f = loop
      where
        loop accum = await >>= maybe (mapM_ yield (snd (finalizer accum))) go
          where
            go a = do
              let (accum', bs) = f a accum
              mapM_ yield bs
              loop accum'

    conduitToTKs' :: Monad m => Bool -> ConduitT Pkt TK m ()
    conduitToTKs' intolerant =
      CL.filter notTrustPacket .| CL.map (: []) .|
      fakecmAccum
        finalizeParsing
        (parseAChunk (anyTK intolerant))
        ([], Just (Nothing, anyTK intolerant)) .|
      CL.catMaybes
      where
        notTrustPacket = not . isTrustPkt

    sinkKeyringMap :: Monad m => ConduitT TK Void m Keyring
    sinkKeyringMap = CL.fold (flip insert) empty