Merge pull request #1005 from haskell-servant/using-free-client
Add 'using free client' recipe
This commit is contained in:
Oleg Grenrus
GitHub
commit
bd8c5b96c3
20
.travis.yml
20
.travis.yml
|
|
@ -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'
|
||||
|
|
|
|||
|
|
@ -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,
|
||||
|
|
|
|||
|
|
@ -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
194
doc/cookbook/using-free-client/UsingFreeClient.lhs
Normal 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
26
doc/cookbook/using-free-client/using-free-client.cabal
Normal 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
|
||||
Loading…
Reference in New Issue
Block a user