e4bd07a · servant · git.iko.soy

doc/cookbook/basic-auth/BasicAuth.lhs+1−1

compare with master

unifiedsplit

@@ -164,7 +164,7 @@ main :: IO ()

164main = do

165 mgr <- newManager defaultManagerSettings

166 bracket (forkIO $ runApp userDB) killThread $ \_ ->

167− runClientM (getSite u) (ClientEnv mgr (BaseUrl Http "localhost" 8080 ""))

167+ runClientM (getSite u) (mkClientEnv mgr (BaseUrl Http "localhost" 8080 ""))

168 >>= print

169

170 where u = BasicAuthData "foo" "bar"

doc/cookbook/db-postgres-pool/PostgresPool.lhs+1−1

@@ -125,7 +125,7 @@ main = do

125 initDB connStr

126 mgr <- newManager defaultManagerSettings

127 bracket (forkIO $ runApp pool) killThread $ \_ -> do

128− ms <- flip runClientM (ClientEnv mgr (BaseUrl Http "localhost" 8080 "")) $ do

128+ ms <- flip runClientM (mkClientEnv mgr (BaseUrl Http "localhost" 8080 "")) $ do

129 postMsg "hello"

130 postMsg "world"

131 getMsgs

doc/cookbook/db-sqlite-simple/DBConnection.lhs+1−1

@@ -86,7 +86,7 @@ main = do

86 initDB dbfile

87 mgr <- newManager defaultManagerSettings

88 bracket (forkIO $ runApp dbfile) killThread $ \_ -> do

89− ms <- flip runClientM (ClientEnv mgr (BaseUrl Http "localhost" 8080 "")) $ do

89+ ms <- flip runClientM (mkClientEnv mgr (BaseUrl Http "localhost" 8080 "")) $ do

90 postMsg "hello"

91 postMsg "world"

92 getMsgs

doc/cookbook/jwt-and-basic-auth/JWTAndBasicAuth.lhs+1−1

@@ -151,7 +151,7 @@ testClient = do

151 let (foo :<|> _) = client (Proxy :: Proxy TestAPIClient)

152 (BasicAuthData "name" "pass")

153 res <- runClientM (foo 42)

154− (ClientEnv mgr (BaseUrl Http "localhost" port ""))

154+ (mkClientEnv mgr (BaseUrl Http "localhost" port ""))

155 hPutStrLn stderr $ case res of

156 Left err -> "Error: " ++ show err

157 Right r -> "Success: " ++ show r

doc/cookbook/using-custom-monad/UsingCustomMonad.lhs+3−3

@@ -11,7 +11,7 @@ We start with a pretty standard set of imports and definition of the model:

