4eca451...master · servant

.github/FUNDING.ymlnew file+12

since splitsnapshots

unifiedsplit

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

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.shnew file+14

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

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.ymlnew file+148

@@ -0,0 +1,148 @@

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+ - "9.4.2"

24+

25+ steps:

26+ - uses: actions/checkout@v2

27+

28+ - uses: haskell/actions/setup@v1

29+ id: setup-haskell-cabal

30+ name: Setup Haskell

31+ with:

32+ ghc-version: ${{ matrix.ghc }}

33+ cabal-version: ${{ matrix.cabal }}

34+

35+ - name: Freeze

36+ run: |

37+ cabal configure --enable-tests --enable-benchmarks --test-show-details=direct

38+ cabal freeze

39+

40+ - uses: actions/cache@v2.1.3

41+ name: Cache ~/.cabal/store and dist-newstyle

42+ with:

43+ path: |

44+ ${{ steps.setup-haskell-cabal.outputs.cabal-store }}

45+ dist-newstyle

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

47+ restore-keys: |

48+ ${{ runner.os }}-${{ matrix.ghc }}-

49+

50+ - name: Configure

51+ run: |

52+ cabal install --ignore-project -j2 doctest --constraint='doctest ^>=0.20'

53+

54+ - name: Build

55+ run: |

56+ cabal build all

57+

58+ - name: Test

59+ run: |

60+ cabal test all

61+

62+ - name: Run doctests

63+ run: |

64+ # Necessary for doctest to be found in $PATH

65+ export PATH="$HOME/.cabal/bin:$PATH"

66+

67+ DOCTEST="cabal repl --with-ghc=doctest --ghc-options=-w"

68+ (cd servant && eval $DOCTEST)

69+ (cd servant-client && eval $DOCTEST)

70+ (cd servant-client-core && eval $DOCTEST)

71+ (cd servant-http-streams && eval $DOCTEST)

72+ (cd servant-docs && eval $DOCTEST)

73+ (cd servant-foreign && eval $DOCTEST)

74+ (cd servant-server && eval $DOCTEST)

75+ (cd servant-machines && eval $DOCTEST)

76+ (cd servant-conduit && eval $DOCTEST)

77+ (cd servant-pipes && eval $DOCTEST)

78+

79+ # stack:

80+ # name: stack / ghc ${{ matrix.ghc }}

81+ # runs-on: ubuntu-latest

82+ # strategy:

83+ # matrix:

84+ # stack: ["2.7.5"]

85+ # ghc: ["8.10.7"]

86+

87+ # steps:

88+ # - uses: actions/checkout@v2

89+

90+ # - uses: haskell/actions/setup@v1

91+ # name: Setup Haskell Stack

92+ # with:

93+ # ghc-version: ${{ matrix.ghc }}

94+ # stack-version: ${{ matrix.stack }}

95+

96+ # - uses: actions/cache@v2.1.3

97+ # name: Cache ~/.stack

98+ # with:

99+ # path: ~/.stack

100+ # key: ${{ runner.os }}-${{ matrix.ghc }}-stack

101+

102+ # - name: Install dependencies

103+ # run: |

104+ # stack build --system-ghc --test --bench --no-run-tests --no-run-benchmarks --only-dependencies

105+

106+ # - name: Build

107+ # run: |

108+ # stack build --system-ghc --test --bench --no-run-tests --no-run-benchmarks

109+

110+ # - name: Test

111+ # run: |

112+ # stack test --system-ghc

113+

114+ ghcjs:

115+ name: ubuntu-latest / ghcjs 8.6

116+ runs-on: "ubuntu-latest"

117+

118+ steps:

119+ - uses: actions/checkout@v2

120+ - uses: cachix/install-nix-action@v13

121+ with:

122+ extra_nix_config: |

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

124+ substituters = https://nixcache.reflex-frp.org https://cache.nixos.org/

125+ - name: Setup

126+ run: |

127+ # Override cabal.project with the lightweight GHCJS one

128+ cp cabal.ghcjs.project cabal.project

129+ cat cabal.project

130+ nix-shell ghcjs.nix --run "cabal v2-update && cabal v2-freeze"

131+

132+ - uses: actions/cache@v2.1.3

133+ name: Cache ~/.cabal/store and dist-newstyle

134+ with:

135+ path: |

136+ ~/.cabal/store

137+ dist-newstyle

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

139+ restore-keys: |

140+ ${{ runner.os }}-ghcjs8.6-

141+

142+ - name: Build

143+ run: |

144+ nix-shell ghcjs.nix --run "cabal v2-build --ghcjs --enable-tests --enable-benchmarks all"

145+

146+ - name: Tests

147+ run: |

148+ nix-shell ghcjs.nix --run ".github/run-ghcjs-tests.sh"

.gitignore+10−1

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

1**/*/dist

2+*~

2−dist-newstyle

3+dist-*

3.ghc.environment.*

4.ghc.environment.*

4/bin

5/bin

5/lib

6/lib

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

29doc/venv

30doc/venv

30doc/tutorial/static/api.js

31doc/tutorial/static/api.js

31doc/tutorial/static/jq.js

32doc/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.ymldeleted−195

@@ -1,195 +0,0 @@

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− - compiler: "ghc-7.10.3"

45− # env: TEST=--disable-tests BENCH=--disable-benchmarks

46− addons: {apt: {packages: [ghc-ppa-tools,cabal-install-2.2,ghc-7.10.3], sources: [hvr-ghc]}}

47− - compiler: "ghc-7.8.4"

48− # env: TEST=--disable-tests BENCH=--disable-benchmarks

49− addons: {apt: {packages: [ghc-ppa-tools,cabal-install-2.2,ghc-7.8.4], sources: [hvr-ghc]}}

50−

51−before_install:

52− - HC=${CC}

53− - HCPKG=${HC/ghc/ghc-pkg}

54− - unset CC

55− - ROOTDIR=$(pwd)

56− - mkdir -p $HOME/.local/bin

57− - "PATH=/opt/ghc/bin:/opt/ghc-ppa-tools/bin:$HOME/local/bin:$PATH"

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

59− - echo $HCNUMVER

60−

61−install:

62− - cabal --version

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

64− - BENCH=${BENCH---enable-benchmarks}

65− - TEST=${TEST---enable-tests}

66− - HADDOCK=${HADDOCK-true}

67− - UNCONSTRAINED=${UNCONSTRAINED-true}

68− - NOINSTALLEDCONSTRAINTS=${NOINSTALLEDCONSTRAINTS-false}

69− - GHCHEAD=${GHCHEAD-false}

70− - travis_retry cabal update -v

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

72− - rm -fv cabal.project cabal.project.local

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

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

75− - "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"

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

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

78− - touch cabal.project.local

80− - cat cabal.project || true

81− - cat cabal.project.local || true

82− - if [ -f "servant/configure.ac" ]; then

83− (cd "servant" && autoreconf -i);

84− fi

85− - if [ -f "servant-client/configure.ac" ]; then

86− (cd "servant-client" && autoreconf -i);

87− fi

88− - if [ -f "servant-client-core/configure.ac" ]; then

89− (cd "servant-client-core" && autoreconf -i);

90− fi

91− - if [ -f "servant-docs/configure.ac" ]; then

92− (cd "servant-docs" && autoreconf -i);

93− fi

94− - if [ -f "servant-foreign/configure.ac" ]; then

95− (cd "servant-foreign" && autoreconf -i);

96− fi

97− - if [ -f "servant-server/configure.ac" ]; then

98− (cd "servant-server" && autoreconf -i);

99− fi

100− - if [ -f "doc/tutorial/configure.ac" ]; then

101− (cd "doc/tutorial" && autoreconf -i);

102− fi

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

104− (cd "doc/cookbook/basic-auth" && autoreconf -i);

105− fi

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

107− (cd "doc/cookbook/db-postgres-pool" && autoreconf -i);

108− fi

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

110− (cd "doc/cookbook/db-sqlite-simple" && autoreconf -i);

111− fi

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

113− (cd "doc/cookbook/file-upload" && autoreconf -i);

114− fi

115− - if [ -f "doc/cookbook/generic/configure.ac" ]; then

116− (cd "doc/cookbook/generic" && autoreconf -i);

117− fi

118− - if [ -f "doc/cookbook/https/configure.ac" ]; then

119− (cd "doc/cookbook/https" && autoreconf -i);

120− fi

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

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

123− fi

124− - if [ -f "doc/cookbook/pagination/configure.ac" ]; then

125− (cd "doc/cookbook/pagination" && autoreconf -i);

126− fi

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

128− (cd "doc/cookbook/structuring-apis" && autoreconf -i);

129− fi

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

131− (cd "doc/cookbook/using-custom-monad" && autoreconf -i);

132− fi

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

134− (cd "doc/cookbook/using-free-client" && autoreconf -i);

135− fi

136− - rm -f cabal.project.freeze

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

138− - DISTDIR=$(mktemp -d /tmp/dist-test.XXXX)

139−

140−# Here starts the actual work to be performed for the package under test;

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

142−script:

143− # test that source-distributions can be generated

144− - echo Packaging... && echo -en 'travis_fold:start:sdist\\r'

145− - (cd "servant" && cabal sdist)

146− - (cd "servant-client" && cabal sdist)

147− - (cd "servant-client-core" && cabal sdist)

148− - (cd "servant-docs" && cabal sdist)

149− - (cd "servant-foreign" && cabal sdist)

150− - (cd "servant-server" && cabal sdist)

151− - (cd "doc/tutorial" && cabal sdist)

152− - (cd "doc/cookbook/basic-auth" && cabal sdist)

153− - (cd "doc/cookbook/db-postgres-pool" && cabal sdist)

154− - (cd "doc/cookbook/db-sqlite-simple" && cabal sdist)

155− - (cd "doc/cookbook/file-upload" && cabal sdist)

156− - (cd "doc/cookbook/generic" && cabal sdist)

157− - (cd "doc/cookbook/https" && cabal sdist)

158− - (cd "doc/cookbook/jwt-and-basic-auth" && cabal sdist)

159− - (cd "doc/cookbook/pagination" && cabal sdist)

160− - (cd "doc/cookbook/structuring-apis" && cabal sdist)

161− - (cd "doc/cookbook/using-custom-monad" && cabal sdist)

162− - (cd "doc/cookbook/using-free-client" && cabal sdist)

163− - echo -en 'travis_fold:end:sdist\\r'

164− - echo Unpacking... && echo -en 'travis_fold:start:unpack\\r'

165− - 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}/

166− - cd ${DISTDIR} || false

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

168− - "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"

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

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

171− - touch cabal.project.local

173− - cat cabal.project || true

174− - cat cabal.project.local || true

175− - echo -en 'travis_fold:end:unpack\\r'

176−

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

178− # build & run tests, build benchmarks

179− - cabal new-build -w ${HC} ${TEST} ${BENCH} all

180− - echo -en 'travis_fold:end:build-everything\\r'

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

182−

183− - echo Haddock... && echo -en 'travis_fold:start:haddock\\r'

184− # haddock

185− - rm -rf ./dist-newstyle

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

187−

188− - echo -en 'travis_fold:end:haddock\\r'

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

190− # Build without installed constraints for packages in global-db

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

192−

193− - echo -en 'travis_fold:end:build-installed\\r'

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

195−# EOF

CONTRIBUTING.md+34−5

@@ -21,6 +21,7 @@ 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`.

24

25

25## General

26## General

26

27

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

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

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

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

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

36

37

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

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

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

39+

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+```

39

66

40## PR process

67## PR process

41

68

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

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

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

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

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

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

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

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

82+know about it! Either hop on

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

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

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

85+read it).

57

86

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

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

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

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

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

76

105

77## Release policy

106## Release policy

78

107

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

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

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

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

81releases it may take some time in between releases.

110releases it may take some time in between releases.

82

111

README.md+27−36

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

4

5## Getting Started

6

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

7+We have a [tutorial](http://docs.servant.dev/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 central documentation can be found [here](http://haskell-servant.readthedocs.org/).

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

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

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

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

15

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

16+If you need help, drop by the IRC channel (#haskell-servant on libera.chat) 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−

38## Contributing

19## Contributing

39

20

40See `CONTRIBUTING.md`

21See `CONTRIBUTING.md`

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

43

24

44- Update changelog and bump versions in `master`

25- Update changelog and bump versions in `master`

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

55 - Temporarily comment out broken package

36 - Temporarily comment out broken package

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

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

57- When ripples are cleared out:

38- When ripples are cleared out:

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

59 - `git push --tags`

40 - `git push --tags`

60 - `cabal sdist` and `cabal upload`

41 - `cabal sdist` and `cabal upload`

61

42

62−## travis

43+## TechEmpower framework benchmarks

63

44

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

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

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

66

46

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

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

68

48

69−```

49+```sh

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

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

71```

51```

72

52

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

53+To compare with `warp`

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:

76

54

55+```sh

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

77```

57```

78−constraints:

58+

79− troublemaker <13.37 && > 13.37

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

60+

61+```sh

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

80```

63```

64+

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

66+

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.projectnew file+14

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

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-ymldeleted−14

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

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+34−14

@@ -1,34 +1,54 @@

1−packages: servant/

1+packages:

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+

2 servant-client/

9 servant-client/

3 servant-client-core/

10 servant-client-core/

11+ servant-http-streams/

4 servant-docs/

12 servant-docs/

5 servant-foreign/

13 servant-foreign/

6 servant-server/

14 servant-server/

15+ servant-swagger/

7 doc/tutorial/

16 doc/tutorial/

8

17

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

18+-- servant streaming

19+packages:

20+ servant-machines/

21+ servant-conduit/

22+ servant-pipes/

23+

24+-- servant GHCJS

25+-- packages:

26+-- servant-jsaddle/

10

27

28+-- Cookbooks

29+packages:

11 doc/cookbook/basic-auth

30 doc/cookbook/basic-auth

31+ doc/cookbook/curl-mock

32+ doc/cookbook/custom-errors

33+ doc/cookbook/basic-streaming

12 doc/cookbook/db-postgres-pool

34 doc/cookbook/db-postgres-pool

13 doc/cookbook/db-sqlite-simple

35 doc/cookbook/db-sqlite-simple

14 doc/cookbook/file-upload

36 doc/cookbook/file-upload

15 doc/cookbook/generic

37 doc/cookbook/generic

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

16 doc/cookbook/https

39 doc/cookbook/https

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

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

18 doc/cookbook/pagination

41 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

19 doc/cookbook/structuring-apis

46 doc/cookbook/structuring-apis

20 doc/cookbook/using-custom-monad

47 doc/cookbook/using-custom-monad

21 doc/cookbook/using-free-client

48 doc/cookbook/using-free-client

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

50+ doc/cookbook/managed-resource

22

51

23−allow-newer:

52+tests: True

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

53+optimization: False

25− servant-auth-server:servant-server

54+-- reorder-goals: True

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/1432new file+9

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

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/1469new file+11

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

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/1477new file+9

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

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/1529new file+10

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

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/1556new file+81

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

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/1569new file+13

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

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/1571new file+10

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

1+synopsis: Support UVerb in servant-auth-server

2+prs: #1571

3+issues: #1570

4+description: {

5+UVerb endpoints are now supported by servant-auth-server and can be used under the

6+Auth combinator when writing servers. It is still unsupported by

7+servant-auth-client.

8+

9+This PR also brings Headers support in UVerb responses

10+}

changelog.d/1573new file+2

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

1+synopsis: Add API docs for ServerT

2+prs: #1573

changelog.d/1580new file+12

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

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/1589new file+2

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

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

2+prs: 1589

changelog.d/1595new file+2

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

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

2+prs: #1595

changelog.d/1606new file+10

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

1+synopsis: Handle Cookies correctly for RunStreamingClient

2+prs: #1606

3+issues: #1605

4+

5+description: {

6+

7+Makes performWithStreamingRequest take into consideration the

8+CookieJar, which it previously didn't.

9+

10+}

changelog.d/1638new file+2

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

1+synopsis: Add Functor instance to AuthHandler.

2+prs: #1638

changelog.d/1649new file+8

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

1+synopsis: Add HasStatus instance for Headers (that defers StatusOf to underlying value)

2+prs: #1649

3+

4+description: {

5+

6+Adds a new HasStatus (Headers hs a) instance (StatusOf (Headers hs a) = StatusOf a)

7+

8+}

changelog.d/confignew file+2

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

1+organization: haskell-servant

2+repository: servant

changelog.d/servant-docs-curlnew file+16

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

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.nixnew file+38

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

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+12−206

@@ -1,216 +1,22 @@

1−# Makefile for Sphinx documentation

1+# Minimal makefile for Sphinx documentation

2#

3

4# You can set these variables from the command line.

5SPHINXOPTS =

6SPHINXBUILD = sphinx-build

7−PAPER =

7+SPHINXPROJ = Servant

8+SOURCEDIR = .

8BUILDDIR = _build

9BUILDDIR = _build

9

10

10−# User-friendly check for sphinx-build

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

11−ifeq ($(shell which $(SPHINXBUILD) >/dev/null 2>&1; echo $$?), 1)

12−$(error The '$(SPHINXBUILD)' command was not found. Make sure you have Sphinx installed, then set the SPHINXBUILD environment variable to point to the full path of the '$(SPHINXBUILD)' executable. Alternatively you can add the directory with the executable to your PATH. If you don't have Sphinx installed, grab it from http://sphinx-doc.org/)

13−endif

14−

15−# Internal variables.

16−PAPEROPT_a4 = -D latex_paper_size=a4

17−PAPEROPT_letter = -D latex_paper_size=letter

18−ALLSPHINXOPTS = -d $(BUILDDIR)/doctrees $(PAPEROPT_$(PAPER)) $(SPHINXOPTS) .

19−# the i18n builder cannot share the environment and doctrees with the others

20−I18NSPHINXOPTS = $(PAPEROPT_$(PAPER)) $(SPHINXOPTS) .

21−

22−.PHONY: help

23help:

12help:

24− @echo "Please use \`make <target>' where <target> is one of"

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

25− @echo " html to make standalone HTML files"

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

26− @echo " dirhtml to make HTML files named index.html in directories"

27− @echo " singlehtml to make a single large HTML file"

28− @echo " pickle to make pickle files"

29− @echo " json to make JSON files"

30− @echo " htmlhelp to make HTML files and a HTML help project"

31− @echo " qthelp to make HTML files and a qthelp project"

32− @echo " applehelp to make an Apple Help Book"

33− @echo " devhelp to make HTML files and a Devhelp project"

34− @echo " epub to make an epub"

35− @echo " latex to make LaTeX files, you can set PAPER=a4 or PAPER=letter"

36− @echo " latexpdf to make LaTeX files and run them through pdflatex"

37− @echo " latexpdfja to make LaTeX files and run them through platex/dvipdfmx"

38− @echo " text to make text files"

39− @echo " man to make manual pages"

40− @echo " texinfo to make Texinfo files"

41− @echo " info to make Texinfo files and run them through makeinfo"

42− @echo " gettext to make PO message catalogs"

43− @echo " changes to make an overview of all changed/added/deprecated items"

44− @echo " xml to make Docutils-native XML files"

45− @echo " pseudoxml to make pseudoxml-XML files for display purposes"

46− @echo " linkcheck to check all external links for integrity"

47− @echo " doctest to run all doctests embedded in the documentation (if enabled)"

48− @echo " coverage to run coverage check of the documentation (if enabled)"

49−

50−.PHONY: clean

51−clean:

52− rm -rf $(BUILDDIR)/*

53−

54−.PHONY: html

55−html:

56− $(SPHINXBUILD) -b html $(ALLSPHINXOPTS) $(BUILDDIR)/html

57− @echo

58− @echo "Build finished. The HTML pages are in $(BUILDDIR)/html."

59−

60−.PHONY: dirhtml

61−dirhtml:

62− $(SPHINXBUILD) -b dirhtml $(ALLSPHINXOPTS) $(BUILDDIR)/dirhtml

63− @echo

64− @echo "Build finished. The HTML pages are in $(BUILDDIR)/dirhtml."

65−

66−.PHONY: singlehtml

67−singlehtml:

68− $(SPHINXBUILD) -b singlehtml $(ALLSPHINXOPTS) $(BUILDDIR)/singlehtml

69− @echo

70− @echo "Build finished. The HTML page is in $(BUILDDIR)/singlehtml."

71−

72−.PHONY: pickle

73−pickle:

74− $(SPHINXBUILD) -b pickle $(ALLSPHINXOPTS) $(BUILDDIR)/pickle

75− @echo

76− @echo "Build finished; now you can process the pickle files."

77−

78−.PHONY: json

79−json:

80− $(SPHINXBUILD) -b json $(ALLSPHINXOPTS) $(BUILDDIR)/json

81− @echo

82− @echo "Build finished; now you can process the JSON files."

83−

84−.PHONY: htmlhelp

85−htmlhelp:

86− $(SPHINXBUILD) -b htmlhelp $(ALLSPHINXOPTS) $(BUILDDIR)/htmlhelp

87− @echo

88− @echo "Build finished; now you can run HTML Help Workshop with the" \

89− ".hhp project file in $(BUILDDIR)/htmlhelp."

90−

91−.PHONY: qthelp

92−qthelp:

93− $(SPHINXBUILD) -b qthelp $(ALLSPHINXOPTS) $(BUILDDIR)/qthelp

94− @echo

95− @echo "Build finished; now you can run "qcollectiongenerator" with the" \

96− ".qhcp project file in $(BUILDDIR)/qthelp, like this:"

97− @echo "# qcollectiongenerator $(BUILDDIR)/qthelp/generics-eot.qhcp"

98− @echo "To view the help file:"

99− @echo "# assistant -collectionFile $(BUILDDIR)/qthelp/generics-eot.qhc"

100−

101−.PHONY: applehelp

102−applehelp:

103− $(SPHINXBUILD) -b applehelp $(ALLSPHINXOPTS) $(BUILDDIR)/applehelp

104− @echo

105− @echo "Build finished. The help book is in $(BUILDDIR)/applehelp."

106− @echo "N.B. You won't be able to view it unless you put it in" \

107− "~/Library/Documentation/Help or install it in your application" \

108− "bundle."

109−

110−.PHONY: devhelp

111−devhelp:

112− $(SPHINXBUILD) -b devhelp $(ALLSPHINXOPTS) $(BUILDDIR)/devhelp

113− @echo

114− @echo "Build finished."

115− @echo "To view the help file:"

116− @echo "# mkdir -p $$HOME/.local/share/devhelp/generics-eot"

117− @echo "# ln -s $(BUILDDIR)/devhelp $$HOME/.local/share/devhelp/generics-eot"

118− @echo "# devhelp"

119−

120−.PHONY: epub

121−epub:

122− $(SPHINXBUILD) -b epub $(ALLSPHINXOPTS) $(BUILDDIR)/epub

123− @echo

124− @echo "Build finished. The epub file is in $(BUILDDIR)/epub."

125−

126−.PHONY: latex

127−latex:

128− $(SPHINXBUILD) -b latex $(ALLSPHINXOPTS) $(BUILDDIR)/latex

129− @echo

130− @echo "Build finished; the LaTeX files are in $(BUILDDIR)/latex."

131− @echo "Run \`make' in that directory to run these through (pdf)latex" \

132− "(use \`make latexpdf' here to do that automatically)."

133−

134−.PHONY: latexpdf

135−latexpdf:

136− $(SPHINXBUILD) -b latex $(ALLSPHINXOPTS) $(BUILDDIR)/latex

137− @echo "Running LaTeX files through pdflatex..."

138− $(MAKE) -C $(BUILDDIR)/latex all-pdf

139− @echo "pdflatex finished; the PDF files are in $(BUILDDIR)/latex."

140−

141−.PHONY: latexpdfja

142−latexpdfja:

143− $(SPHINXBUILD) -b latex $(ALLSPHINXOPTS) $(BUILDDIR)/latex

144− @echo "Running LaTeX files through platex and dvipdfmx..."

145− $(MAKE) -C $(BUILDDIR)/latex all-pdf-ja

146− @echo "pdflatex finished; the PDF files are in $(BUILDDIR)/latex."

147−

148−.PHONY: text

149−text:

150− $(SPHINXBUILD) -b text $(ALLSPHINXOPTS) $(BUILDDIR)/text

151− @echo

152− @echo "Build finished. The text files are in $(BUILDDIR)/text."

153−

154−.PHONY: man

155−man:

156− $(SPHINXBUILD) -b man $(ALLSPHINXOPTS) $(BUILDDIR)/man

157− @echo

158− @echo "Build finished. The manual pages are in $(BUILDDIR)/man."

159−

160−.PHONY: texinfo

161−texinfo:

162− $(SPHINXBUILD) -b texinfo $(ALLSPHINXOPTS) $(BUILDDIR)/texinfo

163− @echo

164− @echo "Build finished. The Texinfo files are in $(BUILDDIR)/texinfo."

165− @echo "Run \`make' in that directory to run these through makeinfo" \

166− "(use \`make info' here to do that automatically)."

167−

168−.PHONY: info

169−info:

170− $(SPHINXBUILD) -b texinfo $(ALLSPHINXOPTS) $(BUILDDIR)/texinfo

171− @echo "Running Texinfo files through makeinfo..."

172− make -C $(BUILDDIR)/texinfo info

173− @echo "makeinfo finished; the Info files are in $(BUILDDIR)/texinfo."

174−

175−.PHONY: gettext

176−gettext:

177− $(SPHINXBUILD) -b gettext $(I18NSPHINXOPTS) $(BUILDDIR)/locale

178− @echo

179− @echo "Build finished. The message catalogs are in $(BUILDDIR)/locale."

180−

181−.PHONY: changes

182−changes:

183− $(SPHINXBUILD) -b changes $(ALLSPHINXOPTS) $(BUILDDIR)/changes

184− @echo

185− @echo "The overview file is in $(BUILDDIR)/changes."

186−

187−.PHONY: linkcheck

188−linkcheck:

189− $(SPHINXBUILD) -b linkcheck $(ALLSPHINXOPTS) $(BUILDDIR)/linkcheck

190− @echo

191− @echo "Link check complete; look for any errors in the above output " \

192− "or in $(BUILDDIR)/linkcheck/output.txt."

193−

194−.PHONY: doctest

195−doctest:

196− $(SPHINXBUILD) -b doctest $(ALLSPHINXOPTS) $(BUILDDIR)/doctest

197− @echo "Testing of doctests in the sources finished, look at the " \

198− "results in $(BUILDDIR)/doctest/output.txt."

199−

200−.PHONY: coverage

201−coverage:

202− $(SPHINXBUILD) -b coverage $(ALLSPHINXOPTS) $(BUILDDIR)/coverage

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

203− @echo "Testing of coverage in the sources finished, look at the " \

204− "results in $(BUILDDIR)/coverage/python.txt."

205

16

206−.PHONY: xml

17+.PHONY: help Makefile

207−xml:

208− $(SPHINXBUILD) -b xml $(ALLSPHINXOPTS) $(BUILDDIR)/xml

209− @echo

210− @echo "Build finished. The XML files are in $(BUILDDIR)/xml."

211

18

212−.PHONY: pseudoxml

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

213−pseudoxml:

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

21+%: Makefile

214− $(SPHINXBUILD) -b pseudoxml $(ALLSPHINXOPTS) $(BUILDDIR)/pseudoxml

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

215− @echo

216− @echo "Build finished. The pseudo-XML files are in $(BUILDDIR)/pseudoxml."

doc/README.mdnew 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/building-the-docsdeleted−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/conf.py+53−176

@@ -1,7 +1,7 @@

1# -*- coding: utf-8 -*-

2#

3−# servant documentation build configuration file, created by

3+# Servant documentation build configuration file, created by

4−# sphinx-quickstart on Mon Nov 23 13:24:36 2015.

4+# sphinx-quickstart on Fri Jul 6 11:38:51 2018.

5#

6# This file is execfile()d with the current directory set to its

7# containing dir.

@@ -12,20 +12,21 @@

12# All configuration values have a default; values that are commented out

13# serve to show the default.

14

15−import sys

16−import os

17−import shlex

18−from recommonmark.parser import CommonMarkParser

19−

20# If extensions (or modules to document with autodoc) are in another directory,

15# If extensions (or modules to document with autodoc) are in another directory,

21# add these directories to sys.path here. If the directory is relative to the

16# add these directories to sys.path here. If the directory is relative to the

22# documentation root, use os.path.abspath to make it absolute, like shown here.

17# documentation root, use os.path.abspath to make it absolute, like shown here.

18+#

19+# import os

20+# import sys

23−#sys.path.insert(0, os.path.abspath('.'))

21+# sys.path.insert(0, os.path.abspath('.'))

22+from recommonmark.parser import CommonMarkParser

23+

24

25# -- General configuration ------------------------------------------------

26

27# If your documentation needs a minimal Sphinx version, state it here.

28+#

28−#needs_sphinx = '1.0'

29+# needs_sphinx = '1.0'

29

30

30# Add any Sphinx extension module names here, as strings. They can be

31# Add any Sphinx extension module names here, as strings. They can be

31# extensions coming with Sphinx (named 'sphinx.ext.*') or your custom

32# extensions coming with Sphinx (named 'sphinx.ext.*') or your custom

@@ -37,17 +38,15 @@ templates_path = ['_templates']

37

38

38# The suffix(es) of source filenames.

39# The suffix(es) of source filenames.

39# You can specify multiple suffix as a list of string:

40# You can specify multiple suffix as a list of string:

41+#

40−source_suffix = ['.md', '.rst', '.lhs']

42+source_suffix = ['.rst', '.md', '.lhs']

41−

42−# The encoding of source files.

43−#source_encoding = 'utf-8-sig'

44

43

45# The master toctree document.

44# The master toctree document.

46master_doc = 'index'

45master_doc = 'index'

47

46

48# General information about the project.

47# General information about the project.

49−project = u'servant'

48+project = u'Servant'

50−copyright = u'2016, Servant Contributors'

49+copyright = u'2022, Servant Contributors'

51author = u'Servant Contributors'

50author = u'Servant Contributors'

52

51

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

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

@@ -55,9 +54,9 @@ author = u'Servant Contributors'

55# built documents.

54# built documents.

56#

55#

57# The short X.Y version.

56# The short X.Y version.

58−# version = 'latest'

57+# version = u'0.14'

59# The full version, including alpha/beta/rc tags.

58# The full version, including alpha/beta/rc tags.

60−# release = 'latest'

59+# release = u'0.14'

61

60

62# The language for content autogenerated by Sphinx. Refer to documentation

61# The language for content autogenerated by Sphinx. Refer to documentation

63# for a list of supported languages.

62# for a list of supported languages.

@@ -66,45 +65,14 @@ author = u'Servant Contributors'

66# Usually you set "language" from the command line for these cases.

65# Usually you set "language" from the command line for these cases.

67language = None

66language = None

68

67

69−# There are two options for replacing |today|: either, you set today to some

70−# non-false value, then it is used:

71−#today = ''

72−# Else, today_fmt is used as the format for a strftime call.

73−#today_fmt = '%B %d, %Y'

74−

75# List of patterns, relative to source directory, that match files and

68# List of patterns, relative to source directory, that match files and

76# directories to ignore when looking for source files.

69# directories to ignore when looking for source files.

70+# This patterns also effect to html_static_path and html_extra_path

77−exclude_patterns = ['_build', 'venv']

71+exclude_patterns = ['_build', 'Thumbs.db', '.DS_Store']

78−

79−# The reST default role (used for this markup: `text`) to use for all

80−# documents.

81−#default_role = None

82−

83−# If true, '()' will be appended to :func: etc. cross-reference text.

84−#add_function_parentheses = True

85−

86−# If true, the current module name will be prepended to all description

87−# unit titles (such as .. function::).

88−#add_module_names = True

89−

90−# If true, sectionauthor and moduleauthor directives will be shown in the

91−# output. They are ignored by default.

92−#show_authors = False

93

72

94# The name of the Pygments (syntax highlighting) style to use.

73# The name of the Pygments (syntax highlighting) style to use.

95pygments_style = 'sphinx'

74pygments_style = 'sphinx'

96

75

97−def setup(app):

98− from sphinx.highlighting import lexers

99− from pygments.lexers import HaskellLexer

100− lexers['haskell ignore'] = HaskellLexer(stripnl=False)

101−

102−# A list of ignored prefixes for module index sorting.

103−#modindex_common_prefix = []

104−

105−# If true, keep warnings as "system message" paragraphs in the built documents.

106−#keep_warnings = False

107−

108# If true, `todo` and `todoList` produce output, else they produce nothing.

76# If true, `todo` and `todoList` produce output, else they produce nothing.

109todo_include_todos = False

77todo_include_todos = False

110

78

@@ -113,157 +81,77 @@ todo_include_todos = False

113

81

114# The theme to use for HTML and HTML Help pages. See the documentation for

82# The theme to use for HTML and HTML Help pages. See the documentation for

115# a list of builtin themes.

83# a list of builtin themes.

84+#

116html_theme = 'sphinx_rtd_theme'

85html_theme = 'sphinx_rtd_theme'

117

86

118# Theme options are theme-specific and customize the look and feel of a theme

87# Theme options are theme-specific and customize the look and feel of a theme

119# further. For a list of options available for each theme, see the

88# further. For a list of options available for each theme, see the

120# documentation.

89# documentation.

90+#

121−#html_theme_options = {}

91+# html_theme_options = {}

122−

123−# Add any paths that contain custom themes here, relative to this directory.

124−#html_theme_path = []

125−

126−# The name for this set of Sphinx documents. If None, it defaults to

127−# "<project> v<release> documentation".

128−#html_title = None

129−

130−# A shorter title for the navigation bar. Default is the same as html_title.

131−#html_short_title = None

132−

133−# The name of an image file (relative to this directory) to place at the top

134−# of the sidebar.

135−#html_logo = None

136−

137−# The name of an image file (within the static path) to use as favicon of the

138−# docs. This file should be a Windows icon file (.ico) being 16x16 or 32x32

139−# pixels large.

140−#html_favicon = None

141

92

142# Add any paths that contain custom static files (such as style sheets) here,

93# Add any paths that contain custom static files (such as style sheets) here,

143# relative to this directory. They are copied after the builtin static files,

94# relative to this directory. They are copied after the builtin static files,

144# so a file named "default.css" will overwrite the builtin "default.css".

95# so a file named "default.css" will overwrite the builtin "default.css".

145html_static_path = ['_static']

96html_static_path = ['_static']

146

97

147−# Add any extra paths that contain custom files (such as robots.txt or

148−# .htaccess) here, relative to this directory. These files are copied

149−# directly to the root of the documentation.

150−#html_extra_path = []

151−

152−# If not '', a 'Last updated on:' timestamp is inserted at every page bottom,

153−# using the given strftime format.

154−#html_last_updated_fmt = '%b %d, %Y'

155−

156−# If true, SmartyPants will be used to convert quotes and dashes to

157−# typographically correct entities.

158−#html_use_smartypants = True

159−

160−# Custom sidebar templates, maps document names to template names.

98+# Custom sidebar templates, must be a dictionary that maps document names

99+# to template names.

100+#

101+# This is required for the alabaster theme

102+# refs: http://alabaster.readthedocs.io/en/latest/installation.html#sidebars

161−#html_sidebars = {}

103+html_sidebars = {

162−

104+ '**': [

163−# Additional templates that should be rendered to pages, maps page names to

105+ 'relations.html', # needs 'show_related': True theme option to display

164−# template names.

106+ 'searchbox.html',

165−#html_additional_pages = {}

107+ ]

166−

108+}

167−# If false, no module index is generated.

168−#html_domain_indices = True

169−

170−# If false, no index is generated.

171−#html_use_index = True

172−

173−# If true, the index is split into individual pages for each letter.

174−#html_split_index = False

175−

176−# If true, links to the reST sources are added to the pages.

177−#html_show_sourcelink = True

178−

179−# If true, "Created using Sphinx" is shown in the HTML footer. Default is True.

180−#html_show_sphinx = True

181−

182−# If true, "(C) Copyright ..." is shown in the HTML footer. Default is True.

183−#html_show_copyright = True

184−

185−# If true, an OpenSearch description file will be output, and all pages will

186−# contain a <link> tag referring to it. The value of this option must be the

187−# base URL from which the finished HTML is served.

188−#html_use_opensearch = ''

189−

190−# This is the file name suffix for HTML files (e.g. ".xhtml").

191−#html_file_suffix = None

192−

193−# Language to be used for generating the HTML full-text search index.

194−# Sphinx supports the following languages:

195−# 'da', 'de', 'en', 'es', 'fi', 'fr', 'hu', 'it', 'ja'

196−# 'nl', 'no', 'pt', 'ro', 'ru', 'sv', 'tr'

197−#html_search_language = 'en'

198

109

199−# A dictionary with options for the search language support, empty by default.

200−# Now only 'ja' uses this config value

201−#html_search_options = {'type': 'default'}

202

110

203−# The name of a javascript file (relative to the configuration directory) that

111+# -- Options for HTMLHelp output ------------------------------------------

204−# implements a search results scorer. If empty, the default will be used.

205−#html_search_scorer = 'scorer.js'

206

112

207# Output file base name for HTML help builder.

113# Output file base name for HTML help builder.

208−htmlhelp_basename = 'servantdoc'

114+htmlhelp_basename = 'Servantdoc'

115+

209

116

210# -- Options for LaTeX output ---------------------------------------------

117# -- Options for LaTeX output ---------------------------------------------

211

118

212latex_elements = {

119latex_elements = {

213−# The paper size ('letterpaper' or 'a4paper').

120+ # The paper size ('letterpaper' or 'a4paper').

121+ #

214−#'papersize': 'letterpaper',

122+ # 'papersize': 'letterpaper',

215

123

216−# The font size ('10pt', '11pt' or '12pt').

124+ # The font size ('10pt', '11pt' or '12pt').

125+ #

217−#'pointsize': '10pt',

126+ # 'pointsize': '10pt',

218

127

219−# Additional stuff for the LaTeX preamble.

128+ # Additional stuff for the LaTeX preamble.

129+ #

220−#'preamble': '',

130+ # 'preamble': '',

221

131

222−# Latex figure (float) alignment

132+ # Latex figure (float) alignment

133+ #

223−#'figure_align': 'htbp',

134+ # 'figure_align': 'htbp',

224}

135}

225

136

226# Grouping the document tree into LaTeX files. List of tuples

137# Grouping the document tree into LaTeX files. List of tuples

227# (source start file, target name, title,

138# (source start file, target name, title,

228# author, documentclass [howto, manual, or own class]).

139# author, documentclass [howto, manual, or own class]).

229latex_documents = [

140latex_documents = [

230− (master_doc, 'servant.tex', u'servant Documentation',

141+ (master_doc, 'Servant.tex', u'Servant Documentation',

231 u'Servant Contributors', 'manual'),

142 u'Servant Contributors', 'manual'),

232]

143]

233

144

234−# The name of an image file (relative to this directory) to place at the top of

235−# the title page.

236−#latex_logo = None

237−

238−# For "manual" documents, if this is true, then toplevel headings are parts,

239−# not chapters.

240−#latex_use_parts = False

241−

242−# If true, show page references after internal links.

243−#latex_show_pagerefs = False

244−

245−# If true, show URL addresses after external links.

246−#latex_show_urls = False

247−

248−# Documents to append as an appendix to all manuals.

249−#latex_appendices = []

250−

251−# If false, no module index is generated.

252−#latex_domain_indices = True

253−

254

145

255# -- Options for manual page output ---------------------------------------

146# -- Options for manual page output ---------------------------------------

256

147

257# One entry per manual page. List of tuples

148# One entry per manual page. List of tuples

258# (source start file, name, description, authors, manual section).

149# (source start file, name, description, authors, manual section).

259man_pages = [

150man_pages = [

260− (master_doc, 'servant', u'servant Documentation',

151+ (master_doc, 'servant', u'Servant Documentation',

261 [author], 1)

152 [author], 1)

262]

153]

263

154

264−# If true, show URL addresses after external links.

265−#man_show_urls = False

266−

267

155

268# -- Options for Texinfo output -------------------------------------------

156# -- Options for Texinfo output -------------------------------------------

269

157

@@ -271,24 +159,13 @@ man_pages = [

271# (source start file, target name, title, author,

159# (source start file, target name, title, author,

272# dir menu entry, description, category)

160# dir menu entry, description, category)

273texinfo_documents = [

161texinfo_documents = [

274− (master_doc, 'servant', u'servant Documentation',

162+ (master_doc, 'Servant', u'Servant Documentation',

275− author, 'servant', 'One line description of project.',

163+ author, 'Servant', 'One line description of project.',

276− 'Miscellaneous'),

164+ 'Miscellaneous'),

277]

165]

278

166

279−# Documents to append as an appendix to all manuals.

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

280−#texinfo_appendices = []

281−

282−# If false, no module index is generated.

283−#texinfo_domain_indices = True

284−

285−# How to display URL addresses: 'footnote', 'no', or 'inline'.

286−#texinfo_show_urls = 'footnote'

287−

288−# If true, do not generate a @detailmenu in the "Top" node's menu.

289−#texinfo_no_detailmenu = False

290

168

291source_parsers = {

169source_parsers = {

292− '.md': CommonMarkParser,

293 '.lhs': CommonMarkParser,

170 '.lhs': CommonMarkParser,

294}

171}

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

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

1+cabal-version: 2.2

1name: cookbook-basic-auth

2name: cookbook-basic-auth

2version: 0.1

3version: 0.1

3synopsis: Basic Authentication cookbook example

4synopsis: Basic Authentication cookbook example

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

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

5−license: BSD3

6+license: BSD-3-Clause

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

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

7author: Servant Contributors

8author: Servant Contributors

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

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

9build-type: Simple

10build-type: Simple

10−cabal-version: >=1.10

11−tested-with: GHC==7.8.4, GHC==7.10.3, GHC==8.0.2, GHC==8.2.2, GHC==8.4.3

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

12

13executable cookbook-basic-auth

14 main-is: BasicAuth.lhs

doc/cookbook/basic-streaming/Streaming.lhsnew file+129

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

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.cabalnew file+28

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

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,13 +1,19 @@

1packages:

2 basic-auth/

3+ curl-mock/

4+ db-mysql-basics/

3 db-sqlite-simple/

5 db-sqlite-simple/

4 db-postgres-pool/

6 db-postgres-pool/

5 using-custom-monad/

7 using-custom-monad/

6 jwt-and-basic-auth/

8 jwt-and-basic-auth/

9+ hoist-server-with-context/

7 file-upload/

10 file-upload/

8 structuring-apis/

11 structuring-apis/

9 https/

12 https/

10 pagination/

13 pagination/

14+ sentry/

15+ testing/

16+ open-id-connect/

11 ../../servant

17 ../../servant

12 ../../servant-server

18 ../../servant-server

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

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

doc/cookbook/cabal.project.localnew file

No changes to the content.

doc/cookbook/curl-mock/CurlMock.lhsnew file+205

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

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.cabalnew file+29

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

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.lhsnew file+189

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

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.cabalnew file+25

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

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.lhsnew file+236

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

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.cabalnew file+40

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

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

1name: cookbook-db-postgres-pool

2name: cookbook-db-postgres-pool

2version: 0.1

3version: 0.1

3synopsis: Simple PostgreSQL connection pool cookbook example

4synopsis: Simple PostgreSQL connection pool cookbook example

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

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

5−license: BSD3

6+license: BSD-3-Clause

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

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

7author: Servant Contributors

8author: Servant Contributors

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

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

9build-type: Simple

10build-type: Simple

10−cabal-version: >=1.10

11−tested-with: GHC==7.8.4, GHC==7.10.3, GHC==8.0.2, GHC==8.2.2, GHC==8.4.3

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

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

1name: cookbook-db-sqlite-simple

2name: cookbook-db-sqlite-simple

2version: 0.1

3version: 0.1

3synopsis: Simple SQLite DB cookbook example

4synopsis: Simple SQLite DB cookbook example

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

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

5−license: BSD3

6+license: BSD-3-Clause

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

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

7author: Servant Contributors

8author: Servant Contributors

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

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

9build-type: Simple

10build-type: Simple

10−cabal-version: >=1.10

11−tested-with: GHC==7.8.4, GHC==7.10.3, GHC==8.0.2, GHC==8.2.2, GHC==8.4.3

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

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

26+ , sqlite-simple >= 0.4.5.0

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 (withSocketsDo)

20+import Network.Socket (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, has servant-multipart does not

93+servant-client this time, as 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://haskell-servant.readthedocs.org/en/stable/tutorial/index.html) that

129+We have a [tutorial](http://docs.servant.dev/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

1name: cookbook-file-upload

2name: cookbook-file-upload

2version: 0.1

3version: 0.1

3synopsis: File upload cookbook example

4synopsis: File upload cookbook example

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

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

5−license: BSD3

6+license: BSD-3-Clause

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

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

7author: Servant Contributors

8author: Servant Contributors

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

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

9build-type: Simple

10build-type: Simple

10−cabal-version: >=1.10

11−tested-with: GHC==7.8.4, GHC==7.10.3, GHC==8.0.2, GHC==8.2.2, GHC==8.4.3

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

12

13executable cookbook-file-upload

14 main-is: FileUpload.lhs

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

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

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)

11−import Data.Proxy (Proxy (..))

12+import Data.Proxy (Proxy (..))

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

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

13−import System.Environment (getArgs)

14+import System.Environment (getArgs)

14

15

15import Servant

16import Servant

16import Servant.Client

17import Servant.Client

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

42api = genericApi (Proxy :: Proxy Routes)

43api = genericApi (Proxy :: Proxy Routes)

43```

44```

44

45

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

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

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

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

47

48

48## Links

49## Links

49

50

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

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

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

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

52as field accessors work as proxies:

53as field accessors work as proxies:

53

54

54```haskell

55```haskell

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

66## Client

67## Client

67

68

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

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

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

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

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

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

71

72

72```haskell

73```haskell

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

102 ("run":_) -> do

103 ("run":_) -> do

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

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

104 run 8000 app

105 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)

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

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

106```

111```

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

1name: cookbook-generic

2name: cookbook-generic

2version: 0.1

3version: 0.1

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

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

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

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

5−license: BSD3

6+license: BSD-3-Clause

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

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

7author: Servant Contributors

8author: Servant Contributors

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

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

9build-type: Simple

10build-type: Simple

10−cabal-version: >=1.10

11−tested-with: GHC==7.8.4, GHC==7.10.3, GHC==8.0.2, GHC==8.2.2, GHC==8.4.3

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

12

13executable cookbook-using-custom-monad

14 main-is: Generic.lhs

doc/cookbook/hoist-server-with-context/HoistServerWithContext.lhsnew file+413

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

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.cabalnew file+37

@@ -0,0 +1,37 @@

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-3.2.4/docs/Network-Wai-Handler-WarpTLS.html)

37+The [`warp-tls`](https://hackage.haskell.org/package/warp-tls/docs/Network-Wai-Handler-WarpTLS.html)

38package provides two functions for running an `Application`, called

39−[`runTLS`](https://hackage.haskell.org/package/warp-tls-3.2.4/docs/Network-Wai-Handler-WarpTLS.html#v:runTLS)

39+[`runTLS`](https://hackage.haskell.org/package/warp-tls/docs/Network-Wai-Handler-WarpTLS.html#v:runTLS)

40−and [`runTLSSocket`](https://hackage.haskell.org/package/warp-tls-3.2.4/docs/Network-Wai-Handler-WarpTLS.html#v:runTLSSocket).

40+and [`runTLSSocket`](https://hackage.haskell.org/package/warp-tls/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-3.2.4/docs/Network-Wai-Handler-WarpTLS.html#t:TLSSettings)

44+[the TLS settings](https://hackage.haskell.org/package/warp-tls/docs/Network-Wai-Handler-WarpTLS.html#t:TLSSettings)

45(certificates, keys, ciphers, etc)

46−and [the warp settings](https://hackage.haskell.org/package/warp-3.2.12/docs/Network-Wai-Handler-Warp-Internal.html#t:Settings)

46+and [the warp settings](https://hackage.haskell.org/package/warp/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

1name: cookbook-https

2name: cookbook-https

2version: 0.1

3version: 0.1

3synopsis: HTTPS cookbook example

4synopsis: HTTPS cookbook example

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

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

5−license: BSD3

6+license: BSD-3-Clause

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

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

7author: Servant Contributors

8author: Servant Contributors

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

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

9build-type: Simple

10build-type: Simple

10−cabal-version: >=1.10

11−tested-with: GHC==7.8.4, GHC==7.10.3, GHC==8.0.2, GHC==8.2.2, GHC==8.4.3

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

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

20+ , warp-tls >= 3.2.9

21 , markdown-unlit >= 0.4

22 default-language: Haskell2010

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

doc/cookbook/index.rst+12−2

@@ -6,8 +6,8 @@ how to solve many common problems with servant. If you're

6interested in contributing examples of your own, feel free

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 **#servant** IRC channel

9+or even to just get in touch with us on the `**#haskell-servant** IRC channel

10−on freenode or on

10+on libera.chat <https://web.libera.chat/#haskell-servant>_ 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,11 +20,21 @@ you name it!

20 structuring-apis/StructuringApis.lhs

21 generic/Generic.lhs

22 https/Https.lhs

23+ db-mysql-basics/MysqlBasics.lhs

23 db-sqlite-simple/DBConnection.lhs

24 db-sqlite-simple/DBConnection.lhs

24 db-postgres-pool/PostgresPool.lhs

25 db-postgres-pool/PostgresPool.lhs

25 using-custom-monad/UsingCustomMonad.lhs

26 using-custom-monad/UsingCustomMonad.lhs

26 using-free-client/UsingFreeClient.lhs

27 using-free-client/UsingFreeClient.lhs

28+ custom-errors/CustomErrors.lhs

29+ uverb/UVerb.lhs

27 basic-auth/BasicAuth.lhs

30 basic-auth/BasicAuth.lhs

31+ basic-streaming/Streaming.lhs

28 jwt-and-basic-auth/JWTAndBasicAuth.lhs

32 jwt-and-basic-auth/JWTAndBasicAuth.lhs

33+ hoist-server-with-context/HoistServerWithContext.lhs

29 file-upload/FileUpload.lhs

34 file-upload/FileUpload.lhs

30 pagination/Pagination.lhs

35 pagination/Pagination.lhs

36+ curl-mock/CurlMock.lhs

37+ sentry/Sentry.lhs

38+ testing/Testing.lhs

39+ open-id-connect/OpenIdConnect.lhs

40+ managed-resource/ManagedResource.lhs

doc/cookbook/jwt-and-basic-auth/jwt-and-basic-auth.cabal+5−8

@@ -1,22 +1,19 @@

1+cabal-version: 2.2

1name: cookbook-jwt-and-basic-auth

2name: cookbook-jwt-and-basic-auth

2version: 0.0.1

3version: 0.0.1

3synopsis: JWT and basic access authentication cookbook example

4synopsis: JWT and basic access authentication cookbook example

4description: Using servant-auth to support both JWT-based and basic

5description: Using servant-auth to support both JWT-based and basic

5 authentication.

6 authentication.

6−homepage: http://haskell-servant.readthedocs.org/

7+homepage: http://docs.servant.dev/

7−license: BSD3

8+license: BSD-3-Clause

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

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

9author: Servant Contributors

10author: Servant Contributors

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

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

11category: Servant

12category: Servant

12build-type: Simple

13build-type: Simple

13−cabal-version: >=1.10

14−tested-with: GHC==7.8.4, GHC==7.10.3, GHC==8.0.2, GHC==8.2.2, GHC==8.4.3

14+tested-with: GHC==8.6.5, GHC==8.8.3, GHC ==8.10.7

15

16executable cookbook-jwt-and-basic-auth

17− if !impl(ghc >= 7.10)

18− buildable: False

19−

20 main-is: JWTAndBasicAuth.lhs

17 main-is: JWTAndBasicAuth.lhs

21 build-depends: base == 4.*

18 build-depends: base == 4.*

22 , text >= 1.2

19 , text >= 1.2

@@ -25,7 +22,7 @@ executable cookbook-jwt-and-basic-auth

25 , servant

22 , servant

26 , servant-client

23 , servant-client

27 , servant-server

24 , servant-server

28− , servant-auth ==0.3.*

25+ , servant-auth == 0.4.*

29 , servant-auth-server >= 0.3.1.0

26 , servant-auth-server >= 0.3.1.0

30 , warp >= 3.2

27 , warp >= 3.2

31 , wai >= 3.2

28 , wai >= 3.2

doc/cookbook/managed-resource/ManagedResource.lhsnew file+114

@@ -0,0 +1,114 @@

1+# Request-lifetime Managed Resources

2+

3+Let's see how we can write a handle that uses a resource managed by Servant. The resource is created automatically by Servant when the server recieves a request, and the resource is automatically destroyed when the server is finished handling a request.

4+

5+As usual, we start with a little bit of throat clearing.

6+

7+

8+``` haskell

9+{-# LANGUAGE DataKinds #-}

10+{-# LANGUAGE TypeOperators #-}

11+import Control.Concurrent

12+import Control.Exception (bracket, throwIO)

13+import Control.Monad.IO.Class

14+import Control.Monad.Trans.Resource

15+import Data.Acquire

16+import Network.HTTP.Client (newManager, defaultManagerSettings)

17+import Network.Wai.Handler.Warp

18+import Servant

19+import Servant.Client

20+import System.IO

21+```

22+

23+Here we define an API type that uses the `WithResource` combinator. The server handler for an endpoint with a `WithResource res` component will receive a value of that type as an argument.

24+

25+``` haskell

26+type API = WithResource Handle :> ReqBody '[PlainText] String :> Post '[JSON] NoContent

27+

28+api :: Proxy API

29+api = Proxy

30+```

31+

32+But this resource value has to come from somewhere. Servant obtains the value using an Acquire provided in the context. The Acquire knows how to both create and destroy resources of a particular type.

33+

34+``` haskell

35+appContext :: Context '[Acquire Handle]

36+appContext = acquireHandle :. EmptyContext

37+

38+acquireHandle :: Acquire Handle

39+acquireHandle = mkAcquire newHandle closeHandle

40+

41+newHandle :: IO Handle

42+newHandle = do

43+ putStrLn "opening file"

44+ h <- openFile "test.txt" AppendMode

45+ putStrLn "opened file"

46+ return h

47+

48+closeHandle :: Handle -> IO ()

49+closeHandle h = do

50+ putStrLn "closing file"

51+ hClose h

52+ putStrLn "closed file"

53+```

54+

55+Now we create the handler which will use this resource. This handler will write the request message to the System.IO.Handle which was provided to us. In some situations the handler will succeed, but in some in will fail. In either case, Servant will clean up the resource for us.

56+

57+``` haskell

58+server :: Server API

59+server = writeToFile

60+

61+ where writeToFile :: (ReleaseKey, Handle) -> String -> Handler NoContent

62+ writeToFile (_, h) msg = case msg of

63+ "illegal" -> error "wait, that's illegal!"

64+ legalMsg -> liftIO $ do

65+ putStrLn "writing file"

66+ hPutStrLn h legalMsg

67+ putStrLn "wrote file"

68+ return NoContent

69+```

70+

71+Finally we run the server in the background while we post messages to it.

72+

73+``` haskell

74+runApp :: IO ()

75+runApp = run 8080 (serveWithContext api appContext $ server)

76+

77+postMsg :: String -> ClientM NoContent

78+postMsg = client api

79+

80+main :: IO ()

81+main = do

82+ mgr <- newManager defaultManagerSettings

83+ bracket (forkIO $ runApp) killThread $ \_ -> do

84+ ms <- flip runClientM (mkClientEnv mgr (BaseUrl Http "localhost" 8080 "")) $ do

85+ liftIO $ putStrLn "sending hello message"

86+ _ <- postMsg "hello"

87+ liftIO $ putStrLn "sending illegal message"

88+ _ <- postMsg "illegal"

89+ liftIO $ putStrLn "done"

90+ print ms

91+```

92+

93+This program prints

94+

95+```

96+sending hello message

97+opening file

98+opened file

99+writing file

100+wrote file

101+closing file

102+closed file

103+sending illegal message

104+opening file

105+opened file

106+closing file

107+closed file

108+wait, that's illegal!

109+CallStack (from HasCallStack):

110+ error, called at ManagedResource.lhs:63:24 in main:Main

111+Left (FailureResponse (Request {requestPath = (BaseUrl {baseUrlScheme = Http, baseUrlHost = "localhost", baseUrlPort = 8080, baseUrlPath = ""},""), requestQueryString = fromList [], requestBody = Just ((),text/plain;charset=utf-8), requestAccept = fromList [], requestHeaders = fromList [], requestHttpVersion = HTTP/1.1, requestMethod = "POST"}) (Response {responseStatusCode = Status {statusCode = 500, statusMessage = "Internal Server Error"}, responseHeaders = fromList [("Transfer-Encoding","chunked"),("Date","Thu, 24 Nov 2022 21:04:47 GMT"),("Server","Warp/3.3.23"),("Content-Type","text/plain; charset=utf-8")], responseHttpVersion = HTTP/1.1, responseBody = "Something went wrong"}))

112+```

113+

114+and appends to a file called `test.txt`. We can see from the output that when a legal message is sent, the file is opened, written to, and closed. We can also see that when an illegal message is sent, the file is opened but not written to. Crucially, it is still closed even though the handler threw an exception.

doc/cookbook/managed-resource/managed-resource.cabalnew file+30

@@ -0,0 +1,30 @@

1+cabal-version: 2.2

2+name: cookbook-managed-resource

3+version: 0.1

4+synopsis: Simple managed resource 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==9.4.2

12+

13+executable cookbook-managed-resource

14+ main-is: ManagedResource.lhs

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

16+ , text >= 1.2

17+ , aeson >= 1.2

18+ , servant

19+ , servant-client

20+ , servant-server

21+ , warp >= 3.2

22+ , wai >= 3.2

23+ , http-types >= 0.12

24+ , markdown-unlit >= 0.4

25+ , http-client >= 0.5

26+ , transformers

27+ , resourcet

28+ default-language: Haskell2010

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

30+ build-tool-depends: markdown-unlit:markdown-unlit

doc/cookbook/open-id-connect/OpenIdConnect.cabalnew file+45

@@ -0,0 +1,45 @@

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.lhsnew file+472

@@ -0,0 +1,472 @@

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 `/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 document, and augment the

21+As a response, the server may return the list of corresponding documents, 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 definintion

130+Note that `getFieldValue :: Proxy "name" -> Color -> String` is the minimal complete definition

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 mentionned in introduction. Expanding the alias boils down to the following:

151+we mentioned 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 (tight to the `Range` HTTP header) indicates the server to parse any `Range`

168+type we've defined above (tied 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 deducted from the `RangeOptions` that are part of the `HasPagination` instance. Therefore, all

195+are deduced 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 annotation are

222+instance. Doing so will make the other helper functions more ambiguous and type annotations 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 overwritten when defining the instance to provide

238+`HasPagination` instance. However, this can be overridden when defining the instance to provide

239−your own options. This options come into play when a `Range` header is received and isn't fully

239+your own options. These 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/dummy/Pagination.lhsdeleted−5

@@ -1,5 +0,0 @@

1−```haskell

2−module Main (main) where

3−main :: IO ()

4−main = return ()

5−```

doc/cookbook/pagination/pagination.cabal+10−19

@@ -1,32 +1,23 @@

1+cabal-version: 2.2

1name: cookbook-pagination

2name: cookbook-pagination

2version: 2.1

3version: 2.1

3synopsis: Pagination with Servant example

4synopsis: Pagination with Servant example

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

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

5−license: BSD3

6+license: BSD-3-Clause

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

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

7author: Servant Contributors

8author: Servant Contributors

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

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

9build-type: Simple

10build-type: Simple

10−cabal-version: >=1.10

11−extra-source-files:

12− Pagination.lhs

13− dummy/Pagination.lhs

14−tested-with: GHC==7.8.4, GHC==7.10.3, GHC==8.0.2, GHC==8.2.2, GHC==8.4.3

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

15

12

16executable cookbook-pagination

13executable cookbook-pagination

17 main-is: Pagination.lhs

14 main-is: Pagination.lhs

18 build-tool-depends: markdown-unlit:markdown-unlit

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

19 default-language: Haskell2010

16 default-language: Haskell2010

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

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

21−

22− if impl(ghc >= 8.0)

23− hs-source-dirs: .

24− build-depends: base >= 4.8 && <4.12

18+ build-depends: base >= 4.9 && <5

25− , aeson

19+ , aeson

26− , servant

20+ , servant

27− , servant-server

21+ , servant-server

28− , servant-pagination >= 2.1.0 && < 3.0.0

22+ , servant-pagination >= 2.1.0 && < 3.0.0

29− , warp

23+ , warp

30− else

31− hs-source-dirs: dummy

32− build-depends: base

doc/cookbook/sentry/Sentry.lhsnew file+116

@@ -0,0 +1,116 @@

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.cabalnew file+24

@@ -0,0 +1,24 @@

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− -> Server (SimpleAPI name a i) m

147+ -> ServerT (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

1name: cookbook-structuring-apis

2name: cookbook-structuring-apis

2version: 0.1

3version: 0.1

3synopsis: Example that shows how APIs can be structured

4synopsis: Example that shows how APIs can be structured

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

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

5−license: BSD3

6+license: BSD-3-Clause

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

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

7author: Servant Contributors

8author: Servant Contributors

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

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

9build-type: Simple

10build-type: Simple

10−cabal-version: >=1.10

11−tested-with: GHC==7.8.4, GHC==7.10.3, GHC==8.0.2, GHC==8.2.2, GHC==8.4.3

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

12

13executable cookbook-structuring-apis

14 main-is: StructuringApis.lhs

doc/cookbook/testing/Testing.lhsnew file+506

@@ -0,0 +1,506 @@

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.cabalnew file+38

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

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+4−1

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

1# Using a custom monad

2

3−In this section we will create and API for a book shelf without any backing DB storage.

3+In this section we will create an 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,3 +115,6 @@ 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

1name: cookbook-using-custom-monad

2name: cookbook-using-custom-monad

2version: 0.1

3version: 0.1

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

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

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

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

5−license: BSD3

6+license: BSD-3-Clause

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

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

7author: Servant Contributors

8author: Servant Contributors

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

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

9build-type: Simple

10build-type: Simple

10−cabal-version: >=1.10

11−tested-with: GHC==7.8.4, GHC==7.10.3, GHC==8.0.2, GHC==8.2.2, GHC==8.4.3

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

12

13executable cookbook-using-custom-monad

14 main-is: UsingCustomMonad.lhs

doc/cookbook/using-free-client/UsingFreeClient.lhs+7−9

@@ -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,8 +99,6 @@ 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 :(

104```

102```

105

103

106We are interested in `RunRequest`, that's what client should block on:

104We are interested in `RunRequest`, that's what client should block on:

@@ -121,7 +119,7 @@ Now we can use `servant-client`'s internals to convert servant's `Request`

121to http-client's `Request`, and we can inspect it:

119to http-client's `Request`, and we can inspect it:

122

120

123```haskell

121```haskell

124− let req' = I.requestToClientRequest burl req

122+ req' <- I.defaultMakeClientRequest burl req

125 putStrLn $ "Making request: " ++ show req'

123 putStrLn $ "Making request: " ++ show req'

126```

124```

127

125

@@ -137,13 +135,13 @@ And we continue by turning http-client's `Response` into servant's `Response`,

137and calling the continuation. We should get a `Pure` value.

135and calling the continuation. We should get a `Pure` value.

138

136

139```haskell

137```haskell

140− let res = I.clientResponseToResponse res'

138+ let res = I.clientResponseToResponse id res'

141−

139+

142 case k res of

140 case k res of

143 Pure n ->

141 Pure n ->

144 putStrLn $ "Expected 1764, got " ++ show n

142 putStrLn $ "Expected 1764, got " ++ show n

145− _ ->

143+ _ ->

146− putStrLn "ERROR: didn't got a response"

144+ putStrLn "ERROR: didn't get a response"

147```

145```

148

146

149So that's it. Using `Free` we can evaluate servant clients step-by-step, and

147So that's it. Using `Free` we can evaluate servant clients step-by-step, and

@@ -155,7 +153,7 @@ and responses available for us to inspect, since `RunClient` only gives us

155access to one `Request` or `Response` at a time.

153access to one `Request` or `Response` at a time.

156

154

157On the other hand, a "batch collection" of requests and/or responses can be achieved

155On the other hand, a "batch collection" of requests and/or responses can be achieved

158−with both free clients and a custom `RunClient` instance rather easily, for example

156+with both free clients and a custom `RunClient` instance rather easily, for example

159by using a `Writer [(Request, Response)]` monad.

157by using a `Writer [(Request, Response)]` monad.

160

158

161Here is an example of running our small `test` against a running server:

159Here is an example of running our small `test` against a running server:

doc/cookbook/using-free-client/using-free-client.cabal+5−5

@@ -1,18 +1,18 @@

1+cabal-version: 2.2

1name: cookbook-using-free-client

2name: cookbook-using-free-client

2version: 0.1

3version: 0.1

3synopsis: Using Free client

4synopsis: Using Free client

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

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

5−license: BSD3

6+license: BSD-3-Clause

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

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

7author: Servant Contributors

8author: Servant Contributors

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

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

9build-type: Simple

10build-type: Simple

10−cabal-version: >=1.10

11−tested-with: GHC==7.8.4, GHC==7.10.3, GHC==8.0.2, GHC==8.2.2, GHC==8.4.3

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

12

13executable cookbook-using-free-client

14 main-is: UsingFreeClient.lhs

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

15+ build-depends: base >= 4.9 && <5

16 , free

17 , servant

18 , servant-client

doc/cookbook/uverb/UVerb.lhsnew file+223

@@ -0,0 +1,223 @@

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 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.cabalnew file+35

@@ -0,0 +1,35 @@

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+12−2

@@ -8,7 +8,7 @@

8

9- **[servant-examples](https://github.com/sras/servant-examples)**:

10

11− Similar to [the cookbook](https://haskell-servant.readthedocs.io/en/latest/cookbook/index.html) but

11+ Similar to [the cookbook](https://docs.servant.dev/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 in uses `haskell-servant`

40+ - a backend that uses `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,3 +48,13 @@

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− `haskell-servant.readthedocs.org <http://haskell-servant.readthedocs.org/>`_

6+ `docs.servant.dev <http://docs.servant.dev/>`_

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− ``#servant`` on freenode

15+ `#haskell-servant on libera.chat <https://web.libera.chat/#haskell-servant>`_

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− `haskell-servant.github.io <http://haskell-servant.github.io>`_

21+ `www.servant.dev <http://www.servant.dev>`_

22

23- the servant packages on hackage:

24

doc/requirements.txt+4−25

@@ -1,25 +1,4 @@

1−alabaster==0.7.7

2−argh==0.26.1

3−Babel==2.2.0

4−backports-abc==0.4

5−backports.ssl-match-hostname==3.5.0.1

6−certifi==2015.11.20.1

7−CommonMark==0.5.4

8−docutils==0.12

9−Jinja2==2.8

10−livereload==2.4.1

11−MarkupSafe==0.23

12−pathtools==0.1.2

13−Pygments==2.2.0

14−pytz==2015.7

15−PyYAML==3.11

16−recommonmark==0.4.0

1+recommonmark==0.5.0

17−singledispatch==3.4.0.3

18−six==1.10.0

19−snowballstemmer==1.2.1

20−Sphinx==1.3.6

2+Sphinx==1.8.4

21−sphinx-autobuild==0.5.2

3+sphinx_rtd_theme>=0.4.2

22−sphinx-rtd-theme==0.1.9

4+jinja2<3.1.0

23−tornado==4.3

24−watchdog==0.8.3

25−wheel==0.26.0

doc/tutorial/ApiType.lhs+42−9

@@ -129,16 +129,23 @@ type UserAPI4 = "users" :> Get '[JSON] [User]

129

130### `StreamGet` and `StreamPost`

131

132+*Note*: Streaming has changed considerably in `servant-0.15`.

133+

132The `StreamGet` and `StreamPost` combinators are defined in terms of the more general `Stream`

134The `StreamGet` and `StreamPost` combinators are defined in terms of the more general `Stream`

133

135

134``` haskell ignore

136``` haskell ignore

135−data Stream (method :: k1) (framing :: *) (contentType :: *) a

137+data Stream (method :: k1) (status :: Nat) (framing :: *) (contentType :: *) (a :: *)

136−type StreamGet = Stream 'GET

137−type StreamPost = Stream 'POST

138−```

139

138

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.

139+type StreamGet = Stream 'GET 200

140+type StreamPost = Stream 'POST 200

141+```

141

142

143+These describe endpoints that return a stream of values rather than just a

144+single value. They not only take a single content type as a parameter, but also

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.

142

149

143### `Capture`

150### `Capture`

144

151

@@ -170,13 +177,12 @@ type UserAPI5 = "user" :> Capture "userid" Integer :> Get '[JSON] User

170 -- except that we explicitly say that "userid"

177 -- except that we explicitly say that "userid"

171 -- must be an integer

178 -- must be an integer

172

179

173− :<|> "user" :> Capture "userid" Integer :> DeleteNoContent '[JSON] NoContent

180+ :<|> "user" :> Capture "userid" Integer :> DeleteNoContent

174 -- equivalent to 'DELETE /user/:userid'

181 -- equivalent to 'DELETE /user/:userid'

175```

182```

176

183

177−In the second case, `DeleteNoContent` specifies a 204 response code,

184+In the second case, `DeleteNoContent` specifies a 204 response code

178−`JSON` specifies the content types on which the handler will match,

179−and `NoContent` says that the response will always be empty.

185+and that the response will always be empty.

180

186

181### `QueryParam`, `QueryParams`, `QueryFlag`

187### `QueryParam`, `QueryParams`, `QueryFlag`

182

188

@@ -383,3 +389,30 @@ One example for this is if you want to serve a directory of static files along

383with the rest of your API. But you can plug in everything that is an

389with the rest of your API. But you can plug in everything that is an

384`Application`, e.g. a whole web application written in any of the web

390`Application`, e.g. a whole web application written in any of the web

385frameworks that support `wai`.

391frameworks 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+10−11

@@ -47,7 +47,6 @@ module Authentication where

47import Data.Aeson (ToJSON)

48import Data.ByteString (ByteString)

49import Data.Map (Map, fromList)

50−import Data.Monoid ((<>))

51import qualified Data.Map as Map

50import qualified Data.Map as Map

52import Data.Proxy (Proxy (Proxy))

51import Data.Proxy (Proxy (Proxy))

53import Data.Text (Text)

52import Data.Text (Text)

@@ -108,7 +107,7 @@ API with "private." Additionally, the private parts of our API use the

108realm for this authentication is `"foo-realm"`).

107realm for this authentication is `"foo-realm"`).

109

108

110Unfortunately we're not done. When someone makes a request to our `"private"`

109Unfortunately we're not done. When someone makes a request to our `"private"`

111−API, we're going to need to provide to servant the logic for validifying

110+API, we're going to need to provide to servant the logic for validating

112usernames and passwords. This adds a certain conceptual wrinkle in servant's

111usernames and passwords. This adds a certain conceptual wrinkle in servant's

113design that we'll briefly discuss. If you want the **TL;DR**: we supply a lookup

112design that we'll briefly discuss. If you want the **TL;DR**: we supply a lookup

114function to servant's new `Context` primitive.

113function to servant's new `Context` primitive.

@@ -133,7 +132,7 @@ combinator. Using `Context`, we can supply a function of type

133handler. This will allow the handler to check authentication and return a `User`

132handler. This will allow the handler to check authentication and return a `User`

134to downstream handlers if successful.

133to downstream handlers if successful.

135

134

136−In practice we wrap `BasicAuthData -> Handler` into a slightly

135+In practice we wrap `BasicAuthData -> Handler User` into a slightly

137different function to better capture the semantics of basic authentication:

136different function to better capture the semantics of basic authentication:

138

137

139``` haskell ignore

138``` haskell ignore

@@ -260,7 +259,7 @@ this.

260

259

261Let's implement a trivial authentication scheme. We will protect our API by

260Let's implement a trivial authentication scheme. We will protect our API by

262looking for a cookie named `"servant-auth-cookie"`. This cookie's value will

261looking for a cookie named `"servant-auth-cookie"`. This cookie's value will

263−contain a key from which we can lookup a `Account`.

262+contain a key from which we can lookup an `Account`.

264

263

265```haskell

264```haskell

266-- | An account type that we "fetch from the database" after

265-- | An account type that we "fetch from the database" after

@@ -274,7 +273,7 @@ database = fromList [ ("key1", Account "Anne Briggs")

274 , ("key3", Account "Ghédalia Tazartès")

273 , ("key3", Account "Ghédalia Tazartès")

275 ]

274 ]

276

275

277−-- | A method that, when given a password, will return a Account.

276+-- | A method that, when given a password, will return an Account.

278-- This is our bespoke (and bad) authentication logic.

277-- This is our bespoke (and bad) authentication logic.

279lookupAccount :: ByteString -> Handler Account

278lookupAccount :: ByteString -> Handler Account

280lookupAccount key = case Map.lookup key database of

279lookupAccount key = case Map.lookup key database of

@@ -318,7 +317,7 @@ genAuthAPI = Proxy

318

317

319Now we need to bring everything together for the server. We have the

318Now we need to bring everything together for the server. We have the

320`AuthHandler Request Account` value and an `AuthProtected` endpoint. To bind these

319`AuthHandler Request Account` value and an `AuthProtected` endpoint. To bind these

321−together, we need to provide a [Type Family](https://downloads.haskell.org/~ghc/latest/docs/html/users_guide/type-families.html)

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)

322instance that tells the `HasServer` instance that our `Context` will supply a

321instance that tells the `HasServer` instance that our `Context` will supply a

323`Account` (via `AuthHandler Request Account`) and that downstream combinators will

322`Account` (via `AuthHandler Request Account`) and that downstream combinators will

324have access to this `Account` value (or an error will be thrown if authentication

323have access to this `Account` value (or an error will be thrown if authentication

@@ -346,7 +345,7 @@ genAuthServerContext = authHandler :. EmptyContext

346

345

347-- | Our API, where we provide all the author-supplied handlers for each end

346-- | Our API, where we provide all the author-supplied handlers for each end

348-- point. Note that 'privateDataFunc' is a function that takes 'Account' as an

347-- point. Note that 'privateDataFunc' is a function that takes 'Account' as an

349−-- argument. We dont' worry about the authentication instrumentation here,

348+-- argument. We don't worry about the authentication instrumentation here,

350-- that is taken care of by supplying context

349-- that is taken care of by supplying context

351genAuthServer :: Server AuthGenAPI

350genAuthServer :: Server AuthGenAPI

352genAuthServer =

351genAuthServer =

@@ -368,10 +367,10 @@ genAuthMain = run 8080 (serveWithContext genAuthAPI genAuthServerContext genAuth

368$ curl -XGET localhost:8080/private

367$ curl -XGET localhost:8080/private

369Missing auth header

368Missing auth header

370

369

371−$ curl -XGET localhost:8080/private -H "servant-auth-cookie: key3"

370+$ curl -XGET localhost:8080/private -H "Cookie: servant-auth-cookie=key3"

372[{"ssshhh":"this is a secret: Ghédalia Tazartès"}]

371[{"ssshhh":"this is a secret: Ghédalia Tazartès"}]

373

372

374−$ curl -XGET localhost:8080/private -H "servant-auth-cookie: bad-key"

373+$ curl -XGET localhost:8080/private -H "Cookie: servant-auth-cookie=bad-key"

375Invalid Cookie

374Invalid Cookie

376

375

377$ curl -XGET localhost:8080/public

376$ curl -XGET localhost:8080/public

@@ -385,11 +384,11 @@ Creating a generalized, ad-hoc authentication scheme was fairly straight

385forward:

384forward:

386

385

3871. use the `AuthProtect` combinator to protect your API.

3861. use the `AuthProtect` combinator to protect your API.

388−2. choose a application-specific data type used by your server when

387+2. choose an application-specific data type used by your server when

389authentication is successful (in our case this was `Account`).

388authentication is successful (in our case this was `Account`).

3903. Create a value of `AuthHandler Request Account` which encapsulates the

3893. Create a value of `AuthHandler Request Account` which encapsulates the

391authentication logic (`Request -> Handler Account`). This function

390authentication logic (`Request -> Handler Account`). This function

392−will be executed everytime a request matches a protected route.

391+will be executed every time a request matches a protected route.

3934. Provide an instance of the `AuthServerData` type family, specifying your

3924. Provide an instance of the `AuthServerData` type family, specifying your

394application-specific data type returned when authentication is successful (in

393application-specific data type returned when authentication is successful (in

395our case this was `Account`).

394our 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.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.

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.

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

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.

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,6 +20,9 @@ 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

23```

26```

24

27

25Also, we need examples for some domain specific data types:

28Also, we need examples for some domain specific data types:

@@ -158,7 +161,7 @@ The types of the arguments for the functions are the same as for (server-side) r

158## Changing the monad the client functions live in

161## Changing the monad the client functions live in

159

162

160Just like `hoistServer` allows us to change the monad in which request handlers

163Just like `hoistServer` allows us to change the monad in which request handlers

161−of a web application live in, we also have `hoistClient` for changing the monad

164+of a web application live, we also have `hoistClient` for changing the monad

162in which _client functions_ live. Consider the following trivial API:

165in which _client functions_ live. Consider the following trivial API:

163

166

164``` haskell

167``` haskell

@@ -170,7 +173,7 @@ hoistClientAPI = Proxy

170

173

171We already know how to derive client functions for this API, and as we have

174We already know how to derive client functions for this API, and as we have

172seen above they all return results in the `ClientM` monad when using `servant-client`.

175seen above they all return results in the `ClientM` monad when using `servant-client`.

173−However, `ClientM` rarely (or never) is the actual monad we need to use the client

176+However, `ClientM` is rarely (or never) the actual monad we need to use the client

174functions in. Sometimes we need to run them in IO, sometimes in a custom monad

177functions in. Sometimes we need to run them in IO, sometimes in a custom monad

175stack. `hoistClient` is a very simple solution to the problem of "changing" the monad

178stack. `hoistClient` is a very simple solution to the problem of "changing" the monad

176the clients run in.

179the clients run in.

@@ -217,41 +220,38 @@ getClients clientEnv

217Consider the following streaming API type:

220Consider the following streaming API type:

218

221

219``` haskell

222``` haskell

220−type StreamAPI = "positionStream" :> StreamGet NewlineFraming JSON (ResultStream Position)

223+type StreamAPI = "positionStream" :> StreamGet NewlineFraming JSON (SourceIO Position)

221```

224```

222

225

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:

226+Note that we use the same `SourceIO` type as on the server-side

224−

227+(this is different from `servant-0.14`).

225−``` haskell ignore

228+However, we have to use different client, `Servant.Client.Streaming`,

226−type StreamAPI f = "positionStream" :> StreamGet NewlineFraming JSON (f Position)

229+which can stream (but has different API).

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 :: ClientM (ResultStream Position)

237+posStream :: S.ClientM (SourceIO Position)

238−

239−posStream = client streamAPI

238+posStream = S.client streamAPI

240```

239```

241

240

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

242−And here's how to just print out all elements from a `ResultStream`, to give some idea of how to work with them.

244+all elements from a `SourceIO`, to give some idea of how to work with them.

243

245

244``` haskell

246``` haskell

245−printResultStream :: Show a => ResultStream a -> IO ()

247+printSourceIO :: Show a => ClientEnv -> S.ClientM (SourceIO a) -> IO ()

246−printResultStream (ResultStream k) = k $ \getResult ->

248+printSourceIO env c = S.withClientM c env $ \e -> case e of

247− let loop = do

249+ Left err -> putStrLn $ "Error: " ++ show err

248− r <- getResult

250+ Right rs -> foreach fail print rs

249− case r of

250− Nothing -> return ()

251− Just x -> print x >> loop

252− in loop

253```

251```

254

252

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.

253+The stream is parsed and provided incrementally. So the above loop prints out

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− -- mutliple examples to display this time

80+ -- multiple 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 down in markdown, by looking at `markdown apiDocs`.

111+That lets us see what our API docs look like 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 want to send the request body (to let you redefine it)

231+ -- | name used when a user wants 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 mean local var)

237+ -- | namespace on which we define the js function (empty means 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+55−41

@@ -29,7 +29,7 @@ import Prelude.Compat

29

30import Control.Monad.Except

31import Control.Monad.Reader

32−import Data.Aeson.Compat

32+import Data.Aeson

33import Data.Aeson.Types

34import Data.Attoparsec.ByteString

35import Data.ByteString (ByteString)

@@ -46,6 +46,7 @@ import Servant

46import System.Directory

47import Text.Blaze

48import Text.Blaze.Html.Renderer.Utf8

49+import Servant.Types.SourceT (source)

49import qualified Data.Aeson.Parser

50import qualified Data.Aeson.Parser

50import qualified Text.Blaze.Html

51import qualified Text.Blaze.Html

51```

52```

@@ -182,7 +183,7 @@ users2 = [isaac, albert]

182

183

183Now, just like we separate the various endpoints in `UserAPI` with `:<|>`, we

184Now, just like we separate the various endpoints in `UserAPI` with `:<|>`, we

184are going to separate the handlers with `:<|>` too! They must be provided in

185are going to separate the handlers with `:<|>` too! They must be provided in

185−the same order as in in the API type.

186+the same order as in the API type.

186

187

187``` haskell

188``` haskell

188server2 :: Server UserAPI2

189server2 :: Server UserAPI2

@@ -312,8 +313,8 @@ For reference, here's a list of some combinators from **servant**:

312## The `FromHttpApiData`/`ToHttpApiData` classes

313## The `FromHttpApiData`/`ToHttpApiData` classes

313

314

314Wait... How does **servant** know how to decode the `Int`s from the URL? Or how

315Wait... How does **servant** know how to decode the `Int`s from the URL? Or how

315−to decode a `ClientInfo` value from the request body? This is what this and the

316+to decode a `ClientInfo` value from the request body? The following three sections will

316−following two sections address.

317+help us answer these questions.

317

318

318`Capture`s and `QueryParam`s are represented by some textual value in URLs.

319`Capture`s and `QueryParam`s are represented by some textual value in URLs.

319`Header`s are similarly represented by a pair of a header name and a

320`Header`s are similarly represented by a pair of a header name and a

@@ -598,7 +599,7 @@ $ curl -H 'Accept: text/html' http://localhost:8081/persons

598

599

599## The `Handler` monad

600## The `Handler` monad

600

601

601−At the heart of the handlers is the monad they run in, namely a newtype `Handler` around `ExceptT ServantErr IO`

602+At the heart of the handlers is the monad they run in, namely a newtype `Handler` around `ExceptT ServerError IO`

602([haddock documentation for `ExceptT`](http://hackage.haskell.org/package/mtl-2.2.1/docs/Control-Monad-Except.html#t:ExceptT)).

603([haddock documentation for `ExceptT`](http://hackage.haskell.org/package/mtl-2.2.1/docs/Control-Monad-Except.html#t:ExceptT)).

603One might wonder: why this monad? The answer is that it is the

604One might wonder: why this monad? The answer is that it is the

604simplest monad with the following properties:

605simplest monad with the following properties:

@@ -616,12 +617,12 @@ newtype ExceptT e m a = ExceptT (m (Either e a))

616```

617```

617

618

618In short, this means that a handler of type `Handler a` is simply

619In short, this means that a handler of type `Handler a` is simply

619−equivalent to a computation of type `IO (Either ServantErr a)`, that is, an IO

620+equivalent to a computation of type `IO (Either ServerError a)`, that is, an IO

620action that either returns an error or a result.

621action that either returns an error or a result.

621

622

622−The module [`Control.Monad.Except`](https://hackage.haskell.org/package/mtl-2.2.1/docs/Control-Monad-Except.html#t:ExceptT)

623+The module [`Control.Monad.Except`](https://hackage.haskell.org/package/mtl/docs/Control-Monad-Except.html#t:ExceptT)

623from which `ExceptT` comes is worth looking at.

624from which `ExceptT` comes is worth looking at.

624−Perhaps most importantly, `ExceptT` and `Handler` are an instances of `MonadError`, so

625+Perhaps most importantly, `ExceptT` and `Handler` are instances of `MonadError`, so

625`throwError` can be used to return an error from your handler (whereas `return`

626`throwError` can be used to return an error from your handler (whereas `return`

626 is enough to return a success).

627 is enough to return a success).

627

628

@@ -631,9 +632,9 @@ kind and abort early. The next two sections cover how to do just that.

631

632

632### Performing IO

633### Performing IO

633

634

634−Another important instances from the list above are `MonadIO m => MonadIO

635+Other important instances from the list above are `MonadIO m => MonadIO

635−(ExceptT e m)`, and therefore also `MonadIO Handler` as there is `MonadIO IO` instance..

636+(ExceptT e m)`, and therefore also `MonadIO Handler` as there is a `MonadIO IO` instance.

636−[`MonadIO`](http://hackage.haskell.org/package/transformers-0.4.3.0/docs/Control-Monad-IO-Class.html)

637+[`MonadIO`](http://hackage.haskell.org/package/base/docs/Control-Monad-IO-Class.html#t:MonadIO)

637is a class from the **transformers** package defined as:

638is a class from the **transformers** package defined as:

638

639

639``` haskell ignore

640``` haskell ignore

@@ -659,16 +660,16 @@ server5 = do

659 return (FileContent filecontent)

660 return (FileContent filecontent)

660```

661```

661

662

662−### Failing, through `ServantErr`

663+### Failing, through `ServerError`

663

664

664If you want to explicitly fail at providing the result promised by an endpoint

665If you want to explicitly fail at providing the result promised by an endpoint

665using the appropriate HTTP status code (not found, unauthorized, etc) and some

666using the appropriate HTTP status code (not found, unauthorized, etc) and some

666error message, all you have to do is use the `throwError` function mentioned above

667error message, all you have to do is use the `throwError` function mentioned above

667−and provide it with the appropriate value of type `ServantErr`, which is

668+and provide it with the appropriate value of type `ServerError`, which is

668defined as:

669defined as:

669

670

670``` haskell ignore

671``` haskell ignore

671−data ServantErr = ServantErr

672+data ServerError = ServerError

672 { errHTTPCode :: Int

673 { errHTTPCode :: Int

673 , errReasonPhrase :: String

674 , errReasonPhrase :: String

674 , errBody :: ByteString -- lazy bytestring

675 , errBody :: ByteString -- lazy bytestring

@@ -684,7 +685,7 @@ use record update syntax:

684failingHandler :: Handler ()

685failingHandler :: Handler ()

685failingHandler = throwError myerr

686failingHandler = throwError myerr

686

687

687− where myerr :: ServantErr

688+ where myerr :: ServerError

688 myerr = err503 { errBody = "Sorry dear user." }

689 myerr = err503 { errBody = "Sorry dear user." }

689```

690```

690

691

@@ -715,7 +716,7 @@ $ curl --verbose http://localhost:8081/myfile.txt

715>

716>

716< HTTP/1.1 404 Not Found

717< HTTP/1.1 404 Not Found

717[snip]

718[snip]

718−myfile.txt just isnt there, please leave this server alone.

719+myfile.txt just isn't there, please leave this server alone.

719

720

720$ echo Hello > myfile.txt

721$ echo Hello > myfile.txt

721

722

@@ -817,7 +818,7 @@ If it doesn't exist, the handler will fail with a `404` status code.

817

818

818`serveDirectoryWebApp` uses some standard settings that fit the use case of

819`serveDirectoryWebApp` uses some standard settings that fit the use case of

819serving static files for most web apps. You can find out about the other

820serving static files for most web apps. You can find out about the other

820−options in the documentation of the `Servant.Utils.StaticFiles` module.

821+options in the documentation of the `Servant.Server.StaticFiles` module.

821

822

822## Nested APIs

823## Nested APIs

823

824

@@ -829,7 +830,7 @@ type UserAPI3 = -- view the user with given userid, in JSON

829 Capture "userid" Int :> Get '[JSON] User

830 Capture "userid" Int :> Get '[JSON] User

830

831

831 :<|> -- delete the user with given userid. empty response

832 :<|> -- delete the user with given userid. empty response

832− Capture "userid" Int :> DeleteNoContent '[JSON] NoContent

833+ Capture "userid" Int :> DeleteNoContent

833```

834```

834

835

835We can instead factor out the `userid`:

836We can instead factor out the `userid`:

@@ -837,7 +838,7 @@ We can instead factor out the `userid`:

837``` haskell

838``` haskell

838type UserAPI4 = Capture "userid" Int :>

839type UserAPI4 = Capture "userid" Int :>

839 ( Get '[JSON] User

840 ( Get '[JSON] User

840− :<|> DeleteNoContent '[JSON] NoContent

841+ :<|> DeleteNoContent

841 )

842 )

842```

843```

843

844

@@ -895,13 +896,13 @@ type API1 = "users" :>

895-- we factor out the Request Body

896-- we factor out the Request Body

896type API2 = ReqBody '[JSON] User :>

897type API2 = ReqBody '[JSON] User :>

897 ( Get '[JSON] User -- just display the same user back, don't register it

898 ( Get '[JSON] User -- just display the same user back, don't register it

898− :<|> PostNoContent '[JSON] NoContent -- register the user. empty response

899+ :<|> PostNoContent -- register the user. empty response

899 )

900 )

900

901

901-- we factor out a Header

902-- we factor out a Header

902type API3 = Header "Authorization" Token :>

903type API3 = Header "Authorization" Token :>

903 ( Get '[JSON] SecretData -- get some secret data, if authorized

904 ( Get '[JSON] SecretData -- get some secret data, if authorized

904− :<|> ReqBody '[JSON] SecretData :> PostNoContent '[JSON] NoContent -- add some secret data, if authorized

905+ :<|> ReqBody '[JSON] SecretData :> PostNoContent -- add some secret data, if authorized

905 )

906 )

906

907

907newtype Token = Token ByteString

908newtype Token = Token ByteString

@@ -914,11 +915,11 @@ API type only at the end.

914``` haskell

915``` haskell

915type UsersAPI =

916type UsersAPI =

916 Get '[JSON] [User] -- list users

917 Get '[JSON] [User] -- list users

917− :<|> ReqBody '[JSON] User :> PostNoContent '[JSON] NoContent -- add a user

918+ :<|> ReqBody '[JSON] User :> PostNoContent -- add a user

918 :<|> Capture "userid" Int :>

919 :<|> Capture "userid" Int :>

919 ( Get '[JSON] User -- view a user

920 ( Get '[JSON] User -- view a user

920− :<|> ReqBody '[JSON] User :> PutNoContent '[JSON] NoContent -- update a user

921+ :<|> ReqBody '[JSON] User :> PutNoContent -- update a user

921− :<|> DeleteNoContent '[JSON] NoContent -- delete a user

922+ :<|> DeleteNoContent -- delete a user

922 )

923 )

923

924

924usersServer :: Server UsersAPI

925usersServer :: Server UsersAPI

@@ -947,11 +948,11 @@ usersServer = getUsers :<|> newUser :<|> userOperations

947``` haskell

948``` haskell

948type ProductsAPI =

949type ProductsAPI =

949 Get '[JSON] [Product] -- list products

950 Get '[JSON] [Product] -- list products

950− :<|> ReqBody '[JSON] Product :> PostNoContent '[JSON] NoContent -- add a product

951+ :<|> ReqBody '[JSON] Product :> PostNoContent -- add a product

951 :<|> Capture "productid" Int :>

952 :<|> Capture "productid" Int :>

952 ( Get '[JSON] Product -- view a product

953 ( Get '[JSON] Product -- view a product

953− :<|> ReqBody '[JSON] Product :> PutNoContent '[JSON] NoContent -- update a product

954+ :<|> ReqBody '[JSON] Product :> PutNoContent -- update a product

954− :<|> DeleteNoContent '[JSON] NoContent -- delete a product

955+ :<|> DeleteNoContent -- delete a product

955 )

956 )

956

957

957data Product = Product { productId :: Int }

958data Product = Product { productId :: Int }

@@ -995,11 +996,11 @@ abstract that away:

995-- indexed by values of type 'i'

996-- indexed by values of type 'i'

996type APIFor a i =

997type APIFor a i =

997 Get '[JSON] [a] -- list 'a's

998 Get '[JSON] [a] -- list 'a's

998− :<|> ReqBody '[JSON] a :> PostNoContent '[JSON] NoContent -- add an 'a'

999+ :<|> ReqBody '[JSON] a :> PostNoContent -- add an 'a'

999 :<|> Capture "id" i :>

1000 :<|> Capture "id" i :>

1000 ( Get '[JSON] a -- view an 'a' given its "identifier" of type 'i'

1001 ( Get '[JSON] a -- view an 'a' given its "identifier" of type 'i'

1001− :<|> ReqBody '[JSON] a :> PutNoContent '[JSON] NoContent -- update an 'a'

1002+ :<|> ReqBody '[JSON] a :> PutNoContent -- update an 'a'

1002− :<|> DeleteNoContent '[JSON] NoContent -- delete an 'a'

1003+ :<|> DeleteNoContent -- delete an 'a'

1003 )

1004 )

1004

1005

1005-- Build the appropriate 'Server'

1006-- Build the appropriate 'Server'

@@ -1127,14 +1128,14 @@ This is the webservice in action:

1127``` bash

1128``` bash

1128$ curl http://localhost:8081/a

1129$ curl http://localhost:8081/a

11291797

11301797

1130−$ curl http://localhost:8081/b

1131+$ curl http://localhost:8081/b -X GET -d '42.0' -H 'Content-Type: application/json'

1131−"hi"

1132+true

1132```

1133```

1133

1134

1134### An arrow is a reader too.

1135### An arrow is a reader too.

1135

1136

1136In previous versions of `servant` we had an `enter` to do what `hoistServer`

1137In previous versions of `servant` we had an `enter` to do what `hoistServer`

1137−does now. `enter` had a ambitious design goals, but was problematic in practice.

1138+does now. `enter` had an ambitious design goals, but was problematic in practice.

1138

1139

1139One problematic situation was when the source monad was `(->) r`, yet it's

1140One problematic situation was when the source monad was `(->) r`, yet it's

1140handy in practice, because `(->) r` is isomorphic to `Reader r`.

1141handy in practice, because `(->) r` is isomorphic to `Reader r`.

@@ -1160,24 +1161,37 @@ app5 = serve readerAPI (hoistServer readerAPI funToHandler funServerT)

1160

1161

1161## Streaming endpoints

1162## Streaming endpoints

1162

1163

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.

1164+We can create endpoints that don't just give back a single result, but give

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.

1164

1174

1165``` haskell

1175``` haskell

1166−type StreamAPI = "userStream" :> StreamGet NewlineFraming JSON (StreamGenerator User)

1176+type StreamAPI = "userStream" :> StreamGet NewlineFraming JSON (SourceIO User)

1167streamAPI :: Proxy StreamAPI

1177streamAPI :: Proxy StreamAPI

1168streamAPI = Proxy

1178streamAPI = Proxy

1169

1179

1170−streamUsers :: StreamGenerator User

1180+streamUsers :: SourceIO User

1171−streamUsers = StreamGenerator $ \sendFirst sendRest -> do

1181+streamUsers = source [isaac, albert, albert]

1172− sendFirst isaac

1173− sendRest albert

1174− sendRest albert

1175

1182

1176app6 :: Application

1183app6 :: Application

1177app6 = serve streamAPI (return streamUsers)

1184app6 = serve streamAPI (return streamUsers)

1178```

1185```

1179

1186

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.

1187+This simple application returns a stream of `User` values encoded in JSON

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.

1181

1195

1182## Conclusion

1196## Conclusion

1183

1197

doc/tutorial/index.rst+1−20

@@ -6,29 +6,10 @@ 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−

29.. toctree::

9.. toctree::

30 :maxdepth: 1

10 :maxdepth: 1

31

11

12+ install.rst

32 ApiType.lhs

13 ApiType.lhs

33 Server.lhs

14 Server.lhs

34 Client.lhs

15 Client.lhs

doc/tutorial/install.rstnew file+68

@@ -0,0 +1,68 @@

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+11−1

@@ -1 +1,11 @@

1−{-# OPTIONS_GHC -F -pgmF hspec-discover #-}

1+module Main where

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

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

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+11−18

@@ -1,23 +1,20 @@

1+cabal-version: 2.2

1name: tutorial

2name: tutorial

2version: 0.10

3version: 0.10

3synopsis: The servant tutorial

4synopsis: The servant tutorial

4description:

5description:

5 The servant tutorial can be found at

6 The servant tutorial can be found at

6− <http://haskell-servant.readthedocs.org/>

7+ <http://docs.servant.dev/>

7−homepage: http://haskell-servant.readthedocs.org/

8+homepage: http://docs.servant.dev/

8category: Servant, Documentation

9category: Servant, Documentation

9−license: BSD3

10+license: BSD-3-Clause

10license-file: LICENSE

11license-file: LICENSE

11author: Servant Contributors

12author: Servant Contributors

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

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

13build-type: Simple

14build-type: Simple

14−cabal-version: >=1.10

15tested-with:

16− GHC==7.8.4

16+ GHC==8.6.5

17− GHC==7.10.3

17+ GHC==8.8.3, GHC ==8.10.7

18− GHC==8.0.2

19− GHC==8.2.2

20− GHC==8.4.3

21extra-source-files:

18extra-source-files:

22 static/index.html

19 static/index.html

23 static/ui.js

20 static/ui.js

@@ -35,9 +32,8 @@ library

35 -- Packages `servant` depends on.

32 -- Packages `servant` depends on.

36 -- We don't need to specify bounds here as this package is never released.

33 -- We don't need to specify bounds here as this package is never released.

37 build-depends:

34 build-depends:

38− base >= 4.7 && <4.12

35+ base >= 4.7 && <5

39 , aeson

36 , aeson

40− , aeson-compat

41 , attoparsec

37 , attoparsec

42 , base-compat

38 , base-compat

43 , bytestring

39 , bytestring

@@ -67,12 +63,11 @@ library

67 blaze-html >= 0.9.0.1 && < 0.10

63 blaze-html >= 0.9.0.1 && < 0.10

68 , blaze-markup >= 0.8.0.0 && < 0.9

64 , blaze-markup >= 0.8.0.0 && < 0.9

69 , cookie >= 0.4.3 && < 0.5

65 , cookie >= 0.4.3 && < 0.5

70− , js-jquery >= 3.2.1 && < 3.3

66+ , js-jquery >= 3.3.1 && < 3.4

71− , lucid >= 2.9.9 && < 2.10

67+ , lucid >= 2.9.11 && < 2.12

72− , mtl-compat >= 0.2.1 && < 0.3

73− , random >= 1.1 && < 1.2

68+ , random >= 1.1 && < 1.3

74 , servant-js >= 0.9 && < 0.10

69 , servant-js >= 0.9 && < 0.10

75− , time >= 1.4.2 && < 1.9

70+ , time >= 1.6.0.1 && < 1.13

76

71

77 -- For legacy tools, we need to specify build-depends too

72 -- For legacy tools, we need to specify build-depends too

78 build-depends: markdown-unlit >= 0.5.0 && <0.6

73 build-depends: markdown-unlit >= 0.5.0 && <0.6

@@ -85,8 +80,6 @@ test-suite spec

85 hs-source-dirs: test

80 hs-source-dirs: test

86 main-is: Spec.hs

81 main-is: Spec.hs

87 other-modules: JavascriptSpec

82 other-modules: JavascriptSpec

88− build-tool-depends:

89− hspec-discover:hspec-discover

90 build-depends: base

83 build-depends: base

91 , tutorial

84 , tutorial

92 , hspec

85 , hspec

ghcjs.nixnew file+22

@@ -0,0 +1,22 @@

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,3 +21,21 @@ 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.jsonnew file+4

@@ -0,0 +1,4 @@

1+{

2+ "rev" : "05f0934825c2a0750d4888c4735f9420c906b388",

3+ "sha256" : "1g8c2w0661qn89ajp44znmwfmghbbiygvdzq0rzlvlpdiz28v6gy"

4+}

nix/nixpkgs.nixnew file+4

@@ -0,0 +1,4 @@

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+17−18

@@ -1,21 +1,20 @@

1−{ pkgs ? import <nixpkgs> {}

2−, compiler ? "ghc822"

1+{ compiler ? "ghc8104"

3, tutorial ? false

2, tutorial ? false

3+, pkgs ? import ./nixpkgs.nix

4}:

5+

6+ with pkgs;

5

7

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−

13−stdenv.mkDerivation {

12+ stdenv.mkDerivation {

14− name = "servant-dev";

13+ name = "servant-dev";

15− buildInputs = [ ghc zlib python3 wget ]

14+ buildInputs = [ ghc zlib python3 wget cabal-install postgresql openssl stack haskellPackages.hspec-discover ]

16− ++ (if tutorial then [docstuffs postgresql] else []);

15+ ++ (if tutorial then [docstuffs postgresql] else []);

17− shellHook = ''

16+ shellHook = ''

18− eval $(grep export ${ghc}/bin/ghc)

17+ eval $(grep export ${ghc}/bin/ghc)

19− export LD_LIBRARY_PATH="${zlib}/lib";

18+ export LD_LIBRARY_PATH=$LD_LIBRARY_PATH:"${zlib}/lib";

20− '';

19+ '';

21−}

20+ }

servant-auth/README.mdnew file+1

@@ -0,0 +1 @@

1+servant-auth-server/README.lhs

servant-auth/servant-auth-client/.ghcinew file+1

@@ -0,0 +1 @@

1+:set -isrc -itest -idoctest/ghci-wrapper/src

servant-auth/servant-auth-client/CHANGELOG.mdnew file+26

@@ -0,0 +1,26 @@

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/LICENSEnew file+31

@@ -0,0 +1,31 @@

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.hsnew file+2

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

1+import Distribution.Simple

2+main = defaultMain

servant-auth/servant-auth-client/servant-auth-client.cabalnew file+80

@@ -0,0 +1,80 @@

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

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.10 && < 0.11

78+ other-modules:

79+ Servant.Auth.ClientSpec

80+ default-language: Haskell2010

servant-auth/servant-auth-client/src/Servant/Auth/Client.hsnew file+3

@@ -0,0 +1,3 @@

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.hsnew file+64

@@ -0,0 +1,64 @@

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.hsnew file+161

@@ -0,0 +1,161 @@

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.hsnew file+1

@@ -0,0 +1 @@

1+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}

servant-auth/servant-auth-docs/.ghcinew file+1

@@ -0,0 +1 @@

1+:set -isrc -itest -idoctest/ghci-wrapper/src

servant-auth/servant-auth-docs/CHANGELOG.mdnew file+14

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

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/LICENSEnew file+31