git.iko.soy/servant
on 73c87bc help sign in
aaeee88
swap
0 ahead, 120 behind
96 files changed+434−1529
since splitsnapshots
unifiedsplit
.github/workflows/master.yml+62−51 CONTRIBUTING.md+2−4 cabal.project+23−1 changelog.d/1529−10 changelog.d/1556−81 changelog.d/1569−13 changelog.d/1571−10 changelog.d/1573−2 changelog.d/1580−12 changelog.d/1589−2 changelog.d/1595−2 changelog.d/1606−10 changelog.d/1638−2 changelog.d/1649−8 doc/Makefile+1−1 doc/conf.py+2−1 doc/cookbook/curl-mock/curl-mock.cabal−3 doc/cookbook/index.rst+2−3 doc/cookbook/managed-resource/ManagedResource.lhs−114 doc/cookbook/managed-resource/managed-resource.cabal−30 doc/cookbook/open-id-connect/OpenIdConnect.lhs+1−1 doc/cookbook/using-free-client/UsingFreeClient.lhs+1−1 doc/cookbook/uverb/UVerb.lhs+1−1 doc/links.rst+1−1 doc/requirements.txt−1 doc/tutorial/install.rst−26 doc/tutorial/tutorial.cabal+1−1 servant-auth/servant-auth-client/servant-auth-client.cabal+11−11 servant-auth/servant-auth-docs/servant-auth-docs.cabal+9−9 servant-auth/servant-auth-server/servant-auth-server.cabal+16−17 servant-auth/servant-auth-server/src/Servant/Auth/Server/Internal.hs+9−6 servant-auth/servant-auth-server/src/Servant/Auth/Server/Internal/AddSetCookie.hs+1−26 servant-auth/servant-auth-server/src/Servant/Auth/Server/Internal/ConfigTypes.hs+2−2 servant-auth/servant-auth-server/src/Servant/Auth/Server/Internal/Cookie.hs−1 servant-auth/servant-auth-server/src/Servant/Auth/Server/Internal/JWT.hs+9−6 servant-auth/servant-auth-server/src/Servant/Auth/Server/Internal/ThrowAll.hs+1−10 servant-auth/servant-auth-server/src/Servant/Auth/Server/Internal/Types.hs−1 servant-auth/servant-auth-server/test/Servant/Auth/ServerSpec.hs+5−39 servant-auth/servant-auth-swagger/servant-auth-swagger.cabal+13−9 servant-auth/servant-auth/servant-auth.cabal+8−8 servant-auth/servant-auth/src/Servant/Auth.hs+1−1 servant-client-core/CHANGELOG.md−31 servant-client-core/servant-client-core.cabal+9−9 servant-client-core/src/Servant/Client/Core.hs−1 servant-client-core/src/Servant/Client/Core/HasClient.hs+21−51 servant-client-core/src/Servant/Client/Core/Request.hs+5−20 servant-client-ghcjs/servant-client-ghcjs.cabal+4−4 servant-client-ghcjs/src/Servant/Client/Internal/XhrClient.hs+5−8 servant-client/CHANGELOG.md−31 servant-client/servant-client.cabal+13−13 servant-client/src/Servant/Client/Internal/HttpClient.hs+8−9 servant-client/src/Servant/Client/Internal/HttpClient/Streaming.hs+6−18 servant-client/test/Servant/ClientTestUtils.hs+1−13 servant-client/test/Servant/SuccessSpec.hs+1−11 servant-conduit/servant-conduit.cabal+6−6 servant-docs/CHANGELOG.md−9 servant-docs/golden/comprehensive.md−18 servant-docs/servant-docs.cabal+7−7 servant-docs/src/Servant/Docs/Internal.hs+1−8 servant-foreign/servant-foreign.cabal+7−7 servant-foreign/src/Servant/Foreign/Internal.hs−7 servant-http-streams/CHANGELOG.md−10 servant-http-streams/servant-http-streams.cabal+15−15 servant-machines/servant-machines.cabal+5−5 servant-pipes/servant-pipes.cabal+5−5 servant-server/CHANGELOG.md−30 servant-server/example/greet.hs+1 servant-server/servant-server.cabal+13−13 servant-server/src/Servant/Server.hs+2−3 servant-server/src/Servant/Server/Experimental/Auth.hs+1−2 servant-server/src/Servant/Server/Internal.hs+40−111 servant-server/src/Servant/Server/Internal/Handler.hs+2−7 servant-server/src/Servant/Server/Internal/Router.hs+15−50 servant-server/test/Servant/Server/RouterSpec.hs+6−127 servant-server/test/Servant/ServerSpec.hs+6−54 servant-swagger/servant-swagger.cabal+13−14 servant-swagger/src/Servant/Swagger.hs+3−5 servant-swagger/src/Servant/Swagger/Internal.hs−15 servant-swagger/src/Servant/Swagger/Internal/Test.hs+6−8 servant/CHANGELOG.md−121 servant/servant.cabal+10−11 servant/src/Servant/API.hs+3−11 servant/src/Servant/API/ContentTypes.hs+1−1 servant/src/Servant/API/Raw.hs−3 servant/src/Servant/API/ResponseHeaders.hs−23 servant/src/Servant/API/TypeLevel.hs+3−3 servant/src/Servant/API/UVerb.hs−3 servant/src/Servant/API/UVerb/Union.hs+2−2 servant/src/Servant/API/Verbs.hs+1−2 servant/src/Servant/API/WithResource.hs−3 servant/src/Servant/Links.hs+5−26 servant/src/Servant/Test/ComprehensiveAPI.hs−1 servant/src/Servant/Types/SourceT.hs−3 servant/test/Servant/API/ContentTypesSpec.hs−11 servant/test/Servant/API/ResponseHeadersSpec.hs−11 stack.yaml−1
.github/workflows/master.yml+62−51
@@ -13,14 +13,12 @@ jobs:
1313 strategy:
1414 matrix:
1515 os: [ubuntu-latest]
16− cabal: ["3.6"]
16+ cabal: ["3.4"]
1717 ghc:
1818 - "8.6.5"
1919 - "8.8.4"
2020 - "8.10.7"
21− - "9.0.2"
22− - "9.2.2"
23− - "9.4.2"
21+ - "9.0.1"
2422
2523 steps:
2624 - uses: actions/checkout@v2
@@ -49,7 +47,10 @@ jobs:
4947
5048 - name: Configure
5149 run: |
52− cabal install --ignore-project -j2 doctest --constraint='doctest ^>=0.20'
50+ # Using separate store-dir because default one already has 'ghc-paths' package installed
51+ # with hardcoded path to ghcup's GHC path (which it was built with). This leads to failure in
52+ # doctest, as it tries to invoke that GHC, and it doesn't exist here.
53+ cabal --store-dir /tmp/cabal-store install --ignore-project -j2 doctest --constraint='doctest ^>=0.18'
5354
5455 - name: Build
5556 run: |
@@ -60,56 +61,66 @@ jobs:
6061 cabal test all
6162
6263 - name: Run doctests
64+ # doctests are broken on GHC 9 due to compiler bug:
65+ # https://gitlab.haskell.org/ghc/ghc/-/issues/19460
66+ continue-on-error: ${{ matrix.ghc == '9.0.1' }}
6367 run: |
6468 # Necessary for doctest to be found in $PATH
6569 export PATH="$HOME/.cabal/bin:$PATH"
6670
67− DOCTEST="cabal repl --with-ghc=doctest --ghc-options=-w"
68− (cd servant && eval $DOCTEST)
69− (cd servant-client && eval $DOCTEST)
70− (cd servant-client-core && eval $DOCTEST)
71− (cd servant-http-streams && eval $DOCTEST)
72− (cd servant-docs && eval $DOCTEST)
73− (cd servant-foreign && eval $DOCTEST)
74− (cd servant-server && eval $DOCTEST)
75− (cd servant-machines && eval $DOCTEST)
76− (cd servant-conduit && eval $DOCTEST)
77− (cd servant-pipes && eval $DOCTEST)
78−
79− # stack:
80− # name: stack / ghc ${{ matrix.ghc }}
81− # runs-on: ubuntu-latest
82− # strategy:
83− # matrix:
84− # stack: ["2.7.5"]
85− # ghc: ["8.10.7"]
86−
87− # steps:
88− # - uses: actions/checkout@v2
89−
90− # - uses: haskell/actions/setup@v1
91− # name: Setup Haskell Stack
92− # with:
93− # ghc-version: ${{ matrix.ghc }}
94− # stack-version: ${{ matrix.stack }}
95−
96− # - uses: actions/cache@v2.1.3
97− # name: Cache ~/.stack
98− # with:
99− # path: ~/.stack
100− # key: ${{ runner.os }}-${{ matrix.ghc }}-stack
101−
102− # - name: Install dependencies
103− # run: |
104− # stack build --system-ghc --test --bench --no-run-tests --no-run-benchmarks --only-dependencies
105−
106− # - name: Build
107− # run: |
108− # stack build --system-ghc --test --bench --no-run-tests --no-run-benchmarks
109−
110− # - name: Test
111− # run: |
112− # stack test --system-ghc
71+ # Filter out base-compat-batteries from .ghc.environment.*, as its modules
72+ # conflict with those of base-compat.
73+ #
74+ # FIXME: This is an ugly hack. Ultimately, we'll want to use cabal-doctest
75+ # (or cabal v2-doctest, if it ever lands) to provide a clean GHC environment.
76+ # This might allow running doctests in GHCJS build as well.
77+ perl -i -e 'while (<ARGV>) { print unless /package-id\s+(base-compat-batteries)-\d+(\.\d+)*/; }' .ghc.environment.*
78+
79+ (cd servant && doctest src)
80+ (cd servant-client && doctest src)
81+ (cd servant-client-core && doctest src)
82+ (cd servant-http-streams && doctest src)
83+ (cd servant-docs && doctest src)
84+ (cd servant-foreign && doctest src)
85+ (cd servant-server && doctest src)
86+ (cd servant-machines && doctest src)
87+ (cd servant-conduit && doctest src)
88+ (cd servant-pipes && doctest src)
89+
90+ stack:
91+ name: stack / ghc ${{ matrix.ghc }}
92+ runs-on: ubuntu-latest
93+ strategy:
94+ matrix:
95+ stack: ["2.7.3"]
96+ ghc: ["8.10.4"]
97+
98+ steps:
99+ - uses: actions/checkout@v2
100+
101+ - uses: haskell/actions/setup@v1
102+ name: Setup Haskell Stack
103+ with:
104+ ghc-version: ${{ matrix.ghc }}
105+ stack-version: ${{ matrix.stack }}
106+
107+ - uses: actions/cache@v2.1.3
108+ name: Cache ~/.stack
109+ with:
110+ path: ~/.stack
111+ key: ${{ runner.os }}-${{ matrix.ghc }}-stack
112+
113+ - name: Install dependencies
114+ run: |
115+ stack build --system-ghc --test --bench --no-run-tests --no-run-benchmarks --only-dependencies
116+
117+ - name: Build
118+ run: |
119+ stack build --system-ghc --test --bench --no-run-tests --no-run-benchmarks
120+
121+ - name: Test
122+ run: |
123+ stack test --system-ghc
113124
114125 ghcjs:
115126 name: ubuntu-latest / ghcjs 8.6
CONTRIBUTING.md+2−4
@@ -79,10 +79,8 @@ not been a timely response to a PR, you can ping the Maintainers group (with
7979We encourage people to experiment with new combinators and instances - it is
8080one of the most powerful ways of using `servant`, and a wonderful way of
8181getting to know it better. If you do write a new combinator, we would love to
82−know about it! Either hop on
83−[#haskell-servant on libera.chat](https://web.libera.chat/#haskell-servant) and
84−let us know, or open an issue with the `news` tag (which we will close when we
85−read it).
82+know about it! Either hop on #servant on freenode and let us know, or open an
83+issue with the `news` tag (which we will close when we read it).
8684
8785As for adding them to the main repo: maintaining combinators can be expensive,
8886since official combinators must have instances for all classes (and new classes
cabal.project+23−1
@@ -47,8 +47,30 @@ packages:
4747 doc/cookbook/using-custom-monad
4848 doc/cookbook/using-free-client
4949 -- doc/cookbook/open-id-connect
50− doc/cookbook/managed-resource
5150
5251tests: True
5352optimization: False
5453-- reorder-goals: True
54+
55+constraints:
56+ -- see https://github.com/haskell-infra/hackage-trustees/issues/119
57+ foundation >=0.0.14,
58+ memory <0.14.12 || >0.14.12
59+
60+constraints: base-compat ^>=0.11
61+constraints: semigroups ^>=0.19
62+
63+-- allow-newer: sqlite-simple-0.4.16.0:semigroups
64+-- allow-newer: direct-sqlite-2.3.24:semigroups
65+
66+-- needed for doctests
67+write-ghc-environment-files: always
68+
69+-- https://github.com/chordify/haskell-servant-pagination/pull/12
70+allow-newer: servant-pagination-2.2.2:servant
71+allow-newer: servant-pagination-2.2.2:servant-server
72+
73+allow-newer: servant-js:servant
74+
75+-- ghc 9
76+allow-newer: tdigest:base
changelog.d/1529deleted−10
@@ -1,10 +0,0 @@
1−synopsis: Fix performRequest in servant-client-ghcjs
2−prs: #1529
3−
4−description: {
5−
6−performRequest function in servant-client-ghcjs was not compatible with the
7−latest RunClient typeclass. Added the acceptStatus parameter and fixed the
8−functionality to match what servant-client provides.
9−
10−}
changelog.d/1556deleted−81
@@ -1,81 +0,0 @@
1−synopsis: Display capture hints in router layout
2−prs: #1556
3−
4−description: {
5−
6−This PR enhances the `Servant.Server.layout` function, which produces a textual description of the routing layout of an API. More precisely, it changes `<capture>` blocks, so that they display the name and type of the variable being captured instead.
7−
8−Example:
9−
10−For the following API
11−```haskell
12−type API =
13− "a" :> "d" :> Get '[JSON] NoContent
14− :<|> "b" :> Capture "x" Int :> Get '[JSON] Bool
15− :<|> "a" :> "e" :> Get '[JSON] Int
16−```
17−
18−we previously got the following output:
19−
20−```
21−/
22−├─ a/
23−│ ├─ d/
24−│ │ └─•
25−│ └─ e/
26−│ └─•
27−└─ b/
28− └─ <capture>/
29− ├─•
30− ┆
31− └─•
32−```
33−
34−now we get:
35−
36−```
37−/
38−├─ a/
39−│ ├─ d/
40−│ │ └─•
41−│ └─ e/
42−│ └─•
43−└─ b/
44− └─ <x::Int>/
45− ├─•
46− ┆
47− └─•
48−```
49−
50−This change is achieved by the introduction of a CaptureHint type, which is passed as an extra argument to the CaptureRouter and CaptureAllRouter constructors for the Router' type.
51−CaptureHint values are then used in routerLayout, to display the name and type of captured values, instead of just `<capture>` previously.
52−
53−N.B.:
54−Because the choice smart constructor for routers can aggregate Capture combinators with different capture hints, the Capture*Router constructors actually take a list of CaptureHint, instead of a single one.
55−
56−This PR also introduces Spec tests for the routerLayout function.
57−
58−Warning:
59−This change is potentially breaking, because it adds the constraint `Typeable a` to all types that are to be captured. Because all types are typeable since GHC 7.10, this is not as bad as it sounds ; it only break expressions where `a` is quantified in an expression with `Capture a`.
60−In those cases, the fix is easy: it suffices to add `Typeable a` to the left-hand side of the quantification constraint.
61−
62−For instance, the following code will no longer compile:
63−```haskell
64−type MyAPI a = Capture "foo" a :> Get '[JSON] ()
65−
66−myServer :: forall a. Server (MyAPI a)
67−myServer = const $ return ()
68−
69−myApi :: forall a. Proxy (MyAPI a)
70−myApi = Proxy
71−
72−app :: forall a. (FromHttpApiData a) => Application
73−app = serve (myApi @a) (myServer @a)
74−```
75−
76−Indeed, `app` should be replaced with:
77−```haskell
78−app :: forall a. (FromHttpApiData a, Typeable a) => Application
79−app = serve (myApi @a) (myServer @a)
80−```
81−}
changelog.d/1569deleted−13
@@ -1,13 +0,0 @@
1−synopsis: Encode captures using toEncodedUrlPiece
2−prs: #1569
3−issues: #1511
4−
5−description: {
6−The `servant-client` library now makes direct use of `toEncodedUrlPiece` from `ToHttpApiData`
7−to encode captured values when building the request path. It gives user freedom to implement
8−URL-encoding however they need.
9−
10−Previous behavior was to use `toUrlPiece` and URL-encode its output using `toEncodedUrlPiece`
11−from the `Text` instance of `ToHttpApiData`. The issue with this approach is that
12−`ToHttpApiData Text` is overly zealous and also encodes characters, such as `*`, which are perfectly valid in a URL.
13−}
changelog.d/1571deleted−10
@@ -1,10 +0,0 @@
1−synopsis: Support UVerb in servant-auth-server
2−prs: #1571
3−issues: #1570
4−description: {
5−UVerb endpoints are now supported by servant-auth-server and can be used under the
6−Auth combinator when writing servers. It is still unsupported by
7−servant-auth-client.
8−
9−This PR also brings Headers support in UVerb responses
10−}
changelog.d/1573deleted−2
@@ -1,2 +0,0 @@
1−synopsis: Add API docs for ServerT
2−prs: #1573
changelog.d/1580deleted−12
@@ -1,12 +0,0 @@
1−synopsis: Allow IO in validationKeys
2−prs: #1580
3−issues: #1579
4−
5−description: {
6−
7−Currently validationKeys are a fixed JWKSet. This does not work with OIDC
8−providers such as AWS Cognito or Okta, which regularly fetching jwks_uri to
9−discover new and expired keys.
10−
11−This change alters the type of validationKeys from JWKSet to IO JWKSet.
12−}
changelog.d/1589deleted−2
@@ -1,2 +0,0 @@
1−synopsis: Only include question mark for nonempty query strings
2−prs: 1589
changelog.d/1595deleted−2
@@ -1,2 +0,0 @@
1−synopsis: Run ClientEnv's makeClientRequest in IO.
2−prs: #1595
changelog.d/1606deleted−10
@@ -1,10 +0,0 @@
1−synopsis: Handle Cookies correctly for RunStreamingClient
2−prs: #1606
3−issues: #1605
4−
5−description: {
6−
7−Makes performWithStreamingRequest take into consideration the
8−CookieJar, which it previously didn't.
9−
10−}
changelog.d/1638deleted−2
@@ -1,2 +0,0 @@
1−synopsis: Add Functor instance to AuthHandler.
2−prs: #1638
changelog.d/1649deleted−8
@@ -1,8 +0,0 @@
1−synopsis: Add HasStatus instance for Headers (that defers StatusOf to underlying value)
2−prs: #1649
3−
4−description: {
5−
6−Adds a new HasStatus (Headers hs a) instance (StatusOf (Headers hs a) = StatusOf a)
7−
8−}
doc/Makefile+1−1
@@ -10,7 +10,7 @@ BUILDDIR = _build
1010
1111# Put it first so that "make" without argument is like "make help".
1212help:
13− @if [ ! -d venv ]; then echo "WARNING: There is no venv directory, did you forget to 'virtualenv venv'. Check README.md."; fi
13+ @if [ ! -d venv ]; then echo "WARNING: There is no venv directory, did you forget to 'virtualenv venv'. Check building-the-docs file."; fi
1414 @if [ ! "z$$(which $(SPHINXBUILD))" = "z$$(pwd)/venv/bin/sphinx-build" ]; then echo "WARNING: Did you forgot to 'source venv/bin/activate'"; fi
1515 @$(SPHINXBUILD) -M help "$(SOURCEDIR)" "$(BUILDDIR)" $(SPHINXOPTS) $(O)
1616
doc/conf.py+2−1
@@ -46,7 +46,7 @@ master_doc = 'index'
4646
4747# General information about the project.
4848project = u'Servant'
49−copyright = u'2022, Servant Contributors'
49+copyright = u'2018, Servant Contributors'
5050author = u'Servant Contributors'
5151
5252# The version info for the project you're documenting, acts as replacement for
@@ -169,3 +169,4 @@ texinfo_documents = [
169169source_parsers = {
170170 '.lhs': CommonMarkParser,
171171}
172+
doc/cookbook/curl-mock/curl-mock.cabal−3
@@ -11,9 +11,6 @@ build-type: Simple
1111tested-with: GHC==8.6.5, GHC==8.8.3, GHC ==8.10.7
1212
1313executable cookbock-curl-mock
14− if impl(ghc >= 9.2)
15− -- generic-arbitrary is incompatible
16− buildable: False
1714 main-is: CurlMock.lhs
1815 build-depends: base == 4.*
1916 , aeson
doc/cookbook/index.rst+2−3
@@ -6,8 +6,8 @@ how to solve many common problems with servant. If you're
66interested in contributing examples of your own, feel free
77to open an issue or a pull request on
88`our github repository <https://github.com/haskell-servant/servant>`_
9−or even to just get in touch with us on the `**#haskell-servant** IRC channel
10−on libera.chat <https://web.libera.chat/#haskell-servant>_ or on
9+or even to just get in touch with us on the **#servant** IRC channel
10+on freenode or on
1111`the mailing list <https://groups.google.com/forum/#!forum/haskell-servant>`_.
1212
1313The scope is very wide. Simple and fancy authentication schemes,
@@ -37,4 +37,3 @@ you name it!
3737 sentry/Sentry.lhs
3838 testing/Testing.lhs
3939 open-id-connect/OpenIdConnect.lhs
40− managed-resource/ManagedResource.lhs
doc/cookbook/managed-resource/ManagedResource.lhsdeleted−114
@@ -1,114 +0,0 @@
1−# Request-lifetime Managed Resources
2−
3−Let's see how we can write a handle that uses a resource managed by Servant. The resource is created automatically by Servant when the server recieves a request, and the resource is automatically destroyed when the server is finished handling a request.
4−
5−As usual, we start with a little bit of throat clearing.
6−
7−
8−``` haskell
9−{-# LANGUAGE DataKinds #-}
10−{-# LANGUAGE TypeOperators #-}
11−import Control.Concurrent
12−import Control.Exception (bracket, throwIO)
13−import Control.Monad.IO.Class
14−import Control.Monad.Trans.Resource
15−import Data.Acquire
16−import Network.HTTP.Client (newManager, defaultManagerSettings)
17−import Network.Wai.Handler.Warp
18−import Servant
19−import Servant.Client
20−import System.IO
21−```
22−
23−Here we define an API type that uses the `WithResource` combinator. The server handler for an endpoint with a `WithResource res` component will receive a value of that type as an argument.
24−
25−``` haskell
26−type API = WithResource Handle :> ReqBody '[PlainText] String :> Post '[JSON] NoContent
27−
28−api :: Proxy API
29−api = Proxy
30−```
31−
32−But this resource value has to come from somewhere. Servant obtains the value using an Acquire provided in the context. The Acquire knows how to both create and destroy resources of a particular type.
33−
34−``` haskell
35−appContext :: Context '[Acquire Handle]
36−appContext = acquireHandle :. EmptyContext
37−
38−acquireHandle :: Acquire Handle
39−acquireHandle = mkAcquire newHandle closeHandle
40−
41−newHandle :: IO Handle
42−newHandle = do
43− putStrLn "opening file"
44− h <- openFile "test.txt" AppendMode
45− putStrLn "opened file"
46− return h
47−
48−closeHandle :: Handle -> IO ()
49−closeHandle h = do
50− putStrLn "closing file"
51− hClose h
52− putStrLn "closed file"
53−```
54−
55−Now we create the handler which will use this resource. This handler will write the request message to the System.IO.Handle which was provided to us. In some situations the handler will succeed, but in some in will fail. In either case, Servant will clean up the resource for us.
56−
57−``` haskell
58−server :: Server API
59−server = writeToFile
60−
61− where writeToFile :: (ReleaseKey, Handle) -> String -> Handler NoContent
62− writeToFile (_, h) msg = case msg of
63− "illegal" -> error "wait, that's illegal!"
64− legalMsg -> liftIO $ do
65− putStrLn "writing file"
66− hPutStrLn h legalMsg
67− putStrLn "wrote file"
68− return NoContent
69−```
70−
71−Finally we run the server in the background while we post messages to it.
72−
73−``` haskell
74−runApp :: IO ()
75−runApp = run 8080 (serveWithContext api appContext $ server)
76−
77−postMsg :: String -> ClientM NoContent
78−postMsg = client api
79−
80−main :: IO ()
81−main = do
82− mgr <- newManager defaultManagerSettings
83− bracket (forkIO $ runApp) killThread $ \_ -> do
84− ms <- flip runClientM (mkClientEnv mgr (BaseUrl Http "localhost" 8080 "")) $ do
85− liftIO $ putStrLn "sending hello message"
86− _ <- postMsg "hello"
87− liftIO $ putStrLn "sending illegal message"
88− _ <- postMsg "illegal"
89− liftIO $ putStrLn "done"
90− print ms
91−```
92−
93−This program prints
94−
95−```
96−sending hello message
97−opening file
98−opened file
99−writing file
100−wrote file
101−closing file
102−closed file
103−sending illegal message
104−opening file
105−opened file
106−closing file
107−closed file
108−wait, that's illegal!
109−CallStack (from HasCallStack):
110− error, called at ManagedResource.lhs:63:24 in main:Main
111−Left (FailureResponse (Request {requestPath = (BaseUrl {baseUrlScheme = Http, baseUrlHost = "localhost", baseUrlPort = 8080, baseUrlPath = ""},""), requestQueryString = fromList [], requestBody = Just ((),text/plain;charset=utf-8), requestAccept = fromList [], requestHeaders = fromList [], requestHttpVersion = HTTP/1.1, requestMethod = "POST"}) (Response {responseStatusCode = Status {statusCode = 500, statusMessage = "Internal Server Error"}, responseHeaders = fromList [("Transfer-Encoding","chunked"),("Date","Thu, 24 Nov 2022 21:04:47 GMT"),("Server","Warp/3.3.23"),("Content-Type","text/plain; charset=utf-8")], responseHttpVersion = HTTP/1.1, responseBody = "Something went wrong"}))
112−```
113−
114−and appends to a file called `test.txt`. We can see from the output that when a legal message is sent, the file is opened, written to, and closed. We can also see that when an illegal message is sent, the file is opened but not written to. Crucially, it is still closed even though the handler threw an exception.
doc/cookbook/managed-resource/managed-resource.cabaldeleted−30
@@ -1,30 +0,0 @@
1−cabal-version: 2.2
2−name: cookbook-managed-resource
3−version: 0.1
4−synopsis: Simple managed resource cookbook example
5−homepage: http://docs.servant.dev/
6−license: BSD-3-Clause
7−license-file: ../../../servant/LICENSE
8−author: Servant Contributors
9−maintainer: haskell-servant-maintainers@googlegroups.com
10−build-type: Simple
11−tested-with: GHC==9.4.2
12−
13−executable cookbook-managed-resource
14− main-is: ManagedResource.lhs
15− build-depends: base == 4.*
16− , text >= 1.2
17− , aeson >= 1.2
18− , servant
19− , servant-client
20− , servant-server
21− , warp >= 3.2
22− , wai >= 3.2
23− , http-types >= 0.12
24− , markdown-unlit >= 0.4
25− , http-client >= 0.5
26− , transformers
27− , resourcet
28− default-language: Haskell2010
29− ghc-options: -Wall -pgmL markdown-unlit
30− build-tool-depends: markdown-unlit:markdown-unlit
doc/cookbook/open-id-connect/OpenIdConnect.lhs+1−1
@@ -330,7 +330,7 @@ data Customer = Customer {
330330```
331331
332332Here is the code that displays the homepage.
333−It should contain a link to the `/login` URL.
333+It should contain a link to the the `/login` URL.
334334When the user clicks on this link it will be redirected to Google login page
335335with some generated information.
336336
doc/cookbook/using-free-client/UsingFreeClient.lhs+1−1
@@ -119,7 +119,7 @@ Now we can use `servant-client`'s internals to convert servant's `Request`
119119to http-client's `Request`, and we can inspect it:
120120
121121```haskell
122− req' <- I.defaultMakeClientRequest burl req
122+ let req' = I.defaultMakeClientRequest burl req
123123 putStrLn $ "Making request: " ++ show req'
124124```
125125
doc/cookbook/uverb/UVerb.lhs+1−1
@@ -199,7 +199,7 @@ parsers in the hope that the ones that should will always error out so
199199you can try until the right one returns a value.)
200200
201201[servant-exceptions](https://github.com/ch1bo/servant-exceptions) is
202−another shot at the problem. It is inspired by
202+another shot at at the problem. It is inspired by
203203servant-checked-exceptions, so it may be worth taking a closer look.
204204The README claims that
205205[cardano-sl](https://github.com/input-output-hk/cardano-sl) also has
doc/links.rst+1−1
@@ -12,7 +12,7 @@ Helpful Links
1212 `https://github.com/haskell-servant/servant/issues <https://github.com/haskell-servant/servant/issues>`_
1313
1414- the irc channel:
15− `#haskell-servant on libera.chat <https://web.libera.chat/#haskell-servant>`_
15+ ``#servant`` on freenode
1616
1717- the mailing list:
1818 `groups.google.com/forum/#!forum/haskell-servant <https://groups.google.com/forum/#!forum/haskell-servant>`_
doc/requirements.txt−1
@@ -1,4 +1,3 @@
11recommonmark==0.5.0
22Sphinx==1.8.4
33sphinx_rtd_theme>=0.4.2
4−jinja2<3.1.0
doc/tutorial/install.rst−26
@@ -40,29 +40,3 @@ nix
4040`Nix <https://nixos.org/nix/>`_ users should feel free to take a look at
4141the `nix/shell.nix` file in the repository and use it to provision a suitable
4242environment to build and run the examples.
43−
44−Note for Ubuntu users
45−--------
46−
47−Ubuntu's packages for `ghc`, `cabal`, and `stack` are years out of date.
48−If the instructions above fail for you,
49−try replacing the Ubuntu packages with up-to-date versions.
50−First remove the installed versions:
51−
52−.. code-block:: bash
53−
54− # remove the obsolete versions
55− $ sudo apt remove ghc haskell-stack cabal-install
56−
57−Then install fresh versions of the Haskell toolchain
58−using the `ghcup <https://www.haskell.org/ghcup/install/>`_ installer.
59−
60−As of February 2022, one easy way to do this is by running a bootstrap script:
61−
62−.. code-block:: bash
63−
64− $ curl --proto '=https' --tlsv1.2 -sSf https://get-ghcup.haskell.org | sh
65−
66−The script is interactive and will prompt you for details about what
67−you want installed and where. To install manually,
68−see `the detailed instructions <https://www.haskell.org/ghcup/install/#manual-install>`_.
doc/tutorial/tutorial.cabal+1−1
@@ -64,7 +64,7 @@ library
6464 , blaze-markup >= 0.8.0.0 && < 0.9
6565 , cookie >= 0.4.3 && < 0.5
6666 , js-jquery >= 3.3.1 && < 3.4
67− , lucid >= 2.9.11 && < 2.12
67+ , lucid >= 2.9.11 && < 2.10
6868 , random >= 1.1 && < 1.3
6969 , servant-js >= 0.9 && < 0.10
7070 , time >= 1.6.0.1 && < 1.13
servant-auth/servant-auth-client/servant-auth-client.cabal+11−11
@@ -7,9 +7,9 @@ description: This package provides instances that allow generating clients fr
77 APIs that use
88 <https://hackage.haskell.org/package/servant-auth servant-auth's> @Auth@ combinator.
99 .
10− For a quick overview of the usage, see the <https://github.com/haskell-servant/servant/tree/master/servant-auth#readme README>.
10+ For a quick overview of the usage, see the <http://github.com/haskell-servant/servant/servant-auth#readme README>.
1111category: Web, Servant, Authentication
12−homepage: https://github.com/haskell-servant/servant/tree/master/servant-auth#readme
12+homepage: http://github.com/haskell-servant/servant/servant-auth#readme
1313bug-reports: https://github.com/haskell-servant/servant/issues
1414author: Julian K. Arni
1515maintainer: jkarni@gmail.com
@@ -31,12 +31,12 @@ library
3131 default-extensions: ConstraintKinds DataKinds DefaultSignatures DeriveFoldable DeriveFunctor DeriveGeneric DeriveTraversable FlexibleContexts FlexibleInstances FunctionalDependencies GADTs KindSignatures MultiParamTypeClasses OverloadedStrings RankNTypes ScopedTypeVariables TypeFamilies TypeOperators
3232 ghc-options: -Wall
3333 build-depends:
34− base >= 4.10 && < 4.18
35− , bytestring >= 0.10.6.0 && < 0.12
34+ base >= 4.10 && < 4.16
35+ , bytestring >= 0.10.6.0 && < 0.11
3636 , containers >= 0.5.6.2 && < 0.7
3737 , servant-auth == 0.4.*
38− , servant >= 0.13 && < 0.20
39− , servant-client-core >= 0.13 && < 0.20
38+ , servant >= 0.13 && < 0.19
39+ , servant-client-core >= 0.13 && < 0.19
4040
4141 exposed-modules:
4242 Servant.Auth.Client
@@ -50,7 +50,7 @@ test-suite spec
5050 test
5151 default-extensions: ConstraintKinds DataKinds DefaultSignatures DeriveFoldable DeriveFunctor DeriveGeneric DeriveTraversable FlexibleContexts FlexibleInstances FunctionalDependencies GADTs KindSignatures MultiParamTypeClasses OverloadedStrings RankNTypes ScopedTypeVariables TypeFamilies TypeOperators
5252 ghc-options: -Wall
53− build-tool-depends: hspec-discover:hspec-discover >=2.5.5 && <2.10
53+ build-tool-depends: hspec-discover:hspec-discover >=2.5.5 && <2.9
5454
5555 -- dependencies with bounds inherited from the library stanza
5656 build-depends:
@@ -62,19 +62,19 @@ test-suite spec
6262
6363 -- test dependencies
6464 build-depends:
65− hspec >= 2.5.5 && < 2.10
65+ hspec >= 2.5.5 && < 2.9
6666 , QuickCheck >= 2.11.3 && < 2.15
6767 , aeson >= 1.3.1.1 && < 3
68− , bytestring >= 0.10.6.0 && < 0.12
68+ , bytestring >= 0.10.6.0 && < 0.11
6969 , http-client >= 0.5.13.1 && < 0.8
7070 , http-types >= 0.12.2 && < 0.13
7171 , servant-auth-server >= 0.4.2.0 && < 0.5
72− , servant-server >= 0.13 && < 0.20
72+ , servant-server >= 0.13 && < 0.19
7373 , time >= 1.5.0.1 && < 1.13
7474 , transformers >= 0.4.2.0 && < 0.6
7575 , wai >= 3.2.1.2 && < 3.3
7676 , warp >= 3.2.25 && < 3.4
77− , jose >= 0.10 && < 0.11
77+ , jose >= 0.7.0.0 && < 0.10
7878 other-modules:
7979 Servant.Auth.ClientSpec
8080 default-language: Haskell2010
servant-auth/servant-auth-docs/servant-auth-docs.cabal+9−9
@@ -7,9 +7,9 @@ description: This package provides instances that allow generating docs from
77 APIs that use
88 <https://hackage.haskell.org/package/servant-auth servant-auth's> @Auth@ combinator.
99 .
10− For a quick overview of the usage, see the <https://github.com/haskell-servant/servant/tree/master/servant-auth#readme README>.
10+ For a quick overview of the usage, see the <http://github.com/haskell-servant/servant/servant-auth#readme README>.
1111category: Web, Servant, Authentication
12−homepage: https://github.com/haskell-servant/servant/tree/master/servant-auth#readme
12+homepage: http://github.com/haskell-servant/servant/servant-auth#readme
1313bug-reports: https://github.com/haskell-servant/servant/issues
1414author: Julian K. Arni
1515maintainer: jkarni@gmail.com
@@ -35,11 +35,11 @@ library
3535 default-extensions: ConstraintKinds DataKinds DefaultSignatures DeriveFoldable DeriveFunctor DeriveGeneric DeriveTraversable FlexibleContexts FlexibleInstances FunctionalDependencies GADTs KindSignatures MultiParamTypeClasses OverloadedStrings RankNTypes ScopedTypeVariables TypeFamilies TypeOperators
3636 ghc-options: -Wall
3737 build-depends:
38− base >= 4.10 && < 4.18
39− , servant-docs >= 0.11.2 && < 0.13
40− , servant >= 0.13 && < 0.20
38+ base >= 4.10 && < 4.16
39+ , servant-docs >= 0.11.2 && < 0.12
40+ , servant >= 0.13 && < 0.19
4141 , servant-auth == 0.4.*
42− , lens >= 4.16.1 && <5.3
42+ , lens >= 4.16.1 && <5.1
4343 exposed-modules:
4444 Servant.Auth.Docs
4545 default-language: Haskell2010
@@ -50,7 +50,7 @@ test-suite doctests
5050 build-depends:
5151 base,
5252 servant-auth-docs,
53− doctest >= 0.16 && < 0.21,
53+ doctest >= 0.16 && < 0.19,
5454 QuickCheck >= 2.11.3 && < 2.15,
5555 template-haskell
5656 ghc-options: -Wall -threaded
@@ -64,7 +64,7 @@ test-suite spec
6464 test
6565 default-extensions: ConstraintKinds DataKinds DefaultSignatures DeriveFoldable DeriveFunctor DeriveGeneric DeriveTraversable FlexibleContexts FlexibleInstances FunctionalDependencies GADTs KindSignatures MultiParamTypeClasses OverloadedStrings RankNTypes ScopedTypeVariables TypeFamilies TypeOperators
6666 ghc-options: -Wall
67− build-tool-depends: hspec-discover:hspec-discover >=2.5.5 && <2.10
67+ build-tool-depends: hspec-discover:hspec-discover >=2.5.5 && <2.9
6868
6969 -- dependencies with bounds inherited from the library stanza
7070 build-depends:
@@ -78,7 +78,7 @@ test-suite spec
7878 -- test dependencies
7979 build-depends:
8080 servant-auth-docs
81− , hspec >= 2.5.5 && < 2.10
81+ , hspec >= 2.5.5 && < 2.9
8282 , QuickCheck >= 2.11.3 && < 2.15
8383
8484 default-language: Haskell2010
servant-auth/servant-auth-server/servant-auth-server.cabal+16−17
@@ -1,15 +1,15 @@
11cabal-version: 2.2
22name: servant-auth-server
3−version: 0.4.7.0
3+version: 0.4.6.0
44synopsis: servant-server/servant-auth compatibility
55description: This package provides the required instances for using the @Auth@ combinator
66 in your 'servant' server.
77 .
88 Both cookie- and token- (REST API) based authentication is provided.
99 .
10− For a quick overview of the usage, see the <https://github.com/haskell-servant/servant/tree/master/servant-auth#readme README>.
10+ For a quick overview of the usage, see the <http://github.com/haskell-servant/servant/servant-auth#readme README>.
1111category: Web, Servant, Authentication
12−homepage: https://github.com/haskell-servant/servant/tree/master/servant-auth#readme
12+homepage: http://github.com/haskell-servant/servant/servant-auth#readme
1313bug-reports: https://github.com/haskell-servant/servant/issues
1414author: Julian K. Arni
1515maintainer: jkarni@gmail.com
@@ -31,27 +31,27 @@ library
3131 default-extensions: ConstraintKinds DataKinds DefaultSignatures DeriveFoldable DeriveFunctor DeriveGeneric DeriveTraversable FlexibleContexts FlexibleInstances FunctionalDependencies GADTs KindSignatures MultiParamTypeClasses OverloadedStrings RankNTypes ScopedTypeVariables TypeFamilies TypeOperators
3232 ghc-options: -Wall
3333 build-depends:
34− base >= 4.10 && < 4.18
34+ base >= 4.10 && < 4.16
3535 , aeson >= 1.0.0.1 && < 3
3636 , base64-bytestring >= 1.0.0.1 && < 2
3737 , blaze-builder >= 0.4.1.0 && < 0.5
38− , bytestring >= 0.10.6.0 && < 0.12
38+ , bytestring >= 0.10.6.0 && < 0.11
3939 , case-insensitive >= 1.2.0.11 && < 1.3
4040 , cookie >= 0.4.4 && < 0.5
4141 , data-default-class >= 0.1.2.0 && < 0.2
4242 , entropy >= 0.4.1.3 && < 0.5
4343 , http-types >= 0.12.2 && < 0.13
44− , jose >= 0.10 && < 0.11
45− , lens >= 4.16.1 && < 5.3
46− , memory >= 0.14.16 && < 0.19
44+ , jose >= 0.7.0.0 && < 0.10
45+ , lens >= 4.16.1 && < 5.1
46+ , memory >= 0.14.16 && < 0.17
4747 , monad-time >= 0.3.1.0 && < 0.4
48− , mtl ^>= 2.2.2 || ^>= 2.3.1
49− , servant >= 0.13 && < 0.20
48+ , mtl >= 2.2.2 && < 2.3
49+ , servant >= 0.13 && < 0.19
5050 , servant-auth == 0.4.*
51− , servant-server >= 0.13 && < 0.20
51+ , servant-server >= 0.13 && < 0.19
5252 , tagged >= 0.8.4 && < 0.9
53− , text >= 1.2.3.0 && < 2.1
54− , time >= 1.5.0.1 && < 1.13
53+ , text >= 1.2.3.0 && < 1.3
54+ , time >= 1.5.0.1 && < 1.10
5555 , unordered-containers >= 0.2.9.0 && < 0.3
5656 , wai >= 3.2.1.2 && < 3.3
5757
@@ -102,7 +102,7 @@ test-suite spec
102102 test
103103 default-extensions: ConstraintKinds DataKinds DefaultSignatures DeriveFoldable DeriveFunctor DeriveGeneric DeriveTraversable FlexibleContexts FlexibleInstances FunctionalDependencies GADTs KindSignatures MultiParamTypeClasses OverloadedStrings RankNTypes ScopedTypeVariables TypeFamilies TypeOperators
104104 ghc-options: -Wall
105− build-tool-depends: hspec-discover:hspec-discover >=2.5.5 && <2.10
105+ build-tool-depends: hspec-discover:hspec-discover >=2.5.5 && <2.8
106106
107107 -- dependencies with bounds inherited from the library stanza
108108 build-depends:
@@ -123,13 +123,12 @@ test-suite spec
123123 -- test dependencies
124124 build-depends:
125125 servant-auth-server
126− , hspec >= 2.5.5 && < 2.10
126+ , hspec >= 2.5.5 && < 2.8
127127 , QuickCheck >= 2.11.3 && < 2.15
128128 , http-client >= 0.5.13.1 && < 0.8
129− , lens-aeson >= 1.0.2 && < 1.3
129+ , lens-aeson >= 1.0.2 && < 1.2
130130 , warp >= 3.2.25 && < 3.4
131131 , wreq >= 0.5.2.1 && < 0.6
132− , text >= 1.2.3.0 && < 2.1
133132 other-modules:
134133 Servant.Auth.ServerSpec
135134 default-language: Haskell2010
servant-auth/servant-auth-server/src/Servant/Auth/Server/Internal.hs+9−6
@@ -54,12 +54,15 @@ instance ( n ~ 'S ('S 'Z)
5454
5555 makeCookies :: AuthResult v -> IO (SetCookieList ('S ('S 'Z)))
5656 makeCookies authResult = do
57− case authResult of
58− (Authenticated v) -> do
59− ejwt <- makeSessionCookie cookieSettings jwtSettings v
60− xsrf <- makeXsrfCookie cookieSettings
61− return $ Just xsrf `SetCookieCons` (ejwt `SetCookieCons` SetCookieNil)
62− _ -> return $ Nothing `SetCookieCons` (Nothing `SetCookieCons` SetCookieNil)
57+ xsrf <- makeXsrfCookie cookieSettings
58+ fmap (Just xsrf `SetCookieCons`) $
59+ case authResult of
60+ (Authenticated v) -> do
61+ ejwt <- makeSessionCookie cookieSettings jwtSettings v
62+ case ejwt of
63+ Nothing -> return $ Nothing `SetCookieCons` SetCookieNil
64+ Just jwt -> return $ Just jwt `SetCookieCons` SetCookieNil
65+ _ -> return $ Nothing `SetCookieCons` SetCookieNil
6366
6467 go :: (AuthResult v -> ServerT api Handler)
6568 -> (AuthResult v, SetCookieList n)
servant-auth/servant-auth-server/src/Servant/Auth/Server/Internal/AddSetCookie.hs+1−26
@@ -11,9 +11,6 @@ import Data.Tagged (Tagged (..))
1111import qualified Network.HTTP.Types as HTTP
1212import Network.Wai (mapResponseHeaders)
1313import Servant
14−import Servant.API.UVerb.Union
15−import Servant.API.Generic
16−import Servant.Server.Generic
1714import Web.Cookie
1815
1916-- What are we doing here? Well, the idea is to add headers to the response,
@@ -34,24 +31,11 @@ type family AddSetCookieApiVerb a where
3431 AddSetCookieApiVerb (Headers ls a) = Headers (Header "Set-Cookie" SetCookie ': ls) a
3532 AddSetCookieApiVerb a = Headers '[Header "Set-Cookie" SetCookie] a
3633
37−#if MIN_VERSION_servant_server(0,18,1)
38−type family MapAddSetCookieApiVerb (as :: [*]) where
39− MapAddSetCookieApiVerb '[] = '[]
40− MapAddSetCookieApiVerb (a ': as) = (AddSetCookieApiVerb a ': MapAddSetCookieApiVerb as)
41−#endif
42−
4334type family AddSetCookieApi a :: *
4435type instance AddSetCookieApi (a :> b) = a :> AddSetCookieApi b
4536type instance AddSetCookieApi (a :<|> b) = AddSetCookieApi a :<|> AddSetCookieApi b
46−#if MIN_VERSION_servant_server(0,19,0)
47−type instance AddSetCookieApi (NamedRoutes api) = AddSetCookieApi (ToServantApi api)
48−#endif
4937type instance AddSetCookieApi (Verb method stat ctyps a)
5038 = Verb method stat ctyps (AddSetCookieApiVerb a)
51−#if MIN_VERSION_servant_server(0,18,1)
52−type instance AddSetCookieApi (UVerb method ctyps as)
53− = UVerb method ctyps (MapAddSetCookieApiVerb as)
54−#endif
5539type instance AddSetCookieApi Raw = Raw
5640#if MIN_VERSION_servant_server(0,15,0)
5741type instance AddSetCookieApi (Stream method stat framing ctyps a)
@@ -70,7 +54,7 @@ instance {-# OVERLAPS #-} AddSetCookies ('S n) oldb newb
7054 => AddSetCookies ('S n) (a -> oldb) (a -> newb) where
7155 addSetCookies cookies oldfn = addSetCookies cookies . oldfn
7256
73−instance (orig1 ~ orig2) => AddSetCookies 'Z orig1 orig2 where
57+instance AddSetCookies 'Z orig orig where
7458 addSetCookies _ = id
7559
7660instance {-# OVERLAPPABLE #-}
@@ -88,15 +72,6 @@ instance {-# OVERLAPS #-}
8872 => AddSetCookies ('S n) (a :<|> b) (a' :<|> b') where
8973 addSetCookies cookies (a :<|> b) = addSetCookies cookies a :<|> addSetCookies cookies b
9074
91−instance {-# OVERLAPS #-}
92− ( AddSetCookies ('S n) (ServerT (ToServantApi api) m) cookiedApi
93− , Generic (api (AsServerT m))
94− , GServantProduct (Rep (api (AsServerT m)))
95− , ToServant api (AsServerT m) ~ ServerT (ToServantApi api) m
96− )
97− => AddSetCookies ('S n) (api (AsServerT m)) cookiedApi where
98− addSetCookies cookies = addSetCookies cookies . toServant
99−
10075-- | for @servant <0.11@
10176instance
10277 AddSetCookies ('S n) Application Application where
servant-auth/servant-auth-server/src/Servant/Auth/Server/Internal/ConfigTypes.hs+2−2
@@ -33,7 +33,7 @@ data JWTSettings = JWTSettings
3333 -- | Algorithm used to sign JWT.
3434 , jwtAlg :: Maybe Jose.Alg
3535 -- | Keys used to validate JWT.
36− , validationKeys :: IO Jose.JWKSet
36+ , validationKeys :: Jose.JWKSet
3737 -- | An @aud@ predicate. The @aud@ is a string or URI that identifies the
3838 -- intended recipient of the JWT.
3939 , audienceMatches :: Jose.StringOrURI -> IsMatch
@@ -44,7 +44,7 @@ defaultJWTSettings :: Jose.JWK -> JWTSettings
4444defaultJWTSettings k = JWTSettings
4545 { signingKey = k
4646 , jwtAlg = Nothing
47− , validationKeys = pure $ Jose.JWKSet [k]
47+ , validationKeys = Jose.JWKSet [k]
4848 , audienceMatches = const Matches }
4949
5050-- | The policies to use when generating cookies.
servant-auth/servant-auth-server/src/Servant/Auth/Server/Internal/Cookie.hs−1
@@ -2,7 +2,6 @@
22module Servant.Auth.Server.Internal.Cookie where
33
44import Blaze.ByteString.Builder (toByteString)
5−import Control.Monad (MonadPlus(..), guard)
65import Control.Monad.Except
76import Control.Monad.Reader
87import qualified Crypto.JOSE as Jose
servant-auth/servant-auth-server/src/Servant/Auth/Server/Internal/JWT.hs+9−6
@@ -1,14 +1,18 @@
11module Servant.Auth.Server.Internal.JWT where
22
33import Control.Lens
4−import Control.Monad (MonadPlus(..), guard)
4+import Control.Monad.Except
55import Control.Monad.Reader
66import qualified Crypto.JOSE as Jose
77import qualified Crypto.JWT as Jose
8+import Data.Aeson (FromJSON, Result (..), ToJSON, fromJSON,
9+ toJSON)
810import Data.ByteArray (constEq)
911import qualified Data.ByteString as BS
1012import qualified Data.ByteString.Lazy as BSL
13+import qualified Data.HashMap.Strict as HM
1114import Data.Maybe (fromMaybe)
15+import qualified Data.Text as T
1216import Data.Time (UTCTime)
1317import Network.Wai (requestHeaders)
1418
@@ -38,7 +42,7 @@ jwtAuthCheck jwtSettings = do
3842-- token expires.
3943makeJWT :: ToJWT a
4044 => a -> JWTSettings -> Maybe UTCTime -> IO (Either Jose.Error BSL.ByteString)
41−makeJWT v cfg expiry = Jose.runJOSE $ do
45+makeJWT v cfg expiry = runExceptT $ do
4246 bestAlg <- Jose.bestJWSAlg $ signingKey cfg
4347 let alg = fromMaybe bestAlg $ jwtAlg cfg
4448 ejwt <- Jose.signClaims (signingKey cfg)
@@ -54,15 +58,14 @@ makeJWT v cfg expiry = Jose.runJOSE $ do
5458
5559verifyJWT :: FromJWT a => JWTSettings -> BS.ByteString -> IO (Maybe a)
5660verifyJWT jwtCfg input = do
57− keys <- validationKeys jwtCfg
58− verifiedJWT <- Jose.runJOSE $ do
61+ verifiedJWT <- liftIO $ runExceptT $ do
5962 unverifiedJWT <- Jose.decodeCompact (BSL.fromStrict input)
6063 Jose.verifyClaims
6164 (jwtSettingsToJwtValidationSettings jwtCfg)
62− keys
65+ (validationKeys jwtCfg)
6366 unverifiedJWT
6467 return $ case verifiedJWT of
6568 Left (_ :: Jose.JWTError) -> Nothing
6669 Right v -> case decodeJWT v of
6770 Left _ -> Nothing
68− Right v' -> Just v'
71+ Right v' -> Just v'
servant-auth/servant-auth-server/src/Servant/Auth/Server/Internal/ThrowAll.hs+1−10
@@ -8,10 +8,7 @@ module Servant.Auth.Server.Internal.ThrowAll where
88
99import Control.Monad.Error.Class
1010import Data.Tagged (Tagged (..))
11−import Servant ((:<|>) (..), ServerError(..), NamedRoutes(..))
12−import Servant.API.Generic
13−import Servant.Server.Generic
14−import Servant.Server
11+import Servant ((:<|>) (..), ServerError(..))
1512import Network.HTTP.Types
1613import Network.Wai
1714
@@ -29,12 +26,6 @@ class ThrowAll a where
2926instance (ThrowAll a, ThrowAll b) => ThrowAll (a :<|> b) where
3027 throwAll e = throwAll e :<|> throwAll e
3128
32−instance
33− ( ThrowAll (ToServant api (AsServerT m)) , GenericServant api (AsServerT m)) =>
34− ThrowAll (api (AsServerT m)) where
35−
36− throwAll = fromServant . throwAll
37−
3829-- Really this shouldn't be necessary - ((->) a) should be an instance of
3930-- MonadError, no?
4031instance {-# OVERLAPPING #-} ThrowAll b => ThrowAll (a -> b) where
servant-auth/servant-auth-server/src/Servant/Auth/Server/Internal/Types.hs−1
@@ -2,7 +2,6 @@
22module Servant.Auth.Server.Internal.Types where
33
44import Control.Applicative
5−import Control.Monad (MonadPlus(..), ap)
65import Control.Monad.Reader
76import Control.Monad.Time
87import Data.Monoid (Monoid (..))
servant-auth/servant-auth-server/test/Servant/Auth/ServerSpec.hs+5−39
@@ -1,5 +1,4 @@
11{-# LANGUAGE CPP #-}
2−{-# LANGUAGE TypeApplications #-}
32module Servant.Auth.ServerSpec (spec) where
43
54#if !MIN_VERSION_servant_server(0,16,0)
@@ -7,12 +6,13 @@ module Servant.Auth.ServerSpec (spec) where
76#endif
87
98import Control.Lens
9+import Control.Monad.Except (runExceptT)
1010import Control.Monad.IO.Class (liftIO)
1111import Crypto.JOSE (Alg (HS256, None), Error,
1212 JWK, JWSHeader,
1313 KeyMaterialGenParam (OctGenParam),
1414 ToCompact, encodeCompact,
15− genJWK, newJWSHeader, runJOSE)
15+ genJWK, newJWSHeader)
1616import Crypto.JWT (Audience (..), ClaimsSet,
1717 NumericDate (NumericDate),
1818 SignedJWT,
@@ -25,7 +25,6 @@ import Data.Aeson (FromJSON, ToJSON, Value,
2525import Data.Aeson.Lens (_JSON)
2626import qualified Data.ByteString as BS
2727import qualified Data.ByteString.Lazy as BSL
28−import Data.Text (Text, pack)
2928import Data.CaseInsensitive (mk)
3029import Data.Foldable (find)
3130import Data.Monoid
@@ -41,7 +40,6 @@ import Network.HTTP.Types (Status, status200,
4140import Network.Wai (responseLBS)
4241import Network.Wai.Handler.Warp (testWithApplication)
4342import Network.Wreq (Options, auth, basicAuth,
44− checkResponse,
4543 cookieExpiryTime, cookies,
4644 defaults, get, getWith, postWith,
4745 header, oauth2Bearer,
@@ -52,7 +50,6 @@ import Network.Wreq (Options, auth, basicAuth,
5250import Network.Wreq.Types (Postable(..))
5351import Servant hiding (BasicAuth,
5452 IsSecure (..), header)
55−import Servant.API.Generic ((:-))
5653import Servant.Auth.Server
5754import Servant.Auth.Server.Internal.Cookie (expireTime)
5855import Servant.Auth.Server.SetCookieOrphan ()
@@ -185,21 +182,8 @@ cookieAuthSpec
185182 it "fails with no XSRF header or cookie" $ \port -> property
186183 $ \(user :: User) -> do
187184 jwt <- createJWT theKey (newJWSHeader ((), HS256)) (claims $ toJSON user)
188− opts' <- addJwtToCookie cookieCfg jwt
189− let opts = opts' & checkResponse .~ Just mempty
190− resp <- getWith opts (url port)
191− resp ^. responseStatus `shouldBe` status401
192− (resp ^. responseCookieJar) `shouldNotHaveCookies` ["XSRF-TOKEN"]
193−
194− -- Validating that the XSRF cookie isn't added for UVerb routes either.
195− -- These routes can return a 401 response directly without using throwError / throwAll,
196− -- which revealed a bug:
197− --
198− -- https://github.com/haskell-servant/servant/issues/1570#issuecomment-1076374449
199− resp <- getWith opts (url port ++ "/uverb")
200− resp ^. responseStatus `shouldBe` status401
201− (resp ^. responseCookieJar) `shouldNotHaveCookies` ["XSRF-TOKEN"]
202−
185+ opts <- addJwtToCookie cookieCfg jwt
186+ getWith opts (url port) `shouldHTTPErrorWith` status401
203187
204188 it "succeeds if XSRF header and cookie match, and JWT is valid" $ \port -> property
205189 $ \(user :: User) -> do
@@ -421,23 +405,17 @@ type API auths
421405 = Auth auths User :>
422406 ( Get '[JSON] Int
423407 :<|> ReqBody '[JSON] Int :> Post '[JSON] Int
424− :<|> "named" :> NamedRoutes DummyRoutes
425408 :<|> "header" :> Get '[JSON] (Headers '[Header "Blah" Int] Int)
426409#if MIN_VERSION_servant_server(0,15,0)
427410 :<|> "stream" :> StreamGet NoFraming OctetStream (SourceIO BS.ByteString)
428411#endif
429412 :<|> "raw" :> Raw
430413 )
431− :<|> "uverb" :> Auth auths User :> UVerb 'GET '[JSON] '[WithStatus 200 Int, WithStatus 401 Text, WithStatus 403 Text]
432414 :<|> "login" :> ReqBody '[JSON] User :> Post '[JSON] (Headers '[ Header "Set-Cookie" SetCookie
433415 , Header "Set-Cookie" SetCookie ] NoContent)
434416 :<|> "logout" :> Get '[JSON] (Headers '[ Header "Set-Cookie" SetCookie
435417 , Header "Set-Cookie" SetCookie ] NoContent)
436418
437−data DummyRoutes mode = DummyRoutes
438− { dummyInt :: mode :- "dummy" :> Get '[JSON] Int
439− } deriving Generic
440−
441419jwtOnlyApi :: Proxy (API '[Servant.Auth.Server.JWT])
442420jwtOnlyApi = Proxy
443421
@@ -498,7 +476,6 @@ server ccfg =
498476 (\authResult -> case authResult of
499477 Authenticated usr -> getInt usr
500478 :<|> postInt usr
501− :<|> DummyRoutes { dummyInt = getInt usr }
502479 :<|> getHeaderInt
503480#if MIN_VERSION_servant_server(0,15,0)
504481 :<|> return (S.source ["bytestring"])
@@ -506,11 +483,6 @@ server ccfg =
506483 :<|> raw
507484 Indefinite -> throwAll err401
508485 _ -> throwAll err403
509− ) :<|>
510− (\authResult -> case authResult of
511− Authenticated usr -> respond (WithStatus @200 (42 :: Int))
512− Indefinite -> respond (WithStatus @401 $ pack "Authentication required")
513− _ -> respond (WithStatus @403 $ pack "Forbidden")
514486 )
515487 :<|> getLogin
516488 :<|> getLogout
@@ -561,7 +533,7 @@ addJwtToHeader jwt = case jwt of
561533 $ defaults & header "Authorization" .~ ["Bearer " <> BSL.toStrict v]
562534
563535createJWT :: JWK -> JWSHeader () -> ClaimsSet -> IO (Either Error Crypto.JWT.SignedJWT)
564−createJWT k a b = runJOSE $ signClaims k a b
536+createJWT k a b = runExceptT $ signClaims k a b
565537
566538addJwtToCookie :: ToCompact a => CookieSettings -> Either Error a -> IO Options
567539addJwtToCookie ccfg jwt = case jwt >>= (return . encodeCompact) of
@@ -591,12 +563,6 @@ shouldMatchCookieNames cj patterns
591563 = fmap cookie_name (destroyCookieJar cj)
592564 `shouldMatchList` patterns
593565
594−shouldNotHaveCookies :: HCli.CookieJar -> [BS.ByteString] -> Expectation
595−shouldNotHaveCookies cj patterns =
596− sequence_ $ (\cookieName -> cookieNames `shouldNotContain` [cookieName]) <$> patterns
597− where cookieNames :: [BS.ByteString]
598− cookieNames = cookie_name <$> destroyCookieJar cj
599−
600566shouldMatchCookieNameValues :: HCli.CookieJar -> [(BS.ByteString, BS.ByteString)] -> Expectation
601567shouldMatchCookieNameValues cj patterns
602568 = fmap ((,) <$> cookie_name <*> cookie_value) (destroyCookieJar cj)
servant-auth/servant-auth-swagger/servant-auth-swagger.cabal+13−9
@@ -7,9 +7,9 @@ description: This package provides instances that allow generating swagger2 s
77 APIs that use
88 <https://hackage.haskell.org/package/servant-auth servant-auth's> @Auth@ combinator.
99 .
10− For a quick overview of the usage, see the <https://github.com/haskell-servant/servant/tree/master/servant-auth#readme README>.
10+ For a quick overview of the usage, see the <http://github.com/haskell-servant/servant/servant-auth#readme README>.
1111category: Web, Servant, Authentication
12−homepage: https://github.com/haskell-servant/servant/tree/master/servant-auth#readme
12+homepage: http://github.com/haskell-servant/servant/servant-auth#readme
1313bug-reports: https://github.com/haskell-servant/servant/issues
1414author: Julian K. Arni
1515maintainer: jkarni@gmail.com
@@ -31,13 +31,15 @@ library
3131 default-extensions: ConstraintKinds DataKinds DefaultSignatures DeriveFoldable DeriveFunctor DeriveGeneric DeriveTraversable FlexibleContexts FlexibleInstances FunctionalDependencies GADTs KindSignatures MultiParamTypeClasses OverloadedStrings RankNTypes ScopedTypeVariables TypeFamilies TypeOperators
3232 ghc-options: -Wall
3333 build-depends:
34− base >= 4.10 && < 4.18
35− , text >= 1.2.3.0 && < 2.1
34+ base >= 4.10 && < 4.16
35+ , text >= 1.2.3.0 && < 1.3
3636 , servant-swagger >= 1.1.5 && < 2
3737 , swagger2 >= 2.2.2 && < 3
38− , servant >= 0.13 && < 0.20
38+ , servant >= 0.13 && < 0.19
3939 , servant-auth == 0.4.*
40− , lens >= 4.16.1 && < 5.3
40+ , lens >= 4.16.1 && < 5.1
41+ if impl(ghc >= 9)
42+ buildable: False
4143 exposed-modules:
4244 Servant.Auth.Swagger
4345 default-language: Haskell2010
@@ -49,7 +51,7 @@ test-suite spec
4951 test
5052 default-extensions: ConstraintKinds DataKinds DefaultSignatures DeriveFoldable DeriveFunctor DeriveGeneric DeriveTraversable FlexibleContexts FlexibleInstances FunctionalDependencies GADTs KindSignatures MultiParamTypeClasses OverloadedStrings RankNTypes ScopedTypeVariables TypeFamilies TypeOperators
5153 ghc-options: -Wall
52− build-tool-depends: hspec-discover:hspec-discover >= 2.5.5 && <2.10
54+ build-tool-depends: hspec-discover:hspec-discover >= 2.5.5 && <2.9
5355 -- dependencies with bounds inherited from the library stanza
5456 build-depends:
5557 base
@@ -59,11 +61,13 @@ test-suite spec
5961 , servant
6062 , servant-auth
6163 , lens
62−
64+ if impl(ghc >= 9)
65+ buildable: False
66+
6367 -- test dependencies
6468 build-depends:
6569 servant-auth-swagger
66− , hspec >= 2.5.5 && < 2.10
70+ , hspec >= 2.5.5 && < 2.9
6771 , QuickCheck >= 2.11.3 && < 2.15
6872 other-modules:
6973 Servant.Auth.SwaggerSpec
servant-auth/servant-auth/servant-auth.cabal+8−8
@@ -1,6 +1,6 @@
11cabal-version: 2.2
22name: servant-auth
3−version: 0.4.1.0
3+version: 0.4.0.0
44synopsis: Authentication combinators for servant
55description: This package provides an @Auth@ combinator for 'servant'. This combinator
66 allows using different authentication schemes in a straightforward way,
@@ -9,9 +9,9 @@ description: This package provides an @Auth@ combinator for 'servant'. This c
99 'servant-auth' additionally provides concrete authentication schemes, such
1010 as Basic Access Authentication, JSON Web Tokens, and Cookies.
1111 .
12− For more details on how to use this, see the <https://github.com/haskell-servant/servant/tree/master/servant-auth#readme README>.
12+ For more details on how to use this, see the <http://github.com/haskell-servant/servant/servant-auth#readme README>.
1313category: Web, Servant, Authentication
14−homepage: https://github.com/haskell-servant/servant/tree/master/servant-auth#readme
14+homepage: http://github.com/haskell-servant/servant/servant-auth#readme
1515bug-reports: https://github.com/haskell-servant/servant/issues
1616author: Julian K. Arni
1717maintainer: jkarni@gmail.com
@@ -33,13 +33,13 @@ library
3333 default-extensions: ConstraintKinds DataKinds DefaultSignatures DeriveFoldable DeriveFunctor DeriveGeneric DeriveTraversable FlexibleContexts FlexibleInstances FunctionalDependencies GADTs KindSignatures MultiParamTypeClasses OverloadedStrings RankNTypes ScopedTypeVariables TypeFamilies TypeOperators
3434 ghc-options: -Wall
3535 build-depends:
36− base >= 4.10 && < 4.18
36+ base >= 4.10 && < 4.16
3737 , containers >= 0.6 && < 0.7
3838 , aeson >= 1.3.1.1 && < 3
39− , jose >= 0.10 && < 0.11
40− , lens >= 4.16.1 && < 5.3
41− , servant >= 0.15 && < 0.20
42− , text >= 1.2.3.0 && < 2.1
39+ , jose >= 0.7.0.0 && < 0.10
40+ , lens >= 4.16.1 && < 5.1
41+ , servant >= 0.15 && < 0.19
42+ , text >= 1.2.3.0 && < 1.3
4343 , unordered-containers >= 0.2.9.0 && < 0.3
4444 exposed-modules:
4545 Servant.Auth
servant-auth/servant-auth/src/Servant/Auth.hs+1−1
@@ -27,7 +27,7 @@ instance HasLink sub => HasLink (Auth (tag :: [*]) value :> sub) where
2727
2828-- ** Combinators
2929
30−-- | A JSON Web Token (JWT) in the Authorization header:
30+-- | A JSON Web Token (JWT) in the the Authorization header:
3131--
3232-- @Authorization: Bearer \<token\>@
3333--
servant-client-core/CHANGELOG.md−31
@@ -1,37 +1,6 @@
11[The latest version of this document is on GitHub.](https://github.com/haskell-servant/servant/blob/master/servant-client-core/CHANGELOG.md)
22[Changelog for `servant` package contains significant entries for all core packages.](https://github.com/haskell-servant/servant/blob/master/servant/CHANGELOG.md)
33
4−Package versions follow the [Package Versioning Policy](https://pvp.haskell.org/): in A.B.C, bumps to either A or B represent major versions.
5−
6−0.19
7−----
8−
9−### Significant changes
10−
11−- Drop support for GHC < 8.6.
12−- Support GHC 9.0 (GHC 9.2 should work as well, but isn't fully tested yet).
13−- Support Aeson 2 ([#1475](https://github.com/haskell-servant/servant/pull/1475)),
14− which fixes a [DOS vulnerability](https://github.com/haskell/aeson/issues/864)
15− related to hash collisions.
16−- Add `NamedRoutes` combinator, making support for records first-class in Servant
17− ([#1388](https://github.com/haskell-servant/servant/pull/1388)).
18−- Add custom type errors for partially applied combinators
19− ([#1289](https://github.com/haskell-servant/servant/pull/1289),
20− [#1486](https://github.com/haskell-servant/servant/pull/1486)).
21−- *servant-client* / *servant-client-core* / *servant-http-streams*: Fix
22− erroneous behavior, where only 2XX status codes would be considered
23− successful, irrelevant of the status parameter specified by the verb
24− combinator. ([#1469](https://github.com/haskell-servant/servant/pull/1469))
25−- *servant-client* / *servant-client-core*: Fix `Show` instance for
26− `Servant.Client.Core.Request`.
27−- *servant-client* / *servant-client-core*: Allow passing arbitrary binary data
28− in Query parameters.
29− ([#1432](https://github.com/haskell-servant/servant/pull/1432)).
30−
31−### Other changes
32−
33−- Various version bumps.
34−
3540.18.3
365------
376
servant-client-core/servant-client-core.cabal+9−9
@@ -1,6 +1,6 @@
11cabal-version: 2.2
22name: servant-client-core
3−version: 0.19
3+version: 0.18.3
44
55synopsis: Core functionality and class for client function generation for servant APIs
66category: Servant, Web
@@ -50,14 +50,14 @@ library
5050 --
5151 -- note: mtl lower bound is so low because of GHC-7.8
5252 build-depends:
53− base >= 4.9 && < 4.18
53+ base >= 4.9 && < 4.16
5454 , bytestring >= 0.10.8.1 && < 0.12
5555 , constraints >= 0.2 && < 0.14
5656 , containers >= 0.5.7.1 && < 0.7
5757 , deepseq >= 1.4.2.0 && < 1.5
58− , text >= 1.2.3.0 && < 2.1
59− , transformers >= 0.5.2.0 && < 0.7
60− , template-haskell >= 2.11.1.0 && < 2.20
58+ , text >= 1.2.3.0 && < 1.3
59+ , transformers >= 0.5.2.0 && < 0.6
60+ , template-haskell >= 2.11.1.0 && < 2.18
6161
6262 if !impl(ghc >= 8.2)
6363 build-depends:
@@ -65,13 +65,13 @@ library
6565
6666 -- Servant dependencies
6767 build-depends:
68− servant >= 0.19
68+ servant >= 0.18.3 && <0.19
6969
7070 -- Other dependencies: Lower bound around what is in the latest Stackage LTS.
7171 -- Here can be exceptions if we really need features from the newer versions.
7272 build-depends:
7373 aeson >= 1.4.1.0 && < 3
74− , base-compat >= 0.10.5 && < 0.13
74+ , base-compat >= 0.10.5 && < 0.12
7575 , base64-bytestring >= 1.0.0.1 && < 1.3
7676 , exceptions >= 0.10.0 && < 0.11
7777 , free >= 5.1 && < 5.2
@@ -104,8 +104,8 @@ test-suite spec
104104 -- Additional dependencies
105105 build-depends:
106106 deepseq >= 1.4.2.0 && < 1.5
107− , hspec >= 2.6.0 && < 2.10
107+ , hspec >= 2.6.0 && < 2.9
108108 , QuickCheck >= 2.12.6.1 && < 2.15
109109
110110 build-tool-depends:
111− hspec-discover:hspec-discover >= 2.6.0 && <2.10
111+ hspec-discover:hspec-discover >= 2.6.0 && <2.9
servant-client-core/src/Servant/Client/Core.hs−1
@@ -59,7 +59,6 @@ module Servant.Client.Core
5959 , appendToPath
6060 , setRequestBodyLBS
6161 , setRequestBody
62− , encodeQueryParamValue
6362 ) where
6463import Servant.Client.Core.Auth
6564import Servant.Client.Core.BaseUrl
servant-client-core/src/Servant/Client/Core/HasClient.hs+21−51
@@ -33,7 +33,9 @@ import Control.Arrow
3333import Control.Monad
3434 (unless)
3535import qualified Data.ByteString as BS
36−import qualified Data.ByteString.Lazy as BL
36+import Data.ByteString.Builder
37+ (toLazyByteString)
38+import qualified Data.ByteString.Lazy as BL
3739import Data.Either
3840 (partitionEithers)
3941import Data.Constraint (Dict(..))
@@ -63,7 +65,7 @@ import Data.Text
6365import Data.Proxy
6466 (Proxy (Proxy))
6567import GHC.TypeLits
66− (KnownNat, KnownSymbol, TypeError, symbolVal)
68+ (KnownNat, KnownSymbol, symbolVal)
6769import Network.HTTP.Types
6870 (Status)
6971import qualified Network.HTTP.Types as H
@@ -74,10 +76,10 @@ import Servant.API
7476 FromSourceIO (..), Header', Headers (..), HttpVersion,
7577 IsSecure, MimeRender (mimeRender),
7678 MimeUnrender (mimeUnrender), NoContent (NoContent),
77− NoContentVerb, QueryFlag, QueryParam', QueryParams, Raw, RawM,
79+ NoContentVerb, QueryFlag, QueryParam', QueryParams, Raw,
7880 ReflectMethod (..), RemoteHost, ReqBody', SBoolI, Stream,
7981 StreamBody', Summary, ToHttpApiData, ToSourceIO (..), Vault,
80− Verb, WithNamedContext, WithResource, WithStatus (..), contentType, getHeadersHList,
82+ Verb, WithNamedContext, WithStatus (..), contentType, getHeadersHList,
8183 getResponse, toEncodedUrlPiece, toUrlPiece, NamedRoutes)
8284import Servant.API.Generic
8385 (GenericMode(..), ToServant, ToServantApi
@@ -89,7 +91,6 @@ import Servant.API.Status
8991import Servant.API.TypeLevel (FragmentUnique, AtLeastOneFragment)
9092import Servant.API.Modifiers
9193 (FoldRequired, RequiredArgument, foldRequiredArgument)
92−import Servant.API.TypeErrors
9394import Servant.API.UVerb
9495 (HasStatus, HasStatuses (Statuses, statuses), UVerb, Union, Unique, inject, statusOf, foldMapUnion, matchUnion)
9596
@@ -208,7 +209,7 @@ instance (KnownSymbol capture, ToHttpApiData a, HasClient m api)
208209 clientWithRoute pm (Proxy :: Proxy api)
209210 (appendToPath p req)
210211
211− where p = toEncodedUrlPiece val
212+ where p = (toUrlPiece val)
212213
213214 hoistClientMonad pm _ f cl = \a ->
214215 hoistClientMonad pm (Proxy :: Proxy api) f (cl a)
@@ -243,7 +244,7 @@ instance (KnownSymbol capture, ToHttpApiData a, HasClient m sublayout)
243244 clientWithRoute pm (Proxy :: Proxy sublayout)
244245 (foldl' (flip appendToPath) req ps)
245246
246− where ps = map toEncodedUrlPiece vals
247+ where ps = map (toUrlPiece) vals
247248
248249 hoistClientMonad pm _ f cl = \as ->
249250 hoistClientMonad pm (Proxy :: Proxy sublayout) f (cl as)
@@ -569,7 +570,7 @@ instance (KnownSymbol sym, ToHttpApiData a, HasClient m api, SBoolI (FoldRequire
569570 (Proxy :: Proxy mods) add (maybe req add) mparam
570571 where
571572 add :: a -> Request
572− add param = appendToQueryString pname (Just $ encodeQueryParamValue param) req
573+ add param = appendToQueryString pname (Just $ encodeQueryParam param) req
573574
574575 pname :: Text
575576 pname = pack $ symbolVal (Proxy :: Proxy sym)
@@ -577,6 +578,9 @@ instance (KnownSymbol sym, ToHttpApiData a, HasClient m api, SBoolI (FoldRequire
577578 hoistClientMonad pm _ f cl = \arg ->
578579 hoistClientMonad pm (Proxy :: Proxy api) f (cl arg)
579580
581+encodeQueryParam :: ToHttpApiData a => a -> BS.ByteString
582+encodeQueryParam = BL.toStrict . toLazyByteString . toEncodedUrlPiece
583+
580584-- | If you use a 'QueryParams' in one of your endpoints in your API,
581585-- the corresponding querying function will automatically take
582586-- an additional argument, a list of values of the type specified
@@ -618,7 +622,7 @@ instance (KnownSymbol sym, ToHttpApiData a, HasClient m api)
618622 )
619623
620624 where pname = pack $ symbolVal (Proxy :: Proxy sym)
621− paramlist' = map (Just . encodeQueryParamValue) paramlist
625+ paramlist' = map (Just . encodeQueryParam) paramlist
622626
623627 hoistClientMonad pm _ f cl = \as ->
624628 hoistClientMonad pm (Proxy :: Proxy api) f (cl as)
@@ -674,16 +678,6 @@ instance RunClient m => HasClient m Raw where
674678
675679 hoistClientMonad _ _ f cl = \meth -> f (cl meth)
676680
677−instance RunClient m => HasClient m RawM where
678− type Client m RawM
679− = H.Method -> m Response
680−
681− clientWithRoute :: Proxy m -> Proxy RawM -> Request -> Client m RawM
682− clientWithRoute _pm Proxy req httpMethod = do
683− runRequest req { requestMethod = httpMethod }
684−
685− hoistClientMonad _ _ f cl = \meth -> f (cl meth)
686−
687681-- | If you use a 'ReqBody' in one of your endpoints in your API,
688682-- the corresponding querying function will automatically take
689683-- an additional argument of the type specified by your 'ReqBody'.
@@ -750,7 +744,7 @@ instance (KnownSymbol path, HasClient m api) => HasClient m (path :> api) where
750744 clientWithRoute pm (Proxy :: Proxy api)
751745 (appendToPath p req)
752746
753− where p = toEncodedUrlPiece $ pack $ symbolVal (Proxy :: Proxy path)
747+ where p = pack $ symbolVal (Proxy :: Proxy path)
754748
755749 hoistClientMonad pm _ f cl = hoistClientMonad pm (Proxy :: Proxy api) f cl
756750
@@ -786,14 +780,6 @@ instance HasClient m subapi =>
786780
787781 hoistClientMonad pm _ f cl = hoistClientMonad pm (Proxy :: Proxy subapi) f cl
788782
789−instance HasClient m subapi =>
790− HasClient m (WithResource res :> subapi) where
791−
792− type Client m (WithResource res :> subapi) = Client m subapi
793− clientWithRoute pm Proxy = clientWithRoute pm (Proxy :: Proxy subapi)
794−
795− hoistClientMonad pm _ f cl = hoistClientMonad pm (Proxy :: Proxy subapi) f cl
796−
797783instance ( HasClient m api
798784 ) => HasClient m (AuthProtect tag :> api) where
799785 type Client m (AuthProtect tag :> api)
@@ -892,7 +878,7 @@ infixl 2 /:
892878--
893879-- Example:
894880--
895−-- @
881+-- @@
896882-- type Api = NamedRoutes RootApi
897883--
898884-- data RootApi mode = RootApi
@@ -912,8 +898,8 @@ infixl 2 /:
912898-- rootClient = client api
913899--
914900-- endpointClient :: ClientM Person
915−-- endpointClient = client \/\/ subApi \/\/ endpoint
916−-- @
901+-- endpointClient = client // subApi // endpoint
902+-- @@
917903(//) :: a -> (a -> b) -> b
918904x // f = f x
919905
@@ -924,7 +910,7 @@ x // f = f x
924910--
925911-- Example:
926912--
927−-- @
913+-- @@
928914-- type Api = NamedRoutes RootApi
929915--
930916-- data RootApi mode = RootApi
@@ -945,11 +931,11 @@ x // f = f x
945931-- rootClient = client api
946932--
947933-- hello :: String -> ClientM String
948−-- hello name = rootClient \/\/ hello \/: name
934+-- hello name = rootClient // hello /: name
949935--
950936-- endpointClient :: ClientM Person
951−-- endpointClient = client \/\/ subApi \/: "foobar123" \/\/ endpoint
952−-- @
937+-- endpointClient = client // subApi /: "foobar123" // endpoint
938+-- @@
953939(/:) :: (a -> b -> c) -> b -> a -> c
954940(/:) = flip
955941
@@ -993,19 +979,3 @@ decodedAs response ct = do
993979 Right val -> return val
994980 where
995981 accept = toList $ contentTypes ct
996−
997−-------------------------------------------------------------------------------
998−-- Custom type errors
999−-------------------------------------------------------------------------------
1000−
1001−-- Erroring instance for HasClient' when a combinator is not fully applied
1002−instance (RunClient m, TypeError (PartialApplication HasClient arr)) => HasClient m ((arr :: a -> b) :> sub)
1003− where
1004− type Client m (arr :> sub) = TypeError (PartialApplication HasClient arr)
1005− clientWithRoute _ _ _ = error "unreachable"
1006− hoistClientMonad _ _ _ _ = error "unreachable"
1007−
1008−-- Erroring instances for 'HasClient' for unknown API combinators
1009−instance {-# OVERLAPPABLE #-} (RunClient m, TypeError (NoInstanceForSub (HasClient m) ty)) => HasClient m (ty :> sub)
1010−
1011−instance {-# OVERLAPPABLE #-} (RunClient m, TypeError (NoInstanceFor (HasClient m api))) => HasClient m api
servant-client-core/src/Servant/Client/Core/Request.hs+5−20
@@ -17,7 +17,6 @@ module Servant.Client.Core.Request (
1717 addHeader,
1818 appendToPath,
1919 appendToQueryString,
20− encodeQueryParamValue,
2120 setRequestBody,
2221 setRequestBodyLBS,
2322 ) where
@@ -34,8 +33,6 @@ import Data.Bifunctor
3433import Data.Bitraversable
3534 (Bitraversable (..), bifoldMapDefault, bimapDefault)
3635import qualified Data.ByteString as BS
37−import Data.ByteString.Builder
38− (Builder)
3936import qualified Data.ByteString.Builder as Builder
4037import qualified Data.ByteString.Lazy as LBS
4138import qualified Data.Sequence as Seq
@@ -114,7 +111,7 @@ instance (NFData path, NFData body) => NFData (RequestF body path) where
114111 rnfB Nothing = ()
115112 rnfB (Just (b, mt)) = rnf b `seq` mediaTypeRnf mt
116113
117−type Request = RequestF RequestBody Builder
114+type Request = RequestF RequestBody Builder.Builder
118115
119116-- | The request body. R replica of the @http-client@ @RequestBody@.
120117data RequestBody
@@ -145,30 +142,18 @@ defaultRequest = Request
145142 , requestMethod = methodGet
146143 }
147144
148−-- | Append extra path to the request being constructed.
149−--
150−-- Warning: This function assumes that the path fragment is already URL-encoded.
151−appendToPath :: Builder -> Request -> Request
145+appendToPath :: Text -> Request -> Request
152146appendToPath p req
153− = req { requestPath = requestPath req <> "/" <> p }
147+ = req { requestPath = requestPath req <> "/" <> toEncodedUrlPiece p }
154148
155−-- | Append a query parameter to the request being constructed.
156−--
157−appendToQueryString :: Text -- ^ query param name
158− -> Maybe BS.ByteString -- ^ query param value
149+appendToQueryString :: Text -- ^ param name
150+ -> Maybe BS.ByteString -- ^ param value
159151 -> Request
160152 -> Request
161153appendToQueryString pname pvalue req
162154 = req { requestQueryString = requestQueryString req
163155 Seq.|> (encodeUtf8 pname, pvalue)}
164156
165−-- | Encode a query parameter value.
166−--
167−encodeQueryParamValue :: ToHttpApiData a => a -> BS.ByteString
168−encodeQueryParamValue = LBS.toStrict . Builder.toLazyByteString . toEncodedUrlPiece
169−
170−-- | Add header to the request being constructed.
171−--
172157addHeader :: ToHttpApiData a => HeaderName -> a -> Request -> Request
173158addHeader name val req
174159 = req { requestHeaders = requestHeaders req Seq.|> (name, toHeader val)}
servant-client-ghcjs/servant-client-ghcjs.cabal+4−4
@@ -38,7 +38,7 @@ library
3838 Servant.Client.Internal.XhrClient
3939
4040 build-depends:
41− base >=4.11 && <5
41+ base >=4.11 && <4.12
4242 , bytestring >=0.10 && <0.12
4343 , case-insensitive >=1.2.0.0 && <1.3.0.0
4444 , containers >=0.5 && <0.7
@@ -48,7 +48,7 @@ library
4848 , http-media >=0.6.2 && <0.9
4949 , http-types >=0.12 && <0.13
5050 , monad-control >=1.0.0.4 && <1.1
51− , mtl ^>=2.2.2 || ^>=2.3.1
51+ , mtl >=2.2.2 && <2.3
5252 , semigroupoids >=5.3 && <5.4
5353 , string-conversions >=0.3 && <0.5
5454 , transformers >=0.3 && <0.6
@@ -56,8 +56,8 @@ library
5656
5757 -- strict, as we re-export stuff
5858 build-depends:
59− servant >=0.16 && <0.20
60− , servant-client-core >=0.16 && <0.20
59+ servant >=0.16 && <0.17
60+ , servant-client-core >=0.16 && <0.16.1
6161
6262 hs-source-dirs: src
6363 default-language: Haskell2010
servant-client-ghcjs/src/Servant/Client/Internal/XhrClient.hs+5−8
@@ -120,7 +120,7 @@ instance Exception StreamingNotSupportedException where
120120 displayException _ = "streamingRequest: streaming is not supported!"
121121
122122instance RunClient ClientM where
123− runRequestAcceptStatus = performRequest
123+ runRequest = performRequest
124124 throwClientError = throwError
125125
126126runClientMOrigin :: ClientM a -> ClientEnv -> IO (Either ClientError a)
@@ -152,18 +152,15 @@ runClientM m = do
152152
153153 runClientMOrigin m (ClientEnv (BaseUrl protocol hostname port ""))
154154
155−performRequest :: Maybe [Status] -> Request -> ClientM Response
156−performRequest acceptStatus req = do
155+performRequest :: Request -> ClientM Response
156+performRequest req = do
157157 xhr <- liftIO initXhr
158158 burl <- asks baseUrl
159159 liftIO $ performXhr xhr burl req
160160 resp <- toResponse xhr
161161
162− let status = responseStatusCode resp
163− goodStatus = case acceptStatus of
164− Nothing -> statusIsSuccessful status
165− Just good -> status `elem` good
166− unless goodStatus $ do
162+ let status = statusCode (responseStatusCode resp)
163+ unless (status >= 200 && status < 300) $ do
167164 let f b = (burl, BL.toStrict $ toLazyByteString b)
168165 throwError $ FailureResponse (bimap (const ()) f req) resp
169166
servant-client/CHANGELOG.md−31
@@ -1,37 +1,6 @@
11[The latest version of this document is on GitHub.](https://github.com/haskell-servant/servant/blob/master/servant-client/CHANGELOG.md)
22[Changelog for `servant` package contains significant entries for all core packages.](https://github.com/haskell-servant/servant/blob/master/servant/CHANGELOG.md)
33
4−Package versions follow the [Package Versioning Policy](https://pvp.haskell.org/): in A.B.C, bumps to either A or B represent major versions.
5−
6−0.19
7−----
8−
9−### Significant changes
10−
11−- Drop support for GHC < 8.6.
12−- Support GHC 9.0 (GHC 9.2 should work as well, but isn't fully tested yet).
13−- Support Aeson 2 ([#1475](https://github.com/haskell-servant/servant/pull/1475)),
14− which fixes a [DOS vulnerability](https://github.com/haskell/aeson/issues/864)
15− related to hash collisions.
16−- Add `NamedRoutes` combinator, making support for records first-class in Servant
17− ([#1388](https://github.com/haskell-servant/servant/pull/1388)).
18−- Add custom type errors for partially applied combinators
19− ([#1289](https://github.com/haskell-servant/servant/pull/1289),
20− [#1486](https://github.com/haskell-servant/servant/pull/1486)).
21−- *servant-client* / *servant-client-core* / *servant-http-streams*: Fix
22− erroneous behavior, where only 2XX status codes would be considered
23− successful, irrelevant of the status parameter specified by the verb
24− combinator. ([#1469](https://github.com/haskell-servant/servant/pull/1469))
25−- *servant-client* / *servant-client-core*: Fix `Show` instance for
26− `Servant.Client.Core.Request`.
27−- *servant-client* / *servant-client-core*: Allow passing arbitrary binary data
28− in Query parameters.
29− ([#1432](https://github.com/haskell-servant/servant/pull/1432)).
30−
31−### Other changes
32−
33−- Various version bumps.
34−
3540.18.3
365------
376
servant-client/servant-client.cabal+13−13
@@ -1,6 +1,6 @@
11cabal-version: 2.2
22name: servant-client
3−version: 0.19
3+version: 0.18.3
44
55synopsis: Automatic derivation of querying functions for servant
66category: Servant, Web
@@ -41,15 +41,15 @@ library
4141 -- Bundled with GHC: Lower bound to not force re-installs
4242 -- text and mtl are bundled starting with GHC-8.4
4343 build-depends:
44− base >= 4.9 && < 4.18
44+ base >= 4.9 && < 4.16
4545 , bytestring >= 0.10.8.1 && < 0.12
4646 , containers >= 0.5.7.1 && < 0.7
4747 , deepseq >= 1.4.2.0 && < 1.5
48− , mtl ^>= 2.2.2 || ^>= 2.3.1
48+ , mtl >= 2.2.2 && < 2.3
4949 , stm >= 2.4.5.1 && < 2.6
50− , text >= 1.2.3.0 && < 2.1
51− , time >= 1.6.0.1 && < 1.13
52− , transformers >= 0.5.2.0 && < 0.7
50+ , text >= 1.2.3.0 && < 1.3
51+ , time >= 1.6.0.1 && < 1.10
52+ , transformers >= 0.5.2.0 && < 0.6
5353
5454 if !impl(ghc >= 8.2)
5555 build-depends:
@@ -58,13 +58,13 @@ library
5858 -- Servant dependencies.
5959 -- Strict dependency on `servant-client-core` as we re-export things.
6060 build-depends:
61− servant >= 0.18 && < 0.20
62− , servant-client-core >= 0.19 && < 0.19.1
61+ servant == 0.18.*
62+ , servant-client-core >= 0.18.3 && <0.18.4
6363
6464 -- Other dependencies: Lower bound around what is in the latest Stackage LTS.
6565 -- Here can be exceptions if we really need features from the newer versions.
6666 build-depends:
67− base-compat >= 0.10.5 && < 0.13
67+ base-compat >= 0.10.5 && < 0.12
6868 , http-client >= 0.5.13.1 && < 0.8
6969 , http-media >= 0.7.1.3 && < 0.9
7070 , http-types >= 0.12.2 && < 0.13
@@ -124,16 +124,16 @@ test-suite spec
124124 -- Additional dependencies
125125 build-depends:
126126 entropy >= 0.4.1.3 && < 0.5
127− , hspec >= 2.6.0 && < 2.10
127+ , hspec >= 2.6.0 && < 2.9
128128 , HUnit >= 1.6.0.0 && < 1.7
129129 , network >= 2.8.0.0 && < 3.2
130130 , QuickCheck >= 2.12.6.1 && < 2.15
131− , servant == 0.19.*
132− , servant-server == 0.19.*
131+ , servant == 0.18.*
132+ , servant-server == 0.18.*
133133 , tdigest >= 0.2 && < 0.3
134134
135135 build-tool-depends:
136− hspec-discover:hspec-discover >= 2.6.0 && < 2.10
136+ hspec-discover:hspec-discover >= 2.6.0 && < 2.9
137137
138138test-suite readme
139139 type: exitcode-stdio-1.0
servant-client/src/Servant/Client/Internal/HttpClient.hs+8−9
@@ -24,7 +24,7 @@ import Control.Monad
2424import Control.Monad.Base
2525 (MonadBase (..))
2626import Control.Monad.Catch
27− (MonadCatch, MonadThrow, MonadMask)
27+ (MonadCatch, MonadThrow)
2828import Control.Monad.Error.Class
2929 (MonadError (..))
3030import Control.Monad.IO.Class
@@ -80,7 +80,7 @@ data ClientEnv
8080 { manager :: Client.Manager
8181 , baseUrl :: BaseUrl
8282 , cookieJar :: Maybe (TVar Client.CookieJar)
83− , makeClientRequest :: BaseUrl -> Request -> IO Client.Request
83+ , makeClientRequest :: BaseUrl -> Request -> Client.Request
8484 -- ^ this function can be used to customize the creation of @http-client@ requests from @servant@ requests. Default value: 'defaultMakeClientRequest'
8585 -- Note that:
8686 -- 1. 'makeClientRequest' exists to allow overriding operational semantics e.g. 'responseTimeout' per request,
@@ -136,7 +136,7 @@ newtype ClientM a = ClientM
136136 { unClientM :: ReaderT ClientEnv (ExceptT ClientError IO) a }
137137 deriving ( Functor, Applicative, Monad, MonadIO, Generic
138138 , MonadReader ClientEnv, MonadError ClientError, MonadThrow
139− , MonadCatch, MonadMask)
139+ , MonadCatch)
140140
141141instance MonadBase IO ClientM where
142142 liftBase = ClientM . liftBase
@@ -162,7 +162,7 @@ runClientM cm env = runExceptT $ flip runReaderT env $ unClientM cm
162162performRequest :: Maybe [Status] -> Request -> ClientM Response
163163performRequest acceptStatus req = do
164164 ClientEnv m burl cookieJar' createClientRequest <- ask
165− clientRequest <- liftIO $ createClientRequest burl req
165+ let clientRequest = createClientRequest burl req
166166 request <- case cookieJar' of
167167 Nothing -> pure clientRequest
168168 Just cj -> liftIO $ do
@@ -229,8 +229,8 @@ clientResponseToResponse f r = Response
229229-- | Create a @http-client@ 'Client.Request' from a @servant@ 'Request'
230230-- The 'Client.host', 'Client.path' and 'Client.port' fields are extracted from the 'BaseUrl'
231231-- otherwise the body, headers and query string are derived from the @servant@ 'Request'
232−defaultMakeClientRequest :: BaseUrl -> Request -> IO Client.Request
233−defaultMakeClientRequest burl r = return Client.defaultRequest
232+defaultMakeClientRequest :: BaseUrl -> Request -> Client.Request
233+defaultMakeClientRequest burl r = Client.defaultRequest
234234 { Client.method = requestMethod r
235235 , Client.host = fromString $ baseUrlHost burl
236236 , Client.port = baseUrlPort burl
@@ -246,7 +246,7 @@ defaultMakeClientRequest burl r = return Client.defaultRequest
246246 where
247247 -- Content-Type and Accept are specified by requestBody and requestAccept
248248 headers = filter (\(h, _) -> h /= "Accept" && h /= "Content-Type") $
249− toList $ requestHeaders r
249+ toList $requestHeaders r
250250
251251 acceptHdr
252252 | null hs = Nothing
@@ -289,8 +289,7 @@ defaultMakeClientRequest burl r = return Client.defaultRequest
289289 Https -> True
290290
291291 -- Query string builder which does not do any encoding
292− buildQueryString [] = mempty
293− buildQueryString qps = "?" <> foldl' addQueryParam mempty qps
292+ buildQueryString = ("?" <>) . foldl' addQueryParam mempty
294293
295294 addQueryParam qs (k, v) =
296295 qs <> (if BS.null qs then mempty else "&") <> urlEncode True k <> foldMap ("=" <>) v
servant-client/src/Servant/Client/Internal/HttpClient/Streaming.hs+6−18
@@ -24,8 +24,7 @@ import Control.DeepSeq
2424 (NFData, force)
2525import Control.Exception
2626 (evaluate, throwIO)
27−import Control.Monad
28− (unless)
27+import Control.Monad ()
2928import Control.Monad.Base
3029 (MonadBase (..))
3130import Control.Monad.Codensity
@@ -141,7 +140,7 @@ performRequest :: Maybe [Status] -> Request -> ClientM Response
141140performRequest acceptStatus req = do
142141 -- TODO: should use Client.withResponse here too
143142 ClientEnv m burl cookieJar' createClientRequest <- ask
144− clientRequest <- liftIO $ createClientRequest burl req
143+ let clientRequest = createClientRequest burl req
145144 request <- case cookieJar' of
146145 Nothing -> pure clientRequest
147146 Just cj -> liftIO $ do
@@ -175,21 +174,10 @@ performRequest acceptStatus req = do
175174-- | TODO: support UVerb ('acceptStatus' argument, like in 'performRequest' above).
176175performWithStreamingRequest :: Request -> (StreamingResponse -> IO a) -> ClientM a
177176performWithStreamingRequest req k = do
178− ClientEnv m burl cookieJar' createClientRequest <- ask
179− clientRequest <- liftIO $ createClientRequest burl req
180− request <- case cookieJar' of
181− Nothing -> pure clientRequest
182− Just cj -> liftIO $ do
183− now <- getCurrentTime
184− atomically $ do
185− oldCookieJar <- readTVar cj
186− let (newRequest, newCookieJar) =
187− Client.insertCookiesIntoRequest
188− clientRequest
189− oldCookieJar
190− now
191− writeTVar cj newCookieJar
192− pure newRequest
177+ m <- asks manager
178+ burl <- asks baseUrl
179+ createClientRequest <- asks makeClientRequest
180+ let request = createClientRequest burl req
193181 ClientM $ lift $ lift $ Codensity $ \k1 ->
194182 Client.withResponse request m $ \res -> do
195183 let status = Client.responseStatus res
servant-client/test/Servant/ClientTestUtils.hs+1−13
@@ -160,7 +160,6 @@ type Api =
160160 WithStatus 301 Text]
161161 :<|> "uverb-get-created" :> UVerb 'GET '[PlainText] '[WithStatus 201 Person]
162162 :<|> NamedRoutes RecordRoutes
163− :<|> "captureVerbatim" :> Capture "someString" Verbatim :> Get '[PlainText] Text
164163
165164api :: Proxy Api
166165api = Proxy
@@ -215,8 +214,7 @@ getRoot
215214 :<|> EmptyClient
216215 :<|> uverbGetSuccessOrRedirect
217216 :<|> uverbGetCreated
218− :<|> recordRoutes
219− :<|> captureVerbatim = client api
217+ :<|> recordRoutes = client api
220218
221219server :: Application
222220server = serve api (
@@ -261,7 +259,6 @@ server = serve api (
261259 { something = pure ["foo", "bar", "pweet"]
262260 }
263261 }
264− :<|> pure . decodeUtf8 . unVerbatim
265262 )
266263
267264-- * api for testing failures
@@ -373,12 +370,3 @@ instance ToHttpApiData UrlEncodedByteString where
373370
374371instance FromHttpApiData UrlEncodedByteString where
375372 parseUrlPiece = pure . UrlEncodedByteString . HTTP.urlDecode True . encodeUtf8
376−
377−newtype Verbatim = Verbatim { unVerbatim :: ByteString }
378−
379−instance ToHttpApiData Verbatim where
380− toEncodedUrlPiece = byteString . unVerbatim
381− toUrlPiece = decodeUtf8 . unVerbatim
382−
383−instance FromHttpApiData Verbatim where
384− parseUrlPiece = pure . Verbatim . encodeUtf8
servant-client/test/Servant/SuccessSpec.hs+1−11
@@ -36,8 +36,6 @@ import Data.Maybe
3636import Data.Monoid ()
3737import Data.Text
3838 (Text)
39−import Data.Text.Encoding
40− (encodeUtf8)
4139import qualified Network.HTTP.Client as C
4240import qualified Network.HTTP.Types as HTTP
4341import Test.Hspec
@@ -162,8 +160,7 @@ successSpec = beforeAll (startWaiApp server) $ afterAll endWaiApp $ do
162160 mgr <- C.newManager C.defaultManagerSettings
163161 -- In proper situation, extra headers should probably be visible in API type.
164162 -- However, testing for response timeout is difficult, so we test with something which is easy to observe
165− let createClientRequest url r = fmap (\req -> req { C.requestHeaders = [("X-Added-Header", "XXX")] })
166− (defaultMakeClientRequest url r)
163+ let createClientRequest url r = (defaultMakeClientRequest url r) { C.requestHeaders = [("X-Added-Header", "XXX")] }
167164 clientEnv = (mkClientEnv mgr baseUrl) { makeClientRequest = createClientRequest }
168165 res <- runClientM (getRawSuccessPassHeaders HTTP.methodGet) clientEnv
169166 case res of
@@ -199,10 +196,3 @@ successSpec = beforeAll (startWaiApp server) $ afterAll endWaiApp $ do
199196 case eitherResponse of
200197 Left clientError -> fail $ show clientError
201198 Right response -> matchUnion response `shouldBe` Just (WithStatus @201 carol)
202−
203− it "encodes URL pieces following ToHttpApiData instance" $ \(_, baseUrl) -> do
204− let textOrig = "*"
205− eitherResponse <- runClient (captureVerbatim $ Verbatim $ encodeUtf8 textOrig) baseUrl
206− case eitherResponse of
207− Left clientError -> fail $ show clientError
208− Right textBack -> textBack `shouldBe` textOrig
servant-conduit/servant-conduit.cabal+6−6
@@ -23,7 +23,7 @@ extra-source-files:
2323
2424source-repository head
2525 type: git
26− location: http://github.com/haskell-servant/servant.git
26+ location: http://github.com/haskell-servant/servant-conduit.git
2727
2828library
2929 exposed-modules: Servant.Conduit
@@ -31,9 +31,9 @@ library
3131 base >=4.9 && <5
3232 , bytestring >=0.10.8.1 && <0.12
3333 , conduit >=1.3.1 && <1.4
34− , mtl ^>=2.2.2 || ^>=2.3.1
35− , resourcet >=1.2.2 && <1.4
36− , servant >=0.15 && <0.20
34+ , mtl >=2.2.2 && <2.3
35+ , resourcet >=1.2.2 && <1.3
36+ , servant >=0.15 && <0.19
3737 , unliftio-core >=0.1.2.0 && <0.3
3838 hs-source-dirs: src
3939 default-language: Haskell2010
@@ -54,8 +54,8 @@ test-suite example
5454 , resourcet
5555 , servant
5656 , servant-conduit
57− , servant-server >=0.15 && <0.20
58− , servant-client >=0.15 && <0.20
57+ , servant-server >=0.15 && <0.19
58+ , servant-client >=0.15 && <0.19
5959 , wai >=3.2.1.2 && <3.3
6060 , warp >=3.2.25 && <3.4
6161 , http-client
servant-docs/CHANGELOG.md−9
@@ -1,15 +1,6 @@
11[The latest version of this document is on GitHub.](https://github.com/haskell-servant/servant/blob/master/servant-docs/CHANGELOG.md)
22[Changelog for `servant` package contains significant entries for all core packages.](https://github.com/haskell-servant/servant/blob/master/servant/CHANGELOG.md)
33
4−0.12
5−----
6−
7−### Significant changes
8−
9−- Generate sample cURL requests
10− ([#1401](https://github.com/haskell-servant/servant/pull/1401/files)).
11− Breaking change: requires sample header values to be supplied with `headers`.
12−
1340.11.9
145------
156
servant-docs/golden/comprehensive.md−18
@@ -530,24 +530,6 @@
530530
531531```
532532
533−## GET /resource
534−
535−### Response:
536−
537−- Status code 200
538−- Headers: []
539−
540−- Supported content types are:
541−
542− - `application/json;charset=utf-8`
543− - `application/json`
544−
545−- Example (`application/json;charset=utf-8`, `application/json`):
546−
547−```javascript
548−
549−```
550−
551533## GET /streaming
552534
553535### Request:
servant-docs/servant-docs.cabal+7−7
@@ -1,6 +1,6 @@
11cabal-version: 2.2
22name: servant-docs
3−version: 0.12
3+version: 0.11.9
44
55synopsis: generate API docs for your servant webservice
66category: Servant, Web
@@ -41,25 +41,25 @@ library
4141 --
4242 -- note: mtl lower bound is so low because of GHC-7.8
4343 build-depends:
44− base >= 4.9 && < 4.18
44+ base >= 4.9 && < 4.16
4545 , bytestring >= 0.10.8.1 && < 0.12
46− , text >= 1.2.3.0 && < 2.1
46+ , text >= 1.2.3.0 && < 1.3
4747
4848 -- Servant dependencies
4949 build-depends:
50− servant >= 0.18 && <0.20
50+ servant >= 0.18 && <0.19
5151
5252 -- Other dependencies: Lower bound around what is in the latest Stackage LTS.
5353 -- Here can be exceptions if we really need features from the newer versions.
5454 build-depends:
5555 aeson >= 1.4.1.0 && < 3
5656 , aeson-pretty >= 0.8.5 && < 0.9
57− , base-compat >= 0.10.5 && < 0.13
57+ , base-compat >= 0.10.5 && < 0.12
5858 , case-insensitive >= 1.2.0.11 && < 1.3
59− , hashable >= 1.2.7.0 && < 1.5
59+ , hashable >= 1.2.7.0 && < 1.4
6060 , http-media >= 0.7.1.3 && < 0.9
6161 , http-types >= 0.12.2 && < 0.13
62− , lens >= 4.17 && < 5.3
62+ , lens >= 4.17 && < 5.1
6363 , string-conversions >= 0.4.0.1 && < 0.5
6464 , universe-base >= 1.1.1 && < 1.2
6565 , unordered-containers >= 0.2.9.0 && < 0.3
servant-docs/src/Servant/Docs/Internal.hs+1−8
@@ -62,7 +62,6 @@ import GHC.TypeLits
6262import Servant.API
6363import Servant.API.ContentTypes
6464import Servant.API.TypeLevel
65−import Servant.API.Generic
6665
6766import qualified Data.Universe.Helpers as U
6867
@@ -447,7 +446,7 @@ docsWith opts intros (ExtraInfo endpoints) p =
447446 & apiEndpoints %~ HM.unionWith (flip combineAction) endpoints
448447
449448
450−-- | Generate the docs for a given API that implements 'HasDocs' with any
449+-- | Generate the docs for a given API that implements 'HasDocs' with with any
451450-- number of introduction(s)
452451docsWithIntros :: HasDocs api => [DocIntro] -> Proxy api -> API
453452docsWithIntros intros = docsWith defaultDocOptions intros mempty
@@ -1144,9 +1143,6 @@ instance HasDocs api => HasDocs (Vault :> api) where
11441143instance HasDocs api => HasDocs (WithNamedContext name context api) where
11451144 docsFor Proxy = docsFor (Proxy :: Proxy api)
11461145
1147−instance HasDocs api => HasDocs (WithResource res :> api) where
1148− docsFor Proxy = docsFor (Proxy :: Proxy api)
1149−
11501146instance (ToAuthInfo (BasicAuth realm usr), HasDocs api) => HasDocs (BasicAuth realm usr :> api) where
11511147 docsFor Proxy (endpoint, action) =
11521148 docsFor (Proxy :: Proxy api) (endpoint, action')
@@ -1154,9 +1150,6 @@ instance (ToAuthInfo (BasicAuth realm usr), HasDocs api) => HasDocs (BasicAuth r
11541150 authProxy = Proxy :: Proxy (BasicAuth realm usr)
11551151 action' = over authInfo (|> toAuthInfo authProxy) action
11561152
1157−instance HasDocs (ToServantApi api) => HasDocs (NamedRoutes api) where
1158− docsFor Proxy = docsFor (Proxy :: Proxy (ToServantApi api))
1159−
11601153-- ToSample instances for simple types
11611154instance ToSample NoContent
11621155instance ToSample Bool
servant-foreign/servant-foreign.cabal+7−7
@@ -41,18 +41,18 @@ library
4141 --
4242 -- note: mtl lower bound is so low because of GHC-7.8
4343 build-depends:
44− base >= 4.9 && < 4.18
45− , text >= 1.2.3.0 && < 2.1
44+ base >= 4.9 && < 4.16
45+ , text >= 1.2.3.0 && < 1.3
4646
4747 -- Servant dependencies
4848 build-depends:
49− servant >=0.18 && <0.20
49+ servant >=0.18 && <0.19
5050
5151 -- Other dependencies: Lower bound around what is in the latest Stackage LTS.
5252 -- Here can be exceptions if we really need features from the newer versions.
5353 build-depends:
54− base-compat >= 0.10.5 && < 0.13
55− , lens >= 4.17 && < 5.3
54+ base-compat >= 0.10.5 && < 0.12
55+ , lens >= 4.17 && < 5.1
5656 , http-types >= 0.12.2 && < 0.13
5757
5858 hs-source-dirs: src
@@ -74,7 +74,7 @@ test-suite spec
7474
7575 -- Additional dependencies
7676 build-depends:
77− hspec >= 2.6.0 && <2.10
77+ hspec >= 2.6.0 && <2.9
7878 build-tool-depends:
79− hspec-discover:hspec-discover >=2.6.0 && <2.10
79+ hspec-discover:hspec-discover >=2.6.0 && <2.9
8080 default-language: Haskell2010
servant-foreign/src/Servant/Foreign/Internal.hs−7
@@ -487,13 +487,6 @@ instance HasForeign lang ftype api =>
487487
488488 foreignFor lang ftype Proxy = foreignFor lang ftype (Proxy :: Proxy api)
489489
490−instance HasForeign lang ftype api =>
491− HasForeign lang ftype (WithResource res :> api) where
492−
493− type Foreign ftype (WithResource res :> api) = Foreign ftype api
494−
495− foreignFor lang ftype Proxy = foreignFor lang ftype (Proxy :: Proxy api)
496−
497490instance HasForeign lang ftype api
498491 => HasForeign lang ftype (HttpVersion :> api) where
499492 type Foreign ftype (HttpVersion :> api) = Foreign ftype api
servant-http-streams/CHANGELOG.md−10
@@ -1,16 +1,6 @@
11 [The latest version of this document is on GitHub.](https://github.com/haskell-servant/servant/blob/master/servant-http-streams/CHANGELOG.md)
22[Changelog for `servant` package contains significant entries for all core packages.](https://github.com/haskell-servant/servant/blob/master/servant/CHANGELOG.md)
33
4−0.18.4
5−------
6−
7−### Significant changes
8−
9−- *servant-client* / *servant-client-core* / *servant-http-streams*:
10− Fix erroneous behavior, where only 2XX status codes would be considered
11− successful, irrelevant of the status parameter specified by the verb
12− combinator. ([#1469](https://github.com/haskell-servant/servant/pull/1469))
13−
1440.18.3
155------
166
servant-http-streams/servant-http-streams.cabal+15−15
@@ -1,6 +1,6 @@
11cabal-version: 2.2
22name: servant-http-streams
3−version: 0.18.4
3+version: 0.18.3
44
55synopsis: Automatic derivation of querying functions for servant
66category: Servant, Web
@@ -38,14 +38,14 @@ library
3838 -- Bundled with GHC: Lower bound to not force re-installs
3939 -- text and mtl are bundled starting with GHC-8.4
4040 build-depends:
41− base >= 4.9 && < 4.18
41+ base >= 4.9 && < 4.16
4242 , bytestring >= 0.10.8.1 && < 0.12
4343 , containers >= 0.5.7.1 && < 0.7
4444 , deepseq >= 1.4.2.0 && < 1.5
45− , mtl ^>= 2.2.2 || ^>= 2.3.1
46− , text >= 1.2.3.0 && < 2.1
47− , time >= 1.6.0.1 && < 1.13
48− , transformers >= 0.5.2.0 && < 0.7
45+ , mtl >= 2.2.2 && < 2.3
46+ , text >= 1.2.3.0 && < 1.3
47+ , time >= 1.6.0.1 && < 1.10
48+ , transformers >= 0.5.2.0 && < 0.6
4949
5050 if !impl(ghc >= 8.2)
5151 build-depends:
@@ -54,25 +54,25 @@ library
5454 -- Servant dependencies.
5555 -- Strict dependency on `servant-client-core` as we re-export things.
5656 build-depends:
57− servant >= 0.18 && < 0.20
58− , servant-client-core >= 0.18.3 && <0.20
57+ servant == 0.18.*
58+ , servant-client-core >= 0.18.3 && <0.18.4
5959
6060 -- Other dependencies: Lower bound around what is in the latest Stackage LTS.
6161 -- Here can be exceptions if we really need features from the newer versions.
6262 build-depends:
63− base-compat >= 0.10.5 && < 0.13
63+ base-compat >= 0.10.5 && < 0.12
6464 , case-insensitive
6565 , http-streams >= 0.8.6.1 && < 0.9
6666 , http-media >= 0.7.1.3 && < 0.9
6767 , io-streams >= 1.5.0.1 && < 1.6
6868 , http-types >= 0.12.2 && < 0.13
69− , http-common >= 0.8.2.0 && < 0.9
69+ , http-common >= 0.8.2.0 && < 0.8.3
7070 , exceptions >= 0.10.0 && < 0.11
7171 , kan-extensions >= 5.2 && < 5.3
7272 , monad-control >= 1.0.2.3 && < 1.1
7373 , semigroupoids >= 5.3.1 && < 5.4
7474 , transformers-base >= 0.4.5.2 && < 0.5
75− , transformers-compat >= 0.6.2 && < 0.8
75+ , transformers-compat >= 0.6.2 && < 0.7
7676
7777 hs-source-dirs: src
7878 default-language: Haskell2010
@@ -112,16 +112,16 @@ test-suite spec
112112 -- Additional dependencies
113113 build-depends:
114114 entropy >= 0.4.1.3 && < 0.5
115− , hspec >= 2.6.0 && < 2.10
115+ , hspec >= 2.6.0 && < 2.9
116116 , HUnit >= 1.6.0.0 && < 1.7
117117 , network >= 2.8.0.0 && < 3.2
118118 , QuickCheck >= 2.12.6.1 && < 2.15
119− , servant == 0.19.*
120− , servant-server == 0.19.*
119+ , servant == 0.18.*
120+ , servant-server == 0.18.*
121121 , tdigest >= 0.2 && < 0.3
122122
123123 build-tool-depends:
124− hspec-discover:hspec-discover >= 2.6.0 && < 2.10
124+ hspec-discover:hspec-discover >= 2.6.0 && < 2.9
125125
126126test-suite readme
127127 type: exitcode-stdio-1.0
servant-machines/servant-machines.cabal+5−5
@@ -23,7 +23,7 @@ extra-source-files:
2323
2424source-repository head
2525 type: git
26− location: http://github.com/haskell-servant/servant.git
26+ location: http://github.com/haskell-servant/servant-machines.git
2727
2828library
2929 exposed-modules: Servant.Machines
@@ -31,8 +31,8 @@ library
3131 base >=4.9 && <5
3232 , bytestring >=0.10.8.1 && <0.12
3333 , machines >=0.6.4 && <0.8
34− , mtl ^>=2.2.2 || ^>=2.3.1
35− , servant >=0.15 && <0.20
34+ , mtl >=2.2.2 && <2.3
35+ , servant >=0.15 && <0.19
3636 hs-source-dirs: src
3737 default-language: Haskell2010
3838 ghc-options: -Wall
@@ -51,8 +51,8 @@ test-suite example
5151 , servant
5252 , machines
5353 , servant-machines
54− , servant-server >=0.15 && <0.20
55− , servant-client >=0.15 && <0.20
54+ , servant-server >=0.15 && <0.19
55+ , servant-client >=0.15 && <0.19
5656 , wai >=3.2.1.2 && <3.3
5757 , warp >=3.2.25 && <3.4
5858 , http-client
servant-pipes/servant-pipes.cabal+5−5
@@ -23,7 +23,7 @@ extra-source-files:
2323
2424source-repository head
2525 type: git
26− location: http://github.com/haskell-servant/servant.git
26+ location: http://github.com/haskell-servant/servant-pipes.git
2727
2828library
2929 exposed-modules: Servant.Pipes
@@ -32,9 +32,9 @@ library
3232 , bytestring >=0.10.8.1 && <0.12
3333 , pipes >=4.3.9 && <4.4
3434 , pipes-safe >=2.3.1 && <2.4
35− , mtl ^>=2.2.2 || ^>=2.3.1
35+ , mtl >=2.2.2 && <2.3
3636 , monad-control >=1.0.2.3 && <1.1
37− , servant >=0.15 && <0.20
37+ , servant >=0.15 && <0.19
3838 hs-source-dirs: src
3939 default-language: Haskell2010
4040 ghc-options: -Wall
@@ -55,8 +55,8 @@ test-suite example
5555 , pipes-safe
5656 , servant-pipes
5757 , pipes-bytestring >=2.1.6 && <2.2
58− , servant-server >=0.15 && <0.20
59− , servant-client >=0.15 && <0.20
58+ , servant-server >=0.15 && <0.19
59+ , servant-client >=0.15 && <0.19
6060 , wai >=3.2.1.2 && <3.3
6161 , warp >=3.2.25 && <3.4
6262 , http-client
servant-server/CHANGELOG.md−30
@@ -1,36 +1,6 @@
11[The latest version of this document is on GitHub.](https://github.com/haskell-servant/servant/blob/master/servant-server/CHANGELOG.md)
22[Changelog for `servant` package contains significant entries for all core packages.](https://github.com/haskell-servant/servant/blob/master/servant/CHANGELOG.md)
33
4−Package versions follow the [Package Versioning Policy](https://pvp.haskell.org/): in A.B.C, bumps to either A or B represent major versions.
5−
6−0.19.2
7−------
8−
9−Compatibility with GHC 9.4, see [PR #1592](https://github.com/haskell-servant/servant/pull/1592).
10−
11−0.19.1
12−------
13−
14−- Add `MonadFail` instance for `Handler` wrt [#1545](https://github.com/haskell-servant/servant/issues/1545)
15−- Support GHC 9.2 [#1525](https://github.com/haskell-servant/servant/issues/1525)
16−- Add capture hints in `Router` type for debug and display purposes [PR #1556] (https://github.com/haskell-servant/servant/pull/1556)
17−
18−0.19
19−----
20−
21−### Significant changes
22−
23−- Drop support for GHC < 8.6.
24−- Support GHC 9.0 (GHC 9.2 should work as well, but isn't fully tested yet).
25−- Support Aeson 2 ([#1475](https://github.com/haskell-servant/servant/pull/1475)),
26− which fixes a [DOS vulnerability](https://github.com/haskell/aeson/issues/864)
27− related to hash collisions.
28−- Add `NamedRoutes` combinator, making support for records first-class in Servant
29− ([#1388](https://github.com/haskell-servant/servant/pull/1388)).
30−- Add custom type errors for partially applied combinators
31− ([#1289](https://github.com/haskell-servant/servant/pull/1289),
32− [#1486](https://github.com/haskell-servant/servant/pull/1486)).
33−
3440.18.3
355------
366
servant-server/example/greet.hs+1
@@ -18,6 +18,7 @@ import Network.Wai.Handler.Warp
1818
1919import Servant
2020import Servant.Server.Generic ()
21+import Servant.API.Generic
2122
2223-- * Example
2324
servant-server/servant-server.cabal+13−13
@@ -1,6 +1,6 @@
11cabal-version: 2.2
22name: servant-server
3−version: 0.19.2
3+version: 0.18.3
44
55synopsis: A family of combinators for defining webservices APIs and serving them
66category: Servant, Web
@@ -23,7 +23,7 @@ author: Servant Contributors
2323maintainer: haskell-servant-maintainers@googlegroups.com
2424copyright: 2014-2016 Zalora South East Asia Pte Ltd, 2016-2019 Servant Contributors
2525build-type: Simple
26−tested-with: GHC ==8.6.5 || ==8.8.4 || ==8.10.7 || ==9.0.2 || ==9.2.4 || ==9.4.3
26+tested-with: GHC ==8.6.5 || ==8.8.4 || ==8.10.2 || ==9.0.1
2727
2828extra-source-files:
2929 CHANGELOG.md
@@ -60,25 +60,25 @@ library
6060 -- Bundled with GHC: Lower bound to not force re-installs
6161 -- text and mtl are bundled starting with GHC-8.4
6262 build-depends:
63− base >= 4.9 && < 4.18
63+ base >= 4.9 && < 4.16
6464 , bytestring >= 0.10.8.1 && < 0.12
6565 , constraints >= 0.2 && < 0.14
6666 , containers >= 0.5.7.1 && < 0.7
67− , mtl ^>= 2.2.2 || ^>= 2.3.1
68− , text >= 1.2.3.0 && < 2.1
69− , transformers >= 0.5.2.0 && < 0.7
67+ , mtl >= 2.2.2 && < 2.3
68+ , text >= 1.2.3.0 && < 1.3
69+ , transformers >= 0.5.2.0 && < 0.6
7070 , filepath >= 1.4.1.1 && < 1.5
7171
7272 -- Servant dependencies
7373 -- strict dependency as we re-export 'servant' things.
7474 build-depends:
75− servant >= 0.19 && < 0.20
76− , http-api-data >= 0.4.1 && < 0.5.1
75+ servant >= 0.18.3 && < 0.18.4
76+ , http-api-data >= 0.4.1 && < 0.4.4
7777
7878 -- Other dependencies: Lower bound around what is in the latest Stackage LTS.
7979 -- Here can be exceptions if we really need features from the newer versions.
8080 build-depends:
81− base-compat >= 0.10.5 && < 0.13
81+ base-compat >= 0.10.5 && < 0.12
8282 , base64-bytestring >= 1.0.0.1 && < 1.3
8383 , exceptions >= 0.10.0 && < 0.11
8484 , http-media >= 0.7.1.3 && < 0.9
@@ -88,10 +88,10 @@ library
8888 , network >= 2.8 && < 3.2
8989 , sop-core >= 0.4.0.0 && < 0.6
9090 , string-conversions >= 0.4.0.1 && < 0.5
91− , resourcet >= 1.2.2 && < 1.4
91+ , resourcet >= 1.2.2 && < 1.3
9292 , tagged >= 0.8.6 && < 0.9
9393 , transformers-base >= 0.4.5.2 && < 0.5
94− , wai >= 3.2.2.1 && < 3.3
94+ , wai >= 3.2.1.2 && < 3.3
9595 , wai-app-static >= 3.1.6.2 && < 3.2
9696 , word8 >= 0.1.3 && < 0.2
9797
@@ -159,7 +159,7 @@ test-suite spec
159159 build-depends:
160160 aeson >= 1.4.1.0 && < 3
161161 , directory >= 1.3.0.0 && < 1.4
162− , hspec >= 2.6.0 && < 2.10
162+ , hspec >= 2.6.0 && < 2.9
163163 , hspec-wai >= 0.10.1 && < 0.12
164164 , QuickCheck >= 2.12.6.1 && < 2.15
165165 , should-not-typecheck >= 2.1.0 && < 2.2
@@ -167,4 +167,4 @@ test-suite spec
167167 , wai-extra >= 3.0.24.3 && < 3.2
168168
169169 build-tool-depends:
170− hspec-discover:hspec-discover >= 2.6.0 && <2.10
170+ hspec-discover:hspec-discover >= 2.6.0 && <2.9
servant-server/src/Servant/Server.hs+2−3
@@ -235,7 +235,7 @@ hoistServer p = hoistServerWithContext p (Proxy :: Proxy '[])
235235-- > │ └─ e/
236236-- > │ └─•
237237-- > ├─ b/
238−-- > │ └─ <x::Int>/
238+-- > │ └─ <capture>/
239239-- > │ ├─•
240240-- > │ ┆
241241-- > │ └─•
@@ -252,8 +252,7 @@ hoistServer p = hoistServerWithContext p (Proxy :: Proxy '[])
252252--
253253-- [@─•@] Leaves reflect endpoints.
254254--
255−-- [@\<x::Int\>/@] This is a delayed capture of a single
256−-- path component named @x@, of expected type @Int@.
255+-- [@\<capture\>/@] This is a delayed capture of a path component.
257256--
258257-- [@\<raw\>@] This is a part of the API we do not know anything about.
259258--
servant-server/src/Servant/Server/Experimental/Auth.hs+1−2
@@ -1,6 +1,5 @@
11{-# OPTIONS_GHC -fno-warn-orphans #-}
22{-# LANGUAGE DeriveDataTypeable #-}
3−{-# LANGUAGE DeriveFunctor #-}
43{-# LANGUAGE DeriveGeneric #-}
54{-# LANGUAGE FlexibleContexts #-}
65{-# LANGUAGE FlexibleInstances #-}
@@ -45,7 +44,7 @@ type family AuthServerData a :: *
4544-- NOTE: THIS API IS EXPERIMENTAL AND SUBJECT TO CHANGE
4645newtype AuthHandler r usr = AuthHandler
4746 { unAuthHandler :: r -> Handler usr }
48− deriving (Functor, Generic, Typeable)
47+ deriving (Generic, Typeable)
4948
5049-- | NOTE: THIS API IS EXPERIMENTAL AND SUBJECT TO CHANGE
5150mkAuthHandler :: (r -> Handler usr) -> AuthHandler r usr
servant-server/src/Servant/Server/Internal.hs+40−111
@@ -1,12 +1,10 @@
11{-# LANGUAGE AllowAmbiguousTypes #-}
22{-# LANGUAGE ConstraintKinds #-}
3−{-# LANGUAGE CPP #-}
43{-# LANGUAGE DataKinds #-}
54{-# LANGUAGE DeriveDataTypeable #-}
65{-# LANGUAGE FlexibleContexts #-}
76{-# LANGUAGE FlexibleInstances #-}
87{-# LANGUAGE InstanceSigs #-}
9−{-# LANGUAGE LambdaCase #-}
108{-# LANGUAGE MultiParamTypeClasses #-}
119{-# LANGUAGE OverloadedStrings #-}
1210{-# LANGUAGE PolyKinds #-}
@@ -36,15 +34,14 @@ module Servant.Server.Internal
3634import Control.Monad
3735 (join, when)
3836import Control.Monad.Trans
39− (liftIO, lift)
37+ (liftIO)
4038import Control.Monad.Trans.Resource
41− (runResourceT, ReleaseKey)
42−import Data.Acquire
39+ (runResourceT)
4340import qualified Data.ByteString as B
4441import qualified Data.ByteString.Builder as BB
4542import qualified Data.ByteString.Char8 as BC8
4643import qualified Data.ByteString.Lazy as BL
47−import Data.Constraint (Constraint, Dict(..))
44+import Data.Constraint (Dict(..))
4845import Data.Either
4946 (partitionEithers)
5047import Data.Maybe
@@ -59,14 +56,14 @@ import qualified Data.Text as T
5956import Data.Typeable
6057import GHC.Generics
6158import GHC.TypeLits
62− (KnownNat, KnownSymbol, TypeError, symbolVal)
59+ (KnownNat, KnownSymbol, symbolVal)
6360import qualified Network.HTTP.Media as NHM
6461import Network.HTTP.Types hiding
6562 (Header, ResponseHeaders)
6663import Network.Socket
6764 (SockAddr)
6865import Network.Wai
69− (Application, Request, Response, ResponseReceived, httpVersion, isSecure, lazyRequestBody,
66+ (Application, Request, httpVersion, isSecure, lazyRequestBody,
7067 queryString, remoteHost, getRequestBodyChunk, requestHeaders,
7168 requestMethod, responseLBS, responseStream, vault)
7269import Prelude ()
@@ -76,10 +73,10 @@ import Servant.API
7673 CaptureAll, Description, EmptyAPI, Fragment,
7774 FramingRender (..), FramingUnrender (..), FromSourceIO (..),
7875 Header', If, IsSecure (..), NoContentVerb, QueryFlag,
79− QueryParam', QueryParams, Raw, RawM, ReflectMethod (reflectMethod),
76+ QueryParam', QueryParams, Raw, ReflectMethod (reflectMethod),
8077 RemoteHost, ReqBody', SBool (..), SBoolI (..), SourceIO,
8178 Stream, StreamBody', Summary, ToSourceIO (..), Vault, Verb,
82− WithNamedContext, WithResource, NamedRoutes)
79+ WithNamedContext, NamedRoutes)
8380import Servant.API.Generic (GenericMode(..), ToServant, ToServantApi, GServantProduct, toServant, fromServant)
8481import Servant.API.ContentTypes
8582 (AcceptHeader (..), AllCTRender (..), AllCTUnrender (..),
@@ -93,12 +90,9 @@ import Servant.API.ResponseHeaders
9390import Servant.API.Status
9491 (statusFromNat)
9592import qualified Servant.Types.SourceT as S
96−import Servant.API.TypeErrors
9793import Web.HttpApiData
9894 (FromHttpApiData, parseHeader, parseQueryParam, parseUrlPiece,
9995 parseUrlPieces)
100−import Data.Kind
101− (Type)
10296
10397import Servant.Server.Internal.BasicAuth
10498import Servant.Server.Internal.Context
@@ -117,10 +111,6 @@ import Servant.API.TypeLevel
117111 (AtLeastOneFragment, FragmentUnique)
118112
119113class HasServer api context where
120− -- | The type of a server for this API, given a monad to run effects in.
121− --
122− -- Note that the result kind is @*@, so it is /not/ a monad transformer, unlike
123− -- what the @T@ in the name might suggest.
124114 type ServerT api (m :: * -> *) :: *
125115
126116 route ::
@@ -182,7 +172,7 @@ instance (HasServer a context, HasServer b context) => HasServer (a :<|> b) cont
182172-- > server = getBook
183173-- > where getBook :: Text -> Handler Book
184174-- > getBook isbn = ...
185−instance (KnownSymbol capture, FromHttpApiData a, Typeable a
175+instance (KnownSymbol capture, FromHttpApiData a
186176 , HasServer api context, SBoolI (FoldLenient mods)
187177 , HasContextEntry (MkContextWithErrorFormatter context) ErrorFormatters
188178 )
@@ -194,7 +184,7 @@ instance (KnownSymbol capture, FromHttpApiData a, Typeable a
194184 hoistServerWithContext _ pc nt s = hoistServerWithContext (Proxy :: Proxy api) pc nt . s
195185
196186 route Proxy context d =
197− CaptureRouter [hint] $
187+ CaptureRouter $
198188 route (Proxy :: Proxy api)
199189 context
200190 (addCapture d $ \ txt -> withRequest $ \ request ->
@@ -206,7 +196,6 @@ instance (KnownSymbol capture, FromHttpApiData a, Typeable a
206196 where
207197 rep = typeRep (Proxy :: Proxy Capture')
208198 formatError = urlParseErrorFormatter $ getContextEntry (mkContextWithErrorFormatter context)
209− hint = CaptureHint (T.pack $ symbolVal $ Proxy @capture) (typeRep (Proxy :: Proxy a))
210199
211200-- | If you use 'CaptureAll' in one of the endpoints for your API,
212201-- this automatically requires your server-side handler to be a
@@ -225,7 +214,7 @@ instance (KnownSymbol capture, FromHttpApiData a, Typeable a
225214-- > server = getSourceFile
226215-- > where getSourceFile :: [Text] -> Handler Book
227216-- > getSourceFile pathSegments = ...
228−instance (KnownSymbol capture, FromHttpApiData a, Typeable a
217+instance (KnownSymbol capture, FromHttpApiData a
229218 , HasServer api context
230219 , HasContextEntry (MkContextWithErrorFormatter context) ErrorFormatters
231220 )
@@ -237,7 +226,7 @@ instance (KnownSymbol capture, FromHttpApiData a, Typeable a
237226 hoistServerWithContext _ pc nt s = hoistServerWithContext (Proxy :: Proxy api) pc nt . s
238227
239228 route Proxy context d =
240− CaptureAllRouter [hint] $
229+ CaptureAllRouter $
241230 route (Proxy :: Proxy api)
242231 context
243232 (addCapture d $ \ txts -> withRequest $ \ request ->
@@ -248,43 +237,6 @@ instance (KnownSymbol capture, FromHttpApiData a, Typeable a
248237 where
249238 rep = typeRep (Proxy :: Proxy CaptureAll)
250239 formatError = urlParseErrorFormatter $ getContextEntry (mkContextWithErrorFormatter context)
251− hint = CaptureHint (T.pack $ symbolVal $ Proxy @capture) (typeRep (Proxy :: Proxy [a]))
252−
253−-- | If you use 'WithResource' in one of the endpoints for your API Servant
254−-- will provide the handler for this endpoint an argument of the specified type.
255−-- The lifespan of this resource will be automatically managed by Servant. This
256−-- resource will be created before the handler starts and it will be destoyed
257−-- after it ends. A new resource is created for each request to the endpoint.
258−
259−-- The creation and destruction are done using a 'Data.Acquire.Acquire'
260−-- provided via server 'Context'.
261−--
262−-- Example
263−--
264−-- > type MyApi = WithResource Handle :> "writeToFile" :> Post '[JSON] NoContent
265−-- >
266−-- > server :: Server MyApi
267−-- > server = writeToFile
268−-- > where writeToFile :: (ReleaseKey, Handle) -> Handler NoContent
269−-- > writeToFile (_, h) = hPutStrLn h "message"
270−--
271−-- In addition to the resource, the handler will also receive a 'ReleaseKey'
272−-- which can be used to deallocate the resource before the end of the request
273−-- if desired.
274−
275−instance (HasServer api ctx, HasContextEntry ctx (Acquire a))
276− => HasServer (WithResource a :> api) ctx where
277−
278− type ServerT (WithResource a :> api) m = (ReleaseKey, a) -> ServerT api m
279−
280− hoistServerWithContext _ pc nt s = hoistServerWithContext (Proxy @api) pc nt . s
281−
282− route Proxy context d = route (Proxy @api) context (d `addParameterCheck` allocateResource)
283− where
284− allocateResource :: DelayedIO (ReleaseKey, a)
285− allocateResource = DelayedIO $ lift $ allocateAcquire (getContextEntry context)
286−
287−
288240
289241allowedMethodHead :: Method -> Request -> Bool
290242allowedMethodHead method request = method == methodGet && requestMethod request == methodHead
@@ -653,35 +605,6 @@ instance HasServer Raw context where
653605 Fail a -> respond $ Fail a
654606 FailFatal e -> respond $ FailFatal e
655607
656−-- | Just pass the request to the underlying application and serve its response.
657−--
658−-- Example:
659−--
660−-- > type MyApi = "images" :> Raw
661−-- >
662−-- > server :: Server MyApi
663−-- > server = serveDirectory "/var/www/images"
664−instance HasServer RawM context where
665− type ServerT RawM m = Request -> (Response -> IO ResponseReceived) -> m ResponseReceived
666−
667− route
668− :: Proxy RawM
669− -> Context context
670− -> Delayed env (Request -> (Response -> IO ResponseReceived) -> Handler ResponseReceived) -> Router env
671− route _ _ handleDelayed = RawRouter $ \env request respond -> runResourceT $ do
672− routeResult <- runDelayed handleDelayed env request
673− let respond' = liftIO . respond
674− liftIO $ case routeResult of
675− Route handler -> runHandler (handler request (respond . Route)) >>=
676− \case
677− Left e -> respond' $ FailFatal e
678− Right a -> pure a
679− Fail e -> respond' $ Fail e
680− FailFatal e -> respond' $ FailFatal e
681−
682− hoistServerWithContext _ _ f srvM = \req respond -> f (srvM req respond)
683−
684−
685608-- | If you use 'ReqBody' in one of the endpoints for your API,
686609-- this automatically requires your server-side handler to be a function
687610-- that takes an argument of the type specified by 'ReqBody'.
@@ -891,19 +814,38 @@ instance (HasContextEntry context (NamedContext name subContext), HasServer subA
891814 hoistServerWithContext _ _ nt s = hoistServerWithContext (Proxy :: Proxy subApi) (Proxy :: Proxy subContext) nt s
892815
893816-------------------------------------------------------------------------------
894−-- Custom type errors
817+-- TypeError helpers
895818-------------------------------------------------------------------------------
896819
897−-- Erroring instance for 'HasServer' when a combinator is not fully applied
898−instance TypeError (PartialApplication
899−#if __GLASGOW_HASKELL__ >= 904
900− @(Type -> [Type] -> Constraint)
901−#endif
902− HasServer arr) => HasServer ((arr :: a -> b) :> sub) context
820+-- | This instance catches mistakes when there are non-saturated
821+-- type applications on LHS of ':>'.
822+--
823+-- >>> serve (Proxy :: Proxy (Capture "foo" :> Get '[JSON] Int)) (error "...")
824+-- ...
825+-- ...Expected something of kind Symbol or *, got: k -> l on the LHS of ':>'.
826+-- ...Maybe you haven't applied enough arguments to
827+-- ...Capture' '[] "foo"
828+-- ...
829+--
830+-- >>> undefined :: Server (Capture "foo" :> Get '[JSON] Int)
831+-- ...
832+-- ...Expected something of kind Symbol or *, got: k -> l on the LHS of ':>'.
833+-- ...Maybe you haven't applied enough arguments to
834+-- ...Capture' '[] "foo"
835+-- ...
836+--
837+instance TypeError (HasServerArrowKindError arr) => HasServer ((arr :: k -> l) :> api) context
903838 where
904− type ServerT (arr :> sub) _ = TypeError (PartialApplication (HasServer :: * -> [*] -> Constraint) arr)
905− route = error "unreachable"
906− hoistServerWithContext _ _ _ _ = error "unreachable"
839+ type ServerT (arr :> api) m = TypeError (HasServerArrowKindError arr)
840+ -- it doesn't really matter what sub route we peak
841+ route _ _ _ = error "servant-server panic: impossible happened in HasServer (arr :> api)"
842+ hoistServerWithContext _ _ _ = id
843+
844+-- Cannot have TypeError here, otherwise use of this symbol will error :)
845+type HasServerArrowKindError arr =
846+ 'Text "Expected something of kind Symbol or *, got: k -> l on the LHS of ':>'."
847+ ':$$: 'Text "Maybe you haven't applied enough arguments to"
848+ ':$$: 'ShowType arr
907849
908850-- | This instance prevents from accidentally using '->' instead of ':>'
909851--
@@ -938,19 +880,6 @@ type HasServerArrowTypeError a b =
938880 ':$$: 'Text "and"
939881 ':$$: 'ShowType b
940882
941−-- Erroring instances for 'HasServer' for unknown API combinators
942−
943−-- XXX: This omits the @context@ parameter, e.g.:
944−--
945−-- "There is no instance for HasServer (Bool :> …)". Do we care ?
946−instance {-# OVERLAPPABLE #-} TypeError (NoInstanceForSub
947−#if __GLASGOW_HASKELL__ >= 904
948− @(Type -> [Type] -> Constraint)
949−#endif
950− HasServer ty) => HasServer (ty :> sub) context
951−
952−instance {-# OVERLAPPABLE #-} TypeError (NoInstanceFor (HasServer api context)) => HasServer api context
953−
954883-- | Ignore @'Fragment'@ in server handlers.
955884-- See <https://ietf.org/rfc/rfc2616.html#section-15.1.3> for more details.
956885--
servant-server/src/Servant/Server/Internal/Handler.hs+2−7
@@ -13,19 +13,17 @@ import Control.Monad.Base
1313import Control.Monad.Catch
1414 (MonadCatch, MonadMask, MonadThrow)
1515import Control.Monad.Error.Class
16− (MonadError, throwError)
16+ (MonadError)
1717import Control.Monad.IO.Class
1818 (MonadIO)
1919import Control.Monad.Trans.Control
2020 (MonadBaseControl (..))
2121import Control.Monad.Trans.Except
2222 (ExceptT, runExceptT)
23−import Data.String
24− (fromString)
2523import GHC.Generics
2624 (Generic)
2725import Servant.Server.Internal.ServerError
28− (ServerError, errBody, err500)
26+ (ServerError)
2927
3028newtype Handler a = Handler { runHandler' :: ExceptT ServerError IO a }
3129 deriving
@@ -34,9 +32,6 @@ newtype Handler a = Handler { runHandler' :: ExceptT ServerError IO a }
3432 , MonadThrow, MonadCatch, MonadMask
3533 )
3634
37−instance MonadFail Handler where
38− fail str = throwError err500 { errBody = fromString str }
39−
4035instance MonadBase IO Handler where
4136 liftBase = Handler . liftBase
4237
servant-server/src/Servant/Server/Internal/Router.hs+15−50
@@ -9,16 +9,12 @@ import Prelude.Compat
99
1010import Data.Function
1111 (on)
12−import Data.List
13− (nub)
1412import Data.Map
1513 (Map)
1614import qualified Data.Map as M
1715import Data.Text
1816 (Text)
1917import qualified Data.Text as T
20−import Data.Typeable
21− (TypeRep)
2218import Network.Wai
2319 (Response, pathInfo)
2420import Servant.Server.Internal.ErrorFormatter
@@ -28,21 +24,6 @@ import Servant.Server.Internal.ServerError
2824
2925type Router env = Router' env RoutingApplication
3026
31−-- | Holds information about pieces of url that are captured as variables.
32−data CaptureHint = CaptureHint
33− { captureName :: Text
34− -- ^ Holds the name of the captured variable
35− , captureType :: TypeRep
36− -- ^ Holds the type of the captured variable
37− }
38− deriving (Show, Eq)
39−
40−toCaptureTag :: CaptureHint -> Text
41−toCaptureTag hint = captureName hint <> "::" <> (T.pack . show) (captureType hint)
42−
43−toCaptureTags :: [CaptureHint] -> Text
44−toCaptureTags hints = "<" <> T.intercalate "|" (map toCaptureTag hints) <> ">"
45−
4627-- | Internal representation of a router.
4728--
4829-- The first argument describes an environment type that is
@@ -55,23 +36,12 @@ data Router' env a =
5536 -- ^ the map contains routers for subpaths (first path component used
5637 -- for lookup and removed afterwards), the list contains handlers
5738 -- for the empty path, to be tried in order
58− | CaptureRouter [CaptureHint] (Router' (Text, env) a)
39+ | CaptureRouter (Router' (Text, env) a)
5940 -- ^ first path component is passed to the child router in its
60− -- environment and removed afterwards.
61− -- The first argument is a list of hints for all variables that can be
62− -- captured by the router. The fact that it is a list is counter-intuitive,
63− -- because the 'Capture' combinator only allows to capture a single varible,
64− -- with a single name and a single type. However, the 'choice' smart
65− -- constructor may merge two 'Capture' combinators with different hints, thus
66− -- forcing the type to be '[CaptureHint]'.
67− -- Because 'CaptureRouter' is built from a 'Capture' combinator, the list of
68− -- hints should always be non-empty.
69− | CaptureAllRouter [CaptureHint] (Router' ([Text], env) a)
41+ -- environment and removed afterwards
42+ | CaptureAllRouter (Router' ([Text], env) a)
7043 -- ^ all path components are passed to the child router in its
7144 -- environment and are removed afterwards
72− -- The first argument is a hint for the list of variables that can be
73− -- captured by the router. Note that the 'captureType' field of the hint
74− -- should always be '[a]' for some 'a'.
7545 | RawRouter (env -> a)
7646 -- ^ to be used for routes we do not know anything about
7747 | Choice (Router' env a) (Router' env a)
@@ -99,8 +69,8 @@ leafRouter l = StaticRouter M.empty [l]
9969choice :: Router' env a -> Router' env a -> Router' env a
10070choice (StaticRouter table1 ls1) (StaticRouter table2 ls2) =
10171 StaticRouter (M.unionWith choice table1 table2) (ls1 ++ ls2)
102−choice (CaptureRouter hints1 router1) (CaptureRouter hints2 router2) =
103− CaptureRouter (nub $ hints1 ++ hints2) (choice router1 router2)
72+choice (CaptureRouter router1) (CaptureRouter router2) =
73+ CaptureRouter (choice router1 router2)
10474choice router1 (Choice router2 router3) = Choice (choice router1 router2) router3
10575choice router1 router2 = Choice router1 router2
10676
@@ -114,11 +84,7 @@ choice router1 router2 = Choice router1 router2
11484--
11585data RouterStructure =
11686 StaticRouterStructure (Map Text RouterStructure) Int
117− | CaptureRouterStructure [CaptureHint] RouterStructure
118− -- ^ The first argument holds information about variables
119− -- that are captured by the router. There may be several hints
120− -- if several routers have been aggregated by the 'choice'
121− -- smart constructor.
87+ | CaptureRouterStructure RouterStructure
12288 | RawRouterStructure
12389 | ChoiceStructure RouterStructure RouterStructure
12490 deriving (Eq, Show)
@@ -132,11 +98,11 @@ data RouterStructure =
13298routerStructure :: Router' env a -> RouterStructure
13399routerStructure (StaticRouter m ls) =
134100 StaticRouterStructure (fmap routerStructure m) (length ls)
135−routerStructure (CaptureRouter hints router) =
136− CaptureRouterStructure hints $
101+routerStructure (CaptureRouter router) =
102+ CaptureRouterStructure $
137103 routerStructure router
138−routerStructure (CaptureAllRouter hints router) =
139− CaptureRouterStructure hints $
104+routerStructure (CaptureAllRouter router) =
105+ CaptureRouterStructure $
140106 routerStructure router
141107routerStructure (RawRouter _) =
142108 RawRouterStructure
@@ -148,8 +114,8 @@ routerStructure (Choice r1 r2) =
148114-- | Compare the structure of two routers.
149115--
150116sameStructure :: Router' env a -> Router' env b -> Bool
151−sameStructure router1 router2 =
152− routerStructure router1 == routerStructure router2
117+sameStructure r1 r2 =
118+ routerStructure r1 == routerStructure r2
153119
154120-- | Provide a textual representation of the
155121-- structure of a router.
@@ -160,8 +126,7 @@ routerLayout router =
160126 where
161127 mkRouterLayout :: Bool -> RouterStructure -> [Text]
162128 mkRouterLayout c (StaticRouterStructure m n) = mkSubTrees c (M.toList m) n
163− mkRouterLayout c (CaptureRouterStructure hints r) =
164− mkSubTree c (toCaptureTags hints) (mkRouterLayout False r)
129+ mkRouterLayout c (CaptureRouterStructure r) = mkSubTree c "<capture>" (mkRouterLayout False r)
165130 mkRouterLayout c RawRouterStructure =
166131 if c then ["├─ <raw>"] else ["└─ <raw>"]
167132 mkRouterLayout c (ChoiceStructure r1 r2) =
@@ -204,7 +169,7 @@ runRouterEnv fmt router env request respond =
204169 -> let request' = request { pathInfo = rest }
205170 in runRouterEnv fmt router' env request' respond
206171 _ -> respond $ Fail $ fmt request
207− CaptureRouter _ router' ->
172+ CaptureRouter router' ->
208173 case pathInfo request of
209174 [] -> respond $ Fail $ fmt request
210175 -- This case is to handle trailing slashes.
@@ -212,7 +177,7 @@ runRouterEnv fmt router env request respond =
212177 first : rest
213178 -> let request' = request { pathInfo = rest }
214179 in runRouterEnv fmt router' (first, env) request' respond
215− CaptureAllRouter _ router' ->
180+ CaptureAllRouter router' ->
216181 let segments = pathInfo request
217182 request' = request { pathInfo = [] }
218183 in runRouterEnv fmt router' (segments, env) request' respond
servant-server/test/Servant/Server/RouterSpec.hs+6−127
@@ -9,9 +9,7 @@ import Control.Monad
99import Data.Proxy
1010 (Proxy (..))
1111import Data.Text
12− (Text, unpack)
13−import Data.Typeable
14− (typeRep)
12+ (unpack)
1513import Network.HTTP.Types
1614 (Status (..))
1715import Network.Wai
@@ -29,7 +27,6 @@ spec :: Spec
2927spec = describe "Servant.Server.Internal.Router" $ do
3028 routerSpec
3129 distributivitySpec
32− serverLayoutSpec
3330
3431routerSpec :: Spec
3532routerSpec = do
@@ -54,7 +51,7 @@ routerSpec = do
5451 toApp = toApplication . runRouter (const err404)
5552
5653 cap :: Router ()
57− cap = CaptureRouter [hint] $
54+ cap = CaptureRouter $
5855 let delayed = addCapture (emptyDelayed $ Route pure) (const $ delayedFail err400)
5956 in leafRouter
6057 $ \env req res ->
@@ -62,9 +59,6 @@ routerSpec = do
6259 . const
6360 $ Route success
6461
65− hint :: CaptureHint
66− hint = CaptureHint "anything" $ typeRep (Proxy :: Proxy ())
67−
6862 router :: Router ()
6963 router = leafRouter (\_ _ res -> res $ Route success)
7064 `Choice` cap
@@ -104,30 +98,12 @@ distributivitySpec =
10498 it "properly handles mixing static paths at different levels" $ do
10599 level `shouldHaveSameStructureAs` levelRef
106100
107−serverLayoutSpec :: Spec
108−serverLayoutSpec =
109− describe "serverLayout" $ do
110− it "correctly represents the example API" $ do
111− exampleLayout `shouldHaveLayout` expectedExampleLayout
112− it "aggregates capture hints when different" $ do
113− captureDifferentTypes `shouldHaveLayout` expectedCaptureDifferentTypes
114− it "nubs capture hints when equal" $ do
115− captureSameType `shouldHaveLayout` expectedCaptureSameType
116− it "properly displays CaptureAll hints" $ do
117− captureAllLayout `shouldHaveLayout` expectedCaptureAllLayout
118−
119101shouldHaveSameStructureAs ::
120102 (HasServer api1 '[], HasServer api2 '[]) => Proxy api1 -> Proxy api2 -> Expectation
121103shouldHaveSameStructureAs p1 p2 =
122104 unless (sameStructure (makeTrivialRouter p1) (makeTrivialRouter p2)) $
123105 expectationFailure ("expected:\n" ++ unpack (layout p2) ++ "\nbut got:\n" ++ unpack (layout p1))
124106
125−shouldHaveLayout ::
126− (HasServer api '[]) => Proxy api -> Text -> Expectation
127−shouldHaveLayout p l =
128− unless (routerLayout (makeTrivialRouter p) == l) $
129− expectationFailure ("expected:\n" ++ unpack l ++ "\nbut got:\n" ++ unpack (layout p))
130−
131107makeTrivialRouter :: (HasServer layout '[]) => Proxy layout -> Router ()
132108makeTrivialRouter p =
133109 route p EmptyContext (emptyDelayed (FailFatal err501))
@@ -168,12 +144,12 @@ staticRef = Proxy
168144-- structure:
169145
170146type Dynamic =
171− "a" :> Capture "foo" Int :> "b" :> End
172− :<|> "a" :> Capture "foo" Int :> "c" :> End
173− :<|> "a" :> Capture "foo" Int :> "d" :> End
147+ "a" :> Capture "foo" Int :> "b" :> End
148+ :<|> "a" :> Capture "bar" Bool :> "c" :> End
149+ :<|> "a" :> Capture "baz" Char :> "d" :> End
174150
175151type DynamicRef =
176− "a" :> Capture "foo" Int :>
152+ "a" :> Capture "anything" () :>
177153 ("b" :> End :<|> "c" :> End :<|> "d" :> End)
178154
179155dynamic :: Proxy Dynamic
@@ -363,100 +339,3 @@ level = Proxy
363339
364340levelRef :: Proxy LevelRef
365341levelRef = Proxy
366−
367−-- The example API for the 'layout' function.
368−-- Should get factorized by the 'choice' smart constructor.
369−type ExampleLayout =
370− "a" :> "d" :> Get '[JSON] NoContent
371− :<|> "b" :> Capture "x" Int :> Get '[JSON] Bool
372− :<|> "c" :> Put '[JSON] Bool
373− :<|> "a" :> "e" :> Get '[JSON] Int
374− :<|> "b" :> Capture "x" Int :> Put '[JSON] Bool
375− :<|> Raw
376−
377−exampleLayout :: Proxy ExampleLayout
378−exampleLayout = Proxy
379−
380−-- The expected representation of the example API layout
381−--
382−expectedExampleLayout :: Text
383−expectedExampleLayout =
384− "/\n\
385− \├─ a/\n\
386− \│ ├─ d/\n\
387− \│ │ └─•\n\
388− \│ └─ e/\n\
389− \│ └─•\n\
390− \├─ b/\n\
391− \│ └─ <x::Int>/\n\
392− \│ ├─•\n\
393− \│ ┆\n\
394− \│ └─•\n\
395− \├─ c/\n\
396− \│ └─•\n\
397− \┆\n\
398− \└─ <raw>\n"
399−
400−-- A capture API with all capture types being the same
401−--
402−type CaptureSameType =
403− "a" :> Capture "foo" Int :> "b" :> End
404− :<|> "a" :> Capture "foo" Int :> "c" :> End
405− :<|> "a" :> Capture "foo" Int :> "d" :> End
406−
407−captureSameType :: Proxy CaptureSameType
408−captureSameType = Proxy
409−
410−-- The expected representation of the CaptureSameType API layout.
411−--
412−expectedCaptureSameType :: Text
413−expectedCaptureSameType =
414− "/\n\
415− \└─ a/\n\
416− \ └─ <foo::Int>/\n\
417− \ ├─ b/\n\
418− \ │ └─•\n\
419− \ ├─ c/\n\
420− \ │ └─•\n\
421− \ └─ d/\n\
422− \ └─•\n"
423−
424−-- A capture API capturing different types
425−--
426−type CaptureDifferentTypes =
427− "a" :> Capture "foo" Int :> "b" :> End
428− :<|> "a" :> Capture "bar" Bool :> "c" :> End
429− :<|> "a" :> Capture "baz" Char :> "d" :> End
430−
431−captureDifferentTypes :: Proxy CaptureDifferentTypes
432−captureDifferentTypes = Proxy
433−
434−-- The expected representation of the CaptureDifferentTypes API layout.
435−--
436−expectedCaptureDifferentTypes :: Text
437−expectedCaptureDifferentTypes =
438− "/\n\
439− \└─ a/\n\
440− \ └─ <foo::Int|bar::Bool|baz::Char>/\n\
441− \ ├─ b/\n\
442− \ │ └─•\n\
443− \ ├─ c/\n\
444− \ │ └─•\n\
445− \ └─ d/\n\
446− \ └─•\n"
447−
448−-- An API with a CaptureAll part
449−
450−type CaptureAllLayout = "a" :> CaptureAll "foos" Int :> End
451−
452−captureAllLayout :: Proxy CaptureAllLayout
453−captureAllLayout = Proxy
454−
455−-- The expected representation of the CaptureAllLayout API.
456−--
457−expectedCaptureAllLayout :: Text
458−expectedCaptureAllLayout =
459− "/\n\
460− \└─ a/\n\
461− \ └─ <foos::[Int]>/\n\
462− \ └─•\n"
servant-server/test/Servant/ServerSpec.hs+6−54
@@ -17,14 +17,10 @@ import Prelude.Compat
1717
1818import Control.Monad
1919 (forM_, unless, when)
20−import Control.Monad.Reader (runReaderT, ask)
2120import Control.Monad.Error.Class
2221 (MonadError (..))
23−import Control.Monad.IO.Class (MonadIO(..))
2422import Data.Aeson
2523 (FromJSON, ToJSON, decode', encode)
26−import Data.Acquire
27− (Acquire, mkAcquire)
2824import qualified Data.ByteString as BS
2925import qualified Data.ByteString.Base64 as Base64
3026import Data.Char
@@ -56,19 +52,19 @@ import Servant.API
5652 Delete, EmptyAPI, Fragment, Get, HasStatus (StatusOf), Header,
5753 Headers, HttpVersion, IsSecure (..), JSON, Lenient,
5854 NoContent (..), NoContentVerb, NoFraming, OctetStream, Patch,
59− PlainText, Post, Put, QueryFlag, QueryParam, QueryParams, Raw, RawM,
55+ PlainText, Post, Put, QueryFlag, QueryParam, QueryParams, Raw,
6056 RemoteHost, ReqBody, SourceIO, StdMethod (..), Stream, Strict,
6157 UVerb, Union, Verb, WithStatus (..), addHeader)
6258import Servant.Server
63− (Context ((:.), EmptyContext), Handler, Server, ServerT, Tagged (..),
64− emptyServer, err401, err403, err404, hoistServer, respond, serve,
59+ (Context ((:.), EmptyContext), Handler, Server, Tagged (..),
60+ emptyServer, err401, err403, err404, respond, serve,
6561 serveWithContext)
6662import Servant.Test.ComprehensiveAPI
6763import qualified Servant.Types.SourceT as S
6864import Test.Hspec
6965 (Spec, context, describe, it, shouldBe, shouldContain)
7066import Test.Hspec.Wai
71− (get, matchHeaders, matchStatus, shouldRespondWith,
67+ (get, liftIO, matchHeaders, matchStatus, shouldRespondWith,
7268 with, (<:>))
7369import qualified Test.Hspec.Wai as THW
7470
@@ -85,11 +81,8 @@ import Servant.Server.Internal.Context
8581-- This declaration simply checks that all instances are in place.
8682_ = serveWithContext comprehensiveAPI comprehensiveApiContext
8783
88−comprehensiveApiContext :: Context '[NamedContext "foo" '[], Acquire Int]
89−comprehensiveApiContext =
90− NamedContext EmptyContext :.
91− mkAcquire (pure 10) (\_ -> pure ()) :.
92− EmptyContext
84+comprehensiveApiContext :: Context '[NamedContext "foo" '[]]
85+comprehensiveApiContext = NamedContext EmptyContext :. EmptyContext
9386
9487-- * Specs
9588
@@ -104,7 +97,6 @@ spec = do
10497 reqBodySpec
10598 headerSpec
10699 rawSpec
107− rawMSpec
108100 alternativeSpec
109101 responseHeadersSpec
110102 uverbResponseHeadersSpec
@@ -613,46 +605,6 @@ rawSpec = do
613605
614606-- }}}
615607------------------------------------------------------------------------------
616−-- * rawMSpec {{{
617−------------------------------------------------------------------------------
618−
619−type RawMApi = "foo" :> RawM
620−
621−rawMApi :: Proxy RawMApi
622−rawMApi = Proxy
623−
624−rawMServer :: (Monad m, MonadIO m, Show a) => (Request -> m a) -> ServerT RawMApi m
625−rawMServer f req resp = liftIO . resp . responseLBS ok200 [] . cs . show =<< f req
626−
627−rawMSpec :: Spec
628−rawMSpec = do
629− describe "Servant.API.RawM" $ do
630− it "gives access to monadic context" $ do
631− flip runSession (serve rawMApi
632− (hoistServer rawMApi (flip runReaderT (42 :: Integer)) (rawMServer (const ask)))) $ do
633− response <- Network.Wai.Test.request defaultRequest{
634− pathInfo = ["foo"]
635− }
636− liftIO $ do
637− simpleBody response `shouldBe` "42"
638−
639− it "lets users throw servant errors" $ do
640− flip runSession (serve rawMApi (rawMServer (const $ throwError err404 >> pure (42 :: Integer)))) $ do
641− response <- Network.Wai.Test.request defaultRequest{
642− pathInfo = ["foo"]
643− }
644− liftIO $ do
645− statusCode (simpleStatus response) `shouldBe` 404
646−
647− it "gets the pathInfo modified" $ do
648− flip runSession (serve rawMApi (rawMServer (pure . pathInfo))) $ do
649− response <- Network.Wai.Test.request defaultRequest{
650− pathInfo = ["foo", "bar"]
651− }
652− liftIO $ do
653− simpleBody response `shouldBe` cs (show ["bar" :: String])
654−-- }}}
655−------------------------------------------------------------------------------
656608-- * alternativeSpec {{{
657609------------------------------------------------------------------------------
658610type AlternativeApi =
servant-swagger/servant-swagger.cabal+13−14
@@ -3,10 +3,10 @@ name: servant-swagger
33version: 1.1.11
44synopsis: Generate a Swagger/OpenAPI/OAS 2.0 specification for your servant API.
55description:
6− Swagger is a project used to describe and document RESTful APIs. The core of the
7− project is the [OpenAPI Specification (OAS)](https://swagger.io/docs/specification/about/).
8− This library implements v2.0 of the spec. Unlike Servant it is language-agnostic and thus is
9− quite popular among developers in different languages. It has also existed for a longer time
6+ Swagger is a project used to describe and document RESTful APIs. The core of the
7+ project is the [OpenAPI Specification (OAS)](https://swagger.io/docs/specification/about/).
8+ This library implements v2.0 of the spec. Unlike Servant it is language-agnostic and thus is
9+ quite popular among developers in different languages. It has also existed for a longer time
1010 and has more helpful tooling.
1111 .
1212 This package provides means to generate a Swagger/OAS specification for a Servant API
@@ -19,7 +19,7 @@ description:
1919 * generating clients and servers in many languages using [Swagger Codegen](http://swagger.io/swagger-codegen/);
2020 .
2121 * and [many others](http://swagger.io/open-source-integrations/).
22−homepage: https://github.com/haskell-servant/servant/tree/master/servant-swagger#readme
22+homepage: https://github.com/haskell-servant/servant/servant-swagger
2323bug-reports: https://github.com/haskell-servant/servant/issues
2424license: BSD-3-Clause
2525license-file: LICENSE
@@ -50,7 +50,6 @@ source-repository head
5050custom-setup
5151 setup-depends:
5252 base >=4.9 && <5,
53− Cabal >= 1.24,
5453 cabal-doctest >=1.0.6 && <1.1
5554
5655library
@@ -72,15 +71,15 @@ library
7271 build-depends: aeson >=1.4.2.0 && <3
7372 , aeson-pretty >=0.8.7 && <0.9
7473 , base >=4.9.1.0 && <5
75− , base-compat >=0.10.5 && <0.13
76− , bytestring >=0.10.8.1 && <0.12
74+ , base-compat >=0.10.5 && <0.12
75+ , bytestring >=0.10.8.1 && <0.11
7776 , http-media >=0.7.1.3 && <0.9
7877 , insert-ordered-containers >=0.2.1.0 && <0.3
7978 , lens >=4.17 && <6
80− , servant >=0.18.2 && <0.20
79+ , servant >=0.18.1 && <0.19
8180 , singleton-bool >=0.1.4 && <0.2
8281 , swagger2 >=2.3.0.1 && <3
83− , text >=1.2.3.0 && <2.1
82+ , text >=1.2.3.0 && <1.3
8483 , unordered-containers >=0.2.9.0 && <0.3
8584
8685 , hspec
@@ -92,7 +91,7 @@ test-suite doctests
9291 build-depends:
9392 base,
9493 directory >= 1.0,
95− doctest >= 0.17 && <0.21,
94+ doctest >= 0.18 && <0.19,
9695 servant,
9796 QuickCheck,
9897 filepath
@@ -106,14 +105,14 @@ test-suite spec
106105 type: exitcode-stdio-1.0
107106 hs-source-dirs: test
108107 main-is: Spec.hs
109− build-tool-depends: hspec-discover:hspec-discover >=2.6.0 && <2.11
108+ build-tool-depends: hspec-discover:hspec-discover >=2.6.0 && <2.8
110109 build-depends: base
111110 , base-compat
112111 , aeson >=1.4.2.0 && <3
113− , hspec >=2.6.0 && <2.11
112+ , hspec >=2.6.0 && <2.8
114113 , QuickCheck
115114 , lens
116− , lens-aeson >=1.0.2 && <1.3
115+ , lens-aeson >=1.0.2 && <1.2
117116 , servant
118117 , servant-swagger
119118 , swagger2
servant-swagger/src/Servant/Swagger.hs+3−5
@@ -55,7 +55,6 @@ import Servant.Swagger.Internal.Orphans ()
5555-- >>> import Data.Typeable
5656-- >>> import GHC.Generics
5757-- >>> import Servant.API
58−-- >>> import System.Environment
5958-- >>> import Test.Hspec
6059-- >>> import Test.QuickCheck
6160-- >>> import qualified Data.ByteString.Lazy.Char8 as BSL8
@@ -65,7 +64,6 @@ import Servant.Swagger.Internal.Orphans ()
6564-- >>> :set -XGeneralizedNewtypeDeriving
6665-- >>> :set -XOverloadedStrings
6766-- >>> :set -XTypeOperators
68−-- >>> setEnv "HSPEC_COLOR" "no"
6967-- >>> data User = User { name :: String, age :: Int } deriving (Show, Generic, Typeable)
7068-- >>> newtype UserId = UserId Integer deriving (Show, Generic, Typeable, ToJSON)
7169-- >>> instance ToJSON User
@@ -162,11 +160,11 @@ import Servant.Swagger.Internal.Orphans ()
162160-- >>> instance Arbitrary UserId where arbitrary = UserId <$> arbitrary
163161-- >>> hspec $ validateEveryToJSON (Proxy :: Proxy UserAPI)
164162-- <BLANKLINE>
165−-- [User]...
163+-- [User]
166164-- ...
167−-- User...
165+-- User
168166-- ...
169−-- UserId...
167+-- UserId
170168-- ...
171169-- Finished in ... seconds
172170-- 3 examples, 0 failures
servant-swagger/src/Servant/Swagger/Internal.hs−15
@@ -3,13 +3,11 @@
33{-# LANGUAGE DataKinds #-}
44{-# LANGUAGE FlexibleContexts #-}
55{-# LANGUAGE FlexibleInstances #-}
6−{-# LANGUAGE OverloadedLists #-}
76{-# LANGUAGE OverloadedStrings #-}
87{-# LANGUAGE PolyKinds #-}
98{-# LANGUAGE RankNTypes #-}
109{-# LANGUAGE ScopedTypeVariables #-}
1110{-# LANGUAGE TypeOperators #-}
12−{-# LANGUAGE TypeFamilies #-}
1311#if __GLASGOW_HASKELL__ >= 806
1412{-# LANGUAGE UndecidableInstances #-}
1513#endif
@@ -32,13 +30,11 @@ import qualified Data.Swagger as Swagger
3230import Data.Swagger.Declare
3331import Data.Text (Text)
3432import qualified Data.Text as Text
35−import GHC.Generics (D1, Meta(..), Rep)
3633import GHC.TypeLits
3734import Network.HTTP.Media (MediaType)
3835import Servant.API
3936import Servant.API.Description (FoldDescription,
4037 reflectDescription)
41−import Servant.API.Generic (ToServantApi, AsApi)
4238import Servant.API.Modifiers (FoldRequired)
4339
4440import Servant.Swagger.Internal.TypeLevel.API
@@ -153,10 +149,6 @@ mkEndpointNoContentVerb path _ = mempty
153149addParam :: Param -> Swagger -> Swagger
154150addParam param = allOperations.parameters %~ (Inline param :)
155151
156−-- | Add a tag to every operation in the spec.
157−addTag :: Text -> Swagger -> Swagger
158−addTag tag = allOperations.tags %~ ([tag] <>)
159−
160152-- | Add accepted content types to every operation in the spec.
161153addConsumes :: [MediaType] -> Swagger -> Swagger
162154addConsumes cs = allOperations.consumes %~ (<> Just (MimeList cs))
@@ -304,10 +296,6 @@ instance (HasSwagger sub) => HasSwagger (HttpVersion :> sub) where
304296instance (HasSwagger sub) => HasSwagger (WithNamedContext x c sub) where
305297 toSwagger _ = toSwagger (Proxy :: Proxy sub)
306298
307−-- | @'WithResource'@ combinator does not change our specification at all.
308−instance (HasSwagger sub) => HasSwagger (WithResource res :> sub) where
309− toSwagger _ = toSwagger (Proxy :: Proxy sub)
310−
311299instance (KnownSymbol sym, HasSwagger sub) => HasSwagger (sym :> sub) where
312300 toSwagger _ = prependPath piece (toSwagger (Proxy :: Proxy sub))
313301 where
@@ -451,9 +439,6 @@ instance (ToSchema a, Accept ct, HasSwagger sub, KnownSymbol (FoldDescription mo
451439 & required ?~ True
452440 & schema .~ ParamBody ref
453441
454−instance (HasSwagger (ToServantApi routes), KnownSymbol datatypeName, Rep (routes AsApi) ~ D1 ('MetaData datatypeName moduleName packageName isNewtype) f) => HasSwagger (NamedRoutes routes) where
455− toSwagger _ = addTag (Text.pack $ symbolVal (Proxy :: Proxy datatypeName)) (toSwagger (Proxy :: Proxy (ToServantApi routes)))
456−
457442-- =======================================================================
458443-- Below are the definitions that should be in Servant.API.ContentTypes
459444-- =======================================================================
servant-swagger/src/Servant/Swagger/Internal/Test.hs+6−8
@@ -29,12 +29,10 @@ import Servant.Swagger.Internal.TypeLevel
2929-- >>> import Control.Applicative
3030-- >>> import GHC.Generics
3131-- >>> import Test.QuickCheck
32−-- >>> import System.Environment (setEnv)
3332-- >>> :set -XDeriveGeneric
3433-- >>> :set -XGeneralizedNewtypeDeriving
3534-- >>> :set -XDataKinds
3635-- >>> :set -XTypeOperators
37−-- >>> setEnv "HSPEC_COLOR" "no"
3836
3937-- | Verify that every type used with @'JSON'@ content type in a servant API
4038-- has compatible @'ToJSON'@ and @'ToSchema'@ instances using @'validateToJSON'@.
@@ -55,10 +53,10 @@ import Servant.Swagger.Internal.TypeLevel
5553--
5654-- >>> hspec $ context "ToJSON matches ToSchema" $ validateEveryToJSON (Proxy :: Proxy UserAPI)
5755-- <BLANKLINE>
58−-- ToJSON matches ToSchema...
59−-- User...
56+-- ToJSON matches ToSchema
57+-- User
6058-- ...
61−-- UserId...
59+-- UserId
6260-- ...
6361-- Finished in ... seconds
6462-- 2 examples, 0 failures
@@ -120,11 +118,11 @@ validateEveryToJSONWithPatternChecker checker _ = props
120118-- :}
121119-- <BLANKLINE>
122120-- read . show == id
123−-- Bool...
121+-- Bool
124122-- ...
125−-- Int...
123+-- Int
126124-- ...
127−-- [Char]...
125+-- [Char]
128126-- ...
129127-- Finished in ... seconds
130128-- 3 examples, 0 failures
servant/CHANGELOG.md−121
@@ -1,126 +1,5 @@
11[The latest version of this document is on GitHub.](https://github.com/haskell-servant/servant/blob/master/servant/CHANGELOG.md)
22
3−Package versions follow the [Package Versioning Policy](https://pvp.haskell.org/): in A.B.C, bumps to either A or B represent major versions.
4−
5−0.19.1
6−------
7−
8−Compatibility with GHC 9.4, see [PR #1592](https://github.com/haskell-servant/servant/pull/1592).
9−
10−0.19
11−----
12−
13−### Significant changes
14−
15−- Drop support for GHC < 8.6.
16−- Support GHC 9.0 (GHC 9.2 should work as well, but isn't fully tested yet).
17−- Support Aeson 2 ([#1475](https://github.com/haskell-servant/servant/pull/1475)),
18− which fixes a [DOS vulnerability](https://github.com/haskell/aeson/issues/864)
19− related to hash collisions.
20−- Add `NamedRoutes` combinator, making support for records first-class in Servant
21− ([#1388](https://github.com/haskell-servant/servant/pull/1388)).
22−
23− Users can now directly mark part as an API as defined by a record, instead of
24− using `(:<|>)` to combine routes. Concretely, the anonymous:
25−
26− ```haskell
27− type API =
28− "version" :> Get '[JSON] String :<|>
29− "products" :> Get '[JSON] [Product]
30− ```
31−
32− can be replaced with the explicitly-named:
33−
34− ```haskell
35− type API = NamedRoutes NamedAPI
36− data NamedAPI mode = NamedAPI
37− { version :: mode :- "version" :> Get '[JSON] String
38− , products :: mode :- "products" :> Get '[JSON] [Product]
39− }
40− ```
41−
42− `NamedRoutes` builds upon `servant-generic`, but improves usability by freeing
43− users from the need to perform `toServant` / `fromServant` conversions
44− manually. Serving `NamedRoutes NamedAPI` is now done directly by providing a
45− record of handlers, and servant generates clients directly as records as well.
46− In particular, it makes it much more practical to work with nested hierarchies
47− of named routes.
48−
49− Two convenience functions, `(//)` and `(/:)`, have been added to make the
50− usage of named route hierarchies more pleasant:
51−
52− ```haskell
53− rootClient :: RootApi (AsClientT ClientM)
54− rootClient = client (Proxy @API)
55−
56− helloClient :: String -> ClientM String
57− helloClient name = rootClient // hello /: name
58−
59− endpointClient :: ClientM Person
60− endpointClient = rootClient // subApi /: "foobar123" // endpoint
61−
62− type Api = NamedRoutes RootApi
63−
64− data RootApi mode = RootApi
65− { subApi :: mode :- Capture "token" String :> NamedRoutes SubApi
66− , hello :: mode :- Capture "name" String :> Get '[JSON] String
67− , …
68− } deriving Generic
69−
70− data SubApi mode = SubApi
71− { endpoint :: mode :- Get '[JSON] Person
72− , …
73− } deriving Generic
74− ```
75−
76−- Add custom type errors for partially applied combinators
77− ([#1289](https://github.com/haskell-servant/servant/pull/1289),
78− [#1486](https://github.com/haskell-servant/servant/pull/1486)).
79−
80− For example, forgetting to document the expected type for a query parameter,
81− as in:
82−
83− ``` haskell
84− type API = QueryParam "param" :> Get '[JSON] NoContent
85− ```
86−
87− will raise to the following error when trying to serve the API:
88−
89− ```
90− • There is no instance for HasServer (QueryParam'
91− '[Optional, Strict] "param" :> ...)
92− QueryParam' '[Optional, Strict] "1" expects 1 more arguments
93− ```
94−
95− As a consequence of this change, unsaturated types are now forbidden before `(:>)`.
96−
97−- Add a `HeadNoContent` verb ([#1502](https://github.com/haskell-servant/servant/pull/1502)).
98−
99−- *servant-client* / *servant-client-core* / *servant-http-streams*:
100− Fix erroneous behavior, where only 2XX status codes would be considered
101− successful, irrelevant of the status parameter specified by the verb
102− combinator. ([#1469](https://github.com/haskell-servant/servant/pull/1469))
103−
104−- *servant-client* / *servant-client-core*: Fix `Show` instance for
105− `Servant.Client.Core.Request`.
106−
107−
108−- *servant-client* / *servant-client-core*: Allow passing arbitrary binary data
109− in Query parameters.
110− ([#1432](https://github.com/haskell-servant/servant/pull/1432)).
111−
112−- *servant-docs*: Generate sample cURL requests
113− ([#1401](https://github.com/haskell-servant/servant/pull/1401/files)).
114−
115− Breaking change: requires sample header values to be supplied with `headers`.
116−
117−### Other changes
118−
119−- Various bit rotten cookbooks have been updated and re-introduced on
120− [docs.servant.dev](https://docs.servant.dev).
121−
122−- Various version bumps.
123−
12430.18.3
1254------
1265
servant/servant.cabal+10−11
@@ -1,6 +1,6 @@
11cabal-version: 2.2
22name: servant
3−version: 0.19.1
3+version: 0.18.3
44
55synopsis: A family of combinators for defining webservices APIs
66category: Servant, Web
@@ -62,7 +62,6 @@ library
6262 Servant.API.Vault
6363 Servant.API.Verbs
6464 Servant.API.WithNamedContext
65− Servant.API.WithResource
6665
6766 -- Types
6867 exposed-modules:
@@ -81,25 +80,25 @@ library
8180 --
8281 -- note: mtl lower bound is so low because of GHC-7.8
8382 build-depends:
84− base >= 4.9 && < 4.18
83+ base >= 4.9 && < 4.16
8584 , bytestring >= 0.10.8.1 && < 0.12
8685 , constraints >= 0.2
87− , mtl ^>= 2.2.2 || ^>= 2.3.1
86+ , mtl >= 2.2.2 && < 2.3
8887 , sop-core >= 0.4.0.0 && < 0.6
89− , transformers >= 0.5.2.0 && < 0.7
90− , text >= 1.2.3.0 && < 2.1
88+ , transformers >= 0.5.2.0 && < 0.6
89+ , text >= 1.2.3.0 && < 1.3
9190
9291
9392 -- We depend (heavily) on the API of these packages:
9493 -- i.e. re-export, or allow using without direct dependency
9594 build-depends:
96− http-api-data >= 0.4.1 && < 0.5.1
95+ http-api-data >= 0.4.1 && < 0.4.4
9796 , singleton-bool >= 0.1.4 && < 0.1.7
9897
9998 -- Other dependencies: Lower bound around what is in the latest Stackage LTS.
10099 -- Here can be exceptions if we really need features from the newer versions.
101100 build-depends:
102− base-compat >= 0.10.5 && < 0.13
101+ base-compat >= 0.10.5 && < 0.12
103102 , aeson >= 1.4.1.0 && < 3
104103 , attoparsec >= 0.13.2.2 && < 0.15
105104 , bifunctors >= 5.5.3 && < 5.6
@@ -107,7 +106,7 @@ library
107106 , deepseq >= 1.4.2.0 && < 1.5
108107 , http-media >= 0.7.1.3 && < 0.9
109108 , http-types >= 0.12.2 && < 0.13
110− , mmorph >= 1.1.2 && < 1.3
109+ , mmorph >= 1.1.2 && < 1.2
111110 , network-uri >= 2.6.1.0 && < 2.7
112111 , QuickCheck >= 2.12.6.1 && < 2.15
113112 , string-conversions >= 0.4.0.1 && < 0.5
@@ -167,9 +166,9 @@ test-suite spec
167166
168167 -- Additional dependencies
169168 build-depends:
170− hspec >= 2.6.0 && < 2.10
169+ hspec >= 2.6.0 && < 2.9
171170 , QuickCheck >= 2.12.6.1 && < 2.15
172171 , quickcheck-instances >= 0.3.19 && < 0.4
173172
174173 build-tool-depends:
175− hspec-discover:hspec-discover >= 2.6.0 && < 2.10
174+ hspec-discover:hspec-discover >= 2.6.0 && < 2.9
servant/src/Servant/API.hs+3−11
@@ -31,8 +31,6 @@ module Servant.API (
3131 -- | Access the location for arbitrary data to be shared by applications and middleware
3232 module Servant.API.WithNamedContext,
3333 -- | Access context entries in combinators in servant-server
34− module Servant.API.WithResource,
35− -- | Access a managed resource scoped to a single request
3634
3735 -- * Actual endpoints, distinguished by HTTP method
3836 module Servant.API.Verbs,
@@ -40,7 +38,6 @@ module Servant.API (
4038
4139 -- * Sub-APIs defined as records of routes
4240 module Servant.API.NamedRoutes,
43− module Servant.API.Generic,
4441
4542 -- * Streaming endpoints, distinguished by HTTP method
4643 module Servant.API.Stream,
@@ -103,9 +100,6 @@ import Servant.API.Experimental.Auth
103100 (AuthProtect)
104101import Servant.API.Fragment
105102 (Fragment)
106−import Servant.API.Generic
107− (AsApi, GServantProduct, GenericMode ((:-)), GenericServant,
108− ToServant, ToServantApi, fromServant, genericApi, toServant)
109103import Servant.API.Header
110104 (Header, Header')
111105import Servant.API.HttpVersion
@@ -114,12 +108,10 @@ import Servant.API.IsSecure
114108 (IsSecure (..))
115109import Servant.API.Modifiers
116110 (Lenient, Optional, Required, Strict)
117−import Servant.API.NamedRoutes
118− (NamedRoutes)
119111import Servant.API.QueryParam
120112 (QueryFlag, QueryParam, QueryParam', QueryParams)
121113import Servant.API.Raw
122− (Raw, RawM)
114+ (Raw)
123115import Servant.API.RemoteHost
124116 (RemoteHost)
125117import Servant.API.ReqBody
@@ -141,6 +133,8 @@ import Servant.API.UVerb
141133 Unique, WithStatus (..), inject, statusOf)
142134import Servant.API.Vault
143135 (Vault)
136+import Servant.API.NamedRoutes
137+ (NamedRoutes)
144138import Servant.API.Verbs
145139 (Delete, DeleteAccepted, DeleteNoContent,
146140 DeleteNonAuthoritative, Get, GetAccepted, GetNoContent,
@@ -152,8 +146,6 @@ import Servant.API.Verbs
152146 ReflectMethod (reflectMethod), StdMethod (..), Verb)
153147import Servant.API.WithNamedContext
154148 (WithNamedContext)
155−import Servant.API.WithResource
156− (WithResource)
157149import Servant.Links
158150 (HasLink (..), IsElem, IsElem', Link, URI (..), safeLink)
159151import Web.HttpApiData
servant/src/Servant/API/ContentTypes.hs+1−1
@@ -295,7 +295,7 @@ instance {-# OVERLAPPABLE #-}
295295-- then this would be taken care of. However there is no more specific instance
296296-- between that and 'MimeRender JSON a', so we do this instead
297297instance {-# OVERLAPPING #-} ( Accept ctyp ) => AllMimeRender '[ctyp] NoContent where
298− allMimeRender _ NoContent = map (, "") $ NE.toList $ contentTypes pctyp
298+ allMimeRender _ _ = map (, "") $ NE.toList $ contentTypes pctyp
299299 where
300300 pctyp = Proxy :: Proxy ctyp
301301
servant/src/Servant/API/Raw.hs−3
@@ -15,6 +15,3 @@ import Data.Typeable
1515-- <https://hackage.haskell.org/package/servant-server/docs/Servant-Server-StaticFiles.html Servant.Server.StaticFiles>
1616-- to serve static files stored in a particular directory on your filesystem
1717data Raw deriving Typeable
18−
19−-- | Variant of 'Raw' that lets you access the underlying monadic context to process the request.
20−data RawM deriving Typeable
servant/src/Servant/API/ResponseHeaders.hs−23
@@ -8,7 +8,6 @@
88{-# LANGUAGE PolyKinds #-}
99{-# LANGUAGE ScopedTypeVariables #-}
1010{-# LANGUAGE TypeFamilies #-}
11−{-# LANGUAGE TypeFamilyDependencies #-}
1211{-# LANGUAGE TypeOperators #-}
1312{-# LANGUAGE UndecidableInstances #-}
1413{-# OPTIONS_HADDOCK not-home #-}
@@ -52,9 +51,6 @@ import Prelude ()
5251import Prelude.Compat
5352import Servant.API.Header
5453 (Header)
55−import Servant.API.UVerb.Union
56−import qualified Data.SOP.BasicFunctors as SOP
57−import qualified Data.SOP.NS as SOP
5854
5955-- | Response Header objects. You should never need to construct one directly.
6056-- Instead, use 'addOptionalHeader'.
@@ -174,25 +170,6 @@ instance {-# OVERLAPPABLE #-} ( KnownSymbol h, ToHttpApiData v , new ~ Headers '
174170 => AddHeader h v a new where
175171 addOptionalHeader hdr resp = Headers resp (HCons hdr HNil)
176172
177−-- Instances to decorate all responses in a 'Union' with headers. The functional
178−-- dependencies force us to consider singleton lists as the base case in the
179−-- recursion (it is impossible to determine h and v otherwise from old / new
180−-- responses if the list is empty).
181−instance (AddHeader h v old new) => AddHeader h v (Union '[old]) (Union '[new]) where
182− addOptionalHeader hdr resp =
183− SOP.Z $ SOP.I $ addOptionalHeader hdr $ SOP.unI $ SOP.unZ $ resp
184−
185−instance
186− ( AddHeader h v old new, AddHeader h v (Union oldrest) (Union newrest)
187− -- This ensures that the remainder of the response list is _not_ empty
188− -- It is necessary to prevent the two instances for union types from
189− -- overlapping.
190− , oldrest ~ (a ': as), newrest ~ (b ': bs))
191− => AddHeader h v (Union (old ': (a ': as))) (Union (new ': (b ': bs))) where
192− addOptionalHeader hdr resp = case resp of
193− SOP.Z (SOP.I rHead) -> SOP.Z $ SOP.I $ addOptionalHeader hdr rHead
194− SOP.S rOthers -> SOP.S $ addOptionalHeader hdr rOthers
195−
196173-- | @addHeader@ adds a header to a response. Note that it changes the type of
197174-- the value in the following ways:
198175--
servant/src/Servant/API/TypeLevel.hs+3−3
@@ -110,7 +110,7 @@ type family IsElem' a s :: Constraint
110110--
111111-- >>> ok (Proxy :: Proxy (IsElem ("bye" :> Get '[JSON] Int) SampleAPI))
112112-- ...
113−-- ... Could not ...
113+-- ... Could not deduce...
114114-- ...
115115--
116116-- An endpoint is considered within an api even if it is missing combinators
@@ -151,7 +151,7 @@ type family IsElem endpoint api :: Constraint where
151151--
152152-- >>> ok (Proxy :: Proxy (IsSubAPI (SampleAPI :<|> Get '[JSON] Int) SampleAPI))
153153-- ...
154−-- ... Could not ...
154+-- ... Could not deduce...
155155-- ...
156156--
157157-- This uses @IsElem@ for checking; thus the note there applies here.
@@ -174,7 +174,7 @@ type family AllIsElem xs api :: Constraint where
174174--
175175-- >>> ok (Proxy :: Proxy (IsIn (Get '[JSON] Int) (Header "h" Bool :> Get '[JSON] Int)))
176176-- ...
177−-- ... Could not ...
177+-- ... Could not deduce...
178178-- ...
179179type family IsIn (endpoint :: *) (api :: *) :: Constraint where
180180 IsIn e (sa :<|> sb) = Or (IsIn e sa) (IsIn e sb)
servant/src/Servant/API/UVerb.hs−3
@@ -38,7 +38,6 @@ import GHC.TypeLits (Nat)
3838import Network.HTTP.Types (Status, StdMethod)
3939import Servant.API.ContentTypes (JSON, PlainText, FormUrlEncoded, OctetStream, NoContent, MimeRender(mimeRender), MimeUnrender(mimeUnrender))
4040import Servant.API.Status (KnownStatus, statusVal)
41−import Servant.API.ResponseHeaders (Headers)
4241import Servant.API.UVerb.Union
4342
4443class KnownStatus (StatusOf a) => HasStatus (a :: *) where
@@ -87,8 +86,6 @@ newtype WithStatus (k :: Nat) a = WithStatus a
8786instance KnownStatus n => HasStatus (WithStatus n a) where
8887 type StatusOf (WithStatus n a) = n
8988
90−instance HasStatus a => HasStatus (Headers ls a) where
91− type StatusOf (Headers ls a) = StatusOf a
9289
9390-- | A variant of 'Verb' that can have any of a number of response values and status codes.
9491--
servant/src/Servant/API/UVerb/Union.hs+2−2
@@ -128,9 +128,9 @@ type DuplicateElementError (rs :: [k]) =
128128 ':$$: 'Text " " ':<>: 'ShowType rs
129129
130130type family Elem (x :: k) (xs :: [k]) :: Bool where
131− Elem x (x ': _) = 'True
132− Elem x (_ ': xs) = Elem x xs
133131 Elem _ '[] = 'False
132+ Elem x (x' ': xs) =
133+ If (x == x') 'True (Elem x xs)
134134
135135type family Unique xs :: Constraint where
136136 Unique xs = If (Nubbed xs == 'True) (() :: Constraint) (TypeError (DuplicateElementError xs))
servant/src/Servant/API/Verbs.hs+1−2
@@ -128,8 +128,7 @@ type DeleteNoContent = NoContentVerb 'DELETE
128128type PatchNoContent = NoContentVerb 'PATCH
129129-- | 'PUT' with 204 status code.
130130type PutNoContent = NoContentVerb 'PUT
131−-- | 'HEAD' with 204 status code.
132−type HeadNoContent = NoContentVerb 'HEAD
131+
133132
134133-- ** 205 Reset Content
135134--
servant/src/Servant/API/WithResource.hsdeleted−3
@@ -1,3 +0,0 @@
1−module Servant.API.WithResource (WithResource) where
2−
3−data WithResource res
servant/src/Servant/Links.hs+5−26
@@ -1,6 +1,5 @@
11{-# LANGUAGE AllowAmbiguousTypes #-}
22{-# LANGUAGE ConstraintKinds #-}
3−{-# LANGUAGE CPP #-}
43{-# LANGUAGE DataKinds #-}
54{-# LANGUAGE FlexibleContexts #-}
65{-# LANGUAGE FlexibleInstances #-}
@@ -92,7 +91,7 @@
9291-- >>> let bad_link = Proxy :: Proxy ("hello" :> Delete '[JSON] NoContent)
9392-- >>> safeLink api bad_link
9493-- ...
95−-- ...Could not ...
94+-- ...Could not deduce...
9695-- ...
9796--
9897-- This error is essentially saying that the type family couldn't find
@@ -175,7 +174,7 @@ import Servant.API.NamedRoutes
175174import Servant.API.QueryParam
176175 (QueryFlag, QueryParam', QueryParams)
177176import Servant.API.Raw
178− (Raw, RawM)
177+ (Raw)
179178import Servant.API.RemoteHost
180179 (RemoteHost)
181180import Servant.API.ReqBody
@@ -193,11 +192,7 @@ import Servant.API.Verbs
193192 (Verb, NoContentVerb)
194193import Servant.API.WithNamedContext
195194 (WithNamedContext)
196−import Servant.API.WithResource
197− (WithResource)
198195import Web.HttpApiData
199−import Data.Kind
200− (Type)
201196
202197-- | A safe link datatype.
203198-- The only way of constructing a 'Link' is using 'safeLink', which means any
@@ -560,10 +555,6 @@ instance HasLink sub => HasLink (WithNamedContext name context sub) where
560555 type MkLink (WithNamedContext name context sub) a = MkLink sub a
561556 toLink toA _ = toLink toA (Proxy :: Proxy sub)
562557
563−instance HasLink sub => HasLink (WithResource res :> sub) where
564− type MkLink (WithResource res :> sub) a = MkLink sub a
565− toLink toA _ = toLink toA (Proxy :: Proxy sub)
566−
567558instance HasLink sub => HasLink (RemoteHost :> sub) where
568559 type MkLink (RemoteHost :> sub) a = MkLink sub a
569560 toLink = simpleToLink (Proxy :: Proxy sub)
@@ -589,10 +580,6 @@ instance HasLink Raw where
589580 type MkLink Raw a = a
590581 toLink toA _ = toA
591582
592−instance HasLink RawM where
593− type MkLink RawM a = a
594− toLink toA _ = toA
595−
596583instance HasLink (Stream m status fr ct a) where
597584 type MkLink (Stream m status fr ct a) r = r
598585 toLink toA _ = toA
@@ -660,20 +647,12 @@ simpleToLink _ toA _ = toLink toA (Proxy :: Proxy sub)
660647-- >>> import Data.Text (Text)
661648
662649-- Erroring instance for 'HasLink' when a combinator is not fully applied
663−instance TypeError (PartialApplication
664−#if __GLASGOW_HASKELL__ >= 904
665− @(Type -> Constraint)
666−#endif
667− HasLink arr) => HasLink ((arr :: a -> b) :> sub)
650+instance TypeError (PartialApplication HasLink arr) => HasLink ((arr :: a -> b) :> sub)
668651 where
669− type MkLink (arr :> sub) _ = TypeError (PartialApplication (HasLink :: * -> Constraint) arr)
652+ type MkLink (arr :> sub) _ = TypeError (PartialApplication HasLink arr)
670653 toLink = error "unreachable"
671654
672655-- Erroring instances for 'HasLink' for unknown API combinators
673−instance {-# OVERLAPPABLE #-} TypeError (NoInstanceForSub
674−#if __GLASGOW_HASKELL__ >= 904
675− @(Type -> Constraint)
676−#endif
677− HasLink ty) => HasLink (ty :> sub)
656+instance {-# OVERLAPPABLE #-} TypeError (NoInstanceForSub HasLink ty) => HasLink (ty :> sub)
678657
679658instance {-# OVERLAPPABLE #-} TypeError (NoInstanceFor (HasLink api)) => HasLink api
servant/src/Servant/Test/ComprehensiveAPI.hs−1
@@ -72,7 +72,6 @@ type ComprehensiveAPIWithoutStreamingOrRaw' endpoint =
7272 :<|> "description" :> Description "foo" :> GET
7373 :<|> "alternative" :> ("left" :> GET :<|> "right" :> GET)
7474 :<|> "fragment" :> Fragment Int :> GET
75− :<|> "resource" :> WithResource Int :> GET
7675 :<|> endpoint
7776
7877type ComprehensiveAPIWithoutStreamingOrRaw = ComprehensiveAPIWithoutStreamingOrRaw' EmptyEndpoint
servant/src/Servant/Types/SourceT.hs−3
@@ -1,4 +1,3 @@
1−{-# LANGUAGE CPP #-}
21{-# LANGUAGE DeriveFunctor #-}
32{-# LANGUAGE GADTs #-}
43{-# LANGUAGE RankNTypes #-}
@@ -155,10 +154,8 @@ instance (Applicative m, Show1 m, Show a) => Show (StepT m a) where
155154-- | >>> lift [1,2,3] :: StepT [] Int
156155-- Effect [Yield 1 Stop,Yield 2 Stop,Yield 3 Stop]
157156--
158−#if !MIN_VERSION_transformers(0,6,0)
159157instance MonadTrans StepT where
160158 lift = Effect . fmap (`Yield` Stop)
161−#endif
162159
163160instance MFunctor StepT where
164161 hoist f = go where
servant/test/Servant/API/ContentTypesSpec.hs−11
@@ -33,8 +33,6 @@ import Data.String.Conversions
3333import qualified Data.Text as TextS
3434import qualified Data.Text.Encoding as TextSE
3535import qualified Data.Text.Lazy as TextL
36−import Control.Exception
37− (evaluate)
3836import GHC.Generics
3937import Test.Hspec
4038import Test.QuickCheck
@@ -80,15 +78,6 @@ spec = describe "Servant.API.ContentTypes" $ do
8078 it "has mimeUnrender reverse mimeRender for valid top-level json " $ do
8179 property $ \x -> mimeUnrender p (mimeRender p x) == Right (x::SomeData)
8280
83− describe "The NoContent Content-Type type" $ do
84− let p = Proxy :: Proxy '[JSON]
85−
86− it "does not render any content" $
87− allMimeRender p NoContent `shouldSatisfy` (all (BSL8.null . snd))
88−
89− it "evaluates the NoContent value" $
90− evaluate (allMimeRender p (undefined :: NoContent)) `shouldThrow` anyErrorCall
91−
9281 describe "The PlainText Content-Type type" $ do
9382 let p = Proxy :: Proxy PlainText
9483
servant/test/Servant/API/ResponseHeadersSpec.hs−11
@@ -2,14 +2,10 @@
22{-# LANGUAGE OverloadedStrings #-}
33module Servant.API.ResponseHeadersSpec where
44
5−import Data.Proxy
6−import GHC.TypeLits
75import Test.Hspec
86
9−import Servant.API.ContentTypes
107import Servant.API.Header
118import Servant.API.ResponseHeaders
12−import Servant.API.UVerb
139
1410spec :: Spec
1511spec = describe "Servant.API.ResponseHeaders" $ do
@@ -32,10 +28,3 @@ spec = describe "Servant.API.ResponseHeaders" $ do
3228 it "does not add a header" $ do
3329 let val = noHeader 5 :: Headers '[Header "test" Int] Int
3430 getHeaders val `shouldBe` []
35−
36− describe "HasStatus Headers" $ do
37−
38− it "gets the status from the underlying value" $ do
39− natVal (Proxy :: Proxy (StatusOf (Headers '[Header "first" Int] NoContent))) `shouldBe` 204
40− natVal (Proxy :: Proxy (StatusOf (Headers '[Header "first" Int] (WithStatus 503 ())))) `shouldBe` 503
41−
stack.yaml−1
@@ -11,7 +11,6 @@ packages:
1111- servant-conduit
1212- servant-machines/
1313- servant-pipes/
14−- servant-swagger/
1514
1615# allow-newer: true # ignores all bounds, that's a sledgehammer
1716# - doc/tutorial/