Make local paths relative to cwd
Some checks failed
Build / test (push) Failing after 5m55s
Build / audit (push) Successful in 13m8s

This commit is contained in:
2024-03-05 23:06:32 +01:00
parent cd15b25db1
commit 16c7063224
3 changed files with 22 additions and 32 deletions

View File

@ -142,16 +142,6 @@ remoteFileExists url = hostedSources url
}
go uri = req HEAD uri NoReqBody ignoreResponse mempty
uploadCommand :: FilePath -> Text -> SlackBuilderT ()
uploadCommand localPath remotePath' = do
remoteRoot <- SlackBuilderT $ asks remotePath
localPathFromRepository <- relativeToRepository localPath
liftIO $ callProcess "scp"
[ localPathFromRepository
, Text.unpack $ remoteRoot <> remotePath'
]
cloneAndArchive :: Text -> FilePath -> Text -> SlackBuilderT ()
cloneAndArchive repo tarballPath tagPrefix = do
let version = snd $ Text.breakOnEnd "-"
@ -217,6 +207,19 @@ cloneAndUpload repo tarballPath tagPrefix = do
>> uploadCommand localPath remoteArchivePath
>> liftIO (runConduitRes go) <&> (remoteResultURI,)
-- | Given a path to a local file and a remote path uploads the file using
-- the settings given in the configuration file.
--
-- The remote path is given relative to the path in the configuration.
uploadCommand :: FilePath -> Text -> SlackBuilderT ()
uploadCommand localPath remotePath' = do
remoteRoot <- SlackBuilderT $ asks remotePath
liftIO $ callProcess "scp"
[ localPath
, Text.unpack $ remoteRoot <> remotePath'
]
-- | Downlaods a file into the directory. Returns name of the downloaded file
-- and checksum.
--