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
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

View File

@ -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")

View File

@ -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)

View File

@ -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

View File

@ -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)

View File

@ -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