Fix filename of the reuploaded sources
This commit is contained in:
@ -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
|
||||
|
Reference in New Issue
Block a user