module BDCS.Export(export,
exportAndCustomize)
where
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
import Data.ContentStore(openContentStore)
import qualified Data.Map.Strict as Map
import qualified Data.Text as T
import Database.Esqueleto(SqlPersistT)
import qualified BDCS.CS as CS
import BDCS.DB(Files)
import qualified BDCS.Export.Directory as Directory
import BDCS.Export.Customize(Customization, filesToObjectsC, runCustomizations)
import BDCS.Export.FSTree(filesToTree, fstreeSource)
import qualified BDCS.Export.Ostree as Ostree
import qualified BDCS.Export.Qcow2 as Qcow2
import qualified BDCS.Export.Tar as Tar
import BDCS.Export.Types(ExportType(..))
import BDCS.Export.Utils(runHacks, runTmpfiles)
import BDCS.Files(groupIdToFilesC)
import BDCS.Groups(getGroupIdC)
export :: (MonadBaseControl IO m, MonadError String m, MonadLoggerIO m, MonadResource m) =>
FilePath
-> FilePath
-> ExportType
-> [T.Text]
-> SqlPersistT m ()
export repo out_path ty things = exportAndCustomize repo out_path ty things []
exportAndCustomize :: (MonadBaseControl IO m, MonadError String m, MonadLoggerIO m, MonadResource m) =>
FilePath
-> FilePath
-> ExportType
-> [T.Text]
-> [Customization]
-> SqlPersistT m ()
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
ExportOstree -> Ostree.ostreeSink out_path
ExportDirectory -> directoryOutput out_path
runExceptT (openContentStore repo) >>= \case
Left e -> throwError $ show e
Right cs -> do
fstree <- runConduit $ CL.sourceList things
.| getGroupIdC
.| groupIdToFilesC
.| filesToTree
let overlay = Map.empty
(overlay', fstree') <- runCustomizations overlay cs fstree custom
runConduitRes $ fstreeSource fstree' .| filesToObjectsC overlay' cs .| objectSink
where
directoryOutput :: (MonadBaseControl IO m, MonadError String m, MonadLoggerIO m) => FilePath -> Consumer (Files, CS.Object) m ()
directoryOutput path = do
logDebugN "Running tmpfiles"
lift $ runTmpfiles path
Directory.directorySink path
logDebugN "Running standard hacks"
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)