diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/Main.hs | 41 |
1 files changed, 35 insertions, 6 deletions
diff --git a/src/Main.hs b/src/Main.hs index 5395fb6..899cfd8 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -6,6 +6,7 @@ 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(..)) @@ -30,7 +31,7 @@ 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) +import Data.Foldable (Foldable(..), for_, find, traverse_) import qualified Text.URI as URI import System.FilePath ((</>), (<.>), dropExtension, takeBaseName, makeRelative, splitFileName) import SlackBuilder.Info @@ -51,9 +52,21 @@ import System.Console.ANSI , Color(..) , ConsoleLayer(..) ) -import System.Directory (listDirectory, doesDirectoryExist) +import System.Directory (listDirectory, doesDirectoryExist, createDirectory) 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 autoUpdatable :: [Package] autoUpdatable = @@ -390,12 +403,16 @@ downloadWithTemplate downloadTemplate packagePath version = do reuploadWithTemplate :: Package.DownloadTemplate -> [CmdSpec] -> Text -> Text -> SlackBuilderT Package.Download reuploadWithTemplate downloadTemplate commands packagePath version = do - Package.Download{ download = uri', md5sum = checksum } <- - downloadWithTemplate downloadTemplate packagePath version + repository' <- SlackBuilderT $ asks repository + 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 + + extractRemote uri' download' <- handleReupload (Text.unpack relativeTarball) downloadFileName + checksum <- liftIO $ runConduitRes $ sourceFile tarball .| sinkHash pure $ Package.Download download' checksum where @@ -407,8 +424,7 @@ reuploadWithTemplate downloadTemplate commands packagePath version = do _ -> let tarballPath = repository' </> relativeTarball packedDirectory = takeBaseName $ dropExtension tarballPath - in liftIO (callProcess "tar" ["xvf", tarballPath]) - >> liftIO (traverse (defaultCreateProcess packedDirectory) commands) + in liftIO (traverse (defaultCreateProcess packedDirectory) commands) >> liftIO (callProcess "tar" ["Jcvf", tarballPath, packedDirectory]) >> uploadTarball relativeTarball downloadFileName uploadTarball relativeTarball downloadFileName @@ -434,6 +450,19 @@ 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 |