Add 'using free client' recipe
This commit is contained in:
Oleg Grenrus
parent
f536c90fa5
commit
8dc323ef0a
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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
```
|
||||
|
|
@ -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