{- |Description: Combinator for Servant to allow Handlers access to the full query
 string from the WAI request.
-}
module Servant.API.QueryString where

import Network.HTTP.Types (Query)
import Network.Wai
import Servant
import Servant.Server.Internal.Delayed (passToServer)

{- |
  @QueryString@ provides handlers access to the full query string from
  the WAI request, rather than pulling each element explicitly. This
  allows for dynamic query management, or to simply take in many
  queries in one argument.

  Example:

@
import Control.Monad.IO.Class (liftIO)
import Network.HTTP.Types (Query, renderQuery)
import Servant
import ServantExtras.QueryString

type MyAPI = "my-cookie-enabled-endpoint"
           :> QueryString
           :> Get '[JSON] NoContent

myServer :: Server MyAPI
myServer = queryEndpointHandler
 where
   queryEndpointHandler :: Query -> Handler NoContent
   queryEndpointHandler query = do
    liftIO $ print $ renderQuery True query
    let mCookieValue = lookup "merlinWasHere" query in
     case mCookieValue of
      Nothing -> do
        liftIO $ print "Merlin was *NOT* here!"
        throwError err400 { errBody = "Clearly you've missed something." }
      Just message -> do
        liftIO $ do
          print "Merlin WAS here, and he left us a message!"
          print message
        pure NoContent
@
-}
data QueryString

instance HasServer api ctx => HasServer (QueryString :> api) ctx where
  type ServerT (QueryString :> api) m = Query -> ServerT api m

  hoistServerWithContext :: forall (m :: * -> *) (n :: * -> *).
Proxy (QueryString :> api)
-> Proxy ctx
-> (forall x. m x -> n x)
-> ServerT (QueryString :> api) m
-> ServerT (QueryString :> api) n
hoistServerWithContext Proxy (QueryString :> api)
_ Proxy ctx
ctx forall x. m x -> n x
nt ServerT (QueryString :> api) m
server =
    forall {k} (api :: k) (context :: [*]) (m :: * -> *) (n :: * -> *).
HasServer api context =>
Proxy api
-> Proxy context
-> (forall x. m x -> n x)
-> ServerT api m
-> ServerT api n
hoistServerWithContext (forall {k} (t :: k). Proxy t
Proxy @api) Proxy ctx
ctx forall x. m x -> n x
nt forall b c a. (b -> c) -> (a -> b) -> a -> c
. ServerT (QueryString :> api) m
server
  route :: forall env.
Proxy (QueryString :> api)
-> Context ctx
-> Delayed env (Server (QueryString :> api))
-> Router env
route Proxy (QueryString :> api)
_ Context ctx
ctx Delayed env (Server (QueryString :> api))
server =
    forall {k} (api :: k) (context :: [*]) env.
HasServer api context =>
Proxy api
-> Context context -> Delayed env (Server api) -> Router env
route (forall {k} (t :: k). Proxy t
Proxy @api) Context ctx
ctx forall a b. (a -> b) -> a -> b
$
      Delayed env (Server (QueryString :> api))
server forall env a b.
Delayed env (a -> b) -> (Request -> a) -> Delayed env b
`passToServer` \Request
req ->
        Request -> Query
queryString Request
req