我有一个Servant应用程序和一个在数据库中创建记录的端点,然后尝试在S3位置之间复制文件。如果复制失败,我想回滚该事务。我有这个运营商
{-# LANGUAGE TemplateHaskell #-}
import Control.Monad.Catch
import Control.Monad.Except
import Control.Monad.Logger
(<??)
:: (MonadError e m, MonadCatch m, MonadLogger m)
=> e
-> m a
-> m a
(<??) err a = a `catchAll` (\e -> $(logErrorSH) e >> throwError err)
infixr 0 <??
捕获所有异常,记录异常的性质,然后抛出(在我的情况下,因为我的App
类型有一个MonadError ServantErr
的实例)ServantErr
。
我的处理程序是这样的:
{-# LANGUAGE ScopedTypeVariables #-}
import Control.Monad
import Control.Monad.Catch
import Control.Monad.IO.Class
import qualified Network.AWS as AWS
import Servant
import App.Types
import App.Db
copy :: Copy -> App Text
copy (Copy user bucket srcKey tgtKey) = do
err400 <?? runDb (insertRecord $ User user bucket srcKey tgtKey)
catch (err500 <?? liftIO $ do
env <- AWS.newEnv AWS.Discover
void . AWS.runResourceT . AWS.runAWS env $ copyFiles bucket srcKey tgtKey
return "OK") (\(e :: ServantErr) -> rollback e user)
where rollback e u = runDb (deleteRecord u) >> throwError e
为了测试逻辑,我移动了我的AWS凭证文件,期望内部AWS动作将抛出InvalidFileError
,然后(<??)
将其转换为ServantErr
,然后catch
将捕获此ServantErr
并制定回滚功能。相反,插入成功,记录了InvalidFileError
,但随后不会发生回滚(即,执行后记录仍然存在于数据库中)。这个deleteRecord
函数在其他地方成功使用,因此我可以肯定它的定义不是问题。
知道是什么原因引起的吗?
如果你的App
类型最终是ExceptT
,问题可能是MonadError
的MonadCatch
和ExceptT
实例不匹配:
MonadError
实例在e
中引发ExceptT e
错误MonadCatch
的ExceptT e
是:
instance definition
MonadCatch (ExceptT e m)
有一个-- | Catches exceptions from the base monad.
instance MonadCatch m => MonadCatch (ExceptT e m) where
catch (ExceptT m) f = ExceptT $ catch m (runExceptT . f)
实例,所以它可以作为两者抛出。
编辑:“例外”类ServantErr
提供了Exception
函数,即使对于MonadMask
也表现得非常好:它在onError
异常和常规异常的情况下运行清理操作:
仅当主操作中引发错误时才运行操作。与onException不同,它适用于各种错误,而不仅仅是异常。例如,如果f是一个以Left中止的ExceptT计算,则计算onError f g将执行g,而onException f g将不执行g。
这是比ExceptT
处理回滚更好的选择。