diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -13,9 +13,8 @@ myApi :: Proxy MyApi myApi = Proxy -getAllBooks :: ExceptT String IO [Book] -postNewBook :: Book -> ExceptT String IO Book +getAllBooks :: Manager -> BaseUrl -> ExceptT String IO [Book] +postNewBook :: Book -> Manager -> BaseUrl -> ExceptT String IO Book -- 'client' allows you to produce operations to query an API from a client. -(getAllBooks :<|> postNewBook) = client myApi host - where host = BaseUrl Http "localhost" 8080 +(getAllBooks :<|> postNewBook) = client myApi ``` diff --git a/servant-client.cabal b/servant-client.cabal --- a/servant-client.cabal +++ b/servant-client.cabal @@ -1,5 +1,5 @@ name: servant-client -version: 0.7.1 +version: 0.8 synopsis: automatical derivation of querying functions for servant webservices description: This library lets you derive automatically Haskell functions that @@ -35,24 +35,24 @@ Servant.Common.BasicAuth Servant.Common.Req build-depends: - base >=4.7 && <5 - , aeson - , attoparsec - , base64-bytestring - , bytestring - , exceptions - , http-api-data >= 0.1 && < 0.3 - , http-client - , http-client-tls - , http-media - , http-types - , network-uri >= 2.6 - , safe - , servant == 0.7.* - , string-conversions - , text - , transformers - , transformers-compat + base >= 4.7 && < 4.10 + , aeson >= 0.7 && < 0.12 + , 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.1 && < 0.3 + , 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 + , network-uri >= 2.6 && < 2.7 + , safe >= 0.3.9 && < 0.4 + , servant == 0.8.* + , string-conversions >= 0.3 && < 0.5 + , text >= 1.2 && < 1.3 + , transformers >= 0.3 && < 0.6 + , transformers-compat >= 0.4 && < 0.6 hs-source-dirs: src default-language: Haskell2010 ghc-options: -Wall @@ -83,9 +83,9 @@ , HUnit , network >= 2.6 , QuickCheck >= 2.7 - , servant == 0.7.* + , servant == 0.8.* , servant-client - , servant-server == 0.7.* + , servant-server == 0.8.* , text , wai , warp diff --git a/src/Servant/Client.hs b/src/Servant/Client.hs --- a/src/Servant/Client.hs +++ b/src/Servant/Client.hs @@ -57,15 +57,15 @@ -- > getAllBooks :: Manager -> BaseUrl -> ClientM [Book] -- > postNewBook :: Book -> Manager -> BaseUrl -> ClientM Book -- > (getAllBooks :<|> postNewBook) = client myApi -client :: HasClient layout => Proxy layout -> Client layout +client :: HasClient api => Proxy api -> Client api client p = clientWithRoute p defReq -- | This class lets us define how each API combinator -- influences the creation of an HTTP request. It's mostly -- an internal class, you can just use 'client'. -class HasClient layout where - type Client layout :: * - clientWithRoute :: Proxy layout -> Req -> Client layout +class HasClient api where + type Client api :: * + clientWithRoute :: Proxy api -> Req -> Client api -- | A client querying function for @a ':<|>' b@ will actually hand you @@ -106,14 +106,14 @@ -- > getBook :: Text -> Manager -> BaseUrl -> ClientM Book -- > getBook = client myApi -- > -- then you can just use "getBook" to query that endpoint -instance (KnownSymbol capture, ToHttpApiData a, HasClient sublayout) - => HasClient (Capture capture a :> sublayout) where +instance (KnownSymbol capture, ToHttpApiData a, HasClient api) + => HasClient (Capture capture a :> api) where - type Client (Capture capture a :> sublayout) = - a -> Client sublayout + type Client (Capture capture a :> api) = + a -> Client api clientWithRoute Proxy req val = - clientWithRoute (Proxy :: Proxy sublayout) + clientWithRoute (Proxy :: Proxy api) (appendToPath p req) where p = unpack (toUrlPiece val) @@ -186,14 +186,14 @@ -- > viewReferer = client myApi -- > -- then you can just use "viewRefer" to query that endpoint -- > -- specifying Nothing or e.g Just "http://haskell.org/" as arguments -instance (KnownSymbol sym, ToHttpApiData a, HasClient sublayout) - => HasClient (Header sym a :> sublayout) where +instance (KnownSymbol sym, ToHttpApiData a, HasClient api) + => HasClient (Header sym a :> api) where - type Client (Header sym a :> sublayout) = - Maybe a -> Client sublayout + type Client (Header sym a :> api) = + Maybe a -> Client api clientWithRoute Proxy req mval = - clientWithRoute (Proxy :: Proxy sublayout) + clientWithRoute (Proxy :: Proxy api) (maybe req (\value -> Servant.Common.Req.addHeader hname value req) mval @@ -203,14 +203,14 @@ -- | Using a 'HttpVersion' combinator in your API doesn't affect the client -- functions. -instance HasClient sublayout - => HasClient (HttpVersion :> sublayout) where +instance HasClient api + => HasClient (HttpVersion :> api) where - type Client (HttpVersion :> sublayout) = - Client sublayout + type Client (HttpVersion :> api) = + Client api clientWithRoute Proxy = - clientWithRoute (Proxy :: Proxy sublayout) + clientWithRoute (Proxy :: Proxy api) -- | If you use a 'QueryParam' in one of your endpoints in your API, -- the corresponding querying function will automatically take @@ -237,15 +237,15 @@ -- > -- then you can just use "getBooksBy" to query that endpoint. -- > -- 'getBooksBy Nothing' for all books -- > -- 'getBooksBy (Just "Isaac Asimov")' to get all books by Isaac Asimov -instance (KnownSymbol sym, ToHttpApiData a, HasClient sublayout) - => HasClient (QueryParam sym a :> sublayout) where +instance (KnownSymbol sym, ToHttpApiData a, HasClient api) + => HasClient (QueryParam sym a :> api) where - type Client (QueryParam sym a :> sublayout) = - Maybe a -> Client sublayout + type Client (QueryParam sym a :> api) = + Maybe a -> Client api -- if mparam = Nothing, we don't add it to the query string clientWithRoute Proxy req mparam = - clientWithRoute (Proxy :: Proxy sublayout) + clientWithRoute (Proxy :: Proxy api) (maybe req (flip (appendToQueryString pname) req . Just) mparamText @@ -282,14 +282,14 @@ -- > -- 'getBooksBy []' for all books -- > -- 'getBooksBy ["Isaac Asimov", "Robert A. Heinlein"]' -- > -- to get all books by Asimov and Heinlein -instance (KnownSymbol sym, ToHttpApiData a, HasClient sublayout) - => HasClient (QueryParams sym a :> sublayout) where +instance (KnownSymbol sym, ToHttpApiData a, HasClient api) + => HasClient (QueryParams sym a :> api) where - type Client (QueryParams sym a :> sublayout) = - [a] -> Client sublayout + type Client (QueryParams sym a :> api) = + [a] -> Client api clientWithRoute Proxy req paramlist = - clientWithRoute (Proxy :: Proxy sublayout) + clientWithRoute (Proxy :: Proxy api) (foldl' (\ req' -> maybe req' (flip (appendToQueryString pname) req' . Just)) req paramlist' @@ -320,14 +320,14 @@ -- > -- then you can just use "getBooks" to query that endpoint. -- > -- 'getBooksBy False' for all books -- > -- 'getBooksBy True' to only get _already published_ books -instance (KnownSymbol sym, HasClient sublayout) - => HasClient (QueryFlag sym :> sublayout) where +instance (KnownSymbol sym, HasClient api) + => HasClient (QueryFlag sym :> api) where - type Client (QueryFlag sym :> sublayout) = - Bool -> Client sublayout + type Client (QueryFlag sym :> api) = + Bool -> Client api clientWithRoute Proxy req flag = - clientWithRoute (Proxy :: Proxy sublayout) + clientWithRoute (Proxy :: Proxy api) (if flag then appendToQueryString paramname Nothing req else req @@ -364,14 +364,14 @@ -- > addBook :: Book -> Manager -> BaseUrl -> ClientM Book -- > addBook = client myApi -- > -- then you can just use "addBook" to query that endpoint -instance (MimeRender ct a, HasClient sublayout) - => HasClient (ReqBody (ct ': cts) a :> sublayout) where +instance (MimeRender ct a, HasClient api) + => HasClient (ReqBody (ct ': cts) a :> api) where - type Client (ReqBody (ct ': cts) a :> sublayout) = - a -> Client sublayout + type Client (ReqBody (ct ': cts) a :> api) = + a -> Client api clientWithRoute Proxy req body = - clientWithRoute (Proxy :: Proxy sublayout) + clientWithRoute (Proxy :: Proxy api) (let ctProxy = Proxy :: Proxy ct in setRQBody (mimeRender ctProxy body) (contentType ctProxy) @@ -379,11 +379,11 @@ ) -- | Make the querying function append @path@ to the request path. -instance (KnownSymbol path, HasClient sublayout) => HasClient (path :> sublayout) where - type Client (path :> sublayout) = Client sublayout +instance (KnownSymbol path, HasClient api) => HasClient (path :> api) where + type Client (path :> api) = Client api clientWithRoute Proxy req = - clientWithRoute (Proxy :: Proxy sublayout) + clientWithRoute (Proxy :: Proxy api) (appendToPath p req) where p = symbolVal (Proxy :: Proxy path) diff --git a/src/Servant/Common/Req.hs b/src/Servant/Common/Req.hs --- a/src/Servant/Common/Req.hs +++ b/src/Servant/Common/Req.hs @@ -103,7 +103,7 @@ reqToRequest :: (Functor m, MonadThrow m) => Req -> BaseUrl -> m Request reqToRequest req (BaseUrl reqScheme reqHost reqPort path) = - setheaders . setAccept . setrqb . setQS <$> parseUrl url + setheaders . setAccept . setrqb . setQS <$> parseUrlThrow url where url = show $ nullURI { uriScheme = case reqScheme of Http -> "http:" @@ -129,6 +129,9 @@ | not . null . reqAccept $ req] } toProperHeader (name, val) = (fromString name, encodeUtf8 val) +#if !MIN_VERSION_http_client(0,4,30) + parseUrlThrow = parseUrl +#endif -- * performing requests @@ -144,9 +147,8 @@ performRequest reqMethod req manager reqHost = do partialRequest <- liftIO $ reqToRequest req reqHost - let request = partialRequest { Client.method = reqMethod - , checkStatus = \ _status _headers _cookies -> Nothing - } + let request = disableStatusCheck $ + partialRequest { Client.method = reqMethod } eResponse <- liftIO $ catchConnectionError $ Client.httpLbs request manager case eResponse of @@ -167,6 +169,12 @@ throwE $ FailureResponse status ct body return (status_code, body, ct, hdrs, response) +disableStatusCheck :: Request -> Request +#if MIN_VERSION_http_client(0,5,0) +disableStatusCheck req = req { checkResponse = \ _req _res -> return () } +#else +disableStatusCheck req = req { checkStatus = \ _status _headers _cookies -> Nothing } +#endif performRequestCT :: MimeUnrender ct result => Proxy ct -> Method -> Req -> Manager -> BaseUrl diff --git a/test/Servant/ClientSpec.hs b/test/Servant/ClientSpec.hs --- a/test/Servant/ClientSpec.hs +++ b/test/Servant/ClientSpec.hs @@ -45,8 +45,7 @@ import Network.HTTP.Media import qualified Network.HTTP.Types as HTTP import Network.Socket -import Network.Wai (Application, Request, - requestHeaders, responseLBS) +import Network.Wai (Request, requestHeaders, responseLBS) import Network.Wai.Handler.Warp import System.IO.Unsafe (unsafePerformIO) import Test.Hspec