Download and determine the digest

This commit is contained in:
Eugen Wissner 2023-08-21 13:38:20 +02:00
parent 258604f22d
commit 6983304b9d
Signed by: belka
GPG Key ID: A27FDC1E8EE902C0
6 changed files with 64 additions and 18 deletions

View File

@ -38,6 +38,8 @@ main = do
<$> remoteFileExists urlPath <$> remoteFileExists urlPath
ArchiveCommand repo nameVersion tarball tagPrefix -> ArchiveCommand repo nameVersion tarball tagPrefix ->
cloneAndArchive repo nameVersion tarball tagPrefix >> pure Nothing cloneAndArchive repo nameVersion tarball tagPrefix >> pure Nothing
DownloadCommand url target -> fmap (Text.pack . show)
<$> download url target
chooseTransformFunction (Just "php") = phpTransform chooseTransformFunction (Just "php") = phpTransform
chooseTransformFunction (Just "rdiff-backup") = Text.stripPrefix "v" chooseTransformFunction (Just "rdiff-backup") = Text.stripPrefix "v"
chooseTransformFunction _ = stripPrefix "v" chooseTransformFunction _ = stripPrefix "v"
@ -45,6 +47,6 @@ main = do
$ fromMaybe string $ fromMaybe string
$ Text.stripPrefix prefix string $ Text.stripPrefix prefix string
phpTransform version phpTransform version
| (majorPrefix, patchVersion) <- Text.breakOnEnd "." version | (majorPrefix, _patchVersion) <- Text.breakOnEnd "." version
, majorPrefix == "php-8.2." = Just $ Text.drop (Text.length "php-") version , majorPrefix == "php-8.2." = Just $ Text.drop (Text.length "php-") version
| otherwise = Nothing | otherwise = Nothing

View File

@ -27,6 +27,7 @@ data SlackBuilderCommand
| CommitCommand Text Text | CommitCommand Text Text
| ExistsCommand Text | ExistsCommand Text
| ArchiveCommand Text Text String Text | ArchiveCommand Text Text String Text
| DownloadCommand Text String
deriving (Eq, Show) deriving (Eq, Show)
data PackagistArguments = PackagistArguments data PackagistArguments = PackagistArguments
@ -69,6 +70,7 @@ slackBuilderCommand = subparser
<> command "commit" (info commitCommand mempty) <> command "commit" (info commitCommand mempty)
<> command "exists" (info existsCommand mempty) <> command "exists" (info existsCommand mempty)
<> command "archive" (info archiveCommand mempty) <> command "archive" (info archiveCommand mempty)
<> command "download" (info downloadCommand mempty)
where where
slackBuildCommand = SlackBuildCommand slackBuildCommand = SlackBuildCommand
<$> argument str (metavar "PATH") <$> argument str (metavar "PATH")
@ -82,3 +84,6 @@ slackBuilderCommand = subparser
<*> argument str (metavar "NAME_VERSION") <*> argument str (metavar "NAME_VERSION")
<*> argument str (metavar "TARBALL") <*> argument str (metavar "TARBALL")
<*> argument str (metavar "TAG_PREFIX") <*> argument str (metavar "TAG_PREFIX")
downloadCommand = DownloadCommand
<$> argument str (metavar "URI")
<*> argument str (metavar "TARGET")

View File

