測試期間如何修改Yesod應用程序？

Question

我有一個類型為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

在多個處理程序中使用。 （該appStripe所述的場App是從未在任何處理直接引用。）在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的字段，以便被測試的處理程序使用該字段？

Answer 1

我在Yesod的Google Group上發布了對此問題的參考，並收到Yesod的發起人Michael Snoyman的以下答復 ：

IIUC，您只需要在代碼的其他位置覆蓋該字段即可。 以腳手架站點為例，我在這里覆蓋：

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

根據該建議，需要對Yesod.Test模塊進行一些重做，以將對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軟件包中。 如果對此有所幫助，我將更新此答案。