@@ -0,0 +1,58 @@
1+{-# LANGUAGE PolyKinds #-}
2+{-# LANGUAGE TypeFamilies #-}
3+{-# LANGUAGE TypeOperators #-}
4+{-# LANGUAGE FlexibleInstances #-}
5+{-# LANGUAGE ScopedTypeVariables #-}
6+module Servant.API.Header where
10+import Data.Text.Encoding (decodeUtf8)
13+import Servant.API.Sub
14+import Servant.Common.Text
17+-- | Extract the given header's value as a value of type @a@.
21+-- > newtype Referer = Referer Text
22+-- > deriving (Eq, Show, FromText, ToText)
24+-- > -- GET /view-my-referer
25+-- > type MyApi = "view-my-referer" :> Header "from" Referer :> Get Referer
28+-- | If you use 'Header' in one of the endpoints for your API,
29+-- this automatically requires your server-side handler to be a function
30+-- that takes an argument of the type specified by 'Header'.
31+-- This lets servant worry about extracting it from the request and turning
32+-- it into a value of the type you specify.
34+-- All it asks is for a 'FromText' instance.
38+-- > newtype Referer = Referer Text
39+-- > deriving (Eq, Show, FromText, ToText)
41+-- > -- GET /view-my-referer
42+-- > type MyApi = "view-my-referer" :> Header "Referer" Referer :> Get Referer
44+-- > server :: Server MyApi
45+-- > server = viewReferer
46+-- > where viewReferer :: Referer -> EitherT (Int, String) IO referer
47+-- > viewReferer referer = return referer
48+instance (KnownSymbol sym, FromText a, HasServer sublayout)
49+ => HasServer (Header sym a :> sublayout) where
51+ type Server (Header sym a :> sublayout) =
52+ Maybe a -> Server sublayout
54+ route Proxy subserver request respond = do
55+ let mheader = fromText . decodeUtf8 =<< lookup str (requestHeaders request)
56+ route (Proxy :: Proxy sublayout) (subserver mheader) request respond
58+ where str = fromString $ symbolVal (Proxy :: Proxy sym)