haskell-servant / haskell-servant/servant

URL query params being parsed multiple times?

Open
#1,193 5 comments 0 reactions 0 assignees View on GitHub
Dominant language
Haskell
Stars
2k
Forks
427
Avg merge
2d 23h
Merged PRs (30d)
5

Description

I've been spending quite some time writing custom Servant combinators, and consequently figuring our how routing works internally in Servant. While reading the source for [`QueryParam'`](https://www.stackage.org/haddock/lts-12.1/servant-server-0.14.1/src/Servant.Server.Internal.html#line-427) combinator, I noticed the following...

```
let querytext req = parseQueryText $ rawQueryString req
```

...which probably meant that the query-params would be parsed as many times as the `QueryParam` combinator was used.

So, I put together a PoC to validate this understanding, and, as expected, the string `parsing` is printed to stdout 5 times for each request to `http://localhost:8001/`. **Is there an underlying reason why the `QueryParam'` combinator has been implemented this way?**

I'm not sure of the perf-impact this has (haven't benchmarked this yet), but as a saving grace, the PoC also confirmed that no query-parsing is done when `http://localhost:8001/abc` is requested. Therefore, perf-impact, if any, will be only for those routes which have many query-params.

---

### Proof-of-concept Code

```
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}

module Try where

import Servant
import Servant.Server
import Servant.Server.Internal
import Data.Text
import Data.Proxy
import Network.Wai.Handler.Warp as Warp
import Debug.Trace
import Network.Wai (Application, Request, rawQueryString)
import Servant.Server.Internal (DelayedIO, addAuthCheck, withRequest, delayedFailFatal, addHeaderCheck, addParameterCheck)
import Servant.API.Modifiers
import Data.Text as T
import Network.HTTP.Types
import GHC.TypeLits (KnownNat, KnownSymbol, natVal, symbolVal, Symbol)
import Data.String.Conv (toS)
import GHC.Base (join)
import Data.Maybe

data MyParam (a :: Symbol) = MyParam

instance
( HasServer api context
, KnownSymbol a
)
=> HasServer (MyParam a :> api) context where
------
type ServerT (MyParam a :> api) m = (Maybe Text -> ServerT api m)

hoistServerWithContext _ pc nt s = hoistServerWithContext (Proxy :: Proxy api) pc nt . s

route Proxy context subserver =
let querytext req = traceShow "parsing" $ parseQueryText $ rawQueryString req
paramname = toS $ symbolVal (Proxy :: Proxy a)

parseParam :: Request -> DelayedIO (Maybe Text)
parseParam req =
unfoldRequestArgument (Proxy :: Proxy '[Optional, Strict]) errReq errSt mev
where
mev :: Maybe (Either T.Text T.Text)
mev = Right <$> (join $ lookup paramname $ querytext req)

errReq = undefined -- we should never reach here...

errSt e = delayedFailFatal err400
{ errBody = toS $ "Error parsing query parameter "
<> paramname <> " failed: " <> e
}

delayed = addParameterCheck subserver . withRequest $ \req ->
parseParam req

in route (Proxy :: Proxy api) context delayed

type Api = MyParam "p1" :> MyParam "p2" :> MyParam "p3" :> MyParam "p4" :> MyParam "p5" :> Get '[JSON] Text
:<|> "abc" :> Get '[JSON] Text

test1 :: Maybe Text -> Maybe Text -> Maybe Text -> Maybe Text -> Maybe Text -> Handler Text
test1 p1 p2 p3 p4 p5 = pure $ (fromMaybe "" p1) <> (fromMaybe "" p2) <> (fromMaybe "" p3) <> (fromMaybe "" p4) <> (fromMaybe "" p5)

test2 :: Handler Text
test2 = pure "works"

serveApp = do
Warp.run 8001 $ serve (Proxy :: Proxy Api) (test1 :<|> test2)
```

Contributor guide

Open the contributing guide

Assessment

This issue has not been assessed yet.

Get new issues in your inbox

A short digest of beginner-friendly GitHub issues.