如何快速检查从 IO 构建的仆人应用程序？

Question

I am writing an API server using Servant. The server includes persistent state. I would like to use QuickCheck to write tests for the server.

The implementation of various endpoints that make up the Servant Application require a database value. Unsurprisingly, creation of the database value is in the IO monad.

I don't understand how to combine the pieces from Hspec, Wai, QuickCheck, and Servant in a way that satisfies them all.

I see that I can perform an IO as part of creating the Hspec Spec itself and I see that I can specify that an IO be performed before each item in the Hspec Spec. Neither of these capabilities seems helpful in this case. The IO needs to be performed for each QuickCheck iteration of the property. Without this, the database accumulates state from each iteration which invalidates the definition of the property (or at least makes it greatly more complicated).

Below is my attempt to create a minimal, self-contained example of this scenario.

{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE FlexibleContexts #-}

module Main where

import Data.IORef
import Test.QuickCheck
import Test.QuickCheck.Monadic
import qualified Test.Hspec.Wai.QuickCheck as QuickWai
import Test.Hspec
import Test.Hspec.Wai
import Text.Printf
import Servant
import Servant.API
import Data.Aeson
import Data.Text.Encoding
import Data.ByteString.UTF8
  ( fromString
  )

data Backend = Backend (IORef Integer)

openBackend :: Integer -> IO Backend
openBackend n = Backend <$> newIORef n

data Acknowledgement = Ok Integer

instance ToJSON Acknowledgement where
  toJSON (Ok n) = object [ "value" .= n ]

serveSomeNumber :: Backend -> Integer -> IO Acknowledgement
serveSomeNumber (Backend a) b = do
  a' <- readIORef a
  modifyIORef a (\n -> n + 1)
  return $ Ok (a' + b)

type TheAPI = Capture "SomeNumber" Integer :> Post '[JSON] Acknowledgement

theServer :: Backend -> Server TheAPI
theServer backend = liftIO . serveSomeNumber backend

theAPI :: Proxy TheAPI
theAPI = Proxy

app :: Backend -> Application
app backend = serve theAPI (theServer backend)

post' n =
  let
    url = printf "/%d" (n :: Integer)
    encoded = fromString url
  in
    post encoded ""

spec_g :: Backend -> Spec
spec_g (Backend expectedResult) =
  describe "foo" $
  it "bar" $ property $ \genN -> monadicIO $ do
  n <- run genN
  m <- run $ readIORef expectedResult
  post' n `shouldRespondWith` ResponseMatcher { matchStatus = fromInteger (n + m) }

main :: IO ()
main = do
  spec_g' <- spec_g `fmap` openBackend 16
  hspec spec_g'

This doesn't type check:

/home/exarkun/Scratch/QuickCheckIOApplication/test/Spec.hs:119:3: error:
    * Couldn't match type `WaiSession' with `PropertyM IO'
      Expected type: PropertyM IO ()
        Actual type: WaiExpectation
    * In a stmt of a 'do' block:
        post' n
          `shouldRespondWith`
            ResponseMatcher {matchStatus = fromInteger (n + m)}
      In the second argument of `($)', namely
        `do n <- run genN
            m <- run $ readIORef expectedResult
            post' n
              `shouldRespondWith`
                ResponseMatcher {matchStatus = fromInteger (n + m)}'
      In the expression:
        monadicIO
          $ do n <- run genN
               m <- run $ readIORef expectedResult
               post' n
                 `shouldRespondWith`
                   ResponseMatcher {matchStatus = fromInteger (n + m)}
    |
119 |   post' n `shouldRespondWith` ResponseMatcher { matchStatus = fromInteger (n + m) }
    |   ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^

I don't know if there is a way to fit a WaiExpectation into a PropertyM IO () at all. I don't even know if monadicIO is helpful here at all.

How can I fit these pieces together?

Answer 1

Define spec_g :: Background -> Spec , then take advantage of IO 's Functor and Monad instances.

main = do
    spec <- fmap spec_g (openBackend 16) -- fmap spec_g :: IO Background -> IO Spec
    hspec spec

or more concisely,

main = spec_g <$> openBackend 16 >>= hspec

Answer 2

IIRC, you're supposed to run each spec or property with the with function. Here's a few properties I wrote some time ago:

  with app $ describe "/reservations/" $ do
    it "responds with 404 when no reservation exists" $ WQC.property $ \rid ->
      get ("/reservations/" <> toASCIIBytes rid) `shouldRespondWith` 404

    it "responds with 200 after reservation is added" $ WQC.property $ \
      (ValidReservation r) -> do
      _ <- postJSON "/reservations" $ encode r
      let actual = get $ "/reservations/" <> toASCIIBytes (reservationId r)
      actual `shouldRespondWith` 200

The app value serves the service, and as far as I recall, it runs the IO action for each test. I did it with an in-memory database using an IORef , and that seems to be working just fine:

app :: IO Application
app = do
  ref <- newIORef Map.empty
  return $
    serve api $
    hoistServer api (Handler . runInFakeDBAndIn2019 ref) $
    server 150 []

The WQC.property function is from a qualified import:

import qualified Test.Hspec.Wai.QuickCheck as WQC

I wasn't too happy, however, with the way I had to structure my tests and properties with HSpec, so I ultimately rewrote all the tests to be driven by HUnit. I've an upcoming blog post that describes this, but I haven't published it yet.