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
, servant-client
, servant-client-core
, stm
, text
, transformers
, transformers-compat

View file

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