From 3b7b15f381fbee648784895067cff165f975c360 Mon Sep 17 00:00:00 2001
From: Eugen Wissner <belka@caraus.de>
Date: Mon, 13 May 2024 18:26:23 +0200
Subject: [PATCH] Fix filename of the reuploaded sources

---
 lib/SlackBuilder/Download.hs | 31 ++++++++++++++++++++-----------
 src/Main.hs                  |  2 +-
 src/SlackBuilder/Update.hs   | 13 +++++++------
 3 files changed, 28 insertions(+), 18 deletions(-)

diff --git a/lib/SlackBuilder/Download.hs b/lib/SlackBuilder/Download.hs
index 096ede8..285e389 100644
--- a/lib/SlackBuilder/Download.hs
+++ b/lib/SlackBuilder/Download.hs
@@ -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
diff --git a/src/Main.hs b/src/Main.hs
index a40bd2d..1ea73da 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -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
diff --git a/src/SlackBuilder/Update.hs b/src/SlackBuilder/Update.hs
index a23ee48..918db66 100644
--- a/src/SlackBuilder/Update.hs
+++ b/src/SlackBuilder/Update.hs
@@ -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