diff options
| author | Joey Hess <joeyh@joeyh.name> | 2016-06-13 18:39:40 -0400 |
|---|---|---|
| committer | Joey Hess <joeyh@joeyh.name> | 2016-06-13 18:40:00 -0400 |
| commit | 7d18d057eb4f2e4ad7f7fd578b3e33564f1c8c7a (patch) | |
| tree | 92bcc8cf868838b09344744a6539ae11d1c1ad31 | |
| parent | 7d6a78c317a8382044682a2183b6524d0d8c050a (diff) | |
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)
| -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) |
