Merge pull request #72 from maksbotan/maksbotan/support-servant-0.18

Support servant-server-0.18
Update src/Servant/QuickCheck/Internal/QuickCheck.hs
2020-07-31 09:54:59 +02:00 · 2020-07-31 10:43:19 +03:00 · 2020-07-30 19:32:29 +03:00 · 2020-07-30 19:22:14 +03:00 · 2020-07-10 13:54:21 +02:00 · 2020-07-02 22:40:04 +02:00
22 changed files with 1819 additions and 471 deletions
--- a/.gitignore
+++ b/.gitignore
@ -1,2 +1,6 @@
 doc/_build/
 scripts/
 samples/
 test-servers/
 /doc/
 .stack-work/
--- a/.travis.yml
+++ b/.travis.yml
@ -1,34 +1,158 @@
-sudo: false
+# This Travis job script has been generated by a script via
-
+#
 #   haskell-ci '--config=cabal.haskell-ci' 'servant-quickcheck.cabal'
 #
 # To regenerate the script (for example after adjusting tested-with) run
 #
 #   haskell-ci regenerate
 #
 # For more information, see https://github.com/haskell-CI/haskell-ci
 #
 # version: 0.10.1
 #
 version: ~> 1.0
 language: c
-
+os: linux
-env:
+dist: xenial
-  - GHCVER=7.8.4
+git:
-  - GHCVER=7.10.2
+  # whether to recursively clone submodules
-
+  submodules: false
-addons:
+branches:
-  apt:
+  only:
-    sources:
+    - master
      - hvr-ghc
    packages:
      - ghc-7.8.4
      - ghc-7.10.2
      - cabal-install-1.22
      - libgmp-dev
      - wrk
 install:
  - (mkdir -p $HOME/.local/bin && cd $HOME/.local/bin && wget https://zalora-public.s3.amazonaws.com/tinc && chmod +x tinc)
  - export PATH=/opt/ghc/$GHCVER/bin:/opt/cabal/1.22/bin:$PATH
  - ghc --version
  - cabal --version
  - travis_retry cabal update
  - sed -i 's/^jobs:/-- jobs:/' ${HOME}/.cabal/config
 script:
  - tinc && cabal configure --enable-tests && cabal build && cabal test
  #- (cd doc && tinc cabal configure --enable-tests && cabal build && cabal test)
 cache:
  directories:
-    - $HOME/.tinc/cache
+    - $HOME/.cabal/packages
    - $HOME/.cabal/store
    - $HOME/.hlint
 before_cache:
  - rm -fv $CABALHOME/packages/hackage.haskell.org/build-reports.log
  # remove files that are regenerated by 'cabal update'
  - rm -fv $CABALHOME/packages/hackage.haskell.org/00-index.*
  - rm -fv $CABALHOME/packages/hackage.haskell.org/*.json
  - rm -fv $CABALHOME/packages/hackage.haskell.org/01-index.cache
  - rm -fv $CABALHOME/packages/hackage.haskell.org/01-index.tar
  - rm -fv $CABALHOME/packages/hackage.haskell.org/01-index.tar.idx
  - rm -rfv $CABALHOME/packages/head.hackage
 jobs:
  include:
    - compiler: ghc-8.8.3
      addons: {"apt":{"sources":[{"sourceline":"deb http://ppa.launchpad.net/hvr/ghc/ubuntu xenial main","key_url":"https://keyserver.ubuntu.com/pks/lookup?op=get&search=0x063dab2bdc0b3f9fcebc378bff3aeacef6f88286"}],"packages":["ghc-8.8.3","cabal-install-3.2"]}}
      os: linux
    - compiler: ghc-8.6.5
      addons: {"apt":{"sources":[{"sourceline":"deb http://ppa.launchpad.net/hvr/ghc/ubuntu xenial main","key_url":"https://keyserver.ubuntu.com/pks/lookup?op=get&search=0x063dab2bdc0b3f9fcebc378bff3aeacef6f88286"}],"packages":["ghc-8.6.5","cabal-install-3.2"]}}
      os: linux
    - compiler: ghc-8.4.4
      addons: {"apt":{"sources":[{"sourceline":"deb http://ppa.launchpad.net/hvr/ghc/ubuntu xenial main","key_url":"https://keyserver.ubuntu.com/pks/lookup?op=get&search=0x063dab2bdc0b3f9fcebc378bff3aeacef6f88286"}],"packages":["ghc-8.4.4","cabal-install-3.2"]}}
      os: linux
    - compiler: ghc-8.2.2
      addons: {"apt":{"sources":[{"sourceline":"deb http://ppa.launchpad.net/hvr/ghc/ubuntu xenial main","key_url":"https://keyserver.ubuntu.com/pks/lookup?op=get&search=0x063dab2bdc0b3f9fcebc378bff3aeacef6f88286"}],"packages":["ghc-8.2.2","cabal-install-3.2"]}}
      os: linux
    - compiler: ghc-8.0.2
      addons: {"apt":{"sources":[{"sourceline":"deb http://ppa.launchpad.net/hvr/ghc/ubuntu xenial main","key_url":"https://keyserver.ubuntu.com/pks/lookup?op=get&search=0x063dab2bdc0b3f9fcebc378bff3aeacef6f88286"}],"packages":["ghc-8.0.2","cabal-install-3.2"]}}
      os: linux
 before_install:
  - HC=$(echo "/opt/$CC/bin/ghc" | sed 's/-/\//')
  - WITHCOMPILER="-w $HC"
  - HADDOCK=$(echo "/opt/$CC/bin/haddock" | sed 's/-/\//')
  - HCPKG="$HC-pkg"
  - unset CC
  - CABAL=/opt/ghc/bin/cabal
  - CABALHOME=$HOME/.cabal
  - export PATH="$CABALHOME/bin:$PATH"
  - TOP=$(pwd)
  - "HCNUMVER=$(${HC} --numeric-version|perl -ne '/^(\\d+)\\.(\\d+)\\.(\\d+)(\\.(\\d+))?$/; print(10000 * $1 + 100 * $2 + ($3 == 0 ? $5 != 1 : $3))')"
  - echo $HCNUMVER
  - CABAL="$CABAL -vnormal+nowrap"
  - set -o pipefail
  - TEST=--enable-tests
  - BENCH=--enable-benchmarks
  - HEADHACKAGE=false
  - rm -f $CABALHOME/config
  - |
    echo "verbose: normal +nowrap +markoutput"          >> $CABALHOME/config
    echo "remote-build-reporting: anonymous"            >> $CABALHOME/config
    echo "write-ghc-environment-files: always"          >> $CABALHOME/config
    echo "remote-repo-cache: $CABALHOME/packages"       >> $CABALHOME/config
    echo "logs-dir:          $CABALHOME/logs"           >> $CABALHOME/config
    echo "world-file:        $CABALHOME/world"          >> $CABALHOME/config
    echo "extra-prog-path:   $CABALHOME/bin"            >> $CABALHOME/config
    echo "symlink-bindir:    $CABALHOME/bin"            >> $CABALHOME/config
    echo "installdir:        $CABALHOME/bin"            >> $CABALHOME/config
    echo "build-summary:     $CABALHOME/logs/build.log" >> $CABALHOME/config
    echo "store-dir:         $CABALHOME/store"          >> $CABALHOME/config
    echo "install-dirs user"                            >> $CABALHOME/config
    echo "  prefix: $CABALHOME"                         >> $CABALHOME/config
    echo "repository hackage.haskell.org"               >> $CABALHOME/config
    echo "  url: http://hackage.haskell.org/"           >> $CABALHOME/config
 install:
  - ${CABAL} --version
  - echo "$(${HC} --version) [$(${HC} --print-project-git-commit-id 2> /dev/null || echo '?')]"
  - |
    echo "program-default-options"                >> $CABALHOME/config
    echo "  ghc-options: $GHCJOBS +RTS -M6G -RTS" >> $CABALHOME/config
  - cat $CABALHOME/config
  - rm -fv cabal.project cabal.project.local cabal.project.freeze
  - travis_retry ${CABAL} v2-update -v
  # Generate cabal.project
  - rm -rf cabal.project cabal.project.local cabal.project.freeze
  - touch cabal.project
  - |
    echo "packages: ." >> cabal.project
  - if [ $HCNUMVER -ge 80200 ] ; then echo 'package servant-quickcheck' >> cabal.project ; fi
  - "if [ $HCNUMVER -ge 80200 ] ; then echo '  ghc-options: -Werror=missing-methods' >> cabal.project ; fi"
  - |
  - "for pkg in $($HCPKG list --simple-output); do echo $pkg | sed 's/-[^-]*$//' | (grep -vE -- '^(servant-quickcheck)$' || true) | sed 's/^/constraints: /' | sed 's/$/ installed/' >> cabal.project.local; done"
  - cat cabal.project || true
  - cat cabal.project.local || true
  - if [ -f "./configure.ac" ]; then (cd "." && autoreconf -i); fi
  - ${CABAL} v2-freeze $WITHCOMPILER ${TEST} ${BENCH}
  - "cat cabal.project.freeze | sed -E 's/^(constraints: *| *)//' | sed 's/any.//'"
  - rm  cabal.project.freeze
  - travis_wait 40 ${CABAL} v2-build $WITHCOMPILER ${TEST} ${BENCH} --dep -j2 all
  - travis_wait 40 ${CABAL} v2-build $WITHCOMPILER --disable-tests --disable-benchmarks --dep -j2 all
 script:
  - DISTDIR=$(mktemp -d /tmp/dist-test.XXXX)
  # Packaging...
  - ${CABAL} v2-sdist all
  # Unpacking...
  - mv dist-newstyle/sdist/*.tar.gz ${DISTDIR}/
  - cd ${DISTDIR} || false
  - find . -maxdepth 1 -type f -name '*.tar.gz' -exec tar -xvf '{}' \;
  - find . -maxdepth 1 -type f -name '*.tar.gz' -exec rm       '{}' \;
  - PKGDIR_servant_quickcheck="$(find . -maxdepth 1 -type d -regex '.*/servant-quickcheck-[0-9.]*')"
  # Generate cabal.project
  - rm -rf cabal.project cabal.project.local cabal.project.freeze
  - touch cabal.project
  - |
    echo "packages: ${PKGDIR_servant_quickcheck}" >> cabal.project
  - if [ $HCNUMVER -ge 80200 ] ; then echo 'package servant-quickcheck' >> cabal.project ; fi
  - "if [ $HCNUMVER -ge 80200 ] ; then echo '  ghc-options: -Werror=missing-methods' >> cabal.project ; fi"
  - |
  - "for pkg in $($HCPKG list --simple-output); do echo $pkg | sed 's/-[^-]*$//' | (grep -vE -- '^(servant-quickcheck)$' || true) | sed 's/^/constraints: /' | sed 's/$/ installed/' >> cabal.project.local; done"
  - cat cabal.project || true
  - cat cabal.project.local || true
  # Building...
  # this builds all libraries and executables (without tests/benchmarks)
  - ${CABAL} v2-build $WITHCOMPILER --disable-tests --disable-benchmarks all
  # Building with tests and benchmarks...
  # build & run tests, build benchmarks
  - ${CABAL} v2-build $WITHCOMPILER ${TEST} ${BENCH} all
  # Testing...
  - ${CABAL} v2-test $WITHCOMPILER ${TEST} ${BENCH} all
  # cabal check...
  - (cd ${PKGDIR_servant_quickcheck} && ${CABAL} -vnormal check)
  # haddock...
  - ${CABAL} v2-haddock $WITHCOMPILER --with-haddock $HADDOCK ${TEST} ${BENCH} all
  # Building without installed constraints for packages in global-db...
  - rm -f cabal.project.local
  - ${CABAL} v2-build $WITHCOMPILER --disable-tests --disable-benchmarks all
  # Constraint sets
  - rm -rf cabal.project.local
  # Constraint set base-compat-0.10
  - ${CABAL} v2-build $WITHCOMPILER --disable-tests --disable-benchmarks --constraint='base-compat ==0.10.*' all
  # Constraint set base-compat-0.11
  - ${CABAL} v2-build $WITHCOMPILER --disable-tests --disable-benchmarks --constraint='base-compat ==0.11.*' all
 # REGENDATA ("0.10.1",["--config=cabal.haskell-ci","servant-quickcheck.cabal"])
 # EOF
--- a/CHANGELOG.yaml
+++ b/CHANGELOG.yaml
@ -0,0 +1,214 @@
 releases:
  - version: "0.0.9.0"
    changes:
      - description: "Support servant-0.15 (#65)"
        authors: fizruk
        date: 2020-06-25
      - description: "Relax constraints for GHC 8.10 (#70)"
        authors: felixmulder
        date: 2020-06-20
  - version: "0.0.8.0"
    changes:
      - description: Support for servant-0.17
        authors: phadej
        date: 2019-01-23
  - version: "0.0.7.3"
    changes:
      - description: Support for servant-0.14
        issue: 53
        authors: phadej
        date: 2018-06-12
      - description: Fix a failure from OnlyJsonObjects when there is no content-type.
        issue: 55
        authors: Phenitei
        date: 2018-08-27
      - description: A bug fix where notAllowedContainsAllowHeader would print the initial request alongside the failure instead of the request causing the failure when it failed.
        issue: 57
        authors: Phenitei
        date: 2018-08-29
      - description: QuickCheck 2.12 compatibility
        issue: 58
        authors: parsonsmatt
        date: 2018-10-12
      - description: GHC 8.6 compatibility
        issue: 59
        authors: phadej
        date: 2018-10-15
  - version: "0.0.7.2"
    changes:
      - description: Allow client to pass an HTTP Manager in to functions
        issue: 47
        authors: parsonsmatt
        date: 2018-05-10
      - description: Fix "should not happen" error when exceptions are thrown
        issue: 48
        authors: parsonsmatt
        date: 2018-05-10
  - version: "0.0.7.0"
    changes:
      - description: Support for base-compat-0.10
        issue: none
        authors: phadej
        date: 2018-04-12
  - version: "0.0.7.0"
    changes:
      - description: Support for GHC-8.4.1
        issue: none
        authors: phadej
        date: 2018-03-23
      - description: Requires hspec-2.5
        issue: none
        authors: phadej
        date: 2018-03-23
  - version: "0.0.6.0"
    changes:
      - description: Support for servant-0.12
        issue: none
        authors: phadej
        date: 2018-02-09
  - version: "0.0.5.0"
    changes:
      - description: Export forgotten predicates
        issue: none
        pr: 40
        authors: Phenitei
        date: 2017-12-14
  - version: "0.0.4"
    changes:
      - description: Support for Servant 0.12
        issue: none
        authors: phadej
        date: 2017-11-07
      - description: Support for Servant 0.11
        issue: none
        pr: 32
        authors: adinapoli-iohk
        date: 2017-10-18
        notes: Includes 0-weighted instance for EmptyAPI
  - version: "0.0.3.0"
    changes:
      - description: Add jsonEquality
        issue: 2
        pr: 30
        authors: erewok
        date: 2017-10-15
      - description: Support hspec >= 2.4
        issue: 27
        pr: 29
        authors: erewok, jkarni
        date: 2017-10-15
  - version: "0.0.2.4"
    changes:
      - description: Don't append slashes to paths
        issue: 22
        authors: declension
        date: 2017-03-11
  - version: "0.0.2.3"
    changes:
      - description: Fix QueryParam and QueryFlag requests
        issue: 23
        authors: declension
        date: 2017-03-10
  - version: "0.0.2.2"
    changes:
      - description: Make onlyJsonObjects succeed in non-JSON endpoints
        issue: 20
        authors: jkarni
        date: 2016-10-18
  - version: "0.0.2.1"
    changes:
      - description: Add notLongerThan predicate
        pr: 17
        authors: jkarni
        date: 2016-10-05
      - description: Add getsHaveLastModifiedHeader predicate
        pr: none
        authors: jkarni
        date: 2016-10-03
      - description: Raise upper bounds
        notes: >
            For Quickcheck, aeson, http-client, servant, servant-client and
            servant-server.
        pr: none
        authors: jkarni
        date: 2016-10-03
  - version: "0.0.2.0"
    changes:
      - description: Update CHANGELOG to YAML syntax.
        pr: 16
        authors: jkarni
        date: 2016-09-14
      - description: Support new CaptureAll combinator
        pr: 16
        authors: jkarni
        date: 2016-09-14
      - description: Support GHC 8
        pr: 16
        authors: jkarni
        date: 2016-09-14
  - version: "0.0.1.1"
    changes:
      - description: Exclude GHC 7.8 (by bumping base lower bound to 4.8)
        pr: none
        authors: jkarni
      - description: More generous bounds for other packages.
        pr: none
        authors: jkarni
  - version: "0.0.1.0"
    changes:
      - description: Better error messages.
        notes: >
          Error messages now contain failing predicate, failing response and
          (except for response predicates), failing requests.
        pr: none
        authors: jkarni
      - description: Signicant changes to RequestPredicate and ResponsePredicate types.
        pr: none
        authors: jkarni
--- a/cabal.haskell-ci
+++ b/cabal.haskell-ci
@ -0,0 +1,7 @@
 branches: master
 constraint-set base-compat-0.10
  constraints: base-compat ==0.10.*
 constraint-set base-compat-0.11
  constraints: base-compat ==0.11.*
--- a/cabal.project
+++ b/cabal.project
@ -0,0 +1,4 @@
 packages: .
 tests: true
 allow-newer: servant-blaze:servant
--- a/doc/posts/Announcement.anansi
+++ b/doc/posts/Announcement.anansi
@ -10,13 +10,62 @@ an API description.
 This is much closer to the traditional use of `QuickCheck`. The most obvious
 use-case is checking that properties hold of an *entire* server rather than of
-individual endpoints.
+individual endpoints. (But there are other uses that you can skip to if they
 sound more interesting.)
 ## `serverSatisfies`
-There are a variety of best practices in writing web APIs that aren't always
+A useful guideline when writing and maintaing software is that, if there isn't
-obvious. As a running example, let's use a simple service that allows adding,
+a test for a behaviour or property, sooner or later that property will be broken.
-removing, and querying biological species. Our SQL schema is:
+Another important perspective is that tests are a form of documentation - the
 present developer telling future ones "this matters, and should be this way".
 The advantage of using tests for this form of documentation is that there's
 simply too much information to convey, some of it only relevant to very specific
 use cases, and rather than overload developers with an inexhaustible quantity of
 details that would be hard to keep track of or remember, tests are a mechanism
 of reminding developers of *only the relevant information, at the right time*.
 <<EXAMPLE>>.
 We might hope that we could use tests to communicate the wide array of best
 practices that have developed around APIs. About to return a top-level integer
 in JSON? A test should say that's bad practice. About to not catch exceptions
 and give a more meaningful HTTP status code? Another test there to stop you.
 Traditionally, in web services these things get done at the level of *individual*
 endpoints. But this means that if a developer who hasn't had extensive experience with web
 programming best practices writes a *new* endpoint which *does* return a top-level
 integer literal, there's no test there to stop her. Code review might help, but
 code review is much more error prone than tests, and really only meant for those
 things that are too subtle to automate. (Indeed, if code review were such a reliable
 defense mechanism against bugs and bad code, why have tests and linters at all?)
 The problem, then, with thinking about tests as only existing at the level of individual
 endpoints is that there are no tests *for* tests - tests that check that new
 behaviour and tests conforms to higher-level, more general best practices.
 `servant-quickcheck` aims to solve that. It allows describing properties that
 *all* endpoints must satisfy. If a new endpoint comes along, it too will be
 tested for that property, without any further work.
 Why isn't this idea already popular? Well, most web frameworks don't have a
 reified description of APIs (beyond perhaps the routes). When you don't know
 what the endpoints of an application are, and what request body they expect,
 trying to generate arbitrary requests is almost entirely going to result in
 404s (not found) and 400s (bad request). Maybe one in a thousand requests will
 actually test a handler. Not very useful.
 `servant` applications, on the other hand, have a machine-readable API description
 already available. And they already associate "correct" requests with particular
 types. It's a small step, therefore, to generate 'arbitrary' values for these
 requests, and all of them will go through to your handlers. (Note: all of the
 uses of `servant-quickcheck` work with applications *not* written with servant-server -
 and indeed not *in Haskell - but the API must be described with the servant
 DSL.)
 Let's see how this works in practice.  As a running example, let's use a simple
 service that allows adding, removing, and querying biological species. Our SQL
 schema is:
 :d schema.sql
@ -53,9 +102,8 @@ import Control.Monad.IO.Class (liftIO)
 type API
  = "species" :> (Capture "species-name" Text :> ( Get '[JSON] Species
                                              :<|> Delete '[JSON] ())
-             :<|> ReqBody '[JSON] Species :> Post '[JSON] ())
+             :<|> ReqBody '[JSON] Species :> Post '[JSON] ()
-  -- The plural of 'species' is unfortunately also 'species'
+             :<|> Get '[JSON] [Species])
 :<|> "speciess" :> Get '[JSON] [Species]
 api :: Proxy API
 api = Proxy
@ -116,6 +164,8 @@ If you want to run this example.)
 This is a plausible effort. You might want to spend a moment thinking about what
 could be improved.
 Here are some `servant-quickcheck`-based tests for this API:
 :d Spec.hs
 {-# LANGUAGE OverloadedStrings #-}
@ -129,11 +179,12 @@ import Test.QuickCheck (Arbitrary(..))
 import Database.PostgreSQL.Simple (connectPostgreSQL)
 spec :: Spec
-spec = describe "the species application" $ do
+spec = describe "the species application" $ beforeAll check $ do
  let pserver = do
        conn <- connectPostgreSQL "dbname=servant-quickcheck"
        return $ server conn
  it "should not return 500s" $ do
    withServantServer api pserver $ \url ->
      serverSatisfies api url defaultArgs (not500 <%> mempty)
@ -142,6 +193,30 @@ spec = describe "the species application" $ do
    withServantServer api pserver $ \url ->
      serverSatisfies api url defaultArgs (onlyJsonObjects <%> mempty)
  it "should return valid locations for 201" $ do
    withServantServer api pserver $ \url ->
      serverSatisfies api url defaultArgs (createContainsValidLocation <%> mempty)
  it "honours Accept header" $ do
    withServantServer api pserver $ \url ->
      serverSatisfies api url defaultArgs (honoursAcceptHeader <%> mempty)
  it "405s contain Allow header" $ do
    withServantServer api pserver $ \url ->
      serverSatisfies api url defaultArgs (notAllowedContainsValidAllow <%> mempty)
  it "should contain WWW-Authenticate header when returning 401s" $ do
    withServantServer api pserver $ \url ->
      serverSatisfies api url defaultArgs (unauthorizedContainsWWWAuthenticate <%> mempty)
  it "GETs should have Cache-Control header" $ do
    withServantServer api pserver $ \url ->
      serverSatisfies api url defaultArgs (getsHaveCacheControlHeader <%> mempty)
  it "HEADs should have Cache-Control header" $ do
    withServantServer api pserver $ \url ->
      serverSatisfies api url defaultArgs (headsHaveCacheControlHeader <%> mempty)
 main :: IO ()
 main = do
  hspec spec
@ -151,6 +226,94 @@ instance Arbitrary Species where
 :
 I won't go through all of the failures; as this is a literate haskell file, you
 can go through them yourself if you're interested. But worth mentioning:
    - The possible pattern match failure in `lookupSpecies` is caught.
    - Returning a top-level list is caught.
    - Not having a link for the `PostCreated` is caught.
 This last test failure illustrates an important point.
 This was an example created with the knowledge of what it was supposed to
 exemplify. To try to get a more accurate assessment of the practical usefulness
 of `servant-quickcheck`, I tried running `serverSatisfies` with a few
 predicates over some of the open-source `servant` servers I could find, and
 results were also promising.
 There are probably a lot of other interesting properties that one might to add
 besides those I've included. As an example, we could have a property that
 all HTML is checked against, which is sometimes tricky for HTML that's
 generated dynamically. Or check that every page has a Portuguese translation.
 ### Why best practices are good
 As a side note: you might have wondered "why bother with API best practices?".
 It is, it has to be said, a lot of extra (as in not only getting the feature done)
 work to do, for dubious benefit. And indeed, the relevance of discoverability, for
 example, unclear, since not that many tools use it as perhaps was anticipated.
 But `servant-quickcheck` both makes it *easier* to conform to best practices,
 and exemplifies their advantage in enabling better tooling. If we pick 201 (Success, the 'resource' was
 created), rather than the more generic 200 (Success), and do a *little* more work
 by knowing to make this decision, `servant-quickcheck` knows this means there
 should be some representation of the resource created. So it knows to ask you
 for a link to it (the RFC creators thought to ask for this). And if you do (again,
 a little more work), `servant-quickcheck` will know to try to look at that
 resource by following the link, checking that it's not broken, and maybe even
 returns a response that equivalent to the original POST request). And then it
 finds a real bug - your application allows species with '/' in their name to
 be created, but not queried with a 'GET' for! This, I think, is already a win.
 ## `serversEqual`
 There's another very appealing application of the ability to generate "sensible"
 arbitrary requests. It's for testing that two applications are equal. We can generate arbitrary
 requests, send them to both servers (in the same order), and check that the responses
 are equivalent.  (This was, incidentally, one of the first applications of
 `servant-client`, albeit in a much more manual way, when we rewrote a microservice
 originally in Python in Haskell.) Generally with rewrites, even if there's some
 behaviour that isn't optimal, perhaps a lot of things already depend on that service
 and make interace poorly with "improvements", so it makes sense to first mimick
 *exactly* the original behaviour, and only then aim for improvements.
 `servant-quickcheck` provides a single function, `serversEqual`, that attempts
 to verify the equivalence of servers. Since some aspects of responses might not
 be relevant (for example, whether the the `Server` header is the same, or whether
 two JSON responses have the same formatting), it allows you to provide a custom
 equivalence function. Other than that, you need only provide an API type and two
 URLs for testing, and the rest `serversEqual` handles.
 ## Future directions: benchmarking
 What else could benefit from tooling that can automatically generate sensible
 (*vis-a-vis* a particular application's expectations) requests?
 One area is extensive automatic benchmarking. Currently we use tools such as
 `ab`, `wrk`, `httperf` in a very manual way - we pick a particular request that
 we are interested in, and write a request that gets made thousands of times.
 But now we can have a multiplicity of requests to benchmark with! This allows
 *finding* slow endpoints, as well as (I would imagine, though I haven't actually
 tried this yet) finding synchronization issues that make threads wait for too
 long (such as waiting on an MVar that's not really needed), bad asymptotics
 with respect to some other type of request.
 (On this last point, imagine not having an index in a database for "people",
 and having a tool that discovers that the latency on a search by first name
 grows linearly with the number of POST requests to a *different* endpoint! We'd
 need to do some work to do this well, possibly involving some machine
 learning, but it's an interesting and probably useful idea.)
 # Conclusion
 I hope this library presents some useful functionality already, but I hope
 you'll also think how it could be improved!
 There'll be a few more packages in the comings weeks - check back soon!
 **Note**: This post is an anansi literate file that generates multiple source
 files. They are:
--- a/doc/posts/Makefile
+++ b/doc/posts/Makefile
@ -4,12 +4,15 @@ src/$(FILES): Announcement.anansi
 	anansi tangle -o "src" Announcement.anansi
 announcement.md: Announcement.anansi
-	anansi weave -o "announcement.md" Announcement.anansi
+	anansi weave -o "announcement.tmp" Announcement.anansi
 	cat announcement.tmp | tr -d '«' | tr -d '»' > announcement.md
 	rm announcement.tmp
 .stack-work/bin/posts: $(FILES) stack.yaml posts.cabal
 	stack build
-
+announcement.html: announcement.md
 	pandoc announcement.md -t html > announcement.html
 run: .stack-work/bin/posts
 	stack exec posts
@ -17,6 +20,6 @@ run: .stack-work/bin/posts
 test: .stack-work/bin/posts
 	stack test
-post: announcement.md
+post: announcement.html
 .PHONY: post run test
--- a/doc/posts/announcement.md
+++ b/doc/posts/announcement.md
@ -9,22 +9,71 @@ an API description.
 This is much closer to the traditional use of `QuickCheck`. The most obvious
 use-case is checking that properties hold of an *entire* server rather than of
-individual endpoints.
+individual endpoints. (But there are other uses that you can skip to if they
 sound more interesting.)
 ## `serverSatisfies`
-There are a variety of best practices in writing web APIs that aren't always
+A useful guideline when writing and maintaing software is that, if there isn't
-obvious. As a running example, let's use a simple service that allows adding,
+a test for a behaviour or property, sooner or later that property will be broken.
-removing, and querying biological species. Our SQL schema is:
+Another important perspective is that tests are a form of documentation - the
 present developer telling future ones "this matters, and should be this way".
 The advantage of using tests for this form of documentation is that there's
 simply too much information to convey, some of it only relevant to very specific
 use cases, and rather than overload developers with an inexhaustible quantity of
 details that would be hard to keep track of or remember, tests are a mechanism
 of reminding developers of *only the relevant information, at the right time*.
 <<EXAMPLE>>.
 We might hope that we could use tests to communicate the wide array of best
 practices that have developed around APIs. About to return a top-level integer
 in JSON? A test should say that's bad practice. About to not catch exceptions
 and give a more meaningful HTTP status code? Another test there to stop you.
 Traditionally, in web services these things get done at the level of *individual*
 endpoints. But this means that if a developer who hasn't had extensive experience with web
 programming best practices writes a *new* endpoint which *does* return a top-level
 integer literal, there's no test there to stop her. Code review might help, but
 code review is much more error prone than tests, and really only meant for those
 things that are too subtle to automate. (Indeed, if code review were such a reliable
 defense mechanism against bugs and bad code, why have tests and linters at all?)
 The problem, then, with thinking about tests as only existing at the level of individual
 endpoints is that there are no tests *for* tests - tests that check that new
 behaviour and tests conforms to higher-level, more general best practices.
 `servant-quickcheck` aims to solve that. It allows describing properties that
 *all* endpoints must satisfy. If a new endpoint comes along, it too will be
 tested for that property, without any further work.
 Why isn't this idea already popular? Well, most web frameworks don't have a
 reified description of APIs (beyond perhaps the routes). When you don't know
 what the endpoints of an application are, and what request body they expect,
 trying to generate arbitrary requests is almost entirely going to result in
 404s (not found) and 400s (bad request). Maybe one in a thousand requests will
 actually test a handler. Not very useful.
 `servant` applications, on the other hand, have a machine-readable API description
 already available. And they already associate "correct" requests with particular
 types. It's a small step, therefore, to generate 'arbitrary' values for these
 requests, and all of them will go through to your handlers. (Note: all of the
 uses of `servant-quickcheck` work with applications *not* written with servant-server -
 and indeed not *in Haskell - but the API must be described with the servant
 DSL.)
 Let's see how this works in practice.  As a running example, let's use a simple
 service that allows adding, removing, and querying biological species. Our SQL
 schema is:
-> **«schema.sql»**
+> **schema.sql**
 >     
 >     CREATE TABLE genus (
 >         genus_name     text  PRIMARY KEY,
 >         genus_family   text  NOT NULL
->     )
+>     );
 >     
 >     CREATE TABLE species (
 >         species_name    text  PRIMARY KEY,
@ -35,7 +84,7 @@ removing, and querying biological species. Our SQL schema is:
 And our actual application:
-> **«Main.hs»**
+> **Main.hs**
 >     {-# LANGUAGE DataKinds #-}
 >     {-# LANGUAGE DeriveAnyClass #-}
@ -43,6 +92,8 @@ And our actual application:
 >     {-# LANGUAGE TypeOperators #-}
 >     {-# LANGUAGE OverloadedStrings #-}
 >     {-# LANGUAGE RecordWildCards #-}
 >     module Main where
 >     
 >     import Servant
 >     import Data.Aeson
 >     import Database.PostgreSQL.Simple
@ -54,8 +105,9 @@ And our actual application:
 >     type API
 >       = "species" :> (Capture "species-name" Text :> ( Get '[JSON] Species
 >                                                   :<|> Delete '[JSON] ())
->                  :<|> ReqBody '[JSON] Species :> Post '[JSON] ()
+>                  :<|> ReqBody '[JSON] Species :> Post '[JSON] ())
->                  :<|> "count" :> Get '[JSON] Int)
+>       -- The plural of 'species' is unfortunately also 'species'
 >      :<|> "speciess" :> Get '[JSON] [Species]
 >     
 >     api :: Proxy API
 >     api = Proxy
@ -74,19 +126,19 @@ And our actual application:
 >     instance FromRow Species
 >     
 >     server :: Connection -> Server API
->     server conn = (\sname -> liftIO (lookupSpecies conn sname)
+>     server conn = ((\sname -> liftIO (lookupSpecies conn sname)
->                         :<|> liftIO (deleteSpecies conn sname))
+>                          :<|> liftIO (deleteSpecies conn sname))
->              :<|> (\species -> liftIO $ insertSpecies conn species)
+>              :<|> (\species -> liftIO $ insertSpecies conn species))
->              :<|> (liftIO $ countSpecies conn)
+>              :<|> (liftIO $ allSpecies conn)
 >     
 >     lookupSpecies :: Connection -> Text -> IO Species
 >     lookupSpecies conn name = do
->       [s] <- query conn "SELECT * FROM species WHERE species_name == ?" (Only name)
+>       [s] <- query conn "SELECT * FROM species WHERE species_name = ?" (Only name)
 >       return s
 >     
 >     deleteSpecies :: Connection -> Text -> IO ()
 >     deleteSpecies conn name = do
->       _ <- execute conn "DELETE FROM species WHERE species_name == ?" (Only name)
+>       _ <- execute conn "DELETE FROM species WHERE species_name = ?" (Only name)
 >       return ()
 >     
 >     insertSpecies :: Connection -> Species -> IO ()
@ -94,25 +146,173 @@ And our actual application:
 >       _ <- execute conn "INSERT INTO species (species_name, species_genus) VALUES (?)" (speciesName, speciesGenus)
 >       return ()
 >     
->     countSpecies :: Connection -> IO Int
+>     allSpecies :: Connection -> IO [Species]
->     countSpecies conn = do
+>     allSpecies conn = do
->       [Only count] <- query_ conn "SELECT count(*) FROM species"
+>       query_ conn "SELECT * FROM species"
 >       return count
 >     
 >     main :: IO ()
 >     main = do
->       conn <- connectPostgreSQL ""
+>       conn <- connectPostgreSQL "dbname=servant-quickcheck"
 >       run 8090 (serve api $ server conn)
 (You'll also also need to run:
-> **» Main.hs**
+```
 createdb servant-quickcheck
 psql --file schema.sql -d servant-quickcheck
 ```
->     «Main.hs»
+If you want to run this example.)
 This is a plausible effort. You might want to spend a moment thinking about what
 could be improved.
 > **Spec.hs**
 >     
 >     {-# LANGUAGE OverloadedStrings #-}
 >     module Spec (main) where
 >     
 >     import Main (server, api, Species(..))
 >     import Test.Hspec
 >     import Test.QuickCheck.Instances
 >     import Servant.QuickCheck
 >     import Test.QuickCheck (Arbitrary(..))
 >     import Database.PostgreSQL.Simple (connectPostgreSQL)
 >     
 >     spec :: Spec
 >     spec = describe "the species application" $ beforeAll check $ do
 >       let pserver = do
 >             conn <- connectPostgreSQL "dbname=servant-quickcheck"
 >             return $ server conn
 >     
 >     
 >       it "should not return 500s" $ do
 >     
 >       it "should not return 500s" $ do
 >         withServantServer api pserver $ \url ->
 >           serverSatisfies api url defaultArgs (not500 <%> mempty)
 >     
 >       it "should not return top-level json" $ do
 >         withServantServer api pserver $ \url ->
 >           serverSatisfies api url defaultArgs (onlyJsonObjects <%> mempty)
 >     
 >       where
 >         check = do
 >           mvar  <- newMVar []
 >           withServantServer api pserver $ \url ->
 >              serverSatisfies api url defaultArgs (onlyJsonObjects <%> mempty)
 >     
 >     main :: IO ()
 >     main = do
 >       hspec spec
 >     
 >     instance Arbitrary Species where
 >       arbitrary = Species <$> arbitrary <*> arbitrary
 But this fails in quite a few ways.
 <<TODO>>
 This was an example created with the knowledge of what it was supposed to
 exemplify. To try to get a more accurate assessment of the practical usefulness
 of `servant-quickcheck`, I tried running `serverSatisfies` with a few
 predicates over some of the open-source `servant` servers I could find, and
 results were also promising.
 There are probably a lot of other interesting properties that one might to add
 besides those I've included. As an example, we could have a property that
 all HTML is checked against, which is sometimes tricky for HTML that's
 generated dynamically. Or check that every page has a Portuguese translation.
 ### Why best practices are good
 As a side note: you might have wondered "why bother with API best practices?".
 It is, it has to be said, a lot of extra (as in not only getting the feature done)
 work to do, for dubious benefit. And indeed, the relevance of discoverability, for
 example, unclear, since not that many tools use it as perhaps was anticipated.
 But `servant-quickcheck` both makes it *easier* to conform to best practices,
 and exemplifies their advantage in enabling better tooling. If we pick 201 (Success, the 'resource' was
 created), rather than the more generic 200 (Success), and do a *little* more work
 by knowing to make this decision, `servant-quickcheck` knows this means there
 should be some representation of the resource created. So it knows to ask you
 for a link to it (the RFC creators thought to ask for this). And if you do (again,
 a little more work), `servant-quickcheck` will know to try to look at that
 resource by following the link, checking that it's not broken, and maybe even
 returns a response that equivalent to the original POST request). And then it
 finds a real bug - your application allows species with '/' in their name to
 be created, but not queried with a 'GET' for! This, I think, is already a win.
 ## `serversEqual`
 There's another very appealing application of the ability to generate "sensible"
 arbitrary requests. It's for testing that two applications are equal. We can generate arbitrary
 requests, send them to both servers (in the same order), and check that the responses
 are equivalent.  (This was, incidentally, one of the first applications of
 `servant-client`, albeit in a much more manual way, when we rewrote a microservice
 originally in Python in Haskell.) Generally with rewrites, even if there's some
 behaviour that isn't optimal, perhaps a lot of things already depend on that service
 and make interace poorly with "improvements", so it makes sense to first mimick
 *exactly* the original behaviour, and only then aim for improvements.
 `servant-quickcheck` provides a single function, `serversEqual`, that attempts
 to verify the equivalence of servers. Since some aspects of responses might not
 be relevant (for example, whether the the `Server` header is the same, or whether
 two JSON responses have the same formatting), it allows you to provide a custom
 equivalence function. Other than that, you need only provide an API type and two
 URLs for testing, and the rest `serversEqual` handles.
 ## Future directions: benchmarking
 What else could benefit from tooling that can automatically generate sensible
 (*vis-a-vis* a particular application's expectations) requests?
 One area is extensive automatic benchmarking. Currently we use tools such as
 `ab`, `wrk`, `httperf` in a very manual way - we pick a particular request that
 we are interested in, and write a request that gets made thousands of times.
 But now we can have a multiplicity of requests to benchmark with! This allows
 *finding* slow endpoints, as well as (I would imagine, though I haven't actually
 tried this yet) finding synchronization issues that make threads wait for too
 long (such as waiting on an MVar that's not really needed), bad asymptotics
 with respect to some other type of request.
 (On this last point, imagine not having an index in a database for "people",
 and having a tool that discovers that the latency on a search by first name
 grows linearly with the number of POST requests to a *different* endpoint! We'd
 need to do some work to do this well, possibly involving some machine
 learning, but it's an interesting and probably useful idea.)
 # Conclusion
 I hope this library presents some useful functionality already, but I hope
 you'll also think how it could be improved!
 There'll be a few more packages in the comings weeks - check back soon!
 **Note**: This post is an anansi literate file that generates multiple source
 files. They are:
 > ** Main.hs**
 >     Main.hs
-> **» schema.sql**
+> ** schema.sql**
->     «schema.sql»
+>     schema.sql
 > ** Spec.hs**
 >     Spec.hs
--- a/doc/posts/src/Main.hs
+++ b/doc/posts/src/Main.hs
@ -1,6 +1,6 @@
-#line 158 "Announcement.anansi"
+#line 296 "Announcement.anansi"
-#line 37 "Announcement.anansi"
+#line 86 "Announcement.anansi"
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE DeriveGeneric #-}
--- a/doc/posts/src/Spec.hs
+++ b/doc/posts/src/Spec.hs
@ -1,6 +1,6 @@
-#line 166 "Announcement.anansi"
+#line 304 "Announcement.anansi"
-#line 120 "Announcement.anansi"
+#line 171 "Announcement.anansi"
 {-# LANGUAGE OverloadedStrings #-}
 module Spec (main) where
@ -13,11 +13,12 @@ import Test.QuickCheck (Arbitrary(..))
 import Database.PostgreSQL.Simple (connectPostgreSQL)
 spec :: Spec
-spec = describe "the species application" $ do
+spec = describe "the species application" $ beforeAll check $ do
  let pserver = do
        conn <- connectPostgreSQL "dbname=servant-quickcheck"
        return $ server conn
  it "should not return 500s" $ do
    withServantServer api pserver $ \url ->
      serverSatisfies api url defaultArgs (not500 <%> mempty)
@ -26,6 +27,11 @@ spec = describe "the species application" $ do
    withServantServer api pserver $ \url ->
      serverSatisfies api url defaultArgs (onlyJsonObjects <%> mempty)
  it "should return valid locations for 201" $ do
    withServantServer api pserver $ \url ->
      serverSatisfies api url defaultArgs (createContainsValidLocation <%> mempty)
 main :: IO ()
 main = do
  hspec spec
--- a/example/Main.hs
+++ b/example/Main.hs
@ -0,0 +1,31 @@
 {-# LANGUAGE OverloadedStrings, DataKinds #-}
 module Main (main) where
 import Servant
 import Servant.QuickCheck
 import Test.Hspec
 import Data.Text (Text)
 import System.Environment (getArgs)
 main :: IO ()
 main = do
    args <- getArgs
    case args of
        [] -> putStrLn "Not running without arguments. Try --help or --fail-fast."
        _  -> hspec spec
 -- Change to String to reproduce
 -- https://github.com/haskell-servant/servant-quickcheck/issues/41
 type API = Get '[PlainText] Text
 api :: Proxy API
 api = Proxy
 server :: Server API
 server = return "Sigurð Fáfnirslayer"
 spec :: Spec
 spec = describe "example server" $
    it "mangles UTF-8 in error messages" $
        withServantServer api (return server) $ \burl ->
            serverSatisfies api burl defaultArgs (getsHaveCacheControlHeader <%> mempty)
--- a/servant-quickcheck.cabal
+++ b/servant-quickcheck.cabal
@ -1,94 +1,138 @@
-name:                servant-quickcheck
+name:               servant-quickcheck
-version:             0.0.0.0
+version:            0.0.9.1
-synopsis:            QuickCheck entire APIs
+synopsis:           QuickCheck entire APIs
 description:
- This packages provides QuickCheck properties that are tested across an entire
+  This packages provides QuickCheck properties that are tested across an entire
- API.
+  API.
-license:             BSD3
+license:            BSD3
-license-file:        LICENSE
+license-file:       LICENSE
-author:              Julian K. Arni
+author:             Julian K. Arni
-maintainer:          jkarni@gmail.com
+maintainer:         jkarni@gmail.com
-category:            Web
+category:           Web
-build-type:          Simple
+build-type:         Simple
-cabal-version:       >=1.10
+cabal-version:      >=1.10
 extra-source-files: CHANGELOG.yaml
 tested-with:        GHC ==8.0.2 || ==8.2.2 || ==8.4.4 || ==8.6.5 || == 8.8.3
 source-repository head
  type:     git
  location: https://github.com/haskell-servant/servant-quickcheck
 flag long-tests
  description: Run more QuickCheck tests
  default:     False
 library
-  exposed-modules:     Servant.QuickCheck
+  exposed-modules:
-                     , Servant.QuickCheck.Internal
+    Servant.QuickCheck
-                     , Servant.QuickCheck.Internal.Predicates
+    Servant.QuickCheck.Internal
-                     , Servant.QuickCheck.Internal.HasGenRequest
+    Servant.QuickCheck.Internal.Equality
-                     , Servant.QuickCheck.Internal.QuickCheck
+    Servant.QuickCheck.Internal.ErrorTypes
-                     , Servant.QuickCheck.Internal.Equality
+    Servant.QuickCheck.Internal.HasGenRequest
-  build-depends:       base >=4.7 && <4.9
+    Servant.QuickCheck.Internal.Predicates
-                     , base-compat == 0.9.*
+    Servant.QuickCheck.Internal.QuickCheck
                     , QuickCheck == 2.8.*
                     , bytestring == 0.10.*
                     , aeson > 0.10 && < 0.12
                     , mtl == 2.2.*
                     , http-client == 0.4.*
                     , http-types == 0.9.*
                     , http-media == 0.6.*
                     , servant-client == 0.7.*
                     , servant-server == 0.7.*
                     , string-conversions == 0.4.*
                     , data-default-class == 0.0.*
                     , servant == 0.7.*
                     , warp >= 3.2.4 && < 3.3
                     , process == 1.2.*
                     , temporary == 1.2.*
                     , split == 0.2.*
                     , case-insensitive == 1.2.*
                     , hspec == 2.2.*
                     , text == 1.*
  if impl(ghc < 7.10)
    build-depends:     bifunctors == 5.*
-  hs-source-dirs:      src
+  build-depends:
-  default-extensions:  TypeOperators
+      aeson                  >=0.8    && <2
-                     , FlexibleInstances
+    , base                   >=4.9    && <4.15
-                     , FlexibleContexts
+    , base-compat-batteries  >=0.10.1 && <0.12
-                     , DataKinds
+    , bytestring             >=0.10   && <0.11
-                     , GADTs
+    , case-insensitive       >=1.2    && <1.3
-                     , MultiParamTypeClasses
+    , clock                  >=0.7    && <0.9
-                     , DeriveFunctor
+    , data-default-class     >=0.0    && <0.2
-                     , KindSignatures
+    , hspec                  >=2.5.6  && <2.8
-                     , RankNTypes
+    , http-client            >=0.4.30 && <0.8
-                     , ConstraintKinds
+    , http-media             >=0.6    && <0.9
-                     , DeriveGeneric
+    , http-types             >=0.8    && <0.13
-                     , ScopedTypeVariables
+    , mtl                    >=2.1    && <2.3
-                     , OverloadedStrings
+    , pretty                 >=1.1    && <1.2
-                     , FunctionalDependencies
+    , process                >=1.2    && <1.7
-                     , NoImplicitPrelude
+    , QuickCheck             >=2.7    && <2.15
-  default-language:    Haskell2010
+    , servant                >=0.17   && <0.19
    , servant-client         >=0.17   && <0.19
    , servant-server         >=0.17   && <0.19
    , split                  >=0.2    && <0.3
    , string-conversions     >=0.3    && <0.5
    , temporary              >=1.2    && <1.4
    , text                   >=1      && <2
    , time                   >=1.5    && <1.11
    , warp                   >=3.2.4  && <3.4
  if !impl(ghc >=8.0)
    build-depends: semigroups >=0.18.3 && <0.20
  hs-source-dirs:     src
  default-extensions:
    NoImplicitPrelude
    ConstraintKinds
    DataKinds
    DeriveDataTypeable
    DeriveFunctor
    DeriveGeneric
    FlexibleContexts
    FlexibleInstances
    FunctionalDependencies
    GADTs
    KindSignatures
    MultiParamTypeClasses
    OverloadedStrings
    RankNTypes
    ScopedTypeVariables
    TypeOperators
  default-language:   Haskell2010
 test-suite spec
-  type:                exitcode-stdio-1.0
+  type:               exitcode-stdio-1.0
-  ghc-options:         -Wall -threaded
+  ghc-options:        -Wall -threaded
-  default-language:    Haskell2010
+  default-language:   Haskell2010
-  hs-source-dirs:      test
+  hs-source-dirs:     test
-  main-is:             Spec.hs
+  main-is:            Spec.hs
-  other-modules:       Servant.QuickCheck.InternalSpec
+  other-modules:      Servant.QuickCheck.InternalSpec
-  build-depends:       base == 4.*
+  build-tool-depends: hspec-discover:hspec-discover -any
-                     , base-compat
+  build-depends:
-                     , servant-quickcheck
+      aeson
-                     , hspec
+    , base
-                     , http-client
+    , base-compat-batteries
-                     , warp
+    , blaze-html
-                     , servant-server
+    , bytestring
-                     , servant-client
+    , hspec
-                     , servant
+    , hspec-core             >=2.5.5 && <2.8
-                     , transformers
+    , http-client
-                     , QuickCheck
+    , QuickCheck
-                     , quickcheck-io
+    , quickcheck-io
-  default-extensions:  TypeOperators
+    , servant
-                     , FlexibleInstances
+    , servant-blaze
-                     , FlexibleContexts
+    , servant-client
-                     , DataKinds
+    , servant-quickcheck
-                     , NoImplicitPrelude
+    , servant-server
    , transformers
    , warp
  default-extensions:
    NoImplicitPrelude
    DataKinds
    FlexibleContexts
    FlexibleInstances
    GADTs
    OverloadedStrings
    ScopedTypeVariables
    TypeOperators
  if flag(long-tests)
-      cpp-options: -DLONG_TESTS
+    cpp-options: -DLONG_TESTS
 test-suite example
  type:             exitcode-stdio-1.0
  main-is:          Main.hs
  hs-source-dirs:   example
  ghc-options:      -Wall
  build-depends:
      base
    , hspec
    , servant-quickcheck
    , servant-server
    , text
  default-language: Haskell2010
--- a/src/Servant/QuickCheck.hs
+++ b/src/Servant/QuickCheck.hs
@ -27,12 +27,18 @@ module Servant.QuickCheck
  -- in RFCs. The __Best Practices__ includes, in addition to RFC
  -- recommendations, recommendations found elsewhere or generally accepted.
  , not500
  , notLongerThan
  , onlyJsonObjects
  , honoursAcceptHeader
  , notAllowedContainsAllowHeader
  , unauthorizedContainsWWWAuthenticate
  , getsHaveLastModifiedHeader
  , getsHaveCacheControlHeader
  , headsHaveCacheControlHeader
  , createContainsValidLocation
    -- * Html Predicates
  , htmlIncludesDoctype
  -- *** Predicate utilities and types
  , (<%>)
  , Predicates
@ -48,6 +54,7 @@ module Servant.QuickCheck
  -- represents other means of checking equality
  -- *** Useful @ResponseEquality@s
  , bodyEquality
  , jsonEquality
  , allEquality
  -- ** Response equality type
  , ResponseEquality(..)
@ -69,10 +76,10 @@ module Servant.QuickCheck
  ) where
 import Data.Proxy                  (Proxy (..))
 import Servant.Client              (BaseUrl (..), Scheme (..))
 import Servant.QuickCheck.Internal
-import Servant.Client (BaseUrl(..), Scheme(..))
+import Test.QuickCheck             (Args (..), stdArgs)
 import Test.QuickCheck (Args(..), stdArgs)
 import Data.Proxy (Proxy(..))
 -- | QuickCheck @Args@ with 1000 rather than 100 test cases.
 --
--- a/src/Servant/QuickCheck/Internal.hs
+++ b/src/Servant/QuickCheck/Internal.hs
@ -1,6 +1,7 @@
 module Servant.QuickCheck.Internal (module X) where
 import Servant.QuickCheck.Internal.Equality      as X
 import Servant.QuickCheck.Internal.ErrorTypes    as X
 import Servant.QuickCheck.Internal.HasGenRequest as X
-import Servant.QuickCheck.Internal.Predicates as X
+import Servant.QuickCheck.Internal.Predicates    as X
-import Servant.QuickCheck.Internal.QuickCheck as X
+import Servant.QuickCheck.Internal.QuickCheck    as X
 import Servant.QuickCheck.Internal.Equality as X
--- a/src/Servant/QuickCheck/Internal/Equality.hs
+++ b/src/Servant/QuickCheck/Internal/Equality.hs
@ -1,16 +1,23 @@
 module Servant.QuickCheck.Internal.Equality where
-import           Data.Function       (on)
+import Data.Aeson          (Value, decode, decodeStrict)
-import           Network.HTTP.Client (Response, responseBody)
+import Data.ByteString     (ByteString)
-import           Prelude.Compat
+import qualified Data.ByteString.Lazy as LB
 import Data.Function       (on)
 import Network.HTTP.Client (Response, responseBody)
 import Data.Semigroup      (Semigroup (..))
 import Prelude.Compat
 newtype ResponseEquality b
  = ResponseEquality { getResponseEquality :: Response b -> Response b -> Bool }
 instance Semigroup (ResponseEquality b) where
  ResponseEquality a <> ResponseEquality b = ResponseEquality $ \x y ->
    a x y && b x y  
 instance Monoid (ResponseEquality b) where
  mempty = ResponseEquality $ \_ _ -> True
-  ResponseEquality a `mappend` ResponseEquality b = ResponseEquality $ \x y ->
+  mappend = (<>)
    a x y && b x y
 -- | Use `Eq` instance for `Response`
 --
@ -23,3 +30,29 @@ allEquality = ResponseEquality (==)
 -- /Since 0.0.0.0/
 bodyEquality :: Eq b => ResponseEquality b
 bodyEquality = ResponseEquality ((==) `on` responseBody)
 -- | Equality as 'Value'. This means that if two bodies are equal as JSON
 -- (e.g., insignificant whitespace difference) they are considered equal.
 --
 -- /Since 0.0.3.0/
 jsonEquality :: (JsonEq b) => ResponseEquality b
 jsonEquality = ResponseEquality (jsonEq `on` responseBody)
 class JsonEq a where
  decode' :: a -> Maybe Value
  jsonEq :: a -> a -> Bool
  jsonEq first second = compareDecodedResponses (decode' first) (decode' second)
 instance JsonEq LB.ByteString where
  decode' = decode
 instance JsonEq ByteString where
  decode' = decodeStrict
 compareDecodedResponses :: Maybe Value -> Maybe Value -> Bool
 compareDecodedResponses resp1 resp2 =
  case resp1 of
    Nothing -> False  -- if decoding fails we assume failure
    (Just r1) -> case resp2 of
      Nothing -> False  -- another decode failure
      (Just r2) -> r1 == r2
--- a/src/Servant/QuickCheck/Internal/ErrorTypes.hs
+++ b/src/Servant/QuickCheck/Internal/ErrorTypes.hs
@ -0,0 +1,82 @@
 {-# LANGUAGE CPP #-}
 module Servant.QuickCheck.Internal.ErrorTypes where
 import           Control.Exception       (Exception (..))
 import qualified Data.ByteString.Lazy    as LBS
 import           Data.String.Conversions (cs)
 import qualified Data.Text               as T
 import           Data.Typeable           (Typeable)
 import           GHC.Generics            (Generic)
 import qualified Network.HTTP.Client     as C
 import           Network.HTTP.Types      (Header, statusCode)
 import           Text.PrettyPrint
 import           Prelude.Compat hiding ((<>))
 data PredicateFailure
  = PredicateFailure T.Text (Maybe C.Request) (C.Response LBS.ByteString)
  deriving (Typeable, Generic)
 instance Exception ServerEqualityFailure where
 instance Show PredicateFailure where
  show = render . prettyPredicateFailure
 data ServerEqualityFailure
  = ServerEqualityFailure C.Request (C.Response LBS.ByteString) (C.Response LBS.ByteString)
  deriving (Typeable, Generic)
 instance Show ServerEqualityFailure where
  show = render . prettyServerEqualityFailure
 instance Exception PredicateFailure where
 -- * Pretty printing
 prettyHeaders :: [Header] -> Doc
 prettyHeaders hdrs = vcat $ prettyHdr <$> hdrs
  where
    prettyHdr (hn, h) = text (show hn) <> colon <+>  text (show h)
 prettyReq :: C.Request -> Doc
 prettyReq r =
  text "Request:" $$ (nest 5 $
     text "Method:"   <+> (nest 5 $ text . show $ C.method r)
  $$ text "Path:"     <+> (nest 5 $ text . cs $ C.path r)
  $$ text "Headers:"  <+> (nest 5 $ prettyHeaders $ C.requestHeaders r)
  $$ text "Body:"     <+> (nest 5 $ text . getReqBody $ C.requestBody r))
  where
    getReqBody (C.RequestBodyLBS lbs ) = cs lbs
    getReqBody (C.RequestBodyBS bs ) = cs bs
    getReqBody _ = error "expected bytestring body"
 prettyResp :: C.Response LBS.ByteString -> Doc
 prettyResp r =
  text "Response:" $$ (nest 5 $
     text "Status code:" <+> (nest 5 $ text . show . statusCode $ C.responseStatus r)
  $$ text "Headers:"  $$ (nest 10 $ prettyHeaders $ C.responseHeaders r)
  $$ text "Body:"     <+> (nest 5 $ text . cs $ C.responseBody r))
 prettyServerEqualityFailure :: ServerEqualityFailure -> Doc
 prettyServerEqualityFailure (ServerEqualityFailure req resp1 resp2) =
  text "Server equality failed" $$ (nest 5 $
     prettyReq req
  $$ prettyResp resp1
  $$ prettyResp resp2)
 prettyPredicateFailure :: PredicateFailure -> Doc
 prettyPredicateFailure (PredicateFailure predicate req resp) =
  text "Predicate failed" $$ (nest 5 $
     text "Predicate:" <+> (text $ T.unpack predicate)
  $$ r
  $$ prettyResp resp)
  where
    r = case req of
      Nothing -> text ""
      Just v  -> prettyReq v
--- a/src/Servant/QuickCheck/Internal/HasGenRequest.hs
+++ b/src/Servant/QuickCheck/Internal/HasGenRequest.hs
@ -1,98 +1,148 @@
 {-# LANGUAGE CPP       #-}
 {-# LANGUAGE PolyKinds #-}
 module Servant.QuickCheck.Internal.HasGenRequest where
-import           Data.Default.Class       (def)
+import Data.String              (fromString)
-import           Data.Monoid              ((<>))
+import Data.String.Conversions  (cs)
-import           Data.String              (fromString)
+import GHC.TypeLits             (KnownSymbol, Nat, symbolVal)
-import           Data.String.Conversions  (cs)
+import Network.HTTP.Client      (Request, RequestBody (..), host, method, path,
-import           GHC.TypeLits             (KnownSymbol, Nat, symbolVal)
+                                 port, queryString, requestBody, requestHeaders,
-import           Network.HTTP.Client      (Request, RequestBody (..), host,
+                                 secure, defaultRequest)
-                                           method, path, port, queryString,
+import Network.HTTP.Media       (renderHeader)
-                                           requestBody, requestHeaders, secure)
+import Prelude.Compat
-import           Network.HTTP.Media       (renderHeader)
+import Servant
-import           Prelude.Compat
+import Servant.API.ContentTypes (AllMimeRender (..))
-import           Servant
+import Servant.Client           (BaseUrl (..), Scheme (..))
-import           Servant.API.ContentTypes (AllMimeRender (..))
+import Test.QuickCheck          (Arbitrary (..), Gen, elements, frequency)
-import           Servant.Client           (BaseUrl (..), Scheme (..))
+
-import           Test.QuickCheck          (Arbitrary (..), Gen, elements, oneof)
+import qualified Data.ByteString as BS
 import qualified Data.ByteString.Internal as BS (c2w)
 -- -----------------------------------------------------------------------------
 -- runGenRequest
 -- | This function returns a QuickCheck `Gen a` when passed a servant API value,
 -- typically a `Proxy API`. The generator returned is a function
 -- that accepts a `BaseUrl` and returns a `Request`, which can then be used
 -- to issue network requests. This `Gen` type makes it easier to compare distinct
 -- APIs across different `BaseUrl`s.
 runGenRequest :: HasGenRequest a => Proxy a -> Gen (BaseUrl -> Request)
 runGenRequest = snd . genRequest
 -- -----------------------------------------------------------------------------
 -- HasGenRequest
 -- | This is the core Servant-Quickcheck generator, which, when given a `Proxy API`
 -- will return a pair of `Int` and `Gen a`, where `a` is a function from
 -- `BaseUrl` to a `Network.Http.Client.Request`. The `Int` is a weight for the
 -- QuickCheck `frequency` function which ensures a random distribution across
 -- all endpoints in an API.
 class HasGenRequest a where
-    genRequest :: Proxy a -> Gen (BaseUrl -> Request)
+    genRequest :: Proxy a -> (Int, Gen (BaseUrl -> Request))
 instance (HasGenRequest a, HasGenRequest b) => HasGenRequest (a :<|> b) where
    genRequest _
-      = oneof [ genRequest (Proxy :: Proxy a)
+      = (lf + rf, frequency [l, r])
-              , genRequest (Proxy :: Proxy b)
+      where
-              ]
+        l@(lf, _) = genRequest (Proxy :: Proxy a)
        r@(rf, _) = genRequest (Proxy :: Proxy b)
 instance (KnownSymbol path, HasGenRequest b) => HasGenRequest (path :> b) where
-    genRequest _ = do
+    genRequest _ = (oldf, do
      old' <- old
-      return $ \burl -> let r = old' burl in r { path = new <> "/" <> path r }
+      return $ \burl -> let r = old' burl
                            oldPath = path r
                            oldPath' = BS.dropWhile (== BS.c2w '/') oldPath
                            paths = filter (not . BS.null) [new, oldPath']
                            in r { path = "/" <> BS.intercalate "/" paths })
      where
-        old = genRequest (Proxy :: Proxy b)
+        (oldf, old) = genRequest (Proxy :: Proxy b)
        new = cs $ symbolVal (Proxy :: Proxy path)
 instance HasGenRequest EmptyAPI where
  genRequest _ = (0, error "EmptyAPIs cannot be queried.")
 instance HasGenRequest api => HasGenRequest (Summary d :> api) where
  genRequest _ = genRequest (Proxy :: Proxy api)
 instance HasGenRequest api => HasGenRequest (Description d :> api) where
  genRequest _ = genRequest (Proxy :: Proxy api)
 instance (Arbitrary c, HasGenRequest b, ToHttpApiData c )
-    => HasGenRequest (Capture x c :> b) where
+    => HasGenRequest (Capture' mods x c :> b) where
-    genRequest _ = do
+    genRequest _ = (oldf, do
      old' <- old
      new' <- toUrlPiece <$> new
-      return $ \burl -> let r = old' burl in r { path = cs new' <> "/" <> path r }
+      return $ \burl -> let r = old' burl in r { path = cs new' <> path r })
      where
-        old = genRequest (Proxy :: Proxy b)
+        (oldf, old) = genRequest (Proxy :: Proxy b)
        new = arbitrary :: Gen c
-instance (Arbitrary c, KnownSymbol h, HasGenRequest b, ToHttpApiData c)
+instance (Arbitrary c, HasGenRequest b, ToHttpApiData c )
-    => HasGenRequest (Header h c :> b) where
+    => HasGenRequest (CaptureAll x c :> b) where
-    genRequest _ = do
+    genRequest _ = (oldf, do
      old' <- old
-      new' <- toUrlPiece <$> new
+      new' <- fmap (cs . toUrlPiece) <$> new
-      return $ \burl -> let r = old' burl in r {
+      let new'' = BS.intercalate "/" new'
-          requestHeaders = (hdr, cs new') : requestHeaders r }
+      return $ \burl -> let r = old' burl in r { path = new'' <> path r })
      where
-        old = genRequest (Proxy :: Proxy b)
+        (oldf, old) = genRequest (Proxy :: Proxy b)
        new = arbitrary :: Gen [c]
 instance (Arbitrary c, KnownSymbol h, HasGenRequest b, ToHttpApiData c)
    => HasGenRequest (Header' mods h c :> b) where
    genRequest _ = (oldf, do
      old' <- old
      new' <- toUrlPiece <$> new  -- TODO: generate lenient or/and optional
      return $ \burl -> let r = old' burl in r {
          requestHeaders = (hdr, cs new') : requestHeaders r })
      where
        (oldf, old) = genRequest (Proxy :: Proxy b)
        hdr = fromString $ symbolVal (Proxy :: Proxy h)
        new = arbitrary :: Gen c
 instance (AllMimeRender x c, Arbitrary c, HasGenRequest b)
-    => HasGenRequest (ReqBody x c :> b) where
+    => HasGenRequest (ReqBody' mods x c :> b) where
-    genRequest _ = do
+    genRequest _ = (oldf, do
-      old' <- old
+      old' <- old  -- TODO: generate lenient
      new' <- new
      (ct, bd) <- elements $ allMimeRender (Proxy :: Proxy x) new'
      return $ \burl -> let r = old' burl in r {
          requestBody = RequestBodyLBS bd
        , requestHeaders = ("Content-Type", renderHeader ct) : requestHeaders r
-        }
+        })
      where
-        old = genRequest (Proxy :: Proxy b)
+        (oldf, old) = genRequest (Proxy :: Proxy b)
        new = arbitrary :: Gen c
 instance (KnownSymbol x, Arbitrary c, ToHttpApiData c, HasGenRequest b)
-    => HasGenRequest (QueryParam x c :> b) where
+    => HasGenRequest (QueryParam' mods x c :> b) where
-    genRequest _ = do
+    genRequest _ = (oldf, do
-      new' <- new
+      new' <- new  -- TODO: generate lenient or/and optional
      old' <- old
-      return $ \burl -> let r = old' burl in r {
+      return $ \burl -> let r = old' burl
-          queryString = queryString r
+                            newExpr = param <> "=" <> cs (toQueryParam new')
-                     <> param <> "=" <> cs (toQueryParam new') }
+                            qs = queryString r in r {
          queryString = if BS.null qs then newExpr else newExpr <> "&" <> qs })
      where
-        old = genRequest (Proxy :: Proxy b)
+        (oldf, old) = genRequest (Proxy :: Proxy b)
        param = cs $ symbolVal (Proxy :: Proxy x)
        new = arbitrary :: Gen c
 instance (KnownSymbol x, Arbitrary c, ToHttpApiData c, HasGenRequest b)
    => HasGenRequest (QueryParams x c :> b) where
-    genRequest _ = do
+    genRequest _ = (oldf, do
      new' <- new
      old' <- old
      return $ \burl -> let r = old' burl in r {
          queryString = queryString r
-                     <> if length new' > 0 then fold (toParam <$> new') else ""}
+                     <> if length new' > 0 then fold (toParam <$> new') else ""})
      where
-        old = genRequest (Proxy :: Proxy b)
+        (oldf, old) = genRequest (Proxy :: Proxy b)
        param = cs $ symbolVal (Proxy :: Proxy x)
        new = arbitrary :: Gen [c]
        toParam c = param <> "[]=" <> cs (toQueryParam c)
@ -100,22 +150,32 @@ instance (KnownSymbol x, Arbitrary c, ToHttpApiData c, HasGenRequest b)
 instance (KnownSymbol x, HasGenRequest b)
    => HasGenRequest (QueryFlag x :> b) where
-    genRequest _ = do
+    genRequest _ = (oldf, do
      old' <- old
-      return $ \burl -> let r = old' burl in r {
+      return $ \burl -> let r = old' burl
-          queryString = queryString r <> param <> "=" }
+                            qs = queryString r in r {
          queryString = if BS.null qs then param else param <> "&" <> qs })
      where
-        old = genRequest (Proxy :: Proxy b)
+        (oldf, old) = genRequest (Proxy :: Proxy b)
        param = cs $ symbolVal (Proxy :: Proxy x)
 instance (ReflectMethod method)
    => HasGenRequest (Verb (method :: k) (status :: Nat) (cts :: [*]) a) where
-    genRequest _ = return $ \burl -> def
+    genRequest _ = (1, return $ \burl -> defaultRequest
       { host = cs $ baseUrlHost burl
       , port = baseUrlPort burl
       , secure = baseUrlScheme burl == Https
       , method = reflectMethod (Proxy :: Proxy method)
-       }
+       })
 instance (ReflectMethod method)
    => HasGenRequest (NoContentVerb (method :: k)) where
    genRequest _ = (1, return $ \burl -> defaultRequest
       { host = cs $ baseUrlHost burl
       , port = baseUrlPort burl
       , secure = baseUrlScheme burl == Https
       , method = reflectMethod (Proxy :: Proxy method)
       })
 instance (HasGenRequest a) => HasGenRequest (RemoteHost :> a) where
    genRequest _ = genRequest (Proxy :: Proxy a)
--- a/src/Servant/QuickCheck/Internal/Predicates.hs
+++ b/src/Servant/QuickCheck/Internal/Predicates.hs
@ -1,28 +1,36 @@
 module Servant.QuickCheck.Internal.Predicates where
-import           Control.Monad         (liftM2)
+import           Control.Exception     (catch, throw)
 import           Control.Monad         (liftM2, unless, when)
 import           Data.Aeson            (Object, decode)
-import           Data.Bifunctor        (Bifunctor (..))
+import           Data.Bifunctor        (first)
 import           Prelude.Compat
 import qualified Data.ByteString       as SBS
 import qualified Data.ByteString.Char8 as SBSC
 import qualified Data.ByteString.Lazy  as LBS
-import           Data.CaseInsensitive  (mk)
+import           Data.CaseInsensitive  (foldCase, foldedCase, mk)
 import           Data.Either           (isRight)
 import           Data.List.Split       (wordsBy)
 import           Data.Maybe            (fromMaybe, isJust)
-import           Data.Monoid           ((<>))
+import           Data.Semigroup        (Semigroup (..))
-import           Data.Text             (Text)
+import qualified Data.Text             as T
 import           Data.Time             (UTCTime, defaultTimeLocale, parseTimeM,
                                        rfc822DateFormat)
 import           GHC.Generics          (Generic)
 import           Network.HTTP.Client   (Manager, Request, Response, httpLbs,
-                                        method, parseUrl, requestHeaders,
+                                        method, parseRequest, requestHeaders,
                                        responseBody, responseHeaders,
                                        responseStatus)
 import           Network.HTTP.Media    (matchAccept)
 import           Network.HTTP.Types    (methodGet, methodHead, parseMethod,
-                                        renderStdMethod, status200, status201,
+                                        renderStdMethod, status100, status200,
-                                        status300, status401, status405,
+                                        status201, status300, status401,
-                                        status500, status100)
+                                        status405, status500)
 import           Prelude.Compat
 import           System.Clock          (Clock (Monotonic), diffTimeSpec,
                                        getTime, toNanoSecs)
 import Servant.QuickCheck.Internal.ErrorTypes
 -- | [__Best Practice__]
 --
@ -33,8 +41,25 @@ import           Network.HTTP.Types    (methodGet, methodHead, parseMethod,
 -- This function checks that the response code is not 500.
 --
 -- /Since 0.0.0.0/
-not500 :: ResponsePredicate Text Bool
+not500 :: ResponsePredicate
-not500 = ResponsePredicate "not500" (\resp -> not $ responseStatus resp == status500)
+not500 = ResponsePredicate $ \resp ->
  when (responseStatus resp == status500) $ throw $ PredicateFailure "not500" Nothing resp
 -- | [__Optional__]
 --
 -- This function checks that the response from the server does not take longer
 -- than the specified number of nanoseconds.
 --
 -- /Since 0.0.2.1/
 notLongerThan :: Integer -> RequestPredicate
 notLongerThan maxAllowed
  = RequestPredicate $ \req mgr -> do
     start <- getTime Monotonic
     resp <- httpLbs req mgr
     end <- getTime Monotonic
     when (toNanoSecs (end `diffTimeSpec` start) > maxAllowed) $
       throw $ PredicateFailure "notLongerThan" (Just req) resp
     return []
 -- | [__Best Practice__]
 --
@ -57,11 +82,15 @@ not500 = ResponsePredicate "not500" (\resp -> not $ responseStatus resp == statu
 --   * JSON Grammar: <https://tools.ietf.org/html/rfc4627#section-2 RFC 4627 Section 2>
 --
 -- /Since 0.0.0.0/
-onlyJsonObjects :: ResponsePredicate Text Bool
+onlyJsonObjects :: ResponsePredicate
 onlyJsonObjects
-  = ResponsePredicate "onlyJsonObjects" (\resp -> case decode (responseBody resp) of
+  = ResponsePredicate (\resp -> do
-      Nothing -> False
+    case lookup "content-type" (first foldedCase <$> responseHeaders resp) of
-      Just (_ :: Object) -> True)
+      Nothing    -> return ()
      Just ctype -> when ("application/json" `SBS.isPrefixOf` ctype) $ do
        case (decode (responseBody resp) :: Maybe Object) of
          Nothing -> throw $ PredicateFailure "onlyJsonObjects" Nothing resp
          Just _  -> return ())
 -- | __Optional__
 --
@ -82,29 +111,59 @@ onlyJsonObjects
 --   * Location header: <https://tools.ietf.org/html/rfc7231#section-7.1.2 RFC 7231 Section 7.1.2>
 --
 -- /Since 0.0.0.0/
-createContainsValidLocation :: RequestPredicate Text Bool
+createContainsValidLocation :: RequestPredicate
 createContainsValidLocation
-  = RequestPredicate
+  = RequestPredicate $ \req mgr -> do
-    { reqPredName = "createContainsValidLocation"
+     let n = "createContainsValidLocation"
-    , reqResps = \req mgr -> do
+     resp <- httpLbs req mgr
-        resp <- httpLbs req mgr
+     if responseStatus resp == status201
-        if responseStatus resp == status201
+         then case lookup "Location" $ responseHeaders resp of
-            then case lookup "Location" $ responseHeaders resp of
+             Nothing -> throw $ PredicateFailure n (Just req) resp
-                Nothing -> return (False, [resp])
+             Just l  -> case parseRequest $ SBSC.unpack l of
-                Just l  -> case parseUrl $ SBSC.unpack l of
+               Nothing -> throw $ PredicateFailure n (Just req) resp
-                  Nothing -> return (False, [resp])
+               Just x  -> do
-                  Just x  -> do
+                 resp2 <- httpLbs x mgr
-                    resp2 <- httpLbs x mgr
+                 status2XX (Just req) resp2 n
-                    return (status2XX resp2, [resp, resp2])
+                 return [resp, resp2]
-            else return (True, [resp])
+         else return [resp]
    }
-{-
+-- | [__Optional__]
-getsHaveLastModifiedHeader :: ResponsePredicate Text Bool
+--
 -- The @Last-Modified@ header represents the time a resource was last
 -- modified. It is used to drive caching and conditional requests.
 --
 -- When using this mechanism, the server adds the @Last-Modified@ header to
 -- responses. Clients may then make requests with the @If-Modified-Since@
 -- header to conditionally request resources. If the resource has not
 -- changed since that date, the server responds with a status code of 304
 -- (@Not Modified@) without a response body.
 --
 -- The @Last-Modified@ header can also be used in conjunction with the
 -- @If-Unmodified-Since@ header to drive optimistic concurrency.
 --
 -- The @Last-Modified@ date must be in RFC 822 format.
 --
 -- __References__:
 --
 --   * 304 Not Modified: <https://tools.ietf.org/html/rfc7232#section-4.1 RFC 7232 Section 4.1>
 --   * Last-Modified header: <https://tools.ietf.org/html/rfc7232#section-2.2 RFC 7232 Section 2.2>
 --   * If-Modified-Since header: <https://tools.ietf.org/html/rfc7232#section-3.3 RFC 7232 Section 3.3>
 --   * If-Unmodified-Since header: <https://tools.ietf.org/html/rfc7232#section-3.4 RFC 7232 Section 3.4>
 --   * Date format: <https://tools.ietf.org/html/rfc2616#section-3.3 RFC 2616 Section 3.3>
 --
 -- /Since 0.0.2.1/
 getsHaveLastModifiedHeader :: RequestPredicate
 getsHaveLastModifiedHeader
-  = ResponsePredicate "getsHaveLastModifiedHeader" (\resp ->
+  = RequestPredicate $ \req mgr ->
     if (method req == methodGet)
      then do
        resp <- httpLbs req mgr
        unless (hasValidHeader "Last-Modified" isRFC822Date resp) $ do
          throw $ PredicateFailure "getsHaveLastModifiedHeader" (Just req) resp
        return [resp]
      else return []
 -}
 -- | [__RFC Compliance__]
 --
@ -116,24 +175,27 @@ getsHaveLastModifiedHeader
 -- This function checks that every @405 Method Not Allowed@ response contains
 -- an @Allow@ header with a list of standard HTTP methods.
 --
 -- Note that 'servant' itself does not currently set the @Allow@ headers.
 --
 -- __References__:
 --
 --   * @Allow@ header: <https://www.w3.org/Protocols/rfc2616/rfc2616-sec14.html RFC 2616 Section 14.7>
 --   * Status 405: <https://www.w3.org/Protocols/rfc2616/rfc2616-sec10.html RFC 2616 Section 10.4.6>
 --   * Servant Allow header issue: <https://github.com/haskell-servant/servant/issues/489 Issue #489>
 --
 -- /Since 0.0.0.0/
-notAllowedContainsAllowHeader :: RequestPredicate Text Bool
+notAllowedContainsAllowHeader :: RequestPredicate
 notAllowedContainsAllowHeader
-  = RequestPredicate
+  = RequestPredicate $ \req mgr -> do
-    { reqPredName = "notAllowedContainsAllowHeader"
+      let reqs = [ req { method = renderStdMethod m } | m <- [minBound .. maxBound]
-    , reqResps = \req mgr -> do
+                                                      , renderStdMethod m /= method req ]
-        resp <- mapM (flip httpLbs mgr) $ [ req { method = renderStdMethod m }
+      resp <- mapM (flip httpLbs mgr) reqs
-                                          | m <- [minBound .. maxBound ]
+
-                                          , renderStdMethod m /= method req ]
+      case filter pred' (zip reqs resp) of
-        return (all pred' resp, resp)
+        (x:_) -> throw $ PredicateFailure "notAllowedContainsAllowHeader" (Just $ fst x) (snd x)
-    }
+        []     -> return resp
    where
-      pred' resp = responseStatus resp /= status405 || hasValidHeader "Allow" go resp
+      pred' (_, resp) = responseStatus resp == status405 && not (hasValidHeader "Allow" go resp)
        where
          go x = all (\y -> isRight $ parseMethod $ SBSC.pack y)
               $ wordsBy (`elem` (", " :: [Char])) (SBSC.unpack x)
@ -154,19 +216,19 @@ notAllowedContainsAllowHeader
 --   * @Accept@ header: <https://www.w3.org/Protocols/rfc2616/rfc2616-sec14.html RFC 2616 Section 14.1>
 --
 -- /Since 0.0.0.0/
-honoursAcceptHeader :: RequestPredicate Text Bool
+honoursAcceptHeader :: RequestPredicate
 honoursAcceptHeader
-  = RequestPredicate
+  = RequestPredicate $ \req mgr -> do
-    { reqPredName = "honoursAcceptHeader"
+      resp <- httpLbs req mgr
-    , reqResps = \req mgr -> do
+      let scode = responseStatus resp
-        resp <- httpLbs req mgr
+          sctype = lookup "Content-Type" $ responseHeaders resp
-        let scode = responseStatus resp
+          sacc  = fromMaybe "*/*" $ lookup "Accept" (requestHeaders req)
-            sctype = lookup "Content-Type" $ responseHeaders resp
+      if status100 < scode && scode < status300
-            sacc  = fromMaybe "*/*" $ lookup "Accept" (requestHeaders req)
+        then if isJust $ sctype >>= \x -> matchAccept [x] sacc
-        if status100 < scode && scode < status300
+          then throw $ PredicateFailure "honoursAcceptHeader" (Just req) resp
-          then return (isJust $ sctype >>= \x -> matchAccept [x] sacc, [resp])
+          else return [resp]
-          else return (True, [resp])
+        else return [resp]
-    }
+
 -- | [__Best Practice__]
 --
@ -182,34 +244,32 @@ honoursAcceptHeader
 --   * @Cache-Control@ header: <https://tools.ietf.org/html/rfc7234#section-5.2 RFC 7234 Section 5.2>
 --
 -- /Since 0.0.0.0/
-getsHaveCacheControlHeader :: RequestPredicate Text Bool
+getsHaveCacheControlHeader :: RequestPredicate
 getsHaveCacheControlHeader
-  = RequestPredicate
+  = RequestPredicate $ \req mgr ->
-     { reqPredName = "getsHaveCacheControlHeader"
+     if (method req == methodGet)
-     , reqResps = \req mgr -> if method req == methodGet
+      then do
-        then do
+        resp <- httpLbs req mgr
-          resp <- httpLbs req mgr
+        unless (hasValidHeader "Cache-Control" (const True) resp) $ do
-          let good = isJust $ lookup "Cache-Control" $ responseHeaders resp
+          throw $ PredicateFailure "getsHaveCacheControlHeader" (Just req) resp
-          return (good, [resp])
+        return [resp]
-        else return (True, [])
+      else return []
     }
 -- | [__Best Practice__]
 --
 -- Like 'getsHaveCacheControlHeader', but for @HEAD@ requests.
 --
 -- /Since 0.0.0.0/
-headsHaveCacheControlHeader :: RequestPredicate Text Bool
+headsHaveCacheControlHeader :: RequestPredicate
 headsHaveCacheControlHeader
-  = RequestPredicate
+  = RequestPredicate $ \req mgr ->
-     { reqPredName = "headsHaveCacheControlHeader"
+     if (method req == methodHead)
-     , reqResps = \req mgr -> if method req == methodHead
+       then do
-        then do
+         resp <- httpLbs req mgr
-          resp <- httpLbs req mgr
+         unless (hasValidHeader "Cache-Control" (const True) resp) $
-          let good = hasValidHeader "Cache-Control" (const True) resp
+           throw $ PredicateFailure "headsHaveCacheControlHeader" (Just req) resp
-          return (good, [resp])
+         return [resp]
-        else return (True, [])
+       else return []
     }
 {-
 -- |
 --
@ -271,12 +331,35 @@ linkHeadersAreValid
 --   * @WWW-Authenticate@ header: <https://tools.ietf.org/html/rfc7235#section-4.1 RFC 7235 Section 4.1>
 --
 -- /Since 0.0.0.0/
-unauthorizedContainsWWWAuthenticate :: ResponsePredicate Text Bool
+unauthorizedContainsWWWAuthenticate :: ResponsePredicate
 unauthorizedContainsWWWAuthenticate
-  = ResponsePredicate "unauthorizedContainsWWWAuthenticate" (\resp ->
+  = ResponsePredicate $ \resp ->
      if responseStatus resp == status401
-        then hasValidHeader "WWW-Authenticate" (const True) resp
+        then unless (hasValidHeader "WWW-Authenticate" (const True) resp) $
-        else True)
+          throw $ PredicateFailure "unauthorizedContainsWWWAuthenticate" Nothing resp
        else return ()
 -- | [__RFC Compliance__]
 --
 -- [An HTML] document will start with exactly this string: <!DOCTYPE html>
 --
 -- This function checks that HTML documents (those with `Content-Type: text/html...`)
 -- include a DOCTYPE declaration at the top. We do not enforce capital case for the string `DOCTYPE`.
 --
 -- __References__:
 --
 --  * HTML5 Doctype: <https://tools.ietf.org/html/rfc7992#section-6.1 RFC 7992 Section 6.1>
 -- /Since 0.3.0.0/
 htmlIncludesDoctype :: ResponsePredicate
 htmlIncludesDoctype
  = ResponsePredicate $ \resp ->
      if hasValidHeader "Content-Type" (SBS.isPrefixOf . foldCase $ "text/html") resp
        then do
            let htmlContent = foldCase . LBS.take 20 $ responseBody resp
            unless (LBS.isPrefixOf (foldCase "<!doctype html>") htmlContent) $
              throw $ PredicateFailure "htmlIncludesDoctype" Nothing resp
        else return ()
 -- * Predicate logic
@ -289,67 +372,56 @@ unauthorizedContainsWWWAuthenticate
 -- | A predicate that depends only on the response.
 --
 -- /Since 0.0.0.0/
-data ResponsePredicate n r = ResponsePredicate
+newtype ResponsePredicate = ResponsePredicate
-  { respPredName :: n
+  { getResponsePredicate :: Response LBS.ByteString -> IO ()
-  , respPred :: Response LBS.ByteString -> r
+  } deriving (Generic)
  } deriving (Functor, Generic)
-instance Bifunctor ResponsePredicate where
+instance Semigroup ResponsePredicate where
-  first f (ResponsePredicate a b) = ResponsePredicate (f a) b
+  ResponsePredicate a <> ResponsePredicate b = ResponsePredicate $ \x -> a x >> b x
  second = fmap
-instance (Monoid n, Monoid r) => Monoid (ResponsePredicate n r) where
+instance Monoid ResponsePredicate where
-  mempty = ResponsePredicate mempty mempty
+  mempty = ResponsePredicate $ const $ return ()
-  a `mappend` b = ResponsePredicate
+  mappend = (<>)
    { respPredName = respPredName a <> respPredName b
    , respPred = respPred a <> respPred b
    }
 -- | A predicate that depends on both the request and the response.
 --
 -- /Since 0.0.0.0/
-data RequestPredicate n r = RequestPredicate
+newtype RequestPredicate = RequestPredicate
-  { reqPredName :: n
+  { getRequestPredicate :: Request -> Manager -> IO [Response LBS.ByteString]
-  , reqResps    :: Request -> Manager -> IO (r, [Response LBS.ByteString])
+  } deriving (Generic)
  } deriving (Generic, Functor)
 instance Bifunctor RequestPredicate where
  first f (RequestPredicate a b) = RequestPredicate (f a) b
  second = fmap
 -- TODO: This isn't actually a monoid
-instance (Monoid n, Monoid r) => Monoid (RequestPredicate n r) where
+instance Monoid RequestPredicate where
-  mempty = RequestPredicate mempty (\r m -> httpLbs r m >>= \x -> return (mempty, [x]))
+  mempty = RequestPredicate (\r m -> httpLbs r m >>= \x -> return ([x]))
-  a `mappend` b = RequestPredicate
+  mappend = (<>)
-    { reqPredName = reqPredName a <> reqPredName b
+
-    , reqResps = \x m -> liftM2 (<>) (reqResps a x m) (reqResps b x m)
+-- TODO: This isn't actually a monoid
-    }
+instance Semigroup RequestPredicate where
  RequestPredicate a <> RequestPredicate b = RequestPredicate $ \r mgr ->
    liftM2 (<>) (a r mgr) (b r mgr)
 -- | A set of predicates. Construct one with 'mempty' and '<%>'.
-data Predicates n r = Predicates
+data Predicates = Predicates
-  { reqPreds :: RequestPredicate n r
+  { requestPredicates  :: RequestPredicate
-  , respPreds :: ResponsePredicate n r
+  , responsePredicates :: ResponsePredicate
-  } deriving (Generic, Functor)
+  } deriving (Generic)
-instance (Monoid n, Monoid r) => Monoid (Predicates n r) where
+instance Semigroup Predicates where
  a <> b = Predicates (requestPredicates a <> requestPredicates b)
                      (responsePredicates a <> responsePredicates b)
 instance Monoid Predicates where
  mempty = Predicates mempty mempty
-  a `mappend` b = Predicates (reqPreds a <> reqPreds b) (respPreds a <> respPreds b)
+  mappend = (<>)
 class JoinPreds a where
-  joinPreds :: a -> Predicates [Text] [Text] -> Predicates [Text] [Text]
+  joinPreds :: a -> Predicates -> Predicates
-instance JoinPreds (RequestPredicate Text Bool) where
+instance JoinPreds (RequestPredicate ) where
-  joinPreds p (Predicates x y) = Predicates (go <> x) y
+  joinPreds p (Predicates x y) = Predicates (p <> x) y
    where go = let p' = first return p
               in fmap (\z -> if z then [] else reqPredName p') p'
 instance JoinPreds (ResponsePredicate Text Bool) where
  joinPreds p (Predicates x y) = Predicates x (go <> y)
    where go = let p' = first return p
               in fmap (\z -> if z then [] else respPredName p') p'
 instance JoinPreds (ResponsePredicate ) where
  joinPreds p (Predicates x y) = Predicates x (p <> y)
 -- | Adds a new predicate (either `ResponsePredicate` or `RequestPredicate`) to
 -- the existing predicates.
@ -357,14 +429,17 @@ instance JoinPreds (ResponsePredicate Text Bool) where
 -- > not500 <%> onlyJsonObjects <%> empty
 --
 -- /Since 0.0.0.0/
-(<%>) :: JoinPreds a => a -> Predicates [Text] [Text] -> Predicates [Text] [Text]
+(<%>) :: JoinPreds a => a -> Predicates -> Predicates
 (<%>) = joinPreds
 infixr 6 <%>
-finishPredicates :: Predicates [Text] [Text] -> Request -> Manager -> IO [Text]
+finishPredicates :: Predicates -> Request -> Manager -> IO (Maybe PredicateFailure)
-finishPredicates p req mgr = do
+finishPredicates p req mgr = go `catch` \(e :: PredicateFailure) -> return $ Just e
-  (soFar, resps) <- reqResps (reqPreds p) req mgr
+  where
-  return $ soFar <> mconcat [respPred (respPreds p) r | r <- resps]
+    go = do
     resps <- getRequestPredicate (requestPredicates p) req mgr
     mapM_  (getResponsePredicate $ responsePredicates p) resps
     return Nothing
 -- * helpers
@ -373,5 +448,14 @@ hasValidHeader hdr p r = case lookup (mk hdr) (responseHeaders r) of
  Nothing -> False
  Just v  -> p v
-status2XX :: Response b -> Bool
+isRFC822Date :: SBS.ByteString -> Bool
-status2XX r = status200 <= responseStatus r && responseStatus r < status300
+isRFC822Date s
  = case parseTimeM True defaultTimeLocale rfc822DateFormat (SBSC.unpack s) of
    Nothing -> False
    Just (_ :: UTCTime) -> True
 status2XX :: Monad m => Maybe Request -> Response LBS.ByteString -> T.Text -> m ()
 status2XX mreq resp t
  | status200 <= responseStatus resp && responseStatus resp < status300
  = return ()
  | otherwise = throw $ PredicateFailure t mreq resp
--- a/src/Servant/QuickCheck/Internal/QuickCheck.hs
+++ b/src/Servant/QuickCheck/Internal/QuickCheck.hs
@ -1,25 +1,31 @@
 {-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE CPP #-}
 module Servant.QuickCheck.Internal.QuickCheck where
 import           Control.Concurrent       (tryReadMVar, newEmptyMVar, tryPutMVar)
 import           Control.Monad            (unless)
 import qualified Data.ByteString.Lazy     as LBS
 import           Data.Proxy               (Proxy)
-import           Data.Text                (Text)
+import qualified Network.HTTP.Client      as C
 import           Network.HTTP.Client      (Manager, Request, checkStatus,
                                           defaultManagerSettings, httpLbs,
                                           newManager)
 import           Network.Wai.Handler.Warp (withApplication)
 import           Prelude.Compat
 import           Servant                  (Context (EmptyContext), HasServer,
                                           Server, serveWithContext)
 #if MIN_VERSION_servant_server(0,18,0)
 import           Servant                  (DefaultErrorFormatters, ErrorFormatters, HasContextEntry, type (.++))
 #endif
 import           Servant.Client           (BaseUrl (..), Scheme (..))
 import           System.IO.Unsafe         (unsafePerformIO)
 import           Test.Hspec               (Expectation, expectationFailure)
-import           Test.QuickCheck          (Args (..), Result (..),
+import           Test.QuickCheck          (Args (..),  Result (..), quickCheckWithResult)
-                                           quickCheckWithResult)
+import           Test.QuickCheck.Monadic  (assert, forAllM, monadicIO, monitor,
-import           Test.QuickCheck.Monadic  (assert, forAllM, monadicIO, run)
+                                           run)
 import           Test.QuickCheck.Property (counterexample)
 import Servant.QuickCheck.Internal.Equality
 import Servant.QuickCheck.Internal.ErrorTypes
 import Servant.QuickCheck.Internal.HasGenRequest
 import Servant.QuickCheck.Internal.Predicates
 import Servant.QuickCheck.Internal.Equality
 -- | Start a servant application on an open port, run the provided function,
@ -34,7 +40,11 @@ withServantServer api = withServantServerAndContext api EmptyContext
 -- application.
 --
 -- /Since 0.0.0.0/
 #if MIN_VERSION_servant_server(0,18,0)
 withServantServerAndContext :: (HasServer a ctx, HasContextEntry (ctx .++ DefaultErrorFormatters) ErrorFormatters)
 #else
 withServantServerAndContext :: HasServer a ctx
 #endif
  => Proxy a -> Context ctx -> IO (Server a) -> (BaseUrl -> IO r) -> IO r
 withServantServerAndContext api ctx server t
  = withApplication (return . serveWithContext api ctx =<< server) $ \port ->
@ -52,21 +62,47 @@ withServantServerAndContext api ctx server t
 -- Evidently, if the behaviour of the server is expected to be
 -- non-deterministic,  this function may produce spurious failures
 --
 -- Note that only valid requests are generated and tested. As an example of why
 -- this matters, let's say your API specifies that a particular endpoint can
 -- only generate @JSON@. @serversEqual@ will then not generate any requests
 -- with an @Accept@ header _other_ than @application/json@. It may therefore
 -- fail to notice that one application, when the request has @Accept:
 -- text/html@, returns a @406 Not Acceptable@ HTTP response, and another
 -- returns a @200 Success@, but with @application/json@ as the content-type.
 --
 -- The fact that only valid requests are tested also means that no endpoints
 -- not listed in the API type are tested.
 --
 -- /Since 0.0.0.0/
 serversEqual :: HasGenRequest a =>
  Proxy a -> BaseUrl -> BaseUrl -> Args -> ResponseEquality LBS.ByteString -> Expectation
 serversEqual api burl1 burl2 args req = do
-  let reqs = (\f -> (f burl1, f burl2)) <$> genRequest api
+  let reqs = (\f -> (f burl1, f burl2)) <$> runGenRequest api
-  r <- quickCheckWithResult args $ monadicIO $ forAllM reqs $ \(req1, req2) -> do
+  -- This MVar stuff is clunky! But there doesn't seem to be an easy way to
-    resp1 <- run $ httpLbs (noCheckStatus req1) defManager
+  -- return results when a test fails, since an exception is throw.
-    resp2 <- run $ httpLbs (noCheckStatus req2) defManager
+  deetsMVar <- newEmptyMVar
-    assert $ getResponseEquality req resp1 resp2
+  r <- quickCheckWithResult args { chatty = False } $ monadicIO $ forAllM reqs $ \(req1, req2) -> do
    resp1 <- run $ C.httpLbs (noCheckStatus req1) defManager
    resp2 <- run $ C.httpLbs (noCheckStatus req2) defManager
    unless (getResponseEquality req resp1 resp2) $ do
      monitor (counterexample "hi" )
      _ <- run $ tryPutMVar deetsMVar $ ServerEqualityFailure req1 resp1 resp2
      assert False
  case r of
    Success {} -> return ()
    Failure{..} -> do
      mx <- tryReadMVar deetsMVar
      case mx of
        Just x ->
          expectationFailure $ "Failed:\n" ++ show x
        Nothing ->
          expectationFailure $ "We failed to record a reason for failure: " <> show r
    GaveUp { numTests = n } -> expectationFailure $ "Gave up after " ++ show n ++ " tests"
-    Failure { output = m } -> expectationFailure $ "Failed:\n" ++ show m
+    NoExpectedFailure {} -> expectationFailure "No expected failure"
-    NoExpectedFailure {} -> expectationFailure $ "No expected failure"
+#if MIN_VERSION_QuickCheck(2,12,0)
-    InsufficientCoverage {} -> expectationFailure $ "Insufficient coverage"
+#else
    InsufficientCoverage {} -> expectationFailure "Insufficient coverage"
 #endif
 -- | Check that a server satisfies the set of properties specified.
 --
@ -88,37 +124,70 @@ serversEqual api burl1 burl2 args req = do
 --
 -- /Since 0.0.0.0/
 serverSatisfies :: (HasGenRequest a) =>
-  Proxy a -> BaseUrl -> Args -> Predicates [Text] [Text] -> Expectation
+  Proxy a -> BaseUrl -> Args -> Predicates -> Expectation
-serverSatisfies api burl args preds = do
+serverSatisfies api =  serverSatisfiesMgr api defManager
-  let reqs = ($ burl) <$> genRequest api
+
-  r <- quickCheckWithResult args $ monadicIO $ forAllM reqs $ \req -> do
+-- | Check that a server satisfies the set of properties specified, and
-     v <- run $ finishPredicates preds (noCheckStatus req) defManager
+-- accept a 'Manager' for running the HTTP requests through.
-     assert $ null v
+--
 -- See 'serverSatisfies' for more details.
 --
 -- @since 0.0.7.2
 serverSatisfiesMgr :: (HasGenRequest a) =>
  Proxy a -> C.Manager -> BaseUrl -> Args -> Predicates -> Expectation
 serverSatisfiesMgr api manager burl args preds = do
  let reqs = ($ burl) <$> runGenRequest api
  deetsMVar <- newEmptyMVar
  r <- quickCheckWithResult args { chatty = False } $ monadicIO $ forAllM reqs $ \req -> do
    v <- run $ finishPredicates preds (noCheckStatus req) manager
    _ <- run $ tryPutMVar deetsMVar v
    case v of
      Just _ -> assert False
      _ -> return ()
  case r of
    Success {} -> return ()
    Failure {..} -> do
      mx <- tryReadMVar deetsMVar
      case mx of
        Just x ->
          expectationFailure $ "Failed:\n" ++ show x
        Nothing ->
          expectationFailure $ "We failed to record a reason for failure: " <> show r
    GaveUp { numTests = n } -> expectationFailure $ "Gave up after " ++ show n ++ " tests"
    Failure { output = m } -> expectationFailure $ "Failed:\n" ++ show m
    NoExpectedFailure {} -> expectationFailure $ "No expected failure"
-    InsufficientCoverage {} -> expectationFailure $ "Insufficient coverage"
+#if MIN_VERSION_QuickCheck(2,12,0)
-
+#else
    InsufficientCoverage {} -> expectationFailure "Insufficient coverage"
 #endif
 serverDoesntSatisfy :: (HasGenRequest a) =>
-  Proxy a -> BaseUrl -> Args -> Predicates [Text] [Text] -> Expectation
+  Proxy a -> BaseUrl -> Args -> Predicates -> Expectation
-serverDoesntSatisfy api burl args preds = do
+serverDoesntSatisfy api = serverDoesntSatisfyMgr api defManager
-  let reqs = ($ burl) <$> genRequest api
+
 serverDoesntSatisfyMgr :: (HasGenRequest a) =>
  Proxy a -> C.Manager -> BaseUrl -> Args -> Predicates -> Expectation
 serverDoesntSatisfyMgr api manager burl args preds = do
  let reqs = ($ burl) <$> runGenRequest api
  r <- quickCheckWithResult args $ monadicIO $ forAllM reqs $ \req -> do
-     v <- run $ finishPredicates preds (noCheckStatus req) defManager
+     v <- run $ finishPredicates preds (noCheckStatus req) manager
     assert $ not $ null v
  case r of
    Success {} -> return ()
    GaveUp { numTests = n } -> expectationFailure $ "Gave up after " ++ show n ++ " tests"
    Failure { output = m } -> expectationFailure $ "Failed:\n" ++ show m
    NoExpectedFailure {} -> expectationFailure $ "No expected failure"
-    InsufficientCoverage {} -> expectationFailure $ "Insufficient coverage"
+#if MIN_VERSION_QuickCheck(2,12,0)
 #else
    InsufficientCoverage {} -> expectationFailure "Insufficient coverage"
 #endif
-noCheckStatus :: Request -> Request
+noCheckStatus :: C.Request -> C.Request
-noCheckStatus r = r { checkStatus = \_ _ _ -> Nothing}
+#if MIN_VERSION_http_client(0,5,0)
 noCheckStatus = id
 #else
 noCheckStatus r = r { C.checkStatus = \_ _ _ -> Nothing}
 #endif
-defManager :: Manager
+defManager :: C.Manager
-defManager = unsafePerformIO $ newManager defaultManagerSettings
+defManager = unsafePerformIO $ C.newManager C.defaultManagerSettings
 {-# NOINLINE defManager #-}
--- a/stack.yaml
+++ b/stack.yaml
@ -1,36 +1,10 @@
-# Specifies the GHC version and set of packages available (e.g., lts-3.5, nightly-2015-09-21, ghc-7.10.2)
+resolver: nightly-2018-09-03
 resolver: nightly-2016-04-20
 # Local packages, usually specified by relative directory name
 packages:
 - '.'
 # Packages to be pulled from upstream that are not in the resolver (e.g., acme-missiles-0.3)
 extra-deps:
- servant-0.7
+- hspec-discover-2.5.6
- servant-client-0.7
+- hspec-core-2.5.6
- servant-server-0.7
+- hspec-2.5.6
-
+- QuickCheck-2.12
 # Override default flag values for local packages and extra-deps
 flags: {}
 # Extra package databases containing global packages
 extra-package-dbs: []
 # Control whether we use the GHC we find on the path
 # system-ghc: true
 # Require a specific version of stack, using version ranges
 # require-stack-version: -any # Default
 # require-stack-version: >= 1.0.0
 # Override the architecture used by stack, especially useful on Windows
 # arch: i386
 # arch: x86_64
 # Extra directories used by stack for building
 # extra-include-dirs: [/path/to/dir]
 # extra-lib-dirs: [/path/to/dir]
 # Allow a newer minor version of GHC than the snapshot specifies
 # compiler-check: newer-minor
--- a/test/Doctest.hs
+++ b/test/Doctest.hs
@ -1,44 +0,0 @@
 module Main where
 import           Data.List            (isPrefixOf)
 import           System.Directory
 import           System.FilePath
 import           System.FilePath.Find
 import           Test.DocTest
 main :: IO ()
 main = do
    files <- find always (extension ==? ".hs") "src"
    mCabalMacrosFile <- getCabalMacrosFile
    doctest $ "-isrc" : "-Iinclude" :
              (maybe [] (\ f -> ["-optP-include", "-optP" ++ f]) mCabalMacrosFile) ++
              "-XOverloadedStrings" :
              "-XDeriveFunctor" :
              "-XFlexibleInstances" :
              "-XFlexibleContexts" :
              "-XMultiParamTypeClasses" :
              "-XDataKinds" :
              "-XTypeOperators" :
              "-XGADTs" :
              files
 getCabalMacrosFile :: IO (Maybe FilePath)
 getCabalMacrosFile = do
  exists <- doesDirectoryExist "dist"
  if exists
    then do
      contents <- getDirectoryContents "dist"
      let rest = "build" </> "autogen" </> "cabal_macros.h"
      whenExists $ case filter ("dist-sandbox-" `isPrefixOf`) contents of
        [x] -> "dist" </> x </> rest
        [] -> "dist" </> rest
        xs -> error $ "ran doctests with multiple dist/dist-sandbox-xxxxx's: \n"
                    ++ show xs ++ "\nTry cabal clean"
    else return Nothing
 where
  whenExists :: FilePath -> IO (Maybe FilePath)
  whenExists file = do
    exists <- doesFileExist file
    return $ if exists
      then Just file
      else Nothing
--- a/test/Servant/QuickCheck/InternalSpec.hs
+++ b/test/Servant/QuickCheck/InternalSpec.hs
@ -1,24 +1,46 @@
-{-# LANGUAGE CPP                 #-}
+{-# LANGUAGE CPP #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 module Servant.QuickCheck.InternalSpec (spec) where
-import           Control.Concurrent.MVar                    (newMVar, readMVar,
+
-                                                             swapMVar)
+import           Control.Concurrent.MVar (newMVar, readMVar, swapMVar)
-import           Control.Monad.IO.Class                     (liftIO)
+import           Control.Exception       (SomeException)
 import           Control.Monad           (replicateM)
 import           Control.Monad.IO.Class  (liftIO)
 import qualified Data.ByteString         as BS
 import qualified Data.ByteString.Char8   as C
 import           Data.Maybe              (fromJust)
 import           Network.HTTP.Client     (path, queryString)
 import           Prelude.Compat
 import           Servant
-import           Servant.API.Internal.Test.ComprehensiveAPI (comprehensiveAPI)
+import           Servant.HTML.Blaze      (HTML)
-import           Test.Hspec                                 (Spec, describe, it,
+import qualified Text.Blaze.Html         as Blaze
-                                                             shouldBe)
+import qualified Text.Blaze.Html5        as Blaze5
 import           Test.Hspec              (Spec, context, describe, it, shouldBe,
                                          shouldContain)
 import           Test.Hspec.Core.Spec    (Arg, Example, Result (..), ResultStatus (..),
                                          defaultParams, safeEvaluateExample)
 import           Test.QuickCheck.Gen     (generate, unGen)
 import           Test.QuickCheck.Random  (mkQCGen)
-import           Servant.QuickCheck
+
-import           Servant.QuickCheck.Internal                (genRequest, serverDoesntSatisfy)
+import Servant.Test.ComprehensiveAPI (comprehensiveAPIWithoutStreamingOrRaw)
 import Servant.QuickCheck
 import Servant.QuickCheck.Internal (genRequest, runGenRequest,
                                    serverDoesntSatisfy)
 spec :: Spec
 spec = do
  serversEqualSpec
  serverSatisfiesSpec
  isComprehensiveSpec
  onlyJsonObjectSpec
  notLongerThanSpec
  queryParamsSpec
  queryFlagsSpec
  deepPathSpec
  htmlDocTypesSpec
  unbiasedGenerationSpec
 serversEqualSpec :: Spec
 serversEqualSpec = describe "serversEqual" $ do
@ -28,6 +50,43 @@ serversEqualSpec = describe "serversEqual" $ do
      withServantServerAndContext api ctx server $ \burl2 -> do
        serversEqual api burl1 burl2 args bodyEquality
  context "when servers are not equal" $ do
    it "provides the failing responses in the error message" $ do
      FailedWith err <- withServantServer api2 server2 $ \burl1 ->
        withServantServer api2 server3 $ \burl2 -> do
          evalExample $ serversEqual api2 burl1 burl2 args bodyEquality
      show err `shouldContain` "Server equality failed"
      show err `shouldContain` "Body: 1"
      show err `shouldContain` "Body: 2"
      show err `shouldContain` "Path: /failplz"
  context "when JSON is equal but looks a bit different as a ByteString" $ do
    it "sanity check: different whitespace same JSON objects bodyEquality fails" $ do
      FailedWith err <- withServantServer jsonApi jsonServer1 $ \burl1 ->
        withServantServer jsonApi jsonServer2 $ \burl2 -> do
          evalExample $ serversEqual jsonApi burl1 burl2 args bodyEquality
      show err `shouldContain` "Server equality failed"
    it "jsonEquality considers equal JSON apis equal regardless of key ordering or whitespace" $ do
      withServantServerAndContext jsonApi ctx jsonServer1 $ \burl1 ->
        withServantServerAndContext jsonApi ctx jsonServer2 $ \burl2 ->
          serversEqual jsonApi burl1 burl2 args jsonEquality
    it "sees when JSON apis are not equal because any value is different" $ do
      FailedWith err <- withServantServer jsonApi jsonServer2 $ \burl1 ->
        withServantServer jsonApi jsonServer3 $ \burl2 -> do
          evalExample $ serversEqual jsonApi burl1 burl2 args jsonEquality
      show err `shouldContain` "Server equality failed"
      show err `shouldContain` "Path: /jsonComparison"
    it "sees when JSON apis are not equal due to different keys but same values" $ do
      FailedWith err <- withServantServer jsonApi jsonServer2 $ \burl1 ->
        withServantServer jsonApi jsonServer4 $ \burl2 -> do
          evalExample $ serversEqual jsonApi burl1 burl2 args jsonEquality
      show err `shouldContain` "Server equality failed"
      show err `shouldContain` "Path: /jsonComparison"
 serverSatisfiesSpec :: Spec
 serverSatisfiesSpec = describe "serverSatisfies" $ do
@ -46,13 +105,126 @@ serverSatisfiesSpec = describe "serverSatisfies" $ do
                                     <%> notAllowedContainsAllowHeader
                                     <%> mempty)
  context "when predicates are false" $ do
    it "fails with informative error messages" $ do
      FailedWith err <- withServantServerAndContext api ctx server $ \burl -> do
        evalExample $ serverSatisfies api burl args (notAllowedContainsAllowHeader <%> mempty)
      show err `shouldContain` "notAllowedContainsAllowHeader"
      show err `shouldContain` "Headers"
      show err `shouldContain` "Body"
 onlyJsonObjectSpec :: Spec
 onlyJsonObjectSpec = describe "onlyJsonObjects" $ do
  it "fails correctly" $ do
    FailedWith err <- withServantServerAndContext api ctx server $ \burl -> do
      evalExample $ serverSatisfies (Proxy :: Proxy (Get '[JSON] Int)) burl args
        (onlyJsonObjects <%> mempty)
    show err `shouldContain` "onlyJsonObjects"
  it "accepts non-JSON endpoints" $ do
    withServantServerAndContext octetAPI ctx serverOctetAPI $ \burl ->
      serverSatisfies octetAPI burl args (onlyJsonObjects <%> mempty)
  it "does not fail when there is no content-type" $ do
    withServantServerAndContext api2 ctx serverFailing $ \burl ->
        serverSatisfies api2 burl args (onlyJsonObjects <%> mempty)
 notLongerThanSpec :: Spec
 notLongerThanSpec = describe "notLongerThan" $ do
  it "fails correctly" $ do
    FailedWith err <- withServantServerAndContext api ctx server $ \burl -> do
      evalExample $ serverSatisfies (Proxy :: Proxy (Get '[JSON] Int)) burl args
        (notLongerThan 1 <%> mempty)
    show err `shouldContain` "notLongerThan"
  it "succeeds correctly" $ do
    withServantServerAndContext api ctx server $ \burl ->
      serverSatisfies api burl args (notLongerThan 1000000000000 <%> mempty)
 isComprehensiveSpec :: Spec
 isComprehensiveSpec = describe "HasGenRequest" $ do
  it "has instances for all 'servant' combinators" $ do
-    let _g = genRequest comprehensiveAPI
+    let _g = genRequest comprehensiveAPIWithoutStreamingOrRaw
    True `shouldBe` True -- This is a type-level check
 deepPathSpec :: Spec
 deepPathSpec = describe "Path components" $ do
  it "are separated by slashes, without a trailing slash" $ do
    let rng = mkQCGen 0
        burl = BaseUrl Http "localhost" 80 ""
        gen = runGenRequest deepAPI
        req = (unGen gen rng 0) burl
    path req `shouldBe` ("/one/two/three")
 queryParamsSpec :: Spec
 queryParamsSpec = describe "QueryParams" $ do
  it "reduce to an HTTP query string correctly" $ do
    let rng = mkQCGen 0
        burl = BaseUrl Http "localhost" 80 ""
        gen = runGenRequest paramsAPI
        req = (unGen gen rng 0) burl
        qs = C.unpack $ queryString req
    qs `shouldBe` "one=_&two=_"
 queryFlagsSpec :: Spec
 queryFlagsSpec = describe "QueryFlags" $ do
  it "reduce to an HTTP query string correctly" $ do
    let rng = mkQCGen 0
        burl = BaseUrl Http "localhost" 80 ""
        gen = runGenRequest flagsAPI
        req = (unGen gen rng 0) burl
        qs = C.unpack $ queryString req
    qs `shouldBe` "one&two"
 htmlDocTypesSpec :: Spec
 htmlDocTypesSpec = describe "HtmlDocTypes" $ do
    it "fails HTML without doctype correctly" $ do
      err <- withServantServerAndContext docTypeApi ctx noDocTypeServer $ \burl -> do
        evalExample $ serverSatisfies docTypeApi burl args
          (htmlIncludesDoctype <%> mempty)
      show err `shouldContain` "htmlIncludesDoctype"
    it "passes HTML with a doctype at start" $ do
      withServantServerAndContext docTypeApi ctx docTypeServer $ \burl ->
        serverSatisfies docTypeApi burl args (htmlIncludesDoctype <%> mempty)
    it "accepts json endpoints and passes over them in silence" $ do
      withServantServerAndContext api ctx server $ \burl -> do
        serverSatisfies (Proxy :: Proxy (Get '[JSON] Int)) burl args
          (htmlIncludesDoctype <%> mempty)
 makeRandomRequest :: Proxy LargeAPI -> BaseUrl -> IO Integer
 makeRandomRequest large burl = do
  req <- generate $ runGenRequest large
  pure $ fst . fromJust . C.readInteger . C.drop 1 . path $ req burl
 unbiasedGenerationSpec :: Spec
 unbiasedGenerationSpec = describe "Unbiased Generation of requests" $
  it "frequency paired with generated endpoint should be more randomly distributed" $ do
    let burl = BaseUrl Http "localhost" 80 ""
    let runs = 10000 :: Double
    someRequests <- replicateM 10000 (makeRandomRequest largeApi burl)
    let mean = (sum $ map fromIntegral someRequests) / runs
    let variancer x = let ix = fromIntegral x in (ix - mean) * (ix - mean)
    let variance = (sum $ map variancer someRequests) / runs - 1
    -- mean should be around 8.5. If this fails, we likely need more runs (or there's a bug!)
    mean > 8 `shouldBe` True
    mean < 9 `shouldBe` True
    -- Std dev is likely around 4. Variance is probably greater than 20.
    variance > 19.5 `shouldBe` True
 ------------------------------------------------------------------------------
 -- APIs
@ -65,6 +237,17 @@ type API = ReqBody '[JSON] String :> Post '[JSON] String
 api :: Proxy API
 api = Proxy
 type ParamsAPI = QueryParam "one" () :> QueryParam "two" () :> Get '[JSON] ()
 paramsAPI :: Proxy ParamsAPI
 paramsAPI = Proxy
 type FlagsAPI = QueryFlag "one" :> QueryFlag "two" :> Get '[JSON] ()
 flagsAPI :: Proxy FlagsAPI
 flagsAPI = Proxy
 server :: IO (Server API)
 server = do
    mvar <- newMVar ""
@ -72,11 +255,110 @@ server = do
        :<|> (liftIO $ readMVar mvar >>= return . length)
        :<|> (const $ return ())
 type API2 = "failplz" :> Get '[JSON] Int
 api2 :: Proxy API2
 api2 = Proxy
 type DeepAPI = "one" :> "two" :> "three":> Get '[JSON] ()
 deepAPI :: Proxy DeepAPI
 deepAPI = Proxy
 server2 :: IO (Server API2)
 server2 = return $ return 1
 server3 :: IO (Server API2)
 server3 = return $ return 2
 serverFailing :: IO (Server API2)
 serverFailing = return . throwError $ err405
 -- With Doctypes
 type HtmlDoctype = Get '[HTML] Blaze.Html
 docTypeApi :: Proxy HtmlDoctype
 docTypeApi = Proxy
 docTypeServer :: IO (Server HtmlDoctype)
 docTypeServer = pure $ pure $ Blaze5.docTypeHtml $ Blaze5.span "Hello Test!"
 noDocTypeServer :: IO (Server HtmlDoctype)
 noDocTypeServer = pure $ pure $ Blaze.text "Hello Test!"
 -- Api for unbiased generation of requests tests
 largeApi :: Proxy LargeAPI
 largeApi = Proxy
 type LargeAPI
  =    "1" :> Get '[JSON] Int
  :<|> "2" :> Get '[JSON] Int
  :<|> "3" :> Get '[JSON] Int
  :<|> "4" :> Get '[JSON] Int
  :<|> "5" :> Get '[JSON] Int
  :<|> "6" :> Get '[JSON] Int
  :<|> "7" :> Get '[JSON] Int
  :<|> "8" :> Get '[JSON] Int
  :<|> "9" :> Get '[JSON] Int
  :<|> "10" :> Get '[JSON] Int
  :<|> "11" :> Get '[JSON] Int
  :<|> "12" :> Get '[JSON] Int
  :<|> "13" :> Get '[JSON] Int
  :<|> "14" :> Get '[JSON] Int
  :<|> "15" :> Get '[JSON] Int
  :<|> "16" :> Get '[JSON] Int
 type OctetAPI = Get '[OctetStream] BS.ByteString
 octetAPI :: Proxy OctetAPI
 octetAPI = Proxy
 serverOctetAPI :: IO (Server OctetAPI)
 serverOctetAPI = return $ return "blah"
 type JsonApi = "jsonComparison" :> Get '[OctetStream] BS.ByteString
 jsonApi :: Proxy JsonApi
 jsonApi = Proxy
 jsonServer1 :: IO (Server JsonApi)
 jsonServer1 = return $ return "{ \"b\": [\"b\"], \"a\": 1 }"  -- whitespace, ordering different
 jsonServer2 :: IO (Server JsonApi)
 jsonServer2 = return $ return "{\"a\": 1,\"b\":[\"b\"]}"
 jsonServer3 :: IO (Server JsonApi)
 jsonServer3 = return $ return "{\"a\": 2, \"b\": [\"b\"]}"
 jsonServer4 :: IO (Server JsonApi)
 jsonServer4 = return $ return "{\"c\": 1, \"d\": [\"b\"]}"
 ctx :: Context '[BasicAuthCheck ()]
 ctx = BasicAuthCheck (const . return $ NoSuchUser) :. EmptyContext
 ------------------------------------------------------------------------------
 -- Utils
 ------------------------------------------------------------------------------
 evalExample :: (Example e, Arg e ~ ()) => e -> IO EvalResult
 evalExample e = do
  r <- safeEvaluateExample e defaultParams ($ ()) progCallback
  case resultStatus r of
    Success          -> return $ AllGood
    Failure _ reason -> return $ FailedWith $ show reason
    Pending {}       -> error "should not happen"
  where
    progCallback _ = return ()
 data EvalResult
  = AnException SomeException
  | AllGood
  | FailedWith String
  deriving (Show)
 args :: Args
 args = defaultArgs { maxSuccess = noOfTestCases }
@ -85,5 +367,5 @@ noOfTestCases :: Int
 #if LONG_TESTS
 noOfTestCases = 20000
 #else
-noOfTestCases = 500
+noOfTestCases = 1000
 #endif
Author	SHA1	Message	Date
fisx	0535413b1a	Merge pull request #72 from maksbotan/maksbotan/support-servant-0.18 Support servant-server-0.18	2020-07-31 09:54:59 +02:00
Maxim Koltsov	7cc95a8120	Update src/Servant/QuickCheck/Internal/QuickCheck.hs Co-authored-by: fisx <mf@zerobuzz.net>	2020-07-31 10:43:19 +03:00
Maxim Koltsov	e1a919127a	haskell-ci regenerate	2020-07-30 19:32:29 +03:00
Maxim Koltsov	e6daf03c16	Support servant-server-0.18	2020-07-30 19:22:14 +03:00
Matthias Fischmann	7926ad6bdb	Fix lower version bounds for servant packages.	2020-07-10 13:54:21 +02:00
Matthias Fischmann	fa9cc11095	Bump version; add changelog entry.	2020-07-02 22:40:04 +02:00
Julian Arni	dfec2529ac	Merge pull request #65 from fizruk/support-servant-0.15 Support servant-0.15	2020-06-25 12:10:58 +02:00
Julian Arni	eb3cdbcd3a	Merge branch 'master' into support-servant-0.15	2020-06-25 11:02:24 +02:00
Julian Arni	f48088b7d2	Merge pull request #70 from felixmulder/relax-constraints-for-GHC-8.10 Relax constraints for GHC 8.10	2020-06-25 11:00:59 +02:00
Felix Mulder	2bf03e822a	Relax constraints for GHC 8.10	2020-06-07 09:58:56 +02:00
Oleg Grenrus	092ebe5423	Merge pull request #68 from haskell-servant/servant-0.17 Support servant-0.17	2020-01-24 10:45:48 +02:00
Oleg Grenrus	13d32d6768	Support servant-0.17	2020-01-23 23:38:03 +02:00
Oleg Grenrus	8e8e9b501b	Change version back to 0.0.7.4 There are no changes since the tag in the src/	2019-09-16 02:11:42 +03:00
Oleg Grenrus	c93bd5a832	Merge pull request #66 from haskell-servant/updates Updates: 2019-09	2019-09-16 02:09:26 +03:00
Oleg Grenrus	f9989bbf79	Updates: 2019-09	2019-09-15 18:22:05 +03:00
Nickolay Kudasov	bb8177928e	Support servant-0.15	2019-07-04 11:52:51 +03:00
Oleg Grenrus	f6fb9033e9	Merge pull request #63 from haskell-servant/updates Support servant-0.16 and http-media-0.8	2019-04-17 12:28:42 +03:00
Oleg Grenrus	804b06283d	Update .travis.yml	2019-04-17 11:36:31 +03:00
Oleg Grenrus	a5cdf78d82	Support servant-0.16 and http-media-0.8	2019-04-16 22:19:54 +03:00
Oleg Grenrus	638580ba49	Merge pull request #62 from haskell-servant/servant-0.16 Allow servant-0.16	2019-02-28 00:05:15 +02:00
Oleg Grenrus	8803b1c09e	Allow servant-0.16	2019-02-27 20:42:16 +02:00
parsonsmatt	e69d4026af	v0.0.7.3	2018-10-24 07:48:05 -06:00
Oleg Grenrus	98fd048bdc	Merge pull request #59 from haskell-servant/ghc-8.6 Support GHC-8.6	2018-10-15 21:13:54 +03:00
Oleg Grenrus	902d7a7583	Support GHC-8.6	2018-10-15 17:51:44 +03:00
parsonsmatt	bc36737c45	Clean up stack.yaml and dependencies	2018-10-12 13:34:13 -06:00
parsonsmatt	0190e5e737	QuickCheck 2.12 Compatibility This commit relaxes the bounds on QuickCheck, allowing it to be compatible with 2.12. In order to be compatible with 2.12, we had to CPP some definitions that referenced code that was deleted.	2018-10-12 13:34:13 -06:00
Alp Mestanogullari	7d6a97af5a	Merge pull request #57 from Phenitei/notAllowedBug Fix #56: a notAllowedContainsAllowHeader bug	2018-08-29 12:01:14 +02:00
Joachim Desroches	9743ac5ec4	Fix a bug in onlyJsonObjects that made it fail if there was no content-type.	2018-08-27 22:31:18 -06:00
Joachim Desroches	e3bf044741	Add test for onlyJsonObjects when no content-type header is present.	2018-08-27 22:31:18 -06:00
Joachim Desroches	89c9170bdf	Fix #56 A bug where the request printed alongside a failure in notAllowedContainsAllowHeader was not the request causing the failure.	2018-08-27 18:12:22 +02:00
Oleg Grenrus	35c98622fc	Merge pull request #53 from haskell-servant/servant-0.14 Support servant-0.14	2018-06-19 14:51:14 +03:00
Oleg Grenrus	cb06284c75	Support servant-0.14	2018-06-19 13:05:16 +03:00
Matt Parsons	4dfcc862e7	v0.0.7.2 (#51 ) * Prepare for 0.0.7.2 release	2018-05-10 11:32:50 -06:00
Matt Parsons	ae40f3d9f7	Fix stack.yaml file (#46 ) * Fix stack.yaml file * Remove unfixable stack files	2018-05-10 10:09:12 -06:00
Matt Parsons	d66c2d278a	Safer MVar usage (#49 ) * Fix stack.yaml file * Remove unfixable stack files * Resolve ambiguous import in GHCi * handle MVars without error * Consistent messaging * Add comment	2018-05-10 10:08:06 -06:00
Julian Arni	78f30bc997	Merge pull request #50 from parsonsmatt/matt/configurable-manager Allow clients to pass a manager in	2018-05-10 14:37:18 +02:00
parsonsmatt	b4a69516d2	Allow clients to pass a manager in	2018-05-09 14:30:38 -06:00
Oleg Grenrus	226c7647e1	Merge pull request #44 from haskell-servant/base-compat-0.10 Allow base-compat-0.10	2018-04-13 18:29:29 +03:00
Oleg Grenrus	26523832f8	Allow base-compat-0.10 and temporary-1.3 Use base-compat-batteries	2018-04-12 09:29:23 +03:00
Oleg Grenrus	d262cead57	Merge pull request #43 from haskell-servant/ghc-8.4.1 Support GHC-8.4.1	2018-03-23 08:21:16 +02:00
Oleg Grenrus	4757df4195	Support GHC-8.4.1	2018-03-23 08:13:36 +02:00
Oleg Grenrus	76a0394cea	Merge pull request #42 from haskell-servant/servant-0.13 Support for servant-0.13	2018-02-09 21:43:51 +02:00
Oleg Grenrus	d46b7183ad	Support for servant-0.13	2018-02-09 20:26:02 +02:00
Julian K. Arni	35bd148037	Changelog and bump version	2017-12-14 21:37:18 -08:00
Julian K. Arni	bc301ad7c1	Bump to 0.0.4.0	2017-12-14 21:35:11 -08:00
Julian Arni	0f334449cb	Merge pull request #40 from Phenitei/expose-missing-predicates Add forgotten predicates to export list.	2017-12-14 21:33:22 -08:00
Joachim Desroches	4f24452d03	Add forgotten predicates to export list. The honoursAcceptHeader and getsHaveLastModifiedHeader predicates had been omitted when writing the export list, making it necessary to import Servant.QuickCheck.Internal.Predicates to have access to them.	2017-12-15 00:22:57 +01:00
Oleg Grenrus	6e6595f68c	Merge pull request #37 from phadej/servant-0.12 Support for servant-0.12	2017-11-08 13:27:13 +02:00
Oleg Grenrus	53785354d3	Add build-tool-depends	2017-11-08 13:02:46 +02:00
Oleg Grenrus	026d4b8bb4	Use new-build based .travis.yml	2017-11-08 11:39:45 +02:00
Oleg Grenrus	3571f543fd	Support for servant-0.12	2017-11-08 10:49:31 +02:00
Erik	d65abc856f	[READY] Fixes #7 : Add HTML missing Doctype predicate with tests (#33 ) * Add HTML missing Doctype predicate with tests * Don't use 'fail' in predicates * Add RFC reference and description for HTML doctype * Only take enough of respBody to compare to doctype string	2017-10-21 15:20:56 -07:00
Julian K. Arni	54a05a53a9	Bump version	2017-10-19 10:12:36 -07:00
Julian Arni	4765664a3e	Merge pull request #32 from adinapoli-iohk/support-servant-0.11 Tentatively support Servant 0.11	2017-10-19 10:11:40 -07:00
Alfredo Di Napoli	199f6cc51e	Code review changes	2017-10-19 09:20:49 +02:00
Julian Arni	fb14b3c7ea	Merge pull request #35 from haskell-servant/issue-34/coverage Add coverage reports	2017-10-18 11:49:19 -07:00
Julian K. Arni	cb4555d6ba	Add coverage reports	2017-10-18 11:30:13 -07:00
Alfredo Di Napoli	b0febe7c58	Tentatively support Servant 0.11	2017-10-18 14:36:45 +02:00
Julian K. Arni	9ebfe9d630	Bump version	2017-10-16 09:13:22 -07:00
Julian K. Arni	fa1a03257e	Documenation for jsonEquality	2017-10-16 09:11:43 -07:00
Julian K. Arni	cce3bef538	Update changelog	2017-10-16 09:04:45 -07:00
Julian Arni	40c576cf15	Merge pull request #30 from haskell-servant/jsonEquality Add jsonEquality to compare JSON APIs	2017-10-16 08:58:53 -07:00
Erik Aker	6c163dc981	Utilize new FailedWith constructor to fix json equality tests	2017-10-15 20:31:52 -07:00
Erik Aker	3f6856103a	Add sanity check test in there to prove jsonEquality really is doing something different	2017-10-15 20:24:21 -07:00
Erik Aker	482656b35e	Create jsonEqaulity function and add some tests for similar JSON values but slightly different whitespace, ordering	2017-10-15 20:24:21 -07:00
Julian Arni	e7206ec875	Merge pull request #29 from haskell-servant/issue-27/supportHspec2.4 Upgrade hspec to 2.4.4 and use safeEvaluateExample for tests	2017-10-15 18:45:03 -07:00
Julian K. Arni	a0ec1777a7	Compatibility with earlier versions of hspec. Adds CPP to the tests to allow for upstream changes to the 'Result' type.	2017-10-15 17:49:47 -07:00
Erik Aker	f3b4fcf7a9	Resolve merge conflicts with unbiasedGeneration merge	2017-10-14 08:16:30 -07:00
Julian Arni	66ce50993f	Unbias generation of requests. (#19 ) * Unbias generation of requests: ...so that each endpoint is picked with the same frequency. Also, include a test for unbiased generation that measures mean and variance of results.	2017-10-14 07:53:04 -07:00
Erik Aker	0e23a2eba7	Code cleanup: remove unused imports and code	2017-07-15 15:11:18 -07:00
Erik Aker	f052dc149b	Bump HSpec to 2.4.4 and make tests use safeEvaluateExample to capture failure msg	2017-07-15 15:03:06 -07:00
Julian K. Arni	e1a9db4924	Bump version	2017-03-11 09:36:16 -06:00
Julian Arni	f12034ccb6	Merge pull request #28 from declension/22-fix-path-delimiting Fix path delimiting (#22)	2017-03-11 09:34:28 -06:00
Nick B	d33214d376	Fix Path delimiting: * Add test API with multiple Path elements * Add basic test using this API, generating an endpoint to validate that query path delimiting is happening correctly (that fails on `master`) * Fix (re)creation of path to prepend `/` to each new path section, but only if it's non-empty (this fixes the trailing slashes, but still allows users to use a `:> "foo/" :>...` if their API demands trailing slashes) * Update / fix the existing test that now fails slightly differently (i.e. the trailing slash in `failplz/` is gone) Fixes #22.	2017-03-11 11:19:57 +00:00
Julian K. Arni	41b2faad45	Bump version.	2017-03-10 21:50:50 -06:00
Julian Arni	78e0b32019	Merge pull request #26 from haskell-servant/fix-ci Fix ci	2017-03-10 21:48:14 -06:00
Julian K. Arni	b7cf4e6f80	upper bound for hspec	2017-03-10 17:29:08 -06:00
Julian K. Arni	a8dd02516f	Switch CI to stack	2017-03-10 15:53:26 -06:00
Julian Arni	be5909d30f	Merge pull request #24 from declension/23-fix-queryparams Fix multiple QueryParams / QueryFlags	2017-03-10 15:31:39 -06:00
Nick B	2109326ad7	QueryFlags don't use = * Also, fix import for old `Servant` versions - _every_ version now needs `Data.Bytestring` (i.e. Servant version < 0.8, as per old lts in `stack.yaml`)	2017-03-10 08:31:56 +00:00
Nick B	77fa490b93	Fix QueryFlags too (#23 ) * Same logic / testing as for `QueryParam` * There's probably some de-duplication that could be done here one day...	2017-03-07 22:52:38 +00:00
Nick B	a8459223ed	Use () for test QueryParam type too ...as suggested (thanks @jkarni)	2017-03-07 22:48:45 +00:00
Nick B	6be6697165	QueryParams: fix ampersand, improve test * Simplify test API to use `()` - no awkward values at all. * The test asserts on _entire_ of resulting path now... * ...and fix the ampersand placement, but preserving the order of params left to right. The code also reads a bit better this way...	2017-03-07 21:25:11 +00:00
Nick B	a5224276d5	Fix multiple QueryParams * Add test API taking multiple `QueryParam`s * Add basic test using this API, generating an endpoint to ensure correct HTTP `one=foo&two=bar` query string generation is happening (that fails on `master`) * Fix (re)creation of query string to append `&` before the new parameter if there is already a built query string. Fixes #23.	2017-03-06 13:32:55 +00:00
Julian K. Arni	47391784ce	Bump version	2016-10-18 14:40:40 +02:00
Julian K. Arni	b1227d3864	Make onlyJsonObjects succeed in non-JSON endpoints.	2016-10-18 14:38:44 +02:00
Julian K. Arni	4f5e6ba25a	Mention that servant servers don't comply with allow header setting	2016-10-18 13:55:28 +02:00
Julian K. Arni	ae07497397	Bump version to 0.2.0.1	2016-10-05 15:36:38 +01:00
Julian Arni	49cfb78f1d	Merge pull request #17 from haskell-servant/notLongerThan Add notLongerThan predicate.	2016-10-05 16:33:01 +02:00
Julian K. Arni	2219d2ef7e	Changelog for notLongerThan.	2016-10-05 15:32:37 +01:00
Julian K. Arni	feff40b2e4	Add notLongerThan predicate.	2016-10-05 15:29:39 +01:00
Julian K. Arni	b4876468e6	Changelog	2016-10-03 16:39:36 +02:00
Julian K. Arni	0563caafae	Newtype rather than data for predicates	2016-10-03 16:32:27 +02:00
Julian K. Arni	8eb5c334c1	Looser bounds. Support recent versions of QuickCheck, aeson, http-client, servant, servant-client, and servant-server.	2016-10-03 16:30:46 +02:00
Julian K. Arni	f36f544ee6	Add predicate getsHaveLastModifiedHeader.	2016-10-03 15:39:46 +02:00
Julian K. Arni	d7757ea5ed	Bump version.	2016-09-14 10:54:57 -03:00
Julian Arni	2411e2966c	Merge pull request #16 from haskell-servant/ghc8-support Ghc8 support	2016-09-14 10:53:30 -03:00
Julian K. Arni	0337996c6c	Support new CaptureAll combinator.	2016-09-14 10:26:13 -03:00
Julian K. Arni	9ff43756ce	Update CHANGELOG to YAML syntax.	2016-09-14 10:14:58 -03:00
Julian K. Arni	6537409968	support ghc 8	2016-09-14 09:37:14 -03:00
Julian K. Arni	84ebc6ed5f	bump version	2016-08-28 20:53:14 -03:00
Julian K. Arni	343f55f61a	Removing GHC 7.8 support. It never really existed.	2016-08-28 20:50:42 -03:00
Julian K. Arni	86d99239bb	Cleanup	2016-08-28 20:23:32 -03:00
Julian K. Arni	ca0b7156d8	bump version	2016-08-28 19:23:19 -03:00
Julian K. Arni	8b1cdb7952	Start changelog	2016-08-28 19:22:51 -03:00
Julian K. Arni	0682e353d6	Cleanup	2016-08-28 19:22:43 -03:00
Julian K. Arni	1a24673206	Valid request doc note	2016-08-28 19:15:46 -03:00
Julian K. Arni	2c1152a8c0	Much better errors	2016-08-28 19:15:26 -03:00
Julian K. Arni	b7df33fbe8	Get an error message in.	2016-08-28 13:32:48 -03:00
Julian K. Arni	70fed09866	Start implementing better error messages.	2016-08-01 11:58:10 -03:00
Julian K. Arni	65a0809921	docs	2016-07-18 16:12:21 -03:00
Julian K. Arni	6fbe9b41c7	wip	2016-05-14 18:44:19 +02:00
Julian K. Arni	3250dc4fac	more	2016-05-14 16:31:32 +02:00