master..720bb40 · typeable/servant

.github/FUNDING.ymldeleted−12

since splitsnapshots

unifiedsplit

@@ -1,12 +0,0 @@

1−# These are supported funding model platforms

2−

3−github: [arianvp]

4−patreon: # Replace with a single Patreon username

5−open_collective: # Replace with a single Open Collective username

6−ko_fi: # Replace with a single Ko-fi username

7−tidelift: # Replace with a single Tidelift platform-name/package-name e.g., npm/babel

8−community_bridge: # Replace with a single Community Bridge project-name e.g., cloud-foundry

9−liberapay: # Replace with a single Liberapay username

10−issuehunt: # Replace with a single IssueHunt username

11−otechie: # Replace with a single Otechie username

12−custom: https://github.com/haskell-servant/haskell-servant.github.io/blob/hakyll/consultancies.md

.github/run-ghcjs-tests.shdeleted−14

@@ -1,14 +0,0 @@

1−#!/usr/bin/env bash

2−#

3−# cabal v2-test does not work with GHCJS

4−# See: https://github.com/haskell/cabal/issues/6175

5−#

6−# This invokes cabal-plan to figure out test binaries, and invokes them with node.

7−

8−cabal-plan list-bins '*:test:*' | while read -r line

9−do

10− testpkg=$(echo "$line" | perl -pe 's/:.*//')

11− testexe=$(echo "$line" | awk '{ print $2 }')

12− echo "testing $textexe in package $textpkg"

13− (cd "$testpkg" && node "$testexe".jsexe/all.js)

14−done

.github/workflows/master.ymldeleted−147

@@ -1,147 +0,0 @@

1−name: CI

2−

3−# Trigger the workflow on push or pull request, but only for the master branch

4−on:

5− pull_request:

6− push:

7− branches: [master]

8−

9−jobs:

10− cabal:

11− name: ${{ matrix.os }} / ghc ${{ matrix.ghc }}

12− runs-on: ${{ matrix.os }}

13− strategy:

14− matrix:

15− os: [ubuntu-latest]

16− cabal: ["3.6"]

17− ghc:

18− - "8.6.5"

19− - "8.8.4"

20− - "8.10.7"

21− - "9.0.2"

22− - "9.2.2"

23−

24− steps:

25− - uses: actions/checkout@v2

26−

27− - uses: haskell/actions/setup@v1

28− id: setup-haskell-cabal

29− name: Setup Haskell

30− with:

31− ghc-version: ${{ matrix.ghc }}

32− cabal-version: ${{ matrix.cabal }}

33−

34− - name: Freeze

35− run: |

36− cabal configure --enable-tests --enable-benchmarks --test-show-details=direct

37− cabal freeze

38−

39− - uses: actions/cache@v2.1.3

40− name: Cache ~/.cabal/store and dist-newstyle

41− with:

42− path: |

43− ${{ steps.setup-haskell-cabal.outputs.cabal-store }}

44− dist-newstyle

45− key: ${{ runner.os }}-${{ matrix.ghc }}-${{ hashFiles('cabal.project.freeze') }}

46− restore-keys: |

47− ${{ runner.os }}-${{ matrix.ghc }}-

48−

49− - name: Configure

50− run: |

51− cabal install --ignore-project -j2 doctest --constraint='doctest ^>=0.20'

52−

53− - name: Build

54− run: |

55− cabal build all

56−

57− - name: Test

58− run: |

59− cabal test all

60−

61− - name: Run doctests

62− run: |

63− # Necessary for doctest to be found in $PATH

64− export PATH="$HOME/.cabal/bin:$PATH"

65−

66− DOCTEST="cabal repl --with-ghc=doctest --ghc-options=-w"

67− (cd servant && eval $DOCTEST)

68− (cd servant-client && eval $DOCTEST)

69− (cd servant-client-core && eval $DOCTEST)

70− (cd servant-http-streams && eval $DOCTEST)

71− (cd servant-docs && eval $DOCTEST)

72− (cd servant-foreign && eval $DOCTEST)

73− (cd servant-server && eval $DOCTEST)

74− (cd servant-machines && eval $DOCTEST)

75− (cd servant-conduit && eval $DOCTEST)

76− (cd servant-pipes && eval $DOCTEST)

77−

78− stack:

79− name: stack / ghc ${{ matrix.ghc }}

80− runs-on: ubuntu-latest

81− strategy:

82− matrix:

83− stack: ["2.7.5"]

84− ghc: ["8.10.7"]

85−

86− steps:

87− - uses: actions/checkout@v2

88−

89− - uses: haskell/actions/setup@v1

90− name: Setup Haskell Stack

91− with:

92− ghc-version: ${{ matrix.ghc }}

93− stack-version: ${{ matrix.stack }}

94−

95− - uses: actions/cache@v2.1.3

96− name: Cache ~/.stack

97− with:

98− path: ~/.stack

99− key: ${{ runner.os }}-${{ matrix.ghc }}-stack

100−

101− - name: Install dependencies

102− run: |

103− stack build --system-ghc --test --bench --no-run-tests --no-run-benchmarks --only-dependencies

104−

105− - name: Build

106− run: |

107− stack build --system-ghc --test --bench --no-run-tests --no-run-benchmarks

108−

109− - name: Test

110− run: |

111− stack test --system-ghc

112−

113− ghcjs:

114− name: ubuntu-latest / ghcjs 8.6

115− runs-on: "ubuntu-latest"

116−

117− steps:

118− - uses: actions/checkout@v2

119− - uses: cachix/install-nix-action@v13

120− with:

121− extra_nix_config: |

122− trusted-public-keys = ryantrinkle.com-1:JJiAKaRv9mWgpVAz8dwewnZe0AzzEAzPkagE9SP5NWI=1aba6f367982bd6dd78ec2fda75ab246a62d32c5 cache.nixos.org-1:6NCHdD59X431o0gWypbMrAURkbJ16ZPMQFGspcDShjY=

123− substituters = https://nixcache.reflex-frp.org https://cache.nixos.org/

124− - name: Setup

125− run: |

126− # Override cabal.project with the lightweight GHCJS one

127− cp cabal.ghcjs.project cabal.project

128− cat cabal.project

129− nix-shell ghcjs.nix --run "cabal v2-update && cabal v2-freeze"

130−

131− - uses: actions/cache@v2.1.3

132− name: Cache ~/.cabal/store and dist-newstyle

133− with:

134− path: |

135− ~/.cabal/store

136− dist-newstyle

137− key: ${{ runner.os }}-ghcjs8.6-${{ hashFiles('cabal.project.freeze') }}

138− restore-keys: |

139− ${{ runner.os }}-ghcjs8.6-

140−

141− - name: Build

142− run: |

143− nix-shell ghcjs.nix --run "cabal v2-build --ghcjs --enable-tests --enable-benchmarks all"

144−

145− - name: Tests

146− run: |

147− nix-shell ghcjs.nix --run ".github/run-ghcjs-tests.sh"

.gitignore+1−10

@@ -1,6 +1,5 @@

1**/*/dist

2−*~

3−dist-*

2+dist-newstyle

4.ghc.environment.*

3.ghc.environment.*

5/bin

4/bin

6/lib

5/lib

@@ -30,11 +29,3 @@ doc/_build

30doc/venv

29doc/venv

31doc/tutorial/static/api.js

30doc/tutorial/static/api.js

32doc/tutorial/static/jq.js

31doc/tutorial/static/jq.js

33−shell.nix

34−.hspec-failures

35−

36−# nix

37−result*

38−

39−# local versions of things

40−servant-multipart

.travis.ymlnew file+189

@@ -0,0 +1,189 @@

1+# This Travis job script has been generated by a script via

2+#

3+# runghc make_travis_yml_2.hs '--config=cabal.make-travis-yml' '--output=.travis.yml' 'cabal.project'

4+#

5+# For more information, see https://github.com/hvr/multi-ghc-travis

6+#

7+language: c

8+sudo: false

9+

10+git:

11+ submodules: false # whether to recursively clone submodules

12+

13+branches:

14+ only:

15+ - master

16+

17+cache:

18+ directories:

19+ - $HOME/.cabal/packages

20+ - $HOME/.cabal/store

21+

22+before_cache:

23+ - rm -fv $HOME/.cabal/packages/hackage.haskell.org/build-reports.log

24+ # remove files that are regenerated by 'cabal update'

25+ - rm -fv $HOME/.cabal/packages/hackage.haskell.org/00-index.*

26+ - rm -fv $HOME/.cabal/packages/hackage.haskell.org/*.json

27+ - rm -fv $HOME/.cabal/packages/hackage.haskell.org/01-index.cache

28+ - rm -fv $HOME/.cabal/packages/hackage.haskell.org/01-index.tar

29+ - rm -fv $HOME/.cabal/packages/hackage.haskell.org/01-index.tar.idx

30+

31+ - rm -rfv $HOME/.cabal/packages/head.hackage

32+

33+matrix:

34+ include:

35+ - compiler: "ghc-8.4.3"

36+ # env: TEST=--disable-tests BENCH=--disable-benchmarks

37+ addons: {apt: {packages: [ghc-ppa-tools,cabal-install-2.2,ghc-8.4.3], sources: [hvr-ghc]}}

38+ - compiler: "ghc-8.2.2"

39+ # env: TEST=--disable-tests BENCH=--disable-benchmarks

40+ addons: {apt: {packages: [ghc-ppa-tools,cabal-install-2.2,ghc-8.2.2], sources: [hvr-ghc]}}

41+ - compiler: "ghc-8.0.2"

42+ # env: TEST=--disable-tests BENCH=--disable-benchmarks

43+ addons: {apt: {packages: [ghc-ppa-tools,cabal-install-2.2,ghc-8.0.2], sources: [hvr-ghc]}}

44+

45+before_install:

46+ - HC=${CC}

47+ - HCPKG=${HC/ghc/ghc-pkg}

48+ - unset CC

49+ - ROOTDIR=$(pwd)

50+ - mkdir -p $HOME/.local/bin

51+ - "PATH=/opt/ghc/bin:/opt/ghc-ppa-tools/bin:$HOME/local/bin:$PATH"

52+ - HCNUMVER=$(( $(${HC} --numeric-version|sed -E 's/([0-9]+)\.([0-9]+)\.([0-9]+).*/\1 * 10000 + \2 * 100 + \3/') ))

53+ - echo $HCNUMVER

54+

55+install:

56+ - cabal --version

57+ - echo "$(${HC} --version) [$(${HC} --print-project-git-commit-id 2> /dev/null || echo '?')]"

58+ - BENCH=${BENCH---enable-benchmarks}

59+ - TEST=${TEST---enable-tests}

60+ - HADDOCK=${HADDOCK-true}

61+ - UNCONSTRAINED=${UNCONSTRAINED-true}

62+ - NOINSTALLEDCONSTRAINTS=${NOINSTALLEDCONSTRAINTS-false}

63+ - GHCHEAD=${GHCHEAD-false}

64+ - travis_retry cabal update -v

65+ - "sed -i.bak 's/^jobs:/-- jobs:/' ${HOME}/.cabal/config"

66+ - rm -fv cabal.project cabal.project.local

67+ - "if [ $HCNUMVER -ge 70800 ]; then sed -i.bak 's/-- ghc-options:.*/ghc-options: -j2/' ${HOME}/.cabal/config; fi"

68+ - grep -Ev -- '^\s*--' ${HOME}/.cabal/config | grep -Ev '^\s*$'

69+ - "printf 'packages: \"servant\" \"servant-client\" \"servant-client-core\" \"servant-docs\" \"servant-foreign\" \"servant-server\" \"doc/tutorial\" \"doc/cookbook/basic-auth\" \"doc/cookbook/db-postgres-pool\" \"doc/cookbook/db-sqlite-simple\" \"doc/cookbook/file-upload\" \"doc/cookbook/generic\" \"doc/cookbook/https\" \"doc/cookbook/jwt-and-basic-auth\" \"doc/cookbook/pagination\" \"doc/cookbook/structuring-apis\" \"doc/cookbook/using-custom-monad\" \"doc/cookbook/using-free-client\"\\n' > cabal.project"

70+ - "echo 'constraints: foundation >=0.0.14,memory <0.14.12 || >0.14.12' >> cabal.project"

71+ - "echo 'allow-newer: servant-auth-server:http-types,servant-auth-server:servant-server, servant-pagination:servant,servant-pagination:servant-server' >> cabal.project"

72+ - touch cabal.project.local

74+ - cat cabal.project || true

75+ - cat cabal.project.local || true

76+ - if [ -f "servant/configure.ac" ]; then

77+ (cd "servant" && autoreconf -i);

78+ fi

79+ - if [ -f "servant-client/configure.ac" ]; then

80+ (cd "servant-client" && autoreconf -i);

81+ fi

82+ - if [ -f "servant-client-core/configure.ac" ]; then

83+ (cd "servant-client-core" && autoreconf -i);

84+ fi

85+ - if [ -f "servant-docs/configure.ac" ]; then

86+ (cd "servant-docs" && autoreconf -i);

87+ fi

88+ - if [ -f "servant-foreign/configure.ac" ]; then

89+ (cd "servant-foreign" && autoreconf -i);

90+ fi

91+ - if [ -f "servant-server/configure.ac" ]; then

92+ (cd "servant-server" && autoreconf -i);

93+ fi

94+ - if [ -f "doc/tutorial/configure.ac" ]; then

95+ (cd "doc/tutorial" && autoreconf -i);

96+ fi

97+ - if [ -f "doc/cookbook/basic-auth/configure.ac" ]; then

98+ (cd "doc/cookbook/basic-auth" && autoreconf -i);

99+ fi

100+ - if [ -f "doc/cookbook/db-postgres-pool/configure.ac" ]; then

101+ (cd "doc/cookbook/db-postgres-pool" && autoreconf -i);

102+ fi

103+ - if [ -f "doc/cookbook/db-sqlite-simple/configure.ac" ]; then

104+ (cd "doc/cookbook/db-sqlite-simple" && autoreconf -i);

105+ fi

106+ - if [ -f "doc/cookbook/file-upload/configure.ac" ]; then

107+ (cd "doc/cookbook/file-upload" && autoreconf -i);

108+ fi

109+ - if [ -f "doc/cookbook/generic/configure.ac" ]; then

110+ (cd "doc/cookbook/generic" && autoreconf -i);

111+ fi

112+ - if [ -f "doc/cookbook/https/configure.ac" ]; then

113+ (cd "doc/cookbook/https" && autoreconf -i);

114+ fi

115+ - if [ -f "doc/cookbook/jwt-and-basic-auth/configure.ac" ]; then

116+ (cd "doc/cookbook/jwt-and-basic-auth" && autoreconf -i);

117+ fi

118+ - if [ -f "doc/cookbook/pagination/configure.ac" ]; then

119+ (cd "doc/cookbook/pagination" && autoreconf -i);

120+ fi

121+ - if [ -f "doc/cookbook/structuring-apis/configure.ac" ]; then

122+ (cd "doc/cookbook/structuring-apis" && autoreconf -i);

123+ fi

124+ - if [ -f "doc/cookbook/using-custom-monad/configure.ac" ]; then

125+ (cd "doc/cookbook/using-custom-monad" && autoreconf -i);

126+ fi

127+ - if [ -f "doc/cookbook/using-free-client/configure.ac" ]; then

128+ (cd "doc/cookbook/using-free-client" && autoreconf -i);

129+ fi

130+ - rm -f cabal.project.freeze

131+ - rm -rf .ghc.environment.* "servant"/dist "servant-client"/dist "servant-client-core"/dist "servant-docs"/dist "servant-foreign"/dist "servant-server"/dist "doc/tutorial"/dist "doc/cookbook/basic-auth"/dist "doc/cookbook/db-postgres-pool"/dist "doc/cookbook/db-sqlite-simple"/dist "doc/cookbook/file-upload"/dist "doc/cookbook/generic"/dist "doc/cookbook/https"/dist "doc/cookbook/jwt-and-basic-auth"/dist "doc/cookbook/pagination"/dist "doc/cookbook/structuring-apis"/dist "doc/cookbook/using-custom-monad"/dist "doc/cookbook/using-free-client"/dist

132+ - DISTDIR=$(mktemp -d /tmp/dist-test.XXXX)

133+

134+# Here starts the actual work to be performed for the package under test;

135+# any command which exits with a non-zero exit code causes the build to fail.

136+script:

137+ # test that source-distributions can be generated

138+ - echo Packaging... && echo -en 'travis_fold:start:sdist\\r'

139+ - (cd "servant" && cabal sdist)

140+ - (cd "servant-client" && cabal sdist)

141+ - (cd "servant-client-core" && cabal sdist)

142+ - (cd "servant-docs" && cabal sdist)

143+ - (cd "servant-foreign" && cabal sdist)

144+ - (cd "servant-server" && cabal sdist)

145+ - (cd "doc/tutorial" && cabal sdist)

146+ - (cd "doc/cookbook/basic-auth" && cabal sdist)

147+ - (cd "doc/cookbook/db-postgres-pool" && cabal sdist)

148+ - (cd "doc/cookbook/db-sqlite-simple" && cabal sdist)

149+ - (cd "doc/cookbook/file-upload" && cabal sdist)

150+ - (cd "doc/cookbook/generic" && cabal sdist)

151+ - (cd "doc/cookbook/https" && cabal sdist)

152+ - (cd "doc/cookbook/jwt-and-basic-auth" && cabal sdist)

153+ - (cd "doc/cookbook/pagination" && cabal sdist)

154+ - (cd "doc/cookbook/structuring-apis" && cabal sdist)

155+ - (cd "doc/cookbook/using-custom-monad" && cabal sdist)

156+ - (cd "doc/cookbook/using-free-client" && cabal sdist)

157+ - echo -en 'travis_fold:end:sdist\\r'

158+ - echo Unpacking... && echo -en 'travis_fold:start:unpack\\r'

159+ - mv "servant"/dist/servant-*.tar.gz "servant-client"/dist/servant-client-*.tar.gz "servant-client-core"/dist/servant-client-core-*.tar.gz "servant-docs"/dist/servant-docs-*.tar.gz "servant-foreign"/dist/servant-foreign-*.tar.gz "servant-server"/dist/servant-server-*.tar.gz "doc/tutorial"/dist/tutorial-*.tar.gz "doc/cookbook/basic-auth"/dist/cookbook-basic-auth-*.tar.gz "doc/cookbook/db-postgres-pool"/dist/cookbook-db-postgres-pool-*.tar.gz "doc/cookbook/db-sqlite-simple"/dist/cookbook-db-sqlite-simple-*.tar.gz "doc/cookbook/file-upload"/dist/cookbook-file-upload-*.tar.gz "doc/cookbook/generic"/dist/cookbook-generic-*.tar.gz "doc/cookbook/https"/dist/cookbook-https-*.tar.gz "doc/cookbook/jwt-and-basic-auth"/dist/cookbook-jwt-and-basic-auth-*.tar.gz "doc/cookbook/pagination"/dist/cookbook-pagination-*.tar.gz "doc/cookbook/structuring-apis"/dist/cookbook-structuring-apis-*.tar.gz "doc/cookbook/using-custom-monad"/dist/cookbook-using-custom-monad-*.tar.gz "doc/cookbook/using-free-client"/dist/cookbook-using-free-client-*.tar.gz ${DISTDIR}/

160+ - cd ${DISTDIR} || false

161+ - find . -maxdepth 1 -name '*.tar.gz' -exec tar -xvf '{}' \;

162+ - "printf 'packages: servant-*/*.cabal servant-client-*/*.cabal servant-client-core-*/*.cabal servant-docs-*/*.cabal servant-foreign-*/*.cabal servant-server-*/*.cabal tutorial-*/*.cabal cookbook-basic-auth-*/*.cabal cookbook-db-postgres-pool-*/*.cabal cookbook-db-sqlite-simple-*/*.cabal cookbook-file-upload-*/*.cabal cookbook-generic-*/*.cabal cookbook-https-*/*.cabal cookbook-jwt-and-basic-auth-*/*.cabal cookbook-pagination-*/*.cabal cookbook-structuring-apis-*/*.cabal cookbook-using-custom-monad-*/*.cabal cookbook-using-free-client-*/*.cabal\\n' > cabal.project"

163+ - "echo 'constraints: foundation >=0.0.14,memory <0.14.12 || >0.14.12' >> cabal.project"

164+ - "echo 'allow-newer: servant-auth-server:http-types,servant-auth-server:servant-server, servant-pagination:servant,servant-pagination:servant-server' >> cabal.project"

165+ - touch cabal.project.local

167+ - cat cabal.project || true

168+ - cat cabal.project.local || true

169+ - echo -en 'travis_fold:end:unpack\\r'

170+

171+ - echo Building with tests and benchmarks... && echo -en 'travis_fold:start:build-everything\\r'

172+ # build & run tests, build benchmarks

173+ - cabal new-build -w ${HC} ${TEST} ${BENCH} all

174+ - echo -en 'travis_fold:end:build-everything\\r'

175+ - if [ "x$TEST" = "x--enable-tests" ]; then cabal new-test -w ${HC} ${TEST} ${BENCH} all; fi

176+

177+ - echo Haddock... && echo -en 'travis_fold:start:haddock\\r'

178+ # haddock

179+ - rm -rf ./dist-newstyle

180+ - if $HADDOCK; then cabal new-haddock -w ${HC} ${TEST} ${BENCH} all; else echo "Skipping haddock generation";fi

181+

182+ - echo -en 'travis_fold:end:haddock\\r'

183+ - echo Building without installed constraints for packages in global-db... && echo -en 'travis_fold:start:build-installed\\r'

184+ # Build without installed constraints for packages in global-db

185+ - if $UNCONSTRAINED; then rm -f cabal.project.local; echo cabal new-build -w ${HC} --disable-tests --disable-benchmarks all; else echo "Not building without installed constraints"; fi

186+

187+ - echo -en 'travis_fold:end:build-installed\\r'

188+# REGENDATA ["--config=cabal.make-travis-yml","--output=.travis.yml","cabal.project"]

189+# EOF

CONTRIBUTING.md+5−34

@@ -21,7 +21,6 @@ Or `nix`:

21./scripts/generate-nix-files.sh # Get up-to-date shell.nix files

22```

23

24−To build the docs, see `doc/README.md`.

25

24

26## General

25## General

27

26

@@ -35,34 +34,8 @@ Some things we like:

35Though we aren't sticklers for style, the `.stylish-haskell.yaml` and `HLint.hs`

34Though we aren't sticklers for style, the `.stylish-haskell.yaml` and `HLint.hs`

36files in the repository provide a good baseline for consistency.

35files in the repository provide a good baseline for consistency.

37

36

38−**Important**: please do not modify the versions of the servant packages you are sending patches for.

37+Please include a description of the changes in your PR in the `CHANGELOG.md` of

39−

38+the packages you've changed. And of course, write tests!

40−## Changelog entries

41−

42−We experiment with using [changelog-d tool](https://github.com/phadej/changelog-d) to assemble changelogs.

43−You are not required to install it.

44−

45−In each PR please add a file to `changelog.d` directory named after issue you are solving or the pull request itself (in a separate commit after you know the pull request number). For example

46−

47−```cabal

48−synopsis: One sentence summary of the change.

49−prs: #1219

50−issues: #1028

51−

52−description: {

53−

54−A longer description. Small changes don't need this.

55−Bigger ones definitely do, for example we try to include migration hints

56−for breaking changes.

57−

58−However if you don't know what to write, that's ok too.

59−

60−By the way, the braces around are omitted when the file is parsed.

61−They can be used so the field doesn't need to be indented, which is handy

62−for prose.

63−

64−}

65−```

66

39

67## PR process

40## PR process

68

41

@@ -79,10 +52,8 @@ not been a timely response to a PR, you can ping the Maintainers group (with

79We encourage people to experiment with new combinators and instances - it is

52We encourage people to experiment with new combinators and instances - it is

80one of the most powerful ways of using `servant`, and a wonderful way of

53one of the most powerful ways of using `servant`, and a wonderful way of

81getting to know it better. If you do write a new combinator, we would love to

54getting to know it better. If you do write a new combinator, we would love to

82−know about it! Either hop on

55+know about it! Either hop on #servant on freenode and let us know, or open an

83−[#haskell-servant on libera.chat](https://web.libera.chat/#haskell-servant) and

84−let us know, or open an issue with the `news` tag (which we will close when we

56+issue with the `news` tag (which we will close when we read it).

85−read it).

86

57

87As for adding them to the main repo: maintaining combinators can be expensive,

58As for adding them to the main repo: maintaining combinators can be expensive,

88since official combinators must have instances for all classes (and new classes

59since official combinators must have instances for all classes (and new classes

@@ -105,7 +76,7 @@ the `news` label if you make a new package so we can know about it!

105

76

106## Release policy

77## Release policy

107

78

108−We are currently moving to a more aggressive release policy, so that you can get

79+We are currently moving to a more aggresive release policy, so that you can get

109what you contribute from Hackage fairly soon. However, note that prior to major

80what you contribute from Hackage fairly soon. However, note that prior to major

110releases it may take some time in between releases.

81releases it may take some time in between releases.

111

82

README.md+36−27

@@ -4,18 +4,37 @@

4

5## Getting Started

6

7−We have a [tutorial](http://docs.servant.dev/en/stable/tutorial/index.html) that

7+We have a [tutorial](http://haskell-servant.readthedocs.org/en/stable/tutorial/index.html) that

8introduces the core features of servant. After this article, you should be able

9to write your first servant webservices, learning the rest from the haddocks'

10examples.

11

12−The core documentation can be found [here](http://docs.servant.dev/).

12+The central documentation can be found [here](http://haskell-servant.readthedocs.org/).

13Other blog posts, videos and slides can be found on the

14−[website](http://www.servant.dev/).

14+[website](http://haskell-servant.github.io/).

15

16−If you need help, drop by the IRC channel (#haskell-servant on libera.chat) or [mailing

16+If you need help, drop by the IRC channel (#servant on freenode) or [mailing

17list](https://groups.google.com/forum/#!forum/haskell-servant).

18

19+## Version history

20+

21+This table lists the versions of some `servant-` libraries at the point of

22+release of `servant` package.

23+

24+| | **0.10** | **0.11** | **0.12** |

25+| ------------------- | -------- |----------|----------|

26+| servant | 0.10 | 0.11 | 0.12 |

27+| servant-blaze | 0.7.1 | ? | ? |

28+| servant-cassava | 0.7 | ? | ? |

29+| servant-client | 0.10 | 0.11 | 0.12 |

30+| servant-docs | 0.10 | 0.11 | 0.11.1 |

31+| servant-foreign | 0.10 | 0.10.0.1 | 0.10.2 |

32+| servant-js | 0.9.1 | ? | ? |

33+| servant-lucid | 0.7.1 | ? | ? |

34+| servant-mock | 0.8.1.1 | ? | ? |

35+| servant-server | 0.10 | 0.11 | 0.12 |

36+| servant-swagger | 1.1.2.1 | ? | ? |

37+

19## Contributing

38## Contributing

20

39

21See `CONTRIBUTING.md`

40See `CONTRIBUTING.md`

@@ -24,7 +43,7 @@ See `CONTRIBUTING.md`

24

43

25- Update changelog and bump versions in `master`

44- Update changelog and bump versions in `master`

26 - `git log --oneline v0.12.. | grep 'Merge pull request'` is a good starting point (use correct previous release tag)

45 - `git log --oneline v0.12.. | grep 'Merge pull request'` is a good starting point (use correct previous release tag)

27−- Create a release branch, e.g. `release-0.13`

46+- Create a release branch, e.g. `release-0.13`, and *protect it* from accidental force pushes.

28 - Release branch is useful for backporting fixes from `master`

47 - Release branch is useful for backporting fixes from `master`

29- Smoke test in [`servant-universe`](https://github.com/phadej/servant-universe)

48- Smoke test in [`servant-universe`](https://github.com/phadej/servant-universe)

30 - `git submodule foreach git checkout master` and `git submodule foreach git pull` to get newest of everything.

49 - `git submodule foreach git checkout master` and `git submodule foreach git pull` to get newest of everything.

@@ -32,7 +51,7 @@ See `CONTRIBUTING.md`

32 - It's a good idea to separate these steps, as tests often pass, if they compile :)

51 - It's a good idea to separate these steps, as tests often pass, if they compile :)

33 - See `cabal.project` to selectively `allow-newer`

52 - See `cabal.project` to selectively `allow-newer`

34 - If some packages are broken, on your discretisation there are two options:

53 - If some packages are broken, on your discretisation there are two options:

35− - Fix them and make PRs: it's a good idea to test against older `servant` version too.

54+ - Fix them and make PRs: it's good idea to test against older `servant` version too.

36 - Temporarily comment out broken package

55 - Temporarily comment out broken package

37 - If you make a commit for `servant-universe`, you can use it as submodule in private projects to test even more

56 - If you make a commit for `servant-universe`, you can use it as submodule in private projects to test even more

38- When ripples are cleared out:

57- When ripples are cleared out:

@@ -40,32 +59,22 @@ See `CONTRIBUTING.md`

40 - `git push --tags`

59 - `git push --tags`

41 - `cabal sdist` and `cabal upload`

60 - `cabal sdist` and `cabal upload`

42

61

43−## TechEmpower framework benchmarks

62+## travis

44

63

45−We develop and maintain the servant TFB entry in https://github.com/haskell-servant/FrameworkBenchmarks/

64+`.travis.yml` is generated using `make-travis-yml` tool, in

65+[multi-ghc-travis](https://github.com/haskell-hvr/multi-ghc-travis) repository.

46

66

47−To verify (i.e. compile and test that it works)

67+To regenerate the script use (*note:* atm you need to comment `doc/cookbook/` packages).

48

68

49−```sh

50−./tfb --mode verify --test servant servant-beam servant-psql-simple --type json plaintext db fortune

51```

69```

52−

70+runghc ~/Documents/other-haskell/multi-ghc-travis/make_travis_yml_2.hs regenerate

53−To compare with `warp`

54−

55−```sh

56−./tfb --mode benchmark --test warp servant servant-beam servant-psql-simple --type json plaintext db fortune

57```

71```

58

72

59−To compare with `reitit` (Clojure framework)

73+In case Travis jobs fail due failing build of dependency, you can temporarily

74+add `constraints` to the `cabal.project`, and regenerate the `.travis.yml`.

75+For example, the following will disallow single `troublemaker-13.37` package version:

60

76

61−```sh

62−./tfb --mode benchmark --test reitit reitit-async reitit-jdbc servant servant-beam servant-psql-simple --type json plaintext db fortune

63```

77```

64−

78+constraints:

65−You can see the visualised results at https://www.techempower.com/benchmarks/#section=test

79+ troublemaker <13.37 && > 13.37

66−

