add Servant.API.Header

servant.cabal

@@ -105,6 +105,7 @@ library
     Servant.API.Capture
     Servant.API.Delete
     Servant.API.Get
+    Servant.API.Header
     Servant.API.Post
     Servant.API.Put
     Servant.API.QueryParam

src/Servant/API.hs

@@ -9,6 +9,8 @@ module Servant.API (
   -- * Accessing information from the request
   -- | Capturing parts of the url path as parsed values: @'Capture'@
   module Servant.API.Capture,
+  -- | Retrieving specific headers from the request
+  module Servant.API.Header,
   -- | Retrieving parameters from the query string of the 'URI': @'QueryParam'@
   module Servant.API.QueryParam,
   -- | Accessing the request body as a JSON-encoded type: @'ReqBody'@
@@ -40,6 +42,7 @@ import Servant.API.Alternative
 import Servant.API.Capture
 import Servant.API.Delete
 import Servant.API.Get
+import Servant.API.Header
 import Servant.API.Post
 import Servant.API.Put
 import Servant.API.QueryParam

src/Servant/API/Header.hs

@@ -0,0 +1,58 @@
+{-# LANGUAGE PolyKinds #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+module Servant.API.Header where
+
+import Data.Proxy
+import Data.String
+import Data.Text.Encoding (decodeUtf8)
+import GHC.TypeLits
+import Network.Wai
+import Servant.API.Sub
+import Servant.Common.Text
+import Servant.Server
+
+-- | Extract the given header's value as a value of type @a@.
+--
+-- Example:
+--
+-- > newtype Referer = Referer Text
+-- >   deriving (Eq, Show, FromText, ToText)
+-- >
+-- >            -- GET /view-my-referer
+-- > type MyApi = "view-my-referer" :> Header "from" Referer :> Get Referer
+data Header sym a
+
+-- | If you use 'Header' in one of the endpoints for your API,
+-- this automatically requires your server-side handler to be a function
+-- that takes an argument of the type specified by 'Header'.
+-- This lets servant worry about extracting it from the request and turning
+-- it into a value of the type you specify.
+--
+-- All it asks is for a 'FromText' instance.
+--
+-- Example:
+--
+-- > newtype Referer = Referer Text
+-- >   deriving (Eq, Show, FromText, ToText)
+-- >
+-- >            -- GET /view-my-referer
+-- > type MyApi = "view-my-referer" :> Header "Referer" Referer :> Get Referer
+-- >
+-- > server :: Server MyApi
+-- > server = viewReferer
+-- >   where viewReferer :: Referer -> EitherT (Int, String) IO referer
+-- >         viewReferer referer = return referer
+instance (KnownSymbol sym, FromText a, HasServer sublayout)
+      => HasServer (Header sym a :> sublayout) where
+
+  type Server (Header sym a :> sublayout) =
+    Maybe a -> Server sublayout
+
+  route Proxy subserver request respond = do
+    let mheader = fromText . decodeUtf8 =<< lookup str (requestHeaders request)
+    route (Proxy :: Proxy sublayout) (subserver mheader) request respond
+
+      where str = fromString $ symbolVal (Proxy :: Proxy sym)