如何快速檢查從 IO 構建的仆人應用程序？

Question

我正在使用 Servant 編寫 API 服務器。 服務器包括持久狀態。 我想使用 QuickCheck 為服務器編寫測試。

構成仆人應用程序的各種端點的實現需要一個數據庫值。 不出所料，數據庫值的創建在IO monad 中。

我不明白如何將 Hspec、Wai、QuickCheck 和 Servant 中的部分組合在一起，以滿足他們所有人的需求。

我看到我可以在創建 Hspec 規范本身的過程中執行 IO，並且我看到我可以指定在 Hspec 規范中的每個項目之前執行 IO。 在這種情況下，這些功能似乎都沒有幫助。 需要為屬性的每個 QuickCheck 迭代執行 IO。 沒有這個，數據庫會從每次迭代中累積狀態，這會使屬性的定義無效（或者至少使它變得更加復雜）。

下面是我嘗試創建此場景的最小、自包含示例。

{-# 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'

這不會類型檢查：

/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) }
    |   ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^

我不知道是否有辦法將WaiExpectation放入PropertyM IO ()中。 我什至不知道monadicIO在這里是否有幫助。

我怎樣才能將這些部分組合在一起？

Answer 1

定義spec_g :: Background -> Spec ，然后利用IO的Functor和Monad實例。

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

或者更簡潔地說，

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

Answer 2

IIRC，您應該使用with函數運行每個規范或屬性。 下面是我前段時間寫的幾個屬性：

  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

app值為服務提供服務，據我所知，它為每個測試運行IO操作。 我使用IORef使用內存數據庫完成了IORef ，這似乎工作得很好：

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

WQC.property函數來自合格的導入：

import qualified Test.Hspec.Wai.QuickCheck as WQC

然而，我對使用 HSpec 構建測試和屬性的方式不太滿意，所以我最終重寫了所有測試以由 HUnit 驅動。 我有一篇即將發布的博客文章描述了這一點，但我還沒有發布。