From 6983304b9d11e78ebf5fd21c835dd04c776102f5 Mon Sep 17 00:00:00 2001 From: Eugen Wissner Date: Mon, 21 Aug 2023 13:38:20 +0200 Subject: [PATCH] Download and determine the digest --- app/Main.hs | 4 ++- app/SlackBuilder/CommandLine.hs | 5 ++++ app/SlackBuilder/Download.hs | 51 +++++++++++++++++++++++++++++++-- app/SlackBuilder/Updater.hs | 4 +-- lib/download.rb | 10 +------ slackbuilder.cabal | 8 ++++-- 6 files changed, 64 insertions(+), 18 deletions(-) diff --git a/app/Main.hs b/app/Main.hs index 2e92865..eea4951 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -38,6 +38,8 @@ main = do <$> remoteFileExists urlPath ArchiveCommand repo nameVersion tarball tagPrefix -> cloneAndArchive repo nameVersion tarball tagPrefix >> pure Nothing + DownloadCommand url target -> fmap (Text.pack . show) + <$> download url target chooseTransformFunction (Just "php") = phpTransform chooseTransformFunction (Just "rdiff-backup") = Text.stripPrefix "v" chooseTransformFunction _ = stripPrefix "v" @@ -45,6 +47,6 @@ main = do $ fromMaybe string $ Text.stripPrefix prefix string phpTransform version - | (majorPrefix, patchVersion) <- Text.breakOnEnd "." version + | (majorPrefix, _patchVersion) <- Text.breakOnEnd "." version , majorPrefix == "php-8.2." = Just $ Text.drop (Text.length "php-") version | otherwise = Nothing diff --git a/app/SlackBuilder/CommandLine.hs b/app/SlackBuilder/CommandLine.hs index 8df1b97..f486b5a 100644 --- a/app/SlackBuilder/CommandLine.hs +++ b/app/SlackBuilder/CommandLine.hs @@ -27,6 +27,7 @@ data SlackBuilderCommand | CommitCommand Text Text | ExistsCommand Text | ArchiveCommand Text Text String Text + | DownloadCommand Text String deriving (Eq, Show) data PackagistArguments = PackagistArguments @@ -69,6 +70,7 @@ slackBuilderCommand = subparser <> command "commit" (info commitCommand mempty) <> command "exists" (info existsCommand mempty) <> command "archive" (info archiveCommand mempty) + <> command "download" (info downloadCommand mempty) where slackBuildCommand = SlackBuildCommand <$> argument str (metavar "PATH") @@ -82,3 +84,6 @@ slackBuilderCommand = subparser <*> argument str (metavar "NAME_VERSION") <*> argument str (metavar "TARBALL") <*> argument str (metavar "TAG_PREFIX") + downloadCommand = DownloadCommand + <$> argument str (metavar "URI") + <*> argument str (metavar "TARGET") diff --git a/app/SlackBuilder/Download.hs b/app/SlackBuilder/Download.hs index cbdcbb8..842f4ae 100644 --- a/app/SlackBuilder/Download.hs +++ b/app/SlackBuilder/Download.hs @@ -1,11 +1,14 @@ module SlackBuilder.Download ( cloneAndArchive , commit + , download , hostedSources , remoteFileExists , updateSlackBuildVersion ) where +import Data.ByteString (ByteString) +import qualified Data.ByteString as ByteString import Data.Text (Text) import qualified Data.Text as Text 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 System.IO (IOMode(..), withFile) import System.FilePath ((), (<.>)) -import System.Process (CreateProcess(..), StdStream(..), proc, readCreateProcessWithExitCode, callProcess) +import System.Process + ( CreateProcess(..) + , StdStream(..) + , proc + , readCreateProcessWithExitCode + , callProcess + ) import System.Exit (ExitCode(..)) import Control.Monad (unless) import Text.URI (URI(..), mkURI) @@ -27,10 +36,24 @@ import Network.HTTP.Req , runReq , defaultHttpConfig , ignoreResponse - , responseStatusCode, HttpConfig (..) + , responseStatusCode + , HttpConfig(..) + , GET(..) + , reqBr ) -import Data.Maybe (fromMaybe) 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 packagePath version = do @@ -123,3 +146,25 @@ cloneAndArchive repo nameVersion tarball tagPrefix = do , 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) diff --git a/app/SlackBuilder/Updater.hs b/app/SlackBuilder/Updater.hs index 7965a5c..6663bb7 100644 --- a/app/SlackBuilder/Updater.hs +++ b/app/SlackBuilder/Updater.hs @@ -36,7 +36,7 @@ import SlackBuilder.CommandLine import SlackBuilder.Trans import qualified Data.Aeson.KeyMap as KeyMap import GHC.Records (HasField(..)) -import Control.Monad.Trans.Reader (ReaderT(..), asks) +import Control.Monad.Trans.Reader (asks) import Control.Monad.IO.Class (MonadIO(..)) newtype PackagistPackage = PackagistPackage @@ -77,7 +77,7 @@ instance Aeson.FromJSON GhData where parseJSON (Aeson.Object keyMap) | Just data' <- KeyMap.lookup "data" keyMap = 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 { name :: Text diff --git a/lib/download.rb b/lib/download.rb index 9b962b0..f230837 100644 --- a/lib/download.rb +++ b/lib/download.rb @@ -32,15 +32,7 @@ module SlackBuilder end def self.download(uri, target) - print Term::ANSIColor.green "Downloading #{uri} " - 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 + `./bin/slackbuilder download #{uri} #{target}`.strip end def self.hosted_sources(absolute_url) diff --git a/slackbuilder.cabal b/slackbuilder.cabal index 0ac55d1..076707c 100644 --- a/slackbuilder.cabal +++ b/slackbuilder.cabal @@ -2,9 +2,6 @@ cabal-version: 2.4 name: slackbuilder version: 0.1.0.0 --- A longer description of the package. --- description: - synopsis: Slackware build scripts and configuration files. bug-reports: https://git.caraus.tech/OSS/slackbuilder/issues @@ -40,7 +37,10 @@ executable slackbuilder aeson ^>= 2.2.0, base ^>= 4.16.4.0, bytestring ^>= 0.11.0, + conduit ^>= 1.3.5, + cryptonite >= 0.30, filepath ^>= 1.4.2, + http-client ^>= 0.7, modern-uri ^>= 0.3.6, optparse-applicative ^>= 0.18.1, process ^>= 1.6.17, @@ -52,3 +52,5 @@ executable slackbuilder vector ^>= 0.13.0 hs-source-dirs: app default-language: Haskell2010 + + ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall