haskell-servant / haskell-servant/servant

Cannot consume body of `Request` twice: not enough input

Open
#1,120 17 comments 0 reactions 0 assignees View on GitHub
question
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

Open the contributing 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

Get new issues in your inbox

A short digest of beginner-friendly GitHub issues.