From c81cabfcbfd2b91a7ce82168fdea4f9af6788b62 Mon Sep 17 00:00:00 2001
From: Eugen Wissner <belka@caraus.de>
Date: Tue, 14 May 2024 19:05:41 +0200
Subject: [PATCH] Replace extern rm rf call with a function

---
 lib/SlackBuilder/Download.hs | 29 +++++++++++++++++------------
 src/SlackBuilder/Update.hs   | 10 ++--------
 2 files changed, 19 insertions(+), 20 deletions(-)

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'