07b3236 · typeable/servant

git.iko.soy/typeable/servant

on master help sign in

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

07b3236Michael Dunn8 years ago

servant-client/servant-client.cabal+1

compare with master

unifiedsplit

@@ -101,6 +101,7 @@ test-suite spec

101 , kan-extensions

102 , servant-client

103 , servant-client-core

104+ , stm

104 , text

105 , text

105 , transformers

106 , transformers

106 , transformers-compat

107 , transformers-compat

servant-client/test/Servant/ClientSpec.hs+25−8

@@ -28,6 +28,10 @@ import Control.Arrow

28 (left)

29import Control.Concurrent

30 (ThreadId, forkIO, killThread)

31+import Control.Concurrent.STM

32+ (atomically)

33+import Control.Concurrent.STM.TVar

34+ (newTVar, readTVar)

31import Control.Exception

35import Control.Exception

32 (bracket)

36 (bracket)

33import Control.Monad.Error.Class

37import Control.Monad.Error.Class

@@ -37,17 +41,19 @@ import Data.Char

37 (chr, isPrint)

41 (chr, isPrint)

38import Data.Foldable

42import Data.Foldable

39 (forM_)

43 (forM_)

44+import Data.Maybe

45+ (listToMaybe)

40import Data.Monoid ()

46import Data.Monoid ()

41import Data.Proxy

47import Data.Proxy

42import Data.Semigroup

48import Data.Semigroup

43 ((<>))

49 ((<>))

44−import qualified Generics.SOP as SOP

50+import qualified Generics.SOP as SOP

45import GHC.Generics

51import GHC.Generics

46 (Generic)

52 (Generic)

47−import qualified Network.HTTP.Client as C

53+import qualified Network.HTTP.Client as C

48−import qualified Network.HTTP.Types as HTTP

54+import qualified Network.HTTP.Types as HTTP

49import Network.Socket

55import Network.Socket

50−import qualified Network.Wai as Wai

56+import qualified Network.Wai as Wai

51import Network.Wai.Handler.Warp

57import Network.Wai.Handler.Warp

52import System.IO.Unsafe

58import System.IO.Unsafe

53 (unsafePerformIO)

59 (unsafePerformIO)

@@ -64,12 +70,12 @@ import Servant.API

64 DeleteNoContent, EmptyAPI, FormUrlEncoded, Get, Header,

70 DeleteNoContent, EmptyAPI, FormUrlEncoded, Get, Header,

65 Headers, JSON, NoContent (NoContent), Post, Put, QueryFlag,

71 Headers, JSON, NoContent (NoContent), Post, Put, QueryFlag,

66 QueryParam, QueryParams, Raw, ReqBody, addHeader, getHeaders)

72 QueryParam, QueryParams, Raw, ReqBody, addHeader, getHeaders)

67−import Servant.Test.ComprehensiveAPI

68import Servant.Client

73import Servant.Client

69−import qualified Servant.Client.Core.Internal.Auth as Auth

74+import qualified Servant.Client.Core.Internal.Auth as Auth

70−import qualified Servant.Client.Core.Internal.Request as Req

75+import qualified Servant.Client.Core.Internal.Request as Req

71import Servant.Server

76import Servant.Server

72import Servant.Server.Experimental.Auth

77import Servant.Server.Experimental.Auth

78+import Servant.Test.ComprehensiveAPI

74-- This declaration simply checks that all instances are in place.

80-- This declaration simply checks that all instances are in place.

75_ = client comprehensiveAPIWithoutStreaming

81_ = client comprehensiveAPIWithoutStreaming

@@ -128,6 +134,7 @@ type Api =

128 Get '[JSON] (String, Maybe Int, Bool, [(String, [Rational])])

134 Get '[JSON] (String, Maybe Int, Bool, [(String, [Rational])])

129 :<|> "headers" :> Get '[JSON] (Headers TestHeaders Bool)

135 :<|> "headers" :> Get '[JSON] (Headers TestHeaders Bool)

130 :<|> "deleteContentType" :> DeleteNoContent '[JSON] NoContent

