git.iko.soy/servant-quickcheck
on master help sign in
.travis.yml+133−70
since splitsnapshots
unifiedsplit
@@ -1,95 +1,158 @@
1# This Travis job script has been generated by a script via
1# This Travis job script has been generated by a script via
2#
2#
3−# make_travis_yml_2.hs '--branch' 'master' '-o' '.travis.yml' 'servant-quickcheck.cabal'
3+# haskell-ci '--config=cabal.haskell-ci' 'servant-quickcheck.cabal'
4#
4#
5−# For more information, see https://github.com/hvr/multi-ghc-travis
5+# To regenerate the script (for example after adjusting tested-with) run
6#
6#
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
7language: c
14language: c
8−sudo: false
15+os: linux
9−
16+dist: xenial
10git:
17git:
11− submodules: false # whether to recursively clone submodules
18+ # whether to recursively clone submodules
12−
19+ submodules: false
13branches:
20branches:
14 only:
21 only:
15 - master
22 - master
16−
17cache:
23cache:
18 directories:
24 directories:
19 - $HOME/.cabal/packages
25 - $HOME/.cabal/packages
20 - $HOME/.cabal/store
26 - $HOME/.cabal/store
21−
27+ - $HOME/.hlint
22before_cache:
28before_cache:
23− - rm -fv $HOME/.cabal/packages/hackage.haskell.org/build-reports.log
29+ - rm -fv $CABALHOME/packages/hackage.haskell.org/build-reports.log
24 # remove files that are regenerated by 'cabal update'
30 # remove files that are regenerated by 'cabal update'
25− - rm -fv $HOME/.cabal/packages/hackage.haskell.org/00-index.*
31+ - rm -fv $CABALHOME/packages/hackage.haskell.org/00-index.*
26− - rm -fv $HOME/.cabal/packages/hackage.haskell.org/*.json
32+ - rm -fv $CABALHOME/packages/hackage.haskell.org/*.json
27− - rm -fv $HOME/.cabal/packages/hackage.haskell.org/01-index.cache
33+ - rm -fv $CABALHOME/packages/hackage.haskell.org/01-index.cache
28− - rm -fv $HOME/.cabal/packages/hackage.haskell.org/01-index.tar
34+ - rm -fv $CABALHOME/packages/hackage.haskell.org/01-index.tar
29− - rm -fv $HOME/.cabal/packages/hackage.haskell.org/01-index.tar.idx
35+ - rm -fv $CABALHOME/packages/hackage.haskell.org/01-index.tar.idx
30−
36+ - rm -rfv $CABALHOME/packages/head.hackage
31−matrix:
37+jobs:
32 include:
38 include:
33− - compiler: "ghc-7.10.3"
39+ - compiler: ghc-8.8.3
34− # env: TEST=--disable-tests BENCH=--disable-benchmarks
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"]}}
35− addons: {apt: {packages: [ghc-ppa-tools,cabal-install-head,ghc-7.10.3], sources: [hvr-ghc]}}
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
36− - compiler: "ghc-8.0.2"
48+ - compiler: ghc-8.2.2
37− # env: TEST=--disable-tests BENCH=--disable-benchmarks
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"]}}
38− addons: {apt: {packages: [ghc-ppa-tools,cabal-install-head,ghc-8.0.2], sources: [hvr-ghc]}}
50+ os: linux
39− - compiler: "ghc-8.2.1"
51+ - compiler: ghc-8.0.2
40− # env: TEST=--disable-tests BENCH=--disable-benchmarks
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"]}}
41− addons: {apt: {packages: [ghc-ppa-tools,cabal-install-head,ghc-8.2.1], sources: [hvr-ghc]}}
53+ os: linux
42−
43before_install:
54before_install:
44− - HC=${CC}
55+ - HC=$(echo "/opt/$CC/bin/ghc" | sed 's/-/\//')
56+ - WITHCOMPILER="-w $HC"
57+ - HADDOCK=$(echo "/opt/$CC/bin/haddock" | sed 's/-/\//')
45− - HCPKG=${HC/ghc/ghc-pkg}
58+ - HCPKG="$HC-pkg"
46 - unset CC
59 - unset CC
47− - PATH=/opt/ghc/bin:/opt/ghc-ppa-tools/bin:$PATH
60+ - CABAL=/opt/ghc/bin/cabal
48−
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
49install:
88install:
50− - cabal --version
89+ - ${CABAL} --version
51 - echo "$(${HC} --version) [$(${HC} --print-project-git-commit-id 2> /dev/null || echo '?')]"
90 - echo "$(${HC} --version) [$(${HC} --print-project-git-commit-id 2> /dev/null || echo '?')]"
52− - BENCH=${BENCH---enable-benchmarks}
91+ - |
53− - TEST=${TEST---enable-tests}
92+ echo "program-default-options" >> $CABALHOME/config
54− - HADDOCK=${HADDOCK-true}
93+ echo " ghc-options: $GHCJOBS +RTS -M6G -RTS" >> $CABALHOME/config
55− - INSTALLED=${INSTALLED-true}
94+ - cat $CABALHOME/config
95+ - rm -fv cabal.project cabal.project.local cabal.project.freeze
56− - travis_retry cabal update -v
96+ - travis_retry ${CABAL} v2-update -v
57− - sed -i.bak 's/^jobs:/-- jobs:/' ${HOME}/.cabal/config
97+ # Generate cabal.project
98+ - rm -rf cabal.project cabal.project.local cabal.project.freeze
58− - rm -fv cabal.project.local
99+ - touch cabal.project
100+ - |
59− - "echo 'packages: .' > cabal.project"
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
60− - if [ -f "./configure.ac" ]; then
108+ - if [ -f "./configure.ac" ]; then (cd "." && autoreconf -i); fi
61− (cd "."; autoreconf -i);
109+ - ${CABAL} v2-freeze $WITHCOMPILER ${TEST} ${BENCH}
62− fi
110+ - "cat cabal.project.freeze | sed -E 's/^(constraints: *| *)//' | sed 's/any.//'"
63− - rm -f cabal.project.freeze
111+ - rm cabal.project.freeze
64− - cabal new-build -w ${HC} ${TEST} ${BENCH} --project-file="cabal.project" --dep -j2 all
112+ - travis_wait 40 ${CABAL} v2-build $WITHCOMPILER ${TEST} ${BENCH} --dep -j2 all
65− - cabal new-build -w ${HC} --disable-tests --disable-benchmarks --project-file="cabal.project" --dep -j2 all
113+ - travis_wait 40 ${CABAL} v2-build $WITHCOMPILER --disable-tests --disable-benchmarks --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.
71script:
114script:
72− # test that source-distributions can be generated
115+ - DISTDIR=$(mktemp -d /tmp/dist-test.XXXX)
73− - (cd "."; cabal sdist)
116+ # Packaging...
117+ - ${CABAL} v2-sdist all
118+ # Unpacking...
74− - mv "."/dist/servant-quickcheck-*.tar.gz ${DISTDIR}/
119+ - mv dist-newstyle/sdist/*.tar.gz ${DISTDIR}/
75− - cd ${DISTDIR}
120+ - cd ${DISTDIR} || false
76− - find . -maxdepth 1 -name '*.tar.gz' -exec tar -xvf '{}' \;
121+ - find . -maxdepth 1 -type f -name '*.tar.gz' -exec tar -xvf '{}' \;
77− - "printf 'packages: servant-quickcheck-*/*.cabal\n' > cabal.project"
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...
78 # this builds all libraries and executables (without tests/benchmarks)
136 # this builds all libraries and executables (without tests/benchmarks)
79− - cabal new-build -w ${HC} --disable-tests --disable-benchmarks all
137+ - ${CABAL} v2-build $WITHCOMPILER --disable-tests --disable-benchmarks all
80−
138+ # Building with tests and benchmarks...
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−
86 # build & run tests, build benchmarks
139 # build & run tests, build benchmarks
87− - cabal new-build -w ${HC} ${TEST} ${BENCH} all
140+ - ${CABAL} v2-build $WITHCOMPILER ${TEST} ${BENCH} all
88− - if [ "x$TEST" = "x--enable-tests" ]; then cabal new-test -w ${HC} ${TEST} all; fi
141+ # Testing...
89−
142+ - ${CABAL} v2-test $WITHCOMPILER ${TEST} ${BENCH} all
90− # haddock
143+ # cabal check...
91− - rm -rf ./dist-newstyle
144+ - (cd ${PKGDIR_servant_quickcheck} && ${CABAL} -vnormal check)
92− - if $HADDOCK; then cabal new-haddock -w ${HC} --disable-tests --disable-benchmarks all; else echo "Skipping haddock generation";fi
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
93
156
94−# REGENDATA ["--branch","master","-o",".travis.yml","servant-quickcheck.cabal"]
157+# REGENDATA ("0.10.1",["--config=cabal.haskell-ci","servant-quickcheck.cabal"])
95# EOF
158# EOF
CHANGELOG.yaml+95−5
@@ -1,6 +1,98 @@
1−upcoming:
2−
3releases:
1releases:
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+
4 - version: "0.0.4"
96 - version: "0.0.4"
5 changes:
97 changes:
6
98
@@ -9,14 +101,12 @@ releases:
9 authors: phadej
101 authors: phadej
10 date: 2017-11-07
102 date: 2017-11-07
11
103
12− - version: "0.0.3.1"
13− changes:
14−
15 - description: Support for Servant 0.11
104 - description: Support for Servant 0.11
16 issue: none
105 issue: none
17 pr: 32
106 pr: 32
18 authors: adinapoli-iohk
107 authors: adinapoli-iohk
19 date: 2017-10-18
108 date: 2017-10-18
109+ notes: Includes 0-weighted instance for EmptyAPI
20
110
21 - version: "0.0.3.0"
111 - version: "0.0.3.0"
22 changes:
112 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
1+name: servant-quickcheck
2−version: 0.0.4
2+version: 0.0.9.1
3−synopsis: QuickCheck entire APIs
3+synopsis: QuickCheck entire APIs
4description:
4description:
5− This packages provides QuickCheck properties that are tested across an entire
5+ This packages provides QuickCheck properties that are tested across an entire
6− API.
6+ API.
7
7
8−license: BSD3
8+license: BSD3
9−license-file: LICENSE
9+license-file: LICENSE
10−author: Julian K. Arni
10+author: Julian K. Arni
11−maintainer: jkarni@gmail.com
11+maintainer: jkarni@gmail.com
12−category: Web
12+category: Web
13−build-type: Simple
13+build-type: Simple
14−cabal-version: >=1.10
14+cabal-version: >=1.10
15−extra-source-files:
15+extra-source-files: CHANGELOG.yaml
16− CHANGELOG.yaml
17−tested-with:
16+tested-with: GHC ==8.0.2 || ==8.2.2 || ==8.4.4 || ==8.6.5 || == 8.8.3
18− GHC==7.10.3,
19− GHC==8.0.2,
20− GHC==8.2.1
21
17
22source-repository head
18source-repository head
23− type: git
19+ type: git
24 location: https://github.com/haskell-servant/servant-quickcheck
20 location: https://github.com/haskell-servant/servant-quickcheck
25
21
26flag long-tests
22flag long-tests
@@ -28,89 +24,115 @@ flag long-tests
28 default: False
24 default: False
29
25
30library
26library
31− exposed-modules: Servant.QuickCheck
27+ exposed-modules:
32− , Servant.QuickCheck.Internal
28+ Servant.QuickCheck
33− , Servant.QuickCheck.Internal.Predicates
29+ Servant.QuickCheck.Internal
34− , Servant.QuickCheck.Internal.HasGenRequest
35− , Servant.QuickCheck.Internal.QuickCheck
36− , Servant.QuickCheck.Internal.Equality
30+ Servant.QuickCheck.Internal.Equality
37− , Servant.QuickCheck.Internal.ErrorTypes
31+ Servant.QuickCheck.Internal.ErrorTypes
38− build-depends: base >=4.8 && <4.11
32+ Servant.QuickCheck.Internal.HasGenRequest
39− , base-compat == 0.9.*
33+ Servant.QuickCheck.Internal.Predicates
40− , aeson > 0.8 && < 2
34+ Servant.QuickCheck.Internal.QuickCheck
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
62
35
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+
63− hs-source-dirs: src
65+ hs-source-dirs: src
64− default-extensions: TypeOperators
66+ default-extensions:
67+ NoImplicitPrelude
68+ ConstraintKinds
69+ DataKinds
70+ DeriveDataTypeable
71+ DeriveFunctor
72+ DeriveGeneric
73+ FlexibleContexts
65− , FlexibleInstances
74+ FlexibleInstances
66− , FlexibleContexts
75+ FunctionalDependencies
67− , DataKinds
68− , GADTs
76+ GADTs
77+ KindSignatures
69− , MultiParamTypeClasses
78+ MultiParamTypeClasses
70− , DeriveFunctor
79+ OverloadedStrings
71− , KindSignatures
72− , RankNTypes
80+ RankNTypes
73− , ConstraintKinds
74− , DeriveGeneric
75− , ScopedTypeVariables
81+ ScopedTypeVariables
76− , OverloadedStrings
82+ TypeOperators
77− , FunctionalDependencies
83+
78− , NoImplicitPrelude
79− , DeriveDataTypeable
80− default-language: Haskell2010
84+ default-language: Haskell2010
81
85
82test-suite spec
86test-suite spec
83− type: exitcode-stdio-1.0
87+ type: exitcode-stdio-1.0
84− ghc-options: -Wall -threaded
88+ ghc-options: -Wall -threaded
85− default-language: Haskell2010
89+ default-language: Haskell2010
86− hs-source-dirs: test
90+ hs-source-dirs: test
87− main-is: Spec.hs
91+ main-is: Spec.hs
88− other-modules: Servant.QuickCheck.InternalSpec
92+ other-modules: Servant.QuickCheck.InternalSpec
89− build-tool-depends: hspec-discover:hspec-discover
93+ build-tool-depends: hspec-discover:hspec-discover -any
90− build-depends: base == 4.*
94+ build-depends:
91− , base-compat
92− , aeson
95+ aeson
93− , servant-quickcheck
96+ , base
97+ , base-compat-batteries
98+ , blaze-html
94− , bytestring
99+ , bytestring
95− , hspec
100+ , hspec
96− , hspec-core
101+ , hspec-core >=2.5.5 && <2.8
97− , http-client
102+ , http-client
103+ , QuickCheck
104+ , quickcheck-io
105+ , servant
98− , blaze-html
106+ , servant-blaze
99− , warp
107+ , servant-client
108+ , servant-quickcheck
100− , servant-server
109+ , servant-server
101− , servant-client
102− , servant
103− , servant-blaze
104− , transformers
110+ , transformers
105− , QuickCheck
111+ , warp
106− , quickcheck-io
112+
107− default-extensions: TypeOperators
113+ default-extensions:
108− , FlexibleInstances
114+ NoImplicitPrelude
115+ DataKinds
109− , FlexibleContexts
116+ FlexibleContexts
117+ FlexibleInstances
110− , GADTs
118+ GADTs
111− , DataKinds
112− , NoImplicitPrelude
113− , OverloadedStrings
119+ OverloadedStrings
114− , ScopedTypeVariables
120+ ScopedTypeVariables
121+ TypeOperators
122+
115 if flag(long-tests)
123 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)
5import qualified Data.ByteString.Lazy as LB
5import qualified Data.ByteString.Lazy as LB
6import Data.Function (on)
6import Data.Function (on)
7import Network.HTTP.Client (Response, responseBody)
7import Network.HTTP.Client (Response, responseBody)
8+import Data.Semigroup (Semigroup (..))
8import Prelude.Compat
9import Prelude.Compat
9
10
10newtype ResponseEquality b
11newtype ResponseEquality b
11 = ResponseEquality { getResponseEquality :: Response b -> Response b -> Bool }
12 = ResponseEquality { getResponseEquality :: Response b -> Response b -> Bool }
12
13
14+instance Semigroup (ResponseEquality b) where
15+ ResponseEquality a <> ResponseEquality b = ResponseEquality $ \x y ->
16+ a x y && b x y
17+
13instance Monoid (ResponseEquality b) where
18instance Monoid (ResponseEquality b) where
14 mempty = ResponseEquality $ \_ _ -> True
19 mempty = ResponseEquality $ \_ _ -> True
15− ResponseEquality a `mappend` ResponseEquality b = ResponseEquality $ \x y ->
20+ mappend = (<>)
16− a x y && b x y
17
21
18-- | Use `Eq` instance for `Response`
22-- | Use `Eq` instance for `Response`
19--
23--
src/Servant/QuickCheck/Internal/ErrorTypes.hs+3−1
@@ -1,3 +1,4 @@
1+{-# LANGUAGE CPP #-}
1module Servant.QuickCheck.Internal.ErrorTypes where
2module Servant.QuickCheck.Internal.ErrorTypes where
2
3
3import Control.Exception (Exception (..))
4import Control.Exception (Exception (..))
@@ -8,9 +9,10 @@ import Data.Typeable (Typeable)
8import GHC.Generics (Generic)
9import GHC.Generics (Generic)
9import qualified Network.HTTP.Client as C
10import qualified Network.HTTP.Client as C
10import Network.HTTP.Types (Header, statusCode)
11import Network.HTTP.Types (Header, statusCode)
11−import Prelude.Compat
12import Text.PrettyPrint
12import Text.PrettyPrint
13
13
14+import Prelude.Compat hiding ((<>))
15+
14data PredicateFailure
16data PredicateFailure
15 = PredicateFailure T.Text (Maybe C.Request) (C.Response LBS.ByteString)
17 = PredicateFailure T.Text (Maybe C.Request) (C.Response LBS.ByteString)
16 deriving (Typeable, Generic)
18 deriving (Typeable, Generic)
src/Servant/QuickCheck/Internal/HasGenRequest.hs+16−14
@@ -2,7 +2,6 @@
2{-# LANGUAGE PolyKinds #-}
2{-# LANGUAGE PolyKinds #-}
3module Servant.QuickCheck.Internal.HasGenRequest where
3module Servant.QuickCheck.Internal.HasGenRequest where
4
4
5−import Data.Monoid ((<>))
6import Data.String (fromString)
5import Data.String (fromString)
7import Data.String.Conversions (cs)
6import Data.String.Conversions (cs)
8import GHC.TypeLits (KnownSymbol, Nat, symbolVal)
7import GHC.TypeLits (KnownSymbol, Nat, symbolVal)
@@ -64,21 +63,17 @@ instance (KnownSymbol path, HasGenRequest b) => HasGenRequest (path :> b) where
64 (oldf, old) = genRequest (Proxy :: Proxy b)
63 (oldf, old) = genRequest (Proxy :: Proxy b)
65 new = cs $ symbolVal (Proxy :: Proxy path)
64 new = cs $ symbolVal (Proxy :: Proxy path)
66
65
67−#if MIN_VERSION_servant(0,11,0)
68instance HasGenRequest EmptyAPI where
66instance HasGenRequest EmptyAPI where
69 genRequest _ = (0, error "EmptyAPIs cannot be queried.")
67 genRequest _ = (0, error "EmptyAPIs cannot be queried.")
70−#endif
71
68
72−#if MIN_VERSION_servant(0,12,0)
73instance HasGenRequest api => HasGenRequest (Summary d :> api) where
69instance HasGenRequest api => HasGenRequest (Summary d :> api) where
74 genRequest _ = genRequest (Proxy :: Proxy api)
70 genRequest _ = genRequest (Proxy :: Proxy api)
75
71
76instance HasGenRequest api => HasGenRequest (Description d :> api) where
72instance HasGenRequest api => HasGenRequest (Description d :> api) where
77 genRequest _ = genRequest (Proxy :: Proxy api)
73 genRequest _ = genRequest (Proxy :: Proxy api)
78−#endif
79
74
80instance (Arbitrary c, HasGenRequest b, ToHttpApiData c )
75instance (Arbitrary c, HasGenRequest b, ToHttpApiData c )
81− => HasGenRequest (Capture x c :> b) where
76+ => HasGenRequest (Capture' mods x c :> b) where
82 genRequest _ = (oldf, do
77 genRequest _ = (oldf, do
83 old' <- old
78 old' <- old
84 new' <- toUrlPiece <$> new
79 new' <- toUrlPiece <$> new
@@ -87,7 +82,6 @@ instance (Arbitrary c, HasGenRequest b, ToHttpApiData c )
87 (oldf, old) = genRequest (Proxy :: Proxy b)
82 (oldf, old) = genRequest (Proxy :: Proxy b)
88 new = arbitrary :: Gen c
83 new = arbitrary :: Gen c
89
84
90−#if MIN_VERSION_servant(0,8,0)
91instance (Arbitrary c, HasGenRequest b, ToHttpApiData c )
85instance (Arbitrary c, HasGenRequest b, ToHttpApiData c )
92 => HasGenRequest (CaptureAll x c :> b) where
86 => HasGenRequest (CaptureAll x c :> b) where
93 genRequest _ = (oldf, do
87 genRequest _ = (oldf, do
@@ -98,13 +92,12 @@ instance (Arbitrary c, HasGenRequest b, ToHttpApiData c )
98 where
92 where
99 (oldf, old) = genRequest (Proxy :: Proxy b)
93 (oldf, old) = genRequest (Proxy :: Proxy b)
100 new = arbitrary :: Gen [c]
94 new = arbitrary :: Gen [c]
101−#endif
102
95
103instance (Arbitrary c, KnownSymbol h, HasGenRequest b, ToHttpApiData c)
96instance (Arbitrary c, KnownSymbol h, HasGenRequest b, ToHttpApiData c)
104− => HasGenRequest (Header h c :> b) where
97+ => HasGenRequest (Header' mods h c :> b) where
105 genRequest _ = (oldf, do
98 genRequest _ = (oldf, do
106 old' <- old
99 old' <- old
107− new' <- toUrlPiece <$> new
100+ new' <- toUrlPiece <$> new -- TODO: generate lenient or/and optional
108 return $ \burl -> let r = old' burl in r {
101 return $ \burl -> let r = old' burl in r {
109 requestHeaders = (hdr, cs new') : requestHeaders r })
102 requestHeaders = (hdr, cs new') : requestHeaders r })
110 where
103 where
@@ -113,9 +106,9 @@ instance (Arbitrary c, KnownSymbol h, HasGenRequest b, ToHttpApiData c)
113 new = arbitrary :: Gen c
106 new = arbitrary :: Gen c
114
107
115instance (AllMimeRender x c, Arbitrary c, HasGenRequest b)
108instance (AllMimeRender x c, Arbitrary c, HasGenRequest b)
116− => HasGenRequest (ReqBody x c :> b) where
109+ => HasGenRequest (ReqBody' mods x c :> b) where
117 genRequest _ = (oldf, do
110 genRequest _ = (oldf, do
118− old' <- old
111+ old' <- old -- TODO: generate lenient
119 new' <- new
112 new' <- new
120 (ct, bd) <- elements $ allMimeRender (Proxy :: Proxy x) new'
113 (ct, bd) <- elements $ allMimeRender (Proxy :: Proxy x) new'
121 return $ \burl -> let r = old' burl in r {
114 return $ \burl -> let r = old' burl in r {
@@ -127,9 +120,9 @@ instance (AllMimeRender x c, Arbitrary c, HasGenRequest b)
127 new = arbitrary :: Gen c
120 new = arbitrary :: Gen c
128
121
129instance (KnownSymbol x, Arbitrary c, ToHttpApiData c, HasGenRequest b)
122instance (KnownSymbol x, Arbitrary c, ToHttpApiData c, HasGenRequest b)
130− => HasGenRequest (QueryParam x c :> b) where
123+ => HasGenRequest (QueryParam' mods x c :> b) where
131 genRequest _ = (oldf, do
124 genRequest _ = (oldf, do
132− new' <- new
125+ new' <- new -- TODO: generate lenient or/and optional
133 old' <- old
126 old' <- old
134 return $ \burl -> let r = old' burl
127 return $ \burl -> let r = old' burl
135 newExpr = param <> "=" <> cs (toQueryParam new')
128 newExpr = param <> "=" <> cs (toQueryParam new')
@@ -175,6 +168,15 @@ instance (ReflectMethod method)
175 , method = reflectMethod (Proxy :: Proxy method)
168 , method = reflectMethod (Proxy :: Proxy method)
176 })
169 })
177
170
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+
178instance (HasGenRequest a) => HasGenRequest (RemoteHost :> a) where
180instance (HasGenRequest a) => HasGenRequest (RemoteHost :> a) where
179 genRequest _ = genRequest (Proxy :: Proxy a)
181 genRequest _ = genRequest (Proxy :: Proxy a)
180
182
src/Servant/QuickCheck/Internal/Predicates.hs+29−20
@@ -11,7 +11,7 @@ import Data.CaseInsensitive (foldCase, foldedCase, mk)
11import Data.Either (isRight)
11import Data.Either (isRight)
12import Data.List.Split (wordsBy)
12import Data.List.Split (wordsBy)
13import Data.Maybe (fromMaybe, isJust)
13import Data.Maybe (fromMaybe, isJust)
14−import Data.Monoid ((<>))
14+import Data.Semigroup (Semigroup (..))
15import qualified Data.Text as T
15import qualified Data.Text as T
16import Data.Time (UTCTime, defaultTimeLocale, parseTimeM,
16import Data.Time (UTCTime, defaultTimeLocale, parseTimeM,
17 rfc822DateFormat)
17 rfc822DateFormat)
@@ -84,15 +84,13 @@ notLongerThan maxAllowed
84-- /Since 0.0.0.0/
84-- /Since 0.0.0.0/
85onlyJsonObjects :: ResponsePredicate
85onlyJsonObjects :: ResponsePredicate
86onlyJsonObjects
86onlyJsonObjects
87− = ResponsePredicate (\resp -> case go resp of
87+ = ResponsePredicate (\resp -> do
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)
88+ case lookup "content-type" (first foldedCase <$> responseHeaders resp) of
89+ Nothing -> return ()
93− when ("application/json" `SBS.isPrefixOf` ctyp) $ do
90+ Just ctype -> when ("application/json" `SBS.isPrefixOf` ctype) $ do
94− (_ :: Object) <- decode (responseBody r)
91+ case (decode (responseBody resp) :: Maybe Object) of
92+ Nothing -> throw $ PredicateFailure "onlyJsonObjects" Nothing resp
95− return ()
93+ Just _ -> return ())
96
94
97-- | __Optional__
95-- | __Optional__
98--
96--
@@ -189,14 +187,15 @@ getsHaveLastModifiedHeader
189notAllowedContainsAllowHeader :: RequestPredicate
187notAllowedContainsAllowHeader :: RequestPredicate
190notAllowedContainsAllowHeader
188notAllowedContainsAllowHeader
191 = RequestPredicate $ \req mgr -> do
189 = RequestPredicate $ \req mgr -> do
192− resp <- mapM (flip httpLbs mgr) $ [ req { method = renderStdMethod m }
190+ let reqs = [ req { method = renderStdMethod m } | m <- [minBound .. maxBound]
193− | m <- [minBound .. maxBound ]
194− , renderStdMethod m /= method req ]
191+ , renderStdMethod m /= method req ]
192+ resp <- mapM (flip httpLbs mgr) reqs
193+
195− case filter pred' resp of
194+ case filter pred' (zip reqs resp) of
196− (x:_) -> throw $ PredicateFailure "notAllowedContainsAllowHeader" (Just req) x
195+ (x:_) -> throw $ PredicateFailure "notAllowedContainsAllowHeader" (Just $ fst x) (snd x)
197 [] -> return resp
196 [] -> return resp
198 where
197 where
199− pred' resp = responseStatus resp == status405 && not (hasValidHeader "Allow" go resp)
198+ pred' (_, resp) = responseStatus resp == status405 && not (hasValidHeader "Allow" go resp)
200 where
199 where
201 go x = all (\y -> isRight $ parseMethod $ SBSC.pack y)
200 go x = all (\y -> isRight $ parseMethod $ SBSC.pack y)
202 $ wordsBy (`elem` (", " :: [Char])) (SBSC.unpack x)
201 $ wordsBy (`elem` (", " :: [Char])) (SBSC.unpack x)
@@ -377,9 +376,12 @@ newtype ResponsePredicate = ResponsePredicate
377 { getResponsePredicate :: Response LBS.ByteString -> IO ()
376 { getResponsePredicate :: Response LBS.ByteString -> IO ()
378 } deriving (Generic)
377 } deriving (Generic)
379
378
379+instance Semigroup ResponsePredicate where
380+ ResponsePredicate a <> ResponsePredicate b = ResponsePredicate $ \x -> a x >> b x
381+
380instance Monoid ResponsePredicate where
382instance Monoid ResponsePredicate where
381 mempty = ResponsePredicate $ const $ return ()
383 mempty = ResponsePredicate $ const $ return ()
382− ResponsePredicate a `mappend` ResponsePredicate b = ResponsePredicate $ \x -> a x >> b x
384+ mappend = (<>)
383
385
384-- | A predicate that depends on both the request and the response.
386-- | A predicate that depends on both the request and the response.
385--
387--
@@ -391,7 +393,11 @@ newtype RequestPredicate = RequestPredicate
391-- TODO: This isn't actually a monoid
393-- TODO: This isn't actually a monoid
392instance Monoid RequestPredicate where
394instance Monoid RequestPredicate where
393 mempty = RequestPredicate (\r m -> httpLbs r m >>= \x -> return ([x]))
395 mempty = RequestPredicate (\r m -> httpLbs r m >>= \x -> return ([x]))
396+ mappend = (<>)
397+
398+-- TODO: This isn't actually a monoid
399+instance Semigroup RequestPredicate where
394− RequestPredicate a `mappend` RequestPredicate b = RequestPredicate $ \r mgr ->
400+ RequestPredicate a <> RequestPredicate b = RequestPredicate $ \r mgr ->
395 liftM2 (<>) (a r mgr) (b r mgr)
401 liftM2 (<>) (a r mgr) (b r mgr)
396
402
397-- | A set of predicates. Construct one with 'mempty' and '<%>'.
403-- | A set of predicates. Construct one with 'mempty' and '<%>'.
@@ -400,10 +406,13 @@ data Predicates = Predicates
400 , responsePredicates :: ResponsePredicate
406 , responsePredicates :: ResponsePredicate
401 } deriving (Generic)
407 } deriving (Generic)
402
408
409+instance Semigroup Predicates where
410+ a <> b = Predicates (requestPredicates a <> requestPredicates b)
411+ (responsePredicates a <> responsePredicates b)
412+
403instance Monoid Predicates where
413instance Monoid Predicates where
404 mempty = Predicates mempty mempty
414 mempty = Predicates mempty mempty
405− a `mappend` b = Predicates (requestPredicates a <> requestPredicates b)
415+ mappend = (<>)
406− (responsePredicates a <> responsePredicates b)
407
416
408class JoinPreds a where
417class JoinPreds a where
409 joinPreds :: a -> Predicates -> Predicates
418 joinPreds :: a -> Predicates -> Predicates
src/Servant/QuickCheck/Internal/QuickCheck.hs+58−19
@@ -2,7 +2,7 @@
2{-# LANGUAGE CPP #-}
2{-# LANGUAGE CPP #-}
3module Servant.QuickCheck.Internal.QuickCheck where
3module Servant.QuickCheck.Internal.QuickCheck where
4
4
5−import Control.Concurrent (modifyMVar_, newMVar, readMVar)
5+import Control.Concurrent (tryReadMVar, newEmptyMVar, tryPutMVar)
6import Control.Monad (unless)
6import Control.Monad (unless)
7import qualified Data.ByteString.Lazy as LBS
7import qualified Data.ByteString.Lazy as LBS
8import Data.Proxy (Proxy)
8import Data.Proxy (Proxy)
@@ -11,6 +11,9 @@ import Network.Wai.Handler.Warp (withApplication)
11import Prelude.Compat
11import Prelude.Compat
12import Servant (Context (EmptyContext), HasServer,
12import Servant (Context (EmptyContext), HasServer,
13 Server, serveWithContext)
13 Server, serveWithContext)
14+#if MIN_VERSION_servant_server(0,18,0)
15+import Servant (DefaultErrorFormatters, ErrorFormatters, HasContextEntry, type (.++))
16+#endif
14import Servant.Client (BaseUrl (..), Scheme (..))
17import Servant.Client (BaseUrl (..), Scheme (..))
15import System.IO.Unsafe (unsafePerformIO)
18import System.IO.Unsafe (unsafePerformIO)
16import Test.Hspec (Expectation, expectationFailure)
19import Test.Hspec (Expectation, expectationFailure)
@@ -37,7 +40,11 @@ withServantServer api = withServantServerAndContext api EmptyContext
37-- application.
40-- application.
38--
41--
39-- /Since 0.0.0.0/
42-- /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
40withServantServerAndContext :: HasServer a ctx
46withServantServerAndContext :: HasServer a ctx
47+#endif
41 => Proxy a -> Context ctx -> IO (Server a) -> (BaseUrl -> IO r) -> IO r
48 => Proxy a -> Context ctx -> IO (Server a) -> (BaseUrl -> IO r) -> IO r
42withServantServerAndContext api ctx server t
49withServantServerAndContext api ctx server t
43 = withApplication (return . serveWithContext api ctx =<< server) $ \port ->
50 = withApplication (return . serveWithContext api ctx =<< server) $ \port ->
@@ -73,21 +80,29 @@ serversEqual api burl1 burl2 args req = do
73 let reqs = (\f -> (f burl1, f burl2)) <$> runGenRequest api
80 let reqs = (\f -> (f burl1, f burl2)) <$> runGenRequest api
74 -- This MVar stuff is clunky! But there doesn't seem to be an easy way to
81 -- This MVar stuff is clunky! But there doesn't seem to be an easy way to
75 -- return results when a test fails, since an exception is throw.
82 -- return results when a test fails, since an exception is throw.
76− deetsMVar <- newMVar $ error "should not be called"
83+ deetsMVar <- newEmptyMVar
77 r <- quickCheckWithResult args { chatty = False } $ monadicIO $ forAllM reqs $ \(req1, req2) -> do
84 r <- quickCheckWithResult args { chatty = False } $ monadicIO $ forAllM reqs $ \(req1, req2) -> do
78 resp1 <- run $ C.httpLbs (noCheckStatus req1) defManager
85 resp1 <- run $ C.httpLbs (noCheckStatus req1) defManager
79 resp2 <- run $ C.httpLbs (noCheckStatus req2) defManager
86 resp2 <- run $ C.httpLbs (noCheckStatus req2) defManager
80 unless (getResponseEquality req resp1 resp2) $ do
87 unless (getResponseEquality req resp1 resp2) $ do
81 monitor (counterexample "hi" )
88 monitor (counterexample "hi" )
82− run $ modifyMVar_ deetsMVar $ const $ return $
83− ServerEqualityFailure req1 resp1 resp2
89+ _ <- run $ tryPutMVar deetsMVar $ ServerEqualityFailure req1 resp1 resp2
84 assert False
90 assert False
85 case r of
91 case r of
86 Success {} -> return ()
92 Success {} -> return ()
93+ Failure{..} -> do
94+ mx <- tryReadMVar deetsMVar
95+ case mx of
96+ Just x ->
87− Failure{..} -> readMVar deetsMVar >>= \x -> expectationFailure $ "Failed:\n" ++ show x
97+ expectationFailure $ "Failed:\n" ++ show x
98+ Nothing ->
99+ expectationFailure $ "We failed to record a reason for failure: " <> show r
88 GaveUp { numTests = n } -> expectationFailure $ "Gave up after " ++ show n ++ " tests"
100 GaveUp { numTests = n } -> expectationFailure $ "Gave up after " ++ show n ++ " tests"
89 NoExpectedFailure {} -> expectationFailure "No expected failure"
101 NoExpectedFailure {} -> expectationFailure "No expected failure"
102+#if MIN_VERSION_QuickCheck(2,12,0)
103+#else
90 InsufficientCoverage {} -> expectationFailure "Insufficient coverage"
104 InsufficientCoverage {} -> expectationFailure "Insufficient coverage"
105+#endif
91
106
92-- | Check that a server satisfies the set of properties specified.
107-- | Check that a server satisfies the set of properties specified.
93--
108--
@@ -110,37 +125,61 @@ serversEqual api burl1 burl2 args req = do
110-- /Since 0.0.0.0/
125-- /Since 0.0.0.0/
111serverSatisfies :: (HasGenRequest a) =>
126serverSatisfies :: (HasGenRequest a) =>
112 Proxy a -> BaseUrl -> Args -> Predicates -> Expectation
127 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
114 let reqs = ($ burl) <$> runGenRequest api
139 let reqs = ($ burl) <$> runGenRequest api
115− deetsMVar <- newMVar $ error "should not be called"
140+ deetsMVar <- newEmptyMVar
116 r <- quickCheckWithResult args { chatty = False } $ monadicIO $ forAllM reqs $ \req -> do
141 r <- quickCheckWithResult args { chatty = False } $ monadicIO $ forAllM reqs $ \req -> do
117− v <- run $ finishPredicates preds (noCheckStatus req) defManager
142+ v <- run $ finishPredicates preds (noCheckStatus req) manager
118− run $ modifyMVar_ deetsMVar $ const $ return v
143+ _ <- run $ tryPutMVar deetsMVar v
119− case v of
144+ case v of
120− Just _ -> assert False
145+ Just _ -> assert False
121− _ -> return ()
146+ _ -> return ()
122 case r of
147 case r of
123 Success {} -> return ()
148 Success {} -> return ()
124− Failure{..} -> readMVar deetsMVar >>= \x -> expectationFailure $
149+ Failure {..} -> do
150+ mx <- tryReadMVar deetsMVar
151+ case mx of
152+ Just x ->
125− "Failed:\n" ++ show x
153+ expectationFailure $ "Failed:\n" ++ show x
154+ Nothing ->
155+ expectationFailure $ "We failed to record a reason for failure: " <> show r
126 GaveUp { numTests = n } -> expectationFailure $ "Gave up after " ++ show n ++ " tests"
156 GaveUp { numTests = n } -> expectationFailure $ "Gave up after " ++ show n ++ " tests"
127 NoExpectedFailure {} -> expectationFailure $ "No expected failure"
157 NoExpectedFailure {} -> expectationFailure $ "No expected failure"
158+#if MIN_VERSION_QuickCheck(2,12,0)
159+#else
128− InsufficientCoverage {} -> expectationFailure $ "Insufficient coverage"
160+ InsufficientCoverage {} -> expectationFailure "Insufficient coverage"
129−
161+#endif
130
162
131serverDoesntSatisfy :: (HasGenRequest a) =>
163serverDoesntSatisfy :: (HasGenRequest a) =>
132 Proxy a -> BaseUrl -> Args -> Predicates -> Expectation
164 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
134 let reqs = ($ burl) <$> runGenRequest api
170 let reqs = ($ burl) <$> runGenRequest api
135 r <- quickCheckWithResult args $ monadicIO $ forAllM reqs $ \req -> do
171 r <- quickCheckWithResult args $ monadicIO $ forAllM reqs $ \req -> do
136− v <- run $ finishPredicates preds (noCheckStatus req) defManager
172+ v <- run $ finishPredicates preds (noCheckStatus req) manager
137 assert $ not $ null v
173 assert $ not $ null v
138 case r of
174 case r of
139 Success {} -> return ()
175 Success {} -> return ()
140 GaveUp { numTests = n } -> expectationFailure $ "Gave up after " ++ show n ++ " tests"
176 GaveUp { numTests = n } -> expectationFailure $ "Gave up after " ++ show n ++ " tests"
141 Failure { output = m } -> expectationFailure $ "Failed:\n" ++ show m
177 Failure { output = m } -> expectationFailure $ "Failed:\n" ++ show m
142 NoExpectedFailure {} -> expectationFailure $ "No expected failure"
178 NoExpectedFailure {} -> expectationFailure $ "No expected failure"
179+#if MIN_VERSION_QuickCheck(2,12,0)
180+#else
143− InsufficientCoverage {} -> expectationFailure $ "Insufficient coverage"
181+ InsufficientCoverage {} -> expectationFailure "Insufficient coverage"
182+#endif
144
183
145noCheckStatus :: C.Request -> C.Request
184noCheckStatus :: C.Request -> C.Request
146#if MIN_VERSION_http_client(0,5,0)
185#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
2packages:
2packages:
3- '.'
3- '.'
4extra-deps:
4extra-deps:
5−- hspec-2.4.4
5+- hspec-discover-2.5.6
6−- hspec-core-2.4.4
6+- hspec-core-2.5.6
7−- hspec-discover-2.4.4
7+- hspec-2.5.6
8−- quickcheck-io-0.2.0
8+- QuickCheck-2.12
9flags: {}
9flags: {}
10extra-package-dbs: []
10extra-package-dbs: []
test/Servant/QuickCheck/InternalSpec.hs+15−38
@@ -17,25 +17,13 @@ import qualified Text.Blaze.Html as Blaze
17import qualified Text.Blaze.Html5 as Blaze5
17import qualified Text.Blaze.Html5 as Blaze5
18import Test.Hspec (Spec, context, describe, it, shouldBe,
18import Test.Hspec (Spec, context, describe, it, shouldBe,
19 shouldContain)
19 shouldContain)
20−import Test.Hspec.Core.Spec (Arg, Example, Result (..),
20+import Test.Hspec.Core.Spec (Arg, Example, Result (..), ResultStatus (..),
21− defaultParams)
21+ defaultParams, safeEvaluateExample)
22import Test.QuickCheck.Gen (generate, unGen)
22import Test.QuickCheck.Gen (generate, unGen)
23import Test.QuickCheck.Random (mkQCGen)
23import Test.QuickCheck.Random (mkQCGen)
24
24
25
25
26−#if MIN_VERSION_servant(0,8,0)
27−import Servant.API.Internal.Test.ComprehensiveAPI (comprehensiveAPIWithoutRaw)
26+import Servant.Test.ComprehensiveAPI (comprehensiveAPIWithoutStreamingOrRaw)
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
39
27
40import Servant.QuickCheck
28import Servant.QuickCheck
41import Servant.QuickCheck.Internal (genRequest, runGenRequest,
29import Servant.QuickCheck.Internal (genRequest, runGenRequest,
@@ -140,6 +128,10 @@ onlyJsonObjectSpec = describe "onlyJsonObjects" $ do
140 withServantServerAndContext octetAPI ctx serverOctetAPI $ \burl ->
128 withServantServerAndContext octetAPI ctx serverOctetAPI $ \burl ->
141 serverSatisfies octetAPI burl args (onlyJsonObjects <%> mempty)
129 serverSatisfies octetAPI burl args (onlyJsonObjects <%> mempty)
142
130
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+
143notLongerThanSpec :: Spec
135notLongerThanSpec :: Spec
144notLongerThanSpec = describe "notLongerThan" $ do
136notLongerThanSpec = describe "notLongerThan" $ do
145
137
@@ -157,7 +149,7 @@ isComprehensiveSpec :: Spec
157isComprehensiveSpec = describe "HasGenRequest" $ do
149isComprehensiveSpec = describe "HasGenRequest" $ do
158
150
159 it "has instances for all 'servant' combinators" $ do
151 it "has instances for all 'servant' combinators" $ do
160− let _g = genRequest comprehensiveAPIWithoutRaw
152+ let _g = genRequest comprehensiveAPIWithoutStreamingOrRaw
161 True `shouldBe` True -- This is a type-level check
153 True `shouldBe` True -- This is a type-level check
162
154
163deepPathSpec :: Spec
155deepPathSpec :: Spec
@@ -281,6 +273,9 @@ server2 = return $ return 1
281server3 :: IO (Server API2)
273server3 :: IO (Server API2)
282server3 = return $ return 2
274server3 = return $ return 2
283
275
276+serverFailing :: IO (Server API2)
277+serverFailing = return . throwError $ err405
278+
284-- With Doctypes
279-- With Doctypes
285type HtmlDoctype = Get '[HTML] Blaze.Html
280type HtmlDoctype = Get '[HTML] Blaze.Html
286
281
@@ -349,27 +344,14 @@ ctx = BasicAuthCheck (const . return $ NoSuchUser) :. EmptyContext
349-- Utils
344-- Utils
350------------------------------------------------------------------------------
345------------------------------------------------------------------------------
351evalExample :: (Example e, Arg e ~ ()) => e -> IO EvalResult
346evalExample :: (Example e, Arg e ~ ()) => e -> IO EvalResult
352−#if MIN_VERSION_hspec(2,4,0)
353evalExample e = do
347evalExample e = do
354 r <- safeEvaluateExample e defaultParams ($ ()) progCallback
348 r <- safeEvaluateExample e defaultParams ($ ()) progCallback
355− case r of
349+ case resultStatus r of
356− Left err -> return $ AnException err
357− Right Success -> return $ AllGood
350+ Success -> return $ AllGood
358− Right (Failure _ reason) -> return $ FailedWith $ show reason
351+ Failure _ reason -> return $ FailedWith $ show reason
359− Right (Pending _) -> error "should not happen"
352+ Pending {} -> error "should not happen"
360 where
353 where
361 progCallback _ = return ()
354 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
373
355
374data EvalResult
356data EvalResult
375 = AnException SomeException
357 = AnException SomeException
@@ -387,8 +369,3 @@ noOfTestCases = 20000
387#else
369#else
388noOfTestCases = 1000
370noOfTestCases = 1000
389#endif
371#endif
390−
391−#if !MIN_VERSION_servant(0,8,0)
392−comprehensiveAPIWithoutRaw :: Proxy ComprehensiveAPI
393−comprehensiveAPIWithoutRaw = comprehensiveAPI
394−#endif