diff options
Diffstat (limited to 'app/SlackBuilder')
| -rw-r--r-- | app/SlackBuilder/CommandLine.hs | 15 | ||||
| -rw-r--r-- | app/SlackBuilder/Config.hs | 16 | ||||
| -rw-r--r-- | app/SlackBuilder/Updater.hs | 91 |
3 files changed, 117 insertions, 5 deletions
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\ + \}" |