haskell-servant / haskell-servant/servant
Cannot consume body of `Request` twice: not enough input
- Dominant language
- Haskell
- Stars
- 2k
- Forks
- 427
- Avg merge
- 2d 23h
- Merged PRs (30d)
- 5
Description
I'm trying to implement custom authorization schemes. Looks like `servant-auth` doesn't support this feature at the moment (though, this probably will be implemented during GSoC 2019):
* https://github.com/haskell-servant/servant-auth/issues/119
So I'm using `Servant.API.Experimental.Auth`. The problem with this approach is that it's not possible to consume body of `Request` twice (for calculating its hash-sum or just printing for debugging purposes) since it's an `IO` action which allows to consume the body only once. Consider the following minimal example:
```haskell
#! /usr/bin/env cabal
{- cabal:
build-depends:
, aeson
, base ^>= 4.12
, bytestring
, servant ^>= 0.15
, servant-server ^>= 0.15
, wai >= 3.2.2
, warp
-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
import Control.Monad.IO.Class (MonadIO (liftIO))
import Data.Aeson (FromJSON, ToJSON)
import Data.Proxy (Proxy (..))
import GHC.Generics (Generic)
import Network.Wai (Request)
import Network.Wai.Handler.Warp (run)
import Network.Wai.Internal (getRequestBodyChunk)
import Servant ((:>), Application, JSON, Post, ReqBody, Server, serveWithContext)
import Servant (Context ((:.), EmptyContext))
import Servant.API (AuthProtect)
import Servant.Server (Handler)
import Servant.Server.Experimental.Auth (AuthHandler, AuthServerData, mkAuthHandler)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BS8
newtype TheAnswer = TheAnswer Int
deriving stock (Show, Generic)
deriving newtype (FromJSON, ToJSON)
type API =
AuthAPI
:> ReqBody '[JSON] TheAnswer
:> Post '[JSON] TheAnswer
type AuthAPI = AuthProtect "TheAnswer"
type instance AuthServerData (AuthProtect "TheAnswer") = ()
server42 :: Server API
server42 = \() theAnswer -> pure theAnswer
authHandler :: AuthHandler Request ()
authHandler = mkAuthHandler handler
where
handler :: Request -> Handler ()
handler req = liftIO $ do
print req
getWaiRequestBody req >>= BS8.putStrLn
getWaiRequestBody :: Request -> IO BS.ByteString
getWaiRequestBody request = BS.concat <$> getChunks
where
getChunks :: IO [BS.ByteString]
getChunks = getRequestBodyChunk request >>= \chunk ->
if chunk == BS.empty
then pure []
else (chunk:) <$> getChunks
app42 :: Application
app42 = serveWithContext
(Proxy @API)
(authHandler :. EmptyContext)
server42
main :: IO ()
main = run 8080 app42
```
If I run this server and try to query it like this:
```
curl -H "Content-Type: application/json" -d '42' http://localhost:8080
```
I see
```
not enough input
```
However, if I comment the following line:
```
getWaiRequestBody req >>= BS8.putStrLn
```
Everything works without problems.
I wonder, whether it's possible to implement some workaround to make body of the request consumable more than once?
Contributor guide
Research direction
Reproduce the minimal server from the issue, starting at Servant.Server.Experimental.Auth and the Network.Wai.Internal getRequestBodyChunk call. Compare the request behavior with and without getWaiRequestBody req in the auth handler. Done means determining and documenting a supported way to consume the request body more than once, or clearly establishing that the current approach cannot do so.
Written by the indexing model from the issue text.
Assessment
- Tech stack
- haskell
- Domain
- api, backend
- Issue type
- Bug
- Difficulty
- 4/5
- Estimated time
- 3-5 days
- Activity status
- Stale
- Clarity
- Needs clarification
- Newbie friendliness
- 25/100