servant/servant-js/test/Servant/JSSpec/CustomHeaders.hs
Arian van Putten 05379ed7e3 Replace all occurances of () with NoContent
We use NoContent to signify an empty response nowadays. This commit
replaces all occurences of () with NoContent so that all packages use
the new semantics.
2016-07-10 16:58:59 +02:00

60 lines
2.4 KiB
Haskell

{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE MultiParamTypeClasses #-}
module Servant.JSSpec.CustomHeaders where
import Control.Lens
import Data.Monoid
import Data.Proxy
import Data.Text (pack)
import GHC.TypeLits
import Servant.API.ContentTypes
import Servant.JS.Internal
-- | This is a hypothetical combinator that fetches an Authorization header.
-- The symbol in the header denotes what kind of authentication we are
-- using -- Basic, Digest, whatever.
data Authorization (sym :: Symbol) a
instance (KnownSymbol sym, HasForeign lang NoContent api)
=> HasForeign lang NoContent (Authorization sym a :> api) where
type Foreign NoContent (Authorization sym a :> api) = Foreign NoContent api
foreignFor lang ftype Proxy req = foreignFor lang ftype (Proxy :: Proxy api) $
req & reqHeaders <>~
[ ReplaceHeaderArg (Arg "Authorization" NoContent)
$ tokenType (pack . symbolVal $ (Proxy :: Proxy sym)) ]
where
tokenType t = t <> " {Authorization}"
-- | This is a combinator that fetches an X-MyLovelyHorse header.
data MyLovelyHorse a
instance (HasForeign lang NoContent api)
=> HasForeign lang NoContent (MyLovelyHorse a :> api) where
type Foreign NoContent (MyLovelyHorse a :> api) = Foreign NoContent api
foreignFor lang ftype Proxy req = foreignFor lang ftype (Proxy :: Proxy api) $
req & reqHeaders <>~ [ ReplaceHeaderArg (Arg "X-MyLovelyHorse" NoContent) tpl ]
where
tpl = "I am good friends with {X-MyLovelyHorse}"
-- | This is a combinator that fetches an X-WhatsForDinner header.
data WhatsForDinner a
instance (HasForeign lang NoContent api)
=> HasForeign lang NoContent (WhatsForDinner a :> api) where
type Foreign NoContent (WhatsForDinner a :> api) = Foreign NoContent api
foreignFor lang ftype Proxy req = foreignFor lang ftype (Proxy :: Proxy api) $
req & reqHeaders <>~ [ ReplaceHeaderArg (Arg "X-WhatsForDinner" NoContent) tpl ]
where
tpl = "I would like {X-WhatsForDinner} with a cherry on top."