如何在测试期间修改我的 Yesod 应用程序?

How do I modify my Yesod app during a test?

我有一个类型为 Yesod 的应用程序:

data App = App
    { appSettings    :: AppSettings
    , appStatic      :: Static
    , appConnPool    :: ConnectionPool
    , appHttpManager :: Manager
    , appLogger      :: Logger
    , appStripe      :: forall a. ((FromJSON (StripeReturn a)), Typeable (StripeReturn a))
                     => StripeConfig
                     -> StripeRequest a
                     -> IO (Either StripeError (StripeReturn a))
    }

和辅助函数

stripe :: (FromJSON (StripeReturn a), Typeable (StripeReturn a))
       => StripeRequest a
       -> Handler (Either StripeError (StripeReturn a))
stripe req = do
  f <- appStripe <$> getYesod
  c <- appStripeConfig . appSettings <$> getYesod
  liftIO $ f c req

在多个处理程序中使用。 (AppappStripe 字段从未在任何处理程序中直接引用。)在 makeFoundation 中,除了 appStripe 字段用 Web.Stripe.stripe 来自 stripe-haskell 库。

在我的测试中,我希望能够模拟对 Stripe 的调用,所以我有以下功能:

withStripeExpecting :: (FromJSON (StripeReturn a), Typeable (StripeReturn a))
                    => StripeRequest a
                    -> Either StripeError (StripeReturn a)
                    -> YesodExample App ()
                    -> YesodExample App ()
withStripeExpecting _expectedReq res = withStateT $ \yed -> yed {yedSite = f (yedSite yed)}
  where f app = app {appStripe = mock}
        mock :: Typeable (StripeReturn b)
             => StripeConfig
             -> StripeRequest b
             -> IO (Either StripeError (StripeReturn b))
        mock _ _actualReq = do
          -- assert actualReq matches expectedReq (in IO???)
          return $ case cast res of
                    Just a -> a
                    Nothing -> error "Stripe return types don’t match in mock."

我在测试用例中使用的,例如:

spec :: Spec
spec = withApp $ do
  describe "create" $ do
    it "returns a 201" $ do
      -- a bunch of set-up elided
      withStripeExpecting stripeReq (Right stripeRes) $ do
        requestWithSubject "auth0|fake" $ do
          setMethod "POST"
          setUrl $ SubscriptionPlansR walletId
          setRequestBody encoded
          addRequestHeader (H.hContentType, "application/json")
        statusIs 201

编译并运行,但抛出错误 StripeError {errorType = InvalidRequest, errorMsg = "Invalid API Key provided: ", errorCode = Nothing, errorParam = Nothing, errorHTTP = Just UnAuthorized} 表明它是 运行 真正的条带 IO 操作而不是模拟。

如何在测试期间更改 App 的字段,以便被测试的处理程序使用它?

我在 Yesod 的 Google 组上发布了对这个问题的引用,并从 Yesod 的创始人 Michael Snoyman 那里收到了this response

IIUC, you just need to override the field at a different spot in the code. Using the scaffolded site as an example, I'd override here:

https://github.com/yesodweb/yesod-scaffold/blob/68ec6af22248de6c2a00e63624c34350846557cf/test/TestImport.hs#L35

根据该建议,需要对 Yesod.Test 模块进行一些返工,以将模拟控制线程化到测试用例。这些更改已在 GitHub.

上的 yesod 存储库的 Pull Request #1274 中捕获

使用修改后的 yesod-test 版本,我可以用以下三行替换 Michael Snoyman 记录的行:

mocks <- newEmptyMVar
let foundation' = foundation { appStripe = mockStripe mocks }
return (foundation', logWare, mocks)

我还在 TestImport 模块中添加了以下支持定义:

data StripeMock = forall a. Typeable (StripeReturn a)
               => StripeMock
                { stripeReq :: StripeRequest a
                , stripeRet :: Either StripeError (StripeReturn a)
                }

type Mocks = MVar StripeMock

type Yex = YesodExample App Mocks

mockStripe :: (Typeable (StripeReturn b))
           => Mocks
           -> StripeConfig
           -> StripeRequest b
           -> IO (Either StripeError (StripeReturn b))
mockStripe mocks _ _actualReq = do
  (StripeMock _expectedReq res) <- takeMVar mocks
  -- assert actualReq matches expectedReq (in IO???)
  return $ case cast res of
            Just a -> a
            Nothing -> error "Stripe return types don’t match in mock."

stripeExpects :: (FromJSON (StripeReturn a), Typeable (StripeReturn a))
              => StripeRequest a
              -> Either StripeError (StripeReturn a)
              -> Yex ()
stripeExpects expectedReq res = do
  mocks <- getMocks
  putMVar mocks $ StripeMock expectedReq res

stripeExpects 辅助函数取代了 withStripeExpecting,并且不像 withStripeExpecting 那样包装请求。

如拉取请求中所示,我正在尝试将此容量包含在 yesod-test 包中。如果我对此有兴趣,我会更新这个答案。