Support extracting gzip on the fly
Some checks failed
Build / audit (push) Successful in 14m44s
Build / test (push) Failing after 5m47s

This commit is contained in:
Eugen Wissner 2024-03-03 17:12:29 +01:00
parent 4c06ae274b
commit e5bde183a5
Signed by: belka
GPG Key ID: A27FDC1E8EE902C0
4 changed files with 41 additions and 13 deletions

View File

@ -18,7 +18,7 @@ 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.Foldable (find)
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.Text (Text)
@ -30,7 +30,7 @@ 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.FilePath ((</>), (<.>), takeFileName, takeDirectory, stripExtension)
import System.Process
( CreateProcess(..)
, StdStream(..)
@ -70,6 +70,8 @@ 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
import qualified Data.Conduit.Zlib as Zlib
import Control.Monad.Catch (MonadThrow(..))
updateSlackBuildVersion :: Text -> Text -> Map Text Text -> SlackBuilderT ()
updateSlackBuildVersion packagePath version additionalDownloads = do
@ -221,19 +223,41 @@ cloneAndUpload repo tarballPath tagPrefix = do
>> uploadCommand localPath remoteArchivePath
>> liftIO (runConduitRes go) <&> Just . (remoteResultURI,)
extractRemote :: URI -> Text -> SlackBuilderT ()
-- | Downloads a compressed tar archive and extracts its contents on the fly to
-- a directory.
--
-- If the download contains the disposition header and the attachment type was
-- recognized as tar archive, returns the attachment name from the
-- disposition header without the extension. So if the disposition header
-- is "attachment; filename=package-1.2.3.tar.gz", returns "package-1.2.3".
extractRemote :: URI -> Text -> SlackBuilderT (Maybe Text)
extractRemote uri' packagePath = do
repository' <- SlackBuilderT $ asks repository
let localToRepository = repository' </> Text.unpack packagePath
traverse_ (runReq defaultHttpConfig . go localToRepository . fst)
$ useHttpsURI uri'
case useHttpsURI uri' of
Just (httpsURI, _httpsOptions) ->
runReq defaultHttpConfig $ go localToRepository httpsURI
Nothing -> throwM $ HttpsUrlExpected 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
readResponse :: FilePath -> Response BodyReader -> IO (Maybe Text)
readResponse toTarget response = do
let attachmentName
= fmap (Char8.unpack . snd . Char8.breakEnd (== '=') . snd)
$ find ((== "Content-Disposition") . fst)
$ responseHeaders response
(decompress, attachmentDirectory) =
case attachmentName of
Just attachmentName'
| Just directoryName' <- stripExtension ".tar.gz" attachmentName' ->
(Zlib.ungzip, Just directoryName')
| Just directoryName' <- stripExtension ".tar.xz" attachmentName' ->
(Lzma.decompress Nothing, Just directoryName')
_ -> (pure (), Nothing)
runConduitRes $ responseBodySource response
.| decompress
.| untar (withDecompressedFile toTarget)
pure $ Text.pack <$> attachmentDirectory
withDecompressedFile toTarget FileInfo{..}
| Char8.last filePath /= '/' =
sinkFile (toTarget </> Char8.unpack filePath)

View File

@ -16,8 +16,11 @@ import Control.Monad.IO.Class (MonadIO(..))
import Control.Monad.Catch (MonadCatch(..), MonadThrow(..))
import Control.Exception (Exception(..))
import System.FilePath ((</>))
import Text.URI (URI)
newtype SlackBuilderException = UpdaterNotFound Text
data SlackBuilderException
= UpdaterNotFound Text
| HttpsUrlExpected URI
deriving Show
instance Exception SlackBuilderException

View File

@ -20,6 +20,7 @@ common dependencies
base >= 4.16 && < 5,
bytestring ^>= 0.11.0,
conduit ^>= 1.3.5,
conduit-extra ^>= 1.3,
http-client ^>= 0.7,
containers ^>= 0.6,
cryptonite >= 0.30,

View File

@ -61,7 +61,7 @@ import System.Console.ANSI
, ConsoleLayer(..)
)
import System.Directory (listDirectory, doesDirectoryExist, withCurrentDirectory, removeDirectoryRecursive)
import Control.Monad (filterM)
import Control.Monad (filterM, void)
import Data.List (isPrefixOf, isSuffixOf, partition)
import Conduit (runConduitRes, (.|), sourceFile)
import Data.Functor ((<&>))
@ -407,7 +407,7 @@ reuploadWithTemplate downloadTemplate commands packagePath version = do
relativeTarball = Text.unpack $ packagePath <> "/" <> downloadFileName
tarball = repository' </> relativeTarball
extractRemote uri' packagePath
void $ extractRemote uri' packagePath
download' <- handleReupload relativeTarball downloadFileName
checksum <- liftIO $ runConduitRes $ sourceFile tarball .| sinkHash