git.iko.soy/typeable/servant
on master help sign in
Add 'using free client' recipe
8dc323eOleg Grenrus
.travis.yml+14−6
compare with master
unifiedsplit
@@ -72,11 +72,11 @@ install:
72 - rm -fv cabal.project cabal.project.local
72 - rm -fv cabal.project cabal.project.local
73 - "if [ $HCNUMVER -ge 70800 ]; then sed -i.bak 's/-- ghc-options:.*/ghc-options: -j2/' ${HOME}/.cabal/config; fi"
73 - "if [ $HCNUMVER -ge 70800 ]; then sed -i.bak 's/-- ghc-options:.*/ghc-options: -j2/' ${HOME}/.cabal/config; fi"
74 - grep -Ev -- '^\s*--' ${HOME}/.cabal/config | grep -Ev '^\s*$'
74 - grep -Ev -- '^\s*--' ${HOME}/.cabal/config | grep -Ev '^\s*$'
75− - "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"
75+ - "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"
76 - "echo 'constraints: foundation >=0.0.14,memory <0.14.12 || >0.14.12' >> cabal.project"
76 - "echo 'constraints: foundation >=0.0.14,memory <0.14.12 || >0.14.12' >> cabal.project"
77 - "echo 'allow-newer: servant-auth-server:http-types,servant-auth-server:servant-server, servant-pagination:servant,servant-pagination:servant-server' >> cabal.project"
77 - "echo 'allow-newer: servant-auth-server:http-types,servant-auth-server:servant-server, servant-pagination:servant,servant-pagination:servant-server' >> cabal.project"
78 - touch cabal.project.local
78 - touch cabal.project.local
79− - "if ! $NOINSTALLEDCONSTRAINTS; then for pkg in $($HCPKG list --simple-output); do echo $pkg | sed 's/^/constraints: /' | sed 's/-[^-]*$/ installed/' >> cabal.project.local; done; fi"
79+ - "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"
80 - cat cabal.project || true
80 - cat cabal.project || true
81 - cat cabal.project.local || true
81 - cat cabal.project.local || true
82 - if [ -f "servant/configure.ac" ]; then
82 - if [ -f "servant/configure.ac" ]; then
@@ -112,6 +112,9 @@ install:
112 - if [ -f "doc/cookbook/file-upload/configure.ac" ]; then
112 - if [ -f "doc/cookbook/file-upload/configure.ac" ]; then
113 (cd "doc/cookbook/file-upload" && autoreconf -i);
113 (cd "doc/cookbook/file-upload" && autoreconf -i);
114 fi
114 fi
115+ - if [ -f "doc/cookbook/generic/configure.ac" ]; then
116+ (cd "doc/cookbook/generic" && autoreconf -i);
117+ fi
115 - if [ -f "doc/cookbook/https/configure.ac" ]; then
118 - if [ -f "doc/cookbook/https/configure.ac" ]; then
116 (cd "doc/cookbook/https" && autoreconf -i);
119 (cd "doc/cookbook/https" && autoreconf -i);
117 fi
120 fi
@@ -127,8 +130,11 @@ install:
127 - if [ -f "doc/cookbook/using-custom-monad/configure.ac" ]; then
130 - if [ -f "doc/cookbook/using-custom-monad/configure.ac" ]; then
128 (cd "doc/cookbook/using-custom-monad" && autoreconf -i);
131 (cd "doc/cookbook/using-custom-monad" && autoreconf -i);
129 fi
132 fi
133+ - if [ -f "doc/cookbook/using-free-client/configure.ac" ]; then
134+ (cd "doc/cookbook/using-free-client" && autoreconf -i);
135+ fi
130 - rm -f cabal.project.freeze
136 - rm -f cabal.project.freeze
131− - 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
137+ - 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
132 - DISTDIR=$(mktemp -d /tmp/dist-test.XXXX)
138 - DISTDIR=$(mktemp -d /tmp/dist-test.XXXX)
133
139
134# Here starts the actual work to be performed for the package under test;
140# Here starts the actual work to be performed for the package under test;
@@ -147,21 +153,23 @@ script:
147 - (cd "doc/cookbook/db-postgres-pool" && cabal sdist)
153 - (cd "doc/cookbook/db-postgres-pool" && cabal sdist)
148 - (cd "doc/cookbook/db-sqlite-simple" && cabal sdist)
154 - (cd "doc/cookbook/db-sqlite-simple" && cabal sdist)
149 - (cd "doc/cookbook/file-upload" && cabal sdist)
155 - (cd "doc/cookbook/file-upload" && cabal sdist)
156+ - (cd "doc/cookbook/generic" && cabal sdist)
150 - (cd "doc/cookbook/https" && cabal sdist)
157 - (cd "doc/cookbook/https" && cabal sdist)
151 - (cd "doc/cookbook/jwt-and-basic-auth" && cabal sdist)
158 - (cd "doc/cookbook/jwt-and-basic-auth" && cabal sdist)
152 - (cd "doc/cookbook/pagination" && cabal sdist)
159 - (cd "doc/cookbook/pagination" && cabal sdist)
153 - (cd "doc/cookbook/structuring-apis" && cabal sdist)
160 - (cd "doc/cookbook/structuring-apis" && cabal sdist)
154 - (cd "doc/cookbook/using-custom-monad" && cabal sdist)
161 - (cd "doc/cookbook/using-custom-monad" && cabal sdist)
162+ - (cd "doc/cookbook/using-free-client" && cabal sdist)
155 - echo -en 'travis_fold:end:sdist\\r'
163 - echo -en 'travis_fold:end:sdist\\r'
156 - echo Unpacking... && echo -en 'travis_fold:start:unpack\\r'
164 - echo Unpacking... && echo -en 'travis_fold:start:unpack\\r'
157− - 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}/
165+ - 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}/
158 - cd ${DISTDIR} || false
166 - cd ${DISTDIR} || false
159 - find . -maxdepth 1 -name '*.tar.gz' -exec tar -xvf '{}' \;
167 - find . -maxdepth 1 -name '*.tar.gz' -exec tar -xvf '{}' \;
160− - "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"
168+ - "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"
161 - "echo 'constraints: foundation >=0.0.14,memory <0.14.12 || >0.14.12' >> cabal.project"
169 - "echo 'constraints: foundation >=0.0.14,memory <0.14.12 || >0.14.12' >> cabal.project"
162 - "echo 'allow-newer: servant-auth-server:http-types,servant-auth-server:servant-server, servant-pagination:servant,servant-pagination:servant-server' >> cabal.project"
170 - "echo 'allow-newer: servant-auth-server:http-types,servant-auth-server:servant-server, servant-pagination:servant,servant-pagination:servant-server' >> cabal.project"
163 - touch cabal.project.local
171 - touch cabal.project.local
164− - "if ! $NOINSTALLEDCONSTRAINTS; then for pkg in $($HCPKG list --simple-output); do echo $pkg | sed 's/^/constraints: /' | sed 's/-[^-]*$/ installed/' >> cabal.project.local; done; fi"
172+ - "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"
165 - cat cabal.project || true
173 - cat cabal.project || true
166 - cat cabal.project.local || true
174 - cat cabal.project.local || true
167 - echo -en 'travis_fold:end:unpack\\r'
175 - echo -en 'travis_fold:end:unpack\\r'
cabal.project+1
@@ -18,6 +18,7 @@ packages: servant/
18 doc/cookbook/pagination
18 doc/cookbook/pagination
19 doc/cookbook/structuring-apis
19 doc/cookbook/structuring-apis
20 doc/cookbook/using-custom-monad
20 doc/cookbook/using-custom-monad
21+ doc/cookbook/using-free-client
21
22
22allow-newer:
23allow-newer:
23 servant-auth-server:http-types,
24 servant-auth-server:http-types,
doc/cookbook/index.rst+1
@@ -23,6 +23,7 @@ you name it!
23 db-sqlite-simple/DBConnection.lhs
23 db-sqlite-simple/DBConnection.lhs
24 db-postgres-pool/PostgresPool.lhs
24 db-postgres-pool/PostgresPool.lhs
25 using-custom-monad/UsingCustomMonad.lhs
25 using-custom-monad/UsingCustomMonad.lhs
26+ using-free-client/UsingFreeClient.lhs
26 basic-auth/BasicAuth.lhs
27 basic-auth/BasicAuth.lhs
27 jwt-and-basic-auth/JWTAndBasicAuth.lhs
28 jwt-and-basic-auth/JWTAndBasicAuth.lhs
28 file-upload/FileUpload.lhs
29 file-upload/FileUpload.lhs
doc/cookbook/using-free-client/UsingFreeClient.lhsnew file+173
@@ -0,0 +1,173 @@
1+# Using Free Client (for tests)
2+
3+Someone asked on IRC about getting `Request` & `Response` of what
4+`servant-client` uses, for testing purposes. My response: to ad-hoc extend
5+`servant-client` (as for tests), use `Servant.Client.Free`. This recipe is an
6+evidence.
7+
8+First the module header, but this time We'll comment the imports.
9+
10+```haskell
11+{-# LANGUAGE DataKinds #-}
12+{-# LANGUAGE TypeOperators #-}
13+module Main (main) where
14+```
15+
16+We will primarily use `Servant.Client.Free`, it doesn't re-export anything
17+from `free` package, so we need to import it as well.
18+
19+```haskell
20+import Control.Monad.Free
21+import Servant.Client.Free
22+```
23+
24+Also we'll use `servant-client` internals, which uses `http-client`,
25+so let's import them *qualified*
26+
27+```haskell
28+import qualified Servant.Client.Internal.HttpClient as I
29+import qualified Network.HTTP.Client as HTTP
30+```
31+
32+The rest of the imports are for a server we implement here for completeness.
33+
34+```haskell
35+import Servant
36+import Network.Wai.Handler.Warp (run)
37+import System.Environment (getArgs)
38+```
39+
40+## API & Main
41+
42+We'll work with a very simple API:
43+
44+```haskell
45+type API = "square" :> Capture "n" Int :> Get '[JSON] Int
46+
47+api :: Proxy API
48+api = Proxy
49+```
50+
51+Next we implement a `main`. If passed `server` it will run `server`, if
52+`client` a small `test` (to be defined next) will be run. This should be pretty
53+straigh-forward:
54+
55+```haskell
56+main :: IO ()
57+main = do
58+ args <- getArgs
59+ case args of
60+ ("server":_) -> do
61+ putStrLn "Starting cookbook-using-free-client at http://localhost:8000"
62+ run 8000 $ serve api $ \n -> return (n * n)
63+ ("client":_) ->
64+ test
65+ _ -> do
66+ putStrLn "Try:"
67+ putStrLn "cabal new-run cookbook-using-free-client server"
68+ putStrLn "cabal new-run cookbook-using-free-client client"
69+```
70+
71+## Test
72+
73+In the actual test, we'll use a `Servant.Client.Free` client.
74+Cecause we have a single endpoint API, we'll get a single client function:
75+
76+```haskell
77+fcli :: Int -> Free ClientF Int
78+fcli = client api
79+```
80+
81+Next, we can write our small test. We'll pass a value to `fcli` and inspect
82+the `Free` structure. First three possibilities are self-explanatory:
83+
84+```haskell
85+test :: IO ()
86+test = case fcli 42 of
87+ Pure n ->
88+ putStrLn $ "ERROR: got pure result: " ++ show n
89+ Free (Throw err) ->
90+ putStrLn $ "ERROR: got error right away: " ++ show err
91+ Free (StreamingRequest _req _k) ->
92+ putStrLn $ "ERROR: need to do streaming request" -- TODO: no Show Req :(
93+```
94+
95+We are interested in `RunRequest`, that's what client should block on:
96+
97+```haskell
98+ Free (RunRequest req k) -> do
99+```
100+
101+Then we need to prepare the context, get HTTP (connection) `Manager`
102+and `BaseUrl`:
103+
104+```haskell
105+ burl <- parseBaseUrl "http://localhost:8000"
106+ mgr <- HTTP.newManager HTTP.defaultManagerSettings
107+```
108+
109+Now we can use `servant-client` internals to convert servant's `Request`
110+to http-client's `Request`, and we can inspect it:
111+
112+```haskell
113+ let req' = I.requestToClientRequest burl req
114+ putStrLn $ "Making request: " ++ show req'
115+```
116+
117+`servant-client` does a bit more than `httpLbs`, but that's enough for us.
118+We get back a http-client `Response` which we can also inspect
119+
120+```haskell
121+ res' <- HTTP.httpLbs req' mgr
122+ putStrLn $ "Got response: " ++ show res'
123+```
124+
125+And we continue by turning http-client's `Response` into servant's `Response`,
126+and calling the continuation. We should get a `Pure` value.
127+
128+```haskell
129+ let res = I.clientResponseToResponse res'
130+
131+ case k res of
132+ Pure n ->
133+ putStrLn $ "Expected 1764, got " ++ show n
134+ _ ->
135+ putStrLn "ERROR: didn't got a response"
136+```
137+
138+So that's it. Using `Free` we can evaluate servant clients step-by-step, and
139+validate that they or the backend does what we expect (think: debugger). At the
140+end an example of client run (prettified):
141+
142+```
143+Making request: Request {
144+ host = "localhost"
145+ port = 8000
146+ secure = False
147+ requestHeaders = [("Accept","application/json;charset=utf-8,application/json")]
148+ path = "/square/42"
149+ queryString = ""
150+ method = "GET"
151+ proxy = Nothing
152+ rawBody = False
153+ redirectCount = 10
154+ responseTimeout = ResponseTimeoutDefault
155+ requestVersion = HTTP/1.1
156+}
157+
158+Got response: Response
159+ { responseStatus = Status {statusCode = 200, statusMessage = "OK"}
160+ , responseVersion = HTTP/1.1
161+ , responseHeaders =
162+ [ ("Transfer-Encoding","chunked")
163+ , ("Date","Thu, 05 Jul 2018 21:12:41 GMT")
164+ , ("Server","Warp/3.2.22")
165+ , ("Content-Type","application/json;charset=utf-8")
166+ ]
167+ , responseBody = "1764"
168+ , responseCookieJar = CJ {expose = []}
169+ , responseClose' = ResponseClose
170+ }
171+
172+Expected 1764, got 1764
173+```
doc/cookbook/using-free-client/using-free-client.cabalnew file+26
@@ -0,0 +1,26 @@
1+name: cookbook-using-free-client
2+version: 0.1
3+synopsis: Using Free client
4+homepage: http://haskell-servant.readthedocs.org/
5+license: BSD3
6+license-file: ../../../servant/LICENSE
7+author: Servant Contributors
8+maintainer: haskell-servant-maintainers@googlegroups.com
9+build-type: Simple
10+cabal-version: >=1.10
11+tested-with: GHC==7.8.4, GHC==7.10.3, GHC==8.0.2, GHC==8.2.2, GHC==8.4.3
12+
13+executable cookbook-using-free-client
14+ main-is: UsingFreeClient.lhs
15+ build-depends: base == 4.*
16+ , free
17+ , servant
18+ , servant-client
19+ , http-client
20+ , servant-client-core
21+ , base-compat
22+ , servant-server
23+ , warp >= 3.2
24+ default-language: Haskell2010
25+ ghc-options: -Wall -pgmL markdown-unlit
26+ build-tool-depends: markdown-unlit:markdown-unlit >= 0.4