{- |Description: This module provides a way to get _all_ the headers
 from a request, rather than asking for them piecemeal.
-}
module Servant.API.HeaderList where

import Network.Wai
import Servant
import Servant.Server.Internal.Delayed (passToServer)

import qualified Network.HTTP.Types.Header as NTH (Header)

{- |
  The HeaderList combinator provides a list of
  @Network.HTTP.Types.Header.Header@ values from the WAI request.

  Example:

@
import Control.Monad.IO.Class (liftIO)
import Servant
import ServantExtras.HeaderList

import qualified Network.HTTP.Types.Header as NTH (Header)

type MyAPI = "my-header-endpoint"
           :> HeaderList
           :> Get '[JSON] NoContent

myServer :: Server MyAPI
myServer = headerEndpointHandler
 where
   headerEndpointHandler :: [NTH.Header] -> Handler NoContent
   headerEndpointHandler headers =
      let mCookieValue = lookup "merlinWasHere" headers 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 HeaderList

instance HasServer api ctx => HasServer (HeaderList :> api) ctx where
  type ServerT (HeaderList :> api) m = [NTH.Header] -> ServerT api m

  hoistServerWithContext :: forall (m :: * -> *) (n :: * -> *).
Proxy (HeaderList :> api)
-> Proxy ctx
-> (forall x. m x -> n x)
-> ServerT (HeaderList :> api) m
-> ServerT (HeaderList :> api) n
hoistServerWithContext Proxy (HeaderList :> api)
_ Proxy ctx
ctx forall x. m x -> n x
nt ServerT (HeaderList :> 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 (HeaderList :> api) m
server
  route :: forall env.
Proxy (HeaderList :> api)
-> Context ctx
-> Delayed env (Server (HeaderList :> api))
-> Router env
route Proxy (HeaderList :> api)
_ Context ctx
ctx Delayed env (Server (HeaderList :> 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 (HeaderList :> api))
server forall env a b.
Delayed env (a -> b) -> (Request -> a) -> Delayed env b
`passToServer` \Request
req ->
        Request -> [Header]
requestHeaders Request
req