module Web.Minion.Request.Conduit (ConduitRequest (..), streamBody, streamBodyBytes) where

import Control.Monad.IO.Class (MonadIO (..))
import Data.ByteString qualified as Bytes
import Data.Conduit qualified as C
import Data.Conduit.Combinators qualified as C
import Network.Wai qualified as Wai
import Web.Minion.Args (WithReq)
import Web.Minion.Introspect qualified as I
import Web.Minion.Request
import Web.Minion.Router

newtype ConduitRequest m = ConduitRequest (C.ConduitT () Bytes.ByteString m ())

instance IsRequest (ConduitRequest m) where
  type RequestValue (ConduitRequest m) = ConduitRequest m
  getRequestValue :: ConduitRequest m -> RequestValue (ConduitRequest m)
getRequestValue = ConduitRequest m -> RequestValue (ConduitRequest m)
ConduitRequest m -> ConduitRequest m
forall a. a -> a
id

{-# INLINE streamBody #-}
streamBody ::
  forall req m i ts.
  (MonadIO m, IsRequest req, I.Introspection i I.Request req) =>
  (ConduitRequest m -> req) ->
  ValueCombinator i (WithReq m req) ts m
streamBody :: forall req (m :: * -> *) i ts.
(MonadIO m, IsRequest req, Introspection i 'Request req) =>
(ConduitRequest m -> req) -> ValueCombinator i (WithReq m req) ts m
streamBody ConduitRequest m -> req
transform = (ErrorBuilder -> Request -> m req)
-> Router' i (ts :+ WithReq m req) m -> Router' i ts m
forall r (m :: * -> *) i ts.
(Introspection i 'Request r, IsRequest r) =>
(ErrorBuilder -> Request -> m r)
-> Router' i (ts :+ WithReq m r) m -> Router' i ts m
Request \ErrorBuilder
_ -> req -> m req
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (req -> m req) -> (Request -> req) -> Request -> m req
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConduitRequest m -> req
transform (ConduitRequest m -> req)
-> (Request -> ConduitRequest m) -> Request -> req
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConduitT () ByteString m () -> ConduitRequest m
forall (m :: * -> *).
ConduitT () ByteString m () -> ConduitRequest m
ConduitRequest (ConduitT () ByteString m () -> ConduitRequest m)
-> (Request -> ConduitT () ByteString m ())
-> Request
-> ConduitRequest m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Request -> ConduitT () ByteString m ()
forall (m :: * -> *) i.
MonadIO m =>
Request -> ConduitT i ByteString m ()
readReq

{-# INLINE streamBodyBytes #-}
streamBodyBytes ::
  forall m i ts.
  (MonadIO m, I.Introspection i I.Request (ConduitRequest m)) =>
  ValueCombinator i (WithReq m (ConduitRequest m)) ts m
streamBodyBytes :: forall (m :: * -> *) i ts.
(MonadIO m, Introspection i 'Request (ConduitRequest m)) =>
ValueCombinator i (WithReq m (ConduitRequest m)) ts m
streamBodyBytes = (ErrorBuilder -> Request -> m (ConduitRequest m))
-> Router' i (ts :+ WithReq m (ConduitRequest m)) m
-> Router' i ts m
forall r (m :: * -> *) i ts.
(Introspection i 'Request r, IsRequest r) =>
(ErrorBuilder -> Request -> m r)
-> Router' i (ts :+ WithReq m r) m -> Router' i ts m
Request \ErrorBuilder
_ -> ConduitRequest m -> m (ConduitRequest m)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ConduitRequest m -> m (ConduitRequest m))
-> (Request -> ConduitRequest m) -> Request -> m (ConduitRequest m)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConduitT () ByteString m () -> ConduitRequest m
forall (m :: * -> *).
ConduitT () ByteString m () -> ConduitRequest m
ConduitRequest (ConduitT () ByteString m () -> ConduitRequest m)
-> (Request -> ConduitT () ByteString m ())
-> Request
-> ConduitRequest m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Request -> ConduitT () ByteString m ()
forall (m :: * -> *) i.
MonadIO m =>
Request -> ConduitT i ByteString m ()
readReq

readReq :: (MonadIO m) => Wai.Request -> C.ConduitT i Bytes.ByteString m ()
readReq :: forall (m :: * -> *) i.
MonadIO m =>
Request -> ConduitT i ByteString m ()
readReq Request
req = m ByteString -> (ByteString -> Bool) -> ConduitT i ByteString m ()
forall (m :: * -> *) a i.
Monad m =>
m a -> (a -> Bool) -> ConduitT i a m ()
C.repeatWhileM (IO ByteString -> m ByteString
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ByteString -> m ByteString) -> IO ByteString -> m ByteString
forall a b. (a -> b) -> a -> b
$ Request -> IO ByteString
Wai.getRequestBodyChunk Request
req) (Bool -> Bool
not (Bool -> Bool) -> (ByteString -> Bool) -> ByteString -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Bool
Bytes.null)