|
|
|
@ -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
|
|
|
|
|
.| untar (withDecompressedFile toTarget)
|
|
|
|
|
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)
|
|
|
|
|