master..bd9e4b1 · servant

.github/workflows/master.yml+62−51

since splitsnapshots

unifiedsplit

@@ -13,14 +13,12 @@ jobs:

13 strategy:

14 matrix:

15 os: [ubuntu-latest]

16− cabal: ["3.6"]

16+ cabal: ["3.4"]

17 ghc:

18 - "8.6.5"

19 - "8.8.4"

20 - "8.10.7"

21− - "9.0.2"

21+ - "9.0.1"

22− - "9.2.2"

23− - "9.4.2"

24

22

25 steps:

23 steps:

26 - uses: actions/checkout@v2

24 - uses: actions/checkout@v2

@@ -49,7 +47,10 @@ jobs:

49

47

50 - name: Configure

48 - name: Configure

51 run: |

49 run: |

50+ # Using separate store-dir because default one already has 'ghc-paths' package installed

51+ # with hardcoded path to ghcup's GHC path (which it was built with). This leads to failure in

52+ # doctest, as it tries to invoke that GHC, and it doesn't exist here.

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

53+ cabal --store-dir /tmp/cabal-store install --ignore-project -j2 doctest --constraint='doctest ^>=0.18'

53

54

54 - name: Build

55 - name: Build

55 run: |

56 run: |

@@ -60,56 +61,66 @@ jobs:

60 cabal test all

61 cabal test all

61

62

62 - name: Run doctests

63 - name: Run doctests

64+ # doctests are broken on GHC 9 due to compiler bug:

65+ # https://gitlab.haskell.org/ghc/ghc/-/issues/19460

66+ continue-on-error: ${{ matrix.ghc == '9.0.1' }}

63 run: |

67 run: |

64 # Necessary for doctest to be found in $PATH

68 # Necessary for doctest to be found in $PATH

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

69 export PATH="$HOME/.cabal/bin:$PATH"

66

70

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

71+ # Filter out base-compat-batteries from .ghc.environment.*, as its modules

72+ # conflict with those of base-compat.

73+ #

74+ # FIXME: This is an ugly hack. Ultimately, we'll want to use cabal-doctest

75+ # (or cabal v2-doctest, if it ever lands) to provide a clean GHC environment.

76+ # This might allow running doctests in GHCJS build as well.

77+ perl -i -e 'while (<ARGV>) { print unless /package-id\s+(base-compat-batteries)-\d+(\.\d+)*/; }' .ghc.environment.*

78+

68− (cd servant && eval $DOCTEST)

79+ (cd servant && doctest src)

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

80+ (cd servant-client && doctest src)

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

81+ (cd servant-client-core && doctest src)

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

82+ (cd servant-http-streams && doctest src)

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

83+ (cd servant-docs && doctest src)

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

84+ (cd servant-foreign && doctest src)

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

85+ (cd servant-server && doctest src)

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

86+ (cd servant-machines && doctest src)

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

87+ (cd servant-conduit && doctest src)

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

88+ (cd servant-pipes && doctest src)

78−

89+

79− # stack:

90+ stack:

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

91+ name: stack / ghc ${{ matrix.ghc }}

81− # runs-on: ubuntu-latest

92+ runs-on: ubuntu-latest

82− # strategy:

93+ strategy:

83− # matrix:

94+ matrix:

84− # stack: ["2.7.5"]

95+ stack: ["2.7.3"]

85− # ghc: ["8.10.7"]

96+ ghc: ["8.10.4"]

86−

97+

87− # steps:

98+ steps:

88− # - uses: actions/checkout@v2

99+ - uses: actions/checkout@v2

89−

100+

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

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

91− # name: Setup Haskell Stack

102+ name: Setup Haskell Stack

92− # with:

103+ with:

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

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

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

105+ stack-version: ${{ matrix.stack }}

95−

106+

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

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

97− # name: Cache ~/.stack

108+ name: Cache ~/.stack

98− # with:

109+ with:

99− # path: ~/.stack

110+ path: ~/.stack

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

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

101−

112+

102− # - name: Install dependencies

113+ - name: Install dependencies

103− # run: |

114+ run: |

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

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

105−

116+

106− # - name: Build

117+ - name: Build

107− # run: |

118+ run: |

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

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

109−

120+

110− # - name: Test

121+ - name: Test

111− # run: |

122+ run: |

112− # stack test --system-ghc

123+ stack test --system-ghc

113

124

114 ghcjs:

125 ghcjs:

115 name: ubuntu-latest / ghcjs 8.6

126 name: ubuntu-latest / ghcjs 8.6

.gitignore−1

@@ -31,7 +31,6 @@ doc/venv

31doc/tutorial/static/api.js

32doc/tutorial/static/jq.js

33shell.nix

34−.hspec-failures

35

34

36# nix

35# nix

37result*

36result*

CONTRIBUTING.md+2−4

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

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

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

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

82−know about it! Either hop on

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

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

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

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

85−read it).

86

84

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

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

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

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

cabal.project+24−3

@@ -12,7 +12,6 @@ packages:

12 servant-docs/

13 servant-foreign/

14 servant-server/

15− servant-swagger/

16 doc/tutorial/

15 doc/tutorial/

17

16

18-- servant streaming

17-- servant streaming

@@ -37,7 +36,7 @@ packages:

37 doc/cookbook/generic

36 doc/cookbook/generic

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

37 doc/cookbook/hoist-server-with-context

39 doc/cookbook/https

38 doc/cookbook/https

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

39+ -- doc/cookbook/jwt-and-basic-auth/

41 doc/cookbook/pagination

40 doc/cookbook/pagination

42 -- doc/cookbook/sentry

41 -- doc/cookbook/sentry

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

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

@@ -47,8 +46,30 @@ packages:

47 doc/cookbook/using-custom-monad

46 doc/cookbook/using-custom-monad

48 doc/cookbook/using-free-client

47 doc/cookbook/using-free-client

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

48 -- doc/cookbook/open-id-connect

50− doc/cookbook/managed-resource

51

49

52tests: True

50tests: True

53optimization: False

51optimization: False

54-- reorder-goals: True

52-- reorder-goals: True

53+

54+constraints:

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

56+ foundation >=0.0.14,

57+ memory <0.14.12 || >0.14.12

58+

59+constraints: base-compat ^>=0.11

60+constraints: semigroups ^>=0.19

61+

62+-- allow-newer: sqlite-simple-0.4.16.0:semigroups

63+-- allow-newer: direct-sqlite-2.3.24:semigroups

64+

65+-- needed for doctests

66+write-ghc-environment-files: always

67+

68+-- https://github.com/chordify/haskell-servant-pagination/pull/12

69+allow-newer: servant-pagination-2.2.2:servant

70+allow-newer: servant-pagination-2.2.2:servant-server

71+

72+allow-newer: servant-js:servant

73+

74+-- ghc 9

75+allow-newer: tdigest:base

changelog.d/1469deleted−11

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

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

2−prs: #1469

3−description: {

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

5−`clientWithRoute` definitions.

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

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

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

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

10−the `Verb` status.

11−}

changelog.d/1477deleted−9

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

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

2−prs: #1477

3−

4−description: {

5−

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

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

8−

9−}

changelog.d/1529deleted−10

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

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

2−prs: #1529

3−

4−description: {

5−

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

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

8−functionality to match what servant-client provides.

9−

10−}

changelog.d/1556deleted−81

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

1−synopsis: Display capture hints in router layout

2−prs: #1556

3−

4−description: {

5−

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

7−

8−Example:

9−

10−For the following API

11−```haskell

12−type API =

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

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

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

16−```

17−

18−we previously got the following output:

19−

20−```

21−/

22−├─ a/

23−│ ├─ d/

24−│ │ └─•

25−│ └─ e/

26−│ └─•

27−└─ b/

28− └─ <capture>/

29− ├─•

30− ┆

31− └─•

32−```

33−

34−now we get:

35−

36−```

37−/

38−├─ a/

39−│ ├─ d/

40−│ │ └─•

41−│ └─ e/

42−│ └─•

43−└─ b/

44− └─ <x::Int>/

45− ├─•

46− ┆

47− └─•

48−```

49−

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

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

52−

53−N.B.:

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

55−

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

57−

58−Warning:

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

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

61−

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

63−```haskell

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

65−

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

67−myServer = const $ return ()

68−

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

70−myApi = Proxy

71−

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

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

74−```

75−

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

77−```haskell

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

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

80−```

81−}

changelog.d/1569deleted−13

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

1−synopsis: Encode captures using toEncodedUrlPiece

2−prs: #1569

3−issues: #1511

4−

5−description: {

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

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

8−URL-encoding however they need.

9−

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

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

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

13−}

changelog.d/1571deleted−10

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

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/1573deleted−2

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

1−synopsis: Add API docs for ServerT

2−prs: #1573

changelog.d/1580deleted−12

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

1−synopsis: Allow IO in validationKeys

2−prs: #1580

3−issues: #1579

4−

5−description: {

6−

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

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

9−discover new and expired keys.

10−

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

12−}

changelog.d/1589deleted−2

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

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

2−prs: 1589

changelog.d/1595deleted−2

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

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

2−prs: #1595

changelog.d/1606deleted−10

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

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/1638deleted−2

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

1−synopsis: Add Functor instance to AuthHandler.

2−prs: #1638

changelog.d/1649deleted−8

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

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

doc/Makefile+1−1

@@ -10,7 +10,7 @@ BUILDDIR = _build

10

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

12help:

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

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

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

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

16

doc/conf.py+2−1

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

46

47# General information about the project.

48project = u'Servant'

49−copyright = u'2022, Servant Contributors'

49+copyright = u'2018, Servant Contributors'

50author = u'Servant Contributors'

51

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

@@ -169,3 +169,4 @@ texinfo_documents = [

169source_parsers = {

170 '.lhs': CommonMarkParser,

171}

172+

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

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

1−cabal-version: 2.2

2name: cookbook-basic-auth

1name: cookbook-basic-auth

3version: 0.1

2version: 0.1

4synopsis: Basic Authentication cookbook example

3synopsis: Basic Authentication cookbook example

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

4homepage: http://docs.servant.dev/

6−license: BSD-3-Clause

5+license: BSD3

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

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

8author: Servant Contributors

7author: Servant Contributors

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

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

10build-type: Simple

9build-type: Simple

10+cabal-version: >=1.10

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

12

13executable cookbook-basic-auth

doc/cookbook/basic-streaming/basic-streaming.cabal+2−2

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

1−cabal-version: 2.2

2name: cookbook-basic-streaming

1name: cookbook-basic-streaming

3version: 2.1

2version: 2.1

4synopsis: Streaming in servant without streaming libs

3synopsis: Streaming in servant without streaming libs

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

4homepage: http://docs.servant.dev/

6−license: BSD-3-Clause

5+license: BSD3

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

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

8author: Servant Contributors

7author: Servant Contributors

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

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

10build-type: Simple

9build-type: Simple

10+cabal-version: >=1.10

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

12

13executable cookbook-basic-streaming

doc/cookbook/curl-mock/curl-mock.cabal+2−5

@@ -1,19 +1,16 @@

1−cabal-version: 2.2

2name: cookbook-curl-mock

1name: cookbook-curl-mock

3version: 0.1

2version: 0.1

4synopsis: Generate curl mock requests cookbook example

3synopsis: Generate curl mock requests cookbook example

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

4homepage: http://docs.servant.dev

6−license: BSD-3-Clause

5+license: BSD3

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

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

8author: Servant Contributors

7author: Servant Contributors

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

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

10build-type: Simple

9build-type: Simple

10+cabal-version: >=1.10

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

12

13executable cookbock-curl-mock

14− if impl(ghc >= 9.2)

15− -- generic-arbitrary is incompatible

16− buildable: False

17 main-is: CurlMock.lhs

14 main-is: CurlMock.lhs

18 build-depends: base == 4.*

15 build-depends: base == 4.*

19 , aeson

16 , aeson

doc/cookbook/custom-errors/custom-errors.cabal+2−2

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

1−cabal-version: 2.2

2name: cookbook-custom-errors

1name: cookbook-custom-errors

3version: 0.1

2version: 0.1

4synopsis: Return custom error messages from combinators

3synopsis: Return custom error messages from combinators

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

4homepage: http://docs.servant.dev

6−license: BSD-3-Clause

5+license: BSD3

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

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

8author: Servant Contributors

7author: Servant Contributors

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

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

10build-type: Simple

9build-type: Simple

10+cabal-version: >=1.10

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

12

13executable cookbook-custom-errors

doc/cookbook/db-mysql-basics/mysql-basics.cabal+2−2

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

1−cabal-version: 2.2

2name: mysql-basics

1name: mysql-basics

3version: 0.1.0.0

2version: 0.1.0.0

4synopsis: Simple MySQL API cookbook example

3synopsis: Simple MySQL API cookbook example

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

4homepage: http://docs.servant.dev/

6−license: BSD-3-Clause

5+license: BSD3

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

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

8author: Servant Contributors

7author: Servant Contributors

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

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

10build-type: Simple

9build-type: Simple

10+cabal-version: >=1.10

11

12executable run

13 hs-source-dirs: .

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

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

1−cabal-version: 2.2

2name: cookbook-db-postgres-pool

1name: cookbook-db-postgres-pool

3version: 0.1

2version: 0.1

4synopsis: Simple PostgreSQL connection pool cookbook example

3synopsis: Simple PostgreSQL connection pool cookbook example

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

4homepage: http://docs.servant.dev/

6−license: BSD-3-Clause

5+license: BSD3

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

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

8author: Servant Contributors

7author: Servant Contributors

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

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

10build-type: Simple

9build-type: Simple

10+cabal-version: >=1.10

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

12

13executable cookbook-db-postgres-pool

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

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

1−cabal-version: 2.2

2name: cookbook-db-sqlite-simple

1name: cookbook-db-sqlite-simple

3version: 0.1

2version: 0.1

4synopsis: Simple SQLite DB cookbook example

3synopsis: Simple SQLite DB cookbook example

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

4homepage: http://docs.servant.dev/

6−license: BSD-3-Clause

5+license: BSD3

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

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

8author: Servant Contributors

7author: Servant Contributors

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

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

10build-type: Simple

9build-type: Simple

10+cabal-version: >=1.10

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

12

13executable cookbook-db-sqlite-simple

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

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

1−cabal-version: 2.2

2name: cookbook-file-upload

1name: cookbook-file-upload

3version: 0.1

2version: 0.1

4synopsis: File upload cookbook example

3synopsis: File upload cookbook example

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

4homepage: http://docs.servant.dev/

6−license: BSD-3-Clause

5+license: BSD3

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

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

8author: Servant Contributors

7author: Servant Contributors

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

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

10build-type: Simple

9build-type: Simple

10+cabal-version: >=1.10

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

12

13executable cookbook-file-upload

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

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

1−cabal-version: 2.2

2name: cookbook-generic

1name: cookbook-generic

3version: 0.1

2version: 0.1

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

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

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

4homepage: http://docs.servant.dev/

6−license: BSD-3-Clause

5+license: BSD3

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

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

8author: Servant Contributors

7author: Servant Contributors

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

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

10build-type: Simple

9build-type: Simple

10+cabal-version: >=1.10

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

12

13executable cookbook-using-custom-monad

doc/cookbook/hoist-server-with-context/hoist-server-with-context.cabal+2−2

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

1−cabal-version: 2.2

2name: cookbook-hoist-server-with-context

1name: cookbook-hoist-server-with-context

3version: 0.0.1

2version: 0.0.1

4synopsis: JWT and basic access authentication with a Custom Monad cookbook example

3synopsis: JWT and basic access authentication with a Custom Monad cookbook example

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

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

6 authentication.

5 authentication.

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

6homepage: http://docs.servant.dev/

8−license: BSD-3-Clause

7+license: BSD3

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

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

10author: Servant Contributors

9author: Servant Contributors

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

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

12category: Servant

11category: Servant

13build-type: Simple

12build-type: Simple

13+cabal-version: >=1.10

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

15

16executable cookbook-hoist-server-with-context

doc/cookbook/https/https.cabal+2−2

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

1−cabal-version: 2.2

2name: cookbook-https

1name: cookbook-https

3version: 0.1

2version: 0.1

4synopsis: HTTPS cookbook example

3synopsis: HTTPS cookbook example

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

4homepage: http://docs.servant.dev/

6−license: BSD-3-Clause

5+license: BSD3

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

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

8author: Servant Contributors

7author: Servant Contributors

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

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

10build-type: Simple

9build-type: Simple

10+cabal-version: >=1.10

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

12

13executable cookbook-https

doc/cookbook/index.rst+2−3

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

6interested in contributing examples of your own, feel free

7to open an issue or a pull request on

8`our github repository <https://github.com/haskell-servant/servant>`_

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

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

10−on libera.chat <https://web.libera.chat/#haskell-servant>_ or on

10+on freenode or on

11`the mailing list <https://groups.google.com/forum/#!forum/haskell-servant>`_.

12

13The scope is very wide. Simple and fancy authentication schemes,

@@ -37,4 +37,3 @@ you name it!

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

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

1−cabal-version: 2.2

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

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

3version: 0.0.1

2version: 0.0.1

4synopsis: JWT and basic access authentication cookbook example

3synopsis: JWT and basic access authentication cookbook example

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

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

6 authentication.

5 authentication.

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

6homepage: http://docs.servant.dev/

8−license: BSD-3-Clause

7+license: BSD3

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

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

10author: Servant Contributors

9author: Servant Contributors

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

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

12category: Servant

11category: Servant

13build-type: Simple

12build-type: Simple

13+cabal-version: >=1.10

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

15

16executable cookbook-jwt-and-basic-auth

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

22 , servant

23 , servant-client

24 , servant-server

25− , servant-auth == 0.4.*

25+ , servant-auth ==0.3.*

26 , servant-auth-server >= 0.3.1.0

27 , warp >= 3.2

28 , wai >= 3.2

doc/cookbook/managed-resource/ManagedResource.lhsdeleted−114

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

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

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

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.cabal+2−2

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

1−cabal-version: 2.2

2name: open-id-connect

1name: open-id-connect

3version: 0.1

2version: 0.1

4synopsis: OpenId Connect with Servant example

3synopsis: OpenId Connect with Servant example

5homepage: http://haskell-servant.readthedocs.org/

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

6−license: BSD-3-Clause

5+license: BSD3

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

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

8author: Servant Contributors

7author: Servant Contributors

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

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

10build-type: Simple

9build-type: Simple

10+cabal-version: >= 1.10

11tested-with: GHC==8.6.5

12

13executable cookbook-openidconnect

doc/cookbook/open-id-connect/OpenIdConnect.lhs+1−1

@@ -330,7 +330,7 @@ data Customer = Customer {

330```

331

332Here is the code that displays the homepage.

333−It should contain a link to the `/login` URL.

333+It should contain a link to the the `/login` URL.

334When the user clicks on this link it will be redirected to Google login page

335with some generated information.

336

doc/cookbook/pagination/pagination.cabal+2−2

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

1−cabal-version: 2.2

2name: cookbook-pagination

1name: cookbook-pagination

3version: 2.1

2version: 2.1

4synopsis: Pagination with Servant example

3synopsis: Pagination with Servant example

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

4homepage: http://docs.servant.dev/

6−license: BSD-3-Clause

5+license: BSD3

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

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

8author: Servant Contributors

7author: Servant Contributors

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

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

10build-type: Simple

9build-type: Simple

10+cabal-version: >=1.10

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

12

13executable cookbook-pagination

doc/cookbook/sentry/sentry.cabal+2−2

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

1−cabal-version: 2.2

2name: cookbook-sentry

1name: cookbook-sentry

3version: 0.1

2version: 0.1

4synopsis: Collecting runtime exceptions using Sentry

3synopsis: Collecting runtime exceptions using Sentry

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

4homepage: http://docs.servant.dev/

6−license: BSD-3-Clause

5+license: BSD3

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

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

8author: Servant Contributors

7author: Servant Contributors

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

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

10build-type: Simple

9build-type: Simple

10+cabal-version: >=1.10

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

12

13executable cookbook-sentry

doc/cookbook/structuring-apis/structuring-apis.cabal+2−2

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

1−cabal-version: 2.2

2name: cookbook-structuring-apis

1name: cookbook-structuring-apis

3version: 0.1

2version: 0.1

4synopsis: Example that shows how APIs can be structured

3synopsis: Example that shows how APIs can be structured

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

4homepage: http://docs.servant.dev/

6−license: BSD-3-Clause

5+license: BSD3

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

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

8author: Servant Contributors

7author: Servant Contributors

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

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

10build-type: Simple

9build-type: Simple

10+cabal-version: >=1.10

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

12

13executable cookbook-structuring-apis

doc/cookbook/testing/testing.cabal+2−2

@@ -1,15 +1,15 @@

1−cabal-version: 2.2

2name: cookbook-testing

1name: cookbook-testing

3version: 0.0.1

2version: 0.0.1

4synopsis: Common testing patterns in Servant apps

3synopsis: Common testing patterns in Servant apps

5description: This recipe includes various strategies for writing tests for Servant.

4description: This recipe includes various strategies for writing tests for Servant.

6homepage: http://docs.servant.dev/

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

7−license: BSD-3-Clause

6+license: BSD3

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

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

9author: Servant Contributors

8author: Servant Contributors

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

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

11category: Servant

10category: Servant

12build-type: Simple

11build-type: Simple

12+cabal-version: >=1.10

13tested-with: GHC==8.6.5, GHC==8.8.3, GHC ==8.10.7

14

15executable cookbook-testing

doc/cookbook/using-custom-monad/using-custom-monad.cabal+2−2

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

1−cabal-version: 2.2

2name: cookbook-using-custom-monad

1name: cookbook-using-custom-monad

3version: 0.1

2version: 0.1

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

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

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

4homepage: http://docs.servant.dev/

6−license: BSD-3-Clause

5+license: BSD3

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

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

8author: Servant Contributors

7author: Servant Contributors

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

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

10build-type: Simple

9build-type: Simple

10+cabal-version: >=1.10

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

12

13executable cookbook-using-custom-monad

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

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

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

120

121```haskell

122− req' <- I.defaultMakeClientRequest burl req

122+ let req' = I.defaultMakeClientRequest burl req

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

124```

125

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

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

1−cabal-version: 2.2

2name: cookbook-using-free-client

1name: cookbook-using-free-client

3version: 0.1

2version: 0.1

4synopsis: Using Free client

3synopsis: Using Free client

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

4homepage: http://docs.servant.dev/

6−license: BSD-3-Clause

5+license: BSD3

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

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

8author: Servant Contributors

7author: Servant Contributors

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

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

10build-type: Simple

9build-type: Simple

10+cabal-version: >=1.10

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

12

13executable cookbook-using-free-client

doc/cookbook/uverb/UVerb.lhs+1−1

@@ -199,7 +199,7 @@ parsers in the hope that the ones that should will always error out so

199you 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

202+another shot at at the problem. It is inspired by

203servant-checked-exceptions, so it may be worth taking a closer look.

204The README claims that

205[cardano-sl](https://github.com/input-output-hk/cardano-sl) also has

doc/cookbook/uverb/uverb.cabal+2−2

@@ -1,15 +1,15 @@

1−cabal-version: 2.2

2name: cookbook-uverb

1name: cookbook-uverb

3version: 0.0.1

2version: 0.0.1

4synopsis: How to use the 'UVerb' type.

3synopsis: How to use the 'UVerb' type.

5description: Listing alternative responses and exceptions in your API types.

4description: Listing alternative responses and exceptions in your API types.

6homepage: http://docs.servant.dev/

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

7−license: BSD-3-Clause

6+license: BSD3

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

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

9author: Servant Contributors

8author: Servant Contributors

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

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

11category: Servant

10category: Servant

12build-type: Simple

11build-type: Simple

12+cabal-version: >=1.10

13tested-with: GHC==8.6.5, GHC==8.8.4, GHC==8.10.7

14

15executable cookbook-uverb

doc/links.rst+1−1

@@ -12,7 +12,7 @@ Helpful Links

12 `https://github.com/haskell-servant/servant/issues <https://github.com/haskell-servant/servant/issues>`_

13

14- the irc channel:

15− `#haskell-servant on libera.chat <https://web.libera.chat/#haskell-servant>`_

15+ ``#servant`` on freenode

16

17- the mailing list:

18 `groups.google.com/forum/#!forum/haskell-servant <https://groups.google.com/forum/#!forum/haskell-servant>`_

doc/requirements.txt−1

@@ -1,4 +1,3 @@

1recommonmark==0.5.0

2Sphinx==1.8.4

3sphinx_rtd_theme>=0.4.2

4−jinja2<3.1.0

doc/tutorial/install.rst−26

@@ -40,29 +40,3 @@ nix

40`Nix <https://nixos.org/nix/>`_ users should feel free to take a look at

41the `nix/shell.nix` file in the repository and use it to provision a suitable

42environment 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/tutorial.cabal+3−3

@@ -1,4 +1,3 @@

1−cabal-version: 2.2

2name: tutorial

1name: tutorial

3version: 0.10

2version: 0.10

4synopsis: The servant tutorial

3synopsis: The servant tutorial

@@ -7,11 +6,12 @@ description:

7 <http://docs.servant.dev/>

6 <http://docs.servant.dev/>

8homepage: http://docs.servant.dev/

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

9category: Servant, Documentation

8category: Servant, Documentation

10−license: BSD-3-Clause

9+license: BSD3

11license-file: LICENSE

10license-file: LICENSE

12author: Servant Contributors

11author: Servant Contributors

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

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

14build-type: Simple

13build-type: Simple

14+cabal-version: >=1.10

15tested-with:

16 GHC==8.6.5

17 GHC==8.8.3, GHC ==8.10.7

@@ -64,7 +64,7 @@ library

64 , blaze-markup >= 0.8.0.0 && < 0.9

65 , cookie >= 0.4.3 && < 0.5

66 , js-jquery >= 3.3.1 && < 3.4

67− , lucid >= 2.9.11 && < 2.12

67+ , lucid >= 2.9.11 && < 2.10

68 , random >= 1.1 && < 1.3

69 , servant-js >= 0.9 && < 0.10

70 , time >= 1.6.0.1 && < 1.13

servant-auth/servant-auth-client/servant-auth-client.cabal+16−14

@@ -1,4 +1,3 @@

1−cabal-version: 2.2

2name: servant-auth-client

1name: servant-auth-client

3version: 0.4.1.0

2version: 0.4.1.0

4synopsis: servant-client/servant-auth compatibility

3synopsis: servant-client/servant-auth compatibility

@@ -7,17 +6,18 @@ description: This package provides instances that allow generating clients fr

7 APIs that use

6 APIs that use

8 <https://hackage.haskell.org/package/servant-auth servant-auth's> @Auth@ combinator.

7 <https://hackage.haskell.org/package/servant-auth servant-auth's> @Auth@ combinator.

9 .

8 .

10− For a quick overview of the usage, see the <https://github.com/haskell-servant/servant/tree/master/servant-auth#readme README>.

9+ For a quick overview of the usage, see the <http://github.com/haskell-servant/servant/servant-auth#readme README>.

11category: Web, Servant, Authentication

10category: Web, Servant, Authentication

12−homepage: https://github.com/haskell-servant/servant/tree/master/servant-auth#readme

11+homepage: http://github.com/haskell-servant/servant/servant-auth#readme

13bug-reports: https://github.com/haskell-servant/servant/issues

12bug-reports: https://github.com/haskell-servant/servant/issues

14author: Julian K. Arni

13author: Julian K. Arni

15maintainer: jkarni@gmail.com

14maintainer: jkarni@gmail.com

16copyright: (c) Julian K. Arni

15copyright: (c) Julian K. Arni

17−license: BSD-3-Clause

16+license: BSD3

18license-file: LICENSE

17license-file: LICENSE

19tested-with: GHC ==8.6.5 || ==8.8.4 || ==8.10.4 || ==9.0.1

18tested-with: GHC ==8.6.5 || ==8.8.4 || ==8.10.4 || ==9.0.1

20build-type: Simple

19build-type: Simple

20+cabal-version: >= 1.10

21extra-source-files:

22 CHANGELOG.md

23

@@ -31,12 +31,12 @@ library

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

34+ base >= 4.10 && < 4.16

35− , bytestring >= 0.10.6.0 && < 0.12

35+ , bytestring >= 0.10.6.0 && < 0.11

36 , containers >= 0.5.6.2 && < 0.7

37 , servant-auth == 0.4.*

38− , servant >= 0.13 && < 0.20

38+ , servant >= 0.13 && < 0.19

39− , servant-client-core >= 0.13 && < 0.20

39+ , servant-client-core >= 0.13 && < 0.19

40

41 exposed-modules:

42 Servant.Auth.Client

@@ -50,7 +50,7 @@ test-suite spec

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

53+ build-tool-depends: hspec-discover:hspec-discover >=2.5.5 && <2.9

54

55 -- dependencies with bounds inherited from the library stanza

56 build-depends:

@@ -59,22 +59,24 @@ test-suite spec

59 , servant-auth

60 , servant

61 , servant-auth-client

62+ if impl(ghc >= 9)

63+ buildable: False

62

64

63 -- test dependencies

65 -- test dependencies

64 build-depends:

66 build-depends:

65− hspec >= 2.5.5 && < 2.10

67+ hspec >= 2.5.5 && < 2.9

66 , QuickCheck >= 2.11.3 && < 2.15

68 , QuickCheck >= 2.11.3 && < 2.15

67− , aeson >= 1.3.1.1 && < 3

69+ , aeson >= 1.3.1.1 && < 1.6

68− , bytestring >= 0.10.6.0 && < 0.12

70+ , bytestring >= 0.10.6.0 && < 0.11

69 , http-client >= 0.5.13.1 && < 0.8

71 , http-client >= 0.5.13.1 && < 0.8

70 , http-types >= 0.12.2 && < 0.13

72 , http-types >= 0.12.2 && < 0.13

71 , servant-auth-server >= 0.4.2.0 && < 0.5

73 , servant-auth-server >= 0.4.2.0 && < 0.5

72− , servant-server >= 0.13 && < 0.20

74+ , servant-server >= 0.13 && < 0.19

73 , time >= 1.5.0.1 && < 1.13

75 , time >= 1.5.0.1 && < 1.13

74 , transformers >= 0.4.2.0 && < 0.6

76 , transformers >= 0.4.2.0 && < 0.6

75 , wai >= 3.2.1.2 && < 3.3

77 , wai >= 3.2.1.2 && < 3.3

76 , warp >= 3.2.25 && < 3.4

78 , warp >= 3.2.25 && < 3.4

77− , jose >= 0.10 && < 0.11

79+ , jose >= 0.7.0.0 && < 0.9

78 other-modules:

80 other-modules:

79 Servant.Auth.ClientSpec

81 Servant.Auth.ClientSpec

80 default-language: Haskell2010

82 default-language: Haskell2010

servant-auth/servant-auth-docs/servant-auth-docs.cabal+11−11

@@ -1,4 +1,3 @@

1−cabal-version: 2.2

2name: servant-auth-docs

1name: servant-auth-docs

3version: 0.2.10.0

2version: 0.2.10.0

4synopsis: servant-docs/servant-auth compatibility

3synopsis: servant-docs/servant-auth compatibility

@@ -7,17 +6,18 @@ description: This package provides instances that allow generating docs from

7 APIs that use

6 APIs that use

8 <https://hackage.haskell.org/package/servant-auth servant-auth's> @Auth@ combinator.

7 <https://hackage.haskell.org/package/servant-auth servant-auth's> @Auth@ combinator.

9 .

8 .

10− For a quick overview of the usage, see the <https://github.com/haskell-servant/servant/tree/master/servant-auth#readme README>.

9+ For a quick overview of the usage, see the <http://github.com/haskell-servant/servant/servant-auth#readme README>.

11category: Web, Servant, Authentication

10category: Web, Servant, Authentication

12−homepage: https://github.com/haskell-servant/servant/tree/master/servant-auth#readme

11+homepage: http://github.com/haskell-servant/servant/servant-auth#readme

13bug-reports: https://github.com/haskell-servant/servant/issues

12bug-reports: https://github.com/haskell-servant/servant/issues

14author: Julian K. Arni

13author: Julian K. Arni

15maintainer: jkarni@gmail.com

14maintainer: jkarni@gmail.com

16copyright: (c) Julian K. Arni

15copyright: (c) Julian K. Arni

17−license: BSD-3-Clause

16+license: BSD3

18license-file: LICENSE

17license-file: LICENSE

19tested-with: GHC ==8.6.5 || ==8.8.4 || ==8.10.4 || ==9.0.1

18tested-with: GHC ==8.6.5 || ==8.8.4 || ==8.10.4 || ==9.0.1

20build-type: Custom

19build-type: Custom

20+cabal-version: >= 1.10

21extra-source-files:

22 CHANGELOG.md

23

@@ -35,11 +35,11 @@ library

35 default-extensions: ConstraintKinds DataKinds DefaultSignatures DeriveFoldable DeriveFunctor DeriveGeneric DeriveTraversable FlexibleContexts FlexibleInstances FunctionalDependencies GADTs KindSignatures MultiParamTypeClasses OverloadedStrings RankNTypes ScopedTypeVariables TypeFamilies TypeOperators

36 ghc-options: -Wall

37 build-depends:

38− base >= 4.10 && < 4.18

38+ base >= 4.10 && < 4.16

39− , servant-docs >= 0.11.2 && < 0.13

39+ , servant-docs >= 0.11.2 && < 0.12

40− , servant >= 0.13 && < 0.20

40+ , servant >= 0.13 && < 0.19

41 , servant-auth == 0.4.*

42− , lens >= 4.16.1 && <5.3

42+ , lens >= 4.16.1 && <5.1

43 exposed-modules:

44 Servant.Auth.Docs

45 default-language: Haskell2010

@@ -50,7 +50,7 @@ test-suite doctests

50 build-depends:

51 base,

52 servant-auth-docs,

53− doctest >= 0.16 && < 0.21,

53+ doctest >= 0.16 && < 0.19,

54 QuickCheck >= 2.11.3 && < 2.15,

55 template-haskell

56 ghc-options: -Wall -threaded

@@ -64,7 +64,7 @@ test-suite spec

64 test

65 default-extensions: ConstraintKinds DataKinds DefaultSignatures DeriveFoldable DeriveFunctor DeriveGeneric DeriveTraversable FlexibleContexts FlexibleInstances FunctionalDependencies GADTs KindSignatures MultiParamTypeClasses OverloadedStrings RankNTypes ScopedTypeVariables TypeFamilies TypeOperators

66 ghc-options: -Wall

67− build-tool-depends: hspec-discover:hspec-discover >=2.5.5 && <2.10

67+ build-tool-depends: hspec-discover:hspec-discover >=2.5.5 && <2.9

68

69 -- dependencies with bounds inherited from the library stanza

70 build-depends:

@@ -78,7 +78,7 @@ test-suite spec

78 -- test dependencies

79 build-depends:

80 servant-auth-docs

81− , hspec >= 2.5.5 && < 2.10

81+ , hspec >= 2.5.5 && < 2.9

82 , QuickCheck >= 2.11.3 && < 2.15

83

84 default-language: Haskell2010

servant-auth/servant-auth-server/servant-auth-server.cabal+24−28

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

1−cabal-version: 2.2

2name: servant-auth-server

1name: servant-auth-server

3−version: 0.4.7.0

2+version: 0.4.6.0

4synopsis: servant-server/servant-auth compatibility

3synopsis: servant-server/servant-auth compatibility

5description: This package provides the required instances for using the @Auth@ combinator

4description: This package provides the required instances for using the @Auth@ combinator

6 in your 'servant' server.

5 in your 'servant' server.

7 .

6 .

8 Both cookie- and token- (REST API) based authentication is provided.

7 Both cookie- and token- (REST API) based authentication is provided.

9 .

8 .

10− For a quick overview of the usage, see the <https://github.com/haskell-servant/servant/tree/master/servant-auth#readme README>.

9+ For a quick overview of the usage, see the <http://github.com/haskell-servant/servant/servant-auth#readme README>.

11category: Web, Servant, Authentication

10category: Web, Servant, Authentication

12−homepage: https://github.com/haskell-servant/servant/tree/master/servant-auth#readme

11+homepage: http://github.com/haskell-servant/servant/servant-auth#readme

13bug-reports: https://github.com/haskell-servant/servant/issues

12bug-reports: https://github.com/haskell-servant/servant/issues

14author: Julian K. Arni

13author: Julian K. Arni

15maintainer: jkarni@gmail.com

14maintainer: jkarni@gmail.com

16copyright: (c) Julian K. Arni

15copyright: (c) Julian K. Arni

17−license: BSD-3-Clause

16+license: BSD3

18license-file: LICENSE

17license-file: LICENSE

19tested-with: GHC ==8.6.5 || ==8.8.4 || ==8.10.4 || ==9.0.1

18tested-with: GHC ==8.6.5 || ==8.8.4 || ==8.10.4 || ==9.0.1

20build-type: Simple

19build-type: Simple

20+cabal-version: >= 1.10

21extra-source-files:

22 CHANGELOG.md

23

@@ -31,37 +31,30 @@ library

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

34+ base >= 4.10 && < 4.16

35− , aeson >= 1.0.0.1 && < 3

35+ , aeson >= 1.3.1.1 && < 1.6

36− , base64-bytestring >= 1.0.0.1 && < 2

36+ , base64-bytestring >= 1.0.0.1 && < 1.2

37 , blaze-builder >= 0.4.1.0 && < 0.5

38− , bytestring >= 0.10.6.0 && < 0.12

38+ , bytestring >= 0.10.6.0 && < 0.11

39 , case-insensitive >= 1.2.0.11 && < 1.3

40 , cookie >= 0.4.4 && < 0.5

41 , data-default-class >= 0.1.2.0 && < 0.2

42 , entropy >= 0.4.1.3 && < 0.5

43 , http-types >= 0.12.2 && < 0.13

44− , jose >= 0.10 && < 0.11

44+ , jose >= 0.7.0.0 && < 0.9

45− , lens >= 4.16.1 && < 5.3

45+ , lens >= 4.16.1 && < 5.1

46− , memory >= 0.14.16 && < 0.19

46+ , memory >= 0.14.16 && < 0.17

47 , monad-time >= 0.3.1.0 && < 0.4

48− , mtl ^>= 2.2.2 || ^>= 2.3.1

48+ , mtl >= 2.2.2 && < 2.3

49− , servant >= 0.13 && < 0.20

49+ , servant >= 0.13 && < 0.19

50 , servant-auth == 0.4.*

51− , servant-server >= 0.13 && < 0.20

51+ , servant-server >= 0.13 && < 0.19

52 , tagged >= 0.8.4 && < 0.9

53− , text >= 1.2.3.0 && < 2.1

53+ , text >= 1.2.3.0 && < 1.3

54− , time >= 1.5.0.1 && < 1.13

54+ , time >= 1.5.0.1 && < 1.10

55 , unordered-containers >= 0.2.9.0 && < 0.3

56 , wai >= 3.2.1.2 && < 3.3

57

58− if impl(ghc >= 9)

59− build-depends:

60− -- base64-bytestring 1.2.1.0 contains important fix for GHC-9, lower versions

61− -- produce wrong results, thus corrupring JWT via jose package.

62− -- See: https://github.com/haskell/base64-bytestring/pull/46

63− base64-bytestring >= 1.2.1.0

64−

65 exposed-modules:

58 exposed-modules:

66 Servant.Auth.Server

59 Servant.Auth.Server

67 Servant.Auth.Server.Internal

60 Servant.Auth.Server.Internal

@@ -94,6 +87,8 @@ test-suite readme

94 default-language: Haskell2010

87 default-language: Haskell2010

95 if impl(ghcjs)

88 if impl(ghcjs)

96 buildable: False

89 buildable: False

90+ if impl(ghc >= 9)

91+ buildable: False

97

92

98test-suite spec

93test-suite spec

99 type: exitcode-stdio-1.0

94 type: exitcode-stdio-1.0

@@ -102,7 +97,7 @@ test-suite spec

102 test

97 test

103 default-extensions: ConstraintKinds DataKinds DefaultSignatures DeriveFoldable DeriveFunctor DeriveGeneric DeriveTraversable FlexibleContexts FlexibleInstances FunctionalDependencies GADTs KindSignatures MultiParamTypeClasses OverloadedStrings RankNTypes ScopedTypeVariables TypeFamilies TypeOperators

98 default-extensions: ConstraintKinds DataKinds DefaultSignatures DeriveFoldable DeriveFunctor DeriveGeneric DeriveTraversable FlexibleContexts FlexibleInstances FunctionalDependencies GADTs KindSignatures MultiParamTypeClasses OverloadedStrings RankNTypes ScopedTypeVariables TypeFamilies TypeOperators

104 ghc-options: -Wall

99 ghc-options: -Wall

105− build-tool-depends: hspec-discover:hspec-discover >=2.5.5 && <2.10

100+ build-tool-depends: hspec-discover:hspec-discover >=2.5.5 && <2.8

106

101

107 -- dependencies with bounds inherited from the library stanza

102 -- dependencies with bounds inherited from the library stanza

108 build-depends:

103 build-depends:

@@ -119,17 +114,18 @@ test-suite spec

119 , servant

114 , servant

120 , servant-server

115 , servant-server

121 , transformers

116 , transformers

117+ if impl(ghc >= 9)

118+ buildable: False

122

119

123 -- test dependencies

120 -- test dependencies

124 build-depends:

121 build-depends:

125 servant-auth-server

122 servant-auth-server

126− , hspec >= 2.5.5 && < 2.10

123+ , hspec >= 2.5.5 && < 2.8

127 , QuickCheck >= 2.11.3 && < 2.15

124 , QuickCheck >= 2.11.3 && < 2.15

128 , http-client >= 0.5.13.1 && < 0.8

125 , http-client >= 0.5.13.1 && < 0.8

129− , lens-aeson >= 1.0.2 && < 1.3

126+ , lens-aeson >= 1.0.2 && < 1.2

130 , warp >= 3.2.25 && < 3.4

127 , warp >= 3.2.25 && < 3.4

131 , wreq >= 0.5.2.1 && < 0.6

128 , wreq >= 0.5.2.1 && < 0.6

132− , text >= 1.2.3.0 && < 2.1

133 other-modules:

129 other-modules:

134 Servant.Auth.ServerSpec

130 Servant.Auth.ServerSpec

135 default-language: Haskell2010

131 default-language: Haskell2010

servant-auth/servant-auth-server/src/Servant/Auth/Server/Internal.hs+9−6

@@ -54,12 +54,15 @@ instance ( n ~ 'S ('S 'Z)

54

55 makeCookies :: AuthResult v -> IO (SetCookieList ('S ('S 'Z)))

56 makeCookies authResult = do

57+ xsrf <- makeXsrfCookie cookieSettings

58+ fmap (Just xsrf `SetCookieCons`) $

57− case authResult of

59+ case authResult of

58− (Authenticated v) -> do

60+ (Authenticated v) -> do

59− ejwt <- makeSessionCookie cookieSettings jwtSettings v

61+ ejwt <- makeSessionCookie cookieSettings jwtSettings v

60− xsrf <- makeXsrfCookie cookieSettings

62+ case ejwt of

63+ Nothing -> return $ Nothing `SetCookieCons` SetCookieNil

61− return $ Just xsrf `SetCookieCons` (ejwt `SetCookieCons` SetCookieNil)

64+ Just jwt -> return $ Just jwt `SetCookieCons` SetCookieNil

62− _ -> return $ Nothing `SetCookieCons` (Nothing `SetCookieCons` SetCookieNil)

65+ _ -> return $ Nothing `SetCookieCons` SetCookieNil

63

66

64 go :: (AuthResult v -> ServerT api Handler)

67 go :: (AuthResult v -> ServerT api Handler)

65 -> (AuthResult v, SetCookieList n)

68 -> (AuthResult v, SetCookieList n)

servant-auth/servant-auth-server/src/Servant/Auth/Server/Internal/AddSetCookie.hs+1−26

@@ -11,9 +11,6 @@ import Data.Tagged (Tagged (..))

11import qualified Network.HTTP.Types as HTTP

12import Network.Wai (mapResponseHeaders)

13import Servant

14−import Servant.API.UVerb.Union

15−import Servant.API.Generic

16−import Servant.Server.Generic

17import Web.Cookie

14import Web.Cookie

18

15

19-- What are we doing here? Well, the idea is to add headers to the response,

16-- What are we doing here? Well, the idea is to add headers to the response,

@@ -34,24 +31,11 @@ type family AddSetCookieApiVerb a where

34 AddSetCookieApiVerb (Headers ls a) = Headers (Header "Set-Cookie" SetCookie ': ls) a

31 AddSetCookieApiVerb (Headers ls a) = Headers (Header "Set-Cookie" SetCookie ': ls) a

35 AddSetCookieApiVerb a = Headers '[Header "Set-Cookie" SetCookie] a

32 AddSetCookieApiVerb a = Headers '[Header "Set-Cookie" SetCookie] a

36

33

37−#if MIN_VERSION_servant_server(0,18,1)

38−type family MapAddSetCookieApiVerb (as :: [*]) where

39− MapAddSetCookieApiVerb '[] = '[]

40− MapAddSetCookieApiVerb (a ': as) = (AddSetCookieApiVerb a ': MapAddSetCookieApiVerb as)

41−#endif

42−

43type family AddSetCookieApi a :: *

34type family AddSetCookieApi a :: *

44type instance AddSetCookieApi (a :> b) = a :> AddSetCookieApi b

35type instance AddSetCookieApi (a :> b) = a :> AddSetCookieApi b

45type instance AddSetCookieApi (a :<|> b) = AddSetCookieApi a :<|> AddSetCookieApi b

36type instance AddSetCookieApi (a :<|> b) = AddSetCookieApi a :<|> AddSetCookieApi b

46−#if MIN_VERSION_servant_server(0,19,0)

47−type instance AddSetCookieApi (NamedRoutes api) = AddSetCookieApi (ToServantApi api)

48−#endif

49type instance AddSetCookieApi (Verb method stat ctyps a)

37type instance AddSetCookieApi (Verb method stat ctyps a)

50 = Verb method stat ctyps (AddSetCookieApiVerb a)

38 = Verb method stat ctyps (AddSetCookieApiVerb a)

51−#if MIN_VERSION_servant_server(0,18,1)

52−type instance AddSetCookieApi (UVerb method ctyps as)

53− = UVerb method ctyps (MapAddSetCookieApiVerb as)

54−#endif

55type instance AddSetCookieApi Raw = Raw

39type instance AddSetCookieApi Raw = Raw

56#if MIN_VERSION_servant_server(0,15,0)

40#if MIN_VERSION_servant_server(0,15,0)

57type instance AddSetCookieApi (Stream method stat framing ctyps a)

41type instance AddSetCookieApi (Stream method stat framing ctyps a)

@@ -70,7 +54,7 @@ instance {-# OVERLAPS #-} AddSetCookies ('S n) oldb newb

70 => AddSetCookies ('S n) (a -> oldb) (a -> newb) where

54 => AddSetCookies ('S n) (a -> oldb) (a -> newb) where

71 addSetCookies cookies oldfn = addSetCookies cookies . oldfn

55 addSetCookies cookies oldfn = addSetCookies cookies . oldfn

72

56

73−instance (orig1 ~ orig2) => AddSetCookies 'Z orig1 orig2 where

57+instance AddSetCookies 'Z orig orig where

74 addSetCookies _ = id

58 addSetCookies _ = id

75

59

76instance {-# OVERLAPPABLE #-}

60instance {-# OVERLAPPABLE #-}

@@ -88,15 +72,6 @@ instance {-# OVERLAPS #-}

88 => AddSetCookies ('S n) (a :<|> b) (a' :<|> b') where

72 => AddSetCookies ('S n) (a :<|> b) (a' :<|> b') where

89 addSetCookies cookies (a :<|> b) = addSetCookies cookies a :<|> addSetCookies cookies b

73 addSetCookies cookies (a :<|> b) = addSetCookies cookies a :<|> addSetCookies cookies b

90

74

91−instance {-# OVERLAPS #-}

92− ( AddSetCookies ('S n) (ServerT (ToServantApi api) m) cookiedApi

93− , Generic (api (AsServerT m))

94− , GServantProduct (Rep (api (AsServerT m)))

95− , ToServant api (AsServerT m) ~ ServerT (ToServantApi api) m

96− )

97− => AddSetCookies ('S n) (api (AsServerT m)) cookiedApi where

98− addSetCookies cookies = addSetCookies cookies . toServant

99−

100-- | for @servant <0.11@

75-- | for @servant <0.11@

101instance

76instance

102 AddSetCookies ('S n) Application Application where

77 AddSetCookies ('S n) Application Application where

servant-auth/servant-auth-server/src/Servant/Auth/Server/Internal/ConfigTypes.hs+2−2

@@ -33,7 +33,7 @@ data JWTSettings = JWTSettings

33 -- | Algorithm used to sign JWT.

34 , jwtAlg :: Maybe Jose.Alg

35 -- | Keys used to validate JWT.

36− , validationKeys :: IO Jose.JWKSet

36+ , validationKeys :: Jose.JWKSet

37 -- | An @aud@ predicate. The @aud@ is a string or URI that identifies the

38 -- intended recipient of the JWT.

39 , audienceMatches :: Jose.StringOrURI -> IsMatch

@@ -44,7 +44,7 @@ defaultJWTSettings :: Jose.JWK -> JWTSettings

44defaultJWTSettings k = JWTSettings

45 { signingKey = k

46 , jwtAlg = Nothing

47− , validationKeys = pure $ Jose.JWKSet [k]

47+ , validationKeys = Jose.JWKSet [k]

48 , audienceMatches = const Matches }

49

50-- | The policies to use when generating cookies.

servant-auth/servant-auth-server/src/Servant/Auth/Server/Internal/Cookie.hs−1

@@ -2,7 +2,6 @@

2module Servant.Auth.Server.Internal.Cookie where

3

4import Blaze.ByteString.Builder (toByteString)

5−import Control.Monad (MonadPlus(..), guard)

6import Control.Monad.Except

5import Control.Monad.Except

7import Control.Monad.Reader

6import Control.Monad.Reader

8import qualified Crypto.JOSE as Jose

7import qualified Crypto.JOSE as Jose

servant-auth/servant-auth-server/src/Servant/Auth/Server/Internal/JWT.hs+9−6

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

1module Servant.Auth.Server.Internal.JWT where

2

3import Control.Lens

4−import Control.Monad (MonadPlus(..), guard)

4+import Control.Monad.Except

5import Control.Monad.Reader

6import qualified Crypto.JOSE as Jose

7import qualified Crypto.JWT as Jose

8+import Data.Aeson (FromJSON, Result (..), ToJSON, fromJSON,

9+ toJSON)

8import Data.ByteArray (constEq)

10import Data.ByteArray (constEq)

9import qualified Data.ByteString as BS

11import qualified Data.ByteString as BS

10import qualified Data.ByteString.Lazy as BSL

12import qualified Data.ByteString.Lazy as BSL

13+import qualified Data.HashMap.Strict as HM

11import Data.Maybe (fromMaybe)

14import Data.Maybe (fromMaybe)

15+import qualified Data.Text as T

12import Data.Time (UTCTime)

16import Data.Time (UTCTime)

13import Network.Wai (requestHeaders)

17import Network.Wai (requestHeaders)

14

18

@@ -38,7 +42,7 @@ jwtAuthCheck jwtSettings = do

38-- token expires.

42-- token expires.

39makeJWT :: ToJWT a

43makeJWT :: ToJWT a

40 => a -> JWTSettings -> Maybe UTCTime -> IO (Either Jose.Error BSL.ByteString)

44 => a -> JWTSettings -> Maybe UTCTime -> IO (Either Jose.Error BSL.ByteString)

41−makeJWT v cfg expiry = Jose.runJOSE $ do

45+makeJWT v cfg expiry = runExceptT $ do

42 bestAlg <- Jose.bestJWSAlg $ signingKey cfg

46 bestAlg <- Jose.bestJWSAlg $ signingKey cfg

43 let alg = fromMaybe bestAlg $ jwtAlg cfg

47 let alg = fromMaybe bestAlg $ jwtAlg cfg

44 ejwt <- Jose.signClaims (signingKey cfg)

48 ejwt <- Jose.signClaims (signingKey cfg)

@@ -54,15 +58,14 @@ makeJWT v cfg expiry = Jose.runJOSE $ do

54

58

55verifyJWT :: FromJWT a => JWTSettings -> BS.ByteString -> IO (Maybe a)

59verifyJWT :: FromJWT a => JWTSettings -> BS.ByteString -> IO (Maybe a)

56verifyJWT jwtCfg input = do

60verifyJWT jwtCfg input = do

57− keys <- validationKeys jwtCfg

58− verifiedJWT <- Jose.runJOSE $ do

61+ verifiedJWT <- liftIO $ runExceptT $ do

59 unverifiedJWT <- Jose.decodeCompact (BSL.fromStrict input)

62 unverifiedJWT <- Jose.decodeCompact (BSL.fromStrict input)

60 Jose.verifyClaims

63 Jose.verifyClaims

61 (jwtSettingsToJwtValidationSettings jwtCfg)

64 (jwtSettingsToJwtValidationSettings jwtCfg)

62− keys

65+ (validationKeys jwtCfg)

63 unverifiedJWT

66 unverifiedJWT

64 return $ case verifiedJWT of

67 return $ case verifiedJWT of

65 Left (_ :: Jose.JWTError) -> Nothing

68 Left (_ :: Jose.JWTError) -> Nothing

66 Right v -> case decodeJWT v of

69 Right v -> case decodeJWT v of

67 Left _ -> Nothing

70 Left _ -> Nothing

68− Right v' -> Just v'

71+ Right v' -> Just v'

servant-auth/servant-auth-server/src/Servant/Auth/Server/Internal/ThrowAll.hs+1−10

@@ -8,10 +8,7 @@ module Servant.Auth.Server.Internal.ThrowAll where

8

9import Control.Monad.Error.Class

10import Data.Tagged (Tagged (..))

11−import Servant ((:<|>) (..), ServerError(..), NamedRoutes(..))

11+import Servant ((:<|>) (..), ServerError(..))

12−import Servant.API.Generic

13−import Servant.Server.Generic

14−import Servant.Server

15import Network.HTTP.Types

12import Network.HTTP.Types

16import Network.Wai

13import Network.Wai

17

14

@@ -29,12 +26,6 @@ class ThrowAll a where

29instance (ThrowAll a, ThrowAll b) => ThrowAll (a :<|> b) where

26instance (ThrowAll a, ThrowAll b) => ThrowAll (a :<|> b) where

30 throwAll e = throwAll e :<|> throwAll e

27 throwAll e = throwAll e :<|> throwAll e

31

28

32−instance

33− ( ThrowAll (ToServant api (AsServerT m)) , GenericServant api (AsServerT m)) =>

34− ThrowAll (api (AsServerT m)) where

35−

36− throwAll = fromServant . throwAll

37−

38-- Really this shouldn't be necessary - ((->) a) should be an instance of

29-- Really this shouldn't be necessary - ((->) a) should be an instance of

39-- MonadError, no?

30-- MonadError, no?

40instance {-# OVERLAPPING #-} ThrowAll b => ThrowAll (a -> b) where

31instance {-# OVERLAPPING #-} ThrowAll b => ThrowAll (a -> b) where

servant-auth/servant-auth-server/src/Servant/Auth/Server/Internal/Types.hs−1

@@ -2,7 +2,6 @@

2module Servant.Auth.Server.Internal.Types where

3

4import Control.Applicative

5−import Control.Monad (MonadPlus(..), ap)

6import Control.Monad.Reader

5import Control.Monad.Reader

7import Control.Monad.Time

6import Control.Monad.Time

8import Data.Monoid (Monoid (..))

7import Data.Monoid (Monoid (..))

servant-auth/servant-auth-server/test/Servant/Auth/ServerSpec.hs+5−39

@@ -1,5 +1,4 @@

1{-# LANGUAGE CPP #-}

2−{-# LANGUAGE TypeApplications #-}

3module Servant.Auth.ServerSpec (spec) where

2module Servant.Auth.ServerSpec (spec) where

4

3

5#if !MIN_VERSION_servant_server(0,16,0)

4#if !MIN_VERSION_servant_server(0,16,0)

@@ -7,12 +6,13 @@ module Servant.Auth.ServerSpec (spec) where

7#endif

6#endif

8

7

9import Control.Lens

8import Control.Lens

9+import Control.Monad.Except (runExceptT)

10import Control.Monad.IO.Class (liftIO)

11import Crypto.JOSE (Alg (HS256, None), Error,

12 JWK, JWSHeader,

13 KeyMaterialGenParam (OctGenParam),

14 ToCompact, encodeCompact,

15− genJWK, newJWSHeader, runJOSE)

15+ genJWK, newJWSHeader)

16import Crypto.JWT (Audience (..), ClaimsSet,

17 NumericDate (NumericDate),

18 SignedJWT,

@@ -25,7 +25,6 @@ import Data.Aeson (FromJSON, ToJSON, Value,

25import Data.Aeson.Lens (_JSON)

26import qualified Data.ByteString as BS

27import qualified Data.ByteString.Lazy as BSL

28−import Data.Text (Text, pack)

29import Data.CaseInsensitive (mk)

28import Data.CaseInsensitive (mk)

30import Data.Foldable (find)

29import Data.Foldable (find)

31import Data.Monoid

30import Data.Monoid

@@ -41,7 +40,6 @@ import Network.HTTP.Types (Status, status200,

41import Network.Wai (responseLBS)

40import Network.Wai (responseLBS)

42import Network.Wai.Handler.Warp (testWithApplication)

41import Network.Wai.Handler.Warp (testWithApplication)

43import Network.Wreq (Options, auth, basicAuth,

42import Network.Wreq (Options, auth, basicAuth,

44− checkResponse,

45 cookieExpiryTime, cookies,

43 cookieExpiryTime, cookies,

46 defaults, get, getWith, postWith,

44 defaults, get, getWith, postWith,

47 header, oauth2Bearer,

45 header, oauth2Bearer,

@@ -52,7 +50,6 @@ import Network.Wreq (Options, auth, basicAuth,

52import Network.Wreq.Types (Postable(..))

50import Network.Wreq.Types (Postable(..))

53import Servant hiding (BasicAuth,

51import Servant hiding (BasicAuth,

54 IsSecure (..), header)

52 IsSecure (..), header)

55−import Servant.API.Generic ((:-))

56import Servant.Auth.Server

53import Servant.Auth.Server

57import Servant.Auth.Server.Internal.Cookie (expireTime)

54import Servant.Auth.Server.Internal.Cookie (expireTime)

58import Servant.Auth.Server.SetCookieOrphan ()

55import Servant.Auth.Server.SetCookieOrphan ()

@@ -185,21 +182,8 @@ cookieAuthSpec

185 it "fails with no XSRF header or cookie" $ \port -> property

182 it "fails with no XSRF header or cookie" $ \port -> property

186 $ \(user :: User) -> do

183 $ \(user :: User) -> do

187 jwt <- createJWT theKey (newJWSHeader ((), HS256)) (claims $ toJSON user)

184 jwt <- createJWT theKey (newJWSHeader ((), HS256)) (claims $ toJSON user)

188− opts' <- addJwtToCookie cookieCfg jwt

185+ opts <- addJwtToCookie cookieCfg jwt

189− let opts = opts' & checkResponse .~ Just mempty

190− resp <- getWith opts (url port)

186+ getWith opts (url port) `shouldHTTPErrorWith` status401

191− resp ^. responseStatus `shouldBe` status401

192− (resp ^. responseCookieJar) `shouldNotHaveCookies` ["XSRF-TOKEN"]

193−

194− -- Validating that the XSRF cookie isn't added for UVerb routes either.

195− -- These routes can return a 401 response directly without using throwError / throwAll,

196− -- which revealed a bug:

197− --

198− -- https://github.com/haskell-servant/servant/issues/1570#issuecomment-1076374449

199− resp <- getWith opts (url port ++ "/uverb")

200− resp ^. responseStatus `shouldBe` status401

201− (resp ^. responseCookieJar) `shouldNotHaveCookies` ["XSRF-TOKEN"]

202−

203

187

204 it "succeeds if XSRF header and cookie match, and JWT is valid" $ \port -> property

188 it "succeeds if XSRF header and cookie match, and JWT is valid" $ \port -> property

205 $ \(user :: User) -> do

189 $ \(user :: User) -> do

@@ -421,23 +405,17 @@ type API auths

421 = Auth auths User :>

405 = Auth auths User :>

422 ( Get '[JSON] Int

406 ( Get '[JSON] Int

423 :<|> ReqBody '[JSON] Int :> Post '[JSON] Int

407 :<|> ReqBody '[JSON] Int :> Post '[JSON] Int

424− :<|> "named" :> NamedRoutes DummyRoutes

425 :<|> "header" :> Get '[JSON] (Headers '[Header "Blah" Int] Int)

408 :<|> "header" :> Get '[JSON] (Headers '[Header "Blah" Int] Int)

426#if MIN_VERSION_servant_server(0,15,0)

409#if MIN_VERSION_servant_server(0,15,0)

427 :<|> "stream" :> StreamGet NoFraming OctetStream (SourceIO BS.ByteString)

410 :<|> "stream" :> StreamGet NoFraming OctetStream (SourceIO BS.ByteString)

428#endif

411#endif

429 :<|> "raw" :> Raw

412 :<|> "raw" :> Raw

430 )

413 )

431− :<|> "uverb" :> Auth auths User :> UVerb 'GET '[JSON] '[WithStatus 200 Int, WithStatus 401 Text, WithStatus 403 Text]

432 :<|> "login" :> ReqBody '[JSON] User :> Post '[JSON] (Headers '[ Header "Set-Cookie" SetCookie

414 :<|> "login" :> ReqBody '[JSON] User :> Post '[JSON] (Headers '[ Header "Set-Cookie" SetCookie

433 , Header "Set-Cookie" SetCookie ] NoContent)

415 , Header "Set-Cookie" SetCookie ] NoContent)

434 :<|> "logout" :> Get '[JSON] (Headers '[ Header "Set-Cookie" SetCookie

416 :<|> "logout" :> Get '[JSON] (Headers '[ Header "Set-Cookie" SetCookie

435 , Header "Set-Cookie" SetCookie ] NoContent)

417 , Header "Set-Cookie" SetCookie ] NoContent)

436

418

437−data DummyRoutes mode = DummyRoutes

438− { dummyInt :: mode :- "dummy" :> Get '[JSON] Int

439− } deriving Generic

440−

441jwtOnlyApi :: Proxy (API '[Servant.Auth.Server.JWT])

419jwtOnlyApi :: Proxy (API '[Servant.Auth.Server.JWT])

442jwtOnlyApi = Proxy

420jwtOnlyApi = Proxy

443

421

@@ -498,7 +476,6 @@ server ccfg =

498 (\authResult -> case authResult of

476 (\authResult -> case authResult of

499 Authenticated usr -> getInt usr

477 Authenticated usr -> getInt usr

500 :<|> postInt usr

478 :<|> postInt usr

501− :<|> DummyRoutes { dummyInt = getInt usr }

502 :<|> getHeaderInt

479 :<|> getHeaderInt

503#if MIN_VERSION_servant_server(0,15,0)

480#if MIN_VERSION_servant_server(0,15,0)

504 :<|> return (S.source ["bytestring"])

481 :<|> return (S.source ["bytestring"])

@@ -506,11 +483,6 @@ server ccfg =

506 :<|> raw

483 :<|> raw

507 Indefinite -> throwAll err401

484 Indefinite -> throwAll err401

508 _ -> throwAll err403

485 _ -> throwAll err403

509− ) :<|>

510− (\authResult -> case authResult of

511− Authenticated usr -> respond (WithStatus @200 (42 :: Int))

512− Indefinite -> respond (WithStatus @401 $ pack "Authentication required")

513− _ -> respond (WithStatus @403 $ pack "Forbidden")

514 )

486 )

515 :<|> getLogin

487 :<|> getLogin

516 :<|> getLogout

488 :<|> getLogout

@@ -561,7 +533,7 @@ addJwtToHeader jwt = case jwt of

561 $ defaults & header "Authorization" .~ ["Bearer " <> BSL.toStrict v]

533 $ defaults & header "Authorization" .~ ["Bearer " <> BSL.toStrict v]

562

534

563createJWT :: JWK -> JWSHeader () -> ClaimsSet -> IO (Either Error Crypto.JWT.SignedJWT)

535createJWT :: JWK -> JWSHeader () -> ClaimsSet -> IO (Either Error Crypto.JWT.SignedJWT)

564−createJWT k a b = runJOSE $ signClaims k a b

536+createJWT k a b = runExceptT $ signClaims k a b

565

537

566addJwtToCookie :: ToCompact a => CookieSettings -> Either Error a -> IO Options

538addJwtToCookie :: ToCompact a => CookieSettings -> Either Error a -> IO Options

567addJwtToCookie ccfg jwt = case jwt >>= (return . encodeCompact) of

539addJwtToCookie ccfg jwt = case jwt >>= (return . encodeCompact) of

@@ -591,12 +563,6 @@ shouldMatchCookieNames cj patterns

591 = fmap cookie_name (destroyCookieJar cj)

563 = fmap cookie_name (destroyCookieJar cj)

592 `shouldMatchList` patterns

564 `shouldMatchList` patterns

593

565

594−shouldNotHaveCookies :: HCli.CookieJar -> [BS.ByteString] -> Expectation

595−shouldNotHaveCookies cj patterns =

596− sequence_ $ (\cookieName -> cookieNames `shouldNotContain` [cookieName]) <$> patterns

597− where cookieNames :: [BS.ByteString]

598− cookieNames = cookie_name <$> destroyCookieJar cj

599−

600shouldMatchCookieNameValues :: HCli.CookieJar -> [(BS.ByteString, BS.ByteString)] -> Expectation

566shouldMatchCookieNameValues :: HCli.CookieJar -> [(BS.ByteString, BS.ByteString)] -> Expectation

601shouldMatchCookieNameValues cj patterns

567shouldMatchCookieNameValues cj patterns

602 = fmap ((,) <$> cookie_name <*> cookie_value) (destroyCookieJar cj)

568 = fmap ((,) <$> cookie_name <*> cookie_value) (destroyCookieJar cj)

servant-auth/servant-auth-swagger/servant-auth-swagger.cabal+17−13

@@ -1,4 +1,3 @@

1−cabal-version: 2.2

2name: servant-auth-swagger

1name: servant-auth-swagger

3version: 0.2.10.1

2version: 0.2.10.1

4synopsis: servant-swagger/servant-auth compatibility

3synopsis: servant-swagger/servant-auth compatibility

@@ -7,17 +6,18 @@ description: This package provides instances that allow generating swagger2 s

7 APIs that use

6 APIs that use

8 <https://hackage.haskell.org/package/servant-auth servant-auth's> @Auth@ combinator.

7 <https://hackage.haskell.org/package/servant-auth servant-auth's> @Auth@ combinator.

9 .

8 .

10− For a quick overview of the usage, see the <https://github.com/haskell-servant/servant/tree/master/servant-auth#readme README>.

9+ For a quick overview of the usage, see the <http://github.com/haskell-servant/servant/servant-auth#readme README>.

11category: Web, Servant, Authentication

10category: Web, Servant, Authentication

12−homepage: https://github.com/haskell-servant/servant/tree/master/servant-auth#readme

11+homepage: http://github.com/haskell-servant/servant/servant-auth#readme

13bug-reports: https://github.com/haskell-servant/servant/issues

12bug-reports: https://github.com/haskell-servant/servant/issues

14author: Julian K. Arni

13author: Julian K. Arni

15maintainer: jkarni@gmail.com

14maintainer: jkarni@gmail.com

16copyright: (c) Julian K. Arni

15copyright: (c) Julian K. Arni

17−license: BSD-3-Clause

16+license: BSD3

18license-file: LICENSE

17license-file: LICENSE

19tested-with: GHC ==8.6.5 || ==8.8.4 || ==8.10.4

18tested-with: GHC ==8.6.5 || ==8.8.4 || ==8.10.4

20build-type: Simple

19build-type: Simple

20+cabal-version: >= 1.10

21extra-source-files:

22 CHANGELOG.md

23

@@ -31,13 +31,15 @@ library

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

34+ base >= 4.10 && < 4.16

35− , text >= 1.2.3.0 && < 2.1

35+ , text >= 1.2.3.0 && < 1.3

36− , servant-swagger >= 1.1.5 && < 2

36+ , servant-swagger >= 1.1.5 && < 1.8

37− , swagger2 >= 2.2.2 && < 3

37+ , swagger2 >= 2.2.2 && < 2.7

38− , servant >= 0.13 && < 0.20

38+ , servant >= 0.13 && < 0.19

39 , servant-auth == 0.4.*

40− , lens >= 4.16.1 && < 5.3

40+ , lens >= 4.16.1 && < 5.1

41+ if impl(ghc >= 9)

42+ buildable: False

41 exposed-modules:

43 exposed-modules:

42 Servant.Auth.Swagger

44 Servant.Auth.Swagger

43 default-language: Haskell2010

45 default-language: Haskell2010

@@ -49,7 +51,7 @@ test-suite spec

49 test

51 test

50 default-extensions: ConstraintKinds DataKinds DefaultSignatures DeriveFoldable DeriveFunctor DeriveGeneric DeriveTraversable FlexibleContexts FlexibleInstances FunctionalDependencies GADTs KindSignatures MultiParamTypeClasses OverloadedStrings RankNTypes ScopedTypeVariables TypeFamilies TypeOperators

52 default-extensions: ConstraintKinds DataKinds DefaultSignatures DeriveFoldable DeriveFunctor DeriveGeneric DeriveTraversable FlexibleContexts FlexibleInstances FunctionalDependencies GADTs KindSignatures MultiParamTypeClasses OverloadedStrings RankNTypes ScopedTypeVariables TypeFamilies TypeOperators

51 ghc-options: -Wall

53 ghc-options: -Wall

52− build-tool-depends: hspec-discover:hspec-discover >= 2.5.5 && <2.10

54+ build-tool-depends: hspec-discover:hspec-discover >= 2.5.5 && <2.9

53 -- dependencies with bounds inherited from the library stanza

55 -- dependencies with bounds inherited from the library stanza

54 build-depends:

56 build-depends:

55 base

57 base

@@ -59,11 +61,13 @@ test-suite spec

59 , servant

61 , servant

60 , servant-auth

62 , servant-auth

61 , lens

63 , lens

62−

64+ if impl(ghc >= 9)

65+ buildable: False

66+

63 -- test dependencies

67 -- test dependencies

64 build-depends:

68 build-depends:

65 servant-auth-swagger

69 servant-auth-swagger

66− , hspec >= 2.5.5 && < 2.10

70+ , hspec >= 2.5.5 && < 2.9

67 , QuickCheck >= 2.11.3 && < 2.15

71 , QuickCheck >= 2.11.3 && < 2.15

68 other-modules:

72 other-modules:

69 Servant.Auth.SwaggerSpec

73 Servant.Auth.SwaggerSpec

servant-auth/servant-auth/servant-auth.cabal+11−12

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

1−cabal-version: 2.2

2name: servant-auth

1name: servant-auth

3−version: 0.4.1.0

2+version: 0.4.0.0

4synopsis: Authentication combinators for servant

3synopsis: Authentication combinators for servant

5description: This package provides an @Auth@ combinator for 'servant'. This combinator

4description: This package provides an @Auth@ combinator for 'servant'. This combinator

6 allows using different authentication schemes in a straightforward way,

5 allows using different authentication schemes in a straightforward way,

@@ -9,17 +8,18 @@ description: This package provides an @Auth@ combinator for 'servant'. This c

9 'servant-auth' additionally provides concrete authentication schemes, such

8 'servant-auth' additionally provides concrete authentication schemes, such

10 as Basic Access Authentication, JSON Web Tokens, and Cookies.

9 as Basic Access Authentication, JSON Web Tokens, and Cookies.

11 .

10 .

12− For more details on how to use this, see the <https://github.com/haskell-servant/servant/tree/master/servant-auth#readme README>.

11+ For more details on how to use this, see the <http://github.com/haskell-servant/servant/servant-auth#readme README>.

13category: Web, Servant, Authentication

12category: Web, Servant, Authentication

14−homepage: https://github.com/haskell-servant/servant/tree/master/servant-auth#readme

13+homepage: http://github.com/haskell-servant/servant/servant-auth#readme

15bug-reports: https://github.com/haskell-servant/servant/issues

14bug-reports: https://github.com/haskell-servant/servant/issues

16author: Julian K. Arni

15author: Julian K. Arni

17maintainer: jkarni@gmail.com

16maintainer: jkarni@gmail.com

18copyright: (c) Julian K. Arni

17copyright: (c) Julian K. Arni

19−license: BSD-3-Clause

18+license: BSD3

20license-file: LICENSE

19license-file: LICENSE

21tested-with: GHC ==8.6.5 || ==8.8.4 || ==8.10.4 || ==9.0.1

20tested-with: GHC ==8.6.5 || ==8.8.4 || ==8.10.4 || ==9.0.1

22build-type: Simple

21build-type: Simple

22+cabal-version: >= 1.10

23extra-source-files:

24 CHANGELOG.md

25

@@ -33,13 +33,12 @@ library

33 default-extensions: ConstraintKinds DataKinds DefaultSignatures DeriveFoldable DeriveFunctor DeriveGeneric DeriveTraversable FlexibleContexts FlexibleInstances FunctionalDependencies GADTs KindSignatures MultiParamTypeClasses OverloadedStrings RankNTypes ScopedTypeVariables TypeFamilies TypeOperators

34 ghc-options: -Wall

35 build-depends:

36− base >= 4.10 && < 4.18

36+ base >= 4.10 && < 4.16

37− , containers >= 0.6 && < 0.7

38− , aeson >= 1.3.1.1 && < 3

37+ , aeson >= 1.3.1.1 && < 1.6

39− , jose >= 0.10 && < 0.11

38+ , jose >= 0.7.0.0 && < 0.9

40− , lens >= 4.16.1 && < 5.3

39+ , lens >= 4.16.1 && < 5.1

41− , servant >= 0.15 && < 0.20

40+ , servant >= 0.15 && < 0.19

42− , text >= 1.2.3.0 && < 2.1

41+ , text >= 1.2.3.0 && < 1.3

43 , unordered-containers >= 0.2.9.0 && < 0.3

42 , unordered-containers >= 0.2.9.0 && < 0.3

44 exposed-modules:

43 exposed-modules:

45 Servant.Auth

44 Servant.Auth

servant-auth/servant-auth/src/Servant/Auth.hs+1−1

@@ -27,7 +27,7 @@ instance HasLink sub => HasLink (Auth (tag :: [*]) value :> sub) where

27

28-- ** Combinators

29

30−-- | A JSON Web Token (JWT) in the Authorization header:

30+-- | A JSON Web Token (JWT) in the the Authorization header:

31--

32-- @Authorization: Bearer \<token\>@

33--

servant-auth/servant-auth/src/Servant/Auth/JWT.hs+2−9

@@ -1,17 +1,10 @@

1−{-# LANGUAGE CPP #-}

2−

3module Servant.Auth.JWT where

1module Servant.Auth.JWT where

4

2

5import Control.Lens ((^.))

3import Control.Lens ((^.))

6import qualified Crypto.JWT as Jose

4import qualified Crypto.JWT as Jose

7import Data.Aeson (FromJSON, Result (..), ToJSON, fromJSON,

5import Data.Aeson (FromJSON, Result (..), ToJSON, fromJSON,

8 toJSON)

6 toJSON)

9−#if MIN_VERSION_aeson(2,0,0)

10−import qualified Data.Map as KM

11−#else

12−import qualified Data.HashMap.Strict as KM

7+import qualified Data.HashMap.Strict as HM

13−#endif

14−

15import qualified Data.Text as T

8import qualified Data.Text as T

16

9

17

10

@@ -24,7 +17,7 @@ import qualified Data.Text as T

24class FromJWT a where

17class FromJWT a where

25 decodeJWT :: Jose.ClaimsSet -> Either T.Text a

18 decodeJWT :: Jose.ClaimsSet -> Either T.Text a

26 default decodeJWT :: FromJSON a => Jose.ClaimsSet -> Either T.Text a

19 default decodeJWT :: FromJSON a => Jose.ClaimsSet -> Either T.Text a

27− decodeJWT m = case KM.lookup "dat" (m ^. Jose.unregisteredClaims) of

20+ decodeJWT m = case HM.lookup "dat" (m ^. Jose.unregisteredClaims) of

28 Nothing -> Left "Missing 'dat' claim"

21 Nothing -> Left "Missing 'dat' claim"

29 Just v -> case fromJSON v of

22 Just v -> case fromJSON v of

30 Error e -> Left $ T.pack e

23 Error e -> Left $ T.pack e

servant-client-core/CHANGELOG.md−31

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

1[The latest version of this document is on GitHub.](https://github.com/haskell-servant/servant/blob/master/servant-client-core/CHANGELOG.md)

2[Changelog for `servant` package contains significant entries for all core packages.](https://github.com/haskell-servant/servant/blob/master/servant/CHANGELOG.md)

3

4−Package versions follow the [Package Versioning Policy](https://pvp.haskell.org/): in A.B.C, bumps to either A or B represent major versions.

5−

6−0.19

7−----

8−

9−### Significant changes

10−

11−- Drop support for GHC < 8.6.

12−- Support GHC 9.0 (GHC 9.2 should work as well, but isn't fully tested yet).

13−- Support Aeson 2 ([#1475](https://github.com/haskell-servant/servant/pull/1475)),

14− which fixes a [DOS vulnerability](https://github.com/haskell/aeson/issues/864)

15− related to hash collisions.

16−- Add `NamedRoutes` combinator, making support for records first-class in Servant

17− ([#1388](https://github.com/haskell-servant/servant/pull/1388)).

18−- Add custom type errors for partially applied combinators

19− ([#1289](https://github.com/haskell-servant/servant/pull/1289),

20− [#1486](https://github.com/haskell-servant/servant/pull/1486)).

21−- *servant-client* / *servant-client-core* / *servant-http-streams*: Fix

22− erroneous behavior, where only 2XX status codes would be considered

23− successful, irrelevant of the status parameter specified by the verb

24− combinator. ([#1469](https://github.com/haskell-servant/servant/pull/1469))

25−- *servant-client* / *servant-client-core*: Fix `Show` instance for

26− `Servant.Client.Core.Request`.

27−- *servant-client* / *servant-client-core*: Allow passing arbitrary binary data

28− in Query parameters.

29− ([#1432](https://github.com/haskell-servant/servant/pull/1432)).

30−

31−### Other changes

32−

33−- Various version bumps.

34−

350.18.3

40.18.3

36------

5------

37

6

servant-client-core/servant-client-core.cabal+12−13

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

1−cabal-version: 2.2

1+cabal-version: >=1.10

2name: servant-client-core

3−version: 0.19

3+version: 0.18.3

4

5synopsis: Core functionality and class for client function generation for servant APIs

6category: Servant, Web

@@ -10,7 +10,7 @@ description:

10

11homepage: http://docs.servant.dev/

12bug-reports: http://github.com/haskell-servant/servant/issues

13−license: BSD-3-Clause

13+license: BSD3

14license-file: LICENSE

15author: Servant Contributors

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

@@ -50,14 +50,13 @@ library

50 --

51 -- note: mtl lower bound is so low because of GHC-7.8

52 build-depends:

53− base >= 4.9 && < 4.18

53+ base >= 4.9 && < 4.16

54 , bytestring >= 0.10.8.1 && < 0.12

55− , constraints >= 0.2 && < 0.14

56 , containers >= 0.5.7.1 && < 0.7

55 , containers >= 0.5.7.1 && < 0.7

57 , deepseq >= 1.4.2.0 && < 1.5

56 , deepseq >= 1.4.2.0 && < 1.5

58− , text >= 1.2.3.0 && < 2.1

57+ , text >= 1.2.3.0 && < 1.3

59− , transformers >= 0.5.2.0 && < 0.7

58+ , transformers >= 0.5.2.0 && < 0.6

60− , template-haskell >= 2.11.1.0 && < 2.20

59+ , template-haskell >= 2.11.1.0 && < 2.18

61

60

62 if !impl(ghc >= 8.2)

61 if !impl(ghc >= 8.2)

63 build-depends:

62 build-depends:

@@ -65,13 +64,13 @@ library

65

64

66 -- Servant dependencies

65 -- Servant dependencies

67 build-depends:

66 build-depends:

68− servant >= 0.19

67+ servant >= 0.18.3 && <0.19

69

68

70 -- Other dependencies: Lower bound around what is in the latest Stackage LTS.

69 -- Other dependencies: Lower bound around what is in the latest Stackage LTS.

71 -- Here can be exceptions if we really need features from the newer versions.

70 -- Here can be exceptions if we really need features from the newer versions.

72 build-depends:

71 build-depends:

73− aeson >= 1.4.1.0 && < 3

72+ aeson >= 1.4.1.0 && < 1.6

74− , base-compat >= 0.10.5 && < 0.13

73+ , base-compat >= 0.10.5 && < 0.12

75 , base64-bytestring >= 1.0.0.1 && < 1.3

74 , base64-bytestring >= 1.0.0.1 && < 1.3

76 , exceptions >= 0.10.0 && < 0.11

75 , exceptions >= 0.10.0 && < 0.11

77 , free >= 5.1 && < 5.2

76 , free >= 5.1 && < 5.2

@@ -104,8 +103,8 @@ test-suite spec

104 -- Additional dependencies

103 -- Additional dependencies

105 build-depends:

104 build-depends:

106 deepseq >= 1.4.2.0 && < 1.5

105 deepseq >= 1.4.2.0 && < 1.5

107− , hspec >= 2.6.0 && < 2.10

106+ , hspec >= 2.6.0 && < 2.9

108 , QuickCheck >= 2.12.6.1 && < 2.15

107 , QuickCheck >= 2.12.6.1 && < 2.15

109

108

110 build-tool-depends:

109 build-tool-depends:

111− hspec-discover:hspec-discover >= 2.6.0 && <2.10

110+ hspec-discover:hspec-discover >= 2.6.0 && <2.9

servant-client-core/src/Servant/Client/Core.hs−1

@@ -59,7 +59,6 @@ module Servant.Client.Core

59 , appendToPath

60 , setRequestBodyLBS

61 , setRequestBody

62− , encodeQueryParamValue

63 ) where

62 ) where

64import Servant.Client.Core.Auth

63import Servant.Client.Core.Auth

65import Servant.Client.Core.BaseUrl

64import Servant.Client.Core.BaseUrl

servant-client-core/src/Servant/Client/Core/HasClient.hs+38−190

@@ -1,4 +1,5 @@

1{-# LANGUAGE ConstraintKinds #-}

2+{-# LANGUAGE CPP #-}

2{-# LANGUAGE DataKinds #-}

3{-# LANGUAGE DataKinds #-}

3{-# LANGUAGE FlexibleContexts #-}

4{-# LANGUAGE FlexibleContexts #-}

4{-# LANGUAGE FlexibleInstances #-}

5{-# LANGUAGE FlexibleInstances #-}

@@ -6,7 +7,6 @@

6{-# LANGUAGE MultiParamTypeClasses #-}

7{-# LANGUAGE MultiParamTypeClasses #-}

7{-# LANGUAGE OverloadedStrings #-}

8{-# LANGUAGE OverloadedStrings #-}

8{-# LANGUAGE PolyKinds #-}

9{-# LANGUAGE PolyKinds #-}

9−{-# LANGUAGE QuantifiedConstraints #-}

10{-# LANGUAGE RankNTypes #-}

11{-# LANGUAGE ScopedTypeVariables #-}

12{-# LANGUAGE TypeApplications #-}

@@ -14,13 +14,14 @@

14{-# LANGUAGE TypeOperators #-}

15{-# LANGUAGE UndecidableInstances #-}

16

17+#if MIN_VERSION_base(4,9,0) && __GLASGOW_HASKELL__ >= 802

18+#define HAS_TYPE_ERROR

19+#endif

20+

17module Servant.Client.Core.HasClient (

21module Servant.Client.Core.HasClient (

18 clientIn,

22 clientIn,

19 HasClient (..),

23 HasClient (..),

20 EmptyClient (..),

24 EmptyClient (..),

21− AsClientT,

22− (//),

23− (/:),

24 foldMapUnion,

25 foldMapUnion,

25 matchUnion,

26 matchUnion,

26 ) where

27 ) where

@@ -33,10 +34,11 @@ import Control.Arrow

33import Control.Monad

34import Control.Monad

34 (unless)

35 (unless)

35import qualified Data.ByteString as BS

36import qualified Data.ByteString as BS

37+import Data.ByteString.Builder

38+ (toLazyByteString)

36−import qualified Data.ByteString.Lazy as BL

39+import qualified Data.ByteString.Lazy as BL

37import Data.Either

40import Data.Either

38 (partitionEithers)

41 (partitionEithers)

39−import Data.Constraint (Dict(..))

40import Data.Foldable

42import Data.Foldable

41 (toList)

43 (toList)

42import Data.List

44import Data.List

@@ -45,8 +47,7 @@ import Data.Sequence

45 (fromList)

47 (fromList)

46import qualified Data.Text as T

48import qualified Data.Text as T

47import Network.HTTP.Media

49import Network.HTTP.Media

48− (MediaType, matches, parseAccept)

50+ (MediaType, matches, parseAccept, (//))

49−import qualified Network.HTTP.Media as Media

50import qualified Data.Sequence as Seq

51import qualified Data.Sequence as Seq

51import Data.SOP.BasicFunctors

52import Data.SOP.BasicFunctors

52 (I (I), (:.:) (Comp))

53 (I (I), (:.:) (Comp))

@@ -63,7 +64,7 @@ import Data.Text

63import Data.Proxy

64import Data.Proxy

64 (Proxy (Proxy))

65 (Proxy (Proxy))

65import GHC.TypeLits

66import GHC.TypeLits

66− (KnownNat, KnownSymbol, TypeError, symbolVal)

67+ (KnownSymbol, symbolVal)

67import Network.HTTP.Types

68import Network.HTTP.Types

68 (Status)

69 (Status)

69import qualified Network.HTTP.Types as H

70import qualified Network.HTTP.Types as H

@@ -74,22 +75,16 @@ import Servant.API

74 FromSourceIO (..), Header', Headers (..), HttpVersion,

75 FromSourceIO (..), Header', Headers (..), HttpVersion,

75 IsSecure, MimeRender (mimeRender),

76 IsSecure, MimeRender (mimeRender),

76 MimeUnrender (mimeUnrender), NoContent (NoContent),

77 MimeUnrender (mimeUnrender), NoContent (NoContent),

77− NoContentVerb, QueryFlag, QueryParam', QueryParams, Raw, RawM,

78+ NoContentVerb, QueryFlag, QueryParam', QueryParams, Raw,

78 ReflectMethod (..), RemoteHost, ReqBody', SBoolI, Stream,

79 ReflectMethod (..), RemoteHost, ReqBody', SBoolI, Stream,

79 StreamBody', Summary, ToHttpApiData, ToSourceIO (..), Vault,

80 StreamBody', Summary, ToHttpApiData, ToSourceIO (..), Vault,

80− Verb, WithNamedContext, WithResource, WithStatus (..), contentType, getHeadersHList,

81+ Verb, WithNamedContext, WithStatus (..), contentType, getHeadersHList,

81− getResponse, toEncodedUrlPiece, toUrlPiece, NamedRoutes)

82+ getResponse, toEncodedUrlPiece, toUrlPiece)

82−import Servant.API.Generic

83− (GenericMode(..), ToServant, ToServantApi

84− , GenericServant, toServant, fromServant)

85import Servant.API.ContentTypes

83import Servant.API.ContentTypes

86 (contentTypes, AllMime (allMime), AllMimeUnrender (allMimeUnrender))

84 (contentTypes, AllMime (allMime), AllMimeUnrender (allMimeUnrender))

87−import Servant.API.Status

88− (statusFromNat)

89import Servant.API.TypeLevel (FragmentUnique, AtLeastOneFragment)

85import Servant.API.TypeLevel (FragmentUnique, AtLeastOneFragment)

90import Servant.API.Modifiers

86import Servant.API.Modifiers

91 (FoldRequired, RequiredArgument, foldRequiredArgument)

87 (FoldRequired, RequiredArgument, foldRequiredArgument)

92−import Servant.API.TypeErrors

93import Servant.API.UVerb

88import Servant.API.UVerb

94 (HasStatus, HasStatuses (Statuses, statuses), UVerb, Union, Unique, inject, statusOf, foldMapUnion, matchUnion)

89 (HasStatus, HasStatuses (Statuses, statuses), UVerb, Union, Unique, inject, statusOf, foldMapUnion, matchUnion)

95

90

@@ -208,7 +203,7 @@ instance (KnownSymbol capture, ToHttpApiData a, HasClient m api)

208 clientWithRoute pm (Proxy :: Proxy api)

203 clientWithRoute pm (Proxy :: Proxy api)

209 (appendToPath p req)

204 (appendToPath p req)

210

205

211− where p = toEncodedUrlPiece val

206+ where p = (toUrlPiece val)

212

207

213 hoistClientMonad pm _ f cl = \a ->

208 hoistClientMonad pm _ f cl = \a ->

214 hoistClientMonad pm (Proxy :: Proxy api) f (cl a)

209 hoistClientMonad pm (Proxy :: Proxy api) f (cl a)

@@ -243,7 +238,7 @@ instance (KnownSymbol capture, ToHttpApiData a, HasClient m sublayout)

243 clientWithRoute pm (Proxy :: Proxy sublayout)

238 clientWithRoute pm (Proxy :: Proxy sublayout)

244 (foldl' (flip appendToPath) req ps)

239 (foldl' (flip appendToPath) req ps)

245

240

246− where ps = map toEncodedUrlPiece vals

241+ where ps = map (toUrlPiece) vals

247

242

248 hoistClientMonad pm _ f cl = \as ->

243 hoistClientMonad pm _ f cl = \as ->

249 hoistClientMonad pm (Proxy :: Proxy sublayout) f (cl as)

244 hoistClientMonad pm (Proxy :: Proxy sublayout) f (cl as)

@@ -251,11 +246,10 @@ instance (KnownSymbol capture, ToHttpApiData a, HasClient m sublayout)

251instance {-# OVERLAPPABLE #-}

246instance {-# OVERLAPPABLE #-}

252 -- Note [Non-Empty Content Types]

247 -- Note [Non-Empty Content Types]

253 ( RunClient m, MimeUnrender ct a, ReflectMethod method, cts' ~ (ct ': cts)

248 ( RunClient m, MimeUnrender ct a, ReflectMethod method, cts' ~ (ct ': cts)

254− , KnownNat status

255 ) => HasClient m (Verb method status cts' a) where

249 ) => HasClient m (Verb method status cts' a) where

256 type Client m (Verb method status cts' a) = m a

250 type Client m (Verb method status cts' a) = m a

257 clientWithRoute _pm Proxy req = do

251 clientWithRoute _pm Proxy req = do

258− response <- runRequestAcceptStatus (Just [status]) req

252+ response <- runRequest req

259 { requestAccept = fromList $ toList accept

253 { requestAccept = fromList $ toList accept

260 , requestMethod = method

254 , requestMethod = method

261 }

255 }

@@ -263,20 +257,18 @@ instance {-# OVERLAPPABLE #-}

263 where

257 where

264 accept = contentTypes (Proxy :: Proxy ct)

258 accept = contentTypes (Proxy :: Proxy ct)

265 method = reflectMethod (Proxy :: Proxy method)

259 method = reflectMethod (Proxy :: Proxy method)

266− status = statusFromNat (Proxy :: Proxy status)

267

260

268 hoistClientMonad _ _ f ma = f ma

261 hoistClientMonad _ _ f ma = f ma

269

262

270instance {-# OVERLAPPING #-}

263instance {-# OVERLAPPING #-}

271− ( RunClient m, ReflectMethod method, KnownNat status

264+ ( RunClient m, ReflectMethod method

272 ) => HasClient m (Verb method status cts NoContent) where

265 ) => HasClient m (Verb method status cts NoContent) where

273 type Client m (Verb method status cts NoContent)

266 type Client m (Verb method status cts NoContent)

274 = m NoContent

267 = m NoContent

275 clientWithRoute _pm Proxy req = do

268 clientWithRoute _pm Proxy req = do

276− _response <- runRequestAcceptStatus (Just [status]) req { requestMethod = method }

269+ _response <- runRequest req { requestMethod = method }

277 return NoContent

270 return NoContent

278 where method = reflectMethod (Proxy :: Proxy method)

271 where method = reflectMethod (Proxy :: Proxy method)

279− status = statusFromNat (Proxy :: Proxy status)

280

272

281 hoistClientMonad _ _ f ma = f ma

273 hoistClientMonad _ _ f ma = f ma

282

274

@@ -293,13 +285,13 @@ instance (RunClient m, ReflectMethod method) =>

293

285

294instance {-# OVERLAPPING #-}

286instance {-# OVERLAPPING #-}

295 -- Note [Non-Empty Content Types]

287 -- Note [Non-Empty Content Types]

296− ( RunClient m, MimeUnrender ct a, BuildHeadersTo ls, KnownNat status

288+ ( RunClient m, MimeUnrender ct a, BuildHeadersTo ls

297 , ReflectMethod method, cts' ~ (ct ': cts)

289 , ReflectMethod method, cts' ~ (ct ': cts)

298 ) => HasClient m (Verb method status cts' (Headers ls a)) where

290 ) => HasClient m (Verb method status cts' (Headers ls a)) where

299 type Client m (Verb method status cts' (Headers ls a))

291 type Client m (Verb method status cts' (Headers ls a))

300 = m (Headers ls a)

292 = m (Headers ls a)

301 clientWithRoute _pm Proxy req = do

293 clientWithRoute _pm Proxy req = do

302− response <- runRequestAcceptStatus (Just [status]) req

294+ response <- runRequest req

303 { requestMethod = method

295 { requestMethod = method

304 , requestAccept = fromList $ toList accept

296 , requestAccept = fromList $ toList accept

305 }

297 }

@@ -307,26 +299,22 @@ instance {-# OVERLAPPING #-}

307 return $ Headers { getResponse = val

299 return $ Headers { getResponse = val

308 , getHeadersHList = buildHeadersTo . toList $ responseHeaders response

300 , getHeadersHList = buildHeadersTo . toList $ responseHeaders response

309 }

301 }

310− where

311− method = reflectMethod (Proxy :: Proxy method)

302+ where method = reflectMethod (Proxy :: Proxy method)

312− accept = contentTypes (Proxy :: Proxy ct)

303+ accept = contentTypes (Proxy :: Proxy ct)

313− status = statusFromNat (Proxy :: Proxy status)

314

304

315 hoistClientMonad _ _ f ma = f ma

305 hoistClientMonad _ _ f ma = f ma

316

306

317instance {-# OVERLAPPING #-}

307instance {-# OVERLAPPING #-}

318− ( RunClient m, BuildHeadersTo ls, ReflectMethod method, KnownNat status

308+ ( RunClient m, BuildHeadersTo ls, ReflectMethod method

319 ) => HasClient m (Verb method status cts (Headers ls NoContent)) where

309 ) => HasClient m (Verb method status cts (Headers ls NoContent)) where

320 type Client m (Verb method status cts (Headers ls NoContent))

310 type Client m (Verb method status cts (Headers ls NoContent))

321 = m (Headers ls NoContent)

311 = m (Headers ls NoContent)

322 clientWithRoute _pm Proxy req = do

312 clientWithRoute _pm Proxy req = do

313+ let method = reflectMethod (Proxy :: Proxy method)

323− response <- runRequestAcceptStatus (Just [status]) req { requestMethod = method }

314+ response <- runRequest req { requestMethod = method }

324 return $ Headers { getResponse = NoContent

315 return $ Headers { getResponse = NoContent

325 , getHeadersHList = buildHeadersTo . toList $ responseHeaders response

316 , getHeadersHList = buildHeadersTo . toList $ responseHeaders response

326 }

317 }

327− where

328− method = reflectMethod (Proxy :: Proxy method)

329− status = statusFromNat (Proxy :: Proxy status)

330

318

331 hoistClientMonad _ _ f ma = f ma

319 hoistClientMonad _ _ f ma = f ma

332

320

@@ -569,7 +557,7 @@ instance (KnownSymbol sym, ToHttpApiData a, HasClient m api, SBoolI (FoldRequire

569 (Proxy :: Proxy mods) add (maybe req add) mparam

557 (Proxy :: Proxy mods) add (maybe req add) mparam

570 where

558 where

571 add :: a -> Request

559 add :: a -> Request

572− add param = appendToQueryString pname (Just $ encodeQueryParamValue param) req

560+ add param = appendToQueryString pname (Just $ encodeQueryParam param) req

573

561

574 pname :: Text

562 pname :: Text

575 pname = pack $ symbolVal (Proxy :: Proxy sym)

563 pname = pack $ symbolVal (Proxy :: Proxy sym)

@@ -577,6 +565,9 @@ instance (KnownSymbol sym, ToHttpApiData a, HasClient m api, SBoolI (FoldRequire

577 hoistClientMonad pm _ f cl = \arg ->

565 hoistClientMonad pm _ f cl = \arg ->

578 hoistClientMonad pm (Proxy :: Proxy api) f (cl arg)

566 hoistClientMonad pm (Proxy :: Proxy api) f (cl arg)

579

567

568+encodeQueryParam :: ToHttpApiData a => a -> BS.ByteString

569+encodeQueryParam = BL.toStrict . toLazyByteString . toEncodedUrlPiece

570+

580-- | If you use a 'QueryParams' in one of your endpoints in your API,

571-- | If you use a 'QueryParams' in one of your endpoints in your API,

581-- the corresponding querying function will automatically take

572-- the corresponding querying function will automatically take

582-- an additional argument, a list of values of the type specified

573-- an additional argument, a list of values of the type specified

@@ -618,7 +609,7 @@ instance (KnownSymbol sym, ToHttpApiData a, HasClient m api)

618 )

609 )

619

610

620 where pname = pack $ symbolVal (Proxy :: Proxy sym)

611 where pname = pack $ symbolVal (Proxy :: Proxy sym)

621− paramlist' = map (Just . encodeQueryParamValue) paramlist

612+ paramlist' = map (Just . encodeQueryParam) paramlist

622

613

623 hoistClientMonad pm _ f cl = \as ->

614 hoistClientMonad pm _ f cl = \as ->

624 hoistClientMonad pm (Proxy :: Proxy api) f (cl as)

615 hoistClientMonad pm (Proxy :: Proxy api) f (cl as)

@@ -674,16 +665,6 @@ instance RunClient m => HasClient m Raw where

674

665

675 hoistClientMonad _ _ f cl = \meth -> f (cl meth)

666 hoistClientMonad _ _ f cl = \meth -> f (cl meth)

676

667

677−instance RunClient m => HasClient m RawM where

678− type Client m RawM

679− = H.Method -> m Response

680−

681− clientWithRoute :: Proxy m -> Proxy RawM -> Request -> Client m RawM

682− clientWithRoute _pm Proxy req httpMethod = do

683− runRequest req { requestMethod = httpMethod }

684−

685− hoistClientMonad _ _ f cl = \meth -> f (cl meth)

686−

687-- | If you use a 'ReqBody' in one of your endpoints in your API,

668-- | If you use a 'ReqBody' in one of your endpoints in your API,

688-- the corresponding querying function will automatically take

669-- the corresponding querying function will automatically take

689-- an additional argument of the type specified by your 'ReqBody'.

670-- an additional argument of the type specified by your 'ReqBody'.

@@ -750,7 +731,7 @@ instance (KnownSymbol path, HasClient m api) => HasClient m (path :> api) where

750 clientWithRoute pm (Proxy :: Proxy api)

731 clientWithRoute pm (Proxy :: Proxy api)

751 (appendToPath p req)

732 (appendToPath p req)

752

733

753− where p = toEncodedUrlPiece $ pack $ symbolVal (Proxy :: Proxy path)

734+ where p = pack $ symbolVal (Proxy :: Proxy path)

754

735

755 hoistClientMonad pm _ f cl = hoistClientMonad pm (Proxy :: Proxy api) f cl

736 hoistClientMonad pm _ f cl = hoistClientMonad pm (Proxy :: Proxy api) f cl

756

737

@@ -786,14 +767,6 @@ instance HasClient m subapi =>

786

767

787 hoistClientMonad pm _ f cl = hoistClientMonad pm (Proxy :: Proxy subapi) f cl

768 hoistClientMonad pm _ f cl = hoistClientMonad pm (Proxy :: Proxy subapi) f cl

788

769

789−instance HasClient m subapi =>

790− HasClient m (WithResource res :> subapi) where

791−

792− type Client m (WithResource res :> subapi) = Client m subapi

793− clientWithRoute pm Proxy = clientWithRoute pm (Proxy :: Proxy subapi)

794−

795− hoistClientMonad pm _ f cl = hoistClientMonad pm (Proxy :: Proxy subapi) f cl

796−

797instance ( HasClient m api

770instance ( HasClient m api

798 ) => HasClient m (AuthProtect tag :> api) where

771 ) => HasClient m (AuthProtect tag :> api) where

799 type Client m (AuthProtect tag :> api)

772 type Client m (AuthProtect tag :> api)

@@ -807,7 +780,7 @@ instance ( HasClient m api

807

780

808-- | Ignore @'Fragment'@ in client functions.

781-- | Ignore @'Fragment'@ in client functions.

809-- See <https://ietf.org/rfc/rfc2616.html#section-15.1.3> for more details.

782-- See <https://ietf.org/rfc/rfc2616.html#section-15.1.3> for more details.

810−--

783+--

811-- Example:

784-- Example:

812--

785--

813-- > type MyApi = "books" :> Fragment Text :> Get '[JSON] [Book]

786-- > type MyApi = "books" :> Fragment Text :> Get '[JSON] [Book]

@@ -819,12 +792,16 @@ instance ( HasClient m api

819-- > getBooks = client myApi

792-- > getBooks = client myApi

820-- > -- then you can just use "getBooksBy" to query that endpoint.

793-- > -- then you can just use "getBooksBy" to query that endpoint.

821-- > -- 'getBooks' for all books.

794-- > -- 'getBooks' for all books.

795+#ifdef HAS_TYPE_ERROR

822instance (AtLeastOneFragment api, FragmentUnique (Fragment a :> api), HasClient m api

796instance (AtLeastOneFragment api, FragmentUnique (Fragment a :> api), HasClient m api

797+#else

798+instance ( HasClient m api

799+#endif

823 ) => HasClient m (Fragment a :> api) where

800 ) => HasClient m (Fragment a :> api) where

824

801

825 type Client m (Fragment a :> api) = Client m api

802 type Client m (Fragment a :> api) = Client m api

826

803

827− clientWithRoute pm _ = clientWithRoute pm (Proxy :: Proxy api)

804+ clientWithRoute pm _ = clientWithRoute pm (Proxy :: Proxy api)

828

805

829 hoistClientMonad pm _ = hoistClientMonad pm (Proxy :: Proxy api)

806 hoistClientMonad pm _ = hoistClientMonad pm (Proxy :: Proxy api)

830

807

@@ -839,119 +816,6 @@ instance HasClient m api => HasClient m (BasicAuth realm usr :> api) where

839 hoistClientMonad pm _ f cl = \bauth ->

816 hoistClientMonad pm _ f cl = \bauth ->

840 hoistClientMonad pm (Proxy :: Proxy api) f (cl bauth)

817 hoistClientMonad pm (Proxy :: Proxy api) f (cl bauth)

841

818

842−-- | A type that specifies that an API record contains a client implementation.

843−data AsClientT (m :: * -> *)

844−instance GenericMode (AsClientT m) where

845− type AsClientT m :- api = Client m api

846−

847−

848−type GClientConstraints api m =

849− ( GenericServant api (AsClientT m)

850− , Client m (ToServantApi api) ~ ToServant api (AsClientT m)

851− )

852−

853−class GClient (api :: * -> *) m where

854− gClientProof :: Dict (GClientConstraints api m)

855−

856−instance GClientConstraints api m => GClient api m where

857− gClientProof = Dict

858−

859−instance

860− ( forall n. GClient api n

861− , HasClient m (ToServantApi api)

862− , RunClient m

863− )

864− => HasClient m (NamedRoutes api) where

865− type Client m (NamedRoutes api) = api (AsClientT m)

866−

867− clientWithRoute :: Proxy m -> Proxy (NamedRoutes api) -> Request -> Client m (NamedRoutes api)

868− clientWithRoute pm _ request =

869− case gClientProof @api @m of

870− Dict -> fromServant $ clientWithRoute pm (Proxy @(ToServantApi api)) request

871−

872− hoistClientMonad

873− :: forall ma mb.

874− Proxy m

875− -> Proxy (NamedRoutes api)

876− -> (forall x. ma x -> mb x)

877− -> Client ma (NamedRoutes api)

878− -> Client mb (NamedRoutes api)

879− hoistClientMonad _ _ nat clientA =

880− case (gClientProof @api @ma, gClientProof @api @mb) of

881− (Dict, Dict) ->

882− fromServant @api @(AsClientT mb) $

883− hoistClientMonad @m @(ToServantApi api) @ma @mb Proxy Proxy nat $

884− toServant @api @(AsClientT ma) clientA

885−

886−infixl 1 //

887−infixl 2 /:

888−

889−-- | Helper to make code using records of clients more readable.

890−--

891−-- Can be mixed with (/:) for supplying arguments.

892−--

893−-- Example:

894−--

895−-- @

896−-- type Api = NamedRoutes RootApi

897−--

898−-- data RootApi mode = RootApi

899−-- { subApi :: mode :- NamedRoutes SubApi

900−-- , …

901−-- } deriving Generic

902−--

903−-- data SubApi mode = SubApi

904−-- { endpoint :: mode :- Get '[JSON] Person

905−-- , …

906−-- } deriving Generic

907−--

908−-- api :: Proxy API

909−-- api = Proxy

910−--

911−-- rootClient :: RootApi (AsClientT ClientM)

912−-- rootClient = client api

913−--

914−-- endpointClient :: ClientM Person

915−-- endpointClient = client \/\/ subApi \/\/ endpoint

916−-- @

917−(//) :: a -> (a -> b) -> b

918−x // f = f x

919−

920−-- | Convenience function for supplying arguments to client functions when

921−-- working with records of clients.

922−--

923−-- Intended to be used in conjunction with '(//)'.

924−--

925−-- Example:

926−--

927−-- @

928−-- type Api = NamedRoutes RootApi

929−--

930−-- data RootApi mode = RootApi

931−-- { subApi :: mode :- Capture "token" String :> NamedRoutes SubApi

932−-- , hello :: mode :- Capture "name" String :> Get '[JSON] String

933−-- , …

934−-- } deriving Generic

935−--

936−-- data SubApi mode = SubApi

937−-- { endpoint :: mode :- Get '[JSON] Person

938−-- , …

939−-- } deriving Generic

940−--

941−-- api :: Proxy API

942−-- api = Proxy

943−--

944−-- rootClient :: RootApi (AsClientT ClientM)

945−-- rootClient = client api

946−--

947−-- hello :: String -> ClientM String

948−-- hello name = rootClient \/\/ hello \/: name

949−--

950−-- endpointClient :: ClientM Person

951−-- endpointClient = client \/\/ subApi \/: "foobar123" \/\/ endpoint

952−-- @

953−(/:) :: (a -> b -> c) -> b -> a -> c

954−(/:) = flip

955

819

956

820

957{- Note [Non-Empty Content Types]

821{- Note [Non-Empty Content Types]

@@ -977,7 +841,7 @@ for empty and one for non-empty lists).

977checkContentTypeHeader :: RunClient m => Response -> m MediaType

841checkContentTypeHeader :: RunClient m => Response -> m MediaType

978checkContentTypeHeader response =

842checkContentTypeHeader response =

979 case lookup "Content-Type" $ toList $ responseHeaders response of

843 case lookup "Content-Type" $ toList $ responseHeaders response of

980− Nothing -> return $ "application" Media.// "octet-stream"

844+ Nothing -> return $ "application"//"octet-stream"

981 Just t -> case parseAccept t of

845 Just t -> case parseAccept t of

982 Nothing -> throwClientError $ InvalidContentTypeHeader response

846 Nothing -> throwClientError $ InvalidContentTypeHeader response

983 Just t' -> return t'

847 Just t' -> return t'

@@ -993,19 +857,3 @@ decodedAs response ct = do

993 Right val -> return val

857 Right val -> return val

994 where

858 where

995 accept = toList $ contentTypes ct

859 accept = toList $ contentTypes ct

996−

997−-------------------------------------------------------------------------------

998−-- Custom type errors

999−-------------------------------------------------------------------------------

1000−

1001−-- Erroring instance for HasClient' when a combinator is not fully applied

1002−instance (RunClient m, TypeError (PartialApplication HasClient arr)) => HasClient m ((arr :: a -> b) :> sub)

1003− where

1004− type Client m (arr :> sub) = TypeError (PartialApplication HasClient arr)

1005− clientWithRoute _ _ _ = error "unreachable"

1006− hoistClientMonad _ _ _ _ = error "unreachable"

1007−

1008−-- Erroring instances for 'HasClient' for unknown API combinators

1009−instance {-# OVERLAPPABLE #-} (RunClient m, TypeError (NoInstanceForSub (HasClient m) ty)) => HasClient m (ty :> sub)

1010−

1011−instance {-# OVERLAPPABLE #-} (RunClient m, TypeError (NoInstanceFor (HasClient m api))) => HasClient m api

servant-client-core/src/Servant/Client/Core/Reexport.hs−4

@@ -7,9 +7,6 @@ module Servant.Client.Core.Reexport

7 HasClient(..)

8 , foldMapUnion

9 , matchUnion

10− , AsClientT

11− , (//)

12− , (/:)

13

10

14 -- * Response (for @Raw@)

11 -- * Response (for @Raw@)

15 , Response

12 , Response

@@ -26,7 +23,6 @@ module Servant.Client.Core.Reexport

26 , showBaseUrl

23 , showBaseUrl

27 , parseBaseUrl

24 , parseBaseUrl

28 , InvalidBaseUrlException

25 , InvalidBaseUrlException

29−

30 ) where

26 ) where

31

27

32

28

servant-client-core/src/Servant/Client/Core/Request.hs+6−22

@@ -17,7 +17,6 @@ module Servant.Client.Core.Request (

17 addHeader,

18 appendToPath,

19 appendToQueryString,

20− encodeQueryParamValue,

21 setRequestBody,

20 setRequestBody,

22 setRequestBodyLBS,

21 setRequestBodyLBS,

23 ) where

22 ) where

@@ -34,8 +33,6 @@ import Data.Bifunctor

34import Data.Bitraversable

33import Data.Bitraversable

35 (Bitraversable (..), bifoldMapDefault, bimapDefault)

34 (Bitraversable (..), bifoldMapDefault, bimapDefault)

36import qualified Data.ByteString as BS

35import qualified Data.ByteString as BS

37−import Data.ByteString.Builder

38− (Builder)

39import qualified Data.ByteString.Builder as Builder

36import qualified Data.ByteString.Builder as Builder

40import qualified Data.ByteString.Lazy as LBS

37import qualified Data.ByteString.Lazy as LBS

41import qualified Data.Sequence as Seq

38import qualified Data.Sequence as Seq

@@ -81,13 +78,12 @@ instance (Show a, Show b) =>

81 . showString ", requestAccept = "

78 . showString ", requestAccept = "

82 . showsPrec 0 (requestAccept req)

79 . showsPrec 0 (requestAccept req)

83 . showString ", requestHeaders = "

80 . showString ", requestHeaders = "

84− . showsPrec 0 (redactSensitiveHeader <$> requestHeaders req)

81+ . showsPrec 0 (redactSensitiveHeader <$> requestHeaders req))

85 . showString ", requestHttpVersion = "

82 . showString ", requestHttpVersion = "

86 . showsPrec 0 (requestHttpVersion req)

83 . showsPrec 0 (requestHttpVersion req)

87 . showString ", requestMethod = "

84 . showString ", requestMethod = "

88 . showsPrec 0 (requestMethod req)

85 . showsPrec 0 (requestMethod req)

89 . showString "}"

86 . showString "}"

90− )

91 where

87 where

92 redactSensitiveHeader :: Header -> Header

88 redactSensitiveHeader :: Header -> Header

93 redactSensitiveHeader ("Authorization", _) = ("Authorization", "<REDACTED>")

89 redactSensitiveHeader ("Authorization", _) = ("Authorization", "<REDACTED>")

@@ -114,7 +110,7 @@ instance (NFData path, NFData body) => NFData (RequestF body path) where

114 rnfB Nothing = ()

110 rnfB Nothing = ()

115 rnfB (Just (b, mt)) = rnf b `seq` mediaTypeRnf mt

111 rnfB (Just (b, mt)) = rnf b `seq` mediaTypeRnf mt

116

112

117−type Request = RequestF RequestBody Builder

113+type Request = RequestF RequestBody Builder.Builder

118

114

119-- | The request body. R replica of the @http-client@ @RequestBody@.

115-- | The request body. R replica of the @http-client@ @RequestBody@.

120data RequestBody

116data RequestBody

@@ -145,30 +141,18 @@ defaultRequest = Request

145 , requestMethod = methodGet

141 , requestMethod = methodGet

146 }

142 }

147

143

148−-- | Append extra path to the request being constructed.

149−--

150−-- Warning: This function assumes that the path fragment is already URL-encoded.

151−appendToPath :: Builder -> Request -> Request

144+appendToPath :: Text -> Request -> Request

152appendToPath p req

145appendToPath p req

153− = req { requestPath = requestPath req <> "/" <> p }

146+ = req { requestPath = requestPath req <> "/" <> toEncodedUrlPiece p }

154

147

155−-- | Append a query parameter to the request being constructed.

156−--

157−appendToQueryString :: Text -- ^ query param name

148+appendToQueryString :: Text -- ^ param name

158− -> Maybe BS.ByteString -- ^ query param value

149+ -> Maybe BS.ByteString -- ^ param value

159 -> Request

150 -> Request

160 -> Request

151 -> Request

161appendToQueryString pname pvalue req

152appendToQueryString pname pvalue req

162 = req { requestQueryString = requestQueryString req

153 = req { requestQueryString = requestQueryString req

163 Seq.|> (encodeUtf8 pname, pvalue)}

154 Seq.|> (encodeUtf8 pname, pvalue)}

164

155

165−-- | Encode a query parameter value.

166−--

167−encodeQueryParamValue :: ToHttpApiData a => a -> BS.ByteString

168−encodeQueryParamValue = LBS.toStrict . Builder.toLazyByteString . toEncodedUrlPiece

169−

170−-- | Add header to the request being constructed.

171−--

172addHeader :: ToHttpApiData a => HeaderName -> a -> Request -> Request

156addHeader :: ToHttpApiData a => HeaderName -> a -> Request -> Request

173addHeader name val req

157addHeader name val req

174 = req { requestHeaders = requestHeaders req Seq.|> (name, toHeader val)}

158 = req { requestHeaders = requestHeaders req Seq.|> (name, toHeader val)}

servant-client-core/src/Servant/Client/Generic.hs+11−8

@@ -1,10 +1,9 @@

1−{-# OPTIONS_GHC -fno-warn-orphans #-}

1+{-# LANGUAGE ConstraintKinds #-}

2−{-# LANGUAGE FlexibleContexts #-}

2+{-# LANGUAGE FlexibleContexts #-}

3−{-# LANGUAGE KindSignatures #-}

3+{-# LANGUAGE KindSignatures #-}

4−{-# LANGUAGE RankNTypes #-}

4+{-# LANGUAGE RankNTypes #-}

5−{-# LANGUAGE ScopedTypeVariables #-}

5+{-# LANGUAGE ScopedTypeVariables #-}

6−{-# LANGUAGE TypeFamilies #-}

6+{-# LANGUAGE TypeFamilies #-}

7−

8module Servant.Client.Generic (

7module Servant.Client.Generic (

9 AsClientT,

8 AsClientT,

10 genericClient,

9 genericClient,

@@ -16,7 +15,11 @@ import Data.Proxy

16

15

17import Servant.API.Generic

16import Servant.API.Generic

18import Servant.Client.Core

17import Servant.Client.Core

19−import Servant.Client.Core.HasClient (AsClientT)

18+

19+-- | A type that specifies that an API record contains a client implementation.

20+data AsClientT (m :: * -> *)

21+instance GenericMode (AsClientT m) where

22+ type AsClientT m :- api = Client m api

20

23

21-- | Generate a record of client functions.

24-- | Generate a record of client functions.

22genericClient

25genericClient

servant-client-core/test/Servant/Client/Core/RequestSpec.hs−12

@@ -10,22 +10,10 @@ import Data.List (isInfixOf)

10import Servant.Client.Core.Request

11import Test.Hspec

12

13−newtype DataWithRequest = DataWithRequest (RequestF RequestBody ())

14− deriving Show

15−

16spec :: Spec

13spec :: Spec

17spec = do

14spec = do

18 describe "Request" $ do

15 describe "Request" $ do

19 describe "show" $ do

16 describe "show" $ do

20− it "has parenthesis correctly positioned" $ do

21− let d = DataWithRequest (void defaultRequest)

22− show d `shouldBe` "DataWithRequest (Request {requestPath = ()\

23− \, requestQueryString = fromList []\

24− \, requestBody = Nothing\

25− \, requestAccept = fromList []\

26− \, requestHeaders = fromList []\

27− \, requestHttpVersion = HTTP/1.1\

28− \, requestMethod = \"GET\"})"

29 it "redacts the authorization header" $ do

17 it "redacts the authorization header" $ do

30 let request = void $ defaultRequest { requestHeaders = pure ("authorization", "secret") }

18 let request = void $ defaultRequest { requestHeaders = pure ("authorization", "secret") }

31 isInfixOf "secret" (show request) `shouldBe` False

19 isInfixOf "secret" (show request) `shouldBe` False

servant-client-ghcjs/servant-client-ghcjs.cabal+6−6

@@ -1,4 +1,4 @@

1−cabal-version: 2.2

1+cabal-version: >=1.10

2name: servant-client-ghcjs

3version: 0.16

4synopsis:

@@ -15,7 +15,7 @@ description:

15

16homepage: http://docs.servant.dev/

17bug-reports: http://github.com/haskell-servant/servant/issues

18−license: BSD-3-Clause

18+license: BSD3

19license-file: LICENSE

20author: Servant Contributors

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

@@ -38,7 +38,7 @@ library

38 Servant.Client.Internal.XhrClient

39

40 build-depends:

41− base >=4.11 && <5

41+ base >=4.11 && <4.12

42 , bytestring >=0.10 && <0.12

43 , case-insensitive >=1.2.0.0 && <1.3.0.0

44 , containers >=0.5 && <0.7

@@ -48,7 +48,7 @@ library

48 , http-media >=0.6.2 && <0.9

49 , http-types >=0.12 && <0.13

50 , monad-control >=1.0.0.4 && <1.1

51− , mtl ^>=2.2.2 || ^>=2.3.1

51+ , mtl >=2.2.2 && <2.3

52 , semigroupoids >=5.3 && <5.4

53 , string-conversions >=0.3 && <0.5

54 , transformers >=0.3 && <0.6

@@ -56,8 +56,8 @@ library

56

57 -- strict, as we re-export stuff

58 build-depends:

59− servant >=0.16 && <0.20

59+ servant >=0.16 && <0.17

60− , servant-client-core >=0.16 && <0.20

60+ , servant-client-core >=0.16 && <0.16.1

61

62 hs-source-dirs: src

63 default-language: Haskell2010

servant-client-ghcjs/src/Servant/Client/Internal/XhrClient.hs+5−8

@@ -120,7 +120,7 @@ instance Exception StreamingNotSupportedException where

120 displayException _ = "streamingRequest: streaming is not supported!"

121

122instance RunClient ClientM where

123− runRequestAcceptStatus = performRequest

123+ runRequest = performRequest

124 throwClientError = throwError

125

126runClientMOrigin :: ClientM a -> ClientEnv -> IO (Either ClientError a)

@@ -152,18 +152,15 @@ runClientM m = do

152

153 runClientMOrigin m (ClientEnv (BaseUrl protocol hostname port ""))

154

155−performRequest :: Maybe [Status] -> Request -> ClientM Response

155+performRequest :: Request -> ClientM Response

156−performRequest acceptStatus req = do

156+performRequest req = do

157 xhr <- liftIO initXhr

158 burl <- asks baseUrl

159 liftIO $ performXhr xhr burl req

160 resp <- toResponse xhr

161

162− let status = responseStatusCode resp

162+ let status = statusCode (responseStatusCode resp)

163− goodStatus = case acceptStatus of

163+ unless (status >= 200 && status < 300) $ do

164− Nothing -> statusIsSuccessful status

165− Just good -> status `elem` good

166− unless goodStatus $ do

167 let f b = (burl, BL.toStrict $ toLazyByteString b)

164 let f b = (burl, BL.toStrict $ toLazyByteString b)

168 throwError $ FailureResponse (bimap (const ()) f req) resp

165 throwError $ FailureResponse (bimap (const ()) f req) resp

169

166

servant-client/CHANGELOG.md−31

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

1[The latest version of this document is on GitHub.](https://github.com/haskell-servant/servant/blob/master/servant-client/CHANGELOG.md)