Implement remote file check as Haskell command

This commit is contained in:
Eugen Wissner 2023-08-17 22:07:09 +02:00
parent 6b15ccd0f5
commit fd649b66f5
Signed by: belka
GPG Key ID: A27FDC1E8EE902C0
7 changed files with 43 additions and 8 deletions

View File

@ -34,6 +34,8 @@ main = do
updateSlackBuildVersion packagePath version >> pure Nothing updateSlackBuildVersion packagePath version >> pure Nothing
CommitCommand packagePath version -> CommitCommand packagePath version ->
commit packagePath version >> pure Nothing commit packagePath version >> pure Nothing
ExistsCommand urlPath -> pure . Text.pack . show
<$> remoteFileExists urlPath
chooseTransformFunction (Just "php") = phpTransform chooseTransformFunction (Just "php") = phpTransform
chooseTransformFunction (Just "rdiff-backup") = Text.stripPrefix "v" chooseTransformFunction (Just "rdiff-backup") = Text.stripPrefix "v"
chooseTransformFunction _ = stripPrefix "v" chooseTransformFunction _ = stripPrefix "v"

View File

@ -25,6 +25,7 @@ data SlackBuilderCommand
| GhCommand GhArguments | GhCommand GhArguments
| SlackBuildCommand Text Text | SlackBuildCommand Text Text
| CommitCommand Text Text | CommitCommand Text Text
| ExistsCommand Text
deriving (Eq, Show) deriving (Eq, Show)
data PackagistArguments = PackagistArguments data PackagistArguments = PackagistArguments
@ -65,6 +66,7 @@ slackBuilderCommand = subparser
<> command "github" (info (GhCommand <$> ghArguments) mempty) <> command "github" (info (GhCommand <$> ghArguments) mempty)
<> command "slackbuild" (info slackBuildCommand mempty) <> command "slackbuild" (info slackBuildCommand mempty)
<> command "commit" (info commitCommand mempty) <> command "commit" (info commitCommand mempty)
<> command "exists" (info existsCommand mempty)
where where
slackBuildCommand = SlackBuildCommand slackBuildCommand = SlackBuildCommand
<$> argument str (metavar "PATH") <$> argument str (metavar "PATH")
@ -72,3 +74,4 @@ slackBuilderCommand = subparser
commitCommand = CommitCommand commitCommand = CommitCommand
<$> argument str (metavar "PATH") <$> argument str (metavar "PATH")
<*> argument str (metavar "VERSION") <*> argument str (metavar "VERSION")
existsCommand = ExistsCommand <$> argument str (metavar "PATH")

View File

@ -11,6 +11,7 @@ data Settings = Settings
{ ghToken :: !Text { ghToken :: !Text
, repository :: !FilePath , repository :: !FilePath
, branch :: Text , branch :: Text
, downloadURL :: Text
} deriving (Eq, Show) } deriving (Eq, Show)
settingsCodec :: Toml.TomlCodec Settings settingsCodec :: Toml.TomlCodec Settings
@ -18,3 +19,4 @@ settingsCodec = Settings
<$> Toml.text "gh_token" .= ghToken <$> Toml.text "gh_token" .= ghToken
<*> Toml.string "repository" .= repository <*> Toml.string "repository" .= repository
<*> Toml.text "branch" .= branch <*> Toml.text "branch" .= branch
<*> Toml.text "download_url" .= downloadURL

View File

@ -1,5 +1,7 @@
module SlackBuilder.Download module SlackBuilder.Download
( commit ( commit
, hostedSources
, remoteFileExists
, updateSlackBuildVersion , updateSlackBuildVersion
) where ) where
@ -15,6 +17,19 @@ import System.FilePath ((</>), (<.>))
import System.Process (CreateProcess(..), StdStream(..), proc, readCreateProcessWithExitCode, callProcess) import System.Process (CreateProcess(..), StdStream(..), proc, readCreateProcessWithExitCode, callProcess)
import System.Exit (ExitCode(..)) import System.Exit (ExitCode(..))
import Control.Monad (unless) import Control.Monad (unless)
import Text.URI (URI(..), mkURI)
import Network.HTTP.Req
( useHttpsURI
, HEAD(..)
, NoReqBody(..)
, req
, runReq
, defaultHttpConfig
, ignoreResponse
, responseStatusCode, HttpConfig (..)
)
import Data.Maybe (fromMaybe)
import Data.Functor ((<&>))
updateSlackBuildVersion :: Text -> Text -> SlackBuilderT () updateSlackBuildVersion :: Text -> Text -> SlackBuilderT ()
updateSlackBuildVersion packagePath version = do updateSlackBuildVersion packagePath version = do
@ -54,3 +69,17 @@ commit packagePath version = do
, std_err = UseHandle nullHandle , std_err = UseHandle nullHandle
} }
in readCreateProcessWithExitCode createCheckoutProcess "" in readCreateProcessWithExitCode createCheckoutProcess ""
hostedSources :: Text -> SlackBuilderT URI
hostedSources absoluteURL = SlackBuilderT (asks downloadURL)
>>= liftIO . mkURI . (<> absoluteURL)
remoteFileExists :: Text -> SlackBuilderT Bool
remoteFileExists url = hostedSources url
>>= traverse (runReq httpConfig . go . fst) . useHttpsURI
<&> maybe False ((== 200) . responseStatusCode)
where
httpConfig = defaultHttpConfig
{ httpConfigCheckResponse = const $ const $ const Nothing
}
go uri = req HEAD uri NoReqBody ignoreResponse mempty

View File

@ -25,7 +25,11 @@ import Network.HTTP.Req
, jsonResponse , jsonResponse
, NoReqBody(..) , NoReqBody(..)
, (/:) , (/:)
, responseBody, useHttpsURI, bsResponse, POST (POST), ReqBodyJson (ReqBodyJson) , responseBody
, useHttpsURI
, bsResponse
, POST(..)
, ReqBodyJson(..)
) )
import Text.URI (mkURI) import Text.URI (mkURI)
import SlackBuilder.CommandLine import SlackBuilder.CommandLine

View File

@ -1,3 +1,4 @@
gh_token = "" gh_token = ""
repository = "./slackbuilds" repository = "./slackbuilds"
branch = "user/nick/updates" branch = "user/nick/updates"
download_url = "https://example.com/some/path"

View File

@ -48,13 +48,7 @@ module SlackBuilder
end end
def self.remote_file_exists?(url) def self.remote_file_exists?(url)
uri = URI hosted_sources(url) `./bin/slackbuilder exists #{url}`.strip == 'True'
request = Net::HTTP.new uri.host, uri.port
request.use_ssl = true
response = request.request_head uri.path
response.code.to_i == 200
end end
def self.download_and_deploy(uri, tarball) def self.download_and_deploy(uri, tarball)