Changed template for ReplaceHeaderArg. Got tests working.

This commit is contained in:
Geoffrey Roberts 2015-01-21 18:47:23 +11:00
parent e16f90f107
commit 158eab5157
4 changed files with 47 additions and 1 deletions

View file

@ -65,6 +65,7 @@ test-suite spec
main-is: Spec.hs main-is: Spec.hs
build-depends: build-depends:
base == 4.* base == 4.*
, lens
, servant-jquery , servant-jquery
, servant , servant
, hspec >= 2.0 , hspec >= 2.0

View file

@ -72,7 +72,7 @@ instance Show HeaderArg where
| otherwise = p | otherwise = p
where where
pv = "header" <> n pv = "header" <> n
pn = "{header" <> n <> "}" pn = "{" <> n <> "}"
rp = replace pn "" p rp = replace pn "" p
data Url = Url data Url = Url

View file

@ -14,6 +14,7 @@ import Test.Hspec
import Servant.API import Servant.API
import Servant.JQuery import Servant.JQuery
import Servant.JQuerySpec.CustomHeaders
type TestAPI = [sitemap| type TestAPI = [sitemap|
POST /simple String -> Bool POST /simple String -> Bool
@ -26,9 +27,15 @@ type TopLevelRawAPI = "something" :> Get Int
type HeaderHandlingAPI = "something" :> Header "Foo" String type HeaderHandlingAPI = "something" :> Header "Foo" String
:> Get Int :> Get Int
type CustomAuthAPI = "something" :> Authorization "Basic" String
:> Get Int
headerHandlingProxy :: Proxy HeaderHandlingAPI headerHandlingProxy :: Proxy HeaderHandlingAPI
headerHandlingProxy = Proxy headerHandlingProxy = Proxy
customAuthProxy :: Proxy CustomAuthAPI
customAuthProxy = Proxy
spec :: Spec spec :: Spec
spec = describe "Servant.JQuery" spec = describe "Servant.JQuery"
generateJSSpec generateJSSpec
@ -53,3 +60,10 @@ generateJSSpec = describe "generateJS" $ do
jsText `shouldContain` "headerFoo" jsText `shouldContain` "headerFoo"
jsText `shouldContain` "headers: { \"Foo\": headerFoo }\n" jsText `shouldContain` "headers: { \"Foo\": headerFoo }\n"
it "should handle complex HTTP headers" $ do
let jsText = generateJS $ jquery customAuthProxy
print jsText
parseFromString jsText `shouldSatisfy` isRight
jsText `shouldContain` "headerAuthorization"
jsText `shouldContain` "headers: { \"Authorization\": \"Basic \" + headerAuthorization }\n"

View file

@ -0,0 +1,31 @@
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
module Servant.JQuerySpec.CustomHeaders where
import Control.Lens
import Data.Monoid
import Data.Proxy
import GHC.TypeLits
import Servant.API
import Servant.JQuery
-- | 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, HasJQ sublayout)
=> HasJQ (Authorization sym a :> sublayout) where
type JQ (Authorization sym a :> sublayout) = JQ sublayout
jqueryFor Proxy req = jqueryFor (Proxy :: Proxy sublayout) $
req & reqHeaders <>~ [ ReplaceHeaderArg "Authorization" $
tokenType (symbolVal (Proxy :: Proxy sym)) ]
where
tokenType t = t <> " {Authorization}"