maralorn/nixos-config
1
0
Fork 0
Code Wiki Activity

Drop announcement room and print ratelimit

Browse source
This commit is contained in:
Malte 2022-11-11 01:41:53 +01:00
parent cc2eb0a852
commit 3438a2c4e0
1 changed files with 34 additions and 41 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

75
exe/Main.hs
View file

@ -34,7 +34,6 @@ name = "nixpkgs"
data MatrixConfig = MatrixConfig data MatrixConfig = MatrixConfig
{ token :: Text { token :: Text
, server :: Text , server :: Text
, room :: Text
} }
deriving stock (Generic) deriving stock (Generic)
deriving anyclass (FromJSON) deriving anyclass (FromJSON)
@ -95,12 +94,6 @@ data Commit = Commit
} }
deriving stock (Show) deriving stock (Show)
ensureJoin :: Matrix.RoomID -> App ()
ensureJoin roomId = do
session <- getEnv matrixSession
rooms <- unwrapMatrixError $ Matrix.getJoinedRooms session
unless (roomId `elem` rooms) $ void . unwrapMatrixError $ Matrix.joinRoom session (coerce roomId)
getEnv :: (Environment -> a) -> App a getEnv :: (Environment -> a) -> App a
getEnv getter = lift $ lift $ lift $ asks getter getEnv getter = lift $ lift $ lift $ asks getter
@ -227,7 +220,8 @@ queryGraphQL query = do
} }
$ GraphQL.runQuery query $ GraphQL.runQuery query
type PRSchema = [GraphQL.unwrap| (GraphQL.API.PullRequestSchema).repository!.pullRequest!|] type PRSchema = [GraphQL.unwrap| (GraphQL.API.PullRequestSchema).repository!.pullRequest! |]
type RateLimitSchema = [GraphQL.unwrap| (GraphQL.API.PullRequestSchema).rateLimit! |]
extractPR :: PRSchema -> (PullRequest, Maybe Merge) extractPR :: PRSchema -> (PullRequest, Maybe Merge)
extractPR pr = extractPR pr =
@ -243,10 +237,17 @@ extractPR pr =
} }
) )
checkRateLimit :: RateLimitSchema -> App ()
checkRateLimit rateLimit = when ([get|rateLimit.remaining|] < warn_threshold) $ putTextLn $ show [get|rateLimit.remaining|]
where
-- Currently github grants 5000 queries per hour
-- The threshold should probably be lower, but for debugging purposes, I currently want to see everytime a graphql Query happens.
warn_threshold = 5000
queryPR :: Persist.Key PullRequest -> App (PullRequest, Maybe Merge) queryPR :: Persist.Key PullRequest -> App (PullRequest, Maybe Merge)
queryPR (PullRequestKey number) = do queryPR (PullRequestKey number) = do
result <- queryGraphQL GraphQL.API.PullRequestQuery{GraphQL.API._number = number, _owner = owner, _name = name} result <- queryGraphQL GraphQL.API.PullRequestQuery{GraphQL.API._number = number, _owner = owner, _name = name}
putTextLn $ show [get|result.rateLimit!|] checkRateLimit [get|result.rateLimit!|]
pure $ extractPR [get|result.repository!.pullRequest!|] pure $ extractPR [get|result.repository!.pullRequest!|]
getPRInfo :: Persist.Key PullRequest -> App PRInfo getPRInfo :: Persist.Key PullRequest -> App PRInfo
@ -307,21 +308,22 @@ findSubscribedPRsInCommitList branch =
SQL.where_ (pr `SQL.notIn` SQL.subList_select ((^. MergeNumber) <$> SQL.from (SQL.table @Merge))) SQL.where_ (pr `SQL.notIn` SQL.subList_select ((^. MergeNumber) <$> SQL.from (SQL.table @Merge)))
pure pr pure pr
when (null unmerged_watched_pull_requests) $ Except.throwError [] when (null unmerged_watched_pull_requests) $ Except.throwError []
result <- lift $ queryGraphQL GraphQL.API.MergingPullRequestQuery{GraphQL.API._commit = commitId change, _owner = owner, _name = name} lift do
putTextLn $ show [get|result.rateLimit!|] result <- queryGraphQL GraphQL.API.MergingPullRequestQuery{GraphQL.API._commit = commitId change, _owner = owner, _name = name}
let prs = extractPR <$> catMaybes [get|result.repository!.object!.__fragment!.associatedPullRequests!.nodes!|] checkRateLimit [get|result.rateLimit!|]
flip mapMaybeM prs \(pr, merge) -> let prs = extractPR <$> catMaybes [get|result.repository!.object!.__fragment!.associatedPullRequests!.nodes!|]
case merge of flip mapMaybeM prs \(pr, merge) ->
Just mergeProof | mergeCommit mergeProof == commitId change -> lift do case merge of
let pr_key = mergeNumber mergeProof Just mergeProof | mergeCommit mergeProof == commitId change -> do
pr_is_watched <- isJust <$> Persist.get (mergeNumber mergeProof) let pr_key = mergeNumber mergeProof
if pr_is_watched pr_is_watched <- isJust <$> Persist.get (mergeNumber mergeProof)
then do if pr_is_watched
Persist.repsert pr_key pr then do
Persist.repsert (MergeKey pr_key) mergeProof Persist.repsert pr_key pr
pure $ Just pr_key Persist.repsert (MergeKey pr_key) mergeProof
else pure Nothing pure $ Just pr_key
_ -> pure Nothing else pure Nothing
_ -> pure Nothing
notifySubscribers :: Text -> [Persist.Key PullRequest] -> App [Subscription] notifySubscribers :: Text -> [Persist.Key PullRequest] -> App [Subscription]
notifySubscribers branch = notifySubscribers branch =
@ -365,16 +367,11 @@ watchRepo = do
Nothing -> do Nothing -> do
putTextLn $ "Initiated database for branch " <> branch <> " at " <> fst (commitHTML new_commit) putTextLn $ "Initiated database for branch " <> branch <> " at " <> fst (commitHTML new_commit)
pure Nothing pure Nothing
if null messages forM_ messages $ \(msg, subscriptions) -> forM_ (NonEmpty.groupAllWith subscriptionUser subscriptions) \subscriptionsByUser -> do
then putTextLn "No advances!" let author = subscriptionUser $ head subscriptionsByUser
else do prs = toList $ subscriptionPullRequest <$> subscriptionsByUser
let message = unlinesMsg (fst <$> messages) prMsgs <- mapM (fmap prHTML . getPRInfo) prs
sendMessage (Matrix.RoomID . room $ matrix conf) message sendMessageToUser author $ unlinesMsg $ msg : m ("Including these " <> show (length prMsgs) <> " pull requests you subscribed to:") : prMsgs
forM_ messages $ \(msg, subscriptions) -> forM_ (NonEmpty.groupAllWith subscriptionUser subscriptions) \subscriptionsByUser -> do
let author = subscriptionUser $ head subscriptionsByUser
prs = toList $ subscriptionPullRequest <$> subscriptionsByUser
prMsgs <- mapM (fmap prHTML . getPRInfo) prs
sendMessageToUser author $ unlinesMsg $ msg : m ("Including these " <> show (length prMsgs) <> " pull requests you subscribed to:") : prMsgs
maintenance maintenance
maintenance :: App () maintenance :: App ()
@ -417,7 +414,7 @@ unsubscribeFromFinishedPRs = do
sendMessage :: Matrix.RoomID -> MessageText -> App () sendMessage :: Matrix.RoomID -> MessageText -> App ()
sendMessage roomId@(Matrix.RoomID roomIdText) message = do sendMessage roomId@(Matrix.RoomID roomIdText) message = do
putTextLn $ "Sending to Room" <> roomIdText <> ":\n" <> fst message putTextLn $ "in room" <> roomIdText <> ":\n" <> fst message
txnId <- Matrix.TxnID . show <$> Random.randomRIO (1000000 :: Int, 9999999) txnId <- Matrix.TxnID . show <$> Random.randomRIO (1000000 :: Int, 9999999)
session <- getEnv matrixSession session <- getEnv matrixSession
void $ void $
@ -433,7 +430,7 @@ sendMessageToUser user message = do
userQuery <- Persist.get (QueryKey user) userQuery <- Persist.get (QueryKey user)
case userQuery of case userQuery of
Just queryPair -> do Just queryPair -> do
putTextLn $ "Sending to user " <> user <> ":" putText $ "To user " <> user <> " "
sendMessage (Matrix.RoomID $ queryRoom queryPair) message sendMessage (Matrix.RoomID $ queryRoom queryPair) message
Nothing -> putTextLn $ "Not finding a query for " <> user <> " can‘t send message: " <> fst message Nothing -> putTextLn $ "Not finding a query for " <> user <> " can‘t send message: " <> fst message
@ -527,10 +524,8 @@ resultHandler syncResult@Matrix.SyncResult{Matrix.srNextBatch, Matrix.srRooms} =
sendMessageToUser author $ sendMessageToUser author $
unlinesMsg unlinesMsg
[ m "Hey! I am the friendly nixpkgs-bot and I am here to help you notice when pull requests are being merged, so you don‘t need to hammer refresh on github." [ m "Hey! I am the friendly nixpkgs-bot and I am here to help you notice when pull requests are being merged, so you don‘t need to hammer refresh on github."
, m "I am continously watching the " <> repoLink "" "nixpkgs git repository on github."
, m "You can see a feed with all merges in the matrix room " <> mention "#nixpkgs-updates:maralorn.de" <> m "."
, mempty , mempty
, m "If you want to be notified whenever a PR reaches one of the relevant branches in the nixpkgs release cycle, you can tell me via the following commands:" , m "I am continously watching the " <> repoLink "" "nixpkgs git repository on github." <> m "If you want to be notified whenever a PR reaches one of the relevant branches in the nixpkgs release cycle, you can tell me via the following commands:"
, mempty , mempty
, codeHTML "subscribe [pr-number]" <> m ": I will subscribe you to the given pull request." , codeHTML "subscribe [pr-number]" <> m ": I will subscribe you to the given pull request."
, codeHTML "unsubscribe [pr-number]" <> m ": I will unsubscribe you from the given pull request." , codeHTML "unsubscribe [pr-number]" <> m ": I will unsubscribe you from the given pull request."
@ -567,8 +562,6 @@ main = do
let runApp :: App a -> IO a let runApp :: App a -> IO a
runApp = flip runReaderT (MkEnvironment config matrix_session last_watch) . Persist.Sqlite.runSqlite (database config) . Persist.Sqlite.retryOnBusy runApp = flip runReaderT (MkEnvironment config matrix_session last_watch) . Persist.Sqlite.runSqlite (database config) . Persist.Sqlite.retryOnBusy
first_next_batch <- runApp do first_next_batch <- runApp do
let roomId = Matrix.RoomID . room $ matrix config
ensureJoin roomId
Persist.Sqlite.runMigration migrateAll Persist.Sqlite.runMigration migrateAll
watchRepo watchRepo
fmap sessionStateValue <$> Persist.get (SessionStateKey' "next_batch") fmap sessionStateValue <$> Persist.get (SessionStateKey' "next_batch")