11{-# LANGUAGE TypeOperators #-}

12

13import Control.Concurrent (forkIO, killThread)

14−import Control.Concurrent.STM.TVar (TVar, newTVar, readTVar,

14+import Control.Concurrent.STM.TVar (TVar, newTVar, readTVar,

15 writeTVar)

16import Control.Exception (bracket)

17import Control.Monad.IO.Class (liftIO)

@@ -95,7 +95,7 @@ main = do

95 bracket (forkIO runApp) killThread $ \_ -> do

96 let getBooksClient :<|> addBookClient = client api

97 let printBooks = getBooksClient >>= liftIO . print

98− _ <- flip runClientM (ClientEnv mgr (BaseUrl Http "localhost" port "")) $ do

98+ _ <- flip runClientM (mkClientEnv mgr (BaseUrl Http "localhost" port "")) $ do

99 _ <- printBooks

100 _ <- addBookClient $ Book "Harry Potter and the Order of the Phoenix"

101 _ <- printBooks

@@ -114,4 +114,4 @@ Running cookbook-using-custom-monad...

114[Book "Harry Potter and the Order of the Phoenix"]

115[Book "To Kill a Mockingbird",Book "Harry Potter and the Order of the Phoenix"]

116[Book "The Picture of Dorian Gray",Book "To Kill a Mockingbird",Book "Harry Potter and the Order of the Phoenix"]

117−```

117+```

doc/tutorial/Client.lhs+1−1

@@ -136,7 +136,7 @@ queries = do

136run :: IO ()

137run = do

138 manager' <- newManager defaultManagerSettings

139− res <- runClientM queries (ClientEnv manager' (BaseUrl Http "localhost" 8081 ""))

139+ res <- runClientM queries (mkClientEnv manager' (BaseUrl Http "localhost" 8081 ""))

140 case res of

141 Left err -> putStrLn $ "Error: " ++ show err

142 Right (pos, message, em) -> do

servant-client-ghcjs/README.md+1−1

@@ -170,6 +170,6 @@ main :: IO ()

170main = do

171 mgr <- newManager defaultManagerSettings

172 let clientBaseUrl = BaseUrl Http "www.example.com" 80 ""

173− ePos <- runClientM (position apiClient 10 20) $ ClientEnv mgr clientBaseUrl

173+ ePos <- runClientM (position apiClient 10 20) $ mkClientEnv mgr clientBaseUrl

174 print ePos

175```

servant-client/servant-client.cabal+2

@@ -46,6 +46,7 @@ library

46 , containers >= 0.5.5.1 && < 0.6

47 , mtl >= 2.1 && < 2.3

48 , text >= 1.2.3.0 && < 1.3

49+ , time >= 1.4.2 && < 1.9

49 , transformers >= 0.3.0.0 && < 0.6

50 , transformers >= 0.3.0.0 && < 0.6

50

51

51 -- Servant dependencies

52 -- Servant dependencies

@@ -65,6 +66,7 @@ library

65 , exceptions >= 0.8.3 && < 0.9

66 , exceptions >= 0.8.3 && < 0.9

66 , monad-control >= 1.0.0.4 && < 1.1

67 , monad-control >= 1.0.0.4 && < 1.1

67 , semigroupoids >= 5.2.1 && < 5.3

68 , semigroupoids >= 5.2.1 && < 5.3

69+ , stm >= 2.4.4.1 && < 2.5

68 , transformers-base >= 0.4.4 && < 0.5

70 , transformers-base >= 0.4.4 && < 0.5

69 , transformers-compat >= 0.5.1 && < 0.6

71 , transformers-compat >= 0.5.1 && < 0.6

70

72

servant-client/src/Servant/Client.hs+1

@@ -6,6 +6,7 @@ module Servant.Client

6 , ClientM

7 , runClientM

8 , ClientEnv(..)

9+ , mkClientEnv

9 , module Servant.Client.Core.Reexport

10 , module Servant.Client.Core.Reexport

10 ) where

11 ) where

11

12

servant-client/src/Servant/Client/Internal/HttpClient.hs+31−9

@@ -16,17 +16,19 @@ module Servant.Client.Internal.HttpClient where

16import Prelude ()

17import Prelude.Compat

18

19+import Control.Concurrent.STM.TVar

19import Control.Exception

20import Control.Exception

20import Control.Monad

21import Control.Monad

21import Control.Monad.Base (MonadBase (..))

22import Control.Monad.Base (MonadBase (..))

22import Control.Monad.Catch (MonadCatch, MonadThrow)

23import Control.Monad.Catch (MonadCatch, MonadThrow)

23import Control.Monad.Error.Class (MonadError (..))

24import Control.Monad.Error.Class (MonadError (..))

24import Control.Monad.Reader

25import Control.Monad.Reader

26+import Control.Monad.STM (atomically)

25import Control.Monad.Trans.Control (MonadBaseControl (..))

27import Control.Monad.Trans.Control (MonadBaseControl (..))

26import Control.Monad.Trans.Except

28import Control.Monad.Trans.Except

27import Data.ByteString.Builder (toLazyByteString)

29import Data.ByteString.Builder (toLazyByteString)

28import qualified Data.ByteString.Lazy as BSL

30import qualified Data.ByteString.Lazy as BSL

29−import Data.Foldable (toList)

31+import Data.Foldable (toList, for_)

30import Data.Functor.Alt (Alt (..))

32import Data.Functor.Alt (Alt (..))

31import Data.Maybe (maybeToList)

33import Data.Maybe (maybeToList)

32import Data.Monoid ((<>))

34import Data.Monoid ((<>))

@@ -34,6 +36,7 @@ import Data.Proxy (Proxy (..))

34import Data.Sequence (fromList)

36import Data.Sequence (fromList)

35import Data.String (fromString)

37import Data.String (fromString)

36import qualified Data.Text as T

38import qualified Data.Text as T

39+import Data.Time.Clock (getCurrentTime)

37import GHC.Generics

40import GHC.Generics

38import Network.HTTP.Media (renderHeader)

41import Network.HTTP.Media (renderHeader)

39import Network.HTTP.Types (hContentType, renderQuery,

42import Network.HTTP.Types (hContentType, renderQuery,

@@ -47,8 +50,13 @@ data ClientEnv

47 = ClientEnv

50 = ClientEnv

48 { manager :: Client.Manager

51 { manager :: Client.Manager

49 , baseUrl :: BaseUrl

52 , baseUrl :: BaseUrl

53+ , cookieJar :: Maybe (TVar Client.CookieJar)

50 }

54 }

51

55

56+-- | 'ClientEnv' smart constructor.

57+mkClientEnv :: Client.Manager -> BaseUrl -> ClientEnv

58+mkClientEnv mgr burl = ClientEnv mgr burl Nothing

59+

52-- | Generates a set of client functions for an API.

60-- | Generates a set of client functions for an API.

53--

61--

54-- Example:

62-- Example:

@@ -68,7 +76,7 @@ client api = api `clientIn` (Proxy :: Proxy ClientM)

68-- | @ClientM@ is the monad in which client functions run. Contains the

76-- | @ClientM@ is the monad in which client functions run. Contains the

69-- 'Client.Manager' and 'BaseUrl' used for requests in the reader environment.

77-- 'Client.Manager' and 'BaseUrl' used for requests in the reader environment.

70newtype ClientM a = ClientM

78newtype ClientM a = ClientM

71− { runClientM' :: ReaderT ClientEnv (ExceptT ServantError IO) a }

79+ { unClientM :: ReaderT ClientEnv (ExceptT ServantError IO) a }

72 deriving ( Functor, Applicative, Monad, MonadIO, Generic

80 deriving ( Functor, Applicative, Monad, MonadIO, Generic

73 , MonadReader ClientEnv, MonadError ServantError, MonadThrow

81 , MonadReader ClientEnv, MonadError ServantError, MonadThrow

74 , MonadCatch)

82 , MonadCatch)

@@ -79,7 +87,7 @@ instance MonadBase IO ClientM where

79instance MonadBaseControl IO ClientM where

87instance MonadBaseControl IO ClientM where

80 type StM ClientM a = Either ServantError a

88 type StM ClientM a = Either ServantError a

81

89

82− liftBaseWith f = ClientM (liftBaseWith (\g -> f (g . runClientM')))

90+ liftBaseWith f = ClientM (liftBaseWith (\g -> f (g . unClientM)))

83

91

84 restoreM st = ClientM (restoreM st)

92 restoreM st = ClientM (restoreM st)

85

93

@@ -97,19 +105,33 @@ instance ClientLike (ClientM a) (ClientM a) where

97 mkClient = id

105 mkClient = id

98

106

99runClientM :: ClientM a -> ClientEnv -> IO (Either ServantError a)

107runClientM :: ClientM a -> ClientEnv -> IO (Either ServantError a)

100−runClientM cm env = runExceptT $ (flip runReaderT env) $ runClientM' cm

108+runClientM cm env = runExceptT $ flip runReaderT env $ unClientM cm

101−

102

109

103performRequest :: Request -> ClientM Response

110performRequest :: Request -> ClientM Response

104performRequest req = do

111performRequest req = do

105− m <- asks manager

112+ ClientEnv m burl cookieJar' <- ask

106− burl <- asks baseUrl

113+ let clientRequest = requestToClientRequest burl req

114+ request <- case cookieJar' of

115+ Nothing -> pure clientRequest

116+ Just cj -> liftIO $ do

117+ now <- getCurrentTime

118+ atomically $ do

119+ oldCookieJar <- readTVar cj

120+ let (newRequest, newCookieJar) =

121+ Client.insertCookiesIntoRequest

107− let request = requestToClientRequest burl req

122+ (requestToClientRequest burl req)

123+ oldCookieJar

124+ now

125+ writeTVar cj newCookieJar

126+ pure newRequest

108

127

109 eResponse <- liftIO $ catchConnectionError $ Client.httpLbs request m

128 eResponse <- liftIO $ catchConnectionError $ Client.httpLbs request m

110 case eResponse of

129 case eResponse of

111− Left err -> throwError $ err

130+ Left err -> throwError err

112 Right response -> do

131 Right response -> do

132+ for_ cookieJar' $ \cj -> liftIO $ do

133+ now' <- getCurrentTime

134+ atomically $ modifyTVar' cj (fst . Client.updateCookieJar response request now')

113 let status = Client.responseStatus response

135 let status = Client.responseStatus response

114 status_code = statusCode status

136 status_code = statusCode status

115 ourResponse = clientResponseToResponse response

137 ourResponse = clientResponseToResponse response

servant-client/test/Servant/ClientSpec.hs+1−1

@@ -302,7 +302,7 @@ manager' :: C.Manager

302manager' = unsafePerformIO $ C.newManager C.defaultManagerSettings

303

304runClient :: ClientM a -> BaseUrl -> IO (Either ServantError a)

305−runClient x baseUrl' = runClientM x (ClientEnv manager' baseUrl')

305+runClient x baseUrl' = runClientM x (mkClientEnv manager' baseUrl')

306

307sucessSpec :: Spec

308sucessSpec = beforeAll (startWaiApp server) $ afterAll endWaiApp $ do

servant-client/test/Servant/StreamSpec.hs+1−1

@@ -92,7 +92,7 @@ manager' :: C.Manager

92manager' = unsafePerformIO $ C.newManager C.defaultManagerSettings

93

94runClient :: ClientM a -> BaseUrl -> IO (Either ServantError a)

95−runClient x baseUrl' = runClientM x (ClientEnv manager' baseUrl')

95+runClient x baseUrl' = runClientM x (mkClientEnv manager' baseUrl')

96

97runResultStream :: ResultStream a -> IO (Maybe (Either String a), Maybe (Either String a), Maybe (Either String a), Maybe (Either String a))

98runResultStream (ResultStream k) = k $ \act -> (,,,) <$> act <*> act <*> act <*> act

sources.txt+1

@@ -1,5 +1,6 @@

1servant

2servant-server

3servant-client

4+servant-client-core

4servant-docs

5servant-docs

5servant-foreign

6servant-foreign