Download and determine the digest
This commit is contained in:
parent
258604f22d
commit
6983304b9d
@ -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
|
||||||
|
@ -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")
|
||||||
|
@ -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)
|
||||||
|
@ -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
|
||||||
|
@ -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)
|
||||||
|
@ -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
|
||||||
|
Loading…
Reference in New Issue
Block a user