-- Compression.hs: OpenPGP (RFC9580) compression conduits
-- Copyright © 2012-2026  Clint Adams
-- This software is released under the terms of the Expat license.
-- (See the LICENSE file).

module Data.Conduit.OpenPGP.Compression
  ( conduitCompress
  , conduitDecompress
  ) where

import Codec.Encryption.OpenPGP.Compression
import Codec.Encryption.OpenPGP.Types
import Control.Monad.Trans.Resource (MonadThrow, throwM)
import Data.Conduit
import qualified Data.Conduit.List as CL

conduitCompress :: MonadThrow m => CompressionAlgorithm -> ConduitT Pkt Pkt m ()
conduitCompress :: forall (m :: * -> *).
MonadThrow m =>
CompressionAlgorithm -> ConduitT Pkt Pkt m ()
conduitCompress CompressionAlgorithm
algo = ConduitT Pkt Pkt m [Pkt]
forall (m :: * -> *) a o. Monad m => ConduitT a o m [a]
CL.consume ConduitT Pkt Pkt m [Pkt]
-> ([Pkt] -> ConduitT Pkt Pkt m ()) -> ConduitT Pkt Pkt m ()
forall a b.
ConduitT Pkt Pkt m a
-> (a -> ConduitT Pkt Pkt m b) -> ConduitT Pkt Pkt m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \[Pkt]
ps -> Pkt -> ConduitT Pkt Pkt m ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield (CompressionAlgorithm -> [Pkt] -> Pkt
compressPkts CompressionAlgorithm
algo [Pkt]
ps)

-- | Decompress OpenPGP Compressed Data packets.  Decompression failures,
-- empty payloads, zero-length results, and marker-only payloads are reported
-- via 'MonadThrow' rather than silently dropped.
conduitDecompress :: MonadThrow m => ConduitT Pkt Pkt m ()
conduitDecompress :: forall (m :: * -> *). MonadThrow m => ConduitT Pkt Pkt m ()
conduitDecompress = (Pkt -> ConduitT Pkt Pkt m ()) -> ConduitT Pkt Pkt m ()
forall (m :: * -> *) i o r.
Monad m =>
(i -> ConduitT i o m r) -> ConduitT i o m ()
awaitForever ((Pkt -> ConduitT Pkt Pkt m ()) -> ConduitT Pkt Pkt m ())
-> (Pkt -> ConduitT Pkt Pkt m ()) -> ConduitT Pkt Pkt m ()
forall a b. (a -> b) -> a -> b
$ \Pkt
pkt ->
  case Pkt -> Either CompressionError [Pkt]
decompressPkt Pkt
pkt of
    Left CompressionError
err   -> IOError -> ConduitT Pkt Pkt m ()
forall e a.
(HasCallStack, Exception e) =>
e -> ConduitT Pkt Pkt m a
forall (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> m a
throwM (String -> IOError
userError (CompressionError -> String
renderCompressionError CompressionError
err))
    Right [Pkt]
pkts -> (Pkt -> ConduitT Pkt Pkt m ()) -> [Pkt] -> ConduitT Pkt Pkt m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Pkt -> ConduitT Pkt Pkt m ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield [Pkt]
pkts