git.iko.soy/typeable/servant
on 39fb875 help sign in
.github/workflows/master.yml+29−17
since splitsnapshots
unifiedsplit
@@ -13,13 +13,12 @@ jobs:
13 strategy:
13 strategy:
14 matrix:
14 matrix:
15 os: [ubuntu-latest]
15 os: [ubuntu-latest]
16− cabal: ["3.6"]
16+ cabal: ["3.4"]
17 ghc:
17 ghc:
18 - "8.6.5"
18 - "8.6.5"
19 - "8.8.4"
19 - "8.8.4"
20 - "8.10.7"
20 - "8.10.7"
21− - "9.0.2"
21+ - "9.0.1"
22− - "9.2.2"
23
22
24 steps:
23 steps:
25 - uses: actions/checkout@v2
24 - uses: actions/checkout@v2
@@ -48,7 +47,10 @@ jobs:
48
47
49 - name: Configure
48 - name: Configure
50 run: |
49 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.
51− cabal install --ignore-project -j2 doctest --constraint='doctest ^>=0.20'
53+ cabal --store-dir /tmp/cabal-store install --ignore-project -j2 doctest --constraint='doctest ^>=0.18'
52
54
53 - name: Build
55 - name: Build
54 run: |
56 run: |
@@ -59,29 +61,39 @@ jobs:
59 cabal test all
61 cabal test all
60
62
61 - name: Run doctests
63 - 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' }}
62 run: |
67 run: |
63 # Necessary for doctest to be found in $PATH
68 # Necessary for doctest to be found in $PATH
64 export PATH="$HOME/.cabal/bin:$PATH"
69 export PATH="$HOME/.cabal/bin:$PATH"
65
70
66− DOCTEST="cabal repl --with-ghc=doctest --ghc-options=-w"
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+
67− (cd servant && eval $DOCTEST)
79+ (cd servant && doctest src)
68− (cd servant-client && eval $DOCTEST)
80+ (cd servant-client && doctest src)
69− (cd servant-client-core && eval $DOCTEST)
81+ (cd servant-client-core && doctest src)
70− (cd servant-http-streams && eval $DOCTEST)
82+ (cd servant-http-streams && doctest src)
71− (cd servant-docs && eval $DOCTEST)
83+ (cd servant-docs && doctest src)
72− (cd servant-foreign && eval $DOCTEST)
84+ (cd servant-foreign && doctest src)
73− (cd servant-server && eval $DOCTEST)
85+ (cd servant-server && doctest src)
74− (cd servant-machines && eval $DOCTEST)
86+ (cd servant-machines && doctest src)
75− (cd servant-conduit && eval $DOCTEST)
87+ (cd servant-conduit && doctest src)
76− (cd servant-pipes && eval $DOCTEST)
88+ (cd servant-pipes && doctest src)
77
89
78 stack:
90 stack:
79 name: stack / ghc ${{ matrix.ghc }}
91 name: stack / ghc ${{ matrix.ghc }}
80 runs-on: ubuntu-latest
92 runs-on: ubuntu-latest
81 strategy:
93 strategy:
82 matrix:
94 matrix:
83− stack: ["2.7.5"]
95+ stack: ["2.7.3"]
84− ghc: ["8.10.7"]
96+ ghc: ["8.10.4"]
85
97
86 steps:
98 steps:
87 - uses: actions/checkout@v2
99 - uses: actions/checkout@v2
.gitignore−1
@@ -31,7 +31,6 @@ doc/venv
31doc/tutorial/static/api.js
31doc/tutorial/static/api.js
32doc/tutorial/static/jq.js
32doc/tutorial/static/jq.js
33shell.nix
33shell.nix
34−.hspec-failures
35
34
36# nix
35# nix
37result*
36result*
CONTRIBUTING.md+2−4
@@ -79,10 +79,8 @@ not been a timely response to a PR, you can ping the Maintainers group (with
79We encourage people to experiment with new combinators and instances - it is
79We encourage people to experiment with new combinators and instances - it is
80one of the most powerful ways of using `servant`, and a wonderful way of
80one of the most powerful ways of using `servant`, and a wonderful way of
81getting to know it better. If you do write a new combinator, we would love to
81getting to know it better. If you do write a new combinator, we would love to
82−know about it! Either hop on
82+know about it! Either hop on #servant on freenode and let us know, or open an
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
83+issue with the `news` tag (which we will close when we read it).
85−read it).
86
84
87As for adding them to the main repo: maintaining combinators can be expensive,
85As for adding them to the main repo: maintaining combinators can be expensive,
88since official combinators must have instances for all classes (and new classes
86since official combinators must have instances for all classes (and new classes
cabal.project+23
@@ -51,3 +51,26 @@ packages:
51tests: True
51tests: True
52optimization: False
52optimization: False
53-- reorder-goals: True
53-- 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/1469deleted−11
@@ -1,11 +0,0 @@
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/1529deleted−10
@@ -1,10 +0,0 @@
1−synopsis: Fix performRequest in servant-client-ghcjs
2−prs: #1529
3−
4−description: {
5−
6−performRequest function in servant-client-ghcjs was not compatible with the
7−latest RunClient typeclass. Added the acceptStatus parameter and fixed the
8−functionality to match what servant-client provides.
9−
10−}
changelog.d/1556deleted−81
@@ -1,81 +0,0 @@
1−synopsis: Display capture hints in router layout
2−prs: #1556
3−
4−description: {
5−
6−This PR enhances the `Servant.Server.layout` function, which produces a textual description of the routing layout of an API. More precisely, it changes `<capture>` blocks, so that they display the name and type of the variable being captured instead.
7−
8−Example:
9−
10−For the following API
11−```haskell
12−type API =
13− "a" :> "d" :> Get '[JSON] NoContent
14− :<|> "b" :> Capture "x" Int :> Get '[JSON] Bool
15− :<|> "a" :> "e" :> Get '[JSON] Int
16−```
17−
18−we previously got the following output:
19−
20−```
21−/
22−├─ a/
23−│ ├─ d/
24−│ │ └─•
25−│ └─ e/
26−│ └─•
27−└─ b/
28− └─ <capture>/
29− ├─•
30− ┆
31− └─•
32−```
33−
34−now we get:
35−
36−```
37−/
38−├─ a/
39−│ ├─ d/
40−│ │ └─•
41−│ └─ e/
42−│ └─•
43−└─ b/
44− └─ <x::Int>/
45− ├─•
46− ┆
47− └─•
48−```
49−
50−This change is achieved by the introduction of a CaptureHint type, which is passed as an extra argument to the CaptureRouter and CaptureAllRouter constructors for the Router' type.
51−CaptureHint values are then used in routerLayout, to display the name and type of captured values, instead of just `<capture>` previously.
52−
53−N.B.:
54−Because the choice smart constructor for routers can aggregate Capture combinators with different capture hints, the Capture*Router constructors actually take a list of CaptureHint, instead of a single one.
55−
56−This PR also introduces Spec tests for the routerLayout function.
57−
58−Warning:
59−This change is potentially breaking, because it adds the constraint `Typeable a` to all types that are to be captured. Because all types are typeable since GHC 7.10, this is not as bad as it sounds ; it only break expressions where `a` is quantified in an expression with `Capture a`.
60−In those cases, the fix is easy: it suffices to add `Typeable a` to the left-hand side of the quantification constraint.
61−
62−For instance, the following code will no longer compile:
63−```haskell
64−type MyAPI a = Capture "foo" a :> Get '[JSON] ()
65−
66−myServer :: forall a. Server (MyAPI a)
67−myServer = const $ return ()
68−
69−myApi :: forall a. Proxy (MyAPI a)
70−myApi = Proxy
71−
72−app :: forall a. (FromHttpApiData a) => Application
73−app = serve (myApi @a) (myServer @a)
74−```
75−
76−Indeed, `app` should be replaced with:
77−```haskell
78−app :: forall a. (FromHttpApiData a, Typeable a) => Application
79−app = serve (myApi @a) (myServer @a)
80−```
81−}
changelog.d/1569deleted−13
@@ -1,13 +0,0 @@
1−synopsis: Encode captures using toEncodedUrlPiece
2−prs: #1569
3−issues: #1511
4−
5−description: {
6−The `servant-client` library now makes direct use of `toEncodedUrlPiece` from `ToHttpApiData`
7−to encode captured values when building the request path. It gives user freedom to implement
8−URL-encoding however they need.
9−
10−Previous behavior was to use `toUrlPiece` and URL-encode its output using `toEncodedUrlPiece`
11−from the `Text` instance of `ToHttpApiData`. The issue with this approach is that
12−`ToHttpApiData Text` is overly zealous and also encodes characters, such as `*`, which are perfectly valid in a URL.
13−}
changelog.d/1580deleted−12
@@ -1,12 +0,0 @@
1−synopsis: Allow IO in validationKeys
2−prs: #1580
3−issues: #1579
4−
5−description: {
6−
7−Currently validationKeys are a fixed JWKSet. This does not work with OIDC
8−providers such as AWS Cognito or Okta, which regularly fetching jwks_uri to
9−discover new and expired keys.
10−
11−This change alters the type of validationKeys from JWKSet to IO JWKSet.
12−}
changelog.d/1589deleted−2
@@ -1,2 +0,0 @@
1−synopsis: Only include question mark for nonempty query strings
2−prs: 1589
changelog.d/1595deleted−2
@@ -1,2 +0,0 @@
1−synopsis: Run ClientEnv's makeClientRequest in IO.
2−prs: #1595
doc/Makefile+1−1
@@ -10,7 +10,7 @@ BUILDDIR = _build
10
10
11# Put it first so that "make" without argument is like "make help".
11# Put it first so that "make" without argument is like "make help".
12help:
12help:
13− @if [ ! -d venv ]; then echo "WARNING: There is no venv directory, did you forget to 'virtualenv venv'. Check README.md."; fi
13+ @if [ ! -d venv ]; then echo "WARNING: There is no venv directory, did you forget to 'virtualenv venv'. Check building-the-docs file."; fi
14 @if [ ! "z$$(which $(SPHINXBUILD))" = "z$$(pwd)/venv/bin/sphinx-build" ]; then echo "WARNING: Did you forgot to 'source venv/bin/activate'"; fi
14 @if [ ! "z$$(which $(SPHINXBUILD))" = "z$$(pwd)/venv/bin/sphinx-build" ]; then echo "WARNING: Did you forgot to 'source venv/bin/activate'"; fi
15 @$(SPHINXBUILD) -M help "$(SOURCEDIR)" "$(BUILDDIR)" $(SPHINXOPTS) $(O)
15 @$(SPHINXBUILD) -M help "$(SOURCEDIR)" "$(BUILDDIR)" $(SPHINXOPTS) $(O)
16
16
doc/conf.py+2−1
@@ -46,7 +46,7 @@ master_doc = 'index'
46
46
47# General information about the project.
47# General information about the project.
48project = u'Servant'
48project = u'Servant'
49−copyright = u'2022, Servant Contributors'
49+copyright = u'2018, Servant Contributors'
50author = u'Servant Contributors'
50author = u'Servant Contributors'
51
51
52# The version info for the project you're documenting, acts as replacement for
52# The version info for the project you're documenting, acts as replacement for
@@ -169,3 +169,4 @@ texinfo_documents = [
169source_parsers = {
169source_parsers = {
170 '.lhs': CommonMarkParser,
170 '.lhs': CommonMarkParser,
171}
171}
172+
doc/cookbook/basic-auth/basic-auth.cabal+1−1
@@ -1,4 +1,3 @@
1−cabal-version: 2.2
2name: cookbook-basic-auth
1name: cookbook-basic-auth
3version: 0.1
2version: 0.1
4synopsis: Basic Authentication cookbook example
3synopsis: Basic Authentication cookbook example
@@ -8,6 +7,7 @@ license-file: ../../../servant/LICENSE
8author: Servant Contributors
7author: Servant Contributors
9maintainer: haskell-servant-maintainers@googlegroups.com
8maintainer: haskell-servant-maintainers@googlegroups.com
10build-type: Simple
9build-type: Simple
10+cabal-version: >=1.10
11tested-with: GHC==8.6.5, GHC==8.8.3, GHC ==8.10.7
11tested-with: GHC==8.6.5, GHC==8.8.3, GHC ==8.10.7
12
12
13executable cookbook-basic-auth
13executable cookbook-basic-auth
doc/cookbook/basic-streaming/basic-streaming.cabal+1−1
@@ -1,4 +1,3 @@
1−cabal-version: 2.2
2name: cookbook-basic-streaming
1name: cookbook-basic-streaming
3version: 2.1
2version: 2.1
4synopsis: Streaming in servant without streaming libs
3synopsis: Streaming in servant without streaming libs
@@ -8,6 +7,7 @@ license-file: ../../../servant/LICENSE
8author: Servant Contributors
7author: Servant Contributors
9maintainer: haskell-servant-maintainers@googlegroups.com
8maintainer: haskell-servant-maintainers@googlegroups.com
10build-type: Simple
9build-type: Simple
10+cabal-version: >=1.10
11tested-with: GHC==8.6.5, GHC==8.8.3, GHC ==8.10.7
11tested-with: GHC==8.6.5, GHC==8.8.3, GHC ==8.10.7
12
12
13executable cookbook-basic-streaming
13executable cookbook-basic-streaming
doc/cookbook/curl-mock/curl-mock.cabal+1−4
@@ -1,4 +1,3 @@
1−cabal-version: 2.2
2name: cookbook-curl-mock
1name: cookbook-curl-mock
3version: 0.1
2version: 0.1
4synopsis: Generate curl mock requests cookbook example
3synopsis: Generate curl mock requests cookbook example
@@ -8,12 +7,10 @@ license-file: ../../../servant/LICENSE
8author: Servant Contributors
7author: Servant Contributors
9maintainer: haskell-servant-maintainers@googlegroups.com
8maintainer: haskell-servant-maintainers@googlegroups.com
10build-type: Simple
9build-type: Simple
10+cabal-version: >=1.10
11tested-with: GHC==8.6.5, GHC==8.8.3, GHC ==8.10.7
11tested-with: GHC==8.6.5, GHC==8.8.3, GHC ==8.10.7
12
12
13executable cookbock-curl-mock
13executable cookbock-curl-mock
14− if impl(ghc >= 9.2)
15− -- generic-arbitrary is incompatible
16− buildable: False
17 main-is: CurlMock.lhs
14 main-is: CurlMock.lhs
18 build-depends: base == 4.*
15 build-depends: base == 4.*
19 , aeson
16 , aeson
doc/cookbook/custom-errors/custom-errors.cabal+1−1
@@ -1,4 +1,3 @@
1−cabal-version: 2.2
2name: cookbook-custom-errors
1name: cookbook-custom-errors
3version: 0.1
2version: 0.1
4synopsis: Return custom error messages from combinators
3synopsis: Return custom error messages from combinators
@@ -8,6 +7,7 @@ license-file: ../../../servant/LICENSE
8author: Servant Contributors
7author: Servant Contributors
9maintainer: haskell-servant-maintainers@googlegroups.com
8maintainer: haskell-servant-maintainers@googlegroups.com
10build-type: Simple
9build-type: Simple
10+cabal-version: >=1.10
11tested-with: GHC==8.6.5, GHC==8.8.3, GHC ==8.10.7
11tested-with: GHC==8.6.5, GHC==8.8.3, GHC ==8.10.7
12
12
13executable cookbook-custom-errors
13executable cookbook-custom-errors
doc/cookbook/db-mysql-basics/mysql-basics.cabal+1−1
@@ -1,4 +1,3 @@
1−cabal-version: 2.2
2name: mysql-basics
1name: mysql-basics
3version: 0.1.0.0
2version: 0.1.0.0
4synopsis: Simple MySQL API cookbook example
3synopsis: Simple MySQL API cookbook example
@@ -8,6 +7,7 @@ license-file: ../../../servant/LICENSE
8author: Servant Contributors
7author: Servant Contributors
9maintainer: haskell-servant-maintainers@googlegroups.com
8maintainer: haskell-servant-maintainers@googlegroups.com
10build-type: Simple
9build-type: Simple
10+cabal-version: >=1.10
11
11
12executable run
12executable run
13 hs-source-dirs: .
13 hs-source-dirs: .
doc/cookbook/db-postgres-pool/db-postgres-pool.cabal+1−1
@@ -1,4 +1,3 @@
1−cabal-version: 2.2
2name: cookbook-db-postgres-pool
1name: cookbook-db-postgres-pool
3version: 0.1
2version: 0.1
4synopsis: Simple PostgreSQL connection pool cookbook example
3synopsis: Simple PostgreSQL connection pool cookbook example
@@ -8,6 +7,7 @@ license-file: ../../../servant/LICENSE
8author: Servant Contributors
7author: Servant Contributors
9maintainer: haskell-servant-maintainers@googlegroups.com
8maintainer: haskell-servant-maintainers@googlegroups.com
10build-type: Simple
9build-type: Simple
10+cabal-version: >=1.10
11tested-with: GHC==8.6.5, GHC==8.8.3, GHC ==8.10.7
11tested-with: GHC==8.6.5, GHC==8.8.3, GHC ==8.10.7
12
12
13executable cookbook-db-postgres-pool
13executable cookbook-db-postgres-pool
doc/cookbook/db-sqlite-simple/db-sqlite-simple.cabal+1−1
@@ -1,4 +1,3 @@
1−cabal-version: 2.2
2name: cookbook-db-sqlite-simple
1name: cookbook-db-sqlite-simple
3version: 0.1
2version: 0.1
4synopsis: Simple SQLite DB cookbook example
3synopsis: Simple SQLite DB cookbook example
@@ -8,6 +7,7 @@ license-file: ../../../servant/LICENSE
8author: Servant Contributors
7author: Servant Contributors
9maintainer: haskell-servant-maintainers@googlegroups.com
8maintainer: haskell-servant-maintainers@googlegroups.com
10build-type: Simple
9build-type: Simple
10+cabal-version: >=1.10
11tested-with: GHC==8.6.5, GHC==8.8.3, GHC ==8.10.7
11tested-with: GHC==8.6.5, GHC==8.8.3, GHC ==8.10.7
12
12
13executable cookbook-db-sqlite-simple
13executable cookbook-db-sqlite-simple
doc/cookbook/file-upload/file-upload.cabal+1−1
@@ -1,4 +1,3 @@
1−cabal-version: 2.2
2name: cookbook-file-upload
1name: cookbook-file-upload
3version: 0.1
2version: 0.1
4synopsis: File upload cookbook example
3synopsis: File upload cookbook example
@@ -8,6 +7,7 @@ license-file: ../../../servant/LICENSE
8author: Servant Contributors
7author: Servant Contributors
9maintainer: haskell-servant-maintainers@googlegroups.com
8maintainer: haskell-servant-maintainers@googlegroups.com
10build-type: Simple
9build-type: Simple
10+cabal-version: >=1.10
11tested-with: GHC==8.6.5, GHC==8.8.3, GHC ==8.10.7
11tested-with: GHC==8.6.5, GHC==8.8.3, GHC ==8.10.7
12
12
13executable cookbook-file-upload
13executable cookbook-file-upload
doc/cookbook/generic/generic.cabal+1−1
@@ -1,4 +1,3 @@
1−cabal-version: 2.2
2name: cookbook-generic
1name: cookbook-generic
3version: 0.1
2version: 0.1
4synopsis: Using custom monad to pass a state between handlers
3synopsis: Using custom monad to pass a state between handlers
@@ -8,6 +7,7 @@ license-file: ../../../servant/LICENSE
8author: Servant Contributors
7author: Servant Contributors
9maintainer: haskell-servant-maintainers@googlegroups.com
8maintainer: haskell-servant-maintainers@googlegroups.com
10build-type: Simple
9build-type: Simple
10+cabal-version: >=1.10
11tested-with: GHC==8.6.5, GHC==8.8.3, GHC ==8.10.7
11tested-with: GHC==8.6.5, GHC==8.8.3, GHC ==8.10.7
12
12
13executable cookbook-using-custom-monad
13executable cookbook-using-custom-monad
doc/cookbook/hoist-server-with-context/hoist-server-with-context.cabal+1−1
@@ -1,4 +1,3 @@
1−cabal-version: 2.2
2name: cookbook-hoist-server-with-context
1name: cookbook-hoist-server-with-context
3version: 0.0.1
2version: 0.0.1
4synopsis: JWT and basic access authentication with a Custom Monad cookbook example
3synopsis: JWT and basic access authentication with a Custom Monad cookbook example
@@ -11,6 +10,7 @@ author: Servant Contributors
11maintainer: haskell-servant-maintainers@googlegroups.com
10maintainer: haskell-servant-maintainers@googlegroups.com
12category: Servant
11category: Servant
13build-type: Simple
12build-type: Simple
13+cabal-version: >=1.10
14tested-with: GHC==8.6.5, GHC==8.8.3, GHC ==8.10.7
14tested-with: GHC==8.6.5, GHC==8.8.3, GHC ==8.10.7
15
15
16executable cookbook-hoist-server-with-context
16executable cookbook-hoist-server-with-context
doc/cookbook/https/https.cabal+1−1
@@ -1,4 +1,3 @@
1−cabal-version: 2.2
2name: cookbook-https
1name: cookbook-https
3version: 0.1
2version: 0.1
4synopsis: HTTPS cookbook example
3synopsis: HTTPS cookbook example
@@ -8,6 +7,7 @@ license-file: ../../../servant/LICENSE
8author: Servant Contributors
7author: Servant Contributors
9maintainer: haskell-servant-maintainers@googlegroups.com
8maintainer: haskell-servant-maintainers@googlegroups.com
10build-type: Simple
9build-type: Simple
10+cabal-version: >=1.10
11tested-with: GHC==8.6.5, GHC==8.8.3, GHC ==8.10.7
11tested-with: GHC==8.6.5, GHC==8.8.3, GHC ==8.10.7
12
12
13executable cookbook-https
13executable cookbook-https
doc/cookbook/index.rst+2−2
@@ -6,8 +6,8 @@ how to solve many common problems with servant. If you're
6interested in contributing examples of your own, feel free
6interested in contributing examples of your own, feel free
7to open an issue or a pull request on
7to open an issue or a pull request on
8`our github repository <https://github.com/haskell-servant/servant>`_
8`our github repository <https://github.com/haskell-servant/servant>`_
9−or even to just get in touch with us on the `**#haskell-servant** IRC channel
9+or even to just get in touch with us on the **#servant** IRC channel
10−on libera.chat <https://web.libera.chat/#haskell-servant>_ or on
10+on freenode or on
11`the mailing list <https://groups.google.com/forum/#!forum/haskell-servant>`_.
11`the mailing list <https://groups.google.com/forum/#!forum/haskell-servant>`_.
12
12
13The scope is very wide. Simple and fancy authentication schemes,
13The scope is very wide. Simple and fancy authentication schemes,
doc/cookbook/jwt-and-basic-auth/jwt-and-basic-auth.cabal+1−1
@@ -1,4 +1,3 @@
1−cabal-version: 2.2
2name: cookbook-jwt-and-basic-auth
1name: cookbook-jwt-and-basic-auth
3version: 0.0.1
2version: 0.0.1
4synopsis: JWT and basic access authentication cookbook example
3synopsis: JWT and basic access authentication cookbook example
@@ -11,6 +10,7 @@ author: Servant Contributors
11maintainer: haskell-servant-maintainers@googlegroups.com
10maintainer: haskell-servant-maintainers@googlegroups.com
12category: Servant
11category: Servant
13build-type: Simple
12build-type: Simple
13+cabal-version: >=1.10
14tested-with: GHC==8.6.5, GHC==8.8.3, GHC ==8.10.7
14tested-with: GHC==8.6.5, GHC==8.8.3, GHC ==8.10.7
15
15
16executable cookbook-jwt-and-basic-auth
16executable cookbook-jwt-and-basic-auth
doc/cookbook/open-id-connect/OpenIdConnect.cabal+1−1
@@ -1,4 +1,3 @@
1−cabal-version: 2.2
2name: open-id-connect
1name: open-id-connect
3version: 0.1
2version: 0.1
4synopsis: OpenId Connect with Servant example
3synopsis: OpenId Connect with Servant example
@@ -8,6 +7,7 @@ license-file: ../../../servant/LICENSE
8author: Servant Contributors
7author: Servant Contributors
9maintainer: haskell-servant-maintainers@googlegroups.com
8maintainer: haskell-servant-maintainers@googlegroups.com
10build-type: Simple
9build-type: Simple
10+cabal-version: >= 1.10
11tested-with: GHC==8.6.5
11tested-with: GHC==8.6.5
12
12
13executable cookbook-openidconnect
13executable cookbook-openidconnect
doc/cookbook/pagination/pagination.cabal+1−1
@@ -1,4 +1,3 @@
1−cabal-version: 2.2
2name: cookbook-pagination
1name: cookbook-pagination
3version: 2.1
2version: 2.1
4synopsis: Pagination with Servant example
3synopsis: Pagination with Servant example
@@ -8,6 +7,7 @@ license-file: ../../../servant/LICENSE
8author: Servant Contributors
7author: Servant Contributors
9maintainer: haskell-servant-maintainers@googlegroups.com
8maintainer: haskell-servant-maintainers@googlegroups.com
10build-type: Simple
9build-type: Simple
10+cabal-version: >=1.10
11tested-with: GHC==8.6.5, GHC==8.8.3, GHC ==8.10.7
11tested-with: GHC==8.6.5, GHC==8.8.3, GHC ==8.10.7
12
12
13executable cookbook-pagination
13executable cookbook-pagination
doc/cookbook/sentry/sentry.cabal+1−1
@@ -1,4 +1,3 @@
1−cabal-version: 2.2
2name: cookbook-sentry
1name: cookbook-sentry
3version: 0.1
2version: 0.1
4synopsis: Collecting runtime exceptions using Sentry
3synopsis: Collecting runtime exceptions using Sentry
@@ -8,6 +7,7 @@ license-file: ../../../servant/LICENSE
8author: Servant Contributors
7author: Servant Contributors
9maintainer: haskell-servant-maintainers@googlegroups.com
8maintainer: haskell-servant-maintainers@googlegroups.com
10build-type: Simple
9build-type: Simple
10+cabal-version: >=1.10
11tested-with: GHC==8.6.5, GHC==8.8.3, GHC ==8.10.7
11tested-with: GHC==8.6.5, GHC==8.8.3, GHC ==8.10.7
12
12
13executable cookbook-sentry
13executable cookbook-sentry
doc/cookbook/structuring-apis/structuring-apis.cabal+1−1
@@ -1,4 +1,3 @@
1−cabal-version: 2.2
2name: cookbook-structuring-apis
1name: cookbook-structuring-apis
3version: 0.1
2version: 0.1
4synopsis: Example that shows how APIs can be structured
3synopsis: Example that shows how APIs can be structured
@@ -8,6 +7,7 @@ license-file: ../../../servant/LICENSE
8author: Servant Contributors
7author: Servant Contributors
9maintainer: haskell-servant-maintainers@googlegroups.com
8maintainer: haskell-servant-maintainers@googlegroups.com
10build-type: Simple
9build-type: Simple
10+cabal-version: >=1.10
11tested-with: GHC==8.6.5, GHC==8.8.3, GHC ==8.10.7
11tested-with: GHC==8.6.5, GHC==8.8.3, GHC ==8.10.7
12
12
13executable cookbook-structuring-apis
13executable cookbook-structuring-apis
doc/cookbook/testing/testing.cabal+1−1
@@ -1,4 +1,3 @@
1−cabal-version: 2.2
2name: cookbook-testing
1name: cookbook-testing
3version: 0.0.1
2version: 0.0.1
4synopsis: Common testing patterns in Servant apps
3synopsis: Common testing patterns in Servant apps
@@ -10,6 +9,7 @@ author: Servant Contributors
10maintainer: haskell-servant-maintainers@googlegroups.com
9maintainer: haskell-servant-maintainers@googlegroups.com
11category: Servant
10category: Servant
12build-type: Simple
11build-type: Simple
12+cabal-version: >=1.10
13tested-with: GHC==8.6.5, GHC==8.8.3, GHC ==8.10.7
13tested-with: GHC==8.6.5, GHC==8.8.3, GHC ==8.10.7
14
14
15executable cookbook-testing
15executable cookbook-testing
doc/cookbook/using-custom-monad/using-custom-monad.cabal+1−1
@@ -1,4 +1,3 @@
1−cabal-version: 2.2
2name: cookbook-using-custom-monad
1name: cookbook-using-custom-monad
3version: 0.1
2version: 0.1
4synopsis: Using custom monad to pass a state between handlers
3synopsis: Using custom monad to pass a state between handlers
@@ -8,6 +7,7 @@ license-file: ../../../servant/LICENSE
8author: Servant Contributors
7author: Servant Contributors
9maintainer: haskell-servant-maintainers@googlegroups.com
8maintainer: haskell-servant-maintainers@googlegroups.com
10build-type: Simple
9build-type: Simple
10+cabal-version: >=1.10
11tested-with: GHC==8.6.5, GHC==8.8.3, GHC ==8.10.7
11tested-with: GHC==8.6.5, GHC==8.8.3, GHC ==8.10.7
12
12
13executable cookbook-using-custom-monad
13executable 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`
119to http-client's `Request`, and we can inspect it:
119to http-client's `Request`, and we can inspect it:
120
120
121```haskell
121```haskell
122− req' <- I.defaultMakeClientRequest burl req
122+ let req' = I.defaultMakeClientRequest burl req
123 putStrLn $ "Making request: " ++ show req'
123 putStrLn $ "Making request: " ++ show req'
124```
124```
125
125
doc/cookbook/using-free-client/using-free-client.cabal+1−1
@@ -1,4 +1,3 @@
1−cabal-version: 2.2
2name: cookbook-using-free-client
1name: cookbook-using-free-client
3version: 0.1
2version: 0.1
4synopsis: Using Free client
3synopsis: Using Free client
@@ -8,6 +7,7 @@ license-file: ../../../servant/LICENSE
8author: Servant Contributors
7author: Servant Contributors
9maintainer: haskell-servant-maintainers@googlegroups.com
8maintainer: haskell-servant-maintainers@googlegroups.com
10build-type: Simple
9build-type: Simple
10+cabal-version: >=1.10
11tested-with: GHC==8.6.5, GHC==8.8.3, GHC ==8.10.7
11tested-with: GHC==8.6.5, GHC==8.8.3, GHC ==8.10.7
12
12
13executable cookbook-using-free-client
13executable cookbook-using-free-client
doc/cookbook/uverb/uverb.cabal+1−1
@@ -1,4 +1,3 @@
1−cabal-version: 2.2
2name: cookbook-uverb
1name: cookbook-uverb
3version: 0.0.1
2version: 0.0.1
4synopsis: How to use the 'UVerb' type.
3synopsis: How to use the 'UVerb' type.
@@ -10,6 +9,7 @@ author: Servant Contributors
10maintainer: haskell-servant-maintainers@googlegroups.com
9maintainer: haskell-servant-maintainers@googlegroups.com
11category: Servant
10category: Servant
12build-type: Simple
11build-type: Simple
12+cabal-version: >=1.10
13tested-with: GHC==8.6.5, GHC==8.8.4, GHC==8.10.7
13tested-with: GHC==8.6.5, GHC==8.8.4, GHC==8.10.7
14
14
15executable cookbook-uverb
15executable cookbook-uverb
doc/links.rst+1−1
@@ -12,7 +12,7 @@ Helpful Links
12 `https://github.com/haskell-servant/servant/issues <https://github.com/haskell-servant/servant/issues>`_
12 `https://github.com/haskell-servant/servant/issues <https://github.com/haskell-servant/servant/issues>`_
13
13
14- the irc channel:
14- the irc channel:
15− `#haskell-servant on libera.chat <https://web.libera.chat/#haskell-servant>`_
15+ ``#servant`` on freenode
16
16
17- the mailing list:
17- the mailing list:
18 `groups.google.com/forum/#!forum/haskell-servant <https://groups.google.com/forum/#!forum/haskell-servant>`_
18 `groups.google.com/forum/#!forum/haskell-servant <https://groups.google.com/forum/#!forum/haskell-servant>`_
doc/tutorial/install.rst−26
@@ -40,29 +40,3 @@ nix
40`Nix <https://nixos.org/nix/>`_ users should feel free to take a look at
40`Nix <https://nixos.org/nix/>`_ users should feel free to take a look at
41the `nix/shell.nix` file in the repository and use it to provision a suitable
41the `nix/shell.nix` file in the repository and use it to provision a suitable
42environment to build and run the examples.
42environment 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,4 +1,3 @@
1−cabal-version: 2.2
2name: tutorial
1name: tutorial
3version: 0.10
2version: 0.10
4synopsis: The servant tutorial
3synopsis: The servant tutorial
@@ -12,6 +11,7 @@ license-file: LICENSE
12author: Servant Contributors
11author: Servant Contributors
13maintainer: haskell-servant-maintainers@googlegroups.com
12maintainer: haskell-servant-maintainers@googlegroups.com
14build-type: Simple
13build-type: Simple
14+cabal-version: >=1.10
15tested-with:
15tested-with:
16 GHC==8.6.5
16 GHC==8.6.5
17 GHC==8.8.3, GHC ==8.10.7
17 GHC==8.8.3, GHC ==8.10.7
@@ -64,7 +64,7 @@ library
64 , blaze-markup >= 0.8.0.0 && < 0.9
64 , blaze-markup >= 0.8.0.0 && < 0.9
65 , cookie >= 0.4.3 && < 0.5
65 , cookie >= 0.4.3 && < 0.5
66 , js-jquery >= 3.3.1 && < 3.4
66 , js-jquery >= 3.3.1 && < 3.4
67− , lucid >= 2.9.11 && < 2.12
67+ , lucid >= 2.9.11 && < 2.10
68 , random >= 1.1 && < 1.3
68 , random >= 1.1 && < 1.3
69 , servant-js >= 0.9 && < 0.10
69 , servant-js >= 0.9 && < 0.10
70 , time >= 1.6.0.1 && < 1.13
70 , time >= 1.6.0.1 && < 1.13
servant-auth/servant-auth-client/servant-auth-client.cabal+13−13
@@ -1,4 +1,3 @@
1−cabal-version: 2.2
2name: servant-auth-client
1name: servant-auth-client
3version: 0.4.1.0
2version: 0.4.1.0
4synopsis: servant-client/servant-auth compatibility
3synopsis: servant-client/servant-auth compatibility
@@ -7,9 +6,9 @@ description: This package provides instances that allow generating clients fr
7 APIs that use
6 APIs that use
8 <https://hackage.haskell.org/package/servant-auth servant-auth's> @Auth@ combinator.
7 <https://hackage.haskell.org/package/servant-auth servant-auth's> @Auth@ combinator.
9 .
8 .
10− For a quick overview of the usage, see the <https://github.com/haskell-servant/servant/tree/master/servant-auth#readme README>.
9+ For a quick overview of the usage, see the <http://github.com/haskell-servant/servant/servant-auth#readme README>.
11category: Web, Servant, Authentication
10category: Web, Servant, Authentication
12−homepage: https://github.com/haskell-servant/servant/tree/master/servant-auth#readme
11+homepage: http://github.com/haskell-servant/servant/servant-auth#readme
13bug-reports: https://github.com/haskell-servant/servant/issues
12bug-reports: https://github.com/haskell-servant/servant/issues
14author: Julian K. Arni
13author: Julian K. Arni
15maintainer: jkarni@gmail.com
14maintainer: jkarni@gmail.com
@@ -18,6 +17,7 @@ license: BSD-3-Clause
18license-file: LICENSE
17license-file: LICENSE
19tested-with: GHC ==8.6.5 || ==8.8.4 || ==8.10.4 || ==9.0.1
18tested-with: GHC ==8.6.5 || ==8.8.4 || ==8.10.4 || ==9.0.1
20build-type: Simple
19build-type: Simple
20+cabal-version: >= 1.10
21extra-source-files:
21extra-source-files:
22 CHANGELOG.md
22 CHANGELOG.md
23
23
@@ -31,12 +31,12 @@ library
31 default-extensions: ConstraintKinds DataKinds DefaultSignatures DeriveFoldable DeriveFunctor DeriveGeneric DeriveTraversable FlexibleContexts FlexibleInstances FunctionalDependencies GADTs KindSignatures MultiParamTypeClasses OverloadedStrings RankNTypes ScopedTypeVariables TypeFamilies TypeOperators
31 default-extensions: ConstraintKinds DataKinds DefaultSignatures DeriveFoldable DeriveFunctor DeriveGeneric DeriveTraversable FlexibleContexts FlexibleInstances FunctionalDependencies GADTs KindSignatures MultiParamTypeClasses OverloadedStrings RankNTypes ScopedTypeVariables TypeFamilies TypeOperators
32 ghc-options: -Wall
32 ghc-options: -Wall
33 build-depends:
33 build-depends:
34− base >= 4.10 && < 4.17
34+ base >= 4.10 && < 4.16
35− , bytestring >= 0.10.6.0 && < 0.12
35+ , bytestring >= 0.10.6.0 && < 0.11
36 , containers >= 0.5.6.2 && < 0.7
36 , containers >= 0.5.6.2 && < 0.7
37 , servant-auth == 0.4.*
37 , servant-auth == 0.4.*
38− , servant >= 0.13 && < 0.20
38+ , servant >= 0.13 && < 0.19
39− , servant-client-core >= 0.13 && < 0.20
39+ , servant-client-core >= 0.13 && < 0.19
40
40
41 exposed-modules:
41 exposed-modules:
42 Servant.Auth.Client
42 Servant.Auth.Client
@@ -50,7 +50,7 @@ test-suite spec
50 test
50 test
51 default-extensions: ConstraintKinds DataKinds DefaultSignatures DeriveFoldable DeriveFunctor DeriveGeneric DeriveTraversable FlexibleContexts FlexibleInstances FunctionalDependencies GADTs KindSignatures MultiParamTypeClasses OverloadedStrings RankNTypes ScopedTypeVariables TypeFamilies TypeOperators
51 default-extensions: ConstraintKinds DataKinds DefaultSignatures DeriveFoldable DeriveFunctor DeriveGeneric DeriveTraversable FlexibleContexts FlexibleInstances FunctionalDependencies GADTs KindSignatures MultiParamTypeClasses OverloadedStrings RankNTypes ScopedTypeVariables TypeFamilies TypeOperators
52 ghc-options: -Wall
52 ghc-options: -Wall
53− build-tool-depends: hspec-discover:hspec-discover >=2.5.5 && <2.10
53+ build-tool-depends: hspec-discover:hspec-discover >=2.5.5 && <2.9
54
54
55 -- dependencies with bounds inherited from the library stanza
55 -- dependencies with bounds inherited from the library stanza
56 build-depends:
56 build-depends:
@@ -62,19 +62,19 @@ test-suite spec
62
62
63 -- test dependencies
63 -- test dependencies
64 build-depends:
64 build-depends:
65− hspec >= 2.5.5 && < 2.10
65+ hspec >= 2.5.5 && < 2.9
66 , QuickCheck >= 2.11.3 && < 2.15
66 , QuickCheck >= 2.11.3 && < 2.15
67− , aeson >= 1.3.1.1 && < 3
67+ , aeson >= 2.0.1.0 && < 3
68− , bytestring >= 0.10.6.0 && < 0.12
68+ , bytestring >= 0.10.6.0 && < 0.11
69 , http-client >= 0.5.13.1 && < 0.8
69 , http-client >= 0.5.13.1 && < 0.8
70 , http-types >= 0.12.2 && < 0.13
70 , http-types >= 0.12.2 && < 0.13
71 , servant-auth-server >= 0.4.2.0 && < 0.5
71 , servant-auth-server >= 0.4.2.0 && < 0.5
72− , servant-server >= 0.13 && < 0.20
72+ , servant-server >= 0.13 && < 0.19
73 , time >= 1.5.0.1 && < 1.13
73 , time >= 1.5.0.1 && < 1.13
74 , transformers >= 0.4.2.0 && < 0.6
74 , transformers >= 0.4.2.0 && < 0.6
75 , wai >= 3.2.1.2 && < 3.3
75 , wai >= 3.2.1.2 && < 3.3
76 , warp >= 3.2.25 && < 3.4
76 , warp >= 3.2.25 && < 3.4
77− , jose >= 0.7.0.0 && < 0.10
77+ , jose >= 0.9 && < 0.10
78 other-modules:
78 other-modules:
79 Servant.Auth.ClientSpec
79 Servant.Auth.ClientSpec
80 default-language: Haskell2010
80 default-language: Haskell2010
servant-auth/servant-auth-docs/servant-auth-docs.cabal+9−9
@@ -1,4 +1,3 @@
1−cabal-version: 2.2
2name: servant-auth-docs
1name: servant-auth-docs
3version: 0.2.10.0
2version: 0.2.10.0
4synopsis: servant-docs/servant-auth compatibility
3synopsis: servant-docs/servant-auth compatibility
@@ -7,9 +6,9 @@ description: This package provides instances that allow generating docs from
7 APIs that use
6 APIs that use
8 <https://hackage.haskell.org/package/servant-auth servant-auth's> @Auth@ combinator.
7 <https://hackage.haskell.org/package/servant-auth servant-auth's> @Auth@ combinator.
9 .
8 .
10− For a quick overview of the usage, see the <https://github.com/haskell-servant/servant/tree/master/servant-auth#readme README>.
9+ For a quick overview of the usage, see the <http://github.com/haskell-servant/servant/servant-auth#readme README>.
11category: Web, Servant, Authentication
10category: Web, Servant, Authentication
12−homepage: https://github.com/haskell-servant/servant/tree/master/servant-auth#readme
11+homepage: http://github.com/haskell-servant/servant/servant-auth#readme
13bug-reports: https://github.com/haskell-servant/servant/issues
12bug-reports: https://github.com/haskell-servant/servant/issues
14author: Julian K. Arni
13author: Julian K. Arni
15maintainer: jkarni@gmail.com
14maintainer: jkarni@gmail.com
@@ -18,6 +17,7 @@ license: BSD-3-Clause
18license-file: LICENSE
17license-file: LICENSE
19tested-with: GHC ==8.6.5 || ==8.8.4 || ==8.10.4 || ==9.0.1
18tested-with: GHC ==8.6.5 || ==8.8.4 || ==8.10.4 || ==9.0.1
20build-type: Custom
19build-type: Custom
20+cabal-version: >= 1.10
21extra-source-files:
21extra-source-files:
22 CHANGELOG.md
22 CHANGELOG.md
23
23
@@ -35,11 +35,11 @@ library
35 default-extensions: ConstraintKinds DataKinds DefaultSignatures DeriveFoldable DeriveFunctor DeriveGeneric DeriveTraversable FlexibleContexts FlexibleInstances FunctionalDependencies GADTs KindSignatures MultiParamTypeClasses OverloadedStrings RankNTypes ScopedTypeVariables TypeFamilies TypeOperators
35 default-extensions: ConstraintKinds DataKinds DefaultSignatures DeriveFoldable DeriveFunctor DeriveGeneric DeriveTraversable FlexibleContexts FlexibleInstances FunctionalDependencies GADTs KindSignatures MultiParamTypeClasses OverloadedStrings RankNTypes ScopedTypeVariables TypeFamilies TypeOperators
36 ghc-options: -Wall
36 ghc-options: -Wall
37 build-depends:
37 build-depends:
38− base >= 4.10 && < 4.17
38+ base >= 4.10 && < 4.16
39− , servant-docs >= 0.11.2 && < 0.13
39+ , servant-docs >= 0.11.2 && < 0.12
40− , servant >= 0.13 && < 0.20
40+ , servant >= 0.13 && < 0.19
41 , servant-auth == 0.4.*
41 , servant-auth == 0.4.*
42− , lens >= 4.16.1 && <5.2
42+ , lens >= 4.16.1 && <5.1
43 exposed-modules:
43 exposed-modules:
44 Servant.Auth.Docs
44 Servant.Auth.Docs
45 default-language: Haskell2010
45 default-language: Haskell2010
@@ -64,7 +64,7 @@ test-suite spec
64 test
64 test
65 default-extensions: ConstraintKinds DataKinds DefaultSignatures DeriveFoldable DeriveFunctor DeriveGeneric DeriveTraversable FlexibleContexts FlexibleInstances FunctionalDependencies GADTs KindSignatures MultiParamTypeClasses OverloadedStrings RankNTypes ScopedTypeVariables TypeFamilies TypeOperators
65 default-extensions: ConstraintKinds DataKinds DefaultSignatures DeriveFoldable DeriveFunctor DeriveGeneric DeriveTraversable FlexibleContexts FlexibleInstances FunctionalDependencies GADTs KindSignatures MultiParamTypeClasses OverloadedStrings RankNTypes ScopedTypeVariables TypeFamilies TypeOperators
66 ghc-options: -Wall
66 ghc-options: -Wall
67− build-tool-depends: hspec-discover:hspec-discover >=2.5.5 && <2.10
67+ build-tool-depends: hspec-discover:hspec-discover >=2.5.5 && <2.9
68
68
69 -- dependencies with bounds inherited from the library stanza
69 -- dependencies with bounds inherited from the library stanza
70 build-depends:
70 build-depends:
@@ -78,7 +78,7 @@ test-suite spec
78 -- test dependencies
78 -- test dependencies
79 build-depends:
79 build-depends:
80 servant-auth-docs
80 servant-auth-docs
81− , hspec >= 2.5.5 && < 2.10
81+ , hspec >= 2.5.5 && < 2.9
82 , QuickCheck >= 2.11.3 && < 2.15
82 , QuickCheck >= 2.11.3 && < 2.15
83
83
84 default-language: Haskell2010
84 default-language: Haskell2010
servant-auth/servant-auth-server/servant-auth-server.cabal+17−17
@@ -1,15 +1,14 @@
1−cabal-version: 2.2
2name: servant-auth-server
1name: servant-auth-server
3−version: 0.4.7.0
2+version: 0.4.6.0
4synopsis: servant-server/servant-auth compatibility
3synopsis: servant-server/servant-auth compatibility
5description: This package provides the required instances for using the @Auth@ combinator
4description: This package provides the required instances for using the @Auth@ combinator
6 in your 'servant' server.
5 in your 'servant' server.
7 .
6 .
8 Both cookie- and token- (REST API) based authentication is provided.
7 Both cookie- and token- (REST API) based authentication is provided.
9 .
8 .
10− For a quick overview of the usage, see the <https://github.com/haskell-servant/servant/tree/master/servant-auth#readme README>.
9+ For a quick overview of the usage, see the <http://github.com/haskell-servant/servant/servant-auth#readme README>.
11category: Web, Servant, Authentication
10category: Web, Servant, Authentication
12−homepage: https://github.com/haskell-servant/servant/tree/master/servant-auth#readme
11+homepage: http://github.com/haskell-servant/servant/servant-auth#readme
13bug-reports: https://github.com/haskell-servant/servant/issues
12bug-reports: https://github.com/haskell-servant/servant/issues
14author: Julian K. Arni
13author: Julian K. Arni
15maintainer: jkarni@gmail.com
14maintainer: jkarni@gmail.com
@@ -18,6 +17,7 @@ license: BSD-3-Clause
18license-file: LICENSE
17license-file: LICENSE
19tested-with: GHC ==8.6.5 || ==8.8.4 || ==8.10.4 || ==9.0.1
18tested-with: GHC ==8.6.5 || ==8.8.4 || ==8.10.4 || ==9.0.1
20build-type: Simple
19build-type: Simple
20+cabal-version: >= 1.10
21extra-source-files:
21extra-source-files:
22 CHANGELOG.md
22 CHANGELOG.md
23
23
@@ -31,27 +31,27 @@ library
31 default-extensions: ConstraintKinds DataKinds DefaultSignatures DeriveFoldable DeriveFunctor DeriveGeneric DeriveTraversable FlexibleContexts FlexibleInstances FunctionalDependencies GADTs KindSignatures MultiParamTypeClasses OverloadedStrings RankNTypes ScopedTypeVariables TypeFamilies TypeOperators
31 default-extensions: ConstraintKinds DataKinds DefaultSignatures DeriveFoldable DeriveFunctor DeriveGeneric DeriveTraversable FlexibleContexts FlexibleInstances FunctionalDependencies GADTs KindSignatures MultiParamTypeClasses OverloadedStrings RankNTypes ScopedTypeVariables TypeFamilies TypeOperators
32 ghc-options: -Wall
32 ghc-options: -Wall
33 build-depends:
33 build-depends:
34− base >= 4.10 && < 4.17
34+ base >= 4.10 && < 4.16
35− , aeson >= 1.0.0.1 && < 3
35+ , aeson >= 2.0.1.0 && < 3
36 , base64-bytestring >= 1.0.0.1 && < 2
36 , base64-bytestring >= 1.0.0.1 && < 2
37 , blaze-builder >= 0.4.1.0 && < 0.5
37 , blaze-builder >= 0.4.1.0 && < 0.5
38− , bytestring >= 0.10.6.0 && < 0.12
38+ , bytestring >= 0.10.6.0 && < 0.11
39 , case-insensitive >= 1.2.0.11 && < 1.3
39 , case-insensitive >= 1.2.0.11 && < 1.3
40 , cookie >= 0.4.4 && < 0.5
40 , cookie >= 0.4.4 && < 0.5
41 , data-default-class >= 0.1.2.0 && < 0.2
41 , data-default-class >= 0.1.2.0 && < 0.2
42 , entropy >= 0.4.1.3 && < 0.5
42 , entropy >= 0.4.1.3 && < 0.5
43 , http-types >= 0.12.2 && < 0.13
43 , http-types >= 0.12.2 && < 0.13
44− , jose >= 0.7.0.0 && < 0.10
44+ , jose >= 0.9 && < 0.10
45− , lens >= 4.16.1 && < 5.2
45+ , lens >= 4.16.1 && < 5.1
46− , memory >= 0.14.16 && < 0.18
46+ , memory >= 0.14.16 && < 0.17
47 , monad-time >= 0.3.1.0 && < 0.4
47 , monad-time >= 0.3.1.0 && < 0.4
48 , mtl >= 2.2.2 && < 2.3
48 , mtl >= 2.2.2 && < 2.3
49− , servant >= 0.13 && < 0.20
49+ , servant >= 0.13 && < 0.19
50 , servant-auth == 0.4.*
50 , servant-auth == 0.4.*
51− , servant-server >= 0.13 && < 0.20
51+ , servant-server >= 0.13 && < 0.19
52 , tagged >= 0.8.4 && < 0.9
52 , tagged >= 0.8.4 && < 0.9
53− , text >= 1.2.3.0 && < 2.1
53+ , text >= 1.2.3.0 && < 1.3
54− , time >= 1.5.0.1 && < 1.12
54+ , time >= 1.5.0.1 && < 1.10
55 , unordered-containers >= 0.2.9.0 && < 0.3
55 , unordered-containers >= 0.2.9.0 && < 0.3
56 , wai >= 3.2.1.2 && < 3.3
56 , wai >= 3.2.1.2 && < 3.3
57
57
@@ -102,7 +102,7 @@ test-suite spec
102 test
102 test
103 default-extensions: ConstraintKinds DataKinds DefaultSignatures DeriveFoldable DeriveFunctor DeriveGeneric DeriveTraversable FlexibleContexts FlexibleInstances FunctionalDependencies GADTs KindSignatures MultiParamTypeClasses OverloadedStrings RankNTypes ScopedTypeVariables TypeFamilies TypeOperators
103 default-extensions: ConstraintKinds DataKinds DefaultSignatures DeriveFoldable DeriveFunctor DeriveGeneric DeriveTraversable FlexibleContexts FlexibleInstances FunctionalDependencies GADTs KindSignatures MultiParamTypeClasses OverloadedStrings RankNTypes ScopedTypeVariables TypeFamilies TypeOperators
104 ghc-options: -Wall
104 ghc-options: -Wall
105− build-tool-depends: hspec-discover:hspec-discover >=2.5.5 && <2.10
105+ build-tool-depends: hspec-discover:hspec-discover >=2.5.5 && <2.8
106
106
107 -- dependencies with bounds inherited from the library stanza
107 -- dependencies with bounds inherited from the library stanza
108 build-depends:
108 build-depends:
@@ -123,10 +123,10 @@ test-suite spec
123 -- test dependencies
123 -- test dependencies
124 build-depends:
124 build-depends:
125 servant-auth-server
125 servant-auth-server
126− , hspec >= 2.5.5 && < 2.10
126+ , hspec >= 2.5.5 && < 2.8
127 , QuickCheck >= 2.11.3 && < 2.15
127 , QuickCheck >= 2.11.3 && < 2.15
128 , http-client >= 0.5.13.1 && < 0.8
128 , http-client >= 0.5.13.1 && < 0.8
129− , lens-aeson >= 1.0.2 && < 1.3
129+ , lens-aeson >= 1.0.2 && < 1.2
130 , warp >= 3.2.25 && < 3.4
130 , warp >= 3.2.25 && < 3.4
131 , wreq >= 0.5.2.1 && < 0.6
131 , wreq >= 0.5.2.1 && < 0.6
132 other-modules:
132 other-modules:
servant-auth/servant-auth-server/src/Servant/Auth/Server/Internal/AddSetCookie.hs−12
@@ -11,8 +11,6 @@ import Data.Tagged (Tagged (..))
11import qualified Network.HTTP.Types as HTTP
11import qualified Network.HTTP.Types as HTTP
12import Network.Wai (mapResponseHeaders)
12import Network.Wai (mapResponseHeaders)
13import Servant
13import Servant
14−import Servant.API.Generic
15−import Servant.Server.Generic
16import Web.Cookie
14import Web.Cookie
17
15
18-- What are we doing here? Well, the idea is to add headers to the response,
16-- What are we doing here? Well, the idea is to add headers to the response,
@@ -36,7 +34,6 @@ type family AddSetCookieApiVerb a where
36type family AddSetCookieApi a :: *
34type family AddSetCookieApi a :: *
37type instance AddSetCookieApi (a :> b) = a :> AddSetCookieApi b
35type instance AddSetCookieApi (a :> b) = a :> AddSetCookieApi b
38type instance AddSetCookieApi (a :<|> b) = AddSetCookieApi a :<|> AddSetCookieApi b
36type instance AddSetCookieApi (a :<|> b) = AddSetCookieApi a :<|> AddSetCookieApi b
39−type instance AddSetCookieApi (NamedRoutes api) = AddSetCookieApi (ToServantApi api)
40type instance AddSetCookieApi (Verb method stat ctyps a)
37type instance AddSetCookieApi (Verb method stat ctyps a)
41 = Verb method stat ctyps (AddSetCookieApiVerb a)
38 = Verb method stat ctyps (AddSetCookieApiVerb a)
42type instance AddSetCookieApi Raw = Raw
39type instance AddSetCookieApi Raw = Raw
@@ -75,15 +72,6 @@ instance {-# OVERLAPS #-}
75 => AddSetCookies ('S n) (a :<|> b) (a' :<|> b') where
72 => AddSetCookies ('S n) (a :<|> b) (a' :<|> b') where
76 addSetCookies cookies (a :<|> b) = addSetCookies cookies a :<|> addSetCookies cookies b
73 addSetCookies cookies (a :<|> b) = addSetCookies cookies a :<|> addSetCookies cookies b
77
74
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−
87-- | for @servant <0.11@
75-- | for @servant <0.11@
88instance
76instance
89 AddSetCookies ('S n) Application Application where
77 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
33 -- | Algorithm used to sign JWT.
33 -- | Algorithm used to sign JWT.
34 , jwtAlg :: Maybe Jose.Alg
34 , jwtAlg :: Maybe Jose.Alg
35 -- | Keys used to validate JWT.
35 -- | Keys used to validate JWT.
36− , validationKeys :: IO Jose.JWKSet
36+ , validationKeys :: Jose.JWKSet
37 -- | An @aud@ predicate. The @aud@ is a string or URI that identifies the
37 -- | An @aud@ predicate. The @aud@ is a string or URI that identifies the
38 -- intended recipient of the JWT.
38 -- intended recipient of the JWT.
39 , audienceMatches :: Jose.StringOrURI -> IsMatch
39 , audienceMatches :: Jose.StringOrURI -> IsMatch
@@ -44,7 +44,7 @@ defaultJWTSettings :: Jose.JWK -> JWTSettings
44defaultJWTSettings k = JWTSettings
44defaultJWTSettings k = JWTSettings
45 { signingKey = k
45 { signingKey = k
46 , jwtAlg = Nothing
46 , jwtAlg = Nothing
47− , validationKeys = pure $ Jose.JWKSet [k]
47+ , validationKeys = Jose.JWKSet [k]
48 , audienceMatches = const Matches }
48 , audienceMatches = const Matches }
49
49
50-- | The policies to use when generating cookies.
50-- | The policies to use when generating cookies.
servant-auth/servant-auth-server/src/Servant/Auth/Server/Internal/JWT.hs+3−4
@@ -58,15 +58,14 @@ makeJWT v cfg expiry = runExceptT $ do
58
58
59verifyJWT :: FromJWT a => JWTSettings -> BS.ByteString -> IO (Maybe a)
59verifyJWT :: FromJWT a => JWTSettings -> BS.ByteString -> IO (Maybe a)
60verifyJWT jwtCfg input = do
60verifyJWT jwtCfg input = do
61− keys <- validationKeys jwtCfg
62− verifiedJWT <- runExceptT $ do
61+ verifiedJWT <- liftIO $ runExceptT $ do
63 unverifiedJWT <- Jose.decodeCompact (BSL.fromStrict input)
62 unverifiedJWT <- Jose.decodeCompact (BSL.fromStrict input)
64 Jose.verifyClaims
63 Jose.verifyClaims
65 (jwtSettingsToJwtValidationSettings jwtCfg)
64 (jwtSettingsToJwtValidationSettings jwtCfg)
66− keys
65+ (validationKeys jwtCfg)
67 unverifiedJWT
66 unverifiedJWT
68 return $ case verifiedJWT of
67 return $ case verifiedJWT of
69 Left (_ :: Jose.JWTError) -> Nothing
68 Left (_ :: Jose.JWTError) -> Nothing
70 Right v -> case decodeJWT v of
69 Right v -> case decodeJWT v of
71 Left _ -> Nothing
70 Left _ -> Nothing
72− Right v' -> Just v'
71+ Right v' -> Just v'
servant-auth/servant-auth-server/src/Servant/Auth/Server/Internal/ThrowAll.hs+1−10
@@ -8,10 +8,7 @@ module Servant.Auth.Server.Internal.ThrowAll where
8
8
9import Control.Monad.Error.Class
9import Control.Monad.Error.Class
10import Data.Tagged (Tagged (..))
10import Data.Tagged (Tagged (..))
11−import Servant ((:<|>) (..), ServerError(..), NamedRoutes(..))
11+import Servant ((:<|>) (..), ServerError(..))
12−import Servant.API.Generic
13−import Servant.Server.Generic
14−import Servant.Server
15import Network.HTTP.Types
12import Network.HTTP.Types
16import Network.Wai
13import Network.Wai
17
14
@@ -29,12 +26,6 @@ class ThrowAll a where
29instance (ThrowAll a, ThrowAll b) => ThrowAll (a :<|> b) where
26instance (ThrowAll a, ThrowAll b) => ThrowAll (a :<|> b) where
30 throwAll e = throwAll e :<|> throwAll e
27 throwAll e = throwAll e :<|> throwAll e
31
28
32−instance
33− ( ThrowAll (ToServant api (AsServerT m)) , GenericServant api (AsServerT m)) =>
34− ThrowAll (api (AsServerT m)) where
35−
36− throwAll = fromServant . throwAll
37−
38-- Really this shouldn't be necessary - ((->) a) should be an instance of
29-- Really this shouldn't be necessary - ((->) a) should be an instance of
39-- MonadError, no?
30-- MonadError, no?
40instance {-# OVERLAPPING #-} ThrowAll b => ThrowAll (a -> b) where
31instance {-# OVERLAPPING #-} ThrowAll b => ThrowAll (a -> b) where
servant-auth/servant-auth-server/test/Servant/Auth/ServerSpec.hs−7
@@ -50,7 +50,6 @@ import Network.Wreq (Options, auth, basicAuth,
50import Network.Wreq.Types (Postable(..))
50import Network.Wreq.Types (Postable(..))
51import Servant hiding (BasicAuth,
51import Servant hiding (BasicAuth,
52 IsSecure (..), header)
52 IsSecure (..), header)
53−import Servant.API.Generic ((:-))
54import Servant.Auth.Server
53import Servant.Auth.Server
55import Servant.Auth.Server.Internal.Cookie (expireTime)
54import Servant.Auth.Server.Internal.Cookie (expireTime)
56import Servant.Auth.Server.SetCookieOrphan ()
55import Servant.Auth.Server.SetCookieOrphan ()
@@ -406,7 +405,6 @@ type API auths
406 = Auth auths User :>
405 = Auth auths User :>
407 ( Get '[JSON] Int
406 ( Get '[JSON] Int
408 :<|> ReqBody '[JSON] Int :> Post '[JSON] Int
407 :<|> ReqBody '[JSON] Int :> Post '[JSON] Int
409− :<|> NamedRoutes DummyRoutes
410 :<|> "header" :> Get '[JSON] (Headers '[Header "Blah" Int] Int)
408 :<|> "header" :> Get '[JSON] (Headers '[Header "Blah" Int] Int)
411#if MIN_VERSION_servant_server(0,15,0)
409#if MIN_VERSION_servant_server(0,15,0)
412 :<|> "stream" :> StreamGet NoFraming OctetStream (SourceIO BS.ByteString)
410 :<|> "stream" :> StreamGet NoFraming OctetStream (SourceIO BS.ByteString)
@@ -418,10 +416,6 @@ type API auths
418 :<|> "logout" :> Get '[JSON] (Headers '[ Header "Set-Cookie" SetCookie
416 :<|> "logout" :> Get '[JSON] (Headers '[ Header "Set-Cookie" SetCookie
419 , Header "Set-Cookie" SetCookie ] NoContent)
417 , Header "Set-Cookie" SetCookie ] NoContent)
420
418
421−data DummyRoutes mode = DummyRoutes
422− { dummyInt :: mode :- "dummy" :> Get '[JSON] Int
423− } deriving Generic
424−
425jwtOnlyApi :: Proxy (API '[Servant.Auth.Server.JWT])
419jwtOnlyApi :: Proxy (API '[Servant.Auth.Server.JWT])
426jwtOnlyApi = Proxy
420jwtOnlyApi = Proxy
427
421
@@ -482,7 +476,6 @@ server ccfg =
482 (\authResult -> case authResult of
476 (\authResult -> case authResult of
483 Authenticated usr -> getInt usr
477 Authenticated usr -> getInt usr
484 :<|> postInt usr
478 :<|> postInt usr
485− :<|> DummyRoutes { dummyInt = getInt usr }
486 :<|> getHeaderInt
479 :<|> getHeaderInt
487#if MIN_VERSION_servant_server(0,15,0)
480#if MIN_VERSION_servant_server(0,15,0)
488 :<|> return (S.source ["bytestring"])
481 :<|> return (S.source ["bytestring"])
servant-auth/servant-auth-swagger/servant-auth-swagger.cabal+16−12
@@ -1,4 +1,3 @@
1−cabal-version: 2.2
2name: servant-auth-swagger
1name: servant-auth-swagger
3version: 0.2.10.1
2version: 0.2.10.1
4synopsis: servant-swagger/servant-auth compatibility
3synopsis: servant-swagger/servant-auth compatibility
@@ -7,9 +6,9 @@ description: This package provides instances that allow generating swagger2 s
7 APIs that use
6 APIs that use
8 <https://hackage.haskell.org/package/servant-auth servant-auth's> @Auth@ combinator.
7 <https://hackage.haskell.org/package/servant-auth servant-auth's> @Auth@ combinator.
9 .
8 .
10− For a quick overview of the usage, see the <https://github.com/haskell-servant/servant/tree/master/servant-auth#readme README>.
9+ For a quick overview of the usage, see the <http://github.com/haskell-servant/servant/servant-auth#readme README>.
11category: Web, Servant, Authentication
10category: Web, Servant, Authentication
12−homepage: https://github.com/haskell-servant/servant/tree/master/servant-auth#readme
11+homepage: http://github.com/haskell-servant/servant/servant-auth#readme
13bug-reports: https://github.com/haskell-servant/servant/issues
12bug-reports: https://github.com/haskell-servant/servant/issues
14author: Julian K. Arni
13author: Julian K. Arni
15maintainer: jkarni@gmail.com
14maintainer: jkarni@gmail.com
@@ -18,6 +17,7 @@ license: BSD-3-Clause
18license-file: LICENSE
17license-file: LICENSE
19tested-with: GHC ==8.6.5 || ==8.8.4 || ==8.10.4
18tested-with: GHC ==8.6.5 || ==8.8.4 || ==8.10.4
20build-type: Simple
19build-type: Simple
20+cabal-version: >= 1.10
21extra-source-files:
21extra-source-files:
22 CHANGELOG.md
22 CHANGELOG.md
23
23
@@ -31,13 +31,15 @@ library
31 default-extensions: ConstraintKinds DataKinds DefaultSignatures DeriveFoldable DeriveFunctor DeriveGeneric DeriveTraversable FlexibleContexts FlexibleInstances FunctionalDependencies GADTs KindSignatures MultiParamTypeClasses OverloadedStrings RankNTypes ScopedTypeVariables TypeFamilies TypeOperators
31 default-extensions: ConstraintKinds DataKinds DefaultSignatures DeriveFoldable DeriveFunctor DeriveGeneric DeriveTraversable FlexibleContexts FlexibleInstances FunctionalDependencies GADTs KindSignatures MultiParamTypeClasses OverloadedStrings RankNTypes ScopedTypeVariables TypeFamilies TypeOperators
32 ghc-options: -Wall
32 ghc-options: -Wall
33 build-depends:
33 build-depends:
34− base >= 4.10 && < 4.17
34+ base >= 4.10 && < 4.16
35− , text >= 1.2.3.0 && < 2.1
35+ , text >= 1.2.3.0 && < 1.3
36− , servant-swagger >= 1.1.5 && < 2
36+ , servant-swagger >= 1.1.5 && < 1.8
37− , swagger2 >= 2.2.2 && < 3
37+ , swagger2 >= 2.2.2 && < 2.7
38− , servant >= 0.13 && < 0.20
38+ , servant >= 0.13 && < 0.19
39 , servant-auth == 0.4.*
39 , servant-auth == 0.4.*
40− , lens >= 4.16.1 && < 5.2
40+ , lens >= 4.16.1 && < 5.1
41+ if impl(ghc >= 9)
42+ buildable: False
41 exposed-modules:
43 exposed-modules:
42 Servant.Auth.Swagger
44 Servant.Auth.Swagger
43 default-language: Haskell2010
45 default-language: Haskell2010
@@ -49,7 +51,7 @@ test-suite spec
49 test
51 test
50 default-extensions: ConstraintKinds DataKinds DefaultSignatures DeriveFoldable DeriveFunctor DeriveGeneric DeriveTraversable FlexibleContexts FlexibleInstances FunctionalDependencies GADTs KindSignatures MultiParamTypeClasses OverloadedStrings RankNTypes ScopedTypeVariables TypeFamilies TypeOperators
52 default-extensions: ConstraintKinds DataKinds DefaultSignatures DeriveFoldable DeriveFunctor DeriveGeneric DeriveTraversable FlexibleContexts FlexibleInstances FunctionalDependencies GADTs KindSignatures MultiParamTypeClasses OverloadedStrings RankNTypes ScopedTypeVariables TypeFamilies TypeOperators
51 ghc-options: -Wall
53 ghc-options: -Wall
52− build-tool-depends: hspec-discover:hspec-discover >= 2.5.5 && <2.10
54+ build-tool-depends: hspec-discover:hspec-discover >= 2.5.5 && <2.9
53 -- dependencies with bounds inherited from the library stanza
55 -- dependencies with bounds inherited from the library stanza
54 build-depends:
56 build-depends:
55 base
57 base
@@ -59,11 +61,13 @@ test-suite spec
59 , servant
61 , servant
60 , servant-auth
62 , servant-auth
61 , lens
63 , lens
62−
64+ if impl(ghc >= 9)
65+ buildable: False
66+
63 -- test dependencies
67 -- test dependencies
64 build-depends:
68 build-depends:
65 servant-auth-swagger
69 servant-auth-swagger
66− , hspec >= 2.5.5 && < 2.10
70+ , hspec >= 2.5.5 && < 2.9
67 , QuickCheck >= 2.11.3 && < 2.15
71 , QuickCheck >= 2.11.3 && < 2.15
68 other-modules:
72 other-modules:
69 Servant.Auth.SwaggerSpec
73 Servant.Auth.SwaggerSpec
servant-auth/servant-auth/servant-auth.cabal+10−11
@@ -1,6 +1,5 @@
1−cabal-version: 2.2
2name: servant-auth
1name: servant-auth
3−version: 0.4.1.0
2+version: 0.4.0.0
4synopsis: Authentication combinators for servant
3synopsis: Authentication combinators for servant
5description: This package provides an @Auth@ combinator for 'servant'. This combinator
4description: This package provides an @Auth@ combinator for 'servant'. This combinator
6 allows using different authentication schemes in a straightforward way,
5 allows using different authentication schemes in a straightforward way,
@@ -9,9 +8,9 @@ description: This package provides an @Auth@ combinator for 'servant'. This c
9 'servant-auth' additionally provides concrete authentication schemes, such
8 'servant-auth' additionally provides concrete authentication schemes, such
10 as Basic Access Authentication, JSON Web Tokens, and Cookies.
9 as Basic Access Authentication, JSON Web Tokens, and Cookies.
11 .
10 .
12− For more details on how to use this, see the <https://github.com/haskell-servant/servant/tree/master/servant-auth#readme README>.
11+ For more details on how to use this, see the <http://github.com/haskell-servant/servant/servant-auth#readme README>.
13category: Web, Servant, Authentication
12category: Web, Servant, Authentication
14−homepage: https://github.com/haskell-servant/servant/tree/master/servant-auth#readme
13+homepage: http://github.com/haskell-servant/servant/servant-auth#readme
15bug-reports: https://github.com/haskell-servant/servant/issues
14bug-reports: https://github.com/haskell-servant/servant/issues
16author: Julian K. Arni
15author: Julian K. Arni
17maintainer: jkarni@gmail.com
16maintainer: jkarni@gmail.com
@@ -20,6 +19,7 @@ license: BSD-3-Clause
20license-file: LICENSE
19license-file: LICENSE
21tested-with: GHC ==8.6.5 || ==8.8.4 || ==8.10.4 || ==9.0.1
20tested-with: GHC ==8.6.5 || ==8.8.4 || ==8.10.4 || ==9.0.1
22build-type: Simple
21build-type: Simple
22+cabal-version: >= 1.10
23extra-source-files:
23extra-source-files:
24 CHANGELOG.md
24 CHANGELOG.md
25
25
@@ -33,14 +33,13 @@ library
33 default-extensions: ConstraintKinds DataKinds DefaultSignatures DeriveFoldable DeriveFunctor DeriveGeneric DeriveTraversable FlexibleContexts FlexibleInstances FunctionalDependencies GADTs KindSignatures MultiParamTypeClasses OverloadedStrings RankNTypes ScopedTypeVariables TypeFamilies TypeOperators
33 default-extensions: ConstraintKinds DataKinds DefaultSignatures DeriveFoldable DeriveFunctor DeriveGeneric DeriveTraversable FlexibleContexts FlexibleInstances FunctionalDependencies GADTs KindSignatures MultiParamTypeClasses OverloadedStrings RankNTypes ScopedTypeVariables TypeFamilies TypeOperators
34 ghc-options: -Wall
34 ghc-options: -Wall
35 build-depends:
35 build-depends:
36− base >= 4.10 && < 4.17
36+ base >= 4.10 && < 4.16
37 , containers >= 0.6 && < 0.7
37 , containers >= 0.6 && < 0.7
38− , aeson >= 1.3.1.1 && < 3
38+ , aeson >= 2.0.1.0 && < 3
39− , jose >= 0.7.0.0 && < 0.10
39+ , jose >= 0.9 && < 0.10
40− , lens >= 4.16.1 && < 5.2
40+ , lens >= 4.16.1 && < 5.1
41− , servant >= 0.15 && < 0.20
41+ , servant >= 0.15 && < 0.19
42− , text >= 1.2.3.0 && < 2.1
42+ , text >= 1.2.3.0 && < 1.3
43− , unordered-containers >= 0.2.9.0 && < 0.3
44 exposed-modules:
43 exposed-modules:
45 Servant.Auth
44 Servant.Auth
46 Servant.Auth.JWT
45 Servant.Auth.JWT
servant-auth/servant-auth/src/Servant/Auth/JWT.hs+2−9
@@ -1,17 +1,10 @@
1−{-# LANGUAGE CPP #-}
2−
3module Servant.Auth.JWT where
1module Servant.Auth.JWT where
4
2
5import Control.Lens ((^.))
3import Control.Lens ((^.))
6import qualified Crypto.JWT as Jose
4import qualified Crypto.JWT as Jose
7import Data.Aeson (FromJSON, Result (..), ToJSON, fromJSON,
5import Data.Aeson (FromJSON, Result (..), ToJSON, fromJSON,
8 toJSON)
6 toJSON)
9−#if MIN_VERSION_aeson(2,0,0)
10−import qualified Data.Map as KM
7+import qualified Data.Map as Map
11−#else
12−import qualified Data.HashMap.Strict as KM
13−#endif
14−
15import qualified Data.Text as T
8import qualified Data.Text as T
16
9
17
10
@@ -24,7 +17,7 @@ import qualified Data.Text as T
24class FromJWT a where
17class FromJWT a where
25 decodeJWT :: Jose.ClaimsSet -> Either T.Text a
18 decodeJWT :: Jose.ClaimsSet -> Either T.Text a
26 default decodeJWT :: FromJSON a => Jose.ClaimsSet -> Either T.Text a
19 default decodeJWT :: FromJSON a => Jose.ClaimsSet -> Either T.Text a
27− decodeJWT m = case KM.lookup "dat" (m ^. Jose.unregisteredClaims) of
20+ decodeJWT m = case Map.lookup "dat" (m ^. Jose.unregisteredClaims) of
28 Nothing -> Left "Missing 'dat' claim"
21 Nothing -> Left "Missing 'dat' claim"
29 Just v -> case fromJSON v of
22 Just v -> case fromJSON v of
30 Error e -> Left $ T.pack e
23 Error e -> Left $ T.pack e
servant-client-core/CHANGELOG.md−31
@@ -1,37 +1,6 @@
1[The latest version of this document is on GitHub.](https://github.com/haskell-servant/servant/blob/master/servant-client-core/CHANGELOG.md)
1[The latest version of this document is on GitHub.](https://github.com/haskell-servant/servant/blob/master/servant-client-core/CHANGELOG.md)
2[Changelog for `servant` package contains significant entries for all core packages.](https://github.com/haskell-servant/servant/blob/master/servant/CHANGELOG.md)
2[Changelog for `servant` package contains significant entries for all core packages.](https://github.com/haskell-servant/servant/blob/master/servant/CHANGELOG.md)
3
3
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−
350.18.3
40.18.3
36------
5------
37
6
servant-client-core/servant-client-core.cabal+10−10
@@ -1,6 +1,6 @@
1−cabal-version: 2.2
1+cabal-version: >=1.10
2name: servant-client-core
2name: servant-client-core
3−version: 0.19
3+version: 0.18.3
4
4
5synopsis: Core functionality and class for client function generation for servant APIs
5synopsis: Core functionality and class for client function generation for servant APIs
6category: Servant, Web
6category: Servant, Web
@@ -50,14 +50,14 @@ library
50 --
50 --
51 -- note: mtl lower bound is so low because of GHC-7.8
51 -- note: mtl lower bound is so low because of GHC-7.8
52 build-depends:
52 build-depends:
53− base >= 4.9 && < 4.17
53+ base >= 4.9 && < 4.16
54 , bytestring >= 0.10.8.1 && < 0.12
54 , bytestring >= 0.10.8.1 && < 0.12
55 , constraints >= 0.2 && < 0.14
55 , constraints >= 0.2 && < 0.14
56 , containers >= 0.5.7.1 && < 0.7
56 , containers >= 0.5.7.1 && < 0.7
57 , deepseq >= 1.4.2.0 && < 1.5
57 , deepseq >= 1.4.2.0 && < 1.5
58− , text >= 1.2.3.0 && < 2.1
58+ , text >= 1.2.3.0 && < 1.3
59 , transformers >= 0.5.2.0 && < 0.6
59 , transformers >= 0.5.2.0 && < 0.6
60− , template-haskell >= 2.11.1.0 && < 2.19
60+ , template-haskell >= 2.11.1.0 && < 2.18
61
61
62 if !impl(ghc >= 8.2)
62 if !impl(ghc >= 8.2)
63 build-depends:
63 build-depends:
@@ -65,13 +65,13 @@ library
65
65
66 -- Servant dependencies
66 -- Servant dependencies
67 build-depends:
67 build-depends:
68− servant >= 0.19
68+ servant >= 0.18.3 && <0.19
69
69
70 -- Other dependencies: Lower bound around what is in the latest Stackage LTS.
70 -- Other dependencies: Lower bound around what is in the latest Stackage LTS.
71 -- Here can be exceptions if we really need features from the newer versions.
71 -- Here can be exceptions if we really need features from the newer versions.
72 build-depends:
72 build-depends:
73− aeson >= 1.4.1.0 && < 3
73+ aeson >= 2.0.1.0 && < 3
74− , base-compat >= 0.10.5 && < 0.13
74+ , base-compat >= 0.10.5 && < 0.12
75 , base64-bytestring >= 1.0.0.1 && < 1.3
75 , base64-bytestring >= 1.0.0.1 && < 1.3
76 , exceptions >= 0.10.0 && < 0.11
76 , exceptions >= 0.10.0 && < 0.11
77 , free >= 5.1 && < 5.2
77 , free >= 5.1 && < 5.2
@@ -104,8 +104,8 @@ test-suite spec
104 -- Additional dependencies
104 -- Additional dependencies
105 build-depends:
105 build-depends:
106 deepseq >= 1.4.2.0 && < 1.5
106 deepseq >= 1.4.2.0 && < 1.5
107− , hspec >= 2.6.0 && < 2.10
107+ , hspec >= 2.6.0 && < 2.9
108 , QuickCheck >= 2.12.6.1 && < 2.15
108 , QuickCheck >= 2.12.6.1 && < 2.15
109
109
110 build-tool-depends:
110 build-tool-depends:
111− hspec-discover:hspec-discover >= 2.6.0 && <2.10
111+ hspec-discover:hspec-discover >= 2.6.0 && <2.9
servant-client-core/src/Servant/Client/Core.hs−1
@@ -59,7 +59,6 @@ module Servant.Client.Core
59 , appendToPath
59 , appendToPath
60 , setRequestBodyLBS
60 , setRequestBodyLBS
61 , setRequestBody
61 , setRequestBody
62− , encodeQueryParamValue
63 ) where
62 ) where
64import Servant.Client.Core.Auth
63import Servant.Client.Core.Auth
65import Servant.Client.Core.BaseUrl
64import Servant.Client.Core.BaseUrl
servant-client-core/src/Servant/Client/Core/HasClient.hs+32−53
@@ -33,7 +33,9 @@ import Control.Arrow
33import Control.Monad
33import Control.Monad
34 (unless)
34 (unless)
35import qualified Data.ByteString as BS
35import qualified Data.ByteString as BS
36+import Data.ByteString.Builder
37+ (toLazyByteString)
36−import qualified Data.ByteString.Lazy as BL
38+import qualified Data.ByteString.Lazy as BL
37import Data.Either
39import Data.Either
38 (partitionEithers)
40 (partitionEithers)
39import Data.Constraint (Dict(..))
41import Data.Constraint (Dict(..))
@@ -63,7 +65,7 @@ import Data.Text
63import Data.Proxy
65import Data.Proxy
64 (Proxy (Proxy))
66 (Proxy (Proxy))
65import GHC.TypeLits
67import GHC.TypeLits
66− (KnownNat, KnownSymbol, TypeError, symbolVal)
68+ (KnownSymbol, symbolVal)
67import Network.HTTP.Types
69import Network.HTTP.Types
68 (Status)
70 (Status)
69import qualified Network.HTTP.Types as H
71import qualified Network.HTTP.Types as H
@@ -84,12 +86,9 @@ import Servant.API.Generic
84 , GenericServant, toServant, fromServant)
86 , GenericServant, toServant, fromServant)
85import Servant.API.ContentTypes
87import Servant.API.ContentTypes
86 (contentTypes, AllMime (allMime), AllMimeUnrender (allMimeUnrender))
88 (contentTypes, AllMime (allMime), AllMimeUnrender (allMimeUnrender))
87−import Servant.API.Status
88− (statusFromNat)
89import Servant.API.TypeLevel (FragmentUnique, AtLeastOneFragment)
89import Servant.API.TypeLevel (FragmentUnique, AtLeastOneFragment)
90import Servant.API.Modifiers
90import Servant.API.Modifiers
91 (FoldRequired, RequiredArgument, foldRequiredArgument)
91 (FoldRequired, RequiredArgument, foldRequiredArgument)
92−import Servant.API.TypeErrors
93import Servant.API.UVerb
92import Servant.API.UVerb
94 (HasStatus, HasStatuses (Statuses, statuses), UVerb, Union, Unique, inject, statusOf, foldMapUnion, matchUnion)
93 (HasStatus, HasStatuses (Statuses, statuses), UVerb, Union, Unique, inject, statusOf, foldMapUnion, matchUnion)
95
94
@@ -208,7 +207,7 @@ instance (KnownSymbol capture, ToHttpApiData a, HasClient m api)
208 clientWithRoute pm (Proxy :: Proxy api)
207 clientWithRoute pm (Proxy :: Proxy api)
209 (appendToPath p req)
208 (appendToPath p req)
210
209
211− where p = toEncodedUrlPiece val
210+ where p = (toUrlPiece val)
212
211
213 hoistClientMonad pm _ f cl = \a ->
212 hoistClientMonad pm _ f cl = \a ->
214 hoistClientMonad pm (Proxy :: Proxy api) f (cl a)
213 hoistClientMonad pm (Proxy :: Proxy api) f (cl a)
@@ -243,7 +242,7 @@ instance (KnownSymbol capture, ToHttpApiData a, HasClient m sublayout)
243 clientWithRoute pm (Proxy :: Proxy sublayout)
242 clientWithRoute pm (Proxy :: Proxy sublayout)
244 (foldl' (flip appendToPath) req ps)
243 (foldl' (flip appendToPath) req ps)
245
244
246− where ps = map toEncodedUrlPiece vals
245+ where ps = map (toUrlPiece) vals
247
246
248 hoistClientMonad pm _ f cl = \as ->
247 hoistClientMonad pm _ f cl = \as ->
249 hoistClientMonad pm (Proxy :: Proxy sublayout) f (cl as)
248 hoistClientMonad pm (Proxy :: Proxy sublayout) f (cl as)
@@ -251,11 +250,10 @@ instance (KnownSymbol capture, ToHttpApiData a, HasClient m sublayout)
251instance {-# OVERLAPPABLE #-}
250instance {-# OVERLAPPABLE #-}
252 -- Note [Non-Empty Content Types]
251 -- Note [Non-Empty Content Types]
253 ( RunClient m, MimeUnrender ct a, ReflectMethod method, cts' ~ (ct ': cts)
252 ( RunClient m, MimeUnrender ct a, ReflectMethod method, cts' ~ (ct ': cts)
254− , KnownNat status
255 ) => HasClient m (Verb method status cts' a) where
253 ) => HasClient m (Verb method status cts' a) where
256 type Client m (Verb method status cts' a) = m a
254 type Client m (Verb method status cts' a) = m a
257 clientWithRoute _pm Proxy req = do
255 clientWithRoute _pm Proxy req = do
258− response <- runRequestAcceptStatus (Just [status]) req
256+ response <- runRequest req
259 { requestAccept = fromList $ toList accept
257 { requestAccept = fromList $ toList accept
260 , requestMethod = method
258 , requestMethod = method
261 }
259 }
@@ -263,20 +261,18 @@ instance {-# OVERLAPPABLE #-}
263 where
261 where
264 accept = contentTypes (Proxy :: Proxy ct)
262 accept = contentTypes (Proxy :: Proxy ct)
265 method = reflectMethod (Proxy :: Proxy method)
263 method = reflectMethod (Proxy :: Proxy method)
266− status = statusFromNat (Proxy :: Proxy status)
267
264
268 hoistClientMonad _ _ f ma = f ma
265 hoistClientMonad _ _ f ma = f ma
269
266
270instance {-# OVERLAPPING #-}
267instance {-# OVERLAPPING #-}
271− ( RunClient m, ReflectMethod method, KnownNat status
268+ ( RunClient m, ReflectMethod method
272 ) => HasClient m (Verb method status cts NoContent) where
269 ) => HasClient m (Verb method status cts NoContent) where
273 type Client m (Verb method status cts NoContent)
270 type Client m (Verb method status cts NoContent)
274 = m NoContent
271 = m NoContent
275 clientWithRoute _pm Proxy req = do
272 clientWithRoute _pm Proxy req = do
276− _response <- runRequestAcceptStatus (Just [status]) req { requestMethod = method }
273+ _response <- runRequest req { requestMethod = method }
277 return NoContent
274 return NoContent
278 where method = reflectMethod (Proxy :: Proxy method)
275 where method = reflectMethod (Proxy :: Proxy method)
279− status = statusFromNat (Proxy :: Proxy status)
280
276
281 hoistClientMonad _ _ f ma = f ma
277 hoistClientMonad _ _ f ma = f ma
282
278
@@ -293,13 +289,13 @@ instance (RunClient m, ReflectMethod method) =>
293
289
294instance {-# OVERLAPPING #-}
290instance {-# OVERLAPPING #-}
295 -- Note [Non-Empty Content Types]
291 -- Note [Non-Empty Content Types]
296− ( RunClient m, MimeUnrender ct a, BuildHeadersTo ls, KnownNat status
292+ ( RunClient m, MimeUnrender ct a, BuildHeadersTo ls
297 , ReflectMethod method, cts' ~ (ct ': cts)
293 , ReflectMethod method, cts' ~ (ct ': cts)
298 ) => HasClient m (Verb method status cts' (Headers ls a)) where
294 ) => HasClient m (Verb method status cts' (Headers ls a)) where
299 type Client m (Verb method status cts' (Headers ls a))
295 type Client m (Verb method status cts' (Headers ls a))
300 = m (Headers ls a)
296 = m (Headers ls a)
301 clientWithRoute _pm Proxy req = do
297 clientWithRoute _pm Proxy req = do
302− response <- runRequestAcceptStatus (Just [status]) req
298+ response <- runRequest req
303 { requestMethod = method
299 { requestMethod = method
304 , requestAccept = fromList $ toList accept
300 , requestAccept = fromList $ toList accept
305 }
301 }
@@ -307,26 +303,22 @@ instance {-# OVERLAPPING #-}
307 return $ Headers { getResponse = val
303 return $ Headers { getResponse = val
308 , getHeadersHList = buildHeadersTo . toList $ responseHeaders response
304 , getHeadersHList = buildHeadersTo . toList $ responseHeaders response
309 }
305 }
310− where
311− method = reflectMethod (Proxy :: Proxy method)
306+ where method = reflectMethod (Proxy :: Proxy method)
312− accept = contentTypes (Proxy :: Proxy ct)
307+ accept = contentTypes (Proxy :: Proxy ct)
313− status = statusFromNat (Proxy :: Proxy status)
314
308
315 hoistClientMonad _ _ f ma = f ma
309 hoistClientMonad _ _ f ma = f ma
316
310
317instance {-# OVERLAPPING #-}
311instance {-# OVERLAPPING #-}
318− ( RunClient m, BuildHeadersTo ls, ReflectMethod method, KnownNat status
312+ ( RunClient m, BuildHeadersTo ls, ReflectMethod method
319 ) => HasClient m (Verb method status cts (Headers ls NoContent)) where
313 ) => HasClient m (Verb method status cts (Headers ls NoContent)) where
320 type Client m (Verb method status cts (Headers ls NoContent))
314 type Client m (Verb method status cts (Headers ls NoContent))
321 = m (Headers ls NoContent)
315 = m (Headers ls NoContent)
322 clientWithRoute _pm Proxy req = do
316 clientWithRoute _pm Proxy req = do
317+ let method = reflectMethod (Proxy :: Proxy method)
323− response <- runRequestAcceptStatus (Just [status]) req { requestMethod = method }
318+ response <- runRequest req { requestMethod = method }
324 return $ Headers { getResponse = NoContent
319 return $ Headers { getResponse = NoContent
325 , getHeadersHList = buildHeadersTo . toList $ responseHeaders response
320 , getHeadersHList = buildHeadersTo . toList $ responseHeaders response
326 }
321 }
327− where
328− method = reflectMethod (Proxy :: Proxy method)
329− status = statusFromNat (Proxy :: Proxy status)
330
322
331 hoistClientMonad _ _ f ma = f ma
323 hoistClientMonad _ _ f ma = f ma
332
324
@@ -569,7 +561,7 @@ instance (KnownSymbol sym, ToHttpApiData a, HasClient m api, SBoolI (FoldRequire
569 (Proxy :: Proxy mods) add (maybe req add) mparam
561 (Proxy :: Proxy mods) add (maybe req add) mparam
570 where
562 where
571 add :: a -> Request
563 add :: a -> Request
572− add param = appendToQueryString pname (Just $ encodeQueryParamValue param) req
564+ add param = appendToQueryString pname (Just $ encodeQueryParam param) req
573
565
574 pname :: Text
566 pname :: Text
575 pname = pack $ symbolVal (Proxy :: Proxy sym)
567 pname = pack $ symbolVal (Proxy :: Proxy sym)
@@ -577,6 +569,9 @@ instance (KnownSymbol sym, ToHttpApiData a, HasClient m api, SBoolI (FoldRequire
577 hoistClientMonad pm _ f cl = \arg ->
569 hoistClientMonad pm _ f cl = \arg ->
578 hoistClientMonad pm (Proxy :: Proxy api) f (cl arg)
570 hoistClientMonad pm (Proxy :: Proxy api) f (cl arg)
579
571
572+encodeQueryParam :: ToHttpApiData a => a -> BS.ByteString
573+encodeQueryParam = BL.toStrict . toLazyByteString . toEncodedUrlPiece
574+
580-- | If you use a 'QueryParams' in one of your endpoints in your API,
575-- | If you use a 'QueryParams' in one of your endpoints in your API,
581-- the corresponding querying function will automatically take
576-- the corresponding querying function will automatically take
582-- an additional argument, a list of values of the type specified
577-- an additional argument, a list of values of the type specified
@@ -618,7 +613,7 @@ instance (KnownSymbol sym, ToHttpApiData a, HasClient m api)
618 )
613 )
619
614
620 where pname = pack $ symbolVal (Proxy :: Proxy sym)
615 where pname = pack $ symbolVal (Proxy :: Proxy sym)
621− paramlist' = map (Just . encodeQueryParamValue) paramlist
616+ paramlist' = map (Just . encodeQueryParam) paramlist
622
617
623 hoistClientMonad pm _ f cl = \as ->
618 hoistClientMonad pm _ f cl = \as ->
624 hoistClientMonad pm (Proxy :: Proxy api) f (cl as)
619 hoistClientMonad pm (Proxy :: Proxy api) f (cl as)
@@ -740,7 +735,7 @@ instance (KnownSymbol path, HasClient m api) => HasClient m (path :> api) where
740 clientWithRoute pm (Proxy :: Proxy api)
735 clientWithRoute pm (Proxy :: Proxy api)
741 (appendToPath p req)
736 (appendToPath p req)
742
737
743− where p = toEncodedUrlPiece $ pack $ symbolVal (Proxy :: Proxy path)
738+ where p = pack $ symbolVal (Proxy :: Proxy path)
744
739
745 hoistClientMonad pm _ f cl = hoistClientMonad pm (Proxy :: Proxy api) f cl
740 hoistClientMonad pm _ f cl = hoistClientMonad pm (Proxy :: Proxy api) f cl
746
741
@@ -789,7 +784,7 @@ instance ( HasClient m api
789
784
790-- | Ignore @'Fragment'@ in client functions.
785-- | Ignore @'Fragment'@ in client functions.
791-- See <https://ietf.org/rfc/rfc2616.html#section-15.1.3> for more details.
786-- See <https://ietf.org/rfc/rfc2616.html#section-15.1.3> for more details.
792−--
787+--
793-- Example:
788-- Example:
794--
789--
795-- > type MyApi = "books" :> Fragment Text :> Get '[JSON] [Book]
790-- > type MyApi = "books" :> Fragment Text :> Get '[JSON] [Book]
@@ -806,7 +801,7 @@ instance (AtLeastOneFragment api, FragmentUnique (Fragment a :> api), HasClient
806
801
807 type Client m (Fragment a :> api) = Client m api
802 type Client m (Fragment a :> api) = Client m api
808
803
809− clientWithRoute pm _ = clientWithRoute pm (Proxy :: Proxy api)
804+ clientWithRoute pm _ = clientWithRoute pm (Proxy :: Proxy api)
810
805
811 hoistClientMonad pm _ = hoistClientMonad pm (Proxy :: Proxy api)
806 hoistClientMonad pm _ = hoistClientMonad pm (Proxy :: Proxy api)
812
807
@@ -833,10 +828,10 @@ type GClientConstraints api m =
833 )
828 )
834
829
835class GClient (api :: * -> *) m where
830class GClient (api :: * -> *) m where
836− gClientProof :: Dict (GClientConstraints api m)
831+ proof :: Dict (GClientConstraints api m)
837
832
838instance GClientConstraints api m => GClient api m where
833instance GClientConstraints api m => GClient api m where
839− gClientProof = Dict
834+ proof = Dict
840
835
841instance
836instance
842 ( forall n. GClient api n
837 ( forall n. GClient api n
@@ -848,7 +843,7 @@ instance
848
843
849 clientWithRoute :: Proxy m -> Proxy (NamedRoutes api) -> Request -> Client m (NamedRoutes api)
844 clientWithRoute :: Proxy m -> Proxy (NamedRoutes api) -> Request -> Client m (NamedRoutes api)
850 clientWithRoute pm _ request =
845 clientWithRoute pm _ request =
851− case gClientProof @api @m of
846+ case proof @api @m of
852 Dict -> fromServant $ clientWithRoute pm (Proxy @(ToServantApi api)) request
847 Dict -> fromServant $ clientWithRoute pm (Proxy @(ToServantApi api)) request
853
848
854 hoistClientMonad
849 hoistClientMonad
@@ -859,7 +854,7 @@ instance
859 -> Client ma (NamedRoutes api)
854 -> Client ma (NamedRoutes api)
860 -> Client mb (NamedRoutes api)
855 -> Client mb (NamedRoutes api)
861 hoistClientMonad _ _ nat clientA =
856 hoistClientMonad _ _ nat clientA =
862− case (gClientProof @api @ma, gClientProof @api @mb) of
857+ case (proof @api @ma, proof @api @mb) of
863 (Dict, Dict) ->
858 (Dict, Dict) ->
864 fromServant @api @(AsClientT mb) $
859 fromServant @api @(AsClientT mb) $
865 hoistClientMonad @m @(ToServantApi api) @ma @mb Proxy Proxy nat $
860 hoistClientMonad @m @(ToServantApi api) @ma @mb Proxy Proxy nat $
@@ -874,7 +869,7 @@ infixl 2 /:
874--
869--
875-- Example:
870-- Example:
876--
871--
877−-- @
872+-- @@
878-- type Api = NamedRoutes RootApi
873-- type Api = NamedRoutes RootApi
879--
874--
880-- data RootApi mode = RootApi
875-- data RootApi mode = RootApi
@@ -895,7 +890,7 @@ infixl 2 /:
895--
890--
896-- endpointClient :: ClientM Person
891-- endpointClient :: ClientM Person
897-- endpointClient = client // subApi // endpoint
892-- endpointClient = client // subApi // endpoint
898−-- @
893+-- @@
899(//) :: a -> (a -> b) -> b
894(//) :: a -> (a -> b) -> b
900x // f = f x
895x // f = f x
901
896
@@ -906,7 +901,7 @@ x // f = f x
906--
901--
907-- Example:
902-- Example:
908--
903--
909−-- @
904+-- @@
910-- type Api = NamedRoutes RootApi
905-- type Api = NamedRoutes RootApi
911--
906--
912-- data RootApi mode = RootApi
907-- data RootApi mode = RootApi
@@ -931,7 +926,7 @@ x // f = f x
931--
926--
932-- endpointClient :: ClientM Person
927-- endpointClient :: ClientM Person
933-- endpointClient = client // subApi /: "foobar123" // endpoint
928-- endpointClient = client // subApi /: "foobar123" // endpoint
934−-- @
929+-- @@
935(/:) :: (a -> b -> c) -> b -> a -> c
930(/:) :: (a -> b -> c) -> b -> a -> c
936(/:) = flip
931(/:) = flip
937
932
@@ -975,19 +970,3 @@ decodedAs response ct = do
975 Right val -> return val
970 Right val -> return val
976 where
971 where
977 accept = toList $ contentTypes ct
972 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+8−25
@@ -17,7 +17,6 @@ module Servant.Client.Core.Request (
17 addHeader,
17 addHeader,
18 appendToPath,
18 appendToPath,
19 appendToQueryString,
19 appendToQueryString,
20− encodeQueryParamValue,
21 setRequestBody,
20 setRequestBody,
22 setRequestBodyLBS,
21 setRequestBodyLBS,
23 ) where
22 ) where
@@ -34,8 +33,6 @@ import Data.Bifunctor
34import Data.Bitraversable
33import Data.Bitraversable
35 (Bitraversable (..), bifoldMapDefault, bimapDefault)
34 (Bitraversable (..), bifoldMapDefault, bimapDefault)
36import qualified Data.ByteString as BS
35import qualified Data.ByteString as BS
37−import Data.ByteString.Builder
38− (Builder)
39import qualified Data.ByteString.Builder as Builder
36import qualified Data.ByteString.Builder as Builder
40import qualified Data.ByteString.Lazy as LBS
37import qualified Data.ByteString.Lazy as LBS
41import qualified Data.Sequence as Seq
38import qualified Data.Sequence as Seq
@@ -51,9 +48,9 @@ import Network.HTTP.Media
51 (MediaType)
48 (MediaType)
52import Network.HTTP.Types
49import Network.HTTP.Types
53 (Header, HeaderName, HttpVersion (..), Method, QueryItem,
50 (Header, HeaderName, HttpVersion (..), Method, QueryItem,
54− http11, methodGet, urlEncodeBuilder)
51+ http11, methodGet)
55import Servant.API
52import Servant.API
56− (ToHttpApiData, toEncodedUrlPiece, toQueryParam, toHeader, SourceIO)
53+ (ToHttpApiData, toEncodedUrlPiece, toHeader, SourceIO)
57
54
58import Servant.Client.Core.Internal (mediaTypeRnf)
55import Servant.Client.Core.Internal (mediaTypeRnf)
59
56
@@ -81,13 +78,12 @@ instance (Show a, Show b) =>
81 . showString ", requestAccept = "
78 . showString ", requestAccept = "
82 . showsPrec 0 (requestAccept req)
79 . showsPrec 0 (requestAccept req)
83 . showString ", requestHeaders = "
80 . showString ", requestHeaders = "
84− . showsPrec 0 (redactSensitiveHeader <$> requestHeaders req)
81+ . showsPrec 0 (redactSensitiveHeader <$> requestHeaders req))
85 . showString ", requestHttpVersion = "
82 . showString ", requestHttpVersion = "
86 . showsPrec 0 (requestHttpVersion req)
83 . showsPrec 0 (requestHttpVersion req)
87 . showString ", requestMethod = "
84 . showString ", requestMethod = "
88 . showsPrec 0 (requestMethod req)
85 . showsPrec 0 (requestMethod req)
89 . showString "}"
86 . showString "}"
90− )
91 where
87 where
92 redactSensitiveHeader :: Header -> Header
88 redactSensitiveHeader :: Header -> Header
93 redactSensitiveHeader ("Authorization", _) = ("Authorization", "<REDACTED>")
89 redactSensitiveHeader ("Authorization", _) = ("Authorization", "<REDACTED>")
@@ -114,7 +110,7 @@ instance (NFData path, NFData body) => NFData (RequestF body path) where
114 rnfB Nothing = ()
110 rnfB Nothing = ()
115 rnfB (Just (b, mt)) = rnf b `seq` mediaTypeRnf mt
111 rnfB (Just (b, mt)) = rnf b `seq` mediaTypeRnf mt
116
112
117−type Request = RequestF RequestBody Builder
113+type Request = RequestF RequestBody Builder.Builder
118
114
119-- | The request body. R replica of the @http-client@ @RequestBody@.
115-- | The request body. R replica of the @http-client@ @RequestBody@.
120data RequestBody
116data RequestBody
@@ -145,31 +141,18 @@ defaultRequest = Request
145 , requestMethod = methodGet
141 , requestMethod = methodGet
146 }
142 }
147
143
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
144+appendToPath :: Text -> Request -> Request
152appendToPath p req
145appendToPath p req
153− = req { requestPath = requestPath req <> "/" <> p }
146+ = req { requestPath = requestPath req <> "/" <> toEncodedUrlPiece p }
154
147
155−-- | Append a query parameter to the request being constructed.
156−--
157−appendToQueryString :: Text -- ^ query param name
148+appendToQueryString :: Text -- ^ param name
158− -> Maybe BS.ByteString -- ^ query param value
149+ -> Maybe BS.ByteString -- ^ param value
159 -> Request
150 -> Request
160 -> Request
151 -> Request
161appendToQueryString pname pvalue req
152appendToQueryString pname pvalue req
162 = req { requestQueryString = requestQueryString req
153 = req { requestQueryString = requestQueryString req
163 Seq.|> (encodeUtf8 pname, pvalue)}
154 Seq.|> (encodeUtf8 pname, pvalue)}
164
155
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−--
173addHeader :: ToHttpApiData a => HeaderName -> a -> Request -> Request
156addHeader :: ToHttpApiData a => HeaderName -> a -> Request -> Request
174addHeader name val req
157addHeader name val req
175 = req { requestHeaders = requestHeaders req Seq.|> (name, toHeader val)}
158 = req { requestHeaders = requestHeaders req Seq.|> (name, toHeader val)}
servant-client-core/test/Servant/Client/Core/RequestSpec.hs−12
@@ -10,22 +10,10 @@ import Data.List (isInfixOf)
10import Servant.Client.Core.Request
10import Servant.Client.Core.Request
11import Test.Hspec
11import Test.Hspec
12
12
13−newtype DataWithRequest = DataWithRequest (RequestF RequestBody ())
14− deriving Show
15−
16spec :: Spec
13spec :: Spec
17spec = do
14spec = do
18 describe "Request" $ do
15 describe "Request" $ do
19 describe "show" $ do
16 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\"})"
29 it "redacts the authorization header" $ do
17 it "redacts the authorization header" $ do
30 let request = void $ defaultRequest { requestHeaders = pure ("authorization", "secret") }
18 let request = void $ defaultRequest { requestHeaders = pure ("authorization", "secret") }
31 isInfixOf "secret" (show request) `shouldBe` False
19 isInfixOf "secret" (show request) `shouldBe` False
servant-client-ghcjs/servant-client-ghcjs.cabal+4−4
@@ -1,4 +1,4 @@
1−cabal-version: 2.2
1+cabal-version: >=1.10
2name: servant-client-ghcjs
2name: servant-client-ghcjs
3version: 0.16
3version: 0.16
4synopsis:
4synopsis:
@@ -38,7 +38,7 @@ library
38 Servant.Client.Internal.XhrClient
38 Servant.Client.Internal.XhrClient
39
39
40 build-depends:
40 build-depends:
41− base >=4.11 && <5
41+ base >=4.11 && <4.12
42 , bytestring >=0.10 && <0.12
42 , bytestring >=0.10 && <0.12
43 , case-insensitive >=1.2.0.0 && <1.3.0.0
43 , case-insensitive >=1.2.0.0 && <1.3.0.0
44 , containers >=0.5 && <0.7
44 , containers >=0.5 && <0.7
@@ -56,8 +56,8 @@ library
56
56
57 -- strict, as we re-export stuff
57 -- strict, as we re-export stuff
58 build-depends:
58 build-depends:
59− servant >=0.16 && <0.20
59+ servant >=0.16 && <0.17
60− , servant-client-core >=0.16 && <0.20
60+ , servant-client-core >=0.16 && <0.16.1
61
61
62 hs-source-dirs: src
62 hs-source-dirs: src
63 default-language: Haskell2010
63 default-language: Haskell2010
servant-client-ghcjs/src/Servant/Client/Internal/XhrClient.hs+5−8
@@ -120,7 +120,7 @@ instance Exception StreamingNotSupportedException where
120 displayException _ = "streamingRequest: streaming is not supported!"
120 displayException _ = "streamingRequest: streaming is not supported!"
121
121
122instance RunClient ClientM where
122instance RunClient ClientM where
123− runRequestAcceptStatus = performRequest
123+ runRequest = performRequest
124 throwClientError = throwError
124 throwClientError = throwError
125
125
126runClientMOrigin :: ClientM a -> ClientEnv -> IO (Either ClientError a)
126runClientMOrigin :: ClientM a -> ClientEnv -> IO (Either ClientError a)
@@ -152,18 +152,15 @@ runClientM m = do
152
152
153 runClientMOrigin m (ClientEnv (BaseUrl protocol hostname port ""))
153 runClientMOrigin m (ClientEnv (BaseUrl protocol hostname port ""))
154
154
155−performRequest :: Maybe [Status] -> Request -> ClientM Response
155+performRequest :: Request -> ClientM Response
156−performRequest acceptStatus req = do
156+performRequest req = do
157 xhr <- liftIO initXhr
157 xhr <- liftIO initXhr
158 burl <- asks baseUrl
158 burl <- asks baseUrl
159 liftIO $ performXhr xhr burl req
159 liftIO $ performXhr xhr burl req
160 resp <- toResponse xhr
160 resp <- toResponse xhr
161
161
162− let status = responseStatusCode resp
162+ let status = statusCode (responseStatusCode resp)
163− goodStatus = case acceptStatus of
163+ unless (status >= 200 && status < 300) $ do
164− Nothing -> statusIsSuccessful status
165− Just good -> status `elem` good
166− unless goodStatus $ do
167 let f b = (burl, BL.toStrict $ toLazyByteString b)
164 let f b = (burl, BL.toStrict $ toLazyByteString b)
168 throwError $ FailureResponse (bimap (const ()) f req) resp
165 throwError $ FailureResponse (bimap (const ()) f req) resp
169
166
servant-client/CHANGELOG.md−31
@@ -1,37 +1,6 @@
1[The latest version of this document is on GitHub.](https://github.com/haskell-servant/servant/blob/master/servant-client/CHANGELOG.md)
1[The latest version of this document is on GitHub.](https://github.com/haskell-servant/servant/blob/master/servant-client/CHANGELOG.md)
2[Changelog for `servant` package contains significant entries for all core packages.](https://github.com/haskell-servant/servant/blob/master/servant/CHANGELOG.md)
2[Changelog for `servant` package contains significant entries for all core packages.](https://github.com/haskell-servant/servant/blob/master/servant/CHANGELOG.md)
3
3
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−
350.18.3
40.18.3
36------
5------
37
6
servant-client/servant-client.cabal+12−13
@@ -1,6 +1,6 @@
1−cabal-version: 2.2
1+cabal-version: >=1.10
2name: servant-client
2name: servant-client
3−version: 0.19
3+version: 0.18.3
4
4
5synopsis: Automatic derivation of querying functions for servant
5synopsis: Automatic derivation of querying functions for servant
6category: Servant, Web
6category: Servant, Web
@@ -41,14 +41,14 @@ library
41 -- Bundled with GHC: Lower bound to not force re-installs
41 -- Bundled with GHC: Lower bound to not force re-installs
42 -- text and mtl are bundled starting with GHC-8.4
42 -- text and mtl are bundled starting with GHC-8.4
43 build-depends:
43 build-depends:
44− base >= 4.9 && < 4.17
44+ base >= 4.9 && < 4.16
45 , bytestring >= 0.10.8.1 && < 0.12
45 , bytestring >= 0.10.8.1 && < 0.12
46 , containers >= 0.5.7.1 && < 0.7
46 , containers >= 0.5.7.1 && < 0.7
47 , deepseq >= 1.4.2.0 && < 1.5
47 , deepseq >= 1.4.2.0 && < 1.5
48 , mtl >= 2.2.2 && < 2.3
48 , mtl >= 2.2.2 && < 2.3
49 , stm >= 2.4.5.1 && < 2.6
49 , stm >= 2.4.5.1 && < 2.6
50− , text >= 1.2.3.0 && < 2.1
50+ , text >= 1.2.3.0 && < 1.3
51− , time >= 1.6.0.1 && < 1.12
51+ , time >= 1.6.0.1 && < 1.10
52 , transformers >= 0.5.2.0 && < 0.6
52 , transformers >= 0.5.2.0 && < 0.6
53
53
54 if !impl(ghc >= 8.2)
54 if !impl(ghc >= 8.2)
@@ -58,13 +58,13 @@ library
58 -- Servant dependencies.
58 -- Servant dependencies.
59 -- Strict dependency on `servant-client-core` as we re-export things.
59 -- Strict dependency on `servant-client-core` as we re-export things.
60 build-depends:
60 build-depends:
61− servant >= 0.18 && < 0.20
61+ servant == 0.18.*
62− , servant-client-core >= 0.19 && < 0.19.1
62+ , servant-client-core >= 0.18.3 && <0.18.4
63
63
64 -- Other dependencies: Lower bound around what is in the latest Stackage LTS.
64 -- Other dependencies: Lower bound around what is in the latest Stackage LTS.
65 -- Here can be exceptions if we really need features from the newer versions.
65 -- Here can be exceptions if we really need features from the newer versions.
66 build-depends:
66 build-depends:
67− base-compat >= 0.10.5 && < 0.13
67+ base-compat >= 0.10.5 && < 0.12
68 , http-client >= 0.5.13.1 && < 0.8
68 , http-client >= 0.5.13.1 && < 0.8
69 , http-media >= 0.7.1.3 && < 0.9
69 , http-media >= 0.7.1.3 && < 0.9
70 , http-types >= 0.12.2 && < 0.13
70 , http-types >= 0.12.2 && < 0.13
@@ -89,7 +89,6 @@ test-suite spec
89 main-is: Spec.hs
89 main-is: Spec.hs
90 other-modules:
90 other-modules:
91 Servant.BasicAuthSpec
91 Servant.BasicAuthSpec
92− Servant.BrokenSpec
93 Servant.ClientTestUtils
92 Servant.ClientTestUtils
94 Servant.ConnectionErrorSpec
93 Servant.ConnectionErrorSpec
95 Servant.FailSpec
94 Servant.FailSpec
@@ -124,16 +123,16 @@ test-suite spec
124 -- Additional dependencies
123 -- Additional dependencies
125 build-depends:
124 build-depends:
126 entropy >= 0.4.1.3 && < 0.5
125 entropy >= 0.4.1.3 && < 0.5
127− , hspec >= 2.6.0 && < 2.10
126+ , hspec >= 2.6.0 && < 2.9
128 , HUnit >= 1.6.0.0 && < 1.7
127 , HUnit >= 1.6.0.0 && < 1.7
129 , network >= 2.8.0.0 && < 3.2
128 , network >= 2.8.0.0 && < 3.2
130 , QuickCheck >= 2.12.6.1 && < 2.15
129 , QuickCheck >= 2.12.6.1 && < 2.15
131− , servant == 0.19.*
130+ , servant == 0.18.*
132− , servant-server == 0.19.*
131+ , servant-server == 0.18.*
133 , tdigest >= 0.2 && < 0.3
132 , tdigest >= 0.2 && < 0.3
134
133
135 build-tool-depends:
134 build-tool-depends:
136− hspec-discover:hspec-discover >= 2.6.0 && < 2.10
135+ hspec-discover:hspec-discover >= 2.6.0 && < 2.9
137
136
138test-suite readme
137test-suite readme
139 type: exitcode-stdio-1.0
138 type: exitcode-stdio-1.0
servant-client/src/Servant/Client/Internal/HttpClient.hs+11−11
@@ -24,7 +24,7 @@ import Control.Monad
24import Control.Monad.Base
24import Control.Monad.Base
25 (MonadBase (..))
25 (MonadBase (..))
26import Control.Monad.Catch
26import Control.Monad.Catch
27− (MonadCatch, MonadThrow, MonadMask)
27+ (MonadCatch, MonadThrow)
28import Control.Monad.Error.Class
28import Control.Monad.Error.Class
29 (MonadError (..))
29 (MonadError (..))
30import Control.Monad.IO.Class
30import Control.Monad.IO.Class
@@ -63,7 +63,7 @@ import GHC.Generics
63import Network.HTTP.Media
63import Network.HTTP.Media
64 (renderHeader)
64 (renderHeader)
65import Network.HTTP.Types
65import Network.HTTP.Types
66− (hContentType, renderQuery, statusIsSuccessful, urlEncode, Status)
66+ (hContentType, renderQuery, statusCode, urlEncode, Status)
67import Servant.Client.Core
67import Servant.Client.Core
68
68
69import qualified Network.HTTP.Client as Client
69import qualified Network.HTTP.Client as Client
@@ -80,7 +80,7 @@ data ClientEnv
80 { manager :: Client.Manager
80 { manager :: Client.Manager
81 , baseUrl :: BaseUrl
81 , baseUrl :: BaseUrl
82 , cookieJar :: Maybe (TVar Client.CookieJar)
82 , cookieJar :: Maybe (TVar Client.CookieJar)
83− , makeClientRequest :: BaseUrl -> Request -> IO Client.Request
83+ , makeClientRequest :: BaseUrl -> Request -> Client.Request
84 -- ^ this function can be used to customize the creation of @http-client@ requests from @servant@ requests. Default value: 'defaultMakeClientRequest'
84 -- ^ this function can be used to customize the creation of @http-client@ requests from @servant@ requests. Default value: 'defaultMakeClientRequest'
85 -- Note that:
85 -- Note that:
86 -- 1. 'makeClientRequest' exists to allow overriding operational semantics e.g. 'responseTimeout' per request,
86 -- 1. 'makeClientRequest' exists to allow overriding operational semantics e.g. 'responseTimeout' per request,
@@ -136,7 +136,7 @@ newtype ClientM a = ClientM
136 { unClientM :: ReaderT ClientEnv (ExceptT ClientError IO) a }
136 { unClientM :: ReaderT ClientEnv (ExceptT ClientError IO) a }
137 deriving ( Functor, Applicative, Monad, MonadIO, Generic
137 deriving ( Functor, Applicative, Monad, MonadIO, Generic
138 , MonadReader ClientEnv, MonadError ClientError, MonadThrow
138 , MonadReader ClientEnv, MonadError ClientError, MonadThrow
139− , MonadCatch, MonadMask)
139+ , MonadCatch)
140
140
141instance MonadBase IO ClientM where
141instance MonadBase IO ClientM where
142 liftBase = ClientM . liftBase
142 liftBase = ClientM . liftBase
@@ -162,7 +162,7 @@ runClientM cm env = runExceptT $ flip runReaderT env $ unClientM cm
162performRequest :: Maybe [Status] -> Request -> ClientM Response
162performRequest :: Maybe [Status] -> Request -> ClientM Response
163performRequest acceptStatus req = do
163performRequest acceptStatus req = do
164 ClientEnv m burl cookieJar' createClientRequest <- ask
164 ClientEnv m burl cookieJar' createClientRequest <- ask
165− clientRequest <- liftIO $ createClientRequest burl req
165+ let clientRequest = createClientRequest burl req
166 request <- case cookieJar' of
166 request <- case cookieJar' of
167 Nothing -> pure clientRequest
167 Nothing -> pure clientRequest
168 Just cj -> liftIO $ do
168 Just cj -> liftIO $ do
@@ -179,9 +179,10 @@ performRequest acceptStatus req = do
179
179
180 response <- maybe (requestWithoutCookieJar m request) (requestWithCookieJar m request) cookieJar'
180 response <- maybe (requestWithoutCookieJar m request) (requestWithCookieJar m request) cookieJar'
181 let status = Client.responseStatus response
181 let status = Client.responseStatus response
182+ status_code = statusCode status
182 ourResponse = clientResponseToResponse id response
183 ourResponse = clientResponseToResponse id response
183 goodStatus = case acceptStatus of
184 goodStatus = case acceptStatus of
184− Nothing -> statusIsSuccessful status
185+ Nothing -> status_code >= 200 && status_code < 300
185 Just good -> status `elem` good
186 Just good -> status `elem` good
186 unless goodStatus $ do
187 unless goodStatus $ do
187 throwError $ mkFailureResponse burl req ourResponse
188 throwError $ mkFailureResponse burl req ourResponse
@@ -229,8 +230,8 @@ clientResponseToResponse f r = Response
229-- | Create a @http-client@ 'Client.Request' from a @servant@ 'Request'
230-- | Create a @http-client@ 'Client.Request' from a @servant@ 'Request'
230-- The 'Client.host', 'Client.path' and 'Client.port' fields are extracted from the 'BaseUrl'
231-- The 'Client.host', 'Client.path' and 'Client.port' fields are extracted from the 'BaseUrl'
231-- otherwise the body, headers and query string are derived from the @servant@ 'Request'
232-- otherwise the body, headers and query string are derived from the @servant@ 'Request'
232−defaultMakeClientRequest :: BaseUrl -> Request -> IO Client.Request
233+defaultMakeClientRequest :: BaseUrl -> Request -> Client.Request
233−defaultMakeClientRequest burl r = return Client.defaultRequest
234+defaultMakeClientRequest burl r = Client.defaultRequest
234 { Client.method = requestMethod r
235 { Client.method = requestMethod r
235 , Client.host = fromString $ baseUrlHost burl
236 , Client.host = fromString $ baseUrlHost burl
236 , Client.port = baseUrlPort burl
237 , Client.port = baseUrlPort burl
@@ -246,7 +247,7 @@ defaultMakeClientRequest burl r = return Client.defaultRequest
246 where
247 where
247 -- Content-Type and Accept are specified by requestBody and requestAccept
248 -- Content-Type and Accept are specified by requestBody and requestAccept
248 headers = filter (\(h, _) -> h /= "Accept" && h /= "Content-Type") $
249 headers = filter (\(h, _) -> h /= "Accept" && h /= "Content-Type") $
249− toList $ requestHeaders r
250+ toList $requestHeaders r
250
251
251 acceptHdr
252 acceptHdr
252 | null hs = Nothing
253 | null hs = Nothing
@@ -289,8 +290,7 @@ defaultMakeClientRequest burl r = return Client.defaultRequest
289 Https -> True
290 Https -> True
290
291
291 -- Query string builder which does not do any encoding
292 -- Query string builder which does not do any encoding
292− buildQueryString [] = mempty
293− buildQueryString qps = "?" <> foldl' addQueryParam mempty qps
293+ buildQueryString = ("?" <>) . foldl' addQueryParam mempty
294
294
295 addQueryParam qs (k, v) =
295 addQueryParam qs (k, v) =
296 qs <> (if BS.null qs then mempty else "&") <> urlEncode True k <> foldMap ("=" <>) v
296 qs <> (if BS.null qs then mempty else "&") <> urlEncode True k <> foldMap ("=" <>) v
servant-client/src/Servant/Client/Internal/HttpClient/Streaming.hs+7−5
@@ -47,7 +47,7 @@ import Data.Time.Clock
47 (getCurrentTime)
47 (getCurrentTime)
48import GHC.Generics
48import GHC.Generics
49import Network.HTTP.Types
49import Network.HTTP.Types
50− (Status, statusIsSuccessful)
50+ (Status, statusCode)
51
51
52import qualified Network.HTTP.Client as Client
52import qualified Network.HTTP.Client as Client
53
53
@@ -140,7 +140,7 @@ performRequest :: Maybe [Status] -> Request -> ClientM Response
140performRequest acceptStatus req = do
140performRequest acceptStatus req = do
141 -- TODO: should use Client.withResponse here too
141 -- TODO: should use Client.withResponse here too
142 ClientEnv m burl cookieJar' createClientRequest <- ask
142 ClientEnv m burl cookieJar' createClientRequest <- ask
143− clientRequest <- liftIO $ createClientRequest burl req
143+ let clientRequest = createClientRequest burl req
144 request <- case cookieJar' of
144 request <- case cookieJar' of
145 Nothing -> pure clientRequest
145 Nothing -> pure clientRequest
146 Just cj -> liftIO $ do
146 Just cj -> liftIO $ do
@@ -163,9 +163,10 @@ performRequest acceptStatus req = do
163 now' <- getCurrentTime
163 now' <- getCurrentTime
164 atomically $ modifyTVar' cj (fst . Client.updateCookieJar response request now')
164 atomically $ modifyTVar' cj (fst . Client.updateCookieJar response request now')
165 let status = Client.responseStatus response
165 let status = Client.responseStatus response
166+ status_code = statusCode status
166 ourResponse = clientResponseToResponse id response
167 ourResponse = clientResponseToResponse id response
167 goodStatus = case acceptStatus of
168 goodStatus = case acceptStatus of
168− Nothing -> statusIsSuccessful status
169+ Nothing -> status_code >= 200 && status_code < 300
169 Just good -> status `elem` good
170 Just good -> status `elem` good
170 unless goodStatus $ do
171 unless goodStatus $ do
171 throwError $ mkFailureResponse burl req ourResponse
172 throwError $ mkFailureResponse burl req ourResponse
@@ -177,13 +178,14 @@ performWithStreamingRequest req k = do
177 m <- asks manager
178 m <- asks manager
178 burl <- asks baseUrl
179 burl <- asks baseUrl
179 createClientRequest <- asks makeClientRequest
180 createClientRequest <- asks makeClientRequest
180− request <- liftIO $ createClientRequest burl req
181+ let request = createClientRequest burl req
181 ClientM $ lift $ lift $ Codensity $ \k1 ->
182 ClientM $ lift $ lift $ Codensity $ \k1 ->
182 Client.withResponse request m $ \res -> do
183 Client.withResponse request m $ \res -> do
183 let status = Client.responseStatus res
184 let status = Client.responseStatus res
185+ status_code = statusCode status
184
186
185 -- we throw FailureResponse in IO :(
187 -- we throw FailureResponse in IO :(
186− unless (statusIsSuccessful status) $ do
188+ unless (status_code >= 200 && status_code < 300) $ do
187 b <- BSL.fromChunks <$> Client.brConsume (Client.responseBody res)
189 b <- BSL.fromChunks <$> Client.brConsume (Client.responseBody res)
188 throwIO $ mkFailureResponse burl req (clientResponseToResponse (const b) res)
190 throwIO $ mkFailureResponse burl req (clientResponseToResponse (const b) res)
189
191
servant-client/test/Servant/BrokenSpec.hsdeleted−71
@@ -1,71 +0,0 @@
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+4−27
@@ -64,7 +64,7 @@ import Servant.API
64 JSON, MimeRender (mimeRender), MimeUnrender (mimeUnrender),
64 JSON, MimeRender (mimeRender), MimeUnrender (mimeUnrender),
65 NoContent (NoContent), PlainText, Post, QueryFlag, QueryParam,
65 NoContent (NoContent), PlainText, Post, QueryFlag, QueryParam,
66 QueryParams, Raw, ReqBody, StdMethod (GET), ToHttpApiData (..), UVerb, Union,
66 QueryParams, Raw, ReqBody, StdMethod (GET), ToHttpApiData (..), UVerb, Union,
67− Verb, WithStatus (WithStatus), NamedRoutes, addHeader)
67+ WithStatus (WithStatus), NamedRoutes, addHeader)
68import Servant.API.Generic ((:-))
68import Servant.API.Generic ((:-))
69import Servant.Client
69import Servant.Client
70import qualified Servant.Client.Core.Auth as Auth
70import qualified Servant.Client.Core.Auth as Auth
@@ -118,16 +118,9 @@ data OtherRoutes mode = OtherRoutes
118 { something :: mode :- "something" :> Get '[JSON] [String]
118 { something :: mode :- "something" :> Get '[JSON] [String]
119 } deriving Generic
119 } deriving Generic
120
120
121−-- Get for HTTP 307 Temporary Redirect
122−type Get307 = Verb 'GET 307
123−
124type Api =
121type Api =
125 Get '[JSON] Person
122 Get '[JSON] Person
126 :<|> "get" :> Get '[JSON] Person
123 :<|> "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
131 :<|> "deleteEmpty" :> DeleteNoContent
124 :<|> "deleteEmpty" :> DeleteNoContent
132 :<|> "capture" :> Capture "name" String :> Get '[JSON,FormUrlEncoded] Person
125 :<|> "capture" :> Capture "name" String :> Get '[JSON,FormUrlEncoded] Person
133 :<|> "captureAll" :> CaptureAll "names" String :> Get '[JSON] [Person]
126 :<|> "captureAll" :> CaptureAll "names" String :> Get '[JSON] [Person]
@@ -160,14 +153,13 @@ type Api =
160 WithStatus 301 Text]
153 WithStatus 301 Text]
161 :<|> "uverb-get-created" :> UVerb 'GET '[PlainText] '[WithStatus 201 Person]
154 :<|> "uverb-get-created" :> UVerb 'GET '[PlainText] '[WithStatus 201 Person]
162 :<|> NamedRoutes RecordRoutes
155 :<|> NamedRoutes RecordRoutes
163− :<|> "captureVerbatim" :> Capture "someString" Verbatim :> Get '[PlainText] Text
156+
164
157
165api :: Proxy Api
158api :: Proxy Api
166api = Proxy
159api = Proxy
167
160
168getRoot :: ClientM Person
161getRoot :: ClientM Person
169getGet :: ClientM Person
162getGet :: ClientM Person
170−getGet307 :: ClientM Text
171getDeleteEmpty :: ClientM NoContent
163getDeleteEmpty :: ClientM NoContent
172getCapture :: String -> ClientM Person
164getCapture :: String -> ClientM Person
173getCaptureAll :: [String] -> ClientM [Person]
165getCaptureAll :: [String] -> ClientM [Person]
@@ -194,7 +186,6 @@ recordRoutes :: RecordRoutes (AsClientT ClientM)
194
186
195getRoot
187getRoot
196 :<|> getGet
188 :<|> getGet
197− :<|> getGet307
198 :<|> getDeleteEmpty
189 :<|> getDeleteEmpty
199 :<|> getCapture
190 :<|> getCapture
200 :<|> getCaptureAll
191 :<|> getCaptureAll
@@ -215,14 +206,12 @@ getRoot
215 :<|> EmptyClient
206 :<|> EmptyClient
216 :<|> uverbGetSuccessOrRedirect
207 :<|> uverbGetSuccessOrRedirect
217 :<|> uverbGetCreated
208 :<|> uverbGetCreated
218− :<|> recordRoutes
209+ :<|> recordRoutes = client api
219− :<|> captureVerbatim = client api
220
210
221server :: Application
211server :: Application
222server = serve api (
212server = serve api (
223 return carol
213 return carol
224 :<|> return alice
214 :<|> return alice
225− :<|> return "redirecting"
226 :<|> return NoContent
215 :<|> return NoContent
227 :<|> (\ name -> return $ Person name 0)
216 :<|> (\ name -> return $ Person name 0)
228 :<|> (\ names -> return (zipWith Person names [0..]))
217 :<|> (\ names -> return (zipWith Person names [0..]))
@@ -261,11 +250,8 @@ server = serve api (
261 { something = pure ["foo", "bar", "pweet"]
250 { something = pure ["foo", "bar", "pweet"]
262 }
251 }
263 }
252 }
264− :<|> pure . decodeUtf8 . unVerbatim
265 )
253 )
266
254
267−-- * api for testing failures
268−
269type FailApi =
255type FailApi =
270 "get" :> Raw
256 "get" :> Raw
271 :<|> "capture" :> Capture "name" String :> Raw
257 :<|> "capture" :> Capture "name" String :> Raw
@@ -280,7 +266,7 @@ failServer = serve failApi (
280 :<|> (\ _capture -> Tagged $ \_request respond -> respond $ Wai.responseLBS HTTP.ok200 [("content-type", "application/json")] "")
266 :<|> (\ _capture -> Tagged $ \_request respond -> respond $ Wai.responseLBS HTTP.ok200 [("content-type", "application/json")] "")
281 :<|> (Tagged $ \_request respond -> respond $ Wai.responseLBS HTTP.ok200 [("content-type", "fooooo")] "")
267 :<|> (Tagged $ \_request respond -> respond $ Wai.responseLBS HTTP.ok200 [("content-type", "fooooo")] "")
282 :<|> (Tagged $ \_request respond -> respond $ Wai.responseLBS HTTP.ok200 [("content-type", "application/x-www-form-urlencoded"), ("X-Example1", "1"), ("X-Example2", "foo")] "")
268 :<|> (Tagged $ \_request respond -> respond $ Wai.responseLBS HTTP.ok200 [("content-type", "application/x-www-form-urlencoded"), ("X-Example1", "1"), ("X-Example2", "foo")] "")
283− )
269+ )
284
270
285-- * basic auth stuff
271-- * basic auth stuff
286
272
@@ -373,12 +359,3 @@ instance ToHttpApiData UrlEncodedByteString where
373
359
374instance FromHttpApiData UrlEncodedByteString where
360instance FromHttpApiData UrlEncodedByteString where
375 parseUrlPiece = pure . UrlEncodedByteString . HTTP.urlDecode True . encodeUtf8
361 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
38
38
39 context "client returns errors appropriately" $ do
39 context "client returns errors appropriately" $ do
40 it "reports FailureResponse" $ \(_, baseUrl) -> do
40 it "reports FailureResponse" $ \(_, baseUrl) -> do
41− let (_ :<|> _ :<|> _ :<|> getDeleteEmpty :<|> _) = client api
41+ let (_ :<|> _ :<|> getDeleteEmpty :<|> _) = client api
42 Left res <- runClient getDeleteEmpty baseUrl
42 Left res <- runClient getDeleteEmpty baseUrl
43 case res of
43 case res of
44 FailureResponse _ r | responseStatusCode r == HTTP.status404 -> return ()
44 FailureResponse _ r | responseStatusCode r == HTTP.status404 -> return ()
45 _ -> fail $ "expected 404 response, but got " <> show res
45 _ -> fail $ "expected 404 response, but got " <> show res
46
46
47 it "reports DecodeFailure" $ \(_, baseUrl) -> do
47 it "reports DecodeFailure" $ \(_, baseUrl) -> do
48− let (_ :<|> _ :<|> _ :<|> _ :<|> getCapture :<|> _) = client api
48+ let (_ :<|> _ :<|> _ :<|> getCapture :<|> _) = client api
49 Left res <- runClient (getCapture "foo") baseUrl
49 Left res <- runClient (getCapture "foo") baseUrl
50 case res of
50 case res of
51 DecodeFailure _ _ -> return ()
51 DecodeFailure _ _ -> return ()
@@ -72,7 +72,7 @@ failSpec = beforeAll (startWaiApp failServer) $ afterAll endWaiApp $ do
72 _ -> fail $ "expected UnsupportedContentType, but got " <> show res
72 _ -> fail $ "expected UnsupportedContentType, but got " <> show res
73
73
74 it "reports InvalidContentTypeHeader" $ \(_, baseUrl) -> do
74 it "reports InvalidContentTypeHeader" $ \(_, baseUrl) -> do
75− let (_ :<|> _ :<|> _ :<|> _ :<|> _ :<|> _ :<|> getBody :<|> _) = client api
75+ let (_ :<|> _ :<|> _ :<|> _ :<|> _ :<|> getBody :<|> _) = client api
76 Left res <- runClient (getBody alice) baseUrl
76 Left res <- runClient (getBody alice) baseUrl
77 case res of
77 case res of
78 InvalidContentTypeHeader _ -> return ()
78 InvalidContentTypeHeader _ -> return ()
servant-client/test/Servant/SuccessSpec.hs+6−21
@@ -36,8 +36,6 @@ import Data.Maybe
36import Data.Monoid ()
36import Data.Monoid ()
37import Data.Text
37import Data.Text
38 (Text)
38 (Text)
39−import Data.Text.Encoding
40− (encodeUtf8)
41import qualified Network.HTTP.Client as C
39import qualified Network.HTTP.Client as C
42import qualified Network.HTTP.Types as HTTP
40import qualified Network.HTTP.Types as HTTP
43import Test.Hspec
41import Test.Hspec
@@ -61,15 +59,11 @@ spec = describe "Servant.SuccessSpec" $ do
61
59
62successSpec :: Spec
60successSpec :: Spec
63successSpec = beforeAll (startWaiApp server) $ afterAll endWaiApp $ do
61successSpec = beforeAll (startWaiApp server) $ afterAll endWaiApp $ do
64− describe "Servant.API.Get" $ do
62+ it "Servant.API.Get root" $ \(_, baseUrl) -> do
65− it "get root endpoint" $ \(_, baseUrl) -> do
66− left show <$> runClient getRoot baseUrl `shouldReturn` Right carol
63+ left show <$> runClient getRoot baseUrl `shouldReturn` Right carol
67
64
68− it "get simple endpoint" $ \(_, baseUrl) -> do
65+ it "Servant.API.Get" $ \(_, baseUrl) -> do
69− left show <$> runClient getGet baseUrl `shouldReturn` Right alice
66+ 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"
73
67
74 describe "Servant.API.Delete" $ do
68 describe "Servant.API.Delete" $ do
75 it "allows empty content type" $ \(_, baseUrl) -> do
69 it "allows empty content type" $ \(_, baseUrl) -> do
@@ -117,7 +111,6 @@ successSpec = beforeAll (startWaiApp server) $ afterAll endWaiApp $ do
117
111
118 it "Servant.API.Fragment" $ \(_, baseUrl) -> do
112 it "Servant.API.Fragment" $ \(_, baseUrl) -> do
119 left id <$> runClient getFragment baseUrl `shouldReturn` Right alice
113 left id <$> runClient getFragment baseUrl `shouldReturn` Right alice
120−
121 it "Servant.API.Raw on success" $ \(_, baseUrl) -> do
114 it "Servant.API.Raw on success" $ \(_, baseUrl) -> do
122 res <- runClient (getRawSuccess HTTP.methodGet) baseUrl
115 res <- runClient (getRawSuccess HTTP.methodGet) baseUrl
123 case res of
116 case res of
@@ -162,9 +155,8 @@ successSpec = beforeAll (startWaiApp server) $ afterAll endWaiApp $ do
162 mgr <- C.newManager C.defaultManagerSettings
155 mgr <- C.newManager C.defaultManagerSettings
163 -- In proper situation, extra headers should probably be visible in API type.
156 -- In proper situation, extra headers should probably be visible in API type.
164 -- However, testing for response timeout is difficult, so we test with something which is easy to observe
157 -- However, testing for response timeout is difficult, so we test with something which is easy to observe
165− let createClientRequest url r = fmap (\req -> req { C.requestHeaders = [("X-Added-Header", "XXX")] })
158+ let createClientRequest url r = (defaultMakeClientRequest url r) { C.requestHeaders = [("X-Added-Header", "XXX")] }
166− (defaultMakeClientRequest url r)
167− clientEnv = (mkClientEnv mgr baseUrl) { makeClientRequest = createClientRequest }
159+ let clientEnv = (mkClientEnv mgr baseUrl) { makeClientRequest = createClientRequest }
168 res <- runClientM (getRawSuccessPassHeaders HTTP.methodGet) clientEnv
160 res <- runClientM (getRawSuccessPassHeaders HTTP.methodGet) clientEnv
169 case res of
161 case res of
170 Left e ->
162 Left e ->
@@ -199,10 +191,3 @@ successSpec = beforeAll (startWaiApp server) $ afterAll endWaiApp $ do
199 case eitherResponse of
191 case eitherResponse of
200 Left clientError -> fail $ show clientError
192 Left clientError -> fail $ show clientError
201 Right response -> matchUnion response `shouldBe` Just (WithStatus @201 carol)
193 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: 2.2
1+cabal-version: >=1.10
2name: servant-conduit
2name: servant-conduit
3version: 0.15.1
3version: 0.15.1
4
4
@@ -23,7 +23,7 @@ extra-source-files:
23
23
24source-repository head
24source-repository head
25 type: git
25 type: git
26− location: http://github.com/haskell-servant/servant.git
26+ location: http://github.com/haskell-servant/servant-conduit.git
27
27
28library
28library
29 exposed-modules: Servant.Conduit
29 exposed-modules: Servant.Conduit
@@ -33,7 +33,7 @@ library
33 , conduit >=1.3.1 && <1.4
33 , conduit >=1.3.1 && <1.4
34 , mtl >=2.2.2 && <2.3
34 , mtl >=2.2.2 && <2.3
35 , resourcet >=1.2.2 && <1.3
35 , resourcet >=1.2.2 && <1.3
36− , servant >=0.15 && <0.20
36+ , servant >=0.15 && <0.19
37 , unliftio-core >=0.1.2.0 && <0.3
37 , unliftio-core >=0.1.2.0 && <0.3
38 hs-source-dirs: src
38 hs-source-dirs: src
39 default-language: Haskell2010
39 default-language: Haskell2010
@@ -54,8 +54,8 @@ test-suite example
54 , resourcet
54 , resourcet
55 , servant
55 , servant
56 , servant-conduit
56 , servant-conduit
57− , servant-server >=0.15 && <0.20
57+ , servant-server >=0.15 && <0.19
58− , servant-client >=0.15 && <0.20
58+ , servant-client >=0.15 && <0.19
59 , wai >=3.2.1.2 && <3.3
59 , wai >=3.2.1.2 && <3.3
60 , warp >=3.2.25 && <3.4
60 , warp >=3.2.25 && <3.4
61 , http-client
61 , http-client
servant-docs/CHANGELOG.md−9
@@ -1,15 +1,6 @@
1[The latest version of this document is on GitHub.](https://github.com/haskell-servant/servant/blob/master/servant-docs/CHANGELOG.md)
1[The latest version of this document is on GitHub.](https://github.com/haskell-servant/servant/blob/master/servant-docs/CHANGELOG.md)
2[Changelog for `servant` package contains significant entries for all core packages.](https://github.com/haskell-servant/servant/blob/master/servant/CHANGELOG.md)
2[Changelog for `servant` package contains significant entries for all core packages.](https://github.com/haskell-servant/servant/blob/master/servant/CHANGELOG.md)
3
3
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−
130.11.9
40.11.9
14------
5------
15
6
servant-docs/servant-docs.cabal+9−9
@@ -1,6 +1,6 @@
1−cabal-version: 2.2
1+cabal-version: >=1.10
2name: servant-docs
2name: servant-docs
3−version: 0.12
3+version: 0.11.9
4
4
5synopsis: generate API docs for your servant webservice
5synopsis: generate API docs for your servant webservice
6category: Servant, Web
6category: Servant, Web
@@ -41,25 +41,25 @@ library
41 --
41 --
42 -- note: mtl lower bound is so low because of GHC-7.8
42 -- note: mtl lower bound is so low because of GHC-7.8
43 build-depends:
43 build-depends:
44− base >= 4.9 && < 4.17
44+ base >= 4.9 && < 4.16
45 , bytestring >= 0.10.8.1 && < 0.12
45 , bytestring >= 0.10.8.1 && < 0.12
46− , text >= 1.2.3.0 && < 2.1
46+ , text >= 1.2.3.0 && < 1.3
47
47
48 -- Servant dependencies
48 -- Servant dependencies
49 build-depends:
49 build-depends:
50− servant >= 0.18 && <0.20
50+ servant >= 0.18 && <0.19
51
51
52 -- Other dependencies: Lower bound around what is in the latest Stackage LTS.
52 -- Other dependencies: Lower bound around what is in the latest Stackage LTS.
53 -- Here can be exceptions if we really need features from the newer versions.
53 -- Here can be exceptions if we really need features from the newer versions.
54 build-depends:
54 build-depends:
55− aeson >= 1.4.1.0 && < 3
55+ aeson >= 2.0.1.0 && < 3
56 , aeson-pretty >= 0.8.5 && < 0.9
56 , aeson-pretty >= 0.8.5 && < 0.9
57− , base-compat >= 0.10.5 && < 0.13
57+ , base-compat >= 0.10.5 && < 0.12
58 , case-insensitive >= 1.2.0.11 && < 1.3
58 , case-insensitive >= 1.2.0.11 && < 1.3
59− , hashable >= 1.2.7.0 && < 1.5
59+ , hashable >= 1.2.7.0 && < 1.4
60 , http-media >= 0.7.1.3 && < 0.9
60 , http-media >= 0.7.1.3 && < 0.9
61 , http-types >= 0.12.2 && < 0.13
61 , http-types >= 0.12.2 && < 0.13
62− , lens >= 4.17 && < 5.2
62+ , lens >= 4.17 && < 5.1
63 , string-conversions >= 0.4.0.1 && < 0.5
63 , string-conversions >= 0.4.0.1 && < 0.5
64 , universe-base >= 1.1.1 && < 1.2
64 , universe-base >= 1.1.1 && < 1.2
65 , unordered-containers >= 0.2.9.0 && < 0.3
65 , unordered-containers >= 0.2.9.0 && < 0.3
servant-docs/src/Servant/Docs/Internal.hs−4
@@ -62,7 +62,6 @@ import GHC.TypeLits
62import Servant.API
62import Servant.API
63import Servant.API.ContentTypes
63import Servant.API.ContentTypes
64import Servant.API.TypeLevel
64import Servant.API.TypeLevel
65−import Servant.API.Generic
66
65
67import qualified Data.Universe.Helpers as U
66import qualified Data.Universe.Helpers as U
68
67
@@ -1151,9 +1150,6 @@ instance (ToAuthInfo (BasicAuth realm usr), HasDocs api) => HasDocs (BasicAuth r
1151 authProxy = Proxy :: Proxy (BasicAuth realm usr)
1150 authProxy = Proxy :: Proxy (BasicAuth realm usr)
1152 action' = over authInfo (|> toAuthInfo authProxy) action
1151 action' = over authInfo (|> toAuthInfo authProxy) action
1153
1152
1154−instance HasDocs (ToServantApi api) => HasDocs (NamedRoutes api) where
1155− docsFor Proxy = docsFor (Proxy :: Proxy (ToServantApi api))
1156−
1157-- ToSample instances for simple types
1153-- ToSample instances for simple types
1158instance ToSample NoContent
1154instance ToSample NoContent
1159instance ToSample Bool
1155instance ToSample Bool
servant-foreign/servant-foreign.cabal+8−8
@@ -1,4 +1,4 @@
1−cabal-version: 2.2
1+cabal-version: >=1.10
2name: servant-foreign
2name: servant-foreign
3version: 0.15.4
3version: 0.15.4
4
4
@@ -41,18 +41,18 @@ library
41 --
41 --
42 -- note: mtl lower bound is so low because of GHC-7.8
42 -- note: mtl lower bound is so low because of GHC-7.8
43 build-depends:
43 build-depends:
44− base >= 4.9 && < 4.17
44+ base >= 4.9 && < 4.16
45− , text >= 1.2.3.0 && < 2.1
45+ , text >= 1.2.3.0 && < 1.3
46
46
47 -- Servant dependencies
47 -- Servant dependencies
48 build-depends:
48 build-depends:
49− servant >=0.18 && <0.20
49+ servant >=0.18 && <0.19
50
50
51 -- Other dependencies: Lower bound around what is in the latest Stackage LTS.
51 -- Other dependencies: Lower bound around what is in the latest Stackage LTS.
52 -- Here can be exceptions if we really need features from the newer versions.
52 -- Here can be exceptions if we really need features from the newer versions.
53 build-depends:
53 build-depends:
54− base-compat >= 0.10.5 && < 0.13
54+ base-compat >= 0.10.5 && < 0.12
55− , lens >= 4.17 && < 5.2
55+ , lens >= 4.17 && < 5.1
56 , http-types >= 0.12.2 && < 0.13
56 , http-types >= 0.12.2 && < 0.13
57
57
58 hs-source-dirs: src
58 hs-source-dirs: src
@@ -74,7 +74,7 @@ test-suite spec
74
74
75 -- Additional dependencies
75 -- Additional dependencies
76 build-depends:
76 build-depends:
77− hspec >= 2.6.0 && <2.10
77+ hspec >= 2.6.0 && <2.9
78 build-tool-depends:
78 build-tool-depends:
79− hspec-discover:hspec-discover >=2.6.0 && <2.10
79+ hspec-discover:hspec-discover >=2.6.0 && <2.9
80 default-language: Haskell2010
80 default-language: Haskell2010
servant-http-streams/CHANGELOG.md−10
@@ -1,16 +1,6 @@
1 [The latest version of this document is on GitHub.](https://github.com/haskell-servant/servant/blob/master/servant-http-streams/CHANGELOG.md)
1 [The latest version of this document is on GitHub.](https://github.com/haskell-servant/servant/blob/master/servant-http-streams/CHANGELOG.md)
2[Changelog for `servant` package contains significant entries for all core packages.](https://github.com/haskell-servant/servant/blob/master/servant/CHANGELOG.md)
2[Changelog for `servant` package contains significant entries for all core packages.](https://github.com/haskell-servant/servant/blob/master/servant/CHANGELOG.md)
3
3
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−
140.18.3
40.18.3
15------
5------
16
6
servant-http-streams/servant-http-streams.cabal+14−14
@@ -1,6 +1,6 @@
1−cabal-version: 2.2
1+cabal-version: >=1.10
2name: servant-http-streams
2name: servant-http-streams
3−version: 0.18.4
3+version: 0.18.3
4
4
5synopsis: Automatic derivation of querying functions for servant
5synopsis: Automatic derivation of querying functions for servant
6category: Servant, Web
6category: Servant, Web
@@ -38,13 +38,13 @@ library
38 -- Bundled with GHC: Lower bound to not force re-installs
38 -- Bundled with GHC: Lower bound to not force re-installs
39 -- text and mtl are bundled starting with GHC-8.4
39 -- text and mtl are bundled starting with GHC-8.4
40 build-depends:
40 build-depends:
41− base >= 4.9 && < 4.17
41+ base >= 4.9 && < 4.16
42 , bytestring >= 0.10.8.1 && < 0.12
42 , bytestring >= 0.10.8.1 && < 0.12
43 , containers >= 0.5.7.1 && < 0.7
43 , containers >= 0.5.7.1 && < 0.7
44 , deepseq >= 1.4.2.0 && < 1.5
44 , deepseq >= 1.4.2.0 && < 1.5
45 , mtl >= 2.2.2 && < 2.3
45 , mtl >= 2.2.2 && < 2.3
46− , text >= 1.2.3.0 && < 2.1
46+ , text >= 1.2.3.0 && < 1.3
47− , time >= 1.6.0.1 && < 1.12
47+ , time >= 1.6.0.1 && < 1.10
48 , transformers >= 0.5.2.0 && < 0.6
48 , transformers >= 0.5.2.0 && < 0.6
49
49
50 if !impl(ghc >= 8.2)
50 if !impl(ghc >= 8.2)
@@ -54,25 +54,25 @@ library
54 -- Servant dependencies.
54 -- Servant dependencies.
55 -- Strict dependency on `servant-client-core` as we re-export things.
55 -- Strict dependency on `servant-client-core` as we re-export things.
56 build-depends:
56 build-depends:
57− servant >= 0.18 && < 0.20
57+ servant == 0.18.*
58− , servant-client-core >= 0.18.3 && <0.20
58+ , servant-client-core >= 0.18.3 && <0.18.4
59
59
60 -- Other dependencies: Lower bound around what is in the latest Stackage LTS.
60 -- Other dependencies: Lower bound around what is in the latest Stackage LTS.
61 -- Here can be exceptions if we really need features from the newer versions.
61 -- Here can be exceptions if we really need features from the newer versions.
62 build-depends:
62 build-depends:
63− base-compat >= 0.10.5 && < 0.13
63+ base-compat >= 0.10.5 && < 0.12
64 , case-insensitive
64 , case-insensitive
65 , http-streams >= 0.8.6.1 && < 0.9
65 , http-streams >= 0.8.6.1 && < 0.9
66 , http-media >= 0.7.1.3 && < 0.9
66 , http-media >= 0.7.1.3 && < 0.9
67 , io-streams >= 1.5.0.1 && < 1.6
67 , io-streams >= 1.5.0.1 && < 1.6
68 , http-types >= 0.12.2 && < 0.13
68 , http-types >= 0.12.2 && < 0.13
69− , http-common >= 0.8.2.0 && < 0.9
69+ , http-common >= 0.8.2.0 && < 0.8.3
70 , exceptions >= 0.10.0 && < 0.11
70 , exceptions >= 0.10.0 && < 0.11
71 , kan-extensions >= 5.2 && < 5.3
71 , kan-extensions >= 5.2 && < 5.3
72 , monad-control >= 1.0.2.3 && < 1.1
72 , monad-control >= 1.0.2.3 && < 1.1
73 , semigroupoids >= 5.3.1 && < 5.4
73 , semigroupoids >= 5.3.1 && < 5.4
74 , transformers-base >= 0.4.5.2 && < 0.5
74 , transformers-base >= 0.4.5.2 && < 0.5
75− , transformers-compat >= 0.6.2 && < 0.8
75+ , transformers-compat >= 0.6.2 && < 0.7
76
76
77 hs-source-dirs: src
77 hs-source-dirs: src
78 default-language: Haskell2010
78 default-language: Haskell2010
@@ -112,16 +112,16 @@ test-suite spec
112 -- Additional dependencies
112 -- Additional dependencies
113 build-depends:
113 build-depends:
114 entropy >= 0.4.1.3 && < 0.5
114 entropy >= 0.4.1.3 && < 0.5
115− , hspec >= 2.6.0 && < 2.10
115+ , hspec >= 2.6.0 && < 2.9
116 , HUnit >= 1.6.0.0 && < 1.7
116 , HUnit >= 1.6.0.0 && < 1.7
117 , network >= 2.8.0.0 && < 3.2
117 , network >= 2.8.0.0 && < 3.2
118 , QuickCheck >= 2.12.6.1 && < 2.15
118 , QuickCheck >= 2.12.6.1 && < 2.15
119− , servant == 0.19.*
119+ , servant == 0.18.*
120− , servant-server == 0.19.*
120+ , servant-server == 0.18.*
121 , tdigest >= 0.2 && < 0.3
121 , tdigest >= 0.2 && < 0.3
122
122
123 build-tool-depends:
123 build-tool-depends:
124− hspec-discover:hspec-discover >= 2.6.0 && < 2.10
124+ hspec-discover:hspec-discover >= 2.6.0 && < 2.9
125
125
126test-suite readme
126test-suite readme
127 type: exitcode-stdio-1.0
127 type: exitcode-stdio-1.0
servant-http-streams/src/Servant/HttpStreams/Internal.hs+6−6
@@ -57,7 +57,7 @@ import GHC.Generics
57import Network.HTTP.Media
57import Network.HTTP.Media
58 (renderHeader)
58 (renderHeader)
59import Network.HTTP.Types
59import Network.HTTP.Types
60− (Status (..), hContentType, http11, renderQuery, statusIsSuccessful)
60+ (Status (..), hContentType, http11, renderQuery)
61import Servant.Client.Core
61import Servant.Client.Core
62
62
63import qualified Network.Http.Client as Client
63import qualified Network.Http.Client as Client
@@ -160,12 +160,12 @@ performRequest acceptStatus req = do
160 x <- ClientM $ lift $ lift $ Codensity $ \k -> do
160 x <- ClientM $ lift $ lift $ Codensity $ \k -> do
161 Client.sendRequest conn req' body
161 Client.sendRequest conn req' body
162 Client.receiveResponse conn $ \res' body' -> do
162 Client.receiveResponse conn $ \res' body' -> do
163− let status = toEnum $ Client.getStatusCode res'
163+ let sc = Client.getStatusCode res'
164 lbs <- BSL.fromChunks <$> Streams.toList body'
164 lbs <- BSL.fromChunks <$> Streams.toList body'
165 let res'' = clientResponseToResponse res' lbs
165 let res'' = clientResponseToResponse res' lbs
166 goodStatus = case acceptStatus of
166 goodStatus = case acceptStatus of
167− Nothing -> statusIsSuccessful status
167+ Nothing -> sc >= 200 && sc < 300
168− Just good -> status `elem` good
168+ Just good -> sc `elem` (statusCode <$> good)
169 if goodStatus
169 if goodStatus
170 then k (Right res'')
170 then k (Right res'')
171 else k (Left (mkFailureResponse burl req res''))
171 else k (Left (mkFailureResponse burl req res''))
@@ -180,8 +180,8 @@ performWithStreamingRequest req k = do
180 Client.sendRequest conn req' body
180 Client.sendRequest conn req' body
181 Client.receiveResponseRaw conn $ \res' body' -> do
181 Client.receiveResponseRaw conn $ \res' body' -> do
182 -- check status code
182 -- check status code
183− let status = toEnum $ Client.getStatusCode res'
183+ let sc = Client.getStatusCode res'
184− unless (statusIsSuccessful status) $ do
184+ unless (sc >= 200 && sc < 300) $ do
185 lbs <- BSL.fromChunks <$> Streams.toList body'
185 lbs <- BSL.fromChunks <$> Streams.toList body'
186 throwIO $ mkFailureResponse burl req (clientResponseToResponse res' lbs)
186 throwIO $ mkFailureResponse burl req (clientResponseToResponse res' lbs)
187
187
servant-machines/servant-machines.cabal+5−5
@@ -1,4 +1,4 @@
1−cabal-version: 2.2
1+cabal-version: >=1.10
2name: servant-machines
2name: servant-machines
3version: 0.15.1
3version: 0.15.1
4
4
@@ -23,7 +23,7 @@ extra-source-files:
23
23
24source-repository head
24source-repository head
25 type: git
25 type: git
26− location: http://github.com/haskell-servant/servant.git
26+ location: http://github.com/haskell-servant/servant-machines.git
27
27
28library
28library
29 exposed-modules: Servant.Machines
29 exposed-modules: Servant.Machines
@@ -32,7 +32,7 @@ library
32 , bytestring >=0.10.8.1 && <0.12
32 , bytestring >=0.10.8.1 && <0.12
33 , machines >=0.6.4 && <0.8
33 , machines >=0.6.4 && <0.8
34 , mtl >=2.2.2 && <2.3
34 , mtl >=2.2.2 && <2.3
35− , servant >=0.15 && <0.20
35+ , servant >=0.15 && <0.19
36 hs-source-dirs: src
36 hs-source-dirs: src
37 default-language: Haskell2010
37 default-language: Haskell2010
38 ghc-options: -Wall
38 ghc-options: -Wall
@@ -51,8 +51,8 @@ test-suite example
51 , servant
51 , servant
52 , machines
52 , machines
53 , servant-machines
53 , servant-machines
54− , servant-server >=0.15 && <0.20
54+ , servant-server >=0.15 && <0.19
55− , servant-client >=0.15 && <0.20
55+ , servant-client >=0.15 && <0.19
56 , wai >=3.2.1.2 && <3.3
56 , wai >=3.2.1.2 && <3.3
57 , warp >=3.2.25 && <3.4
57 , warp >=3.2.25 && <3.4
58 , http-client
58 , http-client
servant-pipes/servant-pipes.cabal+6−6
@@ -1,4 +1,4 @@
1−cabal-version: 2.2
1+cabal-version: >=1.10
2name: servant-pipes
2name: servant-pipes
3version: 0.15.3
3version: 0.15.3
4
4
@@ -23,7 +23,7 @@ extra-source-files:
23
23
24source-repository head
24source-repository head
25 type: git
25 type: git
26− location: http://github.com/haskell-servant/servant.git
26+ location: http://github.com/haskell-servant/servant-pipes.git
27
27
28library
28library
29 exposed-modules: Servant.Pipes
29 exposed-modules: Servant.Pipes
@@ -34,7 +34,7 @@ library
34 , pipes-safe >=2.3.1 && <2.4
34 , pipes-safe >=2.3.1 && <2.4
35 , mtl >=2.2.2 && <2.3
35 , mtl >=2.2.2 && <2.3
36 , monad-control >=1.0.2.3 && <1.1
36 , monad-control >=1.0.2.3 && <1.1
37− , servant >=0.15 && <0.20
37+ , servant >=0.15 && <0.19
38 hs-source-dirs: src
38 hs-source-dirs: src
39 default-language: Haskell2010
39 default-language: Haskell2010
40 ghc-options: -Wall
40 ghc-options: -Wall
@@ -51,12 +51,12 @@ test-suite example
51 , bytestring
51 , bytestring
52 , http-media
52 , http-media
53 , servant
53 , servant
54− , pipes
54+ , pipes
55 , pipes-safe
55 , pipes-safe
56 , servant-pipes
56 , servant-pipes
57 , pipes-bytestring >=2.1.6 && <2.2
57 , pipes-bytestring >=2.1.6 && <2.2
58− , servant-server >=0.15 && <0.20
58+ , servant-server >=0.15 && <0.19
59− , servant-client >=0.15 && <0.20
59+ , servant-client >=0.15 && <0.19
60 , wai >=3.2.1.2 && <3.3
60 , wai >=3.2.1.2 && <3.3
61 , warp >=3.2.25 && <3.4
61 , warp >=3.2.25 && <3.4
62 , http-client
62 , http-client
servant-server/CHANGELOG.md−24
@@ -1,30 +1,6 @@
1[The latest version of this document is on GitHub.](https://github.com/haskell-servant/servant/blob/master/servant-server/CHANGELOG.md)
1[The latest version of this document is on GitHub.](https://github.com/haskell-servant/servant/blob/master/servant-server/CHANGELOG.md)
2[Changelog for `servant` package contains significant entries for all core packages.](https://github.com/haskell-servant/servant/blob/master/servant/CHANGELOG.md)
2[Changelog for `servant` package contains significant entries for all core packages.](https://github.com/haskell-servant/servant/blob/master/servant/CHANGELOG.md)
3
3
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−
280.18.3
40.18.3
29------
5------
30
6
servant-server/example/greet.hs+1
@@ -18,6 +18,7 @@ import Network.Wai.Handler.Warp
18
18
19import Servant
19import Servant
20import Servant.Server.Generic ()
20import Servant.Server.Generic ()
21+import Servant.API.Generic
21
22
22-- * Example
23-- * Example
23
24
servant-server/servant-server.cabal+10−10
@@ -1,6 +1,6 @@
1−cabal-version: 2.2
1+cabal-version: >=1.10
2name: servant-server
2name: servant-server
3−version: 0.19.1
3+version: 0.18.3
4
4
5synopsis: A family of combinators for defining webservices APIs and serving them
5synopsis: A family of combinators for defining webservices APIs and serving them
6category: Servant, Web
6category: Servant, Web
@@ -60,25 +60,25 @@ library
60 -- Bundled with GHC: Lower bound to not force re-installs
60 -- Bundled with GHC: Lower bound to not force re-installs
61 -- text and mtl are bundled starting with GHC-8.4
61 -- text and mtl are bundled starting with GHC-8.4
62 build-depends:
62 build-depends:
63− base >= 4.9 && < 4.17
63+ base >= 4.9 && < 4.16
64 , bytestring >= 0.10.8.1 && < 0.12
64 , bytestring >= 0.10.8.1 && < 0.12
65 , constraints >= 0.2 && < 0.14
65 , constraints >= 0.2 && < 0.14
66 , containers >= 0.5.7.1 && < 0.7
66 , containers >= 0.5.7.1 && < 0.7
67 , mtl >= 2.2.2 && < 2.3
67 , mtl >= 2.2.2 && < 2.3
68− , text >= 1.2.3.0 && < 2.1
68+ , text >= 1.2.3.0 && < 1.3
69 , transformers >= 0.5.2.0 && < 0.6
69 , transformers >= 0.5.2.0 && < 0.6
70 , filepath >= 1.4.1.1 && < 1.5
70 , filepath >= 1.4.1.1 && < 1.5
71
71
72 -- Servant dependencies
72 -- Servant dependencies
73 -- strict dependency as we re-export 'servant' things.
73 -- strict dependency as we re-export 'servant' things.
74 build-depends:
74 build-depends:
75− servant >= 0.19 && < 0.20
75+ servant >= 0.18.3 && < 0.18.4
76 , http-api-data >= 0.4.1 && < 0.4.4
76 , http-api-data >= 0.4.1 && < 0.4.4
77
77
78 -- Other dependencies: Lower bound around what is in the latest Stackage LTS.
78 -- Other dependencies: Lower bound around what is in the latest Stackage LTS.
79 -- Here can be exceptions if we really need features from the newer versions.
79 -- Here can be exceptions if we really need features from the newer versions.
80 build-depends:
80 build-depends:
81− base-compat >= 0.10.5 && < 0.13
81+ base-compat >= 0.10.5 && < 0.12
82 , base64-bytestring >= 1.0.0.1 && < 1.3
82 , base64-bytestring >= 1.0.0.1 && < 1.3
83 , exceptions >= 0.10.0 && < 0.11
83 , exceptions >= 0.10.0 && < 0.11
84 , http-media >= 0.7.1.3 && < 0.9
84 , http-media >= 0.7.1.3 && < 0.9
@@ -114,7 +114,7 @@ executable greet
114 , text
114 , text
115
115
116 build-depends:
116 build-depends:
117− aeson >= 1.4.1.0 && < 3
117+ aeson >= 2.0.1.0 && < 3
118 , warp >= 3.2.25 && < 3.4
118 , warp >= 3.2.25 && < 3.4
119
119
120test-suite spec
120test-suite spec
@@ -157,9 +157,9 @@ test-suite spec
157
157
158 -- Additional dependencies
158 -- Additional dependencies
159 build-depends:
159 build-depends:
160− aeson >= 1.4.1.0 && < 3
160+ aeson >= 2.0.1.0 && < 3
161 , directory >= 1.3.0.0 && < 1.4
161 , directory >= 1.3.0.0 && < 1.4
162− , hspec >= 2.6.0 && < 2.10
162+ , hspec >= 2.6.0 && < 2.9
163 , hspec-wai >= 0.10.1 && < 0.12
163 , hspec-wai >= 0.10.1 && < 0.12
164 , QuickCheck >= 2.12.6.1 && < 2.15
164 , QuickCheck >= 2.12.6.1 && < 2.15
165 , should-not-typecheck >= 2.1.0 && < 2.2
165 , should-not-typecheck >= 2.1.0 && < 2.2
@@ -167,4 +167,4 @@ test-suite spec
167 , wai-extra >= 3.0.24.3 && < 3.2
167 , wai-extra >= 3.0.24.3 && < 3.2
168
168
169 build-tool-depends:
169 build-tool-depends:
170− hspec-discover:hspec-discover >= 2.6.0 && <2.10
170+ hspec-discover:hspec-discover >= 2.6.0 && <2.9
servant-server/src/Servant/Server.hs+2−3
@@ -235,7 +235,7 @@ hoistServer p = hoistServerWithContext p (Proxy :: Proxy '[])
235-- > │ └─ e/
235-- > │ └─ e/
236-- > │ └─•
236-- > │ └─•
237-- > ├─ b/
237-- > ├─ b/
238−-- > │ └─ <x::Int>/
238+-- > │ └─ <capture>/
239-- > │ ├─•
239-- > │ ├─•
240-- > │ ┆
240-- > │ ┆
241-- > │ └─•
241-- > │ └─•
@@ -252,8 +252,7 @@ hoistServer p = hoistServerWithContext p (Proxy :: Proxy '[])
252--
252--
253-- [@─•@] Leaves reflect endpoints.
253-- [@─•@] Leaves reflect endpoints.
254--
254--
255−-- [@\<x::Int\>/@] This is a delayed capture of a single
255+-- [@\<capture\>/@] This is a delayed capture of a path component.
256−-- path component named @x@, of expected type @Int@.
257--
256--
258-- [@\<raw\>@] This is a part of the API we do not know anything about.
257-- [@\<raw\>@] This is a part of the API we do not know anything about.
259--
258--
servant-server/src/Servant/Server/Internal.hs+43−34
@@ -41,7 +41,7 @@ import qualified Data.ByteString as B
41import qualified Data.ByteString.Builder as BB
41import qualified Data.ByteString.Builder as BB
42import qualified Data.ByteString.Char8 as BC8
42import qualified Data.ByteString.Char8 as BC8
43import qualified Data.ByteString.Lazy as BL
43import qualified Data.ByteString.Lazy as BL
44−import Data.Constraint (Constraint, Dict(..))
44+import Data.Constraint (Dict(..))
45import Data.Either
45import Data.Either
46 (partitionEithers)
46 (partitionEithers)
47import Data.Maybe
47import Data.Maybe
@@ -56,7 +56,7 @@ import qualified Data.Text as T
56import Data.Typeable
56import Data.Typeable
57import GHC.Generics
57import GHC.Generics
58import GHC.TypeLits
58import GHC.TypeLits
59− (KnownNat, KnownSymbol, TypeError, symbolVal)
59+ (KnownNat, KnownSymbol, natVal, symbolVal)
60import qualified Network.HTTP.Media as NHM
60import qualified Network.HTTP.Media as NHM
61import Network.HTTP.Types hiding
61import Network.HTTP.Types hiding
62 (Header, ResponseHeaders)
62 (Header, ResponseHeaders)
@@ -87,10 +87,7 @@ import Servant.API.Modifiers
87 unfoldRequestArgument)
87 unfoldRequestArgument)
88import Servant.API.ResponseHeaders
88import Servant.API.ResponseHeaders
89 (GetHeaders, Headers, getHeaders, getResponse)
89 (GetHeaders, Headers, getHeaders, getResponse)
90−import Servant.API.Status
91− (statusFromNat)
92import qualified Servant.Types.SourceT as S
90import qualified Servant.Types.SourceT as S
93−import Servant.API.TypeErrors
94import Web.HttpApiData
91import Web.HttpApiData
95 (FromHttpApiData, parseHeader, parseQueryParam, parseUrlPiece,
92 (FromHttpApiData, parseHeader, parseQueryParam, parseUrlPiece,
96 parseUrlPieces)
93 parseUrlPieces)
@@ -173,7 +170,7 @@ instance (HasServer a context, HasServer b context) => HasServer (a :<|> b) cont
173-- > server = getBook
170-- > server = getBook
174-- > where getBook :: Text -> Handler Book
171-- > where getBook :: Text -> Handler Book
175-- > getBook isbn = ...
172-- > getBook isbn = ...
176−instance (KnownSymbol capture, FromHttpApiData a, Typeable a
173+instance (KnownSymbol capture, FromHttpApiData a
177 , HasServer api context, SBoolI (FoldLenient mods)
174 , HasServer api context, SBoolI (FoldLenient mods)
178 , HasContextEntry (MkContextWithErrorFormatter context) ErrorFormatters
175 , HasContextEntry (MkContextWithErrorFormatter context) ErrorFormatters
179 )
176 )
@@ -185,7 +182,7 @@ instance (KnownSymbol capture, FromHttpApiData a, Typeable a
185 hoistServerWithContext _ pc nt s = hoistServerWithContext (Proxy :: Proxy api) pc nt . s
182 hoistServerWithContext _ pc nt s = hoistServerWithContext (Proxy :: Proxy api) pc nt . s
186
183
187 route Proxy context d =
184 route Proxy context d =
188− CaptureRouter [hint] $
185+ CaptureRouter $
189 route (Proxy :: Proxy api)
186 route (Proxy :: Proxy api)
190 context
187 context
191 (addCapture d $ \ txt -> withRequest $ \ request ->
188 (addCapture d $ \ txt -> withRequest $ \ request ->
@@ -197,7 +194,6 @@ instance (KnownSymbol capture, FromHttpApiData a, Typeable a
197 where
194 where
198 rep = typeRep (Proxy :: Proxy Capture')
195 rep = typeRep (Proxy :: Proxy Capture')
199 formatError = urlParseErrorFormatter $ getContextEntry (mkContextWithErrorFormatter context)
196 formatError = urlParseErrorFormatter $ getContextEntry (mkContextWithErrorFormatter context)
200− hint = CaptureHint (T.pack $ symbolVal $ Proxy @capture) (typeRep (Proxy :: Proxy a))
201
197
202-- | If you use 'CaptureAll' in one of the endpoints for your API,
198-- | If you use 'CaptureAll' in one of the endpoints for your API,
203-- this automatically requires your server-side handler to be a
199-- this automatically requires your server-side handler to be a
@@ -216,7 +212,7 @@ instance (KnownSymbol capture, FromHttpApiData a, Typeable a
216-- > server = getSourceFile
212-- > server = getSourceFile
217-- > where getSourceFile :: [Text] -> Handler Book
213-- > where getSourceFile :: [Text] -> Handler Book
218-- > getSourceFile pathSegments = ...
214-- > getSourceFile pathSegments = ...
219−instance (KnownSymbol capture, FromHttpApiData a, Typeable a
215+instance (KnownSymbol capture, FromHttpApiData a
220 , HasServer api context
216 , HasServer api context
221 , HasContextEntry (MkContextWithErrorFormatter context) ErrorFormatters
217 , HasContextEntry (MkContextWithErrorFormatter context) ErrorFormatters
222 )
218 )
@@ -228,7 +224,7 @@ instance (KnownSymbol capture, FromHttpApiData a, Typeable a
228 hoistServerWithContext _ pc nt s = hoistServerWithContext (Proxy :: Proxy api) pc nt . s
224 hoistServerWithContext _ pc nt s = hoistServerWithContext (Proxy :: Proxy api) pc nt . s
229
225
230 route Proxy context d =
226 route Proxy context d =
231− CaptureAllRouter [hint] $
227+ CaptureAllRouter $
232 route (Proxy :: Proxy api)
228 route (Proxy :: Proxy api)
233 context
229 context
234 (addCapture d $ \ txts -> withRequest $ \ request ->
230 (addCapture d $ \ txts -> withRequest $ \ request ->
@@ -239,7 +235,6 @@ instance (KnownSymbol capture, FromHttpApiData a, Typeable a
239 where
235 where
240 rep = typeRep (Proxy :: Proxy CaptureAll)
236 rep = typeRep (Proxy :: Proxy CaptureAll)
241 formatError = urlParseErrorFormatter $ getContextEntry (mkContextWithErrorFormatter context)
237 formatError = urlParseErrorFormatter $ getContextEntry (mkContextWithErrorFormatter context)
242− hint = CaptureHint (T.pack $ symbolVal $ Proxy @capture) (typeRep (Proxy :: Proxy [a]))
243
238
244allowedMethodHead :: Method -> Request -> Bool
239allowedMethodHead :: Method -> Request -> Bool
245allowedMethodHead method request = method == methodGet && requestMethod request == methodHead
240allowedMethodHead method request = method == methodGet && requestMethod request == methodHead
@@ -303,7 +298,7 @@ instance {-# OVERLAPPABLE #-}
303
298
304 route Proxy _ = methodRouter ([],) method (Proxy :: Proxy ctypes) status
299 route Proxy _ = methodRouter ([],) method (Proxy :: Proxy ctypes) status
305 where method = reflectMethod (Proxy :: Proxy method)
300 where method = reflectMethod (Proxy :: Proxy method)
306− status = statusFromNat (Proxy :: Proxy status)
301+ status = toEnum . fromInteger $ natVal (Proxy :: Proxy status)
307
302
308instance {-# OVERLAPPING #-}
303instance {-# OVERLAPPING #-}
309 ( AllCTRender ctypes a, ReflectMethod method, KnownNat status
304 ( AllCTRender ctypes a, ReflectMethod method, KnownNat status
@@ -315,7 +310,7 @@ instance {-# OVERLAPPING #-}
315
310
316 route Proxy _ = methodRouter (\x -> (getHeaders x, getResponse x)) method (Proxy :: Proxy ctypes) status
311 route Proxy _ = methodRouter (\x -> (getHeaders x, getResponse x)) method (Proxy :: Proxy ctypes) status
317 where method = reflectMethod (Proxy :: Proxy method)
312 where method = reflectMethod (Proxy :: Proxy method)
318− status = statusFromNat (Proxy :: Proxy status)
313+ status = toEnum . fromInteger $ natVal (Proxy :: Proxy status)
319
314
320instance (ReflectMethod method) =>
315instance (ReflectMethod method) =>
321 HasServer (NoContentVerb method) context where
316 HasServer (NoContentVerb method) context where
@@ -336,7 +331,7 @@ instance {-# OVERLAPPABLE #-}
336
331
337 route Proxy _ = streamRouter ([],) method status (Proxy :: Proxy framing) (Proxy :: Proxy ctype)
332 route Proxy _ = streamRouter ([],) method status (Proxy :: Proxy framing) (Proxy :: Proxy ctype)
338 where method = reflectMethod (Proxy :: Proxy method)
333 where method = reflectMethod (Proxy :: Proxy method)
339− status = statusFromNat (Proxy :: Proxy status)
334+ status = toEnum . fromInteger $ natVal (Proxy :: Proxy status)
340
335
341
336
342instance {-# OVERLAPPING #-}
337instance {-# OVERLAPPING #-}
@@ -350,7 +345,7 @@ instance {-# OVERLAPPING #-}
350
345
351 route Proxy _ = streamRouter (\x -> (getHeaders x, getResponse x)) method status (Proxy :: Proxy framing) (Proxy :: Proxy ctype)
346 route Proxy _ = streamRouter (\x -> (getHeaders x, getResponse x)) method status (Proxy :: Proxy framing) (Proxy :: Proxy ctype)
352 where method = reflectMethod (Proxy :: Proxy method)
347 where method = reflectMethod (Proxy :: Proxy method)
353− status = statusFromNat (Proxy :: Proxy status)
348+ status = toEnum . fromInteger $ natVal (Proxy :: Proxy status)
354
349
355
350
356streamRouter :: forall ctype a c chunk env framing. (MimeRender ctype chunk, FramingRender framing, ToSourceIO chunk a) =>
351streamRouter :: forall ctype a c chunk env framing. (MimeRender ctype chunk, FramingRender framing, ToSourceIO chunk a) =>
@@ -817,15 +812,38 @@ instance (HasContextEntry context (NamedContext name subContext), HasServer subA
817 hoistServerWithContext _ _ nt s = hoistServerWithContext (Proxy :: Proxy subApi) (Proxy :: Proxy subContext) nt s
812 hoistServerWithContext _ _ nt s = hoistServerWithContext (Proxy :: Proxy subApi) (Proxy :: Proxy subContext) nt s
818
813
819-------------------------------------------------------------------------------
814-------------------------------------------------------------------------------
820−-- Custom type errors
815+-- TypeError helpers
821-------------------------------------------------------------------------------
816-------------------------------------------------------------------------------
822
817
823−-- Erroring instance for 'HasServer' when a combinator is not fully applied
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+--
824−instance TypeError (PartialApplication HasServer arr) => HasServer ((arr :: a -> b) :> sub) context
835+instance TypeError (HasServerArrowKindError arr) => HasServer ((arr :: k -> l) :> api) context
825 where
836 where
826− type ServerT (arr :> sub) _ = TypeError (PartialApplication (HasServer :: * -> [*] -> Constraint) arr)
837+ type ServerT (arr :> api) m = TypeError (HasServerArrowKindError arr)
827− route = error "unreachable"
838+ -- it doesn't really matter what sub route we peak
839+ route _ _ _ = error "servant-server panic: impossible happened in HasServer (arr :> api)"
828− hoistServerWithContext _ _ _ _ = error "unreachable"
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
829
847
830-- | This instance prevents from accidentally using '->' instead of ':>'
848-- | This instance prevents from accidentally using '->' instead of ':>'
831--
849--
@@ -860,15 +878,6 @@ type HasServerArrowTypeError a b =
860 ':$$: 'Text "and"
878 ':$$: 'Text "and"
861 ':$$: 'ShowType b
879 ':$$: 'ShowType b
862
880
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−
872-- | Ignore @'Fragment'@ in server handlers.
881-- | Ignore @'Fragment'@ in server handlers.
873-- See <https://ietf.org/rfc/rfc2616.html#section-15.1.3> for more details.
882-- See <https://ietf.org/rfc/rfc2616.html#section-15.1.3> for more details.
874--
883--
@@ -919,13 +928,13 @@ type GServerConstraints api m =
919-- is provided in this module for all record APIs.
928-- is provided in this module for all record APIs.
920
929
921class GServer (api :: * -> *) (m :: * -> *) where
930class GServer (api :: * -> *) (m :: * -> *) where
922− gServerProof :: Dict (GServerConstraints api m)
931+ proof :: Dict (GServerConstraints api m)
923
932
924instance
933instance
925 ( ToServant api (AsServerT m) ~ ServerT (ToServantApi api) m
934 ( ToServant api (AsServerT m) ~ ServerT (ToServantApi api) m
926 , GServantProduct (Rep (api (AsServerT m)))
935 , GServantProduct (Rep (api (AsServerT m)))
927 ) => GServer api m where
936 ) => GServer api m where
928− gServerProof = Dict
937+ proof = Dict
929
938
930instance
939instance
931 ( HasServer (ToServantApi api) context
940 ( HasServer (ToServantApi api) context
@@ -941,7 +950,7 @@ instance
941 -> Delayed env (api (AsServerT Handler))
950 -> Delayed env (api (AsServerT Handler))
942 -> Router env
951 -> Router env
943 route _ ctx delayed =
952 route _ ctx delayed =
944− case gServerProof @api @Handler of
953+ case proof @api @Handler of
945 Dict -> route (Proxy @(ToServantApi api)) ctx (toServant <$> delayed)
954 Dict -> route (Proxy @(ToServantApi api)) ctx (toServant <$> delayed)
946
955
947 hoistServerWithContext
956 hoistServerWithContext
@@ -951,7 +960,7 @@ instance
951 -> api (AsServerT m)
960 -> api (AsServerT m)
952 -> api (AsServerT n)
961 -> api (AsServerT n)
953 hoistServerWithContext _ pctx nat server =
962 hoistServerWithContext _ pctx nat server =
954− case (gServerProof @api @m, gServerProof @api @n) of
963+ case (proof @api @m, proof @api @n) of
955 (Dict, Dict) ->
964 (Dict, Dict) ->
956 fromServant servantSrvN
965 fromServant servantSrvN
957 where
966 where
servant-server/src/Servant/Server/Internal/Handler.hs+2−7
@@ -13,19 +13,17 @@ import Control.Monad.Base
13import Control.Monad.Catch
13import Control.Monad.Catch
14 (MonadCatch, MonadMask, MonadThrow)
14 (MonadCatch, MonadMask, MonadThrow)
15import Control.Monad.Error.Class
15import Control.Monad.Error.Class
16− (MonadError, throwError)
16+ (MonadError)
17import Control.Monad.IO.Class
17import Control.Monad.IO.Class
18 (MonadIO)
18 (MonadIO)
19import Control.Monad.Trans.Control
19import Control.Monad.Trans.Control
20 (MonadBaseControl (..))
20 (MonadBaseControl (..))
21import Control.Monad.Trans.Except
21import Control.Monad.Trans.Except
22 (ExceptT, runExceptT)
22 (ExceptT, runExceptT)
23−import Data.String
24− (fromString)
25import GHC.Generics
23import GHC.Generics
26 (Generic)
24 (Generic)
27import Servant.Server.Internal.ServerError
25import Servant.Server.Internal.ServerError
28− (ServerError, errBody, err500)
26+ (ServerError)
29
27
30newtype Handler a = Handler { runHandler' :: ExceptT ServerError IO a }
28newtype Handler a = Handler { runHandler' :: ExceptT ServerError IO a }
31 deriving
29 deriving
@@ -34,9 +32,6 @@ newtype Handler a = Handler { runHandler' :: ExceptT ServerError IO a }
34 , MonadThrow, MonadCatch, MonadMask
32 , MonadThrow, MonadCatch, MonadMask
35 )
33 )
36
34
37−instance MonadFail Handler where
38− fail str = throwError err500 { errBody = fromString str }
39−
40instance MonadBase IO Handler where
35instance MonadBase IO Handler where
41 liftBase = Handler . liftBase
36 liftBase = Handler . liftBase
42
37
servant-server/src/Servant/Server/Internal/Router.hs+14−31
@@ -9,16 +9,12 @@ import Prelude.Compat
9
9
10import Data.Function
10import Data.Function
11 (on)
11 (on)
12−import Data.List
13− (nub)
14import Data.Map
12import Data.Map
15 (Map)
13 (Map)
16import qualified Data.Map as M
14import qualified Data.Map as M
17import Data.Text
15import Data.Text
18 (Text)
16 (Text)
19import qualified Data.Text as T
17import qualified Data.Text as T
20−import Data.Typeable
21− (TypeRep)
22import Network.Wai
18import Network.Wai
23 (Response, pathInfo)
19 (Response, pathInfo)
24import Servant.Server.Internal.ErrorFormatter
20import Servant.Server.Internal.ErrorFormatter
@@ -28,18 +24,6 @@ import Servant.Server.Internal.ServerError
28
24
29type Router env = Router' env RoutingApplication
25type Router env = Router' env RoutingApplication
30
26
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−
43-- | Internal representation of a router.
27-- | Internal representation of a router.
44--
28--
45-- The first argument describes an environment type that is
29-- The first argument describes an environment type that is
@@ -52,10 +36,10 @@ data Router' env a =
52 -- ^ the map contains routers for subpaths (first path component used
36 -- ^ the map contains routers for subpaths (first path component used
53 -- for lookup and removed afterwards), the list contains handlers
37 -- for lookup and removed afterwards), the list contains handlers
54 -- for the empty path, to be tried in order
38 -- for the empty path, to be tried in order
55− | CaptureRouter [CaptureHint] (Router' (Text, env) a)
39+ | CaptureRouter (Router' (Text, env) a)
56 -- ^ first path component is passed to the child router in its
40 -- ^ first path component is passed to the child router in its
57 -- environment and removed afterwards
41 -- environment and removed afterwards
58− | CaptureAllRouter [CaptureHint] (Router' ([Text], env) a)
42+ | CaptureAllRouter (Router' ([Text], env) a)
59 -- ^ all path components are passed to the child router in its
43 -- ^ all path components are passed to the child router in its
60 -- environment and are removed afterwards
44 -- environment and are removed afterwards
61 | RawRouter (env -> a)
45 | RawRouter (env -> a)
@@ -85,8 +69,8 @@ leafRouter l = StaticRouter M.empty [l]
85choice :: Router' env a -> Router' env a -> Router' env a
69choice :: Router' env a -> Router' env a -> Router' env a
86choice (StaticRouter table1 ls1) (StaticRouter table2 ls2) =
70choice (StaticRouter table1 ls1) (StaticRouter table2 ls2) =
87 StaticRouter (M.unionWith choice table1 table2) (ls1 ++ ls2)
71 StaticRouter (M.unionWith choice table1 table2) (ls1 ++ ls2)
88−choice (CaptureRouter hints1 router1) (CaptureRouter hints2 router2) =
72+choice (CaptureRouter router1) (CaptureRouter router2) =
89− CaptureRouter (nub $ hints1 ++ hints2) (choice router1 router2)
73+ CaptureRouter (choice router1 router2)
90choice router1 (Choice router2 router3) = Choice (choice router1 router2) router3
74choice router1 (Choice router2 router3) = Choice (choice router1 router2) router3
91choice router1 router2 = Choice router1 router2
75choice router1 router2 = Choice router1 router2
92
76
@@ -100,7 +84,7 @@ choice router1 router2 = Choice router1 router2
100--
84--
101data RouterStructure =
85data RouterStructure =
102 StaticRouterStructure (Map Text RouterStructure) Int
86 StaticRouterStructure (Map Text RouterStructure) Int
103− | CaptureRouterStructure [CaptureHint] RouterStructure
87+ | CaptureRouterStructure RouterStructure
104 | RawRouterStructure
88 | RawRouterStructure
105 | ChoiceStructure RouterStructure RouterStructure
89 | ChoiceStructure RouterStructure RouterStructure
106 deriving (Eq, Show)
90 deriving (Eq, Show)
@@ -114,11 +98,11 @@ data RouterStructure =
114routerStructure :: Router' env a -> RouterStructure
98routerStructure :: Router' env a -> RouterStructure
115routerStructure (StaticRouter m ls) =
99routerStructure (StaticRouter m ls) =
116 StaticRouterStructure (fmap routerStructure m) (length ls)
100 StaticRouterStructure (fmap routerStructure m) (length ls)
117−routerStructure (CaptureRouter hints router) =
101+routerStructure (CaptureRouter router) =
118− CaptureRouterStructure hints $
102+ CaptureRouterStructure $
119 routerStructure router
103 routerStructure router
120−routerStructure (CaptureAllRouter hints router) =
104+routerStructure (CaptureAllRouter router) =
121− CaptureRouterStructure hints $
105+ CaptureRouterStructure $
122 routerStructure router
106 routerStructure router
123routerStructure (RawRouter _) =
107routerStructure (RawRouter _) =
124 RawRouterStructure
108 RawRouterStructure
@@ -130,8 +114,8 @@ routerStructure (Choice r1 r2) =
130-- | Compare the structure of two routers.
114-- | Compare the structure of two routers.
131--
115--
132sameStructure :: Router' env a -> Router' env b -> Bool
116sameStructure :: Router' env a -> Router' env b -> Bool
133−sameStructure router1 router2 =
117+sameStructure r1 r2 =
134− routerStructure router1 == routerStructure router2
118+ routerStructure r1 == routerStructure r2
135
119
136-- | Provide a textual representation of the
120-- | Provide a textual representation of the
137-- structure of a router.
121-- structure of a router.
@@ -142,8 +126,7 @@ routerLayout router =
142 where
126 where
143 mkRouterLayout :: Bool -> RouterStructure -> [Text]
127 mkRouterLayout :: Bool -> RouterStructure -> [Text]
144 mkRouterLayout c (StaticRouterStructure m n) = mkSubTrees c (M.toList m) n
128 mkRouterLayout c (StaticRouterStructure m n) = mkSubTrees c (M.toList m) n
145− mkRouterLayout c (CaptureRouterStructure hints r) =
129+ mkRouterLayout c (CaptureRouterStructure r) = mkSubTree c "<capture>" (mkRouterLayout False r)
146− mkSubTree c (toCaptureTags hints) (mkRouterLayout False r)
147 mkRouterLayout c RawRouterStructure =
130 mkRouterLayout c RawRouterStructure =
148 if c then ["├─ <raw>"] else ["└─ <raw>"]
131 if c then ["├─ <raw>"] else ["└─ <raw>"]
149 mkRouterLayout c (ChoiceStructure r1 r2) =
132 mkRouterLayout c (ChoiceStructure r1 r2) =
@@ -186,7 +169,7 @@ runRouterEnv fmt router env request respond =
186 -> let request' = request { pathInfo = rest }
169 -> let request' = request { pathInfo = rest }
187 in runRouterEnv fmt router' env request' respond
170 in runRouterEnv fmt router' env request' respond
188 _ -> respond $ Fail $ fmt request
171 _ -> respond $ Fail $ fmt request
189− CaptureRouter _ router' ->
172+ CaptureRouter router' ->
190 case pathInfo request of
173 case pathInfo request of
191 [] -> respond $ Fail $ fmt request
174 [] -> respond $ Fail $ fmt request
192 -- This case is to handle trailing slashes.
175 -- This case is to handle trailing slashes.
@@ -194,7 +177,7 @@ runRouterEnv fmt router env request respond =
194 first : rest
177 first : rest
195 -> let request' = request { pathInfo = rest }
178 -> let request' = request { pathInfo = rest }
196 in runRouterEnv fmt router' (first, env) request' respond
179 in runRouterEnv fmt router' (first, env) request' respond
197− CaptureAllRouter _ router' ->
180+ CaptureAllRouter router' ->
198 let segments = pathInfo request
181 let segments = pathInfo request
199 request' = request { pathInfo = [] }
182 request' = request { pathInfo = [] }
200 in runRouterEnv fmt router' (segments, env) request' respond
183 in runRouterEnv fmt router' (segments, env) request' respond
servant-server/test/Servant/Server/RouterSpec.hs+6−127
@@ -9,9 +9,7 @@ import Control.Monad
9import Data.Proxy
9import Data.Proxy
10 (Proxy (..))
10 (Proxy (..))
11import Data.Text
11import Data.Text
12− (Text, unpack)
12+ (unpack)
13−import Data.Typeable
14− (typeRep)
15import Network.HTTP.Types
13import Network.HTTP.Types
16 (Status (..))
14 (Status (..))
17import Network.Wai
15import Network.Wai
@@ -29,7 +27,6 @@ spec :: Spec
29spec = describe "Servant.Server.Internal.Router" $ do
27spec = describe "Servant.Server.Internal.Router" $ do
30 routerSpec
28 routerSpec
31 distributivitySpec
29 distributivitySpec
32− serverLayoutSpec
33
30
34routerSpec :: Spec
31routerSpec :: Spec
35routerSpec = do
32routerSpec = do
@@ -54,7 +51,7 @@ routerSpec = do
54 toApp = toApplication . runRouter (const err404)
51 toApp = toApplication . runRouter (const err404)
55
52
56 cap :: Router ()
53 cap :: Router ()
57− cap = CaptureRouter [hint] $
54+ cap = CaptureRouter $
58 let delayed = addCapture (emptyDelayed $ Route pure) (const $ delayedFail err400)
55 let delayed = addCapture (emptyDelayed $ Route pure) (const $ delayedFail err400)
59 in leafRouter
56 in leafRouter
60 $ \env req res ->
57 $ \env req res ->
@@ -62,9 +59,6 @@ routerSpec = do
62 . const
59 . const
63 $ Route success
60 $ Route success
64
61
65− hint :: CaptureHint
66− hint = CaptureHint "anything" $ typeRep (Proxy :: Proxy ())
67−
68 router :: Router ()
62 router :: Router ()
69 router = leafRouter (\_ _ res -> res $ Route success)
63 router = leafRouter (\_ _ res -> res $ Route success)
70 `Choice` cap
64 `Choice` cap
@@ -104,30 +98,12 @@ distributivitySpec =
104 it "properly handles mixing static paths at different levels" $ do
98 it "properly handles mixing static paths at different levels" $ do
105 level `shouldHaveSameStructureAs` levelRef
99 level `shouldHaveSameStructureAs` levelRef
106
100
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−
119shouldHaveSameStructureAs ::
101shouldHaveSameStructureAs ::
120 (HasServer api1 '[], HasServer api2 '[]) => Proxy api1 -> Proxy api2 -> Expectation
102 (HasServer api1 '[], HasServer api2 '[]) => Proxy api1 -> Proxy api2 -> Expectation
121shouldHaveSameStructureAs p1 p2 =
103shouldHaveSameStructureAs p1 p2 =
122 unless (sameStructure (makeTrivialRouter p1) (makeTrivialRouter p2)) $
104 unless (sameStructure (makeTrivialRouter p1) (makeTrivialRouter p2)) $
123 expectationFailure ("expected:\n" ++ unpack (layout p2) ++ "\nbut got:\n" ++ unpack (layout p1))
105 expectationFailure ("expected:\n" ++ unpack (layout p2) ++ "\nbut got:\n" ++ unpack (layout p1))
124
106
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−
131makeTrivialRouter :: (HasServer layout '[]) => Proxy layout -> Router ()
107makeTrivialRouter :: (HasServer layout '[]) => Proxy layout -> Router ()
132makeTrivialRouter p =
108makeTrivialRouter p =
133 route p EmptyContext (emptyDelayed (FailFatal err501))
109 route p EmptyContext (emptyDelayed (FailFatal err501))
@@ -168,12 +144,12 @@ staticRef = Proxy
168-- structure:
144-- structure:
169
145
170type Dynamic =
146type Dynamic =
171− "a" :> Capture "foo" Int :> "b" :> End
147+ "a" :> Capture "foo" Int :> "b" :> End
172− :<|> "a" :> Capture "foo" Int :> "c" :> End
148+ :<|> "a" :> Capture "bar" Bool :> "c" :> End
173− :<|> "a" :> Capture "foo" Int :> "d" :> End
149+ :<|> "a" :> Capture "baz" Char :> "d" :> End
174
150
175type DynamicRef =
151type DynamicRef =
176− "a" :> Capture "foo" Int :>
152+ "a" :> Capture "anything" () :>
177 ("b" :> End :<|> "c" :> End :<|> "d" :> End)
153 ("b" :> End :<|> "c" :> End :<|> "d" :> End)
178
154
179dynamic :: Proxy Dynamic
155dynamic :: Proxy Dynamic
@@ -363,100 +339,3 @@ level = Proxy
363
339
364levelRef :: Proxy LevelRef
340levelRef :: Proxy LevelRef
365levelRef = Proxy
341levelRef = 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/.travis.ymlnew file+167
@@ -0,0 +1,167 @@
1+# This Travis job script has been generated by a script via
2+#
3+# haskell-ci '--config=cabal.haskell-ci' 'cabal.project'
4+#
5+# To regenerate the script (for example after adjusting tested-with) run
6+#
7+# haskell-ci regenerate
8+#
9+# For more information, see https://github.com/haskell-CI/haskell-ci
10+#
11+# version: 0.10.3
12+#
13+version: ~> 1.0
14+language: c
15+os: linux
16+dist: xenial
17+git:
18+ # whether to recursively clone submodules
19+ submodules: false
20+branches:
21+ only:
22+ - master
23+cache:
24+ directories:
25+ - $HOME/.cabal/packages
26+ - $HOME/.cabal/store
27+ - $HOME/.hlint
28+before_cache:
29+ - rm -fv $CABALHOME/packages/hackage.haskell.org/build-reports.log
30+ # remove files that are regenerated by 'cabal update'
31+ - rm -fv $CABALHOME/packages/hackage.haskell.org/00-index.*
32+ - rm -fv $CABALHOME/packages/hackage.haskell.org/*.json
33+ - rm -fv $CABALHOME/packages/hackage.haskell.org/01-index.cache
34+ - rm -fv $CABALHOME/packages/hackage.haskell.org/01-index.tar
35+ - rm -fv $CABALHOME/packages/hackage.haskell.org/01-index.tar.idx
36+ - rm -rfv $CABALHOME/packages/head.hackage
37+jobs:
38+ include:
39+ - compiler: ghc-8.10.2
40+ addons: {"apt":{"sources":[{"sourceline":"deb http://ppa.launchpad.net/hvr/ghc/ubuntu xenial main","key_url":"https://keyserver.ubuntu.com/pks/lookup?op=get&search=0x063dab2bdc0b3f9fcebc378bff3aeacef6f88286"}],"packages":["ghc-8.10.2","cabal-install-3.2"]}}
41+ os: linux
42+ - compiler: ghc-8.8.4
43+ addons: {"apt":{"sources":[{"sourceline":"deb http://ppa.launchpad.net/hvr/ghc/ubuntu xenial main","key_url":"https://keyserver.ubuntu.com/pks/lookup?op=get&search=0x063dab2bdc0b3f9fcebc378bff3aeacef6f88286"}],"packages":["ghc-8.8.4","cabal-install-3.2"]}}
44+ os: linux
45+ - compiler: ghc-8.6.5
46+ addons: {"apt":{"sources":[{"sourceline":"deb http://ppa.launchpad.net/hvr/ghc/ubuntu xenial main","key_url":"https://keyserver.ubuntu.com/pks/lookup?op=get&search=0x063dab2bdc0b3f9fcebc378bff3aeacef6f88286"}],"packages":["ghc-8.6.5","cabal-install-3.2"]}}
47+ os: linux
48+ - compiler: ghc-8.4.4
49+ addons: {"apt":{"sources":[{"sourceline":"deb http://ppa.launchpad.net/hvr/ghc/ubuntu xenial main","key_url":"https://keyserver.ubuntu.com/pks/lookup?op=get&search=0x063dab2bdc0b3f9fcebc378bff3aeacef6f88286"}],"packages":["ghc-8.4.4","cabal-install-3.2"]}}
50+ os: linux
51+ - compiler: ghc-8.2.2
52+ addons: {"apt":{"sources":[{"sourceline":"deb http://ppa.launchpad.net/hvr/ghc/ubuntu xenial main","key_url":"https://keyserver.ubuntu.com/pks/lookup?op=get&search=0x063dab2bdc0b3f9fcebc378bff3aeacef6f88286"}],"packages":["ghc-8.2.2","cabal-install-3.2"]}}
53+ os: linux
54+ - compiler: ghc-8.0.2
55+ addons: {"apt":{"sources":[{"sourceline":"deb http://ppa.launchpad.net/hvr/ghc/ubuntu xenial main","key_url":"https://keyserver.ubuntu.com/pks/lookup?op=get&search=0x063dab2bdc0b3f9fcebc378bff3aeacef6f88286"}],"packages":["ghc-8.0.2","cabal-install-3.2"]}}
56+ os: linux
57+before_install:
58+ - HC=$(echo "/opt/$CC/bin/ghc" | sed 's/-/\//')
59+ - WITHCOMPILER="-w $HC"
60+ - HADDOCK=$(echo "/opt/$CC/bin/haddock" | sed 's/-/\//')
61+ - HCPKG="$HC-pkg"
62+ - unset CC
63+ - CABAL=/opt/ghc/bin/cabal
64+ - CABALHOME=$HOME/.cabal
65+ - export PATH="$CABALHOME/bin:$PATH"
66+ - TOP=$(pwd)
67+ - "HCNUMVER=$(${HC} --numeric-version|perl -ne '/^(\\d+)\\.(\\d+)\\.(\\d+)(\\.(\\d+))?$/; print(10000 * $1 + 100 * $2 + ($3 == 0 ? $5 != 1 : $3))')"
68+ - echo $HCNUMVER
69+ - CABAL="$CABAL -vnormal+nowrap"
70+ - set -o pipefail
71+ - TEST=--enable-tests
72+ - BENCH=--enable-benchmarks
73+ - HEADHACKAGE=false
74+ - rm -f $CABALHOME/config
75+ - |
76+ echo "verbose: normal +nowrap +markoutput" >> $CABALHOME/config
77+ echo "remote-build-reporting: anonymous" >> $CABALHOME/config
78+ echo "write-ghc-environment-files: always" >> $CABALHOME/config
79+ echo "remote-repo-cache: $CABALHOME/packages" >> $CABALHOME/config
80+ echo "logs-dir: $CABALHOME/logs" >> $CABALHOME/config
81+ echo "world-file: $CABALHOME/world" >> $CABALHOME/config
82+ echo "extra-prog-path: $CABALHOME/bin" >> $CABALHOME/config
83+ echo "symlink-bindir: $CABALHOME/bin" >> $CABALHOME/config
84+ echo "installdir: $CABALHOME/bin" >> $CABALHOME/config
85+ echo "build-summary: $CABALHOME/logs/build.log" >> $CABALHOME/config
86+ echo "store-dir: $CABALHOME/store" >> $CABALHOME/config
87+ echo "install-dirs user" >> $CABALHOME/config
88+ echo " prefix: $CABALHOME" >> $CABALHOME/config
89+ echo "repository hackage.haskell.org" >> $CABALHOME/config
90+ echo " url: http://hackage.haskell.org/" >> $CABALHOME/config
91+install:
92+ - ${CABAL} --version
93+ - echo "$(${HC} --version) [$(${HC} --print-project-git-commit-id 2> /dev/null || echo '?')]"
94+ - |
95+ echo "program-default-options" >> $CABALHOME/config
96+ echo " ghc-options: $GHCJOBS +RTS -M6G -RTS" >> $CABALHOME/config
97+ - cat $CABALHOME/config
98+ - rm -fv cabal.project cabal.project.local cabal.project.freeze
99+ - travis_retry ${CABAL} v2-update -v
100+ # Generate cabal.project
101+ - rm -rf cabal.project cabal.project.local cabal.project.freeze
102+ - touch cabal.project
103+ - |
104+ echo "packages: ." >> cabal.project
105+ - if [ $HCNUMVER -ge 80200 ] ; then echo 'package servant-swagger' >> cabal.project ; fi
106+ - "if [ $HCNUMVER -ge 80200 ] ; then echo ' ghc-options: -Werror=missing-methods' >> cabal.project ; fi"
107+ - |
108+ echo "allow-newer: aeson-pretty-0.8.7:base-compat" >> cabal.project
109+ - "for pkg in $($HCPKG list --simple-output); do echo $pkg | sed 's/-[^-]*$//' | (grep -vE -- '^(servant-swagger)$' || true) | sed 's/^/constraints: /' | sed 's/$/ installed/' >> cabal.project.local; done"
110+ - cat cabal.project || true
111+ - cat cabal.project.local || true
112+ - if [ -f "./configure.ac" ]; then (cd "." && autoreconf -i); fi
113+ - ${CABAL} v2-freeze $WITHCOMPILER ${TEST} ${BENCH}
114+ - "cat cabal.project.freeze | sed -E 's/^(constraints: *| *)//' | sed 's/any.//'"
115+ - rm cabal.project.freeze
116+ - travis_wait 40 ${CABAL} v2-build $WITHCOMPILER ${TEST} ${BENCH} --dep -j2 all
117+ - travis_wait 40 ${CABAL} v2-build $WITHCOMPILER --disable-tests --disable-benchmarks --dep -j2 all
118+script:
119+ - DISTDIR=$(mktemp -d /tmp/dist-test.XXXX)
120+ # Packaging...
121+ - ${CABAL} v2-sdist all
122+ # Unpacking...
123+ - mv dist-newstyle/sdist/*.tar.gz ${DISTDIR}/
124+ - cd ${DISTDIR} || false
125+ - find . -maxdepth 1 -type f -name '*.tar.gz' -exec tar -xvf '{}' \;
126+ - find . -maxdepth 1 -type f -name '*.tar.gz' -exec rm '{}' \;
127+ - PKGDIR_servant_swagger="$(find . -maxdepth 1 -type d -regex '.*/servant-swagger-[0-9.]*')"
128+ # Generate cabal.project
129+ - rm -rf cabal.project cabal.project.local cabal.project.freeze
130+ - touch cabal.project
131+ - |
132+ echo "packages: ${PKGDIR_servant_swagger}" >> cabal.project
133+ - if [ $HCNUMVER -ge 80200 ] ; then echo 'package servant-swagger' >> cabal.project ; fi
134+ - "if [ $HCNUMVER -ge 80200 ] ; then echo ' ghc-options: -Werror=missing-methods' >> cabal.project ; fi"
135+ - |
136+ echo "allow-newer: aeson-pretty-0.8.7:base-compat" >> cabal.project
137+ - "for pkg in $($HCPKG list --simple-output); do echo $pkg | sed 's/-[^-]*$//' | (grep -vE -- '^(servant-swagger)$' || true) | sed 's/^/constraints: /' | sed 's/$/ installed/' >> cabal.project.local; done"
138+ - cat cabal.project || true
139+ - cat cabal.project.local || true
140+ # Building...
141+ # this builds all libraries and executables (without tests/benchmarks)
142+ - ${CABAL} v2-build $WITHCOMPILER --disable-tests --disable-benchmarks all
143+ # Building with tests and benchmarks...
144+ # build & run tests, build benchmarks
145+ - ${CABAL} v2-build $WITHCOMPILER ${TEST} ${BENCH} all
146+ # Testing...
147+ - ${CABAL} v2-test $WITHCOMPILER ${TEST} ${BENCH} all
148+ # cabal check...
149+ - (cd ${PKGDIR_servant_swagger} && ${CABAL} -vnormal check)
150+ # haddock...
151+ - ${CABAL} v2-haddock $WITHCOMPILER --with-haddock $HADDOCK ${TEST} ${BENCH} all
152+ # Building without installed constraints for packages in global-db...
153+ - rm -f cabal.project.local
154+ - ${CABAL} v2-build $WITHCOMPILER --disable-tests --disable-benchmarks all
155+ # Constraint sets
156+ - rm -rf cabal.project.local
157+ # Constraint set swagger2-2.3
158+ - if [ $HCNUMVER -lt 80800 ] ; then ${CABAL} v2-build $WITHCOMPILER --disable-tests --disable-benchmarks --constraint='swagger2 ==2.3.*' all ; fi
159+ # Constraint set swagger2-2.4
160+ - ${CABAL} v2-build $WITHCOMPILER --disable-tests --disable-benchmarks --constraint='swagger2 ==2.4.*' all
161+ # Constraint set swagger2-2.5
162+ - ${CABAL} v2-build $WITHCOMPILER --disable-tests --disable-benchmarks --constraint='swagger2 ==2.5.*' all
163+ # Constraint set servant-0.18.1
164+ - ${CABAL} v2-build $WITHCOMPILER --disable-tests --disable-benchmarks --constraint='servant == 0.18.1' all
165+
166+# REGENDATA ("0.10.3",["--config=cabal.haskell-ci","cabal.project"])
167+# EOF
servant-swagger/README.md+3−2
@@ -1,5 +1,6 @@
1# servant-swagger
1# servant-swagger
2
2
3+[![Build Status](https://travis-ci.org/haskell-servant/servant-swagger.svg?branch=master)](https://travis-ci.org/haskell-servant/servant-swagger)
3[![Hackage](https://img.shields.io/hackage/v/servant-swagger.svg)](http://hackage.haskell.org/package/servant-swagger)
4[![Hackage](https://img.shields.io/hackage/v/servant-swagger.svg)](http://hackage.haskell.org/package/servant-swagger)
4[![Stackage LTS](http://stackage.org/package/servant-swagger/badge/lts)](http://stackage.org/lts/package/servant-swagger)
5[![Stackage LTS](http://stackage.org/package/servant-swagger/badge/lts)](http://stackage.org/lts/package/servant-swagger)
5[![Stackage Nightly](http://stackage.org/package/servant-swagger/badge/nightly)](http://stackage.org/nightly/package/servant-swagger)
6[![Stackage Nightly](http://stackage.org/package/servant-swagger/badge/nightly)](http://stackage.org/nightly/package/servant-swagger)
@@ -24,7 +25,7 @@ Generated Swagger specification then can be used for many things such as
24
25
25### Usage
26### Usage
26
27
27−Please refer to [haddock documentation](http://hackage.haskell.org/package/servant/servant-swagger).
28+Please refer to [haddock documentation](http://hackage.haskell.org/package/servant-swagger).
28
29
29Some examples can be found in [`example/` directory](/example).
30Some examples can be found in [`example/` directory](/example).
30
31
@@ -42,5 +43,5 @@ Many Swagger tools, including server and client code generation for many languag
42
43
43We are happy to receive bug reports, fixes, documentation enhancements, and other improvements.
44We are happy to receive bug reports, fixes, documentation enhancements, and other improvements.
44
45
45−Please report bugs via the [github issue tracker](https://github.com/haskell-servant/servant/issues).
46+Please report bugs via the [github issue tracker](https://github.com/haskell-servant/servant-swagger/issues).
46
47
servant-swagger/cabal.haskell-cinew file+14
@@ -0,0 +1,14 @@
1+branches: master
2+
3+constraint-set swagger2-2.3
4+ ghc: <8.8
5+ constraints: swagger2 ==2.3.*
6+
7+constraint-set swagger2-2.4
8+ constraints: swagger2 ==2.4.*
9+
10+constraint-set swagger2-2.5
11+ constraints: swagger2 ==2.5.*
12+
13+constraint-set servant-0.17
14+ constraints: servant == 0.17.*
servant-swagger/cabal.projectnew file+2
@@ -0,0 +1,2 @@
1+packages: .
2+allow-newer: aeson-pretty-0.8.7:base-compat
servant-swagger/example/example.cabal+2−2
@@ -1,15 +1,15 @@
1−cabal-version: 2.2
2name: example
1name: example
3version: 1.0
2version: 1.0
4synopsis: servant-swagger demonstration
3synopsis: servant-swagger demonstration
5description: servant-swagger demonstration
4description: servant-swagger demonstration
6−license: BSD-3-Clause
5+license: BSD3
7license-file: LICENSE
6license-file: LICENSE
8author: David Johnson, Nickolay Kudasov
7author: David Johnson, Nickolay Kudasov
9maintainer: nickolay.kudasov@gmail.com
8maintainer: nickolay.kudasov@gmail.com
10copyright: (c) 2015-2016, Servant contributors
9copyright: (c) 2015-2016, Servant contributors
11category: Web
10category: Web
12build-type: Simple
11build-type: Simple
12+cabal-version: >=1.10
13data-files:
13data-files:
14 swagger.json
14 swagger.json
15
15
servant-swagger/servant-swagger.cabal+23−23
@@ -1,12 +1,11 @@
1−cabal-version: 2.2
2name: servant-swagger
1name: servant-swagger
3version: 1.1.11
2version: 1.1.11
4synopsis: Generate a Swagger/OpenAPI/OAS 2.0 specification for your servant API.
3synopsis: Generate a Swagger/OpenAPI/OAS 2.0 specification for your servant API.
5description:
4description:
6− Swagger is a project used to describe and document RESTful APIs. The core of the
5+ 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/).
6+ 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
7+ 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
8+ quite popular among developers in different languages. It has also existed for a longer time
10 and has more helpful tooling.
9 and has more helpful tooling.
11 .
10 .
12 This package provides means to generate a Swagger/OAS specification for a Servant API
11 This package provides means to generate a Swagger/OAS specification for a Servant API
@@ -19,16 +18,17 @@ description:
19 * generating clients and servers in many languages using [Swagger Codegen](http://swagger.io/swagger-codegen/);
18 * generating clients and servers in many languages using [Swagger Codegen](http://swagger.io/swagger-codegen/);
20 .
19 .
21 * and [many others](http://swagger.io/open-source-integrations/).
20 * and [many others](http://swagger.io/open-source-integrations/).
22−homepage: https://github.com/haskell-servant/servant/tree/master/servant-swagger#readme
21+homepage: https://github.com/haskell-servant/servant-swagger
23−bug-reports: https://github.com/haskell-servant/servant/issues
22+bug-reports: https://github.com/haskell-servant/servant-swagger/issues
24−license: BSD-3-Clause
23+license: BSD3
25license-file: LICENSE
24license-file: LICENSE
26−author: Servant Contributors
25+author: David Johnson, Nickolay Kudasov
27−maintainer: haskell-servant-maintainers@googlegroups.com
26+maintainer: nickolay.kudasov@gmail.com
28copyright: (c) 2015-2018, Servant contributors
27copyright: (c) 2015-2018, Servant contributors
29category: Web, Servant, Swagger
28category: Web, Servant, Swagger
30build-type: Custom
29build-type: Custom
30+cabal-version: 1.18
31−tested-with: GHC ==8.6.5 || ==8.8.4 || ==8.10.2
31+tested-with: GHC ==8.0.2 || ==8.2.2 || ==8.4.4 || ==8.6.5 || ==8.8.4 || ==8.10.2
32
32
33extra-source-files:
33extra-source-files:
34 README.md
34 README.md
@@ -45,12 +45,12 @@ extra-doc-files:
45
45
46source-repository head
46source-repository head
47 type: git
47 type: git
48− location: https://github.com/haskell-servant/servant.git
48+ location: https://github.com/haskell-servant/servant-swagger.git
49
49
50custom-setup
50custom-setup
51 setup-depends:
51 setup-depends:
52 base >=4.9 && <5,
52 base >=4.9 && <5,
53− Cabal >= 1.24,
53+ Cabal >= 1.24 && <3.3,
54 cabal-doctest >=1.0.6 && <1.1
54 cabal-doctest >=1.0.6 && <1.1
55
55
56library
56library
@@ -69,18 +69,18 @@ library
69 Servant.Swagger.Internal.TypeLevel.Every
69 Servant.Swagger.Internal.TypeLevel.Every
70 Servant.Swagger.Internal.TypeLevel.TMap
70 Servant.Swagger.Internal.TypeLevel.TMap
71 hs-source-dirs: src
71 hs-source-dirs: src
72− build-depends: aeson >=1.4.2.0 && <3
72+ build-depends: aeson >=1.4.2.0 && <1.6
73 , aeson-pretty >=0.8.7 && <0.9
73 , aeson-pretty >=0.8.7 && <0.9
74 , base >=4.9.1.0 && <5
74 , base >=4.9.1.0 && <5
75− , base-compat >=0.10.5 && <0.13
75+ , base-compat >=0.10.5 && <0.12
76− , bytestring >=0.10.8.1 && <0.12
76+ , bytestring >=0.10.8.1 && <0.11
77 , http-media >=0.7.1.3 && <0.9
77 , http-media >=0.7.1.3 && <0.9
78 , insert-ordered-containers >=0.2.1.0 && <0.3
78 , insert-ordered-containers >=0.2.1.0 && <0.3
79 , lens >=4.17 && <6
79 , lens >=4.17 && <6
80− , servant >=0.18.2 && <0.20
80+ , servant >=0.18.1 && <0.19
81 , singleton-bool >=0.1.4 && <0.2
81 , singleton-bool >=0.1.4 && <0.2
82 , swagger2 >=2.3.0.1 && <3
82 , swagger2 >=2.3.0.1 && <3
83− , text >=1.2.3.0 && <2.1
83+ , text >=1.2.3.0 && <1.3
84 , unordered-containers >=0.2.9.0 && <0.3
84 , unordered-containers >=0.2.9.0 && <0.3
85
85
86 , hspec
86 , hspec
@@ -92,7 +92,7 @@ test-suite doctests
92 build-depends:
92 build-depends:
93 base,
93 base,
94 directory >= 1.0,
94 directory >= 1.0,
95− doctest >= 0.17 && <0.21,
95+ doctest >= 0.18 && <0.19,
96 servant,
96 servant,
97 QuickCheck,
97 QuickCheck,
98 filepath
98 filepath
@@ -106,14 +106,14 @@ test-suite spec
106 type: exitcode-stdio-1.0
106 type: exitcode-stdio-1.0
107 hs-source-dirs: test
107 hs-source-dirs: test
108 main-is: Spec.hs
108 main-is: Spec.hs
109− build-tool-depends: hspec-discover:hspec-discover >=2.6.0 && <2.10
109+ build-tool-depends: hspec-discover:hspec-discover >=2.6.0 && <2.8
110 build-depends: base
110 build-depends: base
111 , base-compat
111 , base-compat
112− , aeson >=1.4.2.0 && <3
112+ , aeson
113− , hspec >=2.6.0 && <2.10
113+ , hspec >=2.6.0 && <2.8
114 , QuickCheck
114 , QuickCheck
115 , lens
115 , lens
116− , lens-aeson >=1.0.2 && <1.3
116+ , lens-aeson >=1.0.2 && <1.2
117 , servant
117 , servant
118 , servant-swagger
118 , servant-swagger
119 , swagger2
119 , swagger2
servant-swagger/src/Servant/Swagger.hs+3−5
@@ -55,7 +55,6 @@ import Servant.Swagger.Internal.Orphans ()
55-- >>> import Data.Typeable
55-- >>> import Data.Typeable
56-- >>> import GHC.Generics
56-- >>> import GHC.Generics
57-- >>> import Servant.API
57-- >>> import Servant.API
58−-- >>> import System.Environment
59-- >>> import Test.Hspec
58-- >>> import Test.Hspec
60-- >>> import Test.QuickCheck
59-- >>> import Test.QuickCheck
61-- >>> import qualified Data.ByteString.Lazy.Char8 as BSL8
60-- >>> import qualified Data.ByteString.Lazy.Char8 as BSL8
@@ -65,7 +64,6 @@ import Servant.Swagger.Internal.Orphans ()
65-- >>> :set -XGeneralizedNewtypeDeriving
64-- >>> :set -XGeneralizedNewtypeDeriving
66-- >>> :set -XOverloadedStrings
65-- >>> :set -XOverloadedStrings
67-- >>> :set -XTypeOperators
66-- >>> :set -XTypeOperators
68−-- >>> setEnv "HSPEC_COLOR" "no"
69-- >>> data User = User { name :: String, age :: Int } deriving (Show, Generic, Typeable)
67-- >>> data User = User { name :: String, age :: Int } deriving (Show, Generic, Typeable)
70-- >>> newtype UserId = UserId Integer deriving (Show, Generic, Typeable, ToJSON)
68-- >>> newtype UserId = UserId Integer deriving (Show, Generic, Typeable, ToJSON)
71-- >>> instance ToJSON User
69-- >>> instance ToJSON User
@@ -162,11 +160,11 @@ import Servant.Swagger.Internal.Orphans ()
162-- >>> instance Arbitrary UserId where arbitrary = UserId <$> arbitrary
160-- >>> instance Arbitrary UserId where arbitrary = UserId <$> arbitrary
163-- >>> hspec $ validateEveryToJSON (Proxy :: Proxy UserAPI)
161-- >>> hspec $ validateEveryToJSON (Proxy :: Proxy UserAPI)
164-- <BLANKLINE>
162-- <BLANKLINE>
165−-- [User]...
163+-- [User]
166-- ...
164-- ...
167−-- User...
165+-- User
168-- ...
166-- ...
169−-- UserId...
167+-- UserId
170-- ...
168-- ...
171-- Finished in ... seconds
169-- Finished in ... seconds
172-- 3 examples, 0 failures
170-- 3 examples, 0 failures
servant-swagger/src/Servant/Swagger/Internal.hs−11
@@ -3,13 +3,11 @@
3{-# LANGUAGE DataKinds #-}
3{-# LANGUAGE DataKinds #-}
4{-# LANGUAGE FlexibleContexts #-}
4{-# LANGUAGE FlexibleContexts #-}
5{-# LANGUAGE FlexibleInstances #-}
5{-# LANGUAGE FlexibleInstances #-}
6−{-# LANGUAGE OverloadedLists #-}
7{-# LANGUAGE OverloadedStrings #-}
6{-# LANGUAGE OverloadedStrings #-}
8{-# LANGUAGE PolyKinds #-}
7{-# LANGUAGE PolyKinds #-}
9{-# LANGUAGE RankNTypes #-}
8{-# LANGUAGE RankNTypes #-}
10{-# LANGUAGE ScopedTypeVariables #-}
9{-# LANGUAGE ScopedTypeVariables #-}
11{-# LANGUAGE TypeOperators #-}
10{-# LANGUAGE TypeOperators #-}
12−{-# LANGUAGE TypeFamilies #-}
13#if __GLASGOW_HASKELL__ >= 806
11#if __GLASGOW_HASKELL__ >= 806
14{-# LANGUAGE UndecidableInstances #-}
12{-# LANGUAGE UndecidableInstances #-}
15#endif
13#endif
@@ -32,13 +30,11 @@ import qualified Data.Swagger as Swagger
32import Data.Swagger.Declare
30import Data.Swagger.Declare
33import Data.Text (Text)
31import Data.Text (Text)
34import qualified Data.Text as Text
32import qualified Data.Text as Text
35−import GHC.Generics (D1, Meta(..), Rep)
36import GHC.TypeLits
33import GHC.TypeLits
37import Network.HTTP.Media (MediaType)
34import Network.HTTP.Media (MediaType)
38import Servant.API
35import Servant.API
39import Servant.API.Description (FoldDescription,
36import Servant.API.Description (FoldDescription,
40 reflectDescription)
37 reflectDescription)
41−import Servant.API.Generic (ToServantApi, AsApi)
42import Servant.API.Modifiers (FoldRequired)
38import Servant.API.Modifiers (FoldRequired)
43
39
44import Servant.Swagger.Internal.TypeLevel.API
40import Servant.Swagger.Internal.TypeLevel.API
@@ -153,10 +149,6 @@ mkEndpointNoContentVerb path _ = mempty
153addParam :: Param -> Swagger -> Swagger
149addParam :: Param -> Swagger -> Swagger
154addParam param = allOperations.parameters %~ (Inline param :)
150addParam param = allOperations.parameters %~ (Inline param :)
155
151
156−-- | Add a tag to every operation in the spec.
157−addTag :: Text -> Swagger -> Swagger
158−addTag tag = allOperations.tags %~ ([tag] <>)
159−
160-- | Add accepted content types to every operation in the spec.
152-- | Add accepted content types to every operation in the spec.
161addConsumes :: [MediaType] -> Swagger -> Swagger
153addConsumes :: [MediaType] -> Swagger -> Swagger
162addConsumes cs = allOperations.consumes %~ (<> Just (MimeList cs))
154addConsumes cs = allOperations.consumes %~ (<> Just (MimeList cs))
@@ -447,9 +439,6 @@ instance (ToSchema a, Accept ct, HasSwagger sub, KnownSymbol (FoldDescription mo
447 & required ?~ True
439 & required ?~ True
448 & schema .~ ParamBody ref
440 & schema .~ ParamBody ref
449
441
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−
453-- =======================================================================
442-- =======================================================================
454-- Below are the definitions that should be in Servant.API.ContentTypes
443-- Below are the definitions that should be in Servant.API.ContentTypes
455-- =======================================================================
444-- =======================================================================
servant-swagger/src/Servant/Swagger/Internal/Test.hs+6−8
@@ -29,12 +29,10 @@ import Servant.Swagger.Internal.TypeLevel
29-- >>> import Control.Applicative
29-- >>> import Control.Applicative
30-- >>> import GHC.Generics
30-- >>> import GHC.Generics
31-- >>> import Test.QuickCheck
31-- >>> import Test.QuickCheck
32−-- >>> import System.Environment (setEnv)
33-- >>> :set -XDeriveGeneric
32-- >>> :set -XDeriveGeneric
34-- >>> :set -XGeneralizedNewtypeDeriving
33-- >>> :set -XGeneralizedNewtypeDeriving
35-- >>> :set -XDataKinds
34-- >>> :set -XDataKinds
36-- >>> :set -XTypeOperators
35-- >>> :set -XTypeOperators
37−-- >>> setEnv "HSPEC_COLOR" "no"
38
36
39-- | Verify that every type used with @'JSON'@ content type in a servant API
37-- | Verify that every type used with @'JSON'@ content type in a servant API
40-- has compatible @'ToJSON'@ and @'ToSchema'@ instances using @'validateToJSON'@.
38-- has compatible @'ToJSON'@ and @'ToSchema'@ instances using @'validateToJSON'@.
@@ -55,10 +53,10 @@ import Servant.Swagger.Internal.TypeLevel
55--
53--
56-- >>> hspec $ context "ToJSON matches ToSchema" $ validateEveryToJSON (Proxy :: Proxy UserAPI)
54-- >>> hspec $ context "ToJSON matches ToSchema" $ validateEveryToJSON (Proxy :: Proxy UserAPI)
57-- <BLANKLINE>
55-- <BLANKLINE>
58−-- ToJSON matches ToSchema...
56+-- ToJSON matches ToSchema
59−-- User...
57+-- User
60-- ...
58-- ...
61−-- UserId...
59+-- UserId
62-- ...
60-- ...
63-- Finished in ... seconds
61-- Finished in ... seconds
64-- 2 examples, 0 failures
62-- 2 examples, 0 failures
@@ -120,11 +118,11 @@ validateEveryToJSONWithPatternChecker checker _ = props
120-- :}
118-- :}
121-- <BLANKLINE>
119-- <BLANKLINE>
122-- read . show == id
120-- read . show == id
123−-- Bool...
121+-- Bool
124-- ...
122-- ...
125−-- Int...
123+-- Int
126-- ...
124-- ...
127−-- [Char]...
125+-- [Char]
128-- ...
126-- ...
129-- Finished in ... seconds
127-- Finished in ... seconds
130-- 3 examples, 0 failures
128-- 3 examples, 0 failures
servant-swagger/stack.yamlnew file+8
@@ -0,0 +1,8 @@
1+resolver: lts-16.7
2+packages:
3+- '.'
4+- example/
5+
6+extra-deps:
7+- servant-0.18.1
8+- servant-server-0.18.1
servant/CHANGELOG.md−116
@@ -1,121 +1,5 @@
1[The latest version of this document is on GitHub.](https://github.com/haskell-servant/servant/blob/master/servant/CHANGELOG.md)
1[The latest version of this document is on GitHub.](https://github.com/haskell-servant/servant/blob/master/servant/CHANGELOG.md)
2
2
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−
1190.18.3
30.18.3
120------
4------
121
5
servant/servant.cabal+9−10
@@ -1,6 +1,6 @@
1−cabal-version: 2.2
1+cabal-version: >=1.10
2name: servant
2name: servant
3−version: 0.19
3+version: 0.18.3
4
4
5synopsis: A family of combinators for defining webservices APIs
5synopsis: A family of combinators for defining webservices APIs
6category: Servant, Web
6category: Servant, Web
@@ -55,7 +55,6 @@ library
55 Servant.API.Status
55 Servant.API.Status
56 Servant.API.Stream
56 Servant.API.Stream
57 Servant.API.Sub
57 Servant.API.Sub
58− Servant.API.TypeErrors
59 Servant.API.TypeLevel
58 Servant.API.TypeLevel
60 Servant.API.UVerb
59 Servant.API.UVerb
61 Servant.API.UVerb.Union
60 Servant.API.UVerb.Union
@@ -80,13 +79,13 @@ library
80 --
79 --
81 -- note: mtl lower bound is so low because of GHC-7.8
80 -- note: mtl lower bound is so low because of GHC-7.8
82 build-depends:
81 build-depends:
83− base >= 4.9 && < 4.17
82+ base >= 4.9 && < 4.16
84 , bytestring >= 0.10.8.1 && < 0.12
83 , bytestring >= 0.10.8.1 && < 0.12
85 , constraints >= 0.2
84 , constraints >= 0.2
86 , mtl >= 2.2.2 && < 2.3
85 , mtl >= 2.2.2 && < 2.3
87 , sop-core >= 0.4.0.0 && < 0.6
86 , sop-core >= 0.4.0.0 && < 0.6
88 , transformers >= 0.5.2.0 && < 0.6
87 , transformers >= 0.5.2.0 && < 0.6
89− , text >= 1.2.3.0 && < 2.1
88+ , text >= 1.2.3.0 && < 1.3
90
89
91
90
92 -- We depend (heavily) on the API of these packages:
91 -- We depend (heavily) on the API of these packages:
@@ -98,15 +97,15 @@ library
98 -- Other dependencies: Lower bound around what is in the latest Stackage LTS.
97 -- Other dependencies: Lower bound around what is in the latest Stackage LTS.
99 -- Here can be exceptions if we really need features from the newer versions.
98 -- Here can be exceptions if we really need features from the newer versions.
100 build-depends:
99 build-depends:
101− base-compat >= 0.10.5 && < 0.13
100+ base-compat >= 0.10.5 && < 0.12
102− , aeson >= 1.4.1.0 && < 3
101+ , aeson >= 2.0.1.0 && < 3
103 , attoparsec >= 0.13.2.2 && < 0.15
102 , attoparsec >= 0.13.2.2 && < 0.15
104 , bifunctors >= 5.5.3 && < 5.6
103 , bifunctors >= 5.5.3 && < 5.6
105 , case-insensitive >= 1.2.0.11 && < 1.3
104 , case-insensitive >= 1.2.0.11 && < 1.3
106 , deepseq >= 1.4.2.0 && < 1.5
105 , deepseq >= 1.4.2.0 && < 1.5
107 , http-media >= 0.7.1.3 && < 0.9
106 , http-media >= 0.7.1.3 && < 0.9
108 , http-types >= 0.12.2 && < 0.13
107 , http-types >= 0.12.2 && < 0.13
109− , mmorph >= 1.1.2 && < 1.3
108+ , mmorph >= 1.1.2 && < 1.2
110 , network-uri >= 2.6.1.0 && < 2.7
109 , network-uri >= 2.6.1.0 && < 2.7
111 , QuickCheck >= 2.12.6.1 && < 2.15
110 , QuickCheck >= 2.12.6.1 && < 2.15
112 , string-conversions >= 0.4.0.1 && < 0.5
111 , string-conversions >= 0.4.0.1 && < 0.5
@@ -166,9 +165,9 @@ test-suite spec
166
165
167 -- Additional dependencies
166 -- Additional dependencies
168 build-depends:
167 build-depends:
169− hspec >= 2.6.0 && < 2.10
168+ hspec >= 2.6.0 && < 2.9
170 , QuickCheck >= 2.12.6.1 && < 2.15
169 , QuickCheck >= 2.12.6.1 && < 2.15
171 , quickcheck-instances >= 0.3.19 && < 0.4
170 , quickcheck-instances >= 0.3.19 && < 0.4
172
171
173 build-tool-depends:
172 build-tool-depends:
174− hspec-discover:hspec-discover >= 2.6.0 && < 2.10
173+ hspec-discover:hspec-discover >= 2.6.0 && < 2.9
servant/src/Servant/API.hs−4
@@ -38,7 +38,6 @@ module Servant.API (
38
38
39 -- * Sub-APIs defined as records of routes
39 -- * Sub-APIs defined as records of routes
40 module Servant.API.NamedRoutes,
40 module Servant.API.NamedRoutes,
41− module Servant.API.Generic,
42
41
43 -- * Streaming endpoints, distinguished by HTTP method
42 -- * Streaming endpoints, distinguished by HTTP method
44 module Servant.API.Stream,
43 module Servant.API.Stream,
@@ -103,9 +102,6 @@ import Servant.API.Fragment
103 (Fragment)
102 (Fragment)
104import Servant.API.Header
103import Servant.API.Header
105 (Header, Header')
104 (Header, Header')
106−import Servant.API.Generic
107− (GenericMode ((:-)), AsApi, ToServant, ToServantApi, GServantProduct,
108− GenericServant, fromServant, toServant, genericApi)
109import Servant.API.HttpVersion
105import Servant.API.HttpVersion
110 (HttpVersion (..))
106 (HttpVersion (..))
111import Servant.API.IsSecure
107import Servant.API.IsSecure
servant/src/Servant/API/ContentTypes.hs+1−1
@@ -295,7 +295,7 @@ instance {-# OVERLAPPABLE #-}
295-- then this would be taken care of. However there is no more specific instance
295-- then this would be taken care of. However there is no more specific instance
296-- between that and 'MimeRender JSON a', so we do this instead
296-- between that and 'MimeRender JSON a', so we do this instead
297instance {-# OVERLAPPING #-} ( Accept ctyp ) => AllMimeRender '[ctyp] NoContent where
297instance {-# OVERLAPPING #-} ( Accept ctyp ) => AllMimeRender '[ctyp] NoContent where
298− allMimeRender _ NoContent = map (, "") $ NE.toList $ contentTypes pctyp
298+ allMimeRender _ _ = map (, "") $ NE.toList $ contentTypes pctyp
299 where
299 where
300 pctyp = Proxy :: Proxy ctyp
300 pctyp = Proxy :: Proxy ctyp
301
301
servant/src/Servant/API/ResponseHeaders.hs+11−6
@@ -3,8 +3,10 @@
3{-# LANGUAGE DeriveFunctor #-}
3{-# LANGUAGE DeriveFunctor #-}
4{-# LANGUAGE FlexibleContexts #-}
4{-# LANGUAGE FlexibleContexts #-}
5{-# LANGUAGE FlexibleInstances #-}
5{-# LANGUAGE FlexibleInstances #-}
6−{-# LANGUAGE GADTs #-}
7{-# LANGUAGE FunctionalDependencies #-}
6{-# LANGUAGE FunctionalDependencies #-}
7+{-# LANGUAGE GADTs #-}
8+{-# LANGUAGE KindSignatures #-}
9+{-# LANGUAGE MultiParamTypeClasses #-}
8{-# LANGUAGE PolyKinds #-}
10{-# LANGUAGE PolyKinds #-}
9{-# LANGUAGE ScopedTypeVariables #-}
11{-# LANGUAGE ScopedTypeVariables #-}
10{-# LANGUAGE TypeFamilies #-}
12{-# LANGUAGE TypeFamilies #-}
@@ -49,6 +51,9 @@ import Web.HttpApiData
49
51
50import Prelude ()
52import Prelude ()
51import Prelude.Compat
53import Prelude.Compat
54+import Servant.API.ContentTypes
55+ (JSON, PlainText, FormUrlEncoded, OctetStream,
56+ MimeRender(..))
52import Servant.API.Header
57import Servant.API.Header
53 (Header)
58 (Header)
54
59
@@ -112,7 +117,7 @@ instance {-# OVERLAPPABLE #-} ( FromHttpApiData v, BuildHeadersTo xs, KnownSymbo
112 `HCons` buildHeadersTo headers
117 `HCons` buildHeadersTo headers
113 Right h -> Header h `HCons` buildHeadersTo headers
118 Right h -> Header h `HCons` buildHeadersTo headers
114
119
115−-- * Getting headers
120+-- * Getting
116
121
117class GetHeaders ls where
122class GetHeaders ls where
118 getHeaders :: ls -> [HTTP.Header]
123 getHeaders :: ls -> [HTTP.Header]
@@ -153,20 +158,20 @@ instance (KnownSymbol h, GetHeadersFromHList rest, ToHttpApiData v)
153 where
158 where
154 getHeaders' hs = getHeadersFromHList $ getHeadersHList hs
159 getHeaders' hs = getHeadersFromHList $ getHeadersHList hs
155
160
156−-- * Adding headers
161+-- * Adding
157
162
158-- We need all these fundeps to save type inference
163-- We need all these fundeps to save type inference
159class AddHeader h v orig new
164class AddHeader h v orig new
160 | h v orig -> new, new -> h, new -> v, new -> orig where
165 | h v orig -> new, new -> h, new -> v, new -> orig where
161 addOptionalHeader :: ResponseHeader h v -> orig -> new -- ^ N.B.: The same header can't be added multiple times
166 addOptionalHeader :: ResponseHeader h v -> orig -> new -- ^ N.B.: The same header can't be added multiple times
162
167
163−-- In this instance, we add a Header on top of something that is already decorated with some headers
168+
164instance {-# OVERLAPPING #-} ( KnownSymbol h, ToHttpApiData v )
169instance {-# OVERLAPPING #-} ( KnownSymbol h, ToHttpApiData v )
165 => AddHeader h v (Headers (fst ': rest) a) (Headers (Header h v ': fst ': rest) a) where
170 => AddHeader h v (Headers (fst ': rest) a) (Headers (Header h v ': fst ': rest) a) where
166 addOptionalHeader hdr (Headers resp heads) = Headers resp (HCons hdr heads)
171 addOptionalHeader hdr (Headers resp heads) = Headers resp (HCons hdr heads)
167
172
168−-- In this instance, 'a' parameter is decorated with a Header.
169−instance {-# OVERLAPPABLE #-} ( KnownSymbol h, ToHttpApiData v , new ~ Headers '[Header h v] a)
173+instance {-# OVERLAPPABLE #-} ( KnownSymbol h, ToHttpApiData v
174+ , new ~ (Headers '[Header h v] a) )
170 => AddHeader h v a new where
175 => AddHeader h v a new where
171 addOptionalHeader hdr resp = Headers resp (HCons hdr HNil)
176 addOptionalHeader hdr resp = Headers resp (HCons hdr HNil)
172
177
servant/src/Servant/API/Status.hs+1−6
@@ -1,15 +1,10 @@
1{-# LANGUAGE DataKinds #-}
1{-# LANGUAGE DataKinds #-}
2-- Flexible instances is necessary on GHC 8.4 and earlier
2-- Flexible instances is necessary on GHC 8.4 and earlier
3{-# LANGUAGE FlexibleInstances #-}
3{-# LANGUAGE FlexibleInstances #-}
4−{-# LANGUAGE ScopedTypeVariables #-}
5module Servant.API.Status where
4module Servant.API.Status where
6
5
7−import GHC.TypeLits (KnownNat, natVal)
8import Network.HTTP.Types.Status
6import Network.HTTP.Types.Status
9−
7+import GHC.TypeLits
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
13
8
14-- | Witness that a type-level natural number corresponds to a HTTP status code
9-- | Witness that a type-level natural number corresponds to a HTTP status code
15class KnownNat n => KnownStatus n where
10class KnownNat n => KnownStatus n where
servant/src/Servant/API/TypeErrors.hsdeleted−40
@@ -1,40 +0,0 @@
1−{-# LANGUAGE DataKinds #-}
2−{-# LANGUAGE PolyKinds #-}
3−{-# LANGUAGE TypeFamilies #-}
4−{-# LANGUAGE TypeOperators #-}
5−{-# LANGUAGE UndecidableInstances #-}
6−
7−-- | This module defines the error messages used in type-level errors.
8−-- Type-level errors can signal non-existing instances, for instance when
9−-- a combinator is not applied to the correct number of arguments.
10−
11−module Servant.API.TypeErrors (
12− PartialApplication,
13− NoInstanceFor,
14− NoInstanceForSub,
15−) where
16−
17−import Data.Kind
18−import GHC.TypeLits
19−
20−-- | No instance exists for @tycls (expr :> ...)@ because
21−-- @expr@ is not recognised.
22−type NoInstanceForSub (tycls :: k) (expr :: k') =
23− Text "There is no instance for " :<>: ShowType tycls
24− :<>: Text " (" :<>: ShowType expr :<>: Text " :> ...)"
25−
26−-- | No instance exists for @expr@.
27−type NoInstanceFor (expr :: k) =
28− Text "There is no instance for " :<>: ShowType expr
29−
30−-- | No instance exists for @tycls (expr :> ...)@ because @expr@ is not fully saturated.
31−type PartialApplication (tycls :: k) (expr :: k') =
32− NoInstanceForSub tycls expr
33− :$$: ShowType expr :<>: Text " expects " :<>: ShowType (Arity expr) :<>: Text " more arguments"
34−
35−-- The arity of a combinator, i.e. the number of required arguments.
36−type Arity (ty :: k) = Arity' k
37−
38−type family Arity' (ty :: k) :: Nat where
39− Arity' (_ -> ty) = 1 + Arity' ty
40− Arity' _ = 0
servant/src/Servant/API/Verbs.hs+1−2
@@ -128,8 +128,7 @@ type DeleteNoContent = NoContentVerb 'DELETE
128type PatchNoContent = NoContentVerb 'PATCH
128type PatchNoContent = NoContentVerb 'PATCH
129-- | 'PUT' with 204 status code.
129-- | 'PUT' with 204 status code.
130type PutNoContent = NoContentVerb 'PUT
130type PutNoContent = NoContentVerb 'PUT
131−-- | 'HEAD' with 204 status code.
131+
132−type HeadNoContent = NoContentVerb 'HEAD
133
132
134-- ** 205 Reset Content
133-- ** 205 Reset Content
135--
134--
servant/src/Servant/Links.hs+4−16
@@ -140,7 +140,7 @@ import qualified Data.Text.Encoding as TE
140import Data.Type.Bool
140import Data.Type.Bool
141 (If)
141 (If)
142import GHC.TypeLits
142import GHC.TypeLits
143− (KnownSymbol, TypeError, symbolVal)
143+ (KnownSymbol, symbolVal)
144import Network.URI
144import Network.URI
145 (URI (..), escapeURIString, isUnreserved)
145 (URI (..), escapeURIString, isUnreserved)
146import Prelude ()
146import Prelude ()
@@ -183,7 +183,6 @@ import Servant.API.Stream
183 (Stream, StreamBody')
183 (Stream, StreamBody')
184import Servant.API.Sub
184import Servant.API.Sub
185 (type (:>))
185 (type (:>))
186−import Servant.API.TypeErrors
187import Servant.API.TypeLevel
186import Servant.API.TypeLevel
188import Servant.API.UVerb
187import Servant.API.UVerb
189import Servant.API.Vault
188import Servant.API.Vault
@@ -596,10 +595,10 @@ type GLinkConstraints routes a =
596 )
595 )
597
596
598class GLink (routes :: * -> *) (a :: *) where
597class GLink (routes :: * -> *) (a :: *) where
599− gLinkProof :: Dict (GLinkConstraints routes a)
598+ proof :: Dict (GLinkConstraints routes a)
600
599
601instance GLinkConstraints routes a => GLink routes a where
600instance GLinkConstraints routes a => GLink routes a where
602− gLinkProof = Dict
601+ proof = Dict
603
602
604instance
603instance
605 ( HasLink (ToServantApi routes)
604 ( HasLink (ToServantApi routes)
@@ -614,7 +613,7 @@ instance
614 -> Link
613 -> Link
615 -> routes (AsLink a)
614 -> routes (AsLink a)
616
615
617− toLink toA _ l = case gLinkProof @routes @a of
616+ toLink toA _ l = case proof @routes @a of
618 Dict -> fromServant $ toLink toA (Proxy @(ToServantApi routes)) l
617 Dict -> fromServant $ toLink toA (Proxy @(ToServantApi routes)) l
619
618
620-- AuthProtext instances
619-- AuthProtext instances
@@ -645,14 +644,3 @@ simpleToLink _ toA _ = toLink toA (Proxy :: Proxy sub)
645-- $setup
644-- $setup
646-- >>> import Servant.API
645-- >>> import Servant.API
647-- >>> import Data.Text (Text)
646-- >>> import Data.Text (Text)
648−
649−-- Erroring instance for 'HasLink' when a combinator is not fully applied
650−instance TypeError (PartialApplication HasLink arr) => HasLink ((arr :: a -> b) :> sub)
651− where
652− type MkLink (arr :> sub) _ = TypeError (PartialApplication (HasLink :: * -> Constraint) arr)
653− toLink = error "unreachable"
654−
655−-- Erroring instances for 'HasLink' for unknown API combinators
656−instance {-# OVERLAPPABLE #-} TypeError (NoInstanceForSub HasLink ty) => HasLink (ty :> sub)
657−
658−instance {-# OVERLAPPABLE #-} TypeError (NoInstanceFor (HasLink api)) => HasLink api
servant/src/Servant/Types/SourceT.hs+1−1
@@ -319,7 +319,7 @@ fromActionStep stop action = loop where
319-- | Read file.
319-- | Read file.
320--
320--
321-- >>> foreach fail BS.putStr (readFile "servant.cabal")
321-- >>> foreach fail BS.putStr (readFile "servant.cabal")
322−-- cabal-version: 2.2
322+-- cabal-version: >=1.10
323-- name: servant
323-- name: servant
324-- ...
324-- ...
325--
325--
servant/test/Servant/API/ContentTypesSpec.hs−11
@@ -33,8 +33,6 @@ import Data.String.Conversions
33import qualified Data.Text as TextS
33import qualified Data.Text as TextS
34import qualified Data.Text.Encoding as TextSE
34import qualified Data.Text.Encoding as TextSE
35import qualified Data.Text.Lazy as TextL
35import qualified Data.Text.Lazy as TextL
36−import Control.Exception
37− (evaluate)
38import GHC.Generics
36import GHC.Generics
39import Test.Hspec
37import Test.Hspec
40import Test.QuickCheck
38import Test.QuickCheck
@@ -80,15 +78,6 @@ spec = describe "Servant.API.ContentTypes" $ do
80 it "has mimeUnrender reverse mimeRender for valid top-level json " $ do
78 it "has mimeUnrender reverse mimeRender for valid top-level json " $ do
81 property $ \x -> mimeUnrender p (mimeRender p x) == Right (x::SomeData)
79 property $ \x -> mimeUnrender p (mimeRender p x) == Right (x::SomeData)
82
80
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−
92 describe "The PlainText Content-Type type" $ do
81 describe "The PlainText Content-Type type" $ do
93 let p = Proxy :: Proxy PlainText
82 let p = Proxy :: Proxy PlainText
94
83
stack.yaml−1
@@ -11,7 +11,6 @@ packages:
11- servant-conduit
11- servant-conduit
12- servant-machines/
12- servant-machines/
13- servant-pipes/
13- servant-pipes/
14−- servant-swagger/
15
14
16# allow-newer: true # ignores all bounds, that's a sledgehammer
15# allow-newer: true # ignores all bounds, that's a sledgehammer
17# - doc/tutorial/
16# - doc/tutorial/