eeva/servant
1
0
Fork 0
Code Issues Pull requests Projects Releases Wiki Activity

Fix errors in test suite for servant-js.

Browse source
This commit is contained in:
Arian van Putten 2015-10-02 14:38:19 +02:00
parent cf59abd2b8
commit 00179572ec
2 changed files with 38 additions and 27 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

61
servant-js/test/Servant/JSSpec.hs
View file

@ -4,13 +4,17 @@
{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeOperators #-}
{-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS_GHC -fno-warn-orphans #-} {-# OPTIONS_GHC -fno-warn-orphans #-}
module Servant.JSSpec where module Servant.JSSpec where
import Data.Either (isRight) import Data.Either (isRight)
import Data.Monoid ((<>))
import Data.Proxy import Data.Proxy
import Language.ECMAScript3.Parser (parseFromString) import Data.Text (Text)
import Test.Hspec import qualified Data.Text as T
import Language.ECMAScript3.Parser (program, parse)
import Test.Hspec hiding (shouldContain, shouldNotContain)
import Servant.JS import Servant.JS
import Servant.JS.Internal import Servant.JS.Internal
@ -20,22 +24,22 @@ import qualified Servant.JS.JQuery as JQ
import qualified Servant.JS.Vanilla as JS import qualified Servant.JS.Vanilla as JS
import Servant.JSSpec.CustomHeaders import Servant.JSSpec.CustomHeaders
type TestAPI = "simple" :> ReqBody '[JSON,FormUrlEncoded] String :> Post '[JSON] Bool type TestAPI = "simple" :> ReqBody '[JSON,FormUrlEncoded] Text :> Post '[JSON] Bool
:<|> "has.extension" :> Get '[FormUrlEncoded,JSON] Bool :<|> "has.extension" :> Get '[FormUrlEncoded,JSON] Bool
type TopLevelRawAPI = "something" :> Get '[JSON] Int type TopLevelRawAPI = "something" :> Get '[JSON] Int
:<|> Raw :<|> Raw
type HeaderHandlingAPI = "something" :> Header "Foo" String type HeaderHandlingAPI = "something" :> Header "Foo" Text
:> Get '[JSON] Int :> Get '[JSON] Int
type CustomAuthAPI = "something" :> Authorization "Basic" String type CustomAuthAPI = "something" :> Authorization "Basic" Text
:> Get '[JSON] Int :> Get '[JSON] Int
type CustomHeaderAPI = "something" :> MyLovelyHorse String type CustomHeaderAPI = "something" :> MyLovelyHorse Text
:> Get '[JSON] Int :> Get '[JSON] Int
type CustomHeaderAPI2 = "something" :> WhatsForDinner String type CustomHeaderAPI2 = "something" :> WhatsForDinner Text
:> Get '[JSON] Int :> Get '[JSON] Int
headerHandlingProxy :: Proxy HeaderHandlingAPI headerHandlingProxy :: Proxy HeaderHandlingAPI
@ -81,12 +85,16 @@ spec = describe "Servant.JQuery" $ do
axiosSpec axiosSpec
--angularSpec AngularCustom --angularSpec AngularCustom
a `shouldContain` b = shouldSatisfy a (T.isInfixOf b)
a `shouldNotContain` b = shouldNotSatisfy a (T.isInfixOf b)
axiosSpec :: Spec axiosSpec :: Spec
axiosSpec = describe specLabel $ do axiosSpec = describe specLabel $ do
it "should add withCredentials when needed" $ do it "should add withCredentials when needed" $ do
let jsText = genJS withCredOpts $ listFromAPI (Proxy :: Proxy TestAPI) let jsText = genJS withCredOpts $ listFromAPI (Proxy :: Proxy TestAPI)
output jsText output jsText
jsText `shouldContain` ("withCredentials: true") jsText `shouldContain` "withCredentials: true"
it "should add xsrfCookieName when needed" $ do it "should add xsrfCookieName when needed" $ do
let jsText = genJS cookieOpts $ listFromAPI (Proxy :: Proxy TestAPI) let jsText = genJS cookieOpts $ listFromAPI (Proxy :: Proxy TestAPI)
output jsText output jsText
@ -101,79 +109,80 @@ axiosSpec = describe specLabel $ do
withCredOpts = AX.defAxiosOptions { AX.withCredentials = True } withCredOpts = AX.defAxiosOptions { AX.withCredentials = True }
cookieOpts = AX.defAxiosOptions { AX.xsrfCookieName = Just "MyXSRFcookie" } cookieOpts = AX.defAxiosOptions { AX.xsrfCookieName = Just "MyXSRFcookie" }
headerOpts = AX.defAxiosOptions { AX.xsrfHeaderName = Just "MyXSRFheader" } headerOpts = AX.defAxiosOptions { AX.xsrfHeaderName = Just "MyXSRFheader" }
genJS :: AxiosOptions -> [AjaxReq] -> String genJS :: AxiosOptions -> [AjaxReq] -> Text
genJS opts req = concatMap (AX.generateAxiosJS opts) req genJS opts req = mconcat . map (AX.generateAxiosJS opts) $ req
angularSpec :: TestNames -> Spec angularSpec :: TestNames -> Spec
angularSpec test = describe specLabel $ do angularSpec test = describe specLabel $ do
it "should implement a service globally" $ do it "should implement a service globally" $ do
let jsText = genJS $ listFromAPI (Proxy :: Proxy TestAPI) let jsText = genJS $ listFromAPI (Proxy :: Proxy TestAPI)
output jsText output jsText
jsText `shouldContain` (".service('" ++ testName ++ "'") jsText `shouldContain` (".service('" <> testName <> "'")
it "should depend on $http service globally" $ do it "should depend on $http service globally" $ do
let jsText = genJS $ listFromAPI (Proxy :: Proxy TestAPI) let jsText = genJS $ listFromAPI (Proxy :: Proxy TestAPI)
output jsText output jsText
jsText `shouldContain` ("('" ++ testName ++ "', function($http) {") jsText `shouldContain` ("('" <> testName <> "', function($http) {")
it "should not depend on $http service in handlers" $ do it "should not depend on $http service in handlers" $ do
let jsText = genJS $ listFromAPI (Proxy :: Proxy TestAPI) let jsText = genJS $ listFromAPI (Proxy :: Proxy TestAPI)
output jsText output jsText
jsText `shouldNotContain` "getsomething($http, " jsText `shouldNotContain` "getsomething($http, "
where where
specLabel = "AngularJS(" ++ (show test) ++ ")" specLabel = "AngularJS(" <> (show test) <> ")"
output _ = return () output _ = return ()
testName = "MyService" testName = "MyService"
ngOpts = NG.defAngularOptions { NG.serviceName = testName } ngOpts = NG.defAngularOptions { NG.serviceName = testName }
genJS req = NG.angularService ngOpts req genJS req = NG.angularService ngOpts req
generateJSSpec :: TestNames -> (AjaxReq -> String) -> Spec parseFromText = parse program ""
generateJSSpec :: TestNames -> (AjaxReq -> Text) -> Spec
generateJSSpec n gen = describe specLabel $ do generateJSSpec n gen = describe specLabel $ do
it "should generate valid javascript" $ do it "should generate valid javascript" $ do
let s = jsForAPI (Proxy :: Proxy TestAPI) (concatMap gen) let s = jsForAPI (Proxy :: Proxy TestAPI) (mconcat . map gen)
parseFromString s `shouldSatisfy` isRight parseFromText s `shouldSatisfy` isRight
it "should use non-empty function names" $ do it "should use non-empty function names" $ do
let (_ :<|> topLevel) = javascript (Proxy :: Proxy TopLevelRawAPI) let (_ :<|> topLevel) = javascript (Proxy :: Proxy TopLevelRawAPI)
output $ genJS (topLevel "GET") output $ genJS (topLevel "GET")
parseFromString (genJS $ topLevel "GET") `shouldSatisfy` isRight parseFromText (genJS $ topLevel "GET") `shouldSatisfy` isRight
it "should handle simple HTTP headers" $ do it "should handle simple HTTP headers" $ do
let jsText = genJS $ javascript headerHandlingProxy let jsText = genJS $ javascript headerHandlingProxy
output jsText output jsText
parseFromString jsText `shouldSatisfy` isRight parseFromText jsText `shouldSatisfy` isRight
jsText `shouldContain` "headerFoo" jsText `shouldContain` "headerFoo"
jsText `shouldContain` (header n "Foo" $ "headerFoo") jsText `shouldContain` (header n "Foo" $ "headerFoo")
it "should handle complex HTTP headers" $ do it "should handle complex HTTP headers" $ do
let jsText = genJS $ javascript customAuthProxy let jsText = genJS $ javascript customAuthProxy
output jsText output jsText
parseFromString jsText `shouldSatisfy` isRight parseFromText jsText `shouldSatisfy` isRight
jsText `shouldContain` "headerAuthorization" jsText `shouldContain` "headerAuthorization"
jsText `shouldContain` (header n "Authorization" $ "\"Basic \" + headerAuthorization") jsText `shouldContain` (header n "Authorization" $ "\"Basic \" + headerAuthorization")
it "should handle complex, custom HTTP headers" $ do it "should handle complex, custom HTTP headers" $ do
let jsText = genJS $ javascript customHeaderProxy let jsText = genJS $ javascript customHeaderProxy
output jsText output jsText
parseFromString jsText `shouldSatisfy` isRight parseFromText jsText `shouldSatisfy` isRight
jsText `shouldContain` "headerXMyLovelyHorse" jsText `shouldContain` "headerXMyLovelyHorse"
jsText `shouldContain` (header n "X-MyLovelyHorse" $ "\"I am good friends with \" + headerXMyLovelyHorse") jsText `shouldContain` (header n "X-MyLovelyHorse" $ "\"I am good friends with \" + headerXMyLovelyHorse")
it "should handle complex, custom HTTP headers (template replacement)" $ do it "should handle complex, custom HTTP headers (template replacement)" $ do
let jsText = genJS $ javascript customHeaderProxy2 let jsText = genJS $ javascript customHeaderProxy2
output jsText output jsText
parseFromString jsText `shouldSatisfy` isRight parseFromText jsText `shouldSatisfy` isRight
jsText `shouldContain` "headerXWhatsForDinner" jsText `shouldContain` "headerXWhatsForDinner"
jsText `shouldContain` (header n "X-WhatsForDinner" $ "\"I would like \" + headerXWhatsForDinner + \" with a cherry on top.\"") jsText `shouldContain` (header n "X-WhatsForDinner" $ "\"I would like \" + headerXWhatsForDinner + \" with a cherry on top.\"")
it "can generate the whole javascript code string at once with jsForAPI" $ do it "can generate the whole javascript code string at once with jsForAPI" $ do
let jsStr = jsForAPI (Proxy :: Proxy TestAPI) (concatMap gen) let jsStr = jsForAPI (Proxy :: Proxy TestAPI) (concatMap gen)
parseFromString jsStr `shouldSatisfy` isRight parseFromText jsStr `shouldSatisfy` isRight
where where
specLabel = "generateJS(" ++ (show n) ++ ")" specLabel = "generateJS(" <> (show n) <> ")"
output _ = return () output _ = return ()
genJS req = gen req genJS req = gen req
header :: TestNames -> String -> String -> String header :: TestNames -> Text -> Text -> Text
header v headerName headerValue header v headerName headerValue
| v `elem` [Vanilla, VanillaCustom] = "xhr.setRequestHeader(\"" ++ headerName ++ "\", " ++ headerValue ++ ");\n" | v `elem` [Vanilla, VanillaCustom] = "xhr.setRequestHeader(\"" <> headerName <> "\", " <> headerValue <> ");\n"
| otherwise = "headers: { \"" ++ headerName ++ "\": " ++ headerValue ++ " }\n" | otherwise = "headers: { \"" <> headerName <> "\": " <> headerValue <> " }\n"

4
servant-js/test/Servant/JSSpec/CustomHeaders.hs
View file

@ -5,12 +5,14 @@
{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeOperators #-}
{-# LANGUAGE OverloadedStrings #-}
module Servant.JSSpec.CustomHeaders where module Servant.JSSpec.CustomHeaders where
import Control.Lens import Control.Lens
import Data.Monoid import Data.Monoid
import Data.Proxy import Data.Proxy
import Data.Text (pack)
import GHC.TypeLits import GHC.TypeLits
import Servant.JS.Internal import Servant.JS.Internal
@ -25,7 +27,7 @@ instance (KnownSymbol sym, HasForeign sublayout)
foreignFor Proxy req = foreignFor (Proxy :: Proxy sublayout) $ foreignFor Proxy req = foreignFor (Proxy :: Proxy sublayout) $
req & reqHeaders <>~ [ ReplaceHeaderArg "Authorization" $ req & reqHeaders <>~ [ ReplaceHeaderArg "Authorization" $
tokenType (symbolVal (Proxy :: Proxy sym)) ] tokenType (pack . symbolVal $ (Proxy :: Proxy sym)) ]
where where
tokenType t = t <> " {Authorization}" tokenType t = t <> " {Authorization}"