servant-client 0.18 → 0.18.1
raw patch · 6 files changed
+96/−26 lines, 6 filesdep +sop-coredep ~servant-client-corenew-uploader
Dependencies added: sop-core
Dependency ranges changed: servant-client-core
Files
- CHANGELOG.md +11/−0
- servant-client.cabal +4/−9
- src/Servant/Client/Internal/HttpClient.hs +9/−6
- src/Servant/Client/Internal/HttpClient/Streaming.hs +9/−5
- test/Servant/ClientTestUtils.hs +39/−5
- test/Servant/SuccessSpec.hs +24/−1
CHANGELOG.md view
@@ -1,6 +1,17 @@ [The latest version of this document is on GitHub.](https://github.com/haskell-servant/servant/blob/master/servant-client/CHANGELOG.md) [Changelog for `servant` package contains significant entries for all core packages.](https://github.com/haskell-servant/servant/blob/master/servant/CHANGELOG.md) +0.18.1+------++### Significant changes++- Union verbs++### Other changes++- Bump "tested-with" ghc versions+ 0.18 ----
servant-client.cabal view
@@ -1,6 +1,6 @@ cabal-version: >=1.10 name: servant-client-version: 0.18+version: 0.18.1 synopsis: Automatic derivation of querying functions for servant category: Servant, Web@@ -20,13 +20,7 @@ maintainer: haskell-servant-maintainers@googlegroups.com copyright: 2014-2016 Zalora South East Asia Pte Ltd, 2016-2019 Servant Contributors build-type: Simple-tested-with:- GHC ==8.0.2- || ==8.2.2- || ==8.4.4- || ==8.6.5- || ==8.8.3- || ==8.10.1+tested-with: GHC ==8.0.2 || ==8.2.2 || ==8.4.4 || ==8.6.5 || ==8.8.4 || ==8.10.2 extra-source-files: CHANGELOG.md@@ -64,7 +58,7 @@ -- Strict dependency on `servant-client-core` as we re-export things. build-depends: servant == 0.18.*- , servant-client-core >= 0.18 && <0.18.1+ , servant-client-core >= 0.18 && <0.18.2 -- Other dependencies: Lower bound around what is in the latest Stackage LTS. -- Here can be exceptions if we really need features from the newer versions.@@ -114,6 +108,7 @@ , kan-extensions , servant-client , servant-client-core+ , sop-core , stm , text , transformers
src/Servant/Client/Internal/HttpClient.hs view
@@ -65,7 +65,7 @@ import Network.HTTP.Media (renderHeader) import Network.HTTP.Types- (hContentType, renderQuery, statusCode)+ (hContentType, renderQuery, statusCode, Status) import Servant.Client.Core import qualified Network.HTTP.Client as Client@@ -155,14 +155,14 @@ a <!> b = a `catchError` \_ -> b instance RunClient ClientM where- runRequest = performRequest+ runRequestAcceptStatus = performRequest throwClientError = throwError runClientM :: ClientM a -> ClientEnv -> IO (Either ClientError a) runClientM cm env = runExceptT $ flip runReaderT env $ unClientM cm -performRequest :: Request -> ClientM Response-performRequest req = do+performRequest :: Maybe [Status] -> Request -> ClientM Response+performRequest acceptStatus req = do ClientEnv m burl cookieJar' createClientRequest <- ask let clientRequest = createClientRequest burl req request <- case cookieJar' of@@ -183,8 +183,11 @@ let status = Client.responseStatus response status_code = statusCode status ourResponse = clientResponseToResponse id response- unless (status_code >= 200 && status_code < 300) $- throwError $ mkFailureResponse burl req ourResponse+ goodStatus = case acceptStatus of+ Nothing -> status_code >= 200 && status_code < 300+ Just good -> status `elem` good+ unless goodStatus $ do+ throwError $ mkFailureResponse burl req ourResponse return ourResponse where requestWithoutCookieJar :: Client.Manager -> Client.Request -> ClientM (Client.Response BSL.ByteString)
src/Servant/Client/Internal/HttpClient/Streaming.hs view
@@ -47,7 +47,7 @@ (getCurrentTime) import GHC.Generics import Network.HTTP.Types- (statusCode)+ (Status, statusCode) import qualified Network.HTTP.Client as Client @@ -112,7 +112,7 @@ a <!> b = a `catchError` \_ -> b instance RunClient ClientM where- runRequest = performRequest+ runRequestAcceptStatus = performRequest throwClientError = throwError instance RunStreamingClient ClientM where@@ -136,8 +136,8 @@ runClientM :: NFData a => ClientM a -> ClientEnv -> IO (Either ClientError a) runClientM cm env = withClientM cm env (evaluate . force) -performRequest :: Request -> ClientM Response-performRequest req = do+performRequest :: Maybe [Status] -> Request -> ClientM Response+performRequest acceptStatus req = do -- TODO: should use Client.withResponse here too ClientEnv m burl cookieJar' createClientRequest <- ask let clientRequest = createClientRequest burl req@@ -165,10 +165,14 @@ let status = Client.responseStatus response status_code = statusCode status ourResponse = clientResponseToResponse id response- unless (status_code >= 200 && status_code < 300) $+ goodStatus = case acceptStatus of+ Nothing -> status_code >= 200 && status_code < 300+ Just good -> status `elem` good+ unless goodStatus $ do throwError $ mkFailureResponse burl req ourResponse return ourResponse +-- | TODO: support UVerb ('acceptStatus' argument, like in 'performRequest' above). performWithStreamingRequest :: Request -> (StreamingResponse -> IO a) -> ClientM a performWithStreamingRequest req k = do m <- asks manager
test/Servant/ClientTestUtils.hs view
@@ -9,6 +9,7 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PolyKinds #-} {-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-}@@ -26,10 +27,14 @@ import Control.Monad.Error.Class (throwError) import Data.Aeson+import qualified Data.ByteString.Lazy as LazyByteString import Data.Char (chr, isPrint) import Data.Monoid () import Data.Proxy+import Data.Text (Text)+import qualified Data.Text as Text+import Data.Text.Encoding (encodeUtf8, decodeUtf8) import GHC.Generics (Generic) import qualified Network.HTTP.Client as C@@ -47,8 +52,11 @@ ((:<|>) ((:<|>)), (:>), AuthProtect, BasicAuth, BasicAuthData (..), Capture, CaptureAll, DeleteNoContent, EmptyAPI, FormUrlEncoded, Get, Header,- Headers, JSON, NoContent (NoContent), Post, QueryFlag,- QueryParam, QueryParams, Raw, ReqBody, addHeader)+ Headers, JSON, MimeRender(mimeRender),+ MimeUnrender(mimeUnrender), NoContent (NoContent), PlainText,+ Post, QueryFlag, QueryParam, QueryParams, Raw, ReqBody,+ StdMethod(GET), Union, UVerb, WithStatus(WithStatus),+ addHeader) import Servant.Client import qualified Servant.Client.Core.Auth as Auth import Servant.Server@@ -63,7 +71,7 @@ data Person = Person { _name :: String , _age :: Integer- } deriving (Eq, Show, Generic)+ } deriving (Eq, Show, Read, Generic) instance ToJSON Person instance FromJSON Person@@ -74,6 +82,15 @@ instance Arbitrary Person where arbitrary = Person <$> arbitrary <*> arbitrary +instance MimeRender PlainText Person where+ mimeRender _ = LazyByteString.fromStrict . encodeUtf8 . Text.pack . show++instance MimeUnrender PlainText Person where+ mimeUnrender _ =+ -- This does not handle any errors, but it should be fine for tests+ Right . read . Text.unpack . decodeUtf8 . LazyByteString.toStrict++ alice :: Person alice = Person "Alice" 42 @@ -105,7 +122,13 @@ :<|> "deleteContentType" :> DeleteNoContent :<|> "redirectWithCookie" :> Raw :<|> "empty" :> EmptyAPI+ :<|> "uverb-success-or-redirect" :>+ Capture "bool" Bool :>+ UVerb 'GET '[PlainText] '[WithStatus 200 Person,+ WithStatus 301 Text]+ :<|> "uverb-get-created" :> UVerb 'GET '[PlainText] '[WithStatus 201 Person] + api :: Proxy Api api = Proxy @@ -126,6 +149,10 @@ getRespHeaders :: ClientM (Headers TestHeaders Bool) getDeleteContentType :: ClientM NoContent getRedirectWithCookie :: HTTP.Method -> ClientM Response+uverbGetSuccessOrRedirect :: Bool+ -> ClientM (Union '[WithStatus 200 Person,+ WithStatus 301 Text])+uverbGetCreated :: ClientM (Union '[WithStatus 201 Person]) getRoot :<|> getGet@@ -143,7 +170,9 @@ :<|> getRespHeaders :<|> getDeleteContentType :<|> getRedirectWithCookie- :<|> EmptyClient = client api+ :<|> EmptyClient+ :<|> uverbGetSuccessOrRedirect+ :<|> uverbGetCreated = client api server :: Application server = serve api (@@ -166,7 +195,12 @@ :<|> (return $ addHeader 1729 $ addHeader "eg2" True) :<|> return NoContent :<|> (Tagged $ \ _request respond -> respond $ Wai.responseLBS HTTP.found302 [("Location", "testlocation"), ("Set-Cookie", "testcookie=test")] "")- :<|> emptyServer)+ :<|> emptyServer+ :<|> (\shouldRedirect -> if shouldRedirect+ then respond (WithStatus @301 ("redirecting" :: Text))+ else respond (WithStatus @200 alice ))+ :<|> respond (WithStatus @201 carol)+ ) type FailApi = "get" :> Raw
test/Servant/SuccessSpec.hs view
@@ -8,6 +8,7 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PolyKinds #-} {-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-}@@ -31,6 +32,8 @@ import Data.Maybe (listToMaybe) import Data.Monoid ()+import Data.Text+ (Text) import qualified Network.HTTP.Client as C import qualified Network.HTTP.Types as HTTP import Test.Hspec@@ -39,7 +42,7 @@ import Test.QuickCheck import Servant.API- (NoContent (NoContent), getHeaders)+ (NoContent (NoContent), WithStatus(WithStatus), getHeaders) import Servant.Client import qualified Servant.Client.Core.Request as Req import Servant.Client.Internal.HttpClient (defaultMakeClientRequest)@@ -151,3 +154,23 @@ result <- left show <$> runClient (getMultiple cap num flag body) baseUrl return $ result === Right (cap, num, flag, body)++ context "With a route that can either return success or redirect" $ do+ it "Redirects when appropriate" $ \(_, baseUrl) -> do+ eitherResponse <- runClient (uverbGetSuccessOrRedirect True) baseUrl+ case eitherResponse of+ Left clientError -> fail $ show clientError+ Right response -> matchUnion response `shouldBe` Just (WithStatus @301 @Text "redirecting")++ it "Returns a proper response when appropriate" $ \(_, baseUrl) -> do+ eitherResponse <- runClient (uverbGetSuccessOrRedirect False) baseUrl+ case eitherResponse of+ Left clientError -> fail $ show clientError+ Right response -> matchUnion response `shouldBe` Just (WithStatus @200 alice)++ context "with a route that uses uverb but only has a single response" $+ it "returns the expected response" $ \(_, baseUrl) -> do+ eitherResponse <- runClient (uverbGetCreated) baseUrl+ case eitherResponse of+ Left clientError -> fail $ show clientError+ Right response -> matchUnion response `shouldBe` Just (WithStatus @201 carol)