Merge in latest and fix conflicts.
This commit is contained in:
commit
c64bbb96b0
219 changed files with 7189 additions and 1380 deletions
2
.github/FUNDING.yml
vendored
2
.github/FUNDING.yml
vendored
|
@ -1,6 +1,6 @@
|
|||
# These are supported funding model platforms
|
||||
|
||||
github: # Replace with up to 4 GitHub Sponsors-enabled usernames e.g., [user1, user2]
|
||||
github: [arianvp]
|
||||
patreon: # Replace with a single Patreon username
|
||||
open_collective: # Replace with a single Open Collective username
|
||||
ko_fi: # Replace with a single Ko-fi username
|
||||
|
|
14
.github/run-ghcjs-tests.sh
vendored
Executable file
14
.github/run-ghcjs-tests.sh
vendored
Executable file
|
@ -0,0 +1,14 @@
|
|||
#!/usr/bin/env bash
|
||||
#
|
||||
# cabal v2-test does not work with GHCJS
|
||||
# See: https://github.com/haskell/cabal/issues/6175
|
||||
#
|
||||
# This invokes cabal-plan to figure out test binaries, and invokes them with node.
|
||||
|
||||
cabal-plan list-bins '*:test:*' | while read -r line
|
||||
do
|
||||
testpkg=$(echo "$line" | perl -pe 's/:.*//')
|
||||
testexe=$(echo "$line" | awk '{ print $2 }')
|
||||
echo "testing $textexe in package $textpkg"
|
||||
(cd "$testpkg" && node "$testexe".jsexe/all.js)
|
||||
done
|
159
.github/workflows/master.yml
vendored
Normal file
159
.github/workflows/master.yml
vendored
Normal file
|
@ -0,0 +1,159 @@
|
|||
name: CI
|
||||
|
||||
# Trigger the workflow on push or pull request, but only for the master branch
|
||||
on:
|
||||
pull_request:
|
||||
push:
|
||||
branches: [master]
|
||||
|
||||
jobs:
|
||||
cabal:
|
||||
name: ${{ matrix.os }} / ghc ${{ matrix.ghc }}
|
||||
runs-on: ${{ matrix.os }}
|
||||
strategy:
|
||||
matrix:
|
||||
os: [ubuntu-latest]
|
||||
cabal: ["3.4"]
|
||||
ghc:
|
||||
- "8.6.5"
|
||||
- "8.8.4"
|
||||
- "8.10.7"
|
||||
- "9.0.1"
|
||||
|
||||
steps:
|
||||
- uses: actions/checkout@v2
|
||||
|
||||
- uses: haskell/actions/setup@v1
|
||||
id: setup-haskell-cabal
|
||||
name: Setup Haskell
|
||||
with:
|
||||
ghc-version: ${{ matrix.ghc }}
|
||||
cabal-version: ${{ matrix.cabal }}
|
||||
|
||||
- name: Freeze
|
||||
run: |
|
||||
cabal configure --enable-tests --enable-benchmarks --test-show-details=direct
|
||||
cabal freeze
|
||||
|
||||
- uses: actions/cache@v2.1.3
|
||||
name: Cache ~/.cabal/store and dist-newstyle
|
||||
with:
|
||||
path: |
|
||||
${{ steps.setup-haskell-cabal.outputs.cabal-store }}
|
||||
dist-newstyle
|
||||
key: ${{ runner.os }}-${{ matrix.ghc }}-${{ hashFiles('cabal.project.freeze') }}
|
||||
restore-keys: |
|
||||
${{ runner.os }}-${{ matrix.ghc }}-
|
||||
|
||||
- name: Configure
|
||||
run: |
|
||||
# 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
|
||||
run: |
|
||||
cabal build all
|
||||
|
||||
- name: Test
|
||||
run: |
|
||||
cabal test all
|
||||
|
||||
- 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: |
|
||||
# Necessary for doctest to be found in $PATH
|
||||
export PATH="$HOME/.cabal/bin:$PATH"
|
||||
|
||||
# Filter out base-compat-batteries from .ghc.environment.*, as its modules
|
||||
# conflict with those of base-compat.
|
||||
#
|
||||
# FIXME: This is an ugly hack. Ultimately, we'll want to use cabal-doctest
|
||||
# (or cabal v2-doctest, if it ever lands) to provide a clean GHC environment.
|
||||
# This might allow running doctests in GHCJS build as well.
|
||||
perl -i -e 'while (<ARGV>) { print unless /package-id\s+(base-compat-batteries)-\d+(\.\d+)*/; }' .ghc.environment.*
|
||||
|
||||
(cd servant && doctest src)
|
||||
(cd servant-client && doctest src)
|
||||
(cd servant-client-core && doctest src)
|
||||
(cd servant-http-streams && doctest src)
|
||||
(cd servant-docs && doctest src)
|
||||
(cd servant-foreign && doctest src)
|
||||
(cd servant-server && doctest src)
|
||||
(cd servant-machines && doctest src)
|
||||
(cd servant-conduit && doctest src)
|
||||
(cd servant-pipes && doctest src)
|
||||
|
||||
stack:
|
||||
name: stack / ghc ${{ matrix.ghc }}
|
||||
runs-on: ubuntu-latest
|
||||
strategy:
|
||||
matrix:
|
||||
stack: ["2.7.3"]
|
||||
ghc: ["8.10.4"]
|
||||
|
||||
steps:
|
||||
- uses: actions/checkout@v2
|
||||
|
||||
- uses: haskell/actions/setup@v1
|
||||
name: Setup Haskell Stack
|
||||
with:
|
||||
ghc-version: ${{ matrix.ghc }}
|
||||
stack-version: ${{ matrix.stack }}
|
||||
|
||||
- uses: actions/cache@v2.1.3
|
||||
name: Cache ~/.stack
|
||||
with:
|
||||
path: ~/.stack
|
||||
key: ${{ runner.os }}-${{ matrix.ghc }}-stack
|
||||
|
||||
- name: Install dependencies
|
||||
run: |
|
||||
stack build --system-ghc --test --bench --no-run-tests --no-run-benchmarks --only-dependencies
|
||||
|
||||
- name: Build
|
||||
run: |
|
||||
stack build --system-ghc --test --bench --no-run-tests --no-run-benchmarks
|
||||
|
||||
- name: Test
|
||||
run: |
|
||||
stack test --system-ghc
|
||||
|
||||
ghcjs:
|
||||
name: ubuntu-latest / ghcjs 8.6
|
||||
runs-on: "ubuntu-latest"
|
||||
|
||||
steps:
|
||||
- uses: actions/checkout@v2
|
||||
- uses: cachix/install-nix-action@v13
|
||||
with:
|
||||
extra_nix_config: |
|
||||
trusted-public-keys = ryantrinkle.com-1:JJiAKaRv9mWgpVAz8dwewnZe0AzzEAzPkagE9SP5NWI=1aba6f367982bd6dd78ec2fda75ab246a62d32c5 cache.nixos.org-1:6NCHdD59X431o0gWypbMrAURkbJ16ZPMQFGspcDShjY=
|
||||
substituters = https://nixcache.reflex-frp.org https://cache.nixos.org/
|
||||
- name: Setup
|
||||
run: |
|
||||
# Override cabal.project with the lightweight GHCJS one
|
||||
cp cabal.ghcjs.project cabal.project
|
||||
cat cabal.project
|
||||
nix-shell ghcjs.nix --run "cabal v2-update && cabal v2-freeze"
|
||||
|
||||
- uses: actions/cache@v2.1.3
|
||||
name: Cache ~/.cabal/store and dist-newstyle
|
||||
with:
|
||||
path: |
|
||||
~/.cabal/store
|
||||
dist-newstyle
|
||||
key: ${{ runner.os }}-ghcjs8.6-${{ hashFiles('cabal.project.freeze') }}
|
||||
restore-keys: |
|
||||
${{ runner.os }}-ghcjs8.6-
|
||||
|
||||
- name: Build
|
||||
run: |
|
||||
nix-shell ghcjs.nix --run "cabal v2-build --ghcjs --enable-tests --enable-benchmarks all"
|
||||
|
||||
- name: Tests
|
||||
run: |
|
||||
nix-shell ghcjs.nix --run ".github/run-ghcjs-tests.sh"
|
5
.gitignore
vendored
5
.gitignore
vendored
|
@ -1,4 +1,5 @@
|
|||
**/*/dist
|
||||
*~
|
||||
dist-*
|
||||
.ghc.environment.*
|
||||
/bin
|
||||
|
@ -29,6 +30,10 @@ doc/_build
|
|||
doc/venv
|
||||
doc/tutorial/static/api.js
|
||||
doc/tutorial/static/jq.js
|
||||
shell.nix
|
||||
|
||||
# nix
|
||||
result*
|
||||
|
||||
# local versions of things
|
||||
servant-multipart
|
||||
|
|
322
.travis.yml
322
.travis.yml
|
@ -1,322 +0,0 @@
|
|||
# This Travis job script has been generated by a script via
|
||||
#
|
||||
# haskell-ci '--config=cabal.haskell-ci' '--output=.travis.yml' 'cabal.project'
|
||||
#
|
||||
# For more information, see https://github.com/haskell-CI/haskell-ci
|
||||
#
|
||||
# version: 0.9.20200110
|
||||
#
|
||||
version: ~> 1.0
|
||||
language: c
|
||||
os: linux
|
||||
dist: bionic
|
||||
git:
|
||||
# whether to recursively clone submodules
|
||||
submodules: false
|
||||
branches:
|
||||
only:
|
||||
- master
|
||||
addons:
|
||||
google: stable
|
||||
cache:
|
||||
directories:
|
||||
- $HOME/.cabal/packages
|
||||
- $HOME/.cabal/store
|
||||
- $HOME/.hlint
|
||||
before_cache:
|
||||
- rm -fv $CABALHOME/packages/hackage.haskell.org/build-reports.log
|
||||
# remove files that are regenerated by 'cabal update'
|
||||
- rm -fv $CABALHOME/packages/hackage.haskell.org/00-index.*
|
||||
- rm -fv $CABALHOME/packages/hackage.haskell.org/*.json
|
||||
- rm -fv $CABALHOME/packages/hackage.haskell.org/01-index.cache
|
||||
- rm -fv $CABALHOME/packages/hackage.haskell.org/01-index.tar
|
||||
- rm -fv $CABALHOME/packages/hackage.haskell.org/01-index.tar.idx
|
||||
- rm -rfv $CABALHOME/packages/head.hackage
|
||||
jobs:
|
||||
include:
|
||||
- compiler: ghcjs-8.4
|
||||
addons: {"apt":{"sources":[{"sourceline":"deb http://ppa.launchpad.net/hvr/ghc/ubuntu bionic main","key_url":"https://keyserver.ubuntu.com/pks/lookup?op=get&search=0x063dab2bdc0b3f9fcebc378bff3aeacef6f88286"},{"sourceline":"deb http://ppa.launchpad.net/hvr/ghcjs/ubuntu bionic main"},{"sourceline":"deb https://deb.nodesource.com/node_10.x bionic main","key_url":"https://deb.nodesource.com/gpgkey/nodesource.gpg.key"}],"packages":["ghcjs-8.4","cabal-install-3.0","ghc-8.4.4","nodejs"]}}
|
||||
os: linux
|
||||
- compiler: ghc-8.8.1
|
||||
addons: {"apt":{"sources":[{"sourceline":"deb http://ppa.launchpad.net/hvr/ghc/ubuntu bionic main","key_url":"https://keyserver.ubuntu.com/pks/lookup?op=get&search=0x063dab2bdc0b3f9fcebc378bff3aeacef6f88286"}],"packages":["ghc-8.8.1","cabal-install-3.0"]}}
|
||||
os: linux
|
||||
- compiler: ghc-8.6.5
|
||||
addons: {"apt":{"sources":[{"sourceline":"deb http://ppa.launchpad.net/hvr/ghc/ubuntu bionic main","key_url":"https://keyserver.ubuntu.com/pks/lookup?op=get&search=0x063dab2bdc0b3f9fcebc378bff3aeacef6f88286"}],"packages":["ghc-8.6.5","cabal-install-3.0"]}}
|
||||
os: linux
|
||||
- compiler: ghc-8.4.4
|
||||
addons: {"apt":{"sources":[{"sourceline":"deb http://ppa.launchpad.net/hvr/ghc/ubuntu bionic main","key_url":"https://keyserver.ubuntu.com/pks/lookup?op=get&search=0x063dab2bdc0b3f9fcebc378bff3aeacef6f88286"}],"packages":["ghc-8.4.4","cabal-install-3.0"]}}
|
||||
os: linux
|
||||
- compiler: ghc-8.2.2
|
||||
addons: {"apt":{"sources":[{"sourceline":"deb http://ppa.launchpad.net/hvr/ghc/ubuntu bionic main","key_url":"https://keyserver.ubuntu.com/pks/lookup?op=get&search=0x063dab2bdc0b3f9fcebc378bff3aeacef6f88286"}],"packages":["ghc-8.2.2","cabal-install-3.0"]}}
|
||||
os: linux
|
||||
- compiler: ghc-8.0.2
|
||||
addons: {"apt":{"sources":[{"sourceline":"deb http://ppa.launchpad.net/hvr/ghc/ubuntu bionic main","key_url":"https://keyserver.ubuntu.com/pks/lookup?op=get&search=0x063dab2bdc0b3f9fcebc378bff3aeacef6f88286"}],"packages":["ghc-8.0.2","cabal-install-3.0"]}}
|
||||
os: linux
|
||||
before_install:
|
||||
- |
|
||||
if echo $CC | grep -q ghcjs; then
|
||||
GHCJS=true;
|
||||
else
|
||||
GHCJS=false;
|
||||
fi
|
||||
- HC=$(echo "/opt/$CC/bin/ghc" | sed 's/-/\//')
|
||||
- WITHCOMPILER="-w $HC"
|
||||
- if $GHCJS ; then HC=${HC}js ; fi
|
||||
- if $GHCJS ; then WITHCOMPILER="--ghcjs ${WITHCOMPILER}js" ; fi
|
||||
- HADDOCK=$(echo "/opt/$CC/bin/haddock" | sed 's/-/\//')
|
||||
- if $GHCJS ; then PATH="/opt/ghc/8.4.4/bin:$PATH" ; fi
|
||||
- HCPKG="$HC-pkg"
|
||||
- unset CC
|
||||
- CABAL=/opt/ghc/bin/cabal
|
||||
- CABALHOME=$HOME/.cabal
|
||||
- export PATH="$CABALHOME/bin:$PATH"
|
||||
- TOP=$(pwd)
|
||||
- "HCNUMVER=$(${HC} --numeric-version|perl -ne '/^(\\d+)\\.(\\d+)\\.(\\d+)(\\.(\\d+))?$/; print(10000 * $1 + 100 * $2 + ($3 == 0 ? $5 != 1 : $3))')"
|
||||
- echo $HCNUMVER
|
||||
- CABAL="$CABAL -vnormal+nowrap"
|
||||
- set -o pipefail
|
||||
install:
|
||||
- ${CABAL} --version
|
||||
- echo "$(${HC} --version) [$(${HC} --print-project-git-commit-id 2> /dev/null || echo '?')]"
|
||||
- node --version
|
||||
- echo $GHCJS
|
||||
- TEST=--enable-tests
|
||||
- BENCH=--enable-benchmarks
|
||||
- HEADHACKAGE=false
|
||||
- rm -f $CABALHOME/config
|
||||
- |
|
||||
echo "verbose: normal +nowrap +markoutput" >> $CABALHOME/config
|
||||
echo "remote-build-reporting: anonymous" >> $CABALHOME/config
|
||||
echo "write-ghc-environment-files: always" >> $CABALHOME/config
|
||||
echo "remote-repo-cache: $CABALHOME/packages" >> $CABALHOME/config
|
||||
echo "logs-dir: $CABALHOME/logs" >> $CABALHOME/config
|
||||
echo "world-file: $CABALHOME/world" >> $CABALHOME/config
|
||||
echo "extra-prog-path: $CABALHOME/bin" >> $CABALHOME/config
|
||||
echo "symlink-bindir: $CABALHOME/bin" >> $CABALHOME/config
|
||||
echo "installdir: $CABALHOME/bin" >> $CABALHOME/config
|
||||
echo "build-summary: $CABALHOME/logs/build.log" >> $CABALHOME/config
|
||||
echo "store-dir: $CABALHOME/store" >> $CABALHOME/config
|
||||
echo "install-dirs user" >> $CABALHOME/config
|
||||
echo " prefix: $CABALHOME" >> $CABALHOME/config
|
||||
echo "repository hackage.haskell.org" >> $CABALHOME/config
|
||||
echo " url: http://hackage.haskell.org/" >> $CABALHOME/config
|
||||
echo " secure: True" >> $CABALHOME/config
|
||||
echo " key-threshold: 3" >> $CABALHOME/config
|
||||
echo " root-keys:" >> $CABALHOME/config
|
||||
echo " fe331502606802feac15e514d9b9ea83fee8b6ffef71335479a2e68d84adc6b0" >> $CABALHOME/config
|
||||
echo " 1ea9ba32c526d1cc91ab5e5bd364ec5e9e8cb67179a471872f6e26f0ae773d42" >> $CABALHOME/config
|
||||
echo " 2c6c3627bd6c982990239487f1abd02e08a02e6cf16edb105a8012d444d870c3" >> $CABALHOME/config
|
||||
echo " 0a5c7ea47cd1b15f01f5f51a33adda7e655bc0f0b0615baa8e271f4c3351e21d" >> $CABALHOME/config
|
||||
echo " 51f0161b906011b52c6613376b1ae937670da69322113a246a09f807c62f6921" >> $CABALHOME/config
|
||||
- GHCJOBS=-j2
|
||||
- |
|
||||
echo "program-default-options" >> $CABALHOME/config
|
||||
echo " ghc-options: $GHCJOBS +RTS -M6G -RTS" >> $CABALHOME/config
|
||||
- cat $CABALHOME/config
|
||||
- rm -fv cabal.project cabal.project.local cabal.project.freeze
|
||||
- travis_retry ${CABAL} v2-update -v
|
||||
- if ! $GHCJS ; then (cd /tmp && ${CABAL} v2-install $WITHCOMPILER -j2 doctest --constraint='doctest ==0.16.2.*') ; fi
|
||||
- if $GHCJS ; then (cd /tmp && ${CABAL} v2-install -w ghc-8.4.4 cabal-plan --constraint='cabal-plan ^>=0.6.0.0' --constraint='cabal-plan +exe') ; fi
|
||||
- if $GHCJS ; then (cd /tmp && ${CABAL} v2-install -w ghc-8.4.4 hspec-discover) ; fi
|
||||
# Generate cabal.project
|
||||
- rm -rf cabal.project cabal.project.local cabal.project.freeze
|
||||
- touch cabal.project
|
||||
- |
|
||||
echo "packages: servant" >> cabal.project
|
||||
if ! $GHCJS ; then echo "packages: servant-client" >> cabal.project ; fi
|
||||
echo "packages: servant-client-core" >> cabal.project
|
||||
if ! $GHCJS ; then echo "packages: servant-http-streams" >> cabal.project ; fi
|
||||
if ! $GHCJS ; then echo "packages: servant-docs" >> cabal.project ; fi
|
||||
if ! $GHCJS ; then echo "packages: servant-foreign" >> cabal.project ; fi
|
||||
if ! $GHCJS ; then echo "packages: servant-server" >> cabal.project ; fi
|
||||
if ! $GHCJS ; then echo "packages: doc/tutorial" >> cabal.project ; fi
|
||||
if ! $GHCJS ; then echo "packages: servant-machines" >> cabal.project ; fi
|
||||
if ! $GHCJS ; then echo "packages: servant-conduit" >> cabal.project ; fi
|
||||
if ! $GHCJS ; then echo "packages: servant-pipes" >> cabal.project ; fi
|
||||
if ! $GHCJS && [ $HCNUMVER -ge 80400 ] ; then echo "packages: doc/cookbook/basic-auth" >> cabal.project ; fi
|
||||
if ! $GHCJS && [ $HCNUMVER -ge 80400 ] ; then echo "packages: doc/cookbook/curl-mock" >> cabal.project ; fi
|
||||
if ! $GHCJS && [ $HCNUMVER -ge 80400 ] ; then echo "packages: doc/cookbook/basic-streaming" >> cabal.project ; fi
|
||||
if ! $GHCJS && [ $HCNUMVER -ge 80400 ] ; then echo "packages: doc/cookbook/db-postgres-pool" >> cabal.project ; fi
|
||||
if ! $GHCJS && [ $HCNUMVER -ge 80400 ] ; then echo "packages: doc/cookbook/file-upload" >> cabal.project ; fi
|
||||
if ! $GHCJS && [ $HCNUMVER -ge 80400 ] ; then echo "packages: doc/cookbook/generic" >> cabal.project ; fi
|
||||
if ! $GHCJS && [ $HCNUMVER -ge 80400 ] ; then echo "packages: doc/cookbook/pagination" >> cabal.project ; fi
|
||||
if ! $GHCJS && [ $HCNUMVER -ge 80400 ] ; then echo "packages: doc/cookbook/testing" >> cabal.project ; fi
|
||||
if ! $GHCJS && [ $HCNUMVER -ge 80400 ] ; then echo "packages: doc/cookbook/structuring-apis" >> cabal.project ; fi
|
||||
if ! $GHCJS && [ $HCNUMVER -ge 80400 ] ; then echo "packages: doc/cookbook/using-custom-monad" >> cabal.project ; fi
|
||||
if ! $GHCJS && [ $HCNUMVER -ge 80400 ] ; then echo "packages: doc/cookbook/using-free-client" >> cabal.project ; fi
|
||||
- |
|
||||
echo "constraints: foundation >=0.0.14" >> cabal.project
|
||||
echo "constraints: memory <0.14.12 || >0.14.12" >> cabal.project
|
||||
echo "constraints: sqlite-simple < 0" >> cabal.project
|
||||
echo "constraints: base-compat ^>=0.11" >> cabal.project
|
||||
echo "allow-newer: aeson-pretty-0.8.7:base-compat" >> cabal.project
|
||||
echo "allow-newer: vault-0.3.1.2:hashable" >> cabal.project
|
||||
echo "allow-newer: psqueues-0.2.7.1:hashable" >> cabal.project
|
||||
echo "allow-newer: sqlite-simple-0.4.16.0:semigroups" >> cabal.project
|
||||
echo "allow-newer: direct-sqlite-2.3.24:semigroups" >> cabal.project
|
||||
echo "allow-newer: io-streams-1.5.1.0:network" >> cabal.project
|
||||
echo "allow-newer: io-streams-1.5.1.0:primitive" >> cabal.project
|
||||
echo "allow-newer: openssl-streams-1.2.2.0:network" >> cabal.project
|
||||
echo "optimization: False" >> cabal.project
|
||||
- "for pkg in $($HCPKG list --simple-output); do echo $pkg | sed 's/-[^-]*$//' | (grep -vE -- '^(cookbook-basic-auth|cookbook-basic-streaming|cookbook-curl-mock|cookbook-db-postgres-pool|cookbook-file-upload|cookbook-generic|cookbook-pagination|cookbook-structuring-apis|cookbook-testing|cookbook-using-custom-monad|cookbook-using-free-client|servant|servant-client|servant-client-core|servant-conduit|servant-docs|servant-foreign|servant-http-streams|servant-machines|servant-pipes|servant-server|tutorial)$' || true) | sed 's/^/constraints: /' | sed 's/$/ installed/' >> cabal.project.local; done"
|
||||
- cat cabal.project || true
|
||||
- cat cabal.project.local || true
|
||||
- if [ -f "servant/configure.ac" ]; then (cd "servant" && autoreconf -i); fi
|
||||
- if [ -f "servant-client/configure.ac" ]; then (cd "servant-client" && autoreconf -i); fi
|
||||
- if [ -f "servant-client-core/configure.ac" ]; then (cd "servant-client-core" && autoreconf -i); fi
|
||||
- if [ -f "servant-http-streams/configure.ac" ]; then (cd "servant-http-streams" && autoreconf -i); fi
|
||||
- if [ -f "servant-docs/configure.ac" ]; then (cd "servant-docs" && autoreconf -i); fi
|
||||
- if [ -f "servant-foreign/configure.ac" ]; then (cd "servant-foreign" && autoreconf -i); fi
|
||||
- if [ -f "servant-server/configure.ac" ]; then (cd "servant-server" && autoreconf -i); fi
|
||||
- if [ -f "doc/tutorial/configure.ac" ]; then (cd "doc/tutorial" && autoreconf -i); fi
|
||||
- if [ -f "servant-machines/configure.ac" ]; then (cd "servant-machines" && autoreconf -i); fi
|
||||
- if [ -f "servant-conduit/configure.ac" ]; then (cd "servant-conduit" && autoreconf -i); fi
|
||||
- if [ -f "servant-pipes/configure.ac" ]; then (cd "servant-pipes" && autoreconf -i); fi
|
||||
- if [ -f "doc/cookbook/basic-auth/configure.ac" ]; then (cd "doc/cookbook/basic-auth" && autoreconf -i); fi
|
||||
- if [ -f "doc/cookbook/curl-mock/configure.ac" ]; then (cd "doc/cookbook/curl-mock" && autoreconf -i); fi
|
||||
- if [ -f "doc/cookbook/basic-streaming/configure.ac" ]; then (cd "doc/cookbook/basic-streaming" && autoreconf -i); fi
|
||||
- if [ -f "doc/cookbook/db-postgres-pool/configure.ac" ]; then (cd "doc/cookbook/db-postgres-pool" && autoreconf -i); fi
|
||||
- if [ -f "doc/cookbook/file-upload/configure.ac" ]; then (cd "doc/cookbook/file-upload" && autoreconf -i); fi
|
||||
- if [ -f "doc/cookbook/generic/configure.ac" ]; then (cd "doc/cookbook/generic" && autoreconf -i); fi
|
||||
- if [ -f "doc/cookbook/pagination/configure.ac" ]; then (cd "doc/cookbook/pagination" && autoreconf -i); fi
|
||||
- if [ -f "doc/cookbook/testing/configure.ac" ]; then (cd "doc/cookbook/testing" && autoreconf -i); fi
|
||||
- if [ -f "doc/cookbook/structuring-apis/configure.ac" ]; then (cd "doc/cookbook/structuring-apis" && autoreconf -i); fi
|
||||
- if [ -f "doc/cookbook/using-custom-monad/configure.ac" ]; then (cd "doc/cookbook/using-custom-monad" && autoreconf -i); fi
|
||||
- if [ -f "doc/cookbook/using-free-client/configure.ac" ]; then (cd "doc/cookbook/using-free-client" && autoreconf -i); fi
|
||||
- ${CABAL} v2-freeze $WITHCOMPILER ${TEST} ${BENCH}
|
||||
- "cat cabal.project.freeze | sed -E 's/^(constraints: *| *)//' | sed 's/any.//'"
|
||||
- rm cabal.project.freeze
|
||||
script:
|
||||
- DISTDIR=$(mktemp -d /tmp/dist-test.XXXX)
|
||||
# Packaging...
|
||||
- echo 'Packaging...' && echo -en 'travis_fold:start:sdist\\r'
|
||||
- ${CABAL} v2-sdist all
|
||||
- echo -en 'travis_fold:end:sdist\\r'
|
||||
# Unpacking...
|
||||
- echo 'Unpacking...' && echo -en 'travis_fold:start:unpack\\r'
|
||||
- mv dist-newstyle/sdist/*.tar.gz ${DISTDIR}/
|
||||
- cd ${DISTDIR} || false
|
||||
- find . -maxdepth 1 -type f -name '*.tar.gz' -exec tar -xvf '{}' \;
|
||||
- find . -maxdepth 1 -type f -name '*.tar.gz' -exec rm '{}' \;
|
||||
- PKGDIR_servant="$(find . -maxdepth 1 -type d -regex '.*/servant-[0-9.]*')"
|
||||
- PKGDIR_servant_client="$(find . -maxdepth 1 -type d -regex '.*/servant-client-[0-9.]*')"
|
||||
- PKGDIR_servant_client_core="$(find . -maxdepth 1 -type d -regex '.*/servant-client-core-[0-9.]*')"
|
||||
- PKGDIR_servant_http_streams="$(find . -maxdepth 1 -type d -regex '.*/servant-http-streams-[0-9.]*')"
|
||||
- PKGDIR_servant_docs="$(find . -maxdepth 1 -type d -regex '.*/servant-docs-[0-9.]*')"
|
||||
- PKGDIR_servant_foreign="$(find . -maxdepth 1 -type d -regex '.*/servant-foreign-[0-9.]*')"
|
||||
- PKGDIR_servant_server="$(find . -maxdepth 1 -type d -regex '.*/servant-server-[0-9.]*')"
|
||||
- PKGDIR_tutorial="$(find . -maxdepth 1 -type d -regex '.*/tutorial-[0-9.]*')"
|
||||
- PKGDIR_servant_machines="$(find . -maxdepth 1 -type d -regex '.*/servant-machines-[0-9.]*')"
|
||||
- PKGDIR_servant_conduit="$(find . -maxdepth 1 -type d -regex '.*/servant-conduit-[0-9.]*')"
|
||||
- PKGDIR_servant_pipes="$(find . -maxdepth 1 -type d -regex '.*/servant-pipes-[0-9.]*')"
|
||||
- PKGDIR_cookbook_basic_auth="$(find . -maxdepth 1 -type d -regex '.*/cookbook-basic-auth-[0-9.]*')"
|
||||
- PKGDIR_cookbook_curl_mock="$(find . -maxdepth 1 -type d -regex '.*/cookbook-curl-mock-[0-9.]*')"
|
||||
- PKGDIR_cookbook_basic_streaming="$(find . -maxdepth 1 -type d -regex '.*/cookbook-basic-streaming-[0-9.]*')"
|
||||
- PKGDIR_cookbook_db_postgres_pool="$(find . -maxdepth 1 -type d -regex '.*/cookbook-db-postgres-pool-[0-9.]*')"
|
||||
- PKGDIR_cookbook_file_upload="$(find . -maxdepth 1 -type d -regex '.*/cookbook-file-upload-[0-9.]*')"
|
||||
- PKGDIR_cookbook_generic="$(find . -maxdepth 1 -type d -regex '.*/cookbook-generic-[0-9.]*')"
|
||||
- PKGDIR_cookbook_pagination="$(find . -maxdepth 1 -type d -regex '.*/cookbook-pagination-[0-9.]*')"
|
||||
- PKGDIR_cookbook_testing="$(find . -maxdepth 1 -type d -regex '.*/cookbook-testing-[0-9.]*')"
|
||||
- PKGDIR_cookbook_structuring_apis="$(find . -maxdepth 1 -type d -regex '.*/cookbook-structuring-apis-[0-9.]*')"
|
||||
- PKGDIR_cookbook_using_custom_monad="$(find . -maxdepth 1 -type d -regex '.*/cookbook-using-custom-monad-[0-9.]*')"
|
||||
- PKGDIR_cookbook_using_free_client="$(find . -maxdepth 1 -type d -regex '.*/cookbook-using-free-client-[0-9.]*')"
|
||||
# Generate cabal.project
|
||||
- rm -rf cabal.project cabal.project.local cabal.project.freeze
|
||||
- touch cabal.project
|
||||
- |
|
||||
echo "packages: ${PKGDIR_servant}" >> cabal.project
|
||||
if ! $GHCJS ; then echo "packages: ${PKGDIR_servant_client}" >> cabal.project ; fi
|
||||
echo "packages: ${PKGDIR_servant_client_core}" >> cabal.project
|
||||
if ! $GHCJS ; then echo "packages: ${PKGDIR_servant_http_streams}" >> cabal.project ; fi
|
||||
if ! $GHCJS ; then echo "packages: ${PKGDIR_servant_docs}" >> cabal.project ; fi
|
||||
if ! $GHCJS ; then echo "packages: ${PKGDIR_servant_foreign}" >> cabal.project ; fi
|
||||
if ! $GHCJS ; then echo "packages: ${PKGDIR_servant_server}" >> cabal.project ; fi
|
||||
if ! $GHCJS ; then echo "packages: ${PKGDIR_tutorial}" >> cabal.project ; fi
|
||||
if ! $GHCJS ; then echo "packages: ${PKGDIR_servant_machines}" >> cabal.project ; fi
|
||||
if ! $GHCJS ; then echo "packages: ${PKGDIR_servant_conduit}" >> cabal.project ; fi
|
||||
if ! $GHCJS ; then echo "packages: ${PKGDIR_servant_pipes}" >> cabal.project ; fi
|
||||
if ! $GHCJS && [ $HCNUMVER -ge 80400 ] ; then echo "packages: ${PKGDIR_cookbook_basic_auth}" >> cabal.project ; fi
|
||||
if ! $GHCJS && [ $HCNUMVER -ge 80400 ] ; then echo "packages: ${PKGDIR_cookbook_curl_mock}" >> cabal.project ; fi
|
||||
if ! $GHCJS && [ $HCNUMVER -ge 80400 ] ; then echo "packages: ${PKGDIR_cookbook_basic_streaming}" >> cabal.project ; fi
|
||||
if ! $GHCJS && [ $HCNUMVER -ge 80400 ] ; then echo "packages: ${PKGDIR_cookbook_db_postgres_pool}" >> cabal.project ; fi
|
||||
if ! $GHCJS && [ $HCNUMVER -ge 80400 ] ; then echo "packages: ${PKGDIR_cookbook_file_upload}" >> cabal.project ; fi
|
||||
if ! $GHCJS && [ $HCNUMVER -ge 80400 ] ; then echo "packages: ${PKGDIR_cookbook_generic}" >> cabal.project ; fi
|
||||
if ! $GHCJS && [ $HCNUMVER -ge 80400 ] ; then echo "packages: ${PKGDIR_cookbook_pagination}" >> cabal.project ; fi
|
||||
if ! $GHCJS && [ $HCNUMVER -ge 80400 ] ; then echo "packages: ${PKGDIR_cookbook_testing}" >> cabal.project ; fi
|
||||
if ! $GHCJS && [ $HCNUMVER -ge 80400 ] ; then echo "packages: ${PKGDIR_cookbook_structuring_apis}" >> cabal.project ; fi
|
||||
if ! $GHCJS && [ $HCNUMVER -ge 80400 ] ; then echo "packages: ${PKGDIR_cookbook_using_custom_monad}" >> cabal.project ; fi
|
||||
if ! $GHCJS && [ $HCNUMVER -ge 80400 ] ; then echo "packages: ${PKGDIR_cookbook_using_free_client}" >> cabal.project ; fi
|
||||
- |
|
||||
echo "constraints: foundation >=0.0.14" >> cabal.project
|
||||
echo "constraints: memory <0.14.12 || >0.14.12" >> cabal.project
|
||||
echo "constraints: sqlite-simple < 0" >> cabal.project
|
||||
echo "constraints: base-compat ^>=0.11" >> cabal.project
|
||||
echo "allow-newer: aeson-pretty-0.8.7:base-compat" >> cabal.project
|
||||
echo "allow-newer: vault-0.3.1.2:hashable" >> cabal.project
|
||||
echo "allow-newer: psqueues-0.2.7.1:hashable" >> cabal.project
|
||||
echo "allow-newer: sqlite-simple-0.4.16.0:semigroups" >> cabal.project
|
||||
echo "allow-newer: direct-sqlite-2.3.24:semigroups" >> cabal.project
|
||||
echo "allow-newer: io-streams-1.5.1.0:network" >> cabal.project
|
||||
echo "allow-newer: io-streams-1.5.1.0:primitive" >> cabal.project
|
||||
echo "allow-newer: openssl-streams-1.2.2.0:network" >> cabal.project
|
||||
echo "optimization: False" >> cabal.project
|
||||
- "for pkg in $($HCPKG list --simple-output); do echo $pkg | sed 's/-[^-]*$//' | (grep -vE -- '^(cookbook-basic-auth|cookbook-basic-streaming|cookbook-curl-mock|cookbook-db-postgres-pool|cookbook-file-upload|cookbook-generic|cookbook-pagination|cookbook-structuring-apis|cookbook-testing|cookbook-using-custom-monad|cookbook-using-free-client|servant|servant-client|servant-client-core|servant-conduit|servant-docs|servant-foreign|servant-http-streams|servant-machines|servant-pipes|servant-server|tutorial)$' || true) | sed 's/^/constraints: /' | sed 's/$/ installed/' >> cabal.project.local; done"
|
||||
- cat cabal.project || true
|
||||
- cat cabal.project.local || true
|
||||
- |
|
||||
pkgdir() {
|
||||
case $1 in
|
||||
servant) echo ${PKGDIR_servant} ;;
|
||||
servant-client) echo ${PKGDIR_servant_client} ;;
|
||||
servant-client-core) echo ${PKGDIR_servant_client_core} ;;
|
||||
servant-http-streams) echo ${PKGDIR_servant_http_streams} ;;
|
||||
servant-docs) echo ${PKGDIR_servant_docs} ;;
|
||||
servant-foreign) echo ${PKGDIR_servant_foreign} ;;
|
||||
servant-server) echo ${PKGDIR_servant_server} ;;
|
||||
tutorial) echo ${PKGDIR_tutorial} ;;
|
||||
servant-machines) echo ${PKGDIR_servant_machines} ;;
|
||||
servant-conduit) echo ${PKGDIR_servant_conduit} ;;
|
||||
servant-pipes) echo ${PKGDIR_servant_pipes} ;;
|
||||
cookbook-basic-auth) echo ${PKGDIR_cookbook_basic_auth} ;;
|
||||
cookbook-curl-mock) echo ${PKGDIR_cookbook_curl_mock} ;;
|
||||
cookbook-basic-streaming) echo ${PKGDIR_cookbook_basic_streaming} ;;
|
||||
cookbook-db-postgres-pool) echo ${PKGDIR_cookbook_db_postgres_pool} ;;
|
||||
cookbook-file-upload) echo ${PKGDIR_cookbook_file_upload} ;;
|
||||
cookbook-generic) echo ${PKGDIR_cookbook_generic} ;;
|
||||
cookbook-pagination) echo ${PKGDIR_cookbook_pagination} ;;
|
||||
cookbook-testing) echo ${PKGDIR_cookbook_testing} ;;
|
||||
cookbook-structuring-apis) echo ${PKGDIR_cookbook_structuring_apis} ;;
|
||||
cookbook-using-custom-monad) echo ${PKGDIR_cookbook_using_custom_monad} ;;
|
||||
cookbook-using-free-client) echo ${PKGDIR_cookbook_using_free_client} ;;
|
||||
esac
|
||||
}
|
||||
- echo -en 'travis_fold:end:unpack\\r'
|
||||
# Building with tests and benchmarks...
|
||||
- echo 'Building with tests and benchmarks...' && echo -en 'travis_fold:start:build-everything\\r'
|
||||
# build & run tests, build benchmarks
|
||||
- ${CABAL} v2-build $WITHCOMPILER ${TEST} ${BENCH} all
|
||||
- echo -en 'travis_fold:end:build-everything\\r'
|
||||
# Testing...
|
||||
- if ! $GHCJS ; then ${CABAL} v2-test $WITHCOMPILER ${TEST} ${BENCH} all ; fi
|
||||
- if $GHCJS ; then cabal-plan list-bins '*:test:*' | while read -r line; do testpkg=$(echo "$line" | perl -pe 's/:.*//'); testexe=$(echo "$line" | awk '{ print $2 }'); echo "testing $textexe in package $textpkg"; (cd "$(pkgdir $testpkg)" && nodejs "$testexe".jsexe/all.js); done ; fi
|
||||
# Doctest...
|
||||
- echo 'Doctest...' && echo -en 'travis_fold:start:doctest\\r'
|
||||
- perl -i -e 'while (<ARGV>) { print unless /package-id\s+(base-compat-batteries)-\d+(\.\d+)*/; }' .ghc.environment.*
|
||||
- if ! $GHCJS ; then (cd ${PKGDIR_servant} && doctest src) ; fi
|
||||
- if ! $GHCJS ; then (cd ${PKGDIR_servant_client} && doctest src) ; fi
|
||||
- if ! $GHCJS ; then (cd ${PKGDIR_servant_client_core} && doctest src) ; fi
|
||||
- if ! $GHCJS ; then (cd ${PKGDIR_servant_http_streams} && doctest src) ; fi
|
||||
- if ! $GHCJS ; then (cd ${PKGDIR_servant_docs} && doctest src) ; fi
|
||||
- if ! $GHCJS ; then (cd ${PKGDIR_servant_foreign} && doctest src) ; fi
|
||||
- if ! $GHCJS ; then (cd ${PKGDIR_servant_server} && doctest src) ; fi
|
||||
- if ! $GHCJS ; then (cd ${PKGDIR_servant_machines} && doctest src) ; fi
|
||||
- if ! $GHCJS ; then (cd ${PKGDIR_servant_conduit} && doctest src) ; fi
|
||||
- if ! $GHCJS ; then (cd ${PKGDIR_servant_pipes} && doctest src) ; fi
|
||||
- echo -en 'travis_fold:end:doctest\\r'
|
||||
# haddock...
|
||||
- echo 'haddock...' && echo -en 'travis_fold:start:haddock\\r'
|
||||
- if ! $GHCJS ; then ${CABAL} v2-haddock $WITHCOMPILER --with-haddock $HADDOCK ${TEST} ${BENCH} all ; fi
|
||||
- echo -en 'travis_fold:end:haddock\\r'
|
||||
|
||||
# REGENDATA ("0.9.20200110",["--config=cabal.haskell-ci","--output=.travis.yml","cabal.project"])
|
||||
# EOF
|
|
@ -103,7 +103,7 @@ the `news` label if you make a new package so we can know about it!
|
|||
|
||||
## Release policy
|
||||
|
||||
We are currently moving to a more aggresive release policy, so that you can get
|
||||
We are currently moving to a more aggressive release policy, so that you can get
|
||||
what you contribute from Hackage fairly soon. However, note that prior to major
|
||||
releases it may take some time in between releases.
|
||||
|
||||
|
|
32
Makefile
32
Makefile
|
@ -1,32 +0,0 @@
|
|||
# With common maintenance tasks
|
||||
|
||||
HC ?= ghc-8.4.4
|
||||
|
||||
all :
|
||||
@echo "Don't try to make all at once!"
|
||||
|
||||
really-all :
|
||||
$(MAKE) build-ghc
|
||||
$(MAKE) build-ghc HC=ghc-8.0.2
|
||||
$(MAKE) build-ghc HC=ghc-8.2.2
|
||||
$(MAKE) build-ghc HC=ghc-8.6.5
|
||||
$(MAKE) build-ghcjs
|
||||
|
||||
build-ghc :
|
||||
cabal v2-build -w $(HC) all
|
||||
|
||||
build-ghcjs :
|
||||
cabal v2-build --builddir=dist-newstyle-ghcjs --project-file=cabal.ghcjs.project all
|
||||
|
||||
packdeps :
|
||||
packdeps */*.cabal
|
||||
|
||||
doctest : doctest-servant doctest-servant-server
|
||||
perl -i -e 'while (<ARGV>) { print unless /package-id\s+base-compat-\d+(\.\d+)*/; }' .ghc.environment.*
|
||||
|
||||
doctest-servant :
|
||||
(cd servant && doctest src)
|
||||
(cd servant && doctest test/Servant/LinksSpec.hs)
|
||||
|
||||
doctest-servant-server :
|
||||
(cd servant-server && doctest src)
|
38
README.md
38
README.md
|
@ -9,11 +9,11 @@ introduces the core features of servant. After this article, you should be able
|
|||
to write your first servant webservices, learning the rest from the haddocks'
|
||||
examples.
|
||||
|
||||
The central documentation can be found [here](http://docs.servant.dev/).
|
||||
The core documentation can be found [here](http://docs.servant.dev/).
|
||||
Other blog posts, videos and slides can be found on the
|
||||
[website](http://www.servant.dev/).
|
||||
|
||||
If you need help, drop by the IRC channel (#servant on freenode) or [mailing
|
||||
If you need help, drop by the IRC channel (#haskell-servant on libera.chat) or [mailing
|
||||
list](https://groups.google.com/forum/#!forum/haskell-servant).
|
||||
|
||||
## Contributing
|
||||
|
@ -32,7 +32,7 @@ See `CONTRIBUTING.md`
|
|||
- It's a good idea to separate these steps, as tests often pass, if they compile :)
|
||||
- See `cabal.project` to selectively `allow-newer`
|
||||
- If some packages are broken, on your discretisation there are two options:
|
||||
- Fix them and make PRs: it's good idea to test against older `servant` version too.
|
||||
- Fix them and make PRs: it's a good idea to test against older `servant` version too.
|
||||
- Temporarily comment out broken package
|
||||
- If you make a commit for `servant-universe`, you can use it as submodule in private projects to test even more
|
||||
- When ripples are cleared out:
|
||||
|
@ -40,29 +40,9 @@ See `CONTRIBUTING.md`
|
|||
- `git push --tags`
|
||||
- `cabal sdist` and `cabal upload`
|
||||
|
||||
## travis
|
||||
## TechEmpower framework benchmarks
|
||||
|
||||
`.travis.yml` is generated using `make-travis-yml` tool, in
|
||||
[multi-ghc-travis](https://github.com/haskell-hvr/multi-ghc-travis) repository.
|
||||
|
||||
To regenerate the script use (*note:* atm you need to comment `doc/cookbook/` packages).
|
||||
|
||||
```sh
|
||||
runghc ~/Documents/other-haskell/multi-ghc-travis/make_travis_yml_2.hs regenerate
|
||||
```
|
||||
|
||||
In case Travis jobs fail due failing build of dependency, you can temporarily
|
||||
add `constraints` to the `cabal.project`, and regenerate the `.travis.yml`.
|
||||
For example, the following will disallow single `troublemaker-13.37` package version:
|
||||
|
||||
```
|
||||
constraints:
|
||||
troublemaker <13.37 && > 13.37
|
||||
```
|
||||
|
||||
## TechEmpower framework bechmarks
|
||||
|
||||
We develop & maintain the servant TFB entry in https://github.com/haskell-servant/FrameworkBenchmarks/
|
||||
We develop and maintain the servant TFB entry in https://github.com/haskell-servant/FrameworkBenchmarks/
|
||||
|
||||
To verify (i.e. compile and test that it works)
|
||||
|
||||
|
@ -82,4 +62,10 @@ To compare with `reitit` (Clojure framework)
|
|||
./tfb --mode benchmark --test reitit reitit-async reitit-jdbc servant servant-beam servant-psql-simple --type json plaintext db fortune
|
||||
```
|
||||
|
||||
And visualise the results at https://www.techempower.com/benchmarks/#section=test
|
||||
You can see the visualised results at https://www.techempower.com/benchmarks/#section=test
|
||||
|
||||
## Nix
|
||||
|
||||
A developer shell.nix file is provided in the `nix` directory
|
||||
|
||||
See [nix/README.md](nix/README.md)
|
||||
|
|
|
@ -2,9 +2,13 @@
|
|||
|
||||
packages:
|
||||
servant/
|
||||
servant-client/
|
||||
servant-client-core/
|
||||
servant-jsaddle/
|
||||
|
||||
-- we need to tell cabal we are using GHCJS
|
||||
compiler: ghcjs
|
||||
tests: True
|
||||
|
||||
-- Constraints so that reflex-platform provided packages are selected.
|
||||
constraints: attoparsec == 0.13.2.2
|
||||
constraints: hashable == 1.3.0.0
|
||||
|
|
|
@ -1,25 +0,0 @@
|
|||
distribution: bionic
|
||||
folds: all-but-test
|
||||
branches: master
|
||||
jobs-selection: any
|
||||
google-chrome: True
|
||||
ghcjs-tests: True
|
||||
doctest: True
|
||||
doctest-filter-packages: base-compat-batteries
|
||||
doctest-skip: tutorial
|
||||
|
||||
-- https://github.com/haskell/cabal/issues/6176
|
||||
ghcjs-tools: hspec-discover
|
||||
|
||||
-- We have inplace packages (servant-js) so we skip installing dependencies in a separate step
|
||||
install-dependencies: False
|
||||
|
||||
-- this speed-ups the build a little, but we have to check these for release
|
||||
no-tests-no-benchmarks: False
|
||||
unconstrained: False
|
||||
|
||||
-- Don't run cabal check, as cookbook examples won't pass it
|
||||
cabal-check: False
|
||||
|
||||
-- ghc-options: -j2
|
||||
jobs: :2
|
|
@ -1,5 +1,11 @@
|
|||
packages:
|
||||
servant/
|
||||
servant-auth/servant-auth
|
||||
servant-auth/servant-auth-client
|
||||
servant-auth/servant-auth-docs
|
||||
servant-auth/servant-auth-server
|
||||
servant-auth/servant-auth-swagger
|
||||
|
||||
servant-client/
|
||||
servant-client-core/
|
||||
servant-http-streams/
|
||||
|
@ -22,17 +28,20 @@ packages:
|
|||
packages:
|
||||
doc/cookbook/basic-auth
|
||||
doc/cookbook/curl-mock
|
||||
doc/cookbook/custom-errors
|
||||
doc/cookbook/basic-streaming
|
||||
doc/cookbook/db-postgres-pool
|
||||
-- doc/cookbook/db-sqlite-simple
|
||||
doc/cookbook/db-sqlite-simple
|
||||
doc/cookbook/file-upload
|
||||
doc/cookbook/generic
|
||||
-- doc/cookbook/hoist-server-with-context
|
||||
-- doc/cookbook/https
|
||||
-- doc/cookbook/jwt-and-basic-auth/
|
||||
doc/cookbook/hoist-server-with-context
|
||||
doc/cookbook/https
|
||||
doc/cookbook/jwt-and-basic-auth
|
||||
doc/cookbook/pagination
|
||||
-- doc/cookbook/sentry
|
||||
doc/cookbook/testing
|
||||
-- Commented out because servant-quickcheck currently doesn't build.
|
||||
-- doc/cookbook/testing
|
||||
doc/cookbook/uverb
|
||||
doc/cookbook/structuring-apis
|
||||
doc/cookbook/using-custom-monad
|
||||
doc/cookbook/using-free-client
|
||||
|
@ -47,21 +56,20 @@ constraints:
|
|||
foundation >=0.0.14,
|
||||
memory <0.14.12 || >0.14.12
|
||||
|
||||
allow-newer: aeson-pretty-0.8.7:base-compat
|
||||
|
||||
allow-newer: vault-0.3.1.2:hashable
|
||||
allow-newer: psqueues-0.2.7.1:hashable
|
||||
allow-newer: sqlite-simple-0.4.16.0:semigroups
|
||||
allow-newer: direct-sqlite-2.3.24:semigroups
|
||||
allow-newer: io-streams-1.5.1.0:network
|
||||
allow-newer: io-streams-1.5.1.0:primitive
|
||||
allow-newer: openssl-streams-1.2.2.0:network
|
||||
|
||||
-- MonadFail
|
||||
-- https://github.com/nurpax/sqlite-simple/issues/74
|
||||
constraints: sqlite-simple < 0
|
||||
|
||||
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
|
||||
|
|
9
changelog.d/1432
Normal file
9
changelog.d/1432
Normal file
|
@ -0,0 +1,9 @@
|
|||
synopsis: Fixes encoding of URL parameters in servant-client
|
||||
prs: #1432
|
||||
issues: #1418
|
||||
description: {
|
||||
Some applications use query parameters to pass arbitrary (non-unicode) binary
|
||||
data. This change modifies how servant-client handles query parameters, so
|
||||
that application developers can use `ToHttpApiData` to marshal binary data into
|
||||
query parameters.
|
||||
}
|
9
changelog.d/1477
Normal file
9
changelog.d/1477
Normal file
|
@ -0,0 +1,9 @@
|
|||
synopsis: Enable FlexibleContexts in Servant.API.ContentTypes
|
||||
prs: #1477
|
||||
|
||||
description: {
|
||||
|
||||
Starting with GHC 9.2, UndecidableInstances no longer implies FlexibleContexts.
|
||||
Add this extension where it's needed to make compilation succeed.
|
||||
|
||||
}
|
|
@ -1,18 +0,0 @@
|
|||
synopsis: Add NoContentVerb
|
||||
prs: #1228 #1219
|
||||
issues: #1028
|
||||
significance: significant
|
||||
|
||||
description: {
|
||||
|
||||
The `NoContent` API endpoints should now use `NoContentVerb` combinator.
|
||||
The API type changes are usually of the kind
|
||||
|
||||
```diff
|
||||
- :<|> PostNoContent '[JSON] NoContent
|
||||
+ :<|> PostNoContent
|
||||
```
|
||||
|
||||
i.e. one doesn't need to specify the content-type anymore. There is no content.
|
||||
|
||||
}
|
|
@ -1,12 +0,0 @@
|
|||
synopsis: Fix Verb with headers checking content type differently
|
||||
packages: servant-client-core servant-client
|
||||
prs: #1204
|
||||
issues: #1200
|
||||
packages: servant-client servant-client-core servant-http-streams
|
||||
|
||||
description: {
|
||||
|
||||
For `Verb`s with response `Headers`, the implementation didn't check
|
||||
for the content-type of the response. Now it does.
|
||||
|
||||
}
|
|
@ -1,16 +0,0 @@
|
|||
synopsis: Merge documentation from duplicate routes
|
||||
packages: servant-docs
|
||||
prs: #1241
|
||||
issues: #1240
|
||||
|
||||
description: {
|
||||
|
||||
Servant supports defining the same route multiple times with different
|
||||
content-types and result-types, but servant-docs was only documenting
|
||||
the first of copy of such duplicated routes. It now combines the
|
||||
documentation from all the copies.
|
||||
|
||||
Unfortunately, it is not yet possible for the documentation to specify
|
||||
multiple status codes.
|
||||
|
||||
}
|
|
@ -1,3 +0,0 @@
|
|||
synopsis: Progress on servant-jsaddle
|
||||
packages: servant-jsaddle
|
||||
prs: #1216
|
|
@ -1,17 +0,0 @@
|
|||
synopsis: `Capture` can be `Lenient`
|
||||
issues: #1155
|
||||
prs: #1156
|
||||
significance: significant
|
||||
description: {
|
||||
|
||||
You can specify a lenient capture as
|
||||
|
||||
```haskell
|
||||
:<|> "capture-lenient" :> Capture' '[Lenient] "foo" Int :> GET
|
||||
```
|
||||
|
||||
which will make the capture always succeed. Handlers will be of the
|
||||
type `Either String CapturedType`, where `Left err` represents
|
||||
the possible parse failure.
|
||||
|
||||
}
|
|
@ -1,7 +0,0 @@
|
|||
synopsis: Add sponsorship button
|
||||
prs: #1190
|
||||
description: {
|
||||
|
||||
[Well-Typed](https://www.well-typed.com/)
|
||||
|
||||
}
|
|
@ -1,3 +0,0 @@
|
|||
synopsis: Prevent race-conditions in testing
|
||||
packages: servant-docs
|
||||
prs: #1194
|
|
@ -1,4 +0,0 @@
|
|||
synopsis: `HasClient` instance for `Stream` with `Headers`
|
||||
packages: servant-client servant-client servant-http-streams
|
||||
prs: #1197
|
||||
issues: #1170
|
|
@ -1,3 +0,0 @@
|
|||
synopsis: Remove unused extensions from cabal file
|
||||
packages: servant
|
||||
prs: #1201
|
|
@ -1,12 +0,0 @@
|
|||
synopsis: Added a function to create Client.Request in ClientEnv
|
||||
packages: servant-client
|
||||
significance: significant
|
||||
prs: #1213 #1255
|
||||
description: {
|
||||
|
||||
The new member `makeClientRequest` of `ClientEnv` is used to create
|
||||
`http-client` `Request` from `servant-client-core` `Request`.
|
||||
This functionality can be used for example to set
|
||||
dynamic timeouts for each request.
|
||||
|
||||
}
|
|
@ -1,3 +0,0 @@
|
|||
synopsis: Redact the authorization header in Show and exceptions
|
||||
packages: servant-client
|
||||
prs: #1238
|
|
@ -1,15 +0,0 @@
|
|||
synopsis: use queryString to parse QueryParam, QueryParams and QueryFlag
|
||||
packages: servant-server
|
||||
prs: #1249 #1262
|
||||
significance: significant
|
||||
description: {
|
||||
|
||||
Some APIs need query parameters rewriting, e.g. in order to support
|
||||
for multiple casing (camel, snake, etc) or something to that effect.
|
||||
|
||||
This could be easily achieved by using WAI Middleware and modyfing
|
||||
request's `Query`. But QueryParam, QueryParams and QueryFlag use
|
||||
`rawQueryString`. By using `queryString` rather then `rawQueryString`
|
||||
we can enable such rewritings.
|
||||
|
||||
}
|
|
@ -1,11 +0,0 @@
|
|||
synopsis: Make packages `build-type: Simple`
|
||||
packages: servant servant-server
|
||||
prs: #1263
|
||||
significance: significant
|
||||
description: {
|
||||
|
||||
We used `build-type: Custom`, but it's problematic e.g.
|
||||
for cross-compiling. The benefit is small, as the doctests
|
||||
can be run other ways too (though not so conviniently).
|
||||
|
||||
}
|
16
changelog.d/servant-docs-curl
Normal file
16
changelog.d/servant-docs-curl
Normal file
|
@ -0,0 +1,16 @@
|
|||
synopsis: Add sample cURL requests to generated documentation
|
||||
prs: #1401
|
||||
|
||||
description: {
|
||||
|
||||
Add sample cURL requests to generated documentation.
|
||||
|
||||
Those supplying changes to the Request `header` field manually using
|
||||
lenses will need to add a sample bytestring value.
|
||||
|
||||
`headers <>~ ["unicorn"]`
|
||||
|
||||
becomes
|
||||
|
||||
`headers <>~ [("unicorn", "sample value")]`
|
||||
}
|
|
@ -1,8 +0,0 @@
|
|||
synopsis: Try changelog-d for changelog management
|
||||
prs: #1230
|
||||
|
||||
description: {
|
||||
|
||||
Check the [CONTRIBUTING.md](https://github.com/haskell-servant/servant/blob/master/CONTRIBUTING.md) for details
|
||||
|
||||
}
|
|
@ -1,19 +0,0 @@
|
|||
synopsis: CI and testing tweaks.
|
||||
prs:
|
||||
#1154
|
||||
#1157
|
||||
#1182
|
||||
#1214
|
||||
#1229
|
||||
#1233
|
||||
#1242
|
||||
#1247
|
||||
#1250
|
||||
#1258
|
||||
|
||||
description: {
|
||||
|
||||
We are experiencing some bitrotting of cookbook recipe dependencies,
|
||||
therefore some of them aren't build as part of our CI anymore.
|
||||
|
||||
}
|
|
@ -1,9 +0,0 @@
|
|||
synopsis: New cookbook recipes
|
||||
prs: #1171 #1088 #1198
|
||||
|
||||
description: {
|
||||
|
||||
- [OIDC Recipe](#TODO)
|
||||
- [MySQL Recipe](#TODO)
|
||||
|
||||
}
|
|
@ -1,9 +0,0 @@
|
|||
synopsis: Dependency upgrades
|
||||
prs:
|
||||
#1173
|
||||
#1181
|
||||
#1183
|
||||
#1188
|
||||
#1224
|
||||
#1245
|
||||
#1257
|
|
@ -1,8 +0,0 @@
|
|||
synopsis: Documentation updates
|
||||
prs:
|
||||
#1162
|
||||
#1174
|
||||
#1175
|
||||
#1234
|
||||
#1244
|
||||
#1247
|
38
default.nix
Normal file
38
default.nix
Normal file
|
@ -0,0 +1,38 @@
|
|||
with (builtins.fromJSON (builtins.readFile ./nix/nixpkgs.json));
|
||||
{
|
||||
pkgs ? import (builtins.fetchTarball {
|
||||
url = "https://github.com/NixOS/nixpkgs/archive/${rev}.tar.gz";
|
||||
inherit sha256;
|
||||
}) {}
|
||||
, compiler ? "ghc883"
|
||||
}:
|
||||
let
|
||||
overrides = self: super: {
|
||||
servant = self.callCabal2nix "servant" ./servant {};
|
||||
servant-docs = self.callCabal2nix "servant-docs" ./servant-docs {};
|
||||
servant-pipes = self.callCabal2nix "servant-pipes" ./servant-pipes {};
|
||||
servant-server = self.callCabal2nix "servant-server" ./servant-server {};
|
||||
servant-client = self.callCabal2nix "servant-client" ./servant-client {};
|
||||
servant-foreign = self.callCabal2nix "servant-foreign" ./servant-foreign {};
|
||||
servant-conduit = self.callCabal2nix "servant-conduit" ./servant-conduit {};
|
||||
servant-machines = self.callCabal2nix "servant-machines" ./servant-machines {};
|
||||
servant-client-core = self.callCabal2nix "servant-client-core" ./servant-client-core {};
|
||||
servant-http-streams = self.callCabal2nix "servant-http-streams" ./servant-http-streams {};
|
||||
};
|
||||
hPkgs = pkgs.haskell.packages.${compiler}.override { inherit overrides; };
|
||||
in
|
||||
with hPkgs;
|
||||
{
|
||||
inherit
|
||||
servant
|
||||
servant-client
|
||||
servant-client-core
|
||||
servant-conduit
|
||||
servant-docs
|
||||
servant-foreign
|
||||
servant-http-streams
|
||||
servant-machines
|
||||
servant-pipes
|
||||
servant-server;
|
||||
}
|
||||
|
|
@ -2,13 +2,13 @@ name: cookbook-basic-auth
|
|||
version: 0.1
|
||||
synopsis: Basic Authentication cookbook example
|
||||
homepage: http://docs.servant.dev/
|
||||
license: BSD3
|
||||
license: BSD-3-Clause
|
||||
license-file: ../../../servant/LICENSE
|
||||
author: Servant Contributors
|
||||
maintainer: haskell-servant-maintainers@googlegroups.com
|
||||
build-type: Simple
|
||||
cabal-version: >=1.10
|
||||
tested-with: GHC==8.4.4, GHC==8.6.5, GHC==8.8.1
|
||||
tested-with: GHC==8.6.5, GHC==8.8.3, GHC ==8.10.7
|
||||
|
||||
executable cookbook-basic-auth
|
||||
main-is: BasicAuth.lhs
|
||||
|
|
|
@ -8,7 +8,10 @@ In other words, without streaming libraries.
|
|||
- Some basic usage doesn't require usage of streaming libraries,
|
||||
like `conduit`, `pipes`, `machines` or `streaming`.
|
||||
We have bindings for them though.
|
||||
- This is similar example file, which is bundled with each of the packages (TODO: links)
|
||||
- Similar example is bundled with each of our streaming library interop packages (see
|
||||
[servant-pipes](https://github.com/haskell-servant/servant/blob/master/servant-pipes/example/Main.hs),
|
||||
[servant-conduit](https://github.com/haskell-servant/servant/blob/master/servant-conduit/example/Main.hs) and
|
||||
[servant-machines](https://github.com/haskell-servant/servant/blob/master/servant-machines/example/Main.hs))
|
||||
- `SourceT` doesn't have *Prelude* with handy combinators, so we have to write
|
||||
things ourselves. (Note to self: `mapM` and `foldM` would be handy to have).
|
||||
|
||||
|
|
|
@ -2,13 +2,13 @@ name: cookbook-basic-streaming
|
|||
version: 2.1
|
||||
synopsis: Streaming in servant without streaming libs
|
||||
homepage: http://docs.servant.dev/
|
||||
license: BSD3
|
||||
license: BSD-3-Clause
|
||||
license-file: ../../../servant/LICENSE
|
||||
author: Servant Contributors
|
||||
maintainer: haskell-servant-maintainers@googlegroups.com
|
||||
build-type: Simple
|
||||
cabal-version: >=1.10
|
||||
tested-with: GHC==8.4.4, GHC==8.6.5, GHC==8.8.1
|
||||
tested-with: GHC==8.6.5, GHC==8.8.3, GHC ==8.10.7
|
||||
|
||||
executable cookbook-basic-streaming
|
||||
main-is: Streaming.lhs
|
||||
|
|
|
@ -1,7 +1,7 @@
|
|||
# Generating mock curl calls
|
||||
|
||||
In this example we will generate curl requests with mock post data from a servant API.
|
||||
This may be usefull for testing and development purposes.
|
||||
This may be useful for testing and development purposes.
|
||||
Especially post requests with a request body are tedious to send manually.
|
||||
|
||||
Also, we will learn how to use the servant-foreign library to generate stuff from servant APIs.
|
||||
|
@ -24,7 +24,6 @@ Language extensions and imports:
|
|||
import Control.Lens ((^.))
|
||||
import Data.Aeson
|
||||
import Data.Aeson.Text
|
||||
import Data.Monoid ((<>))
|
||||
import Data.Proxy (Proxy (Proxy))
|
||||
import Data.Text (Text)
|
||||
import Data.Text.Encoding (decodeUtf8)
|
||||
|
@ -86,7 +85,7 @@ listFromAPI :: (HasForeign lang ftype api, GenerateList ftype (Foreign ftype api
|
|||
```
|
||||
|
||||
This looks a bit confusing...
|
||||
[Here](https://hackage.haskell.org/package/servant-foreign-0.11.1/docs/Servant-Foreign.html#t:HasForeignType) is the documentation for the `HasForeign` typeclass.
|
||||
[Here](https://hackage.haskell.org/package/servant-foreign/docs/Servant-Foreign.html#t:HasForeign) is the documentation for the `HasForeign` typeclass.
|
||||
We will not go into details here, but this allows us to create a value of type `ftype` for any type `a` in our API.
|
||||
|
||||
In our case we want to create a mock of every type `a`.
|
||||
|
@ -130,24 +129,12 @@ generateCurl :: (GenerateList Mocked (Foreign Mocked api), HasForeign NoLang Moc
|
|||
generateCurl p host =
|
||||
fmap T.unlines body
|
||||
where
|
||||
body = foldr (\endp curlCalls -> mCons (generateEndpoint host endp) curlCalls) (return [])
|
||||
body = mapM (generateEndpoint host)
|
||||
$ listFromAPI (Proxy :: Proxy NoLang) (Proxy :: Proxy Mocked) p
|
||||
```
|
||||
|
||||
To understand this function, better start at the end:
|
||||
|
||||
`listFromAPI` gives us a list of endpoints. We iterate over them (`foldr`) and call `generateEndpoint` for every endpoint.
|
||||
|
||||
As generate endpoint will not return `Text` but `IO Text` (remember we need some random bits to mock), we cannot just use the cons operator but need to build `IO [Text]` from `IO Text`s.
|
||||
|
||||
``` haskell
|
||||
mCons :: IO a -> IO [a] -> IO [a]
|
||||
mCons ele list =
|
||||
ele >>= \e -> list >>= \l -> return ( e : l )
|
||||
```
|
||||
|
||||
|
||||
Now comes the juicy part; accessing the endpoints data:
|
||||
First, `listFromAPI` gives us a list of `Req Mocked`. Each `Req` describes one endpoint from the API type.
|
||||
We generate a curl call for each of them using the following helper.
|
||||
|
||||
``` haskell
|
||||
generateEndpoint :: Text -> Req Mocked -> IO Text
|
||||
|
@ -169,7 +156,7 @@ generateEndpoint host req =
|
|||
`servant-foreign` offers a multitude of lenses to be used with `Req`-values.
|
||||
|
||||
`reqMethod` gives us a straigthforward `Network.HTTP.Types.Method`, `reqUrl` the url part and so on.
|
||||
Just take a look at [the docs](https://hackage.haskell.org/package/servant-foreign-0.11.1/docs/Servant-Foreign.html).
|
||||
Just take a look at [the docs](https://hackage.haskell.org/package/servant-foreign/docs/Servant-Foreign.html).
|
||||
|
||||
But how do we get our mocked json string? This seems to be a bit to short to be true:
|
||||
|
||||
|
@ -201,7 +188,7 @@ And now, lets hook it all up in our main function:
|
|||
``` haskell
|
||||
main :: IO ()
|
||||
main =
|
||||
generateCurl api "localhost:8081" >>= (\v -> T.IO.putStrLn v)
|
||||
generateCurl api "localhost:8081" >>= T.IO.putStrLn
|
||||
```
|
||||
|
||||
Done:
|
||||
|
@ -213,6 +200,6 @@ curl -X POST -d '{"email":"wV_b:z!(3DM V","age":10,"name":"=|W"}
|
|||
```
|
||||
|
||||
This is of course no complete curl call mock generator, many things including path arguments are missing.
|
||||
But it correctly generate mock calls for simple POST requests.
|
||||
But it correctly generates mock calls for simple POST requests.
|
||||
|
||||
Also, we now know how to use `HasForeignType` and `listFromAPI` to generate anything we want.
|
||||
|
|
|
@ -2,13 +2,13 @@ name: cookbook-curl-mock
|
|||
version: 0.1
|
||||
synopsis: Generate curl mock requests cookbook example
|
||||
homepage: http://docs.servant.dev
|
||||
license: BSD3
|
||||
license: BSD-3-Clause
|
||||
license-file: ../../../servant/LICENSE
|
||||
author: Servant Contributors
|
||||
maintainer: haskell-servant-maintainers@googlegroups.com
|
||||
build-type: Simple
|
||||
cabal-version: >=1.10
|
||||
tested-with: GHC==8.4.4, GHC==8.6.5, GHC==8.8.1
|
||||
tested-with: GHC==8.6.5, GHC==8.8.3, GHC ==8.10.7
|
||||
|
||||
executable cookbock-curl-mock
|
||||
main-is: CurlMock.lhs
|
||||
|
|
189
doc/cookbook/custom-errors/CustomErrors.lhs
Normal file
189
doc/cookbook/custom-errors/CustomErrors.lhs
Normal file
|
@ -0,0 +1,189 @@
|
|||
# Customizing errors from Servant
|
||||
|
||||
Servant handles a lot of parsing and validation of the input request. When it can't parse something: query
|
||||
parameters, URL parts or request body, it will return appropriate HTTP codes like 400 Bad Request.
|
||||
|
||||
These responses will contain the error message in their body without any formatting. However, it is often
|
||||
desirable to be able to provide custom formatting for these error messages, for example, to wrap them in JSON.
|
||||
|
||||
Recently Servant got a way to add such formatting. This Cookbook chapter demonstrates how to use it.
|
||||
|
||||
Extensions and imports:
|
||||
```haskell
|
||||
{-# LANGUAGE DataKinds #-}
|
||||
{-# LANGUAGE DeriveGeneric #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE PolyKinds #-}
|
||||
{-# LANGUAGE TypeFamilies #-}
|
||||
{-# LANGUAGE TypeOperators #-}
|
||||
|
||||
import Data.Aeson
|
||||
import Data.Proxy
|
||||
import Data.Text
|
||||
import GHC.Generics
|
||||
import Network.Wai
|
||||
import Network.Wai.Handler.Warp
|
||||
|
||||
import Servant
|
||||
|
||||
import Data.String.Conversions
|
||||
(cs)
|
||||
import Servant.API.ContentTypes
|
||||
```
|
||||
|
||||
The API (from `greet.hs` example in Servant sources):
|
||||
|
||||
```haskell
|
||||
-- | A greet message data type
|
||||
newtype Greet = Greet { _msg :: Text }
|
||||
deriving (Generic, Show)
|
||||
|
||||
instance FromJSON Greet
|
||||
instance ToJSON Greet
|
||||
|
||||
-- API specification
|
||||
type TestApi =
|
||||
-- GET /hello/:name?capital={true, false} returns a Greet as JSON
|
||||
"hello" :> Capture "name" Text :> QueryParam "capital" Bool :> Get '[JSON] Greet
|
||||
|
||||
-- POST /greet with a Greet as JSON in the request body,
|
||||
-- returns a Greet as JSON
|
||||
:<|> "greet" :> ReqBody '[JSON] Greet :> Post '[JSON] Greet
|
||||
|
||||
-- DELETE /greet/:greetid
|
||||
:<|> "greet" :> Capture "greetid" Text :> Delete '[JSON] NoContent
|
||||
|
||||
testApi :: Proxy TestApi
|
||||
testApi = Proxy
|
||||
|
||||
-- Server-side handlers.
|
||||
--
|
||||
-- There's one handler per endpoint, which, just like in the type
|
||||
-- that represents the API, are glued together using :<|>.
|
||||
--
|
||||
-- Each handler runs in the 'Handler' monad.
|
||||
server :: Server TestApi
|
||||
server = helloH :<|> postGreetH :<|> deleteGreetH
|
||||
|
||||
where helloH name Nothing = helloH name (Just False)
|
||||
helloH name (Just False) = return . Greet $ "Hello, " <> name
|
||||
helloH name (Just True) = return . Greet . toUpper $ "Hello, " <> name
|
||||
|
||||
postGreetH greet = return greet
|
||||
|
||||
deleteGreetH _ = return NoContent
|
||||
```
|
||||
|
||||
## Error formatters
|
||||
|
||||
`servant-server` provides an `ErrorFormatter` type to specify how the error message will be
|
||||
formatted. A formatter is just a function accepting three parameters:
|
||||
|
||||
- `TypeRep` from `Data.Typeable`: this is a runtime representation of the type of the combinator
|
||||
(like `Capture` or `ReqBody`) that generated the error. It can be used to display its name (with
|
||||
`show`) or even dynamically dispatch on the combinator type. See the docs for `Data.Typeable` and
|
||||
`Type.Reflection` modules.
|
||||
- `Request`: full information for the request that led to the error.
|
||||
- `String`: specific error message from the combinator.
|
||||
|
||||
The formatter is expected to produce a `ServerError` which will be returned from the handler.
|
||||
|
||||
Additionally, there is `NotFoundErrorFormatter`, which accepts only `Request` and can customize the
|
||||
error in case when no route can be matched (HTTP 404).
|
||||
|
||||
Let's make two formatters. First one will wrap our error in a JSON:
|
||||
|
||||
```json
|
||||
{
|
||||
"error": "ERROR MESSAGE",
|
||||
"combinator": "NAME OF THE COMBINATOR"
|
||||
}
|
||||
```
|
||||
|
||||
Additionally, this formatter will examine the `Accept` header of the request and generate JSON
|
||||
message only if client can accept it.
|
||||
|
||||
```haskell
|
||||
customFormatter :: ErrorFormatter
|
||||
customFormatter tr req err =
|
||||
let
|
||||
-- aeson Value which will be sent to the client
|
||||
value = object ["combinator" .= show tr, "error" .= err]
|
||||
-- Accept header of the request
|
||||
accH = getAcceptHeader req
|
||||
in
|
||||
-- handleAcceptH is Servant's function that checks whether the client can accept a
|
||||
-- certain message type.
|
||||
-- In this case we call it with "Proxy '[JSON]" argument, meaning that we want to return a JSON.
|
||||
case handleAcceptH (Proxy :: Proxy '[JSON]) accH value of
|
||||
-- If client can't handle JSON, we just return the body the old way
|
||||
Nothing -> err400 { errBody = cs err }
|
||||
-- Otherwise, we return the JSON formatted body and set the "Content-Type" header.
|
||||
Just (ctypeH, body) -> err400
|
||||
{ errBody = body
|
||||
, errHeaders = [("Content-Type", cs ctypeH)]
|
||||
}
|
||||
|
||||
notFoundFormatter :: NotFoundErrorFormatter
|
||||
notFoundFormatter req =
|
||||
err404 { errBody = cs $ "Not found path: " <> rawPathInfo req }
|
||||
```
|
||||
|
||||
If you don't need to react to the `Accept` header, you can just unconditionally return the JSON like
|
||||
this (with `encode` from `Data.Aeson`):
|
||||
|
||||
```
|
||||
err400
|
||||
{ errBody = encode body
|
||||
, errHeaders = [("Content-Type", "application/json")]
|
||||
}
|
||||
```
|
||||
|
||||
## Passing formatters to Servant
|
||||
|
||||
Servant uses the Context to configure formatters. You only need to add a value of type
|
||||
`ErrorFormatters` to your context. This is a record with the following fields:
|
||||
|
||||
- `bodyParserErrorFormatter :: ErrorFormatter`
|
||||
- `urlParseErrorFormatter :: ErrorFormatter`
|
||||
- `headerParseErrorFormatter :: ErrorFormatter`
|
||||
- `notFoundErrorFormatter :: NotFoundErrorFormatter`
|
||||
|
||||
Default formatters are exported as `defaultErrorFormatters`, so you can use record update syntax to
|
||||
set the only ones you need:
|
||||
|
||||
```haskell
|
||||
customFormatters :: ErrorFormatters
|
||||
customFormatters = defaultErrorFormatters
|
||||
{ bodyParserErrorFormatter = customFormatter
|
||||
, notFoundErrorFormatter = notFoundFormatter
|
||||
}
|
||||
```
|
||||
|
||||
And at last, use `serveWithContext` to run your server as usual:
|
||||
|
||||
```haskell
|
||||
app :: Application
|
||||
app = serveWithContext testApi (customFormatters :. EmptyContext) server
|
||||
|
||||
main :: IO ()
|
||||
main = run 8000 app
|
||||
```
|
||||
|
||||
Now if we try to request something with a wrong body, we will get a nice error:
|
||||
|
||||
```
|
||||
$ http -j POST localhost:8000/greet 'foo=bar'
|
||||
HTTP/1.1 400 Bad Request
|
||||
Content-Type: application/json;charset=utf-8
|
||||
Date: Fri, 17 Jul 2020 13:34:18 GMT
|
||||
Server: Warp/3.3.12
|
||||
Transfer-Encoding: chunked
|
||||
|
||||
{
|
||||
"combinator": "ReqBody'",
|
||||
"error": "Error in $: parsing Main.Greet(Greet) failed, key \"_msg\" not found"
|
||||
}
|
||||
```
|
||||
|
||||
Notice the `Content-Type` header set by our combinator.
|
25
doc/cookbook/custom-errors/custom-errors.cabal
Normal file
25
doc/cookbook/custom-errors/custom-errors.cabal
Normal file
|
@ -0,0 +1,25 @@
|
|||
name: cookbook-custom-errors
|
||||
version: 0.1
|
||||
synopsis: Return custom error messages from combinators
|
||||
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
|
||||
cabal-version: >=1.10
|
||||
tested-with: GHC==8.6.5, GHC==8.8.3, GHC ==8.10.7
|
||||
|
||||
executable cookbook-custom-errors
|
||||
main-is: CustomErrors.lhs
|
||||
build-depends: base == 4.*
|
||||
, aeson
|
||||
, servant
|
||||
, servant-server
|
||||
, string-conversions
|
||||
, text
|
||||
, wai
|
||||
, warp
|
||||
default-language: Haskell2010
|
||||
ghc-options: -Wall -pgmL markdown-unlit
|
||||
build-tool-depends: markdown-unlit:markdown-unlit
|
|
@ -2,7 +2,7 @@
|
|||
|
||||
This doc will walk through a single-module implementation of a servant API connecting to a MySQL database. It will also include some basic CRUD operations.
|
||||
|
||||
Once you can wrap your head around this implemenation, understanding more complex features like resource pools would be beneficial next steps.
|
||||
Once you can wrap your head around this implementation, understanding more complex features like resource pools would be beneficial next steps.
|
||||
|
||||
The only *prerequisite* is that you have a MySQL database open on port 3306 of your machine. Docker is an easy way to manage this.
|
||||
|
||||
|
|
|
@ -2,7 +2,7 @@ name: mysql-basics
|
|||
version: 0.1.0.0
|
||||
synopsis: Simple MySQL API cookbook example
|
||||
homepage: http://docs.servant.dev/
|
||||
license: BSD3
|
||||
license: BSD-3-Clause
|
||||
license-file: ../../../servant/LICENSE
|
||||
author: Servant Contributors
|
||||
maintainer: haskell-servant-maintainers@googlegroups.com
|
||||
|
|
|
@ -2,13 +2,13 @@ name: cookbook-db-postgres-pool
|
|||
version: 0.1
|
||||
synopsis: Simple PostgreSQL connection pool cookbook example
|
||||
homepage: http://docs.servant.dev/
|
||||
license: BSD3
|
||||
license: BSD-3-Clause
|
||||
license-file: ../../../servant/LICENSE
|
||||
author: Servant Contributors
|
||||
maintainer: haskell-servant-maintainers@googlegroups.com
|
||||
build-type: Simple
|
||||
cabal-version: >=1.10
|
||||
tested-with: GHC==8.4.4, GHC==8.6.5, GHC==8.8.1
|
||||
tested-with: GHC==8.6.5, GHC==8.8.3, GHC ==8.10.7
|
||||
|
||||
executable cookbook-db-postgres-pool
|
||||
main-is: PostgresPool.lhs
|
||||
|
|
|
@ -2,13 +2,13 @@ name: cookbook-db-sqlite-simple
|
|||
version: 0.1
|
||||
synopsis: Simple SQLite DB cookbook example
|
||||
homepage: http://docs.servant.dev/
|
||||
license: BSD3
|
||||
license: BSD-3-Clause
|
||||
license-file: ../../../servant/LICENSE
|
||||
author: Servant Contributors
|
||||
maintainer: haskell-servant-maintainers@googlegroups.com
|
||||
build-type: Simple
|
||||
cabal-version: >=1.10
|
||||
tested-with: GHC==8.4.4, GHC==8.6.5, GHC==8.8.1
|
||||
tested-with: GHC==8.6.5, GHC==8.8.3, GHC ==8.10.7
|
||||
|
||||
executable cookbook-db-sqlite-simple
|
||||
main-is: DBConnection.lhs
|
||||
|
@ -23,7 +23,7 @@ executable cookbook-db-sqlite-simple
|
|||
, http-types >= 0.12
|
||||
, markdown-unlit >= 0.4
|
||||
, http-client >= 0.5
|
||||
, sqlite-simple >= 0.4
|
||||
, sqlite-simple >= 0.4.5.0
|
||||
, transformers
|
||||
default-language: Haskell2010
|
||||
ghc-options: -Wall -pgmL markdown-unlit
|
||||
|
|
|
@ -90,8 +90,8 @@ startServer = run 8080 (serve api upload)
|
|||
|
||||
Finally, a main function that brings up our server and
|
||||
sends some test request with `http-client` (and not
|
||||
servant-client this time, has servant-multipart does not
|
||||
yet have support for client generation.
|
||||
servant-client this time, as servant-multipart does not
|
||||
yet have support for client generation).
|
||||
|
||||
``` haskell
|
||||
main :: IO ()
|
||||
|
|
|
@ -2,13 +2,13 @@ name: cookbook-file-upload
|
|||
version: 0.1
|
||||
synopsis: File upload cookbook example
|
||||
homepage: http://docs.servant.dev/
|
||||
license: BSD3
|
||||
license: BSD-3-Clause
|
||||
license-file: ../../../servant/LICENSE
|
||||
author: Servant Contributors
|
||||
maintainer: haskell-servant-maintainers@googlegroups.com
|
||||
build-type: Simple
|
||||
cabal-version: >=1.10
|
||||
tested-with: GHC==8.4.4, GHC==8.6.5, GHC==8.8.1
|
||||
tested-with: GHC==8.6.5, GHC==8.8.3, GHC ==8.10.7
|
||||
|
||||
executable cookbook-file-upload
|
||||
main-is: FileUpload.lhs
|
||||
|
|
|
@ -43,13 +43,13 @@ api :: Proxy (ToServantApi Routes)
|
|||
api = genericApi (Proxy :: Proxy Routes)
|
||||
```
|
||||
|
||||
It's recommented to use `genericApi` function, as then you'll get
|
||||
It's recommended to use `genericApi` function, as then you'll get
|
||||
better error message, for example if you forget to `derive Generic`.
|
||||
|
||||
## Links
|
||||
|
||||
The clear advantage of record-based generics approach, is that
|
||||
we can get safe links very conviently. We don't need to define endpoint types,
|
||||
we can get safe links very conveniently. We don't need to define endpoint types,
|
||||
as field accessors work as proxies:
|
||||
|
||||
```haskell
|
||||
|
@ -67,7 +67,7 @@ routesLinks = allFieldLinks
|
|||
## Client
|
||||
|
||||
Even more power starts to show when we generate a record of client functions.
|
||||
Here we use `genericClientHoist` function, which let us simultaneously
|
||||
Here we use `genericClientHoist` function, which lets us simultaneously
|
||||
hoist the monad, in this case from `ClientM` to `IO`.
|
||||
|
||||
```haskell
|
||||
|
|
|
@ -2,13 +2,13 @@ name: cookbook-generic
|
|||
version: 0.1
|
||||
synopsis: Using custom monad to pass a state between handlers
|
||||
homepage: http://docs.servant.dev/
|
||||
license: BSD3
|
||||
license: BSD-3-Clause
|
||||
license-file: ../../../servant/LICENSE
|
||||
author: Servant Contributors
|
||||
maintainer: haskell-servant-maintainers@googlegroups.com
|
||||
build-type: Simple
|
||||
cabal-version: >=1.10
|
||||
tested-with: GHC==8.4.4, GHC==8.6.5, GHC==8.8.1
|
||||
tested-with: GHC==8.6.5, GHC==8.8.3, GHC ==8.10.7
|
||||
|
||||
executable cookbook-using-custom-monad
|
||||
main-is: Generic.lhs
|
||||
|
|
|
@ -254,7 +254,7 @@ loginHandler cookieSettings jwtSettings form = do
|
|||
liftIO $ pushLogStrLn logset $ toLogStr logMsg
|
||||
throwError err401
|
||||
Just applyCookies -> do
|
||||
let successMsg = logMsg{message = "AdminUser succesfully authenticated!"}
|
||||
let successMsg = logMsg{message = "AdminUser successfully authenticated!"}
|
||||
liftIO $ pushLogStrLn logset $ toLogStr successMsg
|
||||
pure $ applyCookies successMsg
|
||||
loginHandler _ _ _ = throwError err401
|
||||
|
@ -287,7 +287,7 @@ mkApp cfg cs jwts ctx =
|
|||
(flip runReaderT ctx) (adminServer cs jwts)
|
||||
```
|
||||
|
||||
One footenote: because we'd like our logs to be in JSON form, we'll also create a `Middleware` object
|
||||
One footnote: because we'd like our logs to be in JSON form, we'll also create a `Middleware` object
|
||||
so that `Warp` *also* will emit logs as JSON. This will ensure *all* logs are emitted as JSON:
|
||||
|
||||
```haskell
|
||||
|
|
|
@ -4,14 +4,14 @@ synopsis: JWT and basic access authentication with a Custom Monad coo
|
|||
description: Using servant-auth to support both JWT-based and basic
|
||||
authentication.
|
||||
homepage: http://docs.servant.dev/
|
||||
license: BSD3
|
||||
license: BSD-3-Clause
|
||||
license-file: ../../../servant/LICENSE
|
||||
author: Servant Contributors
|
||||
maintainer: haskell-servant-maintainers@googlegroups.com
|
||||
category: Servant
|
||||
build-type: Simple
|
||||
cabal-version: >=1.10
|
||||
tested-with: GHC==8.4.4, GHC==8.6.5, GHC==8.8.1
|
||||
tested-with: GHC==8.6.5, GHC==8.8.3, GHC ==8.10.7
|
||||
|
||||
executable cookbook-hoist-server-with-context
|
||||
main-is: HoistServerWithContext.lhs
|
||||
|
@ -24,7 +24,7 @@ executable cookbook-hoist-server-with-context
|
|||
, servant
|
||||
, servant-server
|
||||
, servant-auth >= 0.3.2
|
||||
, servant-auth-server
|
||||
, servant-auth-server >= 0.4.4.0
|
||||
, time
|
||||
, warp >= 3.2
|
||||
, wai >= 3.2
|
||||
|
|
|
@ -34,16 +34,16 @@ app = serve api server
|
|||
```
|
||||
|
||||
It's now time to actually run the `Application`.
|
||||
The [`warp-tls`](https://hackage.haskell.org/package/warp-tls-3.2.4/docs/Network-Wai-Handler-WarpTLS.html)
|
||||
The [`warp-tls`](https://hackage.haskell.org/package/warp-tls/docs/Network-Wai-Handler-WarpTLS.html)
|
||||
package provides two functions for running an `Application`, called
|
||||
[`runTLS`](https://hackage.haskell.org/package/warp-tls-3.2.4/docs/Network-Wai-Handler-WarpTLS.html#v:runTLS)
|
||||
and [`runTLSSocket`](https://hackage.haskell.org/package/warp-tls-3.2.4/docs/Network-Wai-Handler-WarpTLS.html#v:runTLSSocket).
|
||||
[`runTLS`](https://hackage.haskell.org/package/warp-tls/docs/Network-Wai-Handler-WarpTLS.html#v:runTLS)
|
||||
and [`runTLSSocket`](https://hackage.haskell.org/package/warp-tls/docs/Network-Wai-Handler-WarpTLS.html#v:runTLSSocket).
|
||||
We will be using the first one.
|
||||
|
||||
It takes two arguments,
|
||||
[the TLS settings](https://hackage.haskell.org/package/warp-tls-3.2.4/docs/Network-Wai-Handler-WarpTLS.html#t:TLSSettings)
|
||||
[the TLS settings](https://hackage.haskell.org/package/warp-tls/docs/Network-Wai-Handler-WarpTLS.html#t:TLSSettings)
|
||||
(certificates, keys, ciphers, etc)
|
||||
and [the warp settings](https://hackage.haskell.org/package/warp-3.2.12/docs/Network-Wai-Handler-Warp-Internal.html#t:Settings)
|
||||
and [the warp settings](https://hackage.haskell.org/package/warp/docs/Network-Wai-Handler-Warp-Internal.html#t:Settings)
|
||||
(port, logger, etc).
|
||||
|
||||
We will be using very simple settings for this example but you are of
|
||||
|
|
|
@ -2,13 +2,13 @@ name: cookbook-https
|
|||
version: 0.1
|
||||
synopsis: HTTPS cookbook example
|
||||
homepage: http://docs.servant.dev/
|
||||
license: BSD3
|
||||
license: BSD-3-Clause
|
||||
license-file: ../../../servant/LICENSE
|
||||
author: Servant Contributors
|
||||
maintainer: haskell-servant-maintainers@googlegroups.com
|
||||
build-type: Simple
|
||||
cabal-version: >=1.10
|
||||
tested-with: GHC==8.4.4, GHC==8.6.5, GHC==8.8.1
|
||||
tested-with: GHC==8.6.5, GHC==8.8.3, GHC ==8.10.7
|
||||
|
||||
executable cookbook-https
|
||||
main-is: Https.lhs
|
||||
|
@ -17,7 +17,7 @@ executable cookbook-https
|
|||
, servant-server
|
||||
, wai >= 3.2
|
||||
, warp >= 3.2
|
||||
, warp-tls >= 3.2
|
||||
, warp-tls >= 3.2.9
|
||||
, markdown-unlit >= 0.4
|
||||
default-language: Haskell2010
|
||||
ghc-options: -Wall -pgmL markdown-unlit
|
||||
|
|
|
@ -25,6 +25,8 @@ you name it!
|
|||
db-postgres-pool/PostgresPool.lhs
|
||||
using-custom-monad/UsingCustomMonad.lhs
|
||||
using-free-client/UsingFreeClient.lhs
|
||||
custom-errors/CustomErrors.lhs
|
||||
uverb/UVerb.lhs
|
||||
basic-auth/BasicAuth.lhs
|
||||
basic-streaming/Streaming.lhs
|
||||
jwt-and-basic-auth/JWTAndBasicAuth.lhs
|
||||
|
|
|
@ -4,14 +4,14 @@ synopsis: JWT and basic access authentication cookbook example
|
|||
description: Using servant-auth to support both JWT-based and basic
|
||||
authentication.
|
||||
homepage: http://docs.servant.dev/
|
||||
license: BSD3
|
||||
license: BSD-3-Clause
|
||||
license-file: ../../../servant/LICENSE
|
||||
author: Servant Contributors
|
||||
maintainer: haskell-servant-maintainers@googlegroups.com
|
||||
category: Servant
|
||||
build-type: Simple
|
||||
cabal-version: >=1.10
|
||||
tested-with: GHC==8.4.4, GHC==8.6.5, GHC==8.8.1
|
||||
tested-with: GHC==8.6.5, GHC==8.8.3, GHC ==8.10.7
|
||||
|
||||
executable cookbook-jwt-and-basic-auth
|
||||
main-is: JWTAndBasicAuth.lhs
|
||||
|
@ -22,7 +22,7 @@ executable cookbook-jwt-and-basic-auth
|
|||
, servant
|
||||
, servant-client
|
||||
, servant-server
|
||||
, servant-auth ==0.3.*
|
||||
, servant-auth == 0.4.*
|
||||
, servant-auth-server >= 0.3.1.0
|
||||
, warp >= 3.2
|
||||
, wai >= 3.2
|
||||
|
|
|
@ -2,13 +2,13 @@ name: open-id-connect
|
|||
version: 0.1
|
||||
synopsis: OpenId Connect with Servant example
|
||||
homepage: http://haskell-servant.readthedocs.org/
|
||||
license: BSD3
|
||||
license: BSD-3-Clause
|
||||
license-file: ../../../servant/LICENSE
|
||||
author: Servant Contributors
|
||||
maintainer: haskell-servant-maintainers@googlegroups.com
|
||||
build-type: Simple
|
||||
cabal-version: >= 1.10
|
||||
tested-with: GHC==8.4.4, GHC==8.6.5
|
||||
tested-with: GHC==8.6.5
|
||||
|
||||
executable cookbook-openidconnect
|
||||
main-is: OpenIdConnect.lhs
|
||||
|
|
|
@ -8,8 +8,8 @@ some login token would be saved in the user agent local storage.
|
|||
|
||||
Workflow:
|
||||
|
||||
1. user is presentend with a login button,
|
||||
2. when the user click on the button it is redirected to the OIDC
|
||||
1. user is presented with a login button,
|
||||
2. when the user clicks on the button it is redirected to the OIDC
|
||||
provider,
|
||||
3. the user login in the OIDC provider,
|
||||
4. the OIDC provider will redirect the user and provide a `code`,
|
||||
|
@ -221,9 +221,9 @@ The `AuthInfo` is about the infos we can grab from OIDC provider.
|
|||
|
||||
To be more precise, the user should come with a `code` (a token) and
|
||||
POSTing that code to the correct OIDC provider endpoint should return a JSON
|
||||
object. One of the field should be named `id_token` which should be a
|
||||
JWT containing all the informations we need. Depending on the scopes we
|
||||
asked we might get more informations.
|
||||
object. One of the fields should be named `id_token` which should be a
|
||||
JWT containing all the information we need. Depending on the scopes we
|
||||
asked we might get more information.
|
||||
|
||||
``` haskell
|
||||
-- | @AuthInfo@
|
||||
|
@ -248,16 +248,16 @@ instance JSON.ToJSON AuthInfo where
|
|||
type LoginHandler = AuthInfo -> IO (Either Text User)
|
||||
```
|
||||
|
||||
The `handleLoggedIn` is that part that will retrieve the informations from
|
||||
The `handleLoggedIn` is that part that will retrieve the information from
|
||||
the user once he is redirected from the OIDC Provider after login.
|
||||
|
||||
If the user is redirected to the `redirect_uri` but with an `error` query
|
||||
parameter then it means something goes wrong.
|
||||
parameter then it means something went wrong.
|
||||
If there is no error query param but a `code` query param it means the user
|
||||
sucessfully logged in. From there we need to make a request to the token
|
||||
endpoint of the OIDC provider. Its a POST that should contains the code
|
||||
as well as the client id & secret.
|
||||
This is the role of the `requestTokens` to make this HTTP POST.
|
||||
successfully logged in. From there we need to make a request to the token
|
||||
endpoint of the OIDC provider. It's a POST that should contain the code
|
||||
as well as the client id and secret.
|
||||
Making this HTTP POST is the responsibility of `requestTokens`.
|
||||
|
||||
From there we extract the `claims` of the JWT contained in one of the value
|
||||
of the JSON returned by the POST HTTP Request.
|
||||
|
@ -329,12 +329,12 @@ data Customer = Customer {
|
|||
}
|
||||
```
|
||||
|
||||
Here is the code that display the homepage.
|
||||
Here is the code that displays the homepage.
|
||||
It should contain a link to the the `/login` URL.
|
||||
When the user will click on this link it will be redirected to Google login page
|
||||
with some generated informations.
|
||||
When the user clicks on this link it will be redirected to Google login page
|
||||
with some generated information.
|
||||
|
||||
The page also display the content of the local storage.
|
||||
The page also displays the content of the local storage.
|
||||
And in particular the items `api-key` and `user-id`.
|
||||
Those items should be set after a successful login when the user is redirected to
|
||||
`/login/cb`.
|
||||
|
@ -366,7 +366,7 @@ instance ToMarkup Homepage where
|
|||
We need some helpers to generate random string for generating state and API Keys.
|
||||
|
||||
``` haskell
|
||||
-- | generate a random Bystestring, not necessarily extremely good randomness
|
||||
-- | generate a random ByteString, not necessarily extremely good randomness
|
||||
-- still the password will be long enough to be very difficult to crack
|
||||
genRandomBS :: IO ByteString
|
||||
genRandomBS = do
|
||||
|
|
|
@ -18,7 +18,7 @@ For example: `Range: createdAt 2017-01-15T23:14:67.000Z; offset 5; order desc` i
|
|||
the client is willing to retrieve the next batch of document in descending order that were
|
||||
created after the fifteenth of January, skipping the first 5.
|
||||
|
||||
As a response, the server may return the list of corresponding document, and augment the
|
||||
As a response, the server may return the list of corresponding documents, and augment the
|
||||
response with 3 headers:
|
||||
|
||||
- `Accept-Ranges`: A comma-separated list of fields upon which a range can be defined
|
||||
|
@ -127,7 +127,7 @@ defaultRange =
|
|||
getDefaultRange (Proxy @Color)
|
||||
```
|
||||
|
||||
Note that `getFieldValue :: Proxy "name" -> Color -> String` is the minimal complete definintion
|
||||
Note that `getFieldValue :: Proxy "name" -> Color -> String` is the minimal complete definition
|
||||
of the class. Yet, you can define `getRangeOptions` to provide different parsing options (see
|
||||
the last section of this guide). In the meantime, we've also defined a `defaultRange` as it will
|
||||
come in handy when defining our handler.
|
||||
|
@ -148,7 +148,7 @@ type MyHeaders =
|
|||
```
|
||||
|
||||
`PageHeaders` is a type alias provided by the library to declare the necessary response headers
|
||||
we mentionned in introduction. Expanding the alias boils down to the following:
|
||||
we mentioned in introduction. Expanding the alias boils down to the following:
|
||||
|
||||
``` haskell
|
||||
-- type MyHeaders =
|
||||
|
@ -165,7 +165,7 @@ not, _servant-pagination_ provides an easy way to lift a collection of resources
|
|||
#### Server
|
||||
|
||||
Time to connect the last bits by defining the server implementation of our colorful API. The `Ranges`
|
||||
type we've defined above (tight to the `Range` HTTP header) indicates the server to parse any `Range`
|
||||
type we've defined above (tied to the `Range` HTTP header) indicates the server to parse any `Range`
|
||||
header, looking for the format defined in introduction with fields and target types we have just declared.
|
||||
If no such header is provided, we will end up receiving `Nothing`. Otherwise, it will be possible
|
||||
to _extract_ a `Range` from our `Ranges`.
|
||||
|
@ -192,7 +192,7 @@ the format we defined, where `<field>` here can only be `name` and `<value>` mus
|
|||
- `Range: <field> [<value>][; offset <o>][; limit <l>][; order <asc|desc>]`
|
||||
|
||||
Beside the target field, everything is pretty much optional in the `Range` HTTP header. Missing parts
|
||||
are deducted from the `RangeOptions` that are part of the `HasPagination` instance. Therefore, all
|
||||
are deduced from the `RangeOptions` that are part of the `HasPagination` instance. Therefore, all
|
||||
following examples are valid requests to send to our server:
|
||||
|
||||
- 1 - `curl http://localhost:1442/colors -vH 'Range: name'`
|
||||
|
@ -219,7 +219,7 @@ The previous ranges reads as follows:
|
|||
Note that in the simple above scenario, there's no ambiguity with `extractRange` and `returnRange`
|
||||
because there's only one possible `Range` defined on our resource. Yet, as you've most probably
|
||||
noticed, the `Ranges` combinator accepts a list of fields, each of which must declare a `HasPagination`
|
||||
instance. Doing so will make the other helper functions more ambiguous and type annotation are
|
||||
instance. Doing so will make the other helper functions more ambiguous and type annotations are
|
||||
highly likely to be needed.
|
||||
|
||||
|
||||
|
@ -235,8 +235,8 @@ instance HasPagination Color "hex" where
|
|||
#### Parsing Options
|
||||
|
||||
By default, `servant-pagination` provides an implementation of `getRangeOptions` for each
|
||||
`HasPagination` instance. However, this can be overwritten when defining the instance to provide
|
||||
your own options. This options come into play when a `Range` header is received and isn't fully
|
||||
`HasPagination` instance. However, this can be overridden when defining the instance to provide
|
||||
your own options. These options come into play when a `Range` header is received and isn't fully
|
||||
specified (`limit`, `offset`, `order` are all optional) to provide default fallback values for those.
|
||||
|
||||
For instance, let's say we wanted to change the default limit to `5` in a new range on
|
||||
|
|
|
@ -2,13 +2,13 @@ name: cookbook-pagination
|
|||
version: 2.1
|
||||
synopsis: Pagination with Servant example
|
||||
homepage: http://docs.servant.dev/
|
||||
license: BSD3
|
||||
license: BSD-3-Clause
|
||||
license-file: ../../../servant/LICENSE
|
||||
author: Servant Contributors
|
||||
maintainer: haskell-servant-maintainers@googlegroups.com
|
||||
build-type: Simple
|
||||
cabal-version: >=1.10
|
||||
tested-with: GHC==8.4.4, GHC==8.6.5, GHC==8.8.1
|
||||
tested-with: GHC==8.6.5, GHC==8.8.3, GHC ==8.10.7
|
||||
|
||||
executable cookbook-pagination
|
||||
main-is: Pagination.lhs
|
||||
|
|
|
@ -79,14 +79,14 @@ It does three things. First it initializes the service which will communicate wi
|
|||
|
||||
- the Sentry `DSN`, which is obtained when creating a new project on Sentry
|
||||
- a default way to update sentry fields, where we use the identity function
|
||||
- an event trasport, which generally would be `sendRecord`, an HTTPS capable trasport which uses http-conduit
|
||||
- an event transport, which generally would be `sendRecord`, an HTTPS capable transport which uses http-conduit
|
||||
- a fallback handler, which we choose to be `silentFallback` since later we are logging to the console anyway.
|
||||
|
||||
In the second step it actually sends our message to Sentry with the `register` function. Its arguments are:
|
||||
|
||||
- the configured Sentry service which we just created
|
||||
- the name of the logger
|
||||
- the error level (see [SentryLevel](https://hackage.haskell.org/package/raven-haskell-0.1.2.0/docs/System-Log-Raven-Types.html#t:SentryLevel) for the possible options)
|
||||
- the error level (see [SentryLevel](https://hackage.haskell.org/package/raven-haskell/docs/System-Log-Raven-Types.html#t:SentryLevel) for the possible options)
|
||||
- the message we want to send
|
||||
- an update function to handle the specific `SentryRecord`
|
||||
|
||||
|
|
|
@ -2,13 +2,13 @@ name: cookbook-sentry
|
|||
version: 0.1
|
||||
synopsis: Collecting runtime exceptions using Sentry
|
||||
homepage: http://docs.servant.dev/
|
||||
license: BSD3
|
||||
license: BSD-3-Clause
|
||||
license-file: ../../../servant/LICENSE
|
||||
author: Servant Contributors
|
||||
maintainer: haskell-servant-maintainers@googlegroups.com
|
||||
build-type: Simple
|
||||
cabal-version: >=1.10
|
||||
tested-with: GHC==8.4.4, GHC==8.6.5, GHC==8.8.1
|
||||
tested-with: GHC==8.6.5, GHC==8.8.3, GHC ==8.10.7
|
||||
|
||||
executable cookbook-sentry
|
||||
main-is: Sentry.lhs
|
||||
|
|
|
@ -144,7 +144,7 @@ simpleAPIServer
|
|||
:: m [a]
|
||||
-> (i -> m a)
|
||||
-> (a -> m NoContent)
|
||||
-> Server (SimpleAPI name a i) m
|
||||
-> ServerT (SimpleAPI name a i) m
|
||||
simpleAPIServer listAs getA postA =
|
||||
listAs :<|> getA :<|> postA
|
||||
|
||||
|
|
|
@ -2,13 +2,13 @@ name: cookbook-structuring-apis
|
|||
version: 0.1
|
||||
synopsis: Example that shows how APIs can be structured
|
||||
homepage: http://docs.servant.dev/
|
||||
license: BSD3
|
||||
license: BSD-3-Clause
|
||||
license-file: ../../../servant/LICENSE
|
||||
author: Servant Contributors
|
||||
maintainer: haskell-servant-maintainers@googlegroups.com
|
||||
build-type: Simple
|
||||
cabal-version: >=1.10
|
||||
tested-with: GHC==8.4.4, GHC==8.6.5, GHC==8.8.1
|
||||
tested-with: GHC==8.6.5, GHC==8.8.3, GHC ==8.10.7
|
||||
|
||||
executable cookbook-structuring-apis
|
||||
main-is: StructuringApis.lhs
|
||||
|
|
|
@ -3,14 +3,14 @@ version: 0.0.1
|
|||
synopsis: Common testing patterns in Servant apps
|
||||
description: This recipe includes various strategies for writing tests for Servant.
|
||||
homepage: http://docs.servant.dev/
|
||||
license: BSD3
|
||||
license: BSD-3-Clause
|
||||
license-file: ../../../servant/LICENSE
|
||||
author: Servant Contributors
|
||||
maintainer: haskell-servant-maintainers@googlegroups.com
|
||||
category: Servant
|
||||
build-type: Simple
|
||||
cabal-version: >=1.10
|
||||
tested-with: GHC==8.4.4, GHC==8.6.5, GHC==8.8.1
|
||||
tested-with: GHC==8.6.5, GHC==8.8.3, GHC ==8.10.7
|
||||
|
||||
executable cookbook-testing
|
||||
main-is: Testing.lhs
|
||||
|
@ -23,7 +23,7 @@ executable cookbook-testing
|
|||
, servant
|
||||
, servant-client
|
||||
, servant-server
|
||||
, servant-quickcheck
|
||||
, servant-quickcheck >= 0.0.10
|
||||
, http-client
|
||||
, http-types >= 0.12
|
||||
, hspec
|
||||
|
|
|
@ -1,6 +1,6 @@
|
|||
# Using a custom monad
|
||||
|
||||
In this section we will create and API for a book shelf without any backing DB storage.
|
||||
In this section we will create an API for a book shelf without any backing DB storage.
|
||||
We will keep state in memory and share it between requests using `Reader` monad and `STM`.
|
||||
|
||||
We start with a pretty standard set of imports and definition of the model:
|
||||
|
|
|
@ -2,13 +2,13 @@ name: cookbook-using-custom-monad
|
|||
version: 0.1
|
||||
synopsis: Using custom monad to pass a state between handlers
|
||||
homepage: http://docs.servant.dev/
|
||||
license: BSD3
|
||||
license: BSD-3-Clause
|
||||
license-file: ../../../servant/LICENSE
|
||||
author: Servant Contributors
|
||||
maintainer: haskell-servant-maintainers@googlegroups.com
|
||||
build-type: Simple
|
||||
cabal-version: >=1.10
|
||||
tested-with: GHC==8.4.4, GHC==8.6.5, GHC==8.8.1
|
||||
tested-with: GHC==8.6.5, GHC==8.8.3, GHC ==8.10.7
|
||||
|
||||
executable cookbook-using-custom-monad
|
||||
main-is: UsingCustomMonad.lhs
|
||||
|
|
|
@ -141,7 +141,7 @@ and calling the continuation. We should get a `Pure` value.
|
|||
Pure n ->
|
||||
putStrLn $ "Expected 1764, got " ++ show n
|
||||
_ ->
|
||||
putStrLn "ERROR: didn't got a response"
|
||||
putStrLn "ERROR: didn't get a response"
|
||||
```
|
||||
|
||||
So that's it. Using `Free` we can evaluate servant clients step-by-step, and
|
||||
|
|
|
@ -2,13 +2,13 @@ name: cookbook-using-free-client
|
|||
version: 0.1
|
||||
synopsis: Using Free client
|
||||
homepage: http://docs.servant.dev/
|
||||
license: BSD3
|
||||
license: BSD-3-Clause
|
||||
license-file: ../../../servant/LICENSE
|
||||
author: Servant Contributors
|
||||
maintainer: haskell-servant-maintainers@googlegroups.com
|
||||
build-type: Simple
|
||||
cabal-version: >=1.10
|
||||
tested-with: GHC==8.4.4, GHC==8.6.5, GHC==8.8.1
|
||||
tested-with: GHC==8.6.5, GHC==8.8.3, GHC ==8.10.7
|
||||
|
||||
executable cookbook-using-free-client
|
||||
main-is: UsingFreeClient.lhs
|
||||
|
|
223
doc/cookbook/uverb/UVerb.lhs
Normal file
223
doc/cookbook/uverb/UVerb.lhs
Normal file
|
@ -0,0 +1,223 @@
|
|||
# Listing alternative responses and exceptions in your API types
|
||||
|
||||
Servant allows you to talk about the exceptions you throw in your API
|
||||
types. This is not limited to actual exceptions, you can write
|
||||
handlers that respond with arbitrary open unions of types.
|
||||
|
||||
## Compatibility
|
||||
|
||||
:warning: This cookbook is compatible with GHC 8.6.1 or higher :warning:
|
||||
|
||||
## Preliminaries
|
||||
|
||||
```haskell
|
||||
{-# LANGUAGE ConstraintKinds #-}
|
||||
{-# LANGUAGE DataKinds #-}
|
||||
{-# LANGUAGE DeriveGeneric #-}
|
||||
{-# LANGUAGE DerivingStrategies #-}
|
||||
{-# LANGUAGE DeriveAnyClass #-}
|
||||
{-# LANGUAGE DerivingVia #-}
|
||||
{-# LANGUAGE FlexibleContexts #-}
|
||||
{-# LANGUAGE FlexibleInstances #-}
|
||||
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
|
||||
{-# LANGUAGE InstanceSigs #-}
|
||||
{-# LANGUAGE MultiParamTypeClasses #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
{-# LANGUAGE StandaloneDeriving #-}
|
||||
{-# LANGUAGE TypeApplications #-}
|
||||
{-# LANGUAGE TypeFamilies #-}
|
||||
{-# LANGUAGE TypeOperators #-}
|
||||
{-# LANGUAGE UndecidableInstances #-}
|
||||
{-# OPTIONS_GHC -Wall -Wno-orphans #-}
|
||||
|
||||
import Control.Concurrent (threadDelay)
|
||||
import Control.Concurrent.Async (async)
|
||||
import Control.Monad (when)
|
||||
import Control.Monad.Except (ExceptT (..), MonadError (..), MonadTrans (..), runExceptT)
|
||||
import Data.Aeson (FromJSON (..), ToJSON (..))
|
||||
import Data.Aeson.Encode.Pretty (encodePretty)
|
||||
import Data.String.Conversions (cs)
|
||||
import Data.Swagger (ToSchema)
|
||||
import Data.Typeable (Proxy (Proxy))
|
||||
import qualified GHC.Generics as GHC
|
||||
import qualified Network.HTTP.Client as Client
|
||||
import qualified Network.Wai.Handler.Warp as Warp
|
||||
import Servant.API
|
||||
import Servant.Client
|
||||
import Servant.Server
|
||||
import Servant.Swagger
|
||||
```
|
||||
|
||||
## The API
|
||||
|
||||
This looks like a `Verb`-based routing table, except that `UVerb` has
|
||||
no status, and carries a list of response types rather than a single
|
||||
one. Each entry in the list carries its own response code.
|
||||
|
||||
```haskell
|
||||
type API =
|
||||
"fisx" :> Capture "bool" Bool
|
||||
:> UVerb 'GET '[JSON] '[FisxUser, WithStatus 303 String]
|
||||
:<|> "arian"
|
||||
:> UVerb 'GET '[JSON] '[WithStatus 201 ArianUser]
|
||||
```
|
||||
|
||||
Here are the details:
|
||||
|
||||
```haskell
|
||||
data FisxUser = FisxUser {name :: String}
|
||||
deriving (Eq, Show, GHC.Generic)
|
||||
|
||||
instance ToJSON FisxUser
|
||||
instance FromJSON FisxUser
|
||||
instance ToSchema FisxUser
|
||||
|
||||
-- | 'HasStatus' allows us to can get around 'WithStatus' if we want
|
||||
-- to, and associate the status code with our resource types directly.
|
||||
--
|
||||
-- (To avoid orphan instances and make it more explicit what's in the
|
||||
-- API and what isn't, we could even introduce a newtype 'Resource'
|
||||
-- that wraps all the types we're using in our routing table, and then
|
||||
-- define lots of 'HasStatus' instances for @Resource This@ and
|
||||
-- @Resource That@.)
|
||||
instance HasStatus FisxUser where
|
||||
type StatusOf FisxUser = 203
|
||||
|
||||
data ArianUser = ArianUser
|
||||
deriving (Eq, Show, GHC.Generic)
|
||||
|
||||
instance ToJSON ArianUser
|
||||
instance FromJSON ArianUser
|
||||
instance ToSchema ArianUser
|
||||
```
|
||||
|
||||
## Server, Client, Swagger
|
||||
|
||||
You can just respond with any of the elements of the union in handlers.
|
||||
|
||||
```haskell
|
||||
fisx :: Bool -> Handler (Union '[FisxUser, WithStatus 303 String])
|
||||
fisx True = respond (FisxUser "fisx")
|
||||
fisx False = respond (WithStatus @303 ("still fisx" :: String))
|
||||
|
||||
arian :: Handler (Union '[WithStatus 201 ArianUser])
|
||||
arian = respond (WithStatus @201 ArianUser)
|
||||
```
|
||||
|
||||
You can create client functions like you're used to:
|
||||
|
||||
```
|
||||
fisxClient :: Bool -> ClientM (Union '[FisxUser, WithStatus 303 String])
|
||||
arianClient :: ClientM (Union '[WithStatus 201 ArianUser])
|
||||
(fisxClient :<|> arianClient) = client (Proxy @API)
|
||||
```
|
||||
|
||||
... and that's basically it! Here are a few sample commands that
|
||||
show you how the swagger docs look like and how you can handle the
|
||||
result unions in clients:
|
||||
|
||||
```
|
||||
main :: IO ()
|
||||
main = do
|
||||
putStrLn . cs . encodePretty $ toSwagger (Proxy @API)
|
||||
_ <- async . Warp.run 8080 $ serve (Proxy @API) (fisx :<|> arian)
|
||||
threadDelay 50000
|
||||
mgr <- Client.newManager Client.defaultManagerSettings
|
||||
let cenv = mkClientEnv mgr (BaseUrl Http "localhost" 8080 "")
|
||||
result <- runClientM (fisxClient True) cenv
|
||||
print $ foldMapUnion (Proxy @Show) show <$> result
|
||||
print $ matchUnion @FisxUser <$> result
|
||||
print $ matchUnion @(WithStatus 303 String) <$> result
|
||||
pure ()
|
||||
```
|
||||
|
||||
## Idiomatic exceptions
|
||||
|
||||
Since `UVerb` (probably) will mostly be used for error-like responses, it may be desirable to be able to early abort handler, like with current servant one would use `throwError` with `ServerError`.
|
||||
|
||||
```haskell
|
||||
newtype UVerbT xs m a = UVerbT { unUVerbT :: ExceptT (Union xs) m a }
|
||||
deriving (Functor, Applicative, Monad, MonadTrans)
|
||||
|
||||
-- | Deliberately hide 'ExceptT's 'MonadError' instance to be able to use
|
||||
-- underlying monad's instance.
|
||||
instance MonadError e m => MonadError e (UVerbT xs m) where
|
||||
throwError = lift . throwError
|
||||
catchError (UVerbT act) h = UVerbT $ ExceptT $
|
||||
runExceptT act `catchError` (runExceptT . unUVerbT . h)
|
||||
|
||||
-- | This combinator runs 'UVerbT'. It applies 'respond' internally, so the handler
|
||||
-- may use the usual 'return'.
|
||||
runUVerbT :: (Monad m, HasStatus x, IsMember x xs) => UVerbT xs m x -> m (Union xs)
|
||||
runUVerbT (UVerbT act) = either id id <$> runExceptT (act >>= respond)
|
||||
|
||||
-- | Short-circuit 'UVerbT' computation returning one of the response types.
|
||||
throwUVerb :: (Monad m, HasStatus x, IsMember x xs) => x -> UVerbT xs m a
|
||||
throwUVerb = UVerbT . ExceptT . fmap Left . respond
|
||||
```
|
||||
|
||||
Example usage:
|
||||
|
||||
```haskell
|
||||
data Foo = Foo Int Int Int
|
||||
deriving (Show, Eq, GHC.Generic, ToJSON)
|
||||
deriving HasStatus via WithStatus 200 Foo
|
||||
|
||||
data Bar = Bar
|
||||
deriving (Show, Eq, GHC.Generic)
|
||||
|
||||
instance ToJSON Bar
|
||||
|
||||
h :: Handler (Union '[Foo, WithStatus 400 Bar])
|
||||
h = runUVerbT $ do
|
||||
when ({- something bad -} True) $
|
||||
throwUVerb $ WithStatus @400 Bar
|
||||
|
||||
when ({- really bad -} False) $
|
||||
throwError $ err500
|
||||
|
||||
-- a lot of code here...
|
||||
|
||||
return $ Foo 1 2 3
|
||||
```
|
||||
|
||||
## Related Work
|
||||
|
||||
There is the [issue from
|
||||
2017](https://github.com/haskell-servant/servant/issues/841) that was
|
||||
resolved by the introduction of `UVerb`, with a long discussion on
|
||||
alternative designs.
|
||||
|
||||
[servant-checked-exceptions](https://hackage.haskell.org/package/servant-checked-exceptions)
|
||||
is a good solution to the problem, but it restricts the user to JSON
|
||||
and a very specific envelop encoding for the union type, which is
|
||||
often not acceptable. (One good reason for this design choice is that
|
||||
it makes writing clients easier, where you need to get to the union
|
||||
type from one representative, and you don't want to run several
|
||||
parsers in the hope that the ones that should will always error out so
|
||||
you can try until the right one returns a value.)
|
||||
|
||||
[servant-exceptions](https://github.com/ch1bo/servant-exceptions) is
|
||||
another shot at at the problem. It is inspired by
|
||||
servant-checked-exceptions, so it may be worth taking a closer look.
|
||||
The README claims that
|
||||
[cardano-sl](https://github.com/input-output-hk/cardano-sl) also has
|
||||
some code for generalized error handling.
|
||||
|
||||
In an earier version of the `UVerb` implementation, we have used some
|
||||
code from
|
||||
[world-peace](https://hackage.haskell.org/package/world-peace), but
|
||||
that package itself wasn't flexible enough, and we had to use
|
||||
[sop-core](https://hackage.haskell.org/package/sop-core) to implement
|
||||
the `HasServer` instance.
|
||||
|
||||
Here is a blog post we found on the subject:
|
||||
https://lukwagoallan.com/posts/unifying-servant-server-error-responses
|
||||
|
||||
(If you have anything else, please add it here or let us know.)
|
||||
|
||||
```haskell
|
||||
main :: IO ()
|
||||
main = return ()
|
||||
```
|
35
doc/cookbook/uverb/uverb.cabal
Normal file
35
doc/cookbook/uverb/uverb.cabal
Normal file
|
@ -0,0 +1,35 @@
|
|||
name: cookbook-uverb
|
||||
version: 0.0.1
|
||||
synopsis: How to use the 'UVerb' type.
|
||||
description: Listing alternative responses and exceptions in your API types.
|
||||
homepage: http://docs.servant.dev/
|
||||
license: BSD-3-Clause
|
||||
license-file: ../../../servant/LICENSE
|
||||
author: Servant Contributors
|
||||
maintainer: haskell-servant-maintainers@googlegroups.com
|
||||
category: Servant
|
||||
build-type: Simple
|
||||
cabal-version: >=1.10
|
||||
tested-with: GHC==8.6.5, GHC==8.8.4, GHC==8.10.7
|
||||
|
||||
executable cookbook-uverb
|
||||
main-is: UVerb.lhs
|
||||
build-depends: base == 4.*
|
||||
, aeson >= 1.2
|
||||
, aeson-pretty >= 0.8.8
|
||||
, async
|
||||
, http-client
|
||||
, mtl
|
||||
, servant
|
||||
, servant-client
|
||||
, servant-server
|
||||
, servant-swagger
|
||||
, string-conversions
|
||||
, swagger2
|
||||
, wai
|
||||
, warp
|
||||
if impl(ghc >= 9)
|
||||
buildable: False
|
||||
default-language: Haskell2010
|
||||
ghc-options: -Wall -pgmL markdown-unlit
|
||||
build-tool-depends: markdown-unlit:markdown-unlit
|
|
@ -389,3 +389,30 @@ One example for this is if you want to serve a directory of static files along
|
|||
with the rest of your API. But you can plug in everything that is an
|
||||
`Application`, e.g. a whole web application written in any of the web
|
||||
frameworks that support `wai`.
|
||||
|
||||
Be mindful! The `servant-server`'s router works by pattern-matching the
|
||||
different routes that are composed using `:<|>`. `Raw`, as an escape hatch,
|
||||
matches any route that hasn't been matched by previous patterns. Therefore,
|
||||
any subsequent route will be silently ignored.
|
||||
|
||||
``` haskell
|
||||
type UserAPI14 = Raw
|
||||
:<|> "users" :> Get '[JSON] [User]
|
||||
-- In this situation, the /users endpoint
|
||||
-- will not be reachable because the Raw
|
||||
-- endpoint matches requests before
|
||||
```
|
||||
A simple way to avoid this pitfall is to either use `Raw` as the last
|
||||
definition, or to always have it under a static path.
|
||||
|
||||
``` haskell
|
||||
type UserAPI15 = "files" :> Raw
|
||||
-- The raw endpoint is under the /files
|
||||
-- static path, so it won't match /users.
|
||||
:<|> "users" :> Get '[JSON] [User]
|
||||
|
||||
type UserAPI16 = "users" :> Get '[JSON] [User]
|
||||
:<|> Raw
|
||||
-- The Raw endpoint is matched last, so
|
||||
-- it won't overlap another endpoint.
|
||||
```
|
||||
|
|
|
@ -47,7 +47,6 @@ module Authentication where
|
|||
import Data.Aeson (ToJSON)
|
||||
import Data.ByteString (ByteString)
|
||||
import Data.Map (Map, fromList)
|
||||
import Data.Monoid ((<>))
|
||||
import qualified Data.Map as Map
|
||||
import Data.Proxy (Proxy (Proxy))
|
||||
import Data.Text (Text)
|
||||
|
@ -108,7 +107,7 @@ API with "private." Additionally, the private parts of our API use the
|
|||
realm for this authentication is `"foo-realm"`).
|
||||
|
||||
Unfortunately we're not done. When someone makes a request to our `"private"`
|
||||
API, we're going to need to provide to servant the logic for validifying
|
||||
API, we're going to need to provide to servant the logic for validating
|
||||
usernames and passwords. This adds a certain conceptual wrinkle in servant's
|
||||
design that we'll briefly discuss. If you want the **TL;DR**: we supply a lookup
|
||||
function to servant's new `Context` primitive.
|
||||
|
@ -133,7 +132,7 @@ combinator. Using `Context`, we can supply a function of type
|
|||
handler. This will allow the handler to check authentication and return a `User`
|
||||
to downstream handlers if successful.
|
||||
|
||||
In practice we wrap `BasicAuthData -> Handler` into a slightly
|
||||
In practice we wrap `BasicAuthData -> Handler User` into a slightly
|
||||
different function to better capture the semantics of basic authentication:
|
||||
|
||||
``` haskell ignore
|
||||
|
@ -260,7 +259,7 @@ this.
|
|||
|
||||
Let's implement a trivial authentication scheme. We will protect our API by
|
||||
looking for a cookie named `"servant-auth-cookie"`. This cookie's value will
|
||||
contain a key from which we can lookup a `Account`.
|
||||
contain a key from which we can lookup an `Account`.
|
||||
|
||||
```haskell
|
||||
-- | An account type that we "fetch from the database" after
|
||||
|
@ -274,7 +273,7 @@ database = fromList [ ("key1", Account "Anne Briggs")
|
|||
, ("key3", Account "Ghédalia Tazartès")
|
||||
]
|
||||
|
||||
-- | A method that, when given a password, will return a Account.
|
||||
-- | A method that, when given a password, will return an Account.
|
||||
-- This is our bespoke (and bad) authentication logic.
|
||||
lookupAccount :: ByteString -> Handler Account
|
||||
lookupAccount key = case Map.lookup key database of
|
||||
|
@ -346,7 +345,7 @@ genAuthServerContext = authHandler :. EmptyContext
|
|||
|
||||
-- | Our API, where we provide all the author-supplied handlers for each end
|
||||
-- point. Note that 'privateDataFunc' is a function that takes 'Account' as an
|
||||
-- argument. We dont' worry about the authentication instrumentation here,
|
||||
-- argument. We don't worry about the authentication instrumentation here,
|
||||
-- that is taken care of by supplying context
|
||||
genAuthServer :: Server AuthGenAPI
|
||||
genAuthServer =
|
||||
|
@ -385,11 +384,11 @@ Creating a generalized, ad-hoc authentication scheme was fairly straight
|
|||
forward:
|
||||
|
||||
1. use the `AuthProtect` combinator to protect your API.
|
||||
2. choose a application-specific data type used by your server when
|
||||
2. choose an application-specific data type used by your server when
|
||||
authentication is successful (in our case this was `Account`).
|
||||
3. Create a value of `AuthHandler Request Account` which encapsulates the
|
||||
authentication logic (`Request -> Handler Account`). This function
|
||||
will be executed everytime a request matches a protected route.
|
||||
will be executed every time a request matches a protected route.
|
||||
4. Provide an instance of the `AuthServerData` type family, specifying your
|
||||
application-specific data type returned when authentication is successful (in
|
||||
our case this was `Account`).
|
||||
|
|
|
@ -161,7 +161,7 @@ The types of the arguments for the functions are the same as for (server-side) r
|
|||
## Changing the monad the client functions live in
|
||||
|
||||
Just like `hoistServer` allows us to change the monad in which request handlers
|
||||
of a web application live in, we also have `hoistClient` for changing the monad
|
||||
of a web application live, we also have `hoistClient` for changing the monad
|
||||
in which _client functions_ live. Consider the following trivial API:
|
||||
|
||||
``` haskell
|
||||
|
@ -173,7 +173,7 @@ hoistClientAPI = Proxy
|
|||
|
||||
We already know how to derive client functions for this API, and as we have
|
||||
seen above they all return results in the `ClientM` monad when using `servant-client`.
|
||||
However, `ClientM` rarely (or never) is the actual monad we need to use the client
|
||||
However, `ClientM` is rarely (or never) the actual monad we need to use the client
|
||||
functions in. Sometimes we need to run them in IO, sometimes in a custom monad
|
||||
stack. `hoistClient` is a very simple solution to the problem of "changing" the monad
|
||||
the clients run in.
|
||||
|
|
|
@ -77,7 +77,7 @@ instance ToSample HelloMessage where
|
|||
[ ("When a value is provided for 'name'", HelloMessage "Hello, Alp")
|
||||
, ("When 'name' is not specified", HelloMessage "Hello, anonymous coward")
|
||||
]
|
||||
-- mutliple examples to display this time
|
||||
-- multiple examples to display this time
|
||||
|
||||
ci :: ClientInfo
|
||||
ci = ClientInfo "Alp" "alp@foo.com" 26 ["haskell", "mathematics"]
|
||||
|
@ -108,7 +108,7 @@ apiDocs = docs exampleAPI
|
|||
markdown :: API -> String
|
||||
```
|
||||
|
||||
That lets us see what our API docs look down in markdown, by looking at `markdown apiDocs`.
|
||||
That lets us see what our API docs look like in markdown, by looking at `markdown apiDocs`.
|
||||
|
||||
````````` text
|
||||
## GET /hello
|
||||
|
|
|
@ -228,13 +228,13 @@ data CommonGeneratorOptions = CommonGeneratorOptions
|
|||
{
|
||||
-- | function generating function names
|
||||
functionNameBuilder :: FunctionName -> Text
|
||||
-- | name used when a user want to send the request body (to let you redefine it)
|
||||
-- | name used when a user wants to send the request body (to let you redefine it)
|
||||
, requestBody :: Text
|
||||
-- | name of the callback parameter when the request was successful
|
||||
, successCallback :: Text
|
||||
-- | name of the callback parameter when the request reported an error
|
||||
, errorCallback :: Text
|
||||
-- | namespace on which we define the js function (empty mean local var)
|
||||
-- | namespace on which we define the js function (empty means local var)
|
||||
, moduleName :: Text
|
||||
-- | a prefix that should be prepended to the URL in the generated JS
|
||||
, urlPrefix :: Text
|
||||
|
|
|
@ -183,7 +183,7 @@ users2 = [isaac, albert]
|
|||
|
||||
Now, just like we separate the various endpoints in `UserAPI` with `:<|>`, we
|
||||
are going to separate the handlers with `:<|>` too! They must be provided in
|
||||
the same order as in in the API type.
|
||||
the same order as in the API type.
|
||||
|
||||
``` haskell
|
||||
server2 :: Server UserAPI2
|
||||
|
@ -313,8 +313,8 @@ For reference, here's a list of some combinators from **servant**:
|
|||
## The `FromHttpApiData`/`ToHttpApiData` classes
|
||||
|
||||
Wait... How does **servant** know how to decode the `Int`s from the URL? Or how
|
||||
to decode a `ClientInfo` value from the request body? This is what this and the
|
||||
following two sections address.
|
||||
to decode a `ClientInfo` value from the request body? The following three sections will
|
||||
help us answer these questions.
|
||||
|
||||
`Capture`s and `QueryParam`s are represented by some textual value in URLs.
|
||||
`Header`s are similarly represented by a pair of a header name and a
|
||||
|
@ -620,7 +620,7 @@ In short, this means that a handler of type `Handler a` is simply
|
|||
equivalent to a computation of type `IO (Either ServerError a)`, that is, an IO
|
||||
action that either returns an error or a result.
|
||||
|
||||
The module [`Control.Monad.Except`](https://hackage.haskell.org/package/mtl-2.2.1/docs/Control-Monad-Except.html#t:ExceptT)
|
||||
The module [`Control.Monad.Except`](https://hackage.haskell.org/package/mtl/docs/Control-Monad-Except.html#t:ExceptT)
|
||||
from which `ExceptT` comes is worth looking at.
|
||||
Perhaps most importantly, `ExceptT` and `Handler` are instances of `MonadError`, so
|
||||
`throwError` can be used to return an error from your handler (whereas `return`
|
||||
|
@ -634,7 +634,7 @@ kind and abort early. The next two sections cover how to do just that.
|
|||
|
||||
Other important instances from the list above are `MonadIO m => MonadIO
|
||||
(ExceptT e m)`, and therefore also `MonadIO Handler` as there is a `MonadIO IO` instance.
|
||||
[`MonadIO`](http://hackage.haskell.org/package/transformers-0.4.3.0/docs/Control-Monad-IO-Class.html)
|
||||
[`MonadIO`](http://hackage.haskell.org/package/base/docs/Control-Monad-IO-Class.html#t:MonadIO)
|
||||
is a class from the **transformers** package defined as:
|
||||
|
||||
``` haskell ignore
|
||||
|
@ -716,7 +716,7 @@ $ curl --verbose http://localhost:8081/myfile.txt
|
|||
>
|
||||
< HTTP/1.1 404 Not Found
|
||||
[snip]
|
||||
myfile.txt just isnt there, please leave this server alone.
|
||||
myfile.txt just isn't there, please leave this server alone.
|
||||
|
||||
$ echo Hello > myfile.txt
|
||||
|
||||
|
@ -818,7 +818,7 @@ If it doesn't exist, the handler will fail with a `404` status code.
|
|||
|
||||
`serveDirectoryWebApp` uses some standard settings that fit the use case of
|
||||
serving static files for most web apps. You can find out about the other
|
||||
options in the documentation of the `Servant.Utils.StaticFiles` module.
|
||||
options in the documentation of the `Servant.Server.StaticFiles` module.
|
||||
|
||||
## Nested APIs
|
||||
|
||||
|
@ -1135,7 +1135,7 @@ true
|
|||
### An arrow is a reader too.
|
||||
|
||||
In previous versions of `servant` we had an `enter` to do what `hoistServer`
|
||||
does now. `enter` had a ambitious design goals, but was problematic in practice.
|
||||
does now. `enter` had an ambitious design goals, but was problematic in practice.
|
||||
|
||||
One problematic situation was when the source monad was `(->) r`, yet it's
|
||||
handy in practice, because `(->) r` is isomorphic to `Reader r`.
|
||||
|
@ -1166,7 +1166,7 @@ back a *stream* of results, served one at a time. Stream endpoints only provide
|
|||
a single content type, and also specify what framing strategy is used to
|
||||
delineate the results. To serve these results, we need to give back a stream
|
||||
producer. Adapters can be written to *Pipes*, *Conduit* and the like, or
|
||||
written directly as `SourceIO`s. SourceIO builts upon servant's own `SourceT`
|
||||
written directly as `SourceIO`s. SourceIO builds upon servant's own `SourceT`
|
||||
stream type (it's simpler than *Pipes* or *Conduit*).
|
||||
The API of a streaming endpoint needs to explicitly specify which sort of
|
||||
generator it produces. Note that the generator itself is returned by a
|
||||
|
|
|
@ -6,46 +6,10 @@ This is an introductory tutorial to **servant**. Whilst browsing is fine, it mak
|
|||
Any comments, issues or feedback about the tutorial can be submitted
|
||||
to `servant's issue tracker <http://github.com/haskell-servant/servant/issues>`_.
|
||||
|
||||
cabal-install
|
||||
--------
|
||||
|
||||
The whole tutorial is a `cabal <https://cabal.readthedocs.io/en/latest/>`_
|
||||
project and can be built locally as follows:
|
||||
|
||||
.. code-block:: bash
|
||||
|
||||
$ git clone https://github.com/haskell-servant/servant.git
|
||||
$ cd servant
|
||||
# build
|
||||
$ cabal new-build tutorial
|
||||
# load in ghci to play with it
|
||||
$ cabal new-repl tutorial
|
||||
|
||||
stack
|
||||
--------
|
||||
|
||||
The servant `stack <https://docs.haskellstack.org/en/stable/README/>`_ template includes the working tutorial. To initialize this template, run:
|
||||
|
||||
.. code-block:: bash
|
||||
|
||||
$ stack new myproj servant
|
||||
$ cd myproj
|
||||
# build
|
||||
$ stack build
|
||||
# start server
|
||||
$ stack exec myproj-exe
|
||||
|
||||
The code can be found in the `*.lhs` files under `doc/tutorial/` in the
|
||||
repository. Feel free to edit it while you're reading this documentation and
|
||||
see the effect of your changes.
|
||||
|
||||
`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
|
||||
environment to build and run the examples.
|
||||
|
||||
.. toctree::
|
||||
:maxdepth: 1
|
||||
|
||||
install.rst
|
||||
ApiType.lhs
|
||||
Server.lhs
|
||||
Client.lhs
|
||||
|
|
42
doc/tutorial/install.rst
Normal file
42
doc/tutorial/install.rst
Normal file
|
@ -0,0 +1,42 @@
|
|||
Install
|
||||
========
|
||||
|
||||
cabal-install
|
||||
--------
|
||||
|
||||
The whole tutorial is a `cabal <https://cabal.readthedocs.io/en/latest/>`_
|
||||
project and can be built locally as follows:
|
||||
|
||||
.. code-block:: bash
|
||||
|
||||
$ git clone https://github.com/haskell-servant/servant.git
|
||||
$ cd servant
|
||||
# build
|
||||
$ cabal new-build tutorial
|
||||
# load in ghci to play with it
|
||||
$ cabal new-repl tutorial
|
||||
|
||||
stack
|
||||
--------
|
||||
|
||||
The servant `stack <https://docs.haskellstack.org/en/stable/README/>`_ template includes the working tutorial. To initialize this template, run:
|
||||
|
||||
.. code-block:: bash
|
||||
|
||||
$ stack new myproj servant
|
||||
$ cd myproj
|
||||
# build
|
||||
$ stack build
|
||||
# start server
|
||||
$ stack exec myproj-exe
|
||||
|
||||
The code can be found in the `*.lhs` files under `doc/tutorial/` in the
|
||||
repository. Feel free to edit it while you're reading this documentation and
|
||||
see the effect of your changes.
|
||||
|
||||
nix
|
||||
--------
|
||||
|
||||
`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
|
||||
environment to build and run the examples.
|
|
@ -6,18 +6,15 @@ description:
|
|||
<http://docs.servant.dev/>
|
||||
homepage: http://docs.servant.dev/
|
||||
category: Servant, Documentation
|
||||
license: BSD3
|
||||
license: BSD-3-Clause
|
||||
license-file: LICENSE
|
||||
author: Servant Contributors
|
||||
maintainer: haskell-servant-maintainers@googlegroups.com
|
||||
build-type: Simple
|
||||
cabal-version: >=1.10
|
||||
tested-with:
|
||||
GHC==8.0.2
|
||||
GHC==8.2.2
|
||||
GHC==8.4.4
|
||||
GHC==8.6.5
|
||||
GHC==8.8.1
|
||||
GHC==8.8.3, GHC ==8.10.7
|
||||
extra-source-files:
|
||||
static/index.html
|
||||
static/ui.js
|
||||
|
@ -68,9 +65,9 @@ library
|
|||
, cookie >= 0.4.3 && < 0.5
|
||||
, js-jquery >= 3.3.1 && < 3.4
|
||||
, lucid >= 2.9.11 && < 2.10
|
||||
, random >= 1.1 && < 1.2
|
||||
, random >= 1.1 && < 1.3
|
||||
, servant-js >= 0.9 && < 0.10
|
||||
, time >= 1.6.0.1 && < 1.10
|
||||
, time >= 1.6.0.1 && < 1.13
|
||||
|
||||
-- For legacy tools, we need to specify build-depends too
|
||||
build-depends: markdown-unlit >= 0.5.0 && <0.6
|
||||
|
|
22
ghcjs.nix
Normal file
22
ghcjs.nix
Normal file
|
@ -0,0 +1,22 @@
|
|||
let reflex-platform = import (builtins.fetchTarball
|
||||
{ name = "reflex-platform";
|
||||
url = "https://github.com/reflex-frp/reflex-platform/archive/1aba6f367982bd6dd78ec2fda75ab246a62d32c5.tar.gz";
|
||||
}) {};
|
||||
pkgs = import ./nix/nixpkgs.nix; in
|
||||
|
||||
pkgs.stdenv.mkDerivation {
|
||||
name = "ghcjs-shell";
|
||||
buildInputs =
|
||||
[ (reflex-platform.ghcjs.ghcWithPackages (p: with p; [
|
||||
attoparsec
|
||||
hashable
|
||||
]))
|
||||
pkgs.cabal-install
|
||||
pkgs.gmp
|
||||
pkgs.haskellPackages.cabal-plan
|
||||
pkgs.haskellPackages.hspec-discover
|
||||
pkgs.nodejs
|
||||
pkgs.perl
|
||||
pkgs.zlib
|
||||
];
|
||||
}
|
|
@ -21,3 +21,21 @@ a particular ghc version, e.g:
|
|||
``` sh
|
||||
$ nix-shell nix/shell.nix --argstr compiler ghcHEAD
|
||||
```
|
||||
|
||||
**Possible GHC versions**
|
||||
- `ghc865Binary`
|
||||
- `ghc884`
|
||||
- `ghc8104` - default
|
||||
- `ghc901`
|
||||
|
||||
### Cabal users
|
||||
|
||||
GHC version can be chosen via the nix-shell parameter
|
||||
|
||||
`cabal build all`
|
||||
|
||||
### Stack version
|
||||
|
||||
Since the ghc version is set by the LTS version, it is preferable to use the `ghc8104` version parameter for the nix-shell.
|
||||
|
||||
`stack --no-nix --system-ghc <command>`
|
4
nix/nixpkgs.json
Normal file
4
nix/nixpkgs.json
Normal file
|
@ -0,0 +1,4 @@
|
|||
{
|
||||
"rev" : "05f0934825c2a0750d4888c4735f9420c906b388",
|
||||
"sha256" : "1g8c2w0661qn89ajp44znmwfmghbbiygvdzq0rzlvlpdiz28v6gy"
|
||||
}
|
4
nix/nixpkgs.nix
Normal file
4
nix/nixpkgs.nix
Normal file
|
@ -0,0 +1,4 @@
|
|||
import (builtins.fetchTarball {
|
||||
url = "https://github.com/NixOS/nixpkgs/archive/refs/tags/21.05.tar.gz";
|
||||
sha256 = "sha256:1ckzhh24mgz6jd1xhfgx0i9mijk6xjqxwsshnvq789xsavrmsc36";
|
||||
}) {}
|
|
@ -1,21 +1,20 @@
|
|||
{ pkgs ? import <nixpkgs> {}
|
||||
, compiler ? "ghc822"
|
||||
{ compiler ? "ghc8104"
|
||||
, tutorial ? false
|
||||
, pkgs ? import ./nixpkgs.nix
|
||||
}:
|
||||
|
||||
with pkgs;
|
||||
with pkgs;
|
||||
|
||||
let
|
||||
let
|
||||
ghc = haskell.packages.${compiler}.ghcWithPackages (_: []);
|
||||
docstuffs = python3.withPackages (ps: with ps; [ recommonmark sphinx sphinx_rtd_theme ]);
|
||||
in
|
||||
|
||||
stdenv.mkDerivation {
|
||||
in
|
||||
stdenv.mkDerivation {
|
||||
name = "servant-dev";
|
||||
buildInputs = [ ghc zlib python3 wget ]
|
||||
buildInputs = [ ghc zlib python3 wget cabal-install postgresql openssl stack haskellPackages.hspec-discover ]
|
||||
++ (if tutorial then [docstuffs postgresql] else []);
|
||||
shellHook = ''
|
||||
eval $(grep export ${ghc}/bin/ghc)
|
||||
export LD_LIBRARY_PATH="${zlib}/lib";
|
||||
export LD_LIBRARY_PATH=$LD_LIBRARY_PATH:"${zlib}/lib";
|
||||
'';
|
||||
}
|
||||
}
|
||||
|
|
1
servant-auth/README.md
Symbolic link
1
servant-auth/README.md
Symbolic link
|
@ -0,0 +1 @@
|
|||
servant-auth-server/README.lhs
|
1
servant-auth/servant-auth-client/.ghci
Normal file
1
servant-auth/servant-auth-client/.ghci
Normal file
|
@ -0,0 +1 @@
|
|||
:set -isrc -itest -idoctest/ghci-wrapper/src
|
26
servant-auth/servant-auth-client/CHANGELOG.md
Normal file
26
servant-auth/servant-auth-client/CHANGELOG.md
Normal file
|
@ -0,0 +1,26 @@
|
|||
# Changelog
|
||||
|
||||
All notable changes to this project will be documented in this file.
|
||||
|
||||
The format is based on [Keep a Changelog](http://keepachangelog.com/en/1.0.0/)
|
||||
and this project adheres to [PVP Versioning](https://pvp.haskell.org/).
|
||||
|
||||
## [Unreleased]
|
||||
|
||||
## [0.4.1.0] - 2020-10-06
|
||||
|
||||
- Support generic Bearer token auth
|
||||
|
||||
## [0.4.0.0] - 2019-03-08
|
||||
|
||||
## Changed
|
||||
|
||||
- #145 Support servant-0.16 in tests @domenkozar
|
||||
- #145 Drop GHC 7.10 support @domenkozar
|
||||
|
||||
## [0.3.3.0] - 2018-06-18
|
||||
|
||||
### Added
|
||||
- Support for GHC 8.4 by @phadej
|
||||
- Support for servant-0.14 by @phadej
|
||||
- Changelog by @domenkozar
|
31
servant-auth/servant-auth-client/LICENSE
Normal file
31
servant-auth/servant-auth-client/LICENSE
Normal file
|
@ -0,0 +1,31 @@
|
|||
Copyright Julian K. Arni (c) 2015
|
||||
|
||||
All rights reserved.
|
||||
|
||||
Redistribution and use in source and binary forms, with or without
|
||||
modification, are permitted provided that the following conditions are met:
|
||||
|
||||
* Redistributions of source code must retain the above copyright
|
||||
notice, this list of conditions and the following disclaimer.
|
||||
|
||||
* Redistributions in binary form must reproduce the above
|
||||
copyright notice, this list of conditions and the following
|
||||
disclaimer in the documentation and/or other materials provided
|
||||
with the distribution.
|
||||
|
||||
* Neither the name of Julian K. Arni nor the names of other
|
||||
contributors may be used to endorse or promote products derived
|
||||
from this software without specific prior written permission.
|
||||
|
||||
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||
"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
|
||||
LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
|
||||
A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
|
||||
OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
|
||||
SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
|
||||
LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
|
||||
DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
|
||||
THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
|
||||
(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
|
||||
OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
|
||||
|
2
servant-auth/servant-auth-client/Setup.hs
Normal file
2
servant-auth/servant-auth-client/Setup.hs
Normal file
|
@ -0,0 +1,2 @@
|
|||
import Distribution.Simple
|
||||
main = defaultMain
|
80
servant-auth/servant-auth-client/servant-auth-client.cabal
Normal file
80
servant-auth/servant-auth-client/servant-auth-client.cabal
Normal file
|
@ -0,0 +1,80 @@
|
|||
name: servant-auth-client
|
||||
version: 0.4.1.0
|
||||
synopsis: servant-client/servant-auth compatibility
|
||||
description: This package provides instances that allow generating clients from
|
||||
<https://hackage.haskell.org/package/servant servant>
|
||||
APIs that use
|
||||
<https://hackage.haskell.org/package/servant-auth servant-auth's> @Auth@ combinator.
|
||||
.
|
||||
For a quick overview of the usage, see the <http://github.com/haskell-servant/servant/servant-auth#readme README>.
|
||||
category: Web, Servant, Authentication
|
||||
homepage: http://github.com/haskell-servant/servant/servant-auth#readme
|
||||
bug-reports: https://github.com/haskell-servant/servant/issues
|
||||
author: Julian K. Arni
|
||||
maintainer: jkarni@gmail.com
|
||||
copyright: (c) Julian K. Arni
|
||||
license: BSD-3-Clause
|
||||
license-file: LICENSE
|
||||
tested-with: GHC ==8.6.5 || ==8.8.4 || ==8.10.4 || ==9.0.1
|
||||
build-type: Simple
|
||||
cabal-version: >= 1.10
|
||||
extra-source-files:
|
||||
CHANGELOG.md
|
||||
|
||||
source-repository head
|
||||
type: git
|
||||
location: https://github.com/haskell-servant/servant
|
||||
|
||||
library
|
||||
hs-source-dirs:
|
||||
src
|
||||
default-extensions: ConstraintKinds DataKinds DefaultSignatures DeriveFoldable DeriveFunctor DeriveGeneric DeriveTraversable FlexibleContexts FlexibleInstances FunctionalDependencies GADTs KindSignatures MultiParamTypeClasses OverloadedStrings RankNTypes ScopedTypeVariables TypeFamilies TypeOperators
|
||||
ghc-options: -Wall
|
||||
build-depends:
|
||||
base >= 4.10 && < 4.16
|
||||
, bytestring >= 0.10.6.0 && < 0.11
|
||||
, containers >= 0.5.6.2 && < 0.7
|
||||
, servant-auth == 0.4.*
|
||||
, servant >= 0.13 && < 0.19
|
||||
, servant-client-core >= 0.13 && < 0.19
|
||||
|
||||
exposed-modules:
|
||||
Servant.Auth.Client
|
||||
Servant.Auth.Client.Internal
|
||||
default-language: Haskell2010
|
||||
|
||||
test-suite spec
|
||||
type: exitcode-stdio-1.0
|
||||
main-is: Spec.hs
|
||||
hs-source-dirs:
|
||||
test
|
||||
default-extensions: ConstraintKinds DataKinds DefaultSignatures DeriveFoldable DeriveFunctor DeriveGeneric DeriveTraversable FlexibleContexts FlexibleInstances FunctionalDependencies GADTs KindSignatures MultiParamTypeClasses OverloadedStrings RankNTypes ScopedTypeVariables TypeFamilies TypeOperators
|
||||
ghc-options: -Wall
|
||||
build-tool-depends: hspec-discover:hspec-discover >=2.5.5 && <2.9
|
||||
|
||||
-- dependencies with bounds inherited from the library stanza
|
||||
build-depends:
|
||||
base
|
||||
, servant-client
|
||||
, servant-auth
|
||||
, servant
|
||||
, servant-auth-client
|
||||
|
||||
-- test dependencies
|
||||
build-depends:
|
||||
hspec >= 2.5.5 && < 2.9
|
||||
, QuickCheck >= 2.11.3 && < 2.15
|
||||
, aeson >= 1.3.1.1 && < 1.6
|
||||
, bytestring >= 0.10.6.0 && < 0.11
|
||||
, http-client >= 0.5.13.1 && < 0.8
|
||||
, http-types >= 0.12.2 && < 0.13
|
||||
, servant-auth-server >= 0.4.2.0 && < 0.5
|
||||
, servant-server >= 0.13 && < 0.19
|
||||
, time >= 1.5.0.1 && < 1.13
|
||||
, transformers >= 0.4.2.0 && < 0.6
|
||||
, wai >= 3.2.1.2 && < 3.3
|
||||
, warp >= 3.2.25 && < 3.4
|
||||
, jose >= 0.7.0.0 && < 0.9
|
||||
other-modules:
|
||||
Servant.Auth.ClientSpec
|
||||
default-language: Haskell2010
|
|
@ -0,0 +1,3 @@
|
|||
module Servant.Auth.Client (Token(..), Bearer) where
|
||||
|
||||
import Servant.Auth.Client.Internal (Bearer, Token(..))
|
|
@ -0,0 +1,64 @@
|
|||
{-# LANGUAGE CPP #-}
|
||||
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
|
||||
{-# LANGUAGE UndecidableInstances #-}
|
||||
{-# OPTIONS_GHC -fno-warn-orphans #-}
|
||||
#if __GLASGOW_HASKELL__ == 800
|
||||
{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}
|
||||
#endif
|
||||
module Servant.Auth.Client.Internal where
|
||||
|
||||
import qualified Data.ByteString as BS
|
||||
import Data.Monoid
|
||||
import Data.Proxy (Proxy (..))
|
||||
import Data.String (IsString)
|
||||
import GHC.Exts (Constraint)
|
||||
import GHC.Generics (Generic)
|
||||
import Servant.API ((:>))
|
||||
import Servant.Auth
|
||||
|
||||
import Servant.Client.Core
|
||||
import Data.Sequence ((<|))
|
||||
|
||||
-- | A simple bearer token.
|
||||
newtype Token = Token { getToken :: BS.ByteString }
|
||||
deriving (Eq, Show, Read, Generic, IsString)
|
||||
|
||||
type family HasBearer xs :: Constraint where
|
||||
HasBearer (Bearer ': xs) = ()
|
||||
HasBearer (JWT ': xs) = ()
|
||||
HasBearer (x ': xs) = HasBearer xs
|
||||
HasBearer '[] = BearerAuthNotEnabled
|
||||
|
||||
class BearerAuthNotEnabled
|
||||
|
||||
-- | @'HasBearer' auths@ is nominally a redundant constraint, but ensures we're not
|
||||
-- trying to send a token to an API that doesn't accept them.
|
||||
instance (HasBearer auths, HasClient m api) => HasClient m (Auth auths a :> api) where
|
||||
type Client m (Auth auths a :> api) = Token -> Client m api
|
||||
|
||||
clientWithRoute m _ req (Token token)
|
||||
= clientWithRoute m (Proxy :: Proxy api)
|
||||
$ req { requestHeaders = ("Authorization", headerVal) <| requestHeaders req }
|
||||
where
|
||||
headerVal = "Bearer " <> token
|
||||
|
||||
#if MIN_VERSION_servant_client_core(0,14,0)
|
||||
hoistClientMonad pm _ nt cl = hoistClientMonad pm (Proxy :: Proxy api) nt . cl
|
||||
#endif
|
||||
|
||||
|
||||
-- * Authentication combinators
|
||||
|
||||
-- | A Bearer token in the Authorization header:
|
||||
--
|
||||
-- @Authorization: Bearer <token>@
|
||||
--
|
||||
-- This can be any token recognized by the server, for example,
|
||||
-- a JSON Web Token (JWT).
|
||||
--
|
||||
-- Note that, since the exact way the token is validated is not specified,
|
||||
-- this combinator can only be used in the client. The server would not know
|
||||
-- how to validate it, while the client does not care.
|
||||
-- If you want to implement Bearer authentication in your server, you have to
|
||||
-- choose a specific combinator, such as 'JWT'.
|
||||
data Bearer
|
161
servant-auth/servant-auth-client/test/Servant/Auth/ClientSpec.hs
Normal file
161
servant-auth/servant-auth-client/test/Servant/Auth/ClientSpec.hs
Normal file
|
@ -0,0 +1,161 @@
|
|||
{-# LANGUAGE CPP #-}
|
||||
{-# LANGUAGE DeriveAnyClass #-}
|
||||
module Servant.Auth.ClientSpec (spec) where
|
||||
|
||||
import Crypto.JOSE (JWK,
|
||||
KeyMaterialGenParam (OctGenParam),
|
||||
genJWK)
|
||||
import Data.Aeson (FromJSON (..), ToJSON (..))
|
||||
import qualified Data.ByteString.Lazy as BSL
|
||||
import Data.Time (UTCTime, defaultTimeLocale,
|
||||
parseTimeOrError)
|
||||
import GHC.Generics (Generic)
|
||||
import Network.HTTP.Client (Manager, defaultManagerSettings,
|
||||
newManager)
|
||||
import Network.HTTP.Types (status401)
|
||||
import Network.Wai.Handler.Warp (testWithApplication)
|
||||
import Servant
|
||||
import Servant.Client (BaseUrl (..), Scheme (Http),
|
||||
ClientError (FailureResponse),
|
||||
#if MIN_VERSION_servant_client(0,16,0)
|
||||
ResponseF(..),
|
||||
#elif MIN_VERSION_servant_client(0,13,0)
|
||||
GenResponse(..),
|
||||
#elif MIN_VERSION_servant_client(0,12,0)
|
||||
Response(..),
|
||||
#endif
|
||||
client)
|
||||
import System.IO.Unsafe (unsafePerformIO)
|
||||
import Test.Hspec
|
||||
import Test.QuickCheck
|
||||
|
||||
#if MIN_VERSION_servant_client(0,13,0)
|
||||
import Servant.Client (mkClientEnv, runClientM)
|
||||
#elif MIN_VERSION_servant_client(0,9,0)
|
||||
import Servant.Client (ClientEnv (..), runClientM)
|
||||
#else
|
||||
import Control.Monad.Trans.Except (runExceptT)
|
||||
#endif
|
||||
#if !MIN_VERSION_servant_server(0,16,0)
|
||||
#define ClientError ServantError
|
||||
#endif
|
||||
|
||||
import Servant.Auth.Client
|
||||
import Servant.Auth.Server
|
||||
import Servant.Auth.Server.SetCookieOrphan ()
|
||||
|
||||
spec :: Spec
|
||||
spec = describe "The JWT combinator" $ do
|
||||
hasClientSpec
|
||||
|
||||
|
||||
------------------------------------------------------------------------------
|
||||
-- * HasClient {{{
|
||||
|
||||
hasClientSpec :: Spec
|
||||
hasClientSpec = describe "HasClient" $ around (testWithApplication $ return app) $ do
|
||||
|
||||
let mkTok :: User -> Maybe UTCTime -> IO Token
|
||||
mkTok user mexp = do
|
||||
Right tok <- makeJWT user jwtCfg mexp
|
||||
return $ Token $ BSL.toStrict tok
|
||||
|
||||
it "succeeds when the token does not have expiry" $ \port -> property $ \user -> do
|
||||
tok <- mkTok user Nothing
|
||||
v <- getIntClient tok mgr (BaseUrl Http "localhost" port "")
|
||||
v `shouldBe` Right (length $ name user)
|
||||
|
||||
it "succeeds when the token is not expired" $ \port -> property $ \user -> do
|
||||
tok <- mkTok user (Just future)
|
||||
v <- getIntClient tok mgr (BaseUrl Http "localhost" port "")
|
||||
v `shouldBe` Right (length $ name user)
|
||||
|
||||
it "fails when token is expired" $ \port -> property $ \user -> do
|
||||
tok <- mkTok user (Just past)
|
||||
#if MIN_VERSION_servant_client(0,16,0)
|
||||
Left (FailureResponse _ (Response stat _ _ _))
|
||||
#elif MIN_VERSION_servant_client(0,12,0)
|
||||
Left (FailureResponse (Response stat _ _ _))
|
||||
#elif MIN_VERSION_servant_client(0,11,0)
|
||||
Left (FailureResponse _ stat _ _)
|
||||
#else
|
||||
Left (FailureResponse stat _ _)
|
||||
#endif
|
||||
<- getIntClient tok mgr (BaseUrl Http "localhost" port "")
|
||||
stat `shouldBe` status401
|
||||
|
||||
|
||||
getIntClient :: Token -> Manager -> BaseUrl -> IO (Either ClientError Int)
|
||||
#if MIN_VERSION_servant(0,13,0)
|
||||
getIntClient tok m burl = runClientM (client api tok) (mkClientEnv m burl)
|
||||
#elif MIN_VERSION_servant(0,9,0)
|
||||
getIntClient tok m burl = runClientM (client api tok) (ClientEnv m burl)
|
||||
#else
|
||||
getIntClient tok m burl = runExceptT $ client api tok m burl
|
||||
#endif
|
||||
-- }}}
|
||||
------------------------------------------------------------------------------
|
||||
-- * API and Server {{{
|
||||
|
||||
type API = Auth '[JWT] User :> Get '[JSON] Int
|
||||
|
||||
api :: Proxy API
|
||||
api = Proxy
|
||||
|
||||
theKey :: JWK
|
||||
theKey = unsafePerformIO . genJWK $ OctGenParam 256
|
||||
{-# NOINLINE theKey #-}
|
||||
|
||||
mgr :: Manager
|
||||
mgr = unsafePerformIO $ newManager defaultManagerSettings
|
||||
{-# NOINLINE mgr #-}
|
||||
|
||||
app :: Application
|
||||
app = serveWithContext api ctx server
|
||||
where
|
||||
ctx = cookieCfg :. jwtCfg :. EmptyContext
|
||||
|
||||
jwtCfg :: JWTSettings
|
||||
jwtCfg = defaultJWTSettings theKey
|
||||
|
||||
cookieCfg :: CookieSettings
|
||||
cookieCfg = defaultCookieSettings
|
||||
|
||||
|
||||
server :: Server API
|
||||
server = getInt
|
||||
where
|
||||
getInt :: AuthResult User -> Handler Int
|
||||
getInt (Authenticated u) = return . length $ name u
|
||||
getInt _ = throwAll err401
|
||||
|
||||
|
||||
-- }}}
|
||||
------------------------------------------------------------------------------
|
||||
-- * Utils {{{
|
||||
|
||||
past :: UTCTime
|
||||
past = parseTimeOrError True defaultTimeLocale "%Y-%m-%d" "1970-01-01"
|
||||
|
||||
future :: UTCTime
|
||||
future = parseTimeOrError True defaultTimeLocale "%Y-%m-%d" "2070-01-01"
|
||||
|
||||
|
||||
-- }}}
|
||||
------------------------------------------------------------------------------
|
||||
-- * Types {{{
|
||||
|
||||
data User = User
|
||||
{ name :: String
|
||||
, _id :: String
|
||||
} deriving (Eq, Show, Read, Generic)
|
||||
|
||||
instance FromJWT User
|
||||
instance ToJWT User
|
||||
instance FromJSON User
|
||||
instance ToJSON User
|
||||
|
||||
instance Arbitrary User where
|
||||
arbitrary = User <$> arbitrary <*> arbitrary
|
||||
|
||||
-- }}}
|
1
servant-auth/servant-auth-client/test/Spec.hs
Normal file
1
servant-auth/servant-auth-client/test/Spec.hs
Normal file
|
@ -0,0 +1 @@
|
|||
{-# OPTIONS_GHC -F -pgmF hspec-discover #-}
|
1
servant-auth/servant-auth-docs/.ghci
Normal file
1
servant-auth/servant-auth-docs/.ghci
Normal file
|
@ -0,0 +1 @@
|
|||
:set -isrc -itest -idoctest/ghci-wrapper/src
|
14
servant-auth/servant-auth-docs/CHANGELOG.md
Normal file
14
servant-auth/servant-auth-docs/CHANGELOG.md
Normal file
|
@ -0,0 +1,14 @@
|
|||
# Changelog
|
||||
|
||||
All notable changes to this project will be documented in this file.
|
||||
|
||||
The format is based on [Keep a Changelog](http://keepachangelog.com/en/1.0.0/)
|
||||
and this project adheres to [PVP Versioning](https://pvp.haskell.org/).
|
||||
|
||||
## [Unreleased]
|
||||
|
||||
## [0.2.10.0] - 2018-06-18
|
||||
|
||||
### Added
|
||||
- Support for GHC 8.4 by @phadej
|
||||
- Changelog by @domenkozar
|
31
servant-auth/servant-auth-docs/LICENSE
Normal file
31
servant-auth/servant-auth-docs/LICENSE
Normal file
|
@ -0,0 +1,31 @@
|
|||
Copyright Julian K. Arni (c) 2015
|
||||
|
||||
All rights reserved.
|
||||
|
||||
Redistribution and use in source and binary forms, with or without
|
||||
modification, are permitted provided that the following conditions are met:
|
||||
|
||||
* Redistributions of source code must retain the above copyright
|
||||
notice, this list of conditions and the following disclaimer.
|
||||
|
||||
* Redistributions in binary form must reproduce the above
|
||||
copyright notice, this list of conditions and the following
|
||||
disclaimer in the documentation and/or other materials provided
|
||||
with the distribution.
|
||||
|
||||
* Neither the name of Julian K. Arni nor the names of other
|
||||
contributors may be used to endorse or promote products derived
|
||||
from this software without specific prior written permission.
|
||||
|
||||
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||
"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
|
||||
LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
|
||||
A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
|
||||
OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
|
||||
SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
|
||||
LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
|
||||
DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
|
||||
THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
|
||||
(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
|
||||
OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
|
||||
|
33
servant-auth/servant-auth-docs/Setup.hs
Normal file
33
servant-auth/servant-auth-docs/Setup.hs
Normal file
|
@ -0,0 +1,33 @@
|
|||
{-# LANGUAGE CPP #-}
|
||||
{-# OPTIONS_GHC -Wall #-}
|
||||
module Main (main) where
|
||||
|
||||
#ifndef MIN_VERSION_cabal_doctest
|
||||
#define MIN_VERSION_cabal_doctest(x,y,z) 0
|
||||
#endif
|
||||
|
||||
#if MIN_VERSION_cabal_doctest(1,0,0)
|
||||
|
||||
import Distribution.Extra.Doctest ( defaultMainWithDoctests )
|
||||
main :: IO ()
|
||||
main = defaultMainWithDoctests "doctests"
|
||||
|
||||
#else
|
||||
|
||||
#ifdef MIN_VERSION_Cabal
|
||||
-- If the macro is defined, we have new cabal-install,
|
||||
-- but for some reason we don't have cabal-doctest in package-db
|
||||
--
|
||||
-- Probably we are running cabal sdist, when otherwise using new-build
|
||||
-- workflow
|
||||
#warning You are configuring this package without cabal-doctest installed. \
|
||||
The doctests test-suite will not work as a result. \
|
||||
To fix this, install cabal-doctest before configuring.
|
||||
#endif
|
||||
|
||||
import Distribution.Simple
|
||||
|
||||
main :: IO ()
|
||||
main = defaultMain
|
||||
|
||||
#endif
|
84
servant-auth/servant-auth-docs/servant-auth-docs.cabal
Normal file
84
servant-auth/servant-auth-docs/servant-auth-docs.cabal
Normal file
|
@ -0,0 +1,84 @@
|
|||
name: servant-auth-docs
|
||||
version: 0.2.10.0
|
||||
synopsis: servant-docs/servant-auth compatibility
|
||||
description: This package provides instances that allow generating docs from
|
||||
<https://hackage.haskell.org/package/servant servant>
|
||||
APIs that use
|
||||
<https://hackage.haskell.org/package/servant-auth servant-auth's> @Auth@ combinator.
|
||||
.
|
||||
For a quick overview of the usage, see the <http://github.com/haskell-servant/servant/servant-auth#readme README>.
|
||||
category: Web, Servant, Authentication
|
||||
homepage: http://github.com/haskell-servant/servant/servant-auth#readme
|
||||
bug-reports: https://github.com/haskell-servant/servant/issues
|
||||
author: Julian K. Arni
|
||||
maintainer: jkarni@gmail.com
|
||||
copyright: (c) Julian K. Arni
|
||||
license: BSD-3-Clause
|
||||
license-file: LICENSE
|
||||
tested-with: GHC ==8.6.5 || ==8.8.4 || ==8.10.4 || ==9.0.1
|
||||
build-type: Custom
|
||||
cabal-version: >= 1.10
|
||||
extra-source-files:
|
||||
CHANGELOG.md
|
||||
|
||||
custom-setup
|
||||
setup-depends:
|
||||
base, Cabal, cabal-doctest >=1.0.6 && <1.1
|
||||
|
||||
source-repository head
|
||||
type: git
|
||||
location: https://github.com/haskell-servant/servant
|
||||
|
||||
library
|
||||
hs-source-dirs:
|
||||
src
|
||||
default-extensions: ConstraintKinds DataKinds DefaultSignatures DeriveFoldable DeriveFunctor DeriveGeneric DeriveTraversable FlexibleContexts FlexibleInstances FunctionalDependencies GADTs KindSignatures MultiParamTypeClasses OverloadedStrings RankNTypes ScopedTypeVariables TypeFamilies TypeOperators
|
||||
ghc-options: -Wall
|
||||
build-depends:
|
||||
base >= 4.10 && < 4.16
|
||||
, servant-docs >= 0.11.2 && < 0.12
|
||||
, servant >= 0.13 && < 0.19
|
||||
, servant-auth == 0.4.*
|
||||
, lens >= 4.16.1 && <5.1
|
||||
exposed-modules:
|
||||
Servant.Auth.Docs
|
||||
default-language: Haskell2010
|
||||
|
||||
test-suite doctests
|
||||
type: exitcode-stdio-1.0
|
||||
main-is: doctests.hs
|
||||
build-depends:
|
||||
base,
|
||||
servant-auth-docs,
|
||||
doctest >= 0.16 && < 0.19,
|
||||
QuickCheck >= 2.11.3 && < 2.15,
|
||||
template-haskell
|
||||
ghc-options: -Wall -threaded
|
||||
hs-source-dirs: test
|
||||
default-language: Haskell2010
|
||||
|
||||
test-suite spec
|
||||
type: exitcode-stdio-1.0
|
||||
main-is: Spec.hs
|
||||
hs-source-dirs:
|
||||
test
|
||||
default-extensions: ConstraintKinds DataKinds DefaultSignatures DeriveFoldable DeriveFunctor DeriveGeneric DeriveTraversable FlexibleContexts FlexibleInstances FunctionalDependencies GADTs KindSignatures MultiParamTypeClasses OverloadedStrings RankNTypes ScopedTypeVariables TypeFamilies TypeOperators
|
||||
ghc-options: -Wall
|
||||
build-tool-depends: hspec-discover:hspec-discover >=2.5.5 && <2.9
|
||||
|
||||
-- dependencies with bounds inherited from the library stanza
|
||||
build-depends:
|
||||
base
|
||||
, text
|
||||
, servant-docs
|
||||
, servant
|
||||
, servant-auth
|
||||
, lens
|
||||
|
||||
-- test dependencies
|
||||
build-depends:
|
||||
servant-auth-docs
|
||||
, hspec >= 2.5.5 && < 2.9
|
||||
, QuickCheck >= 2.11.3 && < 2.15
|
||||
|
||||
default-language: Haskell2010
|
96
servant-auth/servant-auth-docs/src/Servant/Auth/Docs.hs
Normal file
96
servant-auth/servant-auth-docs/src/Servant/Auth/Docs.hs
Normal file
|
@ -0,0 +1,96 @@
|
|||
{-# OPTIONS_GHC -fno-warn-orphans #-}
|
||||
module Servant.Auth.Docs
|
||||
(
|
||||
-- | The purpose of this package is provide the instance for 'servant-auth'
|
||||
-- combinators needed for 'servant-docs' documentation generation.
|
||||
--
|
||||
-- >>> type API = Auth '[JWT, Cookie, BasicAuth] Int :> Get '[JSON] Int
|
||||
-- >>> putStr $ markdown $ docs (Proxy :: Proxy API)
|
||||
-- ## GET /
|
||||
-- ...
|
||||
-- ... Authentication
|
||||
-- ...
|
||||
-- This part of the API is protected by the following authentication mechanisms:
|
||||
-- ...
|
||||
-- * JSON Web Tokens ([JWTs](https://en.wikipedia.org/wiki/JSON_Web_Token))
|
||||
-- * [Cookies](https://en.wikipedia.org/wiki/HTTP_cookie)
|
||||
-- * [Basic Authentication](https://en.wikipedia.org/wiki/Basic_access_authentication)
|
||||
-- ...
|
||||
-- Clients must supply the following data
|
||||
-- ...
|
||||
-- One of the following:
|
||||
-- ...
|
||||
-- * A JWT Token signed with this server's key
|
||||
-- * Cookies automatically set by browsers, plus a header
|
||||
-- * Cookies automatically set by browsers, plus a header
|
||||
-- ...
|
||||
|
||||
-- * Re-export
|
||||
JWT
|
||||
, BasicAuth
|
||||
, Cookie
|
||||
, Auth
|
||||
) where
|
||||
|
||||
import Control.Lens ((%~), (&), (|>))
|
||||
import Data.List (intercalate)
|
||||
import Data.Monoid
|
||||
import Data.Proxy (Proxy (Proxy))
|
||||
import Servant.API hiding (BasicAuth)
|
||||
import Servant.Auth
|
||||
import Servant.Docs hiding (pretty)
|
||||
import Servant.Docs.Internal (DocAuthentication (..), authInfo)
|
||||
|
||||
instance (AllDocs auths, HasDocs api) => HasDocs (Auth auths r :> api) where
|
||||
docsFor _ (endpoint, action) =
|
||||
docsFor (Proxy :: Proxy api) (endpoint, action & authInfo %~ (|> info))
|
||||
where
|
||||
(intro, reqData) = pretty $ allDocs (Proxy :: Proxy auths)
|
||||
info = DocAuthentication intro reqData
|
||||
|
||||
|
||||
pretty :: [(String, String)] -> (String, String)
|
||||
pretty [] = error "shouldn't happen"
|
||||
pretty [(i, d)] =
|
||||
( "This part of the API is protected by " <> i
|
||||
, d
|
||||
)
|
||||
pretty rs =
|
||||
( "This part of the API is protected by the following authentication mechanisms:\n\n"
|
||||
++ " * " <> intercalate "\n * " (fst <$> rs)
|
||||
, "\nOne of the following:\n\n"
|
||||
++ " * " <> intercalate "\n * " (snd <$> rs)
|
||||
)
|
||||
|
||||
|
||||
class AllDocs (x :: [*]) where
|
||||
allDocs :: proxy x
|
||||
-- intro, req
|
||||
-> [(String, String)]
|
||||
|
||||
instance (OneDoc a, AllDocs as) => AllDocs (a ': as) where
|
||||
allDocs _ = oneDoc (Proxy :: Proxy a) : allDocs (Proxy :: Proxy as)
|
||||
|
||||
instance AllDocs '[] where
|
||||
allDocs _ = []
|
||||
|
||||
class OneDoc a where
|
||||
oneDoc :: proxy a -> (String, String)
|
||||
|
||||
instance OneDoc JWT where
|
||||
oneDoc _ =
|
||||
("JSON Web Tokens ([JWTs](https://en.wikipedia.org/wiki/JSON_Web_Token))"
|
||||
, "A JWT Token signed with this server's key")
|
||||
|
||||
instance OneDoc Cookie where
|
||||
oneDoc _ =
|
||||
("[Cookies](https://en.wikipedia.org/wiki/HTTP_cookie)"
|
||||
, "Cookies automatically set by browsers, plus a header")
|
||||
|
||||
instance OneDoc BasicAuth where
|
||||
oneDoc _ =
|
||||
( "[Basic Authentication](https://en.wikipedia.org/wiki/Basic_access_authentication)"
|
||||
, "Cookies automatically set by browsers, plus a header")
|
||||
|
||||
-- $setup
|
||||
-- >>> instance ToSample Int where toSamples _ = singleSample 1729
|
1
servant-auth/servant-auth-docs/test/Spec.hs
Normal file
1
servant-auth/servant-auth-docs/test/Spec.hs
Normal file
|
@ -0,0 +1 @@
|
|||
{-# OPTIONS_GHC -F -pgmF hspec-discover #-}
|
Some files were not shown because too many files have changed in this diff Show more
Loading…
Reference in a new issue