From 7d18d057eb4f2e4ad7f7fd578b3e33564f1c8c7a Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Mon, 13 Jun 2016 18:39:40 -0400 Subject: improve exception handling * Improve exception handling. A property that threw a non-IOException used to stop the whole propellor run. Now, all non-async exceptions only make the property that threw them fail. (Implicit API change) * Added StopPropellorException which can be used in the unsual case where a failure of one property should stop propellor from trying to ensure any other properties. * tryPropellor returns Either SomeException a now (API change) --- src/Propellor/Exception.hs | 42 ++++++++++++++++++++++++++++++++++++------ 1 file changed, 36 insertions(+), 6 deletions(-) (limited to 'src/Propellor/Exception.hs') diff --git a/src/Propellor/Exception.hs b/src/Propellor/Exception.hs index 2b38af0c..2f9b1684 100644 --- a/src/Propellor/Exception.hs +++ b/src/Propellor/Exception.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE PackageImports #-} +{-# LANGUAGE ScopedTypeVariables #-} module Propellor.Exception where @@ -6,13 +6,43 @@ import Propellor.Types import Propellor.Message import Utility.Exception -import Control.Exception (IOException) +import Control.Exception (AsyncException) +import Control.Monad.Catch +import Control.Monad.IO.Class (MonadIO) +import Data.Typeable --- | Catches IO exceptions and returns FailedChange. -catchPropellor :: Propellor Result -> Propellor Result +-- | Normally when an exception is encountered while propellor is +-- ensuring a property, the property fails, but propellor robustly +-- continues on to the next property. +-- +-- This is the only exception that will stop the entire propellor run, +-- preventing any subsequent properties of the Host from being ensured. +-- (When propellor is running in a container in a Host, this exception only +-- stops the propellor run in the container; the outer run in the Host +-- continues.) +-- +-- You should only throw this exception when things are so badly messed up +-- that it's best for propellor to not try to do anything else. +data StopPropellorException = StopPropellorException String + deriving (Show, Typeable) + +instance Exception StopPropellorException + +-- | Catches all exceptions (except for `StopPropellorException` and +-- `AsyncException`) and returns FailedChange. +catchPropellor :: (MonadIO m, MonadCatch m) => m Result -> m Result catchPropellor a = either err return =<< tryPropellor a where err e = warningMessage (show e) >> return FailedChange -tryPropellor :: Propellor a -> Propellor (Either IOException a) -tryPropellor = try +catchPropellor' :: MonadCatch m => m a -> (SomeException -> m a) -> m a +catchPropellor' a onerr = a `catches` + [ Handler (\ (e :: AsyncException) -> throwM e) + , Handler (\ (e :: StopPropellorException) -> throwM e) + , Handler (\ (e :: SomeException) -> onerr e) + ] + +-- | Catches all exceptions (except for `StopPropellorException` and +-- `AsyncException`). +tryPropellor :: MonadCatch m => m a -> m (Either SomeException a) +tryPropellor a = (Right <$> a) `catchPropellor'` (pure . Left) -- cgit v1.2.3