git.iko.soy/servant-quickcheck
on master help sign in
16 files changed+525−293
since splitsnapshots
unifiedsplit
.travis.yml+133−70 CHANGELOG.yaml+95−5 cabal.haskell-ci+7 cabal.project+4 example/Main.hs+31 servant-quickcheck.cabal+123−101 src/Servant/QuickCheck/Internal/Equality.hs+6−2 src/Servant/QuickCheck/Internal/ErrorTypes.hs+3−1 src/Servant/QuickCheck/Internal/HasGenRequest.hs+16−14 src/Servant/QuickCheck/Internal/Predicates.hs+29−20 src/Servant/QuickCheck/Internal/QuickCheck.hs+58−19 stack-lts-6.yaml−6 stack-lts-7.yaml−6 stack-lts-9.yaml−6 stack.yaml+5−5 test/Servant/QuickCheck/InternalSpec.hs+15−38
.travis.yml+133−70
@@ -1,95 +1,158 @@
11# This Travis job script has been generated by a script via
22#
3−# make_travis_yml_2.hs '--branch' 'master' '-o' '.travis.yml' 'servant-quickcheck.cabal'
3+# haskell-ci '--config=cabal.haskell-ci' 'servant-quickcheck.cabal'
44#
5−# For more information, see https://github.com/hvr/multi-ghc-travis
5+# To regenerate the script (for example after adjusting tested-with) run
66#
7+# haskell-ci regenerate
8+#
9+# For more information, see https://github.com/haskell-CI/haskell-ci
10+#
11+# version: 0.10.1
12+#
13+version: ~> 1.0
714language: c
8−sudo: false
9−
15+os: linux
16+dist: xenial
1017git:
11− submodules: false # whether to recursively clone submodules
12−
18+ # whether to recursively clone submodules
19+ submodules: false
1320branches:
1421 only:
1522 - master
16−
1723cache:
1824 directories:
1925 - $HOME/.cabal/packages
2026 - $HOME/.cabal/store
21−
27+ - $HOME/.hlint
2228before_cache:
23− - rm -fv $HOME/.cabal/packages/hackage.haskell.org/build-reports.log
29+ - rm -fv $CABALHOME/packages/hackage.haskell.org/build-reports.log
2430 # remove files that are regenerated by 'cabal update'
25− - rm -fv $HOME/.cabal/packages/hackage.haskell.org/00-index.*
26− - rm -fv $HOME/.cabal/packages/hackage.haskell.org/*.json
27− - rm -fv $HOME/.cabal/packages/hackage.haskell.org/01-index.cache
28− - rm -fv $HOME/.cabal/packages/hackage.haskell.org/01-index.tar
29− - rm -fv $HOME/.cabal/packages/hackage.haskell.org/01-index.tar.idx
30−
31−matrix:
31+ - rm -fv $CABALHOME/packages/hackage.haskell.org/00-index.*
32+ - rm -fv $CABALHOME/packages/hackage.haskell.org/*.json
33+ - rm -fv $CABALHOME/packages/hackage.haskell.org/01-index.cache
34+ - rm -fv $CABALHOME/packages/hackage.haskell.org/01-index.tar
35+ - rm -fv $CABALHOME/packages/hackage.haskell.org/01-index.tar.idx
36+ - rm -rfv $CABALHOME/packages/head.hackage
37+jobs:
3238 include:
33− - compiler: "ghc-7.10.3"
34− # env: TEST=--disable-tests BENCH=--disable-benchmarks
35− addons: {apt: {packages: [ghc-ppa-tools,cabal-install-head,ghc-7.10.3], sources: [hvr-ghc]}}
36− - compiler: "ghc-8.0.2"
37− # env: TEST=--disable-tests BENCH=--disable-benchmarks
38− addons: {apt: {packages: [ghc-ppa-tools,cabal-install-head,ghc-8.0.2], sources: [hvr-ghc]}}
39− - compiler: "ghc-8.2.1"
40− # env: TEST=--disable-tests BENCH=--disable-benchmarks
41− addons: {apt: {packages: [ghc-ppa-tools,cabal-install-head,ghc-8.2.1], sources: [hvr-ghc]}}
42−
39+ - compiler: ghc-8.8.3
40+ 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"]}}
41+ os: linux
42+ - compiler: ghc-8.6.5
43+ 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"]}}
44+ os: linux
45+ - compiler: ghc-8.4.4
46+ 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"]}}
47+ os: linux
48+ - compiler: ghc-8.2.2
49+ 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"]}}
50+ os: linux
51+ - compiler: ghc-8.0.2
52+ 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"]}}
53+ os: linux
4354before_install:
44− - HC=${CC}
45− - HCPKG=${HC/ghc/ghc-pkg}
55+ - HC=$(echo "/opt/$CC/bin/ghc" | sed 's/-/\//')
56+ - WITHCOMPILER="-w $HC"
57+ - HADDOCK=$(echo "/opt/$CC/bin/haddock" | sed 's/-/\//')
58+ - HCPKG="$HC-pkg"
4659 - unset CC
47− - PATH=/opt/ghc/bin:/opt/ghc-ppa-tools/bin:$PATH
48−
60+ - CABAL=/opt/ghc/bin/cabal
61+ - CABALHOME=$HOME/.cabal
62+ - export PATH="$CABALHOME/bin:$PATH"
63+ - TOP=$(pwd)
64+ - "HCNUMVER=$(${HC} --numeric-version|perl -ne '/^(\\d+)\\.(\\d+)\\.(\\d+)(\\.(\\d+))?$/; print(10000 * $1 + 100 * $2 + ($3 == 0 ? $5 != 1 : $3))')"
65+ - echo $HCNUMVER
66+ - CABAL="$CABAL -vnormal+nowrap"
67+ - set -o pipefail
68+ - TEST=--enable-tests
69+ - BENCH=--enable-benchmarks
70+ - HEADHACKAGE=false
71+ - rm -f $CABALHOME/config
72+ - |
73+ echo "verbose: normal +nowrap +markoutput" >> $CABALHOME/config
74+ echo "remote-build-reporting: anonymous" >> $CABALHOME/config
75+ echo "write-ghc-environment-files: always" >> $CABALHOME/config
76+ echo "remote-repo-cache: $CABALHOME/packages" >> $CABALHOME/config
77+ echo "logs-dir: $CABALHOME/logs" >> $CABALHOME/config
78+ echo "world-file: $CABALHOME/world" >> $CABALHOME/config
79+ echo "extra-prog-path: $CABALHOME/bin" >> $CABALHOME/config
80+ echo "symlink-bindir: $CABALHOME/bin" >> $CABALHOME/config
81+ echo "installdir: $CABALHOME/bin" >> $CABALHOME/config
82+ echo "build-summary: $CABALHOME/logs/build.log" >> $CABALHOME/config
83+ echo "store-dir: $CABALHOME/store" >> $CABALHOME/config
84+ echo "install-dirs user" >> $CABALHOME/config
85+ echo " prefix: $CABALHOME" >> $CABALHOME/config
86+ echo "repository hackage.haskell.org" >> $CABALHOME/config
87+ echo " url: http://hackage.haskell.org/" >> $CABALHOME/config
4988install:
50− - cabal --version
89+ - ${CABAL} --version
5190 - echo "$(${HC} --version) [$(${HC} --print-project-git-commit-id 2> /dev/null || echo '?')]"
52− - BENCH=${BENCH---enable-benchmarks}
53− - TEST=${TEST---enable-tests}
54− - HADDOCK=${HADDOCK-true}
55− - INSTALLED=${INSTALLED-true}
56− - travis_retry cabal update -v
57− - sed -i.bak 's/^jobs:/-- jobs:/' ${HOME}/.cabal/config
58− - rm -fv cabal.project.local
59− - "echo 'packages: .' > cabal.project"
60− - if [ -f "./configure.ac" ]; then
61− (cd "."; autoreconf -i);
62− fi
63− - rm -f cabal.project.freeze
64− - cabal new-build -w ${HC} ${TEST} ${BENCH} --project-file="cabal.project" --dep -j2 all
65− - cabal new-build -w ${HC} --disable-tests --disable-benchmarks --project-file="cabal.project" --dep -j2 all
66− - rm -rf "."/.ghc.environment.* "."/dist
67− - DISTDIR=$(mktemp -d /tmp/dist-test.XXXX)
68−
69−# Here starts the actual work to be performed for the package under test;
70−# any command which exits with a non-zero exit code causes the build to fail.
91+ - |
92+ echo "program-default-options" >> $CABALHOME/config
93+ echo " ghc-options: $GHCJOBS +RTS -M6G -RTS" >> $CABALHOME/config
94+ - cat $CABALHOME/config
95+ - rm -fv cabal.project cabal.project.local cabal.project.freeze
96+ - travis_retry ${CABAL} v2-update -v
97+ # Generate cabal.project
98+ - rm -rf cabal.project cabal.project.local cabal.project.freeze
99+ - touch cabal.project
100+ - |
101+ echo "packages: ." >> cabal.project
102+ - if [ $HCNUMVER -ge 80200 ] ; then echo 'package servant-quickcheck' >> cabal.project ; fi
103+ - "if [ $HCNUMVER -ge 80200 ] ; then echo ' ghc-options: -Werror=missing-methods' >> cabal.project ; fi"
104+ - |
105+ - "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"
106+ - cat cabal.project || true
107+ - cat cabal.project.local || true
108+ - if [ -f "./configure.ac" ]; then (cd "." && autoreconf -i); fi
109+ - ${CABAL} v2-freeze $WITHCOMPILER ${TEST} ${BENCH}
110+ - "cat cabal.project.freeze | sed -E 's/^(constraints: *| *)//' | sed 's/any.//'"
111+ - rm cabal.project.freeze
112+ - travis_wait 40 ${CABAL} v2-build $WITHCOMPILER ${TEST} ${BENCH} --dep -j2 all
113+ - travis_wait 40 ${CABAL} v2-build $WITHCOMPILER --disable-tests --disable-benchmarks --dep -j2 all
71114script:
72− # test that source-distributions can be generated
73− - (cd "."; cabal sdist)
74− - mv "."/dist/servant-quickcheck-*.tar.gz ${DISTDIR}/
75− - cd ${DISTDIR}
76− - find . -maxdepth 1 -name '*.tar.gz' -exec tar -xvf '{}' \;
77− - "printf 'packages: servant-quickcheck-*/*.cabal\n' > cabal.project"
115+ - DISTDIR=$(mktemp -d /tmp/dist-test.XXXX)
116+ # Packaging...
117+ - ${CABAL} v2-sdist all
118+ # Unpacking...
119+ - mv dist-newstyle/sdist/*.tar.gz ${DISTDIR}/
120+ - cd ${DISTDIR} || false
121+ - find . -maxdepth 1 -type f -name '*.tar.gz' -exec tar -xvf '{}' \;
122+ - find . -maxdepth 1 -type f -name '*.tar.gz' -exec rm '{}' \;
123+ - PKGDIR_servant_quickcheck="$(find . -maxdepth 1 -type d -regex '.*/servant-quickcheck-[0-9.]*')"
124+ # Generate cabal.project
125+ - rm -rf cabal.project cabal.project.local cabal.project.freeze
126+ - touch cabal.project
127+ - |
128+ echo "packages: ${PKGDIR_servant_quickcheck}" >> cabal.project
129+ - if [ $HCNUMVER -ge 80200 ] ; then echo 'package servant-quickcheck' >> cabal.project ; fi
130+ - "if [ $HCNUMVER -ge 80200 ] ; then echo ' ghc-options: -Werror=missing-methods' >> cabal.project ; fi"
131+ - |
132+ - "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"
133+ - cat cabal.project || true
134+ - cat cabal.project.local || true
135+ # Building...
78136 # this builds all libraries and executables (without tests/benchmarks)
79− - cabal new-build -w ${HC} --disable-tests --disable-benchmarks all
80−
81− # Build with installed constraints for packages in global-db
82− - if $INSTALLED; then
83− echo cabal new-build -w ${HC} --disable-tests --disable-benchmarks $(${HCPKG} list --global --simple-output --names-only | sed 's/\([a-zA-Z0-9-]\{1,\}\) */--constraint="\1 installed" /g') all | sh;
84− else echo "Not building with installed constraints"; fi
85−
137+ - ${CABAL} v2-build $WITHCOMPILER --disable-tests --disable-benchmarks all
138+ # Building with tests and benchmarks...
86139 # build & run tests, build benchmarks
87− - cabal new-build -w ${HC} ${TEST} ${BENCH} all
88− - if [ "x$TEST" = "x--enable-tests" ]; then cabal new-test -w ${HC} ${TEST} all; fi
89−
90− # haddock
91− - rm -rf ./dist-newstyle
92− - if $HADDOCK; then cabal new-haddock -w ${HC} --disable-tests --disable-benchmarks all; else echo "Skipping haddock generation";fi
140+ - ${CABAL} v2-build $WITHCOMPILER ${TEST} ${BENCH} all
141+ # Testing...
142+ - ${CABAL} v2-test $WITHCOMPILER ${TEST} ${BENCH} all
143+ # cabal check...
144+ - (cd ${PKGDIR_servant_quickcheck} && ${CABAL} -vnormal check)
145+ # haddock...
146+ - ${CABAL} v2-haddock $WITHCOMPILER --with-haddock $HADDOCK ${TEST} ${BENCH} all
147+ # Building without installed constraints for packages in global-db...
148+ - rm -f cabal.project.local
149+ - ${CABAL} v2-build $WITHCOMPILER --disable-tests --disable-benchmarks all
150+ # Constraint sets
151+ - rm -rf cabal.project.local
152+ # Constraint set base-compat-0.10
153+ - ${CABAL} v2-build $WITHCOMPILER --disable-tests --disable-benchmarks --constraint='base-compat ==0.10.*' all
154+ # Constraint set base-compat-0.11
155+ - ${CABAL} v2-build $WITHCOMPILER --disable-tests --disable-benchmarks --constraint='base-compat ==0.11.*' all
93156
94−# REGENDATA ["--branch","master","-o",".travis.yml","servant-quickcheck.cabal"]
157+# REGENDATA ("0.10.1",["--config=cabal.haskell-ci","servant-quickcheck.cabal"])
95158# EOF
CHANGELOG.yaml+95−5
@@ -1,6 +1,98 @@
1−upcoming:
2−
31releases:
2+ - version: "0.0.9.0"
3+ changes:
4+ - description: "Support servant-0.15 (#65)"
5+ authors: fizruk
6+ date: 2020-06-25
7+
8+ - description: "Relax constraints for GHC 8.10 (#70)"
9+ authors: felixmulder
10+ date: 2020-06-20
11+
12+ - version: "0.0.8.0"
13+ changes:
14+ - description: Support for servant-0.17
15+ authors: phadej
16+ date: 2019-01-23
17+
18+ - version: "0.0.7.3"
19+ changes:
20+ - description: Support for servant-0.14
21+ issue: 53
22+ authors: phadej
23+ date: 2018-06-12
24+
25+ - description: Fix a failure from OnlyJsonObjects when there is no content-type.
26+ issue: 55
27+ authors: Phenitei
28+ date: 2018-08-27
29+
30+ - description: A bug fix where notAllowedContainsAllowHeader would print the initial request alongside the failure instead of the request causing the failure when it failed.
31+ issue: 57
32+ authors: Phenitei
33+ date: 2018-08-29
34+
35+ - description: QuickCheck 2.12 compatibility
36+ issue: 58
37+ authors: parsonsmatt
38+ date: 2018-10-12
39+
40+ - description: GHC 8.6 compatibility
41+ issue: 59
42+ authors: phadej
43+ date: 2018-10-15
44+
45+ - version: "0.0.7.2"
46+ changes:
47+
48+ - description: Allow client to pass an HTTP Manager in to functions
49+ issue: 47
50+ authors: parsonsmatt
51+ date: 2018-05-10
52+
53+ - description: Fix "should not happen" error when exceptions are thrown
54+ issue: 48
55+ authors: parsonsmatt
56+ date: 2018-05-10
57+
58+ - version: "0.0.7.0"
59+ changes:
60+
61+ - description: Support for base-compat-0.10
62+ issue: none
63+ authors: phadej
64+ date: 2018-04-12
65+
66+ - version: "0.0.7.0"
67+ changes:
68+
69+ - description: Support for GHC-8.4.1
70+ issue: none
71+ authors: phadej
72+ date: 2018-03-23
73+
74+ - description: Requires hspec-2.5
75+ issue: none
76+ authors: phadej
77+ date: 2018-03-23
78+
79+ - version: "0.0.6.0"
80+ changes:
81+
82+ - description: Support for servant-0.12
83+ issue: none
84+ authors: phadej
85+ date: 2018-02-09
86+
87+ - version: "0.0.5.0"
88+ changes:
89+
90+ - description: Export forgotten predicates
91+ issue: none
92+ pr: 40
93+ authors: Phenitei
94+ date: 2017-12-14
95+
496 - version: "0.0.4"
597 changes:
698
@@ -9,14 +101,12 @@ releases:
9101 authors: phadej
10102 date: 2017-11-07
11103
12− - version: "0.0.3.1"
13− changes:
14−
15104 - description: Support for Servant 0.11
16105 issue: none
17106 pr: 32
18107 authors: adinapoli-iohk
19108 date: 2017-10-18
109+ notes: Includes 0-weighted instance for EmptyAPI
20110
21111 - version: "0.0.3.0"
22112 changes:
cabal.haskell-cinew file+7
@@ -0,0 +1,7 @@
1+branches: master
2+
3+constraint-set base-compat-0.10
4+ constraints: base-compat ==0.10.*
5+
6+constraint-set base-compat-0.11
7+ constraints: base-compat ==0.11.*
cabal.projectnew file+4
@@ -0,0 +1,4 @@
1+packages: .
2+tests: true
3+
4+allow-newer: servant-blaze:servant
example/Main.hsnew file+31
@@ -0,0 +1,31 @@
1+{-# LANGUAGE OverloadedStrings, DataKinds #-}
2+module Main (main) where
3+
4+import Servant
5+import Servant.QuickCheck
6+import Test.Hspec
7+import Data.Text (Text)
8+import System.Environment (getArgs)
9+
10+main :: IO ()
11+main = do
12+ args <- getArgs
13+ case args of
14+ [] -> putStrLn "Not running without arguments. Try --help or --fail-fast."
15+ _ -> hspec spec
16+
17+-- Change to String to reproduce
18+-- https://github.com/haskell-servant/servant-quickcheck/issues/41
19+type API = Get '[PlainText] Text
20+
21+api :: Proxy API
22+api = Proxy
23+
24+server :: Server API
25+server = return "Sigurð Fáfnirslayer"
26+
27+spec :: Spec
28+spec = describe "example server" $
29+ it "mangles UTF-8 in error messages" $
30+ withServantServer api (return server) $ \burl ->
31+ serverSatisfies api burl defaultArgs (getsHaveCacheControlHeader <%> mempty)
servant-quickcheck.cabal+123−101
@@ -1,26 +1,22 @@
1−name: servant-quickcheck
2−version: 0.0.4
3−synopsis: QuickCheck entire APIs
1+name: servant-quickcheck
2+version: 0.0.9.1
3+synopsis: QuickCheck entire APIs
44description:
5− This packages provides QuickCheck properties that are tested across an entire
6− API.
5+ This packages provides QuickCheck properties that are tested across an entire
6+ API.
77
8−license: BSD3
9−license-file: LICENSE
10−author: Julian K. Arni
11−maintainer: jkarni@gmail.com
12−category: Web
13−build-type: Simple
14−cabal-version: >=1.10
15−extra-source-files:
16− CHANGELOG.yaml
17−tested-with:
18− GHC==7.10.3,
19− GHC==8.0.2,
20− GHC==8.2.1
8+license: BSD3
9+license-file: LICENSE
10+author: Julian K. Arni
11+maintainer: jkarni@gmail.com
12+category: Web
13+build-type: Simple
14+cabal-version: >=1.10
15+extra-source-files: CHANGELOG.yaml
16+tested-with: GHC ==8.0.2 || ==8.2.2 || ==8.4.4 || ==8.6.5 || == 8.8.3
2117
2218source-repository head
23− type: git
19+ type: git
2420 location: https://github.com/haskell-servant/servant-quickcheck
2521
2622flag long-tests
@@ -28,89 +24,115 @@ flag long-tests
2824 default: False
2925
3026library
31− exposed-modules: Servant.QuickCheck
32− , Servant.QuickCheck.Internal
33− , Servant.QuickCheck.Internal.Predicates
34− , Servant.QuickCheck.Internal.HasGenRequest
35− , Servant.QuickCheck.Internal.QuickCheck
36− , Servant.QuickCheck.Internal.Equality
37− , Servant.QuickCheck.Internal.ErrorTypes
38− build-depends: base >=4.8 && <4.11
39− , base-compat == 0.9.*
40− , aeson > 0.8 && < 2
41− , bytestring == 0.10.*
42− , case-insensitive == 1.2.*
43− , clock >= 0.7 && < 0.8
44− , data-default-class >= 0.0 && < 0.2
45− , hspec >= 2.2 && < 2.5
46− , http-client >= 0.4.30 && < 0.6
47− , http-media >= 0.6 && <0.8
48− , http-types > 0.8 && < 0.11
49− , mtl > 2.1 && < 2.3
50− , pretty == 1.1.*
51− , process >= 1.2 && < 1.7
52− , QuickCheck > 2.7 && < 2.11
53− , servant > 0.6 && < 0.13
54− , servant-client > 0.6 && < 0.13
55− , servant-server > 0.6 && < 0.13
56− , split == 0.2.*
57− , string-conversions > 0.3 && < 0.5
58− , temporary == 1.2.*
59− , text == 1.*
60− , time >= 1.5 && < 1.9
61− , warp >= 3.2.4 && < 3.3
27+ exposed-modules:
28+ Servant.QuickCheck
29+ Servant.QuickCheck.Internal
30+ Servant.QuickCheck.Internal.Equality
31+ Servant.QuickCheck.Internal.ErrorTypes
32+ Servant.QuickCheck.Internal.HasGenRequest
33+ Servant.QuickCheck.Internal.Predicates
34+ Servant.QuickCheck.Internal.QuickCheck
6235
63− hs-source-dirs: src
64− default-extensions: TypeOperators
65− , FlexibleInstances
66− , FlexibleContexts
67− , DataKinds
68− , GADTs
69− , MultiParamTypeClasses
70− , DeriveFunctor
71− , KindSignatures
72− , RankNTypes
73− , ConstraintKinds
74− , DeriveGeneric
75− , ScopedTypeVariables
76− , OverloadedStrings
77− , FunctionalDependencies
78− , NoImplicitPrelude
79− , DeriveDataTypeable
80− default-language: Haskell2010
36+ build-depends:
37+ aeson >=0.8 && <2
38+ , base >=4.9 && <4.15
39+ , base-compat-batteries >=0.10.1 && <0.12
40+ , bytestring >=0.10 && <0.11
41+ , case-insensitive >=1.2 && <1.3
42+ , clock >=0.7 && <0.9
43+ , data-default-class >=0.0 && <0.2
44+ , hspec >=2.5.6 && <2.8
45+ , http-client >=0.4.30 && <0.8
46+ , http-media >=0.6 && <0.9
47+ , http-types >=0.8 && <0.13
48+ , mtl >=2.1 && <2.3
49+ , pretty >=1.1 && <1.2
50+ , process >=1.2 && <1.7
51+ , QuickCheck >=2.7 && <2.15
52+ , servant >=0.17 && <0.19
53+ , servant-client >=0.17 && <0.19
54+ , servant-server >=0.17 && <0.19
55+ , split >=0.2 && <0.3
56+ , string-conversions >=0.3 && <0.5
57+ , temporary >=1.2 && <1.4
58+ , text >=1 && <2
59+ , time >=1.5 && <1.11
60+ , warp >=3.2.4 && <3.4
61+
62+ if !impl(ghc >=8.0)
63+ build-depends: semigroups >=0.18.3 && <0.20
64+
65+ hs-source-dirs: src
66+ default-extensions:
67+ NoImplicitPrelude
68+ ConstraintKinds
69+ DataKinds
70+ DeriveDataTypeable
71+ DeriveFunctor
72+ DeriveGeneric
73+ FlexibleContexts
74+ FlexibleInstances
75+ FunctionalDependencies
76+ GADTs
77+ KindSignatures
78+ MultiParamTypeClasses
79+ OverloadedStrings
80+ RankNTypes
81+ ScopedTypeVariables
82+ TypeOperators
83+
84+ default-language: Haskell2010
8185
8286test-suite spec
83− type: exitcode-stdio-1.0
84− ghc-options: -Wall -threaded
85− default-language: Haskell2010
86− hs-source-dirs: test
87− main-is: Spec.hs
88− other-modules: Servant.QuickCheck.InternalSpec
89− build-tool-depends: hspec-discover:hspec-discover
90− build-depends: base == 4.*
91− , base-compat
92− , aeson
93− , servant-quickcheck
94− , bytestring
95− , hspec
96− , hspec-core
97− , http-client
98− , blaze-html
99− , warp
100− , servant-server
101− , servant-client
102− , servant
103− , servant-blaze
104− , transformers
105− , QuickCheck
106− , quickcheck-io
107− default-extensions: TypeOperators
108− , FlexibleInstances
109− , FlexibleContexts
110− , GADTs
111− , DataKinds
112− , NoImplicitPrelude
113− , OverloadedStrings
114− , ScopedTypeVariables
87+ type: exitcode-stdio-1.0
88+ ghc-options: -Wall -threaded
89+ default-language: Haskell2010
90+ hs-source-dirs: test
91+ main-is: Spec.hs
92+ other-modules: Servant.QuickCheck.InternalSpec
93+ build-tool-depends: hspec-discover:hspec-discover -any
94+ build-depends:
95+ aeson
96+ , base
97+ , base-compat-batteries
98+ , blaze-html
99+ , bytestring
100+ , hspec
101+ , hspec-core >=2.5.5 && <2.8
102+ , http-client
103+ , QuickCheck
104+ , quickcheck-io
105+ , servant
106+ , servant-blaze
107+ , servant-client
108+ , servant-quickcheck
109+ , servant-server
110+ , transformers
111+ , warp
112+
113+ default-extensions:
114+ NoImplicitPrelude
115+ DataKinds
116+ FlexibleContexts
117+ FlexibleInstances
118+ GADTs
119+ OverloadedStrings
120+ ScopedTypeVariables
121+ TypeOperators
122+
115123 if flag(long-tests)
116− cpp-options: -DLONG_TESTS
124+ cpp-options: -DLONG_TESTS
125+
126+test-suite example
127+ type: exitcode-stdio-1.0
128+ main-is: Main.hs
129+ hs-source-dirs: example
130+ ghc-options: -Wall
131+ build-depends:
132+ base
133+ , hspec
134+ , servant-quickcheck
135+ , servant-server
136+ , text
137+
138+ default-language: Haskell2010
src/Servant/QuickCheck/Internal/Equality.hs+6−2
@@ -5,15 +5,19 @@ import Data.ByteString (ByteString)
55import qualified Data.ByteString.Lazy as LB
66import Data.Function (on)
77import Network.HTTP.Client (Response, responseBody)
8+import Data.Semigroup (Semigroup (..))
89import Prelude.Compat
910
1011newtype ResponseEquality b
1112 = ResponseEquality { getResponseEquality :: Response b -> Response b -> Bool }
1213
14+instance Semigroup (ResponseEquality b) where
15+ ResponseEquality a <> ResponseEquality b = ResponseEquality $ \x y ->
16+ a x y && b x y
17+
1318instance Monoid (ResponseEquality b) where
1419 mempty = ResponseEquality $ \_ _ -> True
15− ResponseEquality a `mappend` ResponseEquality b = ResponseEquality $ \x y ->
16− a x y && b x y
20+ mappend = (<>)
1721
1822-- | Use `Eq` instance for `Response`
1923--
src/Servant/QuickCheck/Internal/ErrorTypes.hs+3−1
@@ -1,3 +1,4 @@
1+{-# LANGUAGE CPP #-}
12module Servant.QuickCheck.Internal.ErrorTypes where
23
34import Control.Exception (Exception (..))
@@ -8,9 +9,10 @@ import Data.Typeable (Typeable)
89import GHC.Generics (Generic)
910import qualified Network.HTTP.Client as C
1011import Network.HTTP.Types (Header, statusCode)
11−import Prelude.Compat
1212import Text.PrettyPrint
1313
14+import Prelude.Compat hiding ((<>))
15+
1416data PredicateFailure
1517 = PredicateFailure T.Text (Maybe C.Request) (C.Response LBS.ByteString)
1618 deriving (Typeable, Generic)
src/Servant/QuickCheck/Internal/HasGenRequest.hs+16−14
@@ -2,7 +2,6 @@
22{-# LANGUAGE PolyKinds #-}
33module Servant.QuickCheck.Internal.HasGenRequest where
44
5−import Data.Monoid ((<>))
65import Data.String (fromString)
76import Data.String.Conversions (cs)
87import GHC.TypeLits (KnownSymbol, Nat, symbolVal)
@@ -64,21 +63,17 @@ instance (KnownSymbol path, HasGenRequest b) => HasGenRequest (path :> b) where
6463 (oldf, old) = genRequest (Proxy :: Proxy b)
6564 new = cs $ symbolVal (Proxy :: Proxy path)
6665
67−#if MIN_VERSION_servant(0,11,0)
6866instance HasGenRequest EmptyAPI where
6967 genRequest _ = (0, error "EmptyAPIs cannot be queried.")
70−#endif
7168
72−#if MIN_VERSION_servant(0,12,0)
7369instance HasGenRequest api => HasGenRequest (Summary d :> api) where
7470 genRequest _ = genRequest (Proxy :: Proxy api)
7571
7672instance HasGenRequest api => HasGenRequest (Description d :> api) where
7773 genRequest _ = genRequest (Proxy :: Proxy api)
78−#endif
7974
8075instance (Arbitrary c, HasGenRequest b, ToHttpApiData c )
81− => HasGenRequest (Capture x c :> b) where
76+ => HasGenRequest (Capture' mods x c :> b) where
8277 genRequest _ = (oldf, do
8378 old' <- old
8479 new' <- toUrlPiece <$> new
@@ -87,7 +82,6 @@ instance (Arbitrary c, HasGenRequest b, ToHttpApiData c )
8782 (oldf, old) = genRequest (Proxy :: Proxy b)
8883 new = arbitrary :: Gen c
8984
90−#if MIN_VERSION_servant(0,8,0)
9185instance (Arbitrary c, HasGenRequest b, ToHttpApiData c )
9286 => HasGenRequest (CaptureAll x c :> b) where
9387 genRequest _ = (oldf, do
@@ -98,13 +92,12 @@ instance (Arbitrary c, HasGenRequest b, ToHttpApiData c )
9892 where
9993 (oldf, old) = genRequest (Proxy :: Proxy b)
10094 new = arbitrary :: Gen [c]
101−#endif
10295
10396instance (Arbitrary c, KnownSymbol h, HasGenRequest b, ToHttpApiData c)
104− => HasGenRequest (Header h c :> b) where
97+ => HasGenRequest (Header' mods h c :> b) where
10598 genRequest _ = (oldf, do
10699 old' <- old
107− new' <- toUrlPiece <$> new
100+ new' <- toUrlPiece <$> new -- TODO: generate lenient or/and optional
108101 return $ \burl -> let r = old' burl in r {
109102 requestHeaders = (hdr, cs new') : requestHeaders r })
110103 where
@@ -113,9 +106,9 @@ instance (Arbitrary c, KnownSymbol h, HasGenRequest b, ToHttpApiData c)
113106 new = arbitrary :: Gen c
114107
115108instance (AllMimeRender x c, Arbitrary c, HasGenRequest b)
116− => HasGenRequest (ReqBody x c :> b) where
109+ => HasGenRequest (ReqBody' mods x c :> b) where
117110 genRequest _ = (oldf, do
118− old' <- old
111+ old' <- old -- TODO: generate lenient
119112 new' <- new
120113 (ct, bd) <- elements $ allMimeRender (Proxy :: Proxy x) new'
121114 return $ \burl -> let r = old' burl in r {
@@ -127,9 +120,9 @@ instance (AllMimeRender x c, Arbitrary c, HasGenRequest b)
127120 new = arbitrary :: Gen c
128121
129122instance (KnownSymbol x, Arbitrary c, ToHttpApiData c, HasGenRequest b)
130− => HasGenRequest (QueryParam x c :> b) where
123+ => HasGenRequest (QueryParam' mods x c :> b) where
131124 genRequest _ = (oldf, do
132− new' <- new
125+ new' <- new -- TODO: generate lenient or/and optional
133126 old' <- old
134127 return $ \burl -> let r = old' burl
135128 newExpr = param <> "=" <> cs (toQueryParam new')
@@ -175,6 +168,15 @@ instance (ReflectMethod method)
175168 , method = reflectMethod (Proxy :: Proxy method)
176169 })
177170
171+instance (ReflectMethod method)
172+ => HasGenRequest (NoContentVerb (method :: k)) where
173+ genRequest _ = (1, return $ \burl -> defaultRequest
174+ { host = cs $ baseUrlHost burl
175+ , port = baseUrlPort burl
176+ , secure = baseUrlScheme burl == Https
177+ , method = reflectMethod (Proxy :: Proxy method)
178+ })
179+
178180instance (HasGenRequest a) => HasGenRequest (RemoteHost :> a) where
179181 genRequest _ = genRequest (Proxy :: Proxy a)
180182
src/Servant/QuickCheck/Internal/Predicates.hs+29−20
@@ -11,7 +11,7 @@ import Data.CaseInsensitive (foldCase, foldedCase, mk)
1111import Data.Either (isRight)
1212import Data.List.Split (wordsBy)
1313import Data.Maybe (fromMaybe, isJust)
14−import Data.Monoid ((<>))
14+import Data.Semigroup (Semigroup (..))
1515import qualified Data.Text as T
1616import Data.Time (UTCTime, defaultTimeLocale, parseTimeM,
1717 rfc822DateFormat)
@@ -84,15 +84,13 @@ notLongerThan maxAllowed
8484-- /Since 0.0.0.0/
8585onlyJsonObjects :: ResponsePredicate
8686onlyJsonObjects
87− = ResponsePredicate (\resp -> case go resp of
88− Nothing -> throw $ PredicateFailure "onlyJsonObjects" Nothing resp
89− Just () -> return ())
90− where
91− go r = do
92− ctyp <- lookup "content-type" (first foldedCase <$> responseHeaders r)
93− when ("application/json" `SBS.isPrefixOf` ctyp) $ do
94− (_ :: Object) <- decode (responseBody r)
95− return ()
87+ = ResponsePredicate (\resp -> do
88+ case lookup "content-type" (first foldedCase <$> responseHeaders resp) of
89+ Nothing -> return ()
90+ Just ctype -> when ("application/json" `SBS.isPrefixOf` ctype) $ do
91+ case (decode (responseBody resp) :: Maybe Object) of
92+ Nothing -> throw $ PredicateFailure "onlyJsonObjects" Nothing resp
93+ Just _ -> return ())
9694
9795-- | __Optional__
9896--
@@ -189,14 +187,15 @@ getsHaveLastModifiedHeader
189187notAllowedContainsAllowHeader :: RequestPredicate
190188notAllowedContainsAllowHeader
191189 = RequestPredicate $ \req mgr -> do
192− resp <- mapM (flip httpLbs mgr) $ [ req { method = renderStdMethod m }
193− | m <- [minBound .. maxBound ]
194− , renderStdMethod m /= method req ]
195− case filter pred' resp of
196− (x:_) -> throw $ PredicateFailure "notAllowedContainsAllowHeader" (Just req) x
190+ let reqs = [ req { method = renderStdMethod m } | m <- [minBound .. maxBound]
191+ , renderStdMethod m /= method req ]
192+ resp <- mapM (flip httpLbs mgr) reqs
193+
194+ case filter pred' (zip reqs resp) of
195+ (x:_) -> throw $ PredicateFailure "notAllowedContainsAllowHeader" (Just $ fst x) (snd x)
197196 [] -> return resp
198197 where
199− pred' resp = responseStatus resp == status405 && not (hasValidHeader "Allow" go resp)
198+ pred' (_, resp) = responseStatus resp == status405 && not (hasValidHeader "Allow" go resp)
200199 where
201200 go x = all (\y -> isRight $ parseMethod $ SBSC.pack y)
202201 $ wordsBy (`elem` (", " :: [Char])) (SBSC.unpack x)
@@ -377,9 +376,12 @@ newtype ResponsePredicate = ResponsePredicate
377376 { getResponsePredicate :: Response LBS.ByteString -> IO ()
378377 } deriving (Generic)
379378
379+instance Semigroup ResponsePredicate where
380+ ResponsePredicate a <> ResponsePredicate b = ResponsePredicate $ \x -> a x >> b x
381+
380382instance Monoid ResponsePredicate where
381383 mempty = ResponsePredicate $ const $ return ()
382− ResponsePredicate a `mappend` ResponsePredicate b = ResponsePredicate $ \x -> a x >> b x
384+ mappend = (<>)
383385
384386-- | A predicate that depends on both the request and the response.
385387--
@@ -391,7 +393,11 @@ newtype RequestPredicate = RequestPredicate
391393-- TODO: This isn't actually a monoid
392394instance Monoid RequestPredicate where
393395 mempty = RequestPredicate (\r m -> httpLbs r m >>= \x -> return ([x]))
394− RequestPredicate a `mappend` RequestPredicate b = RequestPredicate $ \r mgr ->
396+ mappend = (<>)
397+
398+-- TODO: This isn't actually a monoid
399+instance Semigroup RequestPredicate where
400+ RequestPredicate a <> RequestPredicate b = RequestPredicate $ \r mgr ->
395401 liftM2 (<>) (a r mgr) (b r mgr)
396402
397403-- | A set of predicates. Construct one with 'mempty' and '<%>'.
@@ -400,10 +406,13 @@ data Predicates = Predicates
400406 , responsePredicates :: ResponsePredicate
401407 } deriving (Generic)
402408
409+instance Semigroup Predicates where
410+ a <> b = Predicates (requestPredicates a <> requestPredicates b)
411+ (responsePredicates a <> responsePredicates b)
412+
403413instance Monoid Predicates where
404414 mempty = Predicates mempty mempty
405− a `mappend` b = Predicates (requestPredicates a <> requestPredicates b)
406− (responsePredicates a <> responsePredicates b)
415+ mappend = (<>)
407416
408417class JoinPreds a where
409418 joinPreds :: a -> Predicates -> Predicates
src/Servant/QuickCheck/Internal/QuickCheck.hs+58−19
@@ -2,7 +2,7 @@
22{-# LANGUAGE CPP #-}
33module Servant.QuickCheck.Internal.QuickCheck where
44
5−import Control.Concurrent (modifyMVar_, newMVar, readMVar)
5+import Control.Concurrent (tryReadMVar, newEmptyMVar, tryPutMVar)
66import Control.Monad (unless)
77import qualified Data.ByteString.Lazy as LBS
88import Data.Proxy (Proxy)
@@ -11,6 +11,9 @@ import Network.Wai.Handler.Warp (withApplication)
1111import Prelude.Compat
1212import Servant (Context (EmptyContext), HasServer,
1313 Server, serveWithContext)
14+#if MIN_VERSION_servant_server(0,18,0)
15+import Servant (DefaultErrorFormatters, ErrorFormatters, HasContextEntry, type (.++))
16+#endif
1417import Servant.Client (BaseUrl (..), Scheme (..))
1518import System.IO.Unsafe (unsafePerformIO)
1619import Test.Hspec (Expectation, expectationFailure)
@@ -37,7 +40,11 @@ withServantServer api = withServantServerAndContext api EmptyContext
3740-- application.
3841--
3942-- /Since 0.0.0.0/
43+#if MIN_VERSION_servant_server(0,18,0)
44+withServantServerAndContext :: (HasServer a ctx, HasContextEntry (ctx .++ DefaultErrorFormatters) ErrorFormatters)
45+#else
4046withServantServerAndContext :: HasServer a ctx
47+#endif
4148 => Proxy a -> Context ctx -> IO (Server a) -> (BaseUrl -> IO r) -> IO r
4249withServantServerAndContext api ctx server t
4350 = withApplication (return . serveWithContext api ctx =<< server) $ \port ->
@@ -73,21 +80,29 @@ serversEqual api burl1 burl2 args req = do
7380 let reqs = (\f -> (f burl1, f burl2)) <$> runGenRequest api
7481 -- This MVar stuff is clunky! But there doesn't seem to be an easy way to
7582 -- return results when a test fails, since an exception is throw.
76− deetsMVar <- newMVar $ error "should not be called"
83+ deetsMVar <- newEmptyMVar
7784 r <- quickCheckWithResult args { chatty = False } $ monadicIO $ forAllM reqs $ \(req1, req2) -> do
7885 resp1 <- run $ C.httpLbs (noCheckStatus req1) defManager
7986 resp2 <- run $ C.httpLbs (noCheckStatus req2) defManager
8087 unless (getResponseEquality req resp1 resp2) $ do
8188 monitor (counterexample "hi" )
82− run $ modifyMVar_ deetsMVar $ const $ return $
83− ServerEqualityFailure req1 resp1 resp2
89+ _ <- run $ tryPutMVar deetsMVar $ ServerEqualityFailure req1 resp1 resp2
8490 assert False
8591 case r of
8692 Success {} -> return ()
87− Failure{..} -> readMVar deetsMVar >>= \x -> expectationFailure $ "Failed:\n" ++ show x
93+ Failure{..} -> do
94+ mx <- tryReadMVar deetsMVar
95+ case mx of
96+ Just x ->
97+ expectationFailure $ "Failed:\n" ++ show x
98+ Nothing ->
99+ expectationFailure $ "We failed to record a reason for failure: " <> show r
88100 GaveUp { numTests = n } -> expectationFailure $ "Gave up after " ++ show n ++ " tests"
89101 NoExpectedFailure {} -> expectationFailure "No expected failure"
102+#if MIN_VERSION_QuickCheck(2,12,0)
103+#else
90104 InsufficientCoverage {} -> expectationFailure "Insufficient coverage"
105+#endif
91106
92107-- | Check that a server satisfies the set of properties specified.
93108--
@@ -110,37 +125,61 @@ serversEqual api burl1 burl2 args req = do
110125-- /Since 0.0.0.0/
111126serverSatisfies :: (HasGenRequest a) =>
112127 Proxy a -> BaseUrl -> Args -> Predicates -> Expectation
113−serverSatisfies api burl args preds = do
128+serverSatisfies api = serverSatisfiesMgr api defManager
129+
130+-- | Check that a server satisfies the set of properties specified, and
131+-- accept a 'Manager' for running the HTTP requests through.
132+--
133+-- See 'serverSatisfies' for more details.
134+--
135+-- @since 0.0.7.2
136+serverSatisfiesMgr :: (HasGenRequest a) =>
137+ Proxy a -> C.Manager -> BaseUrl -> Args -> Predicates -> Expectation
138+serverSatisfiesMgr api manager burl args preds = do
114139 let reqs = ($ burl) <$> runGenRequest api
115− deetsMVar <- newMVar $ error "should not be called"
140+ deetsMVar <- newEmptyMVar
116141 r <- quickCheckWithResult args { chatty = False } $ monadicIO $ forAllM reqs $ \req -> do
117− v <- run $ finishPredicates preds (noCheckStatus req) defManager
118− run $ modifyMVar_ deetsMVar $ const $ return v
119− case v of
120− Just _ -> assert False
121− _ -> return ()
142+ v <- run $ finishPredicates preds (noCheckStatus req) manager
143+ _ <- run $ tryPutMVar deetsMVar v
144+ case v of
145+ Just _ -> assert False
146+ _ -> return ()
122147 case r of
123148 Success {} -> return ()
124− Failure{..} -> readMVar deetsMVar >>= \x -> expectationFailure $
125− "Failed:\n" ++ show x
149+ Failure {..} -> do
150+ mx <- tryReadMVar deetsMVar
151+ case mx of
152+ Just x ->
153+ expectationFailure $ "Failed:\n" ++ show x
154+ Nothing ->
155+ expectationFailure $ "We failed to record a reason for failure: " <> show r
126156 GaveUp { numTests = n } -> expectationFailure $ "Gave up after " ++ show n ++ " tests"
127157 NoExpectedFailure {} -> expectationFailure $ "No expected failure"
128− InsufficientCoverage {} -> expectationFailure $ "Insufficient coverage"
129−
158+#if MIN_VERSION_QuickCheck(2,12,0)
159+#else
160+ InsufficientCoverage {} -> expectationFailure "Insufficient coverage"
161+#endif
130162
131163serverDoesntSatisfy :: (HasGenRequest a) =>
132164 Proxy a -> BaseUrl -> Args -> Predicates -> Expectation
133−serverDoesntSatisfy api burl args preds = do
165+serverDoesntSatisfy api = serverDoesntSatisfyMgr api defManager
166+
167+serverDoesntSatisfyMgr :: (HasGenRequest a) =>
168+ Proxy a -> C.Manager -> BaseUrl -> Args -> Predicates -> Expectation
169+serverDoesntSatisfyMgr api manager burl args preds = do
134170 let reqs = ($ burl) <$> runGenRequest api
135171 r <- quickCheckWithResult args $ monadicIO $ forAllM reqs $ \req -> do
136− v <- run $ finishPredicates preds (noCheckStatus req) defManager
172+ v <- run $ finishPredicates preds (noCheckStatus req) manager
137173 assert $ not $ null v
138174 case r of
139175 Success {} -> return ()
140176 GaveUp { numTests = n } -> expectationFailure $ "Gave up after " ++ show n ++ " tests"
141177 Failure { output = m } -> expectationFailure $ "Failed:\n" ++ show m
142178 NoExpectedFailure {} -> expectationFailure $ "No expected failure"
143− InsufficientCoverage {} -> expectationFailure $ "Insufficient coverage"
179+#if MIN_VERSION_QuickCheck(2,12,0)
180+#else
181+ InsufficientCoverage {} -> expectationFailure "Insufficient coverage"
182+#endif
144183
145184noCheckStatus :: C.Request -> C.Request
146185#if MIN_VERSION_http_client(0,5,0)
stack-lts-6.yamldeleted−6
@@ -1,6 +0,0 @@
1−resolver: lts-6.30
2−packages:
3−- '.'
4−extra-deps: []
5−flags: {}
6−extra-package-dbs: []
stack-lts-7.yamldeleted−6
@@ -1,6 +0,0 @@
1−resolver: lts-7.19
2−packages:
3−- '.'
4−extra-deps: []
5−flags: {}
6−extra-package-dbs: []
stack-lts-9.yamldeleted−6
@@ -1,6 +0,0 @@
1−resolver: lts-9.1
2−packages:
3−- '.'
4−extra-deps: []
5−flags: {}
6−extra-package-dbs: []
stack.yaml+5−5
@@ -1,10 +1,10 @@
1−resolver: lts-8.4
1+resolver: nightly-2018-09-03
22packages:
33- '.'
44extra-deps:
5−- hspec-2.4.4
6−- hspec-core-2.4.4
7−- hspec-discover-2.4.4
8−- quickcheck-io-0.2.0
5+- hspec-discover-2.5.6
6+- hspec-core-2.5.6
7+- hspec-2.5.6
8+- QuickCheck-2.12
99flags: {}
1010extra-package-dbs: []
test/Servant/QuickCheck/InternalSpec.hs+15−38
@@ -17,25 +17,13 @@ import qualified Text.Blaze.Html as Blaze
1717import qualified Text.Blaze.Html5 as Blaze5
1818import Test.Hspec (Spec, context, describe, it, shouldBe,
1919 shouldContain)
20−import Test.Hspec.Core.Spec (Arg, Example, Result (..),
21− defaultParams)
20+import Test.Hspec.Core.Spec (Arg, Example, Result (..), ResultStatus (..),
21+ defaultParams, safeEvaluateExample)
2222import Test.QuickCheck.Gen (generate, unGen)
2323import Test.QuickCheck.Random (mkQCGen)
2424
2525
26−#if MIN_VERSION_servant(0,8,0)
27−import Servant.API.Internal.Test.ComprehensiveAPI (comprehensiveAPIWithoutRaw)
28−#else
29−import Servant.API.Internal.Test.ComprehensiveAPI (ComprehensiveAPI,
30− comprehensiveAPI)
31−#endif
32−
33−#if MIN_VERSION_hspec(2,4,0)
34−import Test.Hspec.Core.Spec (safeEvaluateExample)
35−#else
36−import Control.Exception (try)
37−import Test.Hspec.Core.Spec (evaluateExample)
38−#endif
26+import Servant.Test.ComprehensiveAPI (comprehensiveAPIWithoutStreamingOrRaw)
3927
4028import Servant.QuickCheck
4129import Servant.QuickCheck.Internal (genRequest, runGenRequest,
@@ -140,6 +128,10 @@ onlyJsonObjectSpec = describe "onlyJsonObjects" $ do
140128 withServantServerAndContext octetAPI ctx serverOctetAPI $ \burl ->
141129 serverSatisfies octetAPI burl args (onlyJsonObjects <%> mempty)
142130
131+ it "does not fail when there is no content-type" $ do
132+ withServantServerAndContext api2 ctx serverFailing $ \burl ->
133+ serverSatisfies api2 burl args (onlyJsonObjects <%> mempty)
134+
143135notLongerThanSpec :: Spec
144136notLongerThanSpec = describe "notLongerThan" $ do
145137
@@ -157,7 +149,7 @@ isComprehensiveSpec :: Spec
157149isComprehensiveSpec = describe "HasGenRequest" $ do
158150
159151 it "has instances for all 'servant' combinators" $ do
160− let _g = genRequest comprehensiveAPIWithoutRaw
152+ let _g = genRequest comprehensiveAPIWithoutStreamingOrRaw
161153 True `shouldBe` True -- This is a type-level check
162154
163155deepPathSpec :: Spec
@@ -281,6 +273,9 @@ server2 = return $ return 1
281273server3 :: IO (Server API2)
282274server3 = return $ return 2
283275
276+serverFailing :: IO (Server API2)
277+serverFailing = return . throwError $ err405
278+
284279-- With Doctypes
285280type HtmlDoctype = Get '[HTML] Blaze.Html
286281
@@ -349,27 +344,14 @@ ctx = BasicAuthCheck (const . return $ NoSuchUser) :. EmptyContext
349344-- Utils
350345------------------------------------------------------------------------------
351346evalExample :: (Example e, Arg e ~ ()) => e -> IO EvalResult
352−#if MIN_VERSION_hspec(2,4,0)
353347evalExample e = do
354348 r <- safeEvaluateExample e defaultParams ($ ()) progCallback
355− case r of
356− Left err -> return $ AnException err
357− Right Success -> return $ AllGood
358− Right (Failure _ reason) -> return $ FailedWith $ show reason
359− Right (Pending _) -> error "should not happen"
349+ case resultStatus r of
350+ Success -> return $ AllGood
351+ Failure _ reason -> return $ FailedWith $ show reason
352+ Pending {} -> error "should not happen"
360353 where
361354 progCallback _ = return ()
362−#else
363−evalExample e = do
364− r <- try $ evaluateExample e defaultParams ($ ()) progCallback
365− case r of
366− Left err -> return $ AnException err
367− Right Success -> return $ AllGood
368− Right (Fail _ reason) -> return $ FailedWith reason
369− Right (Pending _) -> error "should not happen"
370− where
371− progCallback _ = return ()
372−#endif
373355
374356data EvalResult
375357 = AnException SomeException
@@ -387,8 +369,3 @@ noOfTestCases = 20000
387369#else
388370noOfTestCases = 1000
389371#endif
390−
391−#if !MIN_VERSION_servant(0,8,0)
392−comprehensiveAPIWithoutRaw :: Proxy ComprehensiveAPI
393−comprehensiveAPIWithoutRaw = comprehensiveAPI
394−#endif