Changed template for ReplaceHeaderArg. Got tests working.
This commit is contained in:
parent
e16f90f107
commit
158eab5157
4 changed files with 47 additions and 1 deletions
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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"
|
||||||
|
|
||||||
|
|
31
test/Servant/JQuerySpec/CustomHeaders.hs
Normal file
31
test/Servant/JQuerySpec/CustomHeaders.hs
Normal 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}"
|
Loading…
Reference in a new issue