From 43ebbc5e6705d2cf86650f1918e28b9b7e94406d Mon Sep 17 00:00:00 2001 From: Eugen Wissner Date: Wed, 9 Aug 2023 20:59:42 +0200 Subject: [PATCH] Use TOML configuration --- .gitignore | 2 +- app/Main.hs | 9 ++++ app/SlackBuilder/CommandLine.hs | 15 +++++- app/SlackBuilder/Config.hs | 16 ++++++ app/SlackBuilder/Updater.hs | 91 +++++++++++++++++++++++++++++++-- config/config.toml.example | 1 + lib/up2date.rb | 14 +++-- slackbuilder.cabal | 19 ++++--- 8 files changed, 150 insertions(+), 17 deletions(-) create mode 100644 app/SlackBuilder/Config.hs create mode 100644 config/config.toml.example diff --git a/.gitignore b/.gitignore index 2ded37a..088600b 100644 --- a/.gitignore +++ b/.gitignore @@ -15,12 +15,12 @@ *.pk3 *.run *.deb -*.jar *~ .directory *.phar /slackbuilds/ +/config/config.toml /config/config.rb /vendor/ /.bundle/ diff --git a/app/Main.hs b/app/Main.hs index ac1aae2..7e821e5 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -6,14 +6,23 @@ import qualified Data.Text.IO as Text.IO import Data.Maybe (fromMaybe) import Options.Applicative (execParser) import SlackBuilder.CommandLine +import SlackBuilder.Config import SlackBuilder.Updater +import qualified Toml +import qualified Data.Text as Text main :: IO () main = do programCommand <- execParser slackBuilderParser + settings <- Toml.decodeFile settingsCodec "config/config.toml" latestVersion <- case programCommand of PackagistCommand packagistArguments -> latestPackagist packagistArguments TextCommand textArguments -> latestText textArguments + GhCommand ghArguments -> latestGitHub settings ghArguments (stripPrefix "v") Text.IO.putStrLn $ fromMaybe "" latestVersion + where + stripPrefix prefix string = Just + $ fromMaybe string + $ Text.stripPrefix prefix string diff --git a/app/SlackBuilder/CommandLine.hs b/app/SlackBuilder/CommandLine.hs index 2459bb5..5680c81 100644 --- a/app/SlackBuilder/CommandLine.hs +++ b/app/SlackBuilder/CommandLine.hs @@ -1,5 +1,6 @@ module SlackBuilder.CommandLine - ( SlackBuilderCommand(..) + ( GhArguments(..) + , SlackBuilderCommand(..) , PackagistArguments(..) , TextArguments(..) , slackBuilderParser @@ -21,12 +22,18 @@ import Options.Applicative data SlackBuilderCommand = PackagistCommand PackagistArguments | TextCommand TextArguments + | GhCommand GhArguments data PackagistArguments = PackagistArguments { vendor :: Text , name :: Text } deriving (Eq, Show) +data GhArguments = GhArguments + { owner :: Text + , name :: Text + } deriving (Eq, Show) + newtype TextArguments = TextArguments Text packagistArguments :: Parser PackagistArguments @@ -37,6 +44,11 @@ packagistArguments = PackagistArguments textArguments :: Parser TextArguments textArguments = TextArguments <$> argument str (metavar "URL") +ghArguments :: Parser GhArguments +ghArguments = GhArguments + <$> argument str (metavar "OWNER") + <*> argument str (metavar "NAME") + slackBuilderParser :: ParserInfo SlackBuilderCommand slackBuilderParser = info slackBuilderCommand fullDesc @@ -44,3 +56,4 @@ slackBuilderCommand :: Parser SlackBuilderCommand slackBuilderCommand = subparser $ command "packagist" (info (PackagistCommand <$> packagistArguments) mempty) <> command "text" (info (TextCommand <$> textArguments) mempty) + <> command "github" (info (GhCommand <$> ghArguments) mempty) diff --git a/app/SlackBuilder/Config.hs b/app/SlackBuilder/Config.hs new file mode 100644 index 0000000..be91ae0 --- /dev/null +++ b/app/SlackBuilder/Config.hs @@ -0,0 +1,16 @@ +module SlackBuilder.Config + ( Settings(..) + , settingsCodec + ) where + +import Data.Text (Text) +import Toml ((.=)) +import qualified Toml + +newtype Settings = Settings + { ghToken :: Text + } deriving (Eq, Show) + +settingsCodec :: Toml.TomlCodec Settings +settingsCodec = Settings + <$> Toml.text "gh_token" .= ghToken diff --git a/app/SlackBuilder/Updater.hs b/app/SlackBuilder/Updater.hs index 5373f7e..0e927e2 100644 --- a/app/SlackBuilder/Updater.hs +++ b/app/SlackBuilder/Updater.hs @@ -1,18 +1,23 @@ module SlackBuilder.Updater - ( latestPackagist + ( latestGitHub + , latestPackagist , latestText ) where +import SlackBuilder.Config +import qualified Data.Aeson as Aeson +import Data.Aeson ((.:)) import Data.Aeson.TH (defaultOptions, deriveJSON) import Data.HashMap.Strict (HashMap) import qualified Data.HashMap.Strict as HashMap import Data.Text (Text) import qualified Data.Text as Text import qualified Data.Text.Encoding as Text.Encoding -import Data.Vector (Vector) +import Data.Vector (Vector, (!?)) import qualified Data.Vector as Vector import Network.HTTP.Req - ( runReq + ( header + , runReq , defaultHttpConfig , req , GET(..) @@ -20,10 +25,12 @@ import Network.HTTP.Req , jsonResponse , NoReqBody(..) , (/:) - , responseBody, useHttpsURI, bsResponse + , responseBody, useHttpsURI, bsResponse, POST (POST), ReqBodyJson (ReqBodyJson) ) import Text.URI (mkURI) import SlackBuilder.CommandLine +import qualified Data.Aeson.KeyMap as KeyMap +import GHC.Records (HasField(..)) newtype PackagistPackage = PackagistPackage { version :: Text @@ -37,6 +44,48 @@ newtype PackagistResponse = PackagistResponse $(deriveJSON defaultOptions ''PackagistResponse) +newtype GhRefNode = GhRefNode + { name :: Text + } deriving (Eq, Show) + +$(deriveJSON defaultOptions ''GhRefNode) + +newtype GhRef = GhRef + { nodes :: Vector GhRefNode + } deriving (Eq, Show) + +$(deriveJSON defaultOptions ''GhRef) + +newtype GhRepository = GhRepository + { refs :: GhRef + } deriving (Eq, Show) + +$(deriveJSON defaultOptions ''GhRepository) + +newtype GhData = GhData + { repository :: GhRepository + } deriving (Eq, Show) + +instance Aeson.FromJSON GhData where + parseJSON (Aeson.Object keyMap) + | Just data' <- KeyMap.lookup "data" keyMap = + GhData <$> Aeson.withObject "GhData" (.: "repository") data' + parseJSON v = fail "data key not found in the response" + +data GhVariables = GhVariables + { name :: Text + , owner :: Text + } deriving (Eq, Show) + +$(deriveJSON defaultOptions ''GhVariables) + +data GhQuery = GhQuery + { query :: Text + , variables :: GhVariables + } deriving (Eq, Show) + +$(deriveJSON defaultOptions ''GhQuery) + latestPackagist :: PackagistArguments -> IO (Maybe Text) latestPackagist PackagistArguments{..} = do packagistResponse <- runReq defaultHttpConfig $ @@ -59,3 +108,37 @@ latestText (TextArguments textArguments) = do <$> packagistResponse where go uri = req GET uri NoReqBody bsResponse mempty + +latestGitHub :: Settings -> GhArguments -> (Text -> Maybe Text) -> IO (Maybe Text) +latestGitHub Settings{..} GhArguments{..} versionTransform = do + ghResponse <- runReq defaultHttpConfig $ + let uri = https "api.github.com" /: "graphql" + query = GhQuery + { query = githubQuery + , variables = GhVariables + { owner = owner + , name = name + } + } + authorizationHeader = header "authorization" + $ Text.Encoding.encodeUtf8 + $ "Bearer " <> ghToken + in req POST uri (ReqBodyJson query) jsonResponse + $ authorizationHeader <> header "User-Agent" "SlackBuilder" + let ghNodes = nodes $ refs $ repository $ responseBody ghResponse + refs' = Vector.reverse + $ Vector.catMaybes + $ versionTransform . getField @"name" <$> ghNodes + pure $ refs' !? 0 + where + githubQuery = + "query ($name: String!, $owner: String!) {\n\ + \ repository(name: $name, owner: $owner) {\n\ + \ refs(last: 10, refPrefix: \"refs/tags/\", orderBy: { field: TAG_COMMIT_DATE, direction: ASC }) {\n\ + \ nodes {\n\ + \ id,\n\ + \ name\n\ + \ }\n\ + \ }\n\ + \ }\n\ + \}" diff --git a/config/config.toml.example b/config/config.toml.example new file mode 100644 index 0000000..117472e --- /dev/null +++ b/config/config.toml.example @@ -0,0 +1 @@ +gh_token = "" diff --git a/lib/up2date.rb b/lib/up2date.rb index 06e46e3..3ccbbd3 100644 --- a/lib/up2date.rb +++ b/lib/up2date.rb @@ -36,7 +36,7 @@ module SlackBuilder GQL private_constant :GITHUB_QUERY - def initialize(owner, name, version_transform = ->(v) { v.delete_prefix 'v' }) + def initialize(owner, name, version_transform = nil) super() @owner = owner @@ -45,6 +45,16 @@ module SlackBuilder end def latest + if @version_transform.nil? + `./bin/slackbuilder github #{@owner} #{@name}`.strip + else + latest_with_transform + end + end + + private + + def latest_with_transform post_data = { 'query' => GITHUB_QUERY, 'variables' => { 'name' => @name, 'owner' => @owner } @@ -57,8 +67,6 @@ module SlackBuilder filter_versions_from_response JSON.parse(response.body) end - private - def filter_versions_from_response(response) response['data']['repository']['refs']['nodes'] .map { |node| @version_transform.call node['name'] } diff --git a/slackbuilder.cabal b/slackbuilder.cabal index 29c2a9d..58585e2 100644 --- a/slackbuilder.cabal +++ b/slackbuilder.cabal @@ -1,13 +1,11 @@ -cabal-version: 2.4 -name: slackbuilder -version: 0.1.0.0 - --- A short (one-line) description of the package. --- synopsis: +cabal-version: 2.4 +name: slackbuilder +version: 0.1.0.0 -- A longer description of the package. -- description: +synopsis: Slackware build scripts and configuration files. bug-reports: https://git.caraus.tech/OSS/slackbuilder/issues license: MPL-2.0 @@ -21,15 +19,19 @@ category: Build extra-source-files: CHANGELOG.md executable slackbuilder - main-is: Main.hs + main-is: Main.hs other-modules: SlackBuilder.CommandLine + SlackBuilder.Config SlackBuilder.Updater default-extensions: + DataKinds + DuplicateRecordFields OverloadedStrings RecordWildCards TemplateHaskell + TypeApplications build-depends: aeson ^>= 2.2.0, base ^>= 4.16.4.0, @@ -38,7 +40,8 @@ executable slackbuilder optparse-applicative ^>= 0.18.1, req ^>=3.13, text ^>= 2.0, + tomland ^>= 1.3.3, unordered-containers ^>= 0.2.19, vector ^>= 0.13.0 - hs-source-dirs: app + hs-source-dirs: app default-language: Haskell2010