module Web.Minion.Request.Body.Raw where

import Control.Monad.IO.Class
import Network.Wai qualified as Wai
import Web.Minion.Args
import Web.Minion.Introspect qualified as I
import Web.Minion.Raw
import Web.Minion.Router

lazyBytesBody ::
  forall m i ts.
  (I.Introspection i I.Request LazyBytes) =>
  (MonadIO m) =>
  -- | .
  ValueCombinator i (WithReq m LazyBytes) ts m
lazyBytesBody :: forall (m :: * -> *) i ts.
(Introspection i 'Request LazyBytes, MonadIO m) =>
ValueCombinator i (WithReq m LazyBytes) ts m
lazyBytesBody = (ErrorBuilder -> Request -> m LazyBytes)
-> Router' i (ts :+ WithReq m LazyBytes) 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
_ Request
req -> IO LazyBytes -> m LazyBytes
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO LazyBytes -> m LazyBytes) -> IO LazyBytes -> m LazyBytes
forall a b. (a -> b) -> a -> b
$ ByteString -> LazyBytes
LazyBytes (ByteString -> LazyBytes) -> IO ByteString -> IO LazyBytes
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Request -> IO ByteString
Wai.lazyRequestBody Request
req

chunksBody ::
  forall m i ts.
  (I.Introspection i I.Request Chunks) =>
  (MonadIO m) =>
  -- | .
  ValueCombinator i (WithReq m Chunks) ts m
chunksBody :: forall (m :: * -> *) i ts.
(Introspection i 'Request Chunks, MonadIO m) =>
ValueCombinator i (WithReq m Chunks) ts m
chunksBody = (ErrorBuilder -> Request -> m Chunks)
-> Router' i (ts :+ WithReq m Chunks) 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
_ Request
req -> Chunks -> m Chunks
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Chunks -> m Chunks) -> Chunks -> m Chunks
forall a b. (a -> b) -> a -> b
$ IO ByteString -> Chunks
Chunks (IO ByteString -> Chunks) -> IO ByteString -> Chunks
forall a b. (a -> b) -> a -> b
$ Request -> IO ByteString
Wai.getRequestBodyChunk Request
req