diff options
| -rw-r--r-- | debian/changelog | 9 | ||||
| -rw-r--r-- | src/Propellor/Exception.hs | 42 |
2 files changed, 44 insertions, 7 deletions
diff --git a/debian/changelog b/debian/changelog index 1ce1cbc9..99d89650 100644 --- a/debian/changelog +++ b/debian/changelog @@ -1,4 +1,4 @@ -propellor (3.0.6) UNRELEASED; urgency=medium +propellor (3.1.0) UNRELEASED; urgency=medium * Switch letsencrypt to certbot package name. * Sbuild: Add keyringInsecurelyGenerated which is useful on throwaway @@ -8,6 +8,13 @@ propellor (3.0.6) UNRELEASED; urgency=medium Thanks, Sean Whitton * Property.Reboot: Added toDistroKernel and toKernelNewerThan. Thanks, Sean Whitton + * 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) -- Joey Hess <id@joeyh.name> Fri, 10 Jun 2016 14:59:44 -0400 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) |