diff --git a/servant.cabal b/servant.cabal index 94aaf619..46158ac4 100644 --- a/servant.cabal +++ b/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 diff --git a/src/Servant/API.hs b/src/Servant/API.hs index c5a7a288..bc2eab22 100644 --- a/src/Servant/API.hs +++ b/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 diff --git a/src/Servant/API/Header.hs b/src/Servant/API/Header.hs new file mode 100644 index 00000000..cf19bc6e --- /dev/null +++ b/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)