fix: Don't check author in the check_suite message.

src/GitHub/Tools/AutoMerge.hs

@@ -71,21 +71,15 @@ mergeable PullRequestInfo{prState, prTrustworthy, prUser} =
     prState == "clean" && (prTrustworthy || prUser `elem` trustedAuthors)
 
 
-hasAuthor :: Text -> GitHub.SimplePullRequest -> Bool
-hasAuthor author pr =
-    (GitHub.untagName . GitHub.simpleUserLogin . GitHub.simplePullRequestUser $ pr) == author
-
-
 autoMergePullRequest
   :: String
   -> GitHub.Name GitHub.Owner
   -> GitHub.Name GitHub.Repo
-  -> Text
   -> IO ()
-autoMergePullRequest token ownerName repoName author = do
+autoMergePullRequest token ownerName repoName = do
     let auth = Just . GitHub.OAuth . BS8.pack $ token
     mgr <- newManager tlsManagerSettings
-    pulls <- (filter (hasAuthor author) . V.toList <$>
+    pulls <- (V.toList <$>
         request auth mgr (GitHub.pullRequestsForR ownerName repoName GitHub.stateOpen GitHub.FetchAll))
         >>= getPrInfos auth mgr ownerName repoName
 

tools/hub-automerge.hs

@@ -14,6 +14,6 @@ main = do
     args <- getArgs
     token <- getEnv "GITHUB_TOKEN"
     case args of
-      []             -> autoMergeAll "TokTok" "TokTok" token
-      [repo, author] -> autoMergePullRequest token "TokTok" (fromString repo) (fromString author)
-      _              -> error "Usage: hub-automerge [repo] [author]"
+      []     -> autoMergeAll "TokTok" "TokTok" token
+      [repo] -> autoMergePullRequest token "TokTok" (fromString repo)
+      _      -> error "Usage: hub-automerge [repo] [author]"

web/TokTok/Handlers.hs

@@ -6,9 +6,8 @@ module TokTok.Handlers
 
 import           Data.Text              (Text)
 import           GitHub.Data.Name       (Name (..))
-import           GitHub.Tools.AutoMerge (autoMergePullRequest, trustedAuthors)
-import           GitHub.Types           (Author (..), CheckCommit (..),
-                                         CheckSuite (..), CheckSuiteEvent (..),
+import           GitHub.Tools.AutoMerge (autoMergePullRequest)
+import           GitHub.Types           (CheckSuite (..), CheckSuiteEvent (..),
                                          Payload (..), Repository (..))
 import           System.Environment     (getEnv)
 
@@ -18,15 +17,12 @@ handleEvent (CheckSuiteEventPayload (CheckSuiteEvent
     { checkSuiteEventCheckSuite = CheckSuite
         { checkSuiteConclusion = Just "success"
         , checkSuiteHeadBranch = branch
-        , checkSuiteHeadCommit = Just (CheckCommit
-            { checkCommitCommitter = Author{ authorName = author }
-            })
         }
     , checkSuiteEventRepository = Repository{ repositoryName = repo }
-    })) | branch /= Just "master" && author `elem` trustedAuthors =
-        Just (repo <> "/" <> author, do
+    })) | branch /= Just "master" =
+        Just (repo, do
             -- Get auth token from the $GITHUB_TOKEN environment variable.
             token <- getEnv "GITHUB_TOKEN"
-            autoMergePullRequest token "TokTok" (N repo) author)
+            autoMergePullRequest token "TokTok" (N repo))
 
 handleEvent _ = Nothing

web/TokTok/Webhooks.hs

@@ -131,7 +131,7 @@ newApp = do
     -- Initialise task queue
     tasks <- newMVar Map.empty
     -- Start the task queue processing timer.
-    timer <- oneShotTimer (processTasks tasks) (sDelay 10)  -- after 10 seconds
+    timer <- oneShotTimer (processTasks tasks) (sDelay 30)  -- after 30 seconds
     return $ app (addTasks timer tasks)
   where
     processTasks :: MVar (Map Text (IO ())) -> IO ()