servant-client-core 0.15 → 0.16

raw patch · 23 files changed

+1331/−1261 lines, 23 filesdep +bifunctorsdep −generics-sopdep ~QuickCheckdep ~basedep ~base-compat

Dependencies added: bifunctors

Dependencies removed: generics-sop

Dependency ranges changed: QuickCheck, base, base-compat, hspec, http-media, servant, template-haskell

Files

• CHANGELOG.md +48/−0
• servant-client-core.cabal +21/−15
• src/Servant/Client/Core.hs +18/−15
• src/Servant/Client/Core/Auth.hs +37/−0
• src/Servant/Client/Core/BaseUrl.hs +144/−0
• src/Servant/Client/Core/BasicAuth.hs +25/−0
• src/Servant/Client/Core/ClientError.hs +86/−0
• src/Servant/Client/Core/HasClient.hs +678/−0
• src/Servant/Client/Core/Internal.hs +12/−0
• src/Servant/Client/Core/Internal/Auth.hs +0/−33
• src/Servant/Client/Core/Internal/BaseUrl.hs +0/−133
• src/Servant/Client/Core/Internal/BasicAuth.hs +0/−24
• src/Servant/Client/Core/Internal/ClientF.hs +0/−10
• src/Servant/Client/Core/Internal/Generic.hs +0/−155
• src/Servant/Client/Core/Internal/HasClient.hs +0/−633
• src/Servant/Client/Core/Internal/Request.hs +0/−164
• src/Servant/Client/Core/Internal/RunClient.hs +0/−67
• src/Servant/Client/Core/Reexport.hs +7/−10
• src/Servant/Client/Core/Request.hs +154/−0
• src/Servant/Client/Core/Response.hs +53/−0
• src/Servant/Client/Core/RunClient.hs +46/−0
• src/Servant/Client/Free.hs +1/−1
• test/Servant/Client/Core/Internal/BaseUrlSpec.hs +1/−1

@@ -1,6 +1,54 @@ [The latest version of this document is on GitHub.](https://github.com/haskell-servant/servant/blob/master/servant-client-core/CHANGELOG.md) [Changelog for `servant` package contains significant entries for all core packages.](https://github.com/haskell-servant/servant/blob/master/servant/CHANGELOG.md) +0.16+----++- Rename `ServantError` to `ClientError`, `ServantErr` to `ServerError`+  [#1131](https://github.com/haskell-servant/servant/pull/1131)++- *servant-client-core* Rearrange modules. No more `Internal` modules, whole+  API is versioned.+  [#1130](https://github.com/haskell-servant/servant/pull/1130)++- *servant-client-core* `RequestBody` is now++    ```haskell+    = RequestBodyLBS LBS.ByteString+    | RequestBodyBS BS.ByteString+    | RequestBodySource (SourceIO LBS.ByteString)+    ```++  i.e. no more replicates `http-client`s API.+  [#1117](https://github.com/haskell-servant/servant/pull/1117)++- *servant-client-core* Keep structured exceptions in `ConnectionError`+  constructor of `ClientError`+  [#1115](https://github.com/haskell-servant/servant/pull/1115)++    ```diff+    -| ConnectionError Text+    +| ConnectionError SomeException+    ```++- *servant-client-core* Preserve failing request in `FailureResponse`+  constructor of `ClientError`+  [#1114](https://github.com/haskell-servant/servant/pull/1114)++    ```diff+    -FailureResponse Response+    +-- | The server returned an error response including the+    +-- failing request. 'requestPath' includes the 'BaseUrl' and the+    +-- path of the request.+    +FailureResponse (RequestF () (BaseUrl, BS.ByteString)) Response+    ```++- *servant-client* Fix (implement) `StreamBody` instance+  [#1110](https://github.com/haskell-servant/servant/pull/1110)++- *servant-client* Update CookieJar with intermediate request/responses (redirects)+  [#1104](https://github.com/haskell-servant/servant/pull/1104)+ 0.15 ---- 

@@ -1,6 +1,6 @@ cabal-version:       >=1.10 name:                servant-client-core-version:             0.15+version:             0.16  synopsis:            Core functionality and class for client function generation for servant APIs category:            Servant, Web@@ -14,13 +14,13 @@ license-file:        LICENSE author:              Servant Contributors maintainer:          haskell-servant-maintainers@googlegroups.com-copyright:           2014-2016 Zalora South East Asia Pte Ltd, 2016-2018 Servant Contributors+copyright:           2014-2016 Zalora South East Asia Pte Ltd, 2016-2019 Servant Contributors build-type:          Simple tested-with:   GHC ==8.0.2    || ==8.2.2    || ==8.4.4-   || ==8.6.2+   || ==8.6.3  extra-source-files:   CHANGELOG.md@@ -36,15 +36,18 @@       Servant.Client.Free       Servant.Client.Generic       Servant.Client.Core.Reexport-      Servant.Client.Core.Internal.Auth-      Servant.Client.Core.Internal.BaseUrl-      Servant.Client.Core.Internal.BasicAuth-      Servant.Client.Core.Internal.ClientF-      Servant.Client.Core.Internal.Generic-      Servant.Client.Core.Internal.HasClient-      Servant.Client.Core.Internal.Request-      Servant.Client.Core.Internal.RunClient+      Servant.Client.Core.Auth+      Servant.Client.Core.BaseUrl+      Servant.Client.Core.BasicAuth+      Servant.Client.Core.ClientError+      Servant.Client.Core.HasClient+      Servant.Client.Core.Request+      Servant.Client.Core.Response+      Servant.Client.Core.RunClient +  other-modules:+      Servant.Client.Core.Internal+   -- Bundled with GHC: Lower bound to not force re-installs   -- text and mtl are bundled starting with GHC-8.4   --@@ -58,9 +61,13 @@     , transformers          >= 0.5.2.0  && < 0.6     , template-haskell      >= 2.11.1.0 && < 2.15 +  if !impl(ghc >= 8.2)+    build-depends:+      bifunctors >= 5.5.3 && < 5.6+   -- Servant dependencies   build-depends:-        servant            >= 0.15 && <0.16+      servant            >= 0.16 && <0.17    -- Other dependencies: Lower bound around what is in the latest Stackage LTS.   -- Here can be exceptions if we really need features from the newer versions.@@ -70,7 +77,6 @@     , base64-bytestring     >= 1.0.0.1  && < 1.1     , exceptions            >= 0.10.0   && < 0.11     , free                  >= 5.1      && < 5.2-    , generics-sop          >= 0.4.0.1  && < 0.5     , http-media            >= 0.7.1.3  && < 0.8     , http-types            >= 0.12.2   && < 0.13     , network-uri           >= 2.6.1.0  && < 2.7@@ -98,8 +104,8 @@   -- Additonal dependencies   build-depends:       deepseq    >= 1.4.2.0  && < 1.5-    , hspec      >= 2.6.0    && < 2.7+    , hspec      >= 2.6.0    && < 2.8     , QuickCheck >= 2.12.6.1 && < 2.13    build-tool-depends:-    hspec-discover:hspec-discover >= 2.6.0 && <2.7+    hspec-discover:hspec-discover >= 2.6.0 && <2.8

@@ -32,18 +32,20 @@   , AuthClientData    -- * Generic Client-  , ClientLike(..)-  , genericMkClientL-  , genericMkClientP-  , ServantError(..)+  , ClientError(..)   , EmptyClient(..) -   -- * Response   , Response-  , GenResponse (..)+  , ResponseF (..)   , RunClient(..)-  , module Servant.Client.Core.Internal.BaseUrl+  -- * BaseUrl+  , BaseUrl (..)+  , Scheme (..)+  , showBaseUrl+  , parseBaseUrl+  , InvalidBaseUrlException (..)+   -- ** Streaming   , RunStreamingClient(..)   , StreamingResponse@@ -56,12 +58,13 @@   , setRequestBodyLBS   , setRequestBody   ) where-import           Servant.Client.Core.Internal.Auth-import           Servant.Client.Core.Internal.BaseUrl-                 (BaseUrl (..), InvalidBaseUrlException, Scheme (..),+import           Servant.Client.Core.Auth+import           Servant.Client.Core.BaseUrl+                 (BaseUrl (..), InvalidBaseUrlException (..), Scheme (..),                  parseBaseUrl, showBaseUrl)-import           Servant.Client.Core.Internal.BasicAuth-import           Servant.Client.Core.Internal.Generic-import           Servant.Client.Core.Internal.HasClient-import           Servant.Client.Core.Internal.Request-import           Servant.Client.Core.Internal.RunClient+import           Servant.Client.Core.BasicAuth+import           Servant.Client.Core.ClientError+import           Servant.Client.Core.HasClient+import           Servant.Client.Core.Request+import           Servant.Client.Core.Response+import           Servant.Client.Core.RunClient

@@ -0,0 +1,37 @@+{-# LANGUAGE OverloadedStrings    #-}+{-# LANGUAGE TypeFamilies         #-}+{-# LANGUAGE TypeSynonymInstances #-}++-- | Authentication for clients++module Servant.Client.Core.Auth (+    AuthClientData,+    AuthenticatedRequest (..),+    mkAuthenticatedRequest,+    ) where++import           Servant.Client.Core.Request+                 (Request)++-- | For a resource protected by authentication (e.g. AuthProtect), we need+-- to provide the client with some data used to add authentication data+-- to a request+--+-- NOTE: THIS API IS EXPERIMENTAL AND SUBJECT TO CHANGE+type family AuthClientData a :: *++-- | For better type inference and to avoid usage of a data family, we newtype+-- wrap the combination of some 'AuthClientData' and a function to add authentication+-- data to a request+--+-- NOTE: THIS API IS EXPERIMENTAL AND SUBJECT TO CHANGE+newtype AuthenticatedRequest a =+  AuthenticatedRequest { unAuthReq :: (AuthClientData a, AuthClientData a -> Request -> Request) }++-- | Handy helper to avoid wrapping datatypes in tuples everywhere.+--+-- NOTE: THIS API IS EXPERIMENTAL AND SUBJECT TO CHANGE+mkAuthenticatedRequest :: AuthClientData a+                  -> (AuthClientData a -> Request -> Request)+                  -> AuthenticatedRequest a+mkAuthenticatedRequest val func = AuthenticatedRequest (val, func)

@@ -0,0 +1,144 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric      #-}+{-# LANGUAGE DeriveLift         #-}+{-# LANGUAGE ViewPatterns       #-}+module Servant.Client.Core.BaseUrl (+    BaseUrl (..),+    Scheme (..),+    showBaseUrl,+    parseBaseUrl,+    InvalidBaseUrlException (..),+    ) where++import           Control.DeepSeq+                 (NFData (..))+import           Control.Monad.Catch+                 (Exception, MonadThrow, throwM)+import           Data.Aeson+                 (FromJSON (..), FromJSONKey (..), ToJSON (..), ToJSONKey (..))+import           Data.Aeson.Types+                 (FromJSONKeyFunction (..), contramapToJSONKeyFunction,+                 withText)+import           Data.Data+                 (Data)+import           Data.List+import qualified Data.Text                  as T+import           GHC.Generics+import           Language.Haskell.TH.Syntax+                 (Lift)+import           Network.URI                hiding+                 (path)+import           Safe+import           Text.Read++-- | URI scheme to use+data Scheme =+    Http  -- ^ http://+  | Https -- ^ https://+  deriving (Show, Eq, Ord, Generic, Lift, Data)++-- | 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)+  , baseUrlPath   :: String   -- ^ path (eg "/a/b/c")+  } deriving (Show, Ord, Generic, Lift, Data)+-- TODO: Ord is more precise than Eq+-- TODO: Add Hashable instance?+--+instance NFData BaseUrl where+  rnf (BaseUrl a b c d) = a `seq` rnf b `seq` rnf c `seq` rnf d++instance Eq BaseUrl where+    BaseUrl a b c path == BaseUrl a' b' c' path'+        = a == a' && b == b' && c == c' && s path == s path'+        where s ('/':x) = x+              s x       = x++-- | >>> traverse_ (LBS8.putStrLn . encode) $ parseBaseUrl "api.example.com"+-- "http://api.example.com"+instance ToJSON BaseUrl where+    toJSON     = toJSON . showBaseUrl+    toEncoding = toEncoding . showBaseUrl++-- | >>> parseBaseUrl "api.example.com" >>= decode . encode :: Maybe BaseUrl+-- Just (BaseUrl {baseUrlScheme = Http, baseUrlHost = "api.example.com", baseUrlPort = 80, baseUrlPath = ""})+instance FromJSON BaseUrl where+    parseJSON = withText "BaseUrl" $ \t -> case parseBaseUrl (T.unpack t) of+        Just u  -> return u+        Nothing -> fail $ "Invalid base url: " ++ T.unpack t++-- | >>> :{+-- traverse_ (LBS8.putStrLn . encode) $ do+--   u1 <- parseBaseUrl "api.example.com"+--   u2 <- parseBaseUrl "example.com"+--   return $ Map.fromList [(u1, 'x'), (u2, 'y')]+-- :}+-- {"http://api.example.com":"x","http://example.com":"y"}+instance ToJSONKey BaseUrl where+    toJSONKey = contramapToJSONKeyFunction showBaseUrl toJSONKey++instance FromJSONKey BaseUrl where+    fromJSONKey = FromJSONKeyTextParser $ \t -> case parseBaseUrl (T.unpack t) of+        Just u  -> return u+        Nothing -> fail $ "Invalid base url: " ++ T.unpack t++-- | >>> showBaseUrl <$> parseBaseUrl "api.example.com"+-- "http://api.example.com"+showBaseUrl :: BaseUrl -> String+showBaseUrl (BaseUrl urlscheme host port path) =+  schemeString ++ "//" ++ host ++ (portString </> path)+    where+      a </> b = if "/" `isPrefixOf` b || null b then a ++ b else a ++ '/':b+      schemeString = case urlscheme of+        Http  -> "http:"+        Https -> "https:"+      portString = case (urlscheme, port) of+        (Http, 80) -> ""+        (Https, 443) -> ""+        _ -> ":" ++ show port++newtype InvalidBaseUrlException = InvalidBaseUrlException String deriving (Show)+instance Exception InvalidBaseUrlException++-- |+--+-- >>> parseBaseUrl "api.example.com"+-- BaseUrl {baseUrlScheme = Http, baseUrlHost = "api.example.com", baseUrlPort = 80, baseUrlPath = ""}+--+-- /Note:/ trailing slash is removed+--+-- >>> parseBaseUrl "api.example.com/"+-- BaseUrl {baseUrlScheme = Http, baseUrlHost = "api.example.com", baseUrlPort = 80, baseUrlPath = ""}+--+-- >>> parseBaseUrl "api.example.com/dir/"+-- BaseUrl {baseUrlScheme = Http, baseUrlHost = "api.example.com", baseUrlPort = 80, baseUrlPath = "/dir"}+--+parseBaseUrl :: MonadThrow m => String -> m 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)))) path "" "") ->+    return (BaseUrl Http host port path)+  Just (URI "http:" (Just (URIAuth "" host "")) path "" "") ->+    return (BaseUrl Http host 80 path)+  Just (URI "https:" (Just (URIAuth "" host (':' : (readMaybe -> Just port)))) path "" "") ->+    return (BaseUrl Https host port path)+  Just (URI "https:" (Just (URIAuth "" host "")) path "" "") ->+    return (BaseUrl Https host 443 path)+  _ -> if "://" `isInfixOf` s+    then throwM (InvalidBaseUrlException $ "Invalid base URL: " ++ s)+    else parseBaseUrl ("http://" ++ s)+ where+  removeTrailingSlash str = case lastMay str of+    Just '/' -> init str+    _ -> str++-- $setup+--+-- >>> import Data.Aeson+-- >>> import Data.Foldable (traverse_)+-- >>> import qualified Data.ByteString.Lazy.Char8 as LBS8+-- >>> import qualified Data.Map.Strict as Map

@@ -0,0 +1,25 @@+{-# LANGUAGE OverloadedStrings    #-}+{-# LANGUAGE TypeFamilies         #-}+{-# LANGUAGE TypeSynonymInstances #-}++-- | Basic Authentication for clients+module Servant.Client.Core.BasicAuth (+    basicAuthReq,+    ) where++import           Data.ByteString.Base64+                 (encode)+import           Data.Monoid+                 ((<>))+import           Data.Text.Encoding+                 (decodeUtf8)+import           Servant.API.BasicAuth+                 (BasicAuthData (BasicAuthData))+import           Servant.Client.Core.Request+                 (Request, addHeader)++-- | Authenticate a request using Basic Authentication+basicAuthReq :: BasicAuthData -> Request -> Request+basicAuthReq (BasicAuthData user pass) req =+    let authText = decodeUtf8 ("Basic " <> encode (user <> ":" <> pass))+    in addHeader "Authorization" authText req

@@ -0,0 +1,86 @@+{-# LANGUAGE DeriveDataTypeable    #-}+{-# LANGUAGE DeriveFoldable        #-}+{-# LANGUAGE DeriveFunctor         #-}+{-# LANGUAGE DeriveGeneric         #-}+{-# LANGUAGE DeriveTraversable     #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings     #-}+{-# LANGUAGE RankNTypes            #-}+{-# LANGUAGE ScopedTypeVariables   #-}+{-# LANGUAGE TypeFamilies          #-}+module Servant.Client.Core.ClientError (+    ClientError (..),+    ) where++import           Prelude ()+import           Prelude.Compat++import           Control.DeepSeq+                 (NFData (..))+import           Control.Exception+                 (SomeException (..))+import           Control.Monad.Catch+                 (Exception)+import qualified Data.ByteString              as BS+import           Data.Text+                 (Text)+import           Data.Typeable+                 (Typeable, typeOf)+import           GHC.Generics+                 (Generic)+import           Network.HTTP.Media+                 (MediaType)+import           Network.HTTP.Types ()++import           Servant.Client.Core.BaseUrl+import           Servant.Client.Core.Internal+                 (mediaTypeRnf)+import           Servant.Client.Core.Request+import           Servant.Client.Core.Response+++-- | A type representing possible errors in a request+--+-- Note that this type substantially changed in 0.12.+data ClientError =+  -- | The server returned an error response including the+  -- failing request. 'requestPath' includes the 'BaseUrl' and the+  -- path of the request.+    FailureResponse (RequestF () (BaseUrl, BS.ByteString)) Response+  -- | The body could not be decoded at the expected type+  | DecodeFailure Text Response+  -- | The content-type of the response is not supported+  | UnsupportedContentType MediaType Response+  -- | The content-type header is invalid+  | InvalidContentTypeHeader Response+  -- | There was a connection error, and no response was received+  | ConnectionError SomeException+  deriving (Show, Generic, Typeable)++instance Eq ClientError where+  FailureResponse req res     == FailureResponse req' res'     = req == req' && res == res'+  DecodeFailure t r           == DecodeFailure t' r'           = t == t' && r == r'+  UnsupportedContentType mt r == UnsupportedContentType mt' r' = mt == mt' && r == r'+  InvalidContentTypeHeader r  == InvalidContentTypeHeader r'   = r == r'+  ConnectionError exc         == ConnectionError exc'          = eqSomeException exc exc'+    where+      -- returns true, if type of exception is the same+      eqSomeException (SomeException a) (SomeException b) = typeOf a == typeOf b++  -- prevent wild card blindness+  FailureResponse          {} == _ = False+  DecodeFailure            {} == _ = False+  UnsupportedContentType   {} == _ = False+  InvalidContentTypeHeader {} == _ = False+  ConnectionError          {} == _ = False++instance Exception ClientError++-- | Note: an exception in 'ConnectionError' might not be evaluated fully,+-- We only 'rnf' its 'show'ed value.+instance NFData ClientError where+    rnf (FailureResponse req res)        = rnf req `seq` rnf res+    rnf (DecodeFailure err res)          = rnf err `seq` rnf res+    rnf (UnsupportedContentType mt' res) = mediaTypeRnf mt' `seq` rnf res+    rnf (InvalidContentTypeHeader res)   = rnf res+    rnf (ConnectionError err)            = err `seq` rnf (show err)

@@ -0,0 +1,678 @@+{-# LANGUAGE DataKinds             #-}+{-# LANGUAGE FlexibleContexts      #-}+{-# LANGUAGE FlexibleInstances     #-}+{-# LANGUAGE InstanceSigs          #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings     #-}+{-# LANGUAGE PolyKinds             #-}+{-# LANGUAGE RankNTypes            #-}+{-# LANGUAGE ScopedTypeVariables   #-}+{-# LANGUAGE TypeFamilies          #-}+{-# LANGUAGE TypeOperators         #-}+{-# LANGUAGE UndecidableInstances  #-}++module Servant.Client.Core.HasClient (+    clientIn,+    HasClient (..),+    EmptyClient (..),+    ) where++import           Prelude ()+import           Prelude.Compat++import           Control.Monad+                 (unless)+import qualified Data.ByteString.Lazy                     as BL+import           Data.Foldable+                 (toList)+import           Data.List+                 (foldl')+import           Data.Proxy+                 (Proxy (Proxy))+import           Data.Sequence+                 (fromList)+import qualified Data.Text                       as T+import           Network.HTTP.Media+                 (MediaType, matches, parseAccept, (//))+import           Data.String+                 (fromString)+import           Data.Text+                 (Text, pack)+import           GHC.TypeLits+                 (KnownSymbol, symbolVal)+import qualified Network.HTTP.Types                       as H+import           Servant.API+                 ((:<|>) ((:<|>)), (:>), AuthProtect, BasicAuth, BasicAuthData,+                 BuildHeadersTo (..), Capture', CaptureAll, Description,+                 EmptyAPI, FramingRender (..), FramingUnrender (..),+                 FromSourceIO (..), Header', Headers (..), HttpVersion,+                 IsSecure, MimeRender (mimeRender),+                 MimeUnrender (mimeUnrender), NoContent (NoContent), QueryFlag,+                 QueryParam', QueryParams, Raw, ReflectMethod (..), RemoteHost,+                 ReqBody', SBoolI, Stream, StreamBody', Summary, ToHttpApiData,+                 ToSourceIO (..), Vault, Verb, WithNamedContext, contentType,+                 getHeadersHList, getResponse, toQueryParam, toUrlPiece)+import           Servant.API.ContentTypes+                 (contentTypes)+import           Servant.API.Modifiers+                 (FoldRequired, RequiredArgument, foldRequiredArgument)++import           Servant.Client.Core.Auth+import           Servant.Client.Core.BasicAuth+import           Servant.Client.Core.ClientError+import           Servant.Client.Core.Request+import           Servant.Client.Core.Response+import           Servant.Client.Core.RunClient++-- * Accessing APIs as a Client++-- | 'clientIn' allows you to produce operations to query an API from a client+-- within a 'RunClient' monad.+--+-- > type MyApi = "books" :> Get '[JSON] [Book] -- GET /books+-- >         :<|> "books" :> ReqBody '[JSON] Book :> Post '[JSON] Book -- POST /books+-- >+-- > myApi :: Proxy MyApi+-- > myApi = Proxy+-- >+-- > clientM :: Proxy ClientM+-- > clientM = Proxy+-- >+-- > getAllBooks :: ClientM [Book]+-- > postNewBook :: Book -> ClientM Book+-- > (getAllBooks :<|> postNewBook) = myApi `clientIn` clientM+clientIn :: HasClient m api => Proxy api -> Proxy m -> Client m api+clientIn p pm = clientWithRoute pm p defaultRequest+++-- | This class lets us define how each API combinator influences the creation+-- of an HTTP request.+--+-- Unless you are writing a new backend for @servant-client-core@ or new+-- combinators that you want to support client-generation, you can ignore this+-- class.+class RunClient m => HasClient m api where+  type Client (m :: * -> *) (api :: *) :: *+  clientWithRoute :: Proxy m -> Proxy api -> Request -> Client m api+  hoistClientMonad+    :: Proxy m+    -> Proxy api+    -> (forall x. mon x -> mon' x)+    -> Client mon api+    -> Client mon' api+++-- | 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 '[JSON] [Book] -- GET /books+-- >         :<|> "books" :> ReqBody '[JSON] Book :> Post Book -- POST /books+-- >+-- > myApi :: Proxy MyApi+-- > myApi = Proxy+-- >+-- > getAllBooks :: ClientM [Book]+-- > postNewBook :: Book -> ClientM Book+-- > (getAllBooks :<|> postNewBook) = client myApi+instance (HasClient m a, HasClient m b) => HasClient m (a :<|> b) where+  type Client m (a :<|> b) = Client m a :<|> Client m b+  clientWithRoute pm Proxy req =+    clientWithRoute pm (Proxy :: Proxy a) req :<|>+    clientWithRoute pm (Proxy :: Proxy b) req++  hoistClientMonad pm _ f (ca :<|> cb) =+    hoistClientMonad pm (Proxy :: Proxy a) f ca :<|>+    hoistClientMonad pm (Proxy :: Proxy b) f cb++-- | 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 RunClient m => HasClient m EmptyAPI where+  type Client m EmptyAPI = EmptyClient+  clientWithRoute _pm Proxy _ = EmptyClient+  hoistClientMonad _ _ _ EmptyClient = 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'.+-- 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 'ToHttpApiData' instance for your type.+--+-- Example:+--+-- > type MyApi = "books" :> Capture "isbn" Text :> Get '[JSON] Book+-- >+-- > myApi :: Proxy MyApi+-- > myApi = Proxy+-- >+-- > getBook :: Text -> ClientM Book+-- > getBook = client myApi+-- > -- then you can just use "getBook" to query that endpoint+instance (KnownSymbol capture, ToHttpApiData a, HasClient m api)+      => HasClient m (Capture' mods capture a :> api) where++  type Client m (Capture' mods capture a :> api) =+    a -> Client m api++  clientWithRoute pm Proxy req val =+    clientWithRoute pm (Proxy :: Proxy api)+                    (appendToPath p req)++    where p = (toUrlPiece val)++  hoistClientMonad pm _ f cl = \a ->+    hoistClientMonad pm (Proxy :: Proxy api) f (cl a)++-- | If you use a 'CaptureAll' in one of your endpoints in your API,+-- the corresponding querying function will automatically take an+-- additional argument of a list of the type specified by your+-- 'CaptureAll'. 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 these values are turned into text by specifying+-- a 'ToHttpApiData' instance of your type.+--+-- Example:+--+-- > type MyAPI = "src" :> CaptureAll Text -> Get '[JSON] SourceFile+-- >+-- > myApi :: Proxy+-- > myApi = Proxy+--+-- > getSourceFile :: [Text] -> ClientM SourceFile+-- > getSourceFile = client myApi+-- > -- then you can use "getSourceFile" to query that endpoint+instance (KnownSymbol capture, ToHttpApiData a, HasClient m sublayout)+      => HasClient m (CaptureAll capture a :> sublayout) where++  type Client m (CaptureAll capture a :> sublayout) =+    [a] -> Client m sublayout++  clientWithRoute pm Proxy req vals =+    clientWithRoute pm (Proxy :: Proxy sublayout)+                    (foldl' (flip appendToPath) req ps)++    where ps = map (toUrlPiece) vals++  hoistClientMonad pm _ f cl = \as ->+    hoistClientMonad pm (Proxy :: Proxy sublayout) f (cl as)++instance {-# OVERLAPPABLE #-}+  -- Note [Non-Empty Content Types]+  ( RunClient m, MimeUnrender ct a, ReflectMethod method, cts' ~ (ct ': cts)+  ) => HasClient m (Verb method status cts' a) where+  type Client m (Verb method status cts' a) = m a+  clientWithRoute _pm Proxy req = do+    response <- runRequest req+      { requestAccept = fromList $ toList accept+      , requestMethod = method+      }+    response `decodedAs` (Proxy :: Proxy ct)+    where+      accept = contentTypes (Proxy :: Proxy ct)+      method = reflectMethod (Proxy :: Proxy method)++  hoistClientMonad _ _ f ma = f ma++instance {-# OVERLAPPING #-}+  ( RunClient m, ReflectMethod method+  ) => HasClient m (Verb method status cts NoContent) where+  type Client m (Verb method status cts NoContent)+    = m NoContent+  clientWithRoute _pm Proxy req = do+    _response <- runRequest req { requestMethod = method }+    return NoContent+      where method = reflectMethod (Proxy :: Proxy method)++  hoistClientMonad _ _ f ma = f ma++instance {-# OVERLAPPING #-}+  -- Note [Non-Empty Content Types]+  ( RunClient m, MimeUnrender ct a, BuildHeadersTo ls+  , ReflectMethod method, cts' ~ (ct ': cts)+  ) => HasClient m (Verb method status cts' (Headers ls a)) where+  type Client m (Verb method status cts' (Headers ls a))+    = m (Headers ls a)+  clientWithRoute _pm Proxy req = do+    response <- runRequest req+       { requestMethod = method+       , requestAccept = fromList $ toList accept+       }+    case mimeUnrender (Proxy :: Proxy ct) $ responseBody response of+      Left err -> throwClientError $ DecodeFailure (pack err) response+      Right val -> return $ Headers+        { getResponse = val+        , getHeadersHList = buildHeadersTo . toList $ responseHeaders response+        }+      where method = reflectMethod (Proxy :: Proxy method)+            accept = contentTypes (Proxy :: Proxy ct)++  hoistClientMonad _ _ f ma = f ma++instance {-# OVERLAPPING #-}+  ( RunClient m, BuildHeadersTo ls, ReflectMethod method+  ) => HasClient m (Verb method status cts (Headers ls NoContent)) where+  type Client m (Verb method status cts (Headers ls NoContent))+    = m (Headers ls NoContent)+  clientWithRoute _pm Proxy req = do+    let method = reflectMethod (Proxy :: Proxy method)+    response <- runRequest req { requestMethod = method }+    return $ Headers { getResponse = NoContent+                     , getHeadersHList = buildHeadersTo . toList $ responseHeaders response+                     }++  hoistClientMonad _ _ f ma = f ma++instance {-# OVERLAPPABLE #-}+  ( RunStreamingClient m, MimeUnrender ct chunk, ReflectMethod method,+    FramingUnrender framing, FromSourceIO chunk a+  ) => HasClient m (Stream method status framing ct a) where++  type Client m (Stream method status framing ct a) = m a++  hoistClientMonad _ _ f ma = f ma++  clientWithRoute _pm Proxy req = withStreamingRequest req' $ \gres -> do+      let mimeUnrender'    = mimeUnrender (Proxy :: Proxy ct) :: BL.ByteString -> Either String chunk+          framingUnrender' = framingUnrender (Proxy :: Proxy framing) mimeUnrender'+      return $ fromSourceIO $ framingUnrender' $ responseBody gres+    where+      req' = req+          { requestAccept = fromList [contentType (Proxy :: Proxy ct)]+          , requestMethod = reflectMethod (Proxy :: Proxy method)+          }++-- | 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 'ToHttpApiData' instance.+--+-- Example:+--+-- > newtype Referer = Referer { referrer :: Text }+-- >   deriving (Eq, Show, Generic, ToHttpApiData)+-- >+-- >            -- GET /view-my-referer+-- > type MyApi = "view-my-referer" :> Header "Referer" Referer :> Get '[JSON] Referer+-- >+-- > myApi :: Proxy MyApi+-- > myApi = Proxy+-- >+-- > viewReferer :: Maybe Referer -> ClientM Book+-- > 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 m api, SBoolI (FoldRequired mods))+      => HasClient m (Header' mods sym a :> api) where++  type Client m (Header' mods sym a :> api) =+    RequiredArgument mods a -> Client m api++  clientWithRoute pm Proxy req mval =+    clientWithRoute pm (Proxy :: Proxy api) $ foldRequiredArgument+      (Proxy :: Proxy mods) add (maybe req add) mval+    where+      hname = fromString $ symbolVal (Proxy :: Proxy sym)++      add :: a -> Request+      add value = addHeader hname value req++  hoistClientMonad pm _ f cl = \arg ->+    hoistClientMonad pm (Proxy :: Proxy api) f (cl arg)++-- | Using a 'HttpVersion' combinator in your API doesn't affect the client+-- functions.+instance HasClient m api+  => HasClient m (HttpVersion :> api) where++  type Client m (HttpVersion :> api) =+    Client m api++  clientWithRoute pm Proxy =+    clientWithRoute pm (Proxy :: Proxy api)++  hoistClientMonad pm _ f cl = hoistClientMonad pm (Proxy :: Proxy api) f cl++-- | Ignore @'Summary'@ in client functions.+instance HasClient m api => HasClient m (Summary desc :> api) where+  type Client m (Summary desc :> api) = Client m api++  clientWithRoute pm _ = clientWithRoute pm (Proxy :: Proxy api)++  hoistClientMonad pm _ f cl = hoistClientMonad pm (Proxy :: Proxy api) f cl++-- | Ignore @'Description'@ in client functions.+instance HasClient m api => HasClient m (Description desc :> api) where+  type Client m (Description desc :> api) = Client m api++  clientWithRoute pm _ = clientWithRoute pm (Proxy :: Proxy api)++  hoistClientMonad pm _ f cl = hoistClientMonad pm (Proxy :: Proxy api) f cl++-- | 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 'ToHttpApiData' instance for your type.+--+-- Example:+--+-- > type MyApi = "books" :> QueryParam "author" Text :> Get '[JSON] [Book]+-- >+-- > myApi :: Proxy MyApi+-- > myApi = Proxy+-- >+-- > getBooksBy :: Maybe Text -> ClientM [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, ToHttpApiData a, HasClient m api, SBoolI (FoldRequired mods))+      => HasClient m (QueryParam' mods sym a :> api) where++  type Client m (QueryParam' mods sym a :> api) =+    RequiredArgument mods a -> Client m api++  -- if mparam = Nothing, we don't add it to the query string+  clientWithRoute pm Proxy req mparam =+    clientWithRoute pm (Proxy :: Proxy api) $ foldRequiredArgument+      (Proxy :: Proxy mods) add (maybe req add) mparam+    where+      add :: a -> Request+      add param = appendToQueryString pname (Just $ toQueryParam param) req++      pname :: Text+      pname  = pack $ symbolVal (Proxy :: Proxy sym)++  hoistClientMonad pm _ f cl = \arg ->+    hoistClientMonad pm (Proxy :: Proxy api) f (cl arg)++-- | 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 'ToHttpApiData' instance for your type.+--+-- Example:+--+-- > type MyApi = "books" :> QueryParams "authors" Text :> Get '[JSON] [Book]+-- >+-- > myApi :: Proxy MyApi+-- > myApi = Proxy+-- >+-- > getBooksBy :: [Text] -> ClientM [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, ToHttpApiData a, HasClient m api)+      => HasClient m (QueryParams sym a :> api) where++  type Client m (QueryParams sym a :> api) =+    [a] -> Client m api++  clientWithRoute pm Proxy req paramlist =+    clientWithRoute pm (Proxy :: Proxy api)+                    (foldl' (\ req' -> maybe req' (flip (appendToQueryString pname) req' . Just))+                            req+                            paramlist'+                    )++    where pname = pack $ symbolVal (Proxy :: Proxy sym)+          paramlist' = map (Just . toQueryParam) paramlist++  hoistClientMonad pm _ f cl = \as ->+    hoistClientMonad pm (Proxy :: Proxy api) f (cl as)++-- | 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 '[JSON] [Book]+-- >+-- > myApi :: Proxy MyApi+-- > myApi = Proxy+-- >+-- > getBooks :: Bool -> ClientM [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 m api)+      => HasClient m (QueryFlag sym :> api) where++  type Client m (QueryFlag sym :> api) =+    Bool -> Client m api++  clientWithRoute pm Proxy req flag =+    clientWithRoute pm (Proxy :: Proxy api)+                    (if flag+                       then appendToQueryString paramname Nothing req+                       else req+                    )++    where paramname = pack $ symbolVal (Proxy :: Proxy sym)++  hoistClientMonad pm _ f cl = \b ->+    hoistClientMonad pm (Proxy :: Proxy api) f (cl b)++-- | Pick a 'Method' and specify where the server you want to query is. You get+-- back the full `Response`.+instance RunClient m => HasClient m Raw where+  type Client m Raw+    = H.Method ->  m Response++  clientWithRoute :: Proxy m -> Proxy Raw -> Request -> Client m Raw+  clientWithRoute _pm Proxy req httpMethod = do+    runRequest req { requestMethod = httpMethod }++  hoistClientMonad _ _ f cl = \meth -> f (cl meth)++-- | 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 '[JSON] Book :> Post '[JSON] Book+-- >+-- > myApi :: Proxy MyApi+-- > myApi = Proxy+-- >+-- > addBook :: Book -> ClientM Book+-- > addBook = client myApi+-- > -- then you can just use "addBook" to query that endpoint+instance (MimeRender ct a, HasClient m api)+      => HasClient m (ReqBody' mods (ct ': cts) a :> api) where++  type Client m (ReqBody' mods (ct ': cts) a :> api) =+    a -> Client m api++  clientWithRoute pm Proxy req body =+    clientWithRoute pm (Proxy :: Proxy api)+                    (let ctProxy = Proxy :: Proxy ct+                     in setRequestBodyLBS (mimeRender ctProxy body)+                                          -- We use first contentType from the Accept list+                                          (contentType ctProxy)+                                          req+                    )++  hoistClientMonad pm _ f cl = \a ->+    hoistClientMonad pm (Proxy :: Proxy api) f (cl a)++instance+    ( HasClient m api, MimeRender ctype chunk, FramingRender framing, ToSourceIO chunk a+    ) => HasClient m (StreamBody' mods framing ctype a :> api)+  where++    type Client m (StreamBody' mods framing ctype a :> api) = a -> Client m api++    hoistClientMonad pm _ f cl = \a ->+      hoistClientMonad pm (Proxy :: Proxy api) f (cl a)++    clientWithRoute pm Proxy req body+        = clientWithRoute pm (Proxy :: Proxy api)+        $ setRequestBody (RequestBodySource sourceIO) (contentType ctypeP) req+      where+        ctypeP   = Proxy :: Proxy ctype+        framingP = Proxy :: Proxy framing++        sourceIO = framingRender+            framingP+            (mimeRender ctypeP :: chunk -> BL.ByteString)+            (toSourceIO body)++-- | Make the querying function append @path@ to the request path.+instance (KnownSymbol path, HasClient m api) => HasClient m (path :> api) where+  type Client m (path :> api) = Client m api++  clientWithRoute pm Proxy req =+     clientWithRoute pm (Proxy :: Proxy api)+                     (appendToPath p req)++    where p = pack $ symbolVal (Proxy :: Proxy path)++  hoistClientMonad pm _ f cl = hoistClientMonad pm (Proxy :: Proxy api) f cl++instance HasClient m api => HasClient m (Vault :> api) where+  type Client m (Vault :> api) = Client m api++  clientWithRoute pm Proxy req =+    clientWithRoute pm (Proxy :: Proxy api) req++  hoistClientMonad pm _ f cl = hoistClientMonad pm (Proxy :: Proxy api) f cl++instance HasClient m api => HasClient m (RemoteHost :> api) where+  type Client m (RemoteHost :> api) = Client m api++  clientWithRoute pm Proxy req =+    clientWithRoute pm (Proxy :: Proxy api) req++  hoistClientMonad pm _ f cl = hoistClientMonad pm (Proxy :: Proxy api) f cl++instance HasClient m api => HasClient m (IsSecure :> api) where+  type Client m (IsSecure :> api) = Client m api++  clientWithRoute pm Proxy req =+    clientWithRoute pm (Proxy :: Proxy api) req++  hoistClientMonad pm _ f cl = hoistClientMonad pm (Proxy :: Proxy api) f cl++instance HasClient m subapi =>+  HasClient m (WithNamedContext name context subapi) where++  type Client m (WithNamedContext name context subapi) = Client m subapi+  clientWithRoute pm Proxy = clientWithRoute pm (Proxy :: Proxy subapi)++  hoistClientMonad pm _ f cl = hoistClientMonad pm (Proxy :: Proxy subapi) f cl++instance ( HasClient m api+         ) => HasClient m (AuthProtect tag :> api) where+  type Client m (AuthProtect tag :> api)+    = AuthenticatedRequest (AuthProtect tag) -> Client m api++  clientWithRoute pm Proxy req (AuthenticatedRequest (val,func)) =+    clientWithRoute pm (Proxy :: Proxy api) (func val req)++  hoistClientMonad pm _ f cl = \authreq ->+    hoistClientMonad pm (Proxy :: Proxy api) f (cl authreq)++-- * Basic Authentication++instance HasClient m api => HasClient m (BasicAuth realm usr :> api) where+  type Client m (BasicAuth realm usr :> api) = BasicAuthData -> Client m api++  clientWithRoute pm Proxy req val =+    clientWithRoute pm (Proxy :: Proxy api) (basicAuthReq val req)++  hoistClientMonad pm _ f cl = \bauth ->+    hoistClientMonad pm (Proxy :: Proxy api) f (cl bauth)++++{- Note [Non-Empty Content Types]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+Rather than have++   instance (..., cts' ~ (ct ': cts)) => ... cts' ...++It may seem to make more sense to have:++   instance (...) => ... (ct ': cts) ...++But this means that if another instance exists that does *not* require+non-empty lists, but is otherwise more specific, no instance will be overall+more specific. This in turn generally means adding yet another instance (one+for empty and one for non-empty lists).+-}++-------------------------------------------------------------------------------+-- helpers+-------------------------------------------------------------------------------++checkContentTypeHeader :: RunClient m => Response -> m MediaType+checkContentTypeHeader response =+  case lookup "Content-Type" $ toList $ responseHeaders response of+    Nothing -> return $ "application"//"octet-stream"+    Just t -> case parseAccept t of+      Nothing -> throwClientError $ InvalidContentTypeHeader response+      Just t' -> return t'++decodedAs :: forall ct a m. (MimeUnrender ct a, RunClient m)+  => Response -> Proxy ct -> m a+decodedAs response ct = do+  responseContentType <- checkContentTypeHeader response+  unless (any (matches responseContentType) accept) $+    throwClientError $ UnsupportedContentType responseContentType response+  case mimeUnrender ct $ responseBody response of+    Left err -> throwClientError $ DecodeFailure (T.pack err) response+    Right val -> return val+  where+    accept = toList $ contentTypes ct 

@@ -0,0 +1,12 @@+module Servant.Client.Core.Internal where++import           Control.DeepSeq+                 (rnf)+import           Network.HTTP.Media+                 (MediaType, mainType, parameters, subType)++mediaTypeRnf :: MediaType -> ()+mediaTypeRnf mt =+    rnf (mainType mt) `seq`+    rnf (subType mt) `seq`+    rnf (parameters mt)

@@ -1,33 +0,0 @@-{-# LANGUAGE OverloadedStrings    #-}-{-# LANGUAGE TypeFamilies         #-}-{-# LANGUAGE TypeSynonymInstances #-}---- | Authentication for clients--module Servant.Client.Core.Internal.Auth where--import           Servant.Client.Core.Internal.Request-                 (Request)---- | For a resource protected by authentication (e.g. AuthProtect), we need--- to provide the client with some data used to add authentication data--- to a request------ NOTE: THIS API IS EXPERIMENTAL AND SUBJECT TO CHANGE-type family AuthClientData a :: *---- | For better type inference and to avoid usage of a data family, we newtype--- wrap the combination of some 'AuthClientData' and a function to add authentication--- data to a request------ NOTE: THIS API IS EXPERIMENTAL AND SUBJECT TO CHANGE-newtype AuthenticatedRequest a =-  AuthenticatedRequest { unAuthReq :: (AuthClientData a, AuthClientData a -> Request -> Request) }---- | Handy helper to avoid wrapping datatypes in tuples everywhere.------ NOTE: THIS API IS EXPERIMENTAL AND SUBJECT TO CHANGE-mkAuthenticatedRequest :: AuthClientData a-                  -> (AuthClientData a -> Request -> Request)-                  -> AuthenticatedRequest a-mkAuthenticatedRequest val func = AuthenticatedRequest (val, func)

@@ -1,133 +0,0 @@-{-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE DeriveGeneric      #-}-{-# LANGUAGE DeriveLift         #-}-{-# LANGUAGE ViewPatterns       #-}-module Servant.Client.Core.Internal.BaseUrl where--import           Control.Monad.Catch-                 (Exception, MonadThrow, throwM)-import           Data.Aeson-                 (FromJSON (..), FromJSONKey (..), ToJSON (..), ToJSONKey (..))-import           Data.Aeson.Types-                 (FromJSONKeyFunction (..), contramapToJSONKeyFunction,-                 withText)-import           Data.Data-                 (Data)-import           Data.List-import qualified Data.Text                  as T-import           GHC.Generics-import           Language.Haskell.TH.Syntax-                 (Lift)-import           Network.URI                hiding-                 (path)-import           Safe-import           Text.Read---- | URI scheme to use-data Scheme =-    Http  -- ^ http://-  | Https -- ^ https://-  deriving (Show, Eq, Ord, Generic, Lift, Data)---- | 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)-  , baseUrlPath   :: String   -- ^ path (eg "/a/b/c")-  } deriving (Show, Ord, Generic, Lift, Data)--- TODO: Ord is more precise than Eq--- TODO: Add Hashable instance?--instance Eq BaseUrl where-    BaseUrl a b c path == BaseUrl a' b' c' path'-        = a == a' && b == b' && c == c' && s path == s path'-        where s ('/':x) = x-              s x       = x---- | >>> traverse_ (LBS8.putStrLn . encode) $ parseBaseUrl "api.example.com"--- "http://api.example.com"-instance ToJSON BaseUrl where-    toJSON     = toJSON . showBaseUrl-    toEncoding = toEncoding . showBaseUrl---- | >>> parseBaseUrl "api.example.com" >>= decode . encode :: Maybe BaseUrl--- Just (BaseUrl {baseUrlScheme = Http, baseUrlHost = "api.example.com", baseUrlPort = 80, baseUrlPath = ""})-instance FromJSON BaseUrl where-    parseJSON = withText "BaseUrl" $ \t -> case parseBaseUrl (T.unpack t) of-        Just u  -> return u-        Nothing -> fail $ "Invalid base url: " ++ T.unpack t---- | >>> :{--- traverse_ (LBS8.putStrLn . encode) $ do---   u1 <- parseBaseUrl "api.example.com"---   u2 <- parseBaseUrl "example.com"---   return $ Map.fromList [(u1, 'x'), (u2, 'y')]--- :}--- {"http://api.example.com":"x","http://example.com":"y"}-instance ToJSONKey BaseUrl where-    toJSONKey = contramapToJSONKeyFunction showBaseUrl toJSONKey--instance FromJSONKey BaseUrl where-    fromJSONKey = FromJSONKeyTextParser $ \t -> case parseBaseUrl (T.unpack t) of-        Just u  -> return u-        Nothing -> fail $ "Invalid base url: " ++ T.unpack t---- | >>> showBaseUrl <$> parseBaseUrl "api.example.com"--- "http://api.example.com"-showBaseUrl :: BaseUrl -> String-showBaseUrl (BaseUrl urlscheme host port path) =-  schemeString ++ "//" ++ host ++ (portString </> path)-    where-      a </> b = if "/" `isPrefixOf` b || null b then a ++ b else a ++ '/':b-      schemeString = case urlscheme of-        Http  -> "http:"-        Https -> "https:"-      portString = case (urlscheme, port) of-        (Http, 80) -> ""-        (Https, 443) -> ""-        _ -> ":" ++ show port--newtype InvalidBaseUrlException = InvalidBaseUrlException String deriving (Show)-instance Exception InvalidBaseUrlException---- |------ >>> parseBaseUrl "api.example.com"--- BaseUrl {baseUrlScheme = Http, baseUrlHost = "api.example.com", baseUrlPort = 80, baseUrlPath = ""}------ /Note:/ trailing slash is removed------ >>> parseBaseUrl "api.example.com/"--- BaseUrl {baseUrlScheme = Http, baseUrlHost = "api.example.com", baseUrlPort = 80, baseUrlPath = ""}------ >>> parseBaseUrl "api.example.com/dir/"--- BaseUrl {baseUrlScheme = Http, baseUrlHost = "api.example.com", baseUrlPort = 80, baseUrlPath = "/dir"}----parseBaseUrl :: MonadThrow m => String -> m 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)))) path "" "") ->-    return (BaseUrl Http host port path)-  Just (URI "http:" (Just (URIAuth "" host "")) path "" "") ->-    return (BaseUrl Http host 80 path)-  Just (URI "https:" (Just (URIAuth "" host (':' : (readMaybe -> Just port)))) path "" "") ->-    return (BaseUrl Https host port path)-  Just (URI "https:" (Just (URIAuth "" host "")) path "" "") ->-    return (BaseUrl Https host 443 path)-  _ -> if "://" `isInfixOf` s-    then throwM (InvalidBaseUrlException $ "Invalid base URL: " ++ s)-    else parseBaseUrl ("http://" ++ s)- where-  removeTrailingSlash str = case lastMay str of-    Just '/' -> init str-    _ -> str---- $setup------ >>> import Data.Aeson--- >>> import Data.Foldable (traverse_)--- >>> import qualified Data.ByteString.Lazy.Char8 as LBS8--- >>> import qualified Data.Map.Strict as Map

@@ -1,24 +0,0 @@-{-# LANGUAGE OverloadedStrings    #-}-{-# LANGUAGE TypeFamilies         #-}-{-# LANGUAGE TypeSynonymInstances #-}---- | Basic Authentication for clients--module Servant.Client.Core.Internal.BasicAuth where--import           Data.ByteString.Base64-                 (encode)-import           Data.Monoid-                 ((<>))-import           Data.Text.Encoding-                 (decodeUtf8)-import           Servant.API.BasicAuth-                 (BasicAuthData (BasicAuthData))-import           Servant.Client.Core.Internal.Request-                 (Request, addHeader)---- | Authenticate a request using Basic Authentication-basicAuthReq :: BasicAuthData -> Request -> Request-basicAuthReq (BasicAuthData user pass) req =-    let authText = decodeUtf8 ("Basic " <> encode (user <> ":" <> pass))-    in addHeader "Authorization" authText req

@@ -1,10 +0,0 @@-{-# LANGUAGE DeriveFunctor #-}-module Servant.Client.Core.Internal.ClientF where--import           Servant.Client.Core.Internal.Request--data ClientF a-    = RunRequest Request (Response -> a)-    | StreamingRequest Request (StreamingResponse -> a)-    | Throw ServantError-  deriving (Functor)

@@ -1,155 +0,0 @@-{-# LANGUAGE DataKinds             #-}-{-# LANGUAGE DefaultSignatures     #-}-{-# LANGUAGE FlexibleContexts      #-}-{-# LANGUAGE FlexibleInstances     #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE TypeFamilies          #-}-{-# LANGUAGE TypeOperators         #-}-{-# LANGUAGE UndecidableInstances  #-}--module Servant.Client.Core.Internal.Generic where--import           Generics.SOP-                 (Code, Generic, I (..), NP (..), NS (Z), SOP (..), to)-import           Servant.API-                 ((:<|>) (..))---- | 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---- | 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-

@@ -1,633 +0,0 @@-{-# LANGUAGE DataKinds             #-}-{-# LANGUAGE FlexibleContexts      #-}-{-# LANGUAGE FlexibleInstances     #-}-{-# LANGUAGE InstanceSigs          #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE OverloadedStrings     #-}-{-# LANGUAGE PolyKinds             #-}-{-# LANGUAGE RankNTypes            #-}-{-# LANGUAGE ScopedTypeVariables   #-}-{-# LANGUAGE TypeFamilies          #-}-{-# LANGUAGE TypeOperators         #-}-{-# LANGUAGE UndecidableInstances  #-}--module Servant.Client.Core.Internal.HasClient where--import           Prelude ()-import           Prelude.Compat--import qualified Data.ByteString                        as BS-import qualified Data.ByteString.Lazy                   as BL-import           Data.Foldable-                 (toList)-import           Data.List-                 (foldl')-import           Data.Proxy-                 (Proxy (Proxy))-import           Data.Sequence-                 (fromList)-import           Data.String-                 (fromString)-import           Data.Text-                 (Text, pack)-import           GHC.TypeLits-                 (KnownSymbol, symbolVal)-import qualified Network.HTTP.Types                     as H-import           Servant.API-                 ((:<|>) ((:<|>)), (:>), AuthProtect, BasicAuth, BasicAuthData,-                 BuildHeadersTo (..), Capture', CaptureAll, Description,-                 EmptyAPI, FramingUnrender (..), FromSourceIO (..), Header',-                 Headers (..), HttpVersion, IsSecure, MimeRender (mimeRender),-                 MimeUnrender (mimeUnrender), NoContent (NoContent), QueryFlag,-                 QueryParam', QueryParams, Raw, ReflectMethod (..), RemoteHost,-                 ReqBody', SBoolI, Stream, StreamBody', Summary, ToHttpApiData,-                 Vault, Verb, WithNamedContext, contentType, getHeadersHList,-                 getResponse, toQueryParam, toUrlPiece)-import           Servant.API.ContentTypes-                 (contentTypes)-import           Servant.API.Modifiers-                 (FoldRequired, RequiredArgument, foldRequiredArgument)-import qualified Servant.Types.SourceT                  as S--import           Servant.Client.Core.Internal.Auth-import           Servant.Client.Core.Internal.BasicAuth-import           Servant.Client.Core.Internal.Request-import           Servant.Client.Core.Internal.RunClient---- * Accessing APIs as a Client---- | 'clientIn' allows you to produce operations to query an API from a client--- within a 'RunClient' monad.------ > type MyApi = "books" :> Get '[JSON] [Book] -- GET /books--- >         :<|> "books" :> ReqBody '[JSON] Book :> Post '[JSON] Book -- POST /books--- >--- > myApi :: Proxy MyApi--- > myApi = Proxy--- >--- > clientM :: Proxy ClientM--- > clientM = Proxy--- >--- > getAllBooks :: ClientM [Book]--- > postNewBook :: Book -> ClientM Book--- > (getAllBooks :<|> postNewBook) = myApi `clientIn` clientM-clientIn :: HasClient m api => Proxy api -> Proxy m -> Client m api-clientIn p pm = clientWithRoute pm p defaultRequest----- | This class lets us define how each API combinator influences the creation--- of an HTTP request.------ Unless you are writing a new backend for @servant-client-core@ or new--- combinators that you want to support client-generation, you can ignore this--- class.-class RunClient m => HasClient m api where-  type Client (m :: * -> *) (api :: *) :: *-  clientWithRoute :: Proxy m -> Proxy api -> Request -> Client m api-  hoistClientMonad-    :: Proxy m-    -> Proxy api-    -> (forall x. mon x -> mon' x)-    -> Client mon api-    -> Client mon' api----- | 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 '[JSON] [Book] -- GET /books--- >         :<|> "books" :> ReqBody '[JSON] Book :> Post Book -- POST /books--- >--- > myApi :: Proxy MyApi--- > myApi = Proxy--- >--- > getAllBooks :: ClientM [Book]--- > postNewBook :: Book -> ClientM Book--- > (getAllBooks :<|> postNewBook) = client myApi-instance (HasClient m a, HasClient m b) => HasClient m (a :<|> b) where-  type Client m (a :<|> b) = Client m a :<|> Client m b-  clientWithRoute pm Proxy req =-    clientWithRoute pm (Proxy :: Proxy a) req :<|>-    clientWithRoute pm (Proxy :: Proxy b) req--  hoistClientMonad pm _ f (ca :<|> cb) =-    hoistClientMonad pm (Proxy :: Proxy a) f ca :<|>-    hoistClientMonad pm (Proxy :: Proxy b) f cb---- | 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 RunClient m => HasClient m EmptyAPI where-  type Client m EmptyAPI = EmptyClient-  clientWithRoute _pm Proxy _ = EmptyClient-  hoistClientMonad _ _ _ EmptyClient = 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'.--- 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 'ToHttpApiData' instance for your type.------ Example:------ > type MyApi = "books" :> Capture "isbn" Text :> Get '[JSON] Book--- >--- > myApi :: Proxy MyApi--- > myApi = Proxy--- >--- > getBook :: Text -> ClientM Book--- > getBook = client myApi--- > -- then you can just use "getBook" to query that endpoint-instance (KnownSymbol capture, ToHttpApiData a, HasClient m api)-      => HasClient m (Capture' mods capture a :> api) where--  type Client m (Capture' mods capture a :> api) =-    a -> Client m api--  clientWithRoute pm Proxy req val =-    clientWithRoute pm (Proxy :: Proxy api)-                    (appendToPath p req)--    where p = (toUrlPiece val)--  hoistClientMonad pm _ f cl = \a ->-    hoistClientMonad pm (Proxy :: Proxy api) f (cl a)---- | If you use a 'CaptureAll' in one of your endpoints in your API,--- the corresponding querying function will automatically take an--- additional argument of a list of the type specified by your--- 'CaptureAll'. 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 these values are turned into text by specifying--- a 'ToHttpApiData' instance of your type.------ Example:------ > type MyAPI = "src" :> CaptureAll Text -> Get '[JSON] SourceFile--- >--- > myApi :: Proxy--- > myApi = Proxy------ > getSourceFile :: [Text] -> ClientM SourceFile--- > getSourceFile = client myApi--- > -- then you can use "getSourceFile" to query that endpoint-instance (KnownSymbol capture, ToHttpApiData a, HasClient m sublayout)-      => HasClient m (CaptureAll capture a :> sublayout) where--  type Client m (CaptureAll capture a :> sublayout) =-    [a] -> Client m sublayout--  clientWithRoute pm Proxy req vals =-    clientWithRoute pm (Proxy :: Proxy sublayout)-                    (foldl' (flip appendToPath) req ps)--    where ps = map (toUrlPiece) vals--  hoistClientMonad pm _ f cl = \as ->-    hoistClientMonad pm (Proxy :: Proxy sublayout) f (cl as)--instance {-# OVERLAPPABLE #-}-  -- Note [Non-Empty Content Types]-  ( RunClient m, MimeUnrender ct a, ReflectMethod method, cts' ~ (ct ': cts)-  ) => HasClient m (Verb method status cts' a) where-  type Client m (Verb method status cts' a) = m a-  clientWithRoute _pm Proxy req = do-    response <- runRequest req-      { requestAccept = fromList $ toList accept-      , requestMethod = method-      }-    response `decodedAs` (Proxy :: Proxy ct)-    where-      accept = contentTypes (Proxy :: Proxy ct)-      method = reflectMethod (Proxy :: Proxy method)--  hoistClientMonad _ _ f ma = f ma--instance {-# OVERLAPPING #-}-  ( RunClient m, ReflectMethod method-  ) => HasClient m (Verb method status cts NoContent) where-  type Client m (Verb method status cts NoContent)-    = m NoContent-  clientWithRoute _pm Proxy req = do-    _response <- runRequest req { requestMethod = method }-    return NoContent-      where method = reflectMethod (Proxy :: Proxy method)--  hoistClientMonad _ _ f ma = f ma--instance {-# OVERLAPPING #-}-  -- Note [Non-Empty Content Types]-  ( RunClient m, MimeUnrender ct a, BuildHeadersTo ls-  , ReflectMethod method, cts' ~ (ct ': cts)-  ) => HasClient m (Verb method status cts' (Headers ls a)) where-  type Client m (Verb method status cts' (Headers ls a))-    = m (Headers ls a)-  clientWithRoute _pm Proxy req = do-    response <- runRequest req-       { requestMethod = method-       , requestAccept = fromList $ toList accept-       }-    case mimeUnrender (Proxy :: Proxy ct) $ responseBody response of-      Left err -> throwServantError $ DecodeFailure (pack err) response-      Right val -> return $ Headers-        { getResponse = val-        , getHeadersHList = buildHeadersTo . toList $ responseHeaders response-        }-      where method = reflectMethod (Proxy :: Proxy method)-            accept = contentTypes (Proxy :: Proxy ct)--  hoistClientMonad _ _ f ma = f ma--instance {-# OVERLAPPING #-}-  ( RunClient m, BuildHeadersTo ls, ReflectMethod method-  ) => HasClient m (Verb method status cts (Headers ls NoContent)) where-  type Client m (Verb method status cts (Headers ls NoContent))-    = m (Headers ls NoContent)-  clientWithRoute _pm Proxy req = do-    let method = reflectMethod (Proxy :: Proxy method)-    response <- runRequest req { requestMethod = method }-    return $ Headers { getResponse = NoContent-                     , getHeadersHList = buildHeadersTo . toList $ responseHeaders response-                     }--  hoistClientMonad _ _ f ma = f ma--instance {-# OVERLAPPABLE #-}-  ( RunStreamingClient m, MimeUnrender ct chunk, ReflectMethod method,-    FramingUnrender framing, FromSourceIO chunk a-  ) => HasClient m (Stream method status framing ct a) where--  type Client m (Stream method status framing ct a) = m a--  hoistClientMonad _ _ f ma = f ma--  clientWithRoute _pm Proxy req = withStreamingRequest req' $ \gres -> do-      let mimeUnrender'    = mimeUnrender (Proxy :: Proxy ct) :: BL.ByteString -> Either String chunk-          framingUnrender' = framingUnrender (Proxy :: Proxy framing) mimeUnrender'-      return $ fromSourceIO $ framingUnrender' $ S.fromAction BS.null (responseBody gres)-    where-      req' = req-          { requestAccept = fromList [contentType (Proxy :: Proxy ct)]-          , requestMethod = reflectMethod (Proxy :: Proxy method)-          }---- | 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 'ToHttpApiData' instance.------ Example:------ > newtype Referer = Referer { referrer :: Text }--- >   deriving (Eq, Show, Generic, ToHttpApiData)--- >--- >            -- GET /view-my-referer--- > type MyApi = "view-my-referer" :> Header "Referer" Referer :> Get '[JSON] Referer--- >--- > myApi :: Proxy MyApi--- > myApi = Proxy--- >--- > viewReferer :: Maybe Referer -> ClientM Book--- > 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 m api, SBoolI (FoldRequired mods))-      => HasClient m (Header' mods sym a :> api) where--  type Client m (Header' mods sym a :> api) =-    RequiredArgument mods a -> Client m api--  clientWithRoute pm Proxy req mval =-    clientWithRoute pm (Proxy :: Proxy api) $ foldRequiredArgument-      (Proxy :: Proxy mods) add (maybe req add) mval-    where-      hname = fromString $ symbolVal (Proxy :: Proxy sym)--      add :: a -> Request-      add value = addHeader hname value req--  hoistClientMonad pm _ f cl = \arg ->-    hoistClientMonad pm (Proxy :: Proxy api) f (cl arg)---- | Using a 'HttpVersion' combinator in your API doesn't affect the client--- functions.-instance HasClient m api-  => HasClient m (HttpVersion :> api) where--  type Client m (HttpVersion :> api) =-    Client m api--  clientWithRoute pm Proxy =-    clientWithRoute pm (Proxy :: Proxy api)--  hoistClientMonad pm _ f cl = hoistClientMonad pm (Proxy :: Proxy api) f cl---- | Ignore @'Summary'@ in client functions.-instance HasClient m api => HasClient m (Summary desc :> api) where-  type Client m (Summary desc :> api) = Client m api--  clientWithRoute pm _ = clientWithRoute pm (Proxy :: Proxy api)--  hoistClientMonad pm _ f cl = hoistClientMonad pm (Proxy :: Proxy api) f cl---- | Ignore @'Description'@ in client functions.-instance HasClient m api => HasClient m (Description desc :> api) where-  type Client m (Description desc :> api) = Client m api--  clientWithRoute pm _ = clientWithRoute pm (Proxy :: Proxy api)--  hoistClientMonad pm _ f cl = hoistClientMonad pm (Proxy :: Proxy api) f cl---- | 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 'ToHttpApiData' instance for your type.------ Example:------ > type MyApi = "books" :> QueryParam "author" Text :> Get '[JSON] [Book]--- >--- > myApi :: Proxy MyApi--- > myApi = Proxy--- >--- > getBooksBy :: Maybe Text -> ClientM [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, ToHttpApiData a, HasClient m api, SBoolI (FoldRequired mods))-      => HasClient m (QueryParam' mods sym a :> api) where--  type Client m (QueryParam' mods sym a :> api) =-    RequiredArgument mods a -> Client m api--  -- if mparam = Nothing, we don't add it to the query string-  clientWithRoute pm Proxy req mparam =-    clientWithRoute pm (Proxy :: Proxy api) $ foldRequiredArgument-      (Proxy :: Proxy mods) add (maybe req add) mparam-    where-      add :: a -> Request-      add param = appendToQueryString pname (Just $ toQueryParam param) req--      pname :: Text-      pname  = pack $ symbolVal (Proxy :: Proxy sym)--  hoistClientMonad pm _ f cl = \arg ->-    hoistClientMonad pm (Proxy :: Proxy api) f (cl arg)---- | 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 'ToHttpApiData' instance for your type.------ Example:------ > type MyApi = "books" :> QueryParams "authors" Text :> Get '[JSON] [Book]--- >--- > myApi :: Proxy MyApi--- > myApi = Proxy--- >--- > getBooksBy :: [Text] -> ClientM [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, ToHttpApiData a, HasClient m api)-      => HasClient m (QueryParams sym a :> api) where--  type Client m (QueryParams sym a :> api) =-    [a] -> Client m api--  clientWithRoute pm Proxy req paramlist =-    clientWithRoute pm (Proxy :: Proxy api)-                    (foldl' (\ req' -> maybe req' (flip (appendToQueryString pname) req' . Just))-                            req-                            paramlist'-                    )--    where pname = pack $ symbolVal (Proxy :: Proxy sym)-          paramlist' = map (Just . toQueryParam) paramlist--  hoistClientMonad pm _ f cl = \as ->-    hoistClientMonad pm (Proxy :: Proxy api) f (cl as)---- | 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 '[JSON] [Book]--- >--- > myApi :: Proxy MyApi--- > myApi = Proxy--- >--- > getBooks :: Bool -> ClientM [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 m api)-      => HasClient m (QueryFlag sym :> api) where--  type Client m (QueryFlag sym :> api) =-    Bool -> Client m api--  clientWithRoute pm Proxy req flag =-    clientWithRoute pm (Proxy :: Proxy api)-                    (if flag-                       then appendToQueryString paramname Nothing req-                       else req-                    )--    where paramname = pack $ symbolVal (Proxy :: Proxy sym)--  hoistClientMonad pm _ f cl = \b ->-    hoistClientMonad pm (Proxy :: Proxy api) f (cl b)---- | Pick a 'Method' and specify where the server you want to query is. You get--- back the full `Response`.-instance RunClient m => HasClient m Raw where-  type Client m Raw-    = H.Method ->  m Response--  clientWithRoute :: Proxy m -> Proxy Raw -> Request -> Client m Raw-  clientWithRoute _pm Proxy req httpMethod = do-    runRequest req { requestMethod = httpMethod }--  hoistClientMonad _ _ f cl = \meth -> f (cl meth)---- | 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 '[JSON] Book :> Post '[JSON] Book--- >--- > myApi :: Proxy MyApi--- > myApi = Proxy--- >--- > addBook :: Book -> ClientM Book--- > addBook = client myApi--- > -- then you can just use "addBook" to query that endpoint-instance (MimeRender ct a, HasClient m api)-      => HasClient m (ReqBody' mods (ct ': cts) a :> api) where--  type Client m (ReqBody' mods (ct ': cts) a :> api) =-    a -> Client m api--  clientWithRoute pm Proxy req body =-    clientWithRoute pm (Proxy :: Proxy api)-                    (let ctProxy = Proxy :: Proxy ct-                     in setRequestBodyLBS (mimeRender ctProxy body)-                                          -- We use first contentType from the Accept list-                                          (contentType ctProxy)-                                          req-                    )--  hoistClientMonad pm _ f cl = \a ->-    hoistClientMonad pm (Proxy :: Proxy api) f (cl a)--instance-    ( HasClient m api-    ) => HasClient m (StreamBody' mods framing ctype a :> api)-  where--    type Client m (StreamBody' mods framing ctype a :> api) = a -> Client m api--    hoistClientMonad pm _ f cl = \a ->-      hoistClientMonad pm (Proxy :: Proxy api) f (cl a)--    clientWithRoute _pm Proxy _req _body = error "HasClient @StreamBody"---- | Make the querying function append @path@ to the request path.-instance (KnownSymbol path, HasClient m api) => HasClient m (path :> api) where-  type Client m (path :> api) = Client m api--  clientWithRoute pm Proxy req =-     clientWithRoute pm (Proxy :: Proxy api)-                     (appendToPath p req)--    where p = pack $ symbolVal (Proxy :: Proxy path)--  hoistClientMonad pm _ f cl = hoistClientMonad pm (Proxy :: Proxy api) f cl--instance HasClient m api => HasClient m (Vault :> api) where-  type Client m (Vault :> api) = Client m api--  clientWithRoute pm Proxy req =-    clientWithRoute pm (Proxy :: Proxy api) req--  hoistClientMonad pm _ f cl = hoistClientMonad pm (Proxy :: Proxy api) f cl--instance HasClient m api => HasClient m (RemoteHost :> api) where-  type Client m (RemoteHost :> api) = Client m api--  clientWithRoute pm Proxy req =-    clientWithRoute pm (Proxy :: Proxy api) req--  hoistClientMonad pm _ f cl = hoistClientMonad pm (Proxy :: Proxy api) f cl--instance HasClient m api => HasClient m (IsSecure :> api) where-  type Client m (IsSecure :> api) = Client m api--  clientWithRoute pm Proxy req =-    clientWithRoute pm (Proxy :: Proxy api) req--  hoistClientMonad pm _ f cl = hoistClientMonad pm (Proxy :: Proxy api) f cl--instance HasClient m subapi =>-  HasClient m (WithNamedContext name context subapi) where--  type Client m (WithNamedContext name context subapi) = Client m subapi-  clientWithRoute pm Proxy = clientWithRoute pm (Proxy :: Proxy subapi)--  hoistClientMonad pm _ f cl = hoistClientMonad pm (Proxy :: Proxy subapi) f cl--instance ( HasClient m api-         ) => HasClient m (AuthProtect tag :> api) where-  type Client m (AuthProtect tag :> api)-    = AuthenticatedRequest (AuthProtect tag) -> Client m api--  clientWithRoute pm Proxy req (AuthenticatedRequest (val,func)) =-    clientWithRoute pm (Proxy :: Proxy api) (func val req)--  hoistClientMonad pm _ f cl = \authreq ->-    hoistClientMonad pm (Proxy :: Proxy api) f (cl authreq)---- * Basic Authentication--instance HasClient m api => HasClient m (BasicAuth realm usr :> api) where-  type Client m (BasicAuth realm usr :> api) = BasicAuthData -> Client m api--  clientWithRoute pm Proxy req val =-    clientWithRoute pm (Proxy :: Proxy api) (basicAuthReq val req)--  hoistClientMonad pm _ f cl = \bauth ->-    hoistClientMonad pm (Proxy :: Proxy api) f (cl bauth)---{- Note [Non-Empty Content Types]-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~-Rather than have--   instance (..., cts' ~ (ct ': cts)) => ... cts' ...--It may seem to make more sense to have:--   instance (...) => ... (ct ': cts) ...--But this means that if another instance exists that does *not* require-non-empty lists, but is otherwise more specific, no instance will be overall-more specific. This in turn generally means adding yet another instance (one-for empty and one for non-empty lists).--}

@@ -1,164 +0,0 @@-{-# LANGUAGE CPP                   #-}-{-# LANGUAGE DeriveDataTypeable    #-}-{-# LANGUAGE DeriveFoldable        #-}-{-# LANGUAGE DeriveFunctor         #-}-{-# LANGUAGE DeriveGeneric         #-}-{-# LANGUAGE DeriveTraversable     #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE OverloadedStrings     #-}-{-# LANGUAGE RankNTypes            #-}-{-# LANGUAGE ScopedTypeVariables   #-}-{-# LANGUAGE TypeFamilies          #-}--module Servant.Client.Core.Internal.Request where--import           Prelude ()-import           Prelude.Compat--import           Control.DeepSeq-                 (NFData (..))-import           Control.Monad.Catch-                 (Exception)-import qualified Data.ByteString         as BS-import qualified Data.ByteString.Builder as Builder-import qualified Data.ByteString.Lazy    as LBS-import           Data.Int-                 (Int64)-import           Data.Semigroup-                 ((<>))-import qualified Data.Sequence           as Seq-import           Data.Text-                 (Text)-import           Data.Text.Encoding-                 (encodeUtf8)-import           Data.Typeable-                 (Typeable)-import           GHC.Generics-                 (Generic)-import           Network.HTTP.Media-                 (MediaType, mainType, parameters, subType)-import           Network.HTTP.Types-                 (Header, HeaderName, HttpVersion (..), Method, QueryItem,-                 Status (..), http11, methodGet)-import           Servant.API-                 (ToHttpApiData, toEncodedUrlPiece, toHeader)---- | A type representing possible errors in a request------ Note that this type substantially changed in 0.12.-data ServantError =-  -- | The server returned an error response-    FailureResponse Response-  -- | The body could not be decoded at the expected type-  | DecodeFailure Text Response-  -- | The content-type of the response is not supported-  | UnsupportedContentType MediaType Response-  -- | The content-type header is invalid-  | InvalidContentTypeHeader Response-  -- | There was a connection error, and no response was received-  | ConnectionError Text-  deriving (Eq, Show, Generic, Typeable)--instance Exception ServantError--instance NFData ServantError where-    rnf (FailureResponse res)            = rnf res-    rnf (DecodeFailure err res)          = rnf err `seq` rnf res-    rnf (UnsupportedContentType mt' res) =-        mediaTypeRnf mt' `seq`-        rnf res-      where-        mediaTypeRnf mt =-            rnf (mainType mt) `seq`-            rnf (subType mt) `seq`-            rnf (parameters mt)-    rnf (InvalidContentTypeHeader res)   = rnf res-    rnf (ConnectionError err)            = rnf err--data RequestF a = Request-  { requestPath        :: a-  , requestQueryString :: Seq.Seq QueryItem-  , requestBody        :: Maybe (RequestBody, MediaType)-  , requestAccept      :: Seq.Seq MediaType-  , requestHeaders     :: Seq.Seq Header-  , requestHttpVersion :: HttpVersion-  , requestMethod      :: Method-  } deriving (Generic, Typeable)--type Request = RequestF Builder.Builder---- | The request body. A replica of the @http-client@ @RequestBody@.-data RequestBody-  = RequestBodyLBS LBS.ByteString-  | RequestBodyBS BS.ByteString-  | RequestBodyBuilder Int64 Builder.Builder-  | RequestBodyStream Int64 ((IO BS.ByteString -> IO ()) -> IO ())-  | RequestBodyStreamChunked ((IO BS.ByteString -> IO ()) -> IO ())-  | RequestBodyIO (IO RequestBody)-  deriving (Generic, Typeable)--data GenResponse a = Response-  { responseStatusCode  :: Status-  , responseHeaders     :: Seq.Seq Header-  , responseHttpVersion :: HttpVersion-  , responseBody        :: a-  } deriving (Eq, Show, Generic, Typeable, Functor, Foldable, Traversable)--instance NFData a => NFData (GenResponse a) where-    rnf (Response sc hs hv body) =-        rnfStatus sc `seq`-        rnf hs `seq`-        rnfHttpVersion hv `seq`-        rnf body-      where-        rnfStatus (Status code msg) = rnf code `seq` rnf msg-        rnfHttpVersion (HttpVersion _ _) = () -- HttpVersion fields are strict--type Response = GenResponse LBS.ByteString-type StreamingResponse = GenResponse (IO BS.ByteString)---- A GET request to the top-level path-defaultRequest :: Request-defaultRequest = Request-  { requestPath = ""-  , requestQueryString = Seq.empty-  , requestBody = Nothing-  , requestAccept = Seq.empty-  , requestHeaders = Seq.empty-  , requestHttpVersion = http11-  , requestMethod = methodGet-  }--appendToPath :: Text -> Request -> Request-appendToPath p req-  = req { requestPath = requestPath req <> "/" <> toEncodedUrlPiece p }--appendToQueryString :: Text       -- ^ param name-                    -> Maybe Text -- ^ param value-                    -> Request-                    -> Request-appendToQueryString pname pvalue req-  = req { requestQueryString = requestQueryString req-                        Seq.|> (encodeUtf8 pname, encodeUtf8 <$> pvalue)}--addHeader :: ToHttpApiData a => HeaderName -> a -> Request -> Request-addHeader name val req-  = req { requestHeaders = requestHeaders req Seq.|> (name, toHeader val)}---- | Set body and media type of the request being constructed.------ The body is set to the given bytestring using the 'RequestBodyLBS'--- constructor.------ @since 0.12----setRequestBodyLBS :: LBS.ByteString -> MediaType -> Request -> Request-setRequestBodyLBS b t req-  = req { requestBody = Just (RequestBodyLBS b, t) }---- | Set body and media type of the request being constructed.------ @since 0.12----setRequestBody :: RequestBody -> MediaType -> Request -> Request-setRequestBody b t req = req { requestBody = Just (b, t) }

@@ -1,67 +0,0 @@-{-# LANGUAGE FlexibleContexts      #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE OverloadedStrings     #-}-{-# LANGUAGE ScopedTypeVariables   #-}-{-# LANGUAGE TypeFamilies          #-}--- | Types for possible backends to run client-side `Request` queries-module Servant.Client.Core.Internal.RunClient where--import           Prelude ()-import           Prelude.Compat--import           Control.Monad-                 (unless)-import           Control.Monad.Free-                 (Free (..), liftF)-import           Data.Foldable-                 (toList)-import           Data.Proxy-                 (Proxy)-import qualified Data.Text                            as T-import           Network.HTTP.Media-                 (MediaType, matches, parseAccept, (//))-import           Servant.API-                 (MimeUnrender, contentTypes, mimeUnrender)--import           Servant.Client.Core.Internal.ClientF-import           Servant.Client.Core.Internal.Request-                 (GenResponse (..), Request, Response, ServantError (..),-                 StreamingResponse)--class Monad m => RunClient m where-  -- | How to make a request.-  runRequest :: Request -> m Response-  throwServantError :: ServantError -> m a--class RunClient m =>  RunStreamingClient m where-    withStreamingRequest :: Request -> (StreamingResponse -> IO a) ->  m a--checkContentTypeHeader :: RunClient m => Response -> m MediaType-checkContentTypeHeader response =-  case lookup "Content-Type" $ toList $ responseHeaders response of-    Nothing -> return $ "application"//"octet-stream"-    Just t -> case parseAccept t of-      Nothing -> throwServantError $ InvalidContentTypeHeader response-      Just t' -> return t'--decodedAs :: forall ct a m. (MimeUnrender ct a, RunClient m)-  => Response -> Proxy ct -> m a-decodedAs response contentType = do-  responseContentType <- checkContentTypeHeader response-  unless (any (matches responseContentType) accept) $-    throwServantError $ UnsupportedContentType responseContentType response-  case mimeUnrender contentType $ responseBody response of-    Left err -> throwServantError $ DecodeFailure (T.pack err) response-    Right val -> return val-  where-    accept = toList $ contentTypes contentType--instance ClientF ~ f => RunClient (Free f) where-    runRequest req  = liftF (RunRequest req id)-    throwServantError = liftF . Throw--{--Free and streaming?-instance ClientF ~ f => RunStreamingClient (Free f) where-    streamingRequest req = liftF (StreamingRequest req id)--}

@@ -9,13 +9,10 @@     -- * Response (for @Raw@)   , Response   , StreamingResponse-  , GenResponse(..)+  , ResponseF(..) -  -- * Generic Client-  , ClientLike(..)-  , genericMkClientL-  , genericMkClientP-  , ServantError(..)+  -- * Data types+  , ClientError(..)   , EmptyClient(..)    -- * BaseUrl@@ -27,7 +24,7 @@   ) where  -import           Servant.Client.Core.Internal.BaseUrl-import           Servant.Client.Core.Internal.Generic-import           Servant.Client.Core.Internal.HasClient-import           Servant.Client.Core.Internal.Request+import           Servant.Client.Core.BaseUrl+import           Servant.Client.Core.HasClient+import           Servant.Client.Core.Response+import           Servant.Client.Core.ClientError

@@ -0,0 +1,154 @@+{-# LANGUAGE DeriveDataTypeable    #-}+{-# LANGUAGE DeriveFoldable        #-}+{-# LANGUAGE DeriveFunctor         #-}+{-# LANGUAGE DeriveGeneric         #-}+{-# LANGUAGE DeriveTraversable     #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings     #-}+{-# LANGUAGE RankNTypes            #-}+{-# LANGUAGE ScopedTypeVariables   #-}+{-# LANGUAGE TypeFamilies          #-}+module Servant.Client.Core.Request (+    Request,+    RequestF (..),+    RequestBody (..),+    defaultRequest,+    -- ** Modifiers+    addHeader,+    appendToPath,+    appendToQueryString,+    setRequestBody,+    setRequestBodyLBS,+    ) where++import           Prelude ()+import           Prelude.Compat++import           Control.DeepSeq+                 (NFData (..))+import           Data.Bifoldable+                 (Bifoldable (..))+import           Data.Bifunctor+                 (Bifunctor (..))+import           Data.Bitraversable+                 (Bitraversable (..), bifoldMapDefault, bimapDefault)+import qualified Data.ByteString                      as BS+import qualified Data.ByteString.Builder              as Builder+import qualified Data.ByteString.Lazy                 as LBS+import           Data.Semigroup+                 ((<>))+import qualified Data.Sequence                        as Seq+import           Data.Text+                 (Text)+import           Data.Text.Encoding+                 (encodeUtf8)+import           Data.Typeable+                 (Typeable)+import           GHC.Generics+                 (Generic)+import           Network.HTTP.Media+                 (MediaType)+import           Network.HTTP.Types+                 (Header, HeaderName, HttpVersion (..), Method, QueryItem,+                 http11, methodGet)+import           Servant.API+                 (ToHttpApiData, toEncodedUrlPiece, toHeader, SourceIO)++import Servant.Client.Core.Internal (mediaTypeRnf)++data RequestF body path = Request+  { requestPath        :: path+  , requestQueryString :: Seq.Seq QueryItem+  , requestBody        :: Maybe (body, MediaType)+  , requestAccept      :: Seq.Seq MediaType+  , requestHeaders     :: Seq.Seq Header+  , requestHttpVersion :: HttpVersion+  , requestMethod      :: Method+  } deriving (Generic, Typeable, Eq, Show, Functor, Foldable, Traversable)++instance Bifunctor RequestF where bimap = bimapDefault+instance Bifoldable RequestF where bifoldMap = bifoldMapDefault+instance Bitraversable RequestF where+    bitraverse f g r = mk+        <$> traverse (bitraverse f pure) (requestBody r)+        <*> g (requestPath r)+      where+        mk b p = r { requestBody = b, requestPath = p }++instance (NFData path, NFData body) => NFData (RequestF body path) where+    rnf r =+        rnf (requestPath r)+        `seq` rnf (requestQueryString r)+        `seq` rnfB (requestBody r)+        `seq` rnf (fmap mediaTypeRnf (requestAccept r))+        `seq` rnf (requestHeaders r)+        `seq` requestHttpVersion r+        `seq` rnf (requestMethod r)+      where+        rnfB Nothing        = ()+        rnfB (Just (b, mt)) = rnf b `seq` mediaTypeRnf mt++type Request = RequestF RequestBody Builder.Builder++-- | The request body. R replica of the @http-client@ @RequestBody@.+data RequestBody+  = RequestBodyLBS LBS.ByteString+  | RequestBodyBS BS.ByteString+  | RequestBodySource (SourceIO LBS.ByteString)+  deriving (Generic, Typeable)++instance Show RequestBody where+    showsPrec d (RequestBodyLBS lbs) = showParen (d > 10)+        $ showString "RequestBodyLBS "+        . showsPrec 11 lbs+    showsPrec d (RequestBodyBS bs) = showParen (d > 10)+        $ showString "RequestBodyBS "+        . showsPrec 11 bs+    showsPrec d (RequestBodySource _) = showParen (d > 10)+        $ showString "RequestBodySource <IO>"++-- A GET request to the top-level path+defaultRequest :: Request+defaultRequest = Request+  { requestPath = ""+  , requestQueryString = Seq.empty+  , requestBody = Nothing+  , requestAccept = Seq.empty+  , requestHeaders = Seq.empty+  , requestHttpVersion = http11+  , requestMethod = methodGet+  }++appendToPath :: Text -> Request -> Request+appendToPath p req+  = req { requestPath = requestPath req <> "/" <> toEncodedUrlPiece p }++appendToQueryString :: Text       -- ^ param name+                    -> Maybe Text -- ^ param value+                    -> Request+                    -> Request+appendToQueryString pname pvalue req+  = req { requestQueryString = requestQueryString req+                        Seq.|> (encodeUtf8 pname, encodeUtf8 <$> pvalue)}++addHeader :: ToHttpApiData a => HeaderName -> a -> Request -> Request+addHeader name val req+  = req { requestHeaders = requestHeaders req Seq.|> (name, toHeader val)}++-- | Set body and media type of the request being constructed.+--+-- The body is set to the given bytestring using the 'RequestBodyLBS'+-- constructor.+--+-- @since 0.12+--+setRequestBodyLBS :: LBS.ByteString -> MediaType -> Request -> Request+setRequestBodyLBS b t req+  = req { requestBody = Just (RequestBodyLBS b, t) }++-- | Set body and media type of the request being constructed.+--+-- @since 0.12+--+setRequestBody :: RequestBody -> MediaType -> Request -> Request+setRequestBody b t req = req { requestBody = Just (b, t) }

@@ -0,0 +1,53 @@+{-# LANGUAGE DeriveDataTypeable    #-}+{-# LANGUAGE DeriveFoldable        #-}+{-# LANGUAGE DeriveFunctor         #-}+{-# LANGUAGE DeriveGeneric         #-}+{-# LANGUAGE DeriveTraversable     #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE RankNTypes            #-}+{-# LANGUAGE ScopedTypeVariables   #-}+{-# LANGUAGE TypeFamilies          #-}++module Servant.Client.Core.Response (+    Response,+    StreamingResponse,+    ResponseF (..),+    ) where++import           Prelude ()+import           Prelude.Compat++import           Control.DeepSeq+                 (NFData (..))+import qualified Data.ByteString      as BS+import qualified Data.ByteString.Lazy as LBS+import qualified Data.Sequence        as Seq+import           Data.Typeable+                 (Typeable)+import           GHC.Generics+                 (Generic)+import           Network.HTTP.Types+                 (Header, HttpVersion (..), Status (..))++import           Servant.API.Stream+                 (SourceIO)++data ResponseF a = Response+  { responseStatusCode  :: Status+  , responseHeaders     :: Seq.Seq Header+  , responseHttpVersion :: HttpVersion+  , responseBody        :: a+  } deriving (Eq, Show, Generic, Typeable, Functor, Foldable, Traversable)++instance NFData a => NFData (ResponseF a) where+    rnf (Response sc hs hv body) =+        rnfStatus sc `seq`+        rnf hs `seq`+        rnfHttpVersion hv `seq`+        rnf body+      where+        rnfStatus (Status code msg) = rnf code `seq` rnf msg+        rnfHttpVersion (HttpVersion _ _) = () -- HttpVersion fields are strict++type Response = ResponseF LBS.ByteString+type StreamingResponse = ResponseF (SourceIO BS.ByteString)

@@ -0,0 +1,46 @@+{-# LANGUAGE DeriveFunctor         #-}+{-# LANGUAGE FlexibleContexts      #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings     #-}+{-# LANGUAGE ScopedTypeVariables   #-}+{-# LANGUAGE TypeFamilies          #-}+-- | Types for possible backends to run client-side `Request` queries+module Servant.Client.Core.RunClient (+    RunClient (..),+    RunStreamingClient (..),+    ClientF (..),+    ) where++import           Prelude ()+import           Prelude.Compat++import           Control.Monad.Free+                 (Free (..), liftF)++import           Servant.Client.Core.ClientError+import           Servant.Client.Core.Request+import           Servant.Client.Core.Response++class Monad m => RunClient m where+  -- | How to make a request.+  runRequest :: Request -> m Response+  throwClientError :: ClientError -> m a++class RunClient m =>  RunStreamingClient m where+    withStreamingRequest :: Request -> (StreamingResponse -> IO a) ->  m a++-------------------------------------------------------------------------------+-- Free+-------------------------------------------------------------------------------++-- | 'ClientF' cannot stream.+--+-- Compare to 'RunClient'.+data ClientF a+    = RunRequest Request (Response -> a)+    | Throw ClientError+  deriving (Functor)++instance ClientF ~ f => RunClient (Free f) where+    runRequest req  = liftF (RunRequest req id)+    throwClientError = liftF . Throw

@@ -11,8 +11,8 @@ import           Data.Proxy                  (Proxy (..)) import           Servant.Client.Core-import           Servant.Client.Core.Internal.ClientF import           Servant.Client.Core.Reexport+import           Servant.Client.Core.RunClient  client :: HasClient (Free ClientF) api => Proxy api -> Client (Free ClientF) api client api = api `clientIn` (Proxy :: Proxy (Free ClientF))

@@ -8,7 +8,7 @@ import           Test.Hspec import           Test.QuickCheck -import           Servant.Client.Core.Internal.BaseUrl+import           Servant.Client.Core.BaseUrl  spec :: Spec spec = do