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 (ReaderT(..), 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 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 -> 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 textArguments) = do uri <- liftIO $ useHttpsURI <$> mkURI textArguments packagistResponse <- traverse (runReq defaultHttpConfig) $ go . fst <$> uri pure $ Text.strip . Text.Encoding.decodeASCII . 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\ \}"