-- 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