861cd4f..master · typeable/servant

.github/workflows/master.yml+17−29

since splitsnapshots

unifiedsplit

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

13 strategy:

14 matrix:

15 os: [ubuntu-latest]

16− cabal: ["3.4"]

16+ cabal: ["3.6"]

17 ghc:

18 - "8.6.5"

19 - "8.8.4"

20 - "8.10.7"

21− - "9.0.1"

21+ - "9.0.2"

22+ - "9.2.2"

22

23

23 steps:

24 steps:

24 - uses: actions/checkout@v2

25 - uses: actions/checkout@v2

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

47

48

48 - name: Configure

49 - name: Configure

49 run: |

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

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

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

54

52

55 - name: Build

53 - name: Build

56 run: |

54 run: |

@@ -61,39 +59,29 @@ jobs:

61 cabal test all

59 cabal test all

62

60

63 - name: Run doctests

61 - 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' }}

67 run: |

62 run: |

68 # Necessary for doctest to be found in $PATH

63 # Necessary for doctest to be found in $PATH

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

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

70

65

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

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

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−

79− (cd servant && doctest src)

67+ (cd servant && eval $DOCTEST)

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

89

77

90 stack:

78 stack:

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

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

92 runs-on: ubuntu-latest

80 runs-on: ubuntu-latest

93 strategy:

81 strategy:

94 matrix:

82 matrix:

95− stack: ["2.7.3"]

83+ stack: ["2.7.5"]

96− ghc: ["8.10.4"]

84+ ghc: ["8.10.7"]

97

85

98 steps:

86 steps:

99 - uses: actions/checkout@v2

87 - uses: actions/checkout@v2

.gitignore+1

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

31doc/tutorial/static/api.js

32doc/tutorial/static/jq.js

33shell.nix

34+.hspec-failures

34

35

35# nix

36# nix

36result*

37result*

CONTRIBUTING.md+4−2

@@ -79,8 +79,10 @@ 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 #servant on freenode and let us know, or open an

82+know about it! Either hop on

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

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

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

85+read it).

84

86

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

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

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

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

cabal.project+1−23

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

12 servant-docs/

13 servant-foreign/

14 servant-server/

15+ servant-swagger/

15 doc/tutorial/

16 doc/tutorial/

16

17

17-- servant streaming

18-- servant streaming

@@ -50,26 +51,3 @@ packages:

50tests: True

51tests: True

51optimization: False

52optimization: False

52-- reorder-goals: True

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

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

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

2+prs: #1469

3+description: {

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

5+`clientWithRoute` definitions.

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

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

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

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

10+the `Verb` status.

11+}

changelog.d/1529new file+10

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

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

2+prs: #1529

3+

4+description: {

5+

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

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

8+functionality to match what servant-client provides.

9+

10+}

changelog.d/1556new file+81

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

1+synopsis: Display capture hints in router layout

2+prs: #1556

3+

4+description: {

5+

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

7+

8+Example:

9+

10+For the following API

11+```haskell

12+type API =

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

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

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

16+```

17+

18+we previously got the following output:

19+

20+```

21+/

22+├─ a/

23+│ ├─ d/

24+│ │ └─•

25+│ └─ e/

26+│ └─•

27+└─ b/

28+ └─ <capture>/

29+ ├─•

30+ ┆

31+ └─•

32+```

33+

34+now we get:

35+

36+```

37+/

38+├─ a/

39+│ ├─ d/

40+│ │ └─•

41+│ └─ e/

42+│ └─•

43+└─ b/

44+ └─ <x::Int>/

45+ ├─•

46+ ┆

47+ └─•

48+```

49+

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

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

52+

53+N.B.:

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

55+

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

57+

58+Warning:

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

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

61+

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

63+```haskell

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

65+

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

67+myServer = const $ return ()

68+

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

70+myApi = Proxy

71+

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

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

74+```

75+

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

77+```haskell

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

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

80+```

81+}

changelog.d/1569new file+13

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

1+synopsis: Encode captures using toEncodedUrlPiece

2+prs: #1569

3+issues: #1511

4+

5+description: {

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

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

8+URL-encoding however they need.

9+

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

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

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

13+}

changelog.d/1580new file+12

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

1+synopsis: Allow IO in validationKeys

2+prs: #1580

3+issues: #1579

4+

5+description: {

6+

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

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

9+discover new and expired keys.

10+

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

12+}

changelog.d/1589new file+2

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

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

2+prs: 1589

changelog.d/1595new file+2

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

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

2+prs: #1595

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 building-the-docs file."; fi

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

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

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

16

doc/conf.py+1−2

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

46

47# General information about the project.

48project = u'Servant'

49−copyright = u'2018, Servant Contributors'

49+copyright = u'2022, Servant Contributors'

50author = u'Servant Contributors'

51

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

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

169source_parsers = {

170 '.lhs': CommonMarkParser,

171}

172−

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

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

1+cabal-version: 2.2

1name: cookbook-basic-auth

2name: cookbook-basic-auth

2version: 0.1

3version: 0.1

3synopsis: Basic Authentication cookbook example

4synopsis: Basic Authentication cookbook example

@@ -7,7 +8,6 @@ license-file: ../../../servant/LICENSE

7author: Servant Contributors

8author: Servant Contributors

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

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

9build-type: Simple

10build-type: Simple

10−cabal-version: >=1.10

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

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

1+cabal-version: 2.2

1name: cookbook-basic-streaming

2name: cookbook-basic-streaming

2version: 2.1

3version: 2.1

3synopsis: Streaming in servant without streaming libs

4synopsis: Streaming in servant without streaming libs

@@ -7,7 +8,6 @@ license-file: ../../../servant/LICENSE

7author: Servant Contributors

8author: Servant Contributors

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

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

9build-type: Simple

10build-type: Simple

10−cabal-version: >=1.10

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

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

1+cabal-version: 2.2

1name: cookbook-curl-mock

2name: cookbook-curl-mock

2version: 0.1

3version: 0.1

3synopsis: Generate curl mock requests cookbook example

4synopsis: Generate curl mock requests cookbook example

@@ -7,10 +8,12 @@ license-file: ../../../servant/LICENSE

7author: Servant Contributors

8author: Servant Contributors

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

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

9build-type: Simple

10build-type: Simple

10−cabal-version: >=1.10

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

14 main-is: CurlMock.lhs

17 main-is: CurlMock.lhs

15 build-depends: base == 4.*

18 build-depends: base == 4.*

16 , aeson

19 , aeson

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

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

1+cabal-version: 2.2

1name: cookbook-custom-errors

2name: cookbook-custom-errors

2version: 0.1

3version: 0.1

3synopsis: Return custom error messages from combinators

4synopsis: Return custom error messages from combinators

@@ -7,7 +8,6 @@ license-file: ../../../servant/LICENSE

7author: Servant Contributors

8author: Servant Contributors

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

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

9build-type: Simple

10build-type: Simple

10−cabal-version: >=1.10

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

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

1+cabal-version: 2.2

1name: mysql-basics

2name: mysql-basics

2version: 0.1.0.0

3version: 0.1.0.0

3synopsis: Simple MySQL API cookbook example

4synopsis: Simple MySQL API cookbook example

@@ -7,7 +8,6 @@ license-file: ../../../servant/LICENSE

7author: Servant Contributors

8author: Servant Contributors

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

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

9build-type: Simple

10build-type: Simple

10−cabal-version: >=1.10

11

12executable run

13 hs-source-dirs: .

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

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

1+cabal-version: 2.2

1name: cookbook-db-postgres-pool

2name: cookbook-db-postgres-pool

2version: 0.1

3version: 0.1

3synopsis: Simple PostgreSQL connection pool cookbook example

4synopsis: Simple PostgreSQL connection pool cookbook example

@@ -7,7 +8,6 @@ license-file: ../../../servant/LICENSE

7author: Servant Contributors

8author: Servant Contributors

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

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

9build-type: Simple

10build-type: Simple

10−cabal-version: >=1.10

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

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

1+cabal-version: 2.2

1name: cookbook-db-sqlite-simple

2name: cookbook-db-sqlite-simple

2version: 0.1

3version: 0.1

3synopsis: Simple SQLite DB cookbook example

4synopsis: Simple SQLite DB cookbook example

@@ -7,7 +8,6 @@ license-file: ../../../servant/LICENSE

7author: Servant Contributors

8author: Servant Contributors

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

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

9build-type: Simple

10build-type: Simple

10−cabal-version: >=1.10

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

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

1+cabal-version: 2.2

1name: cookbook-file-upload

2name: cookbook-file-upload

2version: 0.1

3version: 0.1

3synopsis: File upload cookbook example

4synopsis: File upload cookbook example

@@ -7,7 +8,6 @@ license-file: ../../../servant/LICENSE

7author: Servant Contributors

8author: Servant Contributors

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

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

9build-type: Simple

10build-type: Simple

10−cabal-version: >=1.10

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

