OSS/slackbuilder
1
0
Fork 0
Code Issues 4 Pull Requests Actions Releases Activity

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

Browse Source
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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

29
lib/SlackBuilder/Download.hs
View File

@ -7,6 +7,7 @@ module SlackBuilder.Download
( cloneAndUpload ( cloneAndUpload
, extractRemote , extractRemote
, commit , commit
, createLzmaTarball
, download , download
, hostedSources , hostedSources
, remoteFileExists , remoteFileExists
@ -32,7 +33,7 @@ import SlackBuilder.Config
import SlackBuilder.Trans import SlackBuilder.Trans
import Control.Monad.Trans.Reader (asks) import Control.Monad.Trans.Reader (asks)
import Control.Monad.IO.Class (MonadIO(liftIO)) import Control.Monad.IO.Class (MonadIO(liftIO))
import System.Directory (createDirectory) import System.Directory (createDirectory, removePathForcibly)
import System.IO (IOMode(..), withFile) import System.IO (IOMode(..), withFile)
import System.FilePath ((</>), (<.>), takeFileName, takeDirectory, stripExtension) import System.FilePath ((</>), (<.>), takeFileName, takeDirectory, stripExtension)
import System.Process import System.Process
@ -43,7 +44,7 @@ import System.Process
, callProcess , callProcess
) )
import System.Exit (ExitCode(..)) import System.Exit (ExitCode(..))
import Control.Monad (unless) import Control.Monad (unless, void)
import Text.URI (URI(..)) import Text.URI (URI(..))
import qualified Text.URI as URI import qualified Text.URI as URI
import Network.HTTP.Req import Network.HTTP.Req
@ -55,23 +56,25 @@ import Network.HTTP.Req
, defaultHttpConfig , defaultHttpConfig
, ignoreResponse , ignoreResponse
, responseStatusCode , responseStatusCode
, MonadHttp
, HttpConfig(..) , HttpConfig(..)
, GET(..) , GET(..)
, reqBr, MonadHttp , reqBr
) )
import Data.Functor ((<&>)) import Data.Functor ((<&>))
import Network.HTTP.Client (BodyReader, Response(..), brRead) import Network.HTTP.Client (BodyReader, Response(..), brRead)
import Conduit import Conduit
( ConduitT ( ConduitT
, MonadResource
, yield , yield
, runConduitRes , runConduitRes
, sinkFile , sinkFile
, (.|) , (.|)
, ZipSink(..) , ZipSink(..)
, await , 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 Crypto.Hash (Digest, MD5, hashInit, hashFinalize, hashUpdate)
import Data.Void (Void) import Data.Void (Void)
import qualified Data.Conduit.Lzma as Lzma import qualified Data.Conduit.Lzma as Lzma
@ -160,7 +163,7 @@ cloneAndArchive repo tarballPath tagPrefix = do
repositoryTarballPath <- relativeToRepository tarballPath repositoryTarballPath <- relativeToRepository tarballPath
repositoryArchivePath <- relativeToRepository $ tarballPath <.> "tar.xz" repositoryArchivePath <- relativeToRepository $ tarballPath <.> "tar.xz"
liftIO liftIO
$ callProcess "rm" ["-rf", repositoryTarballPath] $ removePathForcibly repositoryTarballPath
>> callProcess "git" >> callProcess "git"
[ "clone" [ "clone"
, Text.unpack repo , Text.unpack repo
@ -180,12 +183,14 @@ cloneAndArchive repo tarballPath tagPrefix = do
, "--init" , "--init"
, "--recursive" , "--recursive"
] ]
>> callProcess "tar" >> createLzmaTarball repositoryTarballPath repositoryArchivePath
["Jcvf" >> removePathForcibly repositoryTarballPath
, repositoryArchivePath
, repositoryTarballPath createLzmaTarball :: FilePath -> FilePath -> IO (Digest MD5)
] createLzmaTarball input output = runConduitRes $ yield input
>> callProcess "rm" ["-rf", repositoryTarballPath] .| void tarFilePath
.| Lzma.compress Nothing
.| sinkFileAndHash output
responseBodySource :: MonadIO m => Response BodyReader -> ConduitT i ByteString m () responseBodySource :: MonadIO m => Response BodyReader -> ConduitT i ByteString m ()
responseBodySource = bodyReaderSource . responseBody responseBodySource = bodyReaderSource . responseBody

10
src/SlackBuilder/Update.hs
View File

@ -61,13 +61,10 @@ import System.Console.ANSI
, Color(..) , Color(..)
, ConsoleLayer(..) , ConsoleLayer(..)
) )
import Control.Monad (filterM, void) import Control.Monad (filterM)
import Data.List (isPrefixOf, isSuffixOf, partition) import Data.List (isPrefixOf, isSuffixOf, partition)
import Conduit (runConduitRes, (.|), yield)
import Data.Functor ((<&>)) import Data.Functor ((<&>))
import Data.Bifunctor (Bifunctor(..)) import Data.Bifunctor (Bifunctor(..))
import Data.Conduit.Tar (tarFilePath)
import qualified Data.Conduit.Lzma as Lzma
getAndLogLatest :: PackageDescription -> SlackBuilderT (Maybe PackageUpdateData) getAndLogLatest :: PackageDescription -> SlackBuilderT (Maybe PackageUpdateData)
getAndLogLatest description = do getAndLogLatest description = do
@ -182,10 +179,7 @@ reuploadWithTemplate downloadTemplate commands packagePath version = do
appendTarExtension = (<.> "tar.xz") appendTarExtension = (<.> "tar.xz")
in fmap (appendTarExtension tarballPath,) in fmap (appendTarExtension tarballPath,)
$ withCurrentDirectory (takeDirectory tarballPath) $ withCurrentDirectory (takeDirectory tarballPath)
$ runConduitRes $ yield archiveBaseFilename $ createLzmaTarball archiveBaseFilename archiveBaseFilename
.| void tarFilePath
.| Lzma.compress Nothing
.| sinkFileAndHash (appendTarExtension archiveBaseFilename)
handleReupload relativeTarball = do handleReupload relativeTarball = do
liftIO $ putStrLn $ "Upload the source tarball " <> relativeTarball liftIO $ putStrLn $ "Upload the source tarball " <> relativeTarball
uploadSource relativeTarball category' uploadSource relativeTarball category'