@ -1,11 +1,14 @@
module SlackBuilder.Download module SlackBuilder.Download
( cloneAndArchive ( cloneAndArchive
, commit , commit
, download
, hostedSources , hostedSources
, remoteFileExists , remoteFileExists
, updateSlackBuildVersion , updateSlackBuildVersion
) where ) where
import Data.ByteString (ByteString)
import qualified Data.ByteString as ByteString
import Data.Text (Text) import Data.Text (Text)
import qualified Data.Text as Text import qualified Data.Text as Text
import qualified Data.Text.IO as Text.IO import qualified Data.Text.IO as Text.IO
@ -15,7 +18,13 @@ import Control.Monad.Trans.Reader (asks)
import Control.Monad.IO.Class (MonadIO(liftIO)) import Control.Monad.IO.Class (MonadIO(liftIO))
import System.IO (IOMode(..), withFile) import System.IO (IOMode(..), withFile)
import System.FilePath ((</>), (<.>)) import System.FilePath ((</>), (<.>))
import System.Process (CreateProcess(..), StdStream(..), proc, readCreateProcessWithExitCode, callProcess) import System.Process
( CreateProcess(..)
, StdStream(..)
, proc
, readCreateProcessWithExitCode
, callProcess
)
import System.Exit (ExitCode(..)) import System.Exit (ExitCode(..))
import Control.Monad (unless) import Control.Monad (unless)
import Text.URI (URI(..), mkURI) import Text.URI (URI(..), mkURI)
@ -27,10 +36,24 @@ import Network.HTTP.Req
, runReq , runReq
, defaultHttpConfig , defaultHttpConfig
, ignoreResponse , ignoreResponse
, responseStatusCode, HttpConfig (..) , responseStatusCode
, HttpConfig(..)
, GET(..)
, reqBr
) )
import Data.Maybe (fromMaybe)
import Data.Functor ((<&>)) import Data.Functor ((<&>))
import Network.HTTP.Client (BodyReader, Response(..), brRead)
import Conduit
( ConduitT
, yield
, runConduitRes
, sinkFile
, (.|)
, ZipSink(..)
, await
)
import Crypto.Hash (Digest, MD5, hashInit, hashFinalize, hashUpdate)
import Data.Void (Void)
updateSlackBuildVersion :: Text -> Text -> SlackBuilderT () updateSlackBuildVersion :: Text -> Text -> SlackBuilderT ()
updateSlackBuildVersion packagePath version = do updateSlackBuildVersion packagePath version = do
@ -123,3 +146,25 @@ cloneAndArchive repo nameVersion tarball tagPrefix = do
, nameVersion' , nameVersion'
] ]
liftIO $ callProcess "rm" ["-rf", nameVersion'] liftIO $ callProcess "rm" ["-rf", nameVersion']
responseBodySource :: MonadIO m => Response BodyReader -> ConduitT i ByteString m ()
responseBodySource = bodyReaderSource . responseBody
where
bodyReaderSource br = liftIO (brRead br) >>= go br
go br bs = unless (ByteString.null bs) $ yield bs >> bodyReaderSource br
sinkHash :: Monad m => ConduitT ByteString Void m (Digest MD5)
sinkHash = sink hashInit
where
sink ctx = await
>>= maybe (pure $ hashFinalize ctx) (sink . hashUpdate ctx)
download :: Text -> FilePath -> SlackBuilderT (Maybe (Digest MD5))
download uri target = SlackBuilderT (liftIO $ mkURI uri)
>>= traverse (runReq defaultHttpConfig . go . fst) . useHttpsURI
where
go uri' = reqBr GET uri' NoReqBody mempty readResponse
readResponse :: Response BodyReader -> IO (Digest MD5)
readResponse response = runConduitRes
$ responseBodySource response
.| getZipSink (ZipSink (sinkFile target) *> ZipSink sinkHash)

View File

@ -36,7 +36,7 @@ import SlackBuilder.CommandLine
import SlackBuilder.Trans import SlackBuilder.Trans
import qualified Data.Aeson.KeyMap as KeyMap import qualified Data.Aeson.KeyMap as KeyMap
import GHC.Records (HasField(..)) import GHC.Records (HasField(..))
import Control.Monad.Trans.Reader (ReaderT(..), asks) import Control.Monad.Trans.Reader (asks)
import Control.Monad.IO.Class (MonadIO(..)) import Control.Monad.IO.Class (MonadIO(..))
newtype PackagistPackage = PackagistPackage newtype PackagistPackage = PackagistPackage
@ -77,7 +77,7 @@ instance Aeson.FromJSON GhData where
parseJSON (Aeson.Object keyMap) parseJSON (Aeson.Object keyMap)
| Just data' <- KeyMap.lookup "data" keyMap = | Just data' <- KeyMap.lookup "data" keyMap =
GhData <$> Aeson.withObject "GhData" (.: "repository") data' GhData <$> Aeson.withObject "GhData" (.: "repository") data'
parseJSON v = fail "data key not found in the response" parseJSON _ = fail "data key not found in the response"
data GhVariables = GhVariables data GhVariables = GhVariables
{ name :: Text { name :: Text

View File

@ -32,15 +32,7 @@ module SlackBuilder
end end
def self.download(uri, target) def self.download(uri, target)
print Term::ANSIColor.green "Downloading #{uri} " `./bin/slackbuilder download #{uri} #{target}`.strip
checksum = nil
Net::HTTP.start(uri.host, uri.port, use_ssl: uri.scheme == 'https') do |http|
checksum = start_download uri, target, http
end
puts
checksum
end end
def self.hosted_sources(absolute_url) def self.hosted_sources(absolute_url)

View File

@ -2,9 +2,6 @@ cabal-version: 2.4
name: slackbuilder name: slackbuilder
version: 0.1.0.0 version: 0.1.0.0
-- A longer description of the package.
-- description:
synopsis: Slackware build scripts and configuration files. synopsis: Slackware build scripts and configuration files.
bug-reports: https://git.caraus.tech/OSS/slackbuilder/issues bug-reports: https://git.caraus.tech/OSS/slackbuilder/issues
@ -40,7 +37,10 @@ executable slackbuilder
aeson ^>= 2.2.0, aeson ^>= 2.2.0,
base ^>= 4.16.4.0, base ^>= 4.16.4.0,
bytestring ^>= 0.11.0, bytestring ^>= 0.11.0,
conduit ^>= 1.3.5,
cryptonite >= 0.30,
filepath ^>= 1.4.2, filepath ^>= 1.4.2,
http-client ^>= 0.7,
modern-uri ^>= 0.3.6, modern-uri ^>= 0.3.6,
optparse-applicative ^>= 0.18.1, optparse-applicative ^>= 0.18.1,
process ^>= 1.6.17, process ^>= 1.6.17,
@ -52,3 +52,5 @@ executable slackbuilder
vector ^>= 0.13.0 vector ^>= 0.13.0
hs-source-dirs: app hs-source-dirs: app
default-language: Haskell2010 default-language: Haskell2010
ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall