Remove the source directory after repackaing
Some checks failed
Build / audit (push) Successful in 15m1s
Build / test (push) Failing after 6m29s

This commit is contained in:
Eugen Wissner 2024-01-28 13:35:53 +01:00
parent 45472a9088
commit c8643a2fd4
Signed by: belka
GPG Key ID: A27FDC1E8EE902C0
2 changed files with 44 additions and 42 deletions

View File

@ -4,7 +4,7 @@
module SlackBuilder.Download
( cloneAndUpload
, cloneAndArchive
, extractRemote
, commit
, download
, hostedSources
@ -17,6 +17,8 @@ module SlackBuilder.Download
import Data.ByteString (ByteString)
import qualified Data.ByteString as ByteString
import qualified Data.ByteString.Char8 as Char8
import Data.Foldable (traverse_)
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.Text (Text)
@ -26,6 +28,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.IO (IOMode(..), withFile)
import System.FilePath ((</>), (<.>), takeFileName, takeDirectory)
import System.Process
@ -63,8 +66,10 @@ import Conduit
, await
, sourceFile
)
import Data.Conduit.Tar (untar, FileInfo(..))
import Crypto.Hash (Digest, MD5, hashInit, hashFinalize, hashUpdate)
import Data.Void (Void)
import qualified Data.Conduit.Lzma as Lzma
updateSlackBuildVersion :: Text -> Text -> Map Text Text -> SlackBuilderT ()
updateSlackBuildVersion packagePath version additionalDownloads = do
@ -215,3 +220,21 @@ cloneAndUpload repo tarballPath tagPrefix = do
in cloneAndArchive repo tarballPath tagPrefix
>> uploadCommand localPath remoteArchivePath
>> liftIO (runConduitRes go) <&> Just . (remoteResultURI,)
extractRemote :: URI -> Text -> SlackBuilderT ()
extractRemote uri' packagePath = do
repository' <- SlackBuilderT $ asks repository
let localToRepository = repository' </> Text.unpack packagePath
traverse_ (runReq defaultHttpConfig . go localToRepository . fst)
$ useHttpsURI uri'
where
go toTarget url' = reqBr GET url' NoReqBody mempty $ readResponse toTarget
readResponse :: FilePath -> Response BodyReader -> IO ()
readResponse toTarget response = runConduitRes
$ responseBodySource response
.| Lzma.decompress Nothing
.| untar (withDecompressedFile toTarget)
withDecompressedFile toTarget FileInfo{..}
| Char8.last filePath /= '/' =
sinkFile (toTarget </> Char8.unpack filePath)
| otherwise = liftIO (createDirectory (toTarget </> Char8.unpack filePath))

View File

