Added Cookie in CookieJar after redirect test case to ClientSpec.hs.

This commit is contained in:
Michael Dunn 2019-01-25 10:17:58 -06:00
parent 37a38d7a9b
commit 07b3236eb6
2 changed files with 26 additions and 8 deletions

View file

@ -101,6 +101,7 @@ test-suite spec
, kan-extensions , kan-extensions
, servant-client , servant-client
, servant-client-core , servant-client-core
, stm
, text , text
, transformers , transformers
, transformers-compat , transformers-compat

View file

@ -28,6 +28,10 @@ import Control.Arrow
(left) (left)
import Control.Concurrent import Control.Concurrent
(ThreadId, forkIO, killThread) (ThreadId, forkIO, killThread)
import Control.Concurrent.STM
(atomically)
import Control.Concurrent.STM.TVar
(newTVar, readTVar)
import Control.Exception import Control.Exception
(bracket) (bracket)
import Control.Monad.Error.Class import Control.Monad.Error.Class
@ -37,6 +41,8 @@ import Data.Char
(chr, isPrint) (chr, isPrint)
import Data.Foldable import Data.Foldable
(forM_) (forM_)
import Data.Maybe
(listToMaybe)
import Data.Monoid () import Data.Monoid ()
import Data.Proxy import Data.Proxy
import Data.Semigroup import Data.Semigroup
@ -64,12 +70,12 @@ import Servant.API
DeleteNoContent, EmptyAPI, FormUrlEncoded, Get, Header, DeleteNoContent, EmptyAPI, FormUrlEncoded, Get, Header,
Headers, JSON, NoContent (NoContent), Post, Put, QueryFlag, Headers, JSON, NoContent (NoContent), Post, Put, QueryFlag,
QueryParam, QueryParams, Raw, ReqBody, addHeader, getHeaders) QueryParam, QueryParams, Raw, ReqBody, addHeader, getHeaders)
import Servant.Test.ComprehensiveAPI
import Servant.Client import Servant.Client
import qualified Servant.Client.Core.Internal.Auth as Auth import qualified Servant.Client.Core.Internal.Auth as Auth
import qualified Servant.Client.Core.Internal.Request as Req import qualified Servant.Client.Core.Internal.Request as Req
import Servant.Server import Servant.Server
import Servant.Server.Experimental.Auth import Servant.Server.Experimental.Auth
import Servant.Test.ComprehensiveAPI
-- This declaration simply checks that all instances are in place. -- This declaration simply checks that all instances are in place.
_ = client comprehensiveAPIWithoutStreaming _ = client comprehensiveAPIWithoutStreaming
@ -128,6 +134,7 @@ type Api =
Get '[JSON] (String, Maybe Int, Bool, [(String, [Rational])]) Get '[JSON] (String, Maybe Int, Bool, [(String, [Rational])])
:<|> "headers" :> Get '[JSON] (Headers TestHeaders Bool) :<|> "headers" :> Get '[JSON] (Headers TestHeaders Bool)
:<|> "deleteContentType" :> DeleteNoContent '[JSON] NoContent :<|> "deleteContentType" :> DeleteNoContent '[JSON] NoContent
:<|> "redirectWithCookie" :> Raw
:<|> "empty" :> EmptyAPI :<|> "empty" :> EmptyAPI
api :: Proxy Api api :: Proxy Api
@ -148,6 +155,7 @@ getMultiple :: String -> Maybe Int -> Bool -> [(String, [Rational])]
-> ClientM (String, Maybe Int, Bool, [(String, [Rational])]) -> ClientM (String, Maybe Int, Bool, [(String, [Rational])])
getRespHeaders :: ClientM (Headers TestHeaders Bool) getRespHeaders :: ClientM (Headers TestHeaders Bool)
getDeleteContentType :: ClientM NoContent getDeleteContentType :: ClientM NoContent
getRedirectWithCookie :: HTTP.Method -> ClientM Response
getRoot getRoot
:<|> getGet :<|> getGet
@ -163,6 +171,7 @@ getRoot
:<|> getMultiple :<|> getMultiple
:<|> getRespHeaders :<|> getRespHeaders
:<|> getDeleteContentType :<|> getDeleteContentType
:<|> getRedirectWithCookie
:<|> EmptyClient = client api :<|> EmptyClient = client api
server :: Application server :: Application
@ -184,9 +193,9 @@ server = serve api (
:<|> (\ a b c d -> return (a, b, c, d)) :<|> (\ a b c d -> return (a, b, c, d))
:<|> (return $ addHeader 1729 $ addHeader "eg2" True) :<|> (return $ addHeader 1729 $ addHeader "eg2" True)
:<|> return NoContent :<|> return NoContent
:<|> (Tagged $ \ _request respond -> respond $ Wai.responseLBS HTTP.found302 [("Location", "testlocation"), ("Set-Cookie", "testcookie=test")] "")
:<|> emptyServer) :<|> emptyServer)
type FailApi = type FailApi =
"get" :> Raw "get" :> Raw
:<|> "capture" :> Capture "name" String :> Raw :<|> "capture" :> Capture "name" String :> Raw
@ -364,6 +373,14 @@ sucessSpec = beforeAll (startWaiApp server) $ afterAll endWaiApp $ do
Left e -> assertFailure $ show e Left e -> assertFailure $ show e
Right val -> getHeaders val `shouldBe` [("X-Example1", "1729"), ("X-Example2", "eg2")] Right val -> getHeaders val `shouldBe` [("X-Example1", "1729"), ("X-Example2", "eg2")]
it "Stores Cookie in CookieJar after a redirect" $ \(_, baseUrl) -> do
mgr <- C.newManager C.defaultManagerSettings
cj <- atomically . newTVar $ C.createCookieJar []
_ <- runClientM (getRedirectWithCookie HTTP.methodGet) (ClientEnv mgr baseUrl (Just cj))
cookie <- listToMaybe . C.destroyCookieJar <$> atomically (readTVar cj)
C.cookie_name <$> cookie `shouldBe` Just "testcookie"
C.cookie_value <$> cookie `shouldBe` Just "test"
modifyMaxSuccess (const 20) $ do modifyMaxSuccess (const 20) $ do
it "works for a combination of Capture, QueryParam, QueryFlag and ReqBody" $ \(_, baseUrl) -> it "works for a combination of Capture, QueryParam, QueryFlag and ReqBody" $ \(_, baseUrl) ->
property $ forAllShrink pathGen shrink $ \(NonEmpty cap) num flag body -> property $ forAllShrink pathGen shrink $ \(NonEmpty cap) num flag body ->