diff --git a/.travis.yml b/.travis.yml index 755fabf4..8d500dab 100644 --- a/.travis.yml +++ b/.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' diff --git a/cabal.project b/cabal.project index 50be543b..e6e2127c 100644 --- a/cabal.project +++ b/cabal.project @@ -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, diff --git a/doc/cookbook/index.rst b/doc/cookbook/index.rst index c0bc9573..b53c7437 100644 --- a/doc/cookbook/index.rst +++ b/doc/cookbook/index.rst @@ -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 diff --git a/doc/cookbook/using-free-client/UsingFreeClient.lhs b/doc/cookbook/using-free-client/UsingFreeClient.lhs new file mode 100644 index 00000000..d866dcfc --- /dev/null +++ b/doc/cookbook/using-free-client/UsingFreeClient.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 +``` diff --git a/doc/cookbook/using-free-client/using-free-client.cabal b/doc/cookbook/using-free-client/using-free-client.cabal new file mode 100644 index 00000000..ff0fa247 --- /dev/null +++ b/doc/cookbook/using-free-client/using-free-client.cabal @@ -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