Compare commits
1 commit
master
...
no-mimeren
Author | SHA1 | Date | |
---|---|---|---|
|
c2af6e775d |
141 changed files with 500 additions and 3919 deletions
99
.github/workflows/master.yml
vendored
99
.github/workflows/master.yml
vendored
|
@ -13,14 +13,12 @@ jobs:
|
||||||
strategy:
|
strategy:
|
||||||
matrix:
|
matrix:
|
||||||
os: [ubuntu-latest]
|
os: [ubuntu-latest]
|
||||||
cabal: ["3.6"]
|
cabal: ["3.4"]
|
||||||
ghc:
|
ghc:
|
||||||
- "8.6.5"
|
- "8.6.5"
|
||||||
- "8.8.4"
|
- "8.8.4"
|
||||||
- "8.10.7"
|
- "8.10.7"
|
||||||
- "9.0.2"
|
- "9.0.1"
|
||||||
- "9.2.2"
|
|
||||||
- "9.4.2"
|
|
||||||
|
|
||||||
steps:
|
steps:
|
||||||
- uses: actions/checkout@v2
|
- uses: actions/checkout@v2
|
||||||
|
@ -49,7 +47,10 @@ jobs:
|
||||||
|
|
||||||
- name: Configure
|
- name: Configure
|
||||||
run: |
|
run: |
|
||||||
cabal install --ignore-project -j2 doctest --constraint='doctest ^>=0.20'
|
# Using separate store-dir because default one already has 'ghc-paths' package installed
|
||||||
|
# with hardcoded path to ghcup's GHC path (which it was built with). This leads to failure in
|
||||||
|
# doctest, as it tries to invoke that GHC, and it doesn't exist here.
|
||||||
|
cabal --store-dir /tmp/cabal-store install --ignore-project -j2 doctest --constraint='doctest ^>=0.18'
|
||||||
|
|
||||||
- name: Build
|
- name: Build
|
||||||
run: |
|
run: |
|
||||||
|
@ -60,56 +61,66 @@ jobs:
|
||||||
cabal test all
|
cabal test all
|
||||||
|
|
||||||
- name: Run doctests
|
- name: Run doctests
|
||||||
|
# doctests are broken on GHC 9 due to compiler bug:
|
||||||
|
# https://gitlab.haskell.org/ghc/ghc/-/issues/19460
|
||||||
|
continue-on-error: ${{ matrix.ghc == '9.0.1' }}
|
||||||
run: |
|
run: |
|
||||||
# Necessary for doctest to be found in $PATH
|
# Necessary for doctest to be found in $PATH
|
||||||
export PATH="$HOME/.cabal/bin:$PATH"
|
export PATH="$HOME/.cabal/bin:$PATH"
|
||||||
|
|
||||||
DOCTEST="cabal repl --with-ghc=doctest --ghc-options=-w"
|
# Filter out base-compat-batteries from .ghc.environment.*, as its modules
|
||||||
(cd servant && eval $DOCTEST)
|
# conflict with those of base-compat.
|
||||||
(cd servant-client && eval $DOCTEST)
|
#
|
||||||
(cd servant-client-core && eval $DOCTEST)
|
# FIXME: This is an ugly hack. Ultimately, we'll want to use cabal-doctest
|
||||||
(cd servant-http-streams && eval $DOCTEST)
|
# (or cabal v2-doctest, if it ever lands) to provide a clean GHC environment.
|
||||||
(cd servant-docs && eval $DOCTEST)
|
# This might allow running doctests in GHCJS build as well.
|
||||||
(cd servant-foreign && eval $DOCTEST)
|
perl -i -e 'while (<ARGV>) { print unless /package-id\s+(base-compat-batteries)-\d+(\.\d+)*/; }' .ghc.environment.*
|
||||||
(cd servant-server && eval $DOCTEST)
|
|
||||||
(cd servant-machines && eval $DOCTEST)
|
|
||||||
(cd servant-conduit && eval $DOCTEST)
|
|
||||||
(cd servant-pipes && eval $DOCTEST)
|
|
||||||
|
|
||||||
# stack:
|
(cd servant && doctest src)
|
||||||
# name: stack / ghc ${{ matrix.ghc }}
|
(cd servant-client && doctest src)
|
||||||
# runs-on: ubuntu-latest
|
(cd servant-client-core && doctest src)
|
||||||
# strategy:
|
(cd servant-http-streams && doctest src)
|
||||||
# matrix:
|
(cd servant-docs && doctest src)
|
||||||
# stack: ["2.7.5"]
|
(cd servant-foreign && doctest src)
|
||||||
# ghc: ["8.10.7"]
|
(cd servant-server && doctest src)
|
||||||
|
(cd servant-machines && doctest src)
|
||||||
|
(cd servant-conduit && doctest src)
|
||||||
|
(cd servant-pipes && doctest src)
|
||||||
|
|
||||||
# steps:
|
stack:
|
||||||
# - uses: actions/checkout@v2
|
name: stack / ghc ${{ matrix.ghc }}
|
||||||
|
runs-on: ubuntu-latest
|
||||||
|
strategy:
|
||||||
|
matrix:
|
||||||
|
stack: ["2.7.3"]
|
||||||
|
ghc: ["8.10.4"]
|
||||||
|
|
||||||
# - uses: haskell/actions/setup@v1
|
steps:
|
||||||
# name: Setup Haskell Stack
|
- uses: actions/checkout@v2
|
||||||
# with:
|
|
||||||
# ghc-version: ${{ matrix.ghc }}
|
|
||||||
# stack-version: ${{ matrix.stack }}
|
|
||||||
|
|
||||||
# - uses: actions/cache@v2.1.3
|
- uses: haskell/actions/setup@v1
|
||||||
# name: Cache ~/.stack
|
name: Setup Haskell Stack
|
||||||
# with:
|
with:
|
||||||
# path: ~/.stack
|
ghc-version: ${{ matrix.ghc }}
|
||||||
# key: ${{ runner.os }}-${{ matrix.ghc }}-stack
|
stack-version: ${{ matrix.stack }}
|
||||||
|
|
||||||
# - name: Install dependencies
|
- uses: actions/cache@v2.1.3
|
||||||
# run: |
|
name: Cache ~/.stack
|
||||||
# stack build --system-ghc --test --bench --no-run-tests --no-run-benchmarks --only-dependencies
|
with:
|
||||||
|
path: ~/.stack
|
||||||
|
key: ${{ runner.os }}-${{ matrix.ghc }}-stack
|
||||||
|
|
||||||
# - name: Build
|
- name: Install dependencies
|
||||||
# run: |
|
run: |
|
||||||
# stack build --system-ghc --test --bench --no-run-tests --no-run-benchmarks
|
stack build --system-ghc --test --bench --no-run-tests --no-run-benchmarks --only-dependencies
|
||||||
|
|
||||||
# - name: Test
|
- name: Build
|
||||||
# run: |
|
run: |
|
||||||
# stack test --system-ghc
|
stack build --system-ghc --test --bench --no-run-tests --no-run-benchmarks
|
||||||
|
|
||||||
|
- name: Test
|
||||||
|
run: |
|
||||||
|
stack test --system-ghc
|
||||||
|
|
||||||
ghcjs:
|
ghcjs:
|
||||||
name: ubuntu-latest / ghcjs 8.6
|
name: ubuntu-latest / ghcjs 8.6
|
||||||
|
|
1
.gitignore
vendored
1
.gitignore
vendored
|
@ -31,7 +31,6 @@ doc/venv
|
||||||
doc/tutorial/static/api.js
|
doc/tutorial/static/api.js
|
||||||
doc/tutorial/static/jq.js
|
doc/tutorial/static/jq.js
|
||||||
shell.nix
|
shell.nix
|
||||||
.hspec-failures
|
|
||||||
|
|
||||||
# nix
|
# nix
|
||||||
result*
|
result*
|
||||||
|
|
|
@ -79,10 +79,8 @@ not been a timely response to a PR, you can ping the Maintainers group (with
|
||||||
We encourage people to experiment with new combinators and instances - it is
|
We encourage people to experiment with new combinators and instances - it is
|
||||||
one of the most powerful ways of using `servant`, and a wonderful way of
|
one of the most powerful ways of using `servant`, and a wonderful way of
|
||||||
getting to know it better. If you do write a new combinator, we would love to
|
getting to know it better. If you do write a new combinator, we would love to
|
||||||
know about it! Either hop on
|
know about it! Either hop on #servant on freenode and let us know, or open an
|
||||||
[#haskell-servant on libera.chat](https://web.libera.chat/#haskell-servant) and
|
issue with the `news` tag (which we will close when we read it).
|
||||||
let us know, or open an issue with the `news` tag (which we will close when we
|
|
||||||
read it).
|
|
||||||
|
|
||||||
As for adding them to the main repo: maintaining combinators can be expensive,
|
As for adding them to the main repo: maintaining combinators can be expensive,
|
||||||
since official combinators must have instances for all classes (and new classes
|
since official combinators must have instances for all classes (and new classes
|
||||||
|
|
|
@ -12,7 +12,6 @@ packages:
|
||||||
servant-docs/
|
servant-docs/
|
||||||
servant-foreign/
|
servant-foreign/
|
||||||
servant-server/
|
servant-server/
|
||||||
servant-swagger/
|
|
||||||
doc/tutorial/
|
doc/tutorial/
|
||||||
|
|
||||||
-- servant streaming
|
-- servant streaming
|
||||||
|
@ -47,8 +46,30 @@ packages:
|
||||||
doc/cookbook/using-custom-monad
|
doc/cookbook/using-custom-monad
|
||||||
doc/cookbook/using-free-client
|
doc/cookbook/using-free-client
|
||||||
-- doc/cookbook/open-id-connect
|
-- doc/cookbook/open-id-connect
|
||||||
doc/cookbook/managed-resource
|
|
||||||
|
|
||||||
tests: True
|
tests: True
|
||||||
optimization: False
|
optimization: False
|
||||||
-- reorder-goals: True
|
-- reorder-goals: True
|
||||||
|
|
||||||
|
constraints:
|
||||||
|
-- see https://github.com/haskell-infra/hackage-trustees/issues/119
|
||||||
|
foundation >=0.0.14,
|
||||||
|
memory <0.14.12 || >0.14.12
|
||||||
|
|
||||||
|
constraints: base-compat ^>=0.11
|
||||||
|
constraints: semigroups ^>=0.19
|
||||||
|
|
||||||
|
-- allow-newer: sqlite-simple-0.4.16.0:semigroups
|
||||||
|
-- allow-newer: direct-sqlite-2.3.24:semigroups
|
||||||
|
|
||||||
|
-- needed for doctests
|
||||||
|
write-ghc-environment-files: always
|
||||||
|
|
||||||
|
-- https://github.com/chordify/haskell-servant-pagination/pull/12
|
||||||
|
allow-newer: servant-pagination-2.2.2:servant
|
||||||
|
allow-newer: servant-pagination-2.2.2:servant-server
|
||||||
|
|
||||||
|
allow-newer: servant-js:servant
|
||||||
|
|
||||||
|
-- ghc 9
|
||||||
|
allow-newer: tdigest:base
|
||||||
|
|
|
@ -1,11 +0,0 @@
|
||||||
synopsis: Derive HasClient good response status from Verb status
|
|
||||||
prs: #1469
|
|
||||||
description: {
|
|
||||||
`HasClient` instances for the `Verb` datatype use `runRequest` in
|
|
||||||
`clientWithRoute` definitions.
|
|
||||||
This means that a request performed with `runClientM` will be successful if and
|
|
||||||
only if the endpoint specify a response status code >=200 and <300.
|
|
||||||
This change replaces `runRequest` with `runRequestAcceptStatus` in `Verb`
|
|
||||||
instances for the `HasClient` class, deriving the good response status from
|
|
||||||
the `Verb` status.
|
|
||||||
}
|
|
|
@ -1,10 +0,0 @@
|
||||||
synopsis: Fix performRequest in servant-client-ghcjs
|
|
||||||
prs: #1529
|
|
||||||
|
|
||||||
description: {
|
|
||||||
|
|
||||||
performRequest function in servant-client-ghcjs was not compatible with the
|
|
||||||
latest RunClient typeclass. Added the acceptStatus parameter and fixed the
|
|
||||||
functionality to match what servant-client provides.
|
|
||||||
|
|
||||||
}
|
|
|
@ -1,81 +0,0 @@
|
||||||
synopsis: Display capture hints in router layout
|
|
||||||
prs: #1556
|
|
||||||
|
|
||||||
description: {
|
|
||||||
|
|
||||||
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.
|
|
||||||
|
|
||||||
Example:
|
|
||||||
|
|
||||||
For the following API
|
|
||||||
```haskell
|
|
||||||
type API =
|
|
||||||
"a" :> "d" :> Get '[JSON] NoContent
|
|
||||||
:<|> "b" :> Capture "x" Int :> Get '[JSON] Bool
|
|
||||||
:<|> "a" :> "e" :> Get '[JSON] Int
|
|
||||||
```
|
|
||||||
|
|
||||||
we previously got the following output:
|
|
||||||
|
|
||||||
```
|
|
||||||
/
|
|
||||||
├─ a/
|
|
||||||
│ ├─ d/
|
|
||||||
│ │ └─•
|
|
||||||
│ └─ e/
|
|
||||||
│ └─•
|
|
||||||
└─ b/
|
|
||||||
└─ <capture>/
|
|
||||||
├─•
|
|
||||||
┆
|
|
||||||
└─•
|
|
||||||
```
|
|
||||||
|
|
||||||
now we get:
|
|
||||||
|
|
||||||
```
|
|
||||||
/
|
|
||||||
├─ a/
|
|
||||||
│ ├─ d/
|
|
||||||
│ │ └─•
|
|
||||||
│ └─ e/
|
|
||||||
│ └─•
|
|
||||||
└─ b/
|
|
||||||
└─ <x::Int>/
|
|
||||||
├─•
|
|
||||||
┆
|
|
||||||
└─•
|
|
||||||
```
|
|
||||||
|
|
||||||
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.
|
|
||||||
CaptureHint values are then used in routerLayout, to display the name and type of captured values, instead of just `<capture>` previously.
|
|
||||||
|
|
||||||
N.B.:
|
|
||||||
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.
|
|
||||||
|
|
||||||
This PR also introduces Spec tests for the routerLayout function.
|
|
||||||
|
|
||||||
Warning:
|
|
||||||
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`.
|
|
||||||
In those cases, the fix is easy: it suffices to add `Typeable a` to the left-hand side of the quantification constraint.
|
|
||||||
|
|
||||||
For instance, the following code will no longer compile:
|
|
||||||
```haskell
|
|
||||||
type MyAPI a = Capture "foo" a :> Get '[JSON] ()
|
|
||||||
|
|
||||||
myServer :: forall a. Server (MyAPI a)
|
|
||||||
myServer = const $ return ()
|
|
||||||
|
|
||||||
myApi :: forall a. Proxy (MyAPI a)
|
|
||||||
myApi = Proxy
|
|
||||||
|
|
||||||
app :: forall a. (FromHttpApiData a) => Application
|
|
||||||
app = serve (myApi @a) (myServer @a)
|
|
||||||
```
|
|
||||||
|
|
||||||
Indeed, `app` should be replaced with:
|
|
||||||
```haskell
|
|
||||||
app :: forall a. (FromHttpApiData a, Typeable a) => Application
|
|
||||||
app = serve (myApi @a) (myServer @a)
|
|
||||||
```
|
|
||||||
}
|
|
|
@ -1,13 +0,0 @@
|
||||||
synopsis: Encode captures using toEncodedUrlPiece
|
|
||||||
prs: #1569
|
|
||||||
issues: #1511
|
|
||||||
|
|
||||||
description: {
|
|
||||||
The `servant-client` library now makes direct use of `toEncodedUrlPiece` from `ToHttpApiData`
|
|
||||||
to encode captured values when building the request path. It gives user freedom to implement
|
|
||||||
URL-encoding however they need.
|
|
||||||
|
|
||||||
Previous behavior was to use `toUrlPiece` and URL-encode its output using `toEncodedUrlPiece`
|
|
||||||
from the `Text` instance of `ToHttpApiData`. The issue with this approach is that
|
|
||||||
`ToHttpApiData Text` is overly zealous and also encodes characters, such as `*`, which are perfectly valid in a URL.
|
|
||||||
}
|
|
|
@ -1,2 +0,0 @@
|
||||||
synopsis: Add API docs for ServerT
|
|
||||||
prs: #1573
|
|
|
@ -1,12 +0,0 @@
|
||||||
synopsis: Allow IO in validationKeys
|
|
||||||
prs: #1580
|
|
||||||
issues: #1579
|
|
||||||
|
|
||||||
description: {
|
|
||||||
|
|
||||||
Currently validationKeys are a fixed JWKSet. This does not work with OIDC
|
|
||||||
providers such as AWS Cognito or Okta, which regularly fetching jwks_uri to
|
|
||||||
discover new and expired keys.
|
|
||||||
|
|
||||||
This change alters the type of validationKeys from JWKSet to IO JWKSet.
|
|
||||||
}
|
|
|
@ -1,2 +0,0 @@
|
||||||
synopsis: Only include question mark for nonempty query strings
|
|
||||||
prs: 1589
|
|
|
@ -1,2 +0,0 @@
|
||||||
synopsis: Run ClientEnv's makeClientRequest in IO.
|
|
||||||
prs: #1595
|
|
|
@ -1,10 +0,0 @@
|
||||||
synopsis: Handle Cookies correctly for RunStreamingClient
|
|
||||||
prs: #1606
|
|
||||||
issues: #1605
|
|
||||||
|
|
||||||
description: {
|
|
||||||
|
|
||||||
Makes performWithStreamingRequest take into consideration the
|
|
||||||
CookieJar, which it previously didn't.
|
|
||||||
|
|
||||||
}
|
|
|
@ -1,2 +0,0 @@
|
||||||
synopsis: Add Functor instance to AuthHandler.
|
|
||||||
prs: #1638
|
|
|
@ -1,8 +0,0 @@
|
||||||
synopsis: Add HasStatus instance for Headers (that defers StatusOf to underlying value)
|
|
||||||
prs: #1649
|
|
||||||
|
|
||||||
description: {
|
|
||||||
|
|
||||||
Adds a new HasStatus (Headers hs a) instance (StatusOf (Headers hs a) = StatusOf a)
|
|
||||||
|
|
||||||
}
|
|
|
@ -10,7 +10,7 @@ BUILDDIR = _build
|
||||||
|
|
||||||
# Put it first so that "make" without argument is like "make help".
|
# Put it first so that "make" without argument is like "make help".
|
||||||
help:
|
help:
|
||||||
@if [ ! -d venv ]; then echo "WARNING: There is no venv directory, did you forget to 'virtualenv venv'. Check README.md."; fi
|
@if [ ! -d venv ]; then echo "WARNING: There is no venv directory, did you forget to 'virtualenv venv'. Check building-the-docs file."; fi
|
||||||
@if [ ! "z$$(which $(SPHINXBUILD))" = "z$$(pwd)/venv/bin/sphinx-build" ]; then echo "WARNING: Did you forgot to 'source venv/bin/activate'"; fi
|
@if [ ! "z$$(which $(SPHINXBUILD))" = "z$$(pwd)/venv/bin/sphinx-build" ]; then echo "WARNING: Did you forgot to 'source venv/bin/activate'"; fi
|
||||||
@$(SPHINXBUILD) -M help "$(SOURCEDIR)" "$(BUILDDIR)" $(SPHINXOPTS) $(O)
|
@$(SPHINXBUILD) -M help "$(SOURCEDIR)" "$(BUILDDIR)" $(SPHINXOPTS) $(O)
|
||||||
|
|
||||||
|
|
|
@ -46,7 +46,7 @@ master_doc = 'index'
|
||||||
|
|
||||||
# General information about the project.
|
# General information about the project.
|
||||||
project = u'Servant'
|
project = u'Servant'
|
||||||
copyright = u'2022, Servant Contributors'
|
copyright = u'2018, Servant Contributors'
|
||||||
author = u'Servant Contributors'
|
author = u'Servant Contributors'
|
||||||
|
|
||||||
# The version info for the project you're documenting, acts as replacement for
|
# The version info for the project you're documenting, acts as replacement for
|
||||||
|
@ -169,3 +169,4 @@ texinfo_documents = [
|
||||||
source_parsers = {
|
source_parsers = {
|
||||||
'.lhs': CommonMarkParser,
|
'.lhs': CommonMarkParser,
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
|
@ -1,4 +1,3 @@
|
||||||
cabal-version: 2.2
|
|
||||||
name: cookbook-basic-auth
|
name: cookbook-basic-auth
|
||||||
version: 0.1
|
version: 0.1
|
||||||
synopsis: Basic Authentication cookbook example
|
synopsis: Basic Authentication cookbook example
|
||||||
|
@ -8,6 +7,7 @@ license-file: ../../../servant/LICENSE
|
||||||
author: Servant Contributors
|
author: Servant Contributors
|
||||||
maintainer: haskell-servant-maintainers@googlegroups.com
|
maintainer: haskell-servant-maintainers@googlegroups.com
|
||||||
build-type: Simple
|
build-type: Simple
|
||||||
|
cabal-version: >=1.10
|
||||||
tested-with: GHC==8.6.5, GHC==8.8.3, GHC ==8.10.7
|
tested-with: GHC==8.6.5, GHC==8.8.3, GHC ==8.10.7
|
||||||
|
|
||||||
executable cookbook-basic-auth
|
executable cookbook-basic-auth
|
||||||
|
|
|
@ -1,4 +1,3 @@
|
||||||
cabal-version: 2.2
|
|
||||||
name: cookbook-basic-streaming
|
name: cookbook-basic-streaming
|
||||||
version: 2.1
|
version: 2.1
|
||||||
synopsis: Streaming in servant without streaming libs
|
synopsis: Streaming in servant without streaming libs
|
||||||
|
@ -8,6 +7,7 @@ license-file: ../../../servant/LICENSE
|
||||||
author: Servant Contributors
|
author: Servant Contributors
|
||||||
maintainer: haskell-servant-maintainers@googlegroups.com
|
maintainer: haskell-servant-maintainers@googlegroups.com
|
||||||
build-type: Simple
|
build-type: Simple
|
||||||
|
cabal-version: >=1.10
|
||||||
tested-with: GHC==8.6.5, GHC==8.8.3, GHC ==8.10.7
|
tested-with: GHC==8.6.5, GHC==8.8.3, GHC ==8.10.7
|
||||||
|
|
||||||
executable cookbook-basic-streaming
|
executable cookbook-basic-streaming
|
||||||
|
|
|
@ -1,4 +1,3 @@
|
||||||
cabal-version: 2.2
|
|
||||||
name: cookbook-curl-mock
|
name: cookbook-curl-mock
|
||||||
version: 0.1
|
version: 0.1
|
||||||
synopsis: Generate curl mock requests cookbook example
|
synopsis: Generate curl mock requests cookbook example
|
||||||
|
@ -8,12 +7,10 @@ license-file: ../../../servant/LICENSE
|
||||||
author: Servant Contributors
|
author: Servant Contributors
|
||||||
maintainer: haskell-servant-maintainers@googlegroups.com
|
maintainer: haskell-servant-maintainers@googlegroups.com
|
||||||
build-type: Simple
|
build-type: Simple
|
||||||
|
cabal-version: >=1.10
|
||||||
tested-with: GHC==8.6.5, GHC==8.8.3, GHC ==8.10.7
|
tested-with: GHC==8.6.5, GHC==8.8.3, GHC ==8.10.7
|
||||||
|
|
||||||
executable cookbock-curl-mock
|
executable cookbock-curl-mock
|
||||||
if impl(ghc >= 9.2)
|
|
||||||
-- generic-arbitrary is incompatible
|
|
||||||
buildable: False
|
|
||||||
main-is: CurlMock.lhs
|
main-is: CurlMock.lhs
|
||||||
build-depends: base == 4.*
|
build-depends: base == 4.*
|
||||||
, aeson
|
, aeson
|
||||||
|
|
|
@ -1,4 +1,3 @@
|
||||||
cabal-version: 2.2
|
|
||||||
name: cookbook-custom-errors
|
name: cookbook-custom-errors
|
||||||
version: 0.1
|
version: 0.1
|
||||||
synopsis: Return custom error messages from combinators
|
synopsis: Return custom error messages from combinators
|
||||||
|
@ -8,6 +7,7 @@ license-file: ../../../servant/LICENSE
|
||||||
author: Servant Contributors
|
author: Servant Contributors
|
||||||
maintainer: haskell-servant-maintainers@googlegroups.com
|
maintainer: haskell-servant-maintainers@googlegroups.com
|
||||||
build-type: Simple
|
build-type: Simple
|
||||||
|
cabal-version: >=1.10
|
||||||
tested-with: GHC==8.6.5, GHC==8.8.3, GHC ==8.10.7
|
tested-with: GHC==8.6.5, GHC==8.8.3, GHC ==8.10.7
|
||||||
|
|
||||||
executable cookbook-custom-errors
|
executable cookbook-custom-errors
|
||||||
|
|
|
@ -1,4 +1,3 @@
|
||||||
cabal-version: 2.2
|
|
||||||
name: mysql-basics
|
name: mysql-basics
|
||||||
version: 0.1.0.0
|
version: 0.1.0.0
|
||||||
synopsis: Simple MySQL API cookbook example
|
synopsis: Simple MySQL API cookbook example
|
||||||
|
@ -8,6 +7,7 @@ license-file: ../../../servant/LICENSE
|
||||||
author: Servant Contributors
|
author: Servant Contributors
|
||||||
maintainer: haskell-servant-maintainers@googlegroups.com
|
maintainer: haskell-servant-maintainers@googlegroups.com
|
||||||
build-type: Simple
|
build-type: Simple
|
||||||
|
cabal-version: >=1.10
|
||||||
|
|
||||||
executable run
|
executable run
|
||||||
hs-source-dirs: .
|
hs-source-dirs: .
|
||||||
|
|
|
@ -1,4 +1,3 @@
|
||||||
cabal-version: 2.2
|
|
||||||
name: cookbook-db-postgres-pool
|
name: cookbook-db-postgres-pool
|
||||||
version: 0.1
|
version: 0.1
|
||||||
synopsis: Simple PostgreSQL connection pool cookbook example
|
synopsis: Simple PostgreSQL connection pool cookbook example
|
||||||
|
@ -8,6 +7,7 @@ license-file: ../../../servant/LICENSE
|
||||||
author: Servant Contributors
|
author: Servant Contributors
|
||||||
maintainer: haskell-servant-maintainers@googlegroups.com
|
maintainer: haskell-servant-maintainers@googlegroups.com
|
||||||
build-type: Simple
|
build-type: Simple
|
||||||
|
cabal-version: >=1.10
|
||||||
tested-with: GHC==8.6.5, GHC==8.8.3, GHC ==8.10.7
|
tested-with: GHC==8.6.5, GHC==8.8.3, GHC ==8.10.7
|
||||||
|
|
||||||
executable cookbook-db-postgres-pool
|
executable cookbook-db-postgres-pool
|
||||||
|
|
|
@ -1,4 +1,3 @@
|
||||||
cabal-version: 2.2
|
|
||||||
name: cookbook-db-sqlite-simple
|
name: cookbook-db-sqlite-simple
|
||||||
version: 0.1
|
version: 0.1
|
||||||
synopsis: Simple SQLite DB cookbook example
|
synopsis: Simple SQLite DB cookbook example
|
||||||
|
@ -8,6 +7,7 @@ license-file: ../../../servant/LICENSE
|
||||||
author: Servant Contributors
|
author: Servant Contributors
|
||||||
maintainer: haskell-servant-maintainers@googlegroups.com
|
maintainer: haskell-servant-maintainers@googlegroups.com
|
||||||
build-type: Simple
|
build-type: Simple
|
||||||
|
cabal-version: >=1.10
|
||||||
tested-with: GHC==8.6.5, GHC==8.8.3, GHC ==8.10.7
|
tested-with: GHC==8.6.5, GHC==8.8.3, GHC ==8.10.7
|
||||||
|
|
||||||
executable cookbook-db-sqlite-simple
|
executable cookbook-db-sqlite-simple
|
||||||
|
|
|
@ -1,4 +1,3 @@
|
||||||
cabal-version: 2.2
|
|
||||||
name: cookbook-file-upload
|
name: cookbook-file-upload
|
||||||
version: 0.1
|
version: 0.1
|
||||||
synopsis: File upload cookbook example
|
synopsis: File upload cookbook example
|
||||||
|
@ -8,6 +7,7 @@ license-file: ../../../servant/LICENSE
|
||||||
author: Servant Contributors
|
author: Servant Contributors
|
||||||
maintainer: haskell-servant-maintainers@googlegroups.com
|
maintainer: haskell-servant-maintainers@googlegroups.com
|
||||||
build-type: Simple
|
build-type: Simple
|
||||||
|
cabal-version: >=1.10
|
||||||
tested-with: GHC==8.6.5, GHC==8.8.3, GHC ==8.10.7
|
tested-with: GHC==8.6.5, GHC==8.8.3, GHC ==8.10.7
|
||||||
|
|
||||||
executable cookbook-file-upload
|
executable cookbook-file-upload
|
||||||
|
|
|
@ -1,4 +1,3 @@
|
||||||
cabal-version: 2.2
|
|
||||||
name: cookbook-generic
|
name: cookbook-generic
|
||||||
version: 0.1
|
version: 0.1
|
||||||
synopsis: Using custom monad to pass a state between handlers
|
synopsis: Using custom monad to pass a state between handlers
|
||||||
|
@ -8,6 +7,7 @@ license-file: ../../../servant/LICENSE
|
||||||
author: Servant Contributors
|
author: Servant Contributors
|
||||||
maintainer: haskell-servant-maintainers@googlegroups.com
|
maintainer: haskell-servant-maintainers@googlegroups.com
|
||||||
build-type: Simple
|
build-type: Simple
|
||||||
|
cabal-version: >=1.10
|
||||||
tested-with: GHC==8.6.5, GHC==8.8.3, GHC ==8.10.7
|
tested-with: GHC==8.6.5, GHC==8.8.3, GHC ==8.10.7
|
||||||
|
|
||||||
executable cookbook-using-custom-monad
|
executable cookbook-using-custom-monad
|
||||||
|
|
|
@ -1,4 +1,3 @@
|
||||||
cabal-version: 2.2
|
|
||||||
name: cookbook-hoist-server-with-context
|
name: cookbook-hoist-server-with-context
|
||||||
version: 0.0.1
|
version: 0.0.1
|
||||||
synopsis: JWT and basic access authentication with a Custom Monad cookbook example
|
synopsis: JWT and basic access authentication with a Custom Monad cookbook example
|
||||||
|
@ -11,6 +10,7 @@ author: Servant Contributors
|
||||||
maintainer: haskell-servant-maintainers@googlegroups.com
|
maintainer: haskell-servant-maintainers@googlegroups.com
|
||||||
category: Servant
|
category: Servant
|
||||||
build-type: Simple
|
build-type: Simple
|
||||||
|
cabal-version: >=1.10
|
||||||
tested-with: GHC==8.6.5, GHC==8.8.3, GHC ==8.10.7
|
tested-with: GHC==8.6.5, GHC==8.8.3, GHC ==8.10.7
|
||||||
|
|
||||||
executable cookbook-hoist-server-with-context
|
executable cookbook-hoist-server-with-context
|
||||||
|
|
|
@ -1,4 +1,3 @@
|
||||||
cabal-version: 2.2
|
|
||||||
name: cookbook-https
|
name: cookbook-https
|
||||||
version: 0.1
|
version: 0.1
|
||||||
synopsis: HTTPS cookbook example
|
synopsis: HTTPS cookbook example
|
||||||
|
@ -8,6 +7,7 @@ license-file: ../../../servant/LICENSE
|
||||||
author: Servant Contributors
|
author: Servant Contributors
|
||||||
maintainer: haskell-servant-maintainers@googlegroups.com
|
maintainer: haskell-servant-maintainers@googlegroups.com
|
||||||
build-type: Simple
|
build-type: Simple
|
||||||
|
cabal-version: >=1.10
|
||||||
tested-with: GHC==8.6.5, GHC==8.8.3, GHC ==8.10.7
|
tested-with: GHC==8.6.5, GHC==8.8.3, GHC ==8.10.7
|
||||||
|
|
||||||
executable cookbook-https
|
executable cookbook-https
|
||||||
|
|
|
@ -6,8 +6,8 @@ how to solve many common problems with servant. If you're
|
||||||
interested in contributing examples of your own, feel free
|
interested in contributing examples of your own, feel free
|
||||||
to open an issue or a pull request on
|
to open an issue or a pull request on
|
||||||
`our github repository <https://github.com/haskell-servant/servant>`_
|
`our github repository <https://github.com/haskell-servant/servant>`_
|
||||||
or even to just get in touch with us on the `**#haskell-servant** IRC channel
|
or even to just get in touch with us on the **#servant** IRC channel
|
||||||
on libera.chat <https://web.libera.chat/#haskell-servant>_ or on
|
on freenode or on
|
||||||
`the mailing list <https://groups.google.com/forum/#!forum/haskell-servant>`_.
|
`the mailing list <https://groups.google.com/forum/#!forum/haskell-servant>`_.
|
||||||
|
|
||||||
The scope is very wide. Simple and fancy authentication schemes,
|
The scope is very wide. Simple and fancy authentication schemes,
|
||||||
|
@ -37,4 +37,3 @@ you name it!
|
||||||
sentry/Sentry.lhs
|
sentry/Sentry.lhs
|
||||||
testing/Testing.lhs
|
testing/Testing.lhs
|
||||||
open-id-connect/OpenIdConnect.lhs
|
open-id-connect/OpenIdConnect.lhs
|
||||||
managed-resource/ManagedResource.lhs
|
|
||||||
|
|
|
@ -1,4 +1,3 @@
|
||||||
cabal-version: 2.2
|
|
||||||
name: cookbook-jwt-and-basic-auth
|
name: cookbook-jwt-and-basic-auth
|
||||||
version: 0.0.1
|
version: 0.0.1
|
||||||
synopsis: JWT and basic access authentication cookbook example
|
synopsis: JWT and basic access authentication cookbook example
|
||||||
|
@ -11,6 +10,7 @@ author: Servant Contributors
|
||||||
maintainer: haskell-servant-maintainers@googlegroups.com
|
maintainer: haskell-servant-maintainers@googlegroups.com
|
||||||
category: Servant
|
category: Servant
|
||||||
build-type: Simple
|
build-type: Simple
|
||||||
|
cabal-version: >=1.10
|
||||||
tested-with: GHC==8.6.5, GHC==8.8.3, GHC ==8.10.7
|
tested-with: GHC==8.6.5, GHC==8.8.3, GHC ==8.10.7
|
||||||
|
|
||||||
executable cookbook-jwt-and-basic-auth
|
executable cookbook-jwt-and-basic-auth
|
||||||
|
|
|
@ -1,114 +0,0 @@
|
||||||
# Request-lifetime Managed Resources
|
|
||||||
|
|
||||||
Let's see how we can write a handle that uses a resource managed by Servant. The resource is created automatically by Servant when the server recieves a request, and the resource is automatically destroyed when the server is finished handling a request.
|
|
||||||
|
|
||||||
As usual, we start with a little bit of throat clearing.
|
|
||||||
|
|
||||||
|
|
||||||
``` haskell
|
|
||||||
{-# LANGUAGE DataKinds #-}
|
|
||||||
{-# LANGUAGE TypeOperators #-}
|
|
||||||
import Control.Concurrent
|
|
||||||
import Control.Exception (bracket, throwIO)
|
|
||||||
import Control.Monad.IO.Class
|
|
||||||
import Control.Monad.Trans.Resource
|
|
||||||
import Data.Acquire
|
|
||||||
import Network.HTTP.Client (newManager, defaultManagerSettings)
|
|
||||||
import Network.Wai.Handler.Warp
|
|
||||||
import Servant
|
|
||||||
import Servant.Client
|
|
||||||
import System.IO
|
|
||||||
```
|
|
||||||
|
|
||||||
Here we define an API type that uses the `WithResource` combinator. The server handler for an endpoint with a `WithResource res` component will receive a value of that type as an argument.
|
|
||||||
|
|
||||||
``` haskell
|
|
||||||
type API = WithResource Handle :> ReqBody '[PlainText] String :> Post '[JSON] NoContent
|
|
||||||
|
|
||||||
api :: Proxy API
|
|
||||||
api = Proxy
|
|
||||||
```
|
|
||||||
|
|
||||||
But this resource value has to come from somewhere. Servant obtains the value using an Acquire provided in the context. The Acquire knows how to both create and destroy resources of a particular type.
|
|
||||||
|
|
||||||
``` haskell
|
|
||||||
appContext :: Context '[Acquire Handle]
|
|
||||||
appContext = acquireHandle :. EmptyContext
|
|
||||||
|
|
||||||
acquireHandle :: Acquire Handle
|
|
||||||
acquireHandle = mkAcquire newHandle closeHandle
|
|
||||||
|
|
||||||
newHandle :: IO Handle
|
|
||||||
newHandle = do
|
|
||||||
putStrLn "opening file"
|
|
||||||
h <- openFile "test.txt" AppendMode
|
|
||||||
putStrLn "opened file"
|
|
||||||
return h
|
|
||||||
|
|
||||||
closeHandle :: Handle -> IO ()
|
|
||||||
closeHandle h = do
|
|
||||||
putStrLn "closing file"
|
|
||||||
hClose h
|
|
||||||
putStrLn "closed file"
|
|
||||||
```
|
|
||||||
|
|
||||||
Now we create the handler which will use this resource. This handler will write the request message to the System.IO.Handle which was provided to us. In some situations the handler will succeed, but in some in will fail. In either case, Servant will clean up the resource for us.
|
|
||||||
|
|
||||||
``` haskell
|
|
||||||
server :: Server API
|
|
||||||
server = writeToFile
|
|
||||||
|
|
||||||
where writeToFile :: (ReleaseKey, Handle) -> String -> Handler NoContent
|
|
||||||
writeToFile (_, h) msg = case msg of
|
|
||||||
"illegal" -> error "wait, that's illegal!"
|
|
||||||
legalMsg -> liftIO $ do
|
|
||||||
putStrLn "writing file"
|
|
||||||
hPutStrLn h legalMsg
|
|
||||||
putStrLn "wrote file"
|
|
||||||
return NoContent
|
|
||||||
```
|
|
||||||
|
|
||||||
Finally we run the server in the background while we post messages to it.
|
|
||||||
|
|
||||||
``` haskell
|
|
||||||
runApp :: IO ()
|
|
||||||
runApp = run 8080 (serveWithContext api appContext $ server)
|
|
||||||
|
|
||||||
postMsg :: String -> ClientM NoContent
|
|
||||||
postMsg = client api
|
|
||||||
|
|
||||||
main :: IO ()
|
|
||||||
main = do
|
|
||||||
mgr <- newManager defaultManagerSettings
|
|
||||||
bracket (forkIO $ runApp) killThread $ \_ -> do
|
|
||||||
ms <- flip runClientM (mkClientEnv mgr (BaseUrl Http "localhost" 8080 "")) $ do
|
|
||||||
liftIO $ putStrLn "sending hello message"
|
|
||||||
_ <- postMsg "hello"
|
|
||||||
liftIO $ putStrLn "sending illegal message"
|
|
||||||
_ <- postMsg "illegal"
|
|
||||||
liftIO $ putStrLn "done"
|
|
||||||
print ms
|
|
||||||
```
|
|
||||||
|
|
||||||
This program prints
|
|
||||||
|
|
||||||
```
|
|
||||||
sending hello message
|
|
||||||
opening file
|
|
||||||
opened file
|
|
||||||
writing file
|
|
||||||
wrote file
|
|
||||||
closing file
|
|
||||||
closed file
|
|
||||||
sending illegal message
|
|
||||||
opening file
|
|
||||||
opened file
|
|
||||||
closing file
|
|
||||||
closed file
|
|
||||||
wait, that's illegal!
|
|
||||||
CallStack (from HasCallStack):
|
|
||||||
error, called at ManagedResource.lhs:63:24 in main:Main
|
|
||||||
Left (FailureResponse (Request {requestPath = (BaseUrl {baseUrlScheme = Http, baseUrlHost = "localhost", baseUrlPort = 8080, baseUrlPath = ""},""), requestQueryString = fromList [], requestBody = Just ((),text/plain;charset=utf-8), requestAccept = fromList [], requestHeaders = fromList [], requestHttpVersion = HTTP/1.1, requestMethod = "POST"}) (Response {responseStatusCode = Status {statusCode = 500, statusMessage = "Internal Server Error"}, responseHeaders = fromList [("Transfer-Encoding","chunked"),("Date","Thu, 24 Nov 2022 21:04:47 GMT"),("Server","Warp/3.3.23"),("Content-Type","text/plain; charset=utf-8")], responseHttpVersion = HTTP/1.1, responseBody = "Something went wrong"}))
|
|
||||||
```
|
|
||||||
|
|
||||||
and appends to a file called `test.txt`. We can see from the output that when a legal message is sent, the file is opened, written to, and closed. We can also see that when an illegal message is sent, the file is opened but not written to. Crucially, it is still closed even though the handler threw an exception.
|
|
|
@ -1,30 +0,0 @@
|
||||||
cabal-version: 2.2
|
|
||||||
name: cookbook-managed-resource
|
|
||||||
version: 0.1
|
|
||||||
synopsis: Simple managed resource cookbook example
|
|
||||||
homepage: http://docs.servant.dev/
|
|
||||||
license: BSD-3-Clause
|
|
||||||
license-file: ../../../servant/LICENSE
|
|
||||||
author: Servant Contributors
|
|
||||||
maintainer: haskell-servant-maintainers@googlegroups.com
|
|
||||||
build-type: Simple
|
|
||||||
tested-with: GHC==9.4.2
|
|
||||||
|
|
||||||
executable cookbook-managed-resource
|
|
||||||
main-is: ManagedResource.lhs
|
|
||||||
build-depends: base == 4.*
|
|
||||||
, text >= 1.2
|
|
||||||
, aeson >= 1.2
|
|
||||||
, servant
|
|
||||||
, servant-client
|
|
||||||
, servant-server
|
|
||||||
, warp >= 3.2
|
|
||||||
, wai >= 3.2
|
|
||||||
, http-types >= 0.12
|
|
||||||
, markdown-unlit >= 0.4
|
|
||||||
, http-client >= 0.5
|
|
||||||
, transformers
|
|
||||||
, resourcet
|
|
||||||
default-language: Haskell2010
|
|
||||||
ghc-options: -Wall -pgmL markdown-unlit
|
|
||||||
build-tool-depends: markdown-unlit:markdown-unlit
|
|
|
@ -1,4 +1,3 @@
|
||||||
cabal-version: 2.2
|
|
||||||
name: open-id-connect
|
name: open-id-connect
|
||||||
version: 0.1
|
version: 0.1
|
||||||
synopsis: OpenId Connect with Servant example
|
synopsis: OpenId Connect with Servant example
|
||||||
|
@ -8,6 +7,7 @@ license-file: ../../../servant/LICENSE
|
||||||
author: Servant Contributors
|
author: Servant Contributors
|
||||||
maintainer: haskell-servant-maintainers@googlegroups.com
|
maintainer: haskell-servant-maintainers@googlegroups.com
|
||||||
build-type: Simple
|
build-type: Simple
|
||||||
|
cabal-version: >= 1.10
|
||||||
tested-with: GHC==8.6.5
|
tested-with: GHC==8.6.5
|
||||||
|
|
||||||
executable cookbook-openidconnect
|
executable cookbook-openidconnect
|
||||||
|
|
|
@ -330,7 +330,7 @@ data Customer = Customer {
|
||||||
```
|
```
|
||||||
|
|
||||||
Here is the code that displays the homepage.
|
Here is the code that displays the homepage.
|
||||||
It should contain a link to the `/login` URL.
|
It should contain a link to the the `/login` URL.
|
||||||
When the user clicks on this link it will be redirected to Google login page
|
When the user clicks on this link it will be redirected to Google login page
|
||||||
with some generated information.
|
with some generated information.
|
||||||
|
|
||||||
|
|
|
@ -1,4 +1,3 @@
|
||||||
cabal-version: 2.2
|
|
||||||
name: cookbook-pagination
|
name: cookbook-pagination
|
||||||
version: 2.1
|
version: 2.1
|
||||||
synopsis: Pagination with Servant example
|
synopsis: Pagination with Servant example
|
||||||
|
@ -8,6 +7,7 @@ license-file: ../../../servant/LICENSE
|
||||||
author: Servant Contributors
|
author: Servant Contributors
|
||||||
maintainer: haskell-servant-maintainers@googlegroups.com
|
maintainer: haskell-servant-maintainers@googlegroups.com
|
||||||
build-type: Simple
|
build-type: Simple
|
||||||
|
cabal-version: >=1.10
|
||||||
tested-with: GHC==8.6.5, GHC==8.8.3, GHC ==8.10.7
|
tested-with: GHC==8.6.5, GHC==8.8.3, GHC ==8.10.7
|
||||||
|
|
||||||
executable cookbook-pagination
|
executable cookbook-pagination
|
||||||
|
|
|
@ -1,4 +1,3 @@
|
||||||
cabal-version: 2.2
|
|
||||||
name: cookbook-sentry
|
name: cookbook-sentry
|
||||||
version: 0.1
|
version: 0.1
|
||||||
synopsis: Collecting runtime exceptions using Sentry
|
synopsis: Collecting runtime exceptions using Sentry
|
||||||
|
@ -8,6 +7,7 @@ license-file: ../../../servant/LICENSE
|
||||||
author: Servant Contributors
|
author: Servant Contributors
|
||||||
maintainer: haskell-servant-maintainers@googlegroups.com
|
maintainer: haskell-servant-maintainers@googlegroups.com
|
||||||
build-type: Simple
|
build-type: Simple
|
||||||
|
cabal-version: >=1.10
|
||||||
tested-with: GHC==8.6.5, GHC==8.8.3, GHC ==8.10.7
|
tested-with: GHC==8.6.5, GHC==8.8.3, GHC ==8.10.7
|
||||||
|
|
||||||
executable cookbook-sentry
|
executable cookbook-sentry
|
||||||
|
|
|
@ -1,4 +1,3 @@
|
||||||
cabal-version: 2.2
|
|
||||||
name: cookbook-structuring-apis
|
name: cookbook-structuring-apis
|
||||||
version: 0.1
|
version: 0.1
|
||||||
synopsis: Example that shows how APIs can be structured
|
synopsis: Example that shows how APIs can be structured
|
||||||
|
@ -8,6 +7,7 @@ license-file: ../../../servant/LICENSE
|
||||||
author: Servant Contributors
|
author: Servant Contributors
|
||||||
maintainer: haskell-servant-maintainers@googlegroups.com
|
maintainer: haskell-servant-maintainers@googlegroups.com
|
||||||
build-type: Simple
|
build-type: Simple
|
||||||
|
cabal-version: >=1.10
|
||||||
tested-with: GHC==8.6.5, GHC==8.8.3, GHC ==8.10.7
|
tested-with: GHC==8.6.5, GHC==8.8.3, GHC ==8.10.7
|
||||||
|
|
||||||
executable cookbook-structuring-apis
|
executable cookbook-structuring-apis
|
||||||
|
|
|
@ -1,4 +1,3 @@
|
||||||
cabal-version: 2.2
|
|
||||||
name: cookbook-testing
|
name: cookbook-testing
|
||||||
version: 0.0.1
|
version: 0.0.1
|
||||||
synopsis: Common testing patterns in Servant apps
|
synopsis: Common testing patterns in Servant apps
|
||||||
|
@ -10,6 +9,7 @@ author: Servant Contributors
|
||||||
maintainer: haskell-servant-maintainers@googlegroups.com
|
maintainer: haskell-servant-maintainers@googlegroups.com
|
||||||
category: Servant
|
category: Servant
|
||||||
build-type: Simple
|
build-type: Simple
|
||||||
|
cabal-version: >=1.10
|
||||||
tested-with: GHC==8.6.5, GHC==8.8.3, GHC ==8.10.7
|
tested-with: GHC==8.6.5, GHC==8.8.3, GHC ==8.10.7
|
||||||
|
|
||||||
executable cookbook-testing
|
executable cookbook-testing
|
||||||
|
|
|
@ -1,4 +1,3 @@
|
||||||
cabal-version: 2.2
|
|
||||||
name: cookbook-using-custom-monad
|
name: cookbook-using-custom-monad
|
||||||
version: 0.1
|
version: 0.1
|
||||||
synopsis: Using custom monad to pass a state between handlers
|
synopsis: Using custom monad to pass a state between handlers
|
||||||
|
@ -8,6 +7,7 @@ license-file: ../../../servant/LICENSE
|
||||||
author: Servant Contributors
|
author: Servant Contributors
|
||||||
maintainer: haskell-servant-maintainers@googlegroups.com
|
maintainer: haskell-servant-maintainers@googlegroups.com
|
||||||
build-type: Simple
|
build-type: Simple
|
||||||
|
cabal-version: >=1.10
|
||||||
tested-with: GHC==8.6.5, GHC==8.8.3, GHC ==8.10.7
|
tested-with: GHC==8.6.5, GHC==8.8.3, GHC ==8.10.7
|
||||||
|
|
||||||
executable cookbook-using-custom-monad
|
executable cookbook-using-custom-monad
|
||||||
|
|
|
@ -119,7 +119,7 @@ Now we can use `servant-client`'s internals to convert servant's `Request`
|
||||||
to http-client's `Request`, and we can inspect it:
|
to http-client's `Request`, and we can inspect it:
|
||||||
|
|
||||||
```haskell
|
```haskell
|
||||||
req' <- I.defaultMakeClientRequest burl req
|
let req' = I.defaultMakeClientRequest burl req
|
||||||
putStrLn $ "Making request: " ++ show req'
|
putStrLn $ "Making request: " ++ show req'
|
||||||
```
|
```
|
||||||
|
|
||||||
|
|
|
@ -1,4 +1,3 @@
|
||||||
cabal-version: 2.2
|
|
||||||
name: cookbook-using-free-client
|
name: cookbook-using-free-client
|
||||||
version: 0.1
|
version: 0.1
|
||||||
synopsis: Using Free client
|
synopsis: Using Free client
|
||||||
|
@ -8,6 +7,7 @@ license-file: ../../../servant/LICENSE
|
||||||
author: Servant Contributors
|
author: Servant Contributors
|
||||||
maintainer: haskell-servant-maintainers@googlegroups.com
|
maintainer: haskell-servant-maintainers@googlegroups.com
|
||||||
build-type: Simple
|
build-type: Simple
|
||||||
|
cabal-version: >=1.10
|
||||||
tested-with: GHC==8.6.5, GHC==8.8.3, GHC ==8.10.7
|
tested-with: GHC==8.6.5, GHC==8.8.3, GHC ==8.10.7
|
||||||
|
|
||||||
executable cookbook-using-free-client
|
executable cookbook-using-free-client
|
||||||
|
|
|
@ -199,7 +199,7 @@ parsers in the hope that the ones that should will always error out so
|
||||||
you can try until the right one returns a value.)
|
you can try until the right one returns a value.)
|
||||||
|
|
||||||
[servant-exceptions](https://github.com/ch1bo/servant-exceptions) is
|
[servant-exceptions](https://github.com/ch1bo/servant-exceptions) is
|
||||||
another shot at the problem. It is inspired by
|
another shot at at the problem. It is inspired by
|
||||||
servant-checked-exceptions, so it may be worth taking a closer look.
|
servant-checked-exceptions, so it may be worth taking a closer look.
|
||||||
The README claims that
|
The README claims that
|
||||||
[cardano-sl](https://github.com/input-output-hk/cardano-sl) also has
|
[cardano-sl](https://github.com/input-output-hk/cardano-sl) also has
|
||||||
|
|
|
@ -1,4 +1,3 @@
|
||||||
cabal-version: 2.2
|
|
||||||
name: cookbook-uverb
|
name: cookbook-uverb
|
||||||
version: 0.0.1
|
version: 0.0.1
|
||||||
synopsis: How to use the 'UVerb' type.
|
synopsis: How to use the 'UVerb' type.
|
||||||
|
@ -10,6 +9,7 @@ author: Servant Contributors
|
||||||
maintainer: haskell-servant-maintainers@googlegroups.com
|
maintainer: haskell-servant-maintainers@googlegroups.com
|
||||||
category: Servant
|
category: Servant
|
||||||
build-type: Simple
|
build-type: Simple
|
||||||
|
cabal-version: >=1.10
|
||||||
tested-with: GHC==8.6.5, GHC==8.8.4, GHC==8.10.7
|
tested-with: GHC==8.6.5, GHC==8.8.4, GHC==8.10.7
|
||||||
|
|
||||||
executable cookbook-uverb
|
executable cookbook-uverb
|
||||||
|
|
|
@ -12,7 +12,7 @@ Helpful Links
|
||||||
`https://github.com/haskell-servant/servant/issues <https://github.com/haskell-servant/servant/issues>`_
|
`https://github.com/haskell-servant/servant/issues <https://github.com/haskell-servant/servant/issues>`_
|
||||||
|
|
||||||
- the irc channel:
|
- the irc channel:
|
||||||
`#haskell-servant on libera.chat <https://web.libera.chat/#haskell-servant>`_
|
``#servant`` on freenode
|
||||||
|
|
||||||
- the mailing list:
|
- the mailing list:
|
||||||
`groups.google.com/forum/#!forum/haskell-servant <https://groups.google.com/forum/#!forum/haskell-servant>`_
|
`groups.google.com/forum/#!forum/haskell-servant <https://groups.google.com/forum/#!forum/haskell-servant>`_
|
||||||
|
|
|
@ -1,4 +1,3 @@
|
||||||
recommonmark==0.5.0
|
recommonmark==0.5.0
|
||||||
Sphinx==1.8.4
|
Sphinx==1.8.4
|
||||||
sphinx_rtd_theme>=0.4.2
|
sphinx_rtd_theme>=0.4.2
|
||||||
jinja2<3.1.0
|
|
||||||
|
|
|
@ -40,29 +40,3 @@ nix
|
||||||
`Nix <https://nixos.org/nix/>`_ users should feel free to take a look at
|
`Nix <https://nixos.org/nix/>`_ users should feel free to take a look at
|
||||||
the `nix/shell.nix` file in the repository and use it to provision a suitable
|
the `nix/shell.nix` file in the repository and use it to provision a suitable
|
||||||
environment to build and run the examples.
|
environment to build and run the examples.
|
||||||
|
|
||||||
Note for Ubuntu users
|
|
||||||
--------
|
|
||||||
|
|
||||||
Ubuntu's packages for `ghc`, `cabal`, and `stack` are years out of date.
|
|
||||||
If the instructions above fail for you,
|
|
||||||
try replacing the Ubuntu packages with up-to-date versions.
|
|
||||||
First remove the installed versions:
|
|
||||||
|
|
||||||
.. code-block:: bash
|
|
||||||
|
|
||||||
# remove the obsolete versions
|
|
||||||
$ sudo apt remove ghc haskell-stack cabal-install
|
|
||||||
|
|
||||||
Then install fresh versions of the Haskell toolchain
|
|
||||||
using the `ghcup <https://www.haskell.org/ghcup/install/>`_ installer.
|
|
||||||
|
|
||||||
As of February 2022, one easy way to do this is by running a bootstrap script:
|
|
||||||
|
|
||||||
.. code-block:: bash
|
|
||||||
|
|
||||||
$ curl --proto '=https' --tlsv1.2 -sSf https://get-ghcup.haskell.org | sh
|
|
||||||
|
|
||||||
The script is interactive and will prompt you for details about what
|
|
||||||
you want installed and where. To install manually,
|
|
||||||
see `the detailed instructions <https://www.haskell.org/ghcup/install/#manual-install>`_.
|
|
||||||
|
|
|
@ -1,4 +1,3 @@
|
||||||
cabal-version: 2.2
|
|
||||||
name: tutorial
|
name: tutorial
|
||||||
version: 0.10
|
version: 0.10
|
||||||
synopsis: The servant tutorial
|
synopsis: The servant tutorial
|
||||||
|
@ -12,6 +11,7 @@ license-file: LICENSE
|
||||||
author: Servant Contributors
|
author: Servant Contributors
|
||||||
maintainer: haskell-servant-maintainers@googlegroups.com
|
maintainer: haskell-servant-maintainers@googlegroups.com
|
||||||
build-type: Simple
|
build-type: Simple
|
||||||
|
cabal-version: >=1.10
|
||||||
tested-with:
|
tested-with:
|
||||||
GHC==8.6.5
|
GHC==8.6.5
|
||||||
GHC==8.8.3, GHC ==8.10.7
|
GHC==8.8.3, GHC ==8.10.7
|
||||||
|
@ -64,7 +64,7 @@ library
|
||||||
, blaze-markup >= 0.8.0.0 && < 0.9
|
, blaze-markup >= 0.8.0.0 && < 0.9
|
||||||
, cookie >= 0.4.3 && < 0.5
|
, cookie >= 0.4.3 && < 0.5
|
||||||
, js-jquery >= 3.3.1 && < 3.4
|
, js-jquery >= 3.3.1 && < 3.4
|
||||||
, lucid >= 2.9.11 && < 2.12
|
, lucid >= 2.9.11 && < 2.10
|
||||||
, random >= 1.1 && < 1.3
|
, random >= 1.1 && < 1.3
|
||||||
, servant-js >= 0.9 && < 0.10
|
, servant-js >= 0.9 && < 0.10
|
||||||
, time >= 1.6.0.1 && < 1.13
|
, time >= 1.6.0.1 && < 1.13
|
||||||
|
|
|
@ -1,4 +1,3 @@
|
||||||
cabal-version: 2.2
|
|
||||||
name: servant-auth-client
|
name: servant-auth-client
|
||||||
version: 0.4.1.0
|
version: 0.4.1.0
|
||||||
synopsis: servant-client/servant-auth compatibility
|
synopsis: servant-client/servant-auth compatibility
|
||||||
|
@ -7,9 +6,9 @@ description: This package provides instances that allow generating clients fr
|
||||||
APIs that use
|
APIs that use
|
||||||
<https://hackage.haskell.org/package/servant-auth servant-auth's> @Auth@ combinator.
|
<https://hackage.haskell.org/package/servant-auth servant-auth's> @Auth@ combinator.
|
||||||
.
|
.
|
||||||
For a quick overview of the usage, see the <https://github.com/haskell-servant/servant/tree/master/servant-auth#readme README>.
|
For a quick overview of the usage, see the <http://github.com/haskell-servant/servant/servant-auth#readme README>.
|
||||||
category: Web, Servant, Authentication
|
category: Web, Servant, Authentication
|
||||||
homepage: https://github.com/haskell-servant/servant/tree/master/servant-auth#readme
|
homepage: http://github.com/haskell-servant/servant/servant-auth#readme
|
||||||
bug-reports: https://github.com/haskell-servant/servant/issues
|
bug-reports: https://github.com/haskell-servant/servant/issues
|
||||||
author: Julian K. Arni
|
author: Julian K. Arni
|
||||||
maintainer: jkarni@gmail.com
|
maintainer: jkarni@gmail.com
|
||||||
|
@ -18,6 +17,7 @@ license: BSD-3-Clause
|
||||||
license-file: LICENSE
|
license-file: LICENSE
|
||||||
tested-with: GHC ==8.6.5 || ==8.8.4 || ==8.10.4 || ==9.0.1
|
tested-with: GHC ==8.6.5 || ==8.8.4 || ==8.10.4 || ==9.0.1
|
||||||
build-type: Simple
|
build-type: Simple
|
||||||
|
cabal-version: >= 1.10
|
||||||
extra-source-files:
|
extra-source-files:
|
||||||
CHANGELOG.md
|
CHANGELOG.md
|
||||||
|
|
||||||
|
@ -31,12 +31,12 @@ library
|
||||||
default-extensions: ConstraintKinds DataKinds DefaultSignatures DeriveFoldable DeriveFunctor DeriveGeneric DeriveTraversable FlexibleContexts FlexibleInstances FunctionalDependencies GADTs KindSignatures MultiParamTypeClasses OverloadedStrings RankNTypes ScopedTypeVariables TypeFamilies TypeOperators
|
default-extensions: ConstraintKinds DataKinds DefaultSignatures DeriveFoldable DeriveFunctor DeriveGeneric DeriveTraversable FlexibleContexts FlexibleInstances FunctionalDependencies GADTs KindSignatures MultiParamTypeClasses OverloadedStrings RankNTypes ScopedTypeVariables TypeFamilies TypeOperators
|
||||||
ghc-options: -Wall
|
ghc-options: -Wall
|
||||||
build-depends:
|
build-depends:
|
||||||
base >= 4.10 && < 4.18
|
base >= 4.10 && < 4.16
|
||||||
, bytestring >= 0.10.6.0 && < 0.12
|
, bytestring >= 0.10.6.0 && < 0.11
|
||||||
, containers >= 0.5.6.2 && < 0.7
|
, containers >= 0.5.6.2 && < 0.7
|
||||||
, servant-auth == 0.4.*
|
, servant-auth == 0.4.*
|
||||||
, servant >= 0.13 && < 0.20
|
, servant >= 0.13 && < 0.19
|
||||||
, servant-client-core >= 0.13 && < 0.20
|
, servant-client-core >= 0.13 && < 0.19
|
||||||
|
|
||||||
exposed-modules:
|
exposed-modules:
|
||||||
Servant.Auth.Client
|
Servant.Auth.Client
|
||||||
|
@ -50,7 +50,7 @@ test-suite spec
|
||||||
test
|
test
|
||||||
default-extensions: ConstraintKinds DataKinds DefaultSignatures DeriveFoldable DeriveFunctor DeriveGeneric DeriveTraversable FlexibleContexts FlexibleInstances FunctionalDependencies GADTs KindSignatures MultiParamTypeClasses OverloadedStrings RankNTypes ScopedTypeVariables TypeFamilies TypeOperators
|
default-extensions: ConstraintKinds DataKinds DefaultSignatures DeriveFoldable DeriveFunctor DeriveGeneric DeriveTraversable FlexibleContexts FlexibleInstances FunctionalDependencies GADTs KindSignatures MultiParamTypeClasses OverloadedStrings RankNTypes ScopedTypeVariables TypeFamilies TypeOperators
|
||||||
ghc-options: -Wall
|
ghc-options: -Wall
|
||||||
build-tool-depends: hspec-discover:hspec-discover >=2.5.5 && <2.10
|
build-tool-depends: hspec-discover:hspec-discover >=2.5.5 && <2.9
|
||||||
|
|
||||||
-- dependencies with bounds inherited from the library stanza
|
-- dependencies with bounds inherited from the library stanza
|
||||||
build-depends:
|
build-depends:
|
||||||
|
@ -62,19 +62,19 @@ test-suite spec
|
||||||
|
|
||||||
-- test dependencies
|
-- test dependencies
|
||||||
build-depends:
|
build-depends:
|
||||||
hspec >= 2.5.5 && < 2.10
|
hspec >= 2.5.5 && < 2.9
|
||||||
, QuickCheck >= 2.11.3 && < 2.15
|
, QuickCheck >= 2.11.3 && < 2.15
|
||||||
, aeson >= 1.3.1.1 && < 3
|
, aeson >= 1.3.1.1 && < 1.6
|
||||||
, bytestring >= 0.10.6.0 && < 0.12
|
, bytestring >= 0.10.6.0 && < 0.11
|
||||||
, http-client >= 0.5.13.1 && < 0.8
|
, http-client >= 0.5.13.1 && < 0.8
|
||||||
, http-types >= 0.12.2 && < 0.13
|
, http-types >= 0.12.2 && < 0.13
|
||||||
, servant-auth-server >= 0.4.2.0 && < 0.5
|
, servant-auth-server >= 0.4.2.0 && < 0.5
|
||||||
, servant-server >= 0.13 && < 0.20
|
, servant-server >= 0.13 && < 0.19
|
||||||
, time >= 1.5.0.1 && < 1.13
|
, time >= 1.5.0.1 && < 1.13
|
||||||
, transformers >= 0.4.2.0 && < 0.6
|
, transformers >= 0.4.2.0 && < 0.6
|
||||||
, wai >= 3.2.1.2 && < 3.3
|
, wai >= 3.2.1.2 && < 3.3
|
||||||
, warp >= 3.2.25 && < 3.4
|
, warp >= 3.2.25 && < 3.4
|
||||||
, jose >= 0.10 && < 0.11
|
, jose >= 0.7.0.0 && < 0.9
|
||||||
other-modules:
|
other-modules:
|
||||||
Servant.Auth.ClientSpec
|
Servant.Auth.ClientSpec
|
||||||
default-language: Haskell2010
|
default-language: Haskell2010
|
||||||
|
|
|
@ -1,4 +1,3 @@
|
||||||
cabal-version: 2.2
|
|
||||||
name: servant-auth-docs
|
name: servant-auth-docs
|
||||||
version: 0.2.10.0
|
version: 0.2.10.0
|
||||||
synopsis: servant-docs/servant-auth compatibility
|
synopsis: servant-docs/servant-auth compatibility
|
||||||
|
@ -7,9 +6,9 @@ description: This package provides instances that allow generating docs from
|
||||||
APIs that use
|
APIs that use
|
||||||
<https://hackage.haskell.org/package/servant-auth servant-auth's> @Auth@ combinator.
|
<https://hackage.haskell.org/package/servant-auth servant-auth's> @Auth@ combinator.
|
||||||
.
|
.
|
||||||
For a quick overview of the usage, see the <https://github.com/haskell-servant/servant/tree/master/servant-auth#readme README>.
|
For a quick overview of the usage, see the <http://github.com/haskell-servant/servant/servant-auth#readme README>.
|
||||||
category: Web, Servant, Authentication
|
category: Web, Servant, Authentication
|
||||||
homepage: https://github.com/haskell-servant/servant/tree/master/servant-auth#readme
|
homepage: http://github.com/haskell-servant/servant/servant-auth#readme
|
||||||
bug-reports: https://github.com/haskell-servant/servant/issues
|
bug-reports: https://github.com/haskell-servant/servant/issues
|
||||||
author: Julian K. Arni
|
author: Julian K. Arni
|
||||||
maintainer: jkarni@gmail.com
|
maintainer: jkarni@gmail.com
|
||||||
|
@ -18,6 +17,7 @@ license: BSD-3-Clause
|
||||||
license-file: LICENSE
|
license-file: LICENSE
|
||||||
tested-with: GHC ==8.6.5 || ==8.8.4 || ==8.10.4 || ==9.0.1
|
tested-with: GHC ==8.6.5 || ==8.8.4 || ==8.10.4 || ==9.0.1
|
||||||
build-type: Custom
|
build-type: Custom
|
||||||
|
cabal-version: >= 1.10
|
||||||
extra-source-files:
|
extra-source-files:
|
||||||
CHANGELOG.md
|
CHANGELOG.md
|
||||||
|
|
||||||
|
@ -35,11 +35,11 @@ library
|
||||||
default-extensions: ConstraintKinds DataKinds DefaultSignatures DeriveFoldable DeriveFunctor DeriveGeneric DeriveTraversable FlexibleContexts FlexibleInstances FunctionalDependencies GADTs KindSignatures MultiParamTypeClasses OverloadedStrings RankNTypes ScopedTypeVariables TypeFamilies TypeOperators
|
default-extensions: ConstraintKinds DataKinds DefaultSignatures DeriveFoldable DeriveFunctor DeriveGeneric DeriveTraversable FlexibleContexts FlexibleInstances FunctionalDependencies GADTs KindSignatures MultiParamTypeClasses OverloadedStrings RankNTypes ScopedTypeVariables TypeFamilies TypeOperators
|
||||||
ghc-options: -Wall
|
ghc-options: -Wall
|
||||||
build-depends:
|
build-depends:
|
||||||
base >= 4.10 && < 4.18
|
base >= 4.10 && < 4.16
|
||||||
, servant-docs >= 0.11.2 && < 0.13
|
, servant-docs >= 0.11.2 && < 0.12
|
||||||
, servant >= 0.13 && < 0.20
|
, servant >= 0.13 && < 0.19
|
||||||
, servant-auth == 0.4.*
|
, servant-auth == 0.4.*
|
||||||
, lens >= 4.16.1 && <5.3
|
, lens >= 4.16.1 && <5.1
|
||||||
exposed-modules:
|
exposed-modules:
|
||||||
Servant.Auth.Docs
|
Servant.Auth.Docs
|
||||||
default-language: Haskell2010
|
default-language: Haskell2010
|
||||||
|
@ -50,7 +50,7 @@ test-suite doctests
|
||||||
build-depends:
|
build-depends:
|
||||||
base,
|
base,
|
||||||
servant-auth-docs,
|
servant-auth-docs,
|
||||||
doctest >= 0.16 && < 0.21,
|
doctest >= 0.16 && < 0.19,
|
||||||
QuickCheck >= 2.11.3 && < 2.15,
|
QuickCheck >= 2.11.3 && < 2.15,
|
||||||
template-haskell
|
template-haskell
|
||||||
ghc-options: -Wall -threaded
|
ghc-options: -Wall -threaded
|
||||||
|
@ -64,7 +64,7 @@ test-suite spec
|
||||||
test
|
test
|
||||||
default-extensions: ConstraintKinds DataKinds DefaultSignatures DeriveFoldable DeriveFunctor DeriveGeneric DeriveTraversable FlexibleContexts FlexibleInstances FunctionalDependencies GADTs KindSignatures MultiParamTypeClasses OverloadedStrings RankNTypes ScopedTypeVariables TypeFamilies TypeOperators
|
default-extensions: ConstraintKinds DataKinds DefaultSignatures DeriveFoldable DeriveFunctor DeriveGeneric DeriveTraversable FlexibleContexts FlexibleInstances FunctionalDependencies GADTs KindSignatures MultiParamTypeClasses OverloadedStrings RankNTypes ScopedTypeVariables TypeFamilies TypeOperators
|
||||||
ghc-options: -Wall
|
ghc-options: -Wall
|
||||||
build-tool-depends: hspec-discover:hspec-discover >=2.5.5 && <2.10
|
build-tool-depends: hspec-discover:hspec-discover >=2.5.5 && <2.9
|
||||||
|
|
||||||
-- dependencies with bounds inherited from the library stanza
|
-- dependencies with bounds inherited from the library stanza
|
||||||
build-depends:
|
build-depends:
|
||||||
|
@ -78,7 +78,7 @@ test-suite spec
|
||||||
-- test dependencies
|
-- test dependencies
|
||||||
build-depends:
|
build-depends:
|
||||||
servant-auth-docs
|
servant-auth-docs
|
||||||
, hspec >= 2.5.5 && < 2.10
|
, hspec >= 2.5.5 && < 2.9
|
||||||
, QuickCheck >= 2.11.3 && < 2.15
|
, QuickCheck >= 2.11.3 && < 2.15
|
||||||
|
|
||||||
default-language: Haskell2010
|
default-language: Haskell2010
|
||||||
|
|
|
@ -1,15 +1,14 @@
|
||||||
cabal-version: 2.2
|
|
||||||
name: servant-auth-server
|
name: servant-auth-server
|
||||||
version: 0.4.7.0
|
version: 0.4.6.0
|
||||||
synopsis: servant-server/servant-auth compatibility
|
synopsis: servant-server/servant-auth compatibility
|
||||||
description: This package provides the required instances for using the @Auth@ combinator
|
description: This package provides the required instances for using the @Auth@ combinator
|
||||||
in your 'servant' server.
|
in your 'servant' server.
|
||||||
.
|
.
|
||||||
Both cookie- and token- (REST API) based authentication is provided.
|
Both cookie- and token- (REST API) based authentication is provided.
|
||||||
.
|
.
|
||||||
For a quick overview of the usage, see the <https://github.com/haskell-servant/servant/tree/master/servant-auth#readme README>.
|
For a quick overview of the usage, see the <http://github.com/haskell-servant/servant/servant-auth#readme README>.
|
||||||
category: Web, Servant, Authentication
|
category: Web, Servant, Authentication
|
||||||
homepage: https://github.com/haskell-servant/servant/tree/master/servant-auth#readme
|
homepage: http://github.com/haskell-servant/servant/servant-auth#readme
|
||||||
bug-reports: https://github.com/haskell-servant/servant/issues
|
bug-reports: https://github.com/haskell-servant/servant/issues
|
||||||
author: Julian K. Arni
|
author: Julian K. Arni
|
||||||
maintainer: jkarni@gmail.com
|
maintainer: jkarni@gmail.com
|
||||||
|
@ -18,6 +17,7 @@ license: BSD-3-Clause
|
||||||
license-file: LICENSE
|
license-file: LICENSE
|
||||||
tested-with: GHC ==8.6.5 || ==8.8.4 || ==8.10.4 || ==9.0.1
|
tested-with: GHC ==8.6.5 || ==8.8.4 || ==8.10.4 || ==9.0.1
|
||||||
build-type: Simple
|
build-type: Simple
|
||||||
|
cabal-version: >= 1.10
|
||||||
extra-source-files:
|
extra-source-files:
|
||||||
CHANGELOG.md
|
CHANGELOG.md
|
||||||
|
|
||||||
|
@ -31,27 +31,27 @@ library
|
||||||
default-extensions: ConstraintKinds DataKinds DefaultSignatures DeriveFoldable DeriveFunctor DeriveGeneric DeriveTraversable FlexibleContexts FlexibleInstances FunctionalDependencies GADTs KindSignatures MultiParamTypeClasses OverloadedStrings RankNTypes ScopedTypeVariables TypeFamilies TypeOperators
|
default-extensions: ConstraintKinds DataKinds DefaultSignatures DeriveFoldable DeriveFunctor DeriveGeneric DeriveTraversable FlexibleContexts FlexibleInstances FunctionalDependencies GADTs KindSignatures MultiParamTypeClasses OverloadedStrings RankNTypes ScopedTypeVariables TypeFamilies TypeOperators
|
||||||
ghc-options: -Wall
|
ghc-options: -Wall
|
||||||
build-depends:
|
build-depends:
|
||||||
base >= 4.10 && < 4.18
|
base >= 4.10 && < 4.16
|
||||||
, aeson >= 1.0.0.1 && < 3
|
, aeson >= 1.3.1.1 && < 1.6
|
||||||
, base64-bytestring >= 1.0.0.1 && < 2
|
, base64-bytestring >= 1.0.0.1 && < 1.3
|
||||||
, blaze-builder >= 0.4.1.0 && < 0.5
|
, blaze-builder >= 0.4.1.0 && < 0.5
|
||||||
, bytestring >= 0.10.6.0 && < 0.12
|
, bytestring >= 0.10.6.0 && < 0.11
|
||||||
, case-insensitive >= 1.2.0.11 && < 1.3
|
, case-insensitive >= 1.2.0.11 && < 1.3
|
||||||
, cookie >= 0.4.4 && < 0.5
|
, cookie >= 0.4.4 && < 0.5
|
||||||
, data-default-class >= 0.1.2.0 && < 0.2
|
, data-default-class >= 0.1.2.0 && < 0.2
|
||||||
, entropy >= 0.4.1.3 && < 0.5
|
, entropy >= 0.4.1.3 && < 0.5
|
||||||
, http-types >= 0.12.2 && < 0.13
|
, http-types >= 0.12.2 && < 0.13
|
||||||
, jose >= 0.10 && < 0.11
|
, jose >= 0.7.0.0 && < 0.9
|
||||||
, lens >= 4.16.1 && < 5.3
|
, lens >= 4.16.1 && < 5.1
|
||||||
, memory >= 0.14.16 && < 0.19
|
, memory >= 0.14.16 && < 0.17
|
||||||
, monad-time >= 0.3.1.0 && < 0.4
|
, monad-time >= 0.3.1.0 && < 0.4
|
||||||
, mtl ^>= 2.2.2 || ^>= 2.3.1
|
, mtl >= 2.2.2 && < 2.3
|
||||||
, servant >= 0.13 && < 0.20
|
, servant >= 0.13 && < 0.19
|
||||||
, servant-auth == 0.4.*
|
, servant-auth == 0.4.*
|
||||||
, servant-server >= 0.13 && < 0.20
|
, servant-server >= 0.13 && < 0.19
|
||||||
, tagged >= 0.8.4 && < 0.9
|
, tagged >= 0.8.4 && < 0.9
|
||||||
, text >= 1.2.3.0 && < 2.1
|
, text >= 1.2.3.0 && < 1.3
|
||||||
, time >= 1.5.0.1 && < 1.13
|
, time >= 1.5.0.1 && < 1.10
|
||||||
, unordered-containers >= 0.2.9.0 && < 0.3
|
, unordered-containers >= 0.2.9.0 && < 0.3
|
||||||
, wai >= 3.2.1.2 && < 3.3
|
, wai >= 3.2.1.2 && < 3.3
|
||||||
|
|
||||||
|
@ -102,7 +102,7 @@ test-suite spec
|
||||||
test
|
test
|
||||||
default-extensions: ConstraintKinds DataKinds DefaultSignatures DeriveFoldable DeriveFunctor DeriveGeneric DeriveTraversable FlexibleContexts FlexibleInstances FunctionalDependencies GADTs KindSignatures MultiParamTypeClasses OverloadedStrings RankNTypes ScopedTypeVariables TypeFamilies TypeOperators
|
default-extensions: ConstraintKinds DataKinds DefaultSignatures DeriveFoldable DeriveFunctor DeriveGeneric DeriveTraversable FlexibleContexts FlexibleInstances FunctionalDependencies GADTs KindSignatures MultiParamTypeClasses OverloadedStrings RankNTypes ScopedTypeVariables TypeFamilies TypeOperators
|
||||||
ghc-options: -Wall
|
ghc-options: -Wall
|
||||||
build-tool-depends: hspec-discover:hspec-discover >=2.5.5 && <2.10
|
build-tool-depends: hspec-discover:hspec-discover >=2.5.5 && <2.8
|
||||||
|
|
||||||
-- dependencies with bounds inherited from the library stanza
|
-- dependencies with bounds inherited from the library stanza
|
||||||
build-depends:
|
build-depends:
|
||||||
|
@ -123,10 +123,10 @@ test-suite spec
|
||||||
-- test dependencies
|
-- test dependencies
|
||||||
build-depends:
|
build-depends:
|
||||||
servant-auth-server
|
servant-auth-server
|
||||||
, hspec >= 2.5.5 && < 2.10
|
, hspec >= 2.5.5 && < 2.8
|
||||||
, QuickCheck >= 2.11.3 && < 2.15
|
, QuickCheck >= 2.11.3 && < 2.15
|
||||||
, http-client >= 0.5.13.1 && < 0.8
|
, http-client >= 0.5.13.1 && < 0.8
|
||||||
, lens-aeson >= 1.0.2 && < 1.3
|
, lens-aeson >= 1.0.2 && < 1.2
|
||||||
, warp >= 3.2.25 && < 3.4
|
, warp >= 3.2.25 && < 3.4
|
||||||
, wreq >= 0.5.2.1 && < 0.6
|
, wreq >= 0.5.2.1 && < 0.6
|
||||||
other-modules:
|
other-modules:
|
||||||
|
|
|
@ -11,8 +11,6 @@ import Data.Tagged (Tagged (..))
|
||||||
import qualified Network.HTTP.Types as HTTP
|
import qualified Network.HTTP.Types as HTTP
|
||||||
import Network.Wai (mapResponseHeaders)
|
import Network.Wai (mapResponseHeaders)
|
||||||
import Servant
|
import Servant
|
||||||
import Servant.API.Generic
|
|
||||||
import Servant.Server.Generic
|
|
||||||
import Web.Cookie
|
import Web.Cookie
|
||||||
|
|
||||||
-- What are we doing here? Well, the idea is to add headers to the response,
|
-- What are we doing here? Well, the idea is to add headers to the response,
|
||||||
|
@ -36,7 +34,6 @@ type family AddSetCookieApiVerb a where
|
||||||
type family AddSetCookieApi a :: *
|
type family AddSetCookieApi a :: *
|
||||||
type instance AddSetCookieApi (a :> b) = a :> AddSetCookieApi b
|
type instance AddSetCookieApi (a :> b) = a :> AddSetCookieApi b
|
||||||
type instance AddSetCookieApi (a :<|> b) = AddSetCookieApi a :<|> AddSetCookieApi b
|
type instance AddSetCookieApi (a :<|> b) = AddSetCookieApi a :<|> AddSetCookieApi b
|
||||||
type instance AddSetCookieApi (NamedRoutes api) = AddSetCookieApi (ToServantApi api)
|
|
||||||
type instance AddSetCookieApi (Verb method stat ctyps a)
|
type instance AddSetCookieApi (Verb method stat ctyps a)
|
||||||
= Verb method stat ctyps (AddSetCookieApiVerb a)
|
= Verb method stat ctyps (AddSetCookieApiVerb a)
|
||||||
type instance AddSetCookieApi Raw = Raw
|
type instance AddSetCookieApi Raw = Raw
|
||||||
|
@ -75,15 +72,6 @@ instance {-# OVERLAPS #-}
|
||||||
=> AddSetCookies ('S n) (a :<|> b) (a' :<|> b') where
|
=> AddSetCookies ('S n) (a :<|> b) (a' :<|> b') where
|
||||||
addSetCookies cookies (a :<|> b) = addSetCookies cookies a :<|> addSetCookies cookies b
|
addSetCookies cookies (a :<|> b) = addSetCookies cookies a :<|> addSetCookies cookies b
|
||||||
|
|
||||||
instance {-# OVERLAPS #-}
|
|
||||||
( AddSetCookies ('S n) (ServerT (ToServantApi api) m) cookiedApi
|
|
||||||
, Generic (api (AsServerT m))
|
|
||||||
, GServantProduct (Rep (api (AsServerT m)))
|
|
||||||
, ToServant api (AsServerT m) ~ ServerT (ToServantApi api) m
|
|
||||||
)
|
|
||||||
=> AddSetCookies ('S n) (api (AsServerT m)) cookiedApi where
|
|
||||||
addSetCookies cookies = addSetCookies cookies . toServant
|
|
||||||
|
|
||||||
-- | for @servant <0.11@
|
-- | for @servant <0.11@
|
||||||
instance
|
instance
|
||||||
AddSetCookies ('S n) Application Application where
|
AddSetCookies ('S n) Application Application where
|
||||||
|
|
|
@ -33,7 +33,7 @@ data JWTSettings = JWTSettings
|
||||||
-- | Algorithm used to sign JWT.
|
-- | Algorithm used to sign JWT.
|
||||||
, jwtAlg :: Maybe Jose.Alg
|
, jwtAlg :: Maybe Jose.Alg
|
||||||
-- | Keys used to validate JWT.
|
-- | Keys used to validate JWT.
|
||||||
, validationKeys :: IO Jose.JWKSet
|
, validationKeys :: Jose.JWKSet
|
||||||
-- | An @aud@ predicate. The @aud@ is a string or URI that identifies the
|
-- | An @aud@ predicate. The @aud@ is a string or URI that identifies the
|
||||||
-- intended recipient of the JWT.
|
-- intended recipient of the JWT.
|
||||||
, audienceMatches :: Jose.StringOrURI -> IsMatch
|
, audienceMatches :: Jose.StringOrURI -> IsMatch
|
||||||
|
@ -44,7 +44,7 @@ defaultJWTSettings :: Jose.JWK -> JWTSettings
|
||||||
defaultJWTSettings k = JWTSettings
|
defaultJWTSettings k = JWTSettings
|
||||||
{ signingKey = k
|
{ signingKey = k
|
||||||
, jwtAlg = Nothing
|
, jwtAlg = Nothing
|
||||||
, validationKeys = pure $ Jose.JWKSet [k]
|
, validationKeys = Jose.JWKSet [k]
|
||||||
, audienceMatches = const Matches }
|
, audienceMatches = const Matches }
|
||||||
|
|
||||||
-- | The policies to use when generating cookies.
|
-- | The policies to use when generating cookies.
|
||||||
|
|
|
@ -2,7 +2,6 @@
|
||||||
module Servant.Auth.Server.Internal.Cookie where
|
module Servant.Auth.Server.Internal.Cookie where
|
||||||
|
|
||||||
import Blaze.ByteString.Builder (toByteString)
|
import Blaze.ByteString.Builder (toByteString)
|
||||||
import Control.Monad (MonadPlus(..), guard)
|
|
||||||
import Control.Monad.Except
|
import Control.Monad.Except
|
||||||
import Control.Monad.Reader
|
import Control.Monad.Reader
|
||||||
import qualified Crypto.JOSE as Jose
|
import qualified Crypto.JOSE as Jose
|
||||||
|
|
|
@ -1,14 +1,18 @@
|
||||||
module Servant.Auth.Server.Internal.JWT where
|
module Servant.Auth.Server.Internal.JWT where
|
||||||
|
|
||||||
import Control.Lens
|
import Control.Lens
|
||||||
import Control.Monad (MonadPlus(..), guard)
|
import Control.Monad.Except
|
||||||
import Control.Monad.Reader
|
import Control.Monad.Reader
|
||||||
import qualified Crypto.JOSE as Jose
|
import qualified Crypto.JOSE as Jose
|
||||||
import qualified Crypto.JWT as Jose
|
import qualified Crypto.JWT as Jose
|
||||||
|
import Data.Aeson (FromJSON, Result (..), ToJSON, fromJSON,
|
||||||
|
toJSON)
|
||||||
import Data.ByteArray (constEq)
|
import Data.ByteArray (constEq)
|
||||||
import qualified Data.ByteString as BS
|
import qualified Data.ByteString as BS
|
||||||
import qualified Data.ByteString.Lazy as BSL
|
import qualified Data.ByteString.Lazy as BSL
|
||||||
|
import qualified Data.HashMap.Strict as HM
|
||||||
import Data.Maybe (fromMaybe)
|
import Data.Maybe (fromMaybe)
|
||||||
|
import qualified Data.Text as T
|
||||||
import Data.Time (UTCTime)
|
import Data.Time (UTCTime)
|
||||||
import Network.Wai (requestHeaders)
|
import Network.Wai (requestHeaders)
|
||||||
|
|
||||||
|
@ -38,7 +42,7 @@ jwtAuthCheck jwtSettings = do
|
||||||
-- token expires.
|
-- token expires.
|
||||||
makeJWT :: ToJWT a
|
makeJWT :: ToJWT a
|
||||||
=> a -> JWTSettings -> Maybe UTCTime -> IO (Either Jose.Error BSL.ByteString)
|
=> a -> JWTSettings -> Maybe UTCTime -> IO (Either Jose.Error BSL.ByteString)
|
||||||
makeJWT v cfg expiry = Jose.runJOSE $ do
|
makeJWT v cfg expiry = runExceptT $ do
|
||||||
bestAlg <- Jose.bestJWSAlg $ signingKey cfg
|
bestAlg <- Jose.bestJWSAlg $ signingKey cfg
|
||||||
let alg = fromMaybe bestAlg $ jwtAlg cfg
|
let alg = fromMaybe bestAlg $ jwtAlg cfg
|
||||||
ejwt <- Jose.signClaims (signingKey cfg)
|
ejwt <- Jose.signClaims (signingKey cfg)
|
||||||
|
@ -54,12 +58,11 @@ makeJWT v cfg expiry = Jose.runJOSE $ do
|
||||||
|
|
||||||
verifyJWT :: FromJWT a => JWTSettings -> BS.ByteString -> IO (Maybe a)
|
verifyJWT :: FromJWT a => JWTSettings -> BS.ByteString -> IO (Maybe a)
|
||||||
verifyJWT jwtCfg input = do
|
verifyJWT jwtCfg input = do
|
||||||
keys <- validationKeys jwtCfg
|
verifiedJWT <- liftIO $ runExceptT $ do
|
||||||
verifiedJWT <- Jose.runJOSE $ do
|
|
||||||
unverifiedJWT <- Jose.decodeCompact (BSL.fromStrict input)
|
unverifiedJWT <- Jose.decodeCompact (BSL.fromStrict input)
|
||||||
Jose.verifyClaims
|
Jose.verifyClaims
|
||||||
(jwtSettingsToJwtValidationSettings jwtCfg)
|
(jwtSettingsToJwtValidationSettings jwtCfg)
|
||||||
keys
|
(validationKeys jwtCfg)
|
||||||
unverifiedJWT
|
unverifiedJWT
|
||||||
return $ case verifiedJWT of
|
return $ case verifiedJWT of
|
||||||
Left (_ :: Jose.JWTError) -> Nothing
|
Left (_ :: Jose.JWTError) -> Nothing
|
||||||
|
|
|
@ -8,10 +8,7 @@ module Servant.Auth.Server.Internal.ThrowAll where
|
||||||
|
|
||||||
import Control.Monad.Error.Class
|
import Control.Monad.Error.Class
|
||||||
import Data.Tagged (Tagged (..))
|
import Data.Tagged (Tagged (..))
|
||||||
import Servant ((:<|>) (..), ServerError(..), NamedRoutes(..))
|
import Servant ((:<|>) (..), ServerError(..))
|
||||||
import Servant.API.Generic
|
|
||||||
import Servant.Server.Generic
|
|
||||||
import Servant.Server
|
|
||||||
import Network.HTTP.Types
|
import Network.HTTP.Types
|
||||||
import Network.Wai
|
import Network.Wai
|
||||||
|
|
||||||
|
@ -29,12 +26,6 @@ class ThrowAll a where
|
||||||
instance (ThrowAll a, ThrowAll b) => ThrowAll (a :<|> b) where
|
instance (ThrowAll a, ThrowAll b) => ThrowAll (a :<|> b) where
|
||||||
throwAll e = throwAll e :<|> throwAll e
|
throwAll e = throwAll e :<|> throwAll e
|
||||||
|
|
||||||
instance
|
|
||||||
( ThrowAll (ToServant api (AsServerT m)) , GenericServant api (AsServerT m)) =>
|
|
||||||
ThrowAll (api (AsServerT m)) where
|
|
||||||
|
|
||||||
throwAll = fromServant . throwAll
|
|
||||||
|
|
||||||
-- Really this shouldn't be necessary - ((->) a) should be an instance of
|
-- Really this shouldn't be necessary - ((->) a) should be an instance of
|
||||||
-- MonadError, no?
|
-- MonadError, no?
|
||||||
instance {-# OVERLAPPING #-} ThrowAll b => ThrowAll (a -> b) where
|
instance {-# OVERLAPPING #-} ThrowAll b => ThrowAll (a -> b) where
|
||||||
|
|
|
@ -2,7 +2,6 @@
|
||||||
module Servant.Auth.Server.Internal.Types where
|
module Servant.Auth.Server.Internal.Types where
|
||||||
|
|
||||||
import Control.Applicative
|
import Control.Applicative
|
||||||
import Control.Monad (MonadPlus(..), ap)
|
|
||||||
import Control.Monad.Reader
|
import Control.Monad.Reader
|
||||||
import Control.Monad.Time
|
import Control.Monad.Time
|
||||||
import Data.Monoid (Monoid (..))
|
import Data.Monoid (Monoid (..))
|
||||||
|
|
|
@ -6,12 +6,13 @@ module Servant.Auth.ServerSpec (spec) where
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
import Control.Lens
|
import Control.Lens
|
||||||
|
import Control.Monad.Except (runExceptT)
|
||||||
import Control.Monad.IO.Class (liftIO)
|
import Control.Monad.IO.Class (liftIO)
|
||||||
import Crypto.JOSE (Alg (HS256, None), Error,
|
import Crypto.JOSE (Alg (HS256, None), Error,
|
||||||
JWK, JWSHeader,
|
JWK, JWSHeader,
|
||||||
KeyMaterialGenParam (OctGenParam),
|
KeyMaterialGenParam (OctGenParam),
|
||||||
ToCompact, encodeCompact,
|
ToCompact, encodeCompact,
|
||||||
genJWK, newJWSHeader, runJOSE)
|
genJWK, newJWSHeader)
|
||||||
import Crypto.JWT (Audience (..), ClaimsSet,
|
import Crypto.JWT (Audience (..), ClaimsSet,
|
||||||
NumericDate (NumericDate),
|
NumericDate (NumericDate),
|
||||||
SignedJWT,
|
SignedJWT,
|
||||||
|
@ -49,7 +50,6 @@ import Network.Wreq (Options, auth, basicAuth,
|
||||||
import Network.Wreq.Types (Postable(..))
|
import Network.Wreq.Types (Postable(..))
|
||||||
import Servant hiding (BasicAuth,
|
import Servant hiding (BasicAuth,
|
||||||
IsSecure (..), header)
|
IsSecure (..), header)
|
||||||
import Servant.API.Generic ((:-))
|
|
||||||
import Servant.Auth.Server
|
import Servant.Auth.Server
|
||||||
import Servant.Auth.Server.Internal.Cookie (expireTime)
|
import Servant.Auth.Server.Internal.Cookie (expireTime)
|
||||||
import Servant.Auth.Server.SetCookieOrphan ()
|
import Servant.Auth.Server.SetCookieOrphan ()
|
||||||
|
@ -405,7 +405,6 @@ type API auths
|
||||||
= Auth auths User :>
|
= Auth auths User :>
|
||||||
( Get '[JSON] Int
|
( Get '[JSON] Int
|
||||||
:<|> ReqBody '[JSON] Int :> Post '[JSON] Int
|
:<|> ReqBody '[JSON] Int :> Post '[JSON] Int
|
||||||
:<|> NamedRoutes DummyRoutes
|
|
||||||
:<|> "header" :> Get '[JSON] (Headers '[Header "Blah" Int] Int)
|
:<|> "header" :> Get '[JSON] (Headers '[Header "Blah" Int] Int)
|
||||||
#if MIN_VERSION_servant_server(0,15,0)
|
#if MIN_VERSION_servant_server(0,15,0)
|
||||||
:<|> "stream" :> StreamGet NoFraming OctetStream (SourceIO BS.ByteString)
|
:<|> "stream" :> StreamGet NoFraming OctetStream (SourceIO BS.ByteString)
|
||||||
|
@ -417,10 +416,6 @@ type API auths
|
||||||
:<|> "logout" :> Get '[JSON] (Headers '[ Header "Set-Cookie" SetCookie
|
:<|> "logout" :> Get '[JSON] (Headers '[ Header "Set-Cookie" SetCookie
|
||||||
, Header "Set-Cookie" SetCookie ] NoContent)
|
, Header "Set-Cookie" SetCookie ] NoContent)
|
||||||
|
|
||||||
data DummyRoutes mode = DummyRoutes
|
|
||||||
{ dummyInt :: mode :- "dummy" :> Get '[JSON] Int
|
|
||||||
} deriving Generic
|
|
||||||
|
|
||||||
jwtOnlyApi :: Proxy (API '[Servant.Auth.Server.JWT])
|
jwtOnlyApi :: Proxy (API '[Servant.Auth.Server.JWT])
|
||||||
jwtOnlyApi = Proxy
|
jwtOnlyApi = Proxy
|
||||||
|
|
||||||
|
@ -481,7 +476,6 @@ server ccfg =
|
||||||
(\authResult -> case authResult of
|
(\authResult -> case authResult of
|
||||||
Authenticated usr -> getInt usr
|
Authenticated usr -> getInt usr
|
||||||
:<|> postInt usr
|
:<|> postInt usr
|
||||||
:<|> DummyRoutes { dummyInt = getInt usr }
|
|
||||||
:<|> getHeaderInt
|
:<|> getHeaderInt
|
||||||
#if MIN_VERSION_servant_server(0,15,0)
|
#if MIN_VERSION_servant_server(0,15,0)
|
||||||
:<|> return (S.source ["bytestring"])
|
:<|> return (S.source ["bytestring"])
|
||||||
|
@ -539,7 +533,7 @@ addJwtToHeader jwt = case jwt of
|
||||||
$ defaults & header "Authorization" .~ ["Bearer " <> BSL.toStrict v]
|
$ defaults & header "Authorization" .~ ["Bearer " <> BSL.toStrict v]
|
||||||
|
|
||||||
createJWT :: JWK -> JWSHeader () -> ClaimsSet -> IO (Either Error Crypto.JWT.SignedJWT)
|
createJWT :: JWK -> JWSHeader () -> ClaimsSet -> IO (Either Error Crypto.JWT.SignedJWT)
|
||||||
createJWT k a b = runJOSE $ signClaims k a b
|
createJWT k a b = runExceptT $ signClaims k a b
|
||||||
|
|
||||||
addJwtToCookie :: ToCompact a => CookieSettings -> Either Error a -> IO Options
|
addJwtToCookie :: ToCompact a => CookieSettings -> Either Error a -> IO Options
|
||||||
addJwtToCookie ccfg jwt = case jwt >>= (return . encodeCompact) of
|
addJwtToCookie ccfg jwt = case jwt >>= (return . encodeCompact) of
|
||||||
|
|
|
@ -1,4 +1,3 @@
|
||||||
cabal-version: 2.2
|
|
||||||
name: servant-auth-swagger
|
name: servant-auth-swagger
|
||||||
version: 0.2.10.1
|
version: 0.2.10.1
|
||||||
synopsis: servant-swagger/servant-auth compatibility
|
synopsis: servant-swagger/servant-auth compatibility
|
||||||
|
@ -7,9 +6,9 @@ description: This package provides instances that allow generating swagger2 s
|
||||||
APIs that use
|
APIs that use
|
||||||
<https://hackage.haskell.org/package/servant-auth servant-auth's> @Auth@ combinator.
|
<https://hackage.haskell.org/package/servant-auth servant-auth's> @Auth@ combinator.
|
||||||
.
|
.
|
||||||
For a quick overview of the usage, see the <https://github.com/haskell-servant/servant/tree/master/servant-auth#readme README>.
|
For a quick overview of the usage, see the <http://github.com/haskell-servant/servant/servant-auth#readme README>.
|
||||||
category: Web, Servant, Authentication
|
category: Web, Servant, Authentication
|
||||||
homepage: https://github.com/haskell-servant/servant/tree/master/servant-auth#readme
|
homepage: http://github.com/haskell-servant/servant/servant-auth#readme
|
||||||
bug-reports: https://github.com/haskell-servant/servant/issues
|
bug-reports: https://github.com/haskell-servant/servant/issues
|
||||||
author: Julian K. Arni
|
author: Julian K. Arni
|
||||||
maintainer: jkarni@gmail.com
|
maintainer: jkarni@gmail.com
|
||||||
|
@ -18,6 +17,7 @@ license: BSD-3-Clause
|
||||||
license-file: LICENSE
|
license-file: LICENSE
|
||||||
tested-with: GHC ==8.6.5 || ==8.8.4 || ==8.10.4
|
tested-with: GHC ==8.6.5 || ==8.8.4 || ==8.10.4
|
||||||
build-type: Simple
|
build-type: Simple
|
||||||
|
cabal-version: >= 1.10
|
||||||
extra-source-files:
|
extra-source-files:
|
||||||
CHANGELOG.md
|
CHANGELOG.md
|
||||||
|
|
||||||
|
@ -31,13 +31,15 @@ library
|
||||||
default-extensions: ConstraintKinds DataKinds DefaultSignatures DeriveFoldable DeriveFunctor DeriveGeneric DeriveTraversable FlexibleContexts FlexibleInstances FunctionalDependencies GADTs KindSignatures MultiParamTypeClasses OverloadedStrings RankNTypes ScopedTypeVariables TypeFamilies TypeOperators
|
default-extensions: ConstraintKinds DataKinds DefaultSignatures DeriveFoldable DeriveFunctor DeriveGeneric DeriveTraversable FlexibleContexts FlexibleInstances FunctionalDependencies GADTs KindSignatures MultiParamTypeClasses OverloadedStrings RankNTypes ScopedTypeVariables TypeFamilies TypeOperators
|
||||||
ghc-options: -Wall
|
ghc-options: -Wall
|
||||||
build-depends:
|
build-depends:
|
||||||
base >= 4.10 && < 4.18
|
base >= 4.10 && < 4.16
|
||||||
, text >= 1.2.3.0 && < 2.1
|
, text >= 1.2.3.0 && < 1.3
|
||||||
, servant-swagger >= 1.1.5 && < 2
|
, servant-swagger >= 1.1.5 && < 1.8
|
||||||
, swagger2 >= 2.2.2 && < 3
|
, swagger2 >= 2.2.2 && < 2.7
|
||||||
, servant >= 0.13 && < 0.20
|
, servant >= 0.13 && < 0.19
|
||||||
, servant-auth == 0.4.*
|
, servant-auth == 0.4.*
|
||||||
, lens >= 4.16.1 && < 5.3
|
, lens >= 4.16.1 && < 5.1
|
||||||
|
if impl(ghc >= 9)
|
||||||
|
buildable: False
|
||||||
exposed-modules:
|
exposed-modules:
|
||||||
Servant.Auth.Swagger
|
Servant.Auth.Swagger
|
||||||
default-language: Haskell2010
|
default-language: Haskell2010
|
||||||
|
@ -49,7 +51,7 @@ test-suite spec
|
||||||
test
|
test
|
||||||
default-extensions: ConstraintKinds DataKinds DefaultSignatures DeriveFoldable DeriveFunctor DeriveGeneric DeriveTraversable FlexibleContexts FlexibleInstances FunctionalDependencies GADTs KindSignatures MultiParamTypeClasses OverloadedStrings RankNTypes ScopedTypeVariables TypeFamilies TypeOperators
|
default-extensions: ConstraintKinds DataKinds DefaultSignatures DeriveFoldable DeriveFunctor DeriveGeneric DeriveTraversable FlexibleContexts FlexibleInstances FunctionalDependencies GADTs KindSignatures MultiParamTypeClasses OverloadedStrings RankNTypes ScopedTypeVariables TypeFamilies TypeOperators
|
||||||
ghc-options: -Wall
|
ghc-options: -Wall
|
||||||
build-tool-depends: hspec-discover:hspec-discover >= 2.5.5 && <2.10
|
build-tool-depends: hspec-discover:hspec-discover >= 2.5.5 && <2.9
|
||||||
-- dependencies with bounds inherited from the library stanza
|
-- dependencies with bounds inherited from the library stanza
|
||||||
build-depends:
|
build-depends:
|
||||||
base
|
base
|
||||||
|
@ -59,11 +61,13 @@ test-suite spec
|
||||||
, servant
|
, servant
|
||||||
, servant-auth
|
, servant-auth
|
||||||
, lens
|
, lens
|
||||||
|
if impl(ghc >= 9)
|
||||||
|
buildable: False
|
||||||
|
|
||||||
-- test dependencies
|
-- test dependencies
|
||||||
build-depends:
|
build-depends:
|
||||||
servant-auth-swagger
|
servant-auth-swagger
|
||||||
, hspec >= 2.5.5 && < 2.10
|
, hspec >= 2.5.5 && < 2.9
|
||||||
, QuickCheck >= 2.11.3 && < 2.15
|
, QuickCheck >= 2.11.3 && < 2.15
|
||||||
other-modules:
|
other-modules:
|
||||||
Servant.Auth.SwaggerSpec
|
Servant.Auth.SwaggerSpec
|
||||||
|
|
|
@ -1,6 +1,5 @@
|
||||||
cabal-version: 2.2
|
|
||||||
name: servant-auth
|
name: servant-auth
|
||||||
version: 0.4.1.0
|
version: 0.4.0.0
|
||||||
synopsis: Authentication combinators for servant
|
synopsis: Authentication combinators for servant
|
||||||
description: This package provides an @Auth@ combinator for 'servant'. This combinator
|
description: This package provides an @Auth@ combinator for 'servant'. This combinator
|
||||||
allows using different authentication schemes in a straightforward way,
|
allows using different authentication schemes in a straightforward way,
|
||||||
|
@ -9,9 +8,9 @@ description: This package provides an @Auth@ combinator for 'servant'. This c
|
||||||
'servant-auth' additionally provides concrete authentication schemes, such
|
'servant-auth' additionally provides concrete authentication schemes, such
|
||||||
as Basic Access Authentication, JSON Web Tokens, and Cookies.
|
as Basic Access Authentication, JSON Web Tokens, and Cookies.
|
||||||
.
|
.
|
||||||
For more details on how to use this, see the <https://github.com/haskell-servant/servant/tree/master/servant-auth#readme README>.
|
For more details on how to use this, see the <http://github.com/haskell-servant/servant/servant-auth#readme README>.
|
||||||
category: Web, Servant, Authentication
|
category: Web, Servant, Authentication
|
||||||
homepage: https://github.com/haskell-servant/servant/tree/master/servant-auth#readme
|
homepage: http://github.com/haskell-servant/servant/servant-auth#readme
|
||||||
bug-reports: https://github.com/haskell-servant/servant/issues
|
bug-reports: https://github.com/haskell-servant/servant/issues
|
||||||
author: Julian K. Arni
|
author: Julian K. Arni
|
||||||
maintainer: jkarni@gmail.com
|
maintainer: jkarni@gmail.com
|
||||||
|
@ -20,6 +19,7 @@ license: BSD-3-Clause
|
||||||
license-file: LICENSE
|
license-file: LICENSE
|
||||||
tested-with: GHC ==8.6.5 || ==8.8.4 || ==8.10.4 || ==9.0.1
|
tested-with: GHC ==8.6.5 || ==8.8.4 || ==8.10.4 || ==9.0.1
|
||||||
build-type: Simple
|
build-type: Simple
|
||||||
|
cabal-version: >= 1.10
|
||||||
extra-source-files:
|
extra-source-files:
|
||||||
CHANGELOG.md
|
CHANGELOG.md
|
||||||
|
|
||||||
|
@ -33,13 +33,12 @@ library
|
||||||
default-extensions: ConstraintKinds DataKinds DefaultSignatures DeriveFoldable DeriveFunctor DeriveGeneric DeriveTraversable FlexibleContexts FlexibleInstances FunctionalDependencies GADTs KindSignatures MultiParamTypeClasses OverloadedStrings RankNTypes ScopedTypeVariables TypeFamilies TypeOperators
|
default-extensions: ConstraintKinds DataKinds DefaultSignatures DeriveFoldable DeriveFunctor DeriveGeneric DeriveTraversable FlexibleContexts FlexibleInstances FunctionalDependencies GADTs KindSignatures MultiParamTypeClasses OverloadedStrings RankNTypes ScopedTypeVariables TypeFamilies TypeOperators
|
||||||
ghc-options: -Wall
|
ghc-options: -Wall
|
||||||
build-depends:
|
build-depends:
|
||||||
base >= 4.10 && < 4.18
|
base >= 4.10 && < 4.16
|
||||||
, containers >= 0.6 && < 0.7
|
, aeson >= 1.3.1.1 && < 1.6
|
||||||
, aeson >= 1.3.1.1 && < 3
|
, jose >= 0.7.0.0 && < 0.9
|
||||||
, jose >= 0.10 && < 0.11
|
, lens >= 4.16.1 && < 5.1
|
||||||
, lens >= 4.16.1 && < 5.3
|
, servant >= 0.15 && < 0.19
|
||||||
, servant >= 0.15 && < 0.20
|
, text >= 1.2.3.0 && < 1.3
|
||||||
, text >= 1.2.3.0 && < 2.1
|
|
||||||
, unordered-containers >= 0.2.9.0 && < 0.3
|
, unordered-containers >= 0.2.9.0 && < 0.3
|
||||||
exposed-modules:
|
exposed-modules:
|
||||||
Servant.Auth
|
Servant.Auth
|
||||||
|
|
|
@ -27,7 +27,7 @@ instance HasLink sub => HasLink (Auth (tag :: [*]) value :> sub) where
|
||||||
|
|
||||||
-- ** Combinators
|
-- ** Combinators
|
||||||
|
|
||||||
-- | A JSON Web Token (JWT) in the Authorization header:
|
-- | A JSON Web Token (JWT) in the the Authorization header:
|
||||||
--
|
--
|
||||||
-- @Authorization: Bearer \<token\>@
|
-- @Authorization: Bearer \<token\>@
|
||||||
--
|
--
|
||||||
|
|
|
@ -1,17 +1,10 @@
|
||||||
{-# LANGUAGE CPP #-}
|
|
||||||
|
|
||||||
module Servant.Auth.JWT where
|
module Servant.Auth.JWT where
|
||||||
|
|
||||||
import Control.Lens ((^.))
|
import Control.Lens ((^.))
|
||||||
import qualified Crypto.JWT as Jose
|
import qualified Crypto.JWT as Jose
|
||||||
import Data.Aeson (FromJSON, Result (..), ToJSON, fromJSON,
|
import Data.Aeson (FromJSON, Result (..), ToJSON, fromJSON,
|
||||||
toJSON)
|
toJSON)
|
||||||
#if MIN_VERSION_aeson(2,0,0)
|
import qualified Data.HashMap.Strict as HM
|
||||||
import qualified Data.Map as KM
|
|
||||||
#else
|
|
||||||
import qualified Data.HashMap.Strict as KM
|
|
||||||
#endif
|
|
||||||
|
|
||||||
import qualified Data.Text as T
|
import qualified Data.Text as T
|
||||||
|
|
||||||
|
|
||||||
|
@ -24,7 +17,7 @@ import qualified Data.Text as T
|
||||||
class FromJWT a where
|
class FromJWT a where
|
||||||
decodeJWT :: Jose.ClaimsSet -> Either T.Text a
|
decodeJWT :: Jose.ClaimsSet -> Either T.Text a
|
||||||
default decodeJWT :: FromJSON a => Jose.ClaimsSet -> Either T.Text a
|
default decodeJWT :: FromJSON a => Jose.ClaimsSet -> Either T.Text a
|
||||||
decodeJWT m = case KM.lookup "dat" (m ^. Jose.unregisteredClaims) of
|
decodeJWT m = case HM.lookup "dat" (m ^. Jose.unregisteredClaims) of
|
||||||
Nothing -> Left "Missing 'dat' claim"
|
Nothing -> Left "Missing 'dat' claim"
|
||||||
Just v -> case fromJSON v of
|
Just v -> case fromJSON v of
|
||||||
Error e -> Left $ T.pack e
|
Error e -> Left $ T.pack e
|
||||||
|
|
|
@ -1,37 +1,6 @@
|
||||||
[The latest version of this document is on GitHub.](https://github.com/haskell-servant/servant/blob/master/servant-client-core/CHANGELOG.md)
|
[The latest version of this document is on GitHub.](https://github.com/haskell-servant/servant/blob/master/servant-client-core/CHANGELOG.md)
|
||||||
[Changelog for `servant` package contains significant entries for all core packages.](https://github.com/haskell-servant/servant/blob/master/servant/CHANGELOG.md)
|
[Changelog for `servant` package contains significant entries for all core packages.](https://github.com/haskell-servant/servant/blob/master/servant/CHANGELOG.md)
|
||||||
|
|
||||||
Package versions follow the [Package Versioning Policy](https://pvp.haskell.org/): in A.B.C, bumps to either A or B represent major versions.
|
|
||||||
|
|
||||||
0.19
|
|
||||||
----
|
|
||||||
|
|
||||||
### Significant changes
|
|
||||||
|
|
||||||
- Drop support for GHC < 8.6.
|
|
||||||
- Support GHC 9.0 (GHC 9.2 should work as well, but isn't fully tested yet).
|
|
||||||
- Support Aeson 2 ([#1475](https://github.com/haskell-servant/servant/pull/1475)),
|
|
||||||
which fixes a [DOS vulnerability](https://github.com/haskell/aeson/issues/864)
|
|
||||||
related to hash collisions.
|
|
||||||
- Add `NamedRoutes` combinator, making support for records first-class in Servant
|
|
||||||
([#1388](https://github.com/haskell-servant/servant/pull/1388)).
|
|
||||||
- Add custom type errors for partially applied combinators
|
|
||||||
([#1289](https://github.com/haskell-servant/servant/pull/1289),
|
|
||||||
[#1486](https://github.com/haskell-servant/servant/pull/1486)).
|
|
||||||
- *servant-client* / *servant-client-core* / *servant-http-streams*: Fix
|
|
||||||
erroneous behavior, where only 2XX status codes would be considered
|
|
||||||
successful, irrelevant of the status parameter specified by the verb
|
|
||||||
combinator. ([#1469](https://github.com/haskell-servant/servant/pull/1469))
|
|
||||||
- *servant-client* / *servant-client-core*: Fix `Show` instance for
|
|
||||||
`Servant.Client.Core.Request`.
|
|
||||||
- *servant-client* / *servant-client-core*: Allow passing arbitrary binary data
|
|
||||||
in Query parameters.
|
|
||||||
([#1432](https://github.com/haskell-servant/servant/pull/1432)).
|
|
||||||
|
|
||||||
### Other changes
|
|
||||||
|
|
||||||
- Various version bumps.
|
|
||||||
|
|
||||||
0.18.3
|
0.18.3
|
||||||
------
|
------
|
||||||
|
|
||||||
|
|
|
@ -1,6 +1,6 @@
|
||||||
cabal-version: 2.2
|
cabal-version: >=1.10
|
||||||
name: servant-client-core
|
name: servant-client-core
|
||||||
version: 0.19
|
version: 0.18.3
|
||||||
|
|
||||||
synopsis: Core functionality and class for client function generation for servant APIs
|
synopsis: Core functionality and class for client function generation for servant APIs
|
||||||
category: Servant, Web
|
category: Servant, Web
|
||||||
|
@ -50,14 +50,14 @@ library
|
||||||
--
|
--
|
||||||
-- note: mtl lower bound is so low because of GHC-7.8
|
-- note: mtl lower bound is so low because of GHC-7.8
|
||||||
build-depends:
|
build-depends:
|
||||||
base >= 4.9 && < 4.18
|
base >= 4.9 && < 4.16
|
||||||
, bytestring >= 0.10.8.1 && < 0.12
|
, bytestring >= 0.10.8.1 && < 0.12
|
||||||
, constraints >= 0.2 && < 0.14
|
, constraints >= 0.2 && < 0.14
|
||||||
, containers >= 0.5.7.1 && < 0.7
|
, containers >= 0.5.7.1 && < 0.7
|
||||||
, deepseq >= 1.4.2.0 && < 1.5
|
, deepseq >= 1.4.2.0 && < 1.5
|
||||||
, text >= 1.2.3.0 && < 2.1
|
, text >= 1.2.3.0 && < 1.3
|
||||||
, transformers >= 0.5.2.0 && < 0.7
|
, transformers >= 0.5.2.0 && < 0.6
|
||||||
, template-haskell >= 2.11.1.0 && < 2.20
|
, template-haskell >= 2.11.1.0 && < 2.18
|
||||||
|
|
||||||
if !impl(ghc >= 8.2)
|
if !impl(ghc >= 8.2)
|
||||||
build-depends:
|
build-depends:
|
||||||
|
@ -65,13 +65,13 @@ library
|
||||||
|
|
||||||
-- Servant dependencies
|
-- Servant dependencies
|
||||||
build-depends:
|
build-depends:
|
||||||
servant >= 0.19
|
servant >= 0.18.3 && <0.19
|
||||||
|
|
||||||
-- Other dependencies: Lower bound around what is in the latest Stackage LTS.
|
-- Other dependencies: Lower bound around what is in the latest Stackage LTS.
|
||||||
-- Here can be exceptions if we really need features from the newer versions.
|
-- Here can be exceptions if we really need features from the newer versions.
|
||||||
build-depends:
|
build-depends:
|
||||||
aeson >= 1.4.1.0 && < 3
|
aeson >= 1.4.1.0 && < 1.6
|
||||||
, base-compat >= 0.10.5 && < 0.13
|
, base-compat >= 0.10.5 && < 0.12
|
||||||
, base64-bytestring >= 1.0.0.1 && < 1.3
|
, base64-bytestring >= 1.0.0.1 && < 1.3
|
||||||
, exceptions >= 0.10.0 && < 0.11
|
, exceptions >= 0.10.0 && < 0.11
|
||||||
, free >= 5.1 && < 5.2
|
, free >= 5.1 && < 5.2
|
||||||
|
@ -104,8 +104,8 @@ test-suite spec
|
||||||
-- Additional dependencies
|
-- Additional dependencies
|
||||||
build-depends:
|
build-depends:
|
||||||
deepseq >= 1.4.2.0 && < 1.5
|
deepseq >= 1.4.2.0 && < 1.5
|
||||||
, hspec >= 2.6.0 && < 2.10
|
, hspec >= 2.6.0 && < 2.9
|
||||||
, QuickCheck >= 2.12.6.1 && < 2.15
|
, QuickCheck >= 2.12.6.1 && < 2.15
|
||||||
|
|
||||||
build-tool-depends:
|
build-tool-depends:
|
||||||
hspec-discover:hspec-discover >= 2.6.0 && <2.10
|
hspec-discover:hspec-discover >= 2.6.0 && <2.9
|
||||||
|
|
|
@ -59,7 +59,6 @@ module Servant.Client.Core
|
||||||
, appendToPath
|
, appendToPath
|
||||||
, setRequestBodyLBS
|
, setRequestBodyLBS
|
||||||
, setRequestBody
|
, setRequestBody
|
||||||
, encodeQueryParamValue
|
|
||||||
) where
|
) where
|
||||||
import Servant.Client.Core.Auth
|
import Servant.Client.Core.Auth
|
||||||
import Servant.Client.Core.BaseUrl
|
import Servant.Client.Core.BaseUrl
|
||||||
|
|
|
@ -33,6 +33,8 @@ import Control.Arrow
|
||||||
import Control.Monad
|
import Control.Monad
|
||||||
(unless)
|
(unless)
|
||||||
import qualified Data.ByteString as BS
|
import qualified Data.ByteString as BS
|
||||||
|
import Data.ByteString.Builder
|
||||||
|
(toLazyByteString)
|
||||||
import qualified Data.ByteString.Lazy as BL
|
import qualified Data.ByteString.Lazy as BL
|
||||||
import Data.Either
|
import Data.Either
|
||||||
(partitionEithers)
|
(partitionEithers)
|
||||||
|
@ -63,7 +65,7 @@ import Data.Text
|
||||||
import Data.Proxy
|
import Data.Proxy
|
||||||
(Proxy (Proxy))
|
(Proxy (Proxy))
|
||||||
import GHC.TypeLits
|
import GHC.TypeLits
|
||||||
(KnownNat, KnownSymbol, TypeError, symbolVal)
|
(KnownSymbol, symbolVal)
|
||||||
import Network.HTTP.Types
|
import Network.HTTP.Types
|
||||||
(Status)
|
(Status)
|
||||||
import qualified Network.HTTP.Types as H
|
import qualified Network.HTTP.Types as H
|
||||||
|
@ -77,19 +79,16 @@ import Servant.API
|
||||||
NoContentVerb, QueryFlag, QueryParam', QueryParams, Raw,
|
NoContentVerb, QueryFlag, QueryParam', QueryParams, Raw,
|
||||||
ReflectMethod (..), RemoteHost, ReqBody', SBoolI, Stream,
|
ReflectMethod (..), RemoteHost, ReqBody', SBoolI, Stream,
|
||||||
StreamBody', Summary, ToHttpApiData, ToSourceIO (..), Vault,
|
StreamBody', Summary, ToHttpApiData, ToSourceIO (..), Vault,
|
||||||
Verb, WithNamedContext, WithResource, WithStatus (..), contentType, getHeadersHList,
|
Verb, WithNamedContext, WithStatus (..), contentType, getHeadersHList,
|
||||||
getResponse, toEncodedUrlPiece, toUrlPiece, NamedRoutes)
|
getResponse, toEncodedUrlPiece, toUrlPiece, NamedRoutes)
|
||||||
import Servant.API.Generic
|
import Servant.API.Generic
|
||||||
(GenericMode(..), ToServant, ToServantApi
|
(GenericMode(..), ToServant, ToServantApi
|
||||||
, GenericServant, toServant, fromServant)
|
, GenericServant, toServant, fromServant)
|
||||||
import Servant.API.ContentTypes
|
import Servant.API.ContentTypes
|
||||||
(contentTypes, AllMime (allMime), AllMimeUnrender (allMimeUnrender))
|
(contentTypes, AllMime (allMime), AllMimeUnrender (allMimeUnrender))
|
||||||
import Servant.API.Status
|
|
||||||
(statusFromNat)
|
|
||||||
import Servant.API.TypeLevel (FragmentUnique, AtLeastOneFragment)
|
import Servant.API.TypeLevel (FragmentUnique, AtLeastOneFragment)
|
||||||
import Servant.API.Modifiers
|
import Servant.API.Modifiers
|
||||||
(FoldRequired, RequiredArgument, foldRequiredArgument)
|
(FoldRequired, RequiredArgument, foldRequiredArgument)
|
||||||
import Servant.API.TypeErrors
|
|
||||||
import Servant.API.UVerb
|
import Servant.API.UVerb
|
||||||
(HasStatus, HasStatuses (Statuses, statuses), UVerb, Union, Unique, inject, statusOf, foldMapUnion, matchUnion)
|
(HasStatus, HasStatuses (Statuses, statuses), UVerb, Union, Unique, inject, statusOf, foldMapUnion, matchUnion)
|
||||||
|
|
||||||
|
@ -208,7 +207,7 @@ instance (KnownSymbol capture, ToHttpApiData a, HasClient m api)
|
||||||
clientWithRoute pm (Proxy :: Proxy api)
|
clientWithRoute pm (Proxy :: Proxy api)
|
||||||
(appendToPath p req)
|
(appendToPath p req)
|
||||||
|
|
||||||
where p = toEncodedUrlPiece val
|
where p = (toUrlPiece val)
|
||||||
|
|
||||||
hoistClientMonad pm _ f cl = \a ->
|
hoistClientMonad pm _ f cl = \a ->
|
||||||
hoistClientMonad pm (Proxy :: Proxy api) f (cl a)
|
hoistClientMonad pm (Proxy :: Proxy api) f (cl a)
|
||||||
|
@ -243,7 +242,7 @@ instance (KnownSymbol capture, ToHttpApiData a, HasClient m sublayout)
|
||||||
clientWithRoute pm (Proxy :: Proxy sublayout)
|
clientWithRoute pm (Proxy :: Proxy sublayout)
|
||||||
(foldl' (flip appendToPath) req ps)
|
(foldl' (flip appendToPath) req ps)
|
||||||
|
|
||||||
where ps = map toEncodedUrlPiece vals
|
where ps = map (toUrlPiece) vals
|
||||||
|
|
||||||
hoistClientMonad pm _ f cl = \as ->
|
hoistClientMonad pm _ f cl = \as ->
|
||||||
hoistClientMonad pm (Proxy :: Proxy sublayout) f (cl as)
|
hoistClientMonad pm (Proxy :: Proxy sublayout) f (cl as)
|
||||||
|
@ -251,11 +250,10 @@ instance (KnownSymbol capture, ToHttpApiData a, HasClient m sublayout)
|
||||||
instance {-# OVERLAPPABLE #-}
|
instance {-# OVERLAPPABLE #-}
|
||||||
-- Note [Non-Empty Content Types]
|
-- Note [Non-Empty Content Types]
|
||||||
( RunClient m, MimeUnrender ct a, ReflectMethod method, cts' ~ (ct ': cts)
|
( RunClient m, MimeUnrender ct a, ReflectMethod method, cts' ~ (ct ': cts)
|
||||||
, KnownNat status
|
|
||||||
) => HasClient m (Verb method status cts' a) where
|
) => HasClient m (Verb method status cts' a) where
|
||||||
type Client m (Verb method status cts' a) = m a
|
type Client m (Verb method status cts' a) = m a
|
||||||
clientWithRoute _pm Proxy req = do
|
clientWithRoute _pm Proxy req = do
|
||||||
response <- runRequestAcceptStatus (Just [status]) req
|
response <- runRequest req
|
||||||
{ requestAccept = fromList $ toList accept
|
{ requestAccept = fromList $ toList accept
|
||||||
, requestMethod = method
|
, requestMethod = method
|
||||||
}
|
}
|
||||||
|
@ -263,20 +261,18 @@ instance {-# OVERLAPPABLE #-}
|
||||||
where
|
where
|
||||||
accept = contentTypes (Proxy :: Proxy ct)
|
accept = contentTypes (Proxy :: Proxy ct)
|
||||||
method = reflectMethod (Proxy :: Proxy method)
|
method = reflectMethod (Proxy :: Proxy method)
|
||||||
status = statusFromNat (Proxy :: Proxy status)
|
|
||||||
|
|
||||||
hoistClientMonad _ _ f ma = f ma
|
hoistClientMonad _ _ f ma = f ma
|
||||||
|
|
||||||
instance {-# OVERLAPPING #-}
|
instance {-# OVERLAPPING #-}
|
||||||
( RunClient m, ReflectMethod method, KnownNat status
|
( RunClient m, ReflectMethod method
|
||||||
) => HasClient m (Verb method status cts NoContent) where
|
) => HasClient m (Verb method status cts NoContent) where
|
||||||
type Client m (Verb method status cts NoContent)
|
type Client m (Verb method status cts NoContent)
|
||||||
= m NoContent
|
= m NoContent
|
||||||
clientWithRoute _pm Proxy req = do
|
clientWithRoute _pm Proxy req = do
|
||||||
_response <- runRequestAcceptStatus (Just [status]) req { requestMethod = method }
|
_response <- runRequest req { requestMethod = method }
|
||||||
return NoContent
|
return NoContent
|
||||||
where method = reflectMethod (Proxy :: Proxy method)
|
where method = reflectMethod (Proxy :: Proxy method)
|
||||||
status = statusFromNat (Proxy :: Proxy status)
|
|
||||||
|
|
||||||
hoistClientMonad _ _ f ma = f ma
|
hoistClientMonad _ _ f ma = f ma
|
||||||
|
|
||||||
|
@ -293,13 +289,13 @@ instance (RunClient m, ReflectMethod method) =>
|
||||||
|
|
||||||
instance {-# OVERLAPPING #-}
|
instance {-# OVERLAPPING #-}
|
||||||
-- Note [Non-Empty Content Types]
|
-- Note [Non-Empty Content Types]
|
||||||
( RunClient m, MimeUnrender ct a, BuildHeadersTo ls, KnownNat status
|
( RunClient m, MimeUnrender ct a, BuildHeadersTo ls
|
||||||
, ReflectMethod method, cts' ~ (ct ': cts)
|
, ReflectMethod method, cts' ~ (ct ': cts)
|
||||||
) => HasClient m (Verb method status cts' (Headers ls a)) where
|
) => HasClient m (Verb method status cts' (Headers ls a)) where
|
||||||
type Client m (Verb method status cts' (Headers ls a))
|
type Client m (Verb method status cts' (Headers ls a))
|
||||||
= m (Headers ls a)
|
= m (Headers ls a)
|
||||||
clientWithRoute _pm Proxy req = do
|
clientWithRoute _pm Proxy req = do
|
||||||
response <- runRequestAcceptStatus (Just [status]) req
|
response <- runRequest req
|
||||||
{ requestMethod = method
|
{ requestMethod = method
|
||||||
, requestAccept = fromList $ toList accept
|
, requestAccept = fromList $ toList accept
|
||||||
}
|
}
|
||||||
|
@ -307,26 +303,22 @@ instance {-# OVERLAPPING #-}
|
||||||
return $ Headers { getResponse = val
|
return $ Headers { getResponse = val
|
||||||
, getHeadersHList = buildHeadersTo . toList $ responseHeaders response
|
, getHeadersHList = buildHeadersTo . toList $ responseHeaders response
|
||||||
}
|
}
|
||||||
where
|
where method = reflectMethod (Proxy :: Proxy method)
|
||||||
method = reflectMethod (Proxy :: Proxy method)
|
|
||||||
accept = contentTypes (Proxy :: Proxy ct)
|
accept = contentTypes (Proxy :: Proxy ct)
|
||||||
status = statusFromNat (Proxy :: Proxy status)
|
|
||||||
|
|
||||||
hoistClientMonad _ _ f ma = f ma
|
hoistClientMonad _ _ f ma = f ma
|
||||||
|
|
||||||
instance {-# OVERLAPPING #-}
|
instance {-# OVERLAPPING #-}
|
||||||
( RunClient m, BuildHeadersTo ls, ReflectMethod method, KnownNat status
|
( RunClient m, BuildHeadersTo ls, ReflectMethod method
|
||||||
) => HasClient m (Verb method status cts (Headers ls NoContent)) where
|
) => HasClient m (Verb method status cts (Headers ls NoContent)) where
|
||||||
type Client m (Verb method status cts (Headers ls NoContent))
|
type Client m (Verb method status cts (Headers ls NoContent))
|
||||||
= m (Headers ls NoContent)
|
= m (Headers ls NoContent)
|
||||||
clientWithRoute _pm Proxy req = do
|
clientWithRoute _pm Proxy req = do
|
||||||
response <- runRequestAcceptStatus (Just [status]) req { requestMethod = method }
|
let method = reflectMethod (Proxy :: Proxy method)
|
||||||
|
response <- runRequest req { requestMethod = method }
|
||||||
return $ Headers { getResponse = NoContent
|
return $ Headers { getResponse = NoContent
|
||||||
, getHeadersHList = buildHeadersTo . toList $ responseHeaders response
|
, getHeadersHList = buildHeadersTo . toList $ responseHeaders response
|
||||||
}
|
}
|
||||||
where
|
|
||||||
method = reflectMethod (Proxy :: Proxy method)
|
|
||||||
status = statusFromNat (Proxy :: Proxy status)
|
|
||||||
|
|
||||||
hoistClientMonad _ _ f ma = f ma
|
hoistClientMonad _ _ f ma = f ma
|
||||||
|
|
||||||
|
@ -569,7 +561,7 @@ instance (KnownSymbol sym, ToHttpApiData a, HasClient m api, SBoolI (FoldRequire
|
||||||
(Proxy :: Proxy mods) add (maybe req add) mparam
|
(Proxy :: Proxy mods) add (maybe req add) mparam
|
||||||
where
|
where
|
||||||
add :: a -> Request
|
add :: a -> Request
|
||||||
add param = appendToQueryString pname (Just $ encodeQueryParamValue param) req
|
add param = appendToQueryString pname (Just $ encodeQueryParam param) req
|
||||||
|
|
||||||
pname :: Text
|
pname :: Text
|
||||||
pname = pack $ symbolVal (Proxy :: Proxy sym)
|
pname = pack $ symbolVal (Proxy :: Proxy sym)
|
||||||
|
@ -577,6 +569,9 @@ instance (KnownSymbol sym, ToHttpApiData a, HasClient m api, SBoolI (FoldRequire
|
||||||
hoistClientMonad pm _ f cl = \arg ->
|
hoistClientMonad pm _ f cl = \arg ->
|
||||||
hoistClientMonad pm (Proxy :: Proxy api) f (cl arg)
|
hoistClientMonad pm (Proxy :: Proxy api) f (cl arg)
|
||||||
|
|
||||||
|
encodeQueryParam :: ToHttpApiData a => a -> BS.ByteString
|
||||||
|
encodeQueryParam = BL.toStrict . toLazyByteString . toEncodedUrlPiece
|
||||||
|
|
||||||
-- | If you use a 'QueryParams' in one of your endpoints in your API,
|
-- | If you use a 'QueryParams' in one of your endpoints in your API,
|
||||||
-- the corresponding querying function will automatically take
|
-- the corresponding querying function will automatically take
|
||||||
-- an additional argument, a list of values of the type specified
|
-- an additional argument, a list of values of the type specified
|
||||||
|
@ -618,7 +613,7 @@ instance (KnownSymbol sym, ToHttpApiData a, HasClient m api)
|
||||||
)
|
)
|
||||||
|
|
||||||
where pname = pack $ symbolVal (Proxy :: Proxy sym)
|
where pname = pack $ symbolVal (Proxy :: Proxy sym)
|
||||||
paramlist' = map (Just . encodeQueryParamValue) paramlist
|
paramlist' = map (Just . encodeQueryParam) paramlist
|
||||||
|
|
||||||
hoistClientMonad pm _ f cl = \as ->
|
hoistClientMonad pm _ f cl = \as ->
|
||||||
hoistClientMonad pm (Proxy :: Proxy api) f (cl as)
|
hoistClientMonad pm (Proxy :: Proxy api) f (cl as)
|
||||||
|
@ -740,7 +735,7 @@ instance (KnownSymbol path, HasClient m api) => HasClient m (path :> api) where
|
||||||
clientWithRoute pm (Proxy :: Proxy api)
|
clientWithRoute pm (Proxy :: Proxy api)
|
||||||
(appendToPath p req)
|
(appendToPath p req)
|
||||||
|
|
||||||
where p = toEncodedUrlPiece $ pack $ symbolVal (Proxy :: Proxy path)
|
where p = pack $ symbolVal (Proxy :: Proxy path)
|
||||||
|
|
||||||
hoistClientMonad pm _ f cl = hoistClientMonad pm (Proxy :: Proxy api) f cl
|
hoistClientMonad pm _ f cl = hoistClientMonad pm (Proxy :: Proxy api) f cl
|
||||||
|
|
||||||
|
@ -776,14 +771,6 @@ instance HasClient m subapi =>
|
||||||
|
|
||||||
hoistClientMonad pm _ f cl = hoistClientMonad pm (Proxy :: Proxy subapi) f cl
|
hoistClientMonad pm _ f cl = hoistClientMonad pm (Proxy :: Proxy subapi) f cl
|
||||||
|
|
||||||
instance HasClient m subapi =>
|
|
||||||
HasClient m (WithResource res :> subapi) where
|
|
||||||
|
|
||||||
type Client m (WithResource res :> subapi) = Client m subapi
|
|
||||||
clientWithRoute pm Proxy = clientWithRoute pm (Proxy :: Proxy subapi)
|
|
||||||
|
|
||||||
hoistClientMonad pm _ f cl = hoistClientMonad pm (Proxy :: Proxy subapi) f cl
|
|
||||||
|
|
||||||
instance ( HasClient m api
|
instance ( HasClient m api
|
||||||
) => HasClient m (AuthProtect tag :> api) where
|
) => HasClient m (AuthProtect tag :> api) where
|
||||||
type Client m (AuthProtect tag :> api)
|
type Client m (AuthProtect tag :> api)
|
||||||
|
@ -882,7 +869,7 @@ infixl 2 /:
|
||||||
--
|
--
|
||||||
-- Example:
|
-- Example:
|
||||||
--
|
--
|
||||||
-- @
|
-- @@
|
||||||
-- type Api = NamedRoutes RootApi
|
-- type Api = NamedRoutes RootApi
|
||||||
--
|
--
|
||||||
-- data RootApi mode = RootApi
|
-- data RootApi mode = RootApi
|
||||||
|
@ -902,8 +889,8 @@ infixl 2 /:
|
||||||
-- rootClient = client api
|
-- rootClient = client api
|
||||||
--
|
--
|
||||||
-- endpointClient :: ClientM Person
|
-- endpointClient :: ClientM Person
|
||||||
-- endpointClient = client \/\/ subApi \/\/ endpoint
|
-- endpointClient = client // subApi // endpoint
|
||||||
-- @
|
-- @@
|
||||||
(//) :: a -> (a -> b) -> b
|
(//) :: a -> (a -> b) -> b
|
||||||
x // f = f x
|
x // f = f x
|
||||||
|
|
||||||
|
@ -914,7 +901,7 @@ x // f = f x
|
||||||
--
|
--
|
||||||
-- Example:
|
-- Example:
|
||||||
--
|
--
|
||||||
-- @
|
-- @@
|
||||||
-- type Api = NamedRoutes RootApi
|
-- type Api = NamedRoutes RootApi
|
||||||
--
|
--
|
||||||
-- data RootApi mode = RootApi
|
-- data RootApi mode = RootApi
|
||||||
|
@ -935,11 +922,11 @@ x // f = f x
|
||||||
-- rootClient = client api
|
-- rootClient = client api
|
||||||
--
|
--
|
||||||
-- hello :: String -> ClientM String
|
-- hello :: String -> ClientM String
|
||||||
-- hello name = rootClient \/\/ hello \/: name
|
-- hello name = rootClient // hello /: name
|
||||||
--
|
--
|
||||||
-- endpointClient :: ClientM Person
|
-- endpointClient :: ClientM Person
|
||||||
-- endpointClient = client \/\/ subApi \/: "foobar123" \/\/ endpoint
|
-- endpointClient = client // subApi /: "foobar123" // endpoint
|
||||||
-- @
|
-- @@
|
||||||
(/:) :: (a -> b -> c) -> b -> a -> c
|
(/:) :: (a -> b -> c) -> b -> a -> c
|
||||||
(/:) = flip
|
(/:) = flip
|
||||||
|
|
||||||
|
@ -983,19 +970,3 @@ decodedAs response ct = do
|
||||||
Right val -> return val
|
Right val -> return val
|
||||||
where
|
where
|
||||||
accept = toList $ contentTypes ct
|
accept = toList $ contentTypes ct
|
||||||
|
|
||||||
-------------------------------------------------------------------------------
|
|
||||||
-- Custom type errors
|
|
||||||
-------------------------------------------------------------------------------
|
|
||||||
|
|
||||||
-- Erroring instance for HasClient' when a combinator is not fully applied
|
|
||||||
instance (RunClient m, TypeError (PartialApplication HasClient arr)) => HasClient m ((arr :: a -> b) :> sub)
|
|
||||||
where
|
|
||||||
type Client m (arr :> sub) = TypeError (PartialApplication HasClient arr)
|
|
||||||
clientWithRoute _ _ _ = error "unreachable"
|
|
||||||
hoistClientMonad _ _ _ _ = error "unreachable"
|
|
||||||
|
|
||||||
-- Erroring instances for 'HasClient' for unknown API combinators
|
|
||||||
instance {-# OVERLAPPABLE #-} (RunClient m, TypeError (NoInstanceForSub (HasClient m) ty)) => HasClient m (ty :> sub)
|
|
||||||
|
|
||||||
instance {-# OVERLAPPABLE #-} (RunClient m, TypeError (NoInstanceFor (HasClient m api))) => HasClient m api
|
|
||||||
|
|
|
@ -17,7 +17,6 @@ module Servant.Client.Core.Request (
|
||||||
addHeader,
|
addHeader,
|
||||||
appendToPath,
|
appendToPath,
|
||||||
appendToQueryString,
|
appendToQueryString,
|
||||||
encodeQueryParamValue,
|
|
||||||
setRequestBody,
|
setRequestBody,
|
||||||
setRequestBodyLBS,
|
setRequestBodyLBS,
|
||||||
) where
|
) where
|
||||||
|
@ -34,8 +33,6 @@ import Data.Bifunctor
|
||||||
import Data.Bitraversable
|
import Data.Bitraversable
|
||||||
(Bitraversable (..), bifoldMapDefault, bimapDefault)
|
(Bitraversable (..), bifoldMapDefault, bimapDefault)
|
||||||
import qualified Data.ByteString as BS
|
import qualified Data.ByteString as BS
|
||||||
import Data.ByteString.Builder
|
|
||||||
(Builder)
|
|
||||||
import qualified Data.ByteString.Builder as Builder
|
import qualified Data.ByteString.Builder as Builder
|
||||||
import qualified Data.ByteString.Lazy as LBS
|
import qualified Data.ByteString.Lazy as LBS
|
||||||
import qualified Data.Sequence as Seq
|
import qualified Data.Sequence as Seq
|
||||||
|
@ -81,13 +78,12 @@ instance (Show a, Show b) =>
|
||||||
. showString ", requestAccept = "
|
. showString ", requestAccept = "
|
||||||
. showsPrec 0 (requestAccept req)
|
. showsPrec 0 (requestAccept req)
|
||||||
. showString ", requestHeaders = "
|
. showString ", requestHeaders = "
|
||||||
. showsPrec 0 (redactSensitiveHeader <$> requestHeaders req)
|
. showsPrec 0 (redactSensitiveHeader <$> requestHeaders req))
|
||||||
. showString ", requestHttpVersion = "
|
. showString ", requestHttpVersion = "
|
||||||
. showsPrec 0 (requestHttpVersion req)
|
. showsPrec 0 (requestHttpVersion req)
|
||||||
. showString ", requestMethod = "
|
. showString ", requestMethod = "
|
||||||
. showsPrec 0 (requestMethod req)
|
. showsPrec 0 (requestMethod req)
|
||||||
. showString "}"
|
. showString "}"
|
||||||
)
|
|
||||||
where
|
where
|
||||||
redactSensitiveHeader :: Header -> Header
|
redactSensitiveHeader :: Header -> Header
|
||||||
redactSensitiveHeader ("Authorization", _) = ("Authorization", "<REDACTED>")
|
redactSensitiveHeader ("Authorization", _) = ("Authorization", "<REDACTED>")
|
||||||
|
@ -114,7 +110,7 @@ instance (NFData path, NFData body) => NFData (RequestF body path) where
|
||||||
rnfB Nothing = ()
|
rnfB Nothing = ()
|
||||||
rnfB (Just (b, mt)) = rnf b `seq` mediaTypeRnf mt
|
rnfB (Just (b, mt)) = rnf b `seq` mediaTypeRnf mt
|
||||||
|
|
||||||
type Request = RequestF RequestBody Builder
|
type Request = RequestF RequestBody Builder.Builder
|
||||||
|
|
||||||
-- | The request body. R replica of the @http-client@ @RequestBody@.
|
-- | The request body. R replica of the @http-client@ @RequestBody@.
|
||||||
data RequestBody
|
data RequestBody
|
||||||
|
@ -145,30 +141,18 @@ defaultRequest = Request
|
||||||
, requestMethod = methodGet
|
, requestMethod = methodGet
|
||||||
}
|
}
|
||||||
|
|
||||||
-- | Append extra path to the request being constructed.
|
appendToPath :: Text -> Request -> Request
|
||||||
--
|
|
||||||
-- Warning: This function assumes that the path fragment is already URL-encoded.
|
|
||||||
appendToPath :: Builder -> Request -> Request
|
|
||||||
appendToPath p req
|
appendToPath p req
|
||||||
= req { requestPath = requestPath req <> "/" <> p }
|
= req { requestPath = requestPath req <> "/" <> toEncodedUrlPiece p }
|
||||||
|
|
||||||
-- | Append a query parameter to the request being constructed.
|
appendToQueryString :: Text -- ^ param name
|
||||||
--
|
-> Maybe BS.ByteString -- ^ param value
|
||||||
appendToQueryString :: Text -- ^ query param name
|
|
||||||
-> Maybe BS.ByteString -- ^ query param value
|
|
||||||
-> Request
|
-> Request
|
||||||
-> Request
|
-> Request
|
||||||
appendToQueryString pname pvalue req
|
appendToQueryString pname pvalue req
|
||||||
= req { requestQueryString = requestQueryString req
|
= req { requestQueryString = requestQueryString req
|
||||||
Seq.|> (encodeUtf8 pname, pvalue)}
|
Seq.|> (encodeUtf8 pname, pvalue)}
|
||||||
|
|
||||||
-- | Encode a query parameter value.
|
|
||||||
--
|
|
||||||
encodeQueryParamValue :: ToHttpApiData a => a -> BS.ByteString
|
|
||||||
encodeQueryParamValue = LBS.toStrict . Builder.toLazyByteString . toEncodedUrlPiece
|
|
||||||
|
|
||||||
-- | Add header to the request being constructed.
|
|
||||||
--
|
|
||||||
addHeader :: ToHttpApiData a => HeaderName -> a -> Request -> Request
|
addHeader :: ToHttpApiData a => HeaderName -> a -> Request -> Request
|
||||||
addHeader name val req
|
addHeader name val req
|
||||||
= req { requestHeaders = requestHeaders req Seq.|> (name, toHeader val)}
|
= req { requestHeaders = requestHeaders req Seq.|> (name, toHeader val)}
|
||||||
|
|
|
@ -10,22 +10,10 @@ import Data.List (isInfixOf)
|
||||||
import Servant.Client.Core.Request
|
import Servant.Client.Core.Request
|
||||||
import Test.Hspec
|
import Test.Hspec
|
||||||
|
|
||||||
newtype DataWithRequest = DataWithRequest (RequestF RequestBody ())
|
|
||||||
deriving Show
|
|
||||||
|
|
||||||
spec :: Spec
|
spec :: Spec
|
||||||
spec = do
|
spec = do
|
||||||
describe "Request" $ do
|
describe "Request" $ do
|
||||||
describe "show" $ do
|
describe "show" $ do
|
||||||
it "has parenthesis correctly positioned" $ do
|
|
||||||
let d = DataWithRequest (void defaultRequest)
|
|
||||||
show d `shouldBe` "DataWithRequest (Request {requestPath = ()\
|
|
||||||
\, requestQueryString = fromList []\
|
|
||||||
\, requestBody = Nothing\
|
|
||||||
\, requestAccept = fromList []\
|
|
||||||
\, requestHeaders = fromList []\
|
|
||||||
\, requestHttpVersion = HTTP/1.1\
|
|
||||||
\, requestMethod = \"GET\"})"
|
|
||||||
it "redacts the authorization header" $ do
|
it "redacts the authorization header" $ do
|
||||||
let request = void $ defaultRequest { requestHeaders = pure ("authorization", "secret") }
|
let request = void $ defaultRequest { requestHeaders = pure ("authorization", "secret") }
|
||||||
isInfixOf "secret" (show request) `shouldBe` False
|
isInfixOf "secret" (show request) `shouldBe` False
|
||||||
|
|
|
@ -1,4 +1,4 @@
|
||||||
cabal-version: 2.2
|
cabal-version: >=1.10
|
||||||
name: servant-client-ghcjs
|
name: servant-client-ghcjs
|
||||||
version: 0.16
|
version: 0.16
|
||||||
synopsis:
|
synopsis:
|
||||||
|
@ -38,7 +38,7 @@ library
|
||||||
Servant.Client.Internal.XhrClient
|
Servant.Client.Internal.XhrClient
|
||||||
|
|
||||||
build-depends:
|
build-depends:
|
||||||
base >=4.11 && <5
|
base >=4.11 && <4.12
|
||||||
, bytestring >=0.10 && <0.12
|
, bytestring >=0.10 && <0.12
|
||||||
, case-insensitive >=1.2.0.0 && <1.3.0.0
|
, case-insensitive >=1.2.0.0 && <1.3.0.0
|
||||||
, containers >=0.5 && <0.7
|
, containers >=0.5 && <0.7
|
||||||
|
@ -48,7 +48,7 @@ library
|
||||||
, http-media >=0.6.2 && <0.9
|
, http-media >=0.6.2 && <0.9
|
||||||
, http-types >=0.12 && <0.13
|
, http-types >=0.12 && <0.13
|
||||||
, monad-control >=1.0.0.4 && <1.1
|
, monad-control >=1.0.0.4 && <1.1
|
||||||
, mtl ^>=2.2.2 || ^>=2.3.1
|
, mtl >=2.2.2 && <2.3
|
||||||
, semigroupoids >=5.3 && <5.4
|
, semigroupoids >=5.3 && <5.4
|
||||||
, string-conversions >=0.3 && <0.5
|
, string-conversions >=0.3 && <0.5
|
||||||
, transformers >=0.3 && <0.6
|
, transformers >=0.3 && <0.6
|
||||||
|
@ -56,8 +56,8 @@ library
|
||||||
|
|
||||||
-- strict, as we re-export stuff
|
-- strict, as we re-export stuff
|
||||||
build-depends:
|
build-depends:
|
||||||
servant >=0.16 && <0.20
|
servant >=0.16 && <0.17
|
||||||
, servant-client-core >=0.16 && <0.20
|
, servant-client-core >=0.16 && <0.16.1
|
||||||
|
|
||||||
hs-source-dirs: src
|
hs-source-dirs: src
|
||||||
default-language: Haskell2010
|
default-language: Haskell2010
|
||||||
|
|
|
@ -120,7 +120,7 @@ instance Exception StreamingNotSupportedException where
|
||||||
displayException _ = "streamingRequest: streaming is not supported!"
|
displayException _ = "streamingRequest: streaming is not supported!"
|
||||||
|
|
||||||
instance RunClient ClientM where
|
instance RunClient ClientM where
|
||||||
runRequestAcceptStatus = performRequest
|
runRequest = performRequest
|
||||||
throwClientError = throwError
|
throwClientError = throwError
|
||||||
|
|
||||||
runClientMOrigin :: ClientM a -> ClientEnv -> IO (Either ClientError a)
|
runClientMOrigin :: ClientM a -> ClientEnv -> IO (Either ClientError a)
|
||||||
|
@ -152,18 +152,15 @@ runClientM m = do
|
||||||
|
|
||||||
runClientMOrigin m (ClientEnv (BaseUrl protocol hostname port ""))
|
runClientMOrigin m (ClientEnv (BaseUrl protocol hostname port ""))
|
||||||
|
|
||||||
performRequest :: Maybe [Status] -> Request -> ClientM Response
|
performRequest :: Request -> ClientM Response
|
||||||
performRequest acceptStatus req = do
|
performRequest req = do
|
||||||
xhr <- liftIO initXhr
|
xhr <- liftIO initXhr
|
||||||
burl <- asks baseUrl
|
burl <- asks baseUrl
|
||||||
liftIO $ performXhr xhr burl req
|
liftIO $ performXhr xhr burl req
|
||||||
resp <- toResponse xhr
|
resp <- toResponse xhr
|
||||||
|
|
||||||
let status = responseStatusCode resp
|
let status = statusCode (responseStatusCode resp)
|
||||||
goodStatus = case acceptStatus of
|
unless (status >= 200 && status < 300) $ do
|
||||||
Nothing -> statusIsSuccessful status
|
|
||||||
Just good -> status `elem` good
|
|
||||||
unless goodStatus $ do
|
|
||||||
let f b = (burl, BL.toStrict $ toLazyByteString b)
|
let f b = (burl, BL.toStrict $ toLazyByteString b)
|
||||||
throwError $ FailureResponse (bimap (const ()) f req) resp
|
throwError $ FailureResponse (bimap (const ()) f req) resp
|
||||||
|
|
||||||
|
|
|
@ -1,37 +1,6 @@
|
||||||
[The latest version of this document is on GitHub.](https://github.com/haskell-servant/servant/blob/master/servant-client/CHANGELOG.md)
|
[The latest version of this document is on GitHub.](https://github.com/haskell-servant/servant/blob/master/servant-client/CHANGELOG.md)
|
||||||
[Changelog for `servant` package contains significant entries for all core packages.](https://github.com/haskell-servant/servant/blob/master/servant/CHANGELOG.md)
|
[Changelog for `servant` package contains significant entries for all core packages.](https://github.com/haskell-servant/servant/blob/master/servant/CHANGELOG.md)
|
||||||
|
|
||||||
Package versions follow the [Package Versioning Policy](https://pvp.haskell.org/): in A.B.C, bumps to either A or B represent major versions.
|
|
||||||
|
|
||||||
0.19
|
|
||||||
----
|
|
||||||
|
|
||||||
### Significant changes
|
|
||||||
|
|
||||||
- Drop support for GHC < 8.6.
|
|
||||||
- Support GHC 9.0 (GHC 9.2 should work as well, but isn't fully tested yet).
|
|
||||||
- Support Aeson 2 ([#1475](https://github.com/haskell-servant/servant/pull/1475)),
|
|
||||||
which fixes a [DOS vulnerability](https://github.com/haskell/aeson/issues/864)
|
|
||||||
related to hash collisions.
|
|
||||||
- Add `NamedRoutes` combinator, making support for records first-class in Servant
|
|
||||||
([#1388](https://github.com/haskell-servant/servant/pull/1388)).
|
|
||||||
- Add custom type errors for partially applied combinators
|
|
||||||
([#1289](https://github.com/haskell-servant/servant/pull/1289),
|
|
||||||
[#1486](https://github.com/haskell-servant/servant/pull/1486)).
|
|
||||||
- *servant-client* / *servant-client-core* / *servant-http-streams*: Fix
|
|
||||||
erroneous behavior, where only 2XX status codes would be considered
|
|
||||||
successful, irrelevant of the status parameter specified by the verb
|
|
||||||
combinator. ([#1469](https://github.com/haskell-servant/servant/pull/1469))
|
|
||||||
- *servant-client* / *servant-client-core*: Fix `Show` instance for
|
|
||||||
`Servant.Client.Core.Request`.
|
|
||||||
- *servant-client* / *servant-client-core*: Allow passing arbitrary binary data
|
|
||||||
in Query parameters.
|
|
||||||
([#1432](https://github.com/haskell-servant/servant/pull/1432)).
|
|
||||||
|
|
||||||
### Other changes
|
|
||||||
|
|
||||||
- Various version bumps.
|
|
||||||
|
|
||||||
0.18.3
|
0.18.3
|
||||||
------
|
------
|
||||||
|
|
||||||
|
|
|
@ -1,6 +1,6 @@
|
||||||
cabal-version: 2.2
|
cabal-version: >=1.10
|
||||||
name: servant-client
|
name: servant-client
|
||||||
version: 0.19
|
version: 0.18.3
|
||||||
|
|
||||||
synopsis: Automatic derivation of querying functions for servant
|
synopsis: Automatic derivation of querying functions for servant
|
||||||
category: Servant, Web
|
category: Servant, Web
|
||||||
|
@ -41,15 +41,15 @@ library
|
||||||
-- Bundled with GHC: Lower bound to not force re-installs
|
-- Bundled with GHC: Lower bound to not force re-installs
|
||||||
-- text and mtl are bundled starting with GHC-8.4
|
-- text and mtl are bundled starting with GHC-8.4
|
||||||
build-depends:
|
build-depends:
|
||||||
base >= 4.9 && < 4.18
|
base >= 4.9 && < 4.16
|
||||||
, bytestring >= 0.10.8.1 && < 0.12
|
, bytestring >= 0.10.8.1 && < 0.12
|
||||||
, containers >= 0.5.7.1 && < 0.7
|
, containers >= 0.5.7.1 && < 0.7
|
||||||
, deepseq >= 1.4.2.0 && < 1.5
|
, deepseq >= 1.4.2.0 && < 1.5
|
||||||
, mtl ^>= 2.2.2 || ^>= 2.3.1
|
, mtl >= 2.2.2 && < 2.3
|
||||||
, stm >= 2.4.5.1 && < 2.6
|
, stm >= 2.4.5.1 && < 2.6
|
||||||
, text >= 1.2.3.0 && < 2.1
|
, text >= 1.2.3.0 && < 1.3
|
||||||
, time >= 1.6.0.1 && < 1.13
|
, time >= 1.6.0.1 && < 1.10
|
||||||
, transformers >= 0.5.2.0 && < 0.7
|
, transformers >= 0.5.2.0 && < 0.6
|
||||||
|
|
||||||
if !impl(ghc >= 8.2)
|
if !impl(ghc >= 8.2)
|
||||||
build-depends:
|
build-depends:
|
||||||
|
@ -58,13 +58,13 @@ library
|
||||||
-- Servant dependencies.
|
-- Servant dependencies.
|
||||||
-- Strict dependency on `servant-client-core` as we re-export things.
|
-- Strict dependency on `servant-client-core` as we re-export things.
|
||||||
build-depends:
|
build-depends:
|
||||||
servant >= 0.18 && < 0.20
|
servant == 0.18.*
|
||||||
, servant-client-core >= 0.19 && < 0.19.1
|
, servant-client-core >= 0.18.3 && <0.18.4
|
||||||
|
|
||||||
-- Other dependencies: Lower bound around what is in the latest Stackage LTS.
|
-- Other dependencies: Lower bound around what is in the latest Stackage LTS.
|
||||||
-- Here can be exceptions if we really need features from the newer versions.
|
-- Here can be exceptions if we really need features from the newer versions.
|
||||||
build-depends:
|
build-depends:
|
||||||
base-compat >= 0.10.5 && < 0.13
|
base-compat >= 0.10.5 && < 0.12
|
||||||
, http-client >= 0.5.13.1 && < 0.8
|
, http-client >= 0.5.13.1 && < 0.8
|
||||||
, http-media >= 0.7.1.3 && < 0.9
|
, http-media >= 0.7.1.3 && < 0.9
|
||||||
, http-types >= 0.12.2 && < 0.13
|
, http-types >= 0.12.2 && < 0.13
|
||||||
|
@ -89,7 +89,6 @@ test-suite spec
|
||||||
main-is: Spec.hs
|
main-is: Spec.hs
|
||||||
other-modules:
|
other-modules:
|
||||||
Servant.BasicAuthSpec
|
Servant.BasicAuthSpec
|
||||||
Servant.BrokenSpec
|
|
||||||
Servant.ClientTestUtils
|
Servant.ClientTestUtils
|
||||||
Servant.ConnectionErrorSpec
|
Servant.ConnectionErrorSpec
|
||||||
Servant.FailSpec
|
Servant.FailSpec
|
||||||
|
@ -124,16 +123,16 @@ test-suite spec
|
||||||
-- Additional dependencies
|
-- Additional dependencies
|
||||||
build-depends:
|
build-depends:
|
||||||
entropy >= 0.4.1.3 && < 0.5
|
entropy >= 0.4.1.3 && < 0.5
|
||||||
, hspec >= 2.6.0 && < 2.10
|
, hspec >= 2.6.0 && < 2.9
|
||||||
, HUnit >= 1.6.0.0 && < 1.7
|
, HUnit >= 1.6.0.0 && < 1.7
|
||||||
, network >= 2.8.0.0 && < 3.2
|
, network >= 2.8.0.0 && < 3.2
|
||||||
, QuickCheck >= 2.12.6.1 && < 2.15
|
, QuickCheck >= 2.12.6.1 && < 2.15
|
||||||
, servant == 0.19.*
|
, servant == 0.18.*
|
||||||
, servant-server == 0.19.*
|
, servant-server == 0.18.*
|
||||||
, tdigest >= 0.2 && < 0.3
|
, tdigest >= 0.2 && < 0.3
|
||||||
|
|
||||||
build-tool-depends:
|
build-tool-depends:
|
||||||
hspec-discover:hspec-discover >= 2.6.0 && < 2.10
|
hspec-discover:hspec-discover >= 2.6.0 && < 2.9
|
||||||
|
|
||||||
test-suite readme
|
test-suite readme
|
||||||
type: exitcode-stdio-1.0
|
type: exitcode-stdio-1.0
|
||||||
|
|
|
@ -24,7 +24,7 @@ import Control.Monad
|
||||||
import Control.Monad.Base
|
import Control.Monad.Base
|
||||||
(MonadBase (..))
|
(MonadBase (..))
|
||||||
import Control.Monad.Catch
|
import Control.Monad.Catch
|
||||||
(MonadCatch, MonadThrow, MonadMask)
|
(MonadCatch, MonadThrow)
|
||||||
import Control.Monad.Error.Class
|
import Control.Monad.Error.Class
|
||||||
(MonadError (..))
|
(MonadError (..))
|
||||||
import Control.Monad.IO.Class
|
import Control.Monad.IO.Class
|
||||||
|
@ -63,7 +63,7 @@ import GHC.Generics
|
||||||
import Network.HTTP.Media
|
import Network.HTTP.Media
|
||||||
(renderHeader)
|
(renderHeader)
|
||||||
import Network.HTTP.Types
|
import Network.HTTP.Types
|
||||||
(hContentType, renderQuery, statusIsSuccessful, urlEncode, Status)
|
(hContentType, renderQuery, statusCode, urlEncode, Status)
|
||||||
import Servant.Client.Core
|
import Servant.Client.Core
|
||||||
|
|
||||||
import qualified Network.HTTP.Client as Client
|
import qualified Network.HTTP.Client as Client
|
||||||
|
@ -80,7 +80,7 @@ data ClientEnv
|
||||||
{ manager :: Client.Manager
|
{ manager :: Client.Manager
|
||||||
, baseUrl :: BaseUrl
|
, baseUrl :: BaseUrl
|
||||||
, cookieJar :: Maybe (TVar Client.CookieJar)
|
, cookieJar :: Maybe (TVar Client.CookieJar)
|
||||||
, makeClientRequest :: BaseUrl -> Request -> IO Client.Request
|
, makeClientRequest :: BaseUrl -> Request -> Client.Request
|
||||||
-- ^ this function can be used to customize the creation of @http-client@ requests from @servant@ requests. Default value: 'defaultMakeClientRequest'
|
-- ^ this function can be used to customize the creation of @http-client@ requests from @servant@ requests. Default value: 'defaultMakeClientRequest'
|
||||||
-- Note that:
|
-- Note that:
|
||||||
-- 1. 'makeClientRequest' exists to allow overriding operational semantics e.g. 'responseTimeout' per request,
|
-- 1. 'makeClientRequest' exists to allow overriding operational semantics e.g. 'responseTimeout' per request,
|
||||||
|
@ -136,7 +136,7 @@ newtype ClientM a = ClientM
|
||||||
{ unClientM :: ReaderT ClientEnv (ExceptT ClientError IO) a }
|
{ unClientM :: ReaderT ClientEnv (ExceptT ClientError IO) a }
|
||||||
deriving ( Functor, Applicative, Monad, MonadIO, Generic
|
deriving ( Functor, Applicative, Monad, MonadIO, Generic
|
||||||
, MonadReader ClientEnv, MonadError ClientError, MonadThrow
|
, MonadReader ClientEnv, MonadError ClientError, MonadThrow
|
||||||
, MonadCatch, MonadMask)
|
, MonadCatch)
|
||||||
|
|
||||||
instance MonadBase IO ClientM where
|
instance MonadBase IO ClientM where
|
||||||
liftBase = ClientM . liftBase
|
liftBase = ClientM . liftBase
|
||||||
|
@ -162,7 +162,7 @@ runClientM cm env = runExceptT $ flip runReaderT env $ unClientM cm
|
||||||
performRequest :: Maybe [Status] -> Request -> ClientM Response
|
performRequest :: Maybe [Status] -> Request -> ClientM Response
|
||||||
performRequest acceptStatus req = do
|
performRequest acceptStatus req = do
|
||||||
ClientEnv m burl cookieJar' createClientRequest <- ask
|
ClientEnv m burl cookieJar' createClientRequest <- ask
|
||||||
clientRequest <- liftIO $ createClientRequest burl req
|
let clientRequest = createClientRequest burl req
|
||||||
request <- case cookieJar' of
|
request <- case cookieJar' of
|
||||||
Nothing -> pure clientRequest
|
Nothing -> pure clientRequest
|
||||||
Just cj -> liftIO $ do
|
Just cj -> liftIO $ do
|
||||||
|
@ -179,9 +179,10 @@ performRequest acceptStatus req = do
|
||||||
|
|
||||||
response <- maybe (requestWithoutCookieJar m request) (requestWithCookieJar m request) cookieJar'
|
response <- maybe (requestWithoutCookieJar m request) (requestWithCookieJar m request) cookieJar'
|
||||||
let status = Client.responseStatus response
|
let status = Client.responseStatus response
|
||||||
|
status_code = statusCode status
|
||||||
ourResponse = clientResponseToResponse id response
|
ourResponse = clientResponseToResponse id response
|
||||||
goodStatus = case acceptStatus of
|
goodStatus = case acceptStatus of
|
||||||
Nothing -> statusIsSuccessful status
|
Nothing -> status_code >= 200 && status_code < 300
|
||||||
Just good -> status `elem` good
|
Just good -> status `elem` good
|
||||||
unless goodStatus $ do
|
unless goodStatus $ do
|
||||||
throwError $ mkFailureResponse burl req ourResponse
|
throwError $ mkFailureResponse burl req ourResponse
|
||||||
|
@ -229,8 +230,8 @@ clientResponseToResponse f r = Response
|
||||||
-- | Create a @http-client@ 'Client.Request' from a @servant@ 'Request'
|
-- | Create a @http-client@ 'Client.Request' from a @servant@ 'Request'
|
||||||
-- The 'Client.host', 'Client.path' and 'Client.port' fields are extracted from the 'BaseUrl'
|
-- The 'Client.host', 'Client.path' and 'Client.port' fields are extracted from the 'BaseUrl'
|
||||||
-- otherwise the body, headers and query string are derived from the @servant@ 'Request'
|
-- otherwise the body, headers and query string are derived from the @servant@ 'Request'
|
||||||
defaultMakeClientRequest :: BaseUrl -> Request -> IO Client.Request
|
defaultMakeClientRequest :: BaseUrl -> Request -> Client.Request
|
||||||
defaultMakeClientRequest burl r = return Client.defaultRequest
|
defaultMakeClientRequest burl r = Client.defaultRequest
|
||||||
{ Client.method = requestMethod r
|
{ Client.method = requestMethod r
|
||||||
, Client.host = fromString $ baseUrlHost burl
|
, Client.host = fromString $ baseUrlHost burl
|
||||||
, Client.port = baseUrlPort burl
|
, Client.port = baseUrlPort burl
|
||||||
|
@ -289,8 +290,7 @@ defaultMakeClientRequest burl r = return Client.defaultRequest
|
||||||
Https -> True
|
Https -> True
|
||||||
|
|
||||||
-- Query string builder which does not do any encoding
|
-- Query string builder which does not do any encoding
|
||||||
buildQueryString [] = mempty
|
buildQueryString = ("?" <>) . foldl' addQueryParam mempty
|
||||||
buildQueryString qps = "?" <> foldl' addQueryParam mempty qps
|
|
||||||
|
|
||||||
addQueryParam qs (k, v) =
|
addQueryParam qs (k, v) =
|
||||||
qs <> (if BS.null qs then mempty else "&") <> urlEncode True k <> foldMap ("=" <>) v
|
qs <> (if BS.null qs then mempty else "&") <> urlEncode True k <> foldMap ("=" <>) v
|
||||||
|
|
|
@ -24,8 +24,7 @@ import Control.DeepSeq
|
||||||
(NFData, force)
|
(NFData, force)
|
||||||
import Control.Exception
|
import Control.Exception
|
||||||
(evaluate, throwIO)
|
(evaluate, throwIO)
|
||||||
import Control.Monad
|
import Control.Monad ()
|
||||||
(unless)
|
|
||||||
import Control.Monad.Base
|
import Control.Monad.Base
|
||||||
(MonadBase (..))
|
(MonadBase (..))
|
||||||
import Control.Monad.Codensity
|
import Control.Monad.Codensity
|
||||||
|
@ -48,7 +47,7 @@ import Data.Time.Clock
|
||||||
(getCurrentTime)
|
(getCurrentTime)
|
||||||
import GHC.Generics
|
import GHC.Generics
|
||||||
import Network.HTTP.Types
|
import Network.HTTP.Types
|
||||||
(Status, statusIsSuccessful)
|
(Status, statusCode)
|
||||||
|
|
||||||
import qualified Network.HTTP.Client as Client
|
import qualified Network.HTTP.Client as Client
|
||||||
|
|
||||||
|
@ -141,7 +140,7 @@ performRequest :: Maybe [Status] -> Request -> ClientM Response
|
||||||
performRequest acceptStatus req = do
|
performRequest acceptStatus req = do
|
||||||
-- TODO: should use Client.withResponse here too
|
-- TODO: should use Client.withResponse here too
|
||||||
ClientEnv m burl cookieJar' createClientRequest <- ask
|
ClientEnv m burl cookieJar' createClientRequest <- ask
|
||||||
clientRequest <- liftIO $ createClientRequest burl req
|
let clientRequest = createClientRequest burl req
|
||||||
request <- case cookieJar' of
|
request <- case cookieJar' of
|
||||||
Nothing -> pure clientRequest
|
Nothing -> pure clientRequest
|
||||||
Just cj -> liftIO $ do
|
Just cj -> liftIO $ do
|
||||||
|
@ -164,9 +163,10 @@ performRequest acceptStatus req = do
|
||||||
now' <- getCurrentTime
|
now' <- getCurrentTime
|
||||||
atomically $ modifyTVar' cj (fst . Client.updateCookieJar response request now')
|
atomically $ modifyTVar' cj (fst . Client.updateCookieJar response request now')
|
||||||
let status = Client.responseStatus response
|
let status = Client.responseStatus response
|
||||||
|
status_code = statusCode status
|
||||||
ourResponse = clientResponseToResponse id response
|
ourResponse = clientResponseToResponse id response
|
||||||
goodStatus = case acceptStatus of
|
goodStatus = case acceptStatus of
|
||||||
Nothing -> statusIsSuccessful status
|
Nothing -> status_code >= 200 && status_code < 300
|
||||||
Just good -> status `elem` good
|
Just good -> status `elem` good
|
||||||
unless goodStatus $ do
|
unless goodStatus $ do
|
||||||
throwError $ mkFailureResponse burl req ourResponse
|
throwError $ mkFailureResponse burl req ourResponse
|
||||||
|
@ -175,27 +175,17 @@ performRequest acceptStatus req = do
|
||||||
-- | TODO: support UVerb ('acceptStatus' argument, like in 'performRequest' above).
|
-- | TODO: support UVerb ('acceptStatus' argument, like in 'performRequest' above).
|
||||||
performWithStreamingRequest :: Request -> (StreamingResponse -> IO a) -> ClientM a
|
performWithStreamingRequest :: Request -> (StreamingResponse -> IO a) -> ClientM a
|
||||||
performWithStreamingRequest req k = do
|
performWithStreamingRequest req k = do
|
||||||
ClientEnv m burl cookieJar' createClientRequest <- ask
|
m <- asks manager
|
||||||
clientRequest <- liftIO $ createClientRequest burl req
|
burl <- asks baseUrl
|
||||||
request <- case cookieJar' of
|
createClientRequest <- asks makeClientRequest
|
||||||
Nothing -> pure clientRequest
|
let request = createClientRequest burl req
|
||||||
Just cj -> liftIO $ do
|
|
||||||
now <- getCurrentTime
|
|
||||||
atomically $ do
|
|
||||||
oldCookieJar <- readTVar cj
|
|
||||||
let (newRequest, newCookieJar) =
|
|
||||||
Client.insertCookiesIntoRequest
|
|
||||||
clientRequest
|
|
||||||
oldCookieJar
|
|
||||||
now
|
|
||||||
writeTVar cj newCookieJar
|
|
||||||
pure newRequest
|
|
||||||
ClientM $ lift $ lift $ Codensity $ \k1 ->
|
ClientM $ lift $ lift $ Codensity $ \k1 ->
|
||||||
Client.withResponse request m $ \res -> do
|
Client.withResponse request m $ \res -> do
|
||||||
let status = Client.responseStatus res
|
let status = Client.responseStatus res
|
||||||
|
status_code = statusCode status
|
||||||
|
|
||||||
-- we throw FailureResponse in IO :(
|
-- we throw FailureResponse in IO :(
|
||||||
unless (statusIsSuccessful status) $ do
|
unless (status_code >= 200 && status_code < 300) $ do
|
||||||
b <- BSL.fromChunks <$> Client.brConsume (Client.responseBody res)
|
b <- BSL.fromChunks <$> Client.brConsume (Client.responseBody res)
|
||||||
throwIO $ mkFailureResponse burl req (clientResponseToResponse (const b) res)
|
throwIO $ mkFailureResponse burl req (clientResponseToResponse (const b) res)
|
||||||
|
|
||||||
|
|
|
@ -1,71 +0,0 @@
|
||||||
{-# LANGUAGE DataKinds #-}
|
|
||||||
{-# LANGUAGE TypeOperators #-}
|
|
||||||
{-# OPTIONS_GHC -freduction-depth=100 #-}
|
|
||||||
{-# OPTIONS_GHC -fno-warn-orphans #-}
|
|
||||||
{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
|
|
||||||
|
|
||||||
module Servant.BrokenSpec (spec) where
|
|
||||||
|
|
||||||
import Prelude ()
|
|
||||||
import Prelude.Compat
|
|
||||||
|
|
||||||
import Data.Monoid ()
|
|
||||||
import Data.Proxy
|
|
||||||
import qualified Network.HTTP.Types as HTTP
|
|
||||||
import Test.Hspec
|
|
||||||
|
|
||||||
import Servant.API
|
|
||||||
((:<|>) ((:<|>)), (:>), JSON, Verb, Get, StdMethod (GET))
|
|
||||||
import Servant.Client
|
|
||||||
import Servant.ClientTestUtils
|
|
||||||
import Servant.Server
|
|
||||||
|
|
||||||
-- * api for testing inconsistencies between client and server
|
|
||||||
|
|
||||||
type Get201 = Verb 'GET 201
|
|
||||||
type Get301 = Verb 'GET 301
|
|
||||||
|
|
||||||
type BrokenAPI =
|
|
||||||
-- the server should respond with 200, but returns 201
|
|
||||||
"get200" :> Get201 '[JSON] ()
|
|
||||||
-- the server should respond with 307, but returns 301
|
|
||||||
:<|> "get307" :> Get301 '[JSON] ()
|
|
||||||
|
|
||||||
brokenApi :: Proxy BrokenAPI
|
|
||||||
brokenApi = Proxy
|
|
||||||
|
|
||||||
brokenServer :: Application
|
|
||||||
brokenServer = serve brokenApi (pure () :<|> pure ())
|
|
||||||
|
|
||||||
type PublicAPI =
|
|
||||||
-- the client expects 200
|
|
||||||
"get200" :> Get '[JSON] ()
|
|
||||||
-- the client expects 307
|
|
||||||
:<|> "get307" :> Get307 '[JSON] ()
|
|
||||||
|
|
||||||
publicApi :: Proxy PublicAPI
|
|
||||||
publicApi = Proxy
|
|
||||||
|
|
||||||
get200Client :: ClientM ()
|
|
||||||
get307Client :: ClientM ()
|
|
||||||
get200Client :<|> get307Client = client publicApi
|
|
||||||
|
|
||||||
|
|
||||||
spec :: Spec
|
|
||||||
spec = describe "Servant.BrokenSpec" $ do
|
|
||||||
brokenSpec
|
|
||||||
|
|
||||||
brokenSpec :: Spec
|
|
||||||
brokenSpec = beforeAll (startWaiApp brokenServer) $ afterAll endWaiApp $ do
|
|
||||||
context "client returns errors for inconsistencies between client and server api" $ do
|
|
||||||
it "reports FailureResponse with wrong 2xx status code" $ \(_, baseUrl) -> do
|
|
||||||
res <- runClient get200Client baseUrl
|
|
||||||
case res of
|
|
||||||
Left (FailureResponse _ r) | responseStatusCode r == HTTP.status201 -> return ()
|
|
||||||
_ -> fail $ "expected 201 broken response, but got " <> show res
|
|
||||||
|
|
||||||
it "reports FailureResponse with wrong 3xx status code" $ \(_, baseUrl) -> do
|
|
||||||
res <- runClient get307Client baseUrl
|
|
||||||
case res of
|
|
||||||
Left (FailureResponse _ r) | responseStatusCode r == HTTP.status301 -> return ()
|
|
||||||
_ -> fail $ "expected 301 broken response, but got " <> show res
|
|
|
@ -64,7 +64,7 @@ import Servant.API
|
||||||
JSON, MimeRender (mimeRender), MimeUnrender (mimeUnrender),
|
JSON, MimeRender (mimeRender), MimeUnrender (mimeUnrender),
|
||||||
NoContent (NoContent), PlainText, Post, QueryFlag, QueryParam,
|
NoContent (NoContent), PlainText, Post, QueryFlag, QueryParam,
|
||||||
QueryParams, Raw, ReqBody, StdMethod (GET), ToHttpApiData (..), UVerb, Union,
|
QueryParams, Raw, ReqBody, StdMethod (GET), ToHttpApiData (..), UVerb, Union,
|
||||||
Verb, WithStatus (WithStatus), NamedRoutes, addHeader)
|
WithStatus (WithStatus), NamedRoutes, addHeader)
|
||||||
import Servant.API.Generic ((:-))
|
import Servant.API.Generic ((:-))
|
||||||
import Servant.Client
|
import Servant.Client
|
||||||
import qualified Servant.Client.Core.Auth as Auth
|
import qualified Servant.Client.Core.Auth as Auth
|
||||||
|
@ -118,16 +118,9 @@ data OtherRoutes mode = OtherRoutes
|
||||||
{ something :: mode :- "something" :> Get '[JSON] [String]
|
{ something :: mode :- "something" :> Get '[JSON] [String]
|
||||||
} deriving Generic
|
} deriving Generic
|
||||||
|
|
||||||
-- Get for HTTP 307 Temporary Redirect
|
|
||||||
type Get307 = Verb 'GET 307
|
|
||||||
|
|
||||||
type Api =
|
type Api =
|
||||||
Get '[JSON] Person
|
Get '[JSON] Person
|
||||||
:<|> "get" :> Get '[JSON] Person
|
:<|> "get" :> Get '[JSON] Person
|
||||||
-- This endpoint returns a response with status code 307 Temporary Redirect,
|
|
||||||
-- different from the ones in the 2xx successful class, to test derivation
|
|
||||||
-- of clients' api.
|
|
||||||
:<|> "get307" :> Get307 '[PlainText] Text
|
|
||||||
:<|> "deleteEmpty" :> DeleteNoContent
|
:<|> "deleteEmpty" :> DeleteNoContent
|
||||||
:<|> "capture" :> Capture "name" String :> Get '[JSON,FormUrlEncoded] Person
|
:<|> "capture" :> Capture "name" String :> Get '[JSON,FormUrlEncoded] Person
|
||||||
:<|> "captureAll" :> CaptureAll "names" String :> Get '[JSON] [Person]
|
:<|> "captureAll" :> CaptureAll "names" String :> Get '[JSON] [Person]
|
||||||
|
@ -160,14 +153,13 @@ type Api =
|
||||||
WithStatus 301 Text]
|
WithStatus 301 Text]
|
||||||
:<|> "uverb-get-created" :> UVerb 'GET '[PlainText] '[WithStatus 201 Person]
|
:<|> "uverb-get-created" :> UVerb 'GET '[PlainText] '[WithStatus 201 Person]
|
||||||
:<|> NamedRoutes RecordRoutes
|
:<|> NamedRoutes RecordRoutes
|
||||||
:<|> "captureVerbatim" :> Capture "someString" Verbatim :> Get '[PlainText] Text
|
|
||||||
|
|
||||||
api :: Proxy Api
|
api :: Proxy Api
|
||||||
api = Proxy
|
api = Proxy
|
||||||
|
|
||||||
getRoot :: ClientM Person
|
getRoot :: ClientM Person
|
||||||
getGet :: ClientM Person
|
getGet :: ClientM Person
|
||||||
getGet307 :: ClientM Text
|
|
||||||
getDeleteEmpty :: ClientM NoContent
|
getDeleteEmpty :: ClientM NoContent
|
||||||
getCapture :: String -> ClientM Person
|
getCapture :: String -> ClientM Person
|
||||||
getCaptureAll :: [String] -> ClientM [Person]
|
getCaptureAll :: [String] -> ClientM [Person]
|
||||||
|
@ -194,7 +186,6 @@ recordRoutes :: RecordRoutes (AsClientT ClientM)
|
||||||
|
|
||||||
getRoot
|
getRoot
|
||||||
:<|> getGet
|
:<|> getGet
|
||||||
:<|> getGet307
|
|
||||||
:<|> getDeleteEmpty
|
:<|> getDeleteEmpty
|
||||||
:<|> getCapture
|
:<|> getCapture
|
||||||
:<|> getCaptureAll
|
:<|> getCaptureAll
|
||||||
|
@ -215,14 +206,12 @@ getRoot
|
||||||
:<|> EmptyClient
|
:<|> EmptyClient
|
||||||
:<|> uverbGetSuccessOrRedirect
|
:<|> uverbGetSuccessOrRedirect
|
||||||
:<|> uverbGetCreated
|
:<|> uverbGetCreated
|
||||||
:<|> recordRoutes
|
:<|> recordRoutes = client api
|
||||||
:<|> captureVerbatim = client api
|
|
||||||
|
|
||||||
server :: Application
|
server :: Application
|
||||||
server = serve api (
|
server = serve api (
|
||||||
return carol
|
return carol
|
||||||
:<|> return alice
|
:<|> return alice
|
||||||
:<|> return "redirecting"
|
|
||||||
:<|> return NoContent
|
:<|> return NoContent
|
||||||
:<|> (\ name -> return $ Person name 0)
|
:<|> (\ name -> return $ Person name 0)
|
||||||
:<|> (\ names -> return (zipWith Person names [0..]))
|
:<|> (\ names -> return (zipWith Person names [0..]))
|
||||||
|
@ -261,11 +250,8 @@ server = serve api (
|
||||||
{ something = pure ["foo", "bar", "pweet"]
|
{ something = pure ["foo", "bar", "pweet"]
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
:<|> pure . decodeUtf8 . unVerbatim
|
|
||||||
)
|
)
|
||||||
|
|
||||||
-- * api for testing failures
|
|
||||||
|
|
||||||
type FailApi =
|
type FailApi =
|
||||||
"get" :> Raw
|
"get" :> Raw
|
||||||
:<|> "capture" :> Capture "name" String :> Raw
|
:<|> "capture" :> Capture "name" String :> Raw
|
||||||
|
@ -373,12 +359,3 @@ instance ToHttpApiData UrlEncodedByteString where
|
||||||
|
|
||||||
instance FromHttpApiData UrlEncodedByteString where
|
instance FromHttpApiData UrlEncodedByteString where
|
||||||
parseUrlPiece = pure . UrlEncodedByteString . HTTP.urlDecode True . encodeUtf8
|
parseUrlPiece = pure . UrlEncodedByteString . HTTP.urlDecode True . encodeUtf8
|
||||||
|
|
||||||
newtype Verbatim = Verbatim { unVerbatim :: ByteString }
|
|
||||||
|
|
||||||
instance ToHttpApiData Verbatim where
|
|
||||||
toEncodedUrlPiece = byteString . unVerbatim
|
|
||||||
toUrlPiece = decodeUtf8 . unVerbatim
|
|
||||||
|
|
||||||
instance FromHttpApiData Verbatim where
|
|
||||||
parseUrlPiece = pure . Verbatim . encodeUtf8
|
|
||||||
|
|
|
@ -38,14 +38,14 @@ failSpec = beforeAll (startWaiApp failServer) $ afterAll endWaiApp $ do
|
||||||
|
|
||||||
context "client returns errors appropriately" $ do
|
context "client returns errors appropriately" $ do
|
||||||
it "reports FailureResponse" $ \(_, baseUrl) -> do
|
it "reports FailureResponse" $ \(_, baseUrl) -> do
|
||||||
let (_ :<|> _ :<|> _ :<|> getDeleteEmpty :<|> _) = client api
|
let (_ :<|> _ :<|> getDeleteEmpty :<|> _) = client api
|
||||||
Left res <- runClient getDeleteEmpty baseUrl
|
Left res <- runClient getDeleteEmpty baseUrl
|
||||||
case res of
|
case res of
|
||||||
FailureResponse _ r | responseStatusCode r == HTTP.status404 -> return ()
|
FailureResponse _ r | responseStatusCode r == HTTP.status404 -> return ()
|
||||||
_ -> fail $ "expected 404 response, but got " <> show res
|
_ -> fail $ "expected 404 response, but got " <> show res
|
||||||
|
|
||||||
it "reports DecodeFailure" $ \(_, baseUrl) -> do
|
it "reports DecodeFailure" $ \(_, baseUrl) -> do
|
||||||
let (_ :<|> _ :<|> _ :<|> _ :<|> getCapture :<|> _) = client api
|
let (_ :<|> _ :<|> _ :<|> getCapture :<|> _) = client api
|
||||||
Left res <- runClient (getCapture "foo") baseUrl
|
Left res <- runClient (getCapture "foo") baseUrl
|
||||||
case res of
|
case res of
|
||||||
DecodeFailure _ _ -> return ()
|
DecodeFailure _ _ -> return ()
|
||||||
|
@ -72,7 +72,7 @@ failSpec = beforeAll (startWaiApp failServer) $ afterAll endWaiApp $ do
|
||||||
_ -> fail $ "expected UnsupportedContentType, but got " <> show res
|
_ -> fail $ "expected UnsupportedContentType, but got " <> show res
|
||||||
|
|
||||||
it "reports InvalidContentTypeHeader" $ \(_, baseUrl) -> do
|
it "reports InvalidContentTypeHeader" $ \(_, baseUrl) -> do
|
||||||
let (_ :<|> _ :<|> _ :<|> _ :<|> _ :<|> _ :<|> getBody :<|> _) = client api
|
let (_ :<|> _ :<|> _ :<|> _ :<|> _ :<|> getBody :<|> _) = client api
|
||||||
Left res <- runClient (getBody alice) baseUrl
|
Left res <- runClient (getBody alice) baseUrl
|
||||||
case res of
|
case res of
|
||||||
InvalidContentTypeHeader _ -> return ()
|
InvalidContentTypeHeader _ -> return ()
|
||||||
|
|
|
@ -36,8 +36,6 @@ import Data.Maybe
|
||||||
import Data.Monoid ()
|
import Data.Monoid ()
|
||||||
import Data.Text
|
import Data.Text
|
||||||
(Text)
|
(Text)
|
||||||
import Data.Text.Encoding
|
|
||||||
(encodeUtf8)
|
|
||||||
import qualified Network.HTTP.Client as C
|
import qualified Network.HTTP.Client as C
|
||||||
import qualified Network.HTTP.Types as HTTP
|
import qualified Network.HTTP.Types as HTTP
|
||||||
import Test.Hspec
|
import Test.Hspec
|
||||||
|
@ -61,16 +59,12 @@ spec = describe "Servant.SuccessSpec" $ do
|
||||||
|
|
||||||
successSpec :: Spec
|
successSpec :: Spec
|
||||||
successSpec = beforeAll (startWaiApp server) $ afterAll endWaiApp $ do
|
successSpec = beforeAll (startWaiApp server) $ afterAll endWaiApp $ do
|
||||||
describe "Servant.API.Get" $ do
|
it "Servant.API.Get root" $ \(_, baseUrl) -> do
|
||||||
it "get root endpoint" $ \(_, baseUrl) -> do
|
|
||||||
left show <$> runClient getRoot baseUrl `shouldReturn` Right carol
|
left show <$> runClient getRoot baseUrl `shouldReturn` Right carol
|
||||||
|
|
||||||
it "get simple endpoint" $ \(_, baseUrl) -> do
|
it "Servant.API.Get" $ \(_, baseUrl) -> do
|
||||||
left show <$> runClient getGet baseUrl `shouldReturn` Right alice
|
left show <$> runClient getGet baseUrl `shouldReturn` Right alice
|
||||||
|
|
||||||
it "get redirection endpoint" $ \(_, baseUrl) -> do
|
|
||||||
left show <$> runClient getGet307 baseUrl `shouldReturn` Right "redirecting"
|
|
||||||
|
|
||||||
describe "Servant.API.Delete" $ do
|
describe "Servant.API.Delete" $ do
|
||||||
it "allows empty content type" $ \(_, baseUrl) -> do
|
it "allows empty content type" $ \(_, baseUrl) -> do
|
||||||
left show <$> runClient getDeleteEmpty baseUrl `shouldReturn` Right NoContent
|
left show <$> runClient getDeleteEmpty baseUrl `shouldReturn` Right NoContent
|
||||||
|
@ -117,7 +111,6 @@ successSpec = beforeAll (startWaiApp server) $ afterAll endWaiApp $ do
|
||||||
|
|
||||||
it "Servant.API.Fragment" $ \(_, baseUrl) -> do
|
it "Servant.API.Fragment" $ \(_, baseUrl) -> do
|
||||||
left id <$> runClient getFragment baseUrl `shouldReturn` Right alice
|
left id <$> runClient getFragment baseUrl `shouldReturn` Right alice
|
||||||
|
|
||||||
it "Servant.API.Raw on success" $ \(_, baseUrl) -> do
|
it "Servant.API.Raw on success" $ \(_, baseUrl) -> do
|
||||||
res <- runClient (getRawSuccess HTTP.methodGet) baseUrl
|
res <- runClient (getRawSuccess HTTP.methodGet) baseUrl
|
||||||
case res of
|
case res of
|
||||||
|
@ -162,9 +155,8 @@ successSpec = beforeAll (startWaiApp server) $ afterAll endWaiApp $ do
|
||||||
mgr <- C.newManager C.defaultManagerSettings
|
mgr <- C.newManager C.defaultManagerSettings
|
||||||
-- In proper situation, extra headers should probably be visible in API type.
|
-- In proper situation, extra headers should probably be visible in API type.
|
||||||
-- However, testing for response timeout is difficult, so we test with something which is easy to observe
|
-- However, testing for response timeout is difficult, so we test with something which is easy to observe
|
||||||
let createClientRequest url r = fmap (\req -> req { C.requestHeaders = [("X-Added-Header", "XXX")] })
|
let createClientRequest url r = (defaultMakeClientRequest url r) { C.requestHeaders = [("X-Added-Header", "XXX")] }
|
||||||
(defaultMakeClientRequest url r)
|
let clientEnv = (mkClientEnv mgr baseUrl) { makeClientRequest = createClientRequest }
|
||||||
clientEnv = (mkClientEnv mgr baseUrl) { makeClientRequest = createClientRequest }
|
|
||||||
res <- runClientM (getRawSuccessPassHeaders HTTP.methodGet) clientEnv
|
res <- runClientM (getRawSuccessPassHeaders HTTP.methodGet) clientEnv
|
||||||
case res of
|
case res of
|
||||||
Left e ->
|
Left e ->
|
||||||
|
@ -199,10 +191,3 @@ successSpec = beforeAll (startWaiApp server) $ afterAll endWaiApp $ do
|
||||||
case eitherResponse of
|
case eitherResponse of
|
||||||
Left clientError -> fail $ show clientError
|
Left clientError -> fail $ show clientError
|
||||||
Right response -> matchUnion response `shouldBe` Just (WithStatus @201 carol)
|
Right response -> matchUnion response `shouldBe` Just (WithStatus @201 carol)
|
||||||
|
|
||||||
it "encodes URL pieces following ToHttpApiData instance" $ \(_, baseUrl) -> do
|
|
||||||
let textOrig = "*"
|
|
||||||
eitherResponse <- runClient (captureVerbatim $ Verbatim $ encodeUtf8 textOrig) baseUrl
|
|
||||||
case eitherResponse of
|
|
||||||
Left clientError -> fail $ show clientError
|
|
||||||
Right textBack -> textBack `shouldBe` textOrig
|
|
||||||
|
|
|
@ -1,4 +1,4 @@
|
||||||
cabal-version: 2.2
|
cabal-version: >=1.10
|
||||||
name: servant-conduit
|
name: servant-conduit
|
||||||
version: 0.15.1
|
version: 0.15.1
|
||||||
|
|
||||||
|
@ -23,7 +23,7 @@ extra-source-files:
|
||||||
|
|
||||||
source-repository head
|
source-repository head
|
||||||
type: git
|
type: git
|
||||||
location: http://github.com/haskell-servant/servant.git
|
location: http://github.com/haskell-servant/servant-conduit.git
|
||||||
|
|
||||||
library
|
library
|
||||||
exposed-modules: Servant.Conduit
|
exposed-modules: Servant.Conduit
|
||||||
|
@ -31,9 +31,9 @@ library
|
||||||
base >=4.9 && <5
|
base >=4.9 && <5
|
||||||
, bytestring >=0.10.8.1 && <0.12
|
, bytestring >=0.10.8.1 && <0.12
|
||||||
, conduit >=1.3.1 && <1.4
|
, conduit >=1.3.1 && <1.4
|
||||||
, mtl ^>=2.2.2 || ^>=2.3.1
|
, mtl >=2.2.2 && <2.3
|
||||||
, resourcet >=1.2.2 && <1.4
|
, resourcet >=1.2.2 && <1.3
|
||||||
, servant >=0.15 && <0.20
|
, servant >=0.15 && <0.19
|
||||||
, unliftio-core >=0.1.2.0 && <0.3
|
, unliftio-core >=0.1.2.0 && <0.3
|
||||||
hs-source-dirs: src
|
hs-source-dirs: src
|
||||||
default-language: Haskell2010
|
default-language: Haskell2010
|
||||||
|
@ -54,8 +54,8 @@ test-suite example
|
||||||
, resourcet
|
, resourcet
|
||||||
, servant
|
, servant
|
||||||
, servant-conduit
|
, servant-conduit
|
||||||
, servant-server >=0.15 && <0.20
|
, servant-server >=0.15 && <0.19
|
||||||
, servant-client >=0.15 && <0.20
|
, servant-client >=0.15 && <0.19
|
||||||
, wai >=3.2.1.2 && <3.3
|
, wai >=3.2.1.2 && <3.3
|
||||||
, warp >=3.2.25 && <3.4
|
, warp >=3.2.25 && <3.4
|
||||||
, http-client
|
, http-client
|
||||||
|
|
|
@ -1,15 +1,6 @@
|
||||||
[The latest version of this document is on GitHub.](https://github.com/haskell-servant/servant/blob/master/servant-docs/CHANGELOG.md)
|
[The latest version of this document is on GitHub.](https://github.com/haskell-servant/servant/blob/master/servant-docs/CHANGELOG.md)
|
||||||
[Changelog for `servant` package contains significant entries for all core packages.](https://github.com/haskell-servant/servant/blob/master/servant/CHANGELOG.md)
|
[Changelog for `servant` package contains significant entries for all core packages.](https://github.com/haskell-servant/servant/blob/master/servant/CHANGELOG.md)
|
||||||
|
|
||||||
0.12
|
|
||||||
----
|
|
||||||
|
|
||||||
### Significant changes
|
|
||||||
|
|
||||||
- Generate sample cURL requests
|
|
||||||
([#1401](https://github.com/haskell-servant/servant/pull/1401/files)).
|
|
||||||
Breaking change: requires sample header values to be supplied with `headers`.
|
|
||||||
|
|
||||||
0.11.9
|
0.11.9
|
||||||
------
|
------
|
||||||
|
|
||||||
|
|
|
@ -530,24 +530,6 @@
|
||||||
|
|
||||||
```
|
```
|
||||||
|
|
||||||
## GET /resource
|
|
||||||
|
|
||||||
### Response:
|
|
||||||
|
|
||||||
- Status code 200
|
|
||||||
- Headers: []
|
|
||||||
|
|
||||||
- Supported content types are:
|
|
||||||
|
|
||||||
- `application/json;charset=utf-8`
|
|
||||||
- `application/json`
|
|
||||||
|
|
||||||
- Example (`application/json;charset=utf-8`, `application/json`):
|
|
||||||
|
|
||||||
```javascript
|
|
||||||
|
|
||||||
```
|
|
||||||
|
|
||||||
## GET /streaming
|
## GET /streaming
|
||||||
|
|
||||||
### Request:
|
### Request:
|
||||||
|
|
|
@ -1,6 +1,6 @@
|
||||||
cabal-version: 2.2
|
cabal-version: >=1.10
|
||||||
name: servant-docs
|
name: servant-docs
|
||||||
version: 0.12
|
version: 0.11.9
|
||||||
|
|
||||||
synopsis: generate API docs for your servant webservice
|
synopsis: generate API docs for your servant webservice
|
||||||
category: Servant, Web
|
category: Servant, Web
|
||||||
|
@ -41,25 +41,25 @@ library
|
||||||
--
|
--
|
||||||
-- note: mtl lower bound is so low because of GHC-7.8
|
-- note: mtl lower bound is so low because of GHC-7.8
|
||||||
build-depends:
|
build-depends:
|
||||||
base >= 4.9 && < 4.18
|
base >= 4.9 && < 4.16
|
||||||
, bytestring >= 0.10.8.1 && < 0.12
|
, bytestring >= 0.10.8.1 && < 0.12
|
||||||
, text >= 1.2.3.0 && < 2.1
|
, text >= 1.2.3.0 && < 1.3
|
||||||
|
|
||||||
-- Servant dependencies
|
-- Servant dependencies
|
||||||
build-depends:
|
build-depends:
|
||||||
servant >= 0.18 && <0.20
|
servant >= 0.18 && <0.19
|
||||||
|
|
||||||
-- Other dependencies: Lower bound around what is in the latest Stackage LTS.
|
-- Other dependencies: Lower bound around what is in the latest Stackage LTS.
|
||||||
-- Here can be exceptions if we really need features from the newer versions.
|
-- Here can be exceptions if we really need features from the newer versions.
|
||||||
build-depends:
|
build-depends:
|
||||||
aeson >= 1.4.1.0 && < 3
|
aeson >= 1.4.1.0 && < 1.6
|
||||||
, aeson-pretty >= 0.8.5 && < 0.9
|
, aeson-pretty >= 0.8.5 && < 0.9
|
||||||
, base-compat >= 0.10.5 && < 0.13
|
, base-compat >= 0.10.5 && < 0.12
|
||||||
, case-insensitive >= 1.2.0.11 && < 1.3
|
, case-insensitive >= 1.2.0.11 && < 1.3
|
||||||
, hashable >= 1.2.7.0 && < 1.5
|
, hashable >= 1.2.7.0 && < 1.4
|
||||||
, http-media >= 0.7.1.3 && < 0.9
|
, http-media >= 0.7.1.3 && < 0.9
|
||||||
, http-types >= 0.12.2 && < 0.13
|
, http-types >= 0.12.2 && < 0.13
|
||||||
, lens >= 4.17 && < 5.3
|
, lens >= 4.17 && < 5.1
|
||||||
, string-conversions >= 0.4.0.1 && < 0.5
|
, string-conversions >= 0.4.0.1 && < 0.5
|
||||||
, universe-base >= 1.1.1 && < 1.2
|
, universe-base >= 1.1.1 && < 1.2
|
||||||
, unordered-containers >= 0.2.9.0 && < 0.3
|
, unordered-containers >= 0.2.9.0 && < 0.3
|
||||||
|
|
|
@ -62,7 +62,6 @@ import GHC.TypeLits
|
||||||
import Servant.API
|
import Servant.API
|
||||||
import Servant.API.ContentTypes
|
import Servant.API.ContentTypes
|
||||||
import Servant.API.TypeLevel
|
import Servant.API.TypeLevel
|
||||||
import Servant.API.Generic
|
|
||||||
|
|
||||||
import qualified Data.Universe.Helpers as U
|
import qualified Data.Universe.Helpers as U
|
||||||
|
|
||||||
|
@ -447,7 +446,7 @@ docsWith opts intros (ExtraInfo endpoints) p =
|
||||||
& apiEndpoints %~ HM.unionWith (flip combineAction) endpoints
|
& apiEndpoints %~ HM.unionWith (flip combineAction) endpoints
|
||||||
|
|
||||||
|
|
||||||
-- | Generate the docs for a given API that implements 'HasDocs' with any
|
-- | Generate the docs for a given API that implements 'HasDocs' with with any
|
||||||
-- number of introduction(s)
|
-- number of introduction(s)
|
||||||
docsWithIntros :: HasDocs api => [DocIntro] -> Proxy api -> API
|
docsWithIntros :: HasDocs api => [DocIntro] -> Proxy api -> API
|
||||||
docsWithIntros intros = docsWith defaultDocOptions intros mempty
|
docsWithIntros intros = docsWith defaultDocOptions intros mempty
|
||||||
|
@ -1144,9 +1143,6 @@ instance HasDocs api => HasDocs (Vault :> api) where
|
||||||
instance HasDocs api => HasDocs (WithNamedContext name context api) where
|
instance HasDocs api => HasDocs (WithNamedContext name context api) where
|
||||||
docsFor Proxy = docsFor (Proxy :: Proxy api)
|
docsFor Proxy = docsFor (Proxy :: Proxy api)
|
||||||
|
|
||||||
instance HasDocs api => HasDocs (WithResource res :> api) where
|
|
||||||
docsFor Proxy = docsFor (Proxy :: Proxy api)
|
|
||||||
|
|
||||||
instance (ToAuthInfo (BasicAuth realm usr), HasDocs api) => HasDocs (BasicAuth realm usr :> api) where
|
instance (ToAuthInfo (BasicAuth realm usr), HasDocs api) => HasDocs (BasicAuth realm usr :> api) where
|
||||||
docsFor Proxy (endpoint, action) =
|
docsFor Proxy (endpoint, action) =
|
||||||
docsFor (Proxy :: Proxy api) (endpoint, action')
|
docsFor (Proxy :: Proxy api) (endpoint, action')
|
||||||
|
@ -1154,9 +1150,6 @@ instance (ToAuthInfo (BasicAuth realm usr), HasDocs api) => HasDocs (BasicAuth r
|
||||||
authProxy = Proxy :: Proxy (BasicAuth realm usr)
|
authProxy = Proxy :: Proxy (BasicAuth realm usr)
|
||||||
action' = over authInfo (|> toAuthInfo authProxy) action
|
action' = over authInfo (|> toAuthInfo authProxy) action
|
||||||
|
|
||||||
instance HasDocs (ToServantApi api) => HasDocs (NamedRoutes api) where
|
|
||||||
docsFor Proxy = docsFor (Proxy :: Proxy (ToServantApi api))
|
|
||||||
|
|
||||||
-- ToSample instances for simple types
|
-- ToSample instances for simple types
|
||||||
instance ToSample NoContent
|
instance ToSample NoContent
|
||||||
instance ToSample Bool
|
instance ToSample Bool
|
||||||
|
|
|
@ -1,4 +1,4 @@
|
||||||
cabal-version: 2.2
|
cabal-version: >=1.10
|
||||||
name: servant-foreign
|
name: servant-foreign
|
||||||
version: 0.15.4
|
version: 0.15.4
|
||||||
|
|
||||||
|
@ -41,18 +41,18 @@ library
|
||||||
--
|
--
|
||||||
-- note: mtl lower bound is so low because of GHC-7.8
|
-- note: mtl lower bound is so low because of GHC-7.8
|
||||||
build-depends:
|
build-depends:
|
||||||
base >= 4.9 && < 4.18
|
base >= 4.9 && < 4.16
|
||||||
, text >= 1.2.3.0 && < 2.1
|
, text >= 1.2.3.0 && < 1.3
|
||||||
|
|
||||||
-- Servant dependencies
|
-- Servant dependencies
|
||||||
build-depends:
|
build-depends:
|
||||||
servant >=0.18 && <0.20
|
servant >=0.18 && <0.19
|
||||||
|
|
||||||
-- Other dependencies: Lower bound around what is in the latest Stackage LTS.
|
-- Other dependencies: Lower bound around what is in the latest Stackage LTS.
|
||||||
-- Here can be exceptions if we really need features from the newer versions.
|
-- Here can be exceptions if we really need features from the newer versions.
|
||||||
build-depends:
|
build-depends:
|
||||||
base-compat >= 0.10.5 && < 0.13
|
base-compat >= 0.10.5 && < 0.12
|
||||||
, lens >= 4.17 && < 5.3
|
, lens >= 4.17 && < 5.1
|
||||||
, http-types >= 0.12.2 && < 0.13
|
, http-types >= 0.12.2 && < 0.13
|
||||||
|
|
||||||
hs-source-dirs: src
|
hs-source-dirs: src
|
||||||
|
@ -74,7 +74,7 @@ test-suite spec
|
||||||
|
|
||||||
-- Additional dependencies
|
-- Additional dependencies
|
||||||
build-depends:
|
build-depends:
|
||||||
hspec >= 2.6.0 && <2.10
|
hspec >= 2.6.0 && <2.9
|
||||||
build-tool-depends:
|
build-tool-depends:
|
||||||
hspec-discover:hspec-discover >=2.6.0 && <2.10
|
hspec-discover:hspec-discover >=2.6.0 && <2.9
|
||||||
default-language: Haskell2010
|
default-language: Haskell2010
|
||||||
|
|
|
@ -487,13 +487,6 @@ instance HasForeign lang ftype api =>
|
||||||
|
|
||||||
foreignFor lang ftype Proxy = foreignFor lang ftype (Proxy :: Proxy api)
|
foreignFor lang ftype Proxy = foreignFor lang ftype (Proxy :: Proxy api)
|
||||||
|
|
||||||
instance HasForeign lang ftype api =>
|
|
||||||
HasForeign lang ftype (WithResource res :> api) where
|
|
||||||
|
|
||||||
type Foreign ftype (WithResource res :> api) = Foreign ftype api
|
|
||||||
|
|
||||||
foreignFor lang ftype Proxy = foreignFor lang ftype (Proxy :: Proxy api)
|
|
||||||
|
|
||||||
instance HasForeign lang ftype api
|
instance HasForeign lang ftype api
|
||||||
=> HasForeign lang ftype (HttpVersion :> api) where
|
=> HasForeign lang ftype (HttpVersion :> api) where
|
||||||
type Foreign ftype (HttpVersion :> api) = Foreign ftype api
|
type Foreign ftype (HttpVersion :> api) = Foreign ftype api
|
||||||
|
|
|
@ -1,16 +1,6 @@
|
||||||
[The latest version of this document is on GitHub.](https://github.com/haskell-servant/servant/blob/master/servant-http-streams/CHANGELOG.md)
|
[The latest version of this document is on GitHub.](https://github.com/haskell-servant/servant/blob/master/servant-http-streams/CHANGELOG.md)
|
||||||
[Changelog for `servant` package contains significant entries for all core packages.](https://github.com/haskell-servant/servant/blob/master/servant/CHANGELOG.md)
|
[Changelog for `servant` package contains significant entries for all core packages.](https://github.com/haskell-servant/servant/blob/master/servant/CHANGELOG.md)
|
||||||
|
|
||||||
0.18.4
|
|
||||||
------
|
|
||||||
|
|
||||||
### Significant changes
|
|
||||||
|
|
||||||
- *servant-client* / *servant-client-core* / *servant-http-streams*:
|
|
||||||
Fix erroneous behavior, where only 2XX status codes would be considered
|
|
||||||
successful, irrelevant of the status parameter specified by the verb
|
|
||||||
combinator. ([#1469](https://github.com/haskell-servant/servant/pull/1469))
|
|
||||||
|
|
||||||
0.18.3
|
0.18.3
|
||||||
------
|
------
|
||||||
|
|
||||||
|
|
|
@ -1,6 +1,6 @@
|
||||||
cabal-version: 2.2
|
cabal-version: >=1.10
|
||||||
name: servant-http-streams
|
name: servant-http-streams
|
||||||
version: 0.18.4
|
version: 0.18.3
|
||||||
|
|
||||||
synopsis: Automatic derivation of querying functions for servant
|
synopsis: Automatic derivation of querying functions for servant
|
||||||
category: Servant, Web
|
category: Servant, Web
|
||||||
|
@ -38,14 +38,14 @@ library
|
||||||
-- Bundled with GHC: Lower bound to not force re-installs
|
-- Bundled with GHC: Lower bound to not force re-installs
|
||||||
-- text and mtl are bundled starting with GHC-8.4
|
-- text and mtl are bundled starting with GHC-8.4
|
||||||
build-depends:
|
build-depends:
|
||||||
base >= 4.9 && < 4.18
|
base >= 4.9 && < 4.16
|
||||||
, bytestring >= 0.10.8.1 && < 0.12
|
, bytestring >= 0.10.8.1 && < 0.12
|
||||||
, containers >= 0.5.7.1 && < 0.7
|
, containers >= 0.5.7.1 && < 0.7
|
||||||
, deepseq >= 1.4.2.0 && < 1.5
|
, deepseq >= 1.4.2.0 && < 1.5
|
||||||
, mtl ^>= 2.2.2 || ^>= 2.3.1
|
, mtl >= 2.2.2 && < 2.3
|
||||||
, text >= 1.2.3.0 && < 2.1
|
, text >= 1.2.3.0 && < 1.3
|
||||||
, time >= 1.6.0.1 && < 1.13
|
, time >= 1.6.0.1 && < 1.10
|
||||||
, transformers >= 0.5.2.0 && < 0.7
|
, transformers >= 0.5.2.0 && < 0.6
|
||||||
|
|
||||||
if !impl(ghc >= 8.2)
|
if !impl(ghc >= 8.2)
|
||||||
build-depends:
|
build-depends:
|
||||||
|
@ -54,25 +54,25 @@ library
|
||||||
-- Servant dependencies.
|
-- Servant dependencies.
|
||||||
-- Strict dependency on `servant-client-core` as we re-export things.
|
-- Strict dependency on `servant-client-core` as we re-export things.
|
||||||
build-depends:
|
build-depends:
|
||||||
servant >= 0.18 && < 0.20
|
servant == 0.18.*
|
||||||
, servant-client-core >= 0.18.3 && <0.20
|
, servant-client-core >= 0.18.3 && <0.18.4
|
||||||
|
|
||||||
-- Other dependencies: Lower bound around what is in the latest Stackage LTS.
|
-- Other dependencies: Lower bound around what is in the latest Stackage LTS.
|
||||||
-- Here can be exceptions if we really need features from the newer versions.
|
-- Here can be exceptions if we really need features from the newer versions.
|
||||||
build-depends:
|
build-depends:
|
||||||
base-compat >= 0.10.5 && < 0.13
|
base-compat >= 0.10.5 && < 0.12
|
||||||
, case-insensitive
|
, case-insensitive
|
||||||
, http-streams >= 0.8.6.1 && < 0.9
|
, http-streams >= 0.8.6.1 && < 0.9
|
||||||
, http-media >= 0.7.1.3 && < 0.9
|
, http-media >= 0.7.1.3 && < 0.9
|
||||||
, io-streams >= 1.5.0.1 && < 1.6
|
, io-streams >= 1.5.0.1 && < 1.6
|
||||||
, http-types >= 0.12.2 && < 0.13
|
, http-types >= 0.12.2 && < 0.13
|
||||||
, http-common >= 0.8.2.0 && < 0.9
|
, http-common >= 0.8.2.0 && < 0.8.3
|
||||||
, exceptions >= 0.10.0 && < 0.11
|
, exceptions >= 0.10.0 && < 0.11
|
||||||
, kan-extensions >= 5.2 && < 5.3
|
, kan-extensions >= 5.2 && < 5.3
|
||||||
, monad-control >= 1.0.2.3 && < 1.1
|
, monad-control >= 1.0.2.3 && < 1.1
|
||||||
, semigroupoids >= 5.3.1 && < 5.4
|
, semigroupoids >= 5.3.1 && < 5.4
|
||||||
, transformers-base >= 0.4.5.2 && < 0.5
|
, transformers-base >= 0.4.5.2 && < 0.5
|
||||||
, transformers-compat >= 0.6.2 && < 0.8
|
, transformers-compat >= 0.6.2 && < 0.7
|
||||||
|
|
||||||
hs-source-dirs: src
|
hs-source-dirs: src
|
||||||
default-language: Haskell2010
|
default-language: Haskell2010
|
||||||
|
@ -112,16 +112,16 @@ test-suite spec
|
||||||
-- Additional dependencies
|
-- Additional dependencies
|
||||||
build-depends:
|
build-depends:
|
||||||
entropy >= 0.4.1.3 && < 0.5
|
entropy >= 0.4.1.3 && < 0.5
|
||||||
, hspec >= 2.6.0 && < 2.10
|
, hspec >= 2.6.0 && < 2.9
|
||||||
, HUnit >= 1.6.0.0 && < 1.7
|
, HUnit >= 1.6.0.0 && < 1.7
|
||||||
, network >= 2.8.0.0 && < 3.2
|
, network >= 2.8.0.0 && < 3.2
|
||||||
, QuickCheck >= 2.12.6.1 && < 2.15
|
, QuickCheck >= 2.12.6.1 && < 2.15
|
||||||
, servant == 0.19.*
|
, servant == 0.18.*
|
||||||
, servant-server == 0.19.*
|
, servant-server == 0.18.*
|
||||||
, tdigest >= 0.2 && < 0.3
|
, tdigest >= 0.2 && < 0.3
|
||||||
|
|
||||||
build-tool-depends:
|
build-tool-depends:
|
||||||
hspec-discover:hspec-discover >= 2.6.0 && < 2.10
|
hspec-discover:hspec-discover >= 2.6.0 && < 2.9
|
||||||
|
|
||||||
test-suite readme
|
test-suite readme
|
||||||
type: exitcode-stdio-1.0
|
type: exitcode-stdio-1.0
|
||||||
|
|
|
@ -57,7 +57,7 @@ import GHC.Generics
|
||||||
import Network.HTTP.Media
|
import Network.HTTP.Media
|
||||||
(renderHeader)
|
(renderHeader)
|
||||||
import Network.HTTP.Types
|
import Network.HTTP.Types
|
||||||
(Status (..), hContentType, http11, renderQuery, statusIsSuccessful)
|
(Status (..), hContentType, http11, renderQuery)
|
||||||
import Servant.Client.Core
|
import Servant.Client.Core
|
||||||
|
|
||||||
import qualified Network.Http.Client as Client
|
import qualified Network.Http.Client as Client
|
||||||
|
@ -160,12 +160,12 @@ performRequest acceptStatus req = do
|
||||||
x <- ClientM $ lift $ lift $ Codensity $ \k -> do
|
x <- ClientM $ lift $ lift $ Codensity $ \k -> do
|
||||||
Client.sendRequest conn req' body
|
Client.sendRequest conn req' body
|
||||||
Client.receiveResponse conn $ \res' body' -> do
|
Client.receiveResponse conn $ \res' body' -> do
|
||||||
let status = toEnum $ Client.getStatusCode res'
|
let sc = Client.getStatusCode res'
|
||||||
lbs <- BSL.fromChunks <$> Streams.toList body'
|
lbs <- BSL.fromChunks <$> Streams.toList body'
|
||||||
let res'' = clientResponseToResponse res' lbs
|
let res'' = clientResponseToResponse res' lbs
|
||||||
goodStatus = case acceptStatus of
|
goodStatus = case acceptStatus of
|
||||||
Nothing -> statusIsSuccessful status
|
Nothing -> sc >= 200 && sc < 300
|
||||||
Just good -> status `elem` good
|
Just good -> sc `elem` (statusCode <$> good)
|
||||||
if goodStatus
|
if goodStatus
|
||||||
then k (Right res'')
|
then k (Right res'')
|
||||||
else k (Left (mkFailureResponse burl req res''))
|
else k (Left (mkFailureResponse burl req res''))
|
||||||
|
@ -180,8 +180,8 @@ performWithStreamingRequest req k = do
|
||||||
Client.sendRequest conn req' body
|
Client.sendRequest conn req' body
|
||||||
Client.receiveResponseRaw conn $ \res' body' -> do
|
Client.receiveResponseRaw conn $ \res' body' -> do
|
||||||
-- check status code
|
-- check status code
|
||||||
let status = toEnum $ Client.getStatusCode res'
|
let sc = Client.getStatusCode res'
|
||||||
unless (statusIsSuccessful status) $ do
|
unless (sc >= 200 && sc < 300) $ do
|
||||||
lbs <- BSL.fromChunks <$> Streams.toList body'
|
lbs <- BSL.fromChunks <$> Streams.toList body'
|
||||||
throwIO $ mkFailureResponse burl req (clientResponseToResponse res' lbs)
|
throwIO $ mkFailureResponse burl req (clientResponseToResponse res' lbs)
|
||||||
|
|
||||||
|
|
|
@ -1,4 +1,4 @@
|
||||||
cabal-version: 2.2
|
cabal-version: >=1.10
|
||||||
name: servant-machines
|
name: servant-machines
|
||||||
version: 0.15.1
|
version: 0.15.1
|
||||||
|
|
||||||
|
@ -23,7 +23,7 @@ extra-source-files:
|
||||||
|
|
||||||
source-repository head
|
source-repository head
|
||||||
type: git
|
type: git
|
||||||
location: http://github.com/haskell-servant/servant.git
|
location: http://github.com/haskell-servant/servant-machines.git
|
||||||
|
|
||||||
library
|
library
|
||||||
exposed-modules: Servant.Machines
|
exposed-modules: Servant.Machines
|
||||||
|
@ -31,8 +31,8 @@ library
|
||||||
base >=4.9 && <5
|
base >=4.9 && <5
|
||||||
, bytestring >=0.10.8.1 && <0.12
|
, bytestring >=0.10.8.1 && <0.12
|
||||||
, machines >=0.6.4 && <0.8
|
, machines >=0.6.4 && <0.8
|
||||||
, mtl ^>=2.2.2 || ^>=2.3.1
|
, mtl >=2.2.2 && <2.3
|
||||||
, servant >=0.15 && <0.20
|
, servant >=0.15 && <0.19
|
||||||
hs-source-dirs: src
|
hs-source-dirs: src
|
||||||
default-language: Haskell2010
|
default-language: Haskell2010
|
||||||
ghc-options: -Wall
|
ghc-options: -Wall
|
||||||
|
@ -51,8 +51,8 @@ test-suite example
|
||||||
, servant
|
, servant
|
||||||
, machines
|
, machines
|
||||||
, servant-machines
|
, servant-machines
|
||||||
, servant-server >=0.15 && <0.20
|
, servant-server >=0.15 && <0.19
|
||||||
, servant-client >=0.15 && <0.20
|
, servant-client >=0.15 && <0.19
|
||||||
, wai >=3.2.1.2 && <3.3
|
, wai >=3.2.1.2 && <3.3
|
||||||
, warp >=3.2.25 && <3.4
|
, warp >=3.2.25 && <3.4
|
||||||
, http-client
|
, http-client
|
||||||
|
|
|
@ -1,4 +1,4 @@
|
||||||
cabal-version: 2.2
|
cabal-version: >=1.10
|
||||||
name: servant-pipes
|
name: servant-pipes
|
||||||
version: 0.15.3
|
version: 0.15.3
|
||||||
|
|
||||||
|
@ -23,7 +23,7 @@ extra-source-files:
|
||||||
|
|
||||||
source-repository head
|
source-repository head
|
||||||
type: git
|
type: git
|
||||||
location: http://github.com/haskell-servant/servant.git
|
location: http://github.com/haskell-servant/servant-pipes.git
|
||||||
|
|
||||||
library
|
library
|
||||||
exposed-modules: Servant.Pipes
|
exposed-modules: Servant.Pipes
|
||||||
|
@ -32,9 +32,9 @@ library
|
||||||
, bytestring >=0.10.8.1 && <0.12
|
, bytestring >=0.10.8.1 && <0.12
|
||||||
, pipes >=4.3.9 && <4.4
|
, pipes >=4.3.9 && <4.4
|
||||||
, pipes-safe >=2.3.1 && <2.4
|
, pipes-safe >=2.3.1 && <2.4
|
||||||
, mtl ^>=2.2.2 || ^>=2.3.1
|
, mtl >=2.2.2 && <2.3
|
||||||
, monad-control >=1.0.2.3 && <1.1
|
, monad-control >=1.0.2.3 && <1.1
|
||||||
, servant >=0.15 && <0.20
|
, servant >=0.15 && <0.19
|
||||||
hs-source-dirs: src
|
hs-source-dirs: src
|
||||||
default-language: Haskell2010
|
default-language: Haskell2010
|
||||||
ghc-options: -Wall
|
ghc-options: -Wall
|
||||||
|
@ -55,8 +55,8 @@ test-suite example
|
||||||
, pipes-safe
|
, pipes-safe
|
||||||
, servant-pipes
|
, servant-pipes
|
||||||
, pipes-bytestring >=2.1.6 && <2.2
|
, pipes-bytestring >=2.1.6 && <2.2
|
||||||
, servant-server >=0.15 && <0.20
|
, servant-server >=0.15 && <0.19
|
||||||
, servant-client >=0.15 && <0.20
|
, servant-client >=0.15 && <0.19
|
||||||
, wai >=3.2.1.2 && <3.3
|
, wai >=3.2.1.2 && <3.3
|
||||||
, warp >=3.2.25 && <3.4
|
, warp >=3.2.25 && <3.4
|
||||||
, http-client
|
, http-client
|
||||||
|
|
|
@ -1,36 +1,6 @@
|
||||||
[The latest version of this document is on GitHub.](https://github.com/haskell-servant/servant/blob/master/servant-server/CHANGELOG.md)
|
[The latest version of this document is on GitHub.](https://github.com/haskell-servant/servant/blob/master/servant-server/CHANGELOG.md)
|
||||||
[Changelog for `servant` package contains significant entries for all core packages.](https://github.com/haskell-servant/servant/blob/master/servant/CHANGELOG.md)
|
[Changelog for `servant` package contains significant entries for all core packages.](https://github.com/haskell-servant/servant/blob/master/servant/CHANGELOG.md)
|
||||||
|
|
||||||
Package versions follow the [Package Versioning Policy](https://pvp.haskell.org/): in A.B.C, bumps to either A or B represent major versions.
|
|
||||||
|
|
||||||
0.19.2
|
|
||||||
------
|
|
||||||
|
|
||||||
Compatibility with GHC 9.4, see [PR #1592](https://github.com/haskell-servant/servant/pull/1592).
|
|
||||||
|
|
||||||
0.19.1
|
|
||||||
------
|
|
||||||
|
|
||||||
- Add `MonadFail` instance for `Handler` wrt [#1545](https://github.com/haskell-servant/servant/issues/1545)
|
|
||||||
- Support GHC 9.2 [#1525](https://github.com/haskell-servant/servant/issues/1525)
|
|
||||||
- Add capture hints in `Router` type for debug and display purposes [PR #1556] (https://github.com/haskell-servant/servant/pull/1556)
|
|
||||||
|
|
||||||
0.19
|
|
||||||
----
|
|
||||||
|
|
||||||
### Significant changes
|
|
||||||
|
|
||||||
- Drop support for GHC < 8.6.
|
|
||||||
- Support GHC 9.0 (GHC 9.2 should work as well, but isn't fully tested yet).
|
|
||||||
- Support Aeson 2 ([#1475](https://github.com/haskell-servant/servant/pull/1475)),
|
|
||||||
which fixes a [DOS vulnerability](https://github.com/haskell/aeson/issues/864)
|
|
||||||
related to hash collisions.
|
|
||||||
- Add `NamedRoutes` combinator, making support for records first-class in Servant
|
|
||||||
([#1388](https://github.com/haskell-servant/servant/pull/1388)).
|
|
||||||
- Add custom type errors for partially applied combinators
|
|
||||||
([#1289](https://github.com/haskell-servant/servant/pull/1289),
|
|
||||||
[#1486](https://github.com/haskell-servant/servant/pull/1486)).
|
|
||||||
|
|
||||||
0.18.3
|
0.18.3
|
||||||
------
|
------
|
||||||
|
|
||||||
|
|
|
@ -18,6 +18,7 @@ import Network.Wai.Handler.Warp
|
||||||
|
|
||||||
import Servant
|
import Servant
|
||||||
import Servant.Server.Generic ()
|
import Servant.Server.Generic ()
|
||||||
|
import Servant.API.Generic
|
||||||
|
|
||||||
-- * Example
|
-- * Example
|
||||||
|
|
||||||
|
|
|
@ -1,6 +1,6 @@
|
||||||
cabal-version: 2.2
|
cabal-version: >=1.10
|
||||||
name: servant-server
|
name: servant-server
|
||||||
version: 0.19.2
|
version: 0.18.3
|
||||||
|
|
||||||
synopsis: A family of combinators for defining webservices APIs and serving them
|
synopsis: A family of combinators for defining webservices APIs and serving them
|
||||||
category: Servant, Web
|
category: Servant, Web
|
||||||
|
@ -23,7 +23,7 @@ author: Servant Contributors
|
||||||
maintainer: haskell-servant-maintainers@googlegroups.com
|
maintainer: haskell-servant-maintainers@googlegroups.com
|
||||||
copyright: 2014-2016 Zalora South East Asia Pte Ltd, 2016-2019 Servant Contributors
|
copyright: 2014-2016 Zalora South East Asia Pte Ltd, 2016-2019 Servant Contributors
|
||||||
build-type: Simple
|
build-type: Simple
|
||||||
tested-with: GHC ==8.6.5 || ==8.8.4 || ==8.10.7 || ==9.0.2 || ==9.2.4 || ==9.4.3
|
tested-with: GHC ==8.6.5 || ==8.8.4 || ==8.10.2 || ==9.0.1
|
||||||
|
|
||||||
extra-source-files:
|
extra-source-files:
|
||||||
CHANGELOG.md
|
CHANGELOG.md
|
||||||
|
@ -60,25 +60,25 @@ library
|
||||||
-- Bundled with GHC: Lower bound to not force re-installs
|
-- Bundled with GHC: Lower bound to not force re-installs
|
||||||
-- text and mtl are bundled starting with GHC-8.4
|
-- text and mtl are bundled starting with GHC-8.4
|
||||||
build-depends:
|
build-depends:
|
||||||
base >= 4.9 && < 4.18
|
base >= 4.9 && < 4.16
|
||||||
, bytestring >= 0.10.8.1 && < 0.12
|
, bytestring >= 0.10.8.1 && < 0.12
|
||||||
, constraints >= 0.2 && < 0.14
|
, constraints >= 0.2 && < 0.14
|
||||||
, containers >= 0.5.7.1 && < 0.7
|
, containers >= 0.5.7.1 && < 0.7
|
||||||
, mtl ^>= 2.2.2 || ^>= 2.3.1
|
, mtl >= 2.2.2 && < 2.3
|
||||||
, text >= 1.2.3.0 && < 2.1
|
, text >= 1.2.3.0 && < 1.3
|
||||||
, transformers >= 0.5.2.0 && < 0.7
|
, transformers >= 0.5.2.0 && < 0.6
|
||||||
, filepath >= 1.4.1.1 && < 1.5
|
, filepath >= 1.4.1.1 && < 1.5
|
||||||
|
|
||||||
-- Servant dependencies
|
-- Servant dependencies
|
||||||
-- strict dependency as we re-export 'servant' things.
|
-- strict dependency as we re-export 'servant' things.
|
||||||
build-depends:
|
build-depends:
|
||||||
servant >= 0.19 && < 0.20
|
servant >= 0.18.3 && < 0.18.4
|
||||||
, http-api-data >= 0.4.1 && < 0.5.1
|
, http-api-data >= 0.4.1 && < 0.4.4
|
||||||
|
|
||||||
-- Other dependencies: Lower bound around what is in the latest Stackage LTS.
|
-- Other dependencies: Lower bound around what is in the latest Stackage LTS.
|
||||||
-- Here can be exceptions if we really need features from the newer versions.
|
-- Here can be exceptions if we really need features from the newer versions.
|
||||||
build-depends:
|
build-depends:
|
||||||
base-compat >= 0.10.5 && < 0.13
|
base-compat >= 0.10.5 && < 0.12
|
||||||
, base64-bytestring >= 1.0.0.1 && < 1.3
|
, base64-bytestring >= 1.0.0.1 && < 1.3
|
||||||
, exceptions >= 0.10.0 && < 0.11
|
, exceptions >= 0.10.0 && < 0.11
|
||||||
, http-media >= 0.7.1.3 && < 0.9
|
, http-media >= 0.7.1.3 && < 0.9
|
||||||
|
@ -88,10 +88,10 @@ library
|
||||||
, network >= 2.8 && < 3.2
|
, network >= 2.8 && < 3.2
|
||||||
, sop-core >= 0.4.0.0 && < 0.6
|
, sop-core >= 0.4.0.0 && < 0.6
|
||||||
, string-conversions >= 0.4.0.1 && < 0.5
|
, string-conversions >= 0.4.0.1 && < 0.5
|
||||||
, resourcet >= 1.2.2 && < 1.4
|
, resourcet >= 1.2.2 && < 1.3
|
||||||
, tagged >= 0.8.6 && < 0.9
|
, tagged >= 0.8.6 && < 0.9
|
||||||
, transformers-base >= 0.4.5.2 && < 0.5
|
, transformers-base >= 0.4.5.2 && < 0.5
|
||||||
, wai >= 3.2.2.1 && < 3.3
|
, wai >= 3.2.1.2 && < 3.3
|
||||||
, wai-app-static >= 3.1.6.2 && < 3.2
|
, wai-app-static >= 3.1.6.2 && < 3.2
|
||||||
, word8 >= 0.1.3 && < 0.2
|
, word8 >= 0.1.3 && < 0.2
|
||||||
|
|
||||||
|
@ -114,7 +114,7 @@ executable greet
|
||||||
, text
|
, text
|
||||||
|
|
||||||
build-depends:
|
build-depends:
|
||||||
aeson >= 1.4.1.0 && < 3
|
aeson >= 1.4.1.0 && < 1.6
|
||||||
, warp >= 3.2.25 && < 3.4
|
, warp >= 3.2.25 && < 3.4
|
||||||
|
|
||||||
test-suite spec
|
test-suite spec
|
||||||
|
@ -157,9 +157,9 @@ test-suite spec
|
||||||
|
|
||||||
-- Additional dependencies
|
-- Additional dependencies
|
||||||
build-depends:
|
build-depends:
|
||||||
aeson >= 1.4.1.0 && < 3
|
aeson >= 1.4.1.0 && < 1.6
|
||||||
, directory >= 1.3.0.0 && < 1.4
|
, directory >= 1.3.0.0 && < 1.4
|
||||||
, hspec >= 2.6.0 && < 2.10
|
, hspec >= 2.6.0 && < 2.9
|
||||||
, hspec-wai >= 0.10.1 && < 0.12
|
, hspec-wai >= 0.10.1 && < 0.12
|
||||||
, QuickCheck >= 2.12.6.1 && < 2.15
|
, QuickCheck >= 2.12.6.1 && < 2.15
|
||||||
, should-not-typecheck >= 2.1.0 && < 2.2
|
, should-not-typecheck >= 2.1.0 && < 2.2
|
||||||
|
@ -167,4 +167,4 @@ test-suite spec
|
||||||
, wai-extra >= 3.0.24.3 && < 3.2
|
, wai-extra >= 3.0.24.3 && < 3.2
|
||||||
|
|
||||||
build-tool-depends:
|
build-tool-depends:
|
||||||
hspec-discover:hspec-discover >= 2.6.0 && <2.10
|
hspec-discover:hspec-discover >= 2.6.0 && <2.9
|
||||||
|
|
|
@ -235,7 +235,7 @@ hoistServer p = hoistServerWithContext p (Proxy :: Proxy '[])
|
||||||
-- > │ └─ e/
|
-- > │ └─ e/
|
||||||
-- > │ └─•
|
-- > │ └─•
|
||||||
-- > ├─ b/
|
-- > ├─ b/
|
||||||
-- > │ └─ <x::Int>/
|
-- > │ └─ <capture>/
|
||||||
-- > │ ├─•
|
-- > │ ├─•
|
||||||
-- > │ ┆
|
-- > │ ┆
|
||||||
-- > │ └─•
|
-- > │ └─•
|
||||||
|
@ -252,8 +252,7 @@ hoistServer p = hoistServerWithContext p (Proxy :: Proxy '[])
|
||||||
--
|
--
|
||||||
-- [@─•@] Leaves reflect endpoints.
|
-- [@─•@] Leaves reflect endpoints.
|
||||||
--
|
--
|
||||||
-- [@\<x::Int\>/@] This is a delayed capture of a single
|
-- [@\<capture\>/@] This is a delayed capture of a path component.
|
||||||
-- path component named @x@, of expected type @Int@.
|
|
||||||
--
|
--
|
||||||
-- [@\<raw\>@] This is a part of the API we do not know anything about.
|
-- [@\<raw\>@] This is a part of the API we do not know anything about.
|
||||||
--
|
--
|
||||||
|
|
|
@ -1,6 +1,5 @@
|
||||||
{-# OPTIONS_GHC -fno-warn-orphans #-}
|
{-# OPTIONS_GHC -fno-warn-orphans #-}
|
||||||
{-# LANGUAGE DeriveDataTypeable #-}
|
{-# LANGUAGE DeriveDataTypeable #-}
|
||||||
{-# LANGUAGE DeriveFunctor #-}
|
|
||||||
{-# LANGUAGE DeriveGeneric #-}
|
{-# LANGUAGE DeriveGeneric #-}
|
||||||
{-# LANGUAGE FlexibleContexts #-}
|
{-# LANGUAGE FlexibleContexts #-}
|
||||||
{-# LANGUAGE FlexibleInstances #-}
|
{-# LANGUAGE FlexibleInstances #-}
|
||||||
|
@ -45,7 +44,7 @@ type family AuthServerData a :: *
|
||||||
-- NOTE: THIS API IS EXPERIMENTAL AND SUBJECT TO CHANGE
|
-- NOTE: THIS API IS EXPERIMENTAL AND SUBJECT TO CHANGE
|
||||||
newtype AuthHandler r usr = AuthHandler
|
newtype AuthHandler r usr = AuthHandler
|
||||||
{ unAuthHandler :: r -> Handler usr }
|
{ unAuthHandler :: r -> Handler usr }
|
||||||
deriving (Functor, Generic, Typeable)
|
deriving (Generic, Typeable)
|
||||||
|
|
||||||
-- | NOTE: THIS API IS EXPERIMENTAL AND SUBJECT TO CHANGE
|
-- | NOTE: THIS API IS EXPERIMENTAL AND SUBJECT TO CHANGE
|
||||||
mkAuthHandler :: (r -> Handler usr) -> AuthHandler r usr
|
mkAuthHandler :: (r -> Handler usr) -> AuthHandler r usr
|
||||||
|
|
|
@ -1,6 +1,5 @@
|
||||||
{-# LANGUAGE AllowAmbiguousTypes #-}
|
{-# LANGUAGE AllowAmbiguousTypes #-}
|
||||||
{-# LANGUAGE ConstraintKinds #-}
|
{-# LANGUAGE ConstraintKinds #-}
|
||||||
{-# LANGUAGE CPP #-}
|
|
||||||
{-# LANGUAGE DataKinds #-}
|
{-# LANGUAGE DataKinds #-}
|
||||||
{-# LANGUAGE DeriveDataTypeable #-}
|
{-# LANGUAGE DeriveDataTypeable #-}
|
||||||
{-# LANGUAGE FlexibleContexts #-}
|
{-# LANGUAGE FlexibleContexts #-}
|
||||||
|
@ -35,15 +34,14 @@ module Servant.Server.Internal
|
||||||
import Control.Monad
|
import Control.Monad
|
||||||
(join, when)
|
(join, when)
|
||||||
import Control.Monad.Trans
|
import Control.Monad.Trans
|
||||||
(liftIO, lift)
|
(liftIO)
|
||||||
import Control.Monad.Trans.Resource
|
import Control.Monad.Trans.Resource
|
||||||
(runResourceT, ReleaseKey)
|
(runResourceT)
|
||||||
import Data.Acquire
|
|
||||||
import qualified Data.ByteString as B
|
import qualified Data.ByteString as B
|
||||||
import qualified Data.ByteString.Builder as BB
|
import qualified Data.ByteString.Builder as BB
|
||||||
import qualified Data.ByteString.Char8 as BC8
|
import qualified Data.ByteString.Char8 as BC8
|
||||||
import qualified Data.ByteString.Lazy as BL
|
import qualified Data.ByteString.Lazy as BL
|
||||||
import Data.Constraint (Constraint, Dict(..))
|
import Data.Constraint (Dict(..))
|
||||||
import Data.Either
|
import Data.Either
|
||||||
(partitionEithers)
|
(partitionEithers)
|
||||||
import Data.Maybe
|
import Data.Maybe
|
||||||
|
@ -58,7 +56,7 @@ import qualified Data.Text as T
|
||||||
import Data.Typeable
|
import Data.Typeable
|
||||||
import GHC.Generics
|
import GHC.Generics
|
||||||
import GHC.TypeLits
|
import GHC.TypeLits
|
||||||
(KnownNat, KnownSymbol, TypeError, symbolVal)
|
(KnownNat, KnownSymbol, natVal, symbolVal)
|
||||||
import qualified Network.HTTP.Media as NHM
|
import qualified Network.HTTP.Media as NHM
|
||||||
import Network.HTTP.Types hiding
|
import Network.HTTP.Types hiding
|
||||||
(Header, ResponseHeaders)
|
(Header, ResponseHeaders)
|
||||||
|
@ -78,7 +76,7 @@ import Servant.API
|
||||||
QueryParam', QueryParams, Raw, ReflectMethod (reflectMethod),
|
QueryParam', QueryParams, Raw, ReflectMethod (reflectMethod),
|
||||||
RemoteHost, ReqBody', SBool (..), SBoolI (..), SourceIO,
|
RemoteHost, ReqBody', SBool (..), SBoolI (..), SourceIO,
|
||||||
Stream, StreamBody', Summary, ToSourceIO (..), Vault, Verb,
|
Stream, StreamBody', Summary, ToSourceIO (..), Vault, Verb,
|
||||||
WithNamedContext, WithResource, NamedRoutes)
|
WithNamedContext, NamedRoutes)
|
||||||
import Servant.API.Generic (GenericMode(..), ToServant, ToServantApi, GServantProduct, toServant, fromServant)
|
import Servant.API.Generic (GenericMode(..), ToServant, ToServantApi, GServantProduct, toServant, fromServant)
|
||||||
import Servant.API.ContentTypes
|
import Servant.API.ContentTypes
|
||||||
(AcceptHeader (..), AllCTRender (..), AllCTUnrender (..),
|
(AcceptHeader (..), AllCTRender (..), AllCTUnrender (..),
|
||||||
|
@ -89,15 +87,10 @@ import Servant.API.Modifiers
|
||||||
unfoldRequestArgument)
|
unfoldRequestArgument)
|
||||||
import Servant.API.ResponseHeaders
|
import Servant.API.ResponseHeaders
|
||||||
(GetHeaders, Headers, getHeaders, getResponse)
|
(GetHeaders, Headers, getHeaders, getResponse)
|
||||||
import Servant.API.Status
|
|
||||||
(statusFromNat)
|
|
||||||
import qualified Servant.Types.SourceT as S
|
import qualified Servant.Types.SourceT as S
|
||||||
import Servant.API.TypeErrors
|
|
||||||
import Web.HttpApiData
|
import Web.HttpApiData
|
||||||
(FromHttpApiData, parseHeader, parseQueryParam, parseUrlPiece,
|
(FromHttpApiData, parseHeader, parseQueryParam, parseUrlPiece,
|
||||||
parseUrlPieces)
|
parseUrlPieces)
|
||||||
import Data.Kind
|
|
||||||
(Type)
|
|
||||||
|
|
||||||
import Servant.Server.Internal.BasicAuth
|
import Servant.Server.Internal.BasicAuth
|
||||||
import Servant.Server.Internal.Context
|
import Servant.Server.Internal.Context
|
||||||
|
@ -116,10 +109,6 @@ import Servant.API.TypeLevel
|
||||||
(AtLeastOneFragment, FragmentUnique)
|
(AtLeastOneFragment, FragmentUnique)
|
||||||
|
|
||||||
class HasServer api context where
|
class HasServer api context where
|
||||||
-- | The type of a server for this API, given a monad to run effects in.
|
|
||||||
--
|
|
||||||
-- Note that the result kind is @*@, so it is /not/ a monad transformer, unlike
|
|
||||||
-- what the @T@ in the name might suggest.
|
|
||||||
type ServerT api (m :: * -> *) :: *
|
type ServerT api (m :: * -> *) :: *
|
||||||
|
|
||||||
route ::
|
route ::
|
||||||
|
@ -181,7 +170,7 @@ instance (HasServer a context, HasServer b context) => HasServer (a :<|> b) cont
|
||||||
-- > server = getBook
|
-- > server = getBook
|
||||||
-- > where getBook :: Text -> Handler Book
|
-- > where getBook :: Text -> Handler Book
|
||||||
-- > getBook isbn = ...
|
-- > getBook isbn = ...
|
||||||
instance (KnownSymbol capture, FromHttpApiData a, Typeable a
|
instance (KnownSymbol capture, FromHttpApiData a
|
||||||
, HasServer api context, SBoolI (FoldLenient mods)
|
, HasServer api context, SBoolI (FoldLenient mods)
|
||||||
, HasContextEntry (MkContextWithErrorFormatter context) ErrorFormatters
|
, HasContextEntry (MkContextWithErrorFormatter context) ErrorFormatters
|
||||||
)
|
)
|
||||||
|
@ -193,7 +182,7 @@ instance (KnownSymbol capture, FromHttpApiData a, Typeable a
|
||||||
hoistServerWithContext _ pc nt s = hoistServerWithContext (Proxy :: Proxy api) pc nt . s
|
hoistServerWithContext _ pc nt s = hoistServerWithContext (Proxy :: Proxy api) pc nt . s
|
||||||
|
|
||||||
route Proxy context d =
|
route Proxy context d =
|
||||||
CaptureRouter [hint] $
|
CaptureRouter $
|
||||||
route (Proxy :: Proxy api)
|
route (Proxy :: Proxy api)
|
||||||
context
|
context
|
||||||
(addCapture d $ \ txt -> withRequest $ \ request ->
|
(addCapture d $ \ txt -> withRequest $ \ request ->
|
||||||
|
@ -205,7 +194,6 @@ instance (KnownSymbol capture, FromHttpApiData a, Typeable a
|
||||||
where
|
where
|
||||||
rep = typeRep (Proxy :: Proxy Capture')
|
rep = typeRep (Proxy :: Proxy Capture')
|
||||||
formatError = urlParseErrorFormatter $ getContextEntry (mkContextWithErrorFormatter context)
|
formatError = urlParseErrorFormatter $ getContextEntry (mkContextWithErrorFormatter context)
|
||||||
hint = CaptureHint (T.pack $ symbolVal $ Proxy @capture) (typeRep (Proxy :: Proxy a))
|
|
||||||
|
|
||||||
-- | If you use 'CaptureAll' in one of the endpoints for your API,
|
-- | If you use 'CaptureAll' in one of the endpoints for your API,
|
||||||
-- this automatically requires your server-side handler to be a
|
-- this automatically requires your server-side handler to be a
|
||||||
|
@ -224,7 +212,7 @@ instance (KnownSymbol capture, FromHttpApiData a, Typeable a
|
||||||
-- > server = getSourceFile
|
-- > server = getSourceFile
|
||||||
-- > where getSourceFile :: [Text] -> Handler Book
|
-- > where getSourceFile :: [Text] -> Handler Book
|
||||||
-- > getSourceFile pathSegments = ...
|
-- > getSourceFile pathSegments = ...
|
||||||
instance (KnownSymbol capture, FromHttpApiData a, Typeable a
|
instance (KnownSymbol capture, FromHttpApiData a
|
||||||
, HasServer api context
|
, HasServer api context
|
||||||
, HasContextEntry (MkContextWithErrorFormatter context) ErrorFormatters
|
, HasContextEntry (MkContextWithErrorFormatter context) ErrorFormatters
|
||||||
)
|
)
|
||||||
|
@ -236,7 +224,7 @@ instance (KnownSymbol capture, FromHttpApiData a, Typeable a
|
||||||
hoistServerWithContext _ pc nt s = hoistServerWithContext (Proxy :: Proxy api) pc nt . s
|
hoistServerWithContext _ pc nt s = hoistServerWithContext (Proxy :: Proxy api) pc nt . s
|
||||||
|
|
||||||
route Proxy context d =
|
route Proxy context d =
|
||||||
CaptureAllRouter [hint] $
|
CaptureAllRouter $
|
||||||
route (Proxy :: Proxy api)
|
route (Proxy :: Proxy api)
|
||||||
context
|
context
|
||||||
(addCapture d $ \ txts -> withRequest $ \ request ->
|
(addCapture d $ \ txts -> withRequest $ \ request ->
|
||||||
|
@ -247,43 +235,6 @@ instance (KnownSymbol capture, FromHttpApiData a, Typeable a
|
||||||
where
|
where
|
||||||
rep = typeRep (Proxy :: Proxy CaptureAll)
|
rep = typeRep (Proxy :: Proxy CaptureAll)
|
||||||
formatError = urlParseErrorFormatter $ getContextEntry (mkContextWithErrorFormatter context)
|
formatError = urlParseErrorFormatter $ getContextEntry (mkContextWithErrorFormatter context)
|
||||||
hint = CaptureHint (T.pack $ symbolVal $ Proxy @capture) (typeRep (Proxy :: Proxy [a]))
|
|
||||||
|
|
||||||
-- | If you use 'WithResource' in one of the endpoints for your API Servant
|
|
||||||
-- will provide the handler for this endpoint an argument of the specified type.
|
|
||||||
-- The lifespan of this resource will be automatically managed by Servant. This
|
|
||||||
-- resource will be created before the handler starts and it will be destoyed
|
|
||||||
-- after it ends. A new resource is created for each request to the endpoint.
|
|
||||||
|
|
||||||
-- The creation and destruction are done using a 'Data.Acquire.Acquire'
|
|
||||||
-- provided via server 'Context'.
|
|
||||||
--
|
|
||||||
-- Example
|
|
||||||
--
|
|
||||||
-- > type MyApi = WithResource Handle :> "writeToFile" :> Post '[JSON] NoContent
|
|
||||||
-- >
|
|
||||||
-- > server :: Server MyApi
|
|
||||||
-- > server = writeToFile
|
|
||||||
-- > where writeToFile :: (ReleaseKey, Handle) -> Handler NoContent
|
|
||||||
-- > writeToFile (_, h) = hPutStrLn h "message"
|
|
||||||
--
|
|
||||||
-- In addition to the resource, the handler will also receive a 'ReleaseKey'
|
|
||||||
-- which can be used to deallocate the resource before the end of the request
|
|
||||||
-- if desired.
|
|
||||||
|
|
||||||
instance (HasServer api ctx, HasContextEntry ctx (Acquire a))
|
|
||||||
=> HasServer (WithResource a :> api) ctx where
|
|
||||||
|
|
||||||
type ServerT (WithResource a :> api) m = (ReleaseKey, a) -> ServerT api m
|
|
||||||
|
|
||||||
hoistServerWithContext _ pc nt s = hoistServerWithContext (Proxy @api) pc nt . s
|
|
||||||
|
|
||||||
route Proxy context d = route (Proxy @api) context (d `addParameterCheck` allocateResource)
|
|
||||||
where
|
|
||||||
allocateResource :: DelayedIO (ReleaseKey, a)
|
|
||||||
allocateResource = DelayedIO $ lift $ allocateAcquire (getContextEntry context)
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
allowedMethodHead :: Method -> Request -> Bool
|
allowedMethodHead :: Method -> Request -> Bool
|
||||||
allowedMethodHead method request = method == methodGet && requestMethod request == methodHead
|
allowedMethodHead method request = method == methodGet && requestMethod request == methodHead
|
||||||
|
@ -347,7 +298,7 @@ instance {-# OVERLAPPABLE #-}
|
||||||
|
|
||||||
route Proxy _ = methodRouter ([],) method (Proxy :: Proxy ctypes) status
|
route Proxy _ = methodRouter ([],) method (Proxy :: Proxy ctypes) status
|
||||||
where method = reflectMethod (Proxy :: Proxy method)
|
where method = reflectMethod (Proxy :: Proxy method)
|
||||||
status = statusFromNat (Proxy :: Proxy status)
|
status = toEnum . fromInteger $ natVal (Proxy :: Proxy status)
|
||||||
|
|
||||||
instance {-# OVERLAPPING #-}
|
instance {-# OVERLAPPING #-}
|
||||||
( AllCTRender ctypes a, ReflectMethod method, KnownNat status
|
( AllCTRender ctypes a, ReflectMethod method, KnownNat status
|
||||||
|
@ -359,7 +310,7 @@ instance {-# OVERLAPPING #-}
|
||||||
|
|
||||||
route Proxy _ = methodRouter (\x -> (getHeaders x, getResponse x)) method (Proxy :: Proxy ctypes) status
|
route Proxy _ = methodRouter (\x -> (getHeaders x, getResponse x)) method (Proxy :: Proxy ctypes) status
|
||||||
where method = reflectMethod (Proxy :: Proxy method)
|
where method = reflectMethod (Proxy :: Proxy method)
|
||||||
status = statusFromNat (Proxy :: Proxy status)
|
status = toEnum . fromInteger $ natVal (Proxy :: Proxy status)
|
||||||
|
|
||||||
instance (ReflectMethod method) =>
|
instance (ReflectMethod method) =>
|
||||||
HasServer (NoContentVerb method) context where
|
HasServer (NoContentVerb method) context where
|
||||||
|
@ -380,7 +331,7 @@ instance {-# OVERLAPPABLE #-}
|
||||||
|
|
||||||
route Proxy _ = streamRouter ([],) method status (Proxy :: Proxy framing) (Proxy :: Proxy ctype)
|
route Proxy _ = streamRouter ([],) method status (Proxy :: Proxy framing) (Proxy :: Proxy ctype)
|
||||||
where method = reflectMethod (Proxy :: Proxy method)
|
where method = reflectMethod (Proxy :: Proxy method)
|
||||||
status = statusFromNat (Proxy :: Proxy status)
|
status = toEnum . fromInteger $ natVal (Proxy :: Proxy status)
|
||||||
|
|
||||||
|
|
||||||
instance {-# OVERLAPPING #-}
|
instance {-# OVERLAPPING #-}
|
||||||
|
@ -394,7 +345,7 @@ instance {-# OVERLAPPING #-}
|
||||||
|
|
||||||
route Proxy _ = streamRouter (\x -> (getHeaders x, getResponse x)) method status (Proxy :: Proxy framing) (Proxy :: Proxy ctype)
|
route Proxy _ = streamRouter (\x -> (getHeaders x, getResponse x)) method status (Proxy :: Proxy framing) (Proxy :: Proxy ctype)
|
||||||
where method = reflectMethod (Proxy :: Proxy method)
|
where method = reflectMethod (Proxy :: Proxy method)
|
||||||
status = statusFromNat (Proxy :: Proxy status)
|
status = toEnum . fromInteger $ natVal (Proxy :: Proxy status)
|
||||||
|
|
||||||
|
|
||||||
streamRouter :: forall ctype a c chunk env framing. (MimeRender ctype chunk, FramingRender framing, ToSourceIO chunk a) =>
|
streamRouter :: forall ctype a c chunk env framing. (MimeRender ctype chunk, FramingRender framing, ToSourceIO chunk a) =>
|
||||||
|
@ -861,19 +812,38 @@ instance (HasContextEntry context (NamedContext name subContext), HasServer subA
|
||||||
hoistServerWithContext _ _ nt s = hoistServerWithContext (Proxy :: Proxy subApi) (Proxy :: Proxy subContext) nt s
|
hoistServerWithContext _ _ nt s = hoistServerWithContext (Proxy :: Proxy subApi) (Proxy :: Proxy subContext) nt s
|
||||||
|
|
||||||
-------------------------------------------------------------------------------
|
-------------------------------------------------------------------------------
|
||||||
-- Custom type errors
|
-- TypeError helpers
|
||||||
-------------------------------------------------------------------------------
|
-------------------------------------------------------------------------------
|
||||||
|
|
||||||
-- Erroring instance for 'HasServer' when a combinator is not fully applied
|
-- | This instance catches mistakes when there are non-saturated
|
||||||
instance TypeError (PartialApplication
|
-- type applications on LHS of ':>'.
|
||||||
#if __GLASGOW_HASKELL__ >= 904
|
--
|
||||||
@(Type -> [Type] -> Constraint)
|
-- >>> serve (Proxy :: Proxy (Capture "foo" :> Get '[JSON] Int)) (error "...")
|
||||||
#endif
|
-- ...
|
||||||
HasServer arr) => HasServer ((arr :: a -> b) :> sub) context
|
-- ...Expected something of kind Symbol or *, got: k -> l on the LHS of ':>'.
|
||||||
|
-- ...Maybe you haven't applied enough arguments to
|
||||||
|
-- ...Capture' '[] "foo"
|
||||||
|
-- ...
|
||||||
|
--
|
||||||
|
-- >>> undefined :: Server (Capture "foo" :> Get '[JSON] Int)
|
||||||
|
-- ...
|
||||||
|
-- ...Expected something of kind Symbol or *, got: k -> l on the LHS of ':>'.
|
||||||
|
-- ...Maybe you haven't applied enough arguments to
|
||||||
|
-- ...Capture' '[] "foo"
|
||||||
|
-- ...
|
||||||
|
--
|
||||||
|
instance TypeError (HasServerArrowKindError arr) => HasServer ((arr :: k -> l) :> api) context
|
||||||
where
|
where
|
||||||
type ServerT (arr :> sub) _ = TypeError (PartialApplication (HasServer :: * -> [*] -> Constraint) arr)
|
type ServerT (arr :> api) m = TypeError (HasServerArrowKindError arr)
|
||||||
route = error "unreachable"
|
-- it doesn't really matter what sub route we peak
|
||||||
hoistServerWithContext _ _ _ _ = error "unreachable"
|
route _ _ _ = error "servant-server panic: impossible happened in HasServer (arr :> api)"
|
||||||
|
hoistServerWithContext _ _ _ = id
|
||||||
|
|
||||||
|
-- Cannot have TypeError here, otherwise use of this symbol will error :)
|
||||||
|
type HasServerArrowKindError arr =
|
||||||
|
'Text "Expected something of kind Symbol or *, got: k -> l on the LHS of ':>'."
|
||||||
|
':$$: 'Text "Maybe you haven't applied enough arguments to"
|
||||||
|
':$$: 'ShowType arr
|
||||||
|
|
||||||
-- | This instance prevents from accidentally using '->' instead of ':>'
|
-- | This instance prevents from accidentally using '->' instead of ':>'
|
||||||
--
|
--
|
||||||
|
@ -908,19 +878,6 @@ type HasServerArrowTypeError a b =
|
||||||
':$$: 'Text "and"
|
':$$: 'Text "and"
|
||||||
':$$: 'ShowType b
|
':$$: 'ShowType b
|
||||||
|
|
||||||
-- Erroring instances for 'HasServer' for unknown API combinators
|
|
||||||
|
|
||||||
-- XXX: This omits the @context@ parameter, e.g.:
|
|
||||||
--
|
|
||||||
-- "There is no instance for HasServer (Bool :> …)". Do we care ?
|
|
||||||
instance {-# OVERLAPPABLE #-} TypeError (NoInstanceForSub
|
|
||||||
#if __GLASGOW_HASKELL__ >= 904
|
|
||||||
@(Type -> [Type] -> Constraint)
|
|
||||||
#endif
|
|
||||||
HasServer ty) => HasServer (ty :> sub) context
|
|
||||||
|
|
||||||
instance {-# OVERLAPPABLE #-} TypeError (NoInstanceFor (HasServer api context)) => HasServer api context
|
|
||||||
|
|
||||||
-- | Ignore @'Fragment'@ in server handlers.
|
-- | Ignore @'Fragment'@ in server handlers.
|
||||||
-- See <https://ietf.org/rfc/rfc2616.html#section-15.1.3> for more details.
|
-- See <https://ietf.org/rfc/rfc2616.html#section-15.1.3> for more details.
|
||||||
--
|
--
|
||||||
|
|
|
@ -13,19 +13,17 @@ import Control.Monad.Base
|
||||||
import Control.Monad.Catch
|
import Control.Monad.Catch
|
||||||
(MonadCatch, MonadMask, MonadThrow)
|
(MonadCatch, MonadMask, MonadThrow)
|
||||||
import Control.Monad.Error.Class
|
import Control.Monad.Error.Class
|
||||||
(MonadError, throwError)
|
(MonadError)
|
||||||
import Control.Monad.IO.Class
|
import Control.Monad.IO.Class
|
||||||
(MonadIO)
|
(MonadIO)
|
||||||
import Control.Monad.Trans.Control
|
import Control.Monad.Trans.Control
|
||||||
(MonadBaseControl (..))
|
(MonadBaseControl (..))
|
||||||
import Control.Monad.Trans.Except
|
import Control.Monad.Trans.Except
|
||||||
(ExceptT, runExceptT)
|
(ExceptT, runExceptT)
|
||||||
import Data.String
|
|
||||||
(fromString)
|
|
||||||
import GHC.Generics
|
import GHC.Generics
|
||||||
(Generic)
|
(Generic)
|
||||||
import Servant.Server.Internal.ServerError
|
import Servant.Server.Internal.ServerError
|
||||||
(ServerError, errBody, err500)
|
(ServerError)
|
||||||
|
|
||||||
newtype Handler a = Handler { runHandler' :: ExceptT ServerError IO a }
|
newtype Handler a = Handler { runHandler' :: ExceptT ServerError IO a }
|
||||||
deriving
|
deriving
|
||||||
|
@ -34,9 +32,6 @@ newtype Handler a = Handler { runHandler' :: ExceptT ServerError IO a }
|
||||||
, MonadThrow, MonadCatch, MonadMask
|
, MonadThrow, MonadCatch, MonadMask
|
||||||
)
|
)
|
||||||
|
|
||||||
instance MonadFail Handler where
|
|
||||||
fail str = throwError err500 { errBody = fromString str }
|
|
||||||
|
|
||||||
instance MonadBase IO Handler where
|
instance MonadBase IO Handler where
|
||||||
liftBase = Handler . liftBase
|
liftBase = Handler . liftBase
|
||||||
|
|
||||||
|
|
|
@ -9,16 +9,12 @@ import Prelude.Compat
|
||||||
|
|
||||||
import Data.Function
|
import Data.Function
|
||||||
(on)
|
(on)
|
||||||
import Data.List
|
|
||||||
(nub)
|
|
||||||
import Data.Map
|
import Data.Map
|
||||||
(Map)
|
(Map)
|
||||||
import qualified Data.Map as M
|
import qualified Data.Map as M
|
||||||
import Data.Text
|
import Data.Text
|
||||||
(Text)
|
(Text)
|
||||||
import qualified Data.Text as T
|
import qualified Data.Text as T
|
||||||
import Data.Typeable
|
|
||||||
(TypeRep)
|
|
||||||
import Network.Wai
|
import Network.Wai
|
||||||
(Response, pathInfo)
|
(Response, pathInfo)
|
||||||
import Servant.Server.Internal.ErrorFormatter
|
import Servant.Server.Internal.ErrorFormatter
|
||||||
|
@ -28,21 +24,6 @@ import Servant.Server.Internal.ServerError
|
||||||
|
|
||||||
type Router env = Router' env RoutingApplication
|
type Router env = Router' env RoutingApplication
|
||||||
|
|
||||||
-- | Holds information about pieces of url that are captured as variables.
|
|
||||||
data CaptureHint = CaptureHint
|
|
||||||
{ captureName :: Text
|
|
||||||
-- ^ Holds the name of the captured variable
|
|
||||||
, captureType :: TypeRep
|
|
||||||
-- ^ Holds the type of the captured variable
|
|
||||||
}
|
|
||||||
deriving (Show, Eq)
|
|
||||||
|
|
||||||
toCaptureTag :: CaptureHint -> Text
|
|
||||||
toCaptureTag hint = captureName hint <> "::" <> (T.pack . show) (captureType hint)
|
|
||||||
|
|
||||||
toCaptureTags :: [CaptureHint] -> Text
|
|
||||||
toCaptureTags hints = "<" <> T.intercalate "|" (map toCaptureTag hints) <> ">"
|
|
||||||
|
|
||||||
-- | Internal representation of a router.
|
-- | Internal representation of a router.
|
||||||
--
|
--
|
||||||
-- The first argument describes an environment type that is
|
-- The first argument describes an environment type that is
|
||||||
|
@ -55,23 +36,12 @@ data Router' env a =
|
||||||
-- ^ the map contains routers for subpaths (first path component used
|
-- ^ the map contains routers for subpaths (first path component used
|
||||||
-- for lookup and removed afterwards), the list contains handlers
|
-- for lookup and removed afterwards), the list contains handlers
|
||||||
-- for the empty path, to be tried in order
|
-- for the empty path, to be tried in order
|
||||||
| CaptureRouter [CaptureHint] (Router' (Text, env) a)
|
| CaptureRouter (Router' (Text, env) a)
|
||||||
-- ^ first path component is passed to the child router in its
|
-- ^ first path component is passed to the child router in its
|
||||||
-- environment and removed afterwards.
|
-- environment and removed afterwards
|
||||||
-- The first argument is a list of hints for all variables that can be
|
| CaptureAllRouter (Router' ([Text], env) a)
|
||||||
-- captured by the router. The fact that it is a list is counter-intuitive,
|
|
||||||
-- because the 'Capture' combinator only allows to capture a single varible,
|
|
||||||
-- with a single name and a single type. However, the 'choice' smart
|
|
||||||
-- constructor may merge two 'Capture' combinators with different hints, thus
|
|
||||||
-- forcing the type to be '[CaptureHint]'.
|
|
||||||
-- Because 'CaptureRouter' is built from a 'Capture' combinator, the list of
|
|
||||||
-- hints should always be non-empty.
|
|
||||||
| CaptureAllRouter [CaptureHint] (Router' ([Text], env) a)
|
|
||||||
-- ^ all path components are passed to the child router in its
|
-- ^ all path components are passed to the child router in its
|
||||||
-- environment and are removed afterwards
|
-- environment and are removed afterwards
|
||||||
-- The first argument is a hint for the list of variables that can be
|
|
||||||
-- captured by the router. Note that the 'captureType' field of the hint
|
|
||||||
-- should always be '[a]' for some 'a'.
|
|
||||||
| RawRouter (env -> a)
|
| RawRouter (env -> a)
|
||||||
-- ^ to be used for routes we do not know anything about
|
-- ^ to be used for routes we do not know anything about
|
||||||
| Choice (Router' env a) (Router' env a)
|
| Choice (Router' env a) (Router' env a)
|
||||||
|
@ -99,8 +69,8 @@ leafRouter l = StaticRouter M.empty [l]
|
||||||
choice :: Router' env a -> Router' env a -> Router' env a
|
choice :: Router' env a -> Router' env a -> Router' env a
|
||||||
choice (StaticRouter table1 ls1) (StaticRouter table2 ls2) =
|
choice (StaticRouter table1 ls1) (StaticRouter table2 ls2) =
|
||||||
StaticRouter (M.unionWith choice table1 table2) (ls1 ++ ls2)
|
StaticRouter (M.unionWith choice table1 table2) (ls1 ++ ls2)
|
||||||
choice (CaptureRouter hints1 router1) (CaptureRouter hints2 router2) =
|
choice (CaptureRouter router1) (CaptureRouter router2) =
|
||||||
CaptureRouter (nub $ hints1 ++ hints2) (choice router1 router2)
|
CaptureRouter (choice router1 router2)
|
||||||
choice router1 (Choice router2 router3) = Choice (choice router1 router2) router3
|
choice router1 (Choice router2 router3) = Choice (choice router1 router2) router3
|
||||||
choice router1 router2 = Choice router1 router2
|
choice router1 router2 = Choice router1 router2
|
||||||
|
|
||||||
|
@ -114,11 +84,7 @@ choice router1 router2 = Choice router1 router2
|
||||||
--
|
--
|
||||||
data RouterStructure =
|
data RouterStructure =
|
||||||
StaticRouterStructure (Map Text RouterStructure) Int
|
StaticRouterStructure (Map Text RouterStructure) Int
|
||||||
| CaptureRouterStructure [CaptureHint] RouterStructure
|
| CaptureRouterStructure RouterStructure
|
||||||
-- ^ The first argument holds information about variables
|
|
||||||
-- that are captured by the router. There may be several hints
|
|
||||||
-- if several routers have been aggregated by the 'choice'
|
|
||||||
-- smart constructor.
|
|
||||||
| RawRouterStructure
|
| RawRouterStructure
|
||||||
| ChoiceStructure RouterStructure RouterStructure
|
| ChoiceStructure RouterStructure RouterStructure
|
||||||
deriving (Eq, Show)
|
deriving (Eq, Show)
|
||||||
|
@ -132,11 +98,11 @@ data RouterStructure =
|
||||||
routerStructure :: Router' env a -> RouterStructure
|
routerStructure :: Router' env a -> RouterStructure
|
||||||
routerStructure (StaticRouter m ls) =
|
routerStructure (StaticRouter m ls) =
|
||||||
StaticRouterStructure (fmap routerStructure m) (length ls)
|
StaticRouterStructure (fmap routerStructure m) (length ls)
|
||||||
routerStructure (CaptureRouter hints router) =
|
routerStructure (CaptureRouter router) =
|
||||||
CaptureRouterStructure hints $
|
CaptureRouterStructure $
|
||||||
routerStructure router
|
routerStructure router
|
||||||
routerStructure (CaptureAllRouter hints router) =
|
routerStructure (CaptureAllRouter router) =
|
||||||
CaptureRouterStructure hints $
|
CaptureRouterStructure $
|
||||||
routerStructure router
|
routerStructure router
|
||||||
routerStructure (RawRouter _) =
|
routerStructure (RawRouter _) =
|
||||||
RawRouterStructure
|
RawRouterStructure
|
||||||
|
@ -148,8 +114,8 @@ routerStructure (Choice r1 r2) =
|
||||||
-- | Compare the structure of two routers.
|
-- | Compare the structure of two routers.
|
||||||
--
|
--
|
||||||
sameStructure :: Router' env a -> Router' env b -> Bool
|
sameStructure :: Router' env a -> Router' env b -> Bool
|
||||||
sameStructure router1 router2 =
|
sameStructure r1 r2 =
|
||||||
routerStructure router1 == routerStructure router2
|
routerStructure r1 == routerStructure r2
|
||||||
|
|
||||||
-- | Provide a textual representation of the
|
-- | Provide a textual representation of the
|
||||||
-- structure of a router.
|
-- structure of a router.
|
||||||
|
@ -160,8 +126,7 @@ routerLayout router =
|
||||||
where
|
where
|
||||||
mkRouterLayout :: Bool -> RouterStructure -> [Text]
|
mkRouterLayout :: Bool -> RouterStructure -> [Text]
|
||||||
mkRouterLayout c (StaticRouterStructure m n) = mkSubTrees c (M.toList m) n
|
mkRouterLayout c (StaticRouterStructure m n) = mkSubTrees c (M.toList m) n
|
||||||
mkRouterLayout c (CaptureRouterStructure hints r) =
|
mkRouterLayout c (CaptureRouterStructure r) = mkSubTree c "<capture>" (mkRouterLayout False r)
|
||||||
mkSubTree c (toCaptureTags hints) (mkRouterLayout False r)
|
|
||||||
mkRouterLayout c RawRouterStructure =
|
mkRouterLayout c RawRouterStructure =
|
||||||
if c then ["├─ <raw>"] else ["└─ <raw>"]
|
if c then ["├─ <raw>"] else ["└─ <raw>"]
|
||||||
mkRouterLayout c (ChoiceStructure r1 r2) =
|
mkRouterLayout c (ChoiceStructure r1 r2) =
|
||||||
|
@ -204,7 +169,7 @@ runRouterEnv fmt router env request respond =
|
||||||
-> let request' = request { pathInfo = rest }
|
-> let request' = request { pathInfo = rest }
|
||||||
in runRouterEnv fmt router' env request' respond
|
in runRouterEnv fmt router' env request' respond
|
||||||
_ -> respond $ Fail $ fmt request
|
_ -> respond $ Fail $ fmt request
|
||||||
CaptureRouter _ router' ->
|
CaptureRouter router' ->
|
||||||
case pathInfo request of
|
case pathInfo request of
|
||||||
[] -> respond $ Fail $ fmt request
|
[] -> respond $ Fail $ fmt request
|
||||||
-- This case is to handle trailing slashes.
|
-- This case is to handle trailing slashes.
|
||||||
|
@ -212,7 +177,7 @@ runRouterEnv fmt router env request respond =
|
||||||
first : rest
|
first : rest
|
||||||
-> let request' = request { pathInfo = rest }
|
-> let request' = request { pathInfo = rest }
|
||||||
in runRouterEnv fmt router' (first, env) request' respond
|
in runRouterEnv fmt router' (first, env) request' respond
|
||||||
CaptureAllRouter _ router' ->
|
CaptureAllRouter router' ->
|
||||||
let segments = pathInfo request
|
let segments = pathInfo request
|
||||||
request' = request { pathInfo = [] }
|
request' = request { pathInfo = [] }
|
||||||
in runRouterEnv fmt router' (segments, env) request' respond
|
in runRouterEnv fmt router' (segments, env) request' respond
|
||||||
|
|
|
@ -9,9 +9,7 @@ import Control.Monad
|
||||||
import Data.Proxy
|
import Data.Proxy
|
||||||
(Proxy (..))
|
(Proxy (..))
|
||||||
import Data.Text
|
import Data.Text
|
||||||
(Text, unpack)
|
(unpack)
|
||||||
import Data.Typeable
|
|
||||||
(typeRep)
|
|
||||||
import Network.HTTP.Types
|
import Network.HTTP.Types
|
||||||
(Status (..))
|
(Status (..))
|
||||||
import Network.Wai
|
import Network.Wai
|
||||||
|
@ -29,7 +27,6 @@ spec :: Spec
|
||||||
spec = describe "Servant.Server.Internal.Router" $ do
|
spec = describe "Servant.Server.Internal.Router" $ do
|
||||||
routerSpec
|
routerSpec
|
||||||
distributivitySpec
|
distributivitySpec
|
||||||
serverLayoutSpec
|
|
||||||
|
|
||||||
routerSpec :: Spec
|
routerSpec :: Spec
|
||||||
routerSpec = do
|
routerSpec = do
|
||||||
|
@ -54,7 +51,7 @@ routerSpec = do
|
||||||
toApp = toApplication . runRouter (const err404)
|
toApp = toApplication . runRouter (const err404)
|
||||||
|
|
||||||
cap :: Router ()
|
cap :: Router ()
|
||||||
cap = CaptureRouter [hint] $
|
cap = CaptureRouter $
|
||||||
let delayed = addCapture (emptyDelayed $ Route pure) (const $ delayedFail err400)
|
let delayed = addCapture (emptyDelayed $ Route pure) (const $ delayedFail err400)
|
||||||
in leafRouter
|
in leafRouter
|
||||||
$ \env req res ->
|
$ \env req res ->
|
||||||
|
@ -62,9 +59,6 @@ routerSpec = do
|
||||||
. const
|
. const
|
||||||
$ Route success
|
$ Route success
|
||||||
|
|
||||||
hint :: CaptureHint
|
|
||||||
hint = CaptureHint "anything" $ typeRep (Proxy :: Proxy ())
|
|
||||||
|
|
||||||
router :: Router ()
|
router :: Router ()
|
||||||
router = leafRouter (\_ _ res -> res $ Route success)
|
router = leafRouter (\_ _ res -> res $ Route success)
|
||||||
`Choice` cap
|
`Choice` cap
|
||||||
|
@ -104,30 +98,12 @@ distributivitySpec =
|
||||||
it "properly handles mixing static paths at different levels" $ do
|
it "properly handles mixing static paths at different levels" $ do
|
||||||
level `shouldHaveSameStructureAs` levelRef
|
level `shouldHaveSameStructureAs` levelRef
|
||||||
|
|
||||||
serverLayoutSpec :: Spec
|
|
||||||
serverLayoutSpec =
|
|
||||||
describe "serverLayout" $ do
|
|
||||||
it "correctly represents the example API" $ do
|
|
||||||
exampleLayout `shouldHaveLayout` expectedExampleLayout
|
|
||||||
it "aggregates capture hints when different" $ do
|
|
||||||
captureDifferentTypes `shouldHaveLayout` expectedCaptureDifferentTypes
|
|
||||||
it "nubs capture hints when equal" $ do
|
|
||||||
captureSameType `shouldHaveLayout` expectedCaptureSameType
|
|
||||||
it "properly displays CaptureAll hints" $ do
|
|
||||||
captureAllLayout `shouldHaveLayout` expectedCaptureAllLayout
|
|
||||||
|
|
||||||
shouldHaveSameStructureAs ::
|
shouldHaveSameStructureAs ::
|
||||||
(HasServer api1 '[], HasServer api2 '[]) => Proxy api1 -> Proxy api2 -> Expectation
|
(HasServer api1 '[], HasServer api2 '[]) => Proxy api1 -> Proxy api2 -> Expectation
|
||||||
shouldHaveSameStructureAs p1 p2 =
|
shouldHaveSameStructureAs p1 p2 =
|
||||||
unless (sameStructure (makeTrivialRouter p1) (makeTrivialRouter p2)) $
|
unless (sameStructure (makeTrivialRouter p1) (makeTrivialRouter p2)) $
|
||||||
expectationFailure ("expected:\n" ++ unpack (layout p2) ++ "\nbut got:\n" ++ unpack (layout p1))
|
expectationFailure ("expected:\n" ++ unpack (layout p2) ++ "\nbut got:\n" ++ unpack (layout p1))
|
||||||
|
|
||||||
shouldHaveLayout ::
|
|
||||||
(HasServer api '[]) => Proxy api -> Text -> Expectation
|
|
||||||
shouldHaveLayout p l =
|
|
||||||
unless (routerLayout (makeTrivialRouter p) == l) $
|
|
||||||
expectationFailure ("expected:\n" ++ unpack l ++ "\nbut got:\n" ++ unpack (layout p))
|
|
||||||
|
|
||||||
makeTrivialRouter :: (HasServer layout '[]) => Proxy layout -> Router ()
|
makeTrivialRouter :: (HasServer layout '[]) => Proxy layout -> Router ()
|
||||||
makeTrivialRouter p =
|
makeTrivialRouter p =
|
||||||
route p EmptyContext (emptyDelayed (FailFatal err501))
|
route p EmptyContext (emptyDelayed (FailFatal err501))
|
||||||
|
@ -169,11 +145,11 @@ staticRef = Proxy
|
||||||
|
|
||||||
type Dynamic =
|
type Dynamic =
|
||||||
"a" :> Capture "foo" Int :> "b" :> End
|
"a" :> Capture "foo" Int :> "b" :> End
|
||||||
:<|> "a" :> Capture "foo" Int :> "c" :> End
|
:<|> "a" :> Capture "bar" Bool :> "c" :> End
|
||||||
:<|> "a" :> Capture "foo" Int :> "d" :> End
|
:<|> "a" :> Capture "baz" Char :> "d" :> End
|
||||||
|
|
||||||
type DynamicRef =
|
type DynamicRef =
|
||||||
"a" :> Capture "foo" Int :>
|
"a" :> Capture "anything" () :>
|
||||||
("b" :> End :<|> "c" :> End :<|> "d" :> End)
|
("b" :> End :<|> "c" :> End :<|> "d" :> End)
|
||||||
|
|
||||||
dynamic :: Proxy Dynamic
|
dynamic :: Proxy Dynamic
|
||||||
|
@ -363,100 +339,3 @@ level = Proxy
|
||||||
|
|
||||||
levelRef :: Proxy LevelRef
|
levelRef :: Proxy LevelRef
|
||||||
levelRef = Proxy
|
levelRef = Proxy
|
||||||
|
|
||||||
-- The example API for the 'layout' function.
|
|
||||||
-- Should get factorized by the 'choice' smart constructor.
|
|
||||||
type ExampleLayout =
|
|
||||||
"a" :> "d" :> Get '[JSON] NoContent
|
|
||||||
:<|> "b" :> Capture "x" Int :> Get '[JSON] Bool
|
|
||||||
:<|> "c" :> Put '[JSON] Bool
|
|
||||||
:<|> "a" :> "e" :> Get '[JSON] Int
|
|
||||||
:<|> "b" :> Capture "x" Int :> Put '[JSON] Bool
|
|
||||||
:<|> Raw
|
|
||||||
|
|
||||||
exampleLayout :: Proxy ExampleLayout
|
|
||||||
exampleLayout = Proxy
|
|
||||||
|
|
||||||
-- The expected representation of the example API layout
|
|
||||||
--
|
|
||||||
expectedExampleLayout :: Text
|
|
||||||
expectedExampleLayout =
|
|
||||||
"/\n\
|
|
||||||
\├─ a/\n\
|
|
||||||
\│ ├─ d/\n\
|
|
||||||
\│ │ └─•\n\
|
|
||||||
\│ └─ e/\n\
|
|
||||||
\│ └─•\n\
|
|
||||||
\├─ b/\n\
|
|
||||||
\│ └─ <x::Int>/\n\
|
|
||||||
\│ ├─•\n\
|
|
||||||
\│ ┆\n\
|
|
||||||
\│ └─•\n\
|
|
||||||
\├─ c/\n\
|
|
||||||
\│ └─•\n\
|
|
||||||
\┆\n\
|
|
||||||
\└─ <raw>\n"
|
|
||||||
|
|
||||||
-- A capture API with all capture types being the same
|
|
||||||
--
|
|
||||||
type CaptureSameType =
|
|
||||||
"a" :> Capture "foo" Int :> "b" :> End
|
|
||||||
:<|> "a" :> Capture "foo" Int :> "c" :> End
|
|
||||||
:<|> "a" :> Capture "foo" Int :> "d" :> End
|
|
||||||
|
|
||||||
captureSameType :: Proxy CaptureSameType
|
|
||||||
captureSameType = Proxy
|
|
||||||
|
|
||||||
-- The expected representation of the CaptureSameType API layout.
|
|
||||||
--
|
|
||||||
expectedCaptureSameType :: Text
|
|
||||||
expectedCaptureSameType =
|
|
||||||
"/\n\
|
|
||||||
\└─ a/\n\
|
|
||||||
\ └─ <foo::Int>/\n\
|
|
||||||
\ ├─ b/\n\
|
|
||||||
\ │ └─•\n\
|
|
||||||
\ ├─ c/\n\
|
|
||||||
\ │ └─•\n\
|
|
||||||
\ └─ d/\n\
|
|
||||||
\ └─•\n"
|
|
||||||
|
|
||||||
-- A capture API capturing different types
|
|
||||||
--
|
|
||||||
type CaptureDifferentTypes =
|
|
||||||
"a" :> Capture "foo" Int :> "b" :> End
|
|
||||||
:<|> "a" :> Capture "bar" Bool :> "c" :> End
|
|
||||||
:<|> "a" :> Capture "baz" Char :> "d" :> End
|
|
||||||
|
|
||||||
captureDifferentTypes :: Proxy CaptureDifferentTypes
|
|
||||||
captureDifferentTypes = Proxy
|
|
||||||
|
|
||||||
-- The expected representation of the CaptureDifferentTypes API layout.
|
|
||||||
--
|
|
||||||
expectedCaptureDifferentTypes :: Text
|
|
||||||
expectedCaptureDifferentTypes =
|
|
||||||
"/\n\
|
|
||||||
\└─ a/\n\
|
|
||||||
\ └─ <foo::Int|bar::Bool|baz::Char>/\n\
|
|
||||||
\ ├─ b/\n\
|
|
||||||
\ │ └─•\n\
|
|
||||||
\ ├─ c/\n\
|
|
||||||
\ │ └─•\n\
|
|
||||||
\ └─ d/\n\
|
|
||||||
\ └─•\n"
|
|
||||||
|
|
||||||
-- An API with a CaptureAll part
|
|
||||||
|
|
||||||
type CaptureAllLayout = "a" :> CaptureAll "foos" Int :> End
|
|
||||||
|
|
||||||
captureAllLayout :: Proxy CaptureAllLayout
|
|
||||||
captureAllLayout = Proxy
|
|
||||||
|
|
||||||
-- The expected representation of the CaptureAllLayout API.
|
|
||||||
--
|
|
||||||
expectedCaptureAllLayout :: Text
|
|
||||||
expectedCaptureAllLayout =
|
|
||||||
"/\n\
|
|
||||||
\└─ a/\n\
|
|
||||||
\ └─ <foos::[Int]>/\n\
|
|
||||||
\ └─•\n"
|
|
||||||
|
|
|
@ -21,8 +21,6 @@ import Control.Monad.Error.Class
|
||||||
(MonadError (..))
|
(MonadError (..))
|
||||||
import Data.Aeson
|
import Data.Aeson
|
||||||
(FromJSON, ToJSON, decode', encode)
|
(FromJSON, ToJSON, decode', encode)
|
||||||
import Data.Acquire
|
|
||||||
(Acquire, mkAcquire)
|
|
||||||
import qualified Data.ByteString as BS
|
import qualified Data.ByteString as BS
|
||||||
import qualified Data.ByteString.Base64 as Base64
|
import qualified Data.ByteString.Base64 as Base64
|
||||||
import Data.Char
|
import Data.Char
|
||||||
|
@ -83,11 +81,8 @@ import Servant.Server.Internal.Context
|
||||||
-- This declaration simply checks that all instances are in place.
|
-- This declaration simply checks that all instances are in place.
|
||||||
_ = serveWithContext comprehensiveAPI comprehensiveApiContext
|
_ = serveWithContext comprehensiveAPI comprehensiveApiContext
|
||||||
|
|
||||||
comprehensiveApiContext :: Context '[NamedContext "foo" '[], Acquire Int]
|
comprehensiveApiContext :: Context '[NamedContext "foo" '[]]
|
||||||
comprehensiveApiContext =
|
comprehensiveApiContext = NamedContext EmptyContext :. EmptyContext
|
||||||
NamedContext EmptyContext :.
|
|
||||||
mkAcquire (pure 10) (\_ -> pure ()) :.
|
|
||||||
EmptyContext
|
|
||||||
|
|
||||||
-- * Specs
|
-- * Specs
|
||||||
|
|
||||||
|
|
|
@ -1,143 +0,0 @@
|
||||||
1.1.9
|
|
||||||
-------
|
|
||||||
|
|
||||||
* Support `servant-0.18`
|
|
||||||
|
|
||||||
1.1.8
|
|
||||||
-------
|
|
||||||
|
|
||||||
* Support `servant-0.17`
|
|
||||||
|
|
||||||
1.1.7.1
|
|
||||||
-------
|
|
||||||
|
|
||||||
* Support `swagger2-2.4`
|
|
||||||
|
|
||||||
1.1.7
|
|
||||||
-----
|
|
||||||
|
|
||||||
* Support servant-0.15
|
|
||||||
- support for 'Stream' and 'StreamBody' combinators
|
|
||||||
- orphan 'ToSchema (SourceT m a)' instance
|
|
||||||
* Fix BodyTypes to work with generalized ReqBody'
|
|
||||||
[#88](https://github.com/haskell-servant/servant-swagger/pull/88)
|
|
||||||
|
|
||||||
1.1.6
|
|
||||||
-----
|
|
||||||
|
|
||||||
* Fixes:
|
|
||||||
* `validateEveryToJSON` now prints validation errors
|
|
||||||
|
|
||||||
* Notes:
|
|
||||||
* GHC-8.6 compatible release
|
|
||||||
|
|
||||||
1.1.5
|
|
||||||
-----
|
|
||||||
|
|
||||||
* Notes:
|
|
||||||
* `servant-0.13` compatible release
|
|
||||||
* Drops compatibility with previous `servant` versions.
|
|
||||||
|
|
||||||
1.1.4
|
|
||||||
-----
|
|
||||||
|
|
||||||
* Notes:
|
|
||||||
* `servant-0.12` compatible release
|
|
||||||
|
|
||||||
1.1.3.1
|
|
||||||
---
|
|
||||||
|
|
||||||
* Notes:
|
|
||||||
* GHC-8.2 compatible release
|
|
||||||
|
|
||||||
1.1.3
|
|
||||||
---
|
|
||||||
|
|
||||||
* Notes:
|
|
||||||
* `servant-0.11` compatible release
|
|
||||||
|
|
||||||
1.1.2.1
|
|
||||||
---
|
|
||||||
|
|
||||||
* Notes:
|
|
||||||
* `servant-0.10` compatible release
|
|
||||||
|
|
||||||
1.1.2
|
|
||||||
---
|
|
||||||
|
|
||||||
* Minor fixes:
|
|
||||||
* Support for aeson-1, insert-ordered-containers-0.2
|
|
||||||
* CaptureAll instance
|
|
||||||
|
|
||||||
1.1.1
|
|
||||||
---
|
|
||||||
|
|
||||||
* Minor fixes:
|
|
||||||
* Fix `unused-imports` and `unused-foralls` warnings;
|
|
||||||
* Fix tests to match `swagger2-2.1.1` (add `example` property for `UTCTime` schema).
|
|
||||||
|
|
||||||
1.1
|
|
||||||
---
|
|
||||||
|
|
||||||
* Breaking changes:
|
|
||||||
* Requires `swagger2 >= 2.1`
|
|
||||||
* Requires `servant >= 0.5`
|
|
||||||
|
|
||||||
* Notes:
|
|
||||||
* GHC-8.0 compatible release
|
|
||||||
|
|
||||||
1.0.3
|
|
||||||
---
|
|
||||||
|
|
||||||
* Fixes:
|
|
||||||
* Improve compile-time performance of `BodyTypes` even further (see [18e0d95](https://github.com/haskell-servant/servant-swagger/commit/18e0d95ef6fe9076dd9621cb515d8d1a189f71d3))!
|
|
||||||
|
|
||||||
1.0.2
|
|
||||||
---
|
|
||||||
|
|
||||||
* Minor changes:
|
|
||||||
* Add GHC 7.8 support (see [#26](https://github.com/haskell-servant/servant-swagger/pull/26)).
|
|
||||||
|
|
||||||
* Fixes:
|
|
||||||
* Improve compile-time performance of `BodyTypes` (see [#25](https://github.com/haskell-servant/servant-swagger/issues/25)).
|
|
||||||
|
|
||||||
1.0.1
|
|
||||||
---
|
|
||||||
|
|
||||||
* Fixes:
|
|
||||||
* Stop using `Data.Swagger.Internal`;
|
|
||||||
* Documentation fixes (links to examples).
|
|
||||||
|
|
||||||
1.0
|
|
||||||
---
|
|
||||||
|
|
||||||
* Major changes (see [#24](https://github.com/haskell-servant/servant-swagger/pull/24)):
|
|
||||||
* Switch to `swagger2-2.*`;
|
|
||||||
* Add automatic `ToJSON`/`ToSchema` validation tests;
|
|
||||||
* Add great documentation;
|
|
||||||
* Export some type-level functions for servant API.
|
|
||||||
|
|
||||||
* Minor changes:
|
|
||||||
* Rework Todo API example;
|
|
||||||
* Stop exporting `ToResponseHeader`, `AllAccept` and `AllToResponseHeader` (see [bd50db4](https://github.com/haskell-servant/servant-swagger/commit/bd50db48ca6a106e4366560ded70932d409de1e2));
|
|
||||||
* Change maintainer, update authors/copyrights (see [1a62681](https://github.com/haskell-servant/servant-swagger/commit/1a6268101dc826a92c42e832e402e251c0d32147));
|
|
||||||
* Include changelog and example files into `extra-source-files`.
|
|
||||||
|
|
||||||
0.1.2
|
|
||||||
---
|
|
||||||
|
|
||||||
* Fixes:
|
|
||||||
* Fix default spec for `ReqBody` param to be required (see [#22](https://github.com/haskell-servant/servant-swagger/issues/22));
|
|
||||||
* Set version bounds for `swagger2`.
|
|
||||||
|
|
||||||
0.1.1
|
|
||||||
---
|
|
||||||
|
|
||||||
* Fixes:
|
|
||||||
* Fix `subOperations` to filter endpoints also by method (see [#18](https://github.com/haskell-servant/servant-swagger/issues/18));
|
|
||||||
* Fix response schema in `ToSwagger` instance for `Header` (see [b59e557](https://github.com/haskell-servant/servant-swagger/commit/b59e557a05bc2669332c52b397879e7598747b82)).
|
|
||||||
|
|
||||||
0.1
|
|
||||||
---
|
|
||||||
* Major changes
|
|
||||||
* Use `swagger2` for data model (see [#9](https://github.com/dmjio/servant-swagger/pull/9)); this changes almost everything.
|
|
Some files were not shown because too many files have changed in this diff Show more
Loading…
Reference in a new issue