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

Merge pull request #1005 from haskell-servant/using-free-client

Browse source 
Add 'using free client' recipe
This commit is contained in:
Oleg Grenrus 2018-07-06 04:18:19 +03:00 committed by GitHub
commit bd8c5b96c3
No known key found for this signature in database
GPG key ID: 4AEE18F83AFDEB23
5 changed files with 236 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

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

@ -0,0 +1,194 @@
# Inspecting, debugging, simulating clients and more
or simply put: _a practical introduction to `Servant.Client.Free`_.
Someone asked on IRC how one could access the intermediate Requests (resp. Responses)
produced (resp. received) by client functions derived using servant-client.
My response to such inquiries is: to extend `servant-client` in an ad-hoc way (e.g for testing or debugging
purposes), use `Servant.Client.Free`. This recipe shows how.
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 passed
`"client"` it will run a `test` function (to be defined next). This should be
pretty straightforward:
```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 client part, we will use a `Servant.Client.Free` client.
Because we have a single endpoint API, we'll get a single client function,
running in the `Free ClientF` (free) monad:
```haskell
getSquare :: Int -> Free ClientF Int
getSquare = client api
```
Such clients are "client functions without a backend", so to speak,
or where the backend has been abstracted out. To be more precise, `ClientF` is a functor that
precisely represents the operations servant-client-core needs from an http client backend.
So if we are to emulate one or augment what such a backend does, it will be by interpreting
all those operations, the way we want to. This also means we get access to the requests and
responses and can do anything we want with them, right when they are produced or consumed,
respectively.
Next, we can write our small test. We'll pass a value to `getSquare` and inspect
the `Free` structure. The first three possibilities are self-explanatory:
```haskell
test :: IO ()
test = case getSquare 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`'s 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`'s request does a little more, but this is good enough for
our demo. We get back an 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 the client functions or the HTTP client backend does what we expect
(e.g by printing requests/responses on the fly). In fact, using `Servant.Client.Free`
is a little simpler than defining a custom `RunClient` instance, especially
for those cases where it is handy to have the full sequence of client calls
and responses available for us to inspect, since `RunClient` only gives us
access to one `Request` or `Response` at a time.
On the other hand, a "batch collection" of requests and/or responses can be achieved
with both free clients and a custom `RunClient` instance rather easily, for example
by using a `Writer [(Request, Response)]` monad.
Here is an example of running our small `test` against a running server:
```
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