diff options
| author | Eugen Wissner <belka@caraus.de> | 2023-11-07 19:36:40 +0100 |
|---|---|---|
| committer | Eugen Wissner <belka@caraus.de> | 2023-11-07 19:36:40 +0100 |
| commit | 3414a69bc8e589a0fbfc52f932f6b7df8d05f365 (patch) | |
| tree | 5e90a37a332e955501a4d88120fc080c3ace4bb1 /app/SlackBuilder/Updater.hs | |
| parent | 9770cc8829d6fdacd1ae02e1f78fcf270e5a5503 (diff) | |
| download | slackbuilder-3414a69bc8e589a0fbfc52f932f6b7df8d05f365.tar.gz | |
Support GHC 9.4
Diffstat (limited to 'app/SlackBuilder/Updater.hs')
| -rw-r--r-- | app/SlackBuilder/Updater.hs | 158 |
1 files changed, 0 insertions, 158 deletions
diff --git a/app/SlackBuilder/Updater.hs b/app/SlackBuilder/Updater.hs deleted file mode 100644 index 1ebf7fe..0000000 --- a/app/SlackBuilder/Updater.hs +++ /dev/null @@ -1,158 +0,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\ - \}" |
