diff --git a/servant-client-core.cabal b/servant-client-core.cabal --- a/servant-client-core.cabal +++ b/servant-client-core.cabal @@ -1,111 +1,154 @@ -cabal-version: 2.2 -name: servant-client-core -version: 0.20 +cabal-version: 3.0 +name: servant-client-core +version: 0.20.1 +synopsis: + Core functionality and class for client function generation for servant APIs -synopsis: Core functionality and class for client function generation for servant APIs -category: Servant, Web +category: Servant, Web description: This library provides backend-agnostic generation of client functions. For more information, see the README. -homepage: http://docs.servant.dev/ -bug-reports: http://github.com/haskell-servant/servant/issues -license: BSD-3-Clause -license-file: LICENSE -author: Servant Contributors -maintainer: haskell-servant-maintainers@googlegroups.com -copyright: 2014-2016 Zalora South East Asia Pte Ltd, 2016-2019 Servant Contributors -build-type: Simple -tested-with: GHC==8.6.5, GHC==8.8.4, GHC ==8.10.7, GHC ==9.0.2, GHC ==9.2.7, GHC ==9.4.4 - , GHCJS ==8.6.0.1 +homepage: http://docs.servant.dev/ +bug-reports: http://github.com/haskell-servant/servant/issues +license: BSD-3-Clause +license-file: LICENSE +author: Servant Contributors +maintainer: haskell-servant-maintainers@googlegroups.com +copyright: + 2014-2016 Zalora South East Asia Pte Ltd, 2016-2019 Servant Contributors +build-type: Simple +tested-with: + GHC ==8.10.7 || ==9.0.2 || ==9.2.8 || ==9.4.8 || ==9.6.4 || ==9.8.2 + extra-source-files: CHANGELOG.md README.md source-repository head - type: git - location: http://github.com/haskell-servant/servant.git + type: git + location: http://github.com/haskell-servant/servant.git +common extensions + default-extensions: + AllowAmbiguousTypes + ConstraintKinds + DataKinds + DeriveAnyClass + DeriveDataTypeable + DeriveFunctor + DeriveGeneric + DerivingStrategies + DerivingVia + DuplicateRecordFields + ExplicitNamespaces + FlexibleContexts + FlexibleInstances + FunctionalDependencies + GADTs + InstanceSigs + KindSignatures + LambdaCase + MultiParamTypeClasses + NoStarIsType + OverloadedLabels + OverloadedStrings + PackageImports + PolyKinds + RankNTypes + RecordWildCards + QuantifiedConstraints + ScopedTypeVariables + StrictData + TupleSections + TypeApplications + TypeFamilies + TypeOperators + UndecidableInstances + ViewPatterns + + default-language: Haskell2010 + +common ghc-options + ghc-options: + -Wall -Wcompat -Widentities -Wincomplete-record-updates + -Wincomplete-uni-patterns -Wpartial-fields -Wredundant-constraints + -fhide-source-paths -Wno-unused-do-bind -fdicts-strict + -Wno-unticked-promoted-constructors -Werror=unused-imports + -Wunused-packages + library + import: extensions + import: ghc-options exposed-modules: - Servant.Client.Core - Servant.Client.Free - Servant.Client.Generic - Servant.Client.Core.Reexport - 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 + Servant.Client.Core + Servant.Client.Core.Auth + Servant.Client.Core.BaseUrl + Servant.Client.Core.BasicAuth + Servant.Client.Core.ClientError + Servant.Client.Core.HasClient + Servant.Client.Core.Reexport + Servant.Client.Core.Request + Servant.Client.Core.Response + Servant.Client.Core.RunClient + Servant.Client.Free + Servant.Client.Generic - other-modules: - Servant.Client.Core.Internal + 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 -- -- note: mtl lower bound is so low because of GHC-7.8 build-depends: - base >= 4.9 && < 4.19 - , bytestring >= 0.10.8.1 && < 0.12 - , constraints >= 0.2 && < 0.14 - , containers >= 0.5.7.1 && < 0.7 - , deepseq >= 1.4.2.0 && < 1.5 - , text >= 1.2.3.0 && < 2.1 - , transformers >= 0.5.2.0 && < 0.7 - , template-haskell >= 2.11.1.0 && < 2.21 - - if !impl(ghc >= 8.2) - build-depends: - bifunctors >= 5.5.3 && < 5.7 + , base >=4.9 && <4.20 + , bytestring >=0.10.8.1 && <0.13 + , constraints >=0.2 && <0.15 + , containers >=0.5.7.1 && <0.7 + , deepseq >=1.4.2.0 && <1.6 + , template-haskell >=2.11.1.0 && <2.22 + , text >=1.2.3.0 && <2.2 -- Servant dependencies - build-depends: - servant >= 0.20 + build-depends: servant >=0.20 -- 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. build-depends: - aeson >= 1.4.1.0 && < 3 - , base-compat >= 0.10.5 && < 0.14 - , base64-bytestring >= 1.0.0.1 && < 1.3 - , exceptions >= 0.10.0 && < 0.11 - , free >= 5.1 && < 5.2 - , http-media >= 0.7.1.3 && < 0.9 - , http-types >= 0.12.2 && < 0.13 - , network-uri >= 2.6.1.0 && < 2.7 - , safe >= 0.3.17 && < 0.4 - , sop-core >= 0.4.0.0 && < 0.6 + , aeson >=1.4.1.0 && <3 + , base-compat >=0.10.5 && <0.15 + , base64-bytestring >=1.0.0.1 && <1.3 + , exceptions >=0.10.0 && <0.11 + , free >=5.1 && <5.3 + , http-media >=0.7.1.3 && <0.9 + , http-types >=0.12.2 && <0.13 + , network-uri >=2.6.1.0 && <2.7 + , safe >=0.3.17 && <0.4 + , sop-core >=0.4.0.0 && <0.6 - hs-source-dirs: src - default-language: Haskell2010 - ghc-options: -Wall + hs-source-dirs: src test-suite spec - type: exitcode-stdio-1.0 - ghc-options: -Wall - default-language: Haskell2010 - hs-source-dirs: test - main-is: Spec.hs + import: extensions + import: ghc-options + type: exitcode-stdio-1.0 + hs-source-dirs: test + main-is: Spec.hs other-modules: - Servant.Client.Core.Internal.BaseUrlSpec - Servant.Client.Core.RequestSpec + Servant.Client.Core.Internal.BaseUrlSpec + Servant.Client.Core.RequestSpec -- Dependencies inherited from the library. No need to specify bounds. build-depends: - base + , base , base-compat , servant-client-core -- Additional dependencies build-depends: - deepseq >= 1.4.2.0 && < 1.5 - , hspec >= 2.6.0 && < 2.11 - , QuickCheck >= 2.12.6.1 && < 2.15 + , deepseq >=1.4.2.0 && <1.6 + , hspec >=2.6.0 && <2.12 + , QuickCheck >=2.12.6.1 && <2.15 - build-tool-depends: - hspec-discover:hspec-discover >= 2.6.0 && <2.11 + build-tool-depends: hspec-discover:hspec-discover >=2.6.0 && <2.12 diff --git a/src/Servant/Client/Core/Auth.hs b/src/Servant/Client/Core/Auth.hs --- a/src/Servant/Client/Core/Auth.hs +++ b/src/Servant/Client/Core/Auth.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeSynonymInstances #-} @@ -10,6 +9,8 @@ mkAuthenticatedRequest, ) where +import Data.Kind (Type) + import Servant.Client.Core.Request (Request) @@ -18,7 +19,7 @@ -- to a request -- -- NOTE: THIS API IS EXPERIMENTAL AND SUBJECT TO CHANGE -type family AuthClientData a :: * +type family AuthClientData a :: Type -- | 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 diff --git a/src/Servant/Client/Core/BaseUrl.hs b/src/Servant/Client/Core/BaseUrl.hs --- a/src/Servant/Client/Core/BaseUrl.hs +++ b/src/Servant/Client/Core/BaseUrl.hs @@ -1,7 +1,4 @@ -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DeriveLift #-} -{-# LANGUAGE ViewPatterns #-} module Servant.Client.Core.BaseUrl ( BaseUrl (..), Scheme (..), @@ -21,7 +18,7 @@ withText) import Data.Data (Data) -import Data.List +import qualified Data.List as List import qualified Data.Text as T import GHC.Generics import Language.Haskell.TH.Syntax @@ -91,7 +88,7 @@ showBaseUrl (BaseUrl urlscheme host port path) = schemeString ++ "//" ++ host ++ (portString path) where - a b = if "/" `isPrefixOf` b || null b then a ++ b else a ++ '/':b + a b = if "/" `List.isPrefixOf` b || null b then a ++ b else a ++ '/':b schemeString = case urlscheme of Http -> "http:" Https -> "https:" @@ -128,7 +125,7 @@ return (BaseUrl Https host port path) Just (URI "https:" (Just (URIAuth "" host "")) path "" "") -> return (BaseUrl Https host 443 path) - _ -> if "://" `isInfixOf` s + _ -> if "://" `List.isInfixOf` s then throwM (InvalidBaseUrlException $ "Invalid base URL: " ++ s) else parseBaseUrl ("http://" ++ s) where diff --git a/src/Servant/Client/Core/HasClient.hs b/src/Servant/Client/Core/HasClient.hs --- a/src/Servant/Client/Core/HasClient.hs +++ b/src/Servant/Client/Core/HasClient.hs @@ -1,19 +1,5 @@ -{-# LANGUAGE ConstraintKinds #-} -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE InstanceSigs #-} -{-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE PolyKinds #-} -{-# LANGUAGE QuantifiedConstraints #-} -{-# LANGUAGE RankNTypes #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeApplications #-} -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE TypeOperators #-} -{-# LANGUAGE UndecidableInstances #-} - +{-# LANGUAGE CPP #-} +{-# OPTIONS_GHC -Wno-missing-methods #-} module Servant.Client.Core.HasClient ( clientIn, HasClient (..), @@ -22,7 +8,7 @@ (//), (/:), foldMapUnion, - matchUnion, + matchUnion ) where import Prelude () @@ -32,18 +18,22 @@ (left, (+++)) import Control.Monad (unless) -import qualified Data.ByteString as BS import qualified Data.ByteString.Lazy as BL import Data.Either (partitionEithers) import Data.Constraint (Dict(..)) import Data.Foldable (toList) +import Data.Kind + (Type) +#if !MIN_VERSION_base_compat(0,14,0) import Data.List (foldl') +#endif import Data.Sequence (fromList) import qualified Data.Text as T +import Data.Text.Encoding (encodeUtf8) import Network.HTTP.Media (MediaType, matches, parseAccept) import qualified Network.HTTP.Media as Media @@ -68,25 +58,26 @@ (Status) import qualified Network.HTTP.Types as H import Servant.API - ((:<|>) ((:<|>)), (:>), AuthProtect, BasicAuth, BasicAuthData, - BuildHeadersTo (..), Capture', CaptureAll, Description, - EmptyAPI, Fragment, FramingRender (..), FramingUnrender (..), - FromSourceIO (..), Header', Headers (..), HttpVersion, - IsSecure, MimeRender (mimeRender), - MimeUnrender (mimeUnrender), NoContent (NoContent), - NoContentVerb, QueryFlag, QueryParam', QueryParams, Raw, RawM, - ReflectMethod (..), RemoteHost, ReqBody', SBoolI, Stream, - StreamBody', Summary, ToHttpApiData, ToSourceIO (..), Vault, - Verb, WithNamedContext, WithResource, WithStatus (..), contentType, getHeadersHList, - getResponse, toEncodedUrlPiece, toUrlPiece, NamedRoutes) + ((:<|>) ((:<|>)), (:>), + BuildHeadersTo (..), + EmptyAPI, + FromSourceIO (..), + IsSecure, + MimeUnrender (mimeUnrender), + NoContentVerb, + ReflectMethod (..), + StreamBody', + Verb, + getResponse, AuthProtect, BasicAuth, BasicAuthData, Capture', CaptureAll, DeepQuery, Description, Fragment, FramingRender (..), FramingUnrender (..), Header', Headers (..), HttpVersion, MimeRender (mimeRender), NoContent (NoContent), QueryFlag, QueryParam', QueryParams, QueryString, Raw, RawM, RemoteHost, ReqBody', SBoolI, Stream, Summary, ToHttpApiData, ToSourceIO (..), Vault, WithNamedContext, WithResource, WithStatus (..), contentType, getHeadersHList, toEncodedUrlPiece, NamedRoutes) import Servant.API.Generic (GenericMode(..), ToServant, ToServantApi , GenericServant, toServant, fromServant) import Servant.API.ContentTypes (contentTypes, AllMime (allMime), AllMimeUnrender (allMimeUnrender)) +import Servant.API.QueryString (ToDeepQuery(..), generateDeepParam) import Servant.API.Status (statusFromNat) -import Servant.API.TypeLevel (FragmentUnique, AtLeastOneFragment) +import Servant.API.TypeLevel (FragmentUnique, AtMostOneFragment) import Servant.API.Modifiers (FoldRequired, RequiredArgument, foldRequiredArgument) import Servant.API.TypeErrors @@ -128,7 +119,7 @@ -- combinators that you want to support client-generation, you can ignore this -- class. class RunClient m => HasClient m api where - type Client (m :: * -> *) (api :: *) :: * + type Client (m :: Type -> Type) (api :: Type) :: Type clientWithRoute :: Proxy m -> Proxy api -> Request -> Client m api hoistClientMonad :: Proxy m @@ -198,7 +189,7 @@ -- > 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) +instance (ToHttpApiData a, HasClient m api) => HasClient m (Capture' mods capture a :> api) where type Client m (Capture' mods capture a :> api) = @@ -233,7 +224,7 @@ -- > getSourceFile :: [Text] -> ClientM SourceFile -- > getSourceFile = client myApi -- > -- then you can use "getSourceFile" to query that endpoint -instance (KnownSymbol capture, ToHttpApiData a, HasClient m sublayout) +instance (ToHttpApiData a, HasClient m sublayout) => HasClient m (CaptureAll capture a :> sublayout) where type Client m (CaptureAll capture a :> sublayout) = @@ -333,7 +324,7 @@ data ClientParseError = ClientParseError MediaType String | ClientStatusMismatch | ClientNoMatchingStatus deriving (Eq, Show) -class UnrenderResponse (cts :: [*]) (a :: *) where +class UnrenderResponse (cts :: [Type]) (a :: Type) where unrenderResponse :: Seq.Seq H.Header -> BL.ByteString -> Proxy cts -> [Either (MediaType, String) a] @@ -662,6 +653,36 @@ hoistClientMonad pm _ f cl = \b -> hoistClientMonad pm (Proxy :: Proxy api) f (cl b) +instance (HasClient m api) + => HasClient m (QueryString :> api) where + type Client m (QueryString :> api) = + H.Query -> Client m api + + clientWithRoute pm Proxy req query = + clientWithRoute pm (Proxy :: Proxy api) + (setQueryString query req) + + hoistClientMonad pm _ f cl = \b -> + hoistClientMonad pm (Proxy :: Proxy api) f (cl b) + +instance (KnownSymbol sym, ToDeepQuery a, HasClient m api) + => HasClient m (DeepQuery sym a :> api) where + type Client m (DeepQuery sym a :> api) = + a -> Client m api + + clientWithRoute pm Proxy req deepObject = + let params = toDeepQuery deepObject + withParams = foldl' addDeepParam req params + addDeepParam r' kv = + let (k, textV) = generateDeepParam paramname kv + in appendToQueryString k (encodeUtf8 <$> textV) r' + paramname = pack $ symbolVal (Proxy :: Proxy sym) + in clientWithRoute pm (Proxy :: Proxy api) + withParams + + 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 @@ -819,7 +840,7 @@ -- > getBooks = client myApi -- > -- then you can just use "getBooksBy" to query that endpoint. -- > -- 'getBooks' for all books. -instance (AtLeastOneFragment api, FragmentUnique (Fragment a :> api), HasClient m api +instance (AtMostOneFragment api, FragmentUnique (Fragment a :> api), HasClient m api ) => HasClient m (Fragment a :> api) where type Client m (Fragment a :> api) = Client m api @@ -840,7 +861,7 @@ hoistClientMonad pm (Proxy :: Proxy api) f (cl bauth) -- | A type that specifies that an API record contains a client implementation. -data AsClientT (m :: * -> *) +data AsClientT (m :: Type -> Type) instance GenericMode (AsClientT m) where type AsClientT m :- api = Client m api @@ -850,7 +871,7 @@ , Client m (ToServantApi api) ~ ToServant api (AsClientT m) ) -class GClient (api :: * -> *) m where +class GClient (api :: Type -> Type) m where gClientProof :: Dict (GClientConstraints api m) instance GClientConstraints api m => GClient api m where diff --git a/src/Servant/Client/Core/Request.hs b/src/Servant/Client/Core/Request.hs --- a/src/Servant/Client/Core/Request.hs +++ b/src/Servant/Client/Core/Request.hs @@ -18,6 +18,7 @@ appendToPath, appendToQueryString, encodeQueryParamValue, + setQueryString, setRequestBody, setRequestBodyLBS, ) where @@ -50,10 +51,10 @@ import Network.HTTP.Media (MediaType) import Network.HTTP.Types - (Header, HeaderName, HttpVersion (..), Method, QueryItem, + (Header, HeaderName, HttpVersion (..), Method, Query, QueryItem, http11, methodGet, urlEncodeBuilder) import Servant.API - (ToHttpApiData, toEncodedUrlPiece, toQueryParam, toHeader, SourceIO) + (ToHttpApiData, toQueryParam, toHeader, SourceIO) import Servant.Client.Core.Internal (mediaTypeRnf) @@ -161,6 +162,12 @@ appendToQueryString pname pvalue req = req { requestQueryString = requestQueryString req Seq.|> (encodeUtf8 pname, pvalue)} + +setQueryString :: Query + -> Request + -> Request +setQueryString query req + = req { requestQueryString = Seq.fromList query } -- | Encode a query parameter value. -- diff --git a/src/Servant/Client/Core/RunClient.hs b/src/Servant/Client/Core/RunClient.hs --- a/src/Servant/Client/Core/RunClient.hs +++ b/src/Servant/Client/Core/RunClient.hs @@ -4,6 +4,7 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} -- | Types for possible backends to run client-side `Request` queries module Servant.Client.Core.RunClient ( RunClient (..), diff --git a/src/Servant/Client/Generic.hs b/src/Servant/Client/Generic.hs --- a/src/Servant/Client/Generic.hs +++ b/src/Servant/Client/Generic.hs @@ -4,6 +4,7 @@ {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} module Servant.Client.Generic ( AsClientT,