12

13executable cookbook-file-upload

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

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

1+cabal-version: 2.2

1name: cookbook-generic

2name: cookbook-generic

2version: 0.1

3version: 0.1

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

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

@@ -7,7 +8,6 @@ license-file: ../../../servant/LICENSE

7author: Servant Contributors

8author: Servant Contributors

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

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

9build-type: Simple

10build-type: Simple

10−cabal-version: >=1.10

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

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

1+cabal-version: 2.2

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

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

2version: 0.0.1

3version: 0.0.1

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

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

@@ -10,7 +11,6 @@ author: Servant Contributors

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

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

11category: Servant

12category: Servant

12build-type: Simple

13build-type: Simple

13−cabal-version: >=1.10

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

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

1+cabal-version: 2.2

1name: cookbook-https

2name: cookbook-https

2version: 0.1

3version: 0.1

3synopsis: HTTPS cookbook example

4synopsis: HTTPS cookbook example

@@ -7,7 +8,6 @@ license-file: ../../../servant/LICENSE

7author: Servant Contributors

8author: Servant Contributors

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

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

9build-type: Simple

10build-type: Simple

10−cabal-version: >=1.10

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

12

13executable cookbook-https

doc/cookbook/index.rst+2−2

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

6interested in contributing examples of your own, feel free

7to open an issue or a pull request on

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

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

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

10−on freenode or on

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

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

12

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

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

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

1+cabal-version: 2.2

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

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

2version: 0.0.1

3version: 0.0.1

3synopsis: JWT and basic access authentication cookbook example

4synopsis: JWT and basic access authentication cookbook example

@@ -10,7 +11,6 @@ author: Servant Contributors

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

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

11category: Servant

12category: Servant

12build-type: Simple

13build-type: Simple

13−cabal-version: >=1.10

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

15

16executable cookbook-jwt-and-basic-auth

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

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

1+cabal-version: 2.2

1name: open-id-connect

2name: open-id-connect

2version: 0.1

3version: 0.1

3synopsis: OpenId Connect with Servant example

4synopsis: OpenId Connect with Servant example

@@ -7,7 +8,6 @@ license-file: ../../../servant/LICENSE

7author: Servant Contributors

8author: Servant Contributors

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

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

9build-type: Simple

10build-type: Simple

10−cabal-version: >= 1.10

11tested-with: GHC==8.6.5

12

13executable cookbook-openidconnect

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

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

1+cabal-version: 2.2

1name: cookbook-pagination

2name: cookbook-pagination

2version: 2.1

3version: 2.1

3synopsis: Pagination with Servant example

4synopsis: Pagination with Servant example

@@ -7,7 +8,6 @@ license-file: ../../../servant/LICENSE

7author: Servant Contributors

8author: Servant Contributors

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

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

9build-type: Simple

10build-type: Simple

10−cabal-version: >=1.10

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

12

13executable cookbook-pagination

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

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

1+cabal-version: 2.2

1name: cookbook-sentry

2name: cookbook-sentry

2version: 0.1

3version: 0.1

3synopsis: Collecting runtime exceptions using Sentry

4synopsis: Collecting runtime exceptions using Sentry

@@ -7,7 +8,6 @@ license-file: ../../../servant/LICENSE

7author: Servant Contributors

8author: Servant Contributors

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

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

9build-type: Simple

10build-type: Simple

10−cabal-version: >=1.10

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

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

1+cabal-version: 2.2

1name: cookbook-structuring-apis

2name: cookbook-structuring-apis

2version: 0.1

3version: 0.1

3synopsis: Example that shows how APIs can be structured

4synopsis: Example that shows how APIs can be structured

@@ -7,7 +8,6 @@ license-file: ../../../servant/LICENSE

7author: Servant Contributors

8author: Servant Contributors

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

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

9build-type: Simple

10build-type: Simple

10−cabal-version: >=1.10

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

12

13executable cookbook-structuring-apis

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

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

1+cabal-version: 2.2

1name: cookbook-testing

2name: cookbook-testing

2version: 0.0.1

3version: 0.0.1

3synopsis: Common testing patterns in Servant apps

4synopsis: Common testing patterns in Servant apps

@@ -9,7 +10,6 @@ author: Servant Contributors

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

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

10category: Servant

11category: Servant

11build-type: Simple

12build-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+1−1

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

1+cabal-version: 2.2

1name: cookbook-using-custom-monad

2name: cookbook-using-custom-monad

2version: 0.1

3version: 0.1

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

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

@@ -7,7 +8,6 @@ license-file: ../../../servant/LICENSE

7author: Servant Contributors

8author: Servant Contributors

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

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

9build-type: Simple

10build-type: Simple

10−cabal-version: >=1.10

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− let req' = I.defaultMakeClientRequest burl req

122+ req' <- I.defaultMakeClientRequest burl req

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

