git.iko.soy/typeable/servant
on master help sign in
swap
b3279d996 ahead, 0 behind
96 files changed+1116−406
since splitsnapshots
unifiedsplit
.github/workflows/master.yml+17−29 CONTRIBUTING.md+4−2 cabal.project−23 changelog.d/1469+11 changelog.d/1529+10 changelog.d/1556+81 changelog.d/1569+13 changelog.d/1580+12 changelog.d/1589+2 changelog.d/1595+2 doc/Makefile+1−1 doc/conf.py+1−2 doc/cookbook/basic-auth/basic-auth.cabal+1−1 doc/cookbook/basic-streaming/basic-streaming.cabal+1−1 doc/cookbook/curl-mock/curl-mock.cabal+4−1 doc/cookbook/custom-errors/custom-errors.cabal+1−1 doc/cookbook/db-mysql-basics/mysql-basics.cabal+1−1 doc/cookbook/db-postgres-pool/db-postgres-pool.cabal+1−1 doc/cookbook/db-sqlite-simple/db-sqlite-simple.cabal+1−1 doc/cookbook/file-upload/file-upload.cabal+1−1 doc/cookbook/generic/generic.cabal+1−1 doc/cookbook/hoist-server-with-context/hoist-server-with-context.cabal+1−1 doc/cookbook/https/https.cabal+1−1 doc/cookbook/index.rst+2−2 doc/cookbook/jwt-and-basic-auth/jwt-and-basic-auth.cabal+1−1 doc/cookbook/open-id-connect/OpenIdConnect.cabal+1−1 doc/cookbook/pagination/pagination.cabal+1−1 doc/cookbook/sentry/sentry.cabal+1−1 doc/cookbook/structuring-apis/structuring-apis.cabal+1−1 doc/cookbook/testing/testing.cabal+1−1 doc/cookbook/using-custom-monad/using-custom-monad.cabal+1−1 doc/cookbook/using-free-client/UsingFreeClient.lhs+1−1 doc/cookbook/using-free-client/using-free-client.cabal+1−1 doc/cookbook/uverb/uverb.cabal+1−1 doc/links.rst+1−1 doc/tutorial/install.rst+26 doc/tutorial/tutorial.cabal+2−2 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+15−15 servant-auth/servant-auth-server/src/Servant/Auth/Server/Internal/AddSetCookie.hs+12 servant-auth/servant-auth-server/src/Servant/Auth/Server/Internal/ConfigTypes.hs+2−2 servant-auth/servant-auth-server/src/Servant/Auth/Server/Internal/JWT.hs+4−3 servant-auth/servant-auth-server/src/Servant/Auth/Server/Internal/ThrowAll.hs+10−1 servant-auth/servant-auth-server/test/Servant/Auth/ServerSpec.hs+7 servant-auth/servant-auth-swagger/servant-auth-swagger.cabal+10−14 servant-auth/servant-auth/servant-auth.cabal+8−8 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+49−28 servant-client-core/src/Servant/Client/Core/Request.hs+25−8 servant-client-core/test/Servant/Client/Core/RequestSpec.hs+12 servant-client-ghcjs/servant-client-ghcjs.cabal+4−4 servant-client-ghcjs/src/Servant/Client/Internal/XhrClient.hs+8−5 servant-client/CHANGELOG.md+31 servant-client/servant-client.cabal+13−12 servant-client/src/Servant/Client/Internal/HttpClient.hs+11−11 servant-client/src/Servant/Client/Internal/HttpClient/Streaming.hs+5−7 servant-client/test/Servant/BrokenSpec.hs+71 servant-client/test/Servant/ClientTestUtils.hs+27−4 servant-client/test/Servant/FailSpec.hs+3−3 servant-client/test/Servant/SuccessSpec.hs+21−6 servant-conduit/servant-conduit.cabal+5−5 servant-docs/CHANGELOG.md+9 servant-docs/servant-docs.cabal+8−8 servant-docs/src/Servant/Docs/Internal.hs+4 servant-foreign/servant-foreign.cabal+8−8 servant-http-streams/CHANGELOG.md+10 servant-http-streams/servant-http-streams.cabal+14−14 servant-http-streams/src/Servant/HttpStreams/Internal.hs+6−6 servant-machines/servant-machines.cabal+5−5 servant-pipes/servant-pipes.cabal+6−6 servant-server/CHANGELOG.md+24 servant-server/example/greet.hs−1 servant-server/servant-server.cabal+8−8 servant-server/src/Servant/Server.hs+3−2 servant-server/src/Servant/Server/Internal.hs+30−39 servant-server/src/Servant/Server/Internal/Handler.hs+7−2 servant-server/src/Servant/Server/Internal/Router.hs+31−14 servant-server/test/Servant/Server/RouterSpec.hs+127−6 servant-swagger/example/example.cabal+2−2 servant-swagger/servant-swagger.cabal+16−15 servant-swagger/src/Servant/Swagger.hs+5−3 servant-swagger/src/Servant/Swagger/Internal.hs+11 servant-swagger/src/Servant/Swagger/Internal/Test.hs+8−6 servant/CHANGELOG.md+116 servant/servant.cabal+8−8 servant/src/Servant/API.hs+4 servant/src/Servant/API/ContentTypes.hs+1−1 servant/src/Servant/API/Status.hs+6−1 servant/src/Servant/API/Verbs.hs+2−1 servant/src/Servant/Links.hs+1−1 servant/src/Servant/Types/SourceT.hs+1−1 servant/test/Servant/API/ContentTypesSpec.hs+11 stack.yaml+1
.github/workflows/master.yml+17−29
@@ -13,12 +13,13 @@ jobs:
1313 strategy:
1414 matrix:
1515 os: [ubuntu-latest]
16− cabal: ["3.4"]
16+ cabal: ["3.6"]
1717 ghc:
1818 - "8.6.5"
1919 - "8.8.4"
2020 - "8.10.7"
21− - "9.0.1"
21+ - "9.0.2"
22+ - "9.2.2"
2223
2324 steps:
2425 - uses: actions/checkout@v2
@@ -47,10 +48,7 @@ jobs:
4748
4849 - name: Configure
4950 run: |
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'
51+ cabal install --ignore-project -j2 doctest --constraint='doctest ^>=0.20'
5452
5553 - name: Build
5654 run: |
@@ -61,39 +59,29 @@ jobs:
6159 cabal test all
6260
6361 - 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' }}
6762 run: |
6863 # Necessary for doctest to be found in $PATH
6964 export PATH="$HOME/.cabal/bin:$PATH"
7065
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)
66+ DOCTEST="cabal repl --with-ghc=doctest --ghc-options=-w"
67+ (cd servant && eval $DOCTEST)
68+ (cd servant-client && eval $DOCTEST)
69+ (cd servant-client-core && eval $DOCTEST)
70+ (cd servant-http-streams && eval $DOCTEST)
71+ (cd servant-docs && eval $DOCTEST)
72+ (cd servant-foreign && eval $DOCTEST)
73+ (cd servant-server && eval $DOCTEST)
74+ (cd servant-machines && eval $DOCTEST)
75+ (cd servant-conduit && eval $DOCTEST)
76+ (cd servant-pipes && eval $DOCTEST)
8977
9078 stack:
9179 name: stack / ghc ${{ matrix.ghc }}
9280 runs-on: ubuntu-latest
9381 strategy:
9482 matrix:
95− stack: ["2.7.3"]
96− ghc: ["8.10.4"]
83+ stack: ["2.7.5"]
84+ ghc: ["8.10.7"]
9785
9886 steps:
9987 - uses: actions/checkout@v2
CONTRIBUTING.md+4−2
@@ -79,8 +79,10 @@ 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 #servant on freenode and let us know, or open an
83−issue with the `news` tag (which we will close when we read it).
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).
8486
8587As for adding them to the main repo: maintaining combinators can be expensive,
8688since official combinators must have instances for all classes (and new classes
cabal.project−23
@@ -51,26 +51,3 @@ packages:
5151tests: True
5252optimization: False
5353-- 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/1469new file+11
@@ -0,0 +1,11 @@
1+synopsis: Derive HasClient good response status from Verb status
2+prs: #1469
3+description: {
4+`HasClient` instances for the `Verb` datatype use `runRequest` in
5+`clientWithRoute` definitions.
6+This means that a request performed with `runClientM` will be successful if and
7+only if the endpoint specify a response status code >=200 and <300.
8+This change replaces `runRequest` with `runRequestAcceptStatus` in `Verb`
9+instances for the `HasClient` class, deriving the good response status from
10+the `Verb` status.
11+}
changelog.d/1529new file+10
@@ -0,0 +1,10 @@
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/1556new file+81
@@ -0,0 +1,81 @@
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/1569new file+13
@@ -0,0 +1,13 @@
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/1580new file+12
@@ -0,0 +1,12 @@
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/1589new file+2
@@ -0,0 +1,2 @@
1+synopsis: Only include question mark for nonempty query strings
2+prs: 1589
changelog.d/1595new file+2
@@ -0,0 +1,2 @@
1+synopsis: Run ClientEnv's makeClientRequest in IO.
2+prs: #1595
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 building-the-docs file."; fi
13+ @if [ ! -d venv ]; then echo "WARNING: There is no venv directory, did you forget to 'virtualenv venv'. Check README.md."; 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+1−2
@@ -46,7 +46,7 @@ master_doc = 'index'
4646
4747# General information about the project.
4848project = u'Servant'
49−copyright = u'2018, Servant Contributors'
49+copyright = u'2022, Servant Contributors'
5050author = u'Servant Contributors'
5151
5252# The version info for the project you're documenting, acts as replacement for
@@ -169,4 +169,3 @@ texinfo_documents = [
169169source_parsers = {
170170 '.lhs': CommonMarkParser,
171171}
172−
doc/cookbook/basic-auth/basic-auth.cabal+1−1
@@ -1,3 +1,4 @@
1+cabal-version: 2.2
12name: cookbook-basic-auth
23version: 0.1
34synopsis: Basic Authentication cookbook example
@@ -7,7 +8,6 @@ license-file: ../../../servant/LICENSE
78author: Servant Contributors
89maintainer: haskell-servant-maintainers@googlegroups.com
910build-type: Simple
10−cabal-version: >=1.10
1111tested-with: GHC==8.6.5, GHC==8.8.3, GHC ==8.10.7
1212
1313executable cookbook-basic-auth
doc/cookbook/basic-streaming/basic-streaming.cabal+1−1
@@ -1,3 +1,4 @@
1+cabal-version: 2.2
12name: cookbook-basic-streaming
23version: 2.1
34synopsis: Streaming in servant without streaming libs
@@ -7,7 +8,6 @@ license-file: ../../../servant/LICENSE
78author: Servant Contributors
89maintainer: haskell-servant-maintainers@googlegroups.com
910build-type: Simple
10−cabal-version: >=1.10
1111tested-with: GHC==8.6.5, GHC==8.8.3, GHC ==8.10.7
1212
1313executable cookbook-basic-streaming
doc/cookbook/curl-mock/curl-mock.cabal+4−1
@@ -1,3 +1,4 @@
1+cabal-version: 2.2
12name: cookbook-curl-mock
23version: 0.1
34synopsis: Generate curl mock requests cookbook example
@@ -7,10 +8,12 @@ license-file: ../../../servant/LICENSE
78author: Servant Contributors
89maintainer: haskell-servant-maintainers@googlegroups.com
910build-type: Simple
10−cabal-version: >=1.10
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
1417 main-is: CurlMock.lhs
1518 build-depends: base == 4.*
1619 , aeson
doc/cookbook/custom-errors/custom-errors.cabal+1−1
@@ -1,3 +1,4 @@
1+cabal-version: 2.2
12name: cookbook-custom-errors
23version: 0.1
34synopsis: Return custom error messages from combinators
@@ -7,7 +8,6 @@ license-file: ../../../servant/LICENSE
78author: Servant Contributors
89maintainer: haskell-servant-maintainers@googlegroups.com
910build-type: Simple
10−cabal-version: >=1.10
1111tested-with: GHC==8.6.5, GHC==8.8.3, GHC ==8.10.7
1212
1313executable cookbook-custom-errors
doc/cookbook/db-mysql-basics/mysql-basics.cabal+1−1
@@ -1,3 +1,4 @@
1+cabal-version: 2.2
12name: mysql-basics
23version: 0.1.0.0
34synopsis: Simple MySQL API cookbook example
@@ -7,7 +8,6 @@ license-file: ../../../servant/LICENSE
78author: Servant Contributors
89maintainer: haskell-servant-maintainers@googlegroups.com
910build-type: Simple
10−cabal-version: >=1.10
1111
1212executable run
1313 hs-source-dirs: .
doc/cookbook/db-postgres-pool/db-postgres-pool.cabal+1−1
@@ -1,3 +1,4 @@
1+cabal-version: 2.2
12name: cookbook-db-postgres-pool
23version: 0.1
34synopsis: Simple PostgreSQL connection pool cookbook example
@@ -7,7 +8,6 @@ license-file: ../../../servant/LICENSE
78author: Servant Contributors
89maintainer: haskell-servant-maintainers@googlegroups.com
910build-type: Simple
10−cabal-version: >=1.10
1111tested-with: GHC==8.6.5, GHC==8.8.3, GHC ==8.10.7
1212
1313executable cookbook-db-postgres-pool
doc/cookbook/db-sqlite-simple/db-sqlite-simple.cabal+1−1
@@ -1,3 +1,4 @@
1+cabal-version: 2.2
12name: cookbook-db-sqlite-simple
23version: 0.1
34synopsis: Simple SQLite DB cookbook example
@@ -7,7 +8,6 @@ license-file: ../../../servant/LICENSE
78author: Servant Contributors
89maintainer: haskell-servant-maintainers@googlegroups.com
910build-type: Simple
10−cabal-version: >=1.10
1111tested-with: GHC==8.6.5, GHC==8.8.3, GHC ==8.10.7
1212
1313executable cookbook-db-sqlite-simple
doc/cookbook/file-upload/file-upload.cabal+1−1
@@ -1,3 +1,4 @@
1+cabal-version: 2.2
12name: cookbook-file-upload
23version: 0.1
34synopsis: File upload cookbook example
@@ -7,7 +8,6 @@ license-file: ../../../servant/LICENSE
78author: Servant Contributors
89maintainer: haskell-servant-maintainers@googlegroups.com
910build-type: Simple
10−cabal-version: >=1.10
1111tested-with: GHC==8.6.5, GHC==8.8.3, GHC ==8.10.7
1212
1313executable cookbook-file-upload
doc/cookbook/generic/generic.cabal+1−1
@@ -1,3 +1,4 @@
1+cabal-version: 2.2
12name: cookbook-generic
23version: 0.1
34synopsis: Using custom monad to pass a state between handlers
@@ -7,7 +8,6 @@ license-file: ../../../servant/LICENSE
78author: Servant Contributors
89maintainer: haskell-servant-maintainers@googlegroups.com
910build-type: Simple
10−cabal-version: >=1.10
1111tested-with: GHC==8.6.5, GHC==8.8.3, GHC ==8.10.7
1212
1313executable cookbook-using-custom-monad
doc/cookbook/hoist-server-with-context/hoist-server-with-context.cabal+1−1
@@ -1,3 +1,4 @@
1+cabal-version: 2.2
12name: cookbook-hoist-server-with-context
23version: 0.0.1
34synopsis: JWT and basic access authentication with a Custom Monad cookbook example
@@ -10,7 +11,6 @@ author: Servant Contributors
1011maintainer: haskell-servant-maintainers@googlegroups.com
1112category: Servant
1213build-type: Simple
13−cabal-version: >=1.10
1414tested-with: GHC==8.6.5, GHC==8.8.3, GHC ==8.10.7
1515
1616executable cookbook-hoist-server-with-context
doc/cookbook/https/https.cabal+1−1
@@ -1,3 +1,4 @@
1+cabal-version: 2.2
12name: cookbook-https
23version: 0.1
34synopsis: HTTPS cookbook example
@@ -7,7 +8,6 @@ license-file: ../../../servant/LICENSE
78author: Servant Contributors
89maintainer: haskell-servant-maintainers@googlegroups.com
910build-type: Simple
10−cabal-version: >=1.10
1111tested-with: GHC==8.6.5, GHC==8.8.3, GHC ==8.10.7
1212
1313executable cookbook-https
doc/cookbook/index.rst+2−2
@@ -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 **#servant** IRC channel
10−on freenode or on
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
1111`the mailing list <https://groups.google.com/forum/#!forum/haskell-servant>`_.
1212
1313The scope is very wide. Simple and fancy authentication schemes,
doc/cookbook/jwt-and-basic-auth/jwt-and-basic-auth.cabal+1−1
@@ -1,3 +1,4 @@
1+cabal-version: 2.2
12name: cookbook-jwt-and-basic-auth
23version: 0.0.1
34synopsis: JWT and basic access authentication cookbook example
@@ -10,7 +11,6 @@ author: Servant Contributors
1011maintainer: haskell-servant-maintainers@googlegroups.com
1112category: Servant
1213build-type: Simple
13−cabal-version: >=1.10
1414tested-with: GHC==8.6.5, GHC==8.8.3, GHC ==8.10.7
1515
1616executable cookbook-jwt-and-basic-auth
doc/cookbook/open-id-connect/OpenIdConnect.cabal+1−1
@@ -1,3 +1,4 @@
1+cabal-version: 2.2
12name: open-id-connect
23version: 0.1
34synopsis: OpenId Connect with Servant example
@@ -7,7 +8,6 @@ license-file: ../../../servant/LICENSE
78author: Servant Contributors
89maintainer: haskell-servant-maintainers@googlegroups.com
910build-type: Simple
10−cabal-version: >= 1.10
1111tested-with: GHC==8.6.5
1212
1313executable cookbook-openidconnect
doc/cookbook/pagination/pagination.cabal+1−1
@@ -1,3 +1,4 @@
1+cabal-version: 2.2
12name: cookbook-pagination
23version: 2.1
34synopsis: Pagination with Servant example
@@ -7,7 +8,6 @@ license-file: ../../../servant/LICENSE
78author: Servant Contributors
89maintainer: haskell-servant-maintainers@googlegroups.com
910build-type: Simple
10−cabal-version: >=1.10
1111tested-with: GHC==8.6.5, GHC==8.8.3, GHC ==8.10.7
1212
1313executable cookbook-pagination
doc/cookbook/sentry/sentry.cabal+1−1
@@ -1,3 +1,4 @@
1+cabal-version: 2.2
12name: cookbook-sentry
23version: 0.1
34synopsis: Collecting runtime exceptions using Sentry
@@ -7,7 +8,6 @@ license-file: ../../../servant/LICENSE
78author: Servant Contributors
89maintainer: haskell-servant-maintainers@googlegroups.com
910build-type: Simple
10−cabal-version: >=1.10
1111tested-with: GHC==8.6.5, GHC==8.8.3, GHC ==8.10.7
1212
1313executable cookbook-sentry
doc/cookbook/structuring-apis/structuring-apis.cabal+1−1
@@ -1,3 +1,4 @@
1+cabal-version: 2.2
12name: cookbook-structuring-apis
23version: 0.1
34synopsis: Example that shows how APIs can be structured
@@ -7,7 +8,6 @@ license-file: ../../../servant/LICENSE
78author: Servant Contributors
89maintainer: haskell-servant-maintainers@googlegroups.com
910build-type: Simple
10−cabal-version: >=1.10
1111tested-with: GHC==8.6.5, GHC==8.8.3, GHC ==8.10.7
1212
1313executable cookbook-structuring-apis
doc/cookbook/testing/testing.cabal+1−1
@@ -1,3 +1,4 @@
1+cabal-version: 2.2
12name: cookbook-testing
23version: 0.0.1
34synopsis: Common testing patterns in Servant apps
@@ -9,7 +10,6 @@ author: Servant Contributors
910maintainer: haskell-servant-maintainers@googlegroups.com
1011category: Servant
1112build-type: Simple
12−cabal-version: >=1.10
1313tested-with: GHC==8.6.5, GHC==8.8.3, GHC ==8.10.7
1414
1515executable cookbook-testing
doc/cookbook/using-custom-monad/using-custom-monad.cabal+1−1
@@ -1,3 +1,4 @@
1+cabal-version: 2.2
12name: cookbook-using-custom-monad
23version: 0.1
34synopsis: Using custom monad to pass a state between handlers
@@ -7,7 +8,6 @@ license-file: ../../../servant/LICENSE
78author: Servant Contributors
89maintainer: haskell-servant-maintainers@googlegroups.com
910build-type: Simple
10−cabal-version: >=1.10
1111tested-with: GHC==8.6.5, GHC==8.8.3, GHC ==8.10.7
1212
1313executable cookbook-using-custom-monad
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− let req' = I.defaultMakeClientRequest burl req
122+ req' <- I.defaultMakeClientRequest burl req
123123 putStrLn $ "Making request: " ++ show req'
124124```
125125
doc/cookbook/using-free-client/using-free-client.cabal+1−1
@@ -1,3 +1,4 @@
1+cabal-version: 2.2
12name: cookbook-using-free-client
23version: 0.1
34synopsis: Using Free client
@@ -7,7 +8,6 @@ license-file: ../../../servant/LICENSE
78author: Servant Contributors
89maintainer: haskell-servant-maintainers@googlegroups.com
910build-type: Simple
10−cabal-version: >=1.10
1111tested-with: GHC==8.6.5, GHC==8.8.3, GHC ==8.10.7
1212
1313executable cookbook-using-free-client
doc/cookbook/uverb/uverb.cabal+1−1
@@ -1,3 +1,4 @@
1+cabal-version: 2.2
12name: cookbook-uverb
23version: 0.0.1
34synopsis: How to use the 'UVerb' type.
@@ -9,7 +10,6 @@ author: Servant Contributors
910maintainer: haskell-servant-maintainers@googlegroups.com
1011category: Servant
1112build-type: Simple
12−cabal-version: >=1.10
1313tested-with: GHC==8.6.5, GHC==8.8.4, GHC==8.10.7
1414
1515executable cookbook-uverb
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− ``#servant`` on freenode
15+ `#haskell-servant on libera.chat <https://web.libera.chat/#haskell-servant>`_
1616
1717- the mailing list:
1818 `groups.google.com/forum/#!forum/haskell-servant <https://groups.google.com/forum/#!forum/haskell-servant>`_
doc/tutorial/install.rst+26
@@ -40,3 +40,29 @@ 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+2−2
@@ -1,3 +1,4 @@
1+cabal-version: 2.2
12name: tutorial
23version: 0.10
34synopsis: The servant tutorial
@@ -11,7 +12,6 @@ license-file: LICENSE
1112author: Servant Contributors
1213maintainer: haskell-servant-maintainers@googlegroups.com
1314build-type: Simple
14−cabal-version: >=1.10
1515tested-with:
1616 GHC==8.6.5
1717 GHC==8.8.3, GHC ==8.10.7
@@ -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.10
67+ , lucid >= 2.9.11 && < 2.12
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
@@ -1,3 +1,4 @@
1+cabal-version: 2.2
12name: servant-auth-client
23version: 0.4.1.0
34synopsis: servant-client/servant-auth compatibility
@@ -6,9 +7,9 @@ description: This package provides instances that allow generating clients fr
67 APIs that use
78 <https://hackage.haskell.org/package/servant-auth servant-auth's> @Auth@ combinator.
89 .
9− For a quick overview of the usage, see the <http://github.com/haskell-servant/servant/servant-auth#readme README>.
10+ For a quick overview of the usage, see the <https://github.com/haskell-servant/servant/tree/master/servant-auth#readme README>.
1011category: Web, Servant, Authentication
11−homepage: http://github.com/haskell-servant/servant/servant-auth#readme
12+homepage: https://github.com/haskell-servant/servant/tree/master/servant-auth#readme
1213bug-reports: https://github.com/haskell-servant/servant/issues
1314author: Julian K. Arni
1415maintainer: jkarni@gmail.com
@@ -17,7 +18,6 @@ license: BSD-3-Clause
1718license-file: LICENSE
1819tested-with: GHC ==8.6.5 || ==8.8.4 || ==8.10.4 || ==9.0.1
1920build-type: Simple
20−cabal-version: >= 1.10
2121extra-source-files:
2222 CHANGELOG.md
2323
@@ -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.16
35− , bytestring >= 0.10.6.0 && < 0.11
34+ base >= 4.10 && < 4.17
35+ , bytestring >= 0.10.6.0 && < 0.12
3636 , containers >= 0.5.6.2 && < 0.7
3737 , servant-auth == 0.4.*
38− , servant >= 0.13 && < 0.19
39− , servant-client-core >= 0.13 && < 0.19
38+ , servant >= 0.13 && < 0.20
39+ , servant-client-core >= 0.13 && < 0.20
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.9
53+ build-tool-depends: hspec-discover:hspec-discover >=2.5.5 && <2.10
5454
5555 -- dependencies with bounds inherited from the library stanza
5656 build-depends:
@@ -62,14 +62,14 @@ test-suite spec
6262
6363 -- test dependencies
6464 build-depends:
65− hspec >= 2.5.5 && < 2.9
65+ hspec >= 2.5.5 && < 2.10
6666 , QuickCheck >= 2.11.3 && < 2.15
6767 , aeson >= 1.3.1.1 && < 3
68− , bytestring >= 0.10.6.0 && < 0.11
68+ , bytestring >= 0.10.6.0 && < 0.12
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.19
72+ , servant-server >= 0.13 && < 0.20
7373 , time >= 1.5.0.1 && < 1.13
7474 , transformers >= 0.4.2.0 && < 0.6
7575 , wai >= 3.2.1.2 && < 3.3
servant-auth/servant-auth-docs/servant-auth-docs.cabal+9−9
@@ -1,3 +1,4 @@
1+cabal-version: 2.2
12name: servant-auth-docs
23version: 0.2.10.0
34synopsis: servant-docs/servant-auth compatibility
@@ -6,9 +7,9 @@ description: This package provides instances that allow generating docs from
67 APIs that use
78 <https://hackage.haskell.org/package/servant-auth servant-auth's> @Auth@ combinator.
89 .
9− For a quick overview of the usage, see the <http://github.com/haskell-servant/servant/servant-auth#readme README>.
10+ For a quick overview of the usage, see the <https://github.com/haskell-servant/servant/tree/master/servant-auth#readme README>.
1011category: Web, Servant, Authentication
11−homepage: http://github.com/haskell-servant/servant/servant-auth#readme
12+homepage: https://github.com/haskell-servant/servant/tree/master/servant-auth#readme
1213bug-reports: https://github.com/haskell-servant/servant/issues
1314author: Julian K. Arni
1415maintainer: jkarni@gmail.com
@@ -17,7 +18,6 @@ license: BSD-3-Clause
1718license-file: LICENSE
1819tested-with: GHC ==8.6.5 || ==8.8.4 || ==8.10.4 || ==9.0.1
1920build-type: Custom
20−cabal-version: >= 1.10
2121extra-source-files:
2222 CHANGELOG.md
2323
@@ -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.16
39− , servant-docs >= 0.11.2 && < 0.12
40− , servant >= 0.13 && < 0.19
38+ base >= 4.10 && < 4.17
39+ , servant-docs >= 0.11.2 && < 0.13
40+ , servant >= 0.13 && < 0.20
4141 , servant-auth == 0.4.*
42− , lens >= 4.16.1 && <5.1
42+ , lens >= 4.16.1 && <5.2
4343 exposed-modules:
4444 Servant.Auth.Docs
4545 default-language: Haskell2010
@@ -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.9
67+ build-tool-depends: hspec-discover:hspec-discover >=2.5.5 && <2.10
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.9
81+ , hspec >= 2.5.5 && < 2.10
8282 , QuickCheck >= 2.11.3 && < 2.15
8383
8484 default-language: Haskell2010
servant-auth/servant-auth-server/servant-auth-server.cabal+15−15
@@ -1,14 +1,15 @@
1+cabal-version: 2.2
12name: servant-auth-server
2−version: 0.4.6.0
3+version: 0.4.7.0
34synopsis: servant-server/servant-auth compatibility
45description: This package provides the required instances for using the @Auth@ combinator
56 in your 'servant' server.
67 .
78 Both cookie- and token- (REST API) based authentication is provided.
89 .
9− For a quick overview of the usage, see the <http://github.com/haskell-servant/servant/servant-auth#readme README>.
10+ For a quick overview of the usage, see the <https://github.com/haskell-servant/servant/tree/master/servant-auth#readme README>.
1011category: Web, Servant, Authentication
11−homepage: http://github.com/haskell-servant/servant/servant-auth#readme
12+homepage: https://github.com/haskell-servant/servant/tree/master/servant-auth#readme
1213bug-reports: https://github.com/haskell-servant/servant/issues
1314author: Julian K. Arni
1415maintainer: jkarni@gmail.com
@@ -17,7 +18,6 @@ license: BSD-3-Clause
1718license-file: LICENSE
1819tested-with: GHC ==8.6.5 || ==8.8.4 || ==8.10.4 || ==9.0.1
1920build-type: Simple
20−cabal-version: >= 1.10
2121extra-source-files:
2222 CHANGELOG.md
2323
@@ -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.16
34+ base >= 4.10 && < 4.17
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.11
38+ , bytestring >= 0.10.6.0 && < 0.12
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
4444 , jose >= 0.7.0.0 && < 0.10
45− , lens >= 4.16.1 && < 5.1
46− , memory >= 0.14.16 && < 0.17
45+ , lens >= 4.16.1 && < 5.2
46+ , memory >= 0.14.16 && < 0.18
4747 , monad-time >= 0.3.1.0 && < 0.4
4848 , mtl >= 2.2.2 && < 2.3
49− , servant >= 0.13 && < 0.19
49+ , servant >= 0.13 && < 0.20
5050 , servant-auth == 0.4.*
51− , servant-server >= 0.13 && < 0.19
51+ , servant-server >= 0.13 && < 0.20
5252 , tagged >= 0.8.4 && < 0.9
53− , text >= 1.2.3.0 && < 1.3
54− , time >= 1.5.0.1 && < 1.10
53+ , text >= 1.2.3.0 && < 2.1
54+ , time >= 1.5.0.1 && < 1.12
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.8
105+ build-tool-depends: hspec-discover:hspec-discover >=2.5.5 && <2.10
106106
107107 -- dependencies with bounds inherited from the library stanza
108108 build-depends:
@@ -123,10 +123,10 @@ test-suite spec
123123 -- test dependencies
124124 build-depends:
125125 servant-auth-server
126− , hspec >= 2.5.5 && < 2.8
126+ , hspec >= 2.5.5 && < 2.10
127127 , QuickCheck >= 2.11.3 && < 2.15
128128 , http-client >= 0.5.13.1 && < 0.8
129− , lens-aeson >= 1.0.2 && < 1.2
129+ , lens-aeson >= 1.0.2 && < 1.3
130130 , warp >= 3.2.25 && < 3.4
131131 , wreq >= 0.5.2.1 && < 0.6
132132 other-modules:
servant-auth/servant-auth-server/src/Servant/Auth/Server/Internal/AddSetCookie.hs+12
@@ -11,6 +11,8 @@ import Data.Tagged (Tagged (..))
1111import qualified Network.HTTP.Types as HTTP
1212import Network.Wai (mapResponseHeaders)
1313import Servant
14+import Servant.API.Generic
15+import Servant.Server.Generic
1416import Web.Cookie
1517
1618-- What are we doing here? Well, the idea is to add headers to the response,
@@ -34,6 +36,7 @@ type family AddSetCookieApiVerb a where
3436type family AddSetCookieApi a :: *
3537type instance AddSetCookieApi (a :> b) = a :> AddSetCookieApi b
3638type instance AddSetCookieApi (a :<|> b) = AddSetCookieApi a :<|> AddSetCookieApi b
39+type instance AddSetCookieApi (NamedRoutes api) = AddSetCookieApi (ToServantApi api)
3740type instance AddSetCookieApi (Verb method stat ctyps a)
3841 = Verb method stat ctyps (AddSetCookieApiVerb a)
3942type instance AddSetCookieApi Raw = Raw
@@ -72,6 +75,15 @@ instance {-# OVERLAPS #-}
7275 => AddSetCookies ('S n) (a :<|> b) (a' :<|> b') where
7376 addSetCookies cookies (a :<|> b) = addSetCookies cookies a :<|> addSetCookies cookies b
7477
78+instance {-# OVERLAPS #-}
79+ ( AddSetCookies ('S n) (ServerT (ToServantApi api) m) cookiedApi
80+ , Generic (api (AsServerT m))
81+ , GServantProduct (Rep (api (AsServerT m)))
82+ , ToServant api (AsServerT m) ~ ServerT (ToServantApi api) m
83+ )
84+ => AddSetCookies ('S n) (api (AsServerT m)) cookiedApi where
85+ addSetCookies cookies = addSetCookies cookies . toServant
86+
7587-- | for @servant <0.11@
7688instance
7789 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 :: Jose.JWKSet
36+ , validationKeys :: IO 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 = Jose.JWKSet [k]
47+ , validationKeys = pure $ 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/JWT.hs+4−3
@@ -58,14 +58,15 @@ makeJWT v cfg expiry = runExceptT $ do
5858
5959verifyJWT :: FromJWT a => JWTSettings -> BS.ByteString -> IO (Maybe a)
6060verifyJWT jwtCfg input = do
61− verifiedJWT <- liftIO $ runExceptT $ do
61+ keys <- validationKeys jwtCfg
62+ verifiedJWT <- runExceptT $ do
6263 unverifiedJWT <- Jose.decodeCompact (BSL.fromStrict input)
6364 Jose.verifyClaims
6465 (jwtSettingsToJwtValidationSettings jwtCfg)
65− (validationKeys jwtCfg)
66+ keys
6667 unverifiedJWT
6768 return $ case verifiedJWT of
6869 Left (_ :: Jose.JWTError) -> Nothing
6970 Right v -> case decodeJWT v of
7071 Left _ -> Nothing
71− Right v' -> Just v'
72+ Right v' -> Just v'
servant-auth/servant-auth-server/src/Servant/Auth/Server/Internal/ThrowAll.hs+10−1
@@ -8,7 +8,10 @@ module Servant.Auth.Server.Internal.ThrowAll where
88
99import Control.Monad.Error.Class
1010import Data.Tagged (Tagged (..))
11−import Servant ((:<|>) (..), ServerError(..))
11+import Servant ((:<|>) (..), ServerError(..), NamedRoutes(..))
12+import Servant.API.Generic
13+import Servant.Server.Generic
14+import Servant.Server
1215import Network.HTTP.Types
1316import Network.Wai
1417
@@ -26,6 +29,12 @@ class ThrowAll a where
2629instance (ThrowAll a, ThrowAll b) => ThrowAll (a :<|> b) where
2730 throwAll e = throwAll e :<|> throwAll e
2831
32+instance
33+ ( ThrowAll (ToServant api (AsServerT m)) , GenericServant api (AsServerT m)) =>
34+ ThrowAll (api (AsServerT m)) where
35+
36+ throwAll = fromServant . throwAll
37+
2938-- Really this shouldn't be necessary - ((->) a) should be an instance of
3039-- MonadError, no?
3140instance {-# OVERLAPPING #-} ThrowAll b => ThrowAll (a -> b) where
servant-auth/servant-auth-server/test/Servant/Auth/ServerSpec.hs+7
@@ -50,6 +50,7 @@ import Network.Wreq (Options, auth, basicAuth,
5050import Network.Wreq.Types (Postable(..))
5151import Servant hiding (BasicAuth,
5252 IsSecure (..), header)
53+import Servant.API.Generic ((:-))
5354import Servant.Auth.Server
5455import Servant.Auth.Server.Internal.Cookie (expireTime)
5556import Servant.Auth.Server.SetCookieOrphan ()
@@ -405,6 +406,7 @@ type API auths
405406 = Auth auths User :>
406407 ( Get '[JSON] Int
407408 :<|> ReqBody '[JSON] Int :> Post '[JSON] Int
409+ :<|> NamedRoutes DummyRoutes
408410 :<|> "header" :> Get '[JSON] (Headers '[Header "Blah" Int] Int)
409411#if MIN_VERSION_servant_server(0,15,0)
410412 :<|> "stream" :> StreamGet NoFraming OctetStream (SourceIO BS.ByteString)
@@ -416,6 +418,10 @@ type API auths
416418 :<|> "logout" :> Get '[JSON] (Headers '[ Header "Set-Cookie" SetCookie
417419 , Header "Set-Cookie" SetCookie ] NoContent)
418420
421+data DummyRoutes mode = DummyRoutes
422+ { dummyInt :: mode :- "dummy" :> Get '[JSON] Int
423+ } deriving Generic
424+
419425jwtOnlyApi :: Proxy (API '[Servant.Auth.Server.JWT])
420426jwtOnlyApi = Proxy
421427
@@ -476,6 +482,7 @@ server ccfg =
476482 (\authResult -> case authResult of
477483 Authenticated usr -> getInt usr
478484 :<|> postInt usr
485+ :<|> DummyRoutes { dummyInt = getInt usr }
479486 :<|> getHeaderInt
480487#if MIN_VERSION_servant_server(0,15,0)
481488 :<|> return (S.source ["bytestring"])
servant-auth/servant-auth-swagger/servant-auth-swagger.cabal+10−14
@@ -1,3 +1,4 @@
1+cabal-version: 2.2
12name: servant-auth-swagger
23version: 0.2.10.1
34synopsis: servant-swagger/servant-auth compatibility
@@ -6,9 +7,9 @@ description: This package provides instances that allow generating swagger2 s
67 APIs that use
78 <https://hackage.haskell.org/package/servant-auth servant-auth's> @Auth@ combinator.
89 .
9− For a quick overview of the usage, see the <http://github.com/haskell-servant/servant/servant-auth#readme README>.
10+ For a quick overview of the usage, see the <https://github.com/haskell-servant/servant/tree/master/servant-auth#readme README>.
1011category: Web, Servant, Authentication
11−homepage: http://github.com/haskell-servant/servant/servant-auth#readme
12+homepage: https://github.com/haskell-servant/servant/tree/master/servant-auth#readme
1213bug-reports: https://github.com/haskell-servant/servant/issues
1314author: Julian K. Arni
1415maintainer: jkarni@gmail.com
@@ -17,7 +18,6 @@ license: BSD-3-Clause
1718license-file: LICENSE
1819tested-with: GHC ==8.6.5 || ==8.8.4 || ==8.10.4
1920build-type: Simple
20−cabal-version: >= 1.10
2121extra-source-files:
2222 CHANGELOG.md
2323
@@ -31,15 +31,13 @@ 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.16
35− , text >= 1.2.3.0 && < 1.3
34+ base >= 4.10 && < 4.17
35+ , text >= 1.2.3.0 && < 2.1
3636 , servant-swagger >= 1.1.5 && < 2
3737 , swagger2 >= 2.2.2 && < 3
38− , servant >= 0.13 && < 0.19
38+ , servant >= 0.13 && < 0.20
3939 , servant-auth == 0.4.*
40− , lens >= 4.16.1 && < 5.1
41− if impl(ghc >= 9)
42− buildable: False
40+ , lens >= 4.16.1 && < 5.2
4341 exposed-modules:
4442 Servant.Auth.Swagger
4543 default-language: Haskell2010
@@ -51,7 +49,7 @@ test-suite spec
5149 test
5250 default-extensions: ConstraintKinds DataKinds DefaultSignatures DeriveFoldable DeriveFunctor DeriveGeneric DeriveTraversable FlexibleContexts FlexibleInstances FunctionalDependencies GADTs KindSignatures MultiParamTypeClasses OverloadedStrings RankNTypes ScopedTypeVariables TypeFamilies TypeOperators
5351 ghc-options: -Wall
54− build-tool-depends: hspec-discover:hspec-discover >= 2.5.5 && <2.9
52+ build-tool-depends: hspec-discover:hspec-discover >= 2.5.5 && <2.10
5553 -- dependencies with bounds inherited from the library stanza
5654 build-depends:
5755 base
@@ -61,13 +59,11 @@ test-suite spec
6159 , servant
6260 , servant-auth
6361 , lens
64− if impl(ghc >= 9)
65− buildable: False
66−
62+
6763 -- test dependencies
6864 build-depends:
6965 servant-auth-swagger
70− , hspec >= 2.5.5 && < 2.9
66+ , hspec >= 2.5.5 && < 2.10
7167 , QuickCheck >= 2.11.3 && < 2.15
7268 other-modules:
7369 Servant.Auth.SwaggerSpec
servant-auth/servant-auth/servant-auth.cabal+8−8
@@ -1,5 +1,6 @@
1+cabal-version: 2.2
12name: servant-auth
2−version: 0.4.0.0
3+version: 0.4.1.0
34synopsis: Authentication combinators for servant
45description: This package provides an @Auth@ combinator for 'servant'. This combinator
56 allows using different authentication schemes in a straightforward way,
@@ -8,9 +9,9 @@ description: This package provides an @Auth@ combinator for 'servant'. This c
89 'servant-auth' additionally provides concrete authentication schemes, such
910 as Basic Access Authentication, JSON Web Tokens, and Cookies.
1011 .
11− For more details on how to use this, see the <http://github.com/haskell-servant/servant/servant-auth#readme README>.
12+ For more details on how to use this, see the <https://github.com/haskell-servant/servant/tree/master/servant-auth#readme README>.
1213category: Web, Servant, Authentication
13−homepage: http://github.com/haskell-servant/servant/servant-auth#readme
14+homepage: https://github.com/haskell-servant/servant/tree/master/servant-auth#readme
1415bug-reports: https://github.com/haskell-servant/servant/issues
1516author: Julian K. Arni
1617maintainer: jkarni@gmail.com
@@ -19,7 +20,6 @@ license: BSD-3-Clause
1920license-file: LICENSE
2021tested-with: GHC ==8.6.5 || ==8.8.4 || ==8.10.4 || ==9.0.1
2122build-type: Simple
22−cabal-version: >= 1.10
2323extra-source-files:
2424 CHANGELOG.md
2525
@@ -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.16
36+ base >= 4.10 && < 4.17
3737 , containers >= 0.6 && < 0.7
3838 , aeson >= 1.3.1.1 && < 3
3939 , 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
40+ , lens >= 4.16.1 && < 5.2
41+ , servant >= 0.15 && < 0.20
42+ , text >= 1.2.3.0 && < 2.1
4343 , unordered-containers >= 0.2.9.0 && < 0.3
4444 exposed-modules:
4545 Servant.Auth
servant-client-core/CHANGELOG.md+31
@@ -1,6 +1,37 @@
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+
4350.18.3
536------
637
servant-client-core/servant-client-core.cabal+9−9
@@ -1,6 +1,6 @@
1−cabal-version: >=1.10
1+cabal-version: 2.2
22name: servant-client-core
3−version: 0.18.3
3+version: 0.19
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.16
53+ base >= 4.9 && < 4.17
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 && < 1.3
58+ , text >= 1.2.3.0 && < 2.1
5959 , transformers >= 0.5.2.0 && < 0.6
60− , template-haskell >= 2.11.1.0 && < 2.18
60+ , template-haskell >= 2.11.1.0 && < 2.19
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.18.3 && <0.19
68+ servant >= 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.12
74+ , base-compat >= 0.10.5 && < 0.13
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.9
107+ , hspec >= 2.6.0 && < 2.10
108108 , QuickCheck >= 2.12.6.1 && < 2.15
109109
110110 build-tool-depends:
111− hspec-discover:hspec-discover >= 2.6.0 && <2.9
111+ hspec-discover:hspec-discover >= 2.6.0 && <2.10
servant-client-core/src/Servant/Client/Core.hs+1
@@ -59,6 +59,7 @@ module Servant.Client.Core
5959 , appendToPath
6060 , setRequestBodyLBS
6161 , setRequestBody
62+ , encodeQueryParamValue
6263 ) where
6364import Servant.Client.Core.Auth
6465import Servant.Client.Core.BaseUrl
servant-client-core/src/Servant/Client/Core/HasClient.hs+49−28
@@ -33,9 +33,7 @@ import Control.Arrow
3333import Control.Monad
3434 (unless)
3535import qualified Data.ByteString as BS
36−import Data.ByteString.Builder
37− (toLazyByteString)
38−import qualified Data.ByteString.Lazy as BL
36+import qualified Data.ByteString.Lazy as BL
3937import Data.Either
4038 (partitionEithers)
4139import Data.Constraint (Dict(..))
@@ -65,7 +63,7 @@ import Data.Text
6563import Data.Proxy
6664 (Proxy (Proxy))
6765import GHC.TypeLits
68− (KnownSymbol, symbolVal)
66+ (KnownNat, KnownSymbol, TypeError, symbolVal)
6967import Network.HTTP.Types
7068 (Status)
7169import qualified Network.HTTP.Types as H
@@ -86,9 +84,12 @@ import Servant.API.Generic
8684 , GenericServant, toServant, fromServant)
8785import Servant.API.ContentTypes
8886 (contentTypes, AllMime (allMime), AllMimeUnrender (allMimeUnrender))
87+import Servant.API.Status
88+ (statusFromNat)
8989import Servant.API.TypeLevel (FragmentUnique, AtLeastOneFragment)
9090import Servant.API.Modifiers
9191 (FoldRequired, RequiredArgument, foldRequiredArgument)
92+import Servant.API.TypeErrors
9293import Servant.API.UVerb
9394 (HasStatus, HasStatuses (Statuses, statuses), UVerb, Union, Unique, inject, statusOf, foldMapUnion, matchUnion)
9495
@@ -207,7 +208,7 @@ instance (KnownSymbol capture, ToHttpApiData a, HasClient m api)
207208 clientWithRoute pm (Proxy :: Proxy api)
208209 (appendToPath p req)
209210
210− where p = (toUrlPiece val)
211+ where p = toEncodedUrlPiece val
211212
212213 hoistClientMonad pm _ f cl = \a ->
213214 hoistClientMonad pm (Proxy :: Proxy api) f (cl a)
@@ -242,7 +243,7 @@ instance (KnownSymbol capture, ToHttpApiData a, HasClient m sublayout)
242243 clientWithRoute pm (Proxy :: Proxy sublayout)
243244 (foldl' (flip appendToPath) req ps)
244245
245− where ps = map (toUrlPiece) vals
246+ where ps = map toEncodedUrlPiece vals
246247
247248 hoistClientMonad pm _ f cl = \as ->
248249 hoistClientMonad pm (Proxy :: Proxy sublayout) f (cl as)
@@ -250,10 +251,11 @@ instance (KnownSymbol capture, ToHttpApiData a, HasClient m sublayout)
250251instance {-# OVERLAPPABLE #-}
251252 -- Note [Non-Empty Content Types]
252253 ( RunClient m, MimeUnrender ct a, ReflectMethod method, cts' ~ (ct ': cts)
254+ , KnownNat status
253255 ) => HasClient m (Verb method status cts' a) where
254256 type Client m (Verb method status cts' a) = m a
255257 clientWithRoute _pm Proxy req = do
256− response <- runRequest req
258+ response <- runRequestAcceptStatus (Just [status]) req
257259 { requestAccept = fromList $ toList accept
258260 , requestMethod = method
259261 }
@@ -261,18 +263,20 @@ instance {-# OVERLAPPABLE #-}
261263 where
262264 accept = contentTypes (Proxy :: Proxy ct)
263265 method = reflectMethod (Proxy :: Proxy method)
266+ status = statusFromNat (Proxy :: Proxy status)
264267
265268 hoistClientMonad _ _ f ma = f ma
266269
267270instance {-# OVERLAPPING #-}
268− ( RunClient m, ReflectMethod method
271+ ( RunClient m, ReflectMethod method, KnownNat status
269272 ) => HasClient m (Verb method status cts NoContent) where
270273 type Client m (Verb method status cts NoContent)
271274 = m NoContent
272275 clientWithRoute _pm Proxy req = do
273− _response <- runRequest req { requestMethod = method }
276+ _response <- runRequestAcceptStatus (Just [status]) req { requestMethod = method }
274277 return NoContent
275278 where method = reflectMethod (Proxy :: Proxy method)
279+ status = statusFromNat (Proxy :: Proxy status)
276280
277281 hoistClientMonad _ _ f ma = f ma
278282
@@ -289,13 +293,13 @@ instance (RunClient m, ReflectMethod method) =>
289293
290294instance {-# OVERLAPPING #-}
291295 -- Note [Non-Empty Content Types]
292− ( RunClient m, MimeUnrender ct a, BuildHeadersTo ls
296+ ( RunClient m, MimeUnrender ct a, BuildHeadersTo ls, KnownNat status
293297 , ReflectMethod method, cts' ~ (ct ': cts)
294298 ) => HasClient m (Verb method status cts' (Headers ls a)) where
295299 type Client m (Verb method status cts' (Headers ls a))
296300 = m (Headers ls a)
297301 clientWithRoute _pm Proxy req = do
298− response <- runRequest req
302+ response <- runRequestAcceptStatus (Just [status]) req
299303 { requestMethod = method
300304 , requestAccept = fromList $ toList accept
301305 }
@@ -303,22 +307,26 @@ instance {-# OVERLAPPING #-}
303307 return $ Headers { getResponse = val
304308 , getHeadersHList = buildHeadersTo . toList $ responseHeaders response
305309 }
306− where method = reflectMethod (Proxy :: Proxy method)
307− accept = contentTypes (Proxy :: Proxy ct)
310+ where
311+ method = reflectMethod (Proxy :: Proxy method)
312+ accept = contentTypes (Proxy :: Proxy ct)
313+ status = statusFromNat (Proxy :: Proxy status)
308314
309315 hoistClientMonad _ _ f ma = f ma
310316
311317instance {-# OVERLAPPING #-}
312− ( RunClient m, BuildHeadersTo ls, ReflectMethod method
318+ ( RunClient m, BuildHeadersTo ls, ReflectMethod method, KnownNat status
313319 ) => HasClient m (Verb method status cts (Headers ls NoContent)) where
314320 type Client m (Verb method status cts (Headers ls NoContent))
315321 = m (Headers ls NoContent)
316322 clientWithRoute _pm Proxy req = do
317− let method = reflectMethod (Proxy :: Proxy method)
318− response <- runRequest req { requestMethod = method }
323+ response <- runRequestAcceptStatus (Just [status]) req { requestMethod = method }
319324 return $ Headers { getResponse = NoContent
320325 , getHeadersHList = buildHeadersTo . toList $ responseHeaders response
321326 }
327+ where
328+ method = reflectMethod (Proxy :: Proxy method)
329+ status = statusFromNat (Proxy :: Proxy status)
322330
323331 hoistClientMonad _ _ f ma = f ma
324332
@@ -561,7 +569,7 @@ instance (KnownSymbol sym, ToHttpApiData a, HasClient m api, SBoolI (FoldRequire
561569 (Proxy :: Proxy mods) add (maybe req add) mparam
562570 where
563571 add :: a -> Request
564− add param = appendToQueryString pname (Just $ encodeQueryParam param) req
572+ add param = appendToQueryString pname (Just $ encodeQueryParamValue param) req
565573
566574 pname :: Text
567575 pname = pack $ symbolVal (Proxy :: Proxy sym)
@@ -569,9 +577,6 @@ instance (KnownSymbol sym, ToHttpApiData a, HasClient m api, SBoolI (FoldRequire
569577 hoistClientMonad pm _ f cl = \arg ->
570578 hoistClientMonad pm (Proxy :: Proxy api) f (cl arg)
571579
572−encodeQueryParam :: ToHttpApiData a => a -> BS.ByteString
573−encodeQueryParam = BL.toStrict . toLazyByteString . toEncodedUrlPiece
574−
575580-- | If you use a 'QueryParams' in one of your endpoints in your API,
576581-- the corresponding querying function will automatically take
577582-- an additional argument, a list of values of the type specified
@@ -613,7 +618,7 @@ instance (KnownSymbol sym, ToHttpApiData a, HasClient m api)
613618 )
614619
615620 where pname = pack $ symbolVal (Proxy :: Proxy sym)
616− paramlist' = map (Just . encodeQueryParam) paramlist
621+ paramlist' = map (Just . encodeQueryParamValue) paramlist
617622
618623 hoistClientMonad pm _ f cl = \as ->
619624 hoistClientMonad pm (Proxy :: Proxy api) f (cl as)
@@ -735,7 +740,7 @@ instance (KnownSymbol path, HasClient m api) => HasClient m (path :> api) where
735740 clientWithRoute pm (Proxy :: Proxy api)
736741 (appendToPath p req)
737742
738− where p = pack $ symbolVal (Proxy :: Proxy path)
743+ where p = toEncodedUrlPiece $ pack $ symbolVal (Proxy :: Proxy path)
739744
740745 hoistClientMonad pm _ f cl = hoistClientMonad pm (Proxy :: Proxy api) f cl
741746
@@ -784,7 +789,7 @@ instance ( HasClient m api
784789
785790-- | Ignore @'Fragment'@ in client functions.
786791-- See <https://ietf.org/rfc/rfc2616.html#section-15.1.3> for more details.
787−--
792+--
788793-- Example:
789794--
790795-- > type MyApi = "books" :> Fragment Text :> Get '[JSON] [Book]
@@ -801,7 +806,7 @@ instance (AtLeastOneFragment api, FragmentUnique (Fragment a :> api), HasClient
801806
802807 type Client m (Fragment a :> api) = Client m api
803808
804− clientWithRoute pm _ = clientWithRoute pm (Proxy :: Proxy api)
809+ clientWithRoute pm _ = clientWithRoute pm (Proxy :: Proxy api)
805810
806811 hoistClientMonad pm _ = hoistClientMonad pm (Proxy :: Proxy api)
807812
@@ -869,7 +874,7 @@ infixl 2 /:
869874--
870875-- Example:
871876--
872−-- @@
877+-- @
873878-- type Api = NamedRoutes RootApi
874879--
875880-- data RootApi mode = RootApi
@@ -890,7 +895,7 @@ infixl 2 /:
890895--
891896-- endpointClient :: ClientM Person
892897-- endpointClient = client // subApi // endpoint
893−-- @@
898+-- @
894899(//) :: a -> (a -> b) -> b
895900x // f = f x
896901
@@ -901,7 +906,7 @@ x // f = f x
901906--
902907-- Example:
903908--
904−-- @@
909+-- @
905910-- type Api = NamedRoutes RootApi
906911--
907912-- data RootApi mode = RootApi
@@ -926,7 +931,7 @@ x // f = f x
926931--
927932-- endpointClient :: ClientM Person
928933-- endpointClient = client // subApi /: "foobar123" // endpoint
929−-- @@
934+-- @
930935(/:) :: (a -> b -> c) -> b -> a -> c
931936(/:) = flip
932937
@@ -970,3 +975,19 @@ decodedAs response ct = do
970975 Right val -> return val
971976 where
972977 accept = toList $ contentTypes ct
978+
979+-------------------------------------------------------------------------------
980+-- Custom type errors
981+-------------------------------------------------------------------------------
982+
983+-- Erroring instance for HasClient' when a combinator is not fully applied
984+instance (RunClient m, TypeError (PartialApplication HasClient arr)) => HasClient m ((arr :: a -> b) :> sub)
985+ where
986+ type Client m (arr :> sub) = TypeError (PartialApplication HasClient arr)
987+ clientWithRoute _ _ _ = error "unreachable"
988+ hoistClientMonad _ _ _ _ = error "unreachable"
989+
990+-- Erroring instances for 'HasClient' for unknown API combinators
991+instance {-# OVERLAPPABLE #-} (RunClient m, TypeError (NoInstanceForSub (HasClient m) ty)) => HasClient m (ty :> sub)
992+
993+instance {-# OVERLAPPABLE #-} (RunClient m, TypeError (NoInstanceFor (HasClient m api))) => HasClient m api
servant-client-core/src/Servant/Client/Core/Request.hs+25−8
@@ -17,6 +17,7 @@ module Servant.Client.Core.Request (
1717 addHeader,
1818 appendToPath,
1919 appendToQueryString,
20+ encodeQueryParamValue,
2021 setRequestBody,
2122 setRequestBodyLBS,
2223 ) where
@@ -33,6 +34,8 @@ import Data.Bifunctor
3334import Data.Bitraversable
3435 (Bitraversable (..), bifoldMapDefault, bimapDefault)
3536import qualified Data.ByteString as BS
37+import Data.ByteString.Builder
38+ (Builder)
3639import qualified Data.ByteString.Builder as Builder
3740import qualified Data.ByteString.Lazy as LBS
3841import qualified Data.Sequence as Seq
@@ -48,9 +51,9 @@ import Network.HTTP.Media
4851 (MediaType)
4952import Network.HTTP.Types
5053 (Header, HeaderName, HttpVersion (..), Method, QueryItem,
51− http11, methodGet)
54+ http11, methodGet, urlEncodeBuilder)
5255import Servant.API
53− (ToHttpApiData, toEncodedUrlPiece, toHeader, SourceIO)
56+ (ToHttpApiData, toEncodedUrlPiece, toQueryParam, toHeader, SourceIO)
5457
5558import Servant.Client.Core.Internal (mediaTypeRnf)
5659
@@ -78,12 +81,13 @@ instance (Show a, Show b) =>
7881 . showString ", requestAccept = "
7982 . showsPrec 0 (requestAccept req)
8083 . showString ", requestHeaders = "
81− . showsPrec 0 (redactSensitiveHeader <$> requestHeaders req))
84+ . showsPrec 0 (redactSensitiveHeader <$> requestHeaders req)
8285 . showString ", requestHttpVersion = "
8386 . showsPrec 0 (requestHttpVersion req)
8487 . showString ", requestMethod = "
8588 . showsPrec 0 (requestMethod req)
8689 . showString "}"
90+ )
8791 where
8892 redactSensitiveHeader :: Header -> Header
8993 redactSensitiveHeader ("Authorization", _) = ("Authorization", "<REDACTED>")
@@ -110,7 +114,7 @@ instance (NFData path, NFData body) => NFData (RequestF body path) where
110114 rnfB Nothing = ()
111115 rnfB (Just (b, mt)) = rnf b `seq` mediaTypeRnf mt
112116
113−type Request = RequestF RequestBody Builder.Builder
117+type Request = RequestF RequestBody Builder
114118
115119-- | The request body. R replica of the @http-client@ @RequestBody@.
116120data RequestBody
@@ -141,18 +145,31 @@ defaultRequest = Request
141145 , requestMethod = methodGet
142146 }
143147
144−appendToPath :: Text -> Request -> Request
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
145152appendToPath p req
146− = req { requestPath = requestPath req <> "/" <> toEncodedUrlPiece p }
153+ = req { requestPath = requestPath req <> "/" <> p }
147154
148−appendToQueryString :: Text -- ^ param name
149− -> Maybe BS.ByteString -- ^ param value
155+-- | Append a query parameter to the request being constructed.
156+--
157+appendToQueryString :: Text -- ^ query param name
158+ -> Maybe BS.ByteString -- ^ query param value
150159 -> Request
151160 -> Request
152161appendToQueryString pname pvalue req
153162 = req { requestQueryString = requestQueryString req
154163 Seq.|> (encodeUtf8 pname, pvalue)}
155164
165+-- | Encode a query parameter value.
166+--
167+encodeQueryParamValue :: ToHttpApiData a => a -> BS.ByteString
168+encodeQueryParamValue = LBS.toStrict . Builder.toLazyByteString
169+ . urlEncodeBuilder True . encodeUtf8 . toQueryParam
170+
171+-- | Add header to the request being constructed.
172+--
156173addHeader :: ToHttpApiData a => HeaderName -> a -> Request -> Request
157174addHeader name val req
158175 = req { requestHeaders = requestHeaders req Seq.|> (name, toHeader val)}
servant-client-core/test/Servant/Client/Core/RequestSpec.hs+12
@@ -10,10 +10,22 @@ import Data.List (isInfixOf)
1010import Servant.Client.Core.Request
1111import Test.Hspec
1212
13+newtype DataWithRequest = DataWithRequest (RequestF RequestBody ())
14+ deriving Show
15+
1316spec :: Spec
1417spec = do
1518 describe "Request" $ do
1619 describe "show" $ do
20+ it "has parenthesis correctly positioned" $ do
21+ let d = DataWithRequest (void defaultRequest)
22+ show d `shouldBe` "DataWithRequest (Request {requestPath = ()\
23+ \, requestQueryString = fromList []\
24+ \, requestBody = Nothing\
25+ \, requestAccept = fromList []\
26+ \, requestHeaders = fromList []\
27+ \, requestHttpVersion = HTTP/1.1\
28+ \, requestMethod = \"GET\"})"
1729 it "redacts the authorization header" $ do
1830 let request = void $ defaultRequest { requestHeaders = pure ("authorization", "secret") }
1931 isInfixOf "secret" (show request) `shouldBe` False
servant-client-ghcjs/servant-client-ghcjs.cabal+4−4
@@ -1,4 +1,4 @@
1−cabal-version: >=1.10
1+cabal-version: 2.2
22name: servant-client-ghcjs
33version: 0.16
44synopsis:
@@ -38,7 +38,7 @@ library
3838 Servant.Client.Internal.XhrClient
3939
4040 build-depends:
41− base >=4.11 && <4.12
41+ base >=4.11 && <5
4242 , bytestring >=0.10 && <0.12
4343 , case-insensitive >=1.2.0.0 && <1.3.0.0
4444 , containers >=0.5 && <0.7
@@ -56,8 +56,8 @@ library
5656
5757 -- strict, as we re-export stuff
5858 build-depends:
59− servant >=0.16 && <0.17
60− , servant-client-core >=0.16 && <0.16.1
59+ servant >=0.16 && <0.20
60+ , servant-client-core >=0.16 && <0.20
6161
6262 hs-source-dirs: src
6363 default-language: Haskell2010
servant-client-ghcjs/src/Servant/Client/Internal/XhrClient.hs+8−5
@@ -120,7 +120,7 @@ instance Exception StreamingNotSupportedException where
120120 displayException _ = "streamingRequest: streaming is not supported!"
121121
122122instance RunClient ClientM where
123− runRequest = performRequest
123+ runRequestAcceptStatus = performRequest
124124 throwClientError = throwError
125125
126126runClientMOrigin :: ClientM a -> ClientEnv -> IO (Either ClientError a)
@@ -152,15 +152,18 @@ runClientM m = do
152152
153153 runClientMOrigin m (ClientEnv (BaseUrl protocol hostname port ""))
154154
155−performRequest :: Request -> ClientM Response
156−performRequest req = do
155+performRequest :: Maybe [Status] -> Request -> ClientM Response
156+performRequest acceptStatus req = do
157157 xhr <- liftIO initXhr
158158 burl <- asks baseUrl
159159 liftIO $ performXhr xhr burl req
160160 resp <- toResponse xhr
161161
162− let status = statusCode (responseStatusCode resp)
163− unless (status >= 200 && status < 300) $ do
162+ let status = responseStatusCode resp
163+ goodStatus = case acceptStatus of
164+ Nothing -> statusIsSuccessful status
165+ Just good -> status `elem` good
166+ unless goodStatus $ do
164167 let f b = (burl, BL.toStrict $ toLazyByteString b)
165168 throwError $ FailureResponse (bimap (const ()) f req) resp
166169
servant-client/CHANGELOG.md+31
@@ -1,6 +1,37 @@
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+
4350.18.3
536------
637
servant-client/servant-client.cabal+13−12
@@ -1,6 +1,6 @@
1−cabal-version: >=1.10
1+cabal-version: 2.2
22name: servant-client
3−version: 0.18.3
3+version: 0.19
44
55synopsis: Automatic derivation of querying functions for servant
66category: Servant, Web
@@ -41,14 +41,14 @@ 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.16
44+ base >= 4.9 && < 4.17
4545 , bytestring >= 0.10.8.1 && < 0.12
4646 , containers >= 0.5.7.1 && < 0.7
4747 , deepseq >= 1.4.2.0 && < 1.5
4848 , mtl >= 2.2.2 && < 2.3
4949 , stm >= 2.4.5.1 && < 2.6
50− , text >= 1.2.3.0 && < 1.3
51− , time >= 1.6.0.1 && < 1.10
50+ , text >= 1.2.3.0 && < 2.1
51+ , time >= 1.6.0.1 && < 1.12
5252 , transformers >= 0.5.2.0 && < 0.6
5353
5454 if !impl(ghc >= 8.2)
@@ -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.*
62− , servant-client-core >= 0.18.3 && <0.18.4
61+ servant >= 0.18 && < 0.20
62+ , servant-client-core >= 0.19 && < 0.19.1
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.12
67+ base-compat >= 0.10.5 && < 0.13
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
@@ -89,6 +89,7 @@ test-suite spec
8989 main-is: Spec.hs
9090 other-modules:
9191 Servant.BasicAuthSpec
92+ Servant.BrokenSpec
9293 Servant.ClientTestUtils
9394 Servant.ConnectionErrorSpec
9495 Servant.FailSpec
@@ -123,16 +124,16 @@ test-suite spec
123124 -- Additional dependencies
124125 build-depends:
125126 entropy >= 0.4.1.3 && < 0.5
126− , hspec >= 2.6.0 && < 2.9
127+ , hspec >= 2.6.0 && < 2.10
127128 , HUnit >= 1.6.0.0 && < 1.7
128129 , network >= 2.8.0.0 && < 3.2
129130 , QuickCheck >= 2.12.6.1 && < 2.15
130− , servant == 0.18.*
131− , servant-server == 0.18.*
131+ , servant == 0.19.*
132+ , servant-server == 0.19.*
132133 , tdigest >= 0.2 && < 0.3
133134
134135 build-tool-depends:
135− hspec-discover:hspec-discover >= 2.6.0 && < 2.9
136+ hspec-discover:hspec-discover >= 2.6.0 && < 2.10
136137
137138test-suite readme
138139 type: exitcode-stdio-1.0
servant-client/src/Servant/Client/Internal/HttpClient.hs+11−11
@@ -24,7 +24,7 @@ import Control.Monad
2424import Control.Monad.Base
2525 (MonadBase (..))
2626import Control.Monad.Catch
27− (MonadCatch, MonadThrow)
27+ (MonadCatch, MonadThrow, MonadMask)
2828import Control.Monad.Error.Class
2929 (MonadError (..))
3030import Control.Monad.IO.Class
@@ -63,7 +63,7 @@ import GHC.Generics
6363import Network.HTTP.Media
6464 (renderHeader)
6565import Network.HTTP.Types
66− (hContentType, renderQuery, statusCode, urlEncode, Status)
66+ (hContentType, renderQuery, statusIsSuccessful, urlEncode, Status)
6767import Servant.Client.Core
6868
6969import qualified Network.HTTP.Client as Client
@@ -80,7 +80,7 @@ data ClientEnv
8080 { manager :: Client.Manager
8181 , baseUrl :: BaseUrl
8282 , cookieJar :: Maybe (TVar Client.CookieJar)
83− , makeClientRequest :: BaseUrl -> Request -> Client.Request
83+ , makeClientRequest :: BaseUrl -> Request -> IO 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)
139+ , MonadCatch, MonadMask)
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− let clientRequest = createClientRequest burl req
165+ clientRequest <- liftIO $ createClientRequest burl req
166166 request <- case cookieJar' of
167167 Nothing -> pure clientRequest
168168 Just cj -> liftIO $ do
@@ -179,10 +179,9 @@ performRequest acceptStatus req = do
179179
180180 response <- maybe (requestWithoutCookieJar m request) (requestWithCookieJar m request) cookieJar'
181181 let status = Client.responseStatus response
182− status_code = statusCode status
183182 ourResponse = clientResponseToResponse id response
184183 goodStatus = case acceptStatus of
185− Nothing -> status_code >= 200 && status_code < 300
184+ Nothing -> statusIsSuccessful status
186185 Just good -> status `elem` good
187186 unless goodStatus $ do
188187 throwError $ mkFailureResponse burl req ourResponse
@@ -230,8 +229,8 @@ clientResponseToResponse f r = Response
230229-- | Create a @http-client@ 'Client.Request' from a @servant@ 'Request'
231230-- The 'Client.host', 'Client.path' and 'Client.port' fields are extracted from the 'BaseUrl'
232231-- otherwise the body, headers and query string are derived from the @servant@ 'Request'
233−defaultMakeClientRequest :: BaseUrl -> Request -> Client.Request
234−defaultMakeClientRequest burl r = Client.defaultRequest
232+defaultMakeClientRequest :: BaseUrl -> Request -> IO Client.Request
233+defaultMakeClientRequest burl r = return Client.defaultRequest
235234 { Client.method = requestMethod r
236235 , Client.host = fromString $ baseUrlHost burl
237236 , Client.port = baseUrlPort burl
@@ -247,7 +246,7 @@ defaultMakeClientRequest burl r = Client.defaultRequest
247246 where
248247 -- Content-Type and Accept are specified by requestBody and requestAccept
249248 headers = filter (\(h, _) -> h /= "Accept" && h /= "Content-Type") $
250− toList $requestHeaders r
249+ toList $ requestHeaders r
251250
252251 acceptHdr
253252 | null hs = Nothing
@@ -290,7 +289,8 @@ defaultMakeClientRequest burl r = Client.defaultRequest
290289 Https -> True
291290
292291 -- Query string builder which does not do any encoding
293− buildQueryString = ("?" <>) . foldl' addQueryParam mempty
292+ buildQueryString [] = mempty
293+ buildQueryString qps = "?" <> foldl' addQueryParam mempty qps
294294
295295 addQueryParam qs (k, v) =
296296 qs <> (if BS.null qs then mempty else "&") <> urlEncode True k <> foldMap ("=" <>) v
servant-client/src/Servant/Client/Internal/HttpClient/Streaming.hs+5−7
@@ -47,7 +47,7 @@ import Data.Time.Clock
4747 (getCurrentTime)
4848import GHC.Generics
4949import Network.HTTP.Types
50− (Status, statusCode)
50+ (Status, statusIsSuccessful)
5151
5252import qualified Network.HTTP.Client as Client
5353
@@ -140,7 +140,7 @@ performRequest :: Maybe [Status] -> Request -> ClientM Response
140140performRequest acceptStatus req = do
141141 -- TODO: should use Client.withResponse here too
142142 ClientEnv m burl cookieJar' createClientRequest <- ask
143− let clientRequest = createClientRequest burl req
143+ clientRequest <- liftIO $ createClientRequest burl req
144144 request <- case cookieJar' of
145145 Nothing -> pure clientRequest
146146 Just cj -> liftIO $ do
@@ -163,10 +163,9 @@ performRequest acceptStatus req = do
163163 now' <- getCurrentTime
164164 atomically $ modifyTVar' cj (fst . Client.updateCookieJar response request now')
165165 let status = Client.responseStatus response
166− status_code = statusCode status
167166 ourResponse = clientResponseToResponse id response
168167 goodStatus = case acceptStatus of
169− Nothing -> status_code >= 200 && status_code < 300
168+ Nothing -> statusIsSuccessful status
170169 Just good -> status `elem` good
171170 unless goodStatus $ do
172171 throwError $ mkFailureResponse burl req ourResponse
@@ -178,14 +177,13 @@ performWithStreamingRequest req k = do
178177 m <- asks manager
179178 burl <- asks baseUrl
180179 createClientRequest <- asks makeClientRequest
181− let request = createClientRequest burl req
180+ request <- liftIO $ createClientRequest burl req
182181 ClientM $ lift $ lift $ Codensity $ \k1 ->
183182 Client.withResponse request m $ \res -> do
184183 let status = Client.responseStatus res
185− status_code = statusCode status
186184
187185 -- we throw FailureResponse in IO :(
188− unless (status_code >= 200 && status_code < 300) $ do
186+ unless (statusIsSuccessful status) $ do
189187 b <- BSL.fromChunks <$> Client.brConsume (Client.responseBody res)
190188 throwIO $ mkFailureResponse burl req (clientResponseToResponse (const b) res)
191189
servant-client/test/Servant/BrokenSpec.hsnew file+71
@@ -0,0 +1,71 @@
1+{-# LANGUAGE DataKinds #-}
2+{-# LANGUAGE TypeOperators #-}
3+{-# OPTIONS_GHC -freduction-depth=100 #-}
4+{-# OPTIONS_GHC -fno-warn-orphans #-}
5+{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
6+
7+module Servant.BrokenSpec (spec) where
8+
9+import Prelude ()
10+import Prelude.Compat
11+
12+import Data.Monoid ()
13+import Data.Proxy
14+import qualified Network.HTTP.Types as HTTP
15+import Test.Hspec
16+
17+import Servant.API
18+ ((:<|>) ((:<|>)), (:>), JSON, Verb, Get, StdMethod (GET))
19+import Servant.Client
20+import Servant.ClientTestUtils
21+import Servant.Server
22+
23+-- * api for testing inconsistencies between client and server
24+
25+type Get201 = Verb 'GET 201
26+type Get301 = Verb 'GET 301
27+
28+type BrokenAPI =
29+ -- the server should respond with 200, but returns 201
30+ "get200" :> Get201 '[JSON] ()
31+ -- the server should respond with 307, but returns 301
32+ :<|> "get307" :> Get301 '[JSON] ()
33+
34+brokenApi :: Proxy BrokenAPI
35+brokenApi = Proxy
36+
37+brokenServer :: Application
38+brokenServer = serve brokenApi (pure () :<|> pure ())
39+
40+type PublicAPI =
41+ -- the client expects 200
42+ "get200" :> Get '[JSON] ()
43+ -- the client expects 307
44+ :<|> "get307" :> Get307 '[JSON] ()
45+
46+publicApi :: Proxy PublicAPI
47+publicApi = Proxy
48+
49+get200Client :: ClientM ()
50+get307Client :: ClientM ()
51+get200Client :<|> get307Client = client publicApi
52+
53+
54+spec :: Spec
55+spec = describe "Servant.BrokenSpec" $ do
56+ brokenSpec
57+
58+brokenSpec :: Spec
59+brokenSpec = beforeAll (startWaiApp brokenServer) $ afterAll endWaiApp $ do
60+ context "client returns errors for inconsistencies between client and server api" $ do
61+ it "reports FailureResponse with wrong 2xx status code" $ \(_, baseUrl) -> do
62+ res <- runClient get200Client baseUrl
63+ case res of
64+ Left (FailureResponse _ r) | responseStatusCode r == HTTP.status201 -> return ()
65+ _ -> fail $ "expected 201 broken response, but got " <> show res
66+
67+ it "reports FailureResponse with wrong 3xx status code" $ \(_, baseUrl) -> do
68+ res <- runClient get307Client baseUrl
69+ case res of
70+ Left (FailureResponse _ r) | responseStatusCode r == HTTP.status301 -> return ()
71+ _ -> fail $ "expected 301 broken response, but got " <> show res
servant-client/test/Servant/ClientTestUtils.hs+27−4
@@ -64,7 +64,7 @@ import Servant.API
6464 JSON, MimeRender (mimeRender), MimeUnrender (mimeUnrender),
6565 NoContent (NoContent), PlainText, Post, QueryFlag, QueryParam,
6666 QueryParams, Raw, ReqBody, StdMethod (GET), ToHttpApiData (..), UVerb, Union,
67− WithStatus (WithStatus), NamedRoutes, addHeader)
67+ Verb, WithStatus (WithStatus), NamedRoutes, addHeader)
6868import Servant.API.Generic ((:-))
6969import Servant.Client
7070import qualified Servant.Client.Core.Auth as Auth
@@ -118,9 +118,16 @@ data OtherRoutes mode = OtherRoutes
118118 { something :: mode :- "something" :> Get '[JSON] [String]
119119 } deriving Generic
120120
121+-- Get for HTTP 307 Temporary Redirect
122+type Get307 = Verb 'GET 307
123+
121124type Api =
122125 Get '[JSON] Person
123126 :<|> "get" :> Get '[JSON] Person
127+ -- This endpoint returns a response with status code 307 Temporary Redirect,
128+ -- different from the ones in the 2xx successful class, to test derivation
129+ -- of clients' api.
130+ :<|> "get307" :> Get307 '[PlainText] Text
124131 :<|> "deleteEmpty" :> DeleteNoContent
125132 :<|> "capture" :> Capture "name" String :> Get '[JSON,FormUrlEncoded] Person
126133 :<|> "captureAll" :> CaptureAll "names" String :> Get '[JSON] [Person]
@@ -153,13 +160,14 @@ type Api =
153160 WithStatus 301 Text]
154161 :<|> "uverb-get-created" :> UVerb 'GET '[PlainText] '[WithStatus 201 Person]
155162 :<|> NamedRoutes RecordRoutes
156−
163+ :<|> "captureVerbatim" :> Capture "someString" Verbatim :> Get '[PlainText] Text
157164
158165api :: Proxy Api
159166api = Proxy
160167
161168getRoot :: ClientM Person
162169getGet :: ClientM Person
170+getGet307 :: ClientM Text
163171getDeleteEmpty :: ClientM NoContent
164172getCapture :: String -> ClientM Person
165173getCaptureAll :: [String] -> ClientM [Person]
@@ -186,6 +194,7 @@ recordRoutes :: RecordRoutes (AsClientT ClientM)
186194
187195getRoot
188196 :<|> getGet
197+ :<|> getGet307
189198 :<|> getDeleteEmpty
190199 :<|> getCapture
191200 :<|> getCaptureAll
@@ -206,12 +215,14 @@ getRoot
206215 :<|> EmptyClient
207216 :<|> uverbGetSuccessOrRedirect
208217 :<|> uverbGetCreated
209− :<|> recordRoutes = client api
218+ :<|> recordRoutes
219+ :<|> captureVerbatim = client api
210220
211221server :: Application
212222server = serve api (
213223 return carol
214224 :<|> return alice
225+ :<|> return "redirecting"
215226 :<|> return NoContent
216227 :<|> (\ name -> return $ Person name 0)
217228 :<|> (\ names -> return (zipWith Person names [0..]))
@@ -250,8 +261,11 @@ server = serve api (
250261 { something = pure ["foo", "bar", "pweet"]
251262 }
252263 }
264+ :<|> pure . decodeUtf8 . unVerbatim
253265 )
254266
267+-- * api for testing failures
268+
255269type FailApi =
256270 "get" :> Raw
257271 :<|> "capture" :> Capture "name" String :> Raw
@@ -266,7 +280,7 @@ failServer = serve failApi (
266280 :<|> (\ _capture -> Tagged $ \_request respond -> respond $ Wai.responseLBS HTTP.ok200 [("content-type", "application/json")] "")
267281 :<|> (Tagged $ \_request respond -> respond $ Wai.responseLBS HTTP.ok200 [("content-type", "fooooo")] "")
268282 :<|> (Tagged $ \_request respond -> respond $ Wai.responseLBS HTTP.ok200 [("content-type", "application/x-www-form-urlencoded"), ("X-Example1", "1"), ("X-Example2", "foo")] "")
269− )
283+ )
270284
271285-- * basic auth stuff
272286
@@ -359,3 +373,12 @@ instance ToHttpApiData UrlEncodedByteString where
359373
360374instance FromHttpApiData UrlEncodedByteString where
361375 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/FailSpec.hs+3−3
@@ -38,14 +38,14 @@ failSpec = beforeAll (startWaiApp failServer) $ afterAll endWaiApp $ do
3838
3939 context "client returns errors appropriately" $ do
4040 it "reports FailureResponse" $ \(_, baseUrl) -> do
41− let (_ :<|> _ :<|> getDeleteEmpty :<|> _) = client api
41+ let (_ :<|> _ :<|> _ :<|> getDeleteEmpty :<|> _) = client api
4242 Left res <- runClient getDeleteEmpty baseUrl
4343 case res of
4444 FailureResponse _ r | responseStatusCode r == HTTP.status404 -> return ()
4545 _ -> fail $ "expected 404 response, but got " <> show res
4646
4747 it "reports DecodeFailure" $ \(_, baseUrl) -> do
48− let (_ :<|> _ :<|> _ :<|> getCapture :<|> _) = client api
48+ let (_ :<|> _ :<|> _ :<|> _ :<|> getCapture :<|> _) = client api
4949 Left res <- runClient (getCapture "foo") baseUrl
5050 case res of
5151 DecodeFailure _ _ -> return ()
@@ -72,7 +72,7 @@ failSpec = beforeAll (startWaiApp failServer) $ afterAll endWaiApp $ do
7272 _ -> fail $ "expected UnsupportedContentType, but got " <> show res
7373
7474 it "reports InvalidContentTypeHeader" $ \(_, baseUrl) -> do
75− let (_ :<|> _ :<|> _ :<|> _ :<|> _ :<|> getBody :<|> _) = client api
75+ let (_ :<|> _ :<|> _ :<|> _ :<|> _ :<|> _ :<|> getBody :<|> _) = client api
7676 Left res <- runClient (getBody alice) baseUrl
7777 case res of
7878 InvalidContentTypeHeader _ -> return ()
servant-client/test/Servant/SuccessSpec.hs+21−6
@@ -36,6 +36,8 @@ import Data.Maybe
3636import Data.Monoid ()
3737import Data.Text
3838 (Text)
39+import Data.Text.Encoding
40+ (encodeUtf8)
3941import qualified Network.HTTP.Client as C
4042import qualified Network.HTTP.Types as HTTP
4143import Test.Hspec
@@ -59,11 +61,15 @@ spec = describe "Servant.SuccessSpec" $ do
5961
6062successSpec :: Spec
6163successSpec = beforeAll (startWaiApp server) $ afterAll endWaiApp $ do
62− it "Servant.API.Get root" $ \(_, baseUrl) -> do
63− left show <$> runClient getRoot baseUrl `shouldReturn` Right carol
64+ describe "Servant.API.Get" $ do
65+ it "get root endpoint" $ \(_, baseUrl) -> do
66+ left show <$> runClient getRoot baseUrl `shouldReturn` Right carol
6467
65− it "Servant.API.Get" $ \(_, baseUrl) -> do
66− left show <$> runClient getGet baseUrl `shouldReturn` Right alice
68+ it "get simple endpoint" $ \(_, baseUrl) -> do
69+ left show <$> runClient getGet baseUrl `shouldReturn` Right alice
70+
71+ it "get redirection endpoint" $ \(_, baseUrl) -> do
72+ left show <$> runClient getGet307 baseUrl `shouldReturn` Right "redirecting"
6773
6874 describe "Servant.API.Delete" $ do
6975 it "allows empty content type" $ \(_, baseUrl) -> do
@@ -111,6 +117,7 @@ successSpec = beforeAll (startWaiApp server) $ afterAll endWaiApp $ do
111117
112118 it "Servant.API.Fragment" $ \(_, baseUrl) -> do
113119 left id <$> runClient getFragment baseUrl `shouldReturn` Right alice
120+
114121 it "Servant.API.Raw on success" $ \(_, baseUrl) -> do
115122 res <- runClient (getRawSuccess HTTP.methodGet) baseUrl
116123 case res of
@@ -155,8 +162,9 @@ successSpec = beforeAll (startWaiApp server) $ afterAll endWaiApp $ do
155162 mgr <- C.newManager C.defaultManagerSettings
156163 -- In proper situation, extra headers should probably be visible in API type.
157164 -- However, testing for response timeout is difficult, so we test with something which is easy to observe
158− let createClientRequest url r = (defaultMakeClientRequest url r) { C.requestHeaders = [("X-Added-Header", "XXX")] }
159− let clientEnv = (mkClientEnv mgr baseUrl) { makeClientRequest = createClientRequest }
165+ let createClientRequest url r = fmap (\req -> req { C.requestHeaders = [("X-Added-Header", "XXX")] })
166+ (defaultMakeClientRequest url r)
167+ clientEnv = (mkClientEnv mgr baseUrl) { makeClientRequest = createClientRequest }
160168 res <- runClientM (getRawSuccessPassHeaders HTTP.methodGet) clientEnv
161169 case res of
162170 Left e ->
@@ -191,3 +199,10 @@ successSpec = beforeAll (startWaiApp server) $ afterAll endWaiApp $ do
191199 case eitherResponse of
192200 Left clientError -> fail $ show clientError
193201 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+5−5
@@ -1,4 +1,4 @@
1−cabal-version: >=1.10
1+cabal-version: 2.2
22name: servant-conduit
33version: 0.15.1
44
@@ -23,7 +23,7 @@ extra-source-files:
2323
2424source-repository head
2525 type: git
26− location: http://github.com/haskell-servant/servant-conduit.git
26+ location: http://github.com/haskell-servant/servant.git
2727
2828library
2929 exposed-modules: Servant.Conduit
@@ -33,7 +33,7 @@ library
3333 , conduit >=1.3.1 && <1.4
3434 , mtl >=2.2.2 && <2.3
3535 , resourcet >=1.2.2 && <1.3
36− , servant >=0.15 && <0.19
36+ , servant >=0.15 && <0.20
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.19
58− , servant-client >=0.15 && <0.19
57+ , servant-server >=0.15 && <0.20
58+ , servant-client >=0.15 && <0.20
5959 , wai >=3.2.1.2 && <3.3
6060 , warp >=3.2.25 && <3.4
6161 , http-client
servant-docs/CHANGELOG.md+9
@@ -1,6 +1,15 @@
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+
4130.11.9
514------
615
servant-docs/servant-docs.cabal+8−8
@@ -1,6 +1,6 @@
1−cabal-version: >=1.10
1+cabal-version: 2.2
22name: servant-docs
3−version: 0.11.9
3+version: 0.12
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.16
44+ base >= 4.9 && < 4.17
4545 , bytestring >= 0.10.8.1 && < 0.12
46− , text >= 1.2.3.0 && < 1.3
46+ , text >= 1.2.3.0 && < 2.1
4747
4848 -- Servant dependencies
4949 build-depends:
50− servant >= 0.18 && <0.19
50+ servant >= 0.18 && <0.20
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.12
57+ , base-compat >= 0.10.5 && < 0.13
5858 , case-insensitive >= 1.2.0.11 && < 1.3
59− , hashable >= 1.2.7.0 && < 1.4
59+ , hashable >= 1.2.7.0 && < 1.5
6060 , http-media >= 0.7.1.3 && < 0.9
6161 , http-types >= 0.12.2 && < 0.13
62− , lens >= 4.17 && < 5.1
62+ , lens >= 4.17 && < 5.2
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+4
@@ -62,6 +62,7 @@ import GHC.TypeLits
6262import Servant.API
6363import Servant.API.ContentTypes
6464import Servant.API.TypeLevel
65+import Servant.API.Generic
6566
6667import qualified Data.Universe.Helpers as U
6768
@@ -1150,6 +1151,9 @@ instance (ToAuthInfo (BasicAuth realm usr), HasDocs api) => HasDocs (BasicAuth r
11501151 authProxy = Proxy :: Proxy (BasicAuth realm usr)
11511152 action' = over authInfo (|> toAuthInfo authProxy) action
11521153
1154+instance HasDocs (ToServantApi api) => HasDocs (NamedRoutes api) where
1155+ docsFor Proxy = docsFor (Proxy :: Proxy (ToServantApi api))
1156+
11531157-- ToSample instances for simple types
11541158instance ToSample NoContent
11551159instance ToSample Bool
servant-foreign/servant-foreign.cabal+8−8
@@ -1,4 +1,4 @@
1−cabal-version: >=1.10
1+cabal-version: 2.2
22name: servant-foreign
33version: 0.15.4
44
@@ -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.16
45− , text >= 1.2.3.0 && < 1.3
44+ base >= 4.9 && < 4.17
45+ , text >= 1.2.3.0 && < 2.1
4646
4747 -- Servant dependencies
4848 build-depends:
49− servant >=0.18 && <0.19
49+ servant >=0.18 && <0.20
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.12
55− , lens >= 4.17 && < 5.1
54+ base-compat >= 0.10.5 && < 0.13
55+ , lens >= 4.17 && < 5.2
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.9
77+ hspec >= 2.6.0 && <2.10
7878 build-tool-depends:
79− hspec-discover:hspec-discover >=2.6.0 && <2.9
79+ hspec-discover:hspec-discover >=2.6.0 && <2.10
8080 default-language: Haskell2010
servant-http-streams/CHANGELOG.md+10
@@ -1,6 +1,16 @@
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+
4140.18.3
515------
616
servant-http-streams/servant-http-streams.cabal+14−14
@@ -1,6 +1,6 @@
1−cabal-version: >=1.10
1+cabal-version: 2.2
22name: servant-http-streams
3−version: 0.18.3
3+version: 0.18.4
44
55synopsis: Automatic derivation of querying functions for servant
66category: Servant, Web
@@ -38,13 +38,13 @@ 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.16
41+ base >= 4.9 && < 4.17
4242 , bytestring >= 0.10.8.1 && < 0.12
4343 , containers >= 0.5.7.1 && < 0.7
4444 , deepseq >= 1.4.2.0 && < 1.5
4545 , mtl >= 2.2.2 && < 2.3
46− , text >= 1.2.3.0 && < 1.3
47− , time >= 1.6.0.1 && < 1.10
46+ , text >= 1.2.3.0 && < 2.1
47+ , time >= 1.6.0.1 && < 1.12
4848 , transformers >= 0.5.2.0 && < 0.6
4949
5050 if !impl(ghc >= 8.2)
@@ -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.*
58− , servant-client-core >= 0.18.3 && <0.18.4
57+ servant >= 0.18 && < 0.20
58+ , servant-client-core >= 0.18.3 && <0.20
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.12
63+ base-compat >= 0.10.5 && < 0.13
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.8.3
69+ , http-common >= 0.8.2.0 && < 0.9
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.7
75+ , transformers-compat >= 0.6.2 && < 0.8
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.9
115+ , hspec >= 2.6.0 && < 2.10
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.18.*
120− , servant-server == 0.18.*
119+ , servant == 0.19.*
120+ , servant-server == 0.19.*
121121 , tdigest >= 0.2 && < 0.3
122122
123123 build-tool-depends:
124− hspec-discover:hspec-discover >= 2.6.0 && < 2.9
124+ hspec-discover:hspec-discover >= 2.6.0 && < 2.10
125125
126126test-suite readme
127127 type: exitcode-stdio-1.0
servant-http-streams/src/Servant/HttpStreams/Internal.hs+6−6
@@ -57,7 +57,7 @@ import GHC.Generics
5757import Network.HTTP.Media
5858 (renderHeader)
5959import Network.HTTP.Types
60− (Status (..), hContentType, http11, renderQuery)
60+ (Status (..), hContentType, http11, renderQuery, statusIsSuccessful)
6161import Servant.Client.Core
6262
6363import qualified Network.Http.Client as Client
@@ -160,12 +160,12 @@ performRequest acceptStatus req = do
160160 x <- ClientM $ lift $ lift $ Codensity $ \k -> do
161161 Client.sendRequest conn req' body
162162 Client.receiveResponse conn $ \res' body' -> do
163− let sc = Client.getStatusCode res'
163+ let status = toEnum $ Client.getStatusCode res'
164164 lbs <- BSL.fromChunks <$> Streams.toList body'
165165 let res'' = clientResponseToResponse res' lbs
166166 goodStatus = case acceptStatus of
167− Nothing -> sc >= 200 && sc < 300
168− Just good -> sc `elem` (statusCode <$> good)
167+ Nothing -> statusIsSuccessful status
168+ Just good -> status `elem` good
169169 if goodStatus
170170 then k (Right res'')
171171 else k (Left (mkFailureResponse burl req res''))
@@ -180,8 +180,8 @@ performWithStreamingRequest req k = do
180180 Client.sendRequest conn req' body
181181 Client.receiveResponseRaw conn $ \res' body' -> do
182182 -- check status code
183− let sc = Client.getStatusCode res'
184− unless (sc >= 200 && sc < 300) $ do
183+ let status = toEnum $ Client.getStatusCode res'
184+ unless (statusIsSuccessful status) $ do
185185 lbs <- BSL.fromChunks <$> Streams.toList body'
186186 throwIO $ mkFailureResponse burl req (clientResponseToResponse res' lbs)
187187
servant-machines/servant-machines.cabal+5−5
@@ -1,4 +1,4 @@
1−cabal-version: >=1.10
1+cabal-version: 2.2
22name: servant-machines
33version: 0.15.1
44
@@ -23,7 +23,7 @@ extra-source-files:
2323
2424source-repository head
2525 type: git
26− location: http://github.com/haskell-servant/servant-machines.git
26+ location: http://github.com/haskell-servant/servant.git
2727
2828library
2929 exposed-modules: Servant.Machines
@@ -32,7 +32,7 @@ library
3232 , bytestring >=0.10.8.1 && <0.12
3333 , machines >=0.6.4 && <0.8
3434 , mtl >=2.2.2 && <2.3
35− , servant >=0.15 && <0.19
35+ , servant >=0.15 && <0.20
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.19
55− , servant-client >=0.15 && <0.19
54+ , servant-server >=0.15 && <0.20
55+ , servant-client >=0.15 && <0.20
5656 , wai >=3.2.1.2 && <3.3
5757 , warp >=3.2.25 && <3.4
5858 , http-client
servant-pipes/servant-pipes.cabal+6−6
@@ -1,4 +1,4 @@
1−cabal-version: >=1.10
1+cabal-version: 2.2
22name: servant-pipes
33version: 0.15.3
44
@@ -23,7 +23,7 @@ extra-source-files:
2323
2424source-repository head
2525 type: git
26− location: http://github.com/haskell-servant/servant-pipes.git
26+ location: http://github.com/haskell-servant/servant.git
2727
2828library
2929 exposed-modules: Servant.Pipes
@@ -34,7 +34,7 @@ library
3434 , pipes-safe >=2.3.1 && <2.4
3535 , mtl >=2.2.2 && <2.3
3636 , monad-control >=1.0.2.3 && <1.1
37− , servant >=0.15 && <0.19
37+ , servant >=0.15 && <0.20
3838 hs-source-dirs: src
3939 default-language: Haskell2010
4040 ghc-options: -Wall
@@ -51,12 +51,12 @@ test-suite example
5151 , bytestring
5252 , http-media
5353 , servant
54− , pipes
54+ , pipes
5555 , pipes-safe
5656 , servant-pipes
5757 , pipes-bytestring >=2.1.6 && <2.2
58− , servant-server >=0.15 && <0.19
59− , servant-client >=0.15 && <0.19
58+ , servant-server >=0.15 && <0.20
59+ , servant-client >=0.15 && <0.20
6060 , wai >=3.2.1.2 && <3.3
6161 , warp >=3.2.25 && <3.4
6262 , http-client
servant-server/CHANGELOG.md+24
@@ -1,6 +1,30 @@
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.1
7+------
8+
9+- Add `MonadFail` instance for `Handler` wrt [#1545](https://github.com/haskell-servant/servant/issues/1545)
10+- Support GHC 9.2 [#1525](https://github.com/haskell-servant/servant/issues/1525)
11+
12+0.19
13+----
14+
15+### Significant changes
16+
17+- Drop support for GHC < 8.6.
18+- Support GHC 9.0 (GHC 9.2 should work as well, but isn't fully tested yet).
19+- Support Aeson 2 ([#1475](https://github.com/haskell-servant/servant/pull/1475)),
20+ which fixes a [DOS vulnerability](https://github.com/haskell/aeson/issues/864)
21+ related to hash collisions.
22+- Add `NamedRoutes` combinator, making support for records first-class in Servant
23+ ([#1388](https://github.com/haskell-servant/servant/pull/1388)).
24+- Add custom type errors for partially applied combinators
25+ ([#1289](https://github.com/haskell-servant/servant/pull/1289),
26+ [#1486](https://github.com/haskell-servant/servant/pull/1486)).
27+
4280.18.3
529------
630
servant-server/example/greet.hs−1
@@ -18,7 +18,6 @@ import Network.Wai.Handler.Warp
1818
1919import Servant
2020import Servant.Server.Generic ()
21−import Servant.API.Generic
2221
2322-- * Example
2423
servant-server/servant-server.cabal+8−8
@@ -1,6 +1,6 @@
1−cabal-version: >=1.10
1+cabal-version: 2.2
22name: servant-server
3−version: 0.18.3
3+version: 0.19.1
44
55synopsis: A family of combinators for defining webservices APIs and serving them
66category: Servant, Web
@@ -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.16
63+ base >= 4.9 && < 4.17
6464 , bytestring >= 0.10.8.1 && < 0.12
6565 , constraints >= 0.2 && < 0.14
6666 , containers >= 0.5.7.1 && < 0.7
6767 , mtl >= 2.2.2 && < 2.3
68− , text >= 1.2.3.0 && < 1.3
68+ , text >= 1.2.3.0 && < 2.1
6969 , 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.18.3 && < 0.18.4
75+ servant >= 0.19 && < 0.20
7676 , 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.12
81+ base-compat >= 0.10.5 && < 0.13
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
@@ -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.9
162+ , hspec >= 2.6.0 && < 2.10
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.9
170+ hspec-discover:hspec-discover >= 2.6.0 && <2.10
servant-server/src/Servant/Server.hs+3−2
@@ -235,7 +235,7 @@ hoistServer p = hoistServerWithContext p (Proxy :: Proxy '[])
235235-- > │ └─ e/
236236-- > │ └─•
237237-- > ├─ b/
238−-- > │ └─ <capture>/
238+-- > │ └─ <x::Int>/
239239-- > │ ├─•
240240-- > │ ┆
241241-- > │ └─•
@@ -252,7 +252,8 @@ hoistServer p = hoistServerWithContext p (Proxy :: Proxy '[])
252252--
253253-- [@─•@] Leaves reflect endpoints.
254254--
255−-- [@\<capture\>/@] This is a delayed capture of a path component.
255+-- [@\<x::Int\>/@] This is a delayed capture of a single
256+-- path component named @x@, of expected type @Int@.
256257--
257258-- [@\<raw\>@] This is a part of the API we do not know anything about.
258259--
servant-server/src/Servant/Server/Internal.hs+30−39
@@ -41,7 +41,7 @@ import qualified Data.ByteString as B
4141import qualified Data.ByteString.Builder as BB
4242import qualified Data.ByteString.Char8 as BC8
4343import qualified Data.ByteString.Lazy as BL
44−import Data.Constraint (Dict(..))
44+import Data.Constraint (Constraint, Dict(..))
4545import Data.Either
4646 (partitionEithers)
4747import Data.Maybe
@@ -56,7 +56,7 @@ import qualified Data.Text as T
5656import Data.Typeable
5757import GHC.Generics
5858import GHC.TypeLits
59− (KnownNat, KnownSymbol, natVal, symbolVal)
59+ (KnownNat, KnownSymbol, TypeError, symbolVal)
6060import qualified Network.HTTP.Media as NHM
6161import Network.HTTP.Types hiding
6262 (Header, ResponseHeaders)
@@ -87,7 +87,10 @@ import Servant.API.Modifiers
8787 unfoldRequestArgument)
8888import Servant.API.ResponseHeaders
8989 (GetHeaders, Headers, getHeaders, getResponse)
90+import Servant.API.Status
91+ (statusFromNat)
9092import qualified Servant.Types.SourceT as S
93+import Servant.API.TypeErrors
9194import Web.HttpApiData
9295 (FromHttpApiData, parseHeader, parseQueryParam, parseUrlPiece,
9396 parseUrlPieces)
@@ -170,7 +173,7 @@ instance (HasServer a context, HasServer b context) => HasServer (a :<|> b) cont
170173-- > server = getBook
171174-- > where getBook :: Text -> Handler Book
172175-- > getBook isbn = ...
173−instance (KnownSymbol capture, FromHttpApiData a
176+instance (KnownSymbol capture, FromHttpApiData a, Typeable a
174177 , HasServer api context, SBoolI (FoldLenient mods)
175178 , HasContextEntry (MkContextWithErrorFormatter context) ErrorFormatters
176179 )
@@ -182,7 +185,7 @@ instance (KnownSymbol capture, FromHttpApiData a
182185 hoistServerWithContext _ pc nt s = hoistServerWithContext (Proxy :: Proxy api) pc nt . s
183186
184187 route Proxy context d =
185− CaptureRouter $
188+ CaptureRouter [hint] $
186189 route (Proxy :: Proxy api)
187190 context
188191 (addCapture d $ \ txt -> withRequest $ \ request ->
@@ -194,6 +197,7 @@ instance (KnownSymbol capture, FromHttpApiData a
194197 where
195198 rep = typeRep (Proxy :: Proxy Capture')
196199 formatError = urlParseErrorFormatter $ getContextEntry (mkContextWithErrorFormatter context)
200+ hint = CaptureHint (T.pack $ symbolVal $ Proxy @capture) (typeRep (Proxy :: Proxy a))
197201
198202-- | If you use 'CaptureAll' in one of the endpoints for your API,
199203-- this automatically requires your server-side handler to be a
@@ -212,7 +216,7 @@ instance (KnownSymbol capture, FromHttpApiData a
212216-- > server = getSourceFile
213217-- > where getSourceFile :: [Text] -> Handler Book
214218-- > getSourceFile pathSegments = ...
215−instance (KnownSymbol capture, FromHttpApiData a
219+instance (KnownSymbol capture, FromHttpApiData a, Typeable a
216220 , HasServer api context
217221 , HasContextEntry (MkContextWithErrorFormatter context) ErrorFormatters
218222 )
@@ -224,7 +228,7 @@ instance (KnownSymbol capture, FromHttpApiData a
224228 hoistServerWithContext _ pc nt s = hoistServerWithContext (Proxy :: Proxy api) pc nt . s
225229
226230 route Proxy context d =
227− CaptureAllRouter $
231+ CaptureAllRouter [hint] $
228232 route (Proxy :: Proxy api)
229233 context
230234 (addCapture d $ \ txts -> withRequest $ \ request ->
@@ -235,6 +239,7 @@ instance (KnownSymbol capture, FromHttpApiData a
235239 where
236240 rep = typeRep (Proxy :: Proxy CaptureAll)
237241 formatError = urlParseErrorFormatter $ getContextEntry (mkContextWithErrorFormatter context)
242+ hint = CaptureHint (T.pack $ symbolVal $ Proxy @capture) (typeRep (Proxy :: Proxy [a]))
238243
239244allowedMethodHead :: Method -> Request -> Bool
240245allowedMethodHead method request = method == methodGet && requestMethod request == methodHead
@@ -298,7 +303,7 @@ instance {-# OVERLAPPABLE #-}
298303
299304 route Proxy _ = methodRouter ([],) method (Proxy :: Proxy ctypes) status
300305 where method = reflectMethod (Proxy :: Proxy method)
301− status = toEnum . fromInteger $ natVal (Proxy :: Proxy status)
306+ status = statusFromNat (Proxy :: Proxy status)
302307
303308instance {-# OVERLAPPING #-}
304309 ( AllCTRender ctypes a, ReflectMethod method, KnownNat status
@@ -310,7 +315,7 @@ instance {-# OVERLAPPING #-}
310315
311316 route Proxy _ = methodRouter (\x -> (getHeaders x, getResponse x)) method (Proxy :: Proxy ctypes) status
312317 where method = reflectMethod (Proxy :: Proxy method)
313− status = toEnum . fromInteger $ natVal (Proxy :: Proxy status)
318+ status = statusFromNat (Proxy :: Proxy status)
314319
315320instance (ReflectMethod method) =>
316321 HasServer (NoContentVerb method) context where
@@ -331,7 +336,7 @@ instance {-# OVERLAPPABLE #-}
331336
332337 route Proxy _ = streamRouter ([],) method status (Proxy :: Proxy framing) (Proxy :: Proxy ctype)
333338 where method = reflectMethod (Proxy :: Proxy method)
334− status = toEnum . fromInteger $ natVal (Proxy :: Proxy status)
339+ status = statusFromNat (Proxy :: Proxy status)
335340
336341
337342instance {-# OVERLAPPING #-}
@@ -345,7 +350,7 @@ instance {-# OVERLAPPING #-}
345350
346351 route Proxy _ = streamRouter (\x -> (getHeaders x, getResponse x)) method status (Proxy :: Proxy framing) (Proxy :: Proxy ctype)
347352 where method = reflectMethod (Proxy :: Proxy method)
348− status = toEnum . fromInteger $ natVal (Proxy :: Proxy status)
353+ status = statusFromNat (Proxy :: Proxy status)
349354
350355
351356streamRouter :: forall ctype a c chunk env framing. (MimeRender ctype chunk, FramingRender framing, ToSourceIO chunk a) =>
@@ -812,38 +817,15 @@ instance (HasContextEntry context (NamedContext name subContext), HasServer subA
812817 hoistServerWithContext _ _ nt s = hoistServerWithContext (Proxy :: Proxy subApi) (Proxy :: Proxy subContext) nt s
813818
814819-------------------------------------------------------------------------------
815−-- TypeError helpers
820+-- Custom type errors
816821-------------------------------------------------------------------------------
817822
818−-- | This instance catches mistakes when there are non-saturated
819−-- type applications on LHS of ':>'.
820−--
821−-- >>> serve (Proxy :: Proxy (Capture "foo" :> Get '[JSON] Int)) (error "...")
822−-- ...
823−-- ...Expected something of kind Symbol or *, got: k -> l on the LHS of ':>'.
824−-- ...Maybe you haven't applied enough arguments to
825−-- ...Capture' '[] "foo"
826−-- ...
827−--
828−-- >>> undefined :: Server (Capture "foo" :> Get '[JSON] Int)
829−-- ...
830−-- ...Expected something of kind Symbol or *, got: k -> l on the LHS of ':>'.
831−-- ...Maybe you haven't applied enough arguments to
832−-- ...Capture' '[] "foo"
833−-- ...
834−--
835−instance TypeError (HasServerArrowKindError arr) => HasServer ((arr :: k -> l) :> api) context
823+-- Erroring instance for 'HasServer' when a combinator is not fully applied
824+instance TypeError (PartialApplication HasServer arr) => HasServer ((arr :: a -> b) :> sub) context
836825 where
837− type ServerT (arr :> api) m = TypeError (HasServerArrowKindError arr)
838− -- it doesn't really matter what sub route we peak
839− route _ _ _ = error "servant-server panic: impossible happened in HasServer (arr :> api)"
840− hoistServerWithContext _ _ _ = id
841−
842−-- Cannot have TypeError here, otherwise use of this symbol will error :)
843−type HasServerArrowKindError arr =
844− 'Text "Expected something of kind Symbol or *, got: k -> l on the LHS of ':>'."
845− ':$$: 'Text "Maybe you haven't applied enough arguments to"
846− ':$$: 'ShowType arr
826+ type ServerT (arr :> sub) _ = TypeError (PartialApplication (HasServer :: * -> [*] -> Constraint) arr)
827+ route = error "unreachable"
828+ hoistServerWithContext _ _ _ _ = error "unreachable"
847829
848830-- | This instance prevents from accidentally using '->' instead of ':>'
849831--
@@ -878,6 +860,15 @@ type HasServerArrowTypeError a b =
878860 ':$$: 'Text "and"
879861 ':$$: 'ShowType b
880862
863+-- Erroring instances for 'HasServer' for unknown API combinators
864+
865+-- XXX: This omits the @context@ parameter, e.g.:
866+--
867+-- "There is no instance for HasServer (Bool :> …)". Do we care ?
868+instance {-# OVERLAPPABLE #-} TypeError (NoInstanceForSub HasServer ty) => HasServer (ty :> sub) context
869+
870+instance {-# OVERLAPPABLE #-} TypeError (NoInstanceFor (HasServer api context)) => HasServer api context
871+
881872-- | Ignore @'Fragment'@ in server handlers.
882873-- See <https://ietf.org/rfc/rfc2616.html#section-15.1.3> for more details.
883874--
servant-server/src/Servant/Server/Internal/Handler.hs+7−2
@@ -13,17 +13,19 @@ import Control.Monad.Base
1313import Control.Monad.Catch
1414 (MonadCatch, MonadMask, MonadThrow)
1515import Control.Monad.Error.Class
16− (MonadError)
16+ (MonadError, throwError)
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)
2325import GHC.Generics
2426 (Generic)
2527import Servant.Server.Internal.ServerError
26− (ServerError)
28+ (ServerError, errBody, err500)
2729
2830newtype Handler a = Handler { runHandler' :: ExceptT ServerError IO a }
2931 deriving
@@ -32,6 +34,9 @@ newtype Handler a = Handler { runHandler' :: ExceptT ServerError IO a }
3234 , MonadThrow, MonadCatch, MonadMask
3335 )
3436
37+instance MonadFail Handler where
38+ fail str = throwError err500 { errBody = fromString str }
39+
3540instance MonadBase IO Handler where
3641 liftBase = Handler . liftBase
3742
servant-server/src/Servant/Server/Internal/Router.hs+31−14
@@ -9,12 +9,16 @@ import Prelude.Compat
99
1010import Data.Function
1111 (on)
12+import Data.List
13+ (nub)
1214import Data.Map
1315 (Map)
1416import qualified Data.Map as M
1517import Data.Text
1618 (Text)
1719import qualified Data.Text as T
20+import Data.Typeable
21+ (TypeRep)
1822import Network.Wai
1923 (Response, pathInfo)
2024import Servant.Server.Internal.ErrorFormatter
@@ -24,6 +28,18 @@ import Servant.Server.Internal.ServerError
2428
2529type Router env = Router' env RoutingApplication
2630
31+data CaptureHint = CaptureHint
32+ { captureName :: Text
33+ , captureType :: TypeRep
34+ }
35+ deriving (Show, Eq)
36+
37+toCaptureTag :: CaptureHint -> Text
38+toCaptureTag hint = captureName hint <> "::" <> (T.pack . show) (captureType hint)
39+
40+toCaptureTags :: [CaptureHint] -> Text
41+toCaptureTags hints = "<" <> T.intercalate "|" (map toCaptureTag hints) <> ">"
42+
2743-- | Internal representation of a router.
2844--
2945-- The first argument describes an environment type that is
@@ -36,10 +52,10 @@ data Router' env a =
3652 -- ^ the map contains routers for subpaths (first path component used
3753 -- for lookup and removed afterwards), the list contains handlers
3854 -- for the empty path, to be tried in order
39− | CaptureRouter (Router' (Text, env) a)
55+ | CaptureRouter [CaptureHint] (Router' (Text, env) a)
4056 -- ^ first path component is passed to the child router in its
4157 -- environment and removed afterwards
42− | CaptureAllRouter (Router' ([Text], env) a)
58+ | CaptureAllRouter [CaptureHint] (Router' ([Text], env) a)
4359 -- ^ all path components are passed to the child router in its
4460 -- environment and are removed afterwards
4561 | RawRouter (env -> a)
@@ -69,8 +85,8 @@ leafRouter l = StaticRouter M.empty [l]
6985choice :: Router' env a -> Router' env a -> Router' env a
7086choice (StaticRouter table1 ls1) (StaticRouter table2 ls2) =
7187 StaticRouter (M.unionWith choice table1 table2) (ls1 ++ ls2)
72−choice (CaptureRouter router1) (CaptureRouter router2) =
73− CaptureRouter (choice router1 router2)
88+choice (CaptureRouter hints1 router1) (CaptureRouter hints2 router2) =
89+ CaptureRouter (nub $ hints1 ++ hints2) (choice router1 router2)
7490choice router1 (Choice router2 router3) = Choice (choice router1 router2) router3
7591choice router1 router2 = Choice router1 router2
7692
@@ -84,7 +100,7 @@ choice router1 router2 = Choice router1 router2
84100--
85101data RouterStructure =
86102 StaticRouterStructure (Map Text RouterStructure) Int
87− | CaptureRouterStructure RouterStructure
103+ | CaptureRouterStructure [CaptureHint] RouterStructure
88104 | RawRouterStructure
89105 | ChoiceStructure RouterStructure RouterStructure
90106 deriving (Eq, Show)
@@ -98,11 +114,11 @@ data RouterStructure =
98114routerStructure :: Router' env a -> RouterStructure
99115routerStructure (StaticRouter m ls) =
100116 StaticRouterStructure (fmap routerStructure m) (length ls)
101−routerStructure (CaptureRouter router) =
102− CaptureRouterStructure $
117+routerStructure (CaptureRouter hints router) =
118+ CaptureRouterStructure hints $
103119 routerStructure router
104−routerStructure (CaptureAllRouter router) =
105− CaptureRouterStructure $
120+routerStructure (CaptureAllRouter hints router) =
121+ CaptureRouterStructure hints $
106122 routerStructure router
107123routerStructure (RawRouter _) =
108124 RawRouterStructure
@@ -114,8 +130,8 @@ routerStructure (Choice r1 r2) =
114130-- | Compare the structure of two routers.
115131--
116132sameStructure :: Router' env a -> Router' env b -> Bool
117−sameStructure r1 r2 =
118− routerStructure r1 == routerStructure r2
133+sameStructure router1 router2 =
134+ routerStructure router1 == routerStructure router2
119135
120136-- | Provide a textual representation of the
121137-- structure of a router.
@@ -126,7 +142,8 @@ routerLayout router =
126142 where
127143 mkRouterLayout :: Bool -> RouterStructure -> [Text]
128144 mkRouterLayout c (StaticRouterStructure m n) = mkSubTrees c (M.toList m) n
129− mkRouterLayout c (CaptureRouterStructure r) = mkSubTree c "<capture>" (mkRouterLayout False r)
145+ mkRouterLayout c (CaptureRouterStructure hints r) =
146+ mkSubTree c (toCaptureTags hints) (mkRouterLayout False r)
130147 mkRouterLayout c RawRouterStructure =
131148 if c then ["├─ <raw>"] else ["└─ <raw>"]
132149 mkRouterLayout c (ChoiceStructure r1 r2) =
@@ -169,7 +186,7 @@ runRouterEnv fmt router env request respond =
169186 -> let request' = request { pathInfo = rest }
170187 in runRouterEnv fmt router' env request' respond
171188 _ -> respond $ Fail $ fmt request
172− CaptureRouter router' ->
189+ CaptureRouter _ router' ->
173190 case pathInfo request of
174191 [] -> respond $ Fail $ fmt request
175192 -- This case is to handle trailing slashes.
@@ -177,7 +194,7 @@ runRouterEnv fmt router env request respond =
177194 first : rest
178195 -> let request' = request { pathInfo = rest }
179196 in runRouterEnv fmt router' (first, env) request' respond
180− CaptureAllRouter router' ->
197+ CaptureAllRouter _ router' ->
181198 let segments = pathInfo request
182199 request' = request { pathInfo = [] }
183200 in runRouterEnv fmt router' (segments, env) request' respond
servant-server/test/Servant/Server/RouterSpec.hs+127−6
@@ -9,7 +9,9 @@ import Control.Monad
99import Data.Proxy
1010 (Proxy (..))
1111import Data.Text
12− (unpack)
12+ (Text, unpack)
13+import Data.Typeable
14+ (typeRep)
1315import Network.HTTP.Types
1416 (Status (..))
1517import Network.Wai
@@ -27,6 +29,7 @@ spec :: Spec
2729spec = describe "Servant.Server.Internal.Router" $ do
2830 routerSpec
2931 distributivitySpec
32+ serverLayoutSpec
3033
3134routerSpec :: Spec
3235routerSpec = do
@@ -51,7 +54,7 @@ routerSpec = do
5154 toApp = toApplication . runRouter (const err404)
5255
5356 cap :: Router ()
54− cap = CaptureRouter $
57+ cap = CaptureRouter [hint] $
5558 let delayed = addCapture (emptyDelayed $ Route pure) (const $ delayedFail err400)
5659 in leafRouter
5760 $ \env req res ->
@@ -59,6 +62,9 @@ routerSpec = do
5962 . const
6063 $ Route success
6164
65+ hint :: CaptureHint
66+ hint = CaptureHint "anything" $ typeRep (Proxy :: Proxy ())
67+
6268 router :: Router ()
6369 router = leafRouter (\_ _ res -> res $ Route success)
6470 `Choice` cap
@@ -98,12 +104,30 @@ distributivitySpec =
98104 it "properly handles mixing static paths at different levels" $ do
99105 level `shouldHaveSameStructureAs` levelRef
100106
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+
101119shouldHaveSameStructureAs ::
102120 (HasServer api1 '[], HasServer api2 '[]) => Proxy api1 -> Proxy api2 -> Expectation
103121shouldHaveSameStructureAs p1 p2 =
104122 unless (sameStructure (makeTrivialRouter p1) (makeTrivialRouter p2)) $
105123 expectationFailure ("expected:\n" ++ unpack (layout p2) ++ "\nbut got:\n" ++ unpack (layout p1))
106124
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+
107131makeTrivialRouter :: (HasServer layout '[]) => Proxy layout -> Router ()
108132makeTrivialRouter p =
109133 route p EmptyContext (emptyDelayed (FailFatal err501))
@@ -144,12 +168,12 @@ staticRef = Proxy
144168-- structure:
145169
146170type Dynamic =
147− "a" :> Capture "foo" Int :> "b" :> End
148− :<|> "a" :> Capture "bar" Bool :> "c" :> End
149− :<|> "a" :> Capture "baz" Char :> "d" :> End
171+ "a" :> Capture "foo" Int :> "b" :> End
172+ :<|> "a" :> Capture "foo" Int :> "c" :> End
173+ :<|> "a" :> Capture "foo" Int :> "d" :> End
150174
151175type DynamicRef =
152− "a" :> Capture "anything" () :>
176+ "a" :> Capture "foo" Int :>
153177 ("b" :> End :<|> "c" :> End :<|> "d" :> End)
154178
155179dynamic :: Proxy Dynamic
@@ -339,3 +363,100 @@ level = Proxy
339363
340364levelRef :: Proxy LevelRef
341365levelRef = 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-swagger/example/example.cabal+2−2
@@ -1,15 +1,15 @@
1+cabal-version: 2.2
12name: example
23version: 1.0
34synopsis: servant-swagger demonstration
45description: servant-swagger demonstration
5−license: BSD3
6+license: BSD-3-Clause
67license-file: LICENSE
78author: David Johnson, Nickolay Kudasov
89maintainer: nickolay.kudasov@gmail.com
910copyright: (c) 2015-2016, Servant contributors
1011category: Web
1112build-type: Simple
12−cabal-version: >=1.10
1313data-files:
1414 swagger.json
1515
servant-swagger/servant-swagger.cabal+16−15
@@ -1,11 +1,12 @@
1+cabal-version: 2.2
12name: servant-swagger
23version: 1.1.11
34synopsis: Generate a Swagger/OpenAPI/OAS 2.0 specification for your servant API.
45description:
5− Swagger is a project used to describe and document RESTful APIs. The core of the
6− project is the [OpenAPI Specification (OAS)](https://swagger.io/docs/specification/about/).
7− This library implements v2.0 of the spec. Unlike Servant it is language-agnostic and thus is
8− 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
910 and has more helpful tooling.
1011 .
1112 This package provides means to generate a Swagger/OAS specification for a Servant API
@@ -18,16 +19,15 @@ description:
1819 * generating clients and servers in many languages using [Swagger Codegen](http://swagger.io/swagger-codegen/);
1920 .
2021 * and [many others](http://swagger.io/open-source-integrations/).
21−homepage: https://github.com/haskell-servant/servant/servant-swagger
22+homepage: https://github.com/haskell-servant/servant/tree/master/servant-swagger#readme
2223bug-reports: https://github.com/haskell-servant/servant/issues
23−license: BSD3
24+license: BSD-3-Clause
2425license-file: LICENSE
2526author: Servant Contributors
2627maintainer: haskell-servant-maintainers@googlegroups.com
2728copyright: (c) 2015-2018, Servant contributors
2829category: Web, Servant, Swagger
2930build-type: Custom
30−cabal-version: 1.18
3131tested-with: GHC ==8.6.5 || ==8.8.4 || ==8.10.2
3232
3333extra-source-files:
@@ -50,6 +50,7 @@ source-repository head
5050custom-setup
5151 setup-depends:
5252 base >=4.9 && <5,
53+ Cabal >= 1.24,
5354 cabal-doctest >=1.0.6 && <1.1
5455
5556library
@@ -71,15 +72,15 @@ library
7172 build-depends: aeson >=1.4.2.0 && <3
7273 , aeson-pretty >=0.8.7 && <0.9
7374 , base >=4.9.1.0 && <5
74− , base-compat >=0.10.5 && <0.12
75− , bytestring >=0.10.8.1 && <0.11
75+ , base-compat >=0.10.5 && <0.13
76+ , bytestring >=0.10.8.1 && <0.12
7677 , http-media >=0.7.1.3 && <0.9
7778 , insert-ordered-containers >=0.2.1.0 && <0.3
7879 , lens >=4.17 && <6
79− , servant >=0.18.1 && <0.19
80+ , servant >=0.18.2 && <0.20
8081 , singleton-bool >=0.1.4 && <0.2
8182 , swagger2 >=2.3.0.1 && <3
82− , text >=1.2.3.0 && <1.3
83+ , text >=1.2.3.0 && <2.1
8384 , unordered-containers >=0.2.9.0 && <0.3
8485
8586 , hspec
@@ -91,7 +92,7 @@ test-suite doctests
9192 build-depends:
9293 base,
9394 directory >= 1.0,
94− doctest >= 0.18 && <0.19,
95+ doctest >= 0.17 && <0.21,
9596 servant,
9697 QuickCheck,
9798 filepath
@@ -105,14 +106,14 @@ test-suite spec
105106 type: exitcode-stdio-1.0
106107 hs-source-dirs: test
107108 main-is: Spec.hs
108− build-tool-depends: hspec-discover:hspec-discover >=2.6.0 && <2.8
109+ build-tool-depends: hspec-discover:hspec-discover >=2.6.0 && <2.10
109110 build-depends: base
110111 , base-compat
111112 , aeson >=1.4.2.0 && <3
112− , hspec >=2.6.0 && <2.8
113+ , hspec >=2.6.0 && <2.10
113114 , QuickCheck
114115 , lens
115− , lens-aeson >=1.0.2 && <1.2
116+ , lens-aeson >=1.0.2 && <1.3
116117 , servant
117118 , servant-swagger
118119 , swagger2
servant-swagger/src/Servant/Swagger.hs+5−3
@@ -55,6 +55,7 @@ import Servant.Swagger.Internal.Orphans ()
5555-- >>> import Data.Typeable
5656-- >>> import GHC.Generics
5757-- >>> import Servant.API
58+-- >>> import System.Environment
5859-- >>> import Test.Hspec
5960-- >>> import Test.QuickCheck
6061-- >>> import qualified Data.ByteString.Lazy.Char8 as BSL8
@@ -64,6 +65,7 @@ import Servant.Swagger.Internal.Orphans ()
6465-- >>> :set -XGeneralizedNewtypeDeriving
6566-- >>> :set -XOverloadedStrings
6667-- >>> :set -XTypeOperators
68+-- >>> setEnv "HSPEC_COLOR" "no"
6769-- >>> data User = User { name :: String, age :: Int } deriving (Show, Generic, Typeable)
6870-- >>> newtype UserId = UserId Integer deriving (Show, Generic, Typeable, ToJSON)
6971-- >>> instance ToJSON User
@@ -160,11 +162,11 @@ import Servant.Swagger.Internal.Orphans ()
160162-- >>> instance Arbitrary UserId where arbitrary = UserId <$> arbitrary
161163-- >>> hspec $ validateEveryToJSON (Proxy :: Proxy UserAPI)
162164-- <BLANKLINE>
163−-- [User]
165+-- [User]...
164166-- ...
165−-- User
167+-- User...
166168-- ...
167−-- UserId
169+-- UserId...
168170-- ...
169171-- Finished in ... seconds
170172-- 3 examples, 0 failures
servant-swagger/src/Servant/Swagger/Internal.hs+11
@@ -3,11 +3,13 @@
33{-# LANGUAGE DataKinds #-}
44{-# LANGUAGE FlexibleContexts #-}
55{-# LANGUAGE FlexibleInstances #-}
6+{-# LANGUAGE OverloadedLists #-}
67{-# LANGUAGE OverloadedStrings #-}
78{-# LANGUAGE PolyKinds #-}
89{-# LANGUAGE RankNTypes #-}
910{-# LANGUAGE ScopedTypeVariables #-}
1011{-# LANGUAGE TypeOperators #-}
12+{-# LANGUAGE TypeFamilies #-}
1113#if __GLASGOW_HASKELL__ >= 806
1214{-# LANGUAGE UndecidableInstances #-}
1315#endif
@@ -30,11 +32,13 @@ import qualified Data.Swagger as Swagger
3032import Data.Swagger.Declare
3133import Data.Text (Text)
3234import qualified Data.Text as Text
35+import GHC.Generics (D1, Meta(..), Rep)
3336import GHC.TypeLits
3437import Network.HTTP.Media (MediaType)
3538import Servant.API
3639import Servant.API.Description (FoldDescription,
3740 reflectDescription)
41+import Servant.API.Generic (ToServantApi, AsApi)
3842import Servant.API.Modifiers (FoldRequired)
3943
4044import Servant.Swagger.Internal.TypeLevel.API
@@ -149,6 +153,10 @@ mkEndpointNoContentVerb path _ = mempty
149153addParam :: Param -> Swagger -> Swagger
150154addParam param = allOperations.parameters %~ (Inline param :)
151155
156+-- | Add a tag to every operation in the spec.
157+addTag :: Text -> Swagger -> Swagger
158+addTag tag = allOperations.tags %~ ([tag] <>)
159+
152160-- | Add accepted content types to every operation in the spec.
153161addConsumes :: [MediaType] -> Swagger -> Swagger
154162addConsumes cs = allOperations.consumes %~ (<> Just (MimeList cs))
@@ -439,6 +447,9 @@ instance (ToSchema a, Accept ct, HasSwagger sub, KnownSymbol (FoldDescription mo
439447 & required ?~ True
440448 & schema .~ ParamBody ref
441449
450+instance (HasSwagger (ToServantApi routes), KnownSymbol datatypeName, Rep (routes AsApi) ~ D1 ('MetaData datatypeName moduleName packageName isNewtype) f) => HasSwagger (NamedRoutes routes) where
451+ toSwagger _ = addTag (Text.pack $ symbolVal (Proxy :: Proxy datatypeName)) (toSwagger (Proxy :: Proxy (ToServantApi routes)))
452+
442453-- =======================================================================
443454-- Below are the definitions that should be in Servant.API.ContentTypes
444455-- =======================================================================
servant-swagger/src/Servant/Swagger/Internal/Test.hs+8−6
@@ -29,10 +29,12 @@ import Servant.Swagger.Internal.TypeLevel
2929-- >>> import Control.Applicative
3030-- >>> import GHC.Generics
3131-- >>> import Test.QuickCheck
32+-- >>> import System.Environment (setEnv)
3233-- >>> :set -XDeriveGeneric
3334-- >>> :set -XGeneralizedNewtypeDeriving
3435-- >>> :set -XDataKinds
3536-- >>> :set -XTypeOperators
37+-- >>> setEnv "HSPEC_COLOR" "no"
3638
3739-- | Verify that every type used with @'JSON'@ content type in a servant API
3840-- has compatible @'ToJSON'@ and @'ToSchema'@ instances using @'validateToJSON'@.
@@ -53,10 +55,10 @@ import Servant.Swagger.Internal.TypeLevel
5355--
5456-- >>> hspec $ context "ToJSON matches ToSchema" $ validateEveryToJSON (Proxy :: Proxy UserAPI)
5557-- <BLANKLINE>
56−-- ToJSON matches ToSchema
57−-- User
58+-- ToJSON matches ToSchema...
59+-- User...
5860-- ...
59−-- UserId
61+-- UserId...
6062-- ...
6163-- Finished in ... seconds
6264-- 2 examples, 0 failures
@@ -118,11 +120,11 @@ validateEveryToJSONWithPatternChecker checker _ = props
118120-- :}
119121-- <BLANKLINE>
120122-- read . show == id
121−-- Bool
123+-- Bool...
122124-- ...
123−-- Int
125+-- Int...
124126-- ...
125−-- [Char]
127+-- [Char]...
126128-- ...
127129-- Finished in ... seconds
128130-- 3 examples, 0 failures
servant/CHANGELOG.md+116
@@ -1,5 +1,121 @@
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
6+----
7+
8+### Significant changes
9+
10+- Drop support for GHC < 8.6.
11+- Support GHC 9.0 (GHC 9.2 should work as well, but isn't fully tested yet).
12+- Support Aeson 2 ([#1475](https://github.com/haskell-servant/servant/pull/1475)),
13+ which fixes a [DOS vulnerability](https://github.com/haskell/aeson/issues/864)
14+ related to hash collisions.
15+- Add `NamedRoutes` combinator, making support for records first-class in Servant
16+ ([#1388](https://github.com/haskell-servant/servant/pull/1388)).
17+
18+ Users can now directly mark part as an API as defined by a record, instead of
19+ using `(:<|>)` to combine routes. Concretely, the anonymous:
20+
21+ ```haskell
22+ type API =
23+ "version" :> Get '[JSON] String :<|>
24+ "products" :> Get '[JSON] [Product]
25+ ```
26+
27+ can be replaced with the explicitly-named:
28+
29+ ```haskell
30+ type API = NamedRoutes NamedAPI
31+ data NamedAPI mode = NamedAPI
32+ { version :: mode :- "version" :> Get '[JSON] String
33+ , products :: mode :- "products" :> Get '[JSON] [Product]
34+ }
35+ ```
36+
37+ `NamedRoutes` builds upon `servant-generic`, but improves usability by freeing
38+ users from the need to perform `toServant` / `fromServant` conversions
39+ manually. Serving `NamedRoutes NamedAPI` is now done directly by providing a
40+ record of handlers, and servant generates clients directly as records as well.
41+ In particular, it makes it much more practical to work with nested hierarchies
42+ of named routes.
43+
44+ Two convenience functions, `(//)` and `(/:)`, have been added to make the
45+ usage of named route hierarchies more pleasant:
46+
47+ ```haskell
48+ rootClient :: RootApi (AsClientT ClientM)
49+ rootClient = client (Proxy @API)
50+
51+ helloClient :: String -> ClientM String
52+ helloClient name = rootClient // hello /: name
53+
54+ endpointClient :: ClientM Person
55+ endpointClient = rootClient // subApi /: "foobar123" // endpoint
56+
57+ type Api = NamedRoutes RootApi
58+
59+ data RootApi mode = RootApi
60+ { subApi :: mode :- Capture "token" String :> NamedRoutes SubApi
61+ , hello :: mode :- Capture "name" String :> Get '[JSON] String
62+ , …
63+ } deriving Generic
64+
65+ data SubApi mode = SubApi
66+ { endpoint :: mode :- Get '[JSON] Person
67+ , …
68+ } deriving Generic
69+ ```
70+
71+- Add custom type errors for partially applied combinators
72+ ([#1289](https://github.com/haskell-servant/servant/pull/1289),
73+ [#1486](https://github.com/haskell-servant/servant/pull/1486)).
74+
75+ For example, forgetting to document the expected type for a query parameter,
76+ as in:
77+
78+ ``` haskell
79+ type API = QueryParam "param" :> Get '[JSON] NoContent
80+ ```
81+
82+ will raise to the following error when trying to serve the API:
83+
84+ ```
85+ • There is no instance for HasServer (QueryParam'
86+ '[Optional, Strict] "param" :> ...)
87+ QueryParam' '[Optional, Strict] "1" expects 1 more arguments
88+ ```
89+
90+ As a consequence of this change, unsaturated types are now forbidden before `(:>)`.
91+
92+- Add a `HeadNoContent` verb ([#1502](https://github.com/haskell-servant/servant/pull/1502)).
93+
94+- *servant-client* / *servant-client-core* / *servant-http-streams*:
95+ Fix erroneous behavior, where only 2XX status codes would be considered
96+ successful, irrelevant of the status parameter specified by the verb
97+ combinator. ([#1469](https://github.com/haskell-servant/servant/pull/1469))
98+
99+- *servant-client* / *servant-client-core*: Fix `Show` instance for
100+ `Servant.Client.Core.Request`.
101+
102+
103+- *servant-client* / *servant-client-core*: Allow passing arbitrary binary data
104+ in Query parameters.
105+ ([#1432](https://github.com/haskell-servant/servant/pull/1432)).
106+
107+- *servant-docs*: Generate sample cURL requests
108+ ([#1401](https://github.com/haskell-servant/servant/pull/1401/files)).
109+
110+ Breaking change: requires sample header values to be supplied with `headers`.
111+
112+### Other changes
113+
114+- Various bit rotten cookbooks have been updated and re-introduced on
115+ [docs.servant.dev](https://docs.servant.dev).
116+
117+- Various version bumps.
118+
31190.18.3
4120------
5121
servant/servant.cabal+8−8
@@ -1,6 +1,6 @@
1−cabal-version: >=1.10
1+cabal-version: 2.2
22name: servant
3−version: 0.18.3
3+version: 0.19
44
55synopsis: A family of combinators for defining webservices APIs
66category: Servant, Web
@@ -80,13 +80,13 @@ library
8080 --
8181 -- note: mtl lower bound is so low because of GHC-7.8
8282 build-depends:
83− base >= 4.9 && < 4.16
83+ base >= 4.9 && < 4.17
8484 , bytestring >= 0.10.8.1 && < 0.12
8585 , constraints >= 0.2
8686 , mtl >= 2.2.2 && < 2.3
8787 , sop-core >= 0.4.0.0 && < 0.6
8888 , transformers >= 0.5.2.0 && < 0.6
89− , text >= 1.2.3.0 && < 1.3
89+ , text >= 1.2.3.0 && < 2.1
9090
9191
9292 -- We depend (heavily) on the API of these packages:
@@ -98,7 +98,7 @@ library
9898 -- Other dependencies: Lower bound around what is in the latest Stackage LTS.
9999 -- Here can be exceptions if we really need features from the newer versions.
100100 build-depends:
101− base-compat >= 0.10.5 && < 0.12
101+ base-compat >= 0.10.5 && < 0.13
102102 , aeson >= 1.4.1.0 && < 3
103103 , attoparsec >= 0.13.2.2 && < 0.15
104104 , bifunctors >= 5.5.3 && < 5.6
@@ -106,7 +106,7 @@ library
106106 , deepseq >= 1.4.2.0 && < 1.5
107107 , http-media >= 0.7.1.3 && < 0.9
108108 , http-types >= 0.12.2 && < 0.13
109− , mmorph >= 1.1.2 && < 1.2
109+ , mmorph >= 1.1.2 && < 1.3
110110 , network-uri >= 2.6.1.0 && < 2.7
111111 , QuickCheck >= 2.12.6.1 && < 2.15
112112 , string-conversions >= 0.4.0.1 && < 0.5
@@ -166,9 +166,9 @@ test-suite spec
166166
167167 -- Additional dependencies
168168 build-depends:
169− hspec >= 2.6.0 && < 2.9
169+ hspec >= 2.6.0 && < 2.10
170170 , QuickCheck >= 2.12.6.1 && < 2.15
171171 , quickcheck-instances >= 0.3.19 && < 0.4
172172
173173 build-tool-depends:
174− hspec-discover:hspec-discover >= 2.6.0 && < 2.9
174+ hspec-discover:hspec-discover >= 2.6.0 && < 2.10
servant/src/Servant/API.hs+4
@@ -38,6 +38,7 @@ module Servant.API (
3838
3939 -- * Sub-APIs defined as records of routes
4040 module Servant.API.NamedRoutes,
41+ module Servant.API.Generic,
4142
4243 -- * Streaming endpoints, distinguished by HTTP method
4344 module Servant.API.Stream,
@@ -102,6 +103,9 @@ import Servant.API.Fragment
102103 (Fragment)
103104import Servant.API.Header
104105 (Header, Header')
106+import Servant.API.Generic
107+ (GenericMode ((:-)), AsApi, ToServant, ToServantApi, GServantProduct,
108+ GenericServant, fromServant, toServant, genericApi)
105109import Servant.API.HttpVersion
106110 (HttpVersion (..))
107111import Servant.API.IsSecure
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 _ _ = map (, "") $ NE.toList $ contentTypes pctyp
298+ allMimeRender _ NoContent = map (, "") $ NE.toList $ contentTypes pctyp
299299 where
300300 pctyp = Proxy :: Proxy ctyp
301301
servant/src/Servant/API/Status.hs+6−1
@@ -1,10 +1,15 @@
11{-# LANGUAGE DataKinds #-}
22-- Flexible instances is necessary on GHC 8.4 and earlier
33{-# LANGUAGE FlexibleInstances #-}
4+{-# LANGUAGE ScopedTypeVariables #-}
45module Servant.API.Status where
56
7+import GHC.TypeLits (KnownNat, natVal)
68import Network.HTTP.Types.Status
7−import GHC.TypeLits
9+
10+-- | Retrieve a known or unknown Status from a KnownNat
11+statusFromNat :: forall a proxy. KnownNat a => proxy a -> Status
12+statusFromNat = toEnum . fromInteger . natVal
813
914-- | Witness that a type-level natural number corresponds to a HTTP status code
1015class KnownNat n => KnownStatus n where
servant/src/Servant/API/Verbs.hs+2−1
@@ -128,7 +128,8 @@ type DeleteNoContent = NoContentVerb 'DELETE
128128type PatchNoContent = NoContentVerb 'PATCH
129129-- | 'PUT' with 204 status code.
130130type PutNoContent = NoContentVerb 'PUT
131−
131+-- | 'HEAD' with 204 status code.
132+type HeadNoContent = NoContentVerb 'HEAD
132133
133134-- ** 205 Reset Content
134135--
servant/src/Servant/Links.hs+1−1
@@ -649,7 +649,7 @@ simpleToLink _ toA _ = toLink toA (Proxy :: Proxy sub)
649649-- Erroring instance for 'HasLink' when a combinator is not fully applied
650650instance TypeError (PartialApplication HasLink arr) => HasLink ((arr :: a -> b) :> sub)
651651 where
652− type MkLink (arr :> sub) _ = TypeError (PartialApplication HasLink arr)
652+ type MkLink (arr :> sub) _ = TypeError (PartialApplication (HasLink :: * -> Constraint) arr)
653653 toLink = error "unreachable"
654654
655655-- Erroring instances for 'HasLink' for unknown API combinators
servant/src/Servant/Types/SourceT.hs+1−1
@@ -319,7 +319,7 @@ fromActionStep stop action = loop where
319319-- | Read file.
320320--
321321-- >>> foreach fail BS.putStr (readFile "servant.cabal")
322−-- cabal-version: >=1.10
322+-- cabal-version: 2.2
323323-- name: servant
324324-- ...
325325--
servant/test/Servant/API/ContentTypesSpec.hs+11
@@ -33,6 +33,8 @@ 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)
3638import GHC.Generics
3739import Test.Hspec
3840import Test.QuickCheck
@@ -78,6 +80,15 @@ spec = describe "Servant.API.ContentTypes" $ do
7880 it "has mimeUnrender reverse mimeRender for valid top-level json " $ do
7981 property $ \x -> mimeUnrender p (mimeRender p x) == Right (x::SomeData)
8082
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+
8192 describe "The PlainText Content-Type type" $ do
8293 let p = Proxy :: Proxy PlainText
8394
stack.yaml+1
@@ -11,6 +11,7 @@ packages:
1111- servant-conduit
1212- servant-machines/
1313- servant-pipes/
14+- servant-swagger/
1415
1516# allow-newer: true # ignores all bounds, that's a sledgehammer
1617# - doc/tutorial/