diff options
Diffstat (limited to 'lib/SlackBuilder')
| -rw-r--r-- | lib/SlackBuilder/Download.hs | 31 |
1 files changed, 20 insertions, 11 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 |
