Fix filename of the reuploaded sources
All checks were successful
Build / audit (push) Successful in 13m13s
Build / test (push) Successful in 14m21s

This commit is contained in:
Eugen Wissner 2024-05-13 18:26:23 +02:00
parent f8ef93fde7
commit 3b7b15f381
Signed by: belka
GPG Key ID: A27FDC1E8EE902C0
3 changed files with 28 additions and 18 deletions

View File

@ -131,12 +131,19 @@ commit packagePath version = do
}
in readCreateProcessWithExitCode createCheckoutProcess ""
hostedSources :: Text -> SlackBuilderT URI
hostedSources absoluteURL = SlackBuilderT (asks downloadURL)
>>= liftIO . URI.mkURI . (<> absoluteURL)
hostedSources :: NonEmpty Text -> SlackBuilderT URI
hostedSources urlPathPieces = do
downloadURL' <- SlackBuilderT (asks downloadURL) >>= URI.mkURI
urlPathPieces' <- traverse URI.mkPathPiece urlPathPieces
remoteFileExists :: Text -> SlackBuilderT Bool
remoteFileExists url = hostedSources url
let updatedPath = case URI.uriPath downloadURL' of
Just (_, existingPath) ->
NonEmpty.append existingPath urlPathPieces'
Nothing -> urlPathPieces'
pure $ downloadURL'{ uriPath = Just (False, updatedPath) }
remoteFileExists :: NonEmpty Text -> SlackBuilderT Bool
remoteFileExists urlPathPieces = hostedSources urlPathPieces
>>= traverse (runReq httpConfig . go . fst) . useHttpsURI
<&> maybe False ((== 200) . responseStatusCode)
where
@ -194,12 +201,14 @@ sinkHash = sink hashInit
cloneAndUpload :: Text -> FilePath -> Text -> SlackBuilderT (URI, Digest MD5)
cloneAndUpload repo tarballPath tagPrefix = do
localPath <- relativeToRepository $ tarballPath <.> "tar.xz"
let packageName = takeFileName $ takeDirectory tarballPath
remoteArchivePath = Text.pack
$ packageName </> takeFileName tarballPath <.> "tar.xz"
remoteResultURI <- hostedSources $ Text.cons '/' remoteArchivePath
remoteFileExists' <- remoteFileExists $ Text.cons '/' remoteArchivePath
let tarballFileName = takeFileName tarballPath <.> "tar.xz"
packageName = takeFileName $ takeDirectory tarballPath
remoteArchivePath = Text.pack $ packageName </> tarballFileName
urlPathPieces = Text.pack <$> packageName :| [tarballFileName]
localPath <- relativeToRepository tarballFileName
remoteResultURI <- hostedSources urlPathPieces
remoteFileExists' <- remoteFileExists urlPathPieces
if remoteFileExists'
then (remoteResultURI,) . snd

View File

@ -227,7 +227,7 @@ autoUpdatable =
dcdArguments = PackageOwner{ owner = "dlang-community", name = "DCD" }
latestDub = Package.Updater
{ detectLatest = latestGitHub dubArguments "(v)\\."
, getVersion = downloadWithTemplate dubTemplate
, getVersion = reuploadWithTemplate dubTemplate []
, is64 = False
}
latestDscanner = Package.Updater

View File

@ -46,7 +46,7 @@ import SlackBuilder.Package (PackageDescription(..), PackageUpdateData(..))
import qualified SlackBuilder.Package as Package
import SlackBuilder.Trans
import Text.Megaparsec (parse, errorBundlePretty)
import Text.URI (URI(..), mkURI)
import Text.URI (URI(..))
import qualified Text.URI as URI
import System.Directory
( listDirectory
@ -169,7 +169,7 @@ reuploadWithTemplate downloadTemplate commands packagePath version = do
</> fromMaybe downloadFileName changedArchiveRootName
prepareSource relativeTarball
download' <- handleReupload relativeTarball' downloadFileName
download' <- handleReupload relativeTarball'
pure $ Package.Download download' checksum
where
category' = Text.pack $ takeBaseName $ Text.unpack packagePath
@ -186,12 +186,13 @@ reuploadWithTemplate downloadTemplate commands packagePath version = do
.| void tarFilePath
.| Lzma.compress Nothing
.| sinkFileAndHash (appendTarExtension archiveBaseFilename)
handleReupload relativeTarball downloadFileName = do
downloadURL' <- SlackBuilderT $ asks downloadURL
handleReupload relativeTarball = do
liftIO $ putStrLn $ "Upload the source tarball " <> relativeTarball
uploadSource relativeTarball category'
liftIO $ mkURI $ downloadURL' <> "/" <> category' <> "/" <> Text.pack downloadFileName
hostedSources $ NonEmpty.cons category'
$ pure $ Text.pack $ takeFileName relativeTarball
defaultCreateProcess cwd' cmdSpec
= flip withCreateProcess (const . const . const waitForProcess)
$ CreateProcess