    -- Keyring.hs: OpenPGP (RFC4880) transferable keys parsing
    -- Copyright © 2012-2016  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 (finalizeParsing, parseAChunk, anyTK)
    import Codec.Encryption.OpenPGP.Types
    import Codec.Encryption.OpenPGP.Ontology (isTrustPkt)
    import Data.Conduit.OpenPGP.Keyring.Instances ()

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

    conduitToTKs :: Monad m => Conduit Pkt m TK
    conduitToTKs = conduitToTKs' True

    conduitToTKsDropping :: Monad m => Conduit Pkt m TK
    conduitToTKsDropping = conduitToTKs' False

    fakecmAccum :: Monad m => (accum -> (accum, [b])) -> (a -> accum -> (accum, [b])) -> accum -> Conduit a m b
    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 -> Conduit Pkt m TK
    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 => Sink TK m Keyring
    sinkKeyringMap = CL.fold (flip insert) empty