summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJoey Hess2016-06-13 18:56:52 -0400
committerJoey Hess2016-06-13 18:56:52 -0400
commit490249b919aaf82527b81c88c88350fd478dbed9 (patch)
tree1d136bb0f71bac53bdd64248bc9ab1387ee10b4b
parentb75ee60844fc56d361c5fac5a1038eebd33f26ba (diff)
add stopPropellorMessage
-rw-r--r--debian/changelog6
-rw-r--r--propellor.cabal1
-rw-r--r--src/Propellor/Exception.hs19
-rw-r--r--src/Propellor/Message.hs20
-rw-r--r--src/Propellor/Property/Reboot.hs2
-rw-r--r--src/Propellor/Types/Exception.hs21
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