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 module SlackBuilder.Download
( cloneAndUpload ( cloneAndUpload
, cloneAndArchive , extractRemote
, commit , commit
, download , download
, hostedSources , hostedSources
@ -17,6 +17,8 @@ module SlackBuilder.Download
import Data.ByteString (ByteString) import Data.ByteString (ByteString)
import qualified Data.ByteString as ByteString import qualified Data.ByteString as ByteString
import qualified Data.ByteString.Char8 as Char8
import Data.Foldable (traverse_)
import Data.Map.Strict (Map) import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map import qualified Data.Map.Strict as Map
import Data.Text (Text) import Data.Text (Text)
@ -26,6 +28,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.IO (IOMode(..), withFile) import System.IO (IOMode(..), withFile)
import System.FilePath ((</>), (<.>), takeFileName, takeDirectory) import System.FilePath ((</>), (<.>), takeFileName, takeDirectory)
import System.Process import System.Process
@ -63,8 +66,10 @@ import Conduit
, await , await
, sourceFile , sourceFile
) )
import Data.Conduit.Tar (untar, FileInfo(..))
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
updateSlackBuildVersion :: Text -> Text -> Map Text Text -> SlackBuilderT () updateSlackBuildVersion :: Text -> Text -> Map Text Text -> SlackBuilderT ()
updateSlackBuildVersion packagePath version additionalDownloads = do updateSlackBuildVersion packagePath version additionalDownloads = do
@ -215,3 +220,21 @@ cloneAndUpload repo tarballPath tagPrefix = do
in cloneAndArchive repo tarballPath tagPrefix in cloneAndArchive repo tarballPath tagPrefix
>> uploadCommand localPath remoteArchivePath >> uploadCommand localPath remoteArchivePath
>> liftIO (runConduitRes go) <&> Just . (remoteResultURI,) >> 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 ( main
) where ) where
import qualified Data.ByteString.Char8 as Char8
import Data.Char (isNumber) import Data.Char (isNumber)
import Control.Applicative (Applicative(liftA2)) import Control.Applicative (Applicative(liftA2))
import Data.List.NonEmpty (NonEmpty(..)) import Data.List.NonEmpty (NonEmpty(..))
@ -31,9 +30,9 @@ import SlackBuilder.Package (Package(..))
import qualified SlackBuilder.Package as Package import qualified SlackBuilder.Package as Package
import Text.URI (URI(..), mkURI) import Text.URI (URI(..), mkURI)
import Text.URI.QQ (uri) 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 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 SlackBuilder.Info
import Text.Megaparsec (parse, errorBundlePretty) import Text.Megaparsec (parse, errorBundlePretty)
import GHC.Records (HasField(..)) import GHC.Records (HasField(..))
@ -52,21 +51,10 @@ import System.Console.ANSI
, Color(..) , Color(..)
, ConsoleLayer(..) , ConsoleLayer(..)
) )
import System.Directory (listDirectory, doesDirectoryExist, createDirectory) import System.Directory (listDirectory, doesDirectoryExist, withCurrentDirectory, removeDirectoryRecursive)
import Control.Monad (filterM) import Control.Monad (filterM)
import Data.List (isPrefixOf, isSuffixOf, partition) import Data.List (isPrefixOf, isSuffixOf, partition)
import Network.HTTP.Client (Response, BodyReader) import Conduit (runConduitRes, (.|), sourceFile)
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
autoUpdatable :: [Package] autoUpdatable :: [Package]
autoUpdatable = autoUpdatable =
@ -407,11 +395,11 @@ reuploadWithTemplate downloadTemplate commands packagePath version = do
uri' <- liftIO $ Package.renderDownloadWithVersion downloadTemplate version uri' <- liftIO $ Package.renderDownloadWithVersion downloadTemplate version
let downloadFileName = URI.unRText let downloadFileName = URI.unRText
$ NonEmpty.last $ snd $ fromJust $ URI.uriPath uri' $ NonEmpty.last $ snd $ fromJust $ URI.uriPath uri'
relativeTarball = packagePath <> "/" <> downloadFileName relativeTarball = Text.unpack $ packagePath <> "/" <> downloadFileName
tarball = repository' </> Text.unpack relativeTarball tarball = repository' </> relativeTarball
extractRemote uri' extractRemote uri' packagePath
download' <- handleReupload (Text.unpack relativeTarball) downloadFileName download' <- handleReupload relativeTarball downloadFileName
checksum <- liftIO $ runConduitRes $ sourceFile tarball .| sinkHash checksum <- liftIO $ runConduitRes $ sourceFile tarball .| sinkHash
pure $ Package.Download download' checksum pure $ Package.Download download' checksum
@ -419,18 +407,22 @@ reuploadWithTemplate downloadTemplate commands packagePath version = do
name' = Text.pack $ takeBaseName $ Text.unpack packagePath name' = Text.pack $ takeBaseName $ Text.unpack packagePath
handleReupload relativeTarball downloadFileName = do handleReupload relativeTarball downloadFileName = do
repository' <- SlackBuilderT $ asks repository repository' <- SlackBuilderT $ asks repository
downloadURL' <- SlackBuilderT $ asks downloadURL
liftIO $ putStrLn $ "Upload the source tarball " <> relativeTarball
case commands of case commands of
[] -> uploadTarball relativeTarball downloadFileName [] -> uploadCommand relativeTarball ("/" <> name')
_ -> _ ->
let tarballPath = repository' </> relativeTarball let tarballPath = repository' </> relativeTarball
packedDirectory = takeBaseName $ dropExtension tarballPath packedDirectory = dropExtension $ dropExtension tarballPath
in liftIO (traverse (defaultCreateProcess packedDirectory) commands) in liftIO (traverse (defaultCreateProcess packedDirectory) commands)
>> liftIO (callProcess "tar" ["Jcvf", tarballPath, packedDirectory]) >> liftIO
>> uploadTarball relativeTarball downloadFileName ( withCurrentDirectory (takeDirectory tarballPath)
uploadTarball relativeTarball downloadFileName $ callProcess "tar" ["Jcvf", takeFileName tarballPath, takeFileName packedDirectory]
= liftIO (putStrLn $ "Upload the source tarball " <> relativeTarball) )
>> liftIO (removeDirectoryRecursive packedDirectory)
>> uploadCommand relativeTarball ("/" <> name') >> uploadCommand relativeTarball ("/" <> name')
>> liftIO (mkURI $ "https://download.dlackware.com/hosted-sources/" <> name' <> "/" <> downloadFileName) liftIO $ mkURI $ downloadURL' <> "/" <> name' <> "/" <> downloadFileName
defaultCreateProcess cwd' cmdSpec defaultCreateProcess cwd' cmdSpec
= flip withCreateProcess (const . const . const waitForProcess) = flip withCreateProcess (const . const . const waitForProcess)
$ CreateProcess $ CreateProcess
@ -450,19 +442,6 @@ reuploadWithTemplate downloadTemplate commands packagePath version = do
, child_user = Nothing , child_user = Nothing
, child_group = 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 -> Text -> PackageInfo -> SlackBuilderT ()
updatePackage Package{..} version info = do updatePackage Package{..} version info = do