diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,3 +1,14 @@ +## 0.5.0 + +* Add logging of exceptions in directorySink, runCustomizations, runHacks, + and runTmpfiles. This requires adding MonadBaseControl constraints to + all these functions and MonadError constrains to those functions that + did not already have it. +* Require a filesystem package in the list of things to export. +* Require a dracut package in the list of things to export for ostree. +* Don't assume /etc/shadow exists in the output artifact. +* Log the call to dracut in ostreeSink. + ## 0.4.0 * Add BDCS.Projects.getProjectsLike, which returns projects whose names match diff --git a/bdcs.cabal b/bdcs.cabal --- a/bdcs.cabal +++ b/bdcs.cabal @@ -1,5 +1,5 @@ name: bdcs -version: 0.4.0 +version: 0.5.0 synopsis: Tools for managing a content store of software packages description: This module provides a library and various tools for managing a content store and metadata database. These store the contents of software packages that make up a @@ -136,6 +136,7 @@ gi-ostree >= 1.0.3 && < 1.1.0, gitrev >= 1.3.1 && < 1.4.0, http-conduit >= 2.2.3 && < 2.3.0, + lifted-base, listsafe >= 0.1.0.1 && < 0.2.0, memory >= 0.14.3 && < 0.15.0, monad-control >= 1.0.1.0 && < 1.1.0.0, diff --git a/src/BDCS/Export.hs b/src/BDCS/Export.hs --- a/src/BDCS/Export.hs +++ b/src/BDCS/Export.hs @@ -20,6 +20,7 @@ import Control.Monad.Except(MonadError, runExceptT, throwError) import Control.Monad.Logger(MonadLoggerIO, logDebugN) +import Control.Monad.Trans(lift) import Control.Monad.Trans.Resource(MonadBaseControl, MonadResource) import Data.Conduit(Consumer, (.|), runConduit, runConduitRes) import qualified Data.Conduit.List as CL @@ -56,8 +57,10 @@ -> [T.Text] -> [Customization] -> SqlPersistT m () -exportAndCustomize repo out_path ty things custom | kernelMissing ty things = throwError "ERROR: ostree exports need a kernel package included" - | otherwise = do +exportAndCustomize repo out_path ty things custom | kernelMissing ty things = throwError "ERROR: ostree exports need a kernel package included" + | dracutMissing ty things = throwError "ERROR: ostree exports need a dract package included" + | filesystemMissing things = throwError "ERROR: exports need a filesystem package included" + | otherwise = do let objectSink = case ty of ExportTar -> CS.objectToTarEntry .| Tar.tarSink out_path ExportQcow2 -> Qcow2.qcow2Sink out_path @@ -77,15 +80,21 @@ runConduitRes $ fstreeSource fstree' .| filesToObjectsC overlay' cs .| objectSink where - directoryOutput :: (MonadError String m, MonadLoggerIO m) => FilePath -> Consumer (Files, CS.Object) m () + directoryOutput :: (MonadBaseControl IO m, MonadError String m, MonadLoggerIO m) => FilePath -> Consumer (Files, CS.Object) m () directoryOutput path = do -- Apply tmpfiles.d to the directory first logDebugN "Running tmpfiles" - runTmpfiles path + lift $ runTmpfiles path Directory.directorySink path logDebugN "Running standard hacks" - runHacks path + lift $ runHacks path kernelMissing :: ExportType -> [T.Text] -> Bool kernelMissing exportTy lst = exportTy == ExportOstree && not (any ("kernel-" `T.isPrefixOf`) lst) + + dracutMissing :: ExportType -> [T.Text] -> Bool + dracutMissing exportTy lst = exportTy == ExportOstree && not (any ("dracut-" `T.isPrefixOf`) lst) + + filesystemMissing :: [T.Text] -> Bool + filesystemMissing lst = not (any ("filesystem-" `T.isPrefixOf`) lst) diff --git a/src/BDCS/Export/Customize.hs b/src/BDCS/Export/Customize.hs --- a/src/BDCS/Export/Customize.hs +++ b/src/BDCS/Export/Customize.hs @@ -8,10 +8,12 @@ runCustomizations) where +import qualified Control.Exception.Lifted as CEL import Control.Monad(foldM) -import Control.Monad.Except(MonadError) +import Control.Monad.Except(MonadError, throwError) import Control.Monad.IO.Class(MonadIO) import Control.Monad.Logger(MonadLogger, MonadLoggerIO, logDebugN) +import Control.Monad.Trans.Control(MonadBaseControl) import Crypto.Hash(Digest, hash) import Crypto.Hash.Algorithms(Blake2b_256) import Data.ByteArray(convert) @@ -62,10 +64,15 @@ let digest = hash input :: Digest Blake2b_256 in convert digest -runCustomizations :: (MonadError String m, MonadLoggerIO m) => CSOverlay -> ContentStore -> FSTree -> [Customization] -> m (CSOverlay, FSTree) +runCustomizations :: (MonadBaseControl IO m, MonadError String m, MonadLoggerIO m) => + CSOverlay + -> ContentStore + -> FSTree + -> [Customization] + -> m (CSOverlay, FSTree) runCustomizations overlay _repo tree customizations = do logDebugN $ T.pack "Running customizations" - foldM runCustomization (overlay, tree) customizations + foldM runCustomization (overlay, tree) customizations `CEL.catch` \e -> throwError $ show (e :: CEL.IOException) where runCustomization :: (MonadError String m, MonadLoggerIO m) => (CSOverlay, FSTree) -> Customization -> m (CSOverlay, FSTree) runCustomization (o, t) (WriteFile file content) = addToOverlay o t file content diff --git a/src/BDCS/Export/Directory.hs b/src/BDCS/Export/Directory.hs --- a/src/BDCS/Export/Directory.hs +++ b/src/BDCS/Export/Directory.hs @@ -19,11 +19,13 @@ where import Control.Conditional(unlessM) +import Control.Exception(IOException) import Control.Monad.Except(MonadError, throwError) import Control.Monad.IO.Class(MonadIO, liftIO) import Control.Monad.Logger(MonadLoggerIO) +import Control.Monad.Trans.Control(MonadBaseControl) import qualified Data.ByteString as BS -import Data.Conduit(Consumer, awaitForever) +import Data.Conduit(Consumer, awaitForever, handleC) import qualified Data.Text as T import Data.Time.Clock.POSIX(posixSecondsToUTCTime) import System.Directory(createDirectoryIfMissing, setModificationTime) @@ -41,8 +43,8 @@ -- -- It is expected that the caller will decide whether the destination directory should be empty -- or not. This function does nothing to enforce that. -directorySink :: (MonadError String m, MonadLoggerIO m) => FilePath -> Consumer (Files, CS.Object) m () -directorySink outPath = awaitForever $ \case +directorySink :: (MonadBaseControl IO m, MonadError String m, MonadLoggerIO m) => FilePath -> Consumer (Files, CS.Object) m () +directorySink outPath = handleC (\e -> throwError $ show (e :: IOException)) $ awaitForever $ \case (f, CS.SpecialObject) -> checkoutSpecial f (f, CS.FileObject bs) -> checkoutFile f bs where diff --git a/src/BDCS/Export/Ostree.hs b/src/BDCS/Export/Ostree.hs --- a/src/BDCS/Export/Ostree.hs +++ b/src/BDCS/Export/Ostree.hs @@ -20,11 +20,13 @@ import Conduit(Conduit, Consumer, Producer, (.|), bracketP, runConduit, sourceDirectory, yield) import Control.Conditional(condM, otherwiseM, whenM) -import Control.Exception(SomeException, bracket_, catch) +import qualified Control.Exception.Lifted as CEL import Control.Monad(void) import Control.Monad.Except(MonadError) import Control.Monad.IO.Class(MonadIO, liftIO) import Control.Monad.Logger(MonadLoggerIO, logDebugN, logInfoN) +import Control.Monad.Trans(lift) +import Control.Monad.Trans.Control(MonadBaseControl, liftBaseOp) import Control.Monad.Trans.Resource(MonadResource, runResourceT) import Crypto.Hash(SHA256(..), hashInitWith, hashFinalize, hashUpdate) import qualified Data.ByteString as BS (readFile) @@ -34,9 +36,8 @@ import qualified Data.Text as T import System.Directory import System.FilePath((), takeDirectory, takeFileName) -import System.IO.Temp(createTempDirectory, withTempDirectory) +import System.IO.Temp(createTempDirectory) import System.Posix.Files(createSymbolicLink, fileGroup, fileMode, fileOwner, getFileStatus, readSymbolicLink) -import System.Process(callProcess) import Text.Printf(printf) import GI.Gio(File, fileNewForPath, noCancellable) @@ -58,7 +59,7 @@ -- required to make the destination a valid ostree repo is also done by this function - setting up -- symlinks and directories, pruning unneeded directories, installing an initrd, building an -- RPM database, and so forth. -ostreeSink :: (MonadError String m, MonadLoggerIO m, MonadResource m) => FilePath -> Consumer (Files, CS.Object) m () +ostreeSink :: (MonadBaseControl IO m, MonadError String m, MonadLoggerIO m, MonadResource m) => FilePath -> Consumer (Files, CS.Object) m () ostreeSink outPath = do -- While it's possible to copy objects from one OstreeRepo to another, we can't create our own objects, meaning -- we can't add the dirtree objects we would need to tie all of the files together. So to export to a new @@ -77,7 +78,7 @@ -- Add the standard hacks logDebugN "Running standard hacks" - runHacks tmpDir + lift $ runHacks tmpDir -- Compile the locale-archive file let localeDir = tmpDir "usr" "lib" "locale" @@ -85,7 +86,7 @@ callProcessLogged "chroot" [tmpDir, "/usr/sbin/build-locale-archive"] -- Add the kernel and initramfs - installKernelInitrd tmpDir + lift $ installKernelInitrd tmpDir -- Replace /etc/nsswitch.conf with the altfiles version logDebugN "Modifying /etc files" @@ -191,7 +192,7 @@ yield $ printf "d %s %#o %d %d - -" baseDirPath mode userId groupId - installKernelInitrd :: MonadLoggerIO m => FilePath -> m () + installKernelInitrd :: (MonadBaseControl IO m, MonadLoggerIO m) => FilePath -> m () installKernelInitrd exportDir = do -- The kernel and initramfs need to be named /boot/vmlinuz- -- and /boot/initramfs-, where CHECKSUM is the sha256 @@ -212,19 +213,14 @@ logInfoN $ "Installing kernel " `T.append` T.pack kernel logInfoN $ "Installing initrd " `T.append` T.pack initramfs - -- FIXME: This one isn't getting logged, but withTempDirectory makes that hard. Using that - -- function means scattering MonadMask constraints around in bdcs and bdcs-api, which I'm not - -- sure if that's a good thing or not. Rewriting withTempDirectory to avoid that means using - -- bracket and the IO monad, and the types become very complicated. - liftIO $ withTempDirectory exportDir "dracut" - (\tmpDir -> callProcess "chroot" - [exportDir, - "dracut", - "--add", "ostree", - "--no-hostonly", - "--tmpdir=/" ++ takeFileName tmpDir, - "-f", "/boot/" ++ takeFileName initramfs, - kver]) + withTempDirectory' exportDir "dracut" $ \tmpDir -> + callProcessLogged "chroot" [exportDir, + "dracut", + "--add", "ostree", + "--no-hostonly", + "--tmpdir=/" ++ takeFileName tmpDir, + "-f", "/boot/" ++ takeFileName initramfs, + kver] -- Append the checksum to the filenames kernelData <- liftIO $ BS.readFile kernel @@ -238,6 +234,14 @@ liftIO $ renameFile kernel (kernel ++ "-" ++ digest) liftIO $ renameFile initramfs (initramfs ++ "-" ++ digest) + -- This is like withTempDirectory from the temporary package, but without the requirement on + -- MonadThrow and MonadMask. This allows logging the call to dracut like we do everything + -- else without having to think about adding those constraints to quite a lot of code. + withTempDirectory' :: (MonadBaseControl IO m, MonadLoggerIO m) => FilePath -> String -> (FilePath -> m a) -> m a + withTempDirectory' target template = liftBaseOp $ + CEL.bracket (createTempDirectory target template) + (\path -> removePathForcibly path `CEL.catch` (\(_ :: CEL.SomeException) -> return ())) + renameDirs :: FilePath -> IO () renameDirs exportDir = do -- ostree mandates /usr/etc, and fails if /etc also exists. @@ -320,8 +324,8 @@ -- Given a commit, return the parent of it or Nothing if no parent exists. parentCommit :: IsRepo a => a -> T.Text -> IO (Maybe T.Text) parentCommit repo commitSum = - catch (Just <$> repoResolveRev repo commitSum False) - (\(_ :: SomeException) -> return Nothing) + CEL.catch (Just <$> repoResolveRev repo commitSum False) + (\(_ :: CEL.SomeException) -> return Nothing) -- Same as store, but takes a path to a directory to import storeDirectory :: IsRepo a => a -> FilePath -> IO File @@ -336,6 +340,6 @@ -- Returns the checksum of the commit. withTransaction :: IsRepo a => a -> (a -> IO b) -> IO b withTransaction repo fn = - bracket_ (repoPrepareTransaction repo noCancellable) - (repoCommitTransaction repo noCancellable) - (fn repo) + CEL.bracket_ (repoPrepareTransaction repo noCancellable) + (repoCommitTransaction repo noCancellable) + (fn repo) diff --git a/src/BDCS/Export/Qcow2.hs b/src/BDCS/Export/Qcow2.hs --- a/src/BDCS/Export/Qcow2.hs +++ b/src/BDCS/Export/Qcow2.hs @@ -18,6 +18,8 @@ import Control.Monad.Except(MonadError) import Control.Monad.Logger(MonadLoggerIO, logDebugN) +import Control.Monad.Trans(lift) +import Control.Monad.Trans.Control(MonadBaseControl) import Control.Monad.Trans.Resource(MonadResource) import Data.Conduit(Consumer, bracketP) import System.Directory(removePathForcibly) @@ -32,7 +34,7 @@ -- | A 'Consumer' that writes objects into a temporary directory, and then converts that directory into -- a qcow2 image with virt-make-fs. -qcow2Sink :: (MonadError String m, MonadLoggerIO m, MonadResource m) => FilePath -> Consumer (Files, CS.Object) m () +qcow2Sink :: (MonadBaseControl IO m, MonadError String m, MonadLoggerIO m, MonadResource m) => FilePath -> Consumer (Files, CS.Object) m () qcow2Sink outPath = -- Writing and importing a tar file probably will not work, because some rpms contain paths -- with symlinks (e.g., /lib64/libaudit.so.1 is expected to be written to /usr/lib64). @@ -43,7 +45,7 @@ (\tmpDir -> do -- Apply tmpfiles.d to the directory first logDebugN "Running tmpfiles" - runTmpfiles tmpDir + lift $ runTmpfiles tmpDir -- Run the sink to create a directory export logDebugN "Exporting to directory" @@ -51,7 +53,7 @@ -- Make the direcotry export something usable, hopefully logDebugN "Running standard hacks" - runHacks tmpDir + lift $ runHacks tmpDir -- Run virt-make-fs to generate the qcow2 callProcessLogged "virt-make-fs" [tmpDir, outPath, "--format=qcow2", "--label=composer"] diff --git a/src/BDCS/Export/Utils.hs b/src/BDCS/Export/Utils.hs --- a/src/BDCS/Export/Utils.hs +++ b/src/BDCS/Export/Utils.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE OverloadedStrings #-} -- | @@ -15,11 +16,14 @@ runTmpfiles) where -import Control.Conditional(whenM) +import Control.Conditional(ifM, whenM) import Control.Exception(tryJust) +import qualified Control.Exception.Lifted as CEL import Control.Monad(guard) +import Control.Monad.Except(MonadError, throwError) import Control.Monad.IO.Class(liftIO) import Control.Monad.Logger(MonadLoggerIO, logDebugN) +import Control.Monad.Trans.Control(MonadBaseControl) import Data.List(intercalate) import Data.List.Split(splitOn) import System.Directory(createDirectoryIfMissing, doesFileExist, listDirectory, removePathForcibly, renameFile) @@ -34,13 +38,23 @@ -- | Run filesystem hacks needed to make a directory tree bootable. Any exporter that produces a -- finished image should call this function. Otherwise, it is not generally useful and should be -- avoided. The exact hacks required is likely to change over time. -runHacks :: MonadLoggerIO m => FilePath -> m () -runHacks exportPath = do +-- +-- Any exceptions from 'Control.Exception' will be convered into 'Control.Monad.Except' style +-- exceptions, which can then be handled via catchError from that module. +runHacks :: (MonadBaseControl IO m, MonadError String m, MonadLoggerIO m) => FilePath -> m () +runHacks exportPath = runHacks' exportPath `CEL.catch` \e -> throwError $ show (e :: CEL.IOException) + +-- This is a helper for runHacks that does all the hard work. It exists separately so the main +-- function can handle any exceptions without making a mess of the code. +runHacks' :: MonadLoggerIO m => FilePath -> m () +runHacks' exportPath = do -- set a root password -- pre-crypted from "redhat" logDebugN "Setting root password" liftIO $ do - shadowRecs <- map (splitOn ":") <$> lines <$> readFile (exportPath "etc" "shadow") + shadowRecs <- map (splitOn ":") <$> lines <$> ifM (doesFileExist (exportPath "etc" "shadow")) + (readFile (exportPath "etc" "shadow")) + (return "") let newRecs = map (\rec -> case rec of "root":_:rest -> ["root", "$6$3VLMX3dyCGRa.JX3$RpveyimtrKjqcbZNTanUkjauuTRwqAVzRK8GZFkEinbjzklo7Yj9Z6FqXNlyajpgCdsLf4FEQQKH6tTza35xs/"] ++ rest _ -> rec) @@ -82,7 +96,15 @@ -- | Run tmpfiles.d snippet on the new directory. Most exporters should call this function. Otherwise, -- it is not generally useful and should be avoided. -runTmpfiles :: MonadLoggerIO m => FilePath -> m () -runTmpfiles exportPath = do +-- +-- Any exceptions from 'Control.Exception' will be convered into 'Control.Monad.Except' style +-- exceptions, which can then be handled via catchError from that module. +runTmpfiles :: (MonadBaseControl IO m, MonadError String m, MonadLoggerIO m) => FilePath -> m () +runTmpfiles exportPath = runTmpfiles' exportPath `CEL.catch` \e -> throwError $ show (e :: CEL.IOException) + +-- This is a helper for runTmpfiles that does all the hard work. It exists separately so the main +-- function can handle any exceptions without making a mess of the code. +runTmpfiles' :: MonadLoggerIO m => FilePath -> m () +runTmpfiles' exportPath = do configPath <- liftIO $ getDataFileName "data/tmpfiles-default.conf" setupFilesystem exportPath configPath diff --git a/src/BDCS/Utils/Process.hs b/src/BDCS/Utils/Process.hs --- a/src/BDCS/Utils/Process.hs +++ b/src/BDCS/Utils/Process.hs @@ -15,6 +15,7 @@ module BDCS.Utils.Process(callProcessLogged) where +import Control.Monad(unless) import Control.Monad.IO.Class(liftIO) import Control.Monad.Logger(MonadLoggerIO, logInfoN, logErrorN) import qualified Data.Text as T @@ -27,7 +28,9 @@ callProcessLogged cmd args = do logInfoN $ T.intercalate " " $ T.pack cmd : map T.pack args (rc, stdout, stderr) <- liftIO $ readProcessWithExitCode cmd args "" - logInfoN $ T.pack stdout + + unless (T.null $ T.strip $ T.pack stdout) $ + logInfoN $ T.pack stdout case rc of ExitFailure x -> do logErrorN $ T.pack stderr diff --git a/src/tools/inspect/Utils/Exceptions.hs b/src/tools/inspect/Utils/Exceptions.hs --- a/src/tools/inspect/Utils/Exceptions.hs +++ b/src/tools/inspect/Utils/Exceptions.hs @@ -3,7 +3,7 @@ import Control.Exception(Exception) -data InspectErrors = InvalidLabelError String +data InspectErrors = InvalidLabelError | MissingCSError | MissingDBError deriving(Eq, Show) diff --git a/src/tools/inspect/subcommands/groups.hs b/src/tools/inspect/subcommands/groups.hs --- a/src/tools/inspect/subcommands/groups.hs +++ b/src/tools/inspect/subcommands/groups.hs @@ -3,7 +3,7 @@ {-# LANGUAGE ScopedTypeVariables #-} import Control.Conditional(unlessM) -import Control.Exception(Handler(..), catches, throw) +import Control.Exception(Handler(..), catches, throwIO) import Control.Monad.Except(runExceptT) import Data.Aeson((.=), ToJSON, object, toJSON) import Data.Aeson.Encode.Pretty(encodePretty) @@ -117,7 +117,7 @@ Nothing -> usage Just (db, repo, args) -> do unlessM (doesFileExist db) $ - throw MissingDBError + throwIO MissingDBError result <- runCommand (T.pack db) repo args whenLeft result (\e -> print $ "error: " ++ e) diff --git a/src/tools/inspect/subcommands/ls.hs b/src/tools/inspect/subcommands/ls.hs --- a/src/tools/inspect/subcommands/ls.hs +++ b/src/tools/inspect/subcommands/ls.hs @@ -5,15 +5,15 @@ {-# LANGUAGE ScopedTypeVariables #-} import Control.Conditional(unlessM) -import Control.Exception(Handler(..), catches, throw) +import Control.Exception(Handler(..), catches, throwIO) import Control.Monad(forM_) -import Control.Monad.Except(runExceptT) +import Control.Monad.Except(runExceptT, when) import Data.Aeson((.=), ToJSON, object, toJSON) import Data.Aeson.Encode.Pretty(encodePretty) import Data.ByteString.Lazy(toStrict) import Data.Conduit((.|), runConduit) import qualified Data.Conduit.List as CL -import Data.Maybe(catMaybes, fromMaybe, isJust, mapMaybe) +import Data.Maybe(catMaybes, fromMaybe, isJust, isNothing, mapMaybe) import qualified Data.Text as T import Data.Text.Encoding(decodeUtf8) import Data.Time.Clock.POSIX(getCurrentTime, posixSecondsToUTCTime) @@ -23,6 +23,7 @@ import System.Environment(getArgs) import System.Exit(exitFailure) import Text.Printf(printf) +import Text.Read(readMaybe) import Text.Regex.PCRE((=~)) import BDCS.DB(Files(..), KeyVal(..), checkAndRunSqlite) @@ -116,6 +117,9 @@ runCommand db args = do (opts, _) <- compilerOpts options defaultLsOptions args "ls" + when (isNothing $ lsLabelMatches opts) $ + throwIO InvalidLabelError + printer <- if | lsJSONOutput opts -> return $ liftedPutStrLn . jsonPrinter | lsVerbose opts -> do currentYear <- formatTime defaultTimeLocale "%Y" <$> getCurrentTime return $ liftedPutStrLn . verbosePrinter currentYear @@ -158,9 +162,7 @@ (NoArg (\opts -> opts { lsVerbose = True })) "use a long listing format", Option [] ["label"] - (ReqArg (\d opts -> case reads d :: [(Label, String)] of - [(lbl, _)] -> opts { lsLabelMatches = Just lbl } - _ -> throw $ InvalidLabelError d) "LABEL") + (ReqArg (\d opts -> opts { lsLabelMatches = readMaybe d }) "LABEL") "return only results with the given LABEL", Option ['m'] ["matches"] (ReqArg (\d opts -> opts { lsMatches = d }) "REGEX") @@ -203,7 +205,7 @@ Nothing -> usage Just (db, _, args) -> do unlessM (doesFileExist db) $ - throw MissingDBError + throwIO MissingDBError result <- runCommand (T.pack db) args whenLeft result print @@ -215,8 +217,8 @@ where -- And then add handlers for the various kinds of InspectErrors here. handleInspectErrors :: InspectErrors -> IO () - handleInspectErrors (InvalidLabelError lbl) = do - putStrLn $ lbl ++ " is not a recognized file label\n" + handleInspectErrors InvalidLabelError = do + putStrLn "Unrecognized file label given.\n" putStrLn "Recognized labels:\n" forM_ labelDescriptions $ \(l, d) -> putStrLn $ " " ++ l ++ " - " ++ d diff --git a/src/tools/inspect/subcommands/nevras.hs b/src/tools/inspect/subcommands/nevras.hs --- a/src/tools/inspect/subcommands/nevras.hs +++ b/src/tools/inspect/subcommands/nevras.hs @@ -1,7 +1,7 @@ {-# LANGUAGE ScopedTypeVariables #-} import Control.Conditional(unlessM) -import Control.Exception(Handler(..), catches, throw) +import Control.Exception(Handler(..), catches, throwIO) import Control.Monad.Except(runExceptT) import Data.Conduit((.|), runConduit) import qualified Data.Conduit.List as CL @@ -65,7 +65,7 @@ Nothing -> usage Just (db, repo, args) -> do unlessM (doesFileExist db) $ - throw MissingDBError + throwIO MissingDBError result <- runCommand (T.pack db) repo args whenLeft result (\e -> print $ "error: " ++ e)