eeva/servant
1
0
Fork 0
Code Issues Pull requests Projects Releases Wiki Activity

Add 'using free client' recipe

Browse source
This commit is contained in:
Oleg Grenrus 2018-07-06 00:21:17 +03:00
parent f536c90fa5
commit 8dc323ef0a
5 changed files with 215 additions and 6 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

20
.travis.yml
View file

@ -72,11 +72,11 @@ install:
- 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"
- 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/basic-auth\" \"doc/cookbook/db-postgres-pool\" \"doc/cookbook/db-sqlite-simple\" \"doc/cookbook/file-upload\" \"doc/cookbook/https\" \"doc/cookbook/jwt-and-basic-auth\" \"doc/cookbook/pagination\" \"doc/cookbook/structuring-apis\" \"doc/cookbook/using-custom-monad\"\\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/file-upload\" \"doc/cookbook/generic\" \"doc/cookbook/https\" \"doc/cookbook/jwt-and-basic-auth\" \"doc/cookbook/pagination\" \"doc/cookbook/structuring-apis\" \"doc/cookbook/using-custom-monad\" \"doc/cookbook/using-free-client\"\\n' > cabal.project"
- "echo 'constraints: foundation >=0.0.14,memory <0.14.12 || >0.14.12' >> cabal.project"
- "echo 'allow-newer: servant-auth-server:http-types,servant-auth-server:servant-server, servant-pagination:servant,servant-pagination:servant-server' >> cabal.project"
- touch cabal.project.local
- "if ! $NOINSTALLEDCONSTRAINTS; then for pkg in $($HCPKG list --simple-output); do echo $pkg | sed 's/^/constraints: /' | sed 's/-[^-]*$/ installed/' >> cabal.project.local; done; fi"
- "if ! $NOINSTALLEDCONSTRAINTS; then for pkg in $($HCPKG list --simple-output); do echo $pkg | grep -vw -- servant | grep -vw -- servant-client | grep -vw -- servant-client-core | grep -vw -- servant-docs | grep -vw -- servant-foreign | grep -vw -- servant-server | grep -vw -- tutorial | grep -vw -- cookbook-basic-auth | grep -vw -- cookbook-db-postgres-pool | grep -vw -- cookbook-db-sqlite-simple | grep -vw -- cookbook-file-upload | grep -vw -- cookbook-generic | grep -vw -- cookbook-https | grep -vw -- cookbook-jwt-and-basic-auth | grep -vw -- cookbook-pagination | grep -vw -- cookbook-structuring-apis | grep -vw -- cookbook-using-custom-monad | grep -vw -- cookbook-using-free-client | sed 's/^/constraints: /' | sed 's/-[^-]*$/ installed/' >> cabal.project.local; done; fi"
- cat cabal.project || true
- cat cabal.project.local || true
- if [ -f "servant/configure.ac" ]; then
@ -112,6 +112,9 @@ install:
- if [ -f "doc/cookbook/file-upload/configure.ac" ]; then
(cd "doc/cookbook/file-upload" && autoreconf -i);
fi
- if [ -f "doc/cookbook/generic/configure.ac" ]; then
(cd "doc/cookbook/generic" && autoreconf -i);
fi
- if [ -f "doc/cookbook/https/configure.ac" ]; then
(cd "doc/cookbook/https" && autoreconf -i);
fi
@ -127,8 +130,11 @@ install:
- if [ -f "doc/cookbook/using-custom-monad/configure.ac" ]; then
(cd "doc/cookbook/using-custom-monad" && autoreconf -i);
fi
- if [ -f "doc/cookbook/using-free-client/configure.ac" ]; then
(cd "doc/cookbook/using-free-client" && autoreconf -i);
fi
- 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/basic-auth"/dist "doc/cookbook/db-postgres-pool"/dist "doc/cookbook/db-sqlite-simple"/dist "doc/cookbook/file-upload"/dist "doc/cookbook/https"/dist "doc/cookbook/jwt-and-basic-auth"/dist "doc/cookbook/pagination"/dist "doc/cookbook/structuring-apis"/dist "doc/cookbook/using-custom-monad"/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/file-upload"/dist "doc/cookbook/generic"/dist "doc/cookbook/https"/dist "doc/cookbook/jwt-and-basic-auth"/dist "doc/cookbook/pagination"/dist "doc/cookbook/structuring-apis"/dist "doc/cookbook/using-custom-monad"/dist "doc/cookbook/using-free-client"/dist
- DISTDIR=$(mktemp -d /tmp/dist-test.XXXX)
# Here starts the actual work to be performed for the package under test;
@ -147,21 +153,23 @@ script:
- (cd "doc/cookbook/db-postgres-pool" && cabal sdist)
- (cd "doc/cookbook/db-sqlite-simple" && cabal sdist)
- (cd "doc/cookbook/file-upload" && cabal sdist)
- (cd "doc/cookbook/generic" && cabal sdist)
- (cd "doc/cookbook/https" && cabal sdist)
- (cd "doc/cookbook/jwt-and-basic-auth" && cabal sdist)
- (cd "doc/cookbook/pagination" && cabal sdist)
- (cd "doc/cookbook/structuring-apis" && cabal sdist)
- (cd "doc/cookbook/using-custom-monad" && cabal sdist)
- (cd "doc/cookbook/using-free-client" && cabal sdist)
- echo -en 'travis_fold:end:sdist\\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/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/file-upload"/dist/cookbook-file-upload-*.tar.gz "doc/cookbook/https"/dist/cookbook-https-*.tar.gz "doc/cookbook/jwt-and-basic-auth"/dist/cookbook-jwt-and-basic-auth-*.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}/
- 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/file-upload"/dist/cookbook-file-upload-*.tar.gz "doc/cookbook/generic"/dist/cookbook-generic-*.tar.gz "doc/cookbook/https"/dist/cookbook-https-*.tar.gz "doc/cookbook/jwt-and-basic-auth"/dist/cookbook-jwt-and-basic-auth-*.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 "doc/cookbook/using-free-client"/dist/cookbook-using-free-client-*.tar.gz ${DISTDIR}/
- cd ${DISTDIR} || false
- 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-basic-auth-*/*.cabal cookbook-db-postgres-pool-*/*.cabal cookbook-db-sqlite-simple-*/*.cabal cookbook-file-upload-*/*.cabal cookbook-https-*/*.cabal cookbook-jwt-and-basic-auth-*/*.cabal cookbook-pagination-*/*.cabal cookbook-structuring-apis-*/*.cabal cookbook-using-custom-monad-*/*.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-file-upload-*/*.cabal cookbook-generic-*/*.cabal cookbook-https-*/*.cabal cookbook-jwt-and-basic-auth-*/*.cabal cookbook-pagination-*/*.cabal cookbook-structuring-apis-*/*.cabal cookbook-using-custom-monad-*/*.cabal cookbook-using-free-client-*/*.cabal\\n' > cabal.project"
- "echo 'constraints: foundation >=0.0.14,memory <0.14.12 || >0.14.12' >> cabal.project"
- "echo 'allow-newer: servant-auth-server:http-types,servant-auth-server:servant-server, servant-pagination:servant,servant-pagination:servant-server' >> cabal.project"
- touch cabal.project.local
- "if ! $NOINSTALLEDCONSTRAINTS; then for pkg in $($HCPKG list --simple-output); do echo $pkg | sed 's/^/constraints: /' | sed 's/-[^-]*$/ installed/' >> cabal.project.local; done; fi"
- "if ! $NOINSTALLEDCONSTRAINTS; then for pkg in $($HCPKG list --simple-output); do echo $pkg | grep -vw -- servant | grep -vw -- servant-client | grep -vw -- servant-client-core | grep -vw -- servant-docs | grep -vw -- servant-foreign | grep -vw -- servant-server | grep -vw -- tutorial | grep -vw -- cookbook-basic-auth | grep -vw -- cookbook-db-postgres-pool | grep -vw -- cookbook-db-sqlite-simple | grep -vw -- cookbook-file-upload | grep -vw -- cookbook-generic | grep -vw -- cookbook-https | grep -vw -- cookbook-jwt-and-basic-auth | grep -vw -- cookbook-pagination | grep -vw -- cookbook-structuring-apis | grep -vw -- cookbook-using-custom-monad | grep -vw -- cookbook-using-free-client | sed 's/^/constraints: /' | sed 's/-[^-]*$/ installed/' >> cabal.project.local; done; fi"
- cat cabal.project || true
- cat cabal.project.local || true
- echo -en 'travis_fold:end:unpack\\r'

1
cabal.project
View file

@ -18,6 +18,7 @@ packages: servant/
doc/cookbook/pagination
doc/cookbook/structuring-apis
doc/cookbook/using-custom-monad
doc/cookbook/using-free-client
allow-newer:
servant-auth-server:http-types,

1
doc/cookbook/index.rst
View file

@ -23,6 +23,7 @@ you name it!
db-sqlite-simple/DBConnection.lhs
db-postgres-pool/PostgresPool.lhs
using-custom-monad/UsingCustomMonad.lhs
using-free-client/UsingFreeClient.lhs
basic-auth/BasicAuth.lhs
jwt-and-basic-auth/JWTAndBasicAuth.lhs
file-upload/FileUpload.lhs

173
doc/cookbook/using-free-client/UsingFreeClient.lhs Normal file
View file

@ -0,0 +1,173 @@
# Using Free Client (for tests)
Someone asked on IRC about getting `Request` & `Response` of what
`servant-client` uses, for testing purposes. My response: to ad-hoc extend
`servant-client` (as for tests), use `Servant.Client.Free`. This recipe is an
evidence.
First the module header, but this time We'll comment the imports.
```haskell
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeOperators #-}
module Main (main) where
```
We will primarily use `Servant.Client.Free`, it doesn't re-export anything
from `free` package, so we need to import it as well.
```haskell
import Control.Monad.Free
import Servant.Client.Free
```
Also we'll use `servant-client` internals, which uses `http-client`,
so let's import them *qualified*
```haskell
import qualified Servant.Client.Internal.HttpClient as I
import qualified Network.HTTP.Client as HTTP
```
The rest of the imports are for a server we implement here for completeness.
```haskell
import Servant
import Network.Wai.Handler.Warp (run)
import System.Environment (getArgs)
```
## API & Main
We'll work with a very simple API:
```haskell
type API = "square" :> Capture "n" Int :> Get '[JSON] Int
api :: Proxy API
api = Proxy
```
Next we implement a `main`. If passed `server` it will run `server`, if
`client` a small `test` (to be defined next) will be run. This should be pretty
straigh-forward:
```haskell
main :: IO ()
main = do
args <- getArgs
case args of
("server":_) -> do
putStrLn "Starting cookbook-using-free-client at http://localhost:8000"
run 8000 $ serve api $ \n -> return (n * n)
("client":_) ->
test
_ -> do
putStrLn "Try:"
putStrLn "cabal new-run cookbook-using-free-client server"
putStrLn "cabal new-run cookbook-using-free-client client"
```
## Test
In the actual test, we'll use a `Servant.Client.Free` client.
Cecause we have a single endpoint API, we'll get a single client function:
```haskell
fcli :: Int -> Free ClientF Int
fcli = client api
```
Next, we can write our small test. We'll pass a value to `fcli` and inspect
the `Free` structure. First three possibilities are self-explanatory:
```haskell
test :: IO ()
test = case fcli 42 of
Pure n ->
putStrLn $ "ERROR: got pure result: " ++ show n
Free (Throw err) ->
putStrLn $ "ERROR: got error right away: " ++ show err
Free (StreamingRequest _req _k) ->
putStrLn $ "ERROR: need to do streaming request" -- TODO: no Show Req :(
```
We are interested in `RunRequest`, that's what client should block on:
```haskell
Free (RunRequest req k) -> do
```
Then we need to prepare the context, get HTTP (connection) `Manager`
and `BaseUrl`:
```haskell
burl <- parseBaseUrl "http://localhost:8000"
mgr <- HTTP.newManager HTTP.defaultManagerSettings
```
Now we can use `servant-client` internals to convert servant's `Request`
to http-client's `Request`, and we can inspect it:
```haskell
let req' = I.requestToClientRequest burl req
putStrLn $ "Making request: " ++ show req'
```
`servant-client` does a bit more than `httpLbs`, but that's enough for us.
We get back a http-client `Response` which we can also inspect
```haskell
res' <- HTTP.httpLbs req' mgr
putStrLn $ "Got response: " ++ show res'
```
And we continue by turning http-client's `Response` into servant's `Response`,
and calling the continuation. We should get a `Pure` value.
```haskell
let res = I.clientResponseToResponse res'
case k res of
Pure n ->
putStrLn $ "Expected 1764, got " ++ show n
_ ->
putStrLn "ERROR: didn't got a response"
```
So that's it. Using `Free` we can evaluate servant clients step-by-step, and
validate that they or the backend does what we expect (think: debugger). At the
end an example of client run (prettified):
```
Making request: Request {
host = "localhost"
port = 8000
secure = False
requestHeaders = [("Accept","application/json;charset=utf-8,application/json")]
path = "/square/42"
queryString = ""
method = "GET"
proxy = Nothing
rawBody = False
redirectCount = 10
responseTimeout = ResponseTimeoutDefault
requestVersion = HTTP/1.1
}
Got response: Response
{ responseStatus = Status {statusCode = 200, statusMessage = "OK"}
, responseVersion = HTTP/1.1
, responseHeaders =
[ ("Transfer-Encoding","chunked")
, ("Date","Thu, 05 Jul 2018 21:12:41 GMT")
, ("Server","Warp/3.2.22")
, ("Content-Type","application/json;charset=utf-8")
]
, responseBody = "1764"
, responseCookieJar = CJ {expose = []}
, responseClose' = ResponseClose
}
Expected 1764, got 1764
```

26
doc/cookbook/using-free-client/using-free-client.cabal Normal file
View file

@ -0,0 +1,26 @@
name: cookbook-using-free-client
version: 0.1
synopsis: Using Free client
homepage: http://haskell-servant.readthedocs.org/
license: BSD3
license-file: ../../../servant/LICENSE
author: Servant Contributors
maintainer: haskell-servant-maintainers@googlegroups.com
build-type: Simple
cabal-version: >=1.10
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-free-client
main-is: UsingFreeClient.lhs
build-depends: base == 4.*
, free
, servant
, servant-client
, http-client
, servant-client-core
, base-compat
, servant-server
, warp >= 3.2
default-language: Haskell2010
ghc-options: -Wall -pgmL markdown-unlit
build-tool-depends: markdown-unlit:markdown-unlit >= 0.4