diff options
-rw-r--r-- | debian/changelog | 6 | ||||
-rw-r--r-- | propellor.cabal | 1 | ||||
-rw-r--r-- | src/Propellor/Exception.hs | 19 | ||||
-rw-r--r-- | src/Propellor/Message.hs | 20 | ||||
-rw-r--r-- | src/Propellor/Property/Reboot.hs | 2 | ||||
-rw-r--r-- | src/Propellor/Types/Exception.hs | 21 |
6 files changed, 47 insertions, 22 deletions
diff --git a/debian/changelog b/debian/changelog index 99d89650..86caf1eb 100644 --- a/debian/changelog +++ b/debian/changelog @@ -11,9 +11,9 @@ propellor (3.1.0) UNRELEASED; urgency=medium * 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. + * Added StopPropellorException and stopPropellorMessage 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/propellor.cabal b/propellor.cabal index abbff33a..dd14fcc0 100644 --- a/propellor.cabal +++ b/propellor.cabal @@ -171,6 +171,7 @@ Library Propellor.Types.Docker Propellor.Types.Dns Propellor.Types.Empty + Propellor.Types.Exception Propellor.Types.Info Propellor.Types.MetaTypes Propellor.Types.OS diff --git a/src/Propellor/Exception.hs b/src/Propellor/Exception.hs index 2f9b1684..3ab783bf 100644 --- a/src/Propellor/Exception.hs +++ b/src/Propellor/Exception.hs @@ -3,30 +3,13 @@ module Propellor.Exception where import Propellor.Types +import Propellor.Types.Exception import Propellor.Message import Utility.Exception import Control.Exception (AsyncException) import Control.Monad.Catch import Control.Monad.IO.Class (MonadIO) -import Data.Typeable - --- | 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. diff --git a/src/Propellor/Message.hs b/src/Propellor/Message.hs index 32625e6a..b7e96ec2 100644 --- a/src/Propellor/Message.hs +++ b/src/Propellor/Message.hs @@ -13,6 +13,7 @@ module Propellor.Message ( warningMessage, infoMessage, errorMessage, + stopPropellorMessage, processChainOutput, messagesDone, createProcessConcurrent, @@ -29,6 +30,7 @@ import Control.Applicative import Prelude import Propellor.Types +import Propellor.Types.Exception import Utility.PartialPrelude import Utility.Monad import Utility.Exception @@ -105,11 +107,29 @@ warningMessage s = liftIO $ infoMessage :: MonadIO m => [String] -> m () infoMessage ls = liftIO $ outputConcurrent $ concatMap (++ "\n") ls +-- | Displays the error message in red, and throws an exception. +-- +-- When used inside a property, the exception will only stop the current +-- property from being ensured. Propellor will continue ensuring other +-- properties. errorMessage :: MonadIO m => String -> m a errorMessage s = liftIO $ do outputConcurrent =<< colorLine Vivid Red ("** error: " ++ s) + -- Normally this exception gets caught and is not displayed, + -- and propellor continues. So it's only displayed if not + -- caught, and so we say, cannot continue. error "Cannot continue!" +-- | Like `errorMessage`, but throws a `StopPropellorException` +-- +-- Think twice before using this. Is the problem so bad that propellor +-- cannot try to ensure other properties? If not, use `errorMessage` +-- instead. +stopPropellorMessage :: MonadIO m => String -> m a +stopPropellorMessage s = liftIO $ do + outputConcurrent =<< colorLine Vivid Red ("** fatal error: " ++ s) + throwM $ StopPropellorException "Cannot continue!" + colorLine :: ColorIntensity -> Color -> String -> IO String colorLine intensity color msg = concat <$> sequence [ whenConsole $ diff --git a/src/Propellor/Property/Reboot.hs b/src/Propellor/Property/Reboot.hs index feb08694..161f2aee 100644 --- a/src/Propellor/Property/Reboot.hs +++ b/src/Propellor/Property/Reboot.hs @@ -86,7 +86,7 @@ toKernelNewerThan ver = -- under a kernel version that's too old. -- E.g. Sbuild.built can fail -- to add the config line `union-type=overlay` - else throwM $ StopPropellorException $ + else stopPropellorMessage $ "kernel newer than " ++ ver ++ " not installed" diff --git a/src/Propellor/Types/Exception.hs b/src/Propellor/Types/Exception.hs new file mode 100644 index 00000000..3a810d55 --- /dev/null +++ b/src/Propellor/Types/Exception.hs @@ -0,0 +1,21 @@ +module Propellor.Types.Exception where + +import Data.Typeable +import Control.Exception + +-- | 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 |