136 :<|> "deleteContentType" :> DeleteNoContent '[JSON] NoContent

137+ :<|> "redirectWithCookie" :> Raw

131 :<|> "empty" :> EmptyAPI

138 :<|> "empty" :> EmptyAPI

132

139

133api :: Proxy Api

140api :: Proxy Api

@@ -148,6 +155,7 @@ getMultiple :: String -> Maybe Int -> Bool -> [(String, [Rational])]

148 -> ClientM (String, Maybe Int, Bool, [(String, [Rational])])

155 -> ClientM (String, Maybe Int, Bool, [(String, [Rational])])

149getRespHeaders :: ClientM (Headers TestHeaders Bool)

156getRespHeaders :: ClientM (Headers TestHeaders Bool)

150getDeleteContentType :: ClientM NoContent

157getDeleteContentType :: ClientM NoContent

158+getRedirectWithCookie :: HTTP.Method -> ClientM Response

151

159

152getRoot

160getRoot

153 :<|> getGet

161 :<|> getGet

@@ -163,6 +171,7 @@ getRoot

163 :<|> getMultiple

171 :<|> getMultiple

164 :<|> getRespHeaders

172 :<|> getRespHeaders

165 :<|> getDeleteContentType

173 :<|> getDeleteContentType

174+ :<|> getRedirectWithCookie

166 :<|> EmptyClient = client api

175 :<|> EmptyClient = client api

167

176

168server :: Application

177server :: Application

@@ -184,9 +193,9 @@ server = serve api (

184 :<|> (\ a b c d -> return (a, b, c, d))

193 :<|> (\ a b c d -> return (a, b, c, d))

185 :<|> (return $ addHeader 1729 $ addHeader "eg2" True)

194 :<|> (return $ addHeader 1729 $ addHeader "eg2" True)

186 :<|> return NoContent

195 :<|> return NoContent

196+ :<|> (Tagged $ \ _request respond -> respond $ Wai.responseLBS HTTP.found302 [("Location", "testlocation"), ("Set-Cookie", "testcookie=test")] "")

187 :<|> emptyServer)

197 :<|> emptyServer)

188

198

189−

190type FailApi =

199type FailApi =

191 "get" :> Raw

200 "get" :> Raw

192 :<|> "capture" :> Capture "name" String :> Raw

201 :<|> "capture" :> Capture "name" String :> Raw

@@ -364,6 +373,14 @@ sucessSpec = beforeAll (startWaiApp server) $ afterAll endWaiApp $ do

364 Left e -> assertFailure $ show e

373 Left e -> assertFailure $ show e

365 Right val -> getHeaders val `shouldBe` [("X-Example1", "1729"), ("X-Example2", "eg2")]

374 Right val -> getHeaders val `shouldBe` [("X-Example1", "1729"), ("X-Example2", "eg2")]

366

375

376+ it "Stores Cookie in CookieJar after a redirect" $ \(_, baseUrl) -> do

377+ mgr <- C.newManager C.defaultManagerSettings

378+ cj <- atomically . newTVar $ C.createCookieJar []

379+ _ <- runClientM (getRedirectWithCookie HTTP.methodGet) (ClientEnv mgr baseUrl (Just cj))

380+ cookie <- listToMaybe . C.destroyCookieJar <$> atomically (readTVar cj)

381+ C.cookie_name <$> cookie `shouldBe` Just "testcookie"

382+ C.cookie_value <$> cookie `shouldBe` Just "test"

383+

367 modifyMaxSuccess (const 20) $ do

384 modifyMaxSuccess (const 20) $ do

368 it "works for a combination of Capture, QueryParam, QueryFlag and ReqBody" $ \(_, baseUrl) ->

385 it "works for a combination of Capture, QueryParam, QueryFlag and ReqBody" $ \(_, baseUrl) ->

369 property $ forAllShrink pathGen shrink $ \(NonEmpty cap) num flag body ->

386 property $ forAllShrink pathGen shrink $ \(NonEmpty cap) num flag body ->