Use TOML configuration

1 files changed, 87 insertions, 4 deletions

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