Implement clone command in the binary

This commit is contained in:
2023-08-25 10:30:24 +02:00
parent 6983304b9d
commit 2126488066
4 changed files with 38 additions and 61 deletions

View File

@ -13,6 +13,7 @@ import qualified Toml
import qualified Data.Text as Text
import Control.Monad.Trans.Reader (ReaderT(..))
import SlackBuilder.Download
import Text.URI (mkURI)
main :: IO ()
main = do
@ -38,8 +39,12 @@ 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
DownloadCommand url target
| Just uri <- mkURI url -> fmap (Text.pack . show)
<$> download uri target
| otherwise -> pure Nothing
CloneCommand repo tarball tagPrefix -> fmap (Text.pack . show)
<$> clone repo tarball tagPrefix
chooseTransformFunction (Just "php") = phpTransform
chooseTransformFunction (Just "rdiff-backup") = Text.stripPrefix "v"
chooseTransformFunction _ = stripPrefix "v"

View File

@ -28,6 +28,7 @@ data SlackBuilderCommand
| ExistsCommand Text
| ArchiveCommand Text Text String Text
| DownloadCommand Text String
| CloneCommand Text Text Text
deriving (Eq, Show)
data PackagistArguments = PackagistArguments
@ -71,6 +72,7 @@ slackBuilderCommand = subparser
<> command "exists" (info existsCommand mempty)
<> command "archive" (info archiveCommand mempty)
<> command "download" (info downloadCommand mempty)
<> command "clone" (info cloneCommand mempty)
where
slackBuildCommand = SlackBuildCommand
<$> argument str (metavar "PATH")
@ -87,3 +89,7 @@ slackBuilderCommand = subparser
downloadCommand = DownloadCommand
<$> argument str (metavar "URI")
<*> argument str (metavar "TARGET")
cloneCommand = CloneCommand
<$> argument str (metavar "REPO")
<*> argument str (metavar "TARBALL")
<*> argument str (metavar "TAG_PREFIX")

View File

@ -1,5 +1,6 @@
module SlackBuilder.Download
( cloneAndArchive
( clone
, cloneAndArchive
, commit
, download
, hostedSources
@ -17,7 +18,7 @@ import SlackBuilder.Trans
import Control.Monad.Trans.Reader (asks)
import Control.Monad.IO.Class (MonadIO(liftIO))
import System.IO (IOMode(..), withFile)
import System.FilePath ((</>), (<.>))
import System.FilePath ((</>), (<.>), takeBaseName, splitPath, joinPath)
import System.Process
( CreateProcess(..)
, StdStream(..)
@ -51,6 +52,7 @@ import Conduit
, (.|)
, ZipSink(..)
, await
, sourceFile
)
import Crypto.Hash (Digest, MD5, hashInit, hashFinalize, hashUpdate)
import Data.Void (Void)
@ -159,12 +161,29 @@ sinkHash = sink hashInit
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
download :: URI -> FilePath -> SlackBuilderT (Maybe (Digest MD5))
download uri target = traverse (runReq defaultHttpConfig . go . fst)
$ useHttpsURI uri
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)
clone :: Text -> Text -> Text -> SlackBuilderT (Maybe (Digest MD5))
clone repo tarball tagPrefix = do
let tarballPath = Text.unpack tarball
nameVersion = Text.pack $ takeBaseName tarballPath
remotePath = Text.pack $ joinPath $ ("/" :) $ drop 1 $ splitPath tarballPath
localPath = "slackbuilds" </> tarballPath
remoteFileExists' <- remoteFileExists remotePath
if remoteFileExists'
then
hostedSources remotePath >>= flip download localPath
else
let go = sourceFile localPath .| sinkHash
in cloneAndArchive repo nameVersion tarballPath tagPrefix
>> uploadCommand tarball remotePath
>> liftIO (runConduitRes go) <&> Just