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

时间:2016-08-31 21:32:41

标签: haskell testing yesod

我有一个类型为:

的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的{​​{1}}字段永远不会在任何处理程序中直接引用。)在App中,除了用{填充makeFoundation字段外,所有内容都是支架式的。来自appStripe库的{1}}。

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

Web.Stripe.stripe

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

stripe-haskell

编译并运行,但抛出错误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." ,表明它正在运行真正的条带IO操作而不是模拟。

如何在测试期间更改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 的字段,以便被测试的处理程序使用它?

1 个答案:

答案 0 :(得分:0)

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

  

IIUC,您只需要覆盖代码中不同位置的字段。以脚手架网站为例,我在这里覆盖:

     

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

根据该建议,需要对Yesod.Test模块进行一些返工,以便将模拟的控制线程连接到测试用例。这些更改已在Pull Request #1274中捕获到GitHub上的yesod repo。

使用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包中。如果我对此有所了解,我会更新这个答案。