Get the checksum after repackaging
This commit is contained in:
parent
2802194063
commit
45472a9088
@ -9,6 +9,8 @@ module SlackBuilder.Download
|
||||
, download
|
||||
, hostedSources
|
||||
, remoteFileExists
|
||||
, responseBodySource
|
||||
, sinkHash
|
||||
, updateSlackBuildVersion
|
||||
, uploadCommand
|
||||
) where
|
||||
|
@ -19,6 +19,8 @@ common dependencies
|
||||
build-depends:
|
||||
base >= 4.16 && < 5,
|
||||
bytestring ^>= 0.11.0,
|
||||
conduit ^>= 1.3.5,
|
||||
http-client ^>= 0.7,
|
||||
containers ^>= 0.6,
|
||||
cryptonite >= 0.30,
|
||||
directory ^>= 1.3.8,
|
||||
@ -30,6 +32,8 @@ common dependencies
|
||||
parser-combinators ^>= 1.3,
|
||||
process ^>= 1.6.18,
|
||||
req ^>= 3.13,
|
||||
tar-conduit ^>= 0.4,
|
||||
lzma-conduit ^>= 1.2,
|
||||
text ^>= 2.0,
|
||||
tomland ^>= 1.3.3,
|
||||
transformers ^>= 0.5.6,
|
||||
@ -57,10 +61,6 @@ library
|
||||
SlackBuilder.Package
|
||||
SlackBuilder.Trans
|
||||
hs-source-dirs: lib
|
||||
build-depends:
|
||||
conduit ^>= 1.3.5,
|
||||
http-client ^>= 0.7
|
||||
|
||||
ghc-options: -Wall
|
||||
|
||||
executable slackbuilder
|
||||
|
41
src/Main.hs
41
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
|
||||
|
Loading…
Reference in New Issue
Block a user