Hello community,
here is the log from the commit of package ghc-servant-client for
openSUSE:Factory checked in at 2017-08-31 20:59:13
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Comparing /work/SRC/openSUSE:Factory/ghc-servant-client (Old)
and /work/SRC/openSUSE:Factory/.ghc-servant-client.new (New)
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "ghc-servant-client"
Thu Aug 31 20:59:13 2017 rev:2 rq:513485 version:0.11
Changes:
--------
--- /work/SRC/openSUSE:Factory/ghc-servant-client/ghc-servant-client.changes
2017-05-10 20:51:09.541416086 +0200
+++
/work/SRC/openSUSE:Factory/.ghc-servant-client.new/ghc-servant-client.changes
2017-08-31 20:59:15.803812858 +0200
@@ -1,0 +2,5 @@
+Thu Jul 27 14:06:06 UTC 2017 - [email protected]
+
+- Update to version 0.11 revision 1.
+
+-------------------------------------------------------------------
Old:
----
servant-client-0.9.1.1.tar.gz
New:
----
servant-client-0.11.tar.gz
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Other differences:
------------------
++++++ ghc-servant-client.spec ++++++
--- /var/tmp/diff_new_pack.ZDkX7K/_old 2017-08-31 20:59:17.203616182 +0200
+++ /var/tmp/diff_new_pack.ZDkX7K/_new 2017-08-31 20:59:17.231612248 +0200
@@ -19,7 +19,7 @@
%global pkg_name servant-client
%bcond_with tests
Name: ghc-%{pkg_name}
-Version: 0.9.1.1
+Version: 0.11
Release: 0
Summary: Automatical derivation of querying functions for servant
webservices
License: BSD-3-Clause
@@ -34,18 +34,22 @@
BuildRequires: ghc-base64-bytestring-devel
BuildRequires: ghc-bytestring-devel
BuildRequires: ghc-exceptions-devel
+BuildRequires: ghc-generics-sop-devel
BuildRequires: ghc-http-api-data-devel
BuildRequires: ghc-http-client-devel
BuildRequires: ghc-http-client-tls-devel
BuildRequires: ghc-http-media-devel
BuildRequires: ghc-http-types-devel
+BuildRequires: ghc-monad-control-devel
BuildRequires: ghc-mtl-devel
BuildRequires: ghc-network-uri-devel
BuildRequires: ghc-rpm-macros
BuildRequires: ghc-safe-devel
+BuildRequires: ghc-semigroupoids-devel
BuildRequires: ghc-servant-devel
BuildRequires: ghc-string-conversions-devel
BuildRequires: ghc-text-devel
+BuildRequires: ghc-transformers-base-devel
BuildRequires: ghc-transformers-compat-devel
BuildRequires: ghc-transformers-devel
BuildRoot: %{_tmppath}/%{name}-%{version}-build
++++++ servant-client-0.9.1.1.tar.gz -> servant-client-0.11.tar.gz ++++++
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/servant-client-0.9.1.1/CHANGELOG.md
new/servant-client-0.11/CHANGELOG.md
--- old/servant-client-0.9.1.1/CHANGELOG.md 2016-10-27 13:25:27.000000000
+0200
+++ new/servant-client-0.11/CHANGELOG.md 2017-05-24 09:22:37.000000000
+0200
@@ -1,3 +1,37 @@
+0.11
+----
+
+### Other changes
+
+- Path components are escaped
+ ([#696](https://github.com/haskell-servant/servant/pull/696))
+- `Req` `reqPath` field changed from `String` to `BS.Builder`
+ ([#696](https://github.com/haskell-servant/servant/pull/696))
+- Include `Req` in failure errors
+ ([#740](https://github.com/haskell-servant/servant/pull/740))
+
+0.10
+-----
+
+### Breaking changes
+
+There shouldn't be breaking changes. Released as a part of `servant` suite.
+
+### Other changes
+
+* Add MonadBase and MonadBaseControl instances for ClientM
+ ([#663](https://github.com/haskell-servant/servant/issues/663))
+
+* client asks for any content-type in Accept contentTypes non-empty list
+ ([#615](https://github.com/haskell-servant/servant/pull/615))
+
+* Add `ClientLike` class that matches client functions generated using `client`
+ with client data structure.
+ ([#640](https://github.com/haskell-servant/servant/pull/640))
+
+* Allow direct use of 'RequestBody'
+ ([#661](https://github.com/haskell-servant/servant/pull/661))
+
0.9.1.1
-------
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/servant-client-0.9.1.1/servant-client.cabal
new/servant-client-0.11/servant-client.cabal
--- old/servant-client-0.9.1.1/servant-client.cabal 2016-10-27
13:25:27.000000000 +0200
+++ new/servant-client-0.11/servant-client.cabal 2017-05-24
09:22:37.000000000 +0200
@@ -1,5 +1,5 @@
name: servant-client
-version: 0.9.1.1
+version: 0.11
synopsis: automatical derivation of querying functions for servant webservices
description:
This library lets you derive automatically Haskell functions that
@@ -13,7 +13,7 @@
author: Servant Contributors
maintainer: [email protected]
copyright: 2014-2016 Zalora South East Asia Pte Ltd, Servant
Contributors
-category: Web
+category: Servant Web
build-type: Simple
cabal-version: >=1.10
tested-with: GHC >= 7.8
@@ -30,6 +30,7 @@
library
exposed-modules:
Servant.Client
+ Servant.Client.Generic
Servant.Client.Experimental.Auth
Servant.Common.BaseUrl
Servant.Common.BasicAuth
@@ -37,24 +38,31 @@
build-depends:
base >= 4.7 && < 4.10
, base-compat >= 0.9.1 && < 0.10
- , aeson >= 0.7 && < 1.1
+ , aeson >= 0.7 && < 1.3
, attoparsec >= 0.12 && < 0.14
, base64-bytestring >= 1.0.0.1 && < 1.1
, bytestring >= 0.10 && < 0.11
, exceptions >= 0.8 && < 0.9
- , http-api-data >= 0.3 && < 0.4
+ , generics-sop >= 0.1.0.0 && < 0.4
+ , http-api-data >= 0.3.6 && < 0.4
, http-client >= 0.4.18.1 && < 0.6
, http-client-tls >= 0.2.2 && < 0.4
, http-media >= 0.6.2 && < 0.7
, http-types >= 0.8.6 && < 0.10
+ , monad-control >= 1.0.0.4 && < 1.1
, network-uri >= 2.6 && < 2.7
, safe >= 0.3.9 && < 0.4
- , servant == 0.9.*
+ , semigroupoids >= 4.3 && < 5.3
+ , servant == 0.11.*
, string-conversions >= 0.3 && < 0.5
, text >= 1.2 && < 1.3
, transformers >= 0.3 && < 0.6
+ , transformers-base >= 0.4.4 && < 0.5
, transformers-compat >= 0.4 && < 0.6
, mtl
+ if !impl(ghc >= 8.0)
+ build-depends:
+ semigroups >=0.16.2.2 && <0.19
hs-source-dirs: src
default-language: Haskell2010
ghc-options: -Wall
@@ -73,10 +81,8 @@
, Servant.Common.BaseUrlSpec
build-depends:
base == 4.*
- , base-compat
- , transformers
- , transformers-compat
, aeson
+ , base-compat
, bytestring
, deepseq
, hspec == 2.*
@@ -85,11 +91,15 @@
, http-media
, http-types
, HUnit
+ , mtl
, network >= 2.6
, QuickCheck >= 2.7
- , servant == 0.9.*
+ , servant
, servant-client
- , servant-server == 0.9.*
+ , servant-server == 0.11.*
, text
+ , transformers
+ , transformers-compat
, wai
, warp
+ , generics-sop
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/servant-client-0.9.1.1/src/Servant/Client/Generic.hs
new/servant-client-0.11/src/Servant/Client/Generic.hs
--- old/servant-client-0.9.1.1/src/Servant/Client/Generic.hs 1970-01-01
01:00:00.000000000 +0100
+++ new/servant-client-0.11/src/Servant/Client/Generic.hs 2017-05-24
09:22:37.000000000 +0200
@@ -0,0 +1,164 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DefaultSignatures #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE UndecidableInstances #-}
+
+#include "overlapping-compat.h"
+
+module Servant.Client.Generic
+ ( ClientLike(..)
+ , genericMkClientL
+ , genericMkClientP
+ ) where
+
+import Generics.SOP (Code, Generic, I(..), NP(..), NS(Z), SOP(..), to)
+import Servant.API ((:<|>)(..))
+import Servant.Client (ClientM)
+
+-- | This class allows us to match client structure with client functions
+-- produced with 'client' without explicit pattern-matching.
+--
+-- The client structure needs a 'Generics.SOP.Generic' instance.
+--
+-- Example:
+--
+-- > type API
+-- > = "foo" :> Capture "x" Int :> Get '[JSON] Int
+-- > :<|> "bar" :> QueryParam "a" Char :> QueryParam "b" String :> Post
'[JSON] [Int]
+-- > :<|> Capture "nested" Int :> NestedAPI
+-- >
+-- > type NestedAPI
+-- > = Get '[JSON] String
+-- > :<|> "baz" :> QueryParam "c" Char :> Post '[JSON] ()
+-- >
+-- > data APIClient = APIClient
+-- > { getFoo :: Int -> ClientM Int
+-- > , postBar :: Maybe Char -> Maybe String -> ClientM [Int]
+-- > , mkNestedClient :: Int -> NestedClient
+-- > } deriving GHC.Generic
+-- >
+-- > instance Generics.SOP.Generic APIClient
+-- > instance (Client API ~ client) => ClientLike client APIClient
+-- >
+-- > data NestedClient = NestedClient
+-- > { getString :: ClientM String
+-- > , postBaz :: Maybe Char -> ClientM ()
+-- > } deriving GHC.Generic
+-- >
+-- > instance Generics.SOP.Generic NestedClient
+-- > instance (Client NestedAPI ~ client) => ClientLike client NestedClient
+-- >
+-- > mkAPIClient :: APIClient
+-- > mkAPIClient = mkClient (client (Proxy :: Proxy API))
+--
+-- By default, left-nested alternatives are expanded:
+--
+-- > type API1
+-- > = "foo" :> Capture "x" Int :> Get '[JSON] Int
+-- > :<|> "bar" :> QueryParam "a" Char :> Post '[JSON] String
+-- >
+-- > type API2
+-- > = "baz" :> QueryParam "c" Char :> Post '[JSON] ()
+-- >
+-- > type API = API1 :<|> API2
+-- >
+-- > data APIClient = APIClient
+-- > { getFoo :: Int -> ClientM Int
+-- > , postBar :: Maybe Char -> ClientM String
+-- > , postBaz :: Maybe Char -> ClientM ()
+-- > } deriving GHC.Generic
+-- >
+-- > instance Generics.SOP.Generic APIClient
+-- > instance (Client API ~ client) => ClientLike client APIClient
+-- >
+-- > mkAPIClient :: APIClient
+-- > mkAPIClient = mkClient (client (Proxy :: Proxy API))
+--
+-- If you want to define client for @API1@ as a separate data structure,
+-- you can use 'genericMkClientP':
+--
+-- > data APIClient1 = APIClient1
+-- > { getFoo :: Int -> ClientM Int
+-- > , postBar :: Maybe Char -> ClientM String
+-- > } deriving GHC.Generic
+-- >
+-- > instance Generics.SOP.Generic APIClient1
+-- > instance (Client API1 ~ client) => ClientLike client APIClient1
+-- >
+-- > data APIClient = APIClient
+-- > { mkAPIClient1 :: APIClient1
+-- > , postBaz :: Maybe Char -> ClientM ()
+-- > } deriving GHC.Generic
+-- >
+-- > instance Generics.SOP.Generic APIClient
+-- > instance (Client API ~ client) => ClientLike client APIClient where
+-- > mkClient = genericMkClientP
+-- >
+-- > mkAPIClient :: APIClient
+-- > mkAPIClient = mkClient (client (Proxy :: Proxy API))
+class ClientLike client custom where
+ mkClient :: client -> custom
+ default mkClient :: (Generic custom, Code custom ~ '[xs], GClientList client
'[], GClientLikeL (ClientList client '[]) xs)
+ => client -> custom
+ mkClient = genericMkClientL
+
+instance ClientLike client custom
+ => ClientLike (a -> client) (a -> custom) where
+ mkClient c = mkClient . c
+
+instance ClientLike (ClientM a) (ClientM a) where
+ mkClient = id
+
+-- | Match client structure with client functions, regarding left-nested API
clients
+-- as separate data structures.
+class GClientLikeP client xs where
+ gMkClientP :: client -> NP I xs
+
+instance (GClientLikeP b (y ': xs), ClientLike a x)
+ => GClientLikeP (a :<|> b) (x ': y ': xs) where
+ gMkClientP (a :<|> b) = I (mkClient a) :* gMkClientP b
+
+instance ClientLike a x => GClientLikeP a '[x] where
+ gMkClientP a = I (mkClient a) :* Nil
+
+-- | Match client structure with client functions, expanding left-nested API
clients
+-- in the same structure.
+class GClientLikeL (xs :: [*]) (ys :: [*]) where
+ gMkClientL :: NP I xs -> NP I ys
+
+instance GClientLikeL '[] '[] where
+ gMkClientL Nil = Nil
+
+instance (ClientLike x y, GClientLikeL xs ys) => GClientLikeL (x ': xs) (y ':
ys) where
+ gMkClientL (I x :* xs) = I (mkClient x) :* gMkClientL xs
+
+type family ClientList (client :: *) (acc :: [*]) :: [*] where
+ ClientList (a :<|> b) acc = ClientList a (ClientList b acc)
+ ClientList a acc = a ': acc
+
+class GClientList client (acc :: [*]) where
+ gClientList :: client -> NP I acc -> NP I (ClientList client acc)
+
+instance (GClientList b acc, GClientList a (ClientList b acc))
+ => GClientList (a :<|> b) acc where
+ gClientList (a :<|> b) acc = gClientList a (gClientList b acc)
+
+instance OVERLAPPABLE_ (ClientList client acc ~ (client ': acc))
+ => GClientList client acc where
+ gClientList c acc = I c :* acc
+
+-- | Generate client structure from client type, expanding left-nested API
(done by default).
+genericMkClientL :: (Generic custom, Code custom ~ '[xs], GClientList client
'[], GClientLikeL (ClientList client '[]) xs)
+ => client -> custom
+genericMkClientL = to . SOP . Z . gMkClientL . flip gClientList Nil
+
+-- | Generate client structure from client type, regarding left-nested API
clients as separate data structures.
+genericMkClientP :: (Generic custom, Code custom ~ '[xs], GClientLikeP client
xs)
+ => client -> custom
+genericMkClientP = to . SOP . Z . gMkClientP
+
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/servant-client-0.9.1.1/src/Servant/Client.hs
new/servant-client-0.11/src/Servant/Client.hs
--- old/servant-client-0.9.1.1/src/Servant/Client.hs 2016-10-24
18:27:44.000000000 +0200
+++ new/servant-client-0.11/src/Servant/Client.hs 2017-05-24
09:22:37.000000000 +0200
@@ -24,6 +24,7 @@
, ClientEnv (ClientEnv)
, mkAuthenticateReq
, ServantError(..)
+ , EmptyClient(..)
, module Servant.Common.BaseUrl
) where
@@ -88,6 +89,23 @@
clientWithRoute (Proxy :: Proxy a) req :<|>
clientWithRoute (Proxy :: Proxy b) req
+-- | Singleton type representing a client for an empty API.
+data EmptyClient = EmptyClient deriving (Eq, Show, Bounded, Enum)
+
+-- | The client for 'EmptyAPI' is simply 'EmptyClient'.
+--
+-- > type MyAPI = "books" :> Get '[JSON] [Book] -- GET /books
+-- > :<|> "nothing" :> EmptyAPI
+-- >
+-- > myApi :: Proxy MyApi
+-- > myApi = Proxy
+-- >
+-- > getAllBooks :: ClientM [Book]
+-- > (getAllBooks :<|> EmptyClient) = client myApi
+instance HasClient EmptyAPI where
+ type Client EmptyAPI = EmptyClient
+ clientWithRoute Proxy _ = EmptyClient
+
-- | If you use a 'Capture' in one of your endpoints in your API,
-- the corresponding querying function will automatically take
-- an additional argument of the type specified by your 'Capture'.
@@ -406,7 +424,8 @@
clientWithRoute Proxy req body =
clientWithRoute (Proxy :: Proxy api)
(let ctProxy = Proxy :: Proxy ct
- in setRQBody (mimeRender ctProxy body)
+ in setReqBodyLBS (mimeRender ctProxy body)
+ -- We use first contentType from the Accept
list
(contentType ctProxy)
req
)
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/servant-client-0.9.1.1/src/Servant/Common/Req.hs
new/servant-client-0.11/src/Servant/Common/Req.hs
--- old/servant-client-0.9.1.1/src/Servant/Common/Req.hs 2016-10-27
13:25:54.000000000 +0200
+++ new/servant-client-0.11/src/Servant/Common/Req.hs 2017-05-24
09:22:37.000000000 +0200
@@ -1,9 +1,11 @@
-{-# LANGUAGE DeriveDataTypeable #-}
-{-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE CPP #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ScopedTypeVariables #-}
module Servant.Common.Req where
@@ -13,21 +15,22 @@
import Control.Exception
import Control.Monad
import Control.Monad.Catch (MonadThrow, MonadCatch)
+import Data.Foldable (toList)
+import Data.Functor.Alt (Alt (..))
+import Data.Semigroup ((<>))
-#if MIN_VERSION_mtl(2,2,0)
-import Control.Monad.Except (MonadError(..))
-#else
import Control.Monad.Error.Class (MonadError(..))
-#endif
import Control.Monad.Trans.Except
-
import GHC.Generics
+import Control.Monad.Base (MonadBase (..))
import Control.Monad.IO.Class ()
import Control.Monad.Reader
-import Data.ByteString.Lazy hiding (pack, filter, map, null, elem)
+import Control.Monad.Trans.Control (MonadBaseControl (..))
+import qualified Data.ByteString.Builder as BS
+import Data.ByteString.Lazy hiding (pack, filter, map, null, elem, any)
import Data.String
-import Data.String.Conversions
+import Data.String.Conversions (cs)
import Data.Proxy
import Data.Text (Text)
import Data.Text.Encoding
@@ -46,7 +49,8 @@
data ServantError
= FailureResponse
- { responseStatus :: Status
+ { failingRequest :: UrlReq
+ , responseStatus :: Status
, responseContentType :: MediaType
, responseBody :: ByteString
}
@@ -69,7 +73,7 @@
deriving (Show, Typeable)
instance Eq ServantError where
- FailureResponse a b c == FailureResponse x y z =
+ FailureResponse _ a b c == FailureResponse _ x y z =
(a, b, c) == (x, y, z)
DecodeFailure a b c == DecodeFailure x y z =
(a, b, c) == (x, y, z)
@@ -83,10 +87,17 @@
instance Exception ServantError
+data UrlReq = UrlReq BaseUrl Req
+
+instance Show UrlReq where
+ show (UrlReq url req) = showBaseUrl url ++ path ++ "?" ++ show (qs req)
+ where
+ path = cs (BS.toLazyByteString (reqPath req))
+
data Req = Req
- { reqPath :: String
+ { reqPath :: BS.Builder
, qs :: QueryText
- , reqBody :: Maybe (ByteString, MediaType)
+ , reqBody :: Maybe (RequestBody, MediaType)
, reqAccept :: [MediaType]
, headers :: [(String, Text)]
}
@@ -96,7 +107,7 @@
appendToPath :: String -> Req -> Req
appendToPath p req =
- req { reqPath = reqPath req ++ "/" ++ p }
+ req { reqPath = reqPath req <> "/" <> toEncodedUrlPiece p }
appendToQueryString :: Text -- ^ param name
-> Maybe Text -- ^ param value
@@ -111,8 +122,31 @@
++ [(name, decodeUtf8 (toHeader val))]
}
+-- | Set body and media type of the request being constructed.
+--
+-- The body is set to the given bytestring using the 'RequestBodyLBS'
+-- constructor.
+--
+{-# DEPRECATED setRQBody "Use setReqBodyLBS instead" #-}
setRQBody :: ByteString -> MediaType -> Req -> Req
-setRQBody b t req = req { reqBody = Just (b, t) }
+setRQBody = setReqBodyLBS
+
+-- | Set body and media type of the request being constructed.
+--
+-- The body is set to the given bytestring using the 'RequestBodyLBS'
+-- constructor.
+--
+-- @since 0.9.2.0
+--
+setReqBodyLBS :: ByteString -> MediaType -> Req -> Req
+setReqBodyLBS b t req = req { reqBody = Just (RequestBodyLBS b, t) }
+
+-- | Set body and media type of the request being constructed.
+--
+-- @since 0.9.2.0
+--
+setReqBody :: RequestBody -> MediaType -> Req -> Req
+setReqBody b t req = req { reqBody = Just (b, t) }
reqToRequest :: (Functor m, MonadThrow m) => Req -> BaseUrl -> m Request
reqToRequest req (BaseUrl reqScheme reqHost reqPort path) =
@@ -126,12 +160,13 @@
, uriRegName = reqHost
, uriPort = ":" ++ show reqPort
}
- , uriPath = path ++ reqPath req
+ , uriPath = fullPath
}
+ fullPath = path ++ cs (BS.toLazyByteString (reqPath req))
setrqb r = case reqBody req of
Nothing -> r
- Just (b,t) -> r { requestBody = RequestBodyLBS b
+ Just (b,t) -> r { requestBody = b
, requestHeaders = requestHeaders r
++ [(hContentType, cs .
show $ t)] }
setQS = setQueryString $ queryTextToQuery (qs req)
@@ -179,11 +214,27 @@
, MonadThrow, MonadCatch
)
+instance MonadBase IO ClientM where
+ liftBase = ClientM . liftBase
+
+instance MonadBaseControl IO ClientM where
+ type StM ClientM a = Either ServantError a
+
+ -- liftBaseWith :: (RunInBase ClientM IO -> IO a) -> ClientM a
+ liftBaseWith f = ClientM (liftBaseWith (\g -> f (g . runClientM')))
+
+ -- restoreM :: StM ClientM a -> ClientM a
+ restoreM st = ClientM (restoreM st)
+
+-- | Try clients in order, last error is preserved.
+instance Alt ClientM where
+ a <!> b = a `catchError` \_ -> b
+
runClientM :: ClientM a -> ClientEnv -> IO (Either ServantError a)
runClientM cm env = runExceptT $ (flip runReaderT env) $ runClientM' cm
-performRequest :: Method -> Req
+performRequest :: Method -> Req
-> ClientM ( Int, ByteString, MediaType
, [HTTP.Header], Response ByteString)
performRequest reqMethod req = do
@@ -209,16 +260,16 @@
Nothing -> throwError $ InvalidContentTypeHeader (cs t) body
Just t' -> pure t'
unless (status_code >= 200 && status_code < 300) $
- throwError $ FailureResponse status ct body
+ throwError $ FailureResponse (UrlReq reqHost req) status ct body
return (status_code, body, ct, hdrs, response)
-performRequestCT :: MimeUnrender ct result => Proxy ct -> Method -> Req
+performRequestCT :: MimeUnrender ct result => Proxy ct -> Method -> Req
-> ClientM ([HTTP.Header], result)
performRequestCT ct reqMethod req = do
- let acceptCT = contentType ct
+ let acceptCTS = contentTypes ct
(_status, respBody, respCT, hdrs, _response) <-
- performRequest reqMethod (req { reqAccept = [acceptCT] })
- unless (matches respCT (acceptCT)) $ throwError $ UnsupportedContentType
respCT respBody
+ performRequest reqMethod (req { reqAccept = toList acceptCTS })
+ unless (any (matches respCT) acceptCTS) $ throwError $
UnsupportedContentType respCT respBody
case mimeUnrender ct respBody of
Left err -> throwError $ DecodeFailure err respCT respBody
Right val -> return (hdrs, val)
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/servant-client-0.9.1.1/test/Servant/ClientSpec.hs
new/servant-client-0.11/test/Servant/ClientSpec.hs
--- old/servant-client-0.9.1.1/test/Servant/ClientSpec.hs 2016-10-24
18:27:44.000000000 +0200
+++ new/servant-client-0.11/test/Servant/ClientSpec.hs 2017-05-24
09:22:37.000000000 +0200
@@ -29,13 +29,14 @@
import Control.Arrow (left)
import Control.Concurrent (forkIO, killThread, ThreadId)
import Control.Exception (bracket)
-import Control.Monad.Trans.Except (throwE )
+import Control.Monad.Error.Class (throwError )
import Data.Aeson
import qualified Data.ByteString.Lazy as BS
import Data.Char (chr, isPrint)
import Data.Foldable (forM_)
import Data.Monoid hiding (getLast)
import Data.Proxy
+import qualified Generics.SOP as SOP
import GHC.Generics (Generic)
import qualified Network.HTTP.Client as C
import Network.HTTP.Media
@@ -55,6 +56,7 @@
import Servant.API
import Servant.API.Internal.Test.ComprehensiveAPI
import Servant.Client
+import Servant.Client.Generic
import qualified Servant.Common.Req as SCR
import Servant.Server
import Servant.Server.Experimental.Auth
@@ -69,6 +71,7 @@
wrappedApiSpec
basicAuthSpec
genAuthSpec
+ genericClientSpec
-- * test data types
@@ -108,6 +111,8 @@
Get '[JSON] (String, Maybe Int, Bool, [(String, [Rational])])
:<|> "headers" :> Get '[JSON] (Headers TestHeaders Bool)
:<|> "deleteContentType" :> DeleteNoContent '[JSON] NoContent
+ :<|> "empty" :> EmptyAPI
+
api :: Proxy Api
api = Proxy
@@ -119,14 +124,15 @@
getQueryParam :: Maybe String -> SCR.ClientM Person
getQueryParams :: [String] -> SCR.ClientM [Person]
getQueryFlag :: Bool -> SCR.ClientM Bool
-getRawSuccess :: HTTP.Method
+getRawSuccess :: HTTP.Method
-> SCR.ClientM (Int, BS.ByteString, MediaType, [HTTP.Header], C.Response
BS.ByteString)
-getRawFailure :: HTTP.Method
+getRawFailure :: HTTP.Method
-> SCR.ClientM (Int, BS.ByteString, MediaType, [HTTP.Header], C.Response
BS.ByteString)
getMultiple :: String -> Maybe Int -> Bool -> [(String, [Rational])]
-> SCR.ClientM (String, Maybe Int, Bool, [(String, [Rational])])
getRespHeaders :: SCR.ClientM (Headers TestHeaders Bool)
getDeleteContentType :: SCR.ClientM NoContent
+
getGet
:<|> getDeleteEmpty
:<|> getCapture
@@ -139,7 +145,8 @@
:<|> getRawFailure
:<|> getMultiple
:<|> getRespHeaders
- :<|> getDeleteContentType = client api
+ :<|> getDeleteContentType
+ :<|> EmptyClient = client api
server :: Application
server = serve api (
@@ -150,16 +157,16 @@
:<|> return
:<|> (\ name -> case name of
Just "alice" -> return alice
- Just n -> throwE $ ServantErr 400 (n ++ " not found") "" []
- Nothing -> throwE $ ServantErr 400 "missing parameter" ""
[])
+ Just n -> throwError $ ServantErr 400 (n ++ " not found")
"" []
+ Nothing -> throwError $ ServantErr 400 "missing parameter"
"" [])
:<|> (\ names -> return (zipWith Person names [0..]))
:<|> return
- :<|> (\ _request respond -> respond $ responseLBS HTTP.ok200 [] "rawSuccess")
- :<|> (\ _request respond -> respond $ responseLBS HTTP.badRequest400 []
"rawFailure")
+ :<|> (Tagged $ \ _request respond -> respond $ responseLBS HTTP.ok200 []
"rawSuccess")
+ :<|> (Tagged $ \ _request respond -> respond $ responseLBS
HTTP.badRequest400 [] "rawFailure")
:<|> (\ a b c d -> return (a, b, c, d))
:<|> (return $ addHeader 1729 $ addHeader "eg2" True)
:<|> return NoContent
- )
+ :<|> emptyServer)
type FailApi =
@@ -171,9 +178,9 @@
failServer :: Application
failServer = serve failApi (
- (\ _request respond -> respond $ responseLBS HTTP.ok200 [] "")
- :<|> (\ _capture _request respond -> respond $ responseLBS HTTP.ok200
[("content-type", "application/json")] "")
- :<|> (\_request respond -> respond $ responseLBS HTTP.ok200
[("content-type", "fooooo")] "")
+ (Tagged $ \ _request respond -> respond $ responseLBS HTTP.ok200 [] "")
+ :<|> (\ _capture -> Tagged $ \_request respond -> respond $ responseLBS
HTTP.ok200 [("content-type", "application/json")] "")
+ :<|> (Tagged $ \_request respond -> respond $ responseLBS HTTP.ok200
[("content-type", "fooooo")] "")
)
-- * basic auth stuff
@@ -212,7 +219,7 @@
genAuthHandler :: AuthHandler Request ()
genAuthHandler =
let handler req = case lookup "AuthHeader" (requestHeaders req) of
- Nothing -> throwE (err401 { errBody = "Missing auth header" })
+ Nothing -> throwError (err401 { errBody = "Missing auth header" })
Just _ -> return ()
in mkAuthHandler handler
@@ -222,6 +229,53 @@
genAuthServer :: Application
genAuthServer = serveWithContext genAuthAPI genAuthServerContext (const
(return alice))
+-- * generic client stuff
+
+type GenericClientAPI
+ = QueryParam "sqr" Int :> Get '[JSON] Int
+ :<|> Capture "foo" String :> NestedAPI1
+
+data GenericClient = GenericClient
+ { getSqr :: Maybe Int -> SCR.ClientM Int
+ , mkNestedClient1 :: String -> NestedClient1
+ } deriving Generic
+instance SOP.Generic GenericClient
+instance (Client GenericClientAPI ~ client) => ClientLike client GenericClient
+
+type NestedAPI1
+ = QueryParam "int" Int :> NestedAPI2
+ :<|> QueryParam "id" Char :> Get '[JSON] Char
+
+data NestedClient1 = NestedClient1
+ { mkNestedClient2 :: Maybe Int -> NestedClient2
+ , idChar :: Maybe Char -> SCR.ClientM Char
+ } deriving Generic
+instance SOP.Generic NestedClient1
+instance (Client NestedAPI1 ~ client) => ClientLike client NestedClient1
+
+type NestedAPI2
+ = "sum" :> Capture "first" Int :> Capture "second" Int :> Get '[JSON] Int
+ :<|> "void" :> Post '[JSON] ()
+
+data NestedClient2 = NestedClient2
+ { getSum :: Int -> Int -> SCR.ClientM Int
+ , doNothing :: SCR.ClientM ()
+ } deriving Generic
+instance SOP.Generic NestedClient2
+instance (Client NestedAPI2 ~ client) => ClientLike client NestedClient2
+
+genericClientServer :: Application
+genericClientServer = serve (Proxy :: Proxy GenericClientAPI) (
+ (\ mx -> case mx of
+ Just x -> return (x*x)
+ Nothing -> throwError $ ServantErr 400 "missing parameter"
"" []
+ )
+ :<|> nestedServer1
+ )
+ where
+ nestedServer1 _str = nestedServer2 :<|> (maybe (throwError $ ServantErr
400 "missing parameter" "" []) return)
+ nestedServer2 _int = (\ x y -> return (x + y)) :<|> return ()
+
{-# NOINLINE manager #-}
manager :: C.Manager
manager = unsafePerformIO $ C.newManager C.defaultManagerSettings
@@ -298,7 +352,7 @@
wrappedApiSpec :: Spec
wrappedApiSpec = describe "error status codes" $ do
- let serveW api = serve api $ throwE $ ServantErr 500 "error message" "" []
+ let serveW api = serve api $ throwError $ ServantErr 500 "error message" ""
[]
context "are correctly handled by the client" $
let test :: (WrappedApi, String) -> Spec
test (WrappedApi api, desc) =
@@ -322,7 +376,7 @@
let (_ :<|> getDeleteEmpty :<|> _) = client api
Left res <- runClientM getDeleteEmpty (ClientEnv manager baseUrl)
case res of
- FailureResponse (HTTP.Status 404 "Not Found") _ _ -> return ()
+ FailureResponse _ (HTTP.Status 404 "Not Found") _ _ -> return ()
_ -> fail $ "expected 404 response, but got " <> show res
it "reports DecodeFailure" $ \(_, baseUrl) -> do
@@ -392,6 +446,22 @@
Left FailureResponse{..} <- runClientM (getProtected authRequest)
(ClientEnv manager baseUrl)
responseStatus `shouldBe` (HTTP.Status 401 "Unauthorized")
+genericClientSpec :: Spec
+genericClientSpec = beforeAll (startWaiApp genericClientServer) $ afterAll
endWaiApp $ do
+ describe "Servant.Client.Generic" $ do
+
+ let GenericClient{..} = mkClient (client (Proxy :: Proxy GenericClientAPI))
+ NestedClient1{..} = mkNestedClient1 "example"
+ NestedClient2{..} = mkNestedClient2 (Just 42)
+
+ it "works for top-level client function" $ \(_, baseUrl) -> do
+ (left show <$> (runClientM (getSqr (Just 5)) (ClientEnv manager
baseUrl))) `shouldReturn` Right 25
+
+ it "works for nested clients" $ \(_, baseUrl) -> do
+ (left show <$> (runClientM (idChar (Just 'c')) (ClientEnv manager
baseUrl))) `shouldReturn` Right 'c'
+ (left show <$> (runClientM (getSum 3 4) (ClientEnv manager baseUrl)))
`shouldReturn` Right 7
+ (left show <$> (runClientM doNothing (ClientEnv manager baseUrl)))
`shouldReturn` Right ()
+
-- * utils
startWaiApp :: Application -> IO (ThreadId, BaseUrl)
++++++ servant-client.cabal ++++++
--- /var/tmp/diff_new_pack.ZDkX7K/_old 2017-08-31 20:59:17.775535825 +0200
+++ /var/tmp/diff_new_pack.ZDkX7K/_new 2017-08-31 20:59:17.779535264 +0200
@@ -1,5 +1,5 @@
name: servant-client
-version: 0.9.1.1
+version: 0.11
x-revision: 1
synopsis: automatical derivation of querying functions for servant webservices
description:
@@ -14,7 +14,7 @@
author: Servant Contributors
maintainer: [email protected]
copyright: 2014-2016 Zalora South East Asia Pte Ltd, Servant
Contributors
-category: Web
+category: Servant Web
build-type: Simple
cabal-version: >=1.10
tested-with: GHC >= 7.8
@@ -31,31 +31,39 @@
library
exposed-modules:
Servant.Client
+ Servant.Client.Generic
Servant.Client.Experimental.Auth
Servant.Common.BaseUrl
Servant.Common.BasicAuth
Servant.Common.Req
build-depends:
- base >= 4.7 && < 4.10
+ base >= 4.7 && < 4.11
, base-compat >= 0.9.1 && < 0.10
- , aeson >= 0.7 && < 1.2
+ , aeson >= 0.7 && < 1.3
, attoparsec >= 0.12 && < 0.14
, base64-bytestring >= 1.0.0.1 && < 1.1
, bytestring >= 0.10 && < 0.11
, exceptions >= 0.8 && < 0.9
- , http-api-data >= 0.3 && < 0.4
+ , generics-sop >= 0.1.0.0 && < 0.4
+ , http-api-data >= 0.3.6 && < 0.4
, http-client >= 0.4.18.1 && < 0.6
, http-client-tls >= 0.2.2 && < 0.4
- , http-media >= 0.6.2 && < 0.7
+ , http-media >= 0.6.2 && < 0.8
, http-types >= 0.8.6 && < 0.10
+ , monad-control >= 1.0.0.4 && < 1.1
, network-uri >= 2.6 && < 2.7
, safe >= 0.3.9 && < 0.4
- , servant == 0.9.*
+ , semigroupoids >= 4.3 && < 5.3
+ , servant == 0.11.*
, string-conversions >= 0.3 && < 0.5
, text >= 1.2 && < 1.3
, transformers >= 0.3 && < 0.6
+ , transformers-base >= 0.4.4 && < 0.5
, transformers-compat >= 0.4 && < 0.6
, mtl
+ if !impl(ghc >= 8.0)
+ build-depends:
+ semigroups >=0.16.2.2 && <0.19
hs-source-dirs: src
default-language: Haskell2010
ghc-options: -Wall
@@ -74,10 +82,8 @@
, Servant.Common.BaseUrlSpec
build-depends:
base == 4.*
- , base-compat
- , transformers
- , transformers-compat
, aeson
+ , base-compat
, bytestring
, deepseq
, hspec == 2.*
@@ -86,11 +92,15 @@
, http-media
, http-types
, HUnit
+ , mtl
, network >= 2.6
, QuickCheck >= 2.7
- , servant == 0.9.*
+ , servant
, servant-client
- , servant-server == 0.9.*
+ , servant-server == 0.11.*
, text
+ , transformers
+ , transformers-compat
, wai
, warp
+ , generics-sop
