如何在测试期间修改我的 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
在多个处理程序中使用。 (App
的 appStripe
字段从未在任何处理程序中直接引用。)在 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:
根据该建议,需要对 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 包中。如果我对此有兴趣,我会更新这个答案。
我有一个类型为 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
在多个处理程序中使用。 (App
的 appStripe
字段从未在任何处理程序中直接引用。)在 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:
根据该建议,需要对 Yesod.Test
模块进行一些返工,以将模拟控制线程化到测试用例。这些更改已在 GitHub.
使用修改后的 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 包中。如果我对此有兴趣,我会更新这个答案。