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
|
# 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
|
patreon: # Replace with a single Patreon username
|
||||||
open_collective: # Replace with a single Open Collective username
|
open_collective: # Replace with a single Open Collective username
|
||||||
ko_fi: # Replace with a single Ko-fi 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
|
||||||
|
*~
|
||||||
dist-*
|
dist-*
|
||||||
.ghc.environment.*
|
.ghc.environment.*
|
||||||
/bin
|
/bin
|
||||||
|
@ -29,6 +30,10 @@ doc/_build
|
||||||
doc/venv
|
doc/venv
|
||||||
doc/tutorial/static/api.js
|
doc/tutorial/static/api.js
|
||||||
doc/tutorial/static/jq.js
|
doc/tutorial/static/jq.js
|
||||||
|
shell.nix
|
||||||
|
|
||||||
|
# nix
|
||||||
|
result*
|
||||||
|
|
||||||
# local versions of things
|
# local versions of things
|
||||||
servant-multipart
|
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
|
## 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
|
what you contribute from Hackage fairly soon. However, note that prior to major
|
||||||
releases it may take some time in between releases.
|
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'
|
to write your first servant webservices, learning the rest from the haddocks'
|
||||||
examples.
|
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
|
Other blog posts, videos and slides can be found on the
|
||||||
[website](http://www.servant.dev/).
|
[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).
|
list](https://groups.google.com/forum/#!forum/haskell-servant).
|
||||||
|
|
||||||
## Contributing
|
## Contributing
|
||||||
|
@ -32,7 +32,7 @@ See `CONTRIBUTING.md`
|
||||||
- It's a good idea to separate these steps, as tests often pass, if they compile :)
|
- It's a good idea to separate these steps, as tests often pass, if they compile :)
|
||||||
- See `cabal.project` to selectively `allow-newer`
|
- See `cabal.project` to selectively `allow-newer`
|
||||||
- If some packages are broken, on your discretisation there are two options:
|
- 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
|
- 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
|
- 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:
|
- When ripples are cleared out:
|
||||||
|
@ -40,29 +40,9 @@ See `CONTRIBUTING.md`
|
||||||
- `git push --tags`
|
- `git push --tags`
|
||||||
- `cabal sdist` and `cabal upload`
|
- `cabal sdist` and `cabal upload`
|
||||||
|
|
||||||
## travis
|
## TechEmpower framework benchmarks
|
||||||
|
|
||||||
`.travis.yml` is generated using `make-travis-yml` tool, in
|
We develop and maintain the servant TFB entry in https://github.com/haskell-servant/FrameworkBenchmarks/
|
||||||
[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/
|
|
||||||
|
|
||||||
To verify (i.e. compile and test that it works)
|
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
|
./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:
|
packages:
|
||||||
servant/
|
servant/
|
||||||
|
servant-client/
|
||||||
servant-client-core/
|
servant-client-core/
|
||||||
servant-jsaddle/
|
|
||||||
|
|
||||||
-- we need to tell cabal we are using GHCJS
|
-- we need to tell cabal we are using GHCJS
|
||||||
compiler: ghcjs
|
compiler: ghcjs
|
||||||
tests: True
|
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:
|
packages:
|
||||||
servant/
|
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/
|
||||||
servant-client-core/
|
servant-client-core/
|
||||||
servant-http-streams/
|
servant-http-streams/
|
||||||
|
@ -22,17 +28,20 @@ packages:
|
||||||
packages:
|
packages:
|
||||||
doc/cookbook/basic-auth
|
doc/cookbook/basic-auth
|
||||||
doc/cookbook/curl-mock
|
doc/cookbook/curl-mock
|
||||||
|
doc/cookbook/custom-errors
|
||||||
doc/cookbook/basic-streaming
|
doc/cookbook/basic-streaming
|
||||||
doc/cookbook/db-postgres-pool
|
doc/cookbook/db-postgres-pool
|
||||||
-- doc/cookbook/db-sqlite-simple
|
doc/cookbook/db-sqlite-simple
|
||||||
doc/cookbook/file-upload
|
doc/cookbook/file-upload
|
||||||
doc/cookbook/generic
|
doc/cookbook/generic
|
||||||
-- doc/cookbook/hoist-server-with-context
|
doc/cookbook/hoist-server-with-context
|
||||||
-- doc/cookbook/https
|
doc/cookbook/https
|
||||||
-- doc/cookbook/jwt-and-basic-auth/
|
doc/cookbook/jwt-and-basic-auth
|
||||||
doc/cookbook/pagination
|
doc/cookbook/pagination
|
||||||
-- doc/cookbook/sentry
|
-- 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/structuring-apis
|
||||||
doc/cookbook/using-custom-monad
|
doc/cookbook/using-custom-monad
|
||||||
doc/cookbook/using-free-client
|
doc/cookbook/using-free-client
|
||||||
|
@ -47,21 +56,20 @@ constraints:
|
||||||
foundation >=0.0.14,
|
foundation >=0.0.14,
|
||||||
memory <0.14.12 || >0.14.12
|
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: 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
|
-- needed for doctests
|
||||||
write-ghc-environment-files: always
|
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
|
version: 0.1
|
||||||
synopsis: Basic Authentication cookbook example
|
synopsis: Basic Authentication cookbook example
|
||||||
homepage: http://docs.servant.dev/
|
homepage: http://docs.servant.dev/
|
||||||
license: BSD3
|
license: BSD-3-Clause
|
||||||
license-file: ../../../servant/LICENSE
|
license-file: ../../../servant/LICENSE
|
||||||
author: Servant Contributors
|
author: Servant Contributors
|
||||||
maintainer: haskell-servant-maintainers@googlegroups.com
|
maintainer: haskell-servant-maintainers@googlegroups.com
|
||||||
build-type: Simple
|
build-type: Simple
|
||||||
cabal-version: >=1.10
|
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
|
executable cookbook-basic-auth
|
||||||
main-is: BasicAuth.lhs
|
main-is: BasicAuth.lhs
|
||||||
|
|
|
@ -8,7 +8,10 @@ In other words, without streaming libraries.
|
||||||
- Some basic usage doesn't require usage of streaming libraries,
|
- Some basic usage doesn't require usage of streaming libraries,
|
||||||
like `conduit`, `pipes`, `machines` or `streaming`.
|
like `conduit`, `pipes`, `machines` or `streaming`.
|
||||||
We have bindings for them though.
|
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
|
- `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).
|
things ourselves. (Note to self: `mapM` and `foldM` would be handy to have).
|
||||||
|
|
||||||
|
|
|
@ -2,13 +2,13 @@ name: cookbook-basic-streaming
|
||||||
version: 2.1
|
version: 2.1
|
||||||
synopsis: Streaming in servant without streaming libs
|
synopsis: Streaming in servant without streaming libs
|
||||||
homepage: http://docs.servant.dev/
|
homepage: http://docs.servant.dev/
|
||||||
license: BSD3
|
license: BSD-3-Clause
|
||||||
license-file: ../../../servant/LICENSE
|
license-file: ../../../servant/LICENSE
|
||||||
author: Servant Contributors
|
author: Servant Contributors
|
||||||
maintainer: haskell-servant-maintainers@googlegroups.com
|
maintainer: haskell-servant-maintainers@googlegroups.com
|
||||||
build-type: Simple
|
build-type: Simple
|
||||||
cabal-version: >=1.10
|
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
|
executable cookbook-basic-streaming
|
||||||
main-is: Streaming.lhs
|
main-is: Streaming.lhs
|
||||||
|
|
|
@ -1,7 +1,7 @@
|
||||||
# Generating mock curl calls
|
# Generating mock curl calls
|
||||||
|
|
||||||
In this example we will generate curl requests with mock post data from a servant API.
|
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.
|
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.
|
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 Control.Lens ((^.))
|
||||||
import Data.Aeson
|
import Data.Aeson
|
||||||
import Data.Aeson.Text
|
import Data.Aeson.Text
|
||||||
import Data.Monoid ((<>))
|
|
||||||
import Data.Proxy (Proxy (Proxy))
|
import Data.Proxy (Proxy (Proxy))
|
||||||
import Data.Text (Text)
|
import Data.Text (Text)
|
||||||
import Data.Text.Encoding (decodeUtf8)
|
import Data.Text.Encoding (decodeUtf8)
|
||||||
|
@ -86,7 +85,7 @@ listFromAPI :: (HasForeign lang ftype api, GenerateList ftype (Foreign ftype api
|
||||||
```
|
```
|
||||||
|
|
||||||
This looks a bit confusing...
|
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.
|
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`.
|
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 =
|
generateCurl p host =
|
||||||
fmap T.unlines body
|
fmap T.unlines body
|
||||||
where
|
where
|
||||||
body = foldr (\endp curlCalls -> mCons (generateEndpoint host endp) curlCalls) (return [])
|
body = mapM (generateEndpoint host)
|
||||||
$ listFromAPI (Proxy :: Proxy NoLang) (Proxy :: Proxy Mocked) p
|
$ listFromAPI (Proxy :: Proxy NoLang) (Proxy :: Proxy Mocked) p
|
||||||
```
|
```
|
||||||
|
|
||||||
To understand this function, better start at the end:
|
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.
|
||||||
`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:
|
|
||||||
|
|
||||||
``` haskell
|
``` haskell
|
||||||
generateEndpoint :: Text -> Req Mocked -> IO Text
|
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.
|
`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.
|
`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:
|
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
|
``` haskell
|
||||||
main :: IO ()
|
main :: IO ()
|
||||||
main =
|
main =
|
||||||
generateCurl api "localhost:8081" >>= (\v -> T.IO.putStrLn v)
|
generateCurl api "localhost:8081" >>= T.IO.putStrLn
|
||||||
```
|
```
|
||||||
|
|
||||||
Done:
|
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.
|
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.
|
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
|
version: 0.1
|
||||||
synopsis: Generate curl mock requests cookbook example
|
synopsis: Generate curl mock requests cookbook example
|
||||||
homepage: http://docs.servant.dev
|
homepage: http://docs.servant.dev
|
||||||
license: BSD3
|
license: BSD-3-Clause
|
||||||
license-file: ../../../servant/LICENSE
|
license-file: ../../../servant/LICENSE
|
||||||
author: Servant Contributors
|
author: Servant Contributors
|
||||||
maintainer: haskell-servant-maintainers@googlegroups.com
|
maintainer: haskell-servant-maintainers@googlegroups.com
|
||||||
build-type: Simple
|
build-type: Simple
|
||||||
cabal-version: >=1.10
|
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
|
executable cookbock-curl-mock
|
||||||
main-is: CurlMock.lhs
|
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.
|
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.
|
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
|
version: 0.1.0.0
|
||||||
synopsis: Simple MySQL API cookbook example
|
synopsis: Simple MySQL API cookbook example
|
||||||
homepage: http://docs.servant.dev/
|
homepage: http://docs.servant.dev/
|
||||||
license: BSD3
|
license: BSD-3-Clause
|
||||||
license-file: ../../../servant/LICENSE
|
license-file: ../../../servant/LICENSE
|
||||||
author: Servant Contributors
|
author: Servant Contributors
|
||||||
maintainer: haskell-servant-maintainers@googlegroups.com
|
maintainer: haskell-servant-maintainers@googlegroups.com
|
||||||
|
|
|
@ -2,13 +2,13 @@ name: cookbook-db-postgres-pool
|
||||||
version: 0.1
|
version: 0.1
|
||||||
synopsis: Simple PostgreSQL connection pool cookbook example
|
synopsis: Simple PostgreSQL connection pool cookbook example
|
||||||
homepage: http://docs.servant.dev/
|
homepage: http://docs.servant.dev/
|
||||||
license: BSD3
|
license: BSD-3-Clause
|
||||||
license-file: ../../../servant/LICENSE
|
license-file: ../../../servant/LICENSE
|
||||||
author: Servant Contributors
|
author: Servant Contributors
|
||||||
maintainer: haskell-servant-maintainers@googlegroups.com
|
maintainer: haskell-servant-maintainers@googlegroups.com
|
||||||
build-type: Simple
|
build-type: Simple
|
||||||
cabal-version: >=1.10
|
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
|
executable cookbook-db-postgres-pool
|
||||||
main-is: PostgresPool.lhs
|
main-is: PostgresPool.lhs
|
||||||
|
|
|
@ -2,13 +2,13 @@ name: cookbook-db-sqlite-simple
|
||||||
version: 0.1
|
version: 0.1
|
||||||
synopsis: Simple SQLite DB cookbook example
|
synopsis: Simple SQLite DB cookbook example
|
||||||
homepage: http://docs.servant.dev/
|
homepage: http://docs.servant.dev/
|
||||||
license: BSD3
|
license: BSD-3-Clause
|
||||||
license-file: ../../../servant/LICENSE
|
license-file: ../../../servant/LICENSE
|
||||||
author: Servant Contributors
|
author: Servant Contributors
|
||||||
maintainer: haskell-servant-maintainers@googlegroups.com
|
maintainer: haskell-servant-maintainers@googlegroups.com
|
||||||
build-type: Simple
|
build-type: Simple
|
||||||
cabal-version: >=1.10
|
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
|
executable cookbook-db-sqlite-simple
|
||||||
main-is: DBConnection.lhs
|
main-is: DBConnection.lhs
|
||||||
|
@ -23,7 +23,7 @@ executable cookbook-db-sqlite-simple
|
||||||
, http-types >= 0.12
|
, http-types >= 0.12
|
||||||
, markdown-unlit >= 0.4
|
, markdown-unlit >= 0.4
|
||||||
, http-client >= 0.5
|
, http-client >= 0.5
|
||||||
, sqlite-simple >= 0.4
|
, sqlite-simple >= 0.4.5.0
|
||||||
, transformers
|
, transformers
|
||||||
default-language: Haskell2010
|
default-language: Haskell2010
|
||||||
ghc-options: -Wall -pgmL markdown-unlit
|
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
|
Finally, a main function that brings up our server and
|
||||||
sends some test request with `http-client` (and not
|
sends some test request with `http-client` (and not
|
||||||
servant-client this time, has servant-multipart does not
|
servant-client this time, as servant-multipart does not
|
||||||
yet have support for client generation.
|
yet have support for client generation).
|
||||||
|
|
||||||
``` haskell
|
``` haskell
|
||||||
main :: IO ()
|
main :: IO ()
|
||||||
|
|
|
@ -2,13 +2,13 @@ name: cookbook-file-upload
|
||||||
version: 0.1
|
version: 0.1
|
||||||
synopsis: File upload cookbook example
|
synopsis: File upload cookbook example
|
||||||
homepage: http://docs.servant.dev/
|
homepage: http://docs.servant.dev/
|
||||||
license: BSD3
|
license: BSD-3-Clause
|
||||||
license-file: ../../../servant/LICENSE
|
license-file: ../../../servant/LICENSE
|
||||||
author: Servant Contributors
|
author: Servant Contributors
|
||||||
maintainer: haskell-servant-maintainers@googlegroups.com
|
maintainer: haskell-servant-maintainers@googlegroups.com
|
||||||
build-type: Simple
|
build-type: Simple
|
||||||
cabal-version: >=1.10
|
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
|
executable cookbook-file-upload
|
||||||
main-is: FileUpload.lhs
|
main-is: FileUpload.lhs
|
||||||
|
|
|
@ -43,13 +43,13 @@ api :: Proxy (ToServantApi Routes)
|
||||||
api = genericApi (Proxy :: Proxy 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`.
|
better error message, for example if you forget to `derive Generic`.
|
||||||
|
|
||||||
## Links
|
## Links
|
||||||
|
|
||||||
The clear advantage of record-based generics approach, is that
|
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:
|
as field accessors work as proxies:
|
||||||
|
|
||||||
```haskell
|
```haskell
|
||||||
|
@ -67,7 +67,7 @@ routesLinks = allFieldLinks
|
||||||
## Client
|
## Client
|
||||||
|
|
||||||
Even more power starts to show when we generate a record of client functions.
|
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`.
|
hoist the monad, in this case from `ClientM` to `IO`.
|
||||||
|
|
||||||
```haskell
|
```haskell
|
||||||
|
|
|
@ -2,13 +2,13 @@ name: cookbook-generic
|
||||||
version: 0.1
|
version: 0.1
|
||||||
synopsis: Using custom monad to pass a state between handlers
|
synopsis: Using custom monad to pass a state between handlers
|
||||||
homepage: http://docs.servant.dev/
|
homepage: http://docs.servant.dev/
|
||||||
license: BSD3
|
license: BSD-3-Clause
|
||||||
license-file: ../../../servant/LICENSE
|
license-file: ../../../servant/LICENSE
|
||||||
author: Servant Contributors
|
author: Servant Contributors
|
||||||
maintainer: haskell-servant-maintainers@googlegroups.com
|
maintainer: haskell-servant-maintainers@googlegroups.com
|
||||||
build-type: Simple
|
build-type: Simple
|
||||||
cabal-version: >=1.10
|
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
|
executable cookbook-using-custom-monad
|
||||||
main-is: Generic.lhs
|
main-is: Generic.lhs
|
||||||
|
|
|
@ -254,7 +254,7 @@ loginHandler cookieSettings jwtSettings form = do
|
||||||
liftIO $ pushLogStrLn logset $ toLogStr logMsg
|
liftIO $ pushLogStrLn logset $ toLogStr logMsg
|
||||||
throwError err401
|
throwError err401
|
||||||
Just applyCookies -> do
|
Just applyCookies -> do
|
||||||
let successMsg = logMsg{message = "AdminUser succesfully authenticated!"}
|
let successMsg = logMsg{message = "AdminUser successfully authenticated!"}
|
||||||
liftIO $ pushLogStrLn logset $ toLogStr successMsg
|
liftIO $ pushLogStrLn logset $ toLogStr successMsg
|
||||||
pure $ applyCookies successMsg
|
pure $ applyCookies successMsg
|
||||||
loginHandler _ _ _ = throwError err401
|
loginHandler _ _ _ = throwError err401
|
||||||
|
@ -287,7 +287,7 @@ mkApp cfg cs jwts ctx =
|
||||||
(flip runReaderT ctx) (adminServer cs jwts)
|
(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:
|
so that `Warp` *also* will emit logs as JSON. This will ensure *all* logs are emitted as JSON:
|
||||||
|
|
||||||
```haskell
|
```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
|
description: Using servant-auth to support both JWT-based and basic
|
||||||
authentication.
|
authentication.
|
||||||
homepage: http://docs.servant.dev/
|
homepage: http://docs.servant.dev/
|
||||||
license: BSD3
|
license: BSD-3-Clause
|
||||||
license-file: ../../../servant/LICENSE
|
license-file: ../../../servant/LICENSE
|
||||||
author: Servant Contributors
|
author: Servant Contributors
|
||||||
maintainer: haskell-servant-maintainers@googlegroups.com
|
maintainer: haskell-servant-maintainers@googlegroups.com
|
||||||
category: Servant
|
category: Servant
|
||||||
build-type: Simple
|
build-type: Simple
|
||||||
cabal-version: >=1.10
|
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
|
executable cookbook-hoist-server-with-context
|
||||||
main-is: HoistServerWithContext.lhs
|
main-is: HoistServerWithContext.lhs
|
||||||
|
@ -24,7 +24,7 @@ executable cookbook-hoist-server-with-context
|
||||||
, servant
|
, servant
|
||||||
, servant-server
|
, servant-server
|
||||||
, servant-auth >= 0.3.2
|
, servant-auth >= 0.3.2
|
||||||
, servant-auth-server
|
, servant-auth-server >= 0.4.4.0
|
||||||
, time
|
, time
|
||||||
, warp >= 3.2
|
, warp >= 3.2
|
||||||
, wai >= 3.2
|
, wai >= 3.2
|
||||||
|
|
|
@ -34,16 +34,16 @@ app = serve api server
|
||||||
```
|
```
|
||||||
|
|
||||||
It's now time to actually run the `Application`.
|
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
|
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)
|
[`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-3.2.4/docs/Network-Wai-Handler-WarpTLS.html#v:runTLSSocket).
|
and [`runTLSSocket`](https://hackage.haskell.org/package/warp-tls/docs/Network-Wai-Handler-WarpTLS.html#v:runTLSSocket).
|
||||||
We will be using the first one.
|
We will be using the first one.
|
||||||
|
|
||||||
It takes two arguments,
|
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)
|
(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).
|
(port, logger, etc).
|
||||||
|
|
||||||
We will be using very simple settings for this example but you are of
|
We will be using very simple settings for this example but you are of
|
||||||
|
|
|
@ -2,13 +2,13 @@ name: cookbook-https
|
||||||
version: 0.1
|
version: 0.1
|
||||||
synopsis: HTTPS cookbook example
|
synopsis: HTTPS cookbook example
|
||||||
homepage: http://docs.servant.dev/
|
homepage: http://docs.servant.dev/
|
||||||
license: BSD3
|
license: BSD-3-Clause
|
||||||
license-file: ../../../servant/LICENSE
|
license-file: ../../../servant/LICENSE
|
||||||
author: Servant Contributors
|
author: Servant Contributors
|
||||||
maintainer: haskell-servant-maintainers@googlegroups.com
|
maintainer: haskell-servant-maintainers@googlegroups.com
|
||||||
build-type: Simple
|
build-type: Simple
|
||||||
cabal-version: >=1.10
|
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
|
executable cookbook-https
|
||||||
main-is: Https.lhs
|
main-is: Https.lhs
|
||||||
|
@ -17,7 +17,7 @@ executable cookbook-https
|
||||||
, servant-server
|
, servant-server
|
||||||
, wai >= 3.2
|
, wai >= 3.2
|
||||||
, warp >= 3.2
|
, warp >= 3.2
|
||||||
, warp-tls >= 3.2
|
, warp-tls >= 3.2.9
|
||||||
, markdown-unlit >= 0.4
|
, markdown-unlit >= 0.4
|
||||||
default-language: Haskell2010
|
default-language: Haskell2010
|
||||||
ghc-options: -Wall -pgmL markdown-unlit
|
ghc-options: -Wall -pgmL markdown-unlit
|
||||||
|
|
|
@ -25,6 +25,8 @@ you name it!
|
||||||
db-postgres-pool/PostgresPool.lhs
|
db-postgres-pool/PostgresPool.lhs
|
||||||
using-custom-monad/UsingCustomMonad.lhs
|
using-custom-monad/UsingCustomMonad.lhs
|
||||||
using-free-client/UsingFreeClient.lhs
|
using-free-client/UsingFreeClient.lhs
|
||||||
|
custom-errors/CustomErrors.lhs
|
||||||
|
uverb/UVerb.lhs
|
||||||
basic-auth/BasicAuth.lhs
|
basic-auth/BasicAuth.lhs
|
||||||
basic-streaming/Streaming.lhs
|
basic-streaming/Streaming.lhs
|
||||||
jwt-and-basic-auth/JWTAndBasicAuth.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
|
description: Using servant-auth to support both JWT-based and basic
|
||||||
authentication.
|
authentication.
|
||||||
homepage: http://docs.servant.dev/
|
homepage: http://docs.servant.dev/
|
||||||
license: BSD3
|
license: BSD-3-Clause
|
||||||
license-file: ../../../servant/LICENSE
|
license-file: ../../../servant/LICENSE
|
||||||
author: Servant Contributors
|
author: Servant Contributors
|
||||||
maintainer: haskell-servant-maintainers@googlegroups.com
|
maintainer: haskell-servant-maintainers@googlegroups.com
|
||||||
category: Servant
|
category: Servant
|
||||||
build-type: Simple
|
build-type: Simple
|
||||||
cabal-version: >=1.10
|
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
|
executable cookbook-jwt-and-basic-auth
|
||||||
main-is: JWTAndBasicAuth.lhs
|
main-is: JWTAndBasicAuth.lhs
|
||||||
|
@ -22,7 +22,7 @@ executable cookbook-jwt-and-basic-auth
|
||||||
, servant
|
, servant
|
||||||
, servant-client
|
, servant-client
|
||||||
, servant-server
|
, servant-server
|
||||||
, servant-auth ==0.3.*
|
, servant-auth == 0.4.*
|
||||||
, servant-auth-server >= 0.3.1.0
|
, servant-auth-server >= 0.3.1.0
|
||||||
, warp >= 3.2
|
, warp >= 3.2
|
||||||
, wai >= 3.2
|
, wai >= 3.2
|
||||||
|
|
|
@ -2,13 +2,13 @@ name: open-id-connect
|
||||||
version: 0.1
|
version: 0.1
|
||||||
synopsis: OpenId Connect with Servant example
|
synopsis: OpenId Connect with Servant example
|
||||||
homepage: http://haskell-servant.readthedocs.org/
|
homepage: http://haskell-servant.readthedocs.org/
|
||||||
license: BSD3
|
license: BSD-3-Clause
|
||||||
license-file: ../../../servant/LICENSE
|
license-file: ../../../servant/LICENSE
|
||||||
author: Servant Contributors
|
author: Servant Contributors
|
||||||
maintainer: haskell-servant-maintainers@googlegroups.com
|
maintainer: haskell-servant-maintainers@googlegroups.com
|
||||||
build-type: Simple
|
build-type: Simple
|
||||||
cabal-version: >= 1.10
|
cabal-version: >= 1.10
|
||||||
tested-with: GHC==8.4.4, GHC==8.6.5
|
tested-with: GHC==8.6.5
|
||||||
|
|
||||||
executable cookbook-openidconnect
|
executable cookbook-openidconnect
|
||||||
main-is: OpenIdConnect.lhs
|
main-is: OpenIdConnect.lhs
|
||||||
|
|
|
@ -8,8 +8,8 @@ some login token would be saved in the user agent local storage.
|
||||||
|
|
||||||
Workflow:
|
Workflow:
|
||||||
|
|
||||||
1. user is presentend with a login button,
|
1. user is presented with a login button,
|
||||||
2. when the user click on the button it is redirected to the OIDC
|
2. when the user clicks on the button it is redirected to the OIDC
|
||||||
provider,
|
provider,
|
||||||
3. the user login in the OIDC provider,
|
3. the user login in the OIDC provider,
|
||||||
4. the OIDC provider will redirect the user and provide a `code`,
|
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
|
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
|
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
|
object. One of the fields should be named `id_token` which should be a
|
||||||
JWT containing all the informations we need. Depending on the scopes we
|
JWT containing all the information we need. Depending on the scopes we
|
||||||
asked we might get more informations.
|
asked we might get more information.
|
||||||
|
|
||||||
``` haskell
|
``` haskell
|
||||||
-- | @AuthInfo@
|
-- | @AuthInfo@
|
||||||
|
@ -248,16 +248,16 @@ instance JSON.ToJSON AuthInfo where
|
||||||
type LoginHandler = AuthInfo -> IO (Either Text User)
|
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.
|
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
|
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
|
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
|
successfully 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
|
endpoint of the OIDC provider. It's a POST that should contain the code
|
||||||
as well as the client id & secret.
|
as well as the client id and secret.
|
||||||
This is the role of the `requestTokens` to make this HTTP POST.
|
Making this HTTP POST is the responsibility of `requestTokens`.
|
||||||
|
|
||||||
From there we extract the `claims` of the JWT contained in one of the value
|
From there we extract the `claims` of the JWT contained in one of the value
|
||||||
of the JSON returned by the POST HTTP Request.
|
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.
|
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
|
When the user clicks on this link it will be redirected to Google login page
|
||||||
with some generated informations.
|
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`.
|
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
|
Those items should be set after a successful login when the user is redirected to
|
||||||
`/login/cb`.
|
`/login/cb`.
|
||||||
|
@ -366,7 +366,7 @@ instance ToMarkup Homepage where
|
||||||
We need some helpers to generate random string for generating state and API Keys.
|
We need some helpers to generate random string for generating state and API Keys.
|
||||||
|
|
||||||
``` haskell
|
``` 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
|
-- still the password will be long enough to be very difficult to crack
|
||||||
genRandomBS :: IO ByteString
|
genRandomBS :: IO ByteString
|
||||||
genRandomBS = do
|
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
|
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.
|
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:
|
response with 3 headers:
|
||||||
|
|
||||||
- `Accept-Ranges`: A comma-separated list of fields upon which a range can be defined
|
- `Accept-Ranges`: A comma-separated list of fields upon which a range can be defined
|
||||||
|
@ -127,7 +127,7 @@ defaultRange =
|
||||||
getDefaultRange (Proxy @Color)
|
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
|
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
|
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.
|
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
|
`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
|
``` haskell
|
||||||
-- type MyHeaders =
|
-- type MyHeaders =
|
||||||
|
@ -165,7 +165,7 @@ not, _servant-pagination_ provides an easy way to lift a collection of resources
|
||||||
#### Server
|
#### Server
|
||||||
|
|
||||||
Time to connect the last bits by defining the server implementation of our colorful API. The `Ranges`
|
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.
|
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
|
If no such header is provided, we will end up receiving `Nothing`. Otherwise, it will be possible
|
||||||
to _extract_ a `Range` from our `Ranges`.
|
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>]`
|
- `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
|
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:
|
following examples are valid requests to send to our server:
|
||||||
|
|
||||||
- 1 - `curl http://localhost:1442/colors -vH 'Range: name'`
|
- 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`
|
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
|
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`
|
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.
|
highly likely to be needed.
|
||||||
|
|
||||||
|
|
||||||
|
@ -235,8 +235,8 @@ instance HasPagination Color "hex" where
|
||||||
#### Parsing Options
|
#### Parsing Options
|
||||||
|
|
||||||
By default, `servant-pagination` provides an implementation of `getRangeOptions` for each
|
By default, `servant-pagination` provides an implementation of `getRangeOptions` for each
|
||||||
`HasPagination` instance. However, this can be overwritten when defining the instance to provide
|
`HasPagination` instance. However, this can be overridden when defining the instance to provide
|
||||||
your own options. This options come into play when a `Range` header is received and isn't fully
|
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.
|
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
|
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
|
version: 2.1
|
||||||
synopsis: Pagination with Servant example
|
synopsis: Pagination with Servant example
|
||||||
homepage: http://docs.servant.dev/
|
homepage: http://docs.servant.dev/
|
||||||
license: BSD3
|
license: BSD-3-Clause
|
||||||
license-file: ../../../servant/LICENSE
|
license-file: ../../../servant/LICENSE
|
||||||
author: Servant Contributors
|
author: Servant Contributors
|
||||||
maintainer: haskell-servant-maintainers@googlegroups.com
|
maintainer: haskell-servant-maintainers@googlegroups.com
|
||||||
build-type: Simple
|
build-type: Simple
|
||||||
cabal-version: >=1.10
|
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
|
executable cookbook-pagination
|
||||||
main-is: Pagination.lhs
|
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
|
- 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
|
- 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.
|
- 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:
|
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 configured Sentry service which we just created
|
||||||
- the name of the logger
|
- 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
|
- the message we want to send
|
||||||
- an update function to handle the specific `SentryRecord`
|
- an update function to handle the specific `SentryRecord`
|
||||||
|
|
||||||
|
|
|
@ -2,13 +2,13 @@ name: cookbook-sentry
|
||||||
version: 0.1
|
version: 0.1
|
||||||
synopsis: Collecting runtime exceptions using Sentry
|
synopsis: Collecting runtime exceptions using Sentry
|
||||||
homepage: http://docs.servant.dev/
|
homepage: http://docs.servant.dev/
|
||||||
license: BSD3
|
license: BSD-3-Clause
|
||||||
license-file: ../../../servant/LICENSE
|
license-file: ../../../servant/LICENSE
|
||||||
author: Servant Contributors
|
author: Servant Contributors
|
||||||
maintainer: haskell-servant-maintainers@googlegroups.com
|
maintainer: haskell-servant-maintainers@googlegroups.com
|
||||||
build-type: Simple
|
build-type: Simple
|
||||||
cabal-version: >=1.10
|
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
|
executable cookbook-sentry
|
||||||
main-is: Sentry.lhs
|
main-is: Sentry.lhs
|
||||||
|
|
|
@ -144,7 +144,7 @@ simpleAPIServer
|
||||||
:: m [a]
|
:: m [a]
|
||||||
-> (i -> m a)
|
-> (i -> m a)
|
||||||
-> (a -> m NoContent)
|
-> (a -> m NoContent)
|
||||||
-> Server (SimpleAPI name a i) m
|
-> ServerT (SimpleAPI name a i) m
|
||||||
simpleAPIServer listAs getA postA =
|
simpleAPIServer listAs getA postA =
|
||||||
listAs :<|> getA :<|> postA
|
listAs :<|> getA :<|> postA
|
||||||
|
|
||||||
|
|
|
@ -2,13 +2,13 @@ name: cookbook-structuring-apis
|
||||||
version: 0.1
|
version: 0.1
|
||||||
synopsis: Example that shows how APIs can be structured
|
synopsis: Example that shows how APIs can be structured
|
||||||
homepage: http://docs.servant.dev/
|
homepage: http://docs.servant.dev/
|
||||||
license: BSD3
|
license: BSD-3-Clause
|
||||||
license-file: ../../../servant/LICENSE
|
license-file: ../../../servant/LICENSE
|
||||||
author: Servant Contributors
|
author: Servant Contributors
|
||||||
maintainer: haskell-servant-maintainers@googlegroups.com
|
maintainer: haskell-servant-maintainers@googlegroups.com
|
||||||
build-type: Simple
|
build-type: Simple
|
||||||
cabal-version: >=1.10
|
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
|
executable cookbook-structuring-apis
|
||||||
main-is: StructuringApis.lhs
|
main-is: StructuringApis.lhs
|
||||||
|
|
|
@ -3,14 +3,14 @@ version: 0.0.1
|
||||||
synopsis: Common testing patterns in Servant apps
|
synopsis: Common testing patterns in Servant apps
|
||||||
description: This recipe includes various strategies for writing tests for Servant.
|
description: This recipe includes various strategies for writing tests for Servant.
|
||||||
homepage: http://docs.servant.dev/
|
homepage: http://docs.servant.dev/
|
||||||
license: BSD3
|
license: BSD-3-Clause
|
||||||
license-file: ../../../servant/LICENSE
|
license-file: ../../../servant/LICENSE
|
||||||
author: Servant Contributors
|
author: Servant Contributors
|
||||||
maintainer: haskell-servant-maintainers@googlegroups.com
|
maintainer: haskell-servant-maintainers@googlegroups.com
|
||||||
category: Servant
|
category: Servant
|
||||||
build-type: Simple
|
build-type: Simple
|
||||||
cabal-version: >=1.10
|
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
|
executable cookbook-testing
|
||||||
main-is: Testing.lhs
|
main-is: Testing.lhs
|
||||||
|
@ -23,7 +23,7 @@ executable cookbook-testing
|
||||||
, servant
|
, servant
|
||||||
, servant-client
|
, servant-client
|
||||||
, servant-server
|
, servant-server
|
||||||
, servant-quickcheck
|
, servant-quickcheck >= 0.0.10
|
||||||
, http-client
|
, http-client
|
||||||
, http-types >= 0.12
|
, http-types >= 0.12
|
||||||
, hspec
|
, hspec
|
||||||
|
|
|
@ -1,6 +1,6 @@
|
||||||
# Using a custom monad
|
# 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 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:
|
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
|
version: 0.1
|
||||||
synopsis: Using custom monad to pass a state between handlers
|
synopsis: Using custom monad to pass a state between handlers
|
||||||
homepage: http://docs.servant.dev/
|
homepage: http://docs.servant.dev/
|
||||||
license: BSD3
|
license: BSD-3-Clause
|
||||||
license-file: ../../../servant/LICENSE
|
license-file: ../../../servant/LICENSE
|
||||||
author: Servant Contributors
|
author: Servant Contributors
|
||||||
maintainer: haskell-servant-maintainers@googlegroups.com
|
maintainer: haskell-servant-maintainers@googlegroups.com
|
||||||
build-type: Simple
|
build-type: Simple
|
||||||
cabal-version: >=1.10
|
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
|
executable cookbook-using-custom-monad
|
||||||
main-is: UsingCustomMonad.lhs
|
main-is: UsingCustomMonad.lhs
|
||||||
|
|
|
@ -141,7 +141,7 @@ and calling the continuation. We should get a `Pure` value.
|
||||||
Pure n ->
|
Pure n ->
|
||||||
putStrLn $ "Expected 1764, got " ++ show 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
|
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
|
version: 0.1
|
||||||
synopsis: Using Free client
|
synopsis: Using Free client
|
||||||
homepage: http://docs.servant.dev/
|
homepage: http://docs.servant.dev/
|
||||||
license: BSD3
|
license: BSD-3-Clause
|
||||||
license-file: ../../../servant/LICENSE
|
license-file: ../../../servant/LICENSE
|
||||||
author: Servant Contributors
|
author: Servant Contributors
|
||||||
maintainer: haskell-servant-maintainers@googlegroups.com
|
maintainer: haskell-servant-maintainers@googlegroups.com
|
||||||
build-type: Simple
|
build-type: Simple
|
||||||
cabal-version: >=1.10
|
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
|
executable cookbook-using-free-client
|
||||||
main-is: UsingFreeClient.lhs
|
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
|
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
|
`Application`, e.g. a whole web application written in any of the web
|
||||||
frameworks that support `wai`.
|
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.Aeson (ToJSON)
|
||||||
import Data.ByteString (ByteString)
|
import Data.ByteString (ByteString)
|
||||||
import Data.Map (Map, fromList)
|
import Data.Map (Map, fromList)
|
||||||
import Data.Monoid ((<>))
|
|
||||||
import qualified Data.Map as Map
|
import qualified Data.Map as Map
|
||||||
import Data.Proxy (Proxy (Proxy))
|
import Data.Proxy (Proxy (Proxy))
|
||||||
import Data.Text (Text)
|
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"`).
|
realm for this authentication is `"foo-realm"`).
|
||||||
|
|
||||||
Unfortunately we're not done. When someone makes a request to our `"private"`
|
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
|
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
|
design that we'll briefly discuss. If you want the **TL;DR**: we supply a lookup
|
||||||
function to servant's new `Context` primitive.
|
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`
|
handler. This will allow the handler to check authentication and return a `User`
|
||||||
to downstream handlers if successful.
|
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:
|
different function to better capture the semantics of basic authentication:
|
||||||
|
|
||||||
``` haskell ignore
|
``` haskell ignore
|
||||||
|
@ -260,7 +259,7 @@ this.
|
||||||
|
|
||||||
Let's implement a trivial authentication scheme. We will protect our API by
|
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
|
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
|
```haskell
|
||||||
-- | An account type that we "fetch from the database" after
|
-- | 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")
|
, ("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.
|
-- This is our bespoke (and bad) authentication logic.
|
||||||
lookupAccount :: ByteString -> Handler Account
|
lookupAccount :: ByteString -> Handler Account
|
||||||
lookupAccount key = case Map.lookup key database of
|
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
|
-- | 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
|
-- 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
|
-- that is taken care of by supplying context
|
||||||
genAuthServer :: Server AuthGenAPI
|
genAuthServer :: Server AuthGenAPI
|
||||||
genAuthServer =
|
genAuthServer =
|
||||||
|
@ -385,11 +384,11 @@ Creating a generalized, ad-hoc authentication scheme was fairly straight
|
||||||
forward:
|
forward:
|
||||||
|
|
||||||
1. use the `AuthProtect` combinator to protect your API.
|
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`).
|
authentication is successful (in our case this was `Account`).
|
||||||
3. Create a value of `AuthHandler Request Account` which encapsulates the
|
3. Create a value of `AuthHandler Request Account` which encapsulates the
|
||||||
authentication logic (`Request -> Handler Account`). This function
|
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
|
4. Provide an instance of the `AuthServerData` type family, specifying your
|
||||||
application-specific data type returned when authentication is successful (in
|
application-specific data type returned when authentication is successful (in
|
||||||
our case this was `Account`).
|
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
|
## Changing the monad the client functions live in
|
||||||
|
|
||||||
Just like `hoistServer` allows us to change the monad in which request handlers
|
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:
|
in which _client functions_ live. Consider the following trivial API:
|
||||||
|
|
||||||
``` haskell
|
``` haskell
|
||||||
|
@ -173,7 +173,7 @@ hoistClientAPI = Proxy
|
||||||
|
|
||||||
We already know how to derive client functions for this API, and as we have
|
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`.
|
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
|
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
|
stack. `hoistClient` is a very simple solution to the problem of "changing" the monad
|
||||||
the clients run in.
|
the clients run in.
|
||||||
|
|
|
@ -77,7 +77,7 @@ instance ToSample HelloMessage where
|
||||||
[ ("When a value is provided for 'name'", HelloMessage "Hello, Alp")
|
[ ("When a value is provided for 'name'", HelloMessage "Hello, Alp")
|
||||||
, ("When 'name' is not specified", HelloMessage "Hello, anonymous coward")
|
, ("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
|
||||||
ci = ClientInfo "Alp" "alp@foo.com" 26 ["haskell", "mathematics"]
|
ci = ClientInfo "Alp" "alp@foo.com" 26 ["haskell", "mathematics"]
|
||||||
|
@ -108,7 +108,7 @@ apiDocs = docs exampleAPI
|
||||||
markdown :: API -> String
|
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
|
````````` text
|
||||||
## GET /hello
|
## GET /hello
|
||||||
|
|
|
@ -228,13 +228,13 @@ data CommonGeneratorOptions = CommonGeneratorOptions
|
||||||
{
|
{
|
||||||
-- | function generating function names
|
-- | function generating function names
|
||||||
functionNameBuilder :: FunctionName -> Text
|
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
|
, requestBody :: Text
|
||||||
-- | name of the callback parameter when the request was successful
|
-- | name of the callback parameter when the request was successful
|
||||||
, successCallback :: Text
|
, successCallback :: Text
|
||||||
-- | name of the callback parameter when the request reported an error
|
-- | name of the callback parameter when the request reported an error
|
||||||
, errorCallback :: Text
|
, 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
|
, moduleName :: Text
|
||||||
-- | a prefix that should be prepended to the URL in the generated JS
|
-- | a prefix that should be prepended to the URL in the generated JS
|
||||||
, urlPrefix :: Text
|
, urlPrefix :: Text
|
||||||
|
|
|
@ -183,7 +183,7 @@ users2 = [isaac, albert]
|
||||||
|
|
||||||
Now, just like we separate the various endpoints in `UserAPI` with `:<|>`, we
|
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
|
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
|
``` haskell
|
||||||
server2 :: Server UserAPI2
|
server2 :: Server UserAPI2
|
||||||
|
@ -313,8 +313,8 @@ For reference, here's a list of some combinators from **servant**:
|
||||||
## The `FromHttpApiData`/`ToHttpApiData` classes
|
## The `FromHttpApiData`/`ToHttpApiData` classes
|
||||||
|
|
||||||
Wait... How does **servant** know how to decode the `Int`s from the URL? Or how
|
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
|
to decode a `ClientInfo` value from the request body? The following three sections will
|
||||||
following two sections address.
|
help us answer these questions.
|
||||||
|
|
||||||
`Capture`s and `QueryParam`s are represented by some textual value in URLs.
|
`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
|
`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
|
equivalent to a computation of type `IO (Either ServerError a)`, that is, an IO
|
||||||
action that either returns an error or a result.
|
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.
|
from which `ExceptT` comes is worth looking at.
|
||||||
Perhaps most importantly, `ExceptT` and `Handler` are instances of `MonadError`, so
|
Perhaps most importantly, `ExceptT` and `Handler` are instances of `MonadError`, so
|
||||||
`throwError` can be used to return an error from your handler (whereas `return`
|
`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
|
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.
|
(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:
|
is a class from the **transformers** package defined as:
|
||||||
|
|
||||||
``` haskell ignore
|
``` haskell ignore
|
||||||
|
@ -716,7 +716,7 @@ $ curl --verbose http://localhost:8081/myfile.txt
|
||||||
>
|
>
|
||||||
< HTTP/1.1 404 Not Found
|
< HTTP/1.1 404 Not Found
|
||||||
[snip]
|
[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
|
$ 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
|
`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
|
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
|
## Nested APIs
|
||||||
|
|
||||||
|
@ -1135,7 +1135,7 @@ true
|
||||||
### An arrow is a reader too.
|
### An arrow is a reader too.
|
||||||
|
|
||||||
In previous versions of `servant` we had an `enter` to do what `hoistServer`
|
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
|
One problematic situation was when the source monad was `(->) r`, yet it's
|
||||||
handy in practice, because `(->) r` is isomorphic to `Reader r`.
|
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
|
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
|
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
|
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*).
|
stream type (it's simpler than *Pipes* or *Conduit*).
|
||||||
The API of a streaming endpoint needs to explicitly specify which sort of
|
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
|
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
|
Any comments, issues or feedback about the tutorial can be submitted
|
||||||
to `servant's issue tracker <http://github.com/haskell-servant/servant/issues>`_.
|
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::
|
.. toctree::
|
||||||
:maxdepth: 1
|
:maxdepth: 1
|
||||||
|
|
||||||
|
install.rst
|
||||||
ApiType.lhs
|
ApiType.lhs
|
||||||
Server.lhs
|
Server.lhs
|
||||||
Client.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/>
|
<http://docs.servant.dev/>
|
||||||
homepage: http://docs.servant.dev/
|
homepage: http://docs.servant.dev/
|
||||||
category: Servant, Documentation
|
category: Servant, Documentation
|
||||||
license: BSD3
|
license: BSD-3-Clause
|
||||||
license-file: LICENSE
|
license-file: LICENSE
|
||||||
author: Servant Contributors
|
author: Servant Contributors
|
||||||
maintainer: haskell-servant-maintainers@googlegroups.com
|
maintainer: haskell-servant-maintainers@googlegroups.com
|
||||||
build-type: Simple
|
build-type: Simple
|
||||||
cabal-version: >=1.10
|
cabal-version: >=1.10
|
||||||
tested-with:
|
tested-with:
|
||||||
GHC==8.0.2
|
|
||||||
GHC==8.2.2
|
|
||||||
GHC==8.4.4
|
|
||||||
GHC==8.6.5
|
GHC==8.6.5
|
||||||
GHC==8.8.1
|
GHC==8.8.3, GHC ==8.10.7
|
||||||
extra-source-files:
|
extra-source-files:
|
||||||
static/index.html
|
static/index.html
|
||||||
static/ui.js
|
static/ui.js
|
||||||
|
@ -68,9 +65,9 @@ library
|
||||||
, cookie >= 0.4.3 && < 0.5
|
, cookie >= 0.4.3 && < 0.5
|
||||||
, js-jquery >= 3.3.1 && < 3.4
|
, js-jquery >= 3.3.1 && < 3.4
|
||||||
, lucid >= 2.9.11 && < 2.10
|
, lucid >= 2.9.11 && < 2.10
|
||||||
, random >= 1.1 && < 1.2
|
, random >= 1.1 && < 1.3
|
||||||
, servant-js >= 0.9 && < 0.10
|
, 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
|
-- For legacy tools, we need to specify build-depends too
|
||||||
build-depends: markdown-unlit >= 0.5.0 && <0.6
|
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
|
``` sh
|
||||||
$ nix-shell nix/shell.nix --argstr compiler ghcHEAD
|
$ 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 ? "ghc8104"
|
||||||
, compiler ? "ghc822"
|
|
||||||
, tutorial ? false
|
, tutorial ? false
|
||||||
|
, pkgs ? import ./nixpkgs.nix
|
||||||
}:
|
}:
|
||||||
|
|
||||||
with pkgs;
|
with pkgs;
|
||||||
|
|
||||||
let
|
let
|
||||||
ghc = haskell.packages.${compiler}.ghcWithPackages (_: []);
|
ghc = haskell.packages.${compiler}.ghcWithPackages (_: []);
|
||||||
docstuffs = python3.withPackages (ps: with ps; [ recommonmark sphinx sphinx_rtd_theme ]);
|
docstuffs = python3.withPackages (ps: with ps; [ recommonmark sphinx sphinx_rtd_theme ]);
|
||||||
in
|
in
|
||||||
|
stdenv.mkDerivation {
|
||||||
stdenv.mkDerivation {
|
|
||||||
name = "servant-dev";
|
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 []);
|
++ (if tutorial then [docstuffs postgresql] else []);
|
||||||
shellHook = ''
|
shellHook = ''
|
||||||
eval $(grep export ${ghc}/bin/ghc)
|
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