{-# LANGUAGE FlexibleContexts #-}

-- |
-- Module: Codec.RPM.Conduit
-- Copyright: (c) 2016-2017 Red Hat, Inc.
-- License: LGPL
--
-- Maintainer: https://github.com/weldr
-- Stability: stable
-- Portability: portable
--
-- A module for interacting with an 'RPM' record using conduits.

module Codec.RPM.Conduit(parseRPMC,
                         payloadC,
                         payloadContentsC)
 where

import           Control.Monad.Catch(MonadThrow)
import           Control.Monad.Except(MonadError, throwError)
import           Control.Monad.Trans.Resource(MonadResource)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as C
import           Data.Conduit((.|), Conduit, awaitForever, yield)
import           Data.Conduit.Attoparsec(ParseError, conduitParserEither)
import           Data.Conduit.Lzma(decompress)
import           Data.CPIO(Entry, readCPIO)

import Codec.RPM.Parse(parseRPM)
import Codec.RPM.Types(RPM(..))

-- | Like 'parseRPM', but puts the result into a 'Conduit' as an 'Either', containing either a
-- 'ParseError' or an 'RPM'.  The result can be extracted with 'Control.Monad.Except.runExceptT',
-- like so:
--
-- > import Conduit((.|), runConduitRes, sourceFile)
-- > import Control.Monad.Except(runExceptT)
-- > result <- runExceptT $ runConduitRes $ sourceFile "some.rpm" .| parseRPMC .| someConsumer
--
-- On success, the 'RPM' record will be passed down the conduit for futher processing or
-- consumption.  On error, the rest of the conduit will be skipped and the 'ParseError' will
-- be returned as the result to be dealt with.
parseRPMC :: MonadError ParseError m => Conduit C.ByteString m RPM
parseRPMC :: Conduit ByteString m RPM
parseRPMC =
    Parser ByteString RPM
-> ConduitT
     ByteString (Either ParseError (PositionRange, RPM)) m ()
forall (m :: * -> *) a b.
(Monad m, AttoparsecInput a) =>
Parser a b
-> ConduitT a (Either ParseError (PositionRange, b)) m ()
conduitParserEither Parser ByteString RPM
parseRPM ConduitT ByteString (Either ParseError (PositionRange, RPM)) m ()
-> ConduitM (Either ParseError (PositionRange, RPM)) RPM m ()
-> Conduit ByteString m RPM
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| ConduitM (Either ParseError (PositionRange, RPM)) RPM m ()
forall a o. ConduitT (Either ParseError (a, o)) o m ()
consumer
 where
    consumer :: ConduitT (Either ParseError (a, o)) o m ()
consumer = (Either ParseError (a, o)
 -> ConduitT (Either ParseError (a, o)) o m ())
-> ConduitT (Either ParseError (a, o)) o m ()
forall (m :: * -> *) i o r.
Monad m =>
(i -> ConduitT i o m r) -> ConduitT i o m ()
awaitForever ((Either ParseError (a, o)
  -> ConduitT (Either ParseError (a, o)) o m ())
 -> ConduitT (Either ParseError (a, o)) o m ())
-> (Either ParseError (a, o)
    -> ConduitT (Either ParseError (a, o)) o m ())
-> ConduitT (Either ParseError (a, o)) o m ()
forall a b. (a -> b) -> a -> b
$ (ParseError -> ConduitT (Either ParseError (a, o)) o m ())
-> ((a, o) -> ConduitT (Either ParseError (a, o)) o m ())
-> Either ParseError (a, o)
-> ConduitT (Either ParseError (a, o)) o m ()
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ParseError -> ConduitT (Either ParseError (a, o)) o m ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (o -> ConduitT (Either ParseError (a, o)) o m ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield (o -> ConduitT (Either ParseError (a, o)) o m ())
-> ((a, o) -> o)
-> (a, o)
-> ConduitT (Either ParseError (a, o)) o m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, o) -> o
forall a b. (a, b) -> b
snd)

-- | Extract the package payload from an 'RPM', returning it in the conduit.
payloadC :: Monad m => Conduit RPM m BS.ByteString
payloadC :: Conduit RPM m ByteString
payloadC = (RPM -> Conduit RPM m ByteString) -> Conduit RPM m ByteString
forall (m :: * -> *) i o r.
Monad m =>
(i -> ConduitT i o m r) -> ConduitT i o m ()
awaitForever (ByteString -> Conduit RPM m ByteString
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield (ByteString -> Conduit RPM m ByteString)
-> (RPM -> ByteString) -> RPM -> Conduit RPM m ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RPM -> ByteString
rpmArchive)

-- | Extract the package payload from an 'RPM', decompress it, and return each element of
-- the payload as a 'Data.CPIO.Entry'.
payloadContentsC :: (MonadResource m, MonadThrow m) => Conduit RPM m Entry
payloadContentsC :: Conduit RPM m Entry
payloadContentsC = Conduit RPM m ByteString
forall (m :: * -> *). Monad m => Conduit RPM m ByteString
payloadC
                Conduit RPM m ByteString
-> ConduitM ByteString Entry m () -> Conduit RPM m Entry
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| Maybe Word64 -> ConduitM ByteString ByteString m ()
forall (m :: * -> *).
(MonadThrow m, MonadIO m) =>
Maybe Word64 -> ConduitM ByteString ByteString m ()
decompress Maybe Word64
forall a. Maybe a
Nothing
                ConduitM ByteString ByteString m ()
-> ConduitM ByteString Entry m () -> ConduitM ByteString Entry m ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| ConduitM ByteString Entry m ()
forall (m :: * -> *). Monad m => Conduit ByteString m Entry
readCPIO