Use TOML configuration

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)

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

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\
+        \}"