Merge pull request #1033 from CurrySoftware/master

curl-mock cookbook example
This commit is contained in:
Alp Mestanogullari 2018-09-15 13:03:21 +02:00 committed by GitHub
commit af7ba3d6b8
No known key found for this signature in database
GPG key ID: 4AEE18F83AFDEB23
6 changed files with 258 additions and 6 deletions

View file

@ -66,11 +66,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/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"
- "printf 'packages: \"servant\" \"servant-client\" \"servant-client-core\" \"servant-docs\" \"servant-foreign\" \"servant-server\" \"doc/tutorial\" \"doc/cookbook/basic-auth\" \"doc/cookbook/curl-mock\" \"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 | 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"
- "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-curl-mock | 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
@ -97,6 +97,9 @@ install:
- if [ -f "doc/cookbook/basic-auth/configure.ac" ]; then
(cd "doc/cookbook/basic-auth" && autoreconf -i);
fi
- if [ -f "doc/cookbook/curl-mock/configure.ac" ]; then
(cd "doc/cookbook/curl-mock" && autoreconf -i);
fi
- if [ -f "doc/cookbook/db-postgres-pool/configure.ac" ]; then
(cd "doc/cookbook/db-postgres-pool" && autoreconf -i);
fi
@ -128,7 +131,7 @@ install:
(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/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
- 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/curl-mock"/dist "doc/cookbook/basic-auth"/dist "doc/cookbook/curl-mock"/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;
@ -144,6 +147,7 @@ script:
- (cd "servant-server" && cabal sdist)
- (cd "doc/tutorial" && cabal sdist)
- (cd "doc/cookbook/basic-auth" && cabal sdist)
- (cd "doc/cookbook/curl-mock" && cabal sdist)
- (cd "doc/cookbook/db-postgres-pool" && cabal sdist)
- (cd "doc/cookbook/db-sqlite-simple" && cabal sdist)
- (cd "doc/cookbook/file-upload" && cabal sdist)
@ -156,14 +160,14 @@ script:
- (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/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}/
- 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/curl-mock"/dist/cookbook-curl-mock-*.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-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"
- "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-curl-mock-*/*.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 | 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"
- "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-curl-mock | 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'

View file

@ -9,6 +9,7 @@ packages: servant/
-- doc/cookbook/*/*.cabal
doc/cookbook/basic-auth
doc/cookbook/curl-mock
doc/cookbook/db-postgres-pool
doc/cookbook/db-sqlite-simple
doc/cookbook/file-upload

View file

@ -1,5 +1,6 @@
packages:
basic-auth/
curl-mock/
db-sqlite-simple/
db-postgres-pool/
using-custom-monad/

View file

@ -0,0 +1,218 @@
# Generating mock curl calls
In this example we will generate curl requests with mock post data from a servant API.
This may be usefull for testing and development purposes.
Especially post requests with a request body are tedious to send manually.
Also, we will learn how to use the servant-foreign library to generate stuff from servant APIs.
Language extensions and imports:
``` haskell
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeOperators #-}
import Control.Lens ((^.))
import Data.Aeson.Compat
import Data.Aeson.Text
import Data.Monoid ((<>))
import Data.Proxy (Proxy (Proxy))
import Data.Text (Text)
import Data.Text.Encoding (decodeUtf8)
import qualified Data.Text.IO as T.IO
import qualified Data.Text.Lazy as LazyT
import GHC.Generics
import Servant ((:<|>), (:>), Get, JSON,
Post, ReqBody)
import Servant.Foreign (Foreign, GenerateList,
HasForeign, HasForeignType, Req,
Segment, SegmentType (Cap, Static),
argName, listFromAPI, path,
reqBody, reqMethod, reqUrl, typeFor,
unPathSegment, unSegment,)
import Test.QuickCheck.Arbitrary
import Test.QuickCheck.Arbitrary.Generic
import Test.QuickCheck.Gen (generate)
import qualified Data.Text as T
```
Let's define our API:
``` haskell
type UserAPI = "users" :> Get '[JSON] [User]
:<|> "new" :> "user" :> ReqBody '[JSON] User :> Post '[JSON] ()
data User = User
{ name :: String
, age :: Int
, email :: String
} deriving (Eq, Show, Generic)
instance Arbitrary User where
arbitrary = genericArbitrary
shrink = genericShrink
instance ToJSON User
instance FromJSON User
```
Notice the `Arbitrary User` instance which we will later need to create mock data.
Also, the obligatory servant boilerplate:
``` haskell
api :: Proxy UserAPI
api = Proxy
```
## servant-forgein and the HasForeignType Class
Servant-foreign allows us to look into the API we designed.
The entry point is `listFromAPI` which takes three types and returns a list of endpoints:
``` haskell ignore
listFromAPI :: (HasForeign lang ftype api, GenerateList ftype (Foreign ftype api)) => Proxy lang -> Proxy ftype -> Proxy api -> [Req ftype]
```
This looks a bit confusing...
[Here](https://hackage.haskell.org/package/servant-foreign-0.11.1/docs/Servant-Foreign.html#t:HasForeignType) is the documentation for the `HasForeign` typeclass.
We will not go into details here, but this allows us to create a value of type `ftype` for any type `a` in our API.
In our case we want to create a mock of every type `a`.
We create a new datatype that holds our mocked value. Well, not the mocked value itself. To mock it we need IO (random). So the promise of a mocked value after some IO is performed:
``` haskell
data NoLang
data Mocked = Mocked (IO Text)
```
Now, we create an instance of `HasForeignType` for `NoLang` and `Mocked` for every `a` that implements `ToJSON` and `Arbitrary`:
``` haskell
instance (ToJSON a, Arbitrary a) => HasForeignType NoLang Mocked a where
typeFor _ _ _ =
Mocked (genText (Proxy :: Proxy a))
```
What does `genText` do? It generates an arbitrary value of type `a` and encodes it as text. (And does some lazy to non-lazy text transformation we do not care about):
``` haskell
genText :: (ToJSON a, Arbitrary a) => Proxy a -> IO Text
genText p =
fmap (\v -> LazyT.toStrict $ encodeToLazyText v) (genArb p)
genArb :: Arbitrary a => Proxy a -> IO a
genArb _ =
generate arbitrary
```
### Generating curl calls for every endpoint
Everything is prepared now and we can start generating some curl calls.
``` haskell
generateCurl :: (GenerateList Mocked (Foreign Mocked api), HasForeign NoLang Mocked api)
=> Proxy api
-> Text
-> IO Text
generateCurl p host =
fmap T.unlines body
where
body = foldr (\endp curlCalls -> mCons (generateEndpoint host endp) curlCalls) (return [])
$ listFromAPI (Proxy :: Proxy NoLang) (Proxy :: Proxy Mocked) p
```
To understand this function, better start at the end:
`listFromAPI` gives us a list of endpoints. We iterate over them (`foldr`) and call `generateEndpoint` for every endpoint.
As generate endpoint will not return `Text` but `IO Text` (remember we need some random bits to mock), we cannot just use the cons operator but need to build `IO [Text]` from `IO Text`s.
``` haskell
mCons :: IO a -> IO [a] -> IO [a]
mCons ele list =
ele >>= \e -> list >>= \l -> return ( e : l )
```
Now comes the juicy part; accessing the endpoints data:
``` haskell
generateEndpoint :: Text -> Req Mocked -> IO Text
generateEndpoint host req =
case maybeBody of
Just body ->
body >>= \b -> return $ T.intercalate " " [ "curl", "-X", method, "-d", "'" <> b <> "'"
, "-H 'Content-Type: application/json'", host <> "/" <> url ]
Nothing ->
return $ T.intercalate " " [ "curl", "-X", method, host <> "/" <> url ]
where
method = decodeUtf8 $ req ^. reqMethod
url = T.intercalate "/" $ map segment (req ^. reqUrl . path)
maybeBody = fmap (\(Mocked io) -> io) (req ^. reqBody)
```
`servant-foreign` offers a multitude of lenses to be used with `Req`-values.
`reqMethod` gives us a straigthforward `Network.HTTP.Types.Method`, `reqUrl` the url part and so on.
Just take a look at [the docs](https://hackage.haskell.org/package/servant-foreign-0.11.1/docs/Servant-Foreign.html).
But how do we get our mocked json string? This seems to be a bit to short to be true:
``` haskell ignore
maybeBody = fmap (\(Mocked io) -> io) (req ^. reqBody)
```
But it is that simple!
The docs say `reqBody` gives us a `Maybe f`. What is `f`, you ask? As defined in `generateCurl`, `f` is `Mocked` and contains a `IO Text`. How is this `Mocked` value created? The `HasForeignType::typeFor` does it!
Of course only if the endpoint has a request body.
Some (incomplete) code for url segments:
``` haskell
segment :: Segment Mocked -> Text
segment seg =
case unSegment seg of
Static p ->
unPathSegment p
Cap arg ->
-- Left as exercise for the reader: Mock args in the url
unPathSegment $ arg ^. argName
```
And now, lets hook it all up in our main function:
``` haskell
main :: IO ()
main =
generateCurl api "localhost:8081" >>= (\v -> T.IO.putStrLn v)
```
Done:
``` curl
curl -X GET localhost:8081/users
curl -X POST -d '{"email":"wV򝣀_b򆎘:z񁊞򲙲!(3DM V","age":10,"name":"=|W"}' -H 'Content-Type: application/json' localhost:8081/new/user
```
This is of course no complete curl call mock generator, many things including path arguments are missing.
But it correctly generate mock calls for simple POST requests.
Also, we now know how to use `HasForeignType` and `listFromAPI` to generate anything we want.

View file

@ -0,0 +1,27 @@
name: cookbook-curl-mock
version: 0.1
synopsis: Generate curl mock requests cookbook example
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==8.0.2, GHC==8.2.2, GHC==8.4.3
executable cookbock-curl-mock
main-is: CurlMock.lhs
build-depends: base == 4.*
, aeson
, aeson-compat
, lens
, text
, servant
, servant-server
, servant-foreign
, QuickCheck
, generic-arbitrary
default-language: Haskell2010
ghc-options: -Wall -pgmL markdown-unlit
build-tool-depends: markdown-unlit:markdown-unlit

View file

@ -28,3 +28,4 @@ you name it!
jwt-and-basic-auth/JWTAndBasicAuth.lhs
file-upload/FileUpload.lhs
pagination/Pagination.lhs
curl-mock/CurlMock.lhs