@@ -33,7 +33,9 @@ import Control.Arrow
33import Control.Monad
33import Control.Monad
35import qualified Data.ByteString as BS
35import qualified Data.ByteString as BS
36+import Data.ByteString.Builder
36−import qualified Data.ByteString.Lazy as BL
38+import qualified Data.ByteString.Lazy as BL
37import Data.Either
39import Data.Either
38 (partitionEithers)
40 (partitionEithers)
39import Data.Constraint (Dict(..))
41import Data.Constraint (Dict(..))
@@ -63,7 +65,7 @@ import Data.Text
63import Data.Proxy
65import Data.Proxy
64 (Proxy (Proxy))
66 (Proxy (Proxy))
65import GHC.TypeLits
67import GHC.TypeLits
66− (KnownNat, KnownSymbol, TypeError, symbolVal)
68+ (KnownSymbol, symbolVal)
67import Network.HTTP.Types
69import Network.HTTP.Types
69import qualified Network.HTTP.Types as H
71import qualified Network.HTTP.Types as H
@@ -84,12 +86,9 @@ import Servant.API.Generic
84 , GenericServant, toServant, fromServant)
86 , GenericServant, toServant, fromServant)
85import Servant.API.ContentTypes
87import Servant.API.ContentTypes
86 (contentTypes, AllMime (allMime), AllMimeUnrender (allMimeUnrender))
88 (contentTypes, AllMime (allMime), AllMimeUnrender (allMimeUnrender))
87−import Servant.API.Status
89import Servant.API.TypeLevel (FragmentUnique, AtLeastOneFragment)
89import Servant.API.TypeLevel (FragmentUnique, AtLeastOneFragment)
90import Servant.API.Modifiers
90import Servant.API.Modifiers
91 (FoldRequired, RequiredArgument, foldRequiredArgument)
91 (FoldRequired, RequiredArgument, foldRequiredArgument)
92−import Servant.API.TypeErrors
93import Servant.API.UVerb
92import Servant.API.UVerb
94 (HasStatus, HasStatuses (Statuses, statuses), UVerb, Union, Unique, inject, statusOf, foldMapUnion, matchUnion)
93 (HasStatus, HasStatuses (Statuses, statuses), UVerb, Union, Unique, inject, statusOf, foldMapUnion, matchUnion)
@@ -208,7 +207,7 @@ instance (KnownSymbol capture, ToHttpApiData a, HasClient m api)
208 clientWithRoute pm (Proxy :: Proxy api)
207 clientWithRoute pm (Proxy :: Proxy api)
209 (appendToPath p req)
208 (appendToPath p req)
211− where p = toEncodedUrlPiece val
210+ where p = (toUrlPiece val)
213 hoistClientMonad pm _ f cl = \a ->
212 hoistClientMonad pm _ f cl = \a ->
214 hoistClientMonad pm (Proxy :: Proxy api) f (cl a)
213 hoistClientMonad pm (Proxy :: Proxy api) f (cl a)
@@ -243,7 +242,7 @@ instance (KnownSymbol capture, ToHttpApiData a, HasClient m sublayout)
243 clientWithRoute pm (Proxy :: Proxy sublayout)
242 clientWithRoute pm (Proxy :: Proxy sublayout)
244 (foldl' (flip appendToPath) req ps)
243 (foldl' (flip appendToPath) req ps)
246− where ps = map toEncodedUrlPiece vals
245+ where ps = map (toUrlPiece) vals
248 hoistClientMonad pm _ f cl = \as ->
247 hoistClientMonad pm _ f cl = \as ->
249 hoistClientMonad pm (Proxy :: Proxy sublayout) f (cl as)
248 hoistClientMonad pm (Proxy :: Proxy sublayout) f (cl as)
@@ -251,11 +250,10 @@ instance (KnownSymbol capture, ToHttpApiData a, HasClient m sublayout)
251instance {-# OVERLAPPABLE #-}
250instance {-# OVERLAPPABLE #-}
252 -- Note [Non-Empty Content Types]
251 -- Note [Non-Empty Content Types]
253 ( RunClient m, MimeUnrender ct a, ReflectMethod method, cts' ~ (ct ': cts)
252 ( RunClient m, MimeUnrender ct a, ReflectMethod method, cts' ~ (ct ': cts)
255 ) => HasClient m (Verb method status cts' a) where
253 ) => HasClient m (Verb method status cts' a) where
256 type Client m (Verb method status cts' a) = m a
254 type Client m (Verb method status cts' a) = m a
257 clientWithRoute _pm Proxy req = do
255 clientWithRoute _pm Proxy req = do
258− response <- runRequestAcceptStatus (Just [status]) req
256+ response <- runRequest req
259 { requestAccept = fromList $ toList accept
257 { requestAccept = fromList $ toList accept
260 , requestMethod = method
258 , requestMethod = method
@@ -263,20 +261,18 @@ instance {-# OVERLAPPABLE #-}
264 accept = contentTypes (Proxy :: Proxy ct)
262 accept = contentTypes (Proxy :: Proxy ct)
265 method = reflectMethod (Proxy :: Proxy method)
263 method = reflectMethod (Proxy :: Proxy method)
266− status = statusFromNat (Proxy :: Proxy status)
268 hoistClientMonad _ _ f ma = f ma
265 hoistClientMonad _ _ f ma = f ma
270instance {-# OVERLAPPING #-}
267instance {-# OVERLAPPING #-}
271− ( RunClient m, ReflectMethod method, KnownNat status
268+ ( RunClient m, ReflectMethod method
272 ) => HasClient m (Verb method status cts NoContent) where
269 ) => HasClient m (Verb method status cts NoContent) where
273 type Client m (Verb method status cts NoContent)
270 type Client m (Verb method status cts NoContent)
274 = m NoContent
271 = m NoContent
275 clientWithRoute _pm Proxy req = do
272 clientWithRoute _pm Proxy req = do
276− _response <- runRequestAcceptStatus (Just [status]) req { requestMethod = method }
273+ _response <- runRequest req { requestMethod = method }
277 return NoContent
274 return NoContent
278 where method = reflectMethod (Proxy :: Proxy method)
275 where method = reflectMethod (Proxy :: Proxy method)
279− status = statusFromNat (Proxy :: Proxy status)
281 hoistClientMonad _ _ f ma = f ma
277 hoistClientMonad _ _ f ma = f ma
@@ -293,13 +289,13 @@ instance (RunClient m, ReflectMethod method) =>
294instance {-# OVERLAPPING #-}
290instance {-# OVERLAPPING #-}
295 -- Note [Non-Empty Content Types]
291 -- Note [Non-Empty Content Types]
296− ( RunClient m, MimeUnrender ct a, BuildHeadersTo ls, KnownNat status
292+ ( RunClient m, MimeUnrender ct a, BuildHeadersTo ls
297 , ReflectMethod method, cts' ~ (ct ': cts)
293 , ReflectMethod method, cts' ~ (ct ': cts)
298 ) => HasClient m (Verb method status cts' (Headers ls a)) where
294 ) => HasClient m (Verb method status cts' (Headers ls a)) where
299 type Client m (Verb method status cts' (Headers ls a))
295 type Client m (Verb method status cts' (Headers ls a))
300 = m (Headers ls a)
296 = m (Headers ls a)
301 clientWithRoute _pm Proxy req = do
297 clientWithRoute _pm Proxy req = do
302− response <- runRequestAcceptStatus (Just [status]) req
298+ response <- runRequest req
303 { requestMethod = method
299 { requestMethod = method
304 , requestAccept = fromList $ toList accept
300 , requestAccept = fromList $ toList accept
@@ -307,26 +303,22 @@ instance {-# OVERLAPPING #-}
307 return $ Headers { getResponse = val
303 return $ Headers { getResponse = val
308 , getHeadersHList = buildHeadersTo . toList $ responseHeaders response
304 , getHeadersHList = buildHeadersTo . toList $ responseHeaders response
311− method = reflectMethod (Proxy :: Proxy method)
306+ where method = reflectMethod (Proxy :: Proxy method)
312− accept = contentTypes (Proxy :: Proxy ct)
307+ accept = contentTypes (Proxy :: Proxy ct)
313− status = statusFromNat (Proxy :: Proxy status)
315 hoistClientMonad _ _ f ma = f ma
309 hoistClientMonad _ _ f ma = f ma
317instance {-# OVERLAPPING #-}
311instance {-# OVERLAPPING #-}
318− ( RunClient m, BuildHeadersTo ls, ReflectMethod method, KnownNat status
312+ ( RunClient m, BuildHeadersTo ls, ReflectMethod method
319 ) => HasClient m (Verb method status cts (Headers ls NoContent)) where
313 ) => HasClient m (Verb method status cts (Headers ls NoContent)) where
320 type Client m (Verb method status cts (Headers ls NoContent))
314 type Client m (Verb method status cts (Headers ls NoContent))
321 = m (Headers ls NoContent)
315 = m (Headers ls NoContent)
322 clientWithRoute _pm Proxy req = do
316 clientWithRoute _pm Proxy req = do
317+ let method = reflectMethod (Proxy :: Proxy method)
323− response <- runRequestAcceptStatus (Just [status]) req { requestMethod = method }
318+ response <- runRequest req { requestMethod = method }
324 return $ Headers { getResponse = NoContent
319 return $ Headers { getResponse = NoContent
325 , getHeadersHList = buildHeadersTo . toList $ responseHeaders response
320 , getHeadersHList = buildHeadersTo . toList $ responseHeaders response
328− method = reflectMethod (Proxy :: Proxy method)
329− status = statusFromNat (Proxy :: Proxy status)
331 hoistClientMonad _ _ f ma = f ma
323 hoistClientMonad _ _ f ma = f ma
@@ -569,7 +561,7 @@ instance (KnownSymbol sym, ToHttpApiData a, HasClient m api, SBoolI (FoldRequire
569 (Proxy :: Proxy mods) add (maybe req add) mparam
561 (Proxy :: Proxy mods) add (maybe req add) mparam
571 add :: a -> Request
563 add :: a -> Request
572− add param = appendToQueryString pname (Just $ encodeQueryParamValue param) req
564+ add param = appendToQueryString pname (Just $ encodeQueryParam param) req
574 pname :: Text
566 pname :: Text
575 pname = pack $ symbolVal (Proxy :: Proxy sym)
567 pname = pack $ symbolVal (Proxy :: Proxy sym)
@@ -577,6 +569,9 @@ instance (KnownSymbol sym, ToHttpApiData a, HasClient m api, SBoolI (FoldRequire
577 hoistClientMonad pm _ f cl = \arg ->
569 hoistClientMonad pm _ f cl = \arg ->
578 hoistClientMonad pm (Proxy :: Proxy api) f (cl arg)
570 hoistClientMonad pm (Proxy :: Proxy api) f (cl arg)
572+encodeQueryParam :: ToHttpApiData a => a -> BS.ByteString
573+encodeQueryParam = BL.toStrict . toLazyByteString . toEncodedUrlPiece
580-- | If you use a 'QueryParams' in one of your endpoints in your API,
575-- | If you use a 'QueryParams' in one of your endpoints in your API,
581-- the corresponding querying function will automatically take
576-- the corresponding querying function will automatically take
582-- an additional argument, a list of values of the type specified
577-- an additional argument, a list of values of the type specified
@@ -618,7 +613,7 @@ instance (KnownSymbol sym, ToHttpApiData a, HasClient m api)
620 where pname = pack $ symbolVal (Proxy :: Proxy sym)
615 where pname = pack $ symbolVal (Proxy :: Proxy sym)
621− paramlist' = map (Just . encodeQueryParamValue) paramlist
616+ paramlist' = map (Just . encodeQueryParam) paramlist
623 hoistClientMonad pm _ f cl = \as ->
618 hoistClientMonad pm _ f cl = \as ->
624 hoistClientMonad pm (Proxy :: Proxy api) f (cl as)
619 hoistClientMonad pm (Proxy :: Proxy api) f (cl as)
@@ -740,7 +735,7 @@ instance (KnownSymbol path, HasClient m api) => HasClient m (path :> api) where
740 clientWithRoute pm (Proxy :: Proxy api)
735 clientWithRoute pm (Proxy :: Proxy api)
741 (appendToPath p req)
736 (appendToPath p req)
743− where p = toEncodedUrlPiece $ pack $ symbolVal (Proxy :: Proxy path)
738+ where p = pack $ symbolVal (Proxy :: Proxy path)
745 hoistClientMonad pm _ f cl = hoistClientMonad pm (Proxy :: Proxy api) f cl
740 hoistClientMonad pm _ f cl = hoistClientMonad pm (Proxy :: Proxy api) f cl
@@ -789,7 +784,7 @@ instance ( HasClient m api
790-- | Ignore @'Fragment'@ in client functions.
785-- | Ignore @'Fragment'@ in client functions.
791-- See <https://ietf.org/rfc/rfc2616.html#section-15.1.3> for more details.
786-- See <https://ietf.org/rfc/rfc2616.html#section-15.1.3> for more details.
793-- Example:
788-- Example:
795-- > type MyApi = "books" :> Fragment Text :> Get '[JSON] [Book]
790-- > type MyApi = "books" :> Fragment Text :> Get '[JSON] [Book]
@@ -806,7 +801,7 @@ instance (AtLeastOneFragment api, FragmentUnique (Fragment a :> api), HasClient
807 type Client m (Fragment a :> api) = Client m api
802 type Client m (Fragment a :> api) = Client m api
809− clientWithRoute pm _ = clientWithRoute pm (Proxy :: Proxy api)
804+ clientWithRoute pm _ = clientWithRoute pm (Proxy :: Proxy api)
811 hoistClientMonad pm _ = hoistClientMonad pm (Proxy :: Proxy api)
806 hoistClientMonad pm _ = hoistClientMonad pm (Proxy :: Proxy api)
@@ -833,10 +828,10 @@ type GClientConstraints api m =
835class GClient (api :: * -> *) m where
830class GClient (api :: * -> *) m where
836− gClientProof :: Dict (GClientConstraints api m)
831+ proof :: Dict (GClientConstraints api m)
838instance GClientConstraints api m => GClient api m where
833instance GClientConstraints api m => GClient api m where
839− gClientProof = Dict
834+ proof = Dict
842 ( forall n. GClient api n
837 ( forall n. GClient api n
@@ -848,7 +843,7 @@ instance
849 clientWithRoute :: Proxy m -> Proxy (NamedRoutes api) -> Request -> Client m (NamedRoutes api)
844 clientWithRoute :: Proxy m -> Proxy (NamedRoutes api) -> Request -> Client m (NamedRoutes api)
850 clientWithRoute pm _ request =
845 clientWithRoute pm _ request =
851− case gClientProof @api @m of
846+ case proof @api @m of
852 Dict -> fromServant $ clientWithRoute pm (Proxy @(ToServantApi api)) request
847 Dict -> fromServant $ clientWithRoute pm (Proxy @(ToServantApi api)) request
854 hoistClientMonad
849 hoistClientMonad
@@ -859,7 +854,7 @@ instance
859 -> Client ma (NamedRoutes api)
854 -> Client ma (NamedRoutes api)
860 -> Client mb (NamedRoutes api)
855 -> Client mb (NamedRoutes api)
861 hoistClientMonad _ _ nat clientA =
856 hoistClientMonad _ _ nat clientA =
862− case (gClientProof @api @ma, gClientProof @api @mb) of
857+ case (proof @api @ma, proof @api @mb) of
863 (Dict, Dict) ->
858 (Dict, Dict) ->
864 fromServant @api @(AsClientT mb) $
859 fromServant @api @(AsClientT mb) $
865 hoistClientMonad @m @(ToServantApi api) @ma @mb Proxy Proxy nat $
860 hoistClientMonad @m @(ToServantApi api) @ma @mb Proxy Proxy nat $
@@ -874,7 +869,7 @@ infixl 2 /:
875-- Example:
870-- Example:
878-- type Api = NamedRoutes RootApi
873-- type Api = NamedRoutes RootApi
880-- data RootApi mode = RootApi
875-- data RootApi mode = RootApi
@@ -895,7 +890,7 @@ infixl 2 /:
896-- endpointClient :: ClientM Person
891-- endpointClient :: ClientM Person
897-- endpointClient = client // subApi // endpoint
892-- endpointClient = client // subApi // endpoint
899(//) :: a -> (a -> b) -> b
894(//) :: a -> (a -> b) -> b
900x // f = f x
895x // f = f x
@@ -906,7 +901,7 @@ x // f = f x
907-- Example:
902-- Example:
910-- type Api = NamedRoutes RootApi
905-- type Api = NamedRoutes RootApi
912-- data RootApi mode = RootApi
907-- data RootApi mode = RootApi
@@ -931,7 +926,7 @@ x // f = f x
932-- endpointClient :: ClientM Person
927-- endpointClient :: ClientM Person
933-- endpointClient = client // subApi /: "foobar123" // endpoint
928-- endpointClient = client // subApi /: "foobar123" // endpoint
935(/:) :: (a -> b -> c) -> b -> a -> c
930(/:) :: (a -> b -> c) -> b -> a -> c
936(/:) = flip
931(/:) = flip
@@ -975,19 +970,3 @@ decodedAs response ct = do
975 Right val -> return val
970 Right val -> return val
977 accept = toList $ contentTypes ct
972 accept = toList $ contentTypes ct
979−-------------------------------------------------------------------------------
980−-- Custom type errors
981−-------------------------------------------------------------------------------
983−-- Erroring instance for HasClient' when a combinator is not fully applied
984−instance (RunClient m, TypeError (PartialApplication HasClient arr)) => HasClient m ((arr :: a -> b) :> sub)
986− type Client m (arr :> sub) = TypeError (PartialApplication HasClient arr)
987− clientWithRoute _ _ _ = error "unreachable"
988− hoistClientMonad _ _ _ _ = error "unreachable"
990−-- Erroring instances for 'HasClient' for unknown API combinators
991−instance {-# OVERLAPPABLE #-} (RunClient m, TypeError (NoInstanceForSub (HasClient m) ty)) => HasClient m (ty :> sub)
993−instance {-# OVERLAPPABLE #-} (RunClient m, TypeError (NoInstanceFor (HasClient m api))) => HasClient m api