Merge branch 'master' into 309-handle-application-exceptions-with-500-errors
This commit is contained in:
Sasa Bogicevic
commit
64686f3ec9
34 changed files with 404 additions and 248 deletions
77
.travis.yml
77
.travis.yml
|
|
@ -1,6 +1,6 @@
|
||||||
# This Travis job script has been generated by a script via
|
# This Travis job script has been generated by a script via
|
||||||
#
|
#
|
||||||
# runghc make_travis_yml_2.hs '--config=cabal.make-travis-yml' '--output=.travis.yml' '--max-backjumps=10000' 'cabal.project'
|
# runghc make_travis_yml_2.hs '--config=cabal.make-travis-yml' '--output=.travis.yml' 'cabal.project'
|
||||||
#
|
#
|
||||||
# For more information, see https://github.com/hvr/multi-ghc-travis
|
# For more information, see https://github.com/hvr/multi-ghc-travis
|
||||||
#
|
#
|
||||||
|
|
@ -33,18 +33,21 @@ before_cache:
|
||||||
|
|
||||||
matrix:
|
matrix:
|
||||||
include:
|
include:
|
||||||
- compiler: "ghc-7.8.4"
|
- compiler: "ghc-8.4.3"
|
||||||
# env: TEST=--disable-tests BENCH=--disable-benchmarks
|
# env: TEST=--disable-tests BENCH=--disable-benchmarks
|
||||||
addons: {apt: {packages: [ghc-ppa-tools,cabal-install-head,ghc-7.8.4], sources: [hvr-ghc]}}
|
addons: {apt: {packages: [ghc-ppa-tools,ghc-8.4.3], sources: [hvr-ghc]}}
|
||||||
- compiler: "ghc-7.10.3"
|
|
||||||
# env: TEST=--disable-tests BENCH=--disable-benchmarks
|
|
||||||
addons: {apt: {packages: [ghc-ppa-tools,cabal-install-head,ghc-7.10.3], sources: [hvr-ghc]}}
|
|
||||||
- compiler: "ghc-8.0.2"
|
|
||||||
# env: TEST=--disable-tests BENCH=--disable-benchmarks
|
|
||||||
addons: {apt: {packages: [ghc-ppa-tools,cabal-install-head,ghc-8.0.2], sources: [hvr-ghc]}}
|
|
||||||
- compiler: "ghc-8.2.2"
|
- compiler: "ghc-8.2.2"
|
||||||
# env: TEST=--disable-tests BENCH=--disable-benchmarks
|
# env: TEST=--disable-tests BENCH=--disable-benchmarks
|
||||||
addons: {apt: {packages: [ghc-ppa-tools,cabal-install-head,ghc-8.2.2], sources: [hvr-ghc]}}
|
addons: {apt: {packages: [ghc-ppa-tools,ghc-8.2.2], sources: [hvr-ghc]}}
|
||||||
|
- compiler: "ghc-8.0.2"
|
||||||
|
# env: TEST=--disable-tests BENCH=--disable-benchmarks
|
||||||
|
addons: {apt: {packages: [ghc-ppa-tools,ghc-8.0.2], sources: [hvr-ghc]}}
|
||||||
|
- compiler: "ghc-7.10.3"
|
||||||
|
# env: TEST=--disable-tests BENCH=--disable-benchmarks
|
||||||
|
addons: {apt: {packages: [ghc-ppa-tools,ghc-7.10.3], sources: [hvr-ghc]}}
|
||||||
|
- compiler: "ghc-7.8.4"
|
||||||
|
# env: TEST=--disable-tests BENCH=--disable-benchmarks
|
||||||
|
addons: {apt: {packages: [ghc-ppa-tools,ghc-7.8.4], sources: [hvr-ghc]}}
|
||||||
|
|
||||||
before_install:
|
before_install:
|
||||||
- HC=${CC}
|
- HC=${CC}
|
||||||
|
|
@ -56,6 +59,17 @@ before_install:
|
||||||
- HCNUMVER=$(( $(${HC} --numeric-version|sed -E 's/([0-9]+)\.([0-9]+)\.([0-9]+).*/\1 * 10000 + \2 * 100 + \3/') ))
|
- HCNUMVER=$(( $(${HC} --numeric-version|sed -E 's/([0-9]+)\.([0-9]+)\.([0-9]+).*/\1 * 10000 + \2 * 100 + \3/') ))
|
||||||
- echo $HCNUMVER
|
- echo $HCNUMVER
|
||||||
|
|
||||||
|
# Let's download "better" cabal
|
||||||
|
- "curl -L http://oleg.fi/cabal-grayjay-buildable-fix.xz | xz -d > $HOME/.local/bin/cabal"
|
||||||
|
- |
|
||||||
|
if [ "$(cd $HOME/.local/bin && sha256sum cabal)" != "e281e9466b8eef30ac0d1371e8ea83c9d2e856bda4714a728ac474138b09b20f cabal" ]; then
|
||||||
|
rm -f $HOME/.local/bin/cabal;
|
||||||
|
sha256sum $HOME/.local/bin/cabal;
|
||||||
|
false;
|
||||||
|
else
|
||||||
|
chmod a+x $HOME/.local/bin/cabal;
|
||||||
|
fi
|
||||||
|
|
||||||
install:
|
install:
|
||||||
- cabal --version
|
- cabal --version
|
||||||
- echo "$(${HC} --version) [$(${HC} --print-project-git-commit-id 2> /dev/null || echo '?')]"
|
- echo "$(${HC} --version) [$(${HC} --print-project-git-commit-id 2> /dev/null || echo '?')]"
|
||||||
|
|
@ -64,15 +78,14 @@ install:
|
||||||
- HADDOCK=${HADDOCK-true}
|
- HADDOCK=${HADDOCK-true}
|
||||||
- INSTALLED=${INSTALLED-true}
|
- INSTALLED=${INSTALLED-true}
|
||||||
- GHCHEAD=${GHCHEAD-false}
|
- GHCHEAD=${GHCHEAD-false}
|
||||||
- CABALNEWBUILDOPTS=--max-backjumps=10000
|
|
||||||
- travis_retry cabal update -v
|
- travis_retry cabal update -v
|
||||||
- "sed -i.bak 's/^jobs:/-- jobs:/' ${HOME}/.cabal/config"
|
- "sed -i.bak 's/^jobs:/-- jobs:/' ${HOME}/.cabal/config"
|
||||||
- rm -fv cabal.project cabal.project.local
|
- rm -fv cabal.project cabal.project.local
|
||||||
- "if [ $HCNUMVER -ge 70800 ]; then sed -i.bak 's/-- ghc-options:.*/ghc-options: -j2/' ${HOME}/.cabal/config; fi"
|
- "if [ $HCNUMVER -ge 70800 ]; then sed -i.bak 's/-- ghc-options:.*/ghc-options: -j2/' ${HOME}/.cabal/config; fi"
|
||||||
- grep -Ev -- '^\s*--' ${HOME}/.cabal/config | grep -Ev '^\s*$'
|
- grep -Ev -- '^\s*--' ${HOME}/.cabal/config | grep -Ev '^\s*$'
|
||||||
- "printf 'packages: \"servant\" \"servant-client\" \"servant-client-core\" \"servant-docs\" \"servant-foreign\" \"servant-server\" \"doc/tutorial\" \"doc/cookbook/db-postgres-pool\" \"doc/cookbook/jwt-and-basic-auth\" \"doc/cookbook/db-sqlite-simple\" \"doc/cookbook/basic-auth\" \"doc/cookbook/https\" \"doc/cookbook/structuring-apis\" \"doc/cookbook/using-custom-monad\" \"doc/cookbook/file-upload\"\\n' > cabal.project"
|
- "printf 'packages: \"servant\" \"servant-client\" \"servant-client-core\" \"servant-docs\" \"servant-foreign\" \"servant-server\" \"doc/tutorial\" \"doc/cookbook/basic-auth\" \"doc/cookbook/db-postgres-pool\" \"doc/cookbook/db-sqlite-simple\" \"doc/cookbook/https\" \"doc/cookbook/pagination\" \"doc/cookbook/structuring-apis\" \"doc/cookbook/using-custom-monad\"\\n' > cabal.project"
|
||||||
- "echo 'constraints: foundation >=0.0.14,memory <0.14.12 || >0.14.12' >> cabal.project"
|
- "echo 'constraints: foundation >=0.0.14,memory <0.14.12 || >0.14.12' >> cabal.project"
|
||||||
- "echo 'allow-newer: servant-js:servant,servant-js:servant-foreign,servant-auth-server:http-types,servant-multipart:lens,servant-multipart:resourcet,servant-multipart:servant,servant-multipart:servant-server,servant-auth-server:servant-server' >> cabal.project"
|
- "echo 'allow-newer: servant-auth-server:http-types,servant-auth-server:servant-server, http-media:base' >> cabal.project"
|
||||||
- cat cabal.project
|
- cat cabal.project
|
||||||
- if [ -f "servant/configure.ac" ]; then
|
- if [ -f "servant/configure.ac" ]; then
|
||||||
(cd "servant" && autoreconf -i);
|
(cd "servant" && autoreconf -i);
|
||||||
|
|
@ -95,32 +108,29 @@ install:
|
||||||
- if [ -f "doc/tutorial/configure.ac" ]; then
|
- if [ -f "doc/tutorial/configure.ac" ]; then
|
||||||
(cd "doc/tutorial" && autoreconf -i);
|
(cd "doc/tutorial" && autoreconf -i);
|
||||||
fi
|
fi
|
||||||
|
- if [ -f "doc/cookbook/basic-auth/configure.ac" ]; then
|
||||||
|
(cd "doc/cookbook/basic-auth" && autoreconf -i);
|
||||||
|
fi
|
||||||
- if [ -f "doc/cookbook/db-postgres-pool/configure.ac" ]; then
|
- if [ -f "doc/cookbook/db-postgres-pool/configure.ac" ]; then
|
||||||
(cd "doc/cookbook/db-postgres-pool" && autoreconf -i);
|
(cd "doc/cookbook/db-postgres-pool" && autoreconf -i);
|
||||||
fi
|
fi
|
||||||
- if [ -f "doc/cookbook/jwt-and-basic-auth/configure.ac" ]; then
|
|
||||||
(cd "doc/cookbook/jwt-and-basic-auth" && autoreconf -i);
|
|
||||||
fi
|
|
||||||
- if [ -f "doc/cookbook/db-sqlite-simple/configure.ac" ]; then
|
- if [ -f "doc/cookbook/db-sqlite-simple/configure.ac" ]; then
|
||||||
(cd "doc/cookbook/db-sqlite-simple" && autoreconf -i);
|
(cd "doc/cookbook/db-sqlite-simple" && autoreconf -i);
|
||||||
fi
|
fi
|
||||||
- if [ -f "doc/cookbook/basic-auth/configure.ac" ]; then
|
|
||||||
(cd "doc/cookbook/basic-auth" && autoreconf -i);
|
|
||||||
fi
|
|
||||||
- if [ -f "doc/cookbook/https/configure.ac" ]; then
|
- if [ -f "doc/cookbook/https/configure.ac" ]; then
|
||||||
(cd "doc/cookbook/https" && autoreconf -i);
|
(cd "doc/cookbook/https" && autoreconf -i);
|
||||||
fi
|
fi
|
||||||
|
- if [ -f "doc/cookbook/pagination/configure.ac" ]; then
|
||||||
|
(cd "doc/cookbook/pagination" && autoreconf -i);
|
||||||
|
fi
|
||||||
- if [ -f "doc/cookbook/structuring-apis/configure.ac" ]; then
|
- if [ -f "doc/cookbook/structuring-apis/configure.ac" ]; then
|
||||||
(cd "doc/cookbook/structuring-apis" && autoreconf -i);
|
(cd "doc/cookbook/structuring-apis" && autoreconf -i);
|
||||||
fi
|
fi
|
||||||
- if [ -f "doc/cookbook/using-custom-monad/configure.ac" ]; then
|
- if [ -f "doc/cookbook/using-custom-monad/configure.ac" ]; then
|
||||||
(cd "doc/cookbook/using-custom-monad" && autoreconf -i);
|
(cd "doc/cookbook/using-custom-monad" && autoreconf -i);
|
||||||
fi
|
fi
|
||||||
- if [ -f "doc/cookbook/file-upload/configure.ac" ]; then
|
|
||||||
(cd "doc/cookbook/file-upload" && autoreconf -i);
|
|
||||||
fi
|
|
||||||
- rm -f cabal.project.freeze
|
- rm -f cabal.project.freeze
|
||||||
- rm -rf .ghc.environment.* "servant"/dist "servant-client"/dist "servant-client-core"/dist "servant-docs"/dist "servant-foreign"/dist "servant-server"/dist "doc/tutorial"/dist "doc/cookbook/db-postgres-pool"/dist "doc/cookbook/jwt-and-basic-auth"/dist "doc/cookbook/db-sqlite-simple"/dist "doc/cookbook/basic-auth"/dist "doc/cookbook/https"/dist "doc/cookbook/structuring-apis"/dist "doc/cookbook/using-custom-monad"/dist "doc/cookbook/file-upload"/dist
|
- rm -rf .ghc.environment.* "servant"/dist "servant-client"/dist "servant-client-core"/dist "servant-docs"/dist "servant-foreign"/dist "servant-server"/dist "doc/tutorial"/dist "doc/cookbook/basic-auth"/dist "doc/cookbook/db-postgres-pool"/dist "doc/cookbook/db-sqlite-simple"/dist "doc/cookbook/https"/dist "doc/cookbook/pagination"/dist "doc/cookbook/structuring-apis"/dist "doc/cookbook/using-custom-monad"/dist
|
||||||
- DISTDIR=$(mktemp -d /tmp/dist-test.XXXX)
|
- DISTDIR=$(mktemp -d /tmp/dist-test.XXXX)
|
||||||
|
|
||||||
# Here starts the actual work to be performed for the package under test;
|
# Here starts the actual work to be performed for the package under test;
|
||||||
|
|
@ -135,37 +145,36 @@ script:
|
||||||
- (cd "servant-foreign" && cabal sdist)
|
- (cd "servant-foreign" && cabal sdist)
|
||||||
- (cd "servant-server" && cabal sdist)
|
- (cd "servant-server" && cabal sdist)
|
||||||
- (cd "doc/tutorial" && cabal sdist)
|
- (cd "doc/tutorial" && cabal sdist)
|
||||||
- (cd "doc/cookbook/db-postgres-pool" && cabal sdist)
|
|
||||||
- (cd "doc/cookbook/jwt-and-basic-auth" && cabal sdist)
|
|
||||||
- (cd "doc/cookbook/db-sqlite-simple" && cabal sdist)
|
|
||||||
- (cd "doc/cookbook/basic-auth" && cabal sdist)
|
- (cd "doc/cookbook/basic-auth" && cabal sdist)
|
||||||
|
- (cd "doc/cookbook/db-postgres-pool" && cabal sdist)
|
||||||
|
- (cd "doc/cookbook/db-sqlite-simple" && cabal sdist)
|
||||||
- (cd "doc/cookbook/https" && cabal sdist)
|
- (cd "doc/cookbook/https" && cabal sdist)
|
||||||
|
- (cd "doc/cookbook/pagination" && cabal sdist)
|
||||||
- (cd "doc/cookbook/structuring-apis" && cabal sdist)
|
- (cd "doc/cookbook/structuring-apis" && cabal sdist)
|
||||||
- (cd "doc/cookbook/using-custom-monad" && cabal sdist)
|
- (cd "doc/cookbook/using-custom-monad" && cabal sdist)
|
||||||
- (cd "doc/cookbook/file-upload" && cabal sdist)
|
|
||||||
- echo -en 'travis_fold:end:sdist\\r'
|
- echo -en 'travis_fold:end:sdist\\r'
|
||||||
- echo Unpacking... && echo -en 'travis_fold:start:unpack\\r'
|
- echo Unpacking... && echo -en 'travis_fold:start:unpack\\r'
|
||||||
- mv "servant"/dist/servant-*.tar.gz "servant-client"/dist/servant-client-*.tar.gz "servant-client-core"/dist/servant-client-core-*.tar.gz "servant-docs"/dist/servant-docs-*.tar.gz "servant-foreign"/dist/servant-foreign-*.tar.gz "servant-server"/dist/servant-server-*.tar.gz "doc/tutorial"/dist/tutorial-*.tar.gz "doc/cookbook/db-postgres-pool"/dist/cookbook-db-postgres-pool-*.tar.gz "doc/cookbook/jwt-and-basic-auth"/dist/cookbook-jwt-and-basic-auth-*.tar.gz "doc/cookbook/db-sqlite-simple"/dist/cookbook-db-sqlite-simple-*.tar.gz "doc/cookbook/basic-auth"/dist/cookbook-basic-auth-*.tar.gz "doc/cookbook/https"/dist/cookbook-https-*.tar.gz "doc/cookbook/structuring-apis"/dist/cookbook-structuring-apis-*.tar.gz "doc/cookbook/using-custom-monad"/dist/cookbook-using-custom-monad-*.tar.gz "doc/cookbook/file-upload"/dist/cookbook-file-upload-*.tar.gz ${DISTDIR}/
|
- mv "servant"/dist/servant-*.tar.gz "servant-client"/dist/servant-client-*.tar.gz "servant-client-core"/dist/servant-client-core-*.tar.gz "servant-docs"/dist/servant-docs-*.tar.gz "servant-foreign"/dist/servant-foreign-*.tar.gz "servant-server"/dist/servant-server-*.tar.gz "doc/tutorial"/dist/tutorial-*.tar.gz "doc/cookbook/basic-auth"/dist/cookbook-basic-auth-*.tar.gz "doc/cookbook/db-postgres-pool"/dist/cookbook-db-postgres-pool-*.tar.gz "doc/cookbook/db-sqlite-simple"/dist/cookbook-db-sqlite-simple-*.tar.gz "doc/cookbook/https"/dist/cookbook-https-*.tar.gz "doc/cookbook/pagination"/dist/cookbook-pagination-*.tar.gz "doc/cookbook/structuring-apis"/dist/cookbook-structuring-apis-*.tar.gz "doc/cookbook/using-custom-monad"/dist/cookbook-using-custom-monad-*.tar.gz ${DISTDIR}/
|
||||||
- cd ${DISTDIR} || false
|
- cd ${DISTDIR} || false
|
||||||
- find . -maxdepth 1 -name '*.tar.gz' -exec tar -xvf '{}' \;
|
- find . -maxdepth 1 -name '*.tar.gz' -exec tar -xvf '{}' \;
|
||||||
- "printf 'packages: servant-*/*.cabal servant-client-*/*.cabal servant-client-core-*/*.cabal servant-docs-*/*.cabal servant-foreign-*/*.cabal servant-server-*/*.cabal tutorial-*/*.cabal cookbook-db-postgres-pool-*/*.cabal cookbook-jwt-and-basic-auth-*/*.cabal cookbook-db-sqlite-simple-*/*.cabal cookbook-basic-auth-*/*.cabal cookbook-https-*/*.cabal cookbook-structuring-apis-*/*.cabal cookbook-using-custom-monad-*/*.cabal cookbook-file-upload-*/*.cabal\\n' > cabal.project"
|
- "printf 'packages: servant-*/*.cabal servant-client-*/*.cabal servant-client-core-*/*.cabal servant-docs-*/*.cabal servant-foreign-*/*.cabal servant-server-*/*.cabal tutorial-*/*.cabal cookbook-basic-auth-*/*.cabal cookbook-db-postgres-pool-*/*.cabal cookbook-db-sqlite-simple-*/*.cabal cookbook-https-*/*.cabal cookbook-pagination-*/*.cabal cookbook-structuring-apis-*/*.cabal cookbook-using-custom-monad-*/*.cabal\\n' > cabal.project"
|
||||||
- "echo 'constraints: foundation >=0.0.14,memory <0.14.12 || >0.14.12' >> cabal.project"
|
- "echo 'constraints: foundation >=0.0.14,memory <0.14.12 || >0.14.12' >> cabal.project"
|
||||||
- "echo 'allow-newer: servant-js:servant,servant-js:servant-foreign,servant-auth-server:http-types,servant-multipart:lens,servant-multipart:resourcet,servant-multipart:servant,servant-multipart:servant-server,servant-auth-server:servant-server' >> cabal.project"
|
- "echo 'allow-newer: servant-auth-server:http-types,servant-auth-server:servant-server, http-media:base' >> cabal.project"
|
||||||
- cat cabal.project
|
- cat cabal.project
|
||||||
- echo -en 'travis_fold:end:unpack\\r'
|
- echo -en 'travis_fold:end:unpack\\r'
|
||||||
|
|
||||||
|
|
||||||
- echo Building with tests and benchmarks... && echo -en 'travis_fold:start:build-everything\\r'
|
- echo Building with tests and benchmarks... && echo -en 'travis_fold:start:build-everything\\r'
|
||||||
# build & run tests, build benchmarks
|
# build & run tests, build benchmarks
|
||||||
- cabal new-build -w ${HC} ${TEST} ${BENCH} ${CABALNEWBUILDOPTS} all
|
- cabal new-build -w ${HC} ${TEST} ${BENCH} all
|
||||||
- echo -en 'travis_fold:end:build-everything\\r'
|
- echo -en 'travis_fold:end:build-everything\\r'
|
||||||
- if [ "x$TEST" = "x--enable-tests" ]; then cabal new-test -w ${HC} ${TEST} ${BENCH} ${CABALNEWBUILDOPTS} all; fi
|
- if [ "x$TEST" = "x--enable-tests" ]; then cabal new-test -w ${HC} ${TEST} ${BENCH} all; fi
|
||||||
|
|
||||||
- echo Haddock... && echo -en 'travis_fold:start:haddock\\r'
|
- echo Haddock... && echo -en 'travis_fold:start:haddock\\r'
|
||||||
# haddock
|
# haddock
|
||||||
- rm -rf ./dist-newstyle
|
- rm -rf ./dist-newstyle
|
||||||
- if $HADDOCK; then cabal new-haddock -w ${HC} ${TEST} ${BENCH} ${CABALNEWBUILDOPTS} all; else echo "Skipping haddock generation";fi
|
- if $HADDOCK; then cabal new-haddock -w ${HC} ${TEST} ${BENCH} all; else echo "Skipping haddock generation";fi
|
||||||
|
|
||||||
- echo -en 'travis_fold:end:haddock\\r'
|
- echo -en 'travis_fold:end:haddock\\r'
|
||||||
# REGENDATA ["--config=cabal.make-travis-yml","--output=.travis.yml","--max-backjumps=10000","cabal.project"]
|
# REGENDATA ["--config=cabal.make-travis-yml","--output=.travis.yml","cabal.project"]
|
||||||
# EOF
|
# EOF
|
||||||
|
|
|
||||||
|
|
@ -5,19 +5,29 @@ packages: servant/
|
||||||
servant-foreign/
|
servant-foreign/
|
||||||
servant-server/
|
servant-server/
|
||||||
doc/tutorial/
|
doc/tutorial/
|
||||||
doc/cookbook/*/*.cabal
|
|
||||||
|
-- doc/cookbook/*/*.cabal
|
||||||
|
|
||||||
|
doc/cookbook/basic-auth
|
||||||
|
doc/cookbook/db-postgres-pool
|
||||||
|
doc/cookbook/db-sqlite-simple
|
||||||
|
-- MkLink changed
|
||||||
|
-- doc/cookbook/file-upload
|
||||||
|
doc/cookbook/https
|
||||||
|
-- servant-auth-* doesn't support GHC-8.4
|
||||||
|
-- doc/cookbook/jwt-and-basic-auth
|
||||||
|
doc/cookbook/pagination
|
||||||
|
doc/cookbook/structuring-apis
|
||||||
|
doc/cookbook/using-custom-monad
|
||||||
|
|
||||||
allow-newer:
|
allow-newer:
|
||||||
servant-js:servant,
|
|
||||||
servant-js:servant-foreign,
|
|
||||||
servant-auth-server:http-types,
|
servant-auth-server:http-types,
|
||||||
servant-multipart:lens,
|
|
||||||
servant-multipart:resourcet,
|
|
||||||
servant-multipart:servant,
|
|
||||||
servant-multipart:servant-server,
|
|
||||||
servant-auth-server:servant-server
|
servant-auth-server:servant-server
|
||||||
|
|
||||||
constraints:
|
constraints:
|
||||||
-- see https://github.com/haskell-infra/hackage-trustees/issues/119
|
-- see https://github.com/haskell-infra/hackage-trustees/issues/119
|
||||||
foundation >=0.0.14,
|
foundation >=0.0.14,
|
||||||
memory <0.14.12 || >0.14.12
|
memory <0.14.12 || >0.14.12
|
||||||
|
|
||||||
|
allow-newer:
|
||||||
|
http-media:base
|
||||||
|
|
|
||||||
|
|
@ -8,7 +8,7 @@ author: Servant Contributors
|
||||||
maintainer: haskell-servant-maintainers@googlegroups.com
|
maintainer: haskell-servant-maintainers@googlegroups.com
|
||||||
build-type: Simple
|
build-type: Simple
|
||||||
cabal-version: >=1.10
|
cabal-version: >=1.10
|
||||||
tested-with: GHC==7.8.4, GHC==7.10.3, GHC==8.0.2, GHC==8.2.2
|
tested-with: GHC==7.8.4, GHC==7.10.3, GHC==8.0.2, GHC==8.2.2, GHC==8.4.3
|
||||||
|
|
||||||
executable cookbook-basic-auth
|
executable cookbook-basic-auth
|
||||||
main-is: BasicAuth.lhs
|
main-is: BasicAuth.lhs
|
||||||
|
|
|
||||||
|
|
@ -8,7 +8,7 @@ author: Servant Contributors
|
||||||
maintainer: haskell-servant-maintainers@googlegroups.com
|
maintainer: haskell-servant-maintainers@googlegroups.com
|
||||||
build-type: Simple
|
build-type: Simple
|
||||||
cabal-version: >=1.10
|
cabal-version: >=1.10
|
||||||
tested-with: GHC==7.8.4, GHC==7.10.3, GHC==8.0.2, GHC==8.2.2
|
tested-with: GHC==7.8.4, GHC==7.10.3, GHC==8.0.2, GHC==8.2.2, GHC==8.4.3
|
||||||
|
|
||||||
executable cookbook-db-postgres-pool
|
executable cookbook-db-postgres-pool
|
||||||
main-is: PostgresPool.lhs
|
main-is: PostgresPool.lhs
|
||||||
|
|
|
||||||
|
|
@ -8,7 +8,7 @@ author: Servant Contributors
|
||||||
maintainer: haskell-servant-maintainers@googlegroups.com
|
maintainer: haskell-servant-maintainers@googlegroups.com
|
||||||
build-type: Simple
|
build-type: Simple
|
||||||
cabal-version: >=1.10
|
cabal-version: >=1.10
|
||||||
tested-with: GHC==7.8.4, GHC==7.10.3, GHC==8.0.2, GHC==8.2.2
|
tested-with: GHC==7.8.4, GHC==7.10.3, GHC==8.0.2, GHC==8.2.2, GHC==8.4.3
|
||||||
|
|
||||||
executable cookbook-db-sqlite-simple
|
executable cookbook-db-sqlite-simple
|
||||||
main-is: DBConnection.lhs
|
main-is: DBConnection.lhs
|
||||||
|
|
|
||||||
|
|
@ -8,7 +8,7 @@ author: Servant Contributors
|
||||||
maintainer: haskell-servant-maintainers@googlegroups.com
|
maintainer: haskell-servant-maintainers@googlegroups.com
|
||||||
build-type: Simple
|
build-type: Simple
|
||||||
cabal-version: >=1.10
|
cabal-version: >=1.10
|
||||||
tested-with: GHC==7.8.4, GHC==7.10.3, GHC==8.0.2, GHC==8.2.2
|
tested-with: GHC==7.8.4, GHC==7.10.3, GHC==8.0.2, GHC==8.2.2, GHC==8.4.3
|
||||||
|
|
||||||
executable cookbook-file-upload
|
executable cookbook-file-upload
|
||||||
main-is: FileUpload.lhs
|
main-is: FileUpload.lhs
|
||||||
|
|
|
||||||
|
|
@ -8,7 +8,7 @@ author: Servant Contributors
|
||||||
maintainer: haskell-servant-maintainers@googlegroups.com
|
maintainer: haskell-servant-maintainers@googlegroups.com
|
||||||
build-type: Simple
|
build-type: Simple
|
||||||
cabal-version: >=1.10
|
cabal-version: >=1.10
|
||||||
tested-with: GHC==7.8.4, GHC==7.10.3, GHC==8.0.2, GHC==8.2.2
|
tested-with: GHC==7.8.4, GHC==7.10.3, GHC==8.0.2, GHC==8.2.2, GHC==8.4.3
|
||||||
|
|
||||||
executable cookbook-https
|
executable cookbook-https
|
||||||
main-is: Https.lhs
|
main-is: Https.lhs
|
||||||
|
|
|
||||||
|
|
@ -11,7 +11,7 @@ maintainer: haskell-servant-maintainers@googlegroups.com
|
||||||
category: Servant
|
category: Servant
|
||||||
build-type: Simple
|
build-type: Simple
|
||||||
cabal-version: >=1.10
|
cabal-version: >=1.10
|
||||||
tested-with: GHC==7.8.4, GHC==7.10.3, GHC==8.0.2, GHC==8.2.2
|
tested-with: GHC==7.8.4, GHC==7.10.3, GHC==8.0.2, GHC==8.2.2, GHC==8.4.3
|
||||||
|
|
||||||
executable cookbook-jwt-and-basic-auth
|
executable cookbook-jwt-and-basic-auth
|
||||||
if !impl(ghc >= 7.10)
|
if !impl(ghc >= 7.10)
|
||||||
|
|
|
||||||
5
doc/cookbook/pagination/dummy/Pagination.lhs
Normal file
5
doc/cookbook/pagination/dummy/Pagination.lhs
Normal file
|
|
@ -0,0 +1,5 @@
|
||||||
|
```haskell
|
||||||
|
module Main (main) where
|
||||||
|
main :: IO ()
|
||||||
|
main = return ()
|
||||||
|
```
|
||||||
|
|
@ -8,17 +8,25 @@ author: Servant Contributors
|
||||||
maintainer: haskell-servant-maintainers@googlegroups.com
|
maintainer: haskell-servant-maintainers@googlegroups.com
|
||||||
build-type: Simple
|
build-type: Simple
|
||||||
cabal-version: >=1.10
|
cabal-version: >=1.10
|
||||||
|
extra-source-files:
|
||||||
|
Pagination.lhs
|
||||||
|
dummy/Pagination.lhs
|
||||||
|
tested-with: GHC==7.8.4, GHC==7.10.3, GHC==8.0.2, GHC==8.2.2, GHC==8.4.3
|
||||||
|
|
||||||
executable cookbook-pagination
|
executable cookbook-pagination
|
||||||
if impl(ghc < 7.10.1)
|
|
||||||
buildable: False
|
|
||||||
main-is: Pagination.lhs
|
main-is: Pagination.lhs
|
||||||
build-depends: base == 4.*
|
build-tool-depends: markdown-unlit:markdown-unlit
|
||||||
|
default-language: Haskell2010
|
||||||
|
ghc-options: -Wall -pgmL markdown-unlit
|
||||||
|
|
||||||
|
if impl(ghc >= 8.0)
|
||||||
|
hs-source-dirs: .
|
||||||
|
build-depends: base >= 4.8 && <4.12
|
||||||
, aeson
|
, aeson
|
||||||
, servant
|
, servant
|
||||||
, servant-server
|
, servant-server
|
||||||
, servant-pagination >= 2.1.0 && < 3.0.0
|
, servant-pagination >= 2.1.0 && < 3.0.0
|
||||||
, warp
|
, warp
|
||||||
default-language: Haskell2010
|
else
|
||||||
ghc-options: -Wall -pgmL markdown-unlit
|
hs-source-dirs: dummy
|
||||||
build-tool-depends: markdown-unlit:markdown-unlit
|
build-depends: base
|
||||||
|
|
|
||||||
|
|
@ -8,7 +8,7 @@ author: Servant Contributors
|
||||||
maintainer: haskell-servant-maintainers@googlegroups.com
|
maintainer: haskell-servant-maintainers@googlegroups.com
|
||||||
build-type: Simple
|
build-type: Simple
|
||||||
cabal-version: >=1.10
|
cabal-version: >=1.10
|
||||||
tested-with: GHC==7.8.4, GHC==7.10.3, GHC==8.0.2, GHC==8.2.2
|
tested-with: GHC==7.8.4, GHC==7.10.3, GHC==8.0.2, GHC==8.2.2, GHC==8.4.3
|
||||||
|
|
||||||
executable cookbook-structuring-apis
|
executable cookbook-structuring-apis
|
||||||
main-is: StructuringApis.lhs
|
main-is: StructuringApis.lhs
|
||||||
|
|
|
||||||
|
|
@ -8,7 +8,7 @@ author: Servant Contributors
|
||||||
maintainer: haskell-servant-maintainers@googlegroups.com
|
maintainer: haskell-servant-maintainers@googlegroups.com
|
||||||
build-type: Simple
|
build-type: Simple
|
||||||
cabal-version: >=1.10
|
cabal-version: >=1.10
|
||||||
tested-with: GHC==7.8.4, GHC==7.10.3, GHC==8.0.2, GHC==8.2.2
|
tested-with: GHC==7.8.4, GHC==7.10.3, GHC==8.0.2, GHC==8.2.2, GHC==8.4.3
|
||||||
|
|
||||||
executable cookbook-using-custom-monad
|
executable cookbook-using-custom-monad
|
||||||
main-is: UsingCustomMonad.lhs
|
main-is: UsingCustomMonad.lhs
|
||||||
|
|
|
||||||
|
|
@ -6,6 +6,11 @@
|
||||||
including a test-suite using [**hspec**](http://hspec.github.io/) and
|
including a test-suite using [**hspec**](http://hspec.github.io/) and
|
||||||
**servant-client**.
|
**servant-client**.
|
||||||
|
|
||||||
|
- **[servant-examples](https://github.com/sras/servant-examples)**:
|
||||||
|
|
||||||
|
Similar to [the cookbook](https://haskell-servant.readthedocs.io/en/latest/cookbook/index.html) but
|
||||||
|
with no explanations, for developers who just want to look at code examples to find out how to do X or Y
|
||||||
|
with servant.
|
||||||
|
|
||||||
- **[stack-templates](https://github.com/commercialhaskell/stack-templates)**
|
- **[stack-templates](https://github.com/commercialhaskell/stack-templates)**
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -137,7 +137,7 @@ type StreamGet = Stream 'GET
|
||||||
type StreamPost = Stream 'POST
|
type StreamPost = Stream 'POST
|
||||||
```
|
```
|
||||||
|
|
||||||
These describe endpoints that return a stream of values rather than just a single value. They not only take a single content type as a parameter, but also a framing strategy -- this specifies how the individual results are delineated from one another in the stream. The two standard strategies given with Servant are `NewlineFraming` and `NetstringFraming`, but others can be written to match other protocols.
|
These describe endpoints that return a stream of values rather than just a single value. They not only take a single content type as a parameter, but also a framing strategy -- this specifies how the individual results are delineated from one another in the stream. The three standard strategies given with Servant are `NewlineFraming`, `NetstringFraming` and `NoFraming`, but others can be written to match other protocols.
|
||||||
|
|
||||||
|
|
||||||
### `Capture`
|
### `Capture`
|
||||||
|
|
|
||||||
|
|
@ -95,12 +95,6 @@ users1 =
|
||||||
]
|
]
|
||||||
```
|
```
|
||||||
|
|
||||||
Let's also write our API type.
|
|
||||||
|
|
||||||
``` haskell ignore
|
|
||||||
type UserAPI1 = "users" :> Get '[JSON] [User]
|
|
||||||
```
|
|
||||||
|
|
||||||
We can now take care of writing the actual webservice that will handle requests
|
We can now take care of writing the actual webservice that will handle requests
|
||||||
to such an API. This one will be very simple, being reduced to just a single
|
to such an API. This one will be very simple, being reduced to just a single
|
||||||
endpoint. The type of the web application is determined by the API type,
|
endpoint. The type of the web application is determined by the API type,
|
||||||
|
|
|
||||||
|
|
@ -17,6 +17,7 @@ tested-with:
|
||||||
GHC==7.10.3
|
GHC==7.10.3
|
||||||
GHC==8.0.2
|
GHC==8.0.2
|
||||||
GHC==8.2.2
|
GHC==8.2.2
|
||||||
|
GHC==8.4.3
|
||||||
extra-source-files:
|
extra-source-files:
|
||||||
static/index.html
|
static/index.html
|
||||||
static/ui.js
|
static/ui.js
|
||||||
|
|
@ -34,7 +35,7 @@ library
|
||||||
-- Packages `servant` depends on.
|
-- Packages `servant` depends on.
|
||||||
-- We don't need to specify bounds here as this package is never released.
|
-- We don't need to specify bounds here as this package is never released.
|
||||||
build-depends:
|
build-depends:
|
||||||
base >= 4.7 && <4.11
|
base >= 4.7 && <4.12
|
||||||
, aeson
|
, aeson
|
||||||
, aeson-compat
|
, aeson-compat
|
||||||
, attoparsec
|
, attoparsec
|
||||||
|
|
|
||||||
|
|
@ -23,6 +23,7 @@ tested-with:
|
||||||
GHC==7.10.3
|
GHC==7.10.3
|
||||||
GHC==8.0.2
|
GHC==8.0.2
|
||||||
GHC==8.2.2
|
GHC==8.2.2
|
||||||
|
GHC==8.4.3
|
||||||
|
|
||||||
source-repository head
|
source-repository head
|
||||||
type: git
|
type: git
|
||||||
|
|
@ -47,7 +48,7 @@ library
|
||||||
--
|
--
|
||||||
-- note: mtl lower bound is so low because of GHC-7.8
|
-- note: mtl lower bound is so low because of GHC-7.8
|
||||||
build-depends:
|
build-depends:
|
||||||
base >= 4.7 && < 4.11
|
base >= 4.7 && < 4.12
|
||||||
, bytestring >= 0.10.4.0 && < 0.11
|
, bytestring >= 0.10.4.0 && < 0.11
|
||||||
, containers >= 0.5.5.1 && < 0.6
|
, containers >= 0.5.5.1 && < 0.6
|
||||||
, mtl >= 2.1 && < 2.3
|
, mtl >= 2.1 && < 2.3
|
||||||
|
|
|
||||||
|
|
@ -285,9 +285,9 @@ instance OVERLAPPING_
|
||||||
instance OVERLAPPABLE_
|
instance OVERLAPPABLE_
|
||||||
( RunClient m, MimeUnrender ct a, ReflectMethod method,
|
( RunClient m, MimeUnrender ct a, ReflectMethod method,
|
||||||
FramingUnrender framing a, BuildFromStream a (f a)
|
FramingUnrender framing a, BuildFromStream a (f a)
|
||||||
) => HasClient m (Stream method framing ct (f a)) where
|
) => HasClient m (Stream method status framing ct (f a)) where
|
||||||
|
|
||||||
type Client m (Stream method framing ct (f a)) = m (f a)
|
type Client m (Stream method status framing ct (f a)) = m (f a)
|
||||||
|
|
||||||
clientWithRoute _pm Proxy req = do
|
clientWithRoute _pm Proxy req = do
|
||||||
sresp <- streamingRequest req
|
sresp <- streamingRequest req
|
||||||
|
|
|
||||||
|
|
@ -31,7 +31,7 @@ library
|
||||||
Servant.Client.Ghcjs
|
Servant.Client.Ghcjs
|
||||||
Servant.Client.Internal.XhrClient
|
Servant.Client.Internal.XhrClient
|
||||||
build-depends:
|
build-depends:
|
||||||
base >= 4.7 && < 4.11
|
base >= 4.7 && < 4.12
|
||||||
, bytestring >= 0.10 && < 0.11
|
, bytestring >= 0.10 && < 0.11
|
||||||
, case-insensitive >= 1.2.0.0 && < 1.3.0.0
|
, case-insensitive >= 1.2.0.0 && < 1.3.0.0
|
||||||
, containers >= 0.5 && < 0.6
|
, containers >= 0.5 && < 0.6
|
||||||
|
|
|
||||||
|
|
@ -21,6 +21,7 @@ tested-with:
|
||||||
GHC==7.10.3
|
GHC==7.10.3
|
||||||
GHC==8.0.2
|
GHC==8.0.2
|
||||||
GHC==8.2.2
|
GHC==8.2.2
|
||||||
|
GHC==8.4.3
|
||||||
homepage: http://haskell-servant.readthedocs.org/
|
homepage: http://haskell-servant.readthedocs.org/
|
||||||
Bug-reports: http://github.com/haskell-servant/servant/issues
|
Bug-reports: http://github.com/haskell-servant/servant/issues
|
||||||
extra-source-files:
|
extra-source-files:
|
||||||
|
|
@ -41,7 +42,7 @@ library
|
||||||
--
|
--
|
||||||
-- note: mtl lower bound is so low because of GHC-7.8
|
-- note: mtl lower bound is so low because of GHC-7.8
|
||||||
build-depends:
|
build-depends:
|
||||||
base >= 4.7 && < 4.11
|
base >= 4.7 && < 4.12
|
||||||
, bytestring >= 0.10.4.0 && < 0.11
|
, bytestring >= 0.10.4.0 && < 0.11
|
||||||
, containers >= 0.5.5.1 && < 0.6
|
, containers >= 0.5.5.1 && < 0.6
|
||||||
, mtl >= 2.1 && < 2.3
|
, mtl >= 2.1 && < 2.3
|
||||||
|
|
@ -121,7 +122,7 @@ test-suite spec
|
||||||
, hspec >= 2.4.4 && < 2.6
|
, hspec >= 2.4.4 && < 2.6
|
||||||
, HUnit >= 1.6 && < 1.7
|
, HUnit >= 1.6 && < 1.7
|
||||||
, random-bytestring >= 0.1 && < 0.2
|
, random-bytestring >= 0.1 && < 0.2
|
||||||
, network >= 2.6.3.2 && < 2.7
|
, network >= 2.6.3.2 && < 2.8
|
||||||
, QuickCheck >= 2.10.1 && < 2.12
|
, QuickCheck >= 2.10.1 && < 2.12
|
||||||
, servant == 0.13.*
|
, servant == 0.13.*
|
||||||
, servant-server == 0.13.*
|
, servant-server == 0.13.*
|
||||||
|
|
|
||||||
|
|
@ -29,7 +29,6 @@ module Servant.StreamSpec (spec) where
|
||||||
import Control.Monad (replicateM_, void)
|
import Control.Monad (replicateM_, void)
|
||||||
import qualified Data.ByteString as BS
|
import qualified Data.ByteString as BS
|
||||||
import Data.Proxy
|
import Data.Proxy
|
||||||
import GHC.Stats (currentBytesUsed, getGCStats)
|
|
||||||
import qualified Network.HTTP.Client as C
|
import qualified Network.HTTP.Client as C
|
||||||
import Prelude ()
|
import Prelude ()
|
||||||
import Prelude.Compat
|
import Prelude.Compat
|
||||||
|
|
@ -41,12 +40,18 @@ import Test.QuickCheck
|
||||||
import Servant.API ((:<|>) ((:<|>)), (:>), JSON,
|
import Servant.API ((:<|>) ((:<|>)), (:>), JSON,
|
||||||
NetstringFraming, NewlineFraming,
|
NetstringFraming, NewlineFraming,
|
||||||
OctetStream, ResultStream (..),
|
OctetStream, ResultStream (..),
|
||||||
StreamGenerator (..), StreamGet)
|
StreamGenerator (..), StreamGet,
|
||||||
|
NoFraming)
|
||||||
import Servant.Client
|
import Servant.Client
|
||||||
import Servant.ClientSpec (Person (..))
|
import Servant.ClientSpec (Person (..))
|
||||||
import qualified Servant.ClientSpec as CS
|
import qualified Servant.ClientSpec as CS
|
||||||
import Servant.Server
|
import Servant.Server
|
||||||
|
|
||||||
|
#if MIN_VERSION_base(4,10,0)
|
||||||
|
import GHC.Stats (gcdetails_mem_in_use_bytes, gc, getRTSStats)
|
||||||
|
#else
|
||||||
|
import GHC.Stats (currentBytesUsed, getGCStats)
|
||||||
|
#endif
|
||||||
|
|
||||||
spec :: Spec
|
spec :: Spec
|
||||||
spec = describe "Servant.Stream" $ do
|
spec = describe "Servant.Stream" $ do
|
||||||
|
|
@ -55,7 +60,7 @@ spec = describe "Servant.Stream" $ do
|
||||||
type StreamApi f =
|
type StreamApi f =
|
||||||
"streamGetNewline" :> StreamGet NewlineFraming JSON (f Person)
|
"streamGetNewline" :> StreamGet NewlineFraming JSON (f Person)
|
||||||
:<|> "streamGetNetstring" :> StreamGet NetstringFraming JSON (f Person)
|
:<|> "streamGetNetstring" :> StreamGet NetstringFraming JSON (f Person)
|
||||||
:<|> "streamALot" :> StreamGet NewlineFraming OctetStream (f BS.ByteString)
|
:<|> "streamALot" :> StreamGet NoFraming OctetStream (f BS.ByteString)
|
||||||
|
|
||||||
|
|
||||||
capi :: Proxy (StreamApi ResultStream)
|
capi :: Proxy (StreamApi ResultStream)
|
||||||
|
|
@ -81,16 +86,16 @@ server = serve sapi
|
||||||
:<|> return (StreamGenerator lotsGenerator)
|
:<|> return (StreamGenerator lotsGenerator)
|
||||||
where
|
where
|
||||||
lotsGenerator f r = do
|
lotsGenerator f r = do
|
||||||
f ""
|
void $ f ""
|
||||||
withFile "/dev/urandom" ReadMode $
|
void $ withFile "/dev/urandom" ReadMode $
|
||||||
\handle -> streamFiveMBNTimes handle 1000 r
|
\handle -> streamFiveMBNTimes handle 1000 r
|
||||||
return ()
|
return ()
|
||||||
|
|
||||||
streamFiveMBNTimes handle left sink
|
streamFiveMBNTimes handle left sink
|
||||||
| left <= 0 = return ""
|
| left <= (0 :: Int) = return ()
|
||||||
| otherwise = do
|
| otherwise = do
|
||||||
msg <- BS.hGet handle (megabytes 5)
|
msg <- BS.hGet handle (megabytes 5)
|
||||||
sink msg
|
_ <- sink msg
|
||||||
streamFiveMBNTimes handle (left - 1) sink
|
streamFiveMBNTimes handle (left - 1) sink
|
||||||
|
|
||||||
|
|
||||||
|
|
@ -129,8 +134,12 @@ streamSpec = beforeAll (CS.startWaiApp server) $ afterAll CS.endWaiApp $ do
|
||||||
Right (ResultStream res) <- runClient getGetALot baseUrl
|
Right (ResultStream res) <- runClient getGetALot baseUrl
|
||||||
let consumeNChunks n = replicateM_ n (res void)
|
let consumeNChunks n = replicateM_ n (res void)
|
||||||
consumeNChunks 900
|
consumeNChunks 900
|
||||||
|
#if MIN_VERSION_base(4,10,0)
|
||||||
|
memUsed <- gcdetails_mem_in_use_bytes . gc <$> getRTSStats
|
||||||
|
#else
|
||||||
memUsed <- currentBytesUsed <$> getGCStats
|
memUsed <- currentBytesUsed <$> getGCStats
|
||||||
memUsed `shouldSatisfy` (< (megabytes 20))
|
#endif
|
||||||
|
memUsed `shouldSatisfy` (< megabytes 22)
|
||||||
|
|
||||||
megabytes :: Num a => a -> a
|
megabytes :: Num a => a -> a
|
||||||
megabytes n = n * (1000 ^ 2)
|
megabytes n = n * (1000 ^ (2 :: Int))
|
||||||
|
|
|
||||||
|
|
@ -21,6 +21,7 @@ tested-with:
|
||||||
GHC==7.10.3
|
GHC==7.10.3
|
||||||
GHC==8.0.2
|
GHC==8.0.2
|
||||||
GHC==8.2.2
|
GHC==8.2.2
|
||||||
|
GHC==8.4.3
|
||||||
homepage: http://haskell-servant.readthedocs.org/
|
homepage: http://haskell-servant.readthedocs.org/
|
||||||
Bug-reports: http://github.com/haskell-servant/servant/issues
|
Bug-reports: http://github.com/haskell-servant/servant/issues
|
||||||
extra-source-files:
|
extra-source-files:
|
||||||
|
|
@ -42,7 +43,7 @@ library
|
||||||
--
|
--
|
||||||
-- note: mtl lower bound is so low because of GHC-7.8
|
-- note: mtl lower bound is so low because of GHC-7.8
|
||||||
build-depends:
|
build-depends:
|
||||||
base >= 4.7 && < 4.11
|
base >= 4.7 && < 4.12
|
||||||
, bytestring >= 0.10.4.0 && < 0.11
|
, bytestring >= 0.10.4.0 && < 0.11
|
||||||
, text >= 1.2.3.0 && < 1.3
|
, text >= 1.2.3.0 && < 1.3
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -1,6 +1,11 @@
|
||||||
[The latest version of this document is on GitHub.](https://github.com/haskell-servant/servant/blob/master/servant-foreign/CHANGELOG.md)
|
[The latest version of this document is on GitHub.](https://github.com/haskell-servant/servant/blob/master/servant-foreign/CHANGELOG.md)
|
||||||
[Changelog for `servant` package contains significant entries for all core packages.](https://github.com/haskell-servant/servant/blob/master/servant/CHANGELOG.md)
|
[Changelog for `servant` package contains significant entries for all core packages.](https://github.com/haskell-servant/servant/blob/master/servant/CHANGELOG.md)
|
||||||
|
|
||||||
|
0.11.1
|
||||||
|
------
|
||||||
|
|
||||||
|
- Add missing `Semigroup` instances
|
||||||
|
|
||||||
0.11
|
0.11
|
||||||
----
|
----
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -27,6 +27,7 @@ tested-with:
|
||||||
GHC==7.10.3
|
GHC==7.10.3
|
||||||
GHC==8.0.2
|
GHC==8.0.2
|
||||||
GHC==8.2.2
|
GHC==8.2.2
|
||||||
|
GHC==8.4.3
|
||||||
|
|
||||||
source-repository head
|
source-repository head
|
||||||
type: git
|
type: git
|
||||||
|
|
@ -42,9 +43,13 @@ library
|
||||||
--
|
--
|
||||||
-- note: mtl lower bound is so low because of GHC-7.8
|
-- note: mtl lower bound is so low because of GHC-7.8
|
||||||
build-depends:
|
build-depends:
|
||||||
base >= 4.7 && <4.11
|
base >= 4.7 && <4.12
|
||||||
, text >= 1.2.3.0 && < 1.3
|
, text >= 1.2.3.0 && < 1.3
|
||||||
|
|
||||||
|
if !impl(ghc >= 8.0)
|
||||||
|
build-depends:
|
||||||
|
semigroups >=0.18.3 && <0.19
|
||||||
|
|
||||||
-- Servant dependencies
|
-- Servant dependencies
|
||||||
build-depends:
|
build-depends:
|
||||||
servant == 0.13.*
|
servant == 0.13.*
|
||||||
|
|
|
||||||
|
|
@ -27,6 +27,7 @@ import Control.Lens (makePrisms, makeLenses, Getter, (&), (<>~), (%~),
|
||||||
(.~))
|
(.~))
|
||||||
import Data.Data (Data)
|
import Data.Data (Data)
|
||||||
import Data.Proxy
|
import Data.Proxy
|
||||||
|
import Data.Semigroup (Semigroup)
|
||||||
import Data.String
|
import Data.String
|
||||||
import Data.Text
|
import Data.Text
|
||||||
import Data.Typeable (Typeable)
|
import Data.Typeable (Typeable)
|
||||||
|
|
@ -38,12 +39,12 @@ import Servant.API.TypeLevel
|
||||||
import Servant.API.Modifiers (RequiredArgument)
|
import Servant.API.Modifiers (RequiredArgument)
|
||||||
|
|
||||||
newtype FunctionName = FunctionName { unFunctionName :: [Text] }
|
newtype FunctionName = FunctionName { unFunctionName :: [Text] }
|
||||||
deriving (Data, Show, Eq, Monoid, Typeable)
|
deriving (Data, Show, Eq, Semigroup, Monoid, Typeable)
|
||||||
|
|
||||||
makePrisms ''FunctionName
|
makePrisms ''FunctionName
|
||||||
|
|
||||||
newtype PathSegment = PathSegment { unPathSegment :: Text }
|
newtype PathSegment = PathSegment { unPathSegment :: Text }
|
||||||
deriving (Data, Show, Eq, IsString, Monoid, Typeable)
|
deriving (Data, Show, Eq, IsString, Semigroup, Monoid, Typeable)
|
||||||
|
|
||||||
makePrisms ''PathSegment
|
makePrisms ''PathSegment
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -26,6 +26,7 @@ tested-with:
|
||||||
GHC==7.10.3
|
GHC==7.10.3
|
||||||
GHC==8.0.2
|
GHC==8.0.2
|
||||||
GHC==8.2.2
|
GHC==8.2.2
|
||||||
|
GHC==8.4.3
|
||||||
extra-source-files:
|
extra-source-files:
|
||||||
include/*.h
|
include/*.h
|
||||||
CHANGELOG.md
|
CHANGELOG.md
|
||||||
|
|
@ -60,7 +61,7 @@ library
|
||||||
--
|
--
|
||||||
-- note: mtl lower bound is so low because of GHC-7.8
|
-- note: mtl lower bound is so low because of GHC-7.8
|
||||||
build-depends:
|
build-depends:
|
||||||
base >= 4.7 && < 4.11
|
base >= 4.7 && < 4.12
|
||||||
, bytestring >= 0.10.4.0 && < 0.11
|
, bytestring >= 0.10.4.0 && < 0.11
|
||||||
, containers >= 0.5.5.1 && < 0.6
|
, containers >= 0.5.5.1 && < 0.6
|
||||||
, mtl >= 2.1 && < 2.3
|
, mtl >= 2.1 && < 2.3
|
||||||
|
|
@ -90,7 +91,7 @@ library
|
||||||
, http-types >= 0.12 && < 0.13
|
, http-types >= 0.12 && < 0.13
|
||||||
, network-uri >= 2.6.1.0 && < 2.7
|
, network-uri >= 2.6.1.0 && < 2.7
|
||||||
, monad-control >= 1.0.0.4 && < 1.1
|
, monad-control >= 1.0.0.4 && < 1.1
|
||||||
, network >= 2.6.3.2 && < 2.7
|
, network >= 2.6.3.2 && < 2.8
|
||||||
, safe >= 0.3.15 && < 0.4
|
, safe >= 0.3.15 && < 0.4
|
||||||
, split >= 0.2.3.2 && < 0.3
|
, split >= 0.2.3.2 && < 0.3
|
||||||
, string-conversions >= 0.4.0.1 && < 0.5
|
, string-conversions >= 0.4.0.1 && < 0.5
|
||||||
|
|
|
||||||
|
|
@ -283,37 +283,40 @@ instance OVERLAPPING_
|
||||||
|
|
||||||
|
|
||||||
instance OVERLAPPABLE_
|
instance OVERLAPPABLE_
|
||||||
( MimeRender ctype a, ReflectMethod method,
|
( MimeRender ctype a, ReflectMethod method, KnownNat status,
|
||||||
FramingRender framing ctype, ToStreamGenerator f a
|
FramingRender framing ctype, ToStreamGenerator b a
|
||||||
) => HasServer (Stream method framing ctype (f a)) context where
|
) => HasServer (Stream method status framing ctype b) context where
|
||||||
|
|
||||||
type ServerT (Stream method framing ctype (f a)) m = m (f a)
|
type ServerT (Stream method status framing ctype b) m = m b
|
||||||
hoistServerWithContext _ _ nt s = nt s
|
hoistServerWithContext _ _ nt s = nt s
|
||||||
|
|
||||||
route Proxy _ = streamRouter ([],) method (Proxy :: Proxy framing) (Proxy :: Proxy ctype)
|
route Proxy _ = streamRouter ([],) method status (Proxy :: Proxy framing) (Proxy :: Proxy ctype)
|
||||||
where method = reflectMethod (Proxy :: Proxy method)
|
where method = reflectMethod (Proxy :: Proxy method)
|
||||||
|
status = toEnum . fromInteger $ natVal (Proxy :: Proxy status)
|
||||||
|
|
||||||
instance OVERLAPPING_
|
instance OVERLAPPING_
|
||||||
( MimeRender ctype a, ReflectMethod method,
|
( MimeRender ctype a, ReflectMethod method, KnownNat status,
|
||||||
FramingRender framing ctype, ToStreamGenerator f a,
|
FramingRender framing ctype, ToStreamGenerator b a,
|
||||||
GetHeaders (Headers h (f a))
|
GetHeaders (Headers h b)
|
||||||
) => HasServer (Stream method framing ctype (Headers h (f a))) context where
|
) => HasServer (Stream method status framing ctype (Headers h b)) context where
|
||||||
|
|
||||||
type ServerT (Stream method framing ctype (Headers h (f a))) m = m (Headers h (f a))
|
type ServerT (Stream method status framing ctype (Headers h b)) m = m (Headers h b)
|
||||||
hoistServerWithContext _ _ nt s = nt s
|
hoistServerWithContext _ _ nt s = nt s
|
||||||
|
|
||||||
route Proxy _ = streamRouter (\x -> (getHeaders x, getResponse x)) method (Proxy :: Proxy framing) (Proxy :: Proxy ctype)
|
route Proxy _ = streamRouter (\x -> (getHeaders x, getResponse x)) method status (Proxy :: Proxy framing) (Proxy :: Proxy ctype)
|
||||||
where method = reflectMethod (Proxy :: Proxy method)
|
where method = reflectMethod (Proxy :: Proxy method)
|
||||||
|
status = toEnum . fromInteger $ natVal (Proxy :: Proxy status)
|
||||||
|
|
||||||
|
|
||||||
streamRouter :: (MimeRender ctype a, FramingRender framing ctype, ToStreamGenerator f a) =>
|
streamRouter :: (MimeRender ctype a, FramingRender framing ctype, ToStreamGenerator b a) =>
|
||||||
(b -> ([(HeaderName, B.ByteString)], f a))
|
(c -> ([(HeaderName, B.ByteString)], b))
|
||||||
-> Method
|
-> Method
|
||||||
|
-> Status
|
||||||
-> Proxy framing
|
-> Proxy framing
|
||||||
-> Proxy ctype
|
-> Proxy ctype
|
||||||
-> Delayed env (Handler b)
|
-> Delayed env (Handler c)
|
||||||
-> Router env
|
-> Router env
|
||||||
streamRouter splitHeaders method framingproxy ctypeproxy action = leafRouter $ \env request respond ->
|
streamRouter splitHeaders method status framingproxy ctypeproxy action = leafRouter $ \env request respond ->
|
||||||
let accH = fromMaybe ct_wildcard $ lookup hAccept $ requestHeaders request
|
let accH = fromMaybe ct_wildcard $ lookup hAccept $ requestHeaders request
|
||||||
cmediatype = NHM.matchAccept [contentType ctypeproxy] accH
|
cmediatype = NHM.matchAccept [contentType ctypeproxy] accH
|
||||||
accCheck = when (isNothing cmediatype) $ delayedFail err406
|
accCheck = when (isNothing cmediatype) $ delayedFail err406
|
||||||
|
|
@ -323,7 +326,7 @@ streamRouter splitHeaders method framingproxy ctypeproxy action = leafRouter $ \
|
||||||
) env request respond $ \ output ->
|
) env request respond $ \ output ->
|
||||||
let (headers, fa) = splitHeaders output
|
let (headers, fa) = splitHeaders output
|
||||||
k = getStreamGenerator . toStreamGenerator $ fa in
|
k = getStreamGenerator . toStreamGenerator $ fa in
|
||||||
Route $ responseStream status200 (contentHeader : headers) $ \write flush -> do
|
Route $ responseStream status (contentHeader : headers) $ \write flush -> do
|
||||||
write . BB.lazyByteString $ header framingproxy ctypeproxy
|
write . BB.lazyByteString $ header framingproxy ctypeproxy
|
||||||
case boundary framingproxy ctypeproxy of
|
case boundary framingproxy ctypeproxy of
|
||||||
BoundaryStrategyBracket f ->
|
BoundaryStrategyBracket f ->
|
||||||
|
|
|
||||||
|
|
@ -17,55 +17,60 @@
|
||||||
|
|
||||||
module Servant.ServerSpec where
|
module Servant.ServerSpec where
|
||||||
|
|
||||||
import Control.Monad (forM_, when, unless)
|
import Control.Monad
|
||||||
import Control.Monad.Error.Class (MonadError (..))
|
(forM_, unless, when)
|
||||||
import Data.Aeson (FromJSON, ToJSON, decode', encode)
|
import Control.Monad.Error.Class
|
||||||
|
(MonadError (..))
|
||||||
|
import Data.Aeson
|
||||||
|
(FromJSON, ToJSON, decode', encode)
|
||||||
|
import qualified Data.ByteString as BS
|
||||||
import qualified Data.ByteString.Base64 as Base64
|
import qualified Data.ByteString.Base64 as Base64
|
||||||
import Data.Char (toUpper)
|
import Data.Char
|
||||||
|
(toUpper)
|
||||||
import Data.Monoid
|
import Data.Monoid
|
||||||
import Data.Proxy (Proxy (Proxy))
|
import Data.Proxy
|
||||||
import Data.String (fromString)
|
(Proxy (Proxy))
|
||||||
import Data.String.Conversions (cs)
|
import Data.String
|
||||||
|
(fromString)
|
||||||
|
import Data.String.Conversions
|
||||||
|
(cs)
|
||||||
import qualified Data.Text as T
|
import qualified Data.Text as T
|
||||||
import GHC.Generics (Generic)
|
import GHC.Generics
|
||||||
import Network.HTTP.Types (Status (..), hAccept, hContentType,
|
(Generic)
|
||||||
methodDelete, methodGet,
|
import Network.HTTP.Types
|
||||||
methodHead, methodPatch,
|
(Status (..), hAccept, hContentType, imATeapot418,
|
||||||
methodPost, methodPut, ok200,
|
methodDelete, methodGet, methodHead, methodPatch, methodPost,
|
||||||
imATeapot418,
|
methodPut, ok200, parseQuery)
|
||||||
parseQuery)
|
import Network.Wai
|
||||||
import Network.Wai (Application, Request, requestHeaders, pathInfo,
|
(Application, Request, pathInfo, queryString, rawQueryString,
|
||||||
queryString, rawQueryString,
|
requestHeaders, responseLBS)
|
||||||
responseLBS)
|
import Network.Wai.Test
|
||||||
import Network.Wai.Test (defaultRequest, request,
|
(defaultRequest, request, runSession, simpleBody,
|
||||||
runSession, simpleBody,
|
|
||||||
simpleHeaders, simpleStatus)
|
simpleHeaders, simpleStatus)
|
||||||
import Servant.API ((:<|>) (..), (:>), AuthProtect,
|
import Servant.API
|
||||||
BasicAuth, BasicAuthData(BasicAuthData),
|
((:<|>) (..), (:>), AuthProtect, BasicAuth,
|
||||||
Capture, CaptureAll, Delete, Get, Header,
|
BasicAuthData (BasicAuthData), Capture, CaptureAll, Delete,
|
||||||
Headers, HttpVersion,
|
EmptyAPI, Get, Header, Headers, HttpVersion, IsSecure (..),
|
||||||
IsSecure (..), JSON,
|
JSON, NoContent (..), NoFraming, OctetStream, Patch,
|
||||||
NoContent (..), Patch, PlainText,
|
PlainText, Post, Put, QueryFlag, QueryParam, QueryParams, Raw,
|
||||||
Post, Put, EmptyAPI,
|
RemoteHost, ReqBody, StdMethod (..), Stream,
|
||||||
QueryFlag, QueryParam, QueryParams,
|
StreamGenerator (..), Verb, addHeader)
|
||||||
Raw, RemoteHost, ReqBody,
|
|
||||||
StdMethod (..), Verb, addHeader)
|
|
||||||
import Servant.API.Internal.Test.ComprehensiveAPI
|
import Servant.API.Internal.Test.ComprehensiveAPI
|
||||||
import Servant.Server (Server, Handler, Tagged (..), err401, err403,
|
import Servant.Server
|
||||||
err404, serve, serveWithContext,
|
(Context ((:.), EmptyContext), Handler, Server, Tagged (..),
|
||||||
Context((:.), EmptyContext), emptyServer)
|
emptyServer, err401, err403, err404, serve, serveWithContext)
|
||||||
import Test.Hspec (Spec, context, describe, it,
|
import Test.Hspec
|
||||||
shouldBe, shouldContain)
|
(Spec, context, describe, it, shouldBe, shouldContain)
|
||||||
import qualified Test.Hspec.Wai as THW
|
import Test.Hspec.Wai
|
||||||
import Test.Hspec.Wai (get, liftIO, matchHeaders,
|
(get, liftIO, matchHeaders, matchStatus, shouldRespondWith,
|
||||||
matchStatus, shouldRespondWith,
|
|
||||||
with, (<:>))
|
with, (<:>))
|
||||||
|
import qualified Test.Hspec.Wai as THW
|
||||||
|
|
||||||
import Servant.Server.Internal.BasicAuth (BasicAuthCheck(BasicAuthCheck),
|
|
||||||
BasicAuthResult(Authorized,Unauthorized))
|
|
||||||
import Servant.Server.Experimental.Auth
|
import Servant.Server.Experimental.Auth
|
||||||
(AuthHandler, AuthServerData,
|
(AuthHandler, AuthServerData, mkAuthHandler)
|
||||||
mkAuthHandler)
|
import Servant.Server.Internal.BasicAuth
|
||||||
|
(BasicAuthCheck (BasicAuthCheck),
|
||||||
|
BasicAuthResult (Authorized, Unauthorized))
|
||||||
import Servant.Server.Internal.Context
|
import Servant.Server.Internal.Context
|
||||||
(NamedContext (..))
|
(NamedContext (..))
|
||||||
|
|
||||||
|
|
@ -105,6 +110,7 @@ type VerbApi method status
|
||||||
:<|> "accept" :> ( Verb method status '[JSON] Person
|
:<|> "accept" :> ( Verb method status '[JSON] Person
|
||||||
:<|> Verb method status '[PlainText] String
|
:<|> Verb method status '[PlainText] String
|
||||||
)
|
)
|
||||||
|
:<|> "stream" :> Stream method status NoFraming OctetStream (StreamGenerator BS.ByteString)
|
||||||
|
|
||||||
verbSpec :: Spec
|
verbSpec :: Spec
|
||||||
verbSpec = describe "Servant.API.Verb" $ do
|
verbSpec = describe "Servant.API.Verb" $ do
|
||||||
|
|
@ -114,6 +120,8 @@ verbSpec = describe "Servant.API.Verb" $ do
|
||||||
:<|> return (addHeader 5 alice)
|
:<|> return (addHeader 5 alice)
|
||||||
:<|> return (addHeader 10 NoContent)
|
:<|> return (addHeader 10 NoContent)
|
||||||
:<|> (return alice :<|> return "B")
|
:<|> (return alice :<|> return "B")
|
||||||
|
:<|> return (StreamGenerator $ \f _ -> f "bytestring")
|
||||||
|
|
||||||
get200 = Proxy :: Proxy (VerbApi 'GET 200)
|
get200 = Proxy :: Proxy (VerbApi 'GET 200)
|
||||||
post210 = Proxy :: Proxy (VerbApi 'POST 210)
|
post210 = Proxy :: Proxy (VerbApi 'POST 210)
|
||||||
put203 = Proxy :: Proxy (VerbApi 'PUT 203)
|
put203 = Proxy :: Proxy (VerbApi 'PUT 203)
|
||||||
|
|
@ -179,6 +187,11 @@ verbSpec = describe "Servant.API.Verb" $ do
|
||||||
liftIO $ simpleHeaders response `shouldContain`
|
liftIO $ simpleHeaders response `shouldContain`
|
||||||
[("Content-Type", "application/json;charset=utf-8")]
|
[("Content-Type", "application/json;charset=utf-8")]
|
||||||
|
|
||||||
|
it "works for Stream as for Result" $ do
|
||||||
|
response <- THW.request method "/stream" [] ""
|
||||||
|
liftIO $ statusCode (simpleStatus response) `shouldBe` status
|
||||||
|
liftIO $ simpleBody response `shouldBe` "bytestring"
|
||||||
|
|
||||||
test "GET 200" get200 methodGet 200
|
test "GET 200" get200 methodGet 200
|
||||||
test "POST 210" post210 methodPost 210
|
test "POST 210" post210 methodPost 210
|
||||||
test "PUT 203" put203 methodPut 203
|
test "PUT 203" put203 methodPut 203
|
||||||
|
|
|
||||||
|
|
@ -22,6 +22,7 @@ tested-with:
|
||||||
GHC==7.10.3
|
GHC==7.10.3
|
||||||
GHC==8.0.2
|
GHC==8.0.2
|
||||||
GHC==8.2.2
|
GHC==8.2.2
|
||||||
|
GHC==8.4.3
|
||||||
extra-source-files:
|
extra-source-files:
|
||||||
include/*.h
|
include/*.h
|
||||||
CHANGELOG.md
|
CHANGELOG.md
|
||||||
|
|
@ -69,7 +70,7 @@ library
|
||||||
--
|
--
|
||||||
-- note: mtl lower bound is so low because of GHC-7.8
|
-- note: mtl lower bound is so low because of GHC-7.8
|
||||||
build-depends:
|
build-depends:
|
||||||
base >= 4.7 && < 4.11
|
base >= 4.7 && < 4.12
|
||||||
, bytestring >= 0.10.4.0 && < 0.11
|
, bytestring >= 0.10.4.0 && < 0.11
|
||||||
, mtl >= 2.1 && < 2.3
|
, mtl >= 2.1 && < 2.3
|
||||||
, text >= 1.2.3.0 && < 1.3
|
, text >= 1.2.3.0 && < 1.3
|
||||||
|
|
|
||||||
|
|
@ -117,8 +117,8 @@ import Servant.API.Stream
|
||||||
(BoundaryStrategy (..), BuildFromStream (..),
|
(BoundaryStrategy (..), BuildFromStream (..),
|
||||||
ByteStringParser (..), FramingRender (..),
|
ByteStringParser (..), FramingRender (..),
|
||||||
FramingUnrender (..), NetstringFraming, NewlineFraming,
|
FramingUnrender (..), NetstringFraming, NewlineFraming,
|
||||||
ResultStream (..), Stream, StreamGenerator (..), StreamGet,
|
NoFraming, ResultStream (..), Stream, StreamGenerator (..),
|
||||||
StreamPost, ToStreamGenerator (..))
|
StreamGet, StreamPost, ToStreamGenerator (..))
|
||||||
import Servant.API.Sub
|
import Servant.API.Sub
|
||||||
((:>))
|
((:>))
|
||||||
import Servant.API.Vault
|
import Servant.API.Vault
|
||||||
|
|
|
||||||
|
|
@ -100,23 +100,41 @@ instance OVERLAPPABLE_ ( FromHttpApiData v, BuildHeadersTo xs, KnownSymbol h )
|
||||||
class GetHeaders ls where
|
class GetHeaders ls where
|
||||||
getHeaders :: ls -> [HTTP.Header]
|
getHeaders :: ls -> [HTTP.Header]
|
||||||
|
|
||||||
instance OVERLAPPING_ GetHeaders (HList '[]) where
|
-- | Auxiliary class for @'GetHeaders' ('HList' hs)@ instance
|
||||||
getHeaders _ = []
|
class GetHeadersFromHList hs where
|
||||||
|
getHeadersFromHList :: HList hs -> [HTTP.Header]
|
||||||
|
|
||||||
instance OVERLAPPABLE_ ( KnownSymbol h, ToHttpApiData x, GetHeaders (HList xs) )
|
instance GetHeadersFromHList hs => GetHeaders (HList hs) where
|
||||||
=> GetHeaders (HList (Header h x ': xs)) where
|
getHeaders = getHeadersFromHList
|
||||||
getHeaders hdrs = case hdrs of
|
|
||||||
Header val `HCons` rest -> (headerName , toHeader val):getHeaders rest
|
|
||||||
UndecodableHeader h `HCons` rest -> (headerName, h) :getHeaders rest
|
|
||||||
MissingHeader `HCons` rest -> getHeaders rest
|
|
||||||
where headerName = CI.mk . pack $ symbolVal (Proxy :: Proxy h)
|
|
||||||
|
|
||||||
instance OVERLAPPING_ GetHeaders (Headers '[] a) where
|
instance GetHeadersFromHList '[] where
|
||||||
getHeaders _ = []
|
getHeadersFromHList _ = []
|
||||||
|
|
||||||
instance OVERLAPPABLE_ ( KnownSymbol h, GetHeaders (HList rest), ToHttpApiData v )
|
instance (KnownSymbol h, ToHttpApiData x, GetHeadersFromHList xs)
|
||||||
=> GetHeaders (Headers (Header h v ': rest) a) where
|
=> GetHeadersFromHList (Header h x ': xs)
|
||||||
getHeaders hs = getHeaders $ getHeadersHList hs
|
where
|
||||||
|
getHeadersFromHList hdrs = case hdrs of
|
||||||
|
Header val `HCons` rest -> (headerName , toHeader val) : getHeadersFromHList rest
|
||||||
|
UndecodableHeader h `HCons` rest -> (headerName, h) : getHeadersFromHList rest
|
||||||
|
MissingHeader `HCons` rest -> getHeadersFromHList rest
|
||||||
|
where
|
||||||
|
headerName = CI.mk . pack $ symbolVal (Proxy :: Proxy h)
|
||||||
|
|
||||||
|
-- | Auxiliary class for @'GetHeaders' ('Headers' hs a)@ instance
|
||||||
|
class GetHeaders' hs where
|
||||||
|
getHeaders' :: Headers hs a -> [HTTP.Header]
|
||||||
|
|
||||||
|
instance GetHeaders' hs => GetHeaders (Headers hs a) where
|
||||||
|
getHeaders = getHeaders'
|
||||||
|
|
||||||
|
-- | This instance is an optimisation
|
||||||
|
instance GetHeaders' '[] where
|
||||||
|
getHeaders' _ = []
|
||||||
|
|
||||||
|
instance (KnownSymbol h, GetHeadersFromHList rest, ToHttpApiData v)
|
||||||
|
=> GetHeaders' (Header h v ': rest)
|
||||||
|
where
|
||||||
|
getHeaders' hs = getHeadersFromHList $ getHeadersHList hs
|
||||||
|
|
||||||
-- * Adding
|
-- * Adding
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -2,6 +2,7 @@
|
||||||
{-# LANGUAGE DeriveDataTypeable #-}
|
{-# LANGUAGE DeriveDataTypeable #-}
|
||||||
{-# LANGUAGE DeriveGeneric #-}
|
{-# LANGUAGE DeriveGeneric #-}
|
||||||
{-# LANGUAGE FlexibleInstances #-}
|
{-# LANGUAGE FlexibleInstances #-}
|
||||||
|
{-# LANGUAGE FunctionalDependencies #-}
|
||||||
{-# LANGUAGE KindSignatures #-}
|
{-# LANGUAGE KindSignatures #-}
|
||||||
{-# LANGUAGE MultiParamTypeClasses #-}
|
{-# LANGUAGE MultiParamTypeClasses #-}
|
||||||
{-# LANGUAGE OverloadedStrings #-}
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
|
|
@ -25,26 +26,28 @@ import Data.Typeable
|
||||||
(Typeable)
|
(Typeable)
|
||||||
import GHC.Generics
|
import GHC.Generics
|
||||||
(Generic)
|
(Generic)
|
||||||
|
import GHC.TypeLits
|
||||||
|
(Nat)
|
||||||
import Network.HTTP.Types.Method
|
import Network.HTTP.Types.Method
|
||||||
(StdMethod (..))
|
(StdMethod (..))
|
||||||
import Text.Read
|
import Text.Read
|
||||||
(readMaybe)
|
(readMaybe)
|
||||||
|
|
||||||
-- | A Stream endpoint for a given method emits a stream of encoded values at a given Content-Type, delimited by a framing strategy. Steam endpoints always return response code 200 on success. Type synonyms are provided for standard methods.
|
-- | A Stream endpoint for a given method emits a stream of encoded values at a given Content-Type, delimited by a framing strategy. Stream endpoints always return response code 200 on success. Type synonyms are provided for standard methods.
|
||||||
data Stream (method :: k1) (framing :: *) (contentType :: *) (a :: *)
|
data Stream (method :: k1) (status :: Nat) (framing :: *) (contentType :: *) (a :: *)
|
||||||
deriving (Typeable, Generic)
|
deriving (Typeable, Generic)
|
||||||
|
|
||||||
type StreamGet = Stream 'GET
|
type StreamGet = Stream 'GET 200
|
||||||
type StreamPost = Stream 'POST
|
type StreamPost = Stream 'POST 200
|
||||||
|
|
||||||
-- | Stream endpoints may be implemented as producing a @StreamGenerator@ -- a function that itself takes two emit functions -- the first to be used on the first value the stream emits, and the second to be used on all subsequent values (to allow interspersed framing strategies such as comma separation).
|
-- | Stream endpoints may be implemented as producing a @StreamGenerator@ -- a function that itself takes two emit functions -- the first to be used on the first value the stream emits, and the second to be used on all subsequent values (to allow interspersed framing strategies such as comma separation).
|
||||||
newtype StreamGenerator a = StreamGenerator {getStreamGenerator :: (a -> IO ()) -> (a -> IO ()) -> IO ()}
|
newtype StreamGenerator a = StreamGenerator {getStreamGenerator :: (a -> IO ()) -> (a -> IO ()) -> IO ()}
|
||||||
|
|
||||||
-- | ToStreamGenerator is intended to be implemented for types such as Conduit, Pipe, etc. By implementing this class, all such streaming abstractions can be used directly as endpoints.
|
-- | ToStreamGenerator is intended to be implemented for types such as Conduit, Pipe, etc. By implementing this class, all such streaming abstractions can be used directly as endpoints.
|
||||||
class ToStreamGenerator f a where
|
class ToStreamGenerator a b | a -> b where
|
||||||
toStreamGenerator :: f a -> StreamGenerator a
|
toStreamGenerator :: a -> StreamGenerator b
|
||||||
|
|
||||||
instance ToStreamGenerator StreamGenerator a
|
instance ToStreamGenerator (StreamGenerator a) a
|
||||||
where toStreamGenerator x = x
|
where toStreamGenerator x = x
|
||||||
|
|
||||||
-- | Clients reading from streaming endpoints can be implemented as producing a @ResultStream@ that captures the setup, takedown, and incremental logic for a read, being an IO continuation that takes a producer of Just either values or errors that terminates with a Nothing.
|
-- | Clients reading from streaming endpoints can be implemented as producing a @ResultStream@ that captures the setup, takedown, and incremental logic for a read, being an IO continuation that takes a producer of Just either values or errors that terminates with a Nothing.
|
||||||
|
|
@ -80,6 +83,18 @@ data ByteStringParser a = ByteStringParser {
|
||||||
class FramingUnrender strategy a where
|
class FramingUnrender strategy a where
|
||||||
unrenderFrames :: Proxy strategy -> Proxy a -> ByteStringParser (ByteStringParser (Either String ByteString))
|
unrenderFrames :: Proxy strategy -> Proxy a -> ByteStringParser (ByteStringParser (Either String ByteString))
|
||||||
|
|
||||||
|
-- | A framing strategy that does not do any framing at all, it just passes the input data
|
||||||
|
-- This will be used most of the time with binary data, such as files
|
||||||
|
data NoFraming
|
||||||
|
|
||||||
|
instance FramingRender NoFraming a where
|
||||||
|
header _ _ = empty
|
||||||
|
boundary _ _ = BoundaryStrategyGeneral id
|
||||||
|
trailer _ _ = empty
|
||||||
|
|
||||||
|
instance FramingUnrender NoFraming a where
|
||||||
|
unrenderFrames _ _ = ByteStringParser (Just . (go,)) (go,)
|
||||||
|
where go = ByteStringParser (Just . (, empty) . Right) ((, empty) . Right)
|
||||||
|
|
||||||
-- | A simple framing strategy that has no header or termination, and inserts a newline character between each frame.
|
-- | A simple framing strategy that has no header or termination, and inserts a newline character between each frame.
|
||||||
-- This assumes that it is used with a Content-Type that encodes without newlines (e.g. JSON).
|
-- This assumes that it is used with a Content-Type that encodes without newlines (e.g. JSON).
|
||||||
|
|
|
||||||
|
|
@ -19,8 +19,6 @@
|
||||||
-- >>> import Servant.Utils.Links
|
-- >>> import Servant.Utils.Links
|
||||||
-- >>> import Data.Proxy
|
-- >>> import Data.Proxy
|
||||||
-- >>>
|
-- >>>
|
||||||
-- >>>
|
|
||||||
-- >>>
|
|
||||||
-- >>> type Hello = "hello" :> Get '[JSON] Int
|
-- >>> type Hello = "hello" :> Get '[JSON] Int
|
||||||
-- >>> type Bye = "bye" :> QueryParam "name" String :> Delete '[JSON] NoContent
|
-- >>> type Bye = "bye" :> QueryParam "name" String :> Delete '[JSON] NoContent
|
||||||
-- >>> type API = Hello :<|> Bye
|
-- >>> type API = Hello :<|> Bye
|
||||||
|
|
@ -63,10 +61,24 @@
|
||||||
-- >>> :set -XConstraintKinds
|
-- >>> :set -XConstraintKinds
|
||||||
-- >>> :{
|
-- >>> :{
|
||||||
-- >>> let apiLink :: (IsElem endpoint API, HasLink endpoint)
|
-- >>> let apiLink :: (IsElem endpoint API, HasLink endpoint)
|
||||||
-- >>> => Proxy endpoint -> MkLink endpoint
|
-- >>> => Proxy endpoint -> MkLink endpoint Link
|
||||||
-- >>> apiLink = safeLink api
|
-- >>> apiLink = safeLink api
|
||||||
-- >>> :}
|
-- >>> :}
|
||||||
--
|
--
|
||||||
|
-- `safeLink'` allows to make specialise the output:
|
||||||
|
--
|
||||||
|
-- >>> safeLink' toUrlPiece api without
|
||||||
|
-- "bye"
|
||||||
|
--
|
||||||
|
-- >>> :{
|
||||||
|
-- >>> let apiTextLink :: (IsElem endpoint API, HasLink endpoint)
|
||||||
|
-- >>> => Proxy endpoint -> MkLink endpoint Text
|
||||||
|
-- >>> apiTextLink = safeLink' toUrlPiece api
|
||||||
|
-- >>> :}
|
||||||
|
--
|
||||||
|
-- >>> apiTextLink without
|
||||||
|
-- "bye"
|
||||||
|
--
|
||||||
-- Attempting to construct a link to an endpoint that does not exist in api
|
-- Attempting to construct a link to an endpoint that does not exist in api
|
||||||
-- will result in a type error like this:
|
-- will result in a type error like this:
|
||||||
--
|
--
|
||||||
|
|
@ -86,7 +98,9 @@ module Servant.Utils.Links (
|
||||||
--
|
--
|
||||||
-- | Note that 'URI' is from the "Network.URI" module in the @network-uri@ package.
|
-- | Note that 'URI' is from the "Network.URI" module in the @network-uri@ package.
|
||||||
safeLink
|
safeLink
|
||||||
|
, safeLink'
|
||||||
, allLinks
|
, allLinks
|
||||||
|
, allLinks'
|
||||||
, URI(..)
|
, URI(..)
|
||||||
-- * Adding custom types
|
-- * Adding custom types
|
||||||
, HasLink(..)
|
, HasLink(..)
|
||||||
|
|
@ -276,8 +290,18 @@ safeLink
|
||||||
:: forall endpoint api. (IsElem endpoint api, HasLink endpoint)
|
:: forall endpoint api. (IsElem endpoint api, HasLink endpoint)
|
||||||
=> Proxy api -- ^ The whole API that this endpoint is a part of
|
=> Proxy api -- ^ The whole API that this endpoint is a part of
|
||||||
-> Proxy endpoint -- ^ The API endpoint you would like to point to
|
-> Proxy endpoint -- ^ The API endpoint you would like to point to
|
||||||
-> MkLink endpoint
|
-> MkLink endpoint Link
|
||||||
safeLink _ endpoint = toLink endpoint (Link mempty mempty)
|
safeLink = safeLink' id
|
||||||
|
|
||||||
|
-- | More general 'safeLink'.
|
||||||
|
--
|
||||||
|
safeLink'
|
||||||
|
:: forall endpoint api a. (IsElem endpoint api, HasLink endpoint)
|
||||||
|
=> (Link -> a)
|
||||||
|
-> Proxy api -- ^ The whole API that this endpoint is a part of
|
||||||
|
-> Proxy endpoint -- ^ The API endpoint you would like to point to
|
||||||
|
-> MkLink endpoint a
|
||||||
|
safeLink' toA _ endpoint = toLink toA endpoint (Link mempty mempty)
|
||||||
|
|
||||||
-- | Create all links in an API.
|
-- | Create all links in an API.
|
||||||
--
|
--
|
||||||
|
|
@ -293,37 +317,47 @@ safeLink _ endpoint = toLink endpoint (Link mempty mempty)
|
||||||
--
|
--
|
||||||
-- Note: nested APIs don't work well with this approach
|
-- Note: nested APIs don't work well with this approach
|
||||||
--
|
--
|
||||||
-- >>> :kind! MkLink (Capture "nest" Char :> (Capture "x" Int :> Get '[JSON] Int :<|> Capture "y" Double :> Get '[JSON] Double))
|
-- >>> :kind! MkLink (Capture "nest" Char :> (Capture "x" Int :> Get '[JSON] Int :<|> Capture "y" Double :> Get '[JSON] Double)) Link
|
||||||
-- MkLink (Capture "nest" Char :> (Capture "x" Int :> Get '[JSON] Int :<|> Capture "y" Double :> Get '[JSON] Double)) :: *
|
-- MkLink (Capture "nest" Char :> (Capture "x" Int :> Get '[JSON] Int :<|> Capture "y" Double :> Get '[JSON] Double)) Link :: *
|
||||||
-- = Char -> (Int -> Link) :<|> (Double -> Link)
|
-- = Char -> (Int -> Link) :<|> (Double -> Link)
|
||||||
--
|
|
||||||
allLinks
|
allLinks
|
||||||
:: forall api. HasLink api
|
:: forall api. HasLink api
|
||||||
=> Proxy api
|
=> Proxy api
|
||||||
-> MkLink api
|
-> MkLink api Link
|
||||||
allLinks api = toLink api (Link mempty mempty)
|
allLinks = allLinks' id
|
||||||
|
|
||||||
|
-- | More general 'allLinks'. See `safeLink'`.
|
||||||
|
allLinks'
|
||||||
|
:: forall api a. HasLink api
|
||||||
|
=> (Link -> a)
|
||||||
|
-> Proxy api
|
||||||
|
-> MkLink api a
|
||||||
|
allLinks' toA api = toLink toA api (Link mempty mempty)
|
||||||
|
|
||||||
-- | Construct a toLink for an endpoint.
|
-- | Construct a toLink for an endpoint.
|
||||||
class HasLink endpoint where
|
class HasLink endpoint where
|
||||||
type MkLink endpoint
|
type MkLink endpoint (a :: *)
|
||||||
toLink :: Proxy endpoint -- ^ The API endpoint you would like to point to
|
toLink
|
||||||
|
:: (Link -> a)
|
||||||
|
-> Proxy endpoint -- ^ The API endpoint you would like to point to
|
||||||
-> Link
|
-> Link
|
||||||
-> MkLink endpoint
|
-> MkLink endpoint a
|
||||||
|
|
||||||
-- Naked symbol instance
|
-- Naked symbol instance
|
||||||
instance (KnownSymbol sym, HasLink sub) => HasLink (sym :> sub) where
|
instance (KnownSymbol sym, HasLink sub) => HasLink (sym :> sub) where
|
||||||
type MkLink (sym :> sub) = MkLink sub
|
type MkLink (sym :> sub) a = MkLink sub a
|
||||||
toLink _ =
|
toLink toA _ =
|
||||||
toLink (Proxy :: Proxy sub) . addSegment (escaped seg)
|
toLink toA (Proxy :: Proxy sub) . addSegment (escaped seg)
|
||||||
where
|
where
|
||||||
seg = symbolVal (Proxy :: Proxy sym)
|
seg = symbolVal (Proxy :: Proxy sym)
|
||||||
|
|
||||||
-- QueryParam instances
|
-- QueryParam instances
|
||||||
instance (KnownSymbol sym, ToHttpApiData v, HasLink sub, SBoolI (FoldRequired mods))
|
instance (KnownSymbol sym, ToHttpApiData v, HasLink sub, SBoolI (FoldRequired mods))
|
||||||
=> HasLink (QueryParam' mods sym v :> sub) where
|
=> HasLink (QueryParam' mods sym v :> sub)
|
||||||
type MkLink (QueryParam' mods sym v :> sub) = If (FoldRequired mods) v (Maybe v) -> MkLink sub
|
where
|
||||||
toLink _ l mv =
|
type MkLink (QueryParam' mods sym v :> sub) a = If (FoldRequired mods) v (Maybe v) -> MkLink sub a
|
||||||
toLink (Proxy :: Proxy sub) $
|
toLink toA _ l mv =
|
||||||
|
toLink toA (Proxy :: Proxy sub) $
|
||||||
case sbool :: SBool (FoldRequired mods) of
|
case sbool :: SBool (FoldRequired mods) of
|
||||||
STrue -> (addQueryParam . SingleParam k . toQueryParam) mv l
|
STrue -> (addQueryParam . SingleParam k . toQueryParam) mv l
|
||||||
SFalse -> maybe id (addQueryParam . SingleParam k . toQueryParam) mv l
|
SFalse -> maybe id (addQueryParam . SingleParam k . toQueryParam) mv l
|
||||||
|
|
@ -332,105 +366,121 @@ instance (KnownSymbol sym, ToHttpApiData v, HasLink sub, SBoolI (FoldRequired mo
|
||||||
k = symbolVal (Proxy :: Proxy sym)
|
k = symbolVal (Proxy :: Proxy sym)
|
||||||
|
|
||||||
instance (KnownSymbol sym, ToHttpApiData v, HasLink sub)
|
instance (KnownSymbol sym, ToHttpApiData v, HasLink sub)
|
||||||
=> HasLink (QueryParams sym v :> sub) where
|
=> HasLink (QueryParams sym v :> sub)
|
||||||
type MkLink (QueryParams sym v :> sub) = [v] -> MkLink sub
|
where
|
||||||
toLink _ l =
|
type MkLink (QueryParams sym v :> sub) a = [v] -> MkLink sub a
|
||||||
toLink (Proxy :: Proxy sub) .
|
toLink toA _ l =
|
||||||
|
toLink toA (Proxy :: Proxy sub) .
|
||||||
foldl' (\l' v -> addQueryParam (ArrayElemParam k (toQueryParam v)) l') l
|
foldl' (\l' v -> addQueryParam (ArrayElemParam k (toQueryParam v)) l') l
|
||||||
where
|
where
|
||||||
k = symbolVal (Proxy :: Proxy sym)
|
k = symbolVal (Proxy :: Proxy sym)
|
||||||
|
|
||||||
instance (KnownSymbol sym, HasLink sub)
|
instance (KnownSymbol sym, HasLink sub)
|
||||||
=> HasLink (QueryFlag sym :> sub) where
|
=> HasLink (QueryFlag sym :> sub)
|
||||||
type MkLink (QueryFlag sym :> sub) = Bool -> MkLink sub
|
where
|
||||||
toLink _ l False =
|
type MkLink (QueryFlag sym :> sub) a = Bool -> MkLink sub a
|
||||||
toLink (Proxy :: Proxy sub) l
|
toLink toA _ l False =
|
||||||
toLink _ l True =
|
toLink toA (Proxy :: Proxy sub) l
|
||||||
toLink (Proxy :: Proxy sub) $ addQueryParam (FlagParam k) l
|
toLink toA _ l True =
|
||||||
|
toLink toA (Proxy :: Proxy sub) $ addQueryParam (FlagParam k) l
|
||||||
where
|
where
|
||||||
k = symbolVal (Proxy :: Proxy sym)
|
k = symbolVal (Proxy :: Proxy sym)
|
||||||
|
|
||||||
-- :<|> instance - Generate all links at once
|
-- :<|> instance - Generate all links at once
|
||||||
instance (HasLink a, HasLink b) => HasLink (a :<|> b) where
|
instance (HasLink a, HasLink b) => HasLink (a :<|> b) where
|
||||||
type MkLink (a :<|> b) = MkLink a :<|> MkLink b
|
type MkLink (a :<|> b) r = MkLink a r :<|> MkLink b r
|
||||||
toLink _ l = toLink (Proxy :: Proxy a) l :<|> toLink (Proxy :: Proxy b) l
|
toLink toA _ l = toLink toA (Proxy :: Proxy a) l :<|> toLink toA (Proxy :: Proxy b) l
|
||||||
|
|
||||||
-- Misc instances
|
-- Misc instances
|
||||||
instance HasLink sub => HasLink (ReqBody' mods ct a :> sub) where
|
instance HasLink sub => HasLink (ReqBody' mods ct a :> sub) where
|
||||||
type MkLink (ReqBody' mods ct a :> sub) = MkLink sub
|
type MkLink (ReqBody' mods ct a :> sub) r = MkLink sub r
|
||||||
toLink _ = toLink (Proxy :: Proxy sub)
|
toLink toA _ = toLink toA (Proxy :: Proxy sub)
|
||||||
|
|
||||||
instance (ToHttpApiData v, HasLink sub)
|
instance (ToHttpApiData v, HasLink sub)
|
||||||
=> HasLink (Capture' mods sym v :> sub) where
|
=> HasLink (Capture' mods sym v :> sub)
|
||||||
type MkLink (Capture' mods sym v :> sub) = v -> MkLink sub
|
where
|
||||||
toLink _ l v =
|
type MkLink (Capture' mods sym v :> sub) a = v -> MkLink sub a
|
||||||
toLink (Proxy :: Proxy sub) $
|
toLink toA _ l v =
|
||||||
|
toLink toA (Proxy :: Proxy sub) $
|
||||||
addSegment (escaped . Text.unpack $ toUrlPiece v) l
|
addSegment (escaped . Text.unpack $ toUrlPiece v) l
|
||||||
|
|
||||||
instance (ToHttpApiData v, HasLink sub)
|
instance (ToHttpApiData v, HasLink sub)
|
||||||
=> HasLink (CaptureAll sym v :> sub) where
|
=> HasLink (CaptureAll sym v :> sub)
|
||||||
type MkLink (CaptureAll sym v :> sub) = [v] -> MkLink sub
|
where
|
||||||
toLink _ l vs =
|
type MkLink (CaptureAll sym v :> sub) a = [v] -> MkLink sub a
|
||||||
toLink (Proxy :: Proxy sub) $
|
toLink toA _ l vs = toLink toA (Proxy :: Proxy sub) $
|
||||||
foldl' (flip $ addSegment . escaped . Text.unpack . toUrlPiece) l vs
|
foldl' (flip $ addSegment . escaped . Text.unpack . toUrlPiece) l vs
|
||||||
|
|
||||||
instance HasLink sub => HasLink (Header' mods sym a :> sub) where
|
instance HasLink sub => HasLink (Header' mods sym (a :: *) :> sub) where
|
||||||
type MkLink (Header' mods sym a :> sub) = MkLink sub
|
type MkLink (Header' mods sym a :> sub) r = MkLink sub r
|
||||||
toLink _ = toLink (Proxy :: Proxy sub)
|
toLink = simpleToLink (Proxy :: Proxy sub)
|
||||||
|
|
||||||
instance HasLink sub => HasLink (Vault :> sub) where
|
instance HasLink sub => HasLink (Vault :> sub) where
|
||||||
type MkLink (Vault :> sub) = MkLink sub
|
type MkLink (Vault :> sub) a = MkLink sub a
|
||||||
toLink _ = toLink (Proxy :: Proxy sub)
|
toLink = simpleToLink (Proxy :: Proxy sub)
|
||||||
|
|
||||||
instance HasLink sub => HasLink (Description s :> sub) where
|
instance HasLink sub => HasLink (Description s :> sub) where
|
||||||
type MkLink (Description s :> sub) = MkLink sub
|
type MkLink (Description s :> sub) a = MkLink sub a
|
||||||
toLink _ = toLink (Proxy :: Proxy sub)
|
toLink = simpleToLink (Proxy :: Proxy sub)
|
||||||
|
|
||||||
instance HasLink sub => HasLink (Summary s :> sub) where
|
instance HasLink sub => HasLink (Summary s :> sub) where
|
||||||
type MkLink (Summary s :> sub) = MkLink sub
|
type MkLink (Summary s :> sub) a = MkLink sub a
|
||||||
toLink _ = toLink (Proxy :: Proxy sub)
|
toLink = simpleToLink (Proxy :: Proxy sub)
|
||||||
|
|
||||||
instance HasLink sub => HasLink (HttpVersion :> sub) where
|
instance HasLink sub => HasLink (HttpVersion :> sub) where
|
||||||
type MkLink (HttpVersion:> sub) = MkLink sub
|
type MkLink (HttpVersion:> sub) a = MkLink sub a
|
||||||
toLink _ = toLink (Proxy :: Proxy sub)
|
toLink = simpleToLink (Proxy :: Proxy sub)
|
||||||
|
|
||||||
instance HasLink sub => HasLink (IsSecure :> sub) where
|
instance HasLink sub => HasLink (IsSecure :> sub) where
|
||||||
type MkLink (IsSecure :> sub) = MkLink sub
|
type MkLink (IsSecure :> sub) a = MkLink sub a
|
||||||
toLink _ = toLink (Proxy :: Proxy sub)
|
toLink = simpleToLink (Proxy :: Proxy sub)
|
||||||
|
|
||||||
instance HasLink sub => HasLink (WithNamedContext name context sub) where
|
instance HasLink sub => HasLink (WithNamedContext name context sub) where
|
||||||
type MkLink (WithNamedContext name context sub) = MkLink sub
|
type MkLink (WithNamedContext name context sub) a = MkLink sub a
|
||||||
toLink _ = toLink (Proxy :: Proxy sub)
|
toLink toA _ = toLink toA (Proxy :: Proxy sub)
|
||||||
|
|
||||||
instance HasLink sub => HasLink (RemoteHost :> sub) where
|
instance HasLink sub => HasLink (RemoteHost :> sub) where
|
||||||
type MkLink (RemoteHost :> sub) = MkLink sub
|
type MkLink (RemoteHost :> sub) a = MkLink sub a
|
||||||
toLink _ = toLink (Proxy :: Proxy sub)
|
toLink = simpleToLink (Proxy :: Proxy sub)
|
||||||
|
|
||||||
instance HasLink sub => HasLink (BasicAuth realm a :> sub) where
|
instance HasLink sub => HasLink (BasicAuth realm a :> sub) where
|
||||||
type MkLink (BasicAuth realm a :> sub) = MkLink sub
|
type MkLink (BasicAuth realm a :> sub) r = MkLink sub r
|
||||||
toLink _ = toLink (Proxy :: Proxy sub)
|
toLink = simpleToLink (Proxy :: Proxy sub)
|
||||||
|
|
||||||
instance HasLink EmptyAPI where
|
instance HasLink EmptyAPI where
|
||||||
type MkLink EmptyAPI = EmptyAPI
|
type MkLink EmptyAPI a = EmptyAPI
|
||||||
toLink _ _ = EmptyAPI
|
toLink _ _ _ = EmptyAPI
|
||||||
|
|
||||||
-- Verb (terminal) instances
|
-- Verb (terminal) instances
|
||||||
instance HasLink (Verb m s ct a) where
|
instance HasLink (Verb m s ct a) where
|
||||||
type MkLink (Verb m s ct a) = Link
|
type MkLink (Verb m s ct a) r = r
|
||||||
toLink _ = id
|
toLink toA _ = toA
|
||||||
|
|
||||||
instance HasLink Raw where
|
instance HasLink Raw where
|
||||||
type MkLink Raw = Link
|
type MkLink Raw a = a
|
||||||
toLink _ = id
|
toLink toA _ = toA
|
||||||
|
|
||||||
instance HasLink (Stream m fr ct a) where
|
instance HasLink (Stream m fr ct a) where
|
||||||
type MkLink (Stream m fr ct a) = Link
|
type MkLink (Stream m fr ct a) r = r
|
||||||
toLink _ = id
|
toLink toA _ = toA
|
||||||
|
|
||||||
-- AuthProtext instances
|
-- AuthProtext instances
|
||||||
instance HasLink sub => HasLink (AuthProtect tag :> sub) where
|
instance HasLink sub => HasLink (AuthProtect tag :> sub) where
|
||||||
type MkLink (AuthProtect tag :> sub) = MkLink sub
|
type MkLink (AuthProtect tag :> sub) a = MkLink sub a
|
||||||
toLink _ = toLink (Proxy :: Proxy sub)
|
toLink = simpleToLink (Proxy :: Proxy sub)
|
||||||
|
|
||||||
|
-- | Helper for implemneting 'toLink' for combinators not affecting link
|
||||||
|
-- structure.
|
||||||
|
simpleToLink
|
||||||
|
:: forall sub a combinator.
|
||||||
|
(HasLink sub, MkLink sub a ~ MkLink (combinator :> sub) a)
|
||||||
|
=> Proxy sub
|
||||||
|
-> (Link -> a)
|
||||||
|
-> Proxy (combinator :> sub)
|
||||||
|
-> Link
|
||||||
|
-> MkLink (combinator :> sub) a
|
||||||
|
simpleToLink _ toA _ = toLink toA (Proxy :: Proxy sub)
|
||||||
|
|
||||||
|
|
||||||
-- $setup
|
-- $setup
|
||||||
-- >>> import Servant.API
|
-- >>> import Servant.API
|
||||||
|
|
|
||||||
|
|
@ -41,7 +41,7 @@ type LinkableApi =
|
||||||
|
|
||||||
|
|
||||||
apiLink :: (IsElem endpoint TestApi, HasLink endpoint)
|
apiLink :: (IsElem endpoint TestApi, HasLink endpoint)
|
||||||
=> Proxy endpoint -> MkLink endpoint
|
=> Proxy endpoint -> MkLink endpoint Link
|
||||||
apiLink = safeLink (Proxy :: Proxy TestApi)
|
apiLink = safeLink (Proxy :: Proxy TestApi)
|
||||||
|
|
||||||
-- | Convert a link to a URI and ensure that this maps to the given string
|
-- | Convert a link to a URI and ensure that this maps to the given string
|
||||||
|
|
|
||||||
Loading…
Reference in a new issue