summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--debian/changelog9
-rw-r--r--src/Propellor/Exception.hs42
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)