From 25942fb0cca0ca90933026bf959506e099ff95a4 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Thu, 10 Apr 2014 17:22:32 -0400 Subject: Propellor monad is a Reader for HostAttr So far, the hostname is only used to improve a message in withPrivData, but I anticipate using HostAttr for a lot more. --- Propellor.hs | 5 +++ Propellor/CmdLine.hs | 18 ++++++----- Propellor/Engine.hs | 23 +++++++++----- Propellor/Exception.hs | 16 ++++++++++ Propellor/Message.hs | 25 +++++++++------ Propellor/PrivData.hs | 15 ++++++--- Propellor/Property.hs | 19 ++++++----- Propellor/Property/Cmd.hs | 5 ++- Propellor/Property/Docker.hs | 37 +++++++++++----------- Propellor/Property/File.hs | 4 +-- Propellor/Property/Scheduled.hs | 10 +++--- Propellor/Property/SiteSpecific/GitAnnexBuilder.hs | 5 +-- Propellor/Property/SiteSpecific/GitHome.hs | 2 +- Propellor/Property/Ssh.hs | 2 +- Propellor/Property/Sudo.hs | 2 +- Propellor/Types.hs | 35 +++++++++++++++++++- debian/changelog | 4 ++- propellor.cabal | 12 ++++--- 18 files changed, 163 insertions(+), 76 deletions(-) create mode 100644 Propellor/Exception.hs diff --git a/Propellor.hs b/Propellor.hs index e39fc97d..1f1d7eca 100644 --- a/Propellor.hs +++ b/Propellor.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE PackageImports #-} + -- | Pulls in lots of useful modules for building and using Properties. -- -- Propellor enures that the system it's run in satisfies a list of @@ -31,6 +33,7 @@ module Propellor ( , module Propellor.Property.Cmd , module Propellor.PrivData , module Propellor.Engine + , module Propellor.Exception , module Propellor.Message , localdir @@ -43,6 +46,7 @@ import Propellor.Engine import Propellor.Property.Cmd import Propellor.PrivData import Propellor.Message +import Propellor.Exception import Utility.PartialPrelude as X import Utility.Process as X @@ -62,6 +66,7 @@ import Control.Applicative as X import Control.Monad as X import Data.Monoid as X import Control.Monad.IfElse as X +import "mtl" Control.Monad.Reader as X -- | This is where propellor installs itself when deploying a host. localdir :: FilePath diff --git a/Propellor/CmdLine.hs b/Propellor/CmdLine.hs index 6ddf8907..2026c47a 100644 --- a/Propellor/CmdLine.hs +++ b/Propellor/CmdLine.hs @@ -66,21 +66,23 @@ defaultMain getprops = do go _ (Continue cmdline) = go False cmdline go _ (Set host field) = setPrivData host field go _ (AddKey keyid) = addKey keyid - go _ (Chain host) = withprops host $ \ps -> do - r <- ensureProperties' ps + go _ (Chain host) = withprops host $ \hostattr ps -> do + r <- runPropellor hostattr $ ensureProperties ps putStrLn $ "\n" ++ show r go _ (Docker host) = Docker.chain host go True cmdline@(Spin _) = buildFirst cmdline $ go False cmdline go True cmdline = updateFirst cmdline $ go False cmdline - go False (Spin host) = withprops host $ const $ spin host + go False (Spin host) = withprops host $ const . const $ spin host go False (Run host) = ifM ((==) 0 <$> getRealUserID) - ( onlyProcess $ withprops host ensureProperties + ( onlyProcess $ withprops host mainProperties , go True (Spin host) ) go False (Boot host) = onlyProcess $ withprops host $ boot - withprops host a = maybe (unknownhost host) a $ + withprops host a = maybe (unknownhost host) (a hostattr) $ headMaybe $ catMaybes $ map (\get -> get host) getprops + where + hostattr = mkHostAttr host onlyProcess :: IO a -> IO a onlyProcess a = bracket lock unlock (const a) @@ -275,15 +277,15 @@ fromMarked marker s len = length marker matches = filter (marker `isPrefixOf`) $ lines s -boot :: [Property] -> IO () -boot ps = do +boot :: HostAttr -> [Property] -> IO () +boot hostattr ps = do sendMarked stdout statusMarker $ show Ready reply <- hGetContentsStrict stdin makePrivDataDir maybe noop (writeFileProtected privDataLocal) $ fromMarked privDataMarker reply - ensureProperties ps + mainProperties hostattr ps addKey :: String -> IO () addKey keyid = exitBool =<< allM id [ gpg, gitadd, gitcommit ] diff --git a/Propellor/Engine.hs b/Propellor/Engine.hs index 1ae224ca..c527dc38 100644 --- a/Propellor/Engine.hs +++ b/Propellor/Engine.hs @@ -1,30 +1,37 @@ +{-# LANGUAGE PackageImports #-} + module Propellor.Engine where import System.Exit import System.IO import Data.Monoid import System.Console.ANSI +import "mtl" Control.Monad.Reader import Propellor.Types import Propellor.Message -import Utility.Exception +import Propellor.Exception -ensureProperty :: Property -> IO Result -ensureProperty = catchDefaultIO FailedChange . propertySatisfy +runPropellor :: HostAttr -> Propellor a -> IO a +runPropellor hostattr a = runReaderT (runWithHostAttr a) hostattr -ensureProperties :: [Property] -> IO () -ensureProperties ps = do - r <- ensureProperties' [Property "overall" $ ensureProperties' ps] +mainProperties :: HostAttr -> [Property] -> IO () +mainProperties hostattr ps = do + r <- runPropellor hostattr $ + ensureProperties [Property "overall" $ ensureProperties ps] setTitle "propellor: done" hFlush stdout case r of FailedChange -> exitWith (ExitFailure 1) _ -> exitWith ExitSuccess -ensureProperties' :: [Property] -> IO Result -ensureProperties' ps = ensure ps NoChange +ensureProperties :: [Property] -> Propellor Result +ensureProperties ps = ensure ps NoChange where ensure [] rs = return rs ensure (l:ls) rs = do r <- actionMessage (propertyDesc l) (ensureProperty l) ensure ls (r <> rs) + +ensureProperty :: Property -> Propellor Result +ensureProperty = catchPropellor . propertySatisfy diff --git a/Propellor/Exception.hs b/Propellor/Exception.hs new file mode 100644 index 00000000..bd9212a8 --- /dev/null +++ b/Propellor/Exception.hs @@ -0,0 +1,16 @@ +{-# LANGUAGE PackageImports #-} + +module Propellor.Exception where + +import qualified "MonadCatchIO-transformers" Control.Monad.CatchIO as M +import Control.Exception +import Control.Applicative + +import Propellor.Types + +-- | Catches IO exceptions and returns FailedChange. +catchPropellor :: Propellor Result -> Propellor Result +catchPropellor a = either (\_ -> FailedChange) id <$> tryPropellor a + +tryPropellor :: Propellor a -> Propellor (Either IOException a) +tryPropellor = M.try diff --git a/Propellor/Message.hs b/Propellor/Message.hs index 5a7d8c4b..2e63061e 100644 --- a/Propellor/Message.hs +++ b/Propellor/Message.hs @@ -1,30 +1,35 @@ +{-# LANGUAGE PackageImports #-} + module Propellor.Message where import System.Console.ANSI import System.IO import System.Log.Logger +import "mtl" Control.Monad.Reader import Propellor.Types -- | Shows a message while performing an action, with a colored status -- display. -actionMessage :: ActionResult r => Desc -> IO r -> IO r +actionMessage :: (MonadIO m, ActionResult r) => Desc -> m r -> m r actionMessage desc a = do - setTitle $ "propellor: " ++ desc - hFlush stdout + liftIO $ do + setTitle $ "propellor: " ++ desc + hFlush stdout r <- a - setTitle "propellor: running" - let (msg, intensity, color) = getActionResult r - putStr $ desc ++ " ... " - colorLine intensity color msg - hFlush stdout + liftIO $ do + setTitle "propellor: running" + let (msg, intensity, color) = getActionResult r + putStr $ desc ++ " ... " + colorLine intensity color msg + hFlush stdout return r -warningMessage :: String -> IO () -warningMessage s = colorLine Vivid Red $ "** warning: " ++ s +warningMessage :: MonadIO m => String -> m () +warningMessage s = liftIO $ colorLine Vivid Red $ "** warning: " ++ s colorLine :: ColorIntensity -> Color -> String -> IO () colorLine intensity color msg = do diff --git a/Propellor/PrivData.hs b/Propellor/PrivData.hs index 2897d425..7f5a23dc 100644 --- a/Propellor/PrivData.hs +++ b/Propellor/PrivData.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE PackageImports #-} + module Propellor.PrivData where import qualified Data.Map as M @@ -7,6 +9,7 @@ import System.IO import System.Directory import Data.Maybe import Control.Monad +import "mtl" Control.Monad.Reader import Propellor.Types import Propellor.Message @@ -18,13 +21,15 @@ import Utility.Tmp import Utility.SafeCommand import Utility.Misc -withPrivData :: PrivDataField -> (String -> IO Result) -> IO Result -withPrivData field a = maybe missing a =<< getPrivData field +withPrivData :: PrivDataField -> (String -> Propellor Result) -> Propellor Result +withPrivData field a = maybe missing a =<< liftIO (getPrivData field) where missing = do - warningMessage $ "Missing privdata " ++ show field - putStrLn $ "Fix this by running: propellor --set $hostname '" ++ show field ++ "'" - return FailedChange + host <- getHostName + liftIO $ do + warningMessage $ "Missing privdata " ++ show field + putStrLn $ "Fix this by running: propellor --set "++host++" '" ++ show field ++ "'" + return FailedChange getPrivData :: PrivDataField -> IO (Maybe String) getPrivData field = do diff --git a/Propellor/Property.hs b/Propellor/Property.hs index ca492e33..7af69ea8 100644 --- a/Propellor/Property.hs +++ b/Propellor/Property.hs @@ -1,18 +1,21 @@ +{-# LANGUAGE PackageImports #-} + module Propellor.Property where import System.Directory import Control.Monad import Data.Monoid import Control.Monad.IfElse +import "mtl" Control.Monad.Reader import Propellor.Types import Propellor.Engine import Utility.Monad -makeChange :: IO () -> IO Result -makeChange a = a >> return MadeChange +makeChange :: IO () -> Propellor Result +makeChange a = liftIO a >> return MadeChange -noChange :: IO Result +noChange :: Propellor Result noChange = return NoChange -- | Combines a list of properties, resulting in a single property @@ -20,7 +23,7 @@ noChange = return NoChange -- and print out the description of each as it's run. Does not stop -- on failure; does propigate overall success/failure. propertyList :: Desc -> [Property] -> Property -propertyList desc ps = Property desc $ ensureProperties' ps +propertyList desc ps = Property desc $ ensureProperties ps -- | Combines a list of properties, resulting in one property that -- ensures each in turn, stopping on failure. @@ -49,12 +52,12 @@ p1 `before` p2 = Property (propertyDesc p1) $ do -- Use with caution. flagFile :: Property -> FilePath -> Property flagFile property flagfile = Property (propertyDesc property) $ - go =<< doesFileExist flagfile + go =<< liftIO (doesFileExist flagfile) where go True = return NoChange go False = do r <- ensureProperty property - when (r == MadeChange) $ + when (r == MadeChange) $ liftIO $ unlessM (doesFileExist flagfile) $ writeFile flagfile "" return r @@ -76,13 +79,13 @@ infixl 1 ==> -- | Makes a Property only be performed when a test succeeds. check :: IO Bool -> Property -> Property -check c property = Property (propertyDesc property) $ ifM c +check c property = Property (propertyDesc property) $ ifM (liftIO c) ( ensureProperty property , return NoChange ) boolProperty :: Desc -> IO Bool -> Property -boolProperty desc a = Property desc $ ifM a +boolProperty desc a = Property desc $ ifM (liftIO a) ( return MadeChange , return FailedChange ) diff --git a/Propellor/Property/Cmd.hs b/Propellor/Property/Cmd.hs index c715fd2a..875c1f9a 100644 --- a/Propellor/Property/Cmd.hs +++ b/Propellor/Property/Cmd.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE PackageImports #-} + module Propellor.Property.Cmd ( cmdProperty, cmdProperty', @@ -7,6 +9,7 @@ module Propellor.Property.Cmd ( import Control.Applicative import Data.List +import "mtl" Control.Monad.Reader import Propellor.Types import Utility.Monad @@ -22,7 +25,7 @@ cmdProperty cmd params = cmdProperty' cmd params [] -- | A property that can be satisfied by running a command, -- with added environment. cmdProperty' :: String -> [String] -> [(String, String)] -> Property -cmdProperty' cmd params env = Property desc $ do +cmdProperty' cmd params env = Property desc $ liftIO $ do env' <- addEntries env <$> getEnvironment ifM (boolSystemEnv cmd (map Param params) (Just env')) ( return MadeChange diff --git a/Propellor/Property/Docker.hs b/Propellor/Property/Docker.hs index b573e641..1df34251 100644 --- a/Propellor/Property/Docker.hs +++ b/Propellor/Property/Docker.hs @@ -53,7 +53,7 @@ docked findc hn cn = findContainer findc hn cn $ teardown = combineProperties ("undocked " ++ fromContainerId cid) [ stoppedContainer cid , Property ("cleaned up " ++ fromContainerId cid) $ - report <$> mapM id + liftIO $ report <$> mapM id [ removeContainer cid , removeImage image ] @@ -74,7 +74,7 @@ findContainer findc hn cn mk = case findc hn cn of where cid = ContainerId hn cn cantfind = containerDesc (ContainerId hn cn) $ Property "" $ do - warningMessage $ "missing definition for docker container \"" ++ fromContainerId cid + liftIO $ warningMessage $ "missing definition for docker container \"" ++ fromContainerId cid return FailedChange -- | Causes *any* docker images that are not in use by running containers to @@ -90,9 +90,9 @@ garbageCollected = propertyList "docker garbage collected" ] where gccontainers = Property "docker containers garbage collected" $ - report <$> (mapM removeContainer =<< listContainers AllContainers) + liftIO $ report <$> (mapM removeContainer =<< listContainers AllContainers) gcimages = Property "docker images garbage collected" $ do - report <$> (mapM removeImage =<< listImages) + liftIO $ report <$> (mapM removeImage =<< listImages) -- | Pass to defaultMain to add docker containers. -- You need to provide the function mapping from @@ -239,19 +239,19 @@ containerDesc cid p = p `describe` desc runningContainer :: ContainerId -> Image -> [Containerized Property] -> Property runningContainer cid@(ContainerId hn cn) image containerprops = containerDesc cid $ Property "running" $ do - l <- listContainers RunningContainers + l <- liftIO $ listContainers RunningContainers if cid `elem` l then do -- Check if the ident has changed; if so the -- parameters of the container differ and it must -- be restarted. - runningident <- getrunningident + runningident <- liftIO $ getrunningident if runningident == Just ident - then return NoChange + then noChange else do - void $ stopContainer cid + void $ liftIO $ stopContainer cid restartcontainer - else ifM (elem cid <$> listContainers AllContainers) + else ifM (liftIO $ elem cid <$> listContainers AllContainers) ( restartcontainer , go image ) @@ -259,8 +259,8 @@ runningContainer cid@(ContainerId hn cn) image containerprops = containerDesc ci ident = ContainerIdent image hn cn runps restartcontainer = do - oldimage <- fromMaybe image <$> commitContainer cid - void $ removeContainer cid + oldimage <- liftIO $ fromMaybe image <$> commitContainer cid + void $ liftIO $ removeContainer cid go oldimage getrunningident :: IO (Maybe ContainerIdent) @@ -280,10 +280,11 @@ runningContainer cid@(ContainerId hn cn) image containerprops = containerDesc ci ] go img = do - clearProvisionedFlag cid - createDirectoryIfMissing True (takeDirectory $ identFile cid) - shim <- Shim.setup (localdir "propellor") (localdir shimdir cid) - writeFile (identFile cid) (show ident) + liftIO $ do + clearProvisionedFlag cid + createDirectoryIfMissing True (takeDirectory $ identFile cid) + shim <- liftIO $ Shim.setup (localdir "propellor") (localdir shimdir cid) + liftIO $ writeFile (identFile cid) (show ident) ensureProperty $ boolProperty "run" $ runContainer img (runps ++ ["-i", "-d", "-t"]) [shim, "--docker", fromContainerId cid] @@ -339,7 +340,7 @@ chain s = case toContainerId s of -- being run. So, retry connections to the client for up to -- 1 minute. provisionContainer :: ContainerId -> Property -provisionContainer cid = containerDesc cid $ Property "provision" $ do +provisionContainer cid = containerDesc cid $ Property "provision" $ liftIO $ do let shim = Shim.file (localdir "propellor") (localdir shimdir cid) r <- simpleShClientRetry 60 (namedPipe cid) shim params (go Nothing) when (r /= FailedChange) $ @@ -372,8 +373,8 @@ stopContainer cid = boolSystem dockercmd [Param "stop", Param $ fromContainerId stoppedContainer :: ContainerId -> Property stoppedContainer cid = containerDesc cid $ Property desc $ - ifM (elem cid <$> listContainers RunningContainers) - ( cleanup `after` ensureProperty + ifM (liftIO $ elem cid <$> listContainers RunningContainers) + ( liftIO cleanup `after` ensureProperty (boolProperty desc $ stopContainer cid) , return NoChange ) diff --git a/Propellor/Property/File.hs b/Propellor/Property/File.hs index 64dce66f..10dee75e 100644 --- a/Propellor/Property/File.hs +++ b/Propellor/Property/File.hs @@ -38,10 +38,10 @@ notPresent f = check (doesFileExist f) $ Property (f ++ " not present") $ makeChange $ nukeFile f fileProperty :: Desc -> ([Line] -> [Line]) -> FilePath -> Property -fileProperty desc a f = Property desc $ go =<< doesFileExist f +fileProperty desc a f = Property desc $ go =<< liftIO (doesFileExist f) where go True = do - ls <- lines <$> readFile f + ls <- liftIO $ lines <$> readFile f let ls' = a ls if ls' == ls then noChange diff --git a/Propellor/Property/Scheduled.hs b/Propellor/Property/Scheduled.hs index 827c648c..8341765e 100644 --- a/Propellor/Property/Scheduled.hs +++ b/Propellor/Property/Scheduled.hs @@ -20,13 +20,13 @@ import qualified Data.Map as M -- last run. period :: Property -> Recurrance -> Property period prop recurrance = Property desc $ do - lasttime <- getLastChecked (propertyDesc prop) - nexttime <- fmap startTime <$> nextTime schedule lasttime - t <- localNow + lasttime <- liftIO $ getLastChecked (propertyDesc prop) + nexttime <- liftIO $ fmap startTime <$> nextTime schedule lasttime + t <- liftIO localNow if Just t >= nexttime then do r <- ensureProperty prop - setLastChecked t (propertyDesc prop) + liftIO $ setLastChecked t (propertyDesc prop) return r else noChange where @@ -38,7 +38,7 @@ periodParse :: Property -> String -> Property periodParse prop s = case toRecurrance s of Just recurrance -> period prop recurrance Nothing -> Property "periodParse" $ do - warningMessage $ "failed periodParse: " ++ s + liftIO $ warningMessage $ "failed periodParse: " ++ s noChange lastCheckedFile :: FilePath diff --git a/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs b/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs index 580a52dc..204a9ca7 100644 --- a/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs +++ b/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs @@ -44,12 +44,13 @@ builder arch crontimes rsyncupload = combineProperties "gitannexbuilder" let f = homedir "rsyncpassword" if rsyncupload then withPrivData (Password builduser) $ \p -> do - oldp <- catchDefaultIO "" $ readFileStrict f + oldp <- liftIO $ catchDefaultIO "" $ + readFileStrict f if p /= oldp then makeChange $ writeFile f p else noChange else do - ifM (doesFileExist f) + ifM (liftIO $ doesFileExist f) ( noChange , makeChange $ writeFile f "no password configured" ) diff --git a/Propellor/Property/SiteSpecific/GitHome.hs b/Propellor/Property/SiteSpecific/GitHome.hs index 482100ca..1ba56b94 100644 --- a/Propellor/Property/SiteSpecific/GitHome.hs +++ b/Propellor/Property/SiteSpecific/GitHome.hs @@ -8,7 +8,7 @@ import Utility.SafeCommand -- | Clones Joey Hess's git home directory, and runs its fixups script. installedFor :: UserName -> Property installedFor user = check (not <$> hasGitDir user) $ - Property ("githome " ++ user) (go =<< homedir user) + Property ("githome " ++ user) (go =<< liftIO (homedir user)) `requires` Apt.installed ["git"] where go Nothing = noChange diff --git a/Propellor/Property/Ssh.hs b/Propellor/Property/Ssh.hs index 36766f56..59845f8f 100644 --- a/Propellor/Property/Ssh.hs +++ b/Propellor/Property/Ssh.hs @@ -53,7 +53,7 @@ uniqueHostKeys = flagFile prop "/etc/ssh/.unique_host_keys" `onChange` restartSshd where prop = Property "ssh unique host keys" $ do - void $ boolSystem "sh" + void $ liftIO $ boolSystem "sh" [ Param "-c" , Param "rm -f /etc/ssh/ssh_host_*" ] diff --git a/Propellor/Property/Sudo.hs b/Propellor/Property/Sudo.hs index 68b8d056..66ceb580 100644 --- a/Propellor/Property/Sudo.hs +++ b/Propellor/Property/Sudo.hs @@ -13,7 +13,7 @@ enabledFor :: UserName -> Property enabledFor user = Property desc go `requires` Apt.installed ["sudo"] where go = do - locked <- isLockedPassword user + locked <- liftIO $ isLockedPassword user ensureProperty $ fileProperty desc (modify locked . filter (wanted locked)) diff --git a/Propellor/Types.hs b/Propellor/Types.hs index 3be10d3f..b1632923 100644 --- a/Propellor/Types.hs +++ b/Propellor/Types.hs @@ -1,20 +1,53 @@ +{-# LANGUAGE PackageImports #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} + module Propellor.Types where import Data.Monoid +import Control.Applicative import System.Console.ANSI +import "mtl" Control.Monad.Reader +import "MonadCatchIO-transformers" Control.Monad.CatchIO type HostName = String type GroupName = String type UserName = String +-- | The core data type of Propellor, this reprecents a property +-- that the system should have, and an action to ensure it has the +-- property. data Property = Property { propertyDesc :: Desc -- | must be idempotent; may run repeatedly - , propertySatisfy :: IO Result + , propertySatisfy :: Propellor Result } +-- | A property that can be reverted. data RevertableProperty = RevertableProperty Property Property +-- | Propellor's monad provides read-only access to attributes of the +-- system. +newtype Propellor a = Propellor { runWithHostAttr :: ReaderT HostAttr IO a } + deriving + ( Monad + , Functor + , Applicative + , MonadReader HostAttr + , MonadIO + , MonadCatchIO + ) + +-- | The attributes of a system. For example, its hostname. +newtype HostAttr = HostAttr + { _hostname :: HostName + } + +mkHostAttr :: HostName -> HostAttr +mkHostAttr = HostAttr + +getHostName :: Propellor HostName +getHostName = asks _hostname + class IsProp p where -- | Sets description. describe :: p -> Desc -> p diff --git a/debian/changelog b/debian/changelog index 55043d5b..a9a142df 100644 --- a/debian/changelog +++ b/debian/changelog @@ -1,4 +1,4 @@ -propellor (0.2.4) UNRELEASED; urgency=medium +propellor (0.3.0) UNRELEASED; urgency=medium * ipv6to4: Ensure interface is brought up automatically on boot. * Enabling unattended upgrades now ensures that cron is installed and @@ -8,6 +8,8 @@ propellor (0.2.4) UNRELEASED; urgency=medium * Fix compilation on Debian stable. * Include security updates in sources.list for stable and testing. * Use ssh connection caching, especially when bootstrapping. + * Properties now run in a Propellor monad, which provides access to + attributes of the host. -- Joey Hess Tue, 08 Apr 2014 18:07:12 -0400 diff --git a/propellor.cabal b/propellor.cabal index 03d14743..0c7e3494 100644 --- a/propellor.cabal +++ b/propellor.cabal @@ -1,5 +1,5 @@ Name: propellor -Version: 0.2.3 +Version: 0.3.0 Cabal-Version: >= 1.6 License: GPL Maintainer: Joey Hess @@ -38,7 +38,8 @@ Executable propellor GHC-Options: -Wall Build-Depends: MissingH, directory, filepath, base >= 4.5, base < 5, IfElse, process, bytestring, hslogger, unix-compat, ansi-terminal, - containers, network, async, time, QuickCheck + containers, network, async, time, QuickCheck, mtl, + MonadCatchIO-transformers if (! os(windows)) Build-Depends: unix @@ -48,7 +49,8 @@ Executable config GHC-Options: -Wall -threaded Build-Depends: MissingH, directory, filepath, base >= 4.5, base < 5, IfElse, process, bytestring, hslogger, unix-compat, ansi-terminal, - containers, network, async, time, QuickCheck + containers, network, async, time, QuickCheck, mtl, + MonadCatchIO-transformers if (! os(windows)) Build-Depends: unix @@ -57,7 +59,8 @@ Library GHC-Options: -Wall Build-Depends: MissingH, directory, filepath, base >= 4.5, base < 5, IfElse, process, bytestring, hslogger, unix-compat, ansi-terminal, - containers, network, async, time, QuickCheck + containers, network, async, time, QuickCheck, mtl, + MonadCatchIO-transformers if (! os(windows)) Build-Depends: unix @@ -88,6 +91,7 @@ Library Propellor.Message Propellor.PrivData Propellor.Engine + Propellor.Exception Propellor.Types Other-Modules: Propellor.CmdLine -- cgit v1.2.3