Replace extern rm rf call with a function
All checks were successful
Build / audit (push) Successful in 13m18s
Build / test (push) Successful in 14m23s

This commit is contained in:
Eugen Wissner 2024-05-14 19:05:41 +02:00
parent 3b7b15f381
commit c81cabfcbf
Signed by: belka
GPG Key ID: A27FDC1E8EE902C0
2 changed files with 19 additions and 20 deletions

View File

@ -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

View File

@ -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'