diff options
| author | Eugen Wissner <belka@caraus.de> | 2024-01-01 19:44:45 +0100 |
|---|---|---|
| committer | Eugen Wissner <belka@caraus.de> | 2024-01-01 19:44:45 +0100 |
| commit | a25655c2b24535eb1c8bfce61159d9b37200074f (patch) | |
| tree | e6ca4271cc76968e2af976d80e108fd32cd45e80 /src/SlackBuilder/Updater.hs | |
| parent | 34d7dbd68fc4c61d4dbbd9c4427e5170ea569637 (diff) | |
| download | slackbuilder-a25655c2b24535eb1c8bfce61159d9b37200074f.tar.gz | |
Move latest version checker to a separate module
Diffstat (limited to 'src/SlackBuilder/Updater.hs')
| -rw-r--r-- | src/SlackBuilder/Updater.hs | 162 |
1 files changed, 0 insertions, 162 deletions
diff --git a/src/SlackBuilder/Updater.hs b/src/SlackBuilder/Updater.hs deleted file mode 100644 index 0b87d90..0000000 --- a/src/SlackBuilder/Updater.hs +++ /dev/null @@ -1,162 +0,0 @@ -{- This Source Code Form is subject to the terms of the Mozilla Public License, - v. 2.0. If a copy of the MPL was not distributed with this file, You can - obtain one at https://mozilla.org/MPL/2.0/. -} - -module SlackBuilder.Updater - ( 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 qualified Data.Vector as Vector -import Network.HTTP.Req - ( header - , runReq - , defaultHttpConfig - , req - , GET(..) - , https - , jsonResponse - , NoReqBody(..) - , (/:) - , responseBody - , useHttpsURI - , bsResponse - , POST(..) - , ReqBodyJson(..) - ) -import Text.URI (mkURI) -import SlackBuilder.CommandLine -import SlackBuilder.Trans -import qualified Data.Aeson.KeyMap as KeyMap -import GHC.Records (HasField(..)) -import Control.Monad.Trans.Reader (asks) -import Control.Monad.IO.Class (MonadIO(..)) - -newtype PackagistPackage = PackagistPackage - { version :: Text - } deriving (Eq, Show) - -$(deriveJSON defaultOptions ''PackagistPackage) - -newtype PackagistResponse = PackagistResponse - { packages :: HashMap Text (Vector PackagistPackage) - } deriving (Eq, Show) - -$(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 _ = 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 -> SlackBuilderT (Maybe Text) -latestPackagist PackagistArguments{..} = do - packagistResponse <- runReq defaultHttpConfig $ - let uri = https "repo.packagist.org" /: "p2" - /: vendor - /: name <> ".json" - in req GET uri NoReqBody jsonResponse mempty - let packagistPackages = packages $ responseBody packagistResponse - fullName = Text.intercalate "/" [vendor, name] - - pure $ HashMap.lookup fullName packagistPackages - >>= fmap (version . fst) . Vector.uncons - -latestText :: TextArguments -> SlackBuilderT (Maybe Text) -latestText TextArguments{..} = do - uri <- liftIO $ useHttpsURI <$> mkURI textURL - packagistResponse <- traverse (runReq defaultHttpConfig . go . fst) uri - - pure $ versionPicker . Text.Encoding.decodeUtf8 . responseBody - <$> packagistResponse - where - go uri = req GET uri NoReqBody bsResponse mempty - -latestGitHub - :: GhArguments - -> (Text -> Maybe Text) - -> SlackBuilderT (Maybe Text) -latestGitHub GhArguments{..} versionTransform = do - ghToken' <- SlackBuilderT $ asks ghToken - 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 - $ (getField @"repository" :: GhData -> GhRepository) - $ 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\ - \}" |
