servant/servant-js/test/Servant/JSSpec.hs

206 lines
8.2 KiB
Haskell
Raw Normal View History

{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE OverloadedStrings #-}
2014-12-24 13:55:25 +01:00
{-# OPTIONS_GHC -fno-warn-orphans #-}
2016-03-12 10:45:04 +01:00
module Servant.JSSpec where
2014-12-24 13:55:25 +01:00
import Data.Either (isRight)
2016-03-12 10:45:04 +01:00
import Data.Monoid ()
import Data.Monoid.Compat ((<>))
import Data.Proxy
import Data.Text (Text)
import qualified Data.Text as T
import Language.ECMAScript3.Parser (program, parse)
2016-03-12 10:45:04 +01:00
import Prelude ()
import Prelude.Compat
import Test.Hspec hiding (shouldContain, shouldNotContain)
import Servant.API.Internal.Test.ComprehensiveAPI
import Servant.API.ContentTypes
import Servant.JS
import Servant.JS.Internal
import qualified Servant.JS.Angular as NG
import qualified Servant.JS.Axios as AX
import qualified Servant.JS.JQuery as JQ
import qualified Servant.JS.Vanilla as JS
import Servant.JSSpec.CustomHeaders
2014-12-24 13:55:25 +01:00
-- * comprehensive api
-- This declaration simply checks that all instances are in place.
_ = jsForAPI comprehensiveAPIWithoutRaw vanillaJS :: Text
-- * specs
type TestAPI = "simple" :> ReqBody '[JSON,FormUrlEncoded] Text :> Post '[JSON] Bool
2015-03-03 22:59:36 +01:00
:<|> "has.extension" :> Get '[FormUrlEncoded,JSON] Bool
2014-12-24 13:55:25 +01:00
type TopLevelRawAPI = "something" :> Get '[JSON] Int
2015-01-02 10:46:21 +01:00
:<|> Raw
type HeaderHandlingAPI = "something" :> Header "Foo" Text
:> Get '[JSON] Int
type CustomAuthAPI = "something" :> Authorization "Basic" Text
:> Get '[JSON] Int
type CustomHeaderAPI = "something" :> MyLovelyHorse Text
:> Get '[JSON] Int
type CustomHeaderAPI2 = "something" :> WhatsForDinner Text
:> Get '[JSON] Int
headerHandlingProxy :: Proxy HeaderHandlingAPI
headerHandlingProxy = Proxy
customAuthProxy :: Proxy CustomAuthAPI
customAuthProxy = Proxy
customHeaderProxy :: Proxy CustomHeaderAPI
customHeaderProxy = Proxy
customHeaderProxy2 :: Proxy CustomHeaderAPI2
customHeaderProxy2 = Proxy
data TestNames = Vanilla
| VanillaCustom
| JQuery
| JQueryCustom
| Angular
| AngularCustom
2015-07-27 16:49:52 +02:00
| Axios
| AxiosCustom
deriving (Show, Eq)
customOptions :: CommonGeneratorOptions
2015-07-28 15:06:00 +02:00
customOptions = defCommonGeneratorOptions
{ successCallback = "okCallback"
, errorCallback = "errorCallback"
}
2015-08-17 23:50:42 +02:00
2014-12-24 13:55:25 +01:00
spec :: Spec
spec = describe "Servant.JQuery" $ do
2015-07-23 13:47:44 +02:00
generateJSSpec Vanilla JS.generateVanillaJS
generateJSSpec VanillaCustom (JS.generateVanillaJSWith customOptions)
generateJSSpec JQuery JQ.generateJQueryJS
generateJSSpec JQueryCustom (JQ.generateJQueryJSWith customOptions)
generateJSSpec Angular (NG.generateAngularJS NG.defAngularOptions)
generateJSSpec AngularCustom (NG.generateAngularJSWith NG.defAngularOptions customOptions)
2015-07-28 15:06:00 +02:00
generateJSSpec Axios (AX.generateAxiosJS AX.defAxiosOptions)
generateJSSpec AxiosCustom (AX.generateAxiosJSWith (AX.defAxiosOptions { AX.withCredentials = True }) customOptions)
2015-08-17 23:50:42 +02:00
2015-07-23 13:47:44 +02:00
angularSpec Angular
2015-07-28 15:44:55 +02:00
axiosSpec
2015-07-28 15:06:00 +02:00
--angularSpec AngularCustom
shouldContain :: Text -> Text -> Expectation
a `shouldContain` b = shouldSatisfy a (T.isInfixOf b)
shouldNotContain :: Text -> Text -> Expectation
a `shouldNotContain` b = shouldNotSatisfy a (T.isInfixOf b)
2015-08-17 23:50:42 +02:00
axiosSpec :: Spec
2015-07-28 15:44:55 +02:00
axiosSpec = describe specLabel $ do
let reqList = listFromAPI (Proxy :: Proxy NoTypes) (Proxy :: Proxy NoContent) (Proxy :: Proxy TestAPI)
2015-07-28 15:44:55 +02:00
it "should add withCredentials when needed" $ do
2015-12-02 14:22:01 +01:00
let jsText = genJS withCredOpts $ reqList
2015-07-28 15:44:55 +02:00
output jsText
jsText `shouldContain` "withCredentials: true"
2015-07-28 15:44:55 +02:00
it "should add xsrfCookieName when needed" $ do
2015-12-02 14:22:01 +01:00
let jsText = genJS cookieOpts $ reqList
2015-07-28 15:44:55 +02:00
output jsText
jsText `shouldContain` ("xsrfCookieName: 'MyXSRFcookie'")
it "should add withCredentials when needed" $ do
2015-12-02 14:22:01 +01:00
let jsText = genJS headerOpts $ reqList
2015-07-28 15:44:55 +02:00
output jsText
jsText `shouldContain` ("xsrfHeaderName: 'MyXSRFheader'")
where
specLabel = "Axios"
output _ = return ()
withCredOpts = AX.defAxiosOptions { AX.withCredentials = True }
cookieOpts = AX.defAxiosOptions { AX.xsrfCookieName = Just "MyXSRFcookie" }
headerOpts = AX.defAxiosOptions { AX.xsrfHeaderName = Just "MyXSRFheader" }
genJS :: AxiosOptions -> [AjaxReq] -> Text
genJS opts req = mconcat . map (AX.generateAxiosJS opts) $ req
2015-07-28 15:44:55 +02:00
2015-08-17 23:50:42 +02:00
angularSpec :: TestNames -> Spec
angularSpec test = describe specLabel $ do
let reqList = listFromAPI (Proxy :: Proxy NoTypes) (Proxy :: Proxy NoContent) (Proxy :: Proxy TestAPI)
it "should implement a service globally" $ do
2015-12-02 14:22:01 +01:00
let jsText = genJS reqList
output jsText
jsText `shouldContain` (".service('" <> testName <> "'")
2015-08-17 23:50:42 +02:00
it "should depend on $http service globally" $ do
2015-12-02 14:22:01 +01:00
let jsText = genJS reqList
output jsText
jsText `shouldContain` ("('" <> testName <> "', function($http) {")
2015-08-17 23:50:42 +02:00
it "should not depend on $http service in handlers" $ do
2015-12-02 14:22:01 +01:00
let jsText = genJS reqList
output jsText
jsText `shouldNotContain` "getsomething($http, "
where
specLabel = "AngularJS(" <> (show test) <> ")"
output _ = return ()
testName = "MyService"
ngOpts = NG.defAngularOptions { NG.serviceName = testName }
genJS req = NG.angularService ngOpts req
2015-08-17 23:50:42 +02:00
generateJSSpec :: TestNames -> (AjaxReq -> Text) -> Spec
generateJSSpec n gen = describe specLabel $ do
let parseFromText = parse program ""
2015-01-02 10:46:21 +01:00
it "should generate valid javascript" $ do
let s = jsForAPI (Proxy :: Proxy TestAPI) (mconcat . map gen)
parseFromText s `shouldSatisfy` isRight
2015-01-02 10:46:21 +01:00
it "should use non-empty function names" $ do
let (_ :<|> topLevel) = javascript (Proxy :: Proxy TopLevelRawAPI)
output $ genJS (topLevel "GET")
parseFromText (genJS $ topLevel "GET") `shouldSatisfy` isRight
2014-12-24 13:55:25 +01:00
it "should handle simple HTTP headers" $ do
let jsText = genJS $ javascript headerHandlingProxy
output jsText
parseFromText jsText `shouldSatisfy` isRight
jsText `shouldContain` "headerFoo"
jsText `shouldContain` (header n "Foo" $ "headerFoo")
it "should handle complex HTTP headers" $ do
let jsText = genJS $ javascript customAuthProxy
output jsText
parseFromText jsText `shouldSatisfy` isRight
jsText `shouldContain` "headerAuthorization"
jsText `shouldContain` (header n "Authorization" $ "\"Basic \" + headerAuthorization")
it "should handle complex, custom HTTP headers" $ do
let jsText = genJS $ javascript customHeaderProxy
output jsText
parseFromText jsText `shouldSatisfy` isRight
jsText `shouldContain` "headerXMyLovelyHorse"
jsText `shouldContain` (header n "X-MyLovelyHorse" $ "\"I am good friends with \" + headerXMyLovelyHorse")
it "should handle complex, custom HTTP headers (template replacement)" $ do
let jsText = genJS $ javascript customHeaderProxy2
output jsText
parseFromText jsText `shouldSatisfy` isRight
jsText `shouldContain` "headerXWhatsForDinner"
jsText `shouldContain` (header n "X-WhatsForDinner" $ "\"I would like \" + headerXWhatsForDinner + \" with a cherry on top.\"")
2015-04-19 11:56:29 +02:00
it "can generate the whole javascript code string at once with jsForAPI" $ do
2015-10-02 14:45:50 +02:00
let jsStr = jsForAPI (Proxy :: Proxy TestAPI) (mconcat . map gen)
parseFromText jsStr `shouldSatisfy` isRight
where
specLabel = "generateJS(" <> (show n) <> ")"
2015-07-28 01:27:20 +02:00
output _ = return ()
genJS req = gen req
header :: TestNames -> Text -> Text -> Text
header v headerName headerValue
| v `elem` [Vanilla, VanillaCustom] = "xhr.setRequestHeader(\"" <> headerName <> "\", " <> headerValue <> ");\n"
| otherwise = "headers: { \"" <> headerName <> "\": " <> headerValue <> " }\n"