168 lines
4.4 KiB
Plaintext
168 lines
4.4 KiB
Plaintext
:loom anansi.markdown
|
|
|
|
# Announcing servant-quickcheck
|
|
|
|
Some time ago, we released `servant-mock`. The idea behind it is to use
|
|
`QuickCheck` to create a mock server that accords with a servant API. Not long
|
|
after, we started thinking about an analog that would, instead of mocking a
|
|
server, mock a client instead - i.e., generate random requests that conform to
|
|
an API description.
|
|
|
|
This is much closer to the traditional use of `QuickCheck`. The most obvious
|
|
use-case is checking that properties hold of an *entire* server rather than of
|
|
individual endpoints.
|
|
|
|
## `serverSatisfies`
|
|
|
|
There are a variety of best practices in writing web APIs that aren't always
|
|
obvious. As a running example, let's use a simple service that allows adding,
|
|
removing, and querying biological species. Our SQL schema is:
|
|
|
|
:d schema.sql
|
|
|
|
CREATE TABLE genus (
|
|
genus_name text PRIMARY KEY,
|
|
genus_family text NOT NULL
|
|
);
|
|
|
|
CREATE TABLE species (
|
|
species_name text PRIMARY KEY,
|
|
species_genus text NOT NULL REFERENCES genus (genus_name)
|
|
)
|
|
:
|
|
|
|
And our actual application:
|
|
|
|
:d Main.hs
|
|
{-# LANGUAGE DataKinds #-}
|
|
{-# LANGUAGE DeriveAnyClass #-}
|
|
{-# LANGUAGE DeriveGeneric #-}
|
|
{-# LANGUAGE TypeOperators #-}
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
{-# LANGUAGE RecordWildCards #-}
|
|
module Main where
|
|
|
|
import Servant
|
|
import Data.Aeson
|
|
import Database.PostgreSQL.Simple
|
|
import GHC.Generics (Generic)
|
|
import Data.Text (Text)
|
|
import Network.Wai.Handler.Warp
|
|
import Control.Monad.IO.Class (liftIO)
|
|
|
|
type API
|
|
= "species" :> (Capture "species-name" Text :> ( Get '[JSON] Species
|
|
:<|> Delete '[JSON] ())
|
|
:<|> ReqBody '[JSON] Species :> Post '[JSON] ())
|
|
-- The plural of 'species' is unfortunately also 'species'
|
|
:<|> "speciess" :> Get '[JSON] [Species]
|
|
|
|
api :: Proxy API
|
|
api = Proxy
|
|
|
|
data Species = Species
|
|
{ speciesName :: Text
|
|
, speciesGenus :: Text
|
|
} deriving (Eq, Show, Read, Generic, ToJSON, FromJSON)
|
|
|
|
data Genus = Genus
|
|
{ genusName :: Text
|
|
, genusFamily :: Text
|
|
} deriving (Eq, Show, Read, Generic, ToJSON, FromJSON)
|
|
|
|
instance FromRow Genus
|
|
instance FromRow Species
|
|
|
|
server :: Connection -> Server API
|
|
server conn = ((\sname -> liftIO (lookupSpecies conn sname)
|
|
:<|> liftIO (deleteSpecies conn sname))
|
|
:<|> (\species -> liftIO $ insertSpecies conn species))
|
|
:<|> (liftIO $ allSpecies conn)
|
|
|
|
lookupSpecies :: Connection -> Text -> IO Species
|
|
lookupSpecies conn name = do
|
|
[s] <- query conn "SELECT * FROM species WHERE species_name = ?" (Only name)
|
|
return s
|
|
|
|
deleteSpecies :: Connection -> Text -> IO ()
|
|
deleteSpecies conn name = do
|
|
_ <- execute conn "DELETE FROM species WHERE species_name = ?" (Only name)
|
|
return ()
|
|
|
|
insertSpecies :: Connection -> Species -> IO ()
|
|
insertSpecies conn Species{..} = do
|
|
_ <- execute conn "INSERT INTO species (species_name, species_genus) VALUES (?)" (speciesName, speciesGenus)
|
|
return ()
|
|
|
|
allSpecies :: Connection -> IO [Species]
|
|
allSpecies conn = do
|
|
query_ conn "SELECT * FROM species"
|
|
|
|
main :: IO ()
|
|
main = do
|
|
conn <- connectPostgreSQL "dbname=servant-quickcheck"
|
|
run 8090 (serve api $ server conn)
|
|
:
|
|
|
|
(You'll also also need to run:
|
|
|
|
```
|
|
createdb servant-quickcheck
|
|
psql --file schema.sql -d servant-quickcheck
|
|
```
|
|
|
|
If you want to run this example.)
|
|
|
|
This is a plausible effort. You might want to spend a moment thinking about what
|
|
could be improved.
|
|
|
|
:d Spec.hs
|
|
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
module Spec (main) where
|
|
|
|
import Main (server, api, Species(..))
|
|
import Test.Hspec
|
|
import Test.QuickCheck.Instances
|
|
import Servant.QuickCheck
|
|
import Test.QuickCheck (Arbitrary(..))
|
|
import Database.PostgreSQL.Simple (connectPostgreSQL)
|
|
|
|
spec :: Spec
|
|
spec = describe "the species application" $ do
|
|
let pserver = do
|
|
conn <- connectPostgreSQL "dbname=servant-quickcheck"
|
|
return $ server conn
|
|
|
|
it "should not return 500s" $ do
|
|
withServantServer api pserver $ \url ->
|
|
serverSatisfies api url defaultArgs (not500 <%> mempty)
|
|
|
|
it "should not return top-level json" $ do
|
|
withServantServer api pserver $ \url ->
|
|
serverSatisfies api url defaultArgs (onlyJsonObjects <%> mempty)
|
|
|
|
main :: IO ()
|
|
main = do
|
|
hspec spec
|
|
|
|
instance Arbitrary Species where
|
|
arbitrary = Species <$> arbitrary <*> arbitrary
|
|
:
|
|
|
|
|
|
**Note**: This post is an anansi literate file that generates multiple source
|
|
files. They are:
|
|
|
|
:f Main.hs
|
|
|Main.hs|
|
|
:
|
|
|
|
:f schema.sql
|
|
|schema.sql|
|
|
:
|
|
|
|
:f Spec.hs
|
|
|Spec.hs|
|
|
:
|