124```

125

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

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

1+cabal-version: 2.2

1name: cookbook-using-free-client

2name: cookbook-using-free-client

2version: 0.1

3version: 0.1

3synopsis: Using Free client

4synopsis: Using Free client

@@ -7,7 +8,6 @@ license-file: ../../../servant/LICENSE

7author: Servant Contributors

8author: Servant Contributors

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

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

9build-type: Simple

10build-type: Simple

10−cabal-version: >=1.10

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

12

13executable cookbook-using-free-client

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

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

1+cabal-version: 2.2

1name: cookbook-uverb

2name: cookbook-uverb

2version: 0.0.1

3version: 0.0.1

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

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

@@ -9,7 +10,6 @@ author: Servant Contributors

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

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

10category: Servant

11category: Servant

11build-type: Simple

12build-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− ``#servant`` on freenode

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

16

17- the mailing list:

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

doc/tutorial/install.rst+26

@@ -40,3 +40,29 @@ 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+2−2

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

1+cabal-version: 2.2

1name: tutorial

2name: tutorial

2version: 0.10

3version: 0.10

3synopsis: The servant tutorial

4synopsis: The servant tutorial

@@ -11,7 +12,6 @@ license-file: LICENSE

11author: Servant Contributors

12author: Servant Contributors

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

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

13build-type: Simple

14build-type: Simple

14−cabal-version: >=1.10

15tested-with:

16 GHC==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.10

67+ , lucid >= 2.9.11 && < 2.12

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

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

1+cabal-version: 2.2

1name: servant-auth-client

2name: servant-auth-client

2version: 0.4.1.0

3version: 0.4.1.0

3synopsis: servant-client/servant-auth compatibility

4synopsis: servant-client/servant-auth compatibility

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

6 APIs that use

7 APIs that use

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

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

8 .

9 .

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

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

10category: Web, Servant, Authentication

11category: Web, Servant, Authentication

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

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

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

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

13author: Julian K. Arni

14author: Julian K. Arni

14maintainer: jkarni@gmail.com

15maintainer: jkarni@gmail.com

@@ -17,7 +18,6 @@ license: BSD-3-Clause

17license-file: LICENSE

18license-file: LICENSE

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

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

19build-type: Simple

20build-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.16

34+ base >= 4.10 && < 4.17

35− , bytestring >= 0.10.6.0 && < 0.11

35+ , bytestring >= 0.10.6.0 && < 0.12

36 , containers >= 0.5.6.2 && < 0.7

37 , servant-auth == 0.4.*

38− , servant >= 0.13 && < 0.19

38+ , servant >= 0.13 && < 0.20

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

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

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

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

54

55 -- dependencies with bounds inherited from the library stanza

56 build-depends:

@@ -62,19 +62,19 @@ test-suite spec

62

63 -- test dependencies

64 build-depends:

65− hspec >= 2.5.5 && < 2.9

65+ hspec >= 2.5.5 && < 2.10

66 , QuickCheck >= 2.11.3 && < 2.15

67− , aeson >= 1.3.1.1 && < 1.6

67+ , aeson >= 1.3.1.1 && < 3

68− , bytestring >= 0.10.6.0 && < 0.11

68+ , bytestring >= 0.10.6.0 && < 0.12

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

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

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

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

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

73 , time >= 1.5.0.1 && < 1.13

74 , transformers >= 0.4.2.0 && < 0.6

75 , wai >= 3.2.1.2 && < 3.3

76 , warp >= 3.2.25 && < 3.4

77− , jose >= 0.7.0.0 && < 0.9

77+ , jose >= 0.7.0.0 && < 0.10

78 other-modules:

79 Servant.Auth.ClientSpec

80 default-language: Haskell2010

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

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

1+cabal-version: 2.2

1name: servant-auth-docs

2name: servant-auth-docs

2version: 0.2.10.0

3version: 0.2.10.0

3synopsis: servant-docs/servant-auth compatibility

4synopsis: servant-docs/servant-auth compatibility

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

6 APIs that use

7 APIs that use

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

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

8 .

9 .

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

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

10category: Web, Servant, Authentication

11category: Web, Servant, Authentication

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

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

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

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

13author: Julian K. Arni

14author: Julian K. Arni

14maintainer: jkarni@gmail.com

15maintainer: jkarni@gmail.com

@@ -17,7 +18,6 @@ license: BSD-3-Clause

17license-file: LICENSE

18license-file: LICENSE

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

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

19build-type: Custom

20build-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.16

38+ base >= 4.10 && < 4.17

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

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

40− , servant >= 0.13 && < 0.19

40+ , servant >= 0.13 && < 0.20

41 , servant-auth == 0.4.*

42− , lens >= 4.16.1 && <5.1

42+ , lens >= 4.16.1 && <5.2

43 exposed-modules:

44 Servant.Auth.Docs

45 default-language: Haskell2010

@@ -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.9

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

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

81+ , hspec >= 2.5.5 && < 2.10

82 , QuickCheck >= 2.11.3 && < 2.15

83

84 default-language: Haskell2010

servant-auth/servant-auth-server/servant-auth-server.cabal+18−18

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

1+cabal-version: 2.2

1name: servant-auth-server

2name: servant-auth-server

2−version: 0.4.6.0

3+version: 0.4.7.0

3synopsis: servant-server/servant-auth compatibility

4synopsis: servant-server/servant-auth compatibility

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

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

5 in your 'servant' server.

6 in your 'servant' server.

6 .

7 .

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

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

8 .

9 .

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

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

10category: Web, Servant, Authentication

11category: Web, Servant, Authentication

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

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

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

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

13author: Julian K. Arni

14author: Julian K. Arni

14maintainer: jkarni@gmail.com

15maintainer: jkarni@gmail.com

@@ -17,7 +18,6 @@ license: BSD-3-Clause

17license-file: LICENSE

18license-file: LICENSE

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

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

19build-type: Simple

20build-type: Simple

20−cabal-version: >= 1.10

21extra-source-files:

22 CHANGELOG.md

23

@@ -31,27 +31,27 @@ 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.16

34+ base >= 4.10 && < 4.17

35− , aeson >= 1.3.1.1 && < 1.6

35+ , aeson >= 1.0.0.1 && < 3

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

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

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

38− , bytestring >= 0.10.6.0 && < 0.11

38+ , bytestring >= 0.10.6.0 && < 0.12

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.7.0.0 && < 0.9

44+ , jose >= 0.7.0.0 && < 0.10

45− , lens >= 4.16.1 && < 5.1

45+ , lens >= 4.16.1 && < 5.2

46− , memory >= 0.14.16 && < 0.17

46+ , memory >= 0.14.16 && < 0.18

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

48 , mtl >= 2.2.2 && < 2.3

49− , servant >= 0.13 && < 0.19

49+ , servant >= 0.13 && < 0.20

50 , servant-auth == 0.4.*

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

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

52 , tagged >= 0.8.4 && < 0.9

53− , text >= 1.2.3.0 && < 1.3

53+ , text >= 1.2.3.0 && < 2.1

54− , time >= 1.5.0.1 && < 1.10

54+ , time >= 1.5.0.1 && < 1.12

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

56 , wai >= 3.2.1.2 && < 3.3

57

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

102 test

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

104 ghc-options: -Wall

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

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

106

107 -- dependencies with bounds inherited from the library stanza

108 build-depends:

@@ -123,10 +123,10 @@ test-suite spec

123 -- test dependencies

124 build-depends:

125 servant-auth-server

126− , hspec >= 2.5.5 && < 2.8

126+ , hspec >= 2.5.5 && < 2.10

127 , QuickCheck >= 2.11.3 && < 2.15

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

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

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

130 , warp >= 3.2.25 && < 3.4

131 , wreq >= 0.5.2.1 && < 0.6

132 other-modules:

servant-auth/servant-auth-server/src/Servant/Auth/Server/Internal/AddSetCookie.hs+12

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

11import qualified Network.HTTP.Types as HTTP

12import Network.Wai (mapResponseHeaders)

13import Servant

14+import Servant.API.Generic

15+import Servant.Server.Generic

14import Web.Cookie

16import Web.Cookie

15

17

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

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

@@ -34,6 +36,7 @@ type family AddSetCookieApiVerb a where

34type family AddSetCookieApi a :: *

36type family AddSetCookieApi a :: *

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

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

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

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

39+type instance AddSetCookieApi (NamedRoutes api) = AddSetCookieApi (ToServantApi api)

37type instance AddSetCookieApi (Verb method stat ctyps a)

40type instance AddSetCookieApi (Verb method stat ctyps a)

38 = Verb method stat ctyps (AddSetCookieApiVerb a)

41 = Verb method stat ctyps (AddSetCookieApiVerb a)

39type instance AddSetCookieApi Raw = Raw

42type instance AddSetCookieApi Raw = Raw

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

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

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

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

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

74

77

78+instance {-# OVERLAPS #-}

79+ ( AddSetCookies ('S n) (ServerT (ToServantApi api) m) cookiedApi

80+ , Generic (api (AsServerT m))

81+ , GServantProduct (Rep (api (AsServerT m)))

82+ , ToServant api (AsServerT m) ~ ServerT (ToServantApi api) m

83+ )

84+ => AddSetCookies ('S n) (api (AsServerT m)) cookiedApi where

85+ addSetCookies cookies = addSetCookies cookies . toServant

86+

75-- | for @servant <0.11@

87-- | for @servant <0.11@

76instance

88instance

77 AddSetCookies ('S n) Application Application where

89 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 :: Jose.JWKSet

36+ , validationKeys :: IO 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 = Jose.JWKSet [k]

47+ , validationKeys = pure $ 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/JWT.hs+4−3

@@ -58,14 +58,15 @@ makeJWT v cfg expiry = runExceptT $ do

58

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

60verifyJWT jwtCfg input = do

61+ keys <- validationKeys jwtCfg

61− verifiedJWT <- liftIO $ runExceptT $ do

62+ verifiedJWT <- runExceptT $ do

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

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

63 Jose.verifyClaims

64 Jose.verifyClaims

64 (jwtSettingsToJwtValidationSettings jwtCfg)

65 (jwtSettingsToJwtValidationSettings jwtCfg)

65− (validationKeys jwtCfg)

66+ keys

66 unverifiedJWT

67 unverifiedJWT

67 return $ case verifiedJWT of

68 return $ case verifiedJWT of

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

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

69 Right v -> case decodeJWT v of

70 Right v -> case decodeJWT v of

70 Left _ -> Nothing

71 Left _ -> Nothing

71− Right v' -> Just v'

72+ Right v' -> Just v'

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

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

8

9import Control.Monad.Error.Class

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

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

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

12+import Servant.API.Generic

13+import Servant.Server.Generic

14+import Servant.Server

12import Network.HTTP.Types

15import Network.HTTP.Types

13import Network.Wai

16import Network.Wai

14

17

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

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

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

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

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

28

31

32+instance

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

34+ ThrowAll (api (AsServerT m)) where

35+

36+ throwAll = fromServant . throwAll

37+

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

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

30-- MonadError, no?

39-- MonadError, no?

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

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

servant-auth/servant-auth-server/test/Servant/Auth/ServerSpec.hs+7

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

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

51import Servant hiding (BasicAuth,

52 IsSecure (..), header)

53+import Servant.API.Generic ((:-))

53import Servant.Auth.Server

54import Servant.Auth.Server

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

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

55import Servant.Auth.Server.SetCookieOrphan ()

56import Servant.Auth.Server.SetCookieOrphan ()

@@ -405,6 +406,7 @@ type API auths

405 = Auth auths User :>

406 = Auth auths User :>

406 ( Get '[JSON] Int

407 ( Get '[JSON] Int

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

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

409+ :<|> NamedRoutes DummyRoutes

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

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

409#if MIN_VERSION_servant_server(0,15,0)

411#if MIN_VERSION_servant_server(0,15,0)

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

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

@@ -416,6 +418,10 @@ type API auths

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

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

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

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

418

420

421+data DummyRoutes mode = DummyRoutes

422+ { dummyInt :: mode :- "dummy" :> Get '[JSON] Int

423+ } deriving Generic

424+

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

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

420jwtOnlyApi = Proxy

426jwtOnlyApi = Proxy

421

427

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

476 (\authResult -> case authResult of

482 (\authResult -> case authResult of

477 Authenticated usr -> getInt usr

483 Authenticated usr -> getInt usr

478 :<|> postInt usr

484 :<|> postInt usr

485+ :<|> DummyRoutes { dummyInt = getInt usr }

479 :<|> getHeaderInt

486 :<|> getHeaderInt

480#if MIN_VERSION_servant_server(0,15,0)

487#if MIN_VERSION_servant_server(0,15,0)

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

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

servant-auth/servant-auth-swagger/servant-auth-swagger.cabal+12−16

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

1+cabal-version: 2.2

1name: servant-auth-swagger

2name: servant-auth-swagger

2version: 0.2.10.1

3version: 0.2.10.1

3synopsis: servant-swagger/servant-auth compatibility

4synopsis: servant-swagger/servant-auth compatibility

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

6 APIs that use

7 APIs that use

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

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

8 .

9 .

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

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

10category: Web, Servant, Authentication

11category: Web, Servant, Authentication

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

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

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

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

13author: Julian K. Arni

14author: Julian K. Arni

14maintainer: jkarni@gmail.com

15maintainer: jkarni@gmail.com

@@ -17,7 +18,6 @@ license: BSD-3-Clause

17license-file: LICENSE

18license-file: LICENSE

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

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

19build-type: Simple

20build-type: Simple

20−cabal-version: >= 1.10

21extra-source-files:

22 CHANGELOG.md

23

@@ -31,15 +31,13 @@ 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.16

34+ base >= 4.10 && < 4.17

35− , text >= 1.2.3.0 && < 1.3

35+ , text >= 1.2.3.0 && < 2.1

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

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

37− , swagger2 >= 2.2.2 && < 2.7

37+ , swagger2 >= 2.2.2 && < 3

38− , servant >= 0.13 && < 0.19

38+ , servant >= 0.13 && < 0.20

39 , servant-auth == 0.4.*

40− , lens >= 4.16.1 && < 5.1

40+ , lens >= 4.16.1 && < 5.2

41− if impl(ghc >= 9)

42− buildable: False

43 exposed-modules:

41 exposed-modules:

44 Servant.Auth.Swagger

42 Servant.Auth.Swagger

45 default-language: Haskell2010

43 default-language: Haskell2010

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

51 test

49 test

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

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

53 ghc-options: -Wall

51 ghc-options: -Wall

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

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

55 -- dependencies with bounds inherited from the library stanza

53 -- dependencies with bounds inherited from the library stanza

56 build-depends:

54 build-depends:

57 base

55 base

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

61 , servant

59 , servant

62 , servant-auth

60 , servant-auth

63 , lens

61 , lens

64− if impl(ghc >= 9)

62+

65− buildable: False

66−

67 -- test dependencies

63 -- test dependencies

68 build-depends:

64 build-depends:

69 servant-auth-swagger

65 servant-auth-swagger

70− , hspec >= 2.5.5 && < 2.9

66+ , hspec >= 2.5.5 && < 2.10

71 , QuickCheck >= 2.11.3 && < 2.15

67 , QuickCheck >= 2.11.3 && < 2.15

72 other-modules:

68 other-modules:

73 Servant.Auth.SwaggerSpec

69 Servant.Auth.SwaggerSpec

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

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

1+cabal-version: 2.2

1name: servant-auth

2name: servant-auth

2−version: 0.4.0.0

3+version: 0.4.1.0

3synopsis: Authentication combinators for servant

4synopsis: Authentication combinators for servant

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

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

5 allows using different authentication schemes in a straightforward way,

6 allows using different authentication schemes in a straightforward way,

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

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

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

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

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

10 .

11 .

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

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

12category: Web, Servant, Authentication

13category: Web, Servant, Authentication

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

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

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

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

15author: Julian K. Arni

16author: Julian K. Arni

16maintainer: jkarni@gmail.com

17maintainer: jkarni@gmail.com

@@ -19,7 +20,6 @@ license: BSD-3-Clause

19license-file: LICENSE

20license-file: LICENSE

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

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

21build-type: Simple

22build-type: Simple

22−cabal-version: >= 1.10

23extra-source-files:

24 CHANGELOG.md

25

@@ -33,12 +33,13 @@ 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.16

36+ base >= 4.10 && < 4.17

37+ , containers >= 0.6 && < 0.7

37− , aeson >= 1.3.1.1 && < 1.6

38+ , aeson >= 1.3.1.1 && < 3

38− , jose >= 0.7.0.0 && < 0.9

39+ , jose >= 0.7.0.0 && < 0.10

39− , lens >= 4.16.1 && < 5.1

40+ , lens >= 4.16.1 && < 5.2

40− , servant >= 0.15 && < 0.19

41+ , servant >= 0.15 && < 0.20

41− , text >= 1.2.3.0 && < 1.3

42+ , text >= 1.2.3.0 && < 2.1

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

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

43 exposed-modules:

44 exposed-modules:

44 Servant.Auth

45 Servant.Auth

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

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

1+{-# LANGUAGE CPP #-}

2+

1module Servant.Auth.JWT where

3module Servant.Auth.JWT where

2

4

3import Control.Lens ((^.))

5import Control.Lens ((^.))

4import qualified Crypto.JWT as Jose

6import qualified Crypto.JWT as Jose

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

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

6 toJSON)

8 toJSON)

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

10+import qualified Data.Map as KM

11+#else

7−import qualified Data.HashMap.Strict as HM

12+import qualified Data.HashMap.Strict as KM

13+#endif

14+

8import qualified Data.Text as T

15import qualified Data.Text as T

9

16

10

17

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

17class FromJWT a where

24class FromJWT a where

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

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

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

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

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

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

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

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

22 Just v -> case fromJSON v of

29 Just v -> case fromJSON v of

23 Error e -> Left $ T.pack e

30 Error e -> Left $ T.pack e

servant-client-core/CHANGELOG.md+31

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

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+

40.18.3

350.18.3

5------

36------

6

37

servant-client-core/servant-client-core.cabal+11−11

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

1−cabal-version: >=1.10

1+cabal-version: 2.2

2name: servant-client-core

3−version: 0.18.3

3+version: 0.19

4

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

6category: Servant, Web

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

50 --

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

52 build-depends:

53− base >= 4.9 && < 4.16

53+ base >= 4.9 && < 4.17

54 , bytestring >= 0.10.8.1 && < 0.12

55− , constraints

55+ , constraints >= 0.2 && < 0.14

56 , containers >= 0.5.7.1 && < 0.7

57 , deepseq >= 1.4.2.0 && < 1.5

58− , text >= 1.2.3.0 && < 1.3

58+ , text >= 1.2.3.0 && < 2.1

59 , transformers >= 0.5.2.0 && < 0.6

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

60+ , template-haskell >= 2.11.1.0 && < 2.19

61

62 if !impl(ghc >= 8.2)

63 build-depends:

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

65

66 -- Servant dependencies

67 build-depends:

68− servant >= 0.18.3 && <0.19

68+ servant >= 0.19

69

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

72 build-depends:

73− aeson >= 1.4.1.0 && < 1.6

73+ aeson >= 1.4.1.0 && < 3

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

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

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

76 , exceptions >= 0.10.0 && < 0.11

77 , free >= 5.1 && < 5.2

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

104 -- Additional dependencies

105 build-depends:

106 deepseq >= 1.4.2.0 && < 1.5

107− , hspec >= 2.6.0 && < 2.9

107+ , hspec >= 2.6.0 && < 2.10

108 , QuickCheck >= 2.12.6.1 && < 2.15

109

110 build-tool-depends:

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

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

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

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

59 , appendToPath

60 , setRequestBodyLBS

61 , setRequestBody

62+ , encodeQueryParamValue

62 ) where

63 ) where

63import Servant.Client.Core.Auth

64import Servant.Client.Core.Auth

64import Servant.Client.Core.BaseUrl

65import Servant.Client.Core.BaseUrl

servant-client-core/src/Servant/Client/Core/HasClient.hs+170−36

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

1{-# LANGUAGE ConstraintKinds #-}

2−{-# LANGUAGE CPP #-}

3{-# LANGUAGE DataKinds #-}

2{-# LANGUAGE DataKinds #-}

4{-# LANGUAGE FlexibleContexts #-}

3{-# LANGUAGE FlexibleContexts #-}

5{-# LANGUAGE FlexibleInstances #-}

4{-# LANGUAGE FlexibleInstances #-}

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

7{-# LANGUAGE MultiParamTypeClasses #-}

6{-# LANGUAGE MultiParamTypeClasses #-}

8{-# LANGUAGE OverloadedStrings #-}

7{-# LANGUAGE OverloadedStrings #-}

9{-# LANGUAGE PolyKinds #-}

8{-# LANGUAGE PolyKinds #-}

9+{-# LANGUAGE QuantifiedConstraints #-}

10{-# LANGUAGE RankNTypes #-}

11{-# LANGUAGE ScopedTypeVariables #-}

12{-# LANGUAGE TypeApplications #-}

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

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−

21module Servant.Client.Core.HasClient (

17module Servant.Client.Core.HasClient (

22 clientIn,

18 clientIn,

23 HasClient (..),

19 HasClient (..),

24 EmptyClient (..),

20 EmptyClient (..),

21+ AsClientT,

22+ (//),

23+ (/:),

25 foldMapUnion,

24 foldMapUnion,

26 matchUnion,

25 matchUnion,

27 ) where

26 ) where

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

34import Control.Monad

33import Control.Monad

35 (unless)

34 (unless)

36import qualified Data.ByteString as BS

35import qualified Data.ByteString as BS

37−import Data.ByteString.Builder

38− (toLazyByteString)

39−import qualified Data.ByteString.Lazy as BL

36+import qualified Data.ByteString.Lazy as BL

40import Data.Either

37import Data.Either

41 (partitionEithers)

38 (partitionEithers)

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

42import Data.Foldable

40import Data.Foldable

43 (toList)

41 (toList)

44import Data.List

42import Data.List

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

47 (fromList)

45 (fromList)

48import qualified Data.Text as T

46import qualified Data.Text as T

49import Network.HTTP.Media

47import Network.HTTP.Media

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

48+ (MediaType, matches, parseAccept)

49+import qualified Network.HTTP.Media as Media

51import qualified Data.Sequence as Seq

50import qualified Data.Sequence as Seq

52import Data.SOP.BasicFunctors

51import Data.SOP.BasicFunctors

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

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

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

64import Data.Proxy

63import Data.Proxy

65 (Proxy (Proxy))

64 (Proxy (Proxy))

66import GHC.TypeLits

65import GHC.TypeLits

67− (KnownSymbol, symbolVal)

66+ (KnownNat, KnownSymbol, TypeError, symbolVal)

68import Network.HTTP.Types

67import Network.HTTP.Types

69 (Status)

68 (Status)

70import qualified Network.HTTP.Types as H

69import qualified Network.HTTP.Types as H

@@ -79,12 +78,18 @@ import Servant.API

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

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

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

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

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

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

82− getResponse, toEncodedUrlPiece, toUrlPiece)

81+ getResponse, toEncodedUrlPiece, toUrlPiece, NamedRoutes)

82+import Servant.API.Generic

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

84+ , GenericServant, toServant, fromServant)

83import Servant.API.ContentTypes

85import Servant.API.ContentTypes

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

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

87+import Servant.API.Status

88+ (statusFromNat)

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

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

86import Servant.API.Modifiers

90import Servant.API.Modifiers

87 (FoldRequired, RequiredArgument, foldRequiredArgument)

91 (FoldRequired, RequiredArgument, foldRequiredArgument)

92+import Servant.API.TypeErrors

88import Servant.API.UVerb

93import Servant.API.UVerb

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

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

90

95

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

203 clientWithRoute pm (Proxy :: Proxy api)

208 clientWithRoute pm (Proxy :: Proxy api)

204 (appendToPath p req)

209 (appendToPath p req)

205

210

206− where p = (toUrlPiece val)

211+ where p = toEncodedUrlPiece val

207

212

208 hoistClientMonad pm _ f cl = \a ->

213 hoistClientMonad pm _ f cl = \a ->

209 hoistClientMonad pm (Proxy :: Proxy api) f (cl a)

214 hoistClientMonad pm (Proxy :: Proxy api) f (cl a)

@@ -238,7 +243,7 @@ instance (KnownSymbol capture, ToHttpApiData a, HasClient m sublayout)

238 clientWithRoute pm (Proxy :: Proxy sublayout)

243 clientWithRoute pm (Proxy :: Proxy sublayout)

239 (foldl' (flip appendToPath) req ps)

244 (foldl' (flip appendToPath) req ps)

240

245

241− where ps = map (toUrlPiece) vals

246+ where ps = map toEncodedUrlPiece vals

242

247

243 hoistClientMonad pm _ f cl = \as ->

248 hoistClientMonad pm _ f cl = \as ->

244 hoistClientMonad pm (Proxy :: Proxy sublayout) f (cl as)

249 hoistClientMonad pm (Proxy :: Proxy sublayout) f (cl as)

@@ -246,10 +251,11 @@ instance (KnownSymbol capture, ToHttpApiData a, HasClient m sublayout)

246instance {-# OVERLAPPABLE #-}

251instance {-# OVERLAPPABLE #-}

247 -- Note [Non-Empty Content Types]

252 -- Note [Non-Empty Content Types]

248 ( RunClient m, MimeUnrender ct a, ReflectMethod method, cts' ~ (ct ': cts)

253 ( RunClient m, MimeUnrender ct a, ReflectMethod method, cts' ~ (ct ': cts)

254+ , KnownNat status

249 ) => HasClient m (Verb method status cts' a) where

255 ) => HasClient m (Verb method status cts' a) where

250 type Client m (Verb method status cts' a) = m a

256 type Client m (Verb method status cts' a) = m a

251 clientWithRoute _pm Proxy req = do

257 clientWithRoute _pm Proxy req = do

252− response <- runRequest req

258+ response <- runRequestAcceptStatus (Just [status]) req

253 { requestAccept = fromList $ toList accept

259 { requestAccept = fromList $ toList accept

254 , requestMethod = method

260 , requestMethod = method

255 }

261 }

@@ -257,18 +263,20 @@ instance {-# OVERLAPPABLE #-}

257 where

263 where

258 accept = contentTypes (Proxy :: Proxy ct)

264 accept = contentTypes (Proxy :: Proxy ct)

259 method = reflectMethod (Proxy :: Proxy method)

265 method = reflectMethod (Proxy :: Proxy method)

266+ status = statusFromNat (Proxy :: Proxy status)

260

267

261 hoistClientMonad _ _ f ma = f ma

268 hoistClientMonad _ _ f ma = f ma

262

269

263instance {-# OVERLAPPING #-}

270instance {-# OVERLAPPING #-}

264− ( RunClient m, ReflectMethod method

271+ ( RunClient m, ReflectMethod method, KnownNat status

265 ) => HasClient m (Verb method status cts NoContent) where

272 ) => HasClient m (Verb method status cts NoContent) where

266 type Client m (Verb method status cts NoContent)

273 type Client m (Verb method status cts NoContent)

267 = m NoContent

274 = m NoContent

268 clientWithRoute _pm Proxy req = do

275 clientWithRoute _pm Proxy req = do

269− _response <- runRequest req { requestMethod = method }

276+ _response <- runRequestAcceptStatus (Just [status]) req { requestMethod = method }

270 return NoContent

277 return NoContent

271 where method = reflectMethod (Proxy :: Proxy method)

278 where method = reflectMethod (Proxy :: Proxy method)

279+ status = statusFromNat (Proxy :: Proxy status)

272

280

273 hoistClientMonad _ _ f ma = f ma

281 hoistClientMonad _ _ f ma = f ma

274

282

@@ -285,13 +293,13 @@ instance (RunClient m, ReflectMethod method) =>

285

293

286instance {-# OVERLAPPING #-}

294instance {-# OVERLAPPING #-}

287 -- Note [Non-Empty Content Types]

295 -- Note [Non-Empty Content Types]

288− ( RunClient m, MimeUnrender ct a, BuildHeadersTo ls

296+ ( RunClient m, MimeUnrender ct a, BuildHeadersTo ls, KnownNat status

289 , ReflectMethod method, cts' ~ (ct ': cts)

297 , ReflectMethod method, cts' ~ (ct ': cts)

290 ) => HasClient m (Verb method status cts' (Headers ls a)) where

298 ) => HasClient m (Verb method status cts' (Headers ls a)) where

291 type Client m (Verb method status cts' (Headers ls a))

299 type Client m (Verb method status cts' (Headers ls a))

292 = m (Headers ls a)

300 = m (Headers ls a)

293 clientWithRoute _pm Proxy req = do

301 clientWithRoute _pm Proxy req = do

294− response <- runRequest req

302+ response <- runRequestAcceptStatus (Just [status]) req

295 { requestMethod = method

303 { requestMethod = method

296 , requestAccept = fromList $ toList accept

304 , requestAccept = fromList $ toList accept

297 }

305 }

@@ -299,22 +307,26 @@ instance {-# OVERLAPPING #-}

299 return $ Headers { getResponse = val

307 return $ Headers { getResponse = val

300 , getHeadersHList = buildHeadersTo . toList $ responseHeaders response

308 , getHeadersHList = buildHeadersTo . toList $ responseHeaders response

301 }

309 }

310+ where

302− where method = reflectMethod (Proxy :: Proxy method)

311+ method = reflectMethod (Proxy :: Proxy method)

303− accept = contentTypes (Proxy :: Proxy ct)

312+ accept = contentTypes (Proxy :: Proxy ct)

313+ status = statusFromNat (Proxy :: Proxy status)

304

314

305 hoistClientMonad _ _ f ma = f ma

315 hoistClientMonad _ _ f ma = f ma

306

316

307instance {-# OVERLAPPING #-}

317instance {-# OVERLAPPING #-}

308− ( RunClient m, BuildHeadersTo ls, ReflectMethod method

318+ ( RunClient m, BuildHeadersTo ls, ReflectMethod method, KnownNat status

309 ) => HasClient m (Verb method status cts (Headers ls NoContent)) where

319 ) => HasClient m (Verb method status cts (Headers ls NoContent)) where

310 type Client m (Verb method status cts (Headers ls NoContent))

320 type Client m (Verb method status cts (Headers ls NoContent))

311 = m (Headers ls NoContent)

321 = m (Headers ls NoContent)

312 clientWithRoute _pm Proxy req = do

322 clientWithRoute _pm Proxy req = do

313− let method = reflectMethod (Proxy :: Proxy method)

314− response <- runRequest req { requestMethod = method }

323+ response <- runRequestAcceptStatus (Just [status]) req { requestMethod = method }

315 return $ Headers { getResponse = NoContent

324 return $ Headers { getResponse = NoContent

316 , getHeadersHList = buildHeadersTo . toList $ responseHeaders response

325 , getHeadersHList = buildHeadersTo . toList $ responseHeaders response

317 }

326 }

327+ where

328+ method = reflectMethod (Proxy :: Proxy method)

329+ status = statusFromNat (Proxy :: Proxy status)

318

330

319 hoistClientMonad _ _ f ma = f ma

331 hoistClientMonad _ _ f ma = f ma

320

332

@@ -557,7 +569,7 @@ instance (KnownSymbol sym, ToHttpApiData a, HasClient m api, SBoolI (FoldRequire

557 (Proxy :: Proxy mods) add (maybe req add) mparam

569 (Proxy :: Proxy mods) add (maybe req add) mparam

558 where

570 where

559 add :: a -> Request

571 add :: a -> Request

560− add param = appendToQueryString pname (Just $ encodeQueryParam param) req

572+ add param = appendToQueryString pname (Just $ encodeQueryParamValue param) req

561

573

562 pname :: Text

574 pname :: Text

563 pname = pack $ symbolVal (Proxy :: Proxy sym)

575 pname = pack $ symbolVal (Proxy :: Proxy sym)

@@ -565,9 +577,6 @@ instance (KnownSymbol sym, ToHttpApiData a, HasClient m api, SBoolI (FoldRequire

565 hoistClientMonad pm _ f cl = \arg ->

577 hoistClientMonad pm _ f cl = \arg ->

566 hoistClientMonad pm (Proxy :: Proxy api) f (cl arg)

578 hoistClientMonad pm (Proxy :: Proxy api) f (cl arg)

567

579

568−encodeQueryParam :: ToHttpApiData a => a -> BS.ByteString

569−encodeQueryParam = BL.toStrict . toLazyByteString . toEncodedUrlPiece

570−

571-- | If you use a 'QueryParams' in one of your endpoints in your API,

580-- | If you use a 'QueryParams' in one of your endpoints in your API,

572-- the corresponding querying function will automatically take

581-- the corresponding querying function will automatically take

573-- an additional argument, a list of values of the type specified

582-- an additional argument, a list of values of the type specified

@@ -609,7 +618,7 @@ instance (KnownSymbol sym, ToHttpApiData a, HasClient m api)

609 )

618 )

610

619

611 where pname = pack $ symbolVal (Proxy :: Proxy sym)

620 where pname = pack $ symbolVal (Proxy :: Proxy sym)

612− paramlist' = map (Just . encodeQueryParam) paramlist

621+ paramlist' = map (Just . encodeQueryParamValue) paramlist

613

622

614 hoistClientMonad pm _ f cl = \as ->

623 hoistClientMonad pm _ f cl = \as ->

615 hoistClientMonad pm (Proxy :: Proxy api) f (cl as)

624 hoistClientMonad pm (Proxy :: Proxy api) f (cl as)

@@ -731,7 +740,7 @@ instance (KnownSymbol path, HasClient m api) => HasClient m (path :> api) where

731 clientWithRoute pm (Proxy :: Proxy api)

740 clientWithRoute pm (Proxy :: Proxy api)

732 (appendToPath p req)

741 (appendToPath p req)

733

742

734− where p = pack $ symbolVal (Proxy :: Proxy path)

743+ where p = toEncodedUrlPiece $ pack $ symbolVal (Proxy :: Proxy path)

735

744

736 hoistClientMonad pm _ f cl = hoistClientMonad pm (Proxy :: Proxy api) f cl

745 hoistClientMonad pm _ f cl = hoistClientMonad pm (Proxy :: Proxy api) f cl

737

746

@@ -780,7 +789,7 @@ instance ( HasClient m api

780

789

781-- | Ignore @'Fragment'@ in client functions.

790-- | Ignore @'Fragment'@ in client functions.

782-- See <https://ietf.org/rfc/rfc2616.html#section-15.1.3> for more details.

791-- See <https://ietf.org/rfc/rfc2616.html#section-15.1.3> for more details.

783−--

792+--

784-- Example:

793-- Example:

785--

794--

786-- > type MyApi = "books" :> Fragment Text :> Get '[JSON] [Book]

795-- > type MyApi = "books" :> Fragment Text :> Get '[JSON] [Book]

@@ -792,16 +801,12 @@ instance ( HasClient m api

792-- > getBooks = client myApi

801-- > getBooks = client myApi

793-- > -- then you can just use "getBooksBy" to query that endpoint.

802-- > -- then you can just use "getBooksBy" to query that endpoint.

794-- > -- 'getBooks' for all books.

803-- > -- 'getBooks' for all books.

795−#ifdef HAS_TYPE_ERROR

796instance (AtLeastOneFragment api, FragmentUnique (Fragment a :> api), HasClient m api

804instance (AtLeastOneFragment api, FragmentUnique (Fragment a :> api), HasClient m api

797−#else

798−instance ( HasClient m api

799−#endif

800 ) => HasClient m (Fragment a :> api) where

805 ) => HasClient m (Fragment a :> api) where

801

806

802 type Client m (Fragment a :> api) = Client m api

807 type Client m (Fragment a :> api) = Client m api

803

808

804− clientWithRoute pm _ = clientWithRoute pm (Proxy :: Proxy api)

809+ clientWithRoute pm _ = clientWithRoute pm (Proxy :: Proxy api)

805

810

806 hoistClientMonad pm _ = hoistClientMonad pm (Proxy :: Proxy api)

811 hoistClientMonad pm _ = hoistClientMonad pm (Proxy :: Proxy api)

807

812

@@ -816,6 +821,119 @@ instance HasClient m api => HasClient m (BasicAuth realm usr :> api) where

816 hoistClientMonad pm _ f cl = \bauth ->

821 hoistClientMonad pm _ f cl = \bauth ->

817 hoistClientMonad pm (Proxy :: Proxy api) f (cl bauth)

822 hoistClientMonad pm (Proxy :: Proxy api) f (cl bauth)

818

823

824+-- | A type that specifies that an API record contains a client implementation.

825+data AsClientT (m :: * -> *)

826+instance GenericMode (AsClientT m) where

827+ type AsClientT m :- api = Client m api

828+

829+

830+type GClientConstraints api m =

831+ ( GenericServant api (AsClientT m)

832+ , Client m (ToServantApi api) ~ ToServant api (AsClientT m)

833+ )

834+

835+class GClient (api :: * -> *) m where

836+ gClientProof :: Dict (GClientConstraints api m)

837+

838+instance GClientConstraints api m => GClient api m where

839+ gClientProof = Dict

840+

841+instance

842+ ( forall n. GClient api n

843+ , HasClient m (ToServantApi api)

844+ , RunClient m

845+ )

846+ => HasClient m (NamedRoutes api) where

847+ type Client m (NamedRoutes api) = api (AsClientT m)

848+

849+ clientWithRoute :: Proxy m -> Proxy (NamedRoutes api) -> Request -> Client m (NamedRoutes api)

850+ clientWithRoute pm _ request =

851+ case gClientProof @api @m of

852+ Dict -> fromServant $ clientWithRoute pm (Proxy @(ToServantApi api)) request

853+

854+ hoistClientMonad

855+ :: forall ma mb.

856+ Proxy m

857+ -> Proxy (NamedRoutes api)

858+ -> (forall x. ma x -> mb x)

859+ -> Client ma (NamedRoutes api)

860+ -> Client mb (NamedRoutes api)

861+ hoistClientMonad _ _ nat clientA =

862+ case (gClientProof @api @ma, gClientProof @api @mb) of

863+ (Dict, Dict) ->

864+ fromServant @api @(AsClientT mb) $

865+ hoistClientMonad @m @(ToServantApi api) @ma @mb Proxy Proxy nat $

866+ toServant @api @(AsClientT ma) clientA

867+

868+infixl 1 //

869+infixl 2 /:

870+

871+-- | Helper to make code using records of clients more readable.

872+--

873+-- Can be mixed with (/:) for supplying arguments.

874+--

875+-- Example:

876+--

877+-- @

878+-- type Api = NamedRoutes RootApi

879+--

880+-- data RootApi mode = RootApi

881+-- { subApi :: mode :- NamedRoutes SubApi

882+-- , …

883+-- } deriving Generic

884+--

885+-- data SubApi mode = SubApi

886+-- { endpoint :: mode :- Get '[JSON] Person

887+-- , …

888+-- } deriving Generic

889+--

890+-- api :: Proxy API

891+-- api = Proxy

892+--

893+-- rootClient :: RootApi (AsClientT ClientM)

894+-- rootClient = client api

895+--

896+-- endpointClient :: ClientM Person

897+-- endpointClient = client // subApi // endpoint

898+-- @

899+(//) :: a -> (a -> b) -> b

900+x // f = f x

901+

902+-- | Convenience function for supplying arguments to client functions when

903+-- working with records of clients.

904+--

905+-- Intended to be used in conjunction with '(//)'.

906+--

907+-- Example:

908+--

909+-- @

910+-- type Api = NamedRoutes RootApi

911+--

912+-- data RootApi mode = RootApi

913+-- { subApi :: mode :- Capture "token" String :> NamedRoutes SubApi

914+-- , hello :: mode :- Capture "name" String :> Get '[JSON] String

915+-- , …

916+-- } deriving Generic

917+--

918+-- data SubApi mode = SubApi

919+-- { endpoint :: mode :- Get '[JSON] Person

920+-- , …

921+-- } deriving Generic

922+--

923+-- api :: Proxy API

924+-- api = Proxy

925+--

926+-- rootClient :: RootApi (AsClientT ClientM)

927+-- rootClient = client api

928+--

929+-- hello :: String -> ClientM String

930+-- hello name = rootClient // hello /: name

931+--

932+-- endpointClient :: ClientM Person

933+-- endpointClient = client // subApi /: "foobar123" // endpoint

934+-- @

935+(/:) :: (a -> b -> c) -> b -> a -> c

936+(/:) = flip

819

937

820

938

821{- Note [Non-Empty Content Types]

939{- Note [Non-Empty Content Types]

@@ -841,7 +959,7 @@ for empty and one for non-empty lists).

841checkContentTypeHeader :: RunClient m => Response -> m MediaType

959checkContentTypeHeader :: RunClient m => Response -> m MediaType

842checkContentTypeHeader response =

960checkContentTypeHeader response =

843 case lookup "Content-Type" $ toList $ responseHeaders response of

961 case lookup "Content-Type" $ toList $ responseHeaders response of

844− Nothing -> return $ "application"//"octet-stream"

962+ Nothing -> return $ "application" Media.// "octet-stream"

845 Just t -> case parseAccept t of

963 Just t -> case parseAccept t of

846 Nothing -> throwClientError $ InvalidContentTypeHeader response

964 Nothing -> throwClientError $ InvalidContentTypeHeader response

847 Just t' -> return t'

965 Just t' -> return t'

@@ -857,3 +975,19 @@ decodedAs response ct = do

857 Right val -> return val

975 Right val -> return val

858 where

976 where

859 accept = toList $ contentTypes ct

977 accept = toList $ contentTypes ct

978+

979+-------------------------------------------------------------------------------

980+-- Custom type errors

981+-------------------------------------------------------------------------------

982+

983+-- Erroring instance for HasClient' when a combinator is not fully applied

984+instance (RunClient m, TypeError (PartialApplication HasClient arr)) => HasClient m ((arr :: a -> b) :> sub)

985+ where

986+ type Client m (arr :> sub) = TypeError (PartialApplication HasClient arr)

987+ clientWithRoute _ _ _ = error "unreachable"

988+ hoistClientMonad _ _ _ _ = error "unreachable"

989+

990+-- Erroring instances for 'HasClient' for unknown API combinators

991+instance {-# OVERLAPPABLE #-} (RunClient m, TypeError (NoInstanceForSub (HasClient m) ty)) => HasClient m (ty :> sub)

992+

993+instance {-# OVERLAPPABLE #-} (RunClient m, TypeError (NoInstanceFor (HasClient m api))) => HasClient m api

servant-client-core/src/Servant/Client/Core/Reexport.hs+4

@@ -7,6 +7,9 @@ module Servant.Client.Core.Reexport

7 HasClient(..)

8 , foldMapUnion

9 , matchUnion

10+ , AsClientT

11+ , (//)

12+ , (/:)

10

13

11 -- * Response (for @Raw@)

14 -- * Response (for @Raw@)

12 , Response

15 , Response

@@ -23,6 +26,7 @@ module Servant.Client.Core.Reexport

23 , showBaseUrl

26 , showBaseUrl

24 , parseBaseUrl

27 , parseBaseUrl

25 , InvalidBaseUrlException

28 , InvalidBaseUrlException

29+

26 ) where

30 ) where

27

31

28

32

servant-client-core/src/Servant/Client/Core/Request.hs+25−8

@@ -17,6 +17,7 @@ module Servant.Client.Core.Request (

17 addHeader,

18 appendToPath,

19 appendToQueryString,

20+ encodeQueryParamValue,

20 setRequestBody,

21 setRequestBody,

21 setRequestBodyLBS,

22 setRequestBodyLBS,

22 ) where

23 ) where

@@ -33,6 +34,8 @@ import Data.Bifunctor

33import Data.Bitraversable

34import Data.Bitraversable

34 (Bitraversable (..), bifoldMapDefault, bimapDefault)

35 (Bitraversable (..), bifoldMapDefault, bimapDefault)

35import qualified Data.ByteString as BS

36import qualified Data.ByteString as BS

37+import Data.ByteString.Builder

38+ (Builder)

36import qualified Data.ByteString.Builder as Builder

39import qualified Data.ByteString.Builder as Builder

37import qualified Data.ByteString.Lazy as LBS

40import qualified Data.ByteString.Lazy as LBS

38import qualified Data.Sequence as Seq

41import qualified Data.Sequence as Seq

@@ -48,9 +51,9 @@ import Network.HTTP.Media

48 (MediaType)

51 (MediaType)

49import Network.HTTP.Types

52import Network.HTTP.Types

50 (Header, HeaderName, HttpVersion (..), Method, QueryItem,

53 (Header, HeaderName, HttpVersion (..), Method, QueryItem,

51− http11, methodGet)

54+ http11, methodGet, urlEncodeBuilder)

52import Servant.API

55import Servant.API

53− (ToHttpApiData, toEncodedUrlPiece, toHeader, SourceIO)

56+ (ToHttpApiData, toEncodedUrlPiece, toQueryParam, toHeader, SourceIO)

54

57

55import Servant.Client.Core.Internal (mediaTypeRnf)

58import Servant.Client.Core.Internal (mediaTypeRnf)

56

59

@@ -78,12 +81,13 @@ instance (Show a, Show b) =>

78 . showString ", requestAccept = "

81 . showString ", requestAccept = "

79 . showsPrec 0 (requestAccept req)

82 . showsPrec 0 (requestAccept req)

80 . showString ", requestHeaders = "

83 . showString ", requestHeaders = "

81− . showsPrec 0 (redactSensitiveHeader <$> requestHeaders req))

84+ . showsPrec 0 (redactSensitiveHeader <$> requestHeaders req)

82 . showString ", requestHttpVersion = "

85 . showString ", requestHttpVersion = "

83 . showsPrec 0 (requestHttpVersion req)

86 . showsPrec 0 (requestHttpVersion req)

84 . showString ", requestMethod = "

87 . showString ", requestMethod = "

85 . showsPrec 0 (requestMethod req)

88 . showsPrec 0 (requestMethod req)

86 . showString "}"

89 . showString "}"

90+ )

87 where

91 where

88 redactSensitiveHeader :: Header -> Header

92 redactSensitiveHeader :: Header -> Header

89 redactSensitiveHeader ("Authorization", _) = ("Authorization", "<REDACTED>")

93 redactSensitiveHeader ("Authorization", _) = ("Authorization", "<REDACTED>")

@@ -110,7 +114,7 @@ instance (NFData path, NFData body) => NFData (RequestF body path) where

110 rnfB Nothing = ()

114 rnfB Nothing = ()

111 rnfB (Just (b, mt)) = rnf b `seq` mediaTypeRnf mt

115 rnfB (Just (b, mt)) = rnf b `seq` mediaTypeRnf mt

112

116

113−type Request = RequestF RequestBody Builder.Builder

117+type Request = RequestF RequestBody Builder

114

118

115-- | The request body. R replica of the @http-client@ @RequestBody@.

119-- | The request body. R replica of the @http-client@ @RequestBody@.

116data RequestBody

120data RequestBody

@@ -141,18 +145,31 @@ defaultRequest = Request

141 , requestMethod = methodGet

145 , requestMethod = methodGet

142 }

146 }

143

147

148+-- | Append extra path to the request being constructed.

149+--

150+-- Warning: This function assumes that the path fragment is already URL-encoded.

144−appendToPath :: Text -> Request -> Request

151+appendToPath :: Builder -> Request -> Request

145appendToPath p req

152appendToPath p req

146− = req { requestPath = requestPath req <> "/" <> toEncodedUrlPiece p }

153+ = req { requestPath = requestPath req <> "/" <> p }

147

154

155+-- | Append a query parameter to the request being constructed.

156+--

148−appendToQueryString :: Text -- ^ param name

157+appendToQueryString :: Text -- ^ query param name

149− -> Maybe BS.ByteString -- ^ param value

158+ -> Maybe BS.ByteString -- ^ query param value

150 -> Request

159 -> Request

151 -> Request

160 -> Request

152appendToQueryString pname pvalue req

161appendToQueryString pname pvalue req

153 = req { requestQueryString = requestQueryString req

162 = req { requestQueryString = requestQueryString req

154 Seq.|> (encodeUtf8 pname, pvalue)}

163 Seq.|> (encodeUtf8 pname, pvalue)}

155

164

165+-- | Encode a query parameter value.

166+--

167+encodeQueryParamValue :: ToHttpApiData a => a -> BS.ByteString

168+encodeQueryParamValue = LBS.toStrict . Builder.toLazyByteString

169+ . urlEncodeBuilder True . encodeUtf8 . toQueryParam

170+

171+-- | Add header to the request being constructed.

172+--

156addHeader :: ToHttpApiData a => HeaderName -> a -> Request -> Request

173addHeader :: ToHttpApiData a => HeaderName -> a -> Request -> Request

157addHeader name val req

174addHeader name val req

158 = req { requestHeaders = requestHeaders req Seq.|> (name, toHeader val)}

175 = req { requestHeaders = requestHeaders req Seq.|> (name, toHeader val)}

servant-client-core/src/Servant/Client/Generic.hs+1−59

@@ -1,20 +1,9 @@

1{-# OPTIONS_GHC -fno-warn-orphans #-}

2−{-# LANGUAGE ConstraintKinds #-}

3−{-# LANGUAGE CPP #-}

4{-# LANGUAGE FlexibleContexts #-}

2{-# LANGUAGE FlexibleContexts #-}

5−{-# LANGUAGE FlexibleInstances #-}

6−{-# LANGUAGE InstanceSigs #-}

7{-# LANGUAGE KindSignatures #-}

3{-# LANGUAGE KindSignatures #-}

8−{-# LANGUAGE MultiParamTypeClasses #-}

9{-# LANGUAGE RankNTypes #-}

4{-# LANGUAGE RankNTypes #-}

10{-# LANGUAGE ScopedTypeVariables #-}

5{-# LANGUAGE ScopedTypeVariables #-}

11−{-# LANGUAGE TypeApplications #-}

12{-# LANGUAGE TypeFamilies #-}

6{-# LANGUAGE TypeFamilies #-}

13−{-# LANGUAGE UndecidableInstances #-}

14−

15−#if __GLASGOW_HASKELL__ >= 806

16−{-# LANGUAGE QuantifiedConstraints #-}

17−#endif

18

7

19module Servant.Client.Generic (

8module Servant.Client.Generic (

20 AsClientT,

9 AsClientT,

@@ -22,17 +11,12 @@ module Servant.Client.Generic (

22 genericClientHoist,

11 genericClientHoist,

23 ) where

12 ) where

24

13

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

26import Data.Proxy

14import Data.Proxy

27 (Proxy (..))

15 (Proxy (..))

28

16

29import Servant.API.Generic

17import Servant.API.Generic

30import Servant.Client.Core

18import Servant.Client.Core

31−

19+import Servant.Client.Core.HasClient (AsClientT)

32−-- | A type that specifies that an API record contains a client implementation.

33−data AsClientT (m :: * -> *)

34−instance GenericMode (AsClientT m) where

35− type AsClientT m :- api = Client m api

36

20

37-- | Generate a record of client functions.

21-- | Generate a record of client functions.

38genericClient

22genericClient

@@ -62,45 +46,3 @@ genericClientHoist nt

62 where

46 where

63 m = Proxy :: Proxy m

47 m = Proxy :: Proxy m

64 api = Proxy :: Proxy (ToServantApi routes)

48 api = Proxy :: Proxy (ToServantApi routes)

65−

66−#if __GLASGOW_HASKELL__ >= 806

67−

68−type GClientConstraints api m =

69− ( GenericServant api (AsClientT m)

70− , Client m (ToServantApi api) ~ ToServant api (AsClientT m)

71− )

72−

73−class GClient (api :: * -> *) m where

74− proof :: Dict (GClientConstraints api m)

75−

76−instance GClientConstraints api m => GClient api m where

77− proof = Dict

78−

79−instance

80− ( forall n. GClient api n

81− , HasClient m (ToServantApi api)

82− , RunClient m

83− )

84− => HasClient m (NamedRoutes api) where

85− type Client m (NamedRoutes api) = api (AsClientT m)

86−

87− clientWithRoute :: Proxy m -> Proxy (NamedRoutes api) -> Request -> Client m (NamedRoutes api)

88− clientWithRoute pm _ request =

89− case proof @api @m of

90− Dict -> fromServant $ clientWithRoute pm (Proxy @(ToServantApi api)) request

91−

92− hoistClientMonad

93− :: forall ma mb.

94− Proxy m

95− -> Proxy (NamedRoutes api)

96− -> (forall x. ma x -> mb x)

97− -> Client ma (NamedRoutes api)

98− -> Client mb (NamedRoutes api)

99− hoistClientMonad _ _ nat clientA =

100− case (proof @api @ma, proof @api @mb) of

101− (Dict, Dict) ->

102− fromServant @api @(AsClientT mb) $

103− hoistClientMonad @m @(ToServantApi api) @ma @mb Proxy Proxy nat $

104− toServant @api @(AsClientT ma) clientA

105−

106−#endif

servant-client-core/test/Servant/Client/Core/RequestSpec.hs+12

@@ -10,10 +10,22 @@ import Data.List (isInfixOf)

10import Servant.Client.Core.Request

11import Test.Hspec

12

13+newtype DataWithRequest = DataWithRequest (RequestF RequestBody ())

14+ deriving Show

15+

13spec :: Spec

16spec :: Spec

14spec = do

17spec = do

15 describe "Request" $ do

18 describe "Request" $ do

16 describe "show" $ do

19 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\"})"

17 it "redacts the authorization header" $ do

29 it "redacts the authorization header" $ do

18 let request = void $ defaultRequest { requestHeaders = pure ("authorization", "secret") }

30 let request = void $ defaultRequest { requestHeaders = pure ("authorization", "secret") }

19 isInfixOf "secret" (show request) `shouldBe` False

31 isInfixOf "secret" (show request) `shouldBe` False

servant-client-ghcjs/servant-client-ghcjs.cabal+4−4

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

1−cabal-version: >=1.10

1+cabal-version: 2.2

2name: servant-client-ghcjs

3version: 0.16

4synopsis:

@@ -38,7 +38,7 @@ library

38 Servant.Client.Internal.XhrClient

39

40 build-depends:

41− base >=4.11 && <4.12

41+ base >=4.11 && <5

42 , bytestring >=0.10 && <0.12

43 , case-insensitive >=1.2.0.0 && <1.3.0.0

44 , containers >=0.5 && <0.7

@@ -56,8 +56,8 @@ library

56

57 -- strict, as we re-export stuff

58 build-depends:

59− servant >=0.16 && <0.17

59+ servant >=0.16 && <0.20

60− , servant-client-core >=0.16 && <0.16.1

60+ , servant-client-core >=0.16 && <0.20

61

62 hs-source-dirs: src

63 default-language: Haskell2010

servant-client-ghcjs/src/Servant/Client/Internal/XhrClient.hs+8−5

@@ -120,7 +120,7 @@ instance Exception StreamingNotSupportedException where

120 displayException _ = "streamingRequest: streaming is not supported!"

121

122instance RunClient ClientM where

123− runRequest = performRequest

123+ runRequestAcceptStatus = performRequest

124 throwClientError = throwError

125

126runClientMOrigin :: ClientM a -> ClientEnv -> IO (Either ClientError a)

@@ -152,15 +152,18 @@ runClientM m = do

152

153 runClientMOrigin m (ClientEnv (BaseUrl protocol hostname port ""))

154

155−performRequest :: Request -> ClientM Response

155+performRequest :: Maybe [Status] -> Request -> ClientM Response

156−performRequest req = do

156+performRequest acceptStatus req = do

157 xhr <- liftIO initXhr

158 burl <- asks baseUrl

159 liftIO $ performXhr xhr burl req

160 resp <- toResponse xhr

161

162− let status = statusCode (responseStatusCode resp)

162+ let status = responseStatusCode resp

163− unless (status >= 200 && status < 300) $ do

163+ goodStatus = case acceptStatus of

164+ Nothing -> statusIsSuccessful status

165+ Just good -> status `elem` good

166+ unless goodStatus $ do

164 let f b = (burl, BL.toStrict $ toLazyByteString b)

167 let f b = (burl, BL.toStrict $ toLazyByteString b)

165 throwError $ FailureResponse (bimap (const ()) f req) resp

168 throwError $ FailureResponse (bimap (const ()) f req) resp

166

169

servant-client/CHANGELOG.md+31

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

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