diff --git a/lib/SlackBuilder/Download.hs b/lib/SlackBuilder/Download.hs index 285e389..53e609c 100644 --- a/lib/SlackBuilder/Download.hs +++ b/lib/SlackBuilder/Download.hs @@ -7,6 +7,7 @@ module SlackBuilder.Download ( cloneAndUpload , extractRemote , commit + , createLzmaTarball , download , hostedSources , remoteFileExists @@ -32,7 +33,7 @@ import SlackBuilder.Config import SlackBuilder.Trans import Control.Monad.Trans.Reader (asks) import Control.Monad.IO.Class (MonadIO(liftIO)) -import System.Directory (createDirectory) +import System.Directory (createDirectory, removePathForcibly) import System.IO (IOMode(..), withFile) import System.FilePath ((), (<.>), takeFileName, takeDirectory, stripExtension) import System.Process @@ -43,7 +44,7 @@ import System.Process , callProcess ) import System.Exit (ExitCode(..)) -import Control.Monad (unless) +import Control.Monad (unless, void) import Text.URI (URI(..)) import qualified Text.URI as URI import Network.HTTP.Req @@ -55,23 +56,25 @@ import Network.HTTP.Req , defaultHttpConfig , ignoreResponse , responseStatusCode + , MonadHttp , HttpConfig(..) , GET(..) - , reqBr, MonadHttp + , reqBr ) import Data.Functor ((<&>)) import Network.HTTP.Client (BodyReader, Response(..), brRead) import Conduit ( ConduitT + , MonadResource , yield , runConduitRes , sinkFile , (.|) , ZipSink(..) , await - , sourceFile, MonadResource + , sourceFile ) -import Data.Conduit.Tar (untar, FileInfo(..)) +import Data.Conduit.Tar (FileInfo(..), tarFilePath, untar) import Crypto.Hash (Digest, MD5, hashInit, hashFinalize, hashUpdate) import Data.Void (Void) import qualified Data.Conduit.Lzma as Lzma @@ -160,7 +163,7 @@ cloneAndArchive repo tarballPath tagPrefix = do repositoryTarballPath <- relativeToRepository tarballPath repositoryArchivePath <- relativeToRepository $ tarballPath <.> "tar.xz" liftIO - $ callProcess "rm" ["-rf", repositoryTarballPath] + $ removePathForcibly repositoryTarballPath >> callProcess "git" [ "clone" , Text.unpack repo @@ -180,12 +183,14 @@ cloneAndArchive repo tarballPath tagPrefix = do , "--init" , "--recursive" ] - >> callProcess "tar" - ["Jcvf" - , repositoryArchivePath - , repositoryTarballPath - ] - >> callProcess "rm" ["-rf", repositoryTarballPath] + >> createLzmaTarball repositoryTarballPath repositoryArchivePath + >> removePathForcibly repositoryTarballPath + +createLzmaTarball :: FilePath -> FilePath -> IO (Digest MD5) +createLzmaTarball input output = runConduitRes $ yield input + .| void tarFilePath + .| Lzma.compress Nothing + .| sinkFileAndHash output responseBodySource :: MonadIO m => Response BodyReader -> ConduitT i ByteString m () responseBodySource = bodyReaderSource . responseBody diff --git a/src/SlackBuilder/Update.hs b/src/SlackBuilder/Update.hs index 918db66..c515f4b 100644 --- a/src/SlackBuilder/Update.hs +++ b/src/SlackBuilder/Update.hs @@ -61,13 +61,10 @@ import System.Console.ANSI , Color(..) , ConsoleLayer(..) ) -import Control.Monad (filterM, void) +import Control.Monad (filterM) import Data.List (isPrefixOf, isSuffixOf, partition) -import Conduit (runConduitRes, (.|), yield) import Data.Functor ((<&>)) import Data.Bifunctor (Bifunctor(..)) -import Data.Conduit.Tar (tarFilePath) -import qualified Data.Conduit.Lzma as Lzma getAndLogLatest :: PackageDescription -> SlackBuilderT (Maybe PackageUpdateData) getAndLogLatest description = do @@ -182,10 +179,7 @@ reuploadWithTemplate downloadTemplate commands packagePath version = do appendTarExtension = (<.> "tar.xz") in fmap (appendTarExtension tarballPath,) $ withCurrentDirectory (takeDirectory tarballPath) - $ runConduitRes $ yield archiveBaseFilename - .| void tarFilePath - .| Lzma.compress Nothing - .| sinkFileAndHash (appendTarExtension archiveBaseFilename) + $ createLzmaTarball archiveBaseFilename archiveBaseFilename handleReupload relativeTarball = do liftIO $ putStrLn $ "Upload the source tarball " <> relativeTarball uploadSource relativeTarball category'