80+```

67−## Nix

68−

69−A developer shell.nix file is provided in the `nix` directory

70−

71−See [nix/README.md](nix/README.md)

cabal.ghcjs.projectdeleted−14

@@ -1,14 +0,0 @@

1−-- Using https://launchpad.net/~hvr/+archive/ubuntu/ghcjs

2−

3−packages:

4− servant/

5− servant-client/

6− servant-client-core/

7−

8−-- we need to tell cabal we are using GHCJS

9−compiler: ghcjs

10−tests: True

11−

12−-- Constraints so that reflex-platform provided packages are selected.

13−constraints: attoparsec == 0.13.2.2

14−constraints: hashable == 1.3.0.0

cabal.make-travis-ymlnew file+14

@@ -0,0 +1,14 @@

1+folds: all-but-test

2+branches: master

3+

4+-- We have inplace packages (servant-js) so we skip installing dependencies in a separate step

5+install-dependencies-step: False

6+

7+-- this speed-ups the build a little, but we have to check these for release

8+no-tests-no-benchmarks: False

9+

10+-- Don't run cabal check, as cookbook examples won't pass it

11+cabal-check: False

12+

13+-- ghc-options: -j2

14+jobs: :2

cabal.project+14−33

@@ -1,53 +1,34 @@

1−packages:

1+packages: servant/

2− servant/

3− servant-auth/servant-auth

4− servant-auth/servant-auth-client

5− servant-auth/servant-auth-docs

6− servant-auth/servant-auth-server

7− servant-auth/servant-auth-swagger

8−

9 servant-client/

2 servant-client/

10 servant-client-core/

3 servant-client-core/

11− servant-http-streams/

12 servant-docs/

4 servant-docs/

13 servant-foreign/

5 servant-foreign/

14 servant-server/

6 servant-server/

15− servant-swagger/

16 doc/tutorial/

7 doc/tutorial/

17

8

18−-- servant streaming

9+ -- doc/cookbook/*/*.cabal

19−packages:

20− servant-machines/

21− servant-conduit/

22− servant-pipes/

23−

24−-- servant GHCJS

25−-- packages:

26−-- servant-jsaddle/

27

10

28−-- Cookbooks

29−packages:

30 doc/cookbook/basic-auth

11 doc/cookbook/basic-auth

31− doc/cookbook/curl-mock

32− doc/cookbook/custom-errors

33− doc/cookbook/basic-streaming

34 doc/cookbook/db-postgres-pool

12 doc/cookbook/db-postgres-pool

35 doc/cookbook/db-sqlite-simple

13 doc/cookbook/db-sqlite-simple

36 doc/cookbook/file-upload

14 doc/cookbook/file-upload

37 doc/cookbook/generic

15 doc/cookbook/generic

38− doc/cookbook/hoist-server-with-context

39 doc/cookbook/https

16 doc/cookbook/https

40 doc/cookbook/jwt-and-basic-auth

17 doc/cookbook/jwt-and-basic-auth

41 doc/cookbook/pagination

18 doc/cookbook/pagination

42− -- doc/cookbook/sentry

43− -- Commented out because servant-quickcheck currently doesn't build.

44− -- doc/cookbook/testing

45− doc/cookbook/uverb

46 doc/cookbook/structuring-apis

19 doc/cookbook/structuring-apis

47 doc/cookbook/using-custom-monad

20 doc/cookbook/using-custom-monad

48 doc/cookbook/using-free-client

21 doc/cookbook/using-free-client

49− -- doc/cookbook/open-id-connect

50

22

51−tests: True

23+allow-newer:

52−optimization: False

24+ servant-auth-server:http-types,

53−-- reorder-goals: True

25+ servant-auth-server:servant-server

26+

27+constraints:

28+ -- see https://github.com/haskell-infra/hackage-trustees/issues/119

29+ foundation >=0.0.14,

30+ memory <0.14.12 || >0.14.12

31+

32+allow-newer:

33+ servant-pagination:servant,

34+ servant-pagination:servant-server

changelog.d/1432deleted−9

@@ -1,9 +0,0 @@

1−synopsis: Fixes encoding of URL parameters in servant-client

2−prs: #1432

3−issues: #1418

4−description: {

5−Some applications use query parameters to pass arbitrary (non-unicode) binary

6−data. This change modifies how servant-client handles query parameters, so

7−that application developers can use `ToHttpApiData` to marshal binary data into

8−query parameters.

9−}

changelog.d/1469deleted−11

@@ -1,11 +0,0 @@

1−synopsis: Derive HasClient good response status from Verb status

2−prs: #1469

3−description: {

4−`HasClient` instances for the `Verb` datatype use `runRequest` in

5−`clientWithRoute` definitions.

6−This means that a request performed with `runClientM` will be successful if and

7−only if the endpoint specify a response status code >=200 and <300.

8−This change replaces `runRequest` with `runRequestAcceptStatus` in `Verb`

9−instances for the `HasClient` class, deriving the good response status from

10−the `Verb` status.

11−}

changelog.d/1477deleted−9

@@ -1,9 +0,0 @@

1−synopsis: Enable FlexibleContexts in Servant.API.ContentTypes

2−prs: #1477

3−

4−description: {

5−

6−Starting with GHC 9.2, UndecidableInstances no longer implies FlexibleContexts.

7−Add this extension where it's needed to make compilation succeed.

8−

9−}

changelog.d/1529deleted−10

@@ -1,10 +0,0 @@

1−synopsis: Fix performRequest in servant-client-ghcjs

2−prs: #1529

3−

4−description: {

5−

6−performRequest function in servant-client-ghcjs was not compatible with the

7−latest RunClient typeclass. Added the acceptStatus parameter and fixed the

8−functionality to match what servant-client provides.

9−

10−}

changelog.d/1556deleted−81

@@ -1,81 +0,0 @@

1−synopsis: Display capture hints in router layout

2−prs: #1556

3−

4−description: {

5−

6−This PR enhances the `Servant.Server.layout` function, which produces a textual description of the routing layout of an API. More precisely, it changes `<capture>` blocks, so that they display the name and type of the variable being captured instead.

7−

8−Example:

9−

10−For the following API

11−```haskell

12−type API =

13− "a" :> "d" :> Get '[JSON] NoContent

14− :<|> "b" :> Capture "x" Int :> Get '[JSON] Bool

15− :<|> "a" :> "e" :> Get '[JSON] Int

16−```

17−

18−we previously got the following output:

19−

20−```

21−/

22−├─ a/

23−│ ├─ d/

24−│ │ └─•

25−│ └─ e/

26−│ └─•

27−└─ b/

28− └─ <capture>/

29− ├─•

30− ┆

31− └─•

32−```

33−

34−now we get:

35−

36−```

37−/

38−├─ a/

39−│ ├─ d/

40−│ │ └─•

41−│ └─ e/

42−│ └─•

43−└─ b/

44− └─ <x::Int>/

45− ├─•

46− ┆

47− └─•

48−```

49−

50−This change is achieved by the introduction of a CaptureHint type, which is passed as an extra argument to the CaptureRouter and CaptureAllRouter constructors for the Router' type.

51−CaptureHint values are then used in routerLayout, to display the name and type of captured values, instead of just `<capture>` previously.

52−

53−N.B.:

54−Because the choice smart constructor for routers can aggregate Capture combinators with different capture hints, the Capture*Router constructors actually take a list of CaptureHint, instead of a single one.

55−

56−This PR also introduces Spec tests for the routerLayout function.

57−

58−Warning:

59−This change is potentially breaking, because it adds the constraint `Typeable a` to all types that are to be captured. Because all types are typeable since GHC 7.10, this is not as bad as it sounds ; it only break expressions where `a` is quantified in an expression with `Capture a`.

60−In those cases, the fix is easy: it suffices to add `Typeable a` to the left-hand side of the quantification constraint.

61−

62−For instance, the following code will no longer compile:

63−```haskell

64−type MyAPI a = Capture "foo" a :> Get '[JSON] ()

65−

66−myServer :: forall a. Server (MyAPI a)

67−myServer = const $ return ()

68−

69−myApi :: forall a. Proxy (MyAPI a)

70−myApi = Proxy

71−

72−app :: forall a. (FromHttpApiData a) => Application

73−app = serve (myApi @a) (myServer @a)

74−```

75−

76−Indeed, `app` should be replaced with:

77−```haskell

78−app :: forall a. (FromHttpApiData a, Typeable a) => Application

79−app = serve (myApi @a) (myServer @a)

80−```

81−}

changelog.d/1569deleted−13

@@ -1,13 +0,0 @@

1−synopsis: Encode captures using toEncodedUrlPiece

2−prs: #1569

3−issues: #1511

4−

5−description: {

6−The `servant-client` library now makes direct use of `toEncodedUrlPiece` from `ToHttpApiData`

7−to encode captured values when building the request path. It gives user freedom to implement

8−URL-encoding however they need.

9−

10−Previous behavior was to use `toUrlPiece` and URL-encode its output using `toEncodedUrlPiece`

11−from the `Text` instance of `ToHttpApiData`. The issue with this approach is that

12−`ToHttpApiData Text` is overly zealous and also encodes characters, such as `*`, which are perfectly valid in a URL.

13−}

changelog.d/1580deleted−12

@@ -1,12 +0,0 @@

1−synopsis: Allow IO in validationKeys

2−prs: #1580

3−issues: #1579

4−

5−description: {

6−

7−Currently validationKeys are a fixed JWKSet. This does not work with OIDC

8−providers such as AWS Cognito or Okta, which regularly fetching jwks_uri to

9−discover new and expired keys.

10−

11−This change alters the type of validationKeys from JWKSet to IO JWKSet.

12−}

changelog.d/1589deleted−2

@@ -1,2 +0,0 @@

1−synopsis: Only include question mark for nonempty query strings

2−prs: 1589

changelog.d/1595deleted−2

@@ -1,2 +0,0 @@

1−synopsis: Run ClientEnv's makeClientRequest in IO.

2−prs: #1595

changelog.d/configdeleted−2

@@ -1,2 +0,0 @@

1−organization: haskell-servant

2−repository: servant

changelog.d/servant-docs-curldeleted−16

@@ -1,16 +0,0 @@

1−synopsis: Add sample cURL requests to generated documentation

2−prs: #1401

3−

4−description: {

5−

6−Add sample cURL requests to generated documentation.

7−

8−Those supplying changes to the Request `header` field manually using

9−lenses will need to add a sample bytestring value.

10−

11−`headers <>~ ["unicorn"]`

12−

13−becomes

14−

15−`headers <>~ [("unicorn", "sample value")]`

16−}

default.nixdeleted−38

@@ -1,38 +0,0 @@

1−with (builtins.fromJSON (builtins.readFile ./nix/nixpkgs.json));

2−{

3− pkgs ? import (builtins.fetchTarball {

4− url = "https://github.com/NixOS/nixpkgs/archive/${rev}.tar.gz";

5− inherit sha256;

6− }) {}

7−, compiler ? "ghc883"

8−}:

9−let

10− overrides = self: super: {

11− servant = self.callCabal2nix "servant" ./servant {};

12− servant-docs = self.callCabal2nix "servant-docs" ./servant-docs {};

13− servant-pipes = self.callCabal2nix "servant-pipes" ./servant-pipes {};

14− servant-server = self.callCabal2nix "servant-server" ./servant-server {};

15− servant-client = self.callCabal2nix "servant-client" ./servant-client {};

16− servant-foreign = self.callCabal2nix "servant-foreign" ./servant-foreign {};

17− servant-conduit = self.callCabal2nix "servant-conduit" ./servant-conduit {};

18− servant-machines = self.callCabal2nix "servant-machines" ./servant-machines {};

19− servant-client-core = self.callCabal2nix "servant-client-core" ./servant-client-core {};

20− servant-http-streams = self.callCabal2nix "servant-http-streams" ./servant-http-streams {};

21− };

22− hPkgs = pkgs.haskell.packages.${compiler}.override { inherit overrides; };

23−in

24− with hPkgs;

25− {

26− inherit

27− servant

28− servant-client

29− servant-client-core

30− servant-conduit

31− servant-docs

32− servant-foreign

33− servant-http-streams

34− servant-machines

35− servant-pipes

36− servant-server;

37− }

38−

doc/Makefile+1−3

@@ -10,8 +10,6 @@ BUILDDIR = _build

10

11# Put it first so that "make" without argument is like "make help".

12help:

13− @if [ ! -d venv ]; then echo "WARNING: There is no venv directory, did you forget to 'virtualenv venv'. Check README.md."; fi

14− @if [ ! "z$$(which $(SPHINXBUILD))" = "z$$(pwd)/venv/bin/sphinx-build" ]; then echo "WARNING: Did you forgot to 'source venv/bin/activate'"; fi

15 @$(SPHINXBUILD) -M help "$(SOURCEDIR)" "$(BUILDDIR)" $(SPHINXOPTS) $(O)

13 @$(SPHINXBUILD) -M help "$(SOURCEDIR)" "$(BUILDDIR)" $(SPHINXOPTS) $(O)

16

14

17.PHONY: help Makefile

15.PHONY: help Makefile

@@ -19,4 +17,4 @@ help:

19# Catch-all target: route all unknown targets to Sphinx using the new

17# Catch-all target: route all unknown targets to Sphinx using the new

20# "make mode" option. $(O) is meant as a shortcut for $(SPHINXOPTS).

18# "make mode" option. $(O) is meant as a shortcut for $(SPHINXOPTS).

21%: Makefile

19%: Makefile

22− @$(SPHINXBUILD) -M $@ "$(SOURCEDIR)" "$(BUILDDIR)" $(SPHINXOPTS) $(O)

20+ @$(SPHINXBUILD) -M $@ "$(SOURCEDIR)" "$(BUILDDIR)" $(SPHINXOPTS) $(O)

doc/README.mddeleted−8

@@ -1,8 +0,0 @@

1−To build the docs locally:

2−

3− $ virtualenv venv

4− $ . ./venv/bin/activate

5− $ pip install -r requirements.txt

6− $ make html

7−

8−Docs will be built in _build/html/index.html .

doc/building-the-docsnew file+8

@@ -0,0 +1,8 @@

1+To build the docs locally:

2+

3+$ virtualenv venv

4+$ . ./venv/bin/activate

5+$ pip install -r requirements.txt

6+$ make html

7+

8+Docs will be built in _build/html/index.html .

doc/conf.py+3−1

@@ -46,7 +46,7 @@ master_doc = 'index'

46

47# General information about the project.

48project = u'Servant'

49−copyright = u'2022, Servant Contributors'

49+copyright = u'2018, Servant Contributors'

50author = u'Servant Contributors'

51

52# The version info for the project you're documenting, acts as replacement for

@@ -167,5 +167,7 @@ texinfo_documents = [

167# -- Markdown -------------------------------------------------------------

168

169source_parsers = {

170+ '.md': CommonMarkParser,

170 '.lhs': CommonMarkParser,

171 '.lhs': CommonMarkParser,

171}

172}

173+

doc/cookbook/basic-auth/basic-auth.cabal+4−4

@@ -1,14 +1,14 @@

1−cabal-version: 2.2

2name: cookbook-basic-auth

1name: cookbook-basic-auth

3version: 0.1

2version: 0.1

4synopsis: Basic Authentication cookbook example

3synopsis: Basic Authentication cookbook example

5−homepage: http://docs.servant.dev/

4+homepage: http://haskell-servant.readthedocs.org/

6−license: BSD-3-Clause

5+license: BSD3

7license-file: ../../../servant/LICENSE

6license-file: ../../../servant/LICENSE

8author: Servant Contributors

7author: Servant Contributors

9maintainer: haskell-servant-maintainers@googlegroups.com

8maintainer: haskell-servant-maintainers@googlegroups.com

10build-type: Simple

9build-type: Simple

10+cabal-version: >=1.10

11−tested-with: GHC==8.6.5, GHC==8.8.3, GHC ==8.10.7

11+tested-with: GHC==8.0.2, GHC==8.2.2, GHC==8.4.3

12

13executable cookbook-basic-auth

14 main-is: BasicAuth.lhs

doc/cookbook/basic-streaming/Streaming.lhsdeleted−129

@@ -1,129 +0,0 @@

1−# Streaming out-of-the-box

2−

3−In other words, without streaming libraries.

4−

5−## Introduction

6−

7−- Servant supports streaming

8−- Some basic usage doesn't require usage of streaming libraries,

9− like `conduit`, `pipes`, `machines` or `streaming`.

10− We have bindings for them though.

11−- Similar example is bundled with each of our streaming library interop packages (see

12−[servant-pipes](https://github.com/haskell-servant/servant/blob/master/servant-pipes/example/Main.hs),

13−[servant-conduit](https://github.com/haskell-servant/servant/blob/master/servant-conduit/example/Main.hs) and

14−[servant-machines](https://github.com/haskell-servant/servant/blob/master/servant-machines/example/Main.hs))

15−- `SourceT` doesn't have *Prelude* with handy combinators, so we have to write

16− things ourselves. (Note to self: `mapM` and `foldM` would be handy to have).

17−

18−## Code

19−

20−```haskell

21−{-# LANGUAGE BangPatterns #-}

22−{-# LANGUAGE DataKinds #-}

23−{-# LANGUAGE DeriveGeneric #-}

24−{-# LANGUAGE TypeOperators #-}

25−module Main (main) where

26−

27−import Control.Concurrent

28− (threadDelay)

29−import Control.Monad.IO.Class

30− (MonadIO (..))

31−import qualified Data.ByteString as BS

32−import Data.Maybe

33− (fromMaybe)

34−import Network.HTTP.Client

35− (defaultManagerSettings, newManager)

36−import Network.Wai

37− (Application)

38−import System.Environment

39− (getArgs, lookupEnv)

40−import Text.Read

41− (readMaybe)

42−

43−import Servant

44−import Servant.Client.Streaming

45−import qualified Servant.Types.SourceT as S

46−

47−import qualified Network.Wai.Handler.Warp as Warp

48−

49−type FastAPI = "get" :> Capture "num" Int :> StreamGet NewlineFraming JSON (SourceIO Int)

50−

51−type API = FastAPI

52− :<|> "slow" :> Capture "num" Int :> StreamGet NewlineFraming JSON (SourceIO Int)

53− -- monad can be ResourceT IO too.

54− :<|> "readme" :> StreamGet NoFraming OctetStream (SourceIO BS.ByteString)

55− -- we can have streaming request body

56− :<|> "proxy"

57− :> StreamBody NoFraming OctetStream (SourceIO BS.ByteString)

58− :> StreamPost NoFraming OctetStream (SourceIO BS.ByteString)

59−

60−api :: Proxy API

61−api = Proxy

62−

63−server :: Server API

64−server = fast :<|> slow :<|> readme :<|> proxy where

65− fast n = liftIO $ do

66− putStrLn $ "/get/" ++ show n

67− return $ fastSource n

68−

69− slow n = liftIO $ do

70− putStrLn $ "/slow/" ++ show n

71− return $ slowSource n

72−

73− readme = liftIO $ do

74− putStrLn "/proxy"

75− return (S.readFile "README.md")

76−

77− proxy c = liftIO $ do

78− putStrLn "/proxy"

79− return c

80−

81− -- for some reason unfold leaks?

82− fastSource = S.fromStepT . mk where

83− mk m

84− | m < 0 = S.Stop

85− | otherwise = S.Yield m (mk (m - 1))

86−

87− slowSource m = S.mapStepT delay (fastSource m) where

88− delay S.Stop = S.Stop

89− delay (S.Error err) = S.Error err

90− delay (S.Skip s) = S.Skip (delay s)

91− delay (S.Effect ms) = S.Effect (fmap delay ms)

92− delay (S.Yield x s) = S.Effect $

93− S.Yield x (delay s) <$ threadDelay 1000000

94−

95−app :: Application

96−app = serve api server

97−

98−cli :: Client ClientM FastAPI

99−cli :<|> _ :<|> _ :<|> _ = client api

100−

101−main :: IO ()

102−main = do

103− args <- getArgs

104− case args of

105− ("server":_) -> do

106− putStrLn "Starting cookbook-basic-streaming at http://localhost:8000"

107− port <- fromMaybe 8000 . (>>= readMaybe) <$> lookupEnv "PORT"

108− Warp.run port app

109− ("client":ns:_) -> do

110− n <- maybe (fail $ "not a number: " ++ ns) pure $ readMaybe ns

111− mgr <- newManager defaultManagerSettings

112− burl <- parseBaseUrl "http://localhost:8000/"

113− withClientM (cli n) (mkClientEnv mgr burl) $ \me -> case me of

114− Left err -> print err

115− Right src -> do

116− x <- S.unSourceT src (go (0 :: Int))

117− print x

118− where

119− go !acc S.Stop = return acc

120− go !acc (S.Error err) = print err >> return acc

121− go !acc (S.Skip s) = go acc s

122− go !acc (S.Effect ms) = ms >>= go acc

123− go !acc (S.Yield _ s) = go (acc + 1) s

124− _ -> do

125− putStrLn "Try:"

126− putStrLn "cabal new-run cookbook-basic-streaming server"

127− putStrLn "cabal new-run cookbook-basic-streaming client 10"

128− putStrLn "time curl -H 'Accept: application/json' localhost:8000/slow/5"

129−```

doc/cookbook/basic-streaming/basic-streaming.cabaldeleted−28

@@ -1,28 +0,0 @@

1−cabal-version: 2.2

2−name: cookbook-basic-streaming

3−version: 2.1

4−synopsis: Streaming in servant without streaming libs

5−homepage: http://docs.servant.dev/

6−license: BSD-3-Clause

7−license-file: ../../../servant/LICENSE

8−author: Servant Contributors

9−maintainer: haskell-servant-maintainers@googlegroups.com

10−build-type: Simple

11−tested-with: GHC==8.6.5, GHC==8.8.3, GHC ==8.10.7

12−

13−executable cookbook-basic-streaming

14− main-is: Streaming.lhs

15− build-tool-depends: markdown-unlit:markdown-unlit

16− default-language: Haskell2010

17− ghc-options: -Wall -pgmL markdown-unlit -threaded -rtsopts

18−

19− hs-source-dirs: .

20− build-depends: base >= 4.8 && <5

21− , aeson

22− , bytestring

23− , servant

24− , servant-server

25− , servant-client

26− , http-client

27− , wai

28− , warp

doc/cookbook/cabal.project−6

@@ -1,19 +1,13 @@

1packages:

2 basic-auth/

3− curl-mock/

4− db-mysql-basics/

5 db-sqlite-simple/

3 db-sqlite-simple/

6 db-postgres-pool/

4 db-postgres-pool/

7 using-custom-monad/

5 using-custom-monad/

8 jwt-and-basic-auth/

6 jwt-and-basic-auth/

9− hoist-server-with-context/

10 file-upload/

7 file-upload/

11 structuring-apis/

8 structuring-apis/

12 https/

9 https/

13 pagination/

10 pagination/

14− sentry/

15− testing/

16− open-id-connect/

17 ../../servant

11 ../../servant

18 ../../servant-server

12 ../../servant-server

19 ../../servant-client-core

13 ../../servant-client-core

doc/cookbook/cabal.project.localdeleted

No changes to the content.

doc/cookbook/curl-mock/CurlMock.lhsdeleted−205

@@ -1,205 +0,0 @@

1−# Generating mock curl calls

2−

3−In this example we will generate curl requests with mock post data from a servant API.

4−This may be useful for testing and development purposes.

5−Especially post requests with a request body are tedious to send manually.

6−

7−Also, we will learn how to use the servant-foreign library to generate stuff from servant APIs.

8−

9−

10−Language extensions and imports:

11−``` haskell

12−{-# LANGUAGE DataKinds #-}

13−{-# LANGUAGE DeriveGeneric #-}

14−{-# LANGUAGE FlexibleContexts #-}

15−{-# LANGUAGE FlexibleInstances #-}

16−{-# LANGUAGE GeneralizedNewtypeDeriving #-}

17−{-# LANGUAGE MultiParamTypeClasses #-}

18−{-# LANGUAGE OverloadedStrings #-}

19−{-# LANGUAGE RankNTypes #-}

20−{-# LANGUAGE RecordWildCards #-}

21−{-# LANGUAGE ScopedTypeVariables #-}

22−{-# LANGUAGE TypeOperators #-}

23−

24−import Control.Lens ((^.))

25−import Data.Aeson

26−import Data.Aeson.Text

27−import Data.Proxy (Proxy (Proxy))

28−import Data.Text (Text)

29−import Data.Text.Encoding (decodeUtf8)

30−import qualified Data.Text.IO as T.IO

31−import qualified Data.Text.Lazy as LazyT

32−import GHC.Generics

33−import Servant ((:<|>), (:>), Get, JSON,

34− Post, ReqBody)

35−import Servant.Foreign (Foreign, GenerateList,

36− HasForeign, HasForeignType, Req,

37− Segment, SegmentType (Cap, Static),

38− argName, listFromAPI, path,

39− reqBody, reqMethod, reqUrl, typeFor,

40− unPathSegment, unSegment,)

41−import Test.QuickCheck.Arbitrary

42−import Test.QuickCheck.Arbitrary.Generic

43−import Test.QuickCheck.Gen (generate)

44−import qualified Data.Text as T

45−

46−```

47−

48−

49−Let's define our API:

50−

51−``` haskell

52−type UserAPI = "users" :> Get '[JSON] [User]

53− :<|> "new" :> "user" :> ReqBody '[JSON] User :> Post '[JSON] ()

54−

55−data User = User

56− { name :: String

57− , age :: Int

58− , email :: String

59− } deriving (Eq, Show, Generic)

60−

61−instance Arbitrary User where

62− arbitrary = genericArbitrary

63− shrink = genericShrink

64−instance ToJSON User

65−instance FromJSON User

66−```

67−

68−Notice the `Arbitrary User` instance which we will later need to create mock data.

69−

70−Also, the obligatory servant boilerplate:

71−

72−``` haskell

73−api :: Proxy UserAPI

74−api = Proxy

75−```

76−

77−

78−## servant-foreign and the HasForeignType Class

79−

80−Servant-foreign allows us to look into the API we designed.

81−The entry point is `listFromAPI` which takes three types and returns a list of endpoints:

82−

83−``` haskell ignore

84−listFromAPI :: (HasForeign lang ftype api, GenerateList ftype (Foreign ftype api)) => Proxy lang -> Proxy ftype -> Proxy api -> [Req ftype]

85−```

86−

87−This looks a bit confusing...

88−[Here](https://hackage.haskell.org/package/servant-foreign/docs/Servant-Foreign.html#t:HasForeign) is the documentation for the `HasForeign` typeclass.

89−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.

90−

91−In our case we want to create a mock of every type `a`.

92−

93−We create a new datatype that holds our mocked value. Well, not the mocked value itself. To mock it we need IO (random). So the promise of a mocked value after some IO is performed:

94−

95−``` haskell

96−data NoLang

97−

98−data Mocked = Mocked (IO Text)

99−```

100−

101−Now, we create an instance of `HasForeignType` for `NoLang` and `Mocked` for every `a` that implements `ToJSON` and `Arbitrary`:

102−``` haskell

103−instance (ToJSON a, Arbitrary a) => HasForeignType NoLang Mocked a where

104− typeFor _ _ _ =

105− Mocked (genText (Proxy :: Proxy a))

106−```

107−

108−What does `genText` do? It generates an arbitrary value of type `a` and encodes it as text. (And does some lazy to non-lazy text transformation we do not care about):

109−

110−``` haskell

111−genText :: (ToJSON a, Arbitrary a) => Proxy a -> IO Text

112−genText p =

113− fmap (\v -> LazyT.toStrict $ encodeToLazyText v) (genArb p)

114−

115−genArb :: Arbitrary a => Proxy a -> IO a

116−genArb _ =

117− generate arbitrary

118−```

119−

120−### Generating curl calls for every endpoint

121−

122−Everything is prepared now and we can start generating some curl calls.

123−

124−``` haskell

125−generateCurl :: (GenerateList Mocked (Foreign Mocked api), HasForeign NoLang Mocked api)

126− => Proxy api

127− -> Text

128− -> IO Text

129−generateCurl p host =

130− fmap T.unlines body

131− where

132− body = mapM (generateEndpoint host)

133− $ listFromAPI (Proxy :: Proxy NoLang) (Proxy :: Proxy Mocked) p

134−```

135−

136−First, `listFromAPI` gives us a list of `Req Mocked`. Each `Req` describes one endpoint from the API type.

137−We generate a curl call for each of them using the following helper.

138−

139−``` haskell

140−generateEndpoint :: Text -> Req Mocked -> IO Text

141−generateEndpoint host req =

142− case maybeBody of

143− Just body ->

144− body >>= \b -> return $ T.intercalate " " [ "curl", "-X", method, "-d", "'" <> b <> "'"

145− , "-H 'Content-Type: application/json'", host <> "/" <> url ]

146− Nothing ->

147− return $ T.intercalate " " [ "curl", "-X", method, host <> "/" <> url ]

148− where

149− method = decodeUtf8 $ req ^. reqMethod

150−

151− url = T.intercalate "/" $ map segment (req ^. reqUrl . path)

152−

153− maybeBody = fmap (\(Mocked io) -> io) (req ^. reqBody)

154−

155−```

156−`servant-foreign` offers a multitude of lenses to be used with `Req`-values.

157−

158−`reqMethod` gives us a straigthforward `Network.HTTP.Types.Method`, `reqUrl` the url part and so on.

159−Just take a look at [the docs](https://hackage.haskell.org/package/servant-foreign/docs/Servant-Foreign.html).

160−

161−But how do we get our mocked json string? This seems to be a bit to short to be true:

162−

163−``` haskell ignore

164−maybeBody = fmap (\(Mocked io) -> io) (req ^. reqBody)

165−```

166−

167−But it is that simple!

168−The docs say `reqBody` gives us a `Maybe f`. What is `f`, you ask? As defined in `generateCurl`, `f` is `Mocked` and contains a `IO Text`. How is this `Mocked` value created? The `HasForeignType::typeFor` does it!

169−

170−Of course only if the endpoint has a request body.

171−

172−

173−Some (incomplete) code for url segments:

174−``` haskell

175−segment :: Segment Mocked -> Text

176−segment seg =

177− case unSegment seg of

178− Static p ->

179− unPathSegment p

180−

181− Cap arg ->

182− -- Left as exercise for the reader: Mock args in the url

183− unPathSegment $ arg ^. argName

184−```

185−

186−And now, lets hook it all up in our main function:

187−

188−``` haskell

189−main :: IO ()

190−main =

191− generateCurl api "localhost:8081" >>= T.IO.putStrLn

192−```

193−

194−Done:

195−

196−``` curl

197−curl -X GET localhost:8081/users

198−curl -X POST -d '{"email":"wV򝣀_b򆎘:z񁊞򲙲!(3DM V","age":10,"name":"=|W"}' -H 'Content-Type: application/json' localhost:8081/new/user

199−

200−```

201−

202−This is of course no complete curl call mock generator, many things including path arguments are missing.

203−But it correctly generates mock calls for simple POST requests.

204−

205−Also, we now know how to use `HasForeignType` and `listFromAPI` to generate anything we want.

doc/cookbook/curl-mock/curl-mock.cabaldeleted−29

@@ -1,29 +0,0 @@

1−cabal-version: 2.2

2−name: cookbook-curl-mock

3−version: 0.1

4−synopsis: Generate curl mock requests cookbook example

5−homepage: http://docs.servant.dev

6−license: BSD-3-Clause

7−license-file: ../../../servant/LICENSE

8−author: Servant Contributors

9−maintainer: haskell-servant-maintainers@googlegroups.com

10−build-type: Simple

11−tested-with: GHC==8.6.5, GHC==8.8.3, GHC ==8.10.7

12−

13−executable cookbock-curl-mock

14− if impl(ghc >= 9.2)

15− -- generic-arbitrary is incompatible

16− buildable: False

17− main-is: CurlMock.lhs

18− build-depends: base == 4.*

19− , aeson

20− , lens

21− , text

22− , servant

23− , servant-server

24− , servant-foreign

25− , QuickCheck

26− , generic-arbitrary

27− default-language: Haskell2010

28− ghc-options: -Wall -pgmL markdown-unlit

29− build-tool-depends: markdown-unlit:markdown-unlit

doc/cookbook/custom-errors/CustomErrors.lhsdeleted−189

@@ -1,189 +0,0 @@

1−# Customizing errors from Servant

2−

3−Servant handles a lot of parsing and validation of the input request. When it can't parse something: query

4−parameters, URL parts or request body, it will return appropriate HTTP codes like 400 Bad Request.

5−

6−These responses will contain the error message in their body without any formatting. However, it is often

7−desirable to be able to provide custom formatting for these error messages, for example, to wrap them in JSON.

8−

9−Recently Servant got a way to add such formatting. This Cookbook chapter demonstrates how to use it.

10−

11−Extensions and imports:

12−```haskell

13−{-# LANGUAGE DataKinds #-}

14−{-# LANGUAGE DeriveGeneric #-}

15−{-# LANGUAGE OverloadedStrings #-}

16−{-# LANGUAGE PolyKinds #-}

17−{-# LANGUAGE TypeFamilies #-}

18−{-# LANGUAGE TypeOperators #-}

19−

20−import Data.Aeson

21−import Data.Proxy

22−import Data.Text

23−import GHC.Generics

24−import Network.Wai

25−import Network.Wai.Handler.Warp

26−

27−import Servant

28−

29−import Data.String.Conversions

30− (cs)

31−import Servant.API.ContentTypes

32−```

33−

34−The API (from `greet.hs` example in Servant sources):

35−

36−```haskell

37−-- | A greet message data type

38−newtype Greet = Greet { _msg :: Text }

39− deriving (Generic, Show)

40−

41−instance FromJSON Greet

42−instance ToJSON Greet

43−

44−-- API specification

45−type TestApi =

46− -- GET /hello/:name?capital={true, false} returns a Greet as JSON

47− "hello" :> Capture "name" Text :> QueryParam "capital" Bool :> Get '[JSON] Greet

48−

49− -- POST /greet with a Greet as JSON in the request body,

50− -- returns a Greet as JSON

51− :<|> "greet" :> ReqBody '[JSON] Greet :> Post '[JSON] Greet

52−

53− -- DELETE /greet/:greetid

54− :<|> "greet" :> Capture "greetid" Text :> Delete '[JSON] NoContent

55−

56−testApi :: Proxy TestApi

57−testApi = Proxy

58−

59−-- Server-side handlers.

60−--

61−-- There's one handler per endpoint, which, just like in the type

62−-- that represents the API, are glued together using :<|>.

63−--

64−-- Each handler runs in the 'Handler' monad.

65−server :: Server TestApi

66−server = helloH :<|> postGreetH :<|> deleteGreetH

67−

68− where helloH name Nothing = helloH name (Just False)

69− helloH name (Just False) = return . Greet $ "Hello, " <> name

70− helloH name (Just True) = return . Greet . toUpper $ "Hello, " <> name

71−

72− postGreetH greet = return greet

73−

74− deleteGreetH _ = return NoContent

75−```

76−

77−## Error formatters

78−

79−`servant-server` provides an `ErrorFormatter` type to specify how the error message will be

80−formatted. A formatter is just a function accepting three parameters:

81−

82−- `TypeRep` from `Data.Typeable`: this is a runtime representation of the type of the combinator

83− (like `Capture` or `ReqBody`) that generated the error. It can be used to display its name (with

84− `show`) or even dynamically dispatch on the combinator type. See the docs for `Data.Typeable` and

85− `Type.Reflection` modules.

86−- `Request`: full information for the request that led to the error.

87−- `String`: specific error message from the combinator.

88−

89−The formatter is expected to produce a `ServerError` which will be returned from the handler.

90−

91−Additionally, there is `NotFoundErrorFormatter`, which accepts only `Request` and can customize the

92−error in case when no route can be matched (HTTP 404).

93−

94−Let's make two formatters. First one will wrap our error in a JSON:

95−

96−```json

97−{

98− "error": "ERROR MESSAGE",

99− "combinator": "NAME OF THE COMBINATOR"

100−}

101−```

102−

103−Additionally, this formatter will examine the `Accept` header of the request and generate JSON

104−message only if client can accept it.

105−

106−```haskell

107−customFormatter :: ErrorFormatter

108−customFormatter tr req err =

109− let

110− -- aeson Value which will be sent to the client

111− value = object ["combinator" .= show tr, "error" .= err]

112− -- Accept header of the request

113− accH = getAcceptHeader req

114− in

115− -- handleAcceptH is Servant's function that checks whether the client can accept a

116− -- certain message type.

117− -- In this case we call it with "Proxy '[JSON]" argument, meaning that we want to return a JSON.

118− case handleAcceptH (Proxy :: Proxy '[JSON]) accH value of

119− -- If client can't handle JSON, we just return the body the old way

120− Nothing -> err400 { errBody = cs err }

121− -- Otherwise, we return the JSON formatted body and set the "Content-Type" header.

122− Just (ctypeH, body) -> err400

123− { errBody = body

124− , errHeaders = [("Content-Type", cs ctypeH)]

125− }

126−

127−notFoundFormatter :: NotFoundErrorFormatter

128−notFoundFormatter req =

129− err404 { errBody = cs $ "Not found path: " <> rawPathInfo req }

130−```

131−

132−If you don't need to react to the `Accept` header, you can just unconditionally return the JSON like

133−this (with `encode` from `Data.Aeson`):

134−

135−```

136−err400

137− { errBody = encode body

138− , errHeaders = [("Content-Type", "application/json")]

139− }

140−```

141−

142−## Passing formatters to Servant

143−

144−Servant uses the Context to configure formatters. You only need to add a value of type

145−`ErrorFormatters` to your context. This is a record with the following fields:

146−

147−- `bodyParserErrorFormatter :: ErrorFormatter`

148−- `urlParseErrorFormatter :: ErrorFormatter`

149−- `headerParseErrorFormatter :: ErrorFormatter`

150−- `notFoundErrorFormatter :: NotFoundErrorFormatter`

151−

152−Default formatters are exported as `defaultErrorFormatters`, so you can use record update syntax to

153−set the only ones you need:

154−

155−```haskell

156−customFormatters :: ErrorFormatters

157−customFormatters = defaultErrorFormatters

158− { bodyParserErrorFormatter = customFormatter

159− , notFoundErrorFormatter = notFoundFormatter

160− }

161−```

162−

163−And at last, use `serveWithContext` to run your server as usual:

164−

165−```haskell

166−app :: Application

167−app = serveWithContext testApi (customFormatters :. EmptyContext) server

168−

169−main :: IO ()

170−main = run 8000 app

171−```

172−

173−Now if we try to request something with a wrong body, we will get a nice error:

174−

175−```

176−$ http -j POST localhost:8000/greet 'foo=bar'

177−HTTP/1.1 400 Bad Request

178−Content-Type: application/json;charset=utf-8

179−Date: Fri, 17 Jul 2020 13:34:18 GMT

180−Server: Warp/3.3.12

181−Transfer-Encoding: chunked

182−

183−{

184− "combinator": "ReqBody'",

185− "error": "Error in $: parsing Main.Greet(Greet) failed, key \"_msg\" not found"

186−}

187−```

188−

189−Notice the `Content-Type` header set by our combinator.

doc/cookbook/custom-errors/custom-errors.cabaldeleted−25

@@ -1,25 +0,0 @@

1−cabal-version: 2.2

2−name: cookbook-custom-errors

3−version: 0.1

4−synopsis: Return custom error messages from combinators

5−homepage: http://docs.servant.dev

6−license: BSD-3-Clause

7−license-file: ../../../servant/LICENSE

8−author: Servant Contributors

9−maintainer: haskell-servant-maintainers@googlegroups.com

10−build-type: Simple

11−tested-with: GHC==8.6.5, GHC==8.8.3, GHC ==8.10.7

12−

13−executable cookbook-custom-errors

14− main-is: CustomErrors.lhs

15− build-depends: base == 4.*

16− , aeson

17− , servant

18− , servant-server

19− , string-conversions

20− , text

21− , wai

22− , warp

23− default-language: Haskell2010

24− ghc-options: -Wall -pgmL markdown-unlit

25− build-tool-depends: markdown-unlit:markdown-unlit

doc/cookbook/db-mysql-basics/MysqlBasics.lhsdeleted−236

@@ -1,236 +0,0 @@

1−# Overview

2−

3−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.

4−

5−Once you can wrap your head around this implementation, understanding more complex features like resource pools would be beneficial next steps.

6−

7−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.

8−

9−## Setup

10−

11−- The mysql database should be up and running on 127.0.0.1:3306

12−

13−- Our API will be exposed on localhost:8080

14−

15−## REST actions available

16−

17−*Get all people*

18−

19−```

20−/people GET

21−```

22−

23−*Get person by ID*

24−

25−```

26−/people/:id GET

27−```

28−

29−*Insert a new person*

30−

31−```

32−/people POST

33−

34−{

35− "name": "NewName",

36− "age": 24

37−}

38−```

39−

40−*Delete a person*

41−

42−```

43−/people/:id DELETE

44−```

45−

46−## Other notes

47−

48−At the time of writing this issue may occur when building your project:

49−

50−```

51−setup: Missing dependencies on foreign libraries:

52−* Missing (or bad) C libraries: ssl, crypto

53−```

54−

55−If using stack, this can be fixed by adding the following lines to your `stack.yaml`:

56−

57−```

58−extra-include-dirs:

59−- /usr/local/opt/openssl/include

60−extra-lib-dirs:

61−- /usr/local/opt/openssl/lib

62−```

63−

64−Or for cabal, running your builds with these configurations passed as options.

65−

66−## Implementation: Main.hs

67−

68−Let's jump in:

69−

70−```haskell

71−{-# LANGUAGE DataKinds #-}

72−{-# LANGUAGE DeriveGeneric #-}

73−{-# LANGUAGE FlexibleInstances #-}

74−{-# LANGUAGE GADTs #-}

75−{-# LANGUAGE GeneralizedNewtypeDeriving #-}

76−{-# LANGUAGE MultiParamTypeClasses #-}

77−{-# LANGUAGE QuasiQuotes #-}

78−{-# LANGUAGE TemplateHaskell #-}

79−{-# LANGUAGE TypeFamilies #-}

80−{-# LANGUAGE TypeOperators #-}

81−module Lib where

82−

83−import Control.Monad.IO.Class (liftIO)

84−import Control.Monad.Logger (NoLoggingT (..))

85−import Control.Monad.Trans.Reader (runReaderT)

86−import Control.Monad.Trans.Resource (ResourceT, runResourceT)

87−import Data.Aeson as JSON

88−import Data.Int (Int64 (..))

89−import Data.Text (Text)

90−import qualified Data.Text as T

91−import qualified Data.Text.IO as T

92−import Database.Persist

93−import Database.Persist.MySQL (ConnectInfo (..),

94− SqlBackend (..),

95− defaultConnectInfo, fromSqlKey, runMigration,

96− runSqlPool, toSqlKey, withMySQLConn)

97−import Database.Persist.Sql (SqlPersistT, runSqlConn)

98−import Database.Persist.TH (mkMigrate, mkPersist,

99− persistLowerCase, share,

100− sqlSettings)

101−import Database.Persist.Types (PersistValue(PersistInt64))

102−import Servant (Handler, throwError)

103−

104−import GHC.Generics

105−import Network.Wai

106−import Network.Wai.Handler.Warp

107−import Servant

108−import Servant.API

109−import System.Environment (getArgs)

110−

111−share [mkPersist sqlSettings, mkMigrate "migrateAll"] [persistLowerCase|

112−Person json

113− Id Int Primary Unique

114− name Text

115− age Text

116− deriving Eq Show Generic

117−|]

118−

119−type Api =

120− "person" :> Get '[JSON] [Person]

121− :<|> "person" :> Capture "id" Int :> Get '[JSON] Person

122− :<|> "person" :> Capture "id" Int :> Delete '[JSON] ()

123− :<|> "person" :> ReqBody '[JSON] Person :> Post '[JSON] Person

124−

125−apiProxy :: Proxy Api

126−apiProxy = Proxy

127−

128−app :: Application

129−app = serve apiProxy server

130−

131−-- Run a database operation, and lift the result into a Handler.

132−-- This minimises usage of IO operations in other functions

133−runDB :: SqlPersistT (ResourceT (NoLoggingT IO)) a -> Handler a

134−runDB a = liftIO $ runNoLoggingT $ runResourceT $ withMySQLConn connInfo $ runSqlConn a

135−

136−-- Change these out to suit your local setup

137−connInfo :: ConnectInfo

138−connInfo = defaultConnectInfo { connectHost = "127.0.0.1", connectUser = "root", connectPassword = "abcd", connectDatabase = "test-database" }

139−

140−doMigration :: IO ()

141−doMigration = runNoLoggingT $ runResourceT $ withMySQLConn connInfo $ runReaderT $ runMigration migrateAll

142−

143−server :: Server Api

144−server =

145− personGET :<|>

146− personGETById :<|>

147− personDELETE :<|>

148− personPOST

149− where

150− personGET = selectPersons

151− personGETById id = selectPersonById id

152− personDELETE id = deletePerson id

153− personPOST personJson = createPerson personJson

154−

155−selectPersons :: Handler [Person]

156−selectPersons = do

157− personList <- runDB $ selectList [] []

158− return $ map (\(Entity _ u) -> u) personList

159−

160−selectPersonById :: Int -> Handler Person

161−selectPersonById id = do

162− sqlResult <- runDB $ get $ PersonKey id

163− case sqlResult of

164− Just person -> return person

165− Nothing -> throwError err404 { errBody = JSON.encode "Person with ID not found." }

166−

167−createPerson :: Person -> Handler Person

168−createPerson person = do

169− attemptCreate <- runDB $ insert person

170− case attemptCreate of

171− PersonKey k -> return person

172− _ -> throwError err503 { errBody = JSON.encode "Could not create Person." }

173−

174−deletePerson :: Int -> Handler ()

175−deletePerson id = do runDB $ delete $ PersonKey id

176−

177−startApp :: IO ()

178−startApp = do

179− args <- getArgs

180− let arg1 = if not (null args) then Just (head args) else Nothing

181− case arg1 of

182− Just "migrate" -> doMigration

183− _ -> run 8080 app

184−```

185−

186−## Sample requests

187−

188−Assuming that you have the db running and have first run `stack exec run migrate`, the following sample requests will test your API:

189−

190−*Create a person*

191−

192−```bash

193−curl -X POST \

194− http://localhost:8080/person \

195− -H 'Accept: */*' \

196− -H 'Accept-Encoding: gzip, deflate' \

197− -H 'Cache-Control: no-cache' \

198− -H 'Connection: keep-alive' \

199− -H 'Content-Length: 62' \

200− -H 'Content-Type: application/json' \

201− -H 'Host: localhost:8080' \

202− -H 'cache-control: no-cache' \

203− -d '{

204− "name": "Jake",

205− "age": "25"

206−}'

207−```

208−

209−*Get all persons*

210−

211−```bash

212−curl -X GET \

213− http://localhost:8080/person \

214− -H 'Accept: */*' \

215− -H 'Accept-Encoding: gzip, deflate' \

216− -H 'Cache-Control: no-cache' \

217− -H 'Connection: keep-alive' \

218− -H 'Content-Length: 33' \

219− -H 'Content-Type: application/json' \

220− -H 'Host: localhost:8080' \

221− -H 'cache-control: no-cache'

222−```

223−

224−*Get person by ID*

225−

226−```bash

227−curl -X GET \

228− http://localhost:8080/person/1 \

229− -H 'Accept: */*' \

230− -H 'Accept-Encoding: gzip, deflate' \

231− -H 'Cache-Control: no-cache' \

232− -H 'Connection: keep-alive' \

233− -H 'Content-Type: application/json' \

234− -H 'Host: localhost:8080' \

235− -H 'cache-control: no-cache'

236−```

doc/cookbook/db-mysql-basics/mysql-basics.cabaldeleted−40

@@ -1,40 +0,0 @@

1−cabal-version: 2.2

2−name: mysql-basics

3−version: 0.1.0.0

4−synopsis: Simple MySQL API cookbook example

5−homepage: http://docs.servant.dev/

6−license: BSD-3-Clause

7−license-file: ../../../servant/LICENSE

8−author: Servant Contributors

9−maintainer: haskell-servant-maintainers@googlegroups.com

10−build-type: Simple

11−

12−executable run

13− hs-source-dirs: .

14− main-is: MysqlBasics.hs

15− ghc-options: -threaded -rtsopts -with-rtsopts=-N

16− build-depends: aeson

17− , base

18− , bytestring

19− , http-client

20− , monad-logger

21− , mysql-simple

22− , persistent

23− , persistent-mysql

24− , persistent-template

25− , resource-pool

26− , resourcet

27− , servant

28− , servant-client

29− , servant-server

30− , text

31− , transformers

32− , wai

33− , warp

34− default-language: Haskell2010

35− ghc-options: -Wall -pgmL markdown-unlit

36− build-tool-depends: markdown-unlit:markdown-unlit

37−

38−source-repository head

39− type: git

40− location: https://github.com/githubuser/mysql-basics

doc/cookbook/db-postgres-pool/db-postgres-pool.cabal+4−4

@@ -1,14 +1,14 @@

1−cabal-version: 2.2

2name: cookbook-db-postgres-pool

1name: cookbook-db-postgres-pool

3version: 0.1

2version: 0.1

4synopsis: Simple PostgreSQL connection pool cookbook example

3synopsis: Simple PostgreSQL connection pool cookbook example

5−homepage: http://docs.servant.dev/

4+homepage: http://haskell-servant.readthedocs.org/

6−license: BSD-3-Clause

5+license: BSD3

7license-file: ../../../servant/LICENSE

6license-file: ../../../servant/LICENSE

8author: Servant Contributors

7author: Servant Contributors

9maintainer: haskell-servant-maintainers@googlegroups.com

8maintainer: haskell-servant-maintainers@googlegroups.com

10build-type: Simple

9build-type: Simple

10+cabal-version: >=1.10

11−tested-with: GHC==8.6.5, GHC==8.8.3, GHC ==8.10.7

11+tested-with: GHC==8.0.2, GHC==8.2.2, GHC==8.4.3

12

13executable cookbook-db-postgres-pool

14 main-is: PostgresPool.lhs

doc/cookbook/db-sqlite-simple/db-sqlite-simple.cabal+5−5

@@ -1,14 +1,14 @@

1−cabal-version: 2.2

2name: cookbook-db-sqlite-simple

1name: cookbook-db-sqlite-simple

3version: 0.1

2version: 0.1

4synopsis: Simple SQLite DB cookbook example

3synopsis: Simple SQLite DB cookbook example

5−homepage: http://docs.servant.dev/

4+homepage: http://haskell-servant.readthedocs.org/

6−license: BSD-3-Clause

5+license: BSD3

7license-file: ../../../servant/LICENSE

6license-file: ../../../servant/LICENSE

8author: Servant Contributors

7author: Servant Contributors

9maintainer: haskell-servant-maintainers@googlegroups.com

8maintainer: haskell-servant-maintainers@googlegroups.com

10build-type: Simple

9build-type: Simple

10+cabal-version: >=1.10

11−tested-with: GHC==8.6.5, GHC==8.8.3, GHC ==8.10.7

11+tested-with: GHC==8.0.2, GHC==8.2.2, GHC==8.4.3

12

13executable cookbook-db-sqlite-simple

14 main-is: DBConnection.lhs

@@ -23,7 +23,7 @@ executable cookbook-db-sqlite-simple

23 , http-types >= 0.12

24 , markdown-unlit >= 0.4

25 , http-client >= 0.5

26− , sqlite-simple >= 0.4.5.0

26+ , sqlite-simple >= 0.4

27 , transformers

28 default-language: Haskell2010

29 ghc-options: -Wall -pgmL markdown-unlit

doc/cookbook/file-upload/FileUpload.lhs+4−4

@@ -17,7 +17,7 @@ import Control.Exception

17import Control.Monad

18import Control.Monad.IO.Class

19import Data.Text.Encoding (encodeUtf8)

20−import Network.Socket (withSocketsDo)

20+import Network (withSocketsDo)

21import Network.HTTP.Client hiding (Proxy)

22import Network.HTTP.Client.MultipartFormData

23import Network.Wai.Handler.Warp

@@ -90,8 +90,8 @@ startServer = run 8080 (serve api upload)

90

91Finally, a main function that brings up our server and

92sends some test request with `http-client` (and not

93−servant-client this time, as servant-multipart does not

93+servant-client this time, has servant-multipart does not

94−yet have support for client generation).

94+yet have support for client generation.

95

96``` haskell

97main :: IO ()

@@ -126,7 +126,7 @@ Content of "README.md"

126

127## Getting Started

128

129−We have a [tutorial](http://docs.servant.dev/en/stable/tutorial/index.html) that

129+We have a [tutorial](http://haskell-servant.readthedocs.org/en/stable/tutorial/index.html) that

130introduces the core features of servant. After this article, you should be able

131to write your first servant webservices, learning the rest from the haddocks'

132examples.

doc/cookbook/file-upload/file-upload.cabal+4−4

@@ -1,14 +1,14 @@

1−cabal-version: 2.2

2name: cookbook-file-upload

1name: cookbook-file-upload

3version: 0.1

2version: 0.1

4synopsis: File upload cookbook example

3synopsis: File upload cookbook example

5−homepage: http://docs.servant.dev/

4+homepage: http://haskell-servant.readthedocs.org/

6−license: BSD-3-Clause

5+license: BSD3

7license-file: ../../../servant/LICENSE

6license-file: ../../../servant/LICENSE

8author: Servant Contributors

7author: Servant Contributors

9maintainer: haskell-servant-maintainers@googlegroups.com

8maintainer: haskell-servant-maintainers@googlegroups.com

10build-type: Simple

9build-type: Simple

10+cabal-version: >=1.10

11−tested-with: GHC==8.6.5, GHC==8.8.3, GHC ==8.10.7

11+tested-with: GHC==8.0.2, GHC==8.2.2, GHC==8.4.3

12

13executable cookbook-file-upload

14 main-is: FileUpload.lhs

doc/cookbook/generic/Generic.lhs+7−42

@@ -7,11 +7,10 @@

7{-# LANGUAGE TypeOperators #-}

8module Main (main, api, getLink, routesLinks, cliGet) where

9

10−import Control.Exception (throwIO)

10+import Control.Exception (throwIO)

11−import Control.Monad.Trans.Reader (ReaderT, runReaderT)

12−import Data.Proxy (Proxy (..))

11+import Data.Proxy (Proxy (..))

13−import Network.Wai.Handler.Warp (run)

12+import Network.Wai.Handler.Warp (run)

14−import System.Environment (getArgs)

13+import System.Environment (getArgs)

15

14

16import Servant

15import Servant

17import Servant.Client

16import Servant.Client

@@ -43,13 +42,13 @@ api :: Proxy (ToServantApi Routes)

43api = genericApi (Proxy :: Proxy Routes)

42api = genericApi (Proxy :: Proxy Routes)

44```

43```

45

44

46−It's recommended to use `genericApi` function, as then you'll get

45+It's recommented to use `genericApi` function, as then you'll get

47better error message, for example if you forget to `derive Generic`.

46better error message, for example if you forget to `derive Generic`.

48

47

49## Links

48## Links

50

49

51The clear advantage of record-based generics approach, is that

50The clear advantage of record-based generics approach, is that

52−we can get safe links very conveniently. We don't need to define endpoint types,

51+we can get safe links very conviently. We don't need to define endpoint types,

53as field accessors work as proxies:

52as field accessors work as proxies:

54

53

55```haskell

54```haskell

@@ -67,7 +66,7 @@ routesLinks = allFieldLinks

67## Client

66## Client

68

67

69Even more power starts to show when we generate a record of client functions.

68Even more power starts to show when we generate a record of client functions.

70−Here we use `genericClientHoist` function, which lets us simultaneously

69+Here we use `genericClientHoist` function, which let us simultaneously

71hoist the monad, in this case from `ClientM` to `IO`.

70hoist the monad, in this case from `ClientM` to `IO`.

72

71

73```haskell

72```haskell

@@ -103,39 +102,5 @@ main = do

103 ("run":_) -> do

102 ("run":_) -> do

104 putStrLn "Starting cookbook-generic at http://localhost:8000"

103 putStrLn "Starting cookbook-generic at http://localhost:8000"

105 run 8000 app

104 run 8000 app

106− -- see this cookbook below for custom-monad explanation

107− ("run-custom-monad":_) -> do

108− putStrLn "Starting cookbook-generic with a custom monad at http://localhost:8000"

109− run 8000 (appMyMonad AppCustomState)

110 _ -> putStrLn "To run, pass 'run' argument: cabal new-run cookbook-generic run"

105 _ -> putStrLn "To run, pass 'run' argument: cabal new-run cookbook-generic run"

111```

106```

112−

113−## Using generics together with a custom monad

114−

115−If your app uses a custom monad, here's how you can combine it with

116−generics.

117−

118−```haskell

119−data AppCustomState =

120− AppCustomState

121−

122−type AppM = ReaderT AppCustomState Handler

123−

124−apiMyMonad :: Proxy (ToServantApi Routes)

125−apiMyMonad = genericApi (Proxy :: Proxy Routes)

126−

127−getRouteMyMonad :: Int -> AppM String

128−getRouteMyMonad = return . show

129−

130−putRouteMyMonad :: Int -> AppM Bool

131−putRouteMyMonad = return . odd

132−

133−recordMyMonad :: Routes (AsServerT AppM)

134−recordMyMonad = Routes {_get = getRouteMyMonad, _put = putRouteMyMonad}

135−

136−-- natural transformation

137−nt :: AppCustomState -> AppM a -> Handler a

138−nt s x = runReaderT x s

139−

140−appMyMonad :: AppCustomState -> Application

141−appMyMonad state = genericServeT (nt state) recordMyMonad

doc/cookbook/generic/generic.cabal+4−4

@@ -1,14 +1,14 @@

1−cabal-version: 2.2

2name: cookbook-generic

1name: cookbook-generic

3version: 0.1

2version: 0.1

4synopsis: Using custom monad to pass a state between handlers

3synopsis: Using custom monad to pass a state between handlers

5−homepage: http://docs.servant.dev/

4+homepage: http://haskell-servant.readthedocs.org/

6−license: BSD-3-Clause

5+license: BSD3

7license-file: ../../../servant/LICENSE

6license-file: ../../../servant/LICENSE

8author: Servant Contributors

7author: Servant Contributors

9maintainer: haskell-servant-maintainers@googlegroups.com

8maintainer: haskell-servant-maintainers@googlegroups.com

10build-type: Simple

9build-type: Simple

10+cabal-version: >=1.10

11−tested-with: GHC==8.6.5, GHC==8.8.3, GHC ==8.10.7

11+tested-with: GHC==8.0.2, GHC==8.2.2, GHC==8.4.3

12

13executable cookbook-using-custom-monad

14 main-is: Generic.lhs

doc/cookbook/hoist-server-with-context/HoistServerWithContext.lhsdeleted−413

@@ -1,413 +0,0 @@

1−# Hoist Server With Context for Custom Monads

2−

3−In this example we'll combine some of the patterns we've seen in other examples

4−in order to demonstrate using a custom monad with Servant's `Context` and the function

5−`hoistServerWithContext`.

6−

7−`hoistServerWithContext` is a pattern you may encounter if you are trying to use a library such as

8−[servant-auth-server](https://hackage.haskell.org/package/servant-auth-server) along

9−with your own custom monad.

10−

11−In this example, our custom monad will be based on the commonly used `ReaderT env IO a` stack.

12−We'll create an `AppCtx` to represent our `env` and include some logging utilities as well as

13−other variables we'd like to have available.

14−

15−In addition, in order to demonstrate a custom `Context`, we'll also include authentication in

16−our example. As noted previously (in [jwt-and-basic-auth](../jwt-and-basic-auth/JWTAndBasicAuth.lhs)),

17−while basic authentication comes with Servant itself,

18−[servant-auth](https://hackage.haskell.org/package/servant-auth) and

19−[servant-auth-server](https://hackage.haskell.org/package/servant-auth-server)

20−packages are needed for JWT-based authentication.

21−

22−Finally, we're going to use [fast-logger](http://hackage.haskell.org/package/fast-logger)

23−for our logging example below.

24−

25−This recipe uses the following ingredients:

26−

27−```haskell

28−{-# LANGUAGE DataKinds #-}

29−{-# LANGUAGE DeriveGeneric #-}

30−{-# LANGUAGE OverloadedStrings #-}

31−{-# LANGUAGE TypeFamilies #-}

32−{-# LANGUAGE TypeOperators #-}

33−

34−import Prelude ()

35−import Prelude.Compat

36−

37−import Control.Monad.IO.Class (liftIO)

38−import Control.Monad.Reader

39−import Data.Aeson

40−import Data.Default

41−import Data.Proxy

42−import Data.Text

43−import Data.Time.Clock ( UTCTime, getCurrentTime )

44−import GHC.Generics

45−import Network.Wai (Middleware)

46−import Network.Wai.Handler.Warp as Warp

47−import Network.Wai.Middleware.RequestLogger

48−import Network.Wai.Middleware.RequestLogger.JSON

49−import Servant as S

50−import Servant.Auth as SA

51−import Servant.Auth.Server as SAS

52−import System.Log.FastLogger ( ToLogStr(..)

53− , LoggerSet

54− , defaultBufSize

55− , newStdoutLoggerSet

56− , flushLogStr

57− , pushLogStrLn )

58−

59−

60−port :: Int

61−port = 3001

62−```

63−

64−## Custom Monad

65−

66−Let's say we'd like to create a custom monad based on `ReaderT env` in order to hold

67−access to a config object as well as some logging utilities.

68−

69−With that, we could define an `AppCtx` and `AppM` like this:

70−

71−```haskell

72−type AppM = ReaderT AppCtx Handler

73−

74−data AppCtx = AppCtx {

75− _getConfig :: SiteConfig

76− , _getLogger :: LoggerSet

77− }

78−

79−data SiteConfig = SiteConfig {

80− environment :: !Text

81− , version :: !Text

82− , adminUsername :: !Text

83− , adminPasswd :: !Text

84−} deriving (Generic, Show)

85−```

86−

87−This `SiteConfig` is a simple example: it refers to our deployment environment as well as an

88−application version. For instance, we may do something different based on the environment our app is

89−deployed into. When emitting log messages, we may want to include information about

90−the deployed version of our application.

91−

92−In addition, we're going to identify a single admin user in our config and use

93−that definition to authenticate requests inside our handlers. This is not too

94−flexible (and probably not too secure...), but it works as a simple example.

95−

96−## Logging

97−

98−A common contemporary pattern is to emit log messages as JSON for later ingestion

99−into a database like Elasticsearch.

100−

101−To emit JSON log messages, we'll create a `LogMessage` object and make it so we can turn it

102−into a JSON-encoded `LogStr` (a type from `fast-logger`).

103−

104−```haskell

105−data LogMessage = LogMessage {

106− message :: !Text

107− , timestamp :: !UTCTime

108− , level :: !Text

109− , lversion :: !Text

110− , lenvironment :: !Text

111−} deriving (Eq, Show, Generic)

112−

113−instance FromJSON LogMessage

114−instance ToJSON LogMessage where

115− toEncoding = genericToEncoding defaultOptions

116−

117−instance ToLogStr LogMessage where

118− toLogStr = toLogStr . encode

119−```

120−

121−Eventually, when we'd like to emit a log message inside one of our Handlers, it'll look like this:

122−

123−```haskell

124−sampleHandler :: AppM LogMessage

125−sampleHandler = do

126− config <- asks _getConfig

127− logset <- asks _getLogger

128−

129− tstamp <- liftIO getCurrentTime

130− let logMsg = LogMessage { message = "let's do some logging!"

131− , timestamp = tstamp

132− , level = "info"

133− , lversion = version config

134− , lenvironment = environment config

135− }

136− -- emit log message

137− liftIO $ pushLogStrLn logset $ toLogStr logMsg

138− -- return handler result (for simplicity, result is also a LogMessage)

139− pure logMsg

140−```

141−

142−## Authentication

143−

144−To demonstrate the other part of this recipe, we are going to use a simple

145−representation of a user, someone who may have access to an admin section of our site:

146−

147−```haskell

148−data AdminUser = AdminUser { name :: Text }

149− deriving (Eq, Show, Read, Generic)

150−```

151−

152−The following instances are needed for JWT:

153−

154−```haskell

155−instance ToJSON AdminUser

156−instance FromJSON AdminUser

157−instance SAS.ToJWT AdminUser

158−instance SAS.FromJWT AdminUser

159−```

160−

161−## API

162−

163−Now we can define our API.

164−

165−We'll have an `admin` endpoint and a `login` endpoint that takes a `LoginForm`:

166−

167−```haskell

168−type AdminApi =

169− "admin" :> Get '[JSON] LogMessage

170−

171−type LoginApi =

172− "login"

173− :> ReqBody '[JSON] LoginForm

174− :> Post '[JSON] (Headers '[ Header "Set-Cookie" SetCookie, Header "Set-Cookie" SetCookie] LogMessage)

175−

176−data LoginForm = LoginForm {

177− username :: Text

178− , password :: Text

179−} deriving (Eq, Show, Generic)

180−

181−instance ToJSON LoginForm

182−instance FromJSON LoginForm

183−```

184−

185−We can combine both APIs into one like so:

186−

187−```haskell

188−type AdminAndLogin auths = (SAS.Auth auths AdminUser :> AdminApi) :<|> LoginApi

189−```

190−

191−## Server

192−

193−When we define our server, we'll have to define handlers for the `AdminApi` and the `LoginApi` and

194−we'll have to supply `JWTSettings` and `CookieSettings` so our `login` handler can authenticate users:

195−

196−```haskell

197−adminServer :: SAS.CookieSettings -> SAS.JWTSettings -> ServerT (AdminAndLogin auths) AppM

198−adminServer cs jwts = adminHandler :<|> loginHandler cs jwts

199−```

200−

201−The `admin` route should receive an authenticated `AdminUser` as an argument

202−or it should return a `401`:

203−

204−```haskell

205−adminHandler :: AuthResult AdminUser -> AppM LogMessage

206−adminHandler (SAS.Authenticated adminUser) = do

207− config <- asks _getConfig

208− logset <- asks _getLogger

209−

210− tstamp <- liftIO getCurrentTime

211− let logMsg = LogMessage { message = "Admin User accessing admin: " <> name adminUser

212− , timestamp = tstamp

213− , level = "info"

214− , lversion = version config

215− , lenvironment = environment config

216− }

217− -- emit log message

218− liftIO $ pushLogStrLn logset $ toLogStr logMsg

219− -- return handler result (for simplicity, result is a LogMessage)

220− pure logMsg

221−adminHandler _ = throwError err401

222−```

223−

224−By contrast, the `login` handler is waiting for a `POST` with a login form.

225−

226−If login is successful, it will set session cookies and return a value.

227−

228−Here we're going to include lots of log messages:

229−

230−```haskell

231−loginHandler :: CookieSettings

232− -> JWTSettings

233− -> LoginForm

234− -> AppM (Headers '[ Header "Set-Cookie" SetCookie, Header "Set-Cookie" SetCookie] LogMessage)

235−loginHandler cookieSettings jwtSettings form = do

236− config <- asks _getConfig

237− logset <- asks _getLogger

238−

239− tstamp <- liftIO getCurrentTime

240− let logMsg = LogMessage { message = "AdminUser login attempt failed!"

241− , timestamp = tstamp

242− , level = "info"

243− , lversion = version config

244− , lenvironment = environment config

245− }

246− case validateLogin config form of

247− Nothing -> do

248− liftIO $ pushLogStrLn logset $ toLogStr logMsg

249− throwError err401

250− Just usr -> do

251− mApplyCookies <- liftIO $ SAS.acceptLogin cookieSettings jwtSettings usr

252− case mApplyCookies of

253− Nothing -> do

254− liftIO $ pushLogStrLn logset $ toLogStr logMsg

255− throwError err401

256− Just applyCookies -> do

257− let successMsg = logMsg{message = "AdminUser successfully authenticated!"}

258− liftIO $ pushLogStrLn logset $ toLogStr successMsg

259− pure $ applyCookies successMsg

260−loginHandler _ _ _ = throwError err401

261−

262−validateLogin :: SiteConfig -> LoginForm -> Maybe AdminUser

263−validateLogin config (LoginForm uname passwd ) =

264− if (uname == adminUsername config) && (passwd == adminPasswd config)

265− then Just $ AdminUser uname

266− else Nothing

267−```

268−

269−## `serveWithContext` and `hoistServerWithContext`

270−

271−In order to build a working server, we'll need to `hoist` our custom monad

272−into Servant's Handler monad. We'll also need to pass in the proper context to ensure

273−authentication will work.

274−

275−This will require both `serveWithContext` and `hoistServerWithContext`.

276−

277−Let's define the function which will create our `Application`:

278−

279−```haskell

280−adminLoginApi :: Proxy (AdminAndLogin '[JWT])

281−adminLoginApi = Proxy

282−

283−mkApp :: Context '[SAS.CookieSettings, SAS.JWTSettings] -> CookieSettings -> JWTSettings -> AppCtx -> Application

284−mkApp cfg cs jwts ctx =

285− serveWithContext adminLoginApi cfg $

286− hoistServerWithContext adminLoginApi (Proxy :: Proxy '[SAS.CookieSettings, SAS.JWTSettings])

287− (flip runReaderT ctx) (adminServer cs jwts)

288−```

289−

290−One footnote: because we'd like our logs to be in JSON form, we'll also create a `Middleware` object

291−so that `Warp` *also* will emit logs as JSON. This will ensure *all* logs are emitted as JSON:

292−

293−```haskell

294−jsonRequestLogger :: IO Middleware

295−jsonRequestLogger =

296− mkRequestLogger $ def { outputFormat = CustomOutputFormatWithDetails formatAsJSON }

297−```

298−

299−We now have all the pieces we need to serve our application inside a `main` function:

300−

301−```haskell

302−main :: IO ()

303−main = do

304− -- typically, we'd create our config from environment variables

305− -- but we're going to just make one here

306− let config = SiteConfig "dev" "1.0.0" "admin" "secretPassword"

307−

308− warpLogger <- jsonRequestLogger

309− appLogger <- newStdoutLoggerSet defaultBufSize

310−

311− tstamp <- getCurrentTime

312− myKey <- generateKey

313−

314− let lgmsg = LogMessage {

315− message = "My app starting up!"

316− , timestamp = tstamp

317− , level = "info"

318− , lversion = version config

319− , lenvironment = environment config

320− }

321− pushLogStrLn appLogger (toLogStr lgmsg) >> flushLogStr appLogger

322−

323− let ctx = AppCtx config appLogger

324−

325− warpSettings = Warp.defaultSettings

326− portSettings = Warp.setPort port warpSettings

327− settings = Warp.setTimeout 55 portSettings

328− jwtCfg = defaultJWTSettings myKey

329− cookieCfg = if environment config == "dev"

330− then defaultCookieSettings{cookieIsSecure=SAS.NotSecure}

331− else defaultCookieSettings

332− cfg = cookieCfg :. jwtCfg :. EmptyContext

333−

334− Warp.runSettings settings $ warpLogger $ mkApp cfg cookieCfg jwtCfg ctx

335−```

336−

337−

338−## Usage

339−

340−Now we can run it and try it out with `curl`. In one terminal, let's run our application

341−and see what our log output looks like:

342−

343−```$ ./cookbook-hoist-server-with-context

344−{"message":"My app starting up!","timestamp":"2018-10-04T00:33:12.482568Z","level":"info","lversion":"1.0.0","lenvironment":"dev"}

345−```

346−

347−In another terminal, let's ensure that it fails with `err401` if

348−we're not authenticated:

349−

350−```

351−$ curl -v 'http://localhost:3001/admin'

352−…

353−< HTTP/1.1 401 Unauthorized

354−```

355−

356−```

357−$ curl -v -XPOST 'http://localhost:3001/login' \

358− -H "Content-Type:application/json" \

359− -d '{"username": "bad", "password": "wrong"}'

360−…

361−< HTTP/1.1 401 Unauthorized

362−```

363−

364−And in the other terminal with our log messages (from our JSON `Middleware`):

365−

366−```

367−{"time":"03/Oct/2018:17:35:56 -0700","response":{"status":401,"size":null,"body":""},"request":{"httpVersion":"1.1","path":"/admin","size":0,"body":"","durationMs":0.22,"remoteHost":{"hostAddress":"127.0.0.1","port":51029},"headers":[["Host","localhost:3001"],["User-Agent","curl/7.60.0"],["Accept","*/*"]],"queryString":[],"method":"GET"}}

368−```

369−

370−Now let's see that authentication works, and that we get JWTs:

371−

372−```

373−$ curl -v -XPOST 'http://localhost:3001/login' \

374− -H "Content-Type:application/json" \

375− -d '{"username": "admin", "password": "secretPassword"}'

376−…

377−< HTTP/1.1 200 OK

378−...

379−< Server: Warp/3.2.25

380−< Content-Type: application/json;charset=utf-8

381−< Set-Cookie: JWT-Cookie=eyJhbGciOiJIUzUxMiJ9.eyJkYXQiOnsibmFtZSI6ImFkbWluIn19.SIoRcABKSO4mXnRifzqPWlHJUhVwuy32Qon7s1E_c3vHOsLXdXyX4V4eXOw9tMFoeIqgsXMZucqoFb36vAdKwQ; Path=/; HttpOnly; SameSite=Lax

382−< Set-Cookie: XSRF-TOKEN=y5PmrYHX3ywFUCwGRQqHh1TDheTLiQpwRQB3FFRd8N4=; Path=/

383−...

384−{"message":"AdminUser succesfully authenticated!","timestamp":"2018-10-04T00:37:44.455441Z","level":"info","lversion":"1.0.0","lenvironment":"dev"}

385−```

386−

387−And in the other terminal with our log messages (note that logging out passwords is insecure...):

388−

389−```

390−{"message":"AdminUser succesfully authenticated!","timestamp":"2018-10-04T00:37:44.455441Z","level":"info","lversion":"1.0.0","lenvironment":"dev"}

391−{"time":"03/Oct/2018:17:37:44 -0700","response":{"status":200,"size":null,"body":null},"request":{"httpVersion":"1.1","path":"/login","size":51,"body":"{\"username\": \"admin\", \"password\": \"secretPassword\"}","durationMs":0.23,"remoteHost":{"hostAddress":"127.0.0.1","port":51044},"headers":[["Host","localhost:3001"],["User-Agent","curl/7.60.0"],["Accept","*/*"],["Content-Type","application/json"],["Content-Length","51"]],"queryString":[],"method":"POST"}}

392−```

393−

394−Finally, let's make sure we can access a protected resource with our tokens:

395−

396−```

397−$ export jwt=eyJhbGciOiJIUzUxMiJ9.eyJkYXQiOnsibmFtZSI6ImFkbWluIn19.SIoRcABKSO4mXnRifzqPWlHJUhVwuy32Qon7s1E_c3vHOsLXdXyX4V4eXOw9tMFoeIqgsXMZucqoFb36vAdKwQ

398−$ curl -v \

399− -H "Authorization: Bearer $jwt" \

400− 'http://localhost:3001/admin'

401−…

402−< HTTP/1.1 200 OK

403−{"message":"Admin User accessing admin: admin","timestamp":"2018-10-04T00:58:07.216605Z","level":"info","lversion":"1.0.0","lenvironment":"dev"}

404−```

405−

406−And we should see this message logged-out as well:

407−

408−```

409−{"message":"Admin User accessing admin: admin","timestamp":"2018-10-04T00:58:07.216605Z","level":"info","lversion":"1.0.0","lenvironment":"dev"}

410−```

411−

412−This program is available as a cabal project

413−[here](https://github.com/haskell-servant/servant/tree/master/doc/cookbook/hoist-server-with-context).

doc/cookbook/hoist-server-with-context/hoist-server-with-context.cabaldeleted−37

@@ -1,37 +0,0 @@

1−cabal-version: 2.2

2−name: cookbook-hoist-server-with-context

3−version: 0.0.1

4−synopsis: JWT and basic access authentication with a Custom Monad cookbook example

5−description: Using servant-auth to support both JWT-based and basic

6− authentication.

7−homepage: http://docs.servant.dev/

8−license: BSD-3-Clause

9−license-file: ../../../servant/LICENSE

10−author: Servant Contributors

11−maintainer: haskell-servant-maintainers@googlegroups.com

12−category: Servant

13−build-type: Simple

14−tested-with: GHC==8.6.5, GHC==8.8.3, GHC ==8.10.7

15−

16−executable cookbook-hoist-server-with-context

17− main-is: HoistServerWithContext.lhs

18− build-depends: base == 4.*

19− , base-compat

20− , text >= 1.2

21− , aeson >= 1.2

22− , data-default

23− , fast-logger

24− , servant

25− , servant-server

26− , servant-auth >= 0.3.2

27− , servant-auth-server >= 0.4.4.0

28− , time

29− , warp >= 3.2

30− , wai >= 3.2

31− , wai-extra

32− , http-types >= 0.12

33− , bytestring >= 0.10.4

34− , mtl

35− default-language: Haskell2010

36− ghc-options: -Wall -pgmL markdown-unlit

37− build-tool-depends: markdown-unlit:markdown-unlit

doc/cookbook/https/Https.lhs+5−5

@@ -34,16 +34,16 @@ app = serve api server

34```

35

36It's now time to actually run the `Application`.

37−The [`warp-tls`](https://hackage.haskell.org/package/warp-tls/docs/Network-Wai-Handler-WarpTLS.html)

37+The [`warp-tls`](https://hackage.haskell.org/package/warp-tls-3.2.4/docs/Network-Wai-Handler-WarpTLS.html)

38package provides two functions for running an `Application`, called

39−[`runTLS`](https://hackage.haskell.org/package/warp-tls/docs/Network-Wai-Handler-WarpTLS.html#v:runTLS)

39+[`runTLS`](https://hackage.haskell.org/package/warp-tls-3.2.4/docs/Network-Wai-Handler-WarpTLS.html#v:runTLS)

40−and [`runTLSSocket`](https://hackage.haskell.org/package/warp-tls/docs/Network-Wai-Handler-WarpTLS.html#v:runTLSSocket).

40+and [`runTLSSocket`](https://hackage.haskell.org/package/warp-tls-3.2.4/docs/Network-Wai-Handler-WarpTLS.html#v:runTLSSocket).

41We will be using the first one.

42

43It takes two arguments,

44−[the TLS settings](https://hackage.haskell.org/package/warp-tls/docs/Network-Wai-Handler-WarpTLS.html#t:TLSSettings)

44+[the TLS settings](https://hackage.haskell.org/package/warp-tls-3.2.4/docs/Network-Wai-Handler-WarpTLS.html#t:TLSSettings)

45(certificates, keys, ciphers, etc)

46−and [the warp settings](https://hackage.haskell.org/package/warp/docs/Network-Wai-Handler-Warp-Internal.html#t:Settings)

46+and [the warp settings](https://hackage.haskell.org/package/warp-3.2.12/docs/Network-Wai-Handler-Warp-Internal.html#t:Settings)

47(port, logger, etc).

48

49We will be using very simple settings for this example but you are of

doc/cookbook/https/https.cabal+5−5

@@ -1,14 +1,14 @@

1−cabal-version: 2.2

2name: cookbook-https

1name: cookbook-https

3version: 0.1

2version: 0.1

4synopsis: HTTPS cookbook example

3synopsis: HTTPS cookbook example

5−homepage: http://docs.servant.dev/

4+homepage: http://haskell-servant.readthedocs.org/

6−license: BSD-3-Clause

5+license: BSD3

7license-file: ../../../servant/LICENSE

6license-file: ../../../servant/LICENSE

8author: Servant Contributors

7author: Servant Contributors

9maintainer: haskell-servant-maintainers@googlegroups.com

8maintainer: haskell-servant-maintainers@googlegroups.com

10build-type: Simple

9build-type: Simple

10+cabal-version: >=1.10

11−tested-with: GHC==8.6.5, GHC==8.8.3, GHC ==8.10.7

11+tested-with: GHC==8.0.2, GHC==8.2.2, GHC==8.4.3

12

13executable cookbook-https

14 main-is: Https.lhs

@@ -17,7 +17,7 @@ executable cookbook-https

17 , servant-server

18 , wai >= 3.2

19 , warp >= 3.2

20− , warp-tls >= 3.2.9

20+ , warp-tls >= 3.2

21 , markdown-unlit >= 0.4

22 default-language: Haskell2010

23 ghc-options: -Wall -pgmL markdown-unlit

doc/cookbook/index.rst+2−11

@@ -6,8 +6,8 @@ how to solve many common problems with servant. If you're

6interested in contributing examples of your own, feel free

7to open an issue or a pull request on

8`our github repository <https://github.com/haskell-servant/servant>`_

9−or even to just get in touch with us on the `**#haskell-servant** IRC channel

9+or even to just get in touch with us on the **#servant** IRC channel

10−on libera.chat <https://web.libera.chat/#haskell-servant>_ or on

10+on freenode or on

11`the mailing list <https://groups.google.com/forum/#!forum/haskell-servant>`_.

12

13The scope is very wide. Simple and fancy authentication schemes,

@@ -20,20 +20,11 @@ you name it!

20 structuring-apis/StructuringApis.lhs

21 generic/Generic.lhs

22 https/Https.lhs

23− db-mysql-basics/MysqlBasics.lhs

24 db-sqlite-simple/DBConnection.lhs

23 db-sqlite-simple/DBConnection.lhs

25 db-postgres-pool/PostgresPool.lhs

24 db-postgres-pool/PostgresPool.lhs

26 using-custom-monad/UsingCustomMonad.lhs

25 using-custom-monad/UsingCustomMonad.lhs

27 using-free-client/UsingFreeClient.lhs

26 using-free-client/UsingFreeClient.lhs

28− custom-errors/CustomErrors.lhs

29− uverb/UVerb.lhs

30 basic-auth/BasicAuth.lhs

27 basic-auth/BasicAuth.lhs

31− basic-streaming/Streaming.lhs

32 jwt-and-basic-auth/JWTAndBasicAuth.lhs

28 jwt-and-basic-auth/JWTAndBasicAuth.lhs

33− hoist-server-with-context/HoistServerWithContext.lhs

34 file-upload/FileUpload.lhs

29 file-upload/FileUpload.lhs

35 pagination/Pagination.lhs

30 pagination/Pagination.lhs

36− curl-mock/CurlMock.lhs

37− sentry/Sentry.lhs

38− testing/Testing.lhs

39− open-id-connect/OpenIdConnect.lhs

doc/cookbook/jwt-and-basic-auth/jwt-and-basic-auth.cabal+5−5

@@ -1,17 +1,17 @@

1−cabal-version: 2.2

2name: cookbook-jwt-and-basic-auth

1name: cookbook-jwt-and-basic-auth

3version: 0.0.1

2version: 0.0.1

4synopsis: JWT and basic access authentication cookbook example

3synopsis: JWT and basic access authentication cookbook example

5description: Using servant-auth to support both JWT-based and basic

4description: Using servant-auth to support both JWT-based and basic

6 authentication.

5 authentication.

7−homepage: http://docs.servant.dev/

6+homepage: http://haskell-servant.readthedocs.org/

8−license: BSD-3-Clause

7+license: BSD3

9license-file: ../../../servant/LICENSE

8license-file: ../../../servant/LICENSE

10author: Servant Contributors

9author: Servant Contributors

11maintainer: haskell-servant-maintainers@googlegroups.com

10maintainer: haskell-servant-maintainers@googlegroups.com

12category: Servant

11category: Servant

13build-type: Simple

12build-type: Simple

13+cabal-version: >=1.10

14−tested-with: GHC==8.6.5, GHC==8.8.3, GHC ==8.10.7

14+tested-with: GHC==8.0.2, GHC==8.2.2, GHC==8.4.3

15

16executable cookbook-jwt-and-basic-auth

17 main-is: JWTAndBasicAuth.lhs

@@ -22,7 +22,7 @@ executable cookbook-jwt-and-basic-auth

22 , servant

23 , servant-client

24 , servant-server

25− , servant-auth == 0.4.*

25+ , servant-auth ==0.3.*

26 , servant-auth-server >= 0.3.1.0

27 , warp >= 3.2

28 , wai >= 3.2

doc/cookbook/open-id-connect/OpenIdConnect.cabaldeleted−45

@@ -1,45 +0,0 @@

1−cabal-version: 2.2

2−name: open-id-connect

3−version: 0.1

4−synopsis: OpenId Connect with Servant example

5−homepage: http://haskell-servant.readthedocs.org/

6−license: BSD-3-Clause

7−license-file: ../../../servant/LICENSE

8−author: Servant Contributors

9−maintainer: haskell-servant-maintainers@googlegroups.com

10−build-type: Simple

11−tested-with: GHC==8.6.5

12−

13−executable cookbook-openidconnect

14− main-is: OpenIdConnect.lhs

15− build-depends: base ==4.*

16− , aeson

17− , aeson-pretty

18− , binary

19− , blaze-html

20− , blaze-markup

21− , bytestring

22− , case-insensitive

23− , cereal

24− , containers

25− , generic-lens

26− , http-client

27− , http-client-tls

28− , http-types

29− , jose-jwt

30− , lens

31− , lens-aeson

32− , oidc-client

33− , protolude

34− , random

35− , servant

36− , servant-blaze

37− , servant-server

38− , text

39− , time

40− , vector

41− , wai

42− , warp >= 3.2

43− default-language: Haskell2010

44− ghc-options: -Wall -Wcompat -Wincomplete-uni-patterns -Wredundant-constraints -Wnoncanonical-monad-instances -pgmL markdown-unlit

45− build-tool-depends: markdown-unlit:markdown-unlit >= 0.4

doc/cookbook/open-id-connect/OpenIdConnect.lhsdeleted−472

@@ -1,472 +0,0 @@

1−[OpenID Connect](https://openid.net/connect/)

2−=============================================

3−

4−Use OpenID Connect to authenticate your users.

5−This example use google OIDC provider.

6−It was made for a working with single page application where

7−some login token would be saved in the user agent local storage.

8−

9−Workflow:

10−

11−1. user is presented with a login button,

12−2. when the user clicks on the button it is redirected to the OIDC

13− provider,

14−3. the user login in the OIDC provider,

15−4. the OIDC provider will redirect the user and provide a `code`,

16−5. the server will use this code to make a POST to the OIDC provider

17− and will get back authentication infos,

18−6. The user will get display an HTML page that will save a secret

19− identifying him in the local storage, then it will be redirected to

20− /.

21−

22−Let's put the imports behind us:

23−

24−``` haskell

25−{-# LANGUAGE DataKinds #-}

26−{-# LANGUAGE DeriveGeneric #-}

27−{-# LANGUAGE DuplicateRecordFields #-}

28−{-# LANGUAGE FlexibleContexts #-}

29−{-# LANGUAGE FlexibleInstances #-}

30−{-# LANGUAGE MultiParamTypeClasses #-}

31−{-# LANGUAGE NoImplicitPrelude #-}

32−{-# LANGUAGE OverloadedLists #-}

33−{-# LANGUAGE OverloadedStrings #-}

34−{-# LANGUAGE PartialTypeSignatures #-}

35−{-# LANGUAGE PolyKinds #-}

36−{-# LANGUAGE RankNTypes #-}

37−{-# LANGUAGE RecordWildCards #-}

38−{-# LANGUAGE ScopedTypeVariables #-}

39−{-# LANGUAGE TypeFamilies #-}

40−{-# LANGUAGE TypeOperators #-}

41−{-# LANGUAGE TypeSynonymInstances #-}

42−

43−module Main where

44−

45−import Protolude

46−

47−import Data.Aeson

48− (FromJSON (..), (.:))

49−import qualified Data.Aeson as JSON

50−import qualified Data.Aeson.Types as AeT

51−import qualified Data.ByteString.Lazy as LBS

52−import qualified Data.List as List

53−import qualified Data.Text as Text

54−import Jose.Jwt

55− (Jwt (..), decodeClaims)

56−import Network.HTTP.Client

57− (Manager, newManager)

58−import Network.HTTP.Client.TLS

59− (tlsManagerSettings)

60−import Network.Wai.Handler.Warp

61− (run)

62−import Servant

63−import Servant.HTML.Blaze

64− (HTML)

65−import qualified System.Random as Random

66−import Text.Blaze

67− (ToMarkup (..))

68−import qualified Text.Blaze.Html as H

69−import Text.Blaze.Html5

70− ((!))

71−import qualified Text.Blaze.Html5 as H

72−import qualified Text.Blaze.Html5.Attributes as HA

73−import Text.Blaze.Renderer.Utf8

74− (renderMarkup)

75−import qualified Web.OIDC.Client as O

76−```

77−

78−You'll need to create a new OpenID Connect client in an OpenID Provider.

79−This example was tested with Google.

80−

81−You can find a list of public OIDC provider here:

82−https://connect2id.com/products/nimbus-oauth-openid-connect-sdk/openid-connect-providers

83−

84−I copied some here:

85−

86−- Google: https://developers.google.com/identity/protocols/OpenIDConnect

87− more precisely: https://console.developers.google.com/apis/credentials

88−- Microsoft: https://docs.microsoft.com/en-us/previous-versions/azure/dn645541(v=azure.100)

89−- Yahoo: https://developer.yahoo.com/oauth2/guide/openid_connect/

90−- PayPal: https://developer.paypal.com/docs/integration/direct/identity/log-in-with-paypal/

91−

92−During the configuration you'll need to provide a redirect uri.

93−The redirect_uri should correspond to the uri user will be redirected to

94−after a successful login into the OpenID provider.

95−

96−So during your test, you should certainly just use `http://localhost:3000/login/cb`.

97−In general you should use your own domain name.

98−

99−You'll then be given a `client_id` and a `client_password`.

100−Fill those values in here:

101−

102−``` haskell

103−oidcConf :: OIDCConf

104−oidcConf = OIDCConf { redirectUri = "http://localhost:3000/login/cb"

105− , clientId = "xxxxxxxxxxxx-xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx.apps.googleusercontent.com"

106− , clientPassword = "************************" }

107−```

108−

109−Then we declare our main server:

110−

111−``` haskell

112−main :: IO ()

113−main = do

114− oidcEnv <- initOIDC oidcConf

115− run 3000 (app oidcEnv)

116−

117−type API = IdentityRoutes Customer

118− :<|> Get '[HTML] Homepage

119−

120−api :: Proxy API

121−api = Proxy

122−

123−server :: OIDCEnv -> Server API

124−server oidcEnv = serveOIDC oidcEnv handleOIDCLogin

125− :<|> return Homepage

126−

127−-- | Then main app

128−app :: OIDCEnv -> Application

129−app oidcEnv = serve api (server oidcEnv)

130−```

131−

132−OIDC

133−----

134−

135−That part try to separate concern, and certainly in a real world

136−application that should be in its distinct module.

137−

138−``` haskell

139−-- * OIDC

140−

141−data OIDCConf =

142− OIDCConf { redirectUri :: ByteString

143− , clientId :: ByteString

144− , clientPassword :: ByteString

145− } deriving (Show, Eq)

146−```

147−

148−First we need to initialize OIDC.

149−A short explanation about it:

150−

151−- to complete the workflow we need to make a POST request to the OIDC provider.

152− So we need to create an http manager to make those call properly.

153−- Then in order to prevent replay attack, each time an user wants to login we

154− should provide a random string called the `state`. When the user is

155− redirected to the `redirect_uri`, the OIDC provider should provide the same

156− `state` along a `code` parameter.

157−

158−``` haskell

159−initOIDC :: OIDCConf -> IO OIDCEnv

160−initOIDC OIDCConf{..} = do

161− mgr <- newManager tlsManagerSettings

162− prov <- O.discover "https://accounts.google.com" mgr

163− let oidc = O.setCredentials clientId clientPassword redirectUri (O.newOIDC prov)

164− return OIDCEnv { oidc = oidc

165− , mgr = mgr

166− , genState = genRandomBS

167− , prov = prov

168− , redirectUri = redirectUri

169− , clientId = clientId

170− , clientPassword = clientPassword

171− }

172−

173−data OIDCEnv = OIDCEnv { oidc :: O.OIDC

174− , mgr :: Manager

175− , genState :: IO ByteString

176− , prov :: O.Provider

177− , redirectUri :: ByteString

178− , clientId :: ByteString

179− , clientPassword :: ByteString

180− }

181−```

182−

183−The `IdentityRoutes` are two endpoints:

184−

185−- an endpoint to redirect the users to the OIDC Provider,

186−- another one the user will be redirected to from the OIDC Provider.

187−

188−``` haskell

189−type IdentityRoutes a =

190− "login" :> ( -- redirect User to the OpenID Provider

191− Get '[JSON] NoContent

192− -- render the page that will save the user creds in the user-agent

193− :<|> "cb" :> QueryParam "error" Text

194− :> QueryParam "code" Text

195− :> Get '[HTML] User)

196−

197−-- | gen a 302 redirect helper

198−redirects :: (StringConv s ByteString) => s -> Handler ()

199−redirects url = throwError err302 { errHeaders = [("Location",toS url)]}

200−```

201−

202−That function will generate the URL to redirect the users to when

203−they'll click on the login link: `https://yourdomain/login`.

204−

205−``` haskell

206−genOIDCURL :: OIDCEnv -> IO ByteString

207−genOIDCURL OIDCEnv{..} = do

208− st <- genState -- generate a random string

209− let oidcCreds = O.setCredentials clientId clientPassword redirectUri (O.newOIDC prov)

210− loc <- O.getAuthenticationRequestUrl oidcCreds [O.openId, O.email, O.profile] (Just st) []

211− return (show loc)

212−

213−handleLogin :: OIDCEnv -> Handler NoContent

214−handleLogin oidcenv = do

215− loc <- liftIO (genOIDCURL oidcenv)

216− redirects loc

217− return NoContent

218−```

219−

220−The `AuthInfo` is about the infos we can grab from OIDC provider.

221−

222−To be more precise, the user should come with a `code` (a token) and

223−POSTing that code to the correct OIDC provider endpoint should return a JSON

224−object. One of the fields should be named `id_token` which should be a

225−JWT containing all the information we need. Depending on the scopes we

226−asked we might get more information.

227−

228−``` haskell

229−-- | @AuthInfo@

230−data AuthInfo = AuthInfo { email :: Text

231− , emailVerified :: Bool

232− , name :: Text } deriving (Eq, Show, Generic)

233−

234−instance FromJSON AuthInfo where

235− parseJSON (JSON.Object v) = do

236− email :: Text <- v .: "email"

237− email_verified :: Bool <- v .: "email_verified"

238− name :: Text <- v .: "name"

239− return $ AuthInfo (toS email) email_verified (toS name)

240− parseJSON invalid = AeT.typeMismatch "Coord" invalid

241−instance JSON.ToJSON AuthInfo where

242− toJSON (AuthInfo e ev n) =

243− JSON.object [ "email" JSON..= (toS e :: Text)

244− , "email_verified" JSON..= ev

245− , "name" JSON..= (toS n :: Text)

246− ]

247−

248−type LoginHandler = AuthInfo -> IO (Either Text User)

249−```

250−

251−The `handleLoggedIn` is that part that will retrieve the information from

252−the user once he is redirected from the OIDC Provider after login.

253−

254−If the user is redirected to the `redirect_uri` but with an `error` query

255−parameter then it means something went wrong.

256−If there is no error query param but a `code` query param it means the user

257−successfully logged in. From there we need to make a request to the token

258−endpoint of the OIDC provider. It's a POST that should contain the code

259−as well as the client id and secret.

260−Making this HTTP POST is the responsibility of `requestTokens`.

261−

262−From there we extract the `claims` of the JWT contained in one of the value

263−of the JSON returned by the POST HTTP Request.

264−

265−``` haskell

266−data User = User { userId :: Text

267− , userSecret :: Text

268− , localStorageKey :: Text

269− , redirectUrl :: Maybe Text

270− } deriving (Show,Eq,Ord)

271−

272−handleLoggedIn :: OIDCEnv

273− -> LoginHandler -- ^ handle successful id

274− -> Maybe Text -- ^ error

275− -> Maybe Text -- ^ code

276− -> Handler User

277−handleLoggedIn oidcenv handleSuccessfulId err mcode =

278− case err of

279− Just errorMsg -> forbidden errorMsg

280− Nothing -> case mcode of

281− Just oauthCode -> do

282− tokens <- liftIO $ O.requestTokens (oidc oidcenv) (toS oauthCode) (mgr oidcenv)

283− putText . show . O.claims . O.idToken $ tokens

284− let jwt = toS . unJwt . O.jwt . O.idToken $ tokens

285− eAuthInfo = decodeClaims jwt :: Either O.JwtError (O.JwtHeader,AuthInfo)

286− case eAuthInfo of

287− Left jwtErr -> forbidden $ "JWT decode/check problem: " <> show jwtErr

288− Right (_,authInfo) ->

289− if emailVerified authInfo

290− then do

291− user <- liftIO $ handleSuccessfulId authInfo

292− either forbidden return user

293− else forbidden "Please verify your email"

294− Nothing -> do

295− liftIO $ putText "No code param"

296− forbidden "no code parameter given"

297−```

298−

299−When you render a User with blaze-html, it will generate a page with a js

300−that will put a secret for that user in the local storage. And it will

301−redirect the user to /.

302−

303−``` haskell

304−instance ToMarkup User where

305− toMarkup User{..} = H.docTypeHtml $ do

306− H.head $

307− H.title "Logged In"

308− H.body $ do

309− H.h1 "Logged In"

310− H.p (H.toHtml ("Successful login with id " <> userId))

311− H.script (H.toHtml ("localStorage.setItem('" <> localStorageKey <> "','" <> userSecret <> "');"

312− <> "localStorage.setItem('user-id','" <> userId <> "');"

313− <> "window.location='" <> fromMaybe "/" redirectUrl <> "';" -- redirect the user to /

314− ));

315−

316−serveOIDC :: OIDCEnv -> LoginHandler -> Server (IdentityRoutes a)

317−serveOIDC oidcenv loginHandler =

318− handleLogin oidcenv :<|> handleLoggedIn oidcenv loginHandler

319−

320−-- * Auth

321−type APIKey = ByteString

322−type Account = Text.Text

323−type Conf = [(APIKey,Account)]

324−data Customer = Customer {

325− account :: Account

326− , apiKey :: APIKey

327− , mail :: Maybe Text

328− , fullname :: Maybe Text

329− }

330−```

331−

332−Here is the code that displays the homepage.

333−It should contain a link to the the `/login` URL.

334−When the user clicks on this link it will be redirected to Google login page

335−with some generated information.

336−

337−The page also displays the content of the local storage.

338−And in particular the items `api-key` and `user-id`.

339−Those items should be set after a successful login when the user is redirected to

340−`/login/cb`.

341−

342−The logic used generally is to use that api-key to uniquely identify an user.

343−Another option would have been to set a cookie.

344−

345−``` haskell

346−data Homepage = Homepage

347−

348−instance ToMarkup Homepage where

349− toMarkup Homepage = H.docTypeHtml $ do

350− H.head $ do

351− H.title "OpenID Connect Servant Example"

352− H.style (H.toHtml ("body { font-family: monospace; font-size: 18px; }" :: Text.Text))

353− H.body $ do

354− H.h1 "OpenID Connect Servant Example"

355− H.div $

356− H.a ! HA.href "/login" $ "Click here to login"

357− H.ul $ do

358− H.li $ do

359− H.span "API Key in Local storage: "

360− H.script (H.toHtml ("document.write(localStorage.getItem('api-key'));" :: Text.Text))

361− H.li $ do

362− H.span "User ID in Local storage: "

363− H.script (H.toHtml ("document.write(localStorage.getItem('user-id'));" :: Text.Text))

364−```

365−

366−We need some helpers to generate random string for generating state and API Keys.

367−

368−``` haskell

369−-- | generate a random ByteString, not necessarily extremely good randomness

370−-- still the password will be long enough to be very difficult to crack

371−genRandomBS :: IO ByteString

372−genRandomBS = do

373− g <- Random.newStdGen

374− Random.randomRs (0, n) g & take 42 & fmap toChar & readable 0 & toS & return

375− where

376− n = length letters - 1

377− toChar i = letters List.!! i

378− letters = ['A'..'Z'] <> ['0'..'9'] <> ['a'..'z']

379− readable :: Int -> [Char] -> [Char]

380− readable _ [] = []

381− readable i str =

382− let blocksize = case n of

383− 0 -> 8

384− 1 -> 4

385− 2 -> 4

386− 3 -> 4

387− _ -> 12

388− block = take blocksize str

389− rest = drop blocksize str

390− in if List.null rest

391− then str

392− else block <> "-" <> readable (i+1) rest

393−

394−customerFromAuthInfo :: AuthInfo -> IO Customer

395−customerFromAuthInfo authinfo = do

396− apikey <- genRandomBS

397− return Customer { account = toS (email authinfo)

398− , apiKey = apikey

399− , mail = Just (toS (email authinfo))

400− , fullname = Just (toS (name authinfo))

401− }

402−

403−handleOIDCLogin :: LoginHandler

404−handleOIDCLogin authInfo = do

405− custInfo <- customerFromAuthInfo authInfo

406− if emailVerified authInfo

407− then return . Right . customerToUser $ custInfo

408− else return (Left "You emails is not verified by your provider. Please verify your email.")

409− where

410− customerToUser :: Customer -> User

411− customerToUser c =

412− User { userId = toS (account c)

413− , userSecret = toS (apiKey c)

414− , redirectUrl = Nothing

415− , localStorageKey = "api-key"

416− }

417−```

418−

419−`Error` helpers

420−---------------

421−

422−``` haskell

423−data Err = Err { errTitle :: Text

424− , errMsg :: Text }

425−

426−instance ToMarkup Err where

427− toMarkup Err{..} = H.docTypeHtml $ do

428− H.head $ do

429− H.title "Error"

430− H.body $ do

431− H.h1 (H.a ! HA.href "/" $ "Home")

432− H.h2 (H.toHtml errTitle)

433− H.p (H.toHtml errMsg)

434−

435−format :: ToMarkup a => a -> LBS.ByteString

436−format err = toMarkup err & renderMarkup

437−

438−appToErr :: ServerError -> Text -> ServerError

439−appToErr x msg = x

440− { errBody = toS $ format (Err (toS (errReasonPhrase x)) msg)

441− , errHeaders = [("Content-Type","text/html")]}

442−

443−unauthorized :: (MonadError ServerError m) => Text -> m a

444−unauthorized = throwError . unauthorizedErr

445−

446−unauthorizedErr :: Text -> ServerError

447−unauthorizedErr = appToErr err401

448−

449−forbidden :: (MonadError ServerError m) => Text -> m a

450−forbidden = throwError . forbiddenErr

451−

452−forbiddenErr :: Text -> ServerError

453−forbiddenErr = appToErr err403

454−

455−notFound :: ( MonadError ServerError m) => Text -> m a

456−notFound = throwError . notFoundErr

457−

458−notFoundErr :: Text -> ServerError

459−notFoundErr = appToErr err404

460−

461−preconditionFailed :: ( MonadError ServerError m) => Text -> m a

462−preconditionFailed = throwError . preconditionFailedErr

463−

464−preconditionFailedErr :: Text -> ServerError

465−preconditionFailedErr = appToErr err412

466−

467−serverError :: ( MonadError ServerError m) => Text -> m a

468−serverError = throwError . serverErrorErr

469−

470−serverErrorErr :: Text -> ServerError

471−serverErrorErr = appToErr err500

472−```

doc/cookbook/pagination/Pagination.lhs+8−8

@@ -18,7 +18,7 @@ For example: `Range: createdAt 2017-01-15T23:14:67.000Z; offset 5; order desc` i

18the client is willing to retrieve the next batch of document in descending order that were

19created after the fifteenth of January, skipping the first 5.

20

21−As a response, the server may return the list of corresponding documents, and augment the

21+As a response, the server may return the list of corresponding document, and augment the

22response with 3 headers:

23

24- `Accept-Ranges`: A comma-separated list of fields upon which a range can be defined

@@ -127,7 +127,7 @@ defaultRange =

127 getDefaultRange (Proxy @Color)

128```

129

130−Note that `getFieldValue :: Proxy "name" -> Color -> String` is the minimal complete definition

130+Note that `getFieldValue :: Proxy "name" -> Color -> String` is the minimal complete definintion

131of the class. Yet, you can define `getRangeOptions` to provide different parsing options (see

132the last section of this guide). In the meantime, we've also defined a `defaultRange` as it will

133come in handy when defining our handler.

@@ -148,7 +148,7 @@ type MyHeaders =

148```

149

150`PageHeaders` is a type alias provided by the library to declare the necessary response headers

151−we mentioned in introduction. Expanding the alias boils down to the following:

151+we mentionned in introduction. Expanding the alias boils down to the following:

152

153``` haskell

154-- type MyHeaders =

@@ -165,7 +165,7 @@ not, _servant-pagination_ provides an easy way to lift a collection of resources

165#### Server

166

167Time to connect the last bits by defining the server implementation of our colorful API. The `Ranges`

168−type we've defined above (tied to the `Range` HTTP header) indicates the server to parse any `Range`

168+type we've defined above (tight to the `Range` HTTP header) indicates the server to parse any `Range`

169header, looking for the format defined in introduction with fields and target types we have just declared.

170If no such header is provided, we will end up receiving `Nothing`. Otherwise, it will be possible

171to _extract_ a `Range` from our `Ranges`.

@@ -192,7 +192,7 @@ the format we defined, where `<field>` here can only be `name` and `<value>` mus

192- `Range: <field> [<value>][; offset <o>][; limit <l>][; order <asc|desc>]`

193

194Beside the target field, everything is pretty much optional in the `Range` HTTP header. Missing parts

195−are deduced from the `RangeOptions` that are part of the `HasPagination` instance. Therefore, all

195+are deducted from the `RangeOptions` that are part of the `HasPagination` instance. Therefore, all

196following examples are valid requests to send to our server:

197

198- 1 - `curl http://localhost:1442/colors -vH 'Range: name'`

@@ -219,7 +219,7 @@ The previous ranges reads as follows:

219Note that in the simple above scenario, there's no ambiguity with `extractRange` and `returnRange`

220because there's only one possible `Range` defined on our resource. Yet, as you've most probably

221noticed, the `Ranges` combinator accepts a list of fields, each of which must declare a `HasPagination`

222−instance. Doing so will make the other helper functions more ambiguous and type annotations are

222+instance. Doing so will make the other helper functions more ambiguous and type annotation are

223highly likely to be needed.

224

225

@@ -235,8 +235,8 @@ instance HasPagination Color "hex" where

235#### Parsing Options

236

237By default, `servant-pagination` provides an implementation of `getRangeOptions` for each

238−`HasPagination` instance. However, this can be overridden when defining the instance to provide

238+`HasPagination` instance. However, this can be overwritten when defining the instance to provide

239−your own options. These options come into play when a `Range` header is received and isn't fully

239+your own options. This options come into play when a `Range` header is received and isn't fully

240specified (`limit`, `offset`, `order` are all optional) to provide default fallback values for those.

241

242For instance, let's say we wanted to change the default limit to `5` in a new range on

doc/cookbook/pagination/pagination.cabal+5−5

@@ -1,21 +1,21 @@

1−cabal-version: 2.2

2name: cookbook-pagination

1name: cookbook-pagination

3version: 2.1

2version: 2.1

4synopsis: Pagination with Servant example

3synopsis: Pagination with Servant example

5−homepage: http://docs.servant.dev/

4+homepage: http://haskell-servant.readthedocs.org/

6−license: BSD-3-Clause

5+license: BSD3

7license-file: ../../../servant/LICENSE

6license-file: ../../../servant/LICENSE

8author: Servant Contributors

7author: Servant Contributors

9maintainer: haskell-servant-maintainers@googlegroups.com

8maintainer: haskell-servant-maintainers@googlegroups.com

10build-type: Simple

9build-type: Simple

10+cabal-version: >=1.10

11−tested-with: GHC==8.6.5, GHC==8.8.3, GHC ==8.10.7

11+tested-with: GHC==8.0.2, GHC==8.2.2, GHC==8.4.3

12

13executable cookbook-pagination

14 main-is: Pagination.lhs

15 build-tool-depends: markdown-unlit:markdown-unlit

16 default-language: Haskell2010

17 ghc-options: -Wall -pgmL markdown-unlit

18− build-depends: base >= 4.9 && <5

18+ build-depends: base >= 4.8 && <4.12

19 , aeson

20 , servant

21 , servant-server

doc/cookbook/sentry/Sentry.lhsdeleted−116

@@ -1,116 +0,0 @@

1−# Error logging with Sentry

2−

3−In this recipe we will use [Sentry](https://sentry.io) to collect the runtime exceptions generated by our application. We will use the [raven-haskell](https://hackage.haskell.org/package/raven-haskell) package, which is a client for a Sentry event server. Mind that this package is not present on [Stackage](https://www.stackage.org/), so if we are using [Stack](https://docs.haskellstack.org) we’ll need to add it to our `extra-deps` section in the `stack.yaml` file.

4−

5−To exemplify this we will need the following imports

6−

7−```haskell

8−{-# LANGUAGE DataKinds #-}

9−{-# LANGUAGE TypeOperators #-}

10−

11−import Control.Exception (Exception,

12− SomeException, throw)

13−import Data.ByteString.Char8 (unpack)

14−import Network.Wai (Request, rawPathInfo,

15− requestHeaderHost)

16−import Network.Wai.Handler.Warp (defaultOnException,

17− defaultSettings,

18− runSettings,

19− setOnException,

20− setPort)

21−import Servant

22−import System.Log.Raven (initRaven, register,

23− silentFallback)

24−import System.Log.Raven.Transport.HttpConduit (sendRecord)

25−import System.Log.Raven.Types (SentryLevel (Error),

26− SentryRecord (..))

27−```

28−

29−Just for the sake of the example we will use the following API which will throw an exception

30−

31−```haskell

32−type API = "break" :> Get '[JSON] ()

33−

34−data MyException = MyException deriving (Show)

35−

36−instance Exception MyException

37−

38−server = breakHandler

39− where breakHandler :: Handler ()

40− breakHandler = do

41− throw MyException

42− return ()

43−```

44−

45−First thing we need to do if we want to intercept and log this exception, we need to look in the section of our code where we run the `warp` application, and instead of using the simple `run` function from `warp`, we use the `runSettings` functions which allows to customise the handling of requests

46−

47−```haskell

48−main :: IO ()

49−main =

50− let

51− settings =

52− setPort 8080 $

53− setOnException sentryOnException $

54− defaultSettings

55− in

56− runSettings settings $ serve (Proxy :: Proxy API) server

57−```

58−

59−The definition of the `sentryOnException` function could look as follows

60−

61−```haskell

62−sentryOnException :: Maybe Request -> SomeException -> IO ()

63−sentryOnException mRequest exception = do

64− sentryService <- initRaven

65− "https://username:password@senty.host/id"

66− id

67− sendRecord

68− silentFallback

69− register

70− sentryService

71− "myLogger"

72− Error

73− (formatMessage mRequest exception)

74− (recordUpdate mRequest exception)

75− defaultOnException mRequest exception

76−```

77−

78−It does three things. First it initializes the service which will communicate with Sentry. The parameters it receives are:

79−

80−- the Sentry `DSN`, which is obtained when creating a new project on Sentry

81−- a default way to update sentry fields, where we use the identity function

82−- an event transport, which generally would be `sendRecord`, an HTTPS capable transport which uses http-conduit

83−- a fallback handler, which we choose to be `silentFallback` since later we are logging to the console anyway.

84−

85−In the second step it actually sends our message to Sentry with the `register` function. Its arguments are:

86−

87−- the configured Sentry service which we just created

88−- the name of the logger

89−- the error level (see [SentryLevel](https://hackage.haskell.org/package/raven-haskell/docs/System-Log-Raven-Types.html#t:SentryLevel) for the possible options)

90−- the message we want to send

91−- an update function to handle the specific `SentryRecord`

92−

93−Eventually it just delegates the error handling to the default warp mechanism.

94−

95−The function `formatMessage` simply uses the request and the exception to return a string with the error message.

96−

97−```haskell

98−formatMessage :: Maybe Request -> SomeException -> String

99−formatMessage Nothing exception = "Exception before request could be parsed: " ++ show exception

100−formatMessage (Just request) exception = "Exception " ++ show exception ++ " while handling request " ++ show request

101−```

102−

103−The only piece left now is the `recordUpdate` function which allows to decorate with other [attributes](https://docs.sentry.io/clientdev/attributes/) the default `SentryRecord`.

104−

105−```haskell

106−recordUpdate :: Maybe Request -> SomeException -> SentryRecord -> SentryRecord

107−recordUpdate Nothing exception record = record

108−recordUpdate (Just request) exception record = record

109− { srCulprit = Just $ unpack $ rawPathInfo request

110− , srServerName = fmap unpack $ requestHeaderHost request

111− }

112−```

113−

114−In this examples we set the raw path as the culprit and we use the `Host` header to populate the server name field.

115−

116−You can try to run this code using the `cookbook-sentry` executable. You should obtain a `MyException` error in the console and, if you provided a valid Sentry DSN, you should also find your error in the Sentry interface.

doc/cookbook/sentry/sentry.cabaldeleted−24

@@ -1,24 +0,0 @@

1−cabal-version: 2.2

2−name: cookbook-sentry

3−version: 0.1

4−synopsis: Collecting runtime exceptions using Sentry

5−homepage: http://docs.servant.dev/

6−license: BSD-3-Clause

7−license-file: ../../../servant/LICENSE

8−author: Servant Contributors

9−maintainer: haskell-servant-maintainers@googlegroups.com

10−build-type: Simple

11−tested-with: GHC==8.6.5, GHC==8.8.3, GHC ==8.10.7

12−

13−executable cookbook-sentry

14− main-is: Sentry.lhs

15− build-depends: base == 4.*

16− , bytestring

17− , markdown-unlit >= 0.4

18− , raven-haskell >= 0.1.2

19− , servant-server

20− , warp >= 3.2

21− , wai >= 3.2

22− default-language: Haskell2010

23− ghc-options: -Wall -pgmL markdown-unlit

24− build-tool-depends: markdown-unlit:markdown-unlit

doc/cookbook/structuring-apis/StructuringApis.lhs+1−1

@@ -144,7 +144,7 @@ simpleAPIServer

144 :: m [a]

145 -> (i -> m a)

146 -> (a -> m NoContent)

147− -> ServerT (SimpleAPI name a i) m

147+ -> Server (SimpleAPI name a i) m

148simpleAPIServer listAs getA postA =

149 listAs :<|> getA :<|> postA

150

doc/cookbook/structuring-apis/structuring-apis.cabal+4−4

@@ -1,14 +1,14 @@

1−cabal-version: 2.2

2name: cookbook-structuring-apis

1name: cookbook-structuring-apis

3version: 0.1

2version: 0.1

4synopsis: Example that shows how APIs can be structured

3synopsis: Example that shows how APIs can be structured

5−homepage: http://docs.servant.dev/

4+homepage: http://haskell-servant.readthedocs.org/

6−license: BSD-3-Clause

5+license: BSD3

7license-file: ../../../servant/LICENSE

6license-file: ../../../servant/LICENSE

8author: Servant Contributors

7author: Servant Contributors

9maintainer: haskell-servant-maintainers@googlegroups.com

8maintainer: haskell-servant-maintainers@googlegroups.com

10build-type: Simple

9build-type: Simple

10+cabal-version: >=1.10

11−tested-with: GHC==8.6.5, GHC==8.8.3, GHC ==8.10.7

11+tested-with: GHC==8.0.2, GHC==8.2.2, GHC==8.4.3

12

13executable cookbook-structuring-apis

14 main-is: StructuringApis.lhs

doc/cookbook/testing/Testing.lhsdeleted−506

@@ -1,506 +0,0 @@

1−# How To Test Servant Applications

2−

3−Even with a nicely structured API that passes Haskell's strict type checker,

4−it's a good idea to write some tests for your application.

5−

6−In this recipe we'll work through some common testing strategies and provide

7−examples of utlizing these testing strategies in order to test Servant

8−applications.

9−

10−## Testing strategies

11−

12−There are many testing strategies you may wish to employ when testing your

13−Servant application, but included below are three common testing patterns:

14−

15−- We'll use `servant-client` to derive client functions and then send valid

16−requests to our API, running in another thread. This is great for testing

17−that our **business logic** is correctly implemented with only valid HTTP

18−requests.

19−

20−- We'll also use `hspec-wai` to make **arbitrary HTTP requests**, in order to

21−test how our application may respond to invalid or otherwise unexpected

22−requests.

23−

24−- Finally, we can also use `servant-quickcheck` for **whole-API tests**, in order

25−to assert that our entire application conforms to **best practices**.

26−

27−## Useful Libraries

28−

29−The following libraries will often come in handy when we decide to test our

30−Servant applications:

31−

32−- [hspec](https://hspec.github.io/)

33−- [hspec-wai](http://hackage.haskell.org/package/hspec-wai)

34−- [QuickCheck](http://hackage.haskell.org/package/QuickCheck)

35−- [servant-quickcheck](https://hackage.haskell.org/package/servant-quickcheck)

36−

37−## Imports and Our Testing Module

38−

39−This recipe starts with the following ingredients:

40−

41−```haskell

42−{-# LANGUAGE OverloadedStrings, TypeFamilies, DataKinds,

43− DeriveGeneric, TypeOperators #-}

44−import Prelude ()

45−import Prelude.Compat

46−

47−import qualified Control.Concurrent as C

48−import Control.Concurrent.MVar

49−import Control.Exception (bracket)

50−import Control.Lens hiding (Context)

51−import Data.Aeson

52−import Data.Aeson.Lens

53−import qualified Data.HashMap.Strict as HM

54−import Data.Text (Text, unpack)

55−import GHC.Generics

56−import Network.HTTP.Client hiding (Proxy)

57−import Network.HTTP.Types

58−import Network.Wai

59−import qualified Network.Wai.Handler.Warp as Warp

60−

61−import Servant

62−import Servant.Client

63−import Servant.Server

64−import Servant.QuickCheck

65−import Servant.QuickCheck.Internal (serverDoesntSatisfy)

66−

67−import Test.Hspec

68−import Test.Hspec.Wai

69−import Test.Hspec.Wai.Matcher

70−```

71−

72−We're going to produce different `Spec`s that represent different

73−aspects of our application, and we'll ask `hspec` to run all of our different

74−`Spec`s. This is a common organizational method for testing modules:

75−

76−```haskell

77−spec :: Spec

78−spec = do

79− businessLogicSpec

80− thirdPartyResourcesSpec

81− servantQuickcheckSpec

82−```

83−

84−Often, codebases will use `hspec`'s

85−[autodiscover pragma](http://hspec.github.io/hspec-discover.html)

86−to find all testing modules and `Spec`s inside, but we're going to

87−explicitly make a `main` function to run our tests because we have only one

88−`spec` defined above:

89−

90−```haskell

91−main :: IO ()

92−main = hspec spec

93−```

94−

95−## Testing Your Business Logic

96−

97−Let's say we have an API that looks something like this:

98−

99−```haskell

100−data User = User {

101− name :: Text

102− , user_id :: Integer

103− } deriving (Eq, Show, Generic)

104−

105−instance FromJSON User

106−instance ToJSON User

107−

108−type UserApi =

109− -- One endpoint: create a user

110− "user" :> Capture "userId" Integer :> Post '[JSON] User

111−```

112−

113−A real server would likely use a database to store, retrieve, and validate

114−users, but we're going to do something really simple merely to have something

115−to test. With that said, here's a sample handler, server, and `Application`

116−for the endpoint described above:

117−

118−```haskell

119−userApp :: Application

120−userApp = serve (Proxy :: Proxy UserApi) userServer

121−

122−userServer :: Server UserApi

123−userServer = createUser

124−

125−createUser :: Integer -> Handler User

126−createUser userId = do

127− if userId > 5000

128− then pure $ User { name = "some user", user_id = userId }

129− else throwError $ err400 { errBody = "userId is too small" }

130−```

131−

132−### Strategy 1: Spin Up a Server, Create a Client, Make Some Requests

133−

134−One of the benefits of Servant's type-level DSL for describing APIs is that

135−once you have provided a type-level description of your API, you can create

136−clients, documentation, or other tools for it somewhat magically.

137−

138−In this case, we'd like to *test* our server, so we can use `servant-client`

139−to create a client, after which we'll run our server, and then make requests

140−of it and see how it responds.

141−

142−Let's write some tests:

143−

144−```haskell

145−withUserApp :: (Warp.Port -> IO ()) -> IO ()

146−withUserApp action =

147− -- testWithApplication makes sure the action is executed after the server has

148− -- started and is being properly shutdown.

149− Warp.testWithApplication (pure userApp) action

150−

151−

152−businessLogicSpec :: Spec

153−businessLogicSpec =

154− -- `around` will start our Server before the tests and turn it off after

155− around withUserApp $ do

156− -- create a test client function

157− let createUser = client (Proxy :: Proxy UserApi)

158− -- create a servant-client ClientEnv

159− baseUrl <- runIO $ parseBaseUrl "http://localhost"

160− manager <- runIO $ newManager defaultManagerSettings

161− let clientEnv port = mkClientEnv manager (baseUrl { baseUrlPort = port })

162−

163− -- testing scenarios start here

164− describe "POST /user" $ do

165− it "should create a user with a high enough ID" $ \port -> do

166− result <- runClientM (createUser 50001) (clientEnv port)

167− result `shouldBe` (Right $ User { name = "some user", user_id = 50001})

168− it "will it fail with a too-small ID?" $ \port -> do

169− result <- runClientM (createUser 4999) (clientEnv port)

170− result `shouldBe` (Right $ User { name = "some user", user_id = 50001})

171−```

172−

173−### Running These Tests

174−

175−Let's run our tests and see what happens:

176−

177−```

178−$ cabal new-test all

179−POST /user

180− should create a user with a high enough ID

181− should fail with a too-small ID FAILED [1]

182−

183− Failures:

184−

185− Testing.lhs:129:7:

186− 1) POST /user should fail with a too-small ID

187− expected: Right (User {name = "some user", user_id = 50001})

188− but got: Left (FailureResponse (Response {responseStatusCode = Status {statusCode = 400, statusMessage = "Bad Request"}, responseHeaders = fromList [("Transfer-Encoding","chunked"),("Date","Fri, 12 Oct 2018 04:36:22 GMT"),("Server","Warp/3.2.25")], responseHttpVersion = HTTP/1.1, responseBody = "userId is too small"}))

189−

190− To rerun use: --match "/POST /user/should fail with a too-small ID/"

191−```

192−

193−Hmm. One passed and one failed! It looks like I *was* expecting a success

194−response in the second test, but I actually got a failure. We should fix that,

195−but first I'd like to introduce `hspec-wai`, which will give us different

196−mechanisms for making requests of our application and validating the responses

197−we get. We're also going to spin up a fake Elasticsearch server, so that our

198−server can think it's talking to a real database.

199−

200−

201−## *Mocking* 3rd Party Resources

202−

203−Often our web applications will need to make their own web

204−requests to other 3rd-party applications. These requests provide a lot

205−of opportunity for failure and so we'd like to test that the right

206−messages and failure values (in addition to success values) are returned

207−from our application.

208−

209−### Define the 3rd-Party Resource

210−

211−With Servant's type-level API definitions, assuming you've already defined the

212−API you want to mock, it's relatively trivial to create a simple server for

213−the purposes of running tests. For instance, consider an API server that needs

214−to get data out of Elasticsearch. Let's first define the Elasticsearch server

215−and client using Servant API descriptions:

216−

217−```haskell

218−type SearchAPI =

219− -- We're using Aeson's Generic JSON `Value` to make things easier on

220− -- ourselves. We're also representing only one Elasticsearch endpoint:

221− -- get item by id

222− "myIndex" :> "myDocType" :> Capture "docId" Integer :> Get '[JSON] Value

223−

224−-- Here's our Servant Client function

225−getDocument = client (Proxy :: Proxy SearchAPI)

226−

227−-- We can use these helpers when we want to make requests

228−-- using our client function

229−clientEnv :: Text -> Text -> IO ClientEnv

230−clientEnv esHost esPort = do

231− baseUrl <- parseBaseUrl $ unpack $ esHost <> ":" <> esPort

232− manager <- newManager defaultManagerSettings

233− pure $ mkClientEnv manager baseUrl

234−

235−runSearchClient :: Text -> Text -> ClientM a -> IO (Either ClientError a)

236−runSearchClient esHost esPort = (clientEnv esHost esPort >>=) . runClientM

237−```

238−

239−### Servant Server Example Using this 3rd-Party Resource

240−

241−So we've got an Elasticsearch server and a client to talk to it. Let's now

242−build a simple app server that uses this client to retrieve documents. This

243−is somewhat contrived, but hopefully it illustrates the typical three-tier

244−application architecture.

245−

246−One note: we're also going to take advantage of `lens-aeson` here, which may

247−look a bit foreign. The gist of it is that we're going to traverse a JSON

248−`Value` from Elasticsearch and try to extract some kind of document to

249−return.

250−

251−Imagine, then, that this is our real server implementation:

252−

253−```haskell

254−type DocApi =

255− "docs" :> Capture "docId" Integer :> Get '[JSON] Value

256−

257−docsApp :: Text -> Text -> Application

258−docsApp esHost esPort = serve (Proxy :: Proxy DocApi) $ docServer esHost esPort

259−

260−docServer :: Text -> Text -> Server DocApi

261−docServer esHost esPort = getDocById esHost esPort

262−

263−-- Our Handler tries to get a doc from Elasticsearch and then tries to parse

264−-- it. Unfortunately, there's a lot of opportunity for failure in these

265−-- actions

266−getDocById :: Text -> Text -> Integer -> Handler Value

267−getDocById esHost esPort docId = do

268− -- Our Servant Client function returns Either ClientError Value here:

269− docRes <- liftIO $ runSearchClient esHost esPort (getDocument docId)

270− case docRes of

271− Left err -> throwError $ err404 { errBody = "Failed looking up content" }

272− Right value -> do

273− -- we'll either fail to parse our document or we'll return it

274− case value ^? _Object . ix "_source" of

275− Nothing -> throwError $ err400 { errBody = "Failed parsing content" }

276− Just obj -> pure obj

277−```

278−

279−### Testing Our Backend

280−

281−So the above represents our application and is close to a server we may

282−actually deploy. How then shall we test this application?

283−

284−Ideally, we'd like it to make requests of a *real* Elasticsearch server, but

285−we certainly don't want our tests to trigger requests to a live, production

286−database. In addition, we don't want to depend on our real Elasticsearch

287−server having specific, consistent results for us to test against, because

288−that would make our tests flaky (and flaky tests are sometimes described as

289−worse than not having tests at all).

290−

291−One solution to this is to create a trivial Elasticsearch server as part of

292−our testing code. We can do this relatively easily because we already have

293−an API definition for it above. With a *real* server, we can then let our own

294−application make requests of it and we'll simulate different scenarios in

295−order to make sure our application responds the way we expect it to.

296−

297−Let's start with some helpers which will allow us to run a testing version

298−of our Elasticsearch server in another thread:

299−

300−```haskell

301−-- | We'll run the Elasticsearch server so we can test behaviors

302−withElasticsearch :: IO () -> IO ()

303−withElasticsearch action =

304− bracket (liftIO $ C.forkIO $ Warp.run 9999 esTestApp)

305− C.killThread

306− (const action)

307−

308−esTestApp :: Application

309−esTestApp = serve (Proxy :: Proxy SearchAPI) esTestServer

310−

311−esTestServer :: Server SearchAPI

312−esTestServer = getESDocument

313−

314−-- This is the *mock* handler we're going to use. We create it

315−-- here specifically to trigger different behavior in our tests.

316−getESDocument :: Integer -> Handler Value

317−getESDocument docId

318− -- arbitrary things we can use in our tests to simulate failure:

319− -- we want to trigger different code paths.

320− | docId > 1000 = throwError err500

321− | docId > 500 = pure . Object $ HM.fromList [("bad", String "data")]

322− | otherwise = pure $ Object $ HM.fromList [("_source", Object $ HM.fromList [("a", String "b")])]

323−```

324−

325−Now, we should be ready to write some tests.

326−

327−In this case, we're going to use `hspec-wai`, which will give us a simple way

328−to run our application, make requests, and make assertions against the

329−responses we receive.

330−

331−Hopefully, this will simplify our testing code:

332−

333−```haskell

334−thirdPartyResourcesSpec :: Spec

335−thirdPartyResourcesSpec = around_ withElasticsearch $ do

336− -- we call `with` from `hspec-wai` and pass *real* `Application`

337− with (pure $ docsApp "localhost" "9999") $ do

338− describe "GET /docs" $ do

339− it "should be able to get a document" $

340− -- `get` is a function from hspec-wai`.

341− get "/docs/1" `shouldRespondWith` 200

342− it "should be able to handle connection failures" $

343− get "/docs/1001" `shouldRespondWith` 404

344− it "should be able to handle parsing failures" $

345− get "/docs/501" `shouldRespondWith` 400

346− it "should be able to handle odd HTTP requests" $

347− -- we can also make all kinds of arbitrary custom requests to see how

348− -- our server responds using the `request` function:

349− -- request :: Method -> ByteString -> [Header]

350− -- -> LB.ByteString -> WaiSession SResponse

351− request methodPost "/docs/501" [] "{" `shouldRespondWith` 405

352− it "we can also do more with the Response using hspec-wai's matchers" $

353− -- see also `MatchHeader` and JSON-matching tools as well...

354− get "/docs/1" `shouldRespondWith` 200 { matchBody = MatchBody bodyMatcher }

355−

356−bodyMatcher :: [Network.HTTP.Types.Header] -> Body -> Maybe String

357−bodyMatcher _ body = case (decode body :: Maybe Value) of

358− -- success in this case means we return `Nothing`

359− Just val | val == (Object $ HM.fromList [("a", String "b")]) -> Nothing

360− _ -> Just "This is how we represent failure: this message will be printed"

361−```

362−

363−Out of the box, `hspec-wai` provides a lot of useful tools for us to run tests

364−against our application. What happens when we run these tests?

365−

366−```

367−$ cabal new-test all

368−...

369−

370−GET /docs

371− should be able to get a document

372− should be able to handle connection failures

373− should be able to handle parsing failures

374− should be able to handle odd HTTP requests

375− we can also do more with the Response using hspec-wai's matchers

376−```

377−

378−Fortunately, they all passed! Let's move to another strategy: whole-API

379−testing.

380−

381−## Servant Quickcheck

382−

383−[`servant-quickcheck`](https://github.com/haskell-servant/servant-quickcheck)

384−is a project that allows users to write tests for whole Servant APIs using

385−quickcheck-style property-checking mechanisms.

386−

387−`servant-quickcheck` is great for asserting API-wide rules, such as "no

388−endpoint throws a 500" or "all 301 status codes also come with a Location

389−header". The project even comes with a number of predicates that reference

390−the [RFCs they originate from](https://github.com/haskell-servant/servant-quickcheck/blob/master/src/Servant/QuickCheck/Internal/Predicates.hs).

391−

392−In other words, it's one way to assert that your APIs conform to specs and

393−best practices.

394−

395−### Quickcheckable API

396−

397−Let's make an API and a server to demonstrate how to use `servant-quickcheck`:

398−

399−```haskell

400−type API = ReqBody '[JSON] String :> Post '[JSON] String

401− :<|> Get '[JSON] Int

402− :<|> BasicAuth "some-realm" () :> Get '[JSON] ()

403−

404−api :: Proxy API

405−api = Proxy

406−

407−server :: IO (Server API)

408−server = do

409− mvar <- newMVar ""

410− return $ (\x -> liftIO $ swapMVar mvar x)

411− :<|> (liftIO $ readMVar mvar >>= return . length)

412− :<|> (const $ return ())

413−```

414−

415−### Using `servant-quickcheck`

416−

417−Let's build some tests for our API using `servant-quickcheck`.

418−

419−Similar to the above examples, we're going to create `Spec`s, but in this

420−case, we'll rely on a number of predicates available from `servant-quickcheck`

421−to see if our API server conforms to best practices:

422−

423−```haskell

424−-- Let's set some QuickCheck values

425−args :: Args

426−args = defaultArgs { maxSuccess = 500 }

427−

428−-- Here's a Servant Context object we'll use

429−ctx :: Context '[BasicAuthCheck ()]

430−ctx = BasicAuthCheck (const . return $ NoSuchUser) :. EmptyContext

431−

432−

433−servantQuickcheckSpec :: Spec

434−servantQuickcheckSpec = describe "" $ do

435− it "API demonstrates best practices" $

436− -- `withServerServer` and `withServantServerAndContext` come from `servant-quickcheck`

437− withServantServerAndContext api ctx server $ \burl ->

438− -- `serverSatisfies` and the predicates also come from `servant-quickcheck`

439− serverSatisfies api burl args (unauthorizedContainsWWWAuthenticate

440− <%> not500

441− <%> onlyJsonObjects -- this one isn't true!

442− <%> mempty)

443−

444− it "API doesn't have these things implemented yet" $

445− withServantServerAndContext api ctx server $ \burl -> do

446− serverDoesntSatisfy api burl args (getsHaveCacheControlHeader

447− <%> notAllowedContainsAllowHeader

448− <%> mempty)

449−```

450−

451−Let's see what happens when we run these tests:

452−

453−

454−```

455− API demonstrates best practices FAILED [2]

456−+++ OK, passed 500 tests.

457− API doesn't have these things implemented yet

458−

459− src/Servant/QuickCheck/Internal/QuickCheck.hs:143:11:

460− 2) Main[339:25] API demonstrates best practices

461− Failed:

462− Just Predicate failed

463− Predicate: onlyJsonObjects

464−

465− Response:

466− Status code: 200

467− Headers: "Transfer-Encoding": "chunked"

468− "Date": "Fri, 12 Oct 2018 04:36:22 GMT"

469− "Server": "Warp/3.2.25"

470− "Content-Type": "application/json;charset=utf-8"

471− Body: ""

472−

473− To rerun use: --match "/Main[339:25]/API demonstrates best practices/"

474−

475−Randomized with seed 1046277487

476−

477−Finished in 0.4306 seconds

478−```

479−

480−Hmm. It looks like we *thought* our API only returned JSON objects, which is a

481−best practice, but in fact, we *did* have an endpoint that returned an empty

482−body, which you can see in the printed response above: `Body: ""`. We should

483−consider revising our API to only return top-level JSON Objects in the future!

484−

485−### Other Cool Things

486−

487−`servant-quickcheck` also has a cool mechanism where you can compare two API

488−servers to demonstrate that they respond identically to requests. This may be

489−useful if you are planning to rewrite one API in another language or with

490−another web framework. You have to specify whether you're looking for

491−`jsonEquality` vs regular `ByteString` equality, though.

492−

493−## Conclusion

494−

495−There are lots of techniques for testing and we only covered a few here.

496−

497−Useful libraries such as `hspec-wai` have ways of running Wai `Application`s

498−and sending requests to them, while Servant's type-level DSL for defining APIs

499−allows us to more easily mock out servers and to derive clients, which will

500−only craft valid requests.

501−

502−Lastly, if you want a broad overview of where your application fits in with

503−regard to best practices, consider using `servant-quickcheck`.

504−

505−This program is available as a cabal project

506−[here](https://github.com/haskell-servant/servant/tree/master/doc/cookbook/testing).

doc/cookbook/testing/testing.cabaldeleted−38

@@ -1,38 +0,0 @@

1−cabal-version: 2.2

2−name: cookbook-testing

3−version: 0.0.1

4−synopsis: Common testing patterns in Servant apps

5−description: This recipe includes various strategies for writing tests for Servant.

6−homepage: http://docs.servant.dev/

7−license: BSD-3-Clause

8−license-file: ../../../servant/LICENSE

9−author: Servant Contributors

10−maintainer: haskell-servant-maintainers@googlegroups.com

11−category: Servant

12−build-type: Simple

13−tested-with: GHC==8.6.5, GHC==8.8.3, GHC ==8.10.7

14−

15−executable cookbook-testing

16− main-is: Testing.lhs

17− build-depends: base == 4.*

18− , base-compat

19− , text >= 1.2

20− , aeson >= 1.2

21− , lens-aeson

22− , lens

23− , servant

24− , servant-client

25− , servant-server

26− , servant-quickcheck >= 0.0.10

27− , http-client

28− , http-types >= 0.12

29− , hspec

30− , hspec-wai

31− , QuickCheck

32− , unordered-containers

33− , warp >= 3.2

34− , wai >= 3.2

35− , wai-extra

36− default-language: Haskell2010

37− ghc-options: -Wall -pgmL markdown-unlit

38− build-tool-depends: markdown-unlit:markdown-unlit

doc/cookbook/using-custom-monad/UsingCustomMonad.lhs+1−4

@@ -1,6 +1,6 @@

1# Using a custom monad

2

3−In this section we will create an API for a book shelf without any backing DB storage.

3+In this section we will create and API for a book shelf without any backing DB storage.

4We will keep state in memory and share it between requests using `Reader` monad and `STM`.

5

6We start with a pretty standard set of imports and definition of the model:

@@ -115,6 +115,3 @@ Running cookbook-using-custom-monad...

115[Book "To Kill a Mockingbird",Book "Harry Potter and the Order of the Phoenix"]

116[Book "The Picture of Dorian Gray",Book "To Kill a Mockingbird",Book "Harry Potter and the Order of the Phoenix"]

117```

118−

119−To use `Raw` endpoints, look at the

120−[servant-rawm](http://hackage.haskell.org/package/servant-rawm) package.

doc/cookbook/using-custom-monad/using-custom-monad.cabal+4−4

@@ -1,14 +1,14 @@

1−cabal-version: 2.2

2name: cookbook-using-custom-monad

1name: cookbook-using-custom-monad

3version: 0.1

2version: 0.1

4synopsis: Using custom monad to pass a state between handlers

3synopsis: Using custom monad to pass a state between handlers

5−homepage: http://docs.servant.dev/

4+homepage: http://haskell-servant.readthedocs.org/

6−license: BSD-3-Clause

5+license: BSD3

7license-file: ../../../servant/LICENSE

6license-file: ../../../servant/LICENSE

8author: Servant Contributors

7author: Servant Contributors

9maintainer: haskell-servant-maintainers@googlegroups.com

8maintainer: haskell-servant-maintainers@googlegroups.com

10build-type: Simple

9build-type: Simple

10+cabal-version: >=1.10

11−tested-with: GHC==8.6.5, GHC==8.8.3, GHC ==8.10.7

11+tested-with: GHC==8.0.2, GHC==8.2.2, GHC==8.4.3

12

13executable cookbook-using-custom-monad

14 main-is: UsingCustomMonad.lhs

doc/cookbook/using-free-client/UsingFreeClient.lhs+9−7

@@ -2,7 +2,7 @@

2

3or simply put: _a practical introduction to `Servant.Client.Free`_.

4

5−Someone asked on IRC how one could access the intermediate Requests (resp. Responses)

5+Someone asked on IRC how one could access the intermediate Requests (resp. Responses)

6produced (resp. received) by client functions derived using servant-client.

7My response to such inquiries is: to extend `servant-client` in an ad-hoc way (e.g for testing or debugging

8purposes), use `Servant.Client.Free`. This recipe shows how.

@@ -99,6 +99,8 @@ test = case getSquare 42 of

99 putStrLn $ "ERROR: got pure result: " ++ show n

100 Free (Throw err) ->

101 putStrLn $ "ERROR: got error right away: " ++ show err

102+ Free (StreamingRequest _req _k) ->

103+ putStrLn $ "ERROR: need to do streaming request" -- TODO: no Show Req :(

102```

104```

103

105

104We are interested in `RunRequest`, that's what client should block on:

106We are interested in `RunRequest`, that's what client should block on:

@@ -119,7 +121,7 @@ Now we can use `servant-client`'s internals to convert servant's `Request`

119to http-client's `Request`, and we can inspect it:

121to http-client's `Request`, and we can inspect it:

120

122

121```haskell

123```haskell

122− req' <- I.defaultMakeClientRequest burl req

124+ let req' = I.requestToClientRequest burl req

123 putStrLn $ "Making request: " ++ show req'

125 putStrLn $ "Making request: " ++ show req'

124```

126```

125

127

@@ -135,13 +137,13 @@ And we continue by turning http-client's `Response` into servant's `Response`,

135and calling the continuation. We should get a `Pure` value.

137and calling the continuation. We should get a `Pure` value.

136

138

137```haskell

139```haskell

138− let res = I.clientResponseToResponse id res'

140+ let res = I.clientResponseToResponse res'

139−

141+

140 case k res of

142 case k res of

141 Pure n ->

143 Pure n ->

142 putStrLn $ "Expected 1764, got " ++ show n

144 putStrLn $ "Expected 1764, got " ++ show n

143− _ ->

145+ _ ->

144− putStrLn "ERROR: didn't get a response"

146+ putStrLn "ERROR: didn't got a response"

145```

147```

146

148

147So that's it. Using `Free` we can evaluate servant clients step-by-step, and

149So that's it. Using `Free` we can evaluate servant clients step-by-step, and

@@ -153,7 +155,7 @@ and responses available for us to inspect, since `RunClient` only gives us

153access to one `Request` or `Response` at a time.

155access to one `Request` or `Response` at a time.

154

156

155On the other hand, a "batch collection" of requests and/or responses can be achieved

157On the other hand, a "batch collection" of requests and/or responses can be achieved

156−with both free clients and a custom `RunClient` instance rather easily, for example

158+with both free clients and a custom `RunClient` instance rather easily, for example

157by using a `Writer [(Request, Response)]` monad.

159by using a `Writer [(Request, Response)]` monad.

158

160

159Here is an example of running our small `test` against a running server:

161Here is an example of running our small `test` against a running server:

doc/cookbook/using-free-client/using-free-client.cabal+4−4

@@ -1,14 +1,14 @@

1−cabal-version: 2.2

2name: cookbook-using-free-client

1name: cookbook-using-free-client

3version: 0.1

2version: 0.1

4synopsis: Using Free client

3synopsis: Using Free client

5−homepage: http://docs.servant.dev/

4+homepage: http://haskell-servant.readthedocs.org/

6−license: BSD-3-Clause

5+license: BSD3

7license-file: ../../../servant/LICENSE

6license-file: ../../../servant/LICENSE

8author: Servant Contributors

7author: Servant Contributors

9maintainer: haskell-servant-maintainers@googlegroups.com

8maintainer: haskell-servant-maintainers@googlegroups.com

10build-type: Simple

9build-type: Simple

10+cabal-version: >=1.10

11−tested-with: GHC==8.6.5, GHC==8.8.3, GHC ==8.10.7

11+tested-with: GHC==8.0.2, GHC==8.2.2, GHC==8.4.3

12

13executable cookbook-using-free-client

14 main-is: UsingFreeClient.lhs

doc/cookbook/uverb/UVerb.lhsdeleted−223

@@ -1,223 +0,0 @@

1−# Listing alternative responses and exceptions in your API types

2−

3−Servant allows you to talk about the exceptions you throw in your API

4−types. This is not limited to actual exceptions, you can write

5−handlers that respond with arbitrary open unions of types.

6−

7−## Compatibility

8−

9−:warning: This cookbook is compatible with GHC 8.6.1 or higher :warning:

10−

11−## Preliminaries

12−

13−```haskell

14−{-# LANGUAGE ConstraintKinds #-}

15−{-# LANGUAGE DataKinds #-}

16−{-# LANGUAGE DeriveGeneric #-}

17−{-# LANGUAGE DerivingStrategies #-}

18−{-# LANGUAGE DeriveAnyClass #-}

19−{-# LANGUAGE DerivingVia #-}

20−{-# LANGUAGE FlexibleContexts #-}

21−{-# LANGUAGE FlexibleInstances #-}

22−{-# LANGUAGE GeneralizedNewtypeDeriving #-}

23−{-# LANGUAGE InstanceSigs #-}

24−{-# LANGUAGE MultiParamTypeClasses #-}

25−{-# LANGUAGE OverloadedStrings #-}

26−{-# LANGUAGE ScopedTypeVariables #-}

27−{-# LANGUAGE StandaloneDeriving #-}

28−{-# LANGUAGE TypeApplications #-}

29−{-# LANGUAGE TypeFamilies #-}

30−{-# LANGUAGE TypeOperators #-}

31−{-# LANGUAGE UndecidableInstances #-}

32−{-# OPTIONS_GHC -Wall -Wno-orphans #-}

33−

34−import Control.Concurrent (threadDelay)

35−import Control.Concurrent.Async (async)

36−import Control.Monad (when)

37−import Control.Monad.Except (ExceptT (..), MonadError (..), MonadTrans (..), runExceptT)

38−import Data.Aeson (FromJSON (..), ToJSON (..))

39−import Data.Aeson.Encode.Pretty (encodePretty)

40−import Data.String.Conversions (cs)

41−import Data.Swagger (ToSchema)

42−import Data.Typeable (Proxy (Proxy))

43−import qualified GHC.Generics as GHC

44−import qualified Network.HTTP.Client as Client

45−import qualified Network.Wai.Handler.Warp as Warp

46−import Servant.API

47−import Servant.Client

48−import Servant.Server

49−import Servant.Swagger

50−```

51−

52−## The API

53−

54−This looks like a `Verb`-based routing table, except that `UVerb` has

55−no status, and carries a list of response types rather than a single

56−one. Each entry in the list carries its own response code.

57−

58−```haskell

59−type API =

60− "fisx" :> Capture "bool" Bool

61− :> UVerb 'GET '[JSON] '[FisxUser, WithStatus 303 String]

62− :<|> "arian"

63− :> UVerb 'GET '[JSON] '[WithStatus 201 ArianUser]

64−```

65−

66−Here are the details:

67−

68−```haskell

69−data FisxUser = FisxUser {name :: String}

70− deriving (Eq, Show, GHC.Generic)

71−

72−instance ToJSON FisxUser

73−instance FromJSON FisxUser

74−instance ToSchema FisxUser

75−

76−-- | 'HasStatus' allows us to can get around 'WithStatus' if we want

77−-- to, and associate the status code with our resource types directly.

78−--

79−-- (To avoid orphan instances and make it more explicit what's in the

80−-- API and what isn't, we could even introduce a newtype 'Resource'

81−-- that wraps all the types we're using in our routing table, and then

82−-- define lots of 'HasStatus' instances for @Resource This@ and

83−-- @Resource That@.)

84−instance HasStatus FisxUser where

85− type StatusOf FisxUser = 203

86−

87−data ArianUser = ArianUser

88− deriving (Eq, Show, GHC.Generic)

89−

90−instance ToJSON ArianUser

91−instance FromJSON ArianUser

92−instance ToSchema ArianUser

93−```

94−

95−## Server, Client, Swagger

96−

97−You can just respond with any of the elements of the union in handlers.

98−

99−```haskell

100−fisx :: Bool -> Handler (Union '[FisxUser, WithStatus 303 String])

101−fisx True = respond (FisxUser "fisx")

102−fisx False = respond (WithStatus @303 ("still fisx" :: String))

103−

104−arian :: Handler (Union '[WithStatus 201 ArianUser])

105−arian = respond (WithStatus @201 ArianUser)

106−```

107−

108−You can create client functions like you're used to:

109−

110−```

111−fisxClient :: Bool -> ClientM (Union '[FisxUser, WithStatus 303 String])

112−arianClient :: ClientM (Union '[WithStatus 201 ArianUser])

113−(fisxClient :<|> arianClient) = client (Proxy @API)

114−```

115−

116−... and that's basically it! Here are a few sample commands that

117−show you how the swagger docs look like and how you can handle the

118−result unions in clients:

119−

120−```

121−main :: IO ()

122−main = do

123− putStrLn . cs . encodePretty $ toSwagger (Proxy @API)

124− _ <- async . Warp.run 8080 $ serve (Proxy @API) (fisx :<|> arian)

125− threadDelay 50000

126− mgr <- Client.newManager Client.defaultManagerSettings

127− let cenv = mkClientEnv mgr (BaseUrl Http "localhost" 8080 "")

128− result <- runClientM (fisxClient True) cenv

129− print $ foldMapUnion (Proxy @Show) show <$> result

130− print $ matchUnion @FisxUser <$> result

131− print $ matchUnion @(WithStatus 303 String) <$> result

132− pure ()

133−```

134−

135−## Idiomatic exceptions

136−

137−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`.

138−

139−```haskell

140−newtype UVerbT xs m a = UVerbT { unUVerbT :: ExceptT (Union xs) m a }

141− deriving (Functor, Applicative, Monad, MonadTrans)

142−

143−-- | Deliberately hide 'ExceptT's 'MonadError' instance to be able to use

144−-- underlying monad's instance.

145−instance MonadError e m => MonadError e (UVerbT xs m) where

146− throwError = lift . throwError

147− catchError (UVerbT act) h = UVerbT $ ExceptT $

148− runExceptT act `catchError` (runExceptT . unUVerbT . h)

149−

150−-- | This combinator runs 'UVerbT'. It applies 'respond' internally, so the handler

151−-- may use the usual 'return'.

152−runUVerbT :: (Monad m, HasStatus x, IsMember x xs) => UVerbT xs m x -> m (Union xs)

153−runUVerbT (UVerbT act) = either id id <$> runExceptT (act >>= respond)

154−

155−-- | Short-circuit 'UVerbT' computation returning one of the response types.

156−throwUVerb :: (Monad m, HasStatus x, IsMember x xs) => x -> UVerbT xs m a

157−throwUVerb = UVerbT . ExceptT . fmap Left . respond

158−```

159−

160−Example usage:

161−

162−```haskell

163−data Foo = Foo Int Int Int

164− deriving (Show, Eq, GHC.Generic, ToJSON)

165− deriving HasStatus via WithStatus 200 Foo

166−

167−data Bar = Bar

168− deriving (Show, Eq, GHC.Generic)

169−

170−instance ToJSON Bar

171−

172−h :: Handler (Union '[Foo, WithStatus 400 Bar])

173−h = runUVerbT $ do

174− when ({- something bad -} True) $

175− throwUVerb $ WithStatus @400 Bar

176−

177− when ({- really bad -} False) $

178− throwError $ err500

179−

180− -- a lot of code here...

181−

182− return $ Foo 1 2 3

183−```

184−

185−## Related Work

186−

187−There is the [issue from

188−2017](https://github.com/haskell-servant/servant/issues/841) that was

189−resolved by the introduction of `UVerb`, with a long discussion on

190−alternative designs.

191−

192−[servant-checked-exceptions](https://hackage.haskell.org/package/servant-checked-exceptions)

193−is a good solution to the problem, but it restricts the user to JSON

194−and a very specific envelop encoding for the union type, which is

195−often not acceptable. (One good reason for this design choice is that

196−it makes writing clients easier, where you need to get to the union

197−type from one representative, and you don't want to run several

198−parsers in the hope that the ones that should will always error out so

199−you can try until the right one returns a value.)

200−

201−[servant-exceptions](https://github.com/ch1bo/servant-exceptions) is

202−another shot at at the problem. It is inspired by

203−servant-checked-exceptions, so it may be worth taking a closer look.

204−The README claims that

205−[cardano-sl](https://github.com/input-output-hk/cardano-sl) also has

206−some code for generalized error handling.

207−

208−In an earier version of the `UVerb` implementation, we have used some

209−code from

210−[world-peace](https://hackage.haskell.org/package/world-peace), but

211−that package itself wasn't flexible enough, and we had to use

212−[sop-core](https://hackage.haskell.org/package/sop-core) to implement

213−the `HasServer` instance.

214−

215−Here is a blog post we found on the subject:

216−https://lukwagoallan.com/posts/unifying-servant-server-error-responses

217−

218−(If you have anything else, please add it here or let us know.)

219−

220−```haskell

221−main :: IO ()

222−main = return ()

223−```

doc/cookbook/uverb/uverb.cabaldeleted−35

@@ -1,35 +0,0 @@

1−cabal-version: 2.2

2−name: cookbook-uverb

3−version: 0.0.1

4−synopsis: How to use the 'UVerb' type.

5−description: Listing alternative responses and exceptions in your API types.

6−homepage: http://docs.servant.dev/

7−license: BSD-3-Clause

8−license-file: ../../../servant/LICENSE

9−author: Servant Contributors

10−maintainer: haskell-servant-maintainers@googlegroups.com

11−category: Servant

12−build-type: Simple

13−tested-with: GHC==8.6.5, GHC==8.8.4, GHC==8.10.7

14−

15−executable cookbook-uverb

16− main-is: UVerb.lhs

17− build-depends: base == 4.*

18− , aeson >= 1.2

19− , aeson-pretty >= 0.8.8

20− , async

21− , http-client

22− , mtl

23− , servant

24− , servant-client

25− , servant-server

26− , servant-swagger

27− , string-conversions

28− , swagger2

29− , wai

30− , warp

31− if impl(ghc >= 9)

32− buildable: False

33− default-language: Haskell2010

34− ghc-options: -Wall -pgmL markdown-unlit

35− build-tool-depends: markdown-unlit:markdown-unlit

doc/examples.md+2−12

@@ -8,7 +8,7 @@

8

9- **[servant-examples](https://github.com/sras/servant-examples)**:

10

11− Similar to [the cookbook](https://docs.servant.dev/en/latest/cookbook/index.html) but

11+ Similar to [the cookbook](https://haskell-servant.readthedocs.io/en/latest/cookbook/index.html) but

12 with no explanations, for developers who just want to look at code examples to find out how to do X or Y

13 with servant.

14

@@ -37,7 +37,7 @@

37

38 An example consisting of

39

40− - a backend that uses `servant`

40+ - a backend in uses `haskell-servant`

41 - a frontend written in [PureScript](http://www.purescript.org/) using

42 [servant-purescript](https://github.com/eskimor/servant-purescript) to generate

43 an API wrapper in PureScript to interface the web API with

@@ -48,13 +48,3 @@

48 An example for a web server written with **servant-server** and

49 [persistent](https://www.stackage.org/package/persistent) for writing data

50 into a database.

51−

52−- **[full-example-servant-elm-auth-yeshql-postgresql](https://github.com/aRkadeFR/FlashCard)**:

53−

54− A full open source website written with **servant-server**, yeshql, postgresql and elm 0.19.

55−

56−

57−- [`import Servant` github search](https://github.com/search?q=%22import+Servant%22+language%3AHaskell&type=Code)

58−

59− It has thousands of results and can be a good way to see how people use servant in their projects or even to discover

60− servant-related libraries.

doc/links.rst+3−3

@@ -3,7 +3,7 @@ Helpful Links

3-------------

4

5- the central documentation (this site):

6− `docs.servant.dev <http://docs.servant.dev/>`_

6+ `haskell-servant.readthedocs.org <http://haskell-servant.readthedocs.org/>`_

7

8- the github repo:

9 `github.com/haskell-servant/servant <https://github.com/haskell-servant/servant>`_

@@ -12,13 +12,13 @@ Helpful Links

12 `https://github.com/haskell-servant/servant/issues <https://github.com/haskell-servant/servant/issues>`_

13

14- the irc channel:

15− `#haskell-servant on libera.chat <https://web.libera.chat/#haskell-servant>`_

15+ ``#servant`` on freenode

16

17- the mailing list:

18 `groups.google.com/forum/#!forum/haskell-servant <https://groups.google.com/forum/#!forum/haskell-servant>`_

19

20- blog posts and videos and slides of some talks on servant:

21− `www.servant.dev <http://www.servant.dev>`_

21+ `haskell-servant.github.io <http://haskell-servant.github.io>`_

22

23- the servant packages on hackage:

24

doc/requirements.txt+3−3

@@ -1,3 +1,3 @@

1−recommonmark==0.5.0

1+recommonmark==0.4.0

2−Sphinx==1.8.4

2+Sphinx==1.7.5

3−sphinx_rtd_theme>=0.4.2

3+sphinx_rtd_theme>=0.4.0

doc/tutorial/ApiType.lhs+9−42

@@ -129,23 +129,16 @@ type UserAPI4 = "users" :> Get '[JSON] [User]

129

130### `StreamGet` and `StreamPost`

131

132−*Note*: Streaming has changed considerably in `servant-0.15`.

133−

134The `StreamGet` and `StreamPost` combinators are defined in terms of the more general `Stream`

132The `StreamGet` and `StreamPost` combinators are defined in terms of the more general `Stream`

135

133

136``` haskell ignore

134``` haskell ignore

137−data Stream (method :: k1) (status :: Nat) (framing :: *) (contentType :: *) (a :: *)

135+data Stream (method :: k1) (framing :: *) (contentType :: *) a

138−

139−type StreamGet = Stream 'GET 200

136+type StreamGet = Stream 'GET

140−type StreamPost = Stream 'POST 200

137+type StreamPost = Stream 'POST

141```

138```

142

139

143−These describe endpoints that return a stream of values rather than just a

140+These describe endpoints that return a stream of values rather than just a single value. They not only take a single content type as a parameter, but also a framing strategy -- this specifies how the individual results are delineated from one another in the stream. The three standard strategies given with Servant are `NewlineFraming`, `NetstringFraming` and `NoFraming`, but others can be written to match other protocols.

144−single value. They not only take a single content type as a parameter, but also

141+

145−a framing strategy -- this specifies how the individual results are delineated

146−from one another in the stream. The three standard strategies given with

147−Servant are `NewlineFraming`, `NetstringFraming` and `NoFraming`, but others

148−can be written to match other protocols.

149

142

150### `Capture`

143### `Capture`

151

144

@@ -177,12 +170,13 @@ type UserAPI5 = "user" :> Capture "userid" Integer :> Get '[JSON] User

177 -- except that we explicitly say that "userid"

170 -- except that we explicitly say that "userid"

178 -- must be an integer

171 -- must be an integer

179

172

180− :<|> "user" :> Capture "userid" Integer :> DeleteNoContent

173+ :<|> "user" :> Capture "userid" Integer :> DeleteNoContent '[JSON] NoContent

181 -- equivalent to 'DELETE /user/:userid'

174 -- equivalent to 'DELETE /user/:userid'

182```

175```

183

176

184−In the second case, `DeleteNoContent` specifies a 204 response code

177+In the second case, `DeleteNoContent` specifies a 204 response code,

178+`JSON` specifies the content types on which the handler will match,

185−and that the response will always be empty.

179+and `NoContent` says that the response will always be empty.

186

180

187### `QueryParam`, `QueryParams`, `QueryFlag`

181### `QueryParam`, `QueryParams`, `QueryFlag`

188

182

@@ -389,30 +383,3 @@ One example for this is if you want to serve a directory of static files along

389with the rest of your API. But you can plug in everything that is an

383with the rest of your API. But you can plug in everything that is an

390`Application`, e.g. a whole web application written in any of the web

384`Application`, e.g. a whole web application written in any of the web

391frameworks that support `wai`.

385frameworks that support `wai`.

392−

393−Be mindful! The `servant-server`'s router works by pattern-matching the

394−different routes that are composed using `:<|>`. `Raw`, as an escape hatch,

395−matches any route that hasn't been matched by previous patterns. Therefore,

396−any subsequent route will be silently ignored.

397−

398−``` haskell

399−type UserAPI14 = Raw

400− :<|> "users" :> Get '[JSON] [User]

401− -- In this situation, the /users endpoint

402− -- will not be reachable because the Raw

403− -- endpoint matches requests before

404−```

405−A simple way to avoid this pitfall is to either use `Raw` as the last

406−definition, or to always have it under a static path.

407−

408−``` haskell

409−type UserAPI15 = "files" :> Raw

410− -- The raw endpoint is under the /files

411− -- static path, so it won't match /users.

412− :<|> "users" :> Get '[JSON] [User]

413−

414−type UserAPI16 = "users" :> Get '[JSON] [User]

415− :<|> Raw

416− -- The Raw endpoint is matched last, so

417− -- it won't overlap another endpoint.

418−```

doc/tutorial/Authentication.lhs+11−10

@@ -47,6 +47,7 @@ module Authentication where

47import Data.Aeson (ToJSON)

48import Data.ByteString (ByteString)

49import Data.Map (Map, fromList)

50+import Data.Monoid ((<>))

50import qualified Data.Map as Map

51import qualified Data.Map as Map

51import Data.Proxy (Proxy (Proxy))

52import Data.Proxy (Proxy (Proxy))

52import Data.Text (Text)

53import Data.Text (Text)

@@ -107,7 +108,7 @@ API with "private." Additionally, the private parts of our API use the

107realm for this authentication is `"foo-realm"`).

108realm for this authentication is `"foo-realm"`).

108

109

109Unfortunately we're not done. When someone makes a request to our `"private"`

110Unfortunately we're not done. When someone makes a request to our `"private"`

110−API, we're going to need to provide to servant the logic for validating

111+API, we're going to need to provide to servant the logic for validifying

111usernames and passwords. This adds a certain conceptual wrinkle in servant's

112usernames and passwords. This adds a certain conceptual wrinkle in servant's

112design that we'll briefly discuss. If you want the **TL;DR**: we supply a lookup

113design that we'll briefly discuss. If you want the **TL;DR**: we supply a lookup

113function to servant's new `Context` primitive.

114function to servant's new `Context` primitive.

@@ -132,7 +133,7 @@ combinator. Using `Context`, we can supply a function of type

132handler. This will allow the handler to check authentication and return a `User`

133handler. This will allow the handler to check authentication and return a `User`

133to downstream handlers if successful.

134to downstream handlers if successful.

134

135

135−In practice we wrap `BasicAuthData -> Handler User` into a slightly

136+In practice we wrap `BasicAuthData -> Handler` into a slightly

136different function to better capture the semantics of basic authentication:

137different function to better capture the semantics of basic authentication:

137

138

138``` haskell ignore

139``` haskell ignore

@@ -259,7 +260,7 @@ this.

259

260

260Let's implement a trivial authentication scheme. We will protect our API by

261Let's implement a trivial authentication scheme. We will protect our API by

261looking for a cookie named `"servant-auth-cookie"`. This cookie's value will

262looking for a cookie named `"servant-auth-cookie"`. This cookie's value will

262−contain a key from which we can lookup an `Account`.

263+contain a key from which we can lookup a `Account`.

263

264

264```haskell

265```haskell

265-- | An account type that we "fetch from the database" after

266-- | An account type that we "fetch from the database" after

@@ -273,7 +274,7 @@ database = fromList [ ("key1", Account "Anne Briggs")

273 , ("key3", Account "Ghédalia Tazartès")

274 , ("key3", Account "Ghédalia Tazartès")

274 ]

275 ]

275

276

276−-- | A method that, when given a password, will return an Account.

277+-- | A method that, when given a password, will return a Account.

277-- This is our bespoke (and bad) authentication logic.

278-- This is our bespoke (and bad) authentication logic.

278lookupAccount :: ByteString -> Handler Account

279lookupAccount :: ByteString -> Handler Account

279lookupAccount key = case Map.lookup key database of

280lookupAccount key = case Map.lookup key database of

@@ -317,7 +318,7 @@ genAuthAPI = Proxy

317

318

318Now we need to bring everything together for the server. We have the

319Now we need to bring everything together for the server. We have the

319`AuthHandler Request Account` value and an `AuthProtected` endpoint. To bind these

320`AuthHandler Request Account` value and an `AuthProtected` endpoint. To bind these

320−together, we need to provide a [Type Family](https://downloads.haskell.org/~ghc/8.8.1/docs/html/users_guide/glasgow_exts.html#type-families)

321+together, we need to provide a [Type Family](https://downloads.haskell.org/~ghc/latest/docs/html/users_guide/type-families.html)

321instance that tells the `HasServer` instance that our `Context` will supply a

322instance that tells the `HasServer` instance that our `Context` will supply a

322`Account` (via `AuthHandler Request Account`) and that downstream combinators will

323`Account` (via `AuthHandler Request Account`) and that downstream combinators will

323have access to this `Account` value (or an error will be thrown if authentication

324have access to this `Account` value (or an error will be thrown if authentication

@@ -345,7 +346,7 @@ genAuthServerContext = authHandler :. EmptyContext

345

346

346-- | Our API, where we provide all the author-supplied handlers for each end

347-- | Our API, where we provide all the author-supplied handlers for each end

347-- point. Note that 'privateDataFunc' is a function that takes 'Account' as an

348-- point. Note that 'privateDataFunc' is a function that takes 'Account' as an

348−-- argument. We don't worry about the authentication instrumentation here,

349+-- argument. We dont' worry about the authentication instrumentation here,

349-- that is taken care of by supplying context

350-- that is taken care of by supplying context

350genAuthServer :: Server AuthGenAPI

351genAuthServer :: Server AuthGenAPI

351genAuthServer =

352genAuthServer =

@@ -367,10 +368,10 @@ genAuthMain = run 8080 (serveWithContext genAuthAPI genAuthServerContext genAuth

367$ curl -XGET localhost:8080/private

368$ curl -XGET localhost:8080/private

368Missing auth header

369Missing auth header

369

370

370−$ curl -XGET localhost:8080/private -H "Cookie: servant-auth-cookie=key3"

371+$ curl -XGET localhost:8080/private -H "servant-auth-cookie: key3"

371[{"ssshhh":"this is a secret: Ghédalia Tazartès"}]

372[{"ssshhh":"this is a secret: Ghédalia Tazartès"}]

372

373

373−$ curl -XGET localhost:8080/private -H "Cookie: servant-auth-cookie=bad-key"

374+$ curl -XGET localhost:8080/private -H "servant-auth-cookie: bad-key"

374Invalid Cookie

375Invalid Cookie

375

376

376$ curl -XGET localhost:8080/public

377$ curl -XGET localhost:8080/public

@@ -384,11 +385,11 @@ Creating a generalized, ad-hoc authentication scheme was fairly straight

384forward:

385forward:

385

386

3861. use the `AuthProtect` combinator to protect your API.

3871. use the `AuthProtect` combinator to protect your API.

387−2. choose an application-specific data type used by your server when

388+2. choose a application-specific data type used by your server when

388authentication is successful (in our case this was `Account`).

389authentication is successful (in our case this was `Account`).

3893. Create a value of `AuthHandler Request Account` which encapsulates the

3903. Create a value of `AuthHandler Request Account` which encapsulates the

390authentication logic (`Request -> Handler Account`). This function

391authentication logic (`Request -> Handler Account`). This function

391−will be executed every time a request matches a protected route.

392+will be executed everytime a request matches a protected route.

3924. Provide an instance of the `AuthServerData` type family, specifying your

3934. Provide an instance of the `AuthServerData` type family, specifying your

393application-specific data type returned when authentication is successful (in

394application-specific data type returned when authentication is successful (in

394our case this was `Account`).

395our case this was `Account`).

doc/tutorial/Client.lhs+26−26

@@ -1,9 +1,9 @@

1# Querying an API

2

3−While defining handlers that [serve an API](Server.html) has a lot to it, querying an API is simpler: we do not care about what happens inside the webserver, we just need to know how to talk to it and get a response back. That said, we usually have to write the querying functions by hand because the structure of the API isn't a first class citizen and can't be inspected to generate the client-side functions.

3+While defining handlers that [serve an API](Server.lhs) has a lot to it, querying an API is simpler: we do not care about what happens inside the webserver, we just need to know how to talk to it and get a response back. That said, we usually have to write the querying functions by hand because the structure of the API isn't a first class citizen and can't be inspected to generate the client-side functions.

4

5**servant** however has a way to inspect APIs, because APIs are just Haskell types and (GHC) Haskell lets us do quite a few things with types. In the same way that we look at an API type to deduce the types the handlers should have, we can inspect the structure of the API to *derive* Haskell functions that take one argument for each occurrence of `Capture`, `ReqBody`, `QueryParam`

6−and friends (see [the tutorial introduction](ApiType.html) for an overview). By *derive*, we mean that there's no code generation involved - the functions are defined just by the structure of the API type.

6+and friends (see [the tutorial introduction](ApiType.lhs) for an overview). By *derive*, we mean that there's no code generation involved - the functions are defined just by the structure of the API type.

7

8The source for this tutorial section is a literate Haskell file, so first we need to have some language extensions and imports:

9

@@ -20,9 +20,6 @@ import GHC.Generics

20import Network.HTTP.Client (newManager, defaultManagerSettings)

21import Servant.API

22import Servant.Client

23−import Servant.Types.SourceT (foreach)

24−

25−import qualified Servant.Client.Streaming as S

26```

23```

27

24

28Also, we need examples for some domain specific data types:

25Also, we need examples for some domain specific data types:

@@ -161,7 +158,7 @@ The types of the arguments for the functions are the same as for (server-side) r

161## Changing the monad the client functions live in

158## Changing the monad the client functions live in

162

159

163Just like `hoistServer` allows us to change the monad in which request handlers

160Just like `hoistServer` allows us to change the monad in which request handlers

164−of a web application live, we also have `hoistClient` for changing the monad

161+of a web application live in, we also have `hoistClient` for changing the monad

165in which _client functions_ live. Consider the following trivial API:

162in which _client functions_ live. Consider the following trivial API:

166

163

167``` haskell

164``` haskell

@@ -173,7 +170,7 @@ hoistClientAPI = Proxy

173

170

174We already know how to derive client functions for this API, and as we have

171We already know how to derive client functions for this API, and as we have

175seen above they all return results in the `ClientM` monad when using `servant-client`.

172seen above they all return results in the `ClientM` monad when using `servant-client`.

176−However, `ClientM` is rarely (or never) the actual monad we need to use the client

173+However, `ClientM` rarely (or never) is the actual monad we need to use the client

177functions in. Sometimes we need to run them in IO, sometimes in a custom monad

174functions in. Sometimes we need to run them in IO, sometimes in a custom monad

178stack. `hoistClient` is a very simple solution to the problem of "changing" the monad

175stack. `hoistClient` is a very simple solution to the problem of "changing" the monad

179the clients run in.

176the clients run in.

@@ -220,38 +217,41 @@ getClients clientEnv

220Consider the following streaming API type:

217Consider the following streaming API type:

221

218

222``` haskell

219``` haskell

223−type StreamAPI = "positionStream" :> StreamGet NewlineFraming JSON (SourceIO Position)

220+type StreamAPI = "positionStream" :> StreamGet NewlineFraming JSON (ResultStream Position)

224```

221```

225

222

226−Note that we use the same `SourceIO` type as on the server-side

223+Note that when we declared an API to serve, we specified a `StreamGenerator` as a producer of streams. Now we specify our result type as a `ResultStream`. With types that can be used both ways, if appropriate adaptors are written (in the form of `ToStreamGenerator` and `BuildFromStream` instances), then this asymmetry isn't necessary. Otherwise, if you want to share the same API across clients and servers, you can parameterize it like so:

227−(this is different from `servant-0.14`).

224+

228−However, we have to use different client, `Servant.Client.Streaming`,

225+``` haskell ignore

229−which can stream (but has different API).

226+type StreamAPI f = "positionStream" :> StreamGet NewlineFraming JSON (f Position)

227+type ServerStreamAPI = StreamAPI StreamGenerator

228+type ClientStreamAPI = StreamAPI ResultStream

229+```

230

231In any case, here's how we write a function to query our API:

232

233−```haskell

233+``` haskell

234streamAPI :: Proxy StreamAPI

235streamAPI = Proxy

236

237−posStream :: S.ClientM (SourceIO Position)

237+posStream :: ClientM (ResultStream Position)

238+

238−posStream = S.client streamAPI

239+posStream = client streamAPI

239```

240```

240

241

241−We'll get back a `SourceIO Position`. Instead of `runClientM`, the streaming

242−client provides `withClientM`: the underlying HTTP connection is open only

243−until the inner functions exits. Inside the block we can e.g just print out

244−all elements from a `SourceIO`, to give some idea of how to work with them.

242+And here's how to just print out all elements from a `ResultStream`, to give some idea of how to work with them.

245

243

246``` haskell

244``` haskell

247−printSourceIO :: Show a => ClientEnv -> S.ClientM (SourceIO a) -> IO ()

245+printResultStream :: Show a => ResultStream a -> IO ()

248−printSourceIO env c = S.withClientM c env $ \e -> case e of

246+printResultStream (ResultStream k) = k $ \getResult ->

249− Left err -> putStrLn $ "Error: " ++ show err

247+ let loop = do

250− Right rs -> foreach fail print rs

248+ r <- getResult

249+ case r of

250+ Nothing -> return ()

251+ Just x -> print x >> loop

252+ in loop

251```

253```

252

254

253−The stream is parsed and provided incrementally. So the above loop prints out

255+The stream is parsed and provided incrementally. So the above loop prints out each result as soon as it is received on the stream, rather than waiting until they are all available to print them at once.

254−each result as soon as it is received on the stream, rather than waiting until

255−they are all available to print them at once.

256

257You now know how to use **servant-client**!

doc/tutorial/Docs.lhs+2−2

@@ -77,7 +77,7 @@ instance ToSample HelloMessage where

77 [ ("When a value is provided for 'name'", HelloMessage "Hello, Alp")

78 , ("When 'name' is not specified", HelloMessage "Hello, anonymous coward")

79 ]

80− -- multiple examples to display this time

80+ -- mutliple examples to display this time

81

82ci :: ClientInfo

83ci = ClientInfo "Alp" "alp@foo.com" 26 ["haskell", "mathematics"]

@@ -108,7 +108,7 @@ apiDocs = docs exampleAPI

108markdown :: API -> String

109```

110

111−That lets us see what our API docs look like in markdown, by looking at `markdown apiDocs`.

111+That lets us see what our API docs look down in markdown, by looking at `markdown apiDocs`.

112

113````````` text

114## GET /hello

doc/tutorial/Javascript.lhs+2−2

@@ -228,13 +228,13 @@ data CommonGeneratorOptions = CommonGeneratorOptions

228 {

229 -- | function generating function names

230 functionNameBuilder :: FunctionName -> Text

231− -- | name used when a user wants to send the request body (to let you redefine it)

231+ -- | name used when a user want to send the request body (to let you redefine it)

232 , requestBody :: Text

233 -- | name of the callback parameter when the request was successful

234 , successCallback :: Text

235 -- | name of the callback parameter when the request reported an error

236 , errorCallback :: Text

237− -- | namespace on which we define the js function (empty means local var)

237+ -- | namespace on which we define the js function (empty mean local var)

238 , moduleName :: Text

239 -- | a prefix that should be prepended to the URL in the generated JS

240 , urlPrefix :: Text

doc/tutorial/Server.lhs+41−55

@@ -29,7 +29,7 @@ import Prelude.Compat

29

30import Control.Monad.Except

31import Control.Monad.Reader

32−import Data.Aeson

32+import Data.Aeson.Compat

33import Data.Aeson.Types

34import Data.Attoparsec.ByteString

35import Data.ByteString (ByteString)

@@ -46,7 +46,6 @@ import Servant

46import System.Directory

47import Text.Blaze

48import Text.Blaze.Html.Renderer.Utf8

49−import Servant.Types.SourceT (source)

50import qualified Data.Aeson.Parser

49import qualified Data.Aeson.Parser

51import qualified Text.Blaze.Html

50import qualified Text.Blaze.Html

52```

51```

@@ -183,7 +182,7 @@ users2 = [isaac, albert]

183

182

184Now, just like we separate the various endpoints in `UserAPI` with `:<|>`, we

183Now, just like we separate the various endpoints in `UserAPI` with `:<|>`, we

185are going to separate the handlers with `:<|>` too! They must be provided in

184are going to separate the handlers with `:<|>` too! They must be provided in

186−the same order as in the API type.

185+the same order as in in the API type.

187

186

188``` haskell

187``` haskell

189server2 :: Server UserAPI2

188server2 :: Server UserAPI2

@@ -313,8 +312,8 @@ For reference, here's a list of some combinators from **servant**:

313## The `FromHttpApiData`/`ToHttpApiData` classes

312## The `FromHttpApiData`/`ToHttpApiData` classes

314

313

315Wait... How does **servant** know how to decode the `Int`s from the URL? Or how

314Wait... How does **servant** know how to decode the `Int`s from the URL? Or how

316−to decode a `ClientInfo` value from the request body? The following three sections will

315+to decode a `ClientInfo` value from the request body? This is what this and the

317−help us answer these questions.

316+following two sections address.

318

317

319`Capture`s and `QueryParam`s are represented by some textual value in URLs.

318`Capture`s and `QueryParam`s are represented by some textual value in URLs.

320`Header`s are similarly represented by a pair of a header name and a

319`Header`s are similarly represented by a pair of a header name and a

@@ -599,7 +598,7 @@ $ curl -H 'Accept: text/html' http://localhost:8081/persons

599

598

600## The `Handler` monad

599## The `Handler` monad

601

600

602−At the heart of the handlers is the monad they run in, namely a newtype `Handler` around `ExceptT ServerError IO`

601+At the heart of the handlers is the monad they run in, namely a newtype `Handler` around `ExceptT ServantErr IO`

603([haddock documentation for `ExceptT`](http://hackage.haskell.org/package/mtl-2.2.1/docs/Control-Monad-Except.html#t:ExceptT)).

602([haddock documentation for `ExceptT`](http://hackage.haskell.org/package/mtl-2.2.1/docs/Control-Monad-Except.html#t:ExceptT)).

604One might wonder: why this monad? The answer is that it is the

603One might wonder: why this monad? The answer is that it is the

605simplest monad with the following properties:

604simplest monad with the following properties:

@@ -617,12 +616,12 @@ newtype ExceptT e m a = ExceptT (m (Either e a))

617```

616```

618

617

619In short, this means that a handler of type `Handler a` is simply

618In short, this means that a handler of type `Handler a` is simply

620−equivalent to a computation of type `IO (Either ServerError a)`, that is, an IO

619+equivalent to a computation of type `IO (Either ServantErr a)`, that is, an IO

621action that either returns an error or a result.

620action that either returns an error or a result.

622

621

623−The module [`Control.Monad.Except`](https://hackage.haskell.org/package/mtl/docs/Control-Monad-Except.html#t:ExceptT)

622+The module [`Control.Monad.Except`](https://hackage.haskell.org/package/mtl-2.2.1/docs/Control-Monad-Except.html#t:ExceptT)

624from which `ExceptT` comes is worth looking at.

623from which `ExceptT` comes is worth looking at.

625−Perhaps most importantly, `ExceptT` and `Handler` are instances of `MonadError`, so

624+Perhaps most importantly, `ExceptT` and `Handler` are an instances of `MonadError`, so

626`throwError` can be used to return an error from your handler (whereas `return`

625`throwError` can be used to return an error from your handler (whereas `return`

627 is enough to return a success).

626 is enough to return a success).

628

627

@@ -632,9 +631,9 @@ kind and abort early. The next two sections cover how to do just that.

632

631

633### Performing IO

632### Performing IO

634

633

635−Other important instances from the list above are `MonadIO m => MonadIO

634+Another important instances from the list above are `MonadIO m => MonadIO

636−(ExceptT e m)`, and therefore also `MonadIO Handler` as there is a `MonadIO IO` instance.

635+(ExceptT e m)`, and therefore also `MonadIO Handler` as there is `MonadIO IO` instance..

637−[`MonadIO`](http://hackage.haskell.org/package/base/docs/Control-Monad-IO-Class.html#t:MonadIO)

636+[`MonadIO`](http://hackage.haskell.org/package/transformers-0.4.3.0/docs/Control-Monad-IO-Class.html)

638is a class from the **transformers** package defined as:

637is a class from the **transformers** package defined as:

639

638

640``` haskell ignore

639``` haskell ignore

@@ -660,16 +659,16 @@ server5 = do

660 return (FileContent filecontent)

659 return (FileContent filecontent)

661```

660```

662

661

663−### Failing, through `ServerError`

662+### Failing, through `ServantErr`

664

663

665If you want to explicitly fail at providing the result promised by an endpoint

664If you want to explicitly fail at providing the result promised by an endpoint

666using the appropriate HTTP status code (not found, unauthorized, etc) and some

665using the appropriate HTTP status code (not found, unauthorized, etc) and some

667error message, all you have to do is use the `throwError` function mentioned above

666error message, all you have to do is use the `throwError` function mentioned above

668−and provide it with the appropriate value of type `ServerError`, which is

667+and provide it with the appropriate value of type `ServantErr`, which is

669defined as:

668defined as:

670

669

671``` haskell ignore

670``` haskell ignore

672−data ServerError = ServerError

671+data ServantErr = ServantErr

673 { errHTTPCode :: Int

672 { errHTTPCode :: Int

674 , errReasonPhrase :: String

673 , errReasonPhrase :: String

675 , errBody :: ByteString -- lazy bytestring

674 , errBody :: ByteString -- lazy bytestring

@@ -685,7 +684,7 @@ use record update syntax:

685failingHandler :: Handler ()

684failingHandler :: Handler ()

686failingHandler = throwError myerr

685failingHandler = throwError myerr

687

686

688− where myerr :: ServerError

687+ where myerr :: ServantErr

689 myerr = err503 { errBody = "Sorry dear user." }

688 myerr = err503 { errBody = "Sorry dear user." }

690```

689```

691

690

@@ -716,7 +715,7 @@ $ curl --verbose http://localhost:8081/myfile.txt

716>

715>

717< HTTP/1.1 404 Not Found

716< HTTP/1.1 404 Not Found

718[snip]

717[snip]

719−myfile.txt just isn't there, please leave this server alone.

718+myfile.txt just isnt there, please leave this server alone.

720

719

721$ echo Hello > myfile.txt

720$ echo Hello > myfile.txt

722

721

@@ -818,7 +817,7 @@ If it doesn't exist, the handler will fail with a `404` status code.

818

817

819`serveDirectoryWebApp` uses some standard settings that fit the use case of

818`serveDirectoryWebApp` uses some standard settings that fit the use case of

820serving static files for most web apps. You can find out about the other

819serving static files for most web apps. You can find out about the other

821−options in the documentation of the `Servant.Server.StaticFiles` module.

820+options in the documentation of the `Servant.Utils.StaticFiles` module.

822

821

823## Nested APIs

822## Nested APIs

824

823

@@ -830,7 +829,7 @@ type UserAPI3 = -- view the user with given userid, in JSON

830 Capture "userid" Int :> Get '[JSON] User

829 Capture "userid" Int :> Get '[JSON] User

831

830

832 :<|> -- delete the user with given userid. empty response

831 :<|> -- delete the user with given userid. empty response

833− Capture "userid" Int :> DeleteNoContent

832+ Capture "userid" Int :> DeleteNoContent '[JSON] NoContent

834```

833```

835

834

836We can instead factor out the `userid`:

835We can instead factor out the `userid`:

@@ -838,7 +837,7 @@ We can instead factor out the `userid`:

838``` haskell

837``` haskell

839type UserAPI4 = Capture "userid" Int :>

838type UserAPI4 = Capture "userid" Int :>

840 ( Get '[JSON] User

839 ( Get '[JSON] User

841− :<|> DeleteNoContent

840+ :<|> DeleteNoContent '[JSON] NoContent

842 )

841 )

843```

842```

844

843

@@ -896,13 +895,13 @@ type API1 = "users" :>

896-- we factor out the Request Body

895-- we factor out the Request Body

897type API2 = ReqBody '[JSON] User :>

896type API2 = ReqBody '[JSON] User :>

898 ( Get '[JSON] User -- just display the same user back, don't register it

897 ( Get '[JSON] User -- just display the same user back, don't register it

899− :<|> PostNoContent -- register the user. empty response

898+ :<|> PostNoContent '[JSON] NoContent -- register the user. empty response

900 )

899 )

901

900

902-- we factor out a Header

901-- we factor out a Header

903type API3 = Header "Authorization" Token :>

902type API3 = Header "Authorization" Token :>

904 ( Get '[JSON] SecretData -- get some secret data, if authorized

903 ( Get '[JSON] SecretData -- get some secret data, if authorized

905− :<|> ReqBody '[JSON] SecretData :> PostNoContent -- add some secret data, if authorized

904+ :<|> ReqBody '[JSON] SecretData :> PostNoContent '[JSON] NoContent -- add some secret data, if authorized

906 )

905 )

907

906

908newtype Token = Token ByteString

907newtype Token = Token ByteString

@@ -915,11 +914,11 @@ API type only at the end.

915``` haskell

914``` haskell

916type UsersAPI =

915type UsersAPI =

917 Get '[JSON] [User] -- list users

916 Get '[JSON] [User] -- list users

918− :<|> ReqBody '[JSON] User :> PostNoContent -- add a user

917+ :<|> ReqBody '[JSON] User :> PostNoContent '[JSON] NoContent -- add a user

919 :<|> Capture "userid" Int :>

918 :<|> Capture "userid" Int :>

920 ( Get '[JSON] User -- view a user

919 ( Get '[JSON] User -- view a user

921− :<|> ReqBody '[JSON] User :> PutNoContent -- update a user

920+ :<|> ReqBody '[JSON] User :> PutNoContent '[JSON] NoContent -- update a user

922− :<|> DeleteNoContent -- delete a user

921+ :<|> DeleteNoContent '[JSON] NoContent -- delete a user

923 )

922 )

924

923

925usersServer :: Server UsersAPI

924usersServer :: Server UsersAPI

@@ -948,11 +947,11 @@ usersServer = getUsers :<|> newUser :<|> userOperations

948``` haskell

947``` haskell

949type ProductsAPI =

948type ProductsAPI =

950 Get '[JSON] [Product] -- list products

949 Get '[JSON] [Product] -- list products

951− :<|> ReqBody '[JSON] Product :> PostNoContent -- add a product

950+ :<|> ReqBody '[JSON] Product :> PostNoContent '[JSON] NoContent -- add a product

952 :<|> Capture "productid" Int :>

951 :<|> Capture "productid" Int :>

953 ( Get '[JSON] Product -- view a product

952 ( Get '[JSON] Product -- view a product

954− :<|> ReqBody '[JSON] Product :> PutNoContent -- update a product

953+ :<|> ReqBody '[JSON] Product :> PutNoContent '[JSON] NoContent -- update a product

955− :<|> DeleteNoContent -- delete a product

954+ :<|> DeleteNoContent '[JSON] NoContent -- delete a product

956 )

955 )

957

956

958data Product = Product { productId :: Int }

957data Product = Product { productId :: Int }

@@ -996,11 +995,11 @@ abstract that away:

996-- indexed by values of type 'i'

995-- indexed by values of type 'i'

997type APIFor a i =

996type APIFor a i =

998 Get '[JSON] [a] -- list 'a's

997 Get '[JSON] [a] -- list 'a's

999− :<|> ReqBody '[JSON] a :> PostNoContent -- add an 'a'

998+ :<|> ReqBody '[JSON] a :> PostNoContent '[JSON] NoContent -- add an 'a'

1000 :<|> Capture "id" i :>

999 :<|> Capture "id" i :>

1001 ( Get '[JSON] a -- view an 'a' given its "identifier" of type 'i'

1000 ( Get '[JSON] a -- view an 'a' given its "identifier" of type 'i'

1002− :<|> ReqBody '[JSON] a :> PutNoContent -- update an 'a'

1001+ :<|> ReqBody '[JSON] a :> PutNoContent '[JSON] NoContent -- update an 'a'

1003− :<|> DeleteNoContent -- delete an 'a'

1002+ :<|> DeleteNoContent '[JSON] NoContent -- delete an 'a'

1004 )

1003 )

1005

1004

1006-- Build the appropriate 'Server'

1005-- Build the appropriate 'Server'

@@ -1128,14 +1127,14 @@ This is the webservice in action:

1128``` bash

1127``` bash

1129$ curl http://localhost:8081/a

1128$ curl http://localhost:8081/a

11301797

11291797

1131−$ curl http://localhost:8081/b -X GET -d '42.0' -H 'Content-Type: application/json'

1130+$ curl http://localhost:8081/b

1132−true

1131+"hi"

1133```

1132```

1134

1133

1135### An arrow is a reader too.

1134### An arrow is a reader too.

1136

1135

1137In previous versions of `servant` we had an `enter` to do what `hoistServer`

1136In previous versions of `servant` we had an `enter` to do what `hoistServer`

1138−does now. `enter` had an ambitious design goals, but was problematic in practice.

1137+does now. `enter` had a ambitious design goals, but was problematic in practice.

1139

1138

1140One problematic situation was when the source monad was `(->) r`, yet it's

1139One problematic situation was when the source monad was `(->) r`, yet it's

1141handy in practice, because `(->) r` is isomorphic to `Reader r`.

1140handy in practice, because `(->) r` is isomorphic to `Reader r`.

@@ -1161,37 +1160,24 @@ app5 = serve readerAPI (hoistServer readerAPI funToHandler funServerT)

1161

1160

1162## Streaming endpoints

1161## Streaming endpoints

1163

1162

1164−We can create endpoints that don't just give back a single result, but give

1163+We can create endpoints that don't just give back a single result, but give back a *stream* of results, served one at a time. Stream endpoints only provide a single content type, and also specify what framing strategy is used to delineate the results. To serve these results, we need to give back a stream producer. Adapters can be written to `Pipes`, `Conduit` and the like, or written directly as `StreamGenerator`s. StreamGenerators are IO-based continuations that are handed two functions -- the first to write the first result back, and the second to write all subsequent results back. (This is to allow handling of situations where the entire stream is prefixed by a header, or where a boundary is written between elements, but not prior to the first element). 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 `Handler` action, so that additional IO may be done in the creation of one.

1165−back a *stream* of results, served one at a time. Stream endpoints only provide

1166−a single content type, and also specify what framing strategy is used to

1167−delineate the results. To serve these results, we need to give back a stream

1168−producer. Adapters can be written to *Pipes*, *Conduit* and the like, or

1169−written directly as `SourceIO`s. SourceIO builds upon servant's own `SourceT`

1170−stream type (it's simpler than *Pipes* or *Conduit*).

1171−The API of a streaming endpoint needs to explicitly specify which sort of

1172−generator it produces. Note that the generator itself is returned by a

1173−`Handler` action, so that additional IO may be done in the creation of one.

1174

1164

1175``` haskell

1165``` haskell

1176−type StreamAPI = "userStream" :> StreamGet NewlineFraming JSON (SourceIO User)

1166+type StreamAPI = "userStream" :> StreamGet NewlineFraming JSON (StreamGenerator User)

1177streamAPI :: Proxy StreamAPI

1167streamAPI :: Proxy StreamAPI

1178streamAPI = Proxy

1168streamAPI = Proxy

1179

1169

1180−streamUsers :: SourceIO User

1170+streamUsers :: StreamGenerator User

1181−streamUsers = source [isaac, albert, albert]

1171+streamUsers = StreamGenerator $ \sendFirst sendRest -> do

1172+ sendFirst isaac

1173+ sendRest albert

1174+ sendRest albert

1182

1175

1183app6 :: Application

1176app6 :: Application

1184app6 = serve streamAPI (return streamUsers)

1177app6 = serve streamAPI (return streamUsers)

1185```

1178```

1186

1179

1187−This simple application returns a stream of `User` values encoded in JSON

1180+This simple application returns a stream of `User` values encoded in JSON format, with each value separated by a newline. In this case, the stream will consist of the value of `isaac`, followed by the value of `albert`, then the value of `albert` a third time. Importantly, the stream is written back as results are produced, rather than all at once. This means first that results are delivered when they are available, and second, that if an exception interrupts production of the full stream, nonetheless partial results have already been written back.

1188−format, with each value separated by a newline. In this case, the stream will

1189−consist of the value of `isaac`, followed by the value of `albert`, then the

1190−value of `albert` a second time. Importantly, the stream is written back as

1191−results are produced, rather than all at once. This means first that results

1192−are delivered when they are available, and second, that if an exception

1193−interrupts production of the full stream, nonetheless partial results have

1194−already been written back.

1195

1181

1196## Conclusion

1182## Conclusion

1197

1183

doc/tutorial/index.rst+20−1

@@ -6,10 +6,29 @@ This is an introductory tutorial to **servant**. Whilst browsing is fine, it mak

6Any comments, issues or feedback about the tutorial can be submitted

7to `servant's issue tracker <http://github.com/haskell-servant/servant/issues>`_.

8

9+In fact, the whole tutorial is a `cabal <https://cabal.readthedocs.io/en/latest/>`_

10+project and can be built and played with locally as follows:

11+

12+.. code-block:: bash

13+

14+ $ git clone https://github.com/haskell-servant/servant.git

15+ $ cd servant

16+ # build

17+ $ cabal new-build tutorial

18+ # load in ghci to play with it

19+ $ cabal new-repl tutorial

20+

21+The code can be found in the `*.lhs` files under `doc/tutorial/` in the

22+repository. Feel free to edit it while you're reading this documentation and

23+see the effect of your changes.

24+

25+`Nix <https://nixos.org/nix/>`_ users should feel free to take a look at

26+the `nix/shell.nix` file in the repository and use it to provision a suitable

27+environment to build and run the examples.

28+

9.. toctree::

29.. toctree::

10 :maxdepth: 1

30 :maxdepth: 1

11

31

12− install.rst

13 ApiType.lhs

32 ApiType.lhs

14 Server.lhs

33 Server.lhs

15 Client.lhs

34 Client.lhs

doc/tutorial/install.rstdeleted−68

@@ -1,68 +0,0 @@

1−Install

2−========

3−

4−cabal-install

5−--------

6−

7−The whole tutorial is a `cabal <https://cabal.readthedocs.io/en/latest/>`_

8−project and can be built locally as follows:

9−

10−.. code-block:: bash

11−

12− $ git clone https://github.com/haskell-servant/servant.git

13− $ cd servant

14− # build

15− $ cabal new-build tutorial

16− # load in ghci to play with it

17− $ cabal new-repl tutorial

18−

19−stack

20−--------

21−

22−The servant `stack <https://docs.haskellstack.org/en/stable/README/>`_ template includes the working tutorial. To initialize this template, run:

23−

24−.. code-block:: bash

25−

26− $ stack new myproj servant

27− $ cd myproj

28− # build

29− $ stack build

30− # start server

31− $ stack exec myproj-exe

32−

33−The code can be found in the `*.lhs` files under `doc/tutorial/` in the

34−repository. Feel free to edit it while you're reading this documentation and

35−see the effect of your changes.

36−

37−nix

38−--------

39−

40−`Nix <https://nixos.org/nix/>`_ users should feel free to take a look at

41−the `nix/shell.nix` file in the repository and use it to provision a suitable

42−environment to build and run the examples.

43−

44−Note for Ubuntu users

45−--------

46−

47−Ubuntu's packages for `ghc`, `cabal`, and `stack` are years out of date.

48−If the instructions above fail for you,

49−try replacing the Ubuntu packages with up-to-date versions.

50−First remove the installed versions:

51−

52−.. code-block:: bash

53−

54− # remove the obsolete versions

55− $ sudo apt remove ghc haskell-stack cabal-install

56−

57−Then install fresh versions of the Haskell toolchain

58−using the `ghcup <https://www.haskell.org/ghcup/install/>`_ installer.

59−

60−As of February 2022, one easy way to do this is by running a bootstrap script:

61−

62−.. code-block:: bash

63−

64− $ curl --proto '=https' --tlsv1.2 -sSf https://get-ghcup.haskell.org | sh

65−

66−The script is interactive and will prompt you for details about what

67−you want installed and where. To install manually,

68−see `the detailed instructions <https://www.haskell.org/ghcup/install/#manual-install>`_.

doc/tutorial/test/Spec.hs+1−11

@@ -1,11 +1 @@

1−module Main where

1+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}

2−

3−import qualified JavascriptSpec

4−

5−import Test.Hspec (Spec, hspec, describe)

6−

7−main :: IO ()

8−main = hspec spec

9−

10−spec :: Spec

11−spec = describe "Javascript" JavascriptSpec.spec

doc/tutorial/tinc.yamlnew file+13

@@ -0,0 +1,13 @@

1+dependencies:

2+ - name: servant

3+ path: ../../servant

4+ - name: servant-server

5+ path: ../../servant-server

6+ - name: servant-client

7+ path: ../../servant-client

8+ - name: servant-js

9+ path: ../../servant-js

10+ - name: servant-docs

11+ path: ../../servant-docs

12+ - name: servant-foreign

13+ path: ../../servant-foreign

doc/tutorial/tutorial.cabal+16−11

@@ -1,20 +1,21 @@

1−cabal-version: 2.2

2name: tutorial

1name: tutorial

3version: 0.10

2version: 0.10

4synopsis: The servant tutorial

3synopsis: The servant tutorial

5description:

4description:

6 The servant tutorial can be found at

5 The servant tutorial can be found at

7− <http://docs.servant.dev/>

6+ <http://haskell-servant.readthedocs.org/>

8−homepage: http://docs.servant.dev/

7+homepage: http://haskell-servant.readthedocs.org/

9category: Servant, Documentation

8category: Servant, Documentation

10−license: BSD-3-Clause

9+license: BSD3

11license-file: LICENSE

10license-file: LICENSE

12author: Servant Contributors

11author: Servant Contributors

13maintainer: haskell-servant-maintainers@googlegroups.com

12maintainer: haskell-servant-maintainers@googlegroups.com

14build-type: Simple

13build-type: Simple

14+cabal-version: >=1.10

15tested-with:

16− GHC==8.6.5

16+ GHC==8.0.2

17− GHC==8.8.3, GHC ==8.10.7

17+ GHC==8.2.2

18+ GHC==8.4.3

18extra-source-files:

19extra-source-files:

19 static/index.html

20 static/index.html

20 static/ui.js

21 static/ui.js

@@ -32,8 +33,9 @@ library

32 -- Packages `servant` depends on.

33 -- Packages `servant` depends on.

33 -- We don't need to specify bounds here as this package is never released.

34 -- We don't need to specify bounds here as this package is never released.

34 build-depends:

35 build-depends:

35− base >= 4.7 && <5

36+ base >= 4.7 && <4.12

36 , aeson

37 , aeson

38+ , aeson-compat

37 , attoparsec

39 , attoparsec

38 , base-compat

40 , base-compat

39 , bytestring

41 , bytestring

@@ -63,11 +65,12 @@ library

63 blaze-html >= 0.9.0.1 && < 0.10

65 blaze-html >= 0.9.0.1 && < 0.10

64 , blaze-markup >= 0.8.0.0 && < 0.9

66 , blaze-markup >= 0.8.0.0 && < 0.9

65 , cookie >= 0.4.3 && < 0.5

67 , cookie >= 0.4.3 && < 0.5

66− , js-jquery >= 3.3.1 && < 3.4

68+ , js-jquery >= 3.2.1 && < 3.3

67− , lucid >= 2.9.11 && < 2.12

69+ , lucid >= 2.9.9 && < 2.10

70+ , mtl-compat >= 0.2.1 && < 0.3

68− , random >= 1.1 && < 1.3

71+ , random >= 1.1 && < 1.2

69 , servant-js >= 0.9 && < 0.10

72 , servant-js >= 0.9 && < 0.10

70− , time >= 1.6.0.1 && < 1.13

73+ , time >= 1.4.2 && < 1.9

71

74

72 -- For legacy tools, we need to specify build-depends too

75 -- For legacy tools, we need to specify build-depends too

73 build-depends: markdown-unlit >= 0.5.0 && <0.6

76 build-depends: markdown-unlit >= 0.5.0 && <0.6

@@ -80,6 +83,8 @@ test-suite spec

80 hs-source-dirs: test

83 hs-source-dirs: test

81 main-is: Spec.hs

84 main-is: Spec.hs

82 other-modules: JavascriptSpec

85 other-modules: JavascriptSpec

86+ build-tool-depends:

87+ hspec-discover:hspec-discover

83 build-depends: base

88 build-depends: base

84 , tutorial

89 , tutorial

85 , hspec

90 , hspec

ghcjs.nixdeleted−22

@@ -1,22 +0,0 @@

1−let reflex-platform = import (builtins.fetchTarball

2− { name = "reflex-platform";

3− url = "https://github.com/reflex-frp/reflex-platform/archive/1aba6f367982bd6dd78ec2fda75ab246a62d32c5.tar.gz";

4− }) {};

5− pkgs = import ./nix/nixpkgs.nix; in

6−

7−pkgs.stdenv.mkDerivation {

8− name = "ghcjs-shell";

9− buildInputs =

10− [ (reflex-platform.ghcjs.ghcWithPackages (p: with p; [

11− attoparsec

12− hashable

13− ]))

14− pkgs.cabal-install

15− pkgs.gmp

16− pkgs.haskellPackages.cabal-plan

17− pkgs.haskellPackages.hspec-discover

18− pkgs.nodejs

19− pkgs.perl

20− pkgs.zlib

21− ];

22−}

nix/README.md−18

@@ -21,21 +21,3 @@ a particular ghc version, e.g:

21``` sh

22$ nix-shell nix/shell.nix --argstr compiler ghcHEAD

23```

24−

25−**Possible GHC versions**

26−- `ghc865Binary`

27−- `ghc884`

28−- `ghc8104` - default

29−- `ghc901`

30−

31−### Cabal users

32−

33−GHC version can be chosen via the nix-shell parameter

34−

35−`cabal build all`

36−

37−### Stack version

38−

39−Since the ghc version is set by the LTS version, it is preferable to use the `ghc8104` version parameter for the nix-shell.

40−

41−`stack --no-nix --system-ghc <command>`

nix/nixpkgs.jsondeleted−4

@@ -1,4 +0,0 @@

1−{

2− "rev" : "05f0934825c2a0750d4888c4735f9420c906b388",

3− "sha256" : "1g8c2w0661qn89ajp44znmwfmghbbiygvdzq0rzlvlpdiz28v6gy"

4−}

nix/nixpkgs.nixdeleted−4

@@ -1,4 +0,0 @@

1−import (builtins.fetchTarball {

2− url = "https://github.com/NixOS/nixpkgs/archive/refs/tags/21.05.tar.gz";

3− sha256 = "sha256:1ckzhh24mgz6jd1xhfgx0i9mijk6xjqxwsshnvq789xsavrmsc36";

4−}) {}

nix/shell.nix+18−17

@@ -1,20 +1,21 @@

1+{ pkgs ? import <nixpkgs> {}

1−{ compiler ? "ghc8104"

2+, compiler ? "ghc822"

2, tutorial ? false

3, tutorial ? false

3−, pkgs ? import ./nixpkgs.nix

4}:

5−

6− with pkgs;

7

5

6+with pkgs;

7+

8− let

8+let

9− ghc = haskell.packages.${compiler}.ghcWithPackages (_: []);

9+ ghc = haskell.packages.${compiler}.ghcWithPackages (_: []);

10− docstuffs = python3.withPackages (ps: with ps; [ recommonmark sphinx sphinx_rtd_theme ]);

10+ docstuffs = python3.withPackages (ps: with ps; [ recommonmark sphinx sphinx_rtd_theme ]);

11− in

11+in

12+

12− stdenv.mkDerivation {

13+stdenv.mkDerivation {

13− name = "servant-dev";

14+ name = "servant-dev";

14− buildInputs = [ ghc zlib python3 wget cabal-install postgresql openssl stack haskellPackages.hspec-discover ]

15+ buildInputs = [ ghc zlib python3 wget ]

15− ++ (if tutorial then [docstuffs postgresql] else []);

16+ ++ (if tutorial then [docstuffs postgresql] else []);

16− shellHook = ''

17+ shellHook = ''

17− eval $(grep export ${ghc}/bin/ghc)

18+ eval $(grep export ${ghc}/bin/ghc)

18− export LD_LIBRARY_PATH=$LD_LIBRARY_PATH:"${zlib}/lib";

19+ export LD_LIBRARY_PATH="${zlib}/lib";

19− '';

20+ '';

20− }

21+}

servant-auth/README.mddeleted−1

@@ -1 +0,0 @@

1−servant-auth-server/README.lhs

servant-auth/servant-auth-client/.ghcideleted−1

@@ -1 +0,0 @@

1−:set -isrc -itest -idoctest/ghci-wrapper/src

servant-auth/servant-auth-client/CHANGELOG.mddeleted−26

@@ -1,26 +0,0 @@

1−# Changelog

2−

3−All notable changes to this project will be documented in this file.

4−

5−The format is based on [Keep a Changelog](http://keepachangelog.com/en/1.0.0/)

6−and this project adheres to [PVP Versioning](https://pvp.haskell.org/).

7−

8−## [Unreleased]

9−

10−## [0.4.1.0] - 2020-10-06

11−

12−- Support generic Bearer token auth

13−

14−## [0.4.0.0] - 2019-03-08

15−

16−## Changed

17−

18−- #145 Support servant-0.16 in tests @domenkozar

19−- #145 Drop GHC 7.10 support @domenkozar

20−

21−## [0.3.3.0] - 2018-06-18

22−

23−### Added

24−- Support for GHC 8.4 by @phadej

25−- Support for servant-0.14 by @phadej

26−- Changelog by @domenkozar

servant-auth/servant-auth-client/LICENSEdeleted−31

@@ -1,31 +0,0 @@

2−

4−

5−Redistribution and use in source and binary forms, with or without

6−modification, are permitted provided that the following conditions are met:

7−

8− * Redistributions of source code must retain the above copyright

9− notice, this list of conditions and the following disclaimer.

10−

11− * Redistributions in binary form must reproduce the above

12− copyright notice, this list of conditions and the following

13− disclaimer in the documentation and/or other materials provided

14− with the distribution.

15−

16− * Neither the name of Julian K. Arni nor the names of other

17− contributors may be used to endorse or promote products derived

18− from this software without specific prior written permission.

19−

20−THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS

21−"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT

22−LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR

23−A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT

24−OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,

25−SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT

26−LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,

27−DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY

28−THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT

29−(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE

30−OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

31−

servant-auth/servant-auth-client/Setup.hsdeleted−2

@@ -1,2 +0,0 @@

1−import Distribution.Simple

2−main = defaultMain

servant-auth/servant-auth-client/servant-auth-client.cabaldeleted−80

@@ -1,80 +0,0 @@

1−cabal-version: 2.2

2−name: servant-auth-client

3−version: 0.4.1.0

4−synopsis: servant-client/servant-auth compatibility

5−description: This package provides instances that allow generating clients from

6− <https://hackage.haskell.org/package/servant servant>

7− APIs that use

8− <https://hackage.haskell.org/package/servant-auth servant-auth's> @Auth@ combinator.

9− .

10− For a quick overview of the usage, see the <https://github.com/haskell-servant/servant/tree/master/servant-auth#readme README>.

11−category: Web, Servant, Authentication

12−homepage: https://github.com/haskell-servant/servant/tree/master/servant-auth#readme

13−bug-reports: https://github.com/haskell-servant/servant/issues

14−author: Julian K. Arni

15−maintainer: jkarni@gmail.com

16−copyright: (c) Julian K. Arni

17−license: BSD-3-Clause

18−license-file: LICENSE

19−tested-with: GHC ==8.6.5 || ==8.8.4 || ==8.10.4 || ==9.0.1

20−build-type: Simple

21−extra-source-files:

22− CHANGELOG.md

23−

24−source-repository head

25− type: git

26− location: https://github.com/haskell-servant/servant

27−

28−library

29− hs-source-dirs:

30− src

31− default-extensions: ConstraintKinds DataKinds DefaultSignatures DeriveFoldable DeriveFunctor DeriveGeneric DeriveTraversable FlexibleContexts FlexibleInstances FunctionalDependencies GADTs KindSignatures MultiParamTypeClasses OverloadedStrings RankNTypes ScopedTypeVariables TypeFamilies TypeOperators

32− ghc-options: -Wall

33− build-depends:

34− base >= 4.10 && < 4.17

35− , bytestring >= 0.10.6.0 && < 0.12

36− , containers >= 0.5.6.2 && < 0.7

37− , servant-auth == 0.4.*

38− , servant >= 0.13 && < 0.20

39− , servant-client-core >= 0.13 && < 0.20

40−

41− exposed-modules:

42− Servant.Auth.Client

43− Servant.Auth.Client.Internal

44− default-language: Haskell2010

45−

46−test-suite spec

47− type: exitcode-stdio-1.0

48− main-is: Spec.hs

49− hs-source-dirs:

50− test

51− default-extensions: ConstraintKinds DataKinds DefaultSignatures DeriveFoldable DeriveFunctor DeriveGeneric DeriveTraversable FlexibleContexts FlexibleInstances FunctionalDependencies GADTs KindSignatures MultiParamTypeClasses OverloadedStrings RankNTypes ScopedTypeVariables TypeFamilies TypeOperators

52− ghc-options: -Wall

53− build-tool-depends: hspec-discover:hspec-discover >=2.5.5 && <2.10

54−

55− -- dependencies with bounds inherited from the library stanza

56− build-depends:

57− base

58− , servant-client

59− , servant-auth

60− , servant

61− , servant-auth-client

62−

63− -- test dependencies

64− build-depends:

65− hspec >= 2.5.5 && < 2.10

66− , QuickCheck >= 2.11.3 && < 2.15

67− , aeson >= 1.3.1.1 && < 3

68− , bytestring >= 0.10.6.0 && < 0.12

69− , http-client >= 0.5.13.1 && < 0.8

70− , http-types >= 0.12.2 && < 0.13

71− , servant-auth-server >= 0.4.2.0 && < 0.5

72− , servant-server >= 0.13 && < 0.20

73− , time >= 1.5.0.1 && < 1.13

74− , transformers >= 0.4.2.0 && < 0.6

75− , wai >= 3.2.1.2 && < 3.3

76− , warp >= 3.2.25 && < 3.4

77− , jose >= 0.7.0.0 && < 0.10

78− other-modules:

79− Servant.Auth.ClientSpec

80− default-language: Haskell2010

servant-auth/servant-auth-client/src/Servant/Auth/Client.hsdeleted−3

@@ -1,3 +0,0 @@

1−module Servant.Auth.Client (Token(..), Bearer) where

2−

3−import Servant.Auth.Client.Internal (Bearer, Token(..))

servant-auth/servant-auth-client/src/Servant/Auth/Client/Internal.hsdeleted−64

@@ -1,64 +0,0 @@

1−{-# LANGUAGE CPP #-}

2−{-# LANGUAGE GeneralizedNewtypeDeriving #-}

3−{-# LANGUAGE UndecidableInstances #-}

4−{-# OPTIONS_GHC -fno-warn-orphans #-}

5−#if __GLASGOW_HASKELL__ == 800

6−{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}

7−#endif

8−module Servant.Auth.Client.Internal where

9−

10−import qualified Data.ByteString as BS

11−import Data.Monoid

12−import Data.Proxy (Proxy (..))

13−import Data.String (IsString)

14−import GHC.Exts (Constraint)

15−import GHC.Generics (Generic)

16−import Servant.API ((:>))

17−import Servant.Auth

18−

19−import Servant.Client.Core

20−import Data.Sequence ((<|))

21−

22−-- | A simple bearer token.

23−newtype Token = Token { getToken :: BS.ByteString }

24− deriving (Eq, Show, Read, Generic, IsString)

25−

26−type family HasBearer xs :: Constraint where

27− HasBearer (Bearer ': xs) = ()

28− HasBearer (JWT ': xs) = ()

29− HasBearer (x ': xs) = HasBearer xs

30− HasBearer '[] = BearerAuthNotEnabled

31−

32−class BearerAuthNotEnabled

33−

34−-- | @'HasBearer' auths@ is nominally a redundant constraint, but ensures we're not

35−-- trying to send a token to an API that doesn't accept them.

36−instance (HasBearer auths, HasClient m api) => HasClient m (Auth auths a :> api) where

37− type Client m (Auth auths a :> api) = Token -> Client m api

38−

39− clientWithRoute m _ req (Token token)

40− = clientWithRoute m (Proxy :: Proxy api)

41− $ req { requestHeaders = ("Authorization", headerVal) <| requestHeaders req }

42− where

43− headerVal = "Bearer " <> token

44−

45−#if MIN_VERSION_servant_client_core(0,14,0)

46− hoistClientMonad pm _ nt cl = hoistClientMonad pm (Proxy :: Proxy api) nt . cl

47−#endif

48−

49−

50−-- * Authentication combinators

51−

52−-- | A Bearer token in the Authorization header:

53−--

54−-- @Authorization: Bearer <token>@

55−--

56−-- This can be any token recognized by the server, for example,

57−-- a JSON Web Token (JWT).

58−--

59−-- Note that, since the exact way the token is validated is not specified,

60−-- this combinator can only be used in the client. The server would not know

61−-- how to validate it, while the client does not care.

62−-- If you want to implement Bearer authentication in your server, you have to

63−-- choose a specific combinator, such as 'JWT'.

64−data Bearer

servant-auth/servant-auth-client/test/Servant/Auth/ClientSpec.hsdeleted−161

@@ -1,161 +0,0 @@

1−{-# LANGUAGE CPP #-}

2−{-# LANGUAGE DeriveAnyClass #-}

3−module Servant.Auth.ClientSpec (spec) where

4−

5−import Crypto.JOSE (JWK,

6− KeyMaterialGenParam (OctGenParam),

7− genJWK)

8−import Data.Aeson (FromJSON (..), ToJSON (..))

9−import qualified Data.ByteString.Lazy as BSL

10−import Data.Time (UTCTime, defaultTimeLocale,

11− parseTimeOrError)

12−import GHC.Generics (Generic)

13−import Network.HTTP.Client (Manager, defaultManagerSettings,

14− newManager)

15−import Network.HTTP.Types (status401)

16−import Network.Wai.Handler.Warp (testWithApplication)

17−import Servant

18−import Servant.Client (BaseUrl (..), Scheme (Http),

19− ClientError (FailureResponse),

20−#if MIN_VERSION_servant_client(0,16,0)

21− ResponseF(..),

22−#elif MIN_VERSION_servant_client(0,13,0)

23− GenResponse(..),

24−#elif MIN_VERSION_servant_client(0,12,0)

25− Response(..),

26−#endif

27− client)

28−import System.IO.Unsafe (unsafePerformIO)

29−import Test.Hspec

30−import Test.QuickCheck

31−

32−#if MIN_VERSION_servant_client(0,13,0)

33−import Servant.Client (mkClientEnv, runClientM)

34−#elif MIN_VERSION_servant_client(0,9,0)

35−import Servant.Client (ClientEnv (..), runClientM)

36−#else

37−import Control.Monad.Trans.Except (runExceptT)

38−#endif

39−#if !MIN_VERSION_servant_server(0,16,0)

40−#define ClientError ServantError

41−#endif

42−

43−import Servant.Auth.Client

44−import Servant.Auth.Server

45−import Servant.Auth.Server.SetCookieOrphan ()

46−

47−spec :: Spec

48−spec = describe "The JWT combinator" $ do

49− hasClientSpec

50−

51−

52−------------------------------------------------------------------------------

53−-- * HasClient {{{

54−

55−hasClientSpec :: Spec

56−hasClientSpec = describe "HasClient" $ around (testWithApplication $ return app) $ do

57−

58− let mkTok :: User -> Maybe UTCTime -> IO Token

59− mkTok user mexp = do

60− Right tok <- makeJWT user jwtCfg mexp

61− return $ Token $ BSL.toStrict tok

62−

63− it "succeeds when the token does not have expiry" $ \port -> property $ \user -> do

64− tok <- mkTok user Nothing

65− v <- getIntClient tok mgr (BaseUrl Http "localhost" port "")

66− v `shouldBe` Right (length $ name user)

67−

68− it "succeeds when the token is not expired" $ \port -> property $ \user -> do

69− tok <- mkTok user (Just future)

70− v <- getIntClient tok mgr (BaseUrl Http "localhost" port "")

71− v `shouldBe` Right (length $ name user)

72−

73− it "fails when token is expired" $ \port -> property $ \user -> do

74− tok <- mkTok user (Just past)

75−#if MIN_VERSION_servant_client(0,16,0)

76− Left (FailureResponse _ (Response stat _ _ _))

77−#elif MIN_VERSION_servant_client(0,12,0)

78− Left (FailureResponse (Response stat _ _ _))

79−#elif MIN_VERSION_servant_client(0,11,0)

80− Left (FailureResponse _ stat _ _)

81−#else

82− Left (FailureResponse stat _ _)

83−#endif

84− <- getIntClient tok mgr (BaseUrl Http "localhost" port "")

85− stat `shouldBe` status401

86−

87−

88−getIntClient :: Token -> Manager -> BaseUrl -> IO (Either ClientError Int)

89−#if MIN_VERSION_servant(0,13,0)

90−getIntClient tok m burl = runClientM (client api tok) (mkClientEnv m burl)

91−#elif MIN_VERSION_servant(0,9,0)

92−getIntClient tok m burl = runClientM (client api tok) (ClientEnv m burl)

93−#else

94−getIntClient tok m burl = runExceptT $ client api tok m burl

95−#endif

96−-- }}}

97−------------------------------------------------------------------------------

98−-- * API and Server {{{

99−

100−type API = Auth '[JWT] User :> Get '[JSON] Int

101−

102−api :: Proxy API

103−api = Proxy

104−

105−theKey :: JWK

106−theKey = unsafePerformIO . genJWK $ OctGenParam 256

107−{-# NOINLINE theKey #-}

108−

109−mgr :: Manager

110−mgr = unsafePerformIO $ newManager defaultManagerSettings

111−{-# NOINLINE mgr #-}

112−

113−app :: Application

114−app = serveWithContext api ctx server

115− where

116− ctx = cookieCfg :. jwtCfg :. EmptyContext

117−

118−jwtCfg :: JWTSettings

119−jwtCfg = defaultJWTSettings theKey

120−

121−cookieCfg :: CookieSettings

122−cookieCfg = defaultCookieSettings

123−

124−

125−server :: Server API

126−server = getInt

127− where

128− getInt :: AuthResult User -> Handler Int

129− getInt (Authenticated u) = return . length $ name u

130− getInt _ = throwAll err401

131−

132−

133−-- }}}

134−------------------------------------------------------------------------------

135−-- * Utils {{{

136−

137−past :: UTCTime

138−past = parseTimeOrError True defaultTimeLocale "%Y-%m-%d" "1970-01-01"

139−

140−future :: UTCTime

141−future = parseTimeOrError True defaultTimeLocale "%Y-%m-%d" "2070-01-01"

142−

143−

144−-- }}}

145−------------------------------------------------------------------------------

146−-- * Types {{{

147−

148−data User = User

149− { name :: String

150− , _id :: String

151− } deriving (Eq, Show, Read, Generic)

152−

153−instance FromJWT User

154−instance ToJWT User

155−instance FromJSON User

156−instance ToJSON User

157−

158−instance Arbitrary User where

159− arbitrary = User <$> arbitrary <*> arbitrary

160−

161−-- }}}

servant-auth/servant-auth-client/test/Spec.hsdeleted−1

@@ -1 +0,0 @@

1−{-# OPTIONS_GHC -F -pgmF hspec-discover #-}

servant-auth/servant-auth-docs/.ghcideleted−1

@@ -1 +0,0 @@

1−:set -isrc -itest -idoctest/ghci-wrapper/src

servant-auth/servant-auth-docs/CHANGELOG.mddeleted−14

@@ -1,14 +0,0 @@

1−# Changelog

2−

3−All notable changes to this project will be documented in this file.

4−

5−The format is based on [Keep a Changelog](http://keepachangelog.com/en/1.0.0/)

6−and this project adheres to [PVP Versioning](https://pvp.haskell.org/).

7−

8−## [Unreleased]

9−

10−## [0.2.10.0] - 2018-06-18

11−

12−### Added

13−- Support for GHC 8.4 by @phadej

14−- Changelog by @domenkozar

servant-auth/servant-auth-docs/LICENSEdeleted−31