@@ -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
7+
8+import Data.Proxy
9+import Data.String
10+import Data.Text.Encoding (decodeUtf8)
11+import GHC.TypeLits
12+import Network.Wai
13+import Servant.API.Sub
14+import Servant.Common.Text
15+import Servant.Server
16+
17+-- | Extract the given header's value as a value of type @a@.
18+--
19+-- Example:
20+--
21+-- > newtype Referer = Referer Text
22+-- > deriving (Eq, Show, FromText, ToText)
23+-- >
24+-- > -- GET /view-my-referer
25+-- > type MyApi = "view-my-referer" :> Header "from" Referer :> Get Referer
26+data Header sym a
27+
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.
33+--
34+-- All it asks is for a 'FromText' instance.
35+--
36+-- Example:
37+--
38+-- > newtype Referer = Referer Text
39+-- > deriving (Eq, Show, FromText, ToText)
40+-- >
41+-- > -- GET /view-my-referer
42+-- > type MyApi = "view-my-referer" :> Header "Referer" Referer :> Get Referer
43+-- >
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
50+
51+ type Server (Header sym a :> sublayout) =
52+ Maybe a -> Server sublayout
53+
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
57+
58+ where str = fromString $ symbolVal (Proxy :: Proxy sym)