Merge remote-tracking branch 'servant-client/prepare-merge' into merge

servant-client/CHANGELOG.md

@@ -0,0 +1,15 @@
+0.3
+---
+* Support content-type aware combinators and `Accept`/`Content-type` headers
+* Added a lot of tests
+* Support multiple concurrent threads
+* Use `ServantError` to report Errors instead of `String`
+* Make the clients for `Raw` endpoints return the whole `Response` value (to be able to access response headers for example)
+* Support for PATCH
+* Make () instances expect No Content status code, and not try to decode body.
+* `Canonicalize` API types before generating client functions for them
+
+0.2.2
+-----
+* Add TLS support
+* Add matrix parameter support

servant-client/LICENSE

@@ -0,0 +1,30 @@
+Copyright (c) 2014, Zalora South East Asia Pte Ltd
+
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+    * Redistributions of source code must retain the above copyright
+      notice, this list of conditions and the following disclaimer.
+
+    * Redistributions in binary form must reproduce the above
+      copyright notice, this list of conditions and the following
+      disclaimer in the documentation and/or other materials provided
+      with the distribution.
+
+    * Neither the name of Zalora South East Asia Pte Ltd nor the names of other
+      contributors may be used to endorse or promote products derived
+      from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

servant-client/README.md

@@ -0,0 +1,23 @@
+# servant-client
+
+[![Build Status](https://secure.travis-ci.org/haskell-servant/servant-client.svg)](http://travis-ci.org/haskell-servant/servant-client)
+[![Coverage Status](https://coveralls.io/repos/haskell-servant/servant-client/badge.svg)](https://coveralls.io/r/haskell-servant/servant-client)
+
+![servant](https://raw.githubusercontent.com/haskell-servant/servant/master/servant.png)
+
+This library lets you automatically derive Haskell functions that let you query each endpoint of a *servant* webservice.
+
+## Example
+
+``` haskell
+type MyApi = "books" :> Get [Book] -- GET /books
+        :<|> "books" :> ReqBody Book :> Post Book -- POST /books
+
+myApi :: Proxy MyApi
+myApi = Proxy
+
+getAllBooks :: BaseUrl -> EitherT String IO [Book]
+postNewBook :: Book -> BaseUrl -> EitherT String IO Book
+-- 'client' allows you to produce operations to query an API from a client.
+(getAllBooks :<|> postNewBook) = client myApi
+```

servant-client/Setup.hs

@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain

servant-client/docs.sh

@@ -0,0 +1,52 @@
+SERVANT_DIR=/tmp/servant-client-gh-pages
+
+# Make a temporary clone
+
+rm -rf $SERVANT_DIR
+
+git clone . $SERVANT_DIR
+
+cd $SERVANT_DIR
+
+# Make sure to pull the latest
+
+git remote add haskell-servant git@github.com:haskell-servant/servant-client.git
+
+git fetch haskell-servant
+
+git reset --hard haskell-servant/gh-pages
+
+# Clear everything away
+
+git rm -rf $SERVANT_DIR/*
+
+# Switch back and build the haddocks
+
+cd -
+
+cabal configure --builddir=$SERVANT_DIR
+
+cabal haddock --hoogle --hyperlink-source --html-location='https://hackage.haskell.org/package/$pkg-$version/docs' --builddir=$SERVANT_DIR
+
+commit_hash=$(git rev-parse HEAD)
+
+# Move the HTML docs to the root
+
+cd $SERVANT_DIR
+
+rm *
+rm -rf build
+mv doc/html/servant-client/* .
+rm -r doc/
+
+# Add everything
+
+git add .
+
+git commit -m "Built from $commit_hash"
+
+# Push to update the pages
+
+git push haskell-servant HEAD:gh-pages
+
+rm -rf $SERVANT_DIR

servant-client/servant-client.cabal

@@ -0,0 +1,85 @@
+name:                servant-client
+version:             0.2.2
+synopsis: automatical derivation of querying functions for servant webservices
+description:
+  This library lets you derive automatically Haskell functions that
+  let you query each endpoint of a <http://hackage.haskell.org/package/servant servant> webservice.
+  .
+  Example below.
+  .
+  > type MyApi = "books" :> Get [Book] -- GET /books
+  >         :<|> "books" :> ReqBody Book :> Post Book -- POST /books
+  >
+  > myApi :: Proxy MyApi
+  > myApi = Proxy
+  >
+  > getAllBooks :: BaseUrl -> EitherT String IO [Book]
+  > postNewBook :: Book -> BaseUrl -> EitherT String IO Book
+  > (getAllBooks :<|> postNewBook) = client myApi
+license:             BSD3
+license-file:        LICENSE
+author:              Alp Mestanogullari, Sönke Hahn, Julian K. Arni
+maintainer:          alpmestan@gmail.com
+copyright:           2014 Zalora South East Asia Pte Ltd
+category:            Web
+build-type:          Simple
+cabal-version:       >=1.10
+tested-with:         GHC >= 7.8
+homepage:            http://haskell-servant.github.io/
+Bug-reports:         http://github.com/haskell-servant/servant-client/issues
+source-repository head
+  type: git
+  location: http://github.com/haskell-servant/servant-client.git
+
+library
+  exposed-modules:
+    Servant.Client
+    Servant.Common.BaseUrl
+    Servant.Common.Req
+  build-depends:
+      base >=4.7 && <5
+    , aeson
+    , attoparsec
+    , bytestring
+    , either
+    , exceptions
+    , http-client
+    , http-client-tls
+    , http-media
+    , http-types
+    , network-uri >= 2.6
+    , safe
+    , servant >= 0.2.2
+    , string-conversions
+    , text
+    , transformers
+  hs-source-dirs: src
+  default-language: Haskell2010
+  ghc-options: -Wall
+
+test-suite spec
+  type: exitcode-stdio-1.0
+  ghc-options:
+    -Wall -fno-warn-name-shadowing -fno-warn-missing-signatures
+  default-language: Haskell2010
+  hs-source-dirs: test
+  main-is: Spec.hs
+  build-depends:
+      base == 4.*
+    , aeson
+    , bytestring
+    , deepseq
+    , either
+    , hspec == 2.*
+    , http-client
+    , http-media
+    , http-types
+    , HUnit
+    , network >= 2.6
+    , QuickCheck >= 2.7
+    , servant >= 0.2.1
+    , servant-client
+    , servant-server >= 0.2.1
+    , text
+    , wai
+    , warp

servant-client/src/Servant/Client.hs

@@ -0,0 +1,504 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE InstanceSigs #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE OverlappingInstances #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+-- | This module provides 'client' which can automatically generate
+-- querying functions for each endpoint just from the type representing your
+-- API.
+module Servant.Client
+  ( client
+  , HasClient(..)
+  , Client
+  , ServantError(..)
+  , module Servant.Common.BaseUrl
+  ) where
+
+import Control.Monad
+import Control.Monad.Trans.Either
+import Data.ByteString.Lazy (ByteString)
+import Data.List
+import Data.Proxy
+import Data.String.Conversions
+import Data.Text (unpack)
+import GHC.TypeLits
+import Network.HTTP.Client (Response)
+import Network.HTTP.Media
+import qualified Network.HTTP.Types as H
+import Servant.API
+import Servant.API.ContentTypes
+import Servant.Common.BaseUrl
+import Servant.Common.Req
+
+-- * Accessing APIs as a Client
+
+-- | 'client' allows you to produce operations to query an API from a client.
+--
+-- > type MyApi = "books" :> Get [Book] -- GET /books
+-- >         :<|> "books" :> ReqBody Book :> Post Book -- POST /books
+-- >
+-- > myApi :: Proxy MyApi
+-- > myApi = Proxy
+-- >
+-- > getAllBooks :: BaseUrl -> EitherT String IO [Book]
+-- > postNewBook :: Book -> BaseUrl -> EitherT String IO Book
+-- > (getAllBooks :<|> postNewBook) = client myApi
+client :: HasClient (Canonicalize layout) => Proxy layout -> Client layout
+client p = clientWithRoute (canonicalize 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
+
+type Client layout = Client' (Canonicalize layout)
+
+-- | A client querying function for @a ':<|>' b@ will actually hand you
+--   one function for querying @a@ and another one for querying @b@,
+--   stitching them together with ':<|>', which really is just like a pair.
+--
+-- > type MyApi = "books" :> Get [Book] -- GET /books
+-- >         :<|> "books" :> ReqBody Book :> Post Book -- POST /books
+-- >
+-- > myApi :: Proxy MyApi
+-- > myApi = Proxy
+-- >
+-- > getAllBooks :: BaseUrl -> EitherT String IO [Book]
+-- > postNewBook :: Book -> BaseUrl -> EitherT String IO Book
+-- > (getAllBooks :<|> postNewBook) = client myApi
+instance (HasClient a, HasClient b) => HasClient (a :<|> b) where
+  type Client' (a :<|> b) = Client' a :<|> Client' b
+  clientWithRoute Proxy req =
+    clientWithRoute (Proxy :: Proxy a) req :<|>
+    clientWithRoute (Proxy :: Proxy b) req
+
+-- | 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'.
+-- That function will take care of inserting a textual representation
+-- of this value at the right place in the request path.
+--
+-- You can control how values for this type are turned into
+-- text by specifying a 'ToText' instance for your type.
+--
+-- Example:
+--
+-- > type MyApi = "books" :> Capture "isbn" Text :> Get Book
+-- >
+-- > myApi :: Proxy MyApi
+-- > myApi = Proxy
+-- >
+-- > getBook :: Text -> BaseUrl -> EitherT String IO Book
+-- > getBook = client myApi
+-- > -- then you can just use "getBook" to query that endpoint
+instance (KnownSymbol capture, ToText a, HasClient sublayout)
+      => HasClient (Capture capture a :> sublayout) where
+
+  type Client' (Capture capture a :> sublayout) =
+    a -> Client' sublayout
+
+  clientWithRoute Proxy req val =
+    clientWithRoute (Proxy :: Proxy sublayout) $
+      appendToPath p req
+
+    where p = unpack (toText val)
+
+-- | If you have a 'Delete' endpoint in your API, the client
+-- side querying function that is created when calling 'client'
+-- will just require an argument that specifies the scheme, host
+-- and port to send the request to.
+instance HasClient Delete where
+  type Client' Delete = BaseUrl -> EitherT ServantError IO ()
+
+  clientWithRoute Proxy req host =
+    void $ performRequest H.methodDelete req (`elem` [200, 202, 204]) host
+
+-- | If you have a 'Get' endpoint in your API, the client
+-- side querying function that is created when calling 'client'
+-- will just require an argument that specifies the scheme, host
+-- and port to send the request to.
+instance (MimeUnrender ct result) => HasClient (Get (ct ': cts) result) where
+  type Client' (Get (ct ': cts) result) = BaseUrl -> EitherT ServantError IO result
+  clientWithRoute Proxy req host =
+    performRequestCT (Proxy :: Proxy ct) H.methodGet req [200, 203] host
+
+-- | If you have a 'Get xs ()' endpoint, the client expects a 204 No Content
+-- HTTP header.
+instance HasClient (Get (ct ': cts) ()) where
+  type Client' (Get (ct ': cts) ()) = BaseUrl -> EitherT ServantError IO ()
+  clientWithRoute Proxy req host =
+    performRequestNoBody H.methodGet req [204] host
+
+-- | If you use a 'Header' in one of your endpoints in your API,
+-- the corresponding querying function will automatically take
+-- an additional argument of the type specified by your 'Header',
+-- wrapped in Maybe.
+--
+-- That function will take care of encoding this argument as Text
+-- in the request headers.
+--
+-- All you need is for your type to have a 'ToText' instance.
+--
+-- Example:
+--
+-- > newtype Referer = Referer Text
+-- >   deriving (Eq, Show, FromText, ToText)
+-- >
+-- >            -- GET /view-my-referer
+-- > type MyApi = "view-my-referer" :> Header "Referer" Referer :> Get Referer
+-- >
+-- > myApi :: Proxy MyApi
+-- > myApi = Proxy
+-- >
+-- > viewReferer :: Maybe Referer -> BaseUrl -> EitherT String IO Book
+-- > viewReferer = client myApi
+-- > -- then you can just use "viewRefer" to query that endpoint
+-- > -- specifying Nothing or Just "http://haskell.org/" as arguments
+instance (KnownSymbol sym, ToText a, HasClient sublayout)
+      => HasClient (Header sym a :> sublayout) where
+
+  type Client' (Header sym a :> sublayout) =
+    Maybe a -> Client' sublayout
+
+  clientWithRoute Proxy req mval =
+    clientWithRoute (Proxy :: Proxy sublayout) $
+      maybe req (\value -> Servant.Common.Req.addHeader hname value req) mval
+
+    where hname = symbolVal (Proxy :: Proxy sym)
+
+-- | If you have a 'Post' endpoint in your API, the client
+-- side querying function that is created when calling 'client'
+-- will just require an argument that specifies the scheme, host
+-- and port to send the request to.
+instance (MimeUnrender ct a) => HasClient (Post (ct ': cts) a) where
+  type Client' (Post (ct ': cts) a) = BaseUrl -> EitherT ServantError IO a
+
+  clientWithRoute Proxy req uri =
+    performRequestCT (Proxy :: Proxy ct) H.methodPost req [200,201] uri
+
+-- | If you have a 'Post xs ()' endpoint, the client expects a 204 No Content
+-- HTTP header.
+instance HasClient (Post (ct ': cts) ()) where
+  type Client' (Post (ct ': cts) ()) = BaseUrl -> EitherT ServantError IO ()
+  clientWithRoute Proxy req host =
+    void $ performRequestNoBody H.methodPost req [204] host
+
+-- | If you have a 'Put' endpoint in your API, the client
+-- side querying function that is created when calling 'client'
+-- will just require an argument that specifies the scheme, host
+-- and port to send the request to.
+instance (MimeUnrender ct a) => HasClient (Put (ct ': cts) a) where
+  type Client' (Put (ct ': cts) a) = BaseUrl -> EitherT ServantError IO a
+
+  clientWithRoute Proxy req host =
+    performRequestCT (Proxy :: Proxy ct) H.methodPut req [200,201] host
+
+-- | If you have a 'Put xs ()' endpoint, the client expects a 204 No Content
+-- HTTP header.
+instance HasClient (Put (ct ': cts) ()) where
+  type Client' (Put (ct ': cts) ()) = BaseUrl -> EitherT ServantError IO ()
+  clientWithRoute Proxy req host =
+    void $ performRequestNoBody H.methodPut req [204] host
+
+-- | If you have a 'Patch' endpoint in your API, the client
+-- side querying function that is created when calling 'client'
+-- will just require an argument that specifies the scheme, host
+-- and port to send the request to.
+instance (MimeUnrender ct a) => HasClient (Patch (ct ': cts) a) where
+  type Client' (Patch (ct ': cts) a) = BaseUrl -> EitherT ServantError IO a
+
+  clientWithRoute Proxy req host =
+    performRequestCT (Proxy :: Proxy ct) H.methodPatch req [200,201] host
+
+-- | If you have a 'Patch xs ()' endpoint, the client expects a 204 No Content
+-- HTTP header.
+instance HasClient (Patch (ct ': cts) ()) where
+  type Client' (Patch (ct ': cts) ()) = BaseUrl -> EitherT ServantError IO ()
+  clientWithRoute Proxy req host =
+    void $ performRequestNoBody H.methodPatch req [204] host
+
+-- | If you use a 'QueryParam' in one of your endpoints in your API,
+-- the corresponding querying function will automatically take
+-- an additional argument of the type specified by your 'QueryParam',
+-- enclosed in Maybe.
+--
+-- If you give Nothing, nothing will be added to the query string.
+--
+-- If you give a non-'Nothing' value, this function will take care
+-- of inserting a textual representation of this value in the query string.
+--
+-- You can control how values for your type are turned into
+-- text by specifying a 'ToText' instance for your type.
+--
+-- Example:
+--
+-- > type MyApi = "books" :> QueryParam "author" Text :> Get [Book]
+-- >
+-- > myApi :: Proxy MyApi
+-- > myApi = Proxy
+-- >
+-- > getBooksBy :: Maybe Text -> BaseUrl -> EitherT String IO [Book]
+-- > getBooksBy = client myApi
+-- > -- 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, ToText a, HasClient sublayout)
+      => HasClient (QueryParam sym a :> sublayout) where
+
+  type Client' (QueryParam sym a :> sublayout) =
+    Maybe a -> Client' sublayout
+
+  -- if mparam = Nothing, we don't add it to the query string
+  clientWithRoute Proxy req mparam =
+    clientWithRoute (Proxy :: Proxy sublayout) $
+      maybe req (flip (appendToQueryString pname) req . Just) mparamText
+
+    where pname  = cs pname'
+          pname' = symbolVal (Proxy :: Proxy sym)
+          mparamText = fmap toText mparam
+
+-- | If you use a 'QueryParams' in one of your endpoints in your API,
+-- the corresponding querying function will automatically take
+-- an additional argument, a list of values of the type specified
+-- by your 'QueryParams'.
+--
+-- If you give an empty list, nothing will be added to the query string.
+--
+-- Otherwise, this function will take care
+-- of inserting a textual representation of your values in the query string,
+-- under the same query string parameter name.
+--
+-- You can control how values for your type are turned into
+-- text by specifying a 'ToText' instance for your type.
+--
+-- Example:
+--
+-- > type MyApi = "books" :> QueryParams "authors" Text :> Get [Book]
+-- >
+-- > myApi :: Proxy MyApi
+-- > myApi = Proxy
+-- >
+-- > getBooksBy :: [Text] -> BaseUrl -> EitherT String IO [Book]
+-- > getBooksBy = client myApi
+-- > -- then you can just use "getBooksBy" to query that endpoint.
+-- > -- 'getBooksBy []' for all books
+-- > -- 'getBooksBy ["Isaac Asimov", "Robert A. Heinlein"]'
+-- > --   to get all books by Asimov and Heinlein
+instance (KnownSymbol sym, ToText a, HasClient sublayout)
+      => HasClient (QueryParams sym a :> sublayout) where
+
+  type Client' (QueryParams sym a :> sublayout) =
+    [a] -> Client' sublayout
+
+  clientWithRoute Proxy req paramlist =
+    clientWithRoute (Proxy :: Proxy sublayout) $
+      foldl' (\ req' -> maybe req' (flip (appendToQueryString pname) req' . Just)) req paramlist'
+
+    where pname  = cs pname'
+          pname' = symbolVal (Proxy :: Proxy sym)
+          paramlist' = map (Just . toText) paramlist
+
+-- | If you use a 'QueryFlag' in one of your endpoints in your API,
+-- the corresponding querying function will automatically take
+-- an additional 'Bool' argument.
+--
+-- If you give 'False', nothing will be added to the query string.
+--
+-- Otherwise, this function will insert a value-less query string
+-- parameter under the name associated to your 'QueryFlag'.
+--
+-- Example:
+--
+-- > type MyApi = "books" :> QueryFlag "published" :> Get [Book]
+-- >
+-- > myApi :: Proxy MyApi
+-- > myApi = Proxy
+-- >
+-- > getBooks :: Bool -> BaseUrl -> EitherT String IO [Book]
+-- > getBooks = client myApi
+-- > -- 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
+
+  type Client' (QueryFlag sym :> sublayout) =
+    Bool -> Client' sublayout
+
+  clientWithRoute Proxy req flag =
+    clientWithRoute (Proxy :: Proxy sublayout) $
+      if flag
+        then appendToQueryString paramname Nothing req
+        else req
+
+    where paramname = cs $ symbolVal (Proxy :: Proxy sym)
+
+-- | If you use a 'MatrixParam' in one of your endpoints in your API,
+-- the corresponding querying function will automatically take
+-- an additional argument of the type specified by your 'MatrixParam',
+-- enclosed in Maybe.
+--
+-- If you give Nothing, nothing will be added to the query string.
+--
+-- If you give a non-'Nothing' value, this function will take care
+-- of inserting a textual representation of this value in the query string.
+--
+-- You can control how values for your type are turned into
+-- text by specifying a 'ToText' instance for your type.
+--
+-- Example:
+--
+-- > type MyApi = "books" :> MatrixParam "author" Text :> Get [Book]
+-- >
+-- > myApi :: Proxy MyApi
+-- > myApi = Proxy
+-- >
+-- > getBooksBy :: Maybe Text -> BaseUrl -> EitherT String IO [Book]
+-- > getBooksBy = client myApi
+-- > -- 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, ToText a, HasClient sublayout)
+      => HasClient (MatrixParam sym a :> sublayout) where
+
+  type Client' (MatrixParam sym a :> sublayout) =
+    Maybe a -> Client' sublayout
+
+  -- if mparam = Nothing, we don't add it to the query string
+  clientWithRoute Proxy req mparam =
+    clientWithRoute (Proxy :: Proxy sublayout) $
+      maybe req (flip (appendToMatrixParams pname . Just) req) mparamText
+
+    where pname = symbolVal (Proxy :: Proxy sym)
+          mparamText = fmap (cs . toText) mparam
+
+-- | If you use a 'MatrixParams' in one of your endpoints in your API,
+-- the corresponding querying function will automatically take an
+-- additional argument, a list of values of the type specified by your
+-- 'MatrixParams'.
+--
+-- If you give an empty list, nothing will be added to the query string.
+--
+-- Otherwise, this function will take care of inserting a textual
+-- representation of your values in the path segment string, under the
+-- same matrix string parameter name.
+--
+-- You can control how values for your type are turned into text by
+-- specifying a 'ToText' instance for your type.
+--
+-- Example:
+--
+-- > type MyApi = "books" :> MatrixParams "authors" Text :> Get [Book]
+-- >
+-- > myApi :: Proxy MyApi
+-- > myApi = Proxy
+-- >
+-- > getBooksBy :: [Text] -> BaseUrl -> EitherT String IO [Book]
+-- > getBooksBy = client myApi
+-- > -- then you can just use "getBooksBy" to query that endpoint.
+-- > -- 'getBooksBy []' for all books
+-- > -- 'getBooksBy ["Isaac Asimov", "Robert A. Heinlein"]'
+-- > --   to get all books by Asimov and Heinlein
+instance (KnownSymbol sym, ToText a, HasClient sublayout)
+      => HasClient (MatrixParams sym a :> sublayout) where
+
+  type Client' (MatrixParams sym a :> sublayout) =
+    [a] -> Client' sublayout
+
+  clientWithRoute Proxy req paramlist =
+    clientWithRoute (Proxy :: Proxy sublayout) $
+      foldl' (\ req' value -> maybe req' (flip (appendToMatrixParams pname) req' . Just . cs) value) req paramlist'
+
+    where pname  = cs pname'
+          pname' = symbolVal (Proxy :: Proxy sym)
+          paramlist' = map (Just . toText) paramlist
+
+-- | If you use a 'MatrixFlag' in one of your endpoints in your API,
+-- the corresponding querying function will automatically take an
+-- additional 'Bool' argument.
+--
+-- If you give 'False', nothing will be added to the path segment.
+--
+-- Otherwise, this function will insert a value-less matrix parameter
+-- under the name associated to your 'MatrixFlag'.
+--
+-- Example:
+--
+-- > type MyApi = "books" :> MatrixFlag "published" :> Get [Book]
+-- >
+-- > myApi :: Proxy MyApi
+-- > myApi = Proxy
+-- >
+-- > getBooks :: Bool -> BaseUrl -> EitherT String IO [Book]
+-- > getBooks = client myApi
+-- > -- 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 (MatrixFlag sym :> sublayout) where
+
+  type Client' (MatrixFlag sym :> sublayout) =
+    Bool -> Client' sublayout
+
+  clientWithRoute Proxy req flag =
+    clientWithRoute (Proxy :: Proxy sublayout) $
+      if flag
+        then appendToMatrixParams paramname Nothing req
+        else req
+
+    where paramname = cs $ symbolVal (Proxy :: Proxy sym)
+
+-- | Pick a 'Method' and specify where the server you want to query is. You get
+-- back the full `Response`.
+instance HasClient Raw where
+  type Client' Raw = H.Method -> BaseUrl -> EitherT ServantError IO (Int, ByteString, MediaType, Response ByteString)
+
+  clientWithRoute :: Proxy Raw -> Req -> Client' Raw
+  clientWithRoute Proxy req httpMethod host = do
+    performRequest httpMethod req (const True) host
+
+-- | If you use a 'ReqBody' in one of your endpoints in your API,
+-- the corresponding querying function will automatically take
+-- an additional argument of the type specified by your 'ReqBody'.
+-- That function will take care of encoding this argument as JSON and
+-- of using it as the request body.
+--
+-- All you need is for your type to have a 'ToJSON' instance.
+--
+-- Example:
+--
+-- > type MyApi = "books" :> ReqBody Book :> Post Book
+-- >
+-- > myApi :: Proxy MyApi
+-- > myApi = Proxy
+-- >
+-- > addBook :: Book -> BaseUrl -> EitherT String IO 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
+
+  type Client' (ReqBody (ct ': cts) a :> sublayout) =
+    a -> Client' sublayout
+
+  clientWithRoute Proxy req body =
+    clientWithRoute (Proxy :: Proxy sublayout) $ do
+      let ctProxy = Proxy :: Proxy ct
+      setRQBody (mimeRender ctProxy body) (contentType ctProxy) req
+
+-- | 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
+
+  clientWithRoute Proxy req =
+     clientWithRoute (Proxy :: Proxy sublayout) $
+       appendToPath p req
+
+    where p = symbolVal (Proxy :: Proxy path)
+

servant-client/src/Servant/Common/BaseUrl.hs

@@ -0,0 +1,55 @@
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE ViewPatterns #-}
+module Servant.Common.BaseUrl where
+
+import Data.List
+import GHC.Generics
+import Network.URI
+import Safe
+import Text.Read
+
+-- | URI scheme to use
+data Scheme =
+    Http  -- ^ http://
+  | Https -- ^ https://
+  deriving (Show, Eq, Ord, Generic)
+
+-- | Simple data type to represent the target of HTTP requests
+--   for servant's automatically-generated clients.
+data BaseUrl = BaseUrl
+  { baseUrlScheme :: Scheme -- ^ URI scheme to use
+  , baseUrlHost :: String   -- ^ host (eg "haskell.org")
+  , baseUrlPort :: Int      -- ^ port (eg 80)
+  } deriving (Show, Eq, Ord, Generic)
+
+showBaseUrl :: BaseUrl -> String
+showBaseUrl (BaseUrl urlscheme host port) =
+  schemeString ++ "//" ++ host ++ portString
+    where
+      schemeString = case urlscheme of
+        Http  -> "http:"
+        Https -> "https:"
+      portString = case (urlscheme, port) of
+        (Http, 80) -> ""
+        (Https, 443) -> ""
+        _ -> ":" ++ show port
+
+parseBaseUrl :: String -> Either String BaseUrl
+parseBaseUrl s = case parseURI (removeTrailingSlash s) of
+  -- This is a rather hacky implementation and should be replaced with something
+  -- implemented in attoparsec (which is already a dependency anyhow (via aeson)).
+  Just (URI "http:" (Just (URIAuth "" host (':' : (readMaybe -> Just port)))) "" "" "") ->
+    Right (BaseUrl Http host port)
+  Just (URI "http:" (Just (URIAuth "" host "")) "" "" "") ->
+    Right (BaseUrl Http host 80)
+  Just (URI "https:" (Just (URIAuth "" host (':' : (readMaybe -> Just port)))) "" "" "") ->
+    Right (BaseUrl Https host port)
+  Just (URI "https:" (Just (URIAuth "" host "")) "" "" "") ->
+    Right (BaseUrl Https host 443)
+  _ -> if "://" `isInfixOf` s
+    then Left ("invalid base url: " ++ s)
+    else parseBaseUrl ("http://" ++ s)
+ where
+  removeTrailingSlash str = case lastMay str of
+    Just '/' -> init str
+    _ -> str

servant-client/src/Servant/Common/Req.hs

@@ -0,0 +1,184 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+module Servant.Common.Req where
+
+import Control.Applicative
+import Control.Exception
+import Control.Monad
+import Control.Monad.Catch (MonadThrow)
+import Control.Monad.IO.Class
+import Control.Monad.Trans.Either
+import Data.ByteString.Lazy hiding (pack, filter, map, null, elem)
+import Data.IORef
+import Data.String
+import Data.String.Conversions
+import Data.Proxy
+import Data.Text (Text)
+import Data.Text.Encoding
+import Network.HTTP.Client hiding (Proxy)
+import Network.HTTP.Client.TLS
+import Network.HTTP.Media
+import Network.HTTP.Types
+import Network.URI
+import Servant.API.ContentTypes
+import Servant.Common.BaseUrl
+import Servant.Common.Text
+import System.IO.Unsafe
+
+import qualified Network.HTTP.Client as Client
+
+data ServantError
+  = FailureResponse
+    { responseStatus            :: Status
+    , responseContentType       :: MediaType
+    , responseBody              :: ByteString
+    }
+  | DecodeFailure
+    { decodeError               :: String
+    , responseContentType       :: MediaType
+    , responseBody              :: ByteString
+    }
+  | UnsupportedContentType
+    { responseContentType       :: MediaType
+    , responseBody              :: ByteString
+    }
+  | ConnectionError
+    { connectionError           :: HttpException
+    }
+  | InvalidContentTypeHeader
+    { responseContentTypeHeader :: ByteString
+    , responseBody              :: ByteString
+    }
+  deriving (Show)
+
+data Req = Req
+  { reqPath   :: String
+  , qs        :: QueryText
+  , reqBody   :: Maybe (ByteString, MediaType)
+  , reqAccept :: [MediaType]
+  , headers   :: [(String, Text)]
+  }
+
+defReq :: Req
+defReq = Req "" [] Nothing [] []
+
+appendToPath :: String -> Req -> Req
+appendToPath p req =
+  req { reqPath = reqPath req ++ "/" ++ p }
+
+appendToMatrixParams :: String
+                     -> Maybe String
+                     -> Req
+                     -> Req
+appendToMatrixParams pname pvalue req =
+  req { reqPath = reqPath req ++ ";" ++ pname ++ maybe "" ("=" ++) pvalue }
+
+appendToQueryString :: Text       -- ^ param name
+                    -> Maybe Text -- ^ param value
+                    -> Req
+                    -> Req
+appendToQueryString pname pvalue req =
+  req { qs = qs req ++ [(pname, pvalue)]
+      }
+
+addHeader :: ToText a => String -> a -> Req -> Req
+addHeader name val req = req { headers = headers req
+                                      ++ [(name, toText val)]
+                             }
+
+setRQBody :: ByteString -> MediaType -> Req -> Req
+setRQBody b t req = req { reqBody = Just (b, t) }
+
+reqToRequest :: (Functor m, MonadThrow m) => Req -> BaseUrl -> m Request
+reqToRequest req (BaseUrl reqScheme reqHost reqPort) =
+    fmap (setheaders . setAccept . setrqb . setQS ) $ parseUrl url
+
+  where url = show $ nullURI { uriScheme = case reqScheme of
+                                  Http  -> "http:"
+                                  Https -> "https:"
+                             , uriAuthority = Just $
+                                 URIAuth { uriUserInfo = ""
+                                         , uriRegName = reqHost
+                                         , uriPort = ":" ++ show reqPort
+                                         }
+                             , uriPath = reqPath req
+                             }
+
+        setrqb r = case reqBody req of
+                     Nothing -> r
+                     Just (b,t) -> r { requestBody = RequestBodyLBS b
+                                     , requestHeaders = requestHeaders r
+                                                     ++ [(hContentType, cs . show $ t)] }
+        setQS = setQueryString $ queryTextToQuery (qs req)
+        setheaders r = r { requestHeaders = requestHeaders r
+                                         <> fmap toProperHeader (headers req) }
+        setAccept r = r { requestHeaders = filter ((/= "Accept") . fst) (requestHeaders r)
+                                        <> [("Accept", renderHeader $ reqAccept req)
+                                              | not . null . reqAccept $ req] }
+        toProperHeader (name, val) =
+          (fromString name, encodeUtf8 val)
+
+
+-- * performing requests
+
+{-# NOINLINE __manager #-}
+__manager :: IORef Manager
+__manager = unsafePerformIO (newManager tlsManagerSettings >>= newIORef)
+
+__withGlobalManager :: (Manager -> IO a) -> IO a
+__withGlobalManager action = readIORef __manager >>= action
+
+
+displayHttpRequest :: Method -> String
+displayHttpRequest httpmethod = "HTTP " ++ cs httpmethod ++ " request"
+
+
+performRequest :: Method -> Req -> (Int -> Bool) -> BaseUrl -> EitherT ServantError IO (Int, ByteString, MediaType, Response ByteString)
+performRequest reqMethod req isWantedStatus reqHost = do
+  partialRequest <- liftIO $ reqToRequest req reqHost
+
+  let request = partialRequest { Client.method = reqMethod
+                               , checkStatus = \ _status _headers _cookies -> Nothing
+                               }
+
+  eResponse <- liftIO $ __withGlobalManager $ \ manager ->
+    catchHttpException $
+    Client.httpLbs request manager
+  case eResponse of
+    Left err ->
+      left $ ConnectionError err
+
+    Right response -> do
+      let status = Client.responseStatus response
+          body = Client.responseBody response
+          status_code = statusCode status
+      ct <- case lookup "Content-Type" $ Client.responseHeaders response of
+                 Nothing -> pure $ "application"//"octet-stream"
+                 Just t -> case parseAccept t of
+                   Nothing -> left $ InvalidContentTypeHeader (cs t) body
+                   Just t' -> pure t'
+      unless (isWantedStatus status_code) $
+        left $ FailureResponse status ct body
+      return (status_code, body, ct, response)
+
+performRequestCT :: MimeUnrender ct result =>
+  Proxy ct -> Method -> Req -> [Int] -> BaseUrl -> EitherT ServantError IO result
+performRequestCT ct reqMethod req wantedStatus reqHost = do
+  let acceptCT = contentType ct
+  (_status, respBody, respCT, _response) <-
+    performRequest reqMethod (req { reqAccept = [acceptCT] }) (`elem` wantedStatus) reqHost
+  unless (matches respCT (acceptCT)) $
+    left $ UnsupportedContentType respCT respBody
+  either
+    (left . (\s -> DecodeFailure s respCT respBody))
+    return
+    (mimeUnrender ct respBody)
+
+performRequestNoBody :: Method -> Req -> [Int] -> BaseUrl -> EitherT ServantError IO ()
+performRequestNoBody reqMethod req wantedStatus reqHost = do
+  _ <- performRequest reqMethod req (`elem` wantedStatus) reqHost
+  return ()
+
+catchHttpException :: IO a -> IO (Either HttpException a)
+catchHttpException action =
+  catch (Right <$> action) (pure . Left)

servant-client/test/Servant/ClientSpec.hs

@@ -0,0 +1,345 @@
+{-# LANGUAGE DataKinds          #-}
+{-# LANGUAGE DeriveGeneric      #-}
+{-# LANGUAGE FlexibleContexts   #-}
+{-# LANGUAGE GADTs              #-}
+{-# LANGUAGE OverloadedStrings  #-}
+{-# LANGUAGE RecordWildCards    #-}
+{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE TypeOperators      #-}
+{-# OPTIONS_GHC -fcontext-stack=25 #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+module Servant.ClientSpec where
+
+import           Control.Applicative
+import qualified Control.Arrow              as Arrow
+import           Control.Concurrent
+import           Control.Exception
+import           Control.Monad.Trans.Either
+import           Data.Aeson
+import           Data.ByteString.Lazy       (ByteString)
+import           Data.Char
+import           Data.Foldable              (forM_)
+import           Data.Monoid
+import           Data.Proxy
+import qualified Data.Text                  as T
+import           GHC.Generics
+import qualified Network.HTTP.Client        as C
+import           Network.HTTP.Media
+import           Network.HTTP.Types
+import           Network.Socket
+import           Network.Wai                hiding (Response)
+import           Network.Wai.Handler.Warp
+import           Test.Hspec
+import           Test.Hspec.QuickCheck
+import           Test.HUnit
+import           Test.QuickCheck
+
+import           Servant.API
+import           Servant.Client
+import           Servant.Server
+
+-- * test data types
+
+data Person = Person {
+  name :: String,
+  age :: Integer
+ }
+  deriving (Eq, Show, Generic)
+
+instance ToJSON Person
+instance FromJSON Person
+
+instance ToFormUrlEncoded Person where
+    toFormUrlEncoded Person{..} =
+        [("name", T.pack name), ("age", T.pack (show age))]
+
+lookupEither :: (Show a, Eq a) => a -> [(a,b)] -> Either String b
+lookupEither x xs = do
+    maybe (Left $ "could not find key " <> show x) return $ lookup x xs
+
+instance FromFormUrlEncoded Person where
+    fromFormUrlEncoded xs = do
+        n <- lookupEither "name" xs
+        a <- lookupEither "age" xs
+        return $ Person (T.unpack n) (read $ T.unpack a)
+
+deriving instance Eq ServantError
+
+instance Eq C.HttpException where
+  a == b = show a == show b
+
+alice :: Person
+alice = Person "Alice" 42
+
+type Api =
+       "get" :> Get '[JSON] Person
+  :<|> "delete" :> Delete
+  :<|> "capture" :> Capture "name" String :> Get '[JSON,FormUrlEncoded] Person
+  :<|> "body" :> ReqBody '[FormUrlEncoded,JSON] Person :> Post '[JSON] Person
+  :<|> "param" :> QueryParam "name" String :> Get '[FormUrlEncoded,JSON] Person
+  :<|> "params" :> QueryParams "names" String :> Get '[JSON] [Person]
+  :<|> "flag" :> QueryFlag "flag" :> Get '[JSON] Bool
+  :<|> "matrixparam" :> MatrixParam "name" String :> Get '[JSON] Person
+  :<|> "matrixparams" :> MatrixParams "name" String :> Get '[JSON] [Person]
+  :<|> "matrixflag" :> MatrixFlag "flag" :> Get '[JSON] Bool
+  :<|> "rawSuccess" :> Raw
+  :<|> "rawFailure" :> Raw
+  :<|> "multiple" :>
+            Capture "first" String :>
+            QueryParam "second" Int :>
+            QueryFlag "third" :>
+            ReqBody '[JSON] [(String, [Rational])] :>
+            Get '[JSON] (String, Maybe Int, Bool, [(String, [Rational])])
+api :: Proxy Api
+api = Proxy
+
+server :: Application
+server = serve api (
+       return alice
+  :<|> return ()
+  :<|> (\ name -> return $ Person name 0)
+  :<|> return
+  :<|> (\ name -> case name of
+                   Just "alice" -> return alice
+                   Just name -> left (400, name ++ " not found")
+                   Nothing -> left (400, "missing parameter"))
+  :<|> (\ names -> return (zipWith Person names [0..]))
+  :<|> return
+  :<|> (\ name -> case name of
+                   Just "alice" -> return alice
+                   Just name -> left (400, name ++ " not found")
+                   Nothing -> left (400, "missing parameter"))
+  :<|> (\ names -> return (zipWith Person names [0..]))
+  :<|> return
+  :<|> (\ _request respond -> respond $ responseLBS ok200 [] "rawSuccess")
+  :<|> (\ _request respond -> respond $ responseLBS badRequest400 [] "rawFailure")
+  :<|> \ a b c d -> return (a, b, c, d)
+ )
+
+withServer :: (BaseUrl -> IO a) -> IO a
+withServer action = withWaiDaemon (return server) action
+
+getGet :: BaseUrl -> EitherT ServantError IO Person
+getDelete :: BaseUrl -> EitherT ServantError IO ()
+getCapture :: String -> BaseUrl -> EitherT ServantError IO Person
+getBody :: Person -> BaseUrl -> EitherT ServantError IO Person
+getQueryParam :: Maybe String -> BaseUrl -> EitherT ServantError IO Person
+getQueryParams :: [String] -> BaseUrl -> EitherT ServantError IO [Person]
+getQueryFlag :: Bool -> BaseUrl -> EitherT ServantError IO Bool
+getMatrixParam :: Maybe String -> BaseUrl -> EitherT ServantError IO Person
+getMatrixParams :: [String] -> BaseUrl -> EitherT ServantError IO [Person]
+getMatrixFlag :: Bool -> BaseUrl -> EitherT ServantError IO Bool
+getRawSuccess :: Method -> BaseUrl -> EitherT ServantError IO (Int, ByteString, MediaType, C.Response ByteString)
+getRawFailure :: Method -> BaseUrl -> EitherT ServantError IO (Int, ByteString, MediaType, C.Response ByteString)
+getMultiple :: String -> Maybe Int -> Bool -> [(String, [Rational])]
+  -> BaseUrl
+  -> EitherT ServantError IO (String, Maybe Int, Bool, [(String, [Rational])])
+(     getGet
+ :<|> getDelete
+ :<|> getCapture
+ :<|> getBody
+ :<|> getQueryParam
+ :<|> getQueryParams
+ :<|> getQueryFlag
+ :<|> getMatrixParam
+ :<|> getMatrixParams
+ :<|> getMatrixFlag
+ :<|> getRawSuccess
+ :<|> getRawFailure
+ :<|> getMultiple)
+    = client api
+
+type FailApi =
+       "get" :> Raw
+  :<|> "capture" :> Capture "name" String :> Raw
+  :<|> "body" :> Raw
+failApi :: Proxy FailApi
+failApi = Proxy
+
+failServer :: Application
+failServer = serve failApi (
+       (\ _request respond -> respond $ responseLBS ok200 [] "")
+  :<|> (\ _capture _request respond -> respond $ responseLBS ok200 [("content-type", "application/json")] "")
+  :<|> (\_request respond -> respond $ responseLBS ok200 [("content-type", "fooooo")] "")
+ )
+
+withFailServer :: (BaseUrl -> IO a) -> IO a
+withFailServer action = withWaiDaemon (return failServer) action
+
+spec :: Spec
+spec = do
+  it "Servant.API.Get" $ withServer $ \ host -> do
+    (Arrow.left show <$> runEitherT (getGet host)) `shouldReturn` Right alice
+
+  it "Servant.API.Delete" $ withServer $ \ host -> do
+    (Arrow.left show <$> runEitherT (getDelete host)) `shouldReturn` Right ()
+
+  it "Servant.API.Capture" $ withServer $ \ host -> do
+    (Arrow.left show <$> runEitherT (getCapture "Paula" host)) `shouldReturn` Right (Person "Paula" 0)
+
+  it "Servant.API.ReqBody" $ withServer $ \ host -> do
+    let p = Person "Clara" 42
+    (Arrow.left show <$> runEitherT (getBody p host)) `shouldReturn` Right p
+
+  it "Servant.API.QueryParam" $ withServer $ \ host -> do
+    Arrow.left show <$> runEitherT (getQueryParam (Just "alice") host) `shouldReturn` Right alice
+    Left FailureResponse{..} <- runEitherT (getQueryParam (Just "bob") host)
+    responseStatus `shouldBe` Status 400 "bob not found"
+
+  it "Servant.API.QueryParam.QueryParams" $ withServer $ \ host -> do
+    (Arrow.left show <$> runEitherT (getQueryParams [] host)) `shouldReturn` Right []
+    (Arrow.left show <$> runEitherT (getQueryParams ["alice", "bob"] host))
+      `shouldReturn` Right [Person "alice" 0, Person "bob" 1]
+
+  context "Servant.API.QueryParam.QueryFlag" $
+    forM_ [False, True] $ \ flag ->
+    it (show flag) $ withServer $ \ host -> do
+      (Arrow.left show <$> runEitherT (getQueryFlag flag host)) `shouldReturn` Right flag
+
+  it "Servant.API.MatrixParam" $ withServer $ \ host -> do
+    Arrow.left show <$> runEitherT (getMatrixParam (Just "alice") host) `shouldReturn` Right alice
+    Left FailureResponse{..} <- runEitherT (getMatrixParam (Just "bob") host)
+    responseStatus `shouldBe` Status 400 "bob not found"
+
+  it "Servant.API.MatrixParam.MatrixParams" $ withServer $ \ host -> do
+    Arrow.left show <$> runEitherT (getMatrixParams [] host) `shouldReturn` Right []
+    Arrow.left show <$> runEitherT (getMatrixParams ["alice", "bob"] host)
+      `shouldReturn` Right [Person "alice" 0, Person "bob" 1]
+
+  context "Servant.API.MatrixParam.MatrixFlag" $
+    forM_ [False, True] $ \ flag ->
+    it (show flag) $ withServer $ \ host -> do
+      Arrow.left show <$> runEitherT (getMatrixFlag flag host) `shouldReturn` Right flag
+
+  it "Servant.API.Raw on success" $ withServer $ \ host -> do
+    res <- runEitherT (getRawSuccess methodGet host)
+    case res of
+      Left e -> assertFailure $ show e
+      Right (code, body, ct, response) -> do
+        (code, body, ct) `shouldBe` (200, "rawSuccess", "application"//"octet-stream")
+        C.responseBody response `shouldBe` body
+        C.responseStatus response `shouldBe` ok200
+
+  it "Servant.API.Raw on failure" $ withServer $ \ host -> do
+    res <- runEitherT (getRawFailure methodGet host)
+    case res of
+      Left e -> assertFailure $ show e
+      Right (code, body, ct, response) -> do
+        (code, body, ct) `shouldBe` (400, "rawFailure", "application"//"octet-stream")
+        C.responseBody response `shouldBe` body
+        C.responseStatus response `shouldBe` badRequest400
+
+  modifyMaxSuccess (const 20) $ do
+    it "works for a combination of Capture, QueryParam, QueryFlag and ReqBody" $
+      property $ forAllShrink pathGen shrink $ \(NonEmpty cap) num flag body ->
+        ioProperty $ do
+          withServer $ \ host -> do
+            result <- Arrow.left show <$> runEitherT (getMultiple cap num flag body host)
+            return $
+              result === Right (cap, num, flag, body)
+
+
+  context "client correctly handles error status codes" $ do
+    let test :: (WrappedApi, String) -> Spec
+        test (WrappedApi api, desc) =
+          it desc $
+          withWaiDaemon (return (serve api (left (500, "error message")))) $
+          \ host -> do
+            let getResponse :: BaseUrl -> EitherT ServantError IO ()
+                getResponse = client api
+            Left FailureResponse{..} <- runEitherT (getResponse host)
+            responseStatus `shouldBe` (Status 500 "error message")
+    mapM_ test $
+      (WrappedApi (Proxy :: Proxy Delete), "Delete") :
+      (WrappedApi (Proxy :: Proxy (Get '[JSON] ())), "Get") :
+      (WrappedApi (Proxy :: Proxy (Post '[JSON] ())), "Post") :
+      (WrappedApi (Proxy :: Proxy (Put '[JSON] ())), "Put") :
+      []
+
+  context "client returns errors appropriately" $ do
+    it "reports FailureResponse" $ withFailServer $ \ host -> do
+      Left res <- runEitherT (getDelete host)
+      case res of
+        FailureResponse (Status 404 "Not Found") _ _ -> return ()
+        _ -> fail $ "expected 404 response, but got " <> show res
+
+    it "reports DecodeFailure" $ withFailServer $ \ host -> do
+      Left res <- runEitherT (getCapture "foo" host)
+      case res of
+        DecodeFailure _ ("application/json") _ -> return ()
+        _ -> fail $ "expected DecodeFailure, but got " <> show res
+
+    it "reports ConnectionError" $ do
+      Right host <- return $ parseBaseUrl "127.0.0.1:987654"
+      Left res <- runEitherT (getGet host)
+      case res of
+        ConnectionError (C.FailedConnectionException2 "127.0.0.1" 987654 False _) -> return ()
+        _ -> fail $ "expected ConnectionError, but got " <> show res
+
+    it "reports UnsupportedContentType" $ withFailServer $ \ host -> do
+      Left res <- runEitherT (getGet host)
+      case res of
+        UnsupportedContentType ("application/octet-stream") _ -> return ()
+        _ -> fail $ "expected UnsupportedContentType, but got " <> show res
+
+    it "reports InvalidContentTypeHeader" $ withFailServer $ \ host -> do
+      Left res <- runEitherT (getBody alice host)
+      case res of
+        InvalidContentTypeHeader "fooooo" _ -> return ()
+        _ -> fail $ "expected InvalidContentTypeHeader, but got " <> show res
+
+data WrappedApi where
+  WrappedApi :: (HasServer (Canonicalize api), Server api ~ EitherT (Int, String) IO a,
+                 HasClient (Canonicalize api), Client api ~ (BaseUrl -> EitherT ServantError IO ())) =>
+    Proxy api -> WrappedApi
+
+
+-- * utils
+
+withWaiDaemon :: IO Application -> (BaseUrl -> IO a) -> IO a
+withWaiDaemon mkApplication action = do
+  application <- mkApplication
+  bracket (acquire application) free (\ (_, _, baseUrl) -> action baseUrl)
+ where
+  acquire application = do
+    (notifyStart, waitForStart) <- lvar
+    (notifyKilled, waitForKilled) <- lvar
+    thread <- forkIO $ (do
+      (krakenPort, socket) <- openTestSocket
+      let settings =
+            setPort krakenPort $ -- set here just for consistency, shouldn't be
+                                 -- used (it's set in the socket)
+            setBeforeMainLoop (notifyStart krakenPort)
+            defaultSettings
+      runSettingsSocket settings socket application)
+            `finally` notifyKilled ()
+    krakenPort <- waitForStart
+    let baseUrl = (BaseUrl Http "localhost" 80){baseUrlPort = krakenPort}
+    return (thread, waitForKilled, baseUrl)
+  free (thread, waitForKilled, _) = do
+    killThread thread
+    waitForKilled
+
+  lvar :: IO (a -> IO (), IO a)
+  lvar = do
+    mvar <- newEmptyMVar
+    let put = putMVar mvar
+        wait = readMVar mvar
+    return (put, wait)
+
+openTestSocket :: IO (Port, Socket)
+openTestSocket = do
+  s <- socket AF_INET Stream defaultProtocol
+  localhost <- inet_addr "127.0.0.1"
+  bind s (SockAddrInet aNY_PORT localhost)
+  listen s 1
+  port <- socketPort s
+  return (fromIntegral port, s)
+
+pathGen :: Gen (NonEmptyList Char)
+pathGen = fmap NonEmpty path
+ where
+  path = listOf1 $ elements $
+    filter (not . (`elem` "?%[]/#;")) $
+    filter isPrint $
+    map chr [0..127]

servant-client/test/Servant/Common/BaseUrlSpec.hs

@@ -0,0 +1,69 @@
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+module Servant.Common.BaseUrlSpec where
+
+import Control.Applicative
+import Control.DeepSeq
+import Test.Hspec
+import Test.QuickCheck
+
+import Servant.Common.BaseUrl
+
+spec :: Spec
+spec = do
+  describe "showBaseUrl" $ do
+    it "shows a BaseUrl" $ do
+      showBaseUrl (BaseUrl Http "foo.com" 80) `shouldBe` "http://foo.com"
+
+    it "shows a https BaseUrl" $ do
+      showBaseUrl (BaseUrl Https "foo.com" 443) `shouldBe` "https://foo.com"
+
+  describe "httpBaseUrl" $ do
+    it "allows to construct default http BaseUrls" $ do
+      BaseUrl Http "bar" 80 `shouldBe` BaseUrl Http "bar" 80
+
+  describe "parseBaseUrl" $ do
+    it "is total" $ do
+      property $ \ string ->
+        deepseq (fmap show (parseBaseUrl string)) True
+
+    it "is the inverse of showBaseUrl" $ do
+      property $ \ baseUrl ->
+        counterexample (showBaseUrl baseUrl) $
+        parseBaseUrl (showBaseUrl baseUrl) ===
+          Right baseUrl
+
+    it "allows trailing slashes" $ do
+      parseBaseUrl "foo.com/" `shouldBe` Right (BaseUrl Http "foo.com" 80)
+
+    context "urls without scheme" $ do
+      it "assumes http" $ do
+        parseBaseUrl "foo.com" `shouldBe` Right (BaseUrl Http "foo.com" 80)
+
+      it "allows port numbers" $ do
+        parseBaseUrl "foo.com:8080" `shouldBe` Right (BaseUrl Http "foo.com" 8080)
+
+    it "rejects ftp urls" $ do
+      parseBaseUrl "ftp://foo.com" `shouldSatisfy` isLeft
+
+instance Arbitrary BaseUrl where
+  arbitrary = BaseUrl <$>
+    elements [Http, Https] <*>
+    hostNameGen <*>
+    portGen
+   where
+    -- this does not perfectly mirror the url standard, but I hope it's good
+    -- enough.
+    hostNameGen = do
+      let letters = ['a' .. 'z'] ++ ['A' .. 'Z']
+      first <- elements letters
+      middle <- listOf1 $ elements (letters ++ ['0' .. '9'] ++ ['.', '-'])
+      last <- elements letters
+      return (first : middle ++ [last])
+    portGen = frequency $
+      (1, return 80) :
+      (1, return 443) :
+      (1, choose (1, 20000)) :
+      []
+
+isLeft :: Either a b -> Bool
+isLeft = either (const True) (const False)

servant-client/test/Spec.hs

@@ -0,0 +1 @@
+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}