@ -6,7 +6,6 @@ module Main
( main
) where
import qualified Data.ByteString.Char8 as Char8
import Data.Char (isNumber)
import Control.Applicative (Applicative(liftA2))
import Data.List.NonEmpty (NonEmpty(..))
@ -31,9 +30,9 @@ import SlackBuilder.Package (Package(..))
import qualified SlackBuilder.Package as Package
import Text.URI (URI(..), mkURI)
import Text.URI.QQ (uri)
import Data.Foldable (Foldable(..), for_, find, traverse_)
import Data.Foldable (Foldable(..), for_, find)
import qualified Text.URI as URI
import System.FilePath ((</>), (<.>), dropExtension, takeBaseName, makeRelative, splitFileName)
import System.FilePath ((</>), (<.>), dropExtension, takeBaseName, makeRelative, splitFileName, takeDirectory, takeFileName)
import SlackBuilder.Info
import Text.Megaparsec (parse, errorBundlePretty)
import GHC.Records (HasField(..))
@ -52,21 +51,10 @@ import System.Console.ANSI
, Color(..)
, ConsoleLayer(..)
)
import System.Directory (listDirectory, doesDirectoryExist, createDirectory)
import System.Directory (listDirectory, doesDirectoryExist, withCurrentDirectory, removeDirectoryRecursive)
import Control.Monad (filterM)
import Data.List (isPrefixOf, isSuffixOf, partition)
import Network.HTTP.Client (Response, BodyReader)
import Network.HTTP.Req
( runReq
, defaultHttpConfig
, useHttpsURI
, GET(..)
, reqBr
, NoReqBody(..)
)
import Conduit (runConduitRes, (.|), sinkFile, sourceFile)
import Data.Conduit.Tar (untar, FileInfo(..))
import qualified Data.Conduit.Lzma as Lzma
import Conduit (runConduitRes, (.|), sourceFile)
autoUpdatable :: [Package]
autoUpdatable =
@ -407,11 +395,11 @@ reuploadWithTemplate downloadTemplate commands packagePath version = do
uri' <- liftIO $ Package.renderDownloadWithVersion downloadTemplate version
let downloadFileName = URI.unRText
$ NonEmpty.last $ snd $ fromJust $ URI.uriPath uri'
relativeTarball = packagePath <> "/" <> downloadFileName
tarball = repository' </> Text.unpack relativeTarball
relativeTarball = Text.unpack $ packagePath <> "/" <> downloadFileName
tarball = repository' </> relativeTarball
extractRemote uri'
download' <- handleReupload (Text.unpack relativeTarball) downloadFileName
extractRemote uri' packagePath
download' <- handleReupload relativeTarball downloadFileName
checksum <- liftIO $ runConduitRes $ sourceFile tarball .| sinkHash
pure $ Package.Download download' checksum
@ -419,18 +407,22 @@ reuploadWithTemplate downloadTemplate commands packagePath version = do
name' = Text.pack $ takeBaseName $ Text.unpack packagePath
handleReupload relativeTarball downloadFileName = do
repository' <- SlackBuilderT $ asks repository
downloadURL' <- SlackBuilderT $ asks downloadURL
liftIO $ putStrLn $ "Upload the source tarball " <> relativeTarball
case commands of
[] -> uploadTarball relativeTarball downloadFileName
[] -> uploadCommand relativeTarball ("/" <> name')
_ ->
let tarballPath = repository' </> relativeTarball
packedDirectory = takeBaseName $ dropExtension tarballPath
packedDirectory = dropExtension $ dropExtension tarballPath
in liftIO (traverse (defaultCreateProcess packedDirectory) commands)
>> liftIO (callProcess "tar" ["Jcvf", tarballPath, packedDirectory])
>> uploadTarball relativeTarball downloadFileName
uploadTarball relativeTarball downloadFileName
= liftIO (putStrLn $ "Upload the source tarball " <> relativeTarball)
>> liftIO
( withCurrentDirectory (takeDirectory tarballPath)
$ callProcess "tar" ["Jcvf", takeFileName tarballPath, takeFileName packedDirectory]
)
>> liftIO (removeDirectoryRecursive packedDirectory)
>> uploadCommand relativeTarball ("/" <> name')
>> liftIO (mkURI $ "https://download.dlackware.com/hosted-sources/" <> name' <> "/" <> downloadFileName)
liftIO $ mkURI $ downloadURL' <> "/" <> name' <> "/" <> downloadFileName
defaultCreateProcess cwd' cmdSpec
= flip withCreateProcess (const . const . const waitForProcess)
$ CreateProcess
@ -450,19 +442,6 @@ reuploadWithTemplate downloadTemplate commands packagePath version = do
, child_user = Nothing
, child_group = Nothing
}
extractRemote :: URI -> SlackBuilderT ()
extractRemote uri' = traverse_ (runReq defaultHttpConfig . go . fst)
$ useHttpsURI uri'
go uri' = reqBr GET uri' NoReqBody mempty readResponse
readResponse :: Response BodyReader -> IO ()
readResponse response = runConduitRes
$ responseBodySource response
.| Lzma.decompress Nothing
.| untar withDecompressedFile
withDecompressedFile FileInfo{..}
| Char8.last filePath /= '/' =
sinkFile (Char8.unpack filePath)
| otherwise = liftIO (createDirectory (Char8.unpack filePath))
updatePackage :: Package -> Text -> PackageInfo -> SlackBuilderT ()
updatePackage Package{..} version info = do