diff --git a/src/GitHub/Tools/AutoMerge.hs b/src/GitHub/Tools/AutoMerge.hs index 2301bc3..f823d05 100644 --- a/src/GitHub/Tools/AutoMerge.hs +++ b/src/GitHub/Tools/AutoMerge.hs @@ -1,6 +1,6 @@ {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} -module GitHub.Tools.AutoMerge (autoMergeAll) where +module GitHub.Tools.AutoMerge (autoMergeRepo, autoMergeAll) where import Data.Text (Text) import qualified Data.Text as Text @@ -9,7 +9,7 @@ import System.Posix.Directory (changeWorkingDirectory) import System.Process (callProcess) import GitHub.Tools.PullRequestInfo (PullRequestInfo (..)) -import GitHub.Tools.PullStatus (getPullInfos) +import GitHub.Tools.PullStatus (getPullInfos, getPullInfosFor) trustedAuthors :: [Text] @@ -23,6 +23,10 @@ trustedAuthors = ] +workDir :: FilePath +workDir = "/tmp/automerge" + + autoMerge :: String -> GitHub.Name GitHub.Organization @@ -30,7 +34,7 @@ autoMerge -> IO () autoMerge _ _ PullRequestInfo{prOrigin = Nothing} = return () autoMerge token orgName PullRequestInfo{prRepoName, prUser, prBranch, prOrigin = Just prOrigin} = do - let clonePath = "/tmp/automerge/" <> Text.unpack prRepoName + let clonePath = workDir <> "/" <> Text.unpack prRepoName callProcess "rm" ["-rf", clonePath] callProcess "git" [ "clone", "--depth=2" -- 2 so we have a base commit (hopefully the master HEAD commit) @@ -47,12 +51,28 @@ autoMerge token orgName PullRequestInfo{prRepoName, prUser, prBranch, prOrigin = callProcess "git" [ "push", "upstream", Text.unpack prBranch <> ":master" ] + -- Go back to a directory that will definitely exist even when next time + -- we "rm -rf" the git repo cloned above. + changeWorkingDirectory workDir + mergeable :: PullRequestInfo -> Bool mergeable PullRequestInfo{prState, prTrustworthy, prUser} = prState == "clean" && (prTrustworthy || prUser `elem` trustedAuthors) +autoMergeRepo + :: GitHub.Name GitHub.Owner + -> GitHub.Name GitHub.Organization + -> GitHub.Name GitHub.Repo + -> String + -> GitHub.Auth + -> IO () +autoMergeRepo ownerName orgName repoName token auth = do + pulls <- filter mergeable <$> getPullInfosFor ownerName repoName (Just auth) + mapM_ (autoMerge token orgName) pulls + + autoMergeAll :: GitHub.Name GitHub.Organization -> GitHub.Name GitHub.Owner diff --git a/src/GitHub/Tools/PullStatus.hs b/src/GitHub/Tools/PullStatus.hs index 3fc99db..1ce108e 100644 --- a/src/GitHub/Tools/PullStatus.hs +++ b/src/GitHub/Tools/PullStatus.hs @@ -1,6 +1,7 @@ {-# LANGUAGE OverloadedStrings #-} module GitHub.Tools.PullStatus ( getPullStatus + , getPullInfosFor , getPullInfos , showPullInfos ) where @@ -91,6 +92,15 @@ getPrsForRepo auth mgr ownerName repoName = -- Get more details about each PR. >>= Parallel.mapM (getPrInfo auth mgr ownerName repoName)) +getPullInfosFor + :: GitHub.Name GitHub.Owner + -> GitHub.Name GitHub.Repo + -> Maybe GitHub.Auth + -> IO [PullRequestInfo] +getPullInfosFor ownerName repoName auth = do + mgr <- newManager tlsManagerSettings + getPrsForRepo auth mgr ownerName repoName + getPullInfos :: GitHub.Name GitHub.Organization diff --git a/tools/hub-automerge.hs b/tools/hub-automerge.hs index dc7aa0b..dfa6f97 100644 --- a/tools/hub-automerge.hs +++ b/tools/hub-automerge.hs @@ -3,15 +3,19 @@ module Main (main) where import qualified Data.ByteString.Char8 as BS8 +import Data.String (fromString) import qualified GitHub -import System.Environment (getEnv) +import System.Environment (getArgs, getEnv) -import GitHub.Tools.AutoMerge (autoMergeAll) +import GitHub.Tools.AutoMerge (autoMergeAll, autoMergeRepo) main :: IO () main = do -- Get auth token from the $GITHUB_TOKEN environment variable. + args <- getArgs token <- getEnv "GITHUB_TOKEN" let auth = GitHub.OAuth . BS8.pack $ token - autoMergeAll "TokTok" "TokTok" token auth + case args of + [] -> autoMergeAll "TokTok" "TokTok" token auth + repos -> mapM_ (\repo -> autoMergeRepo "TokTok" "TokTok" (fromString repo) token auth) repos diff --git a/web/TokTok/Handlers.hs b/web/TokTok/Handlers.hs index 6779cc4..10340fc 100644 --- a/web/TokTok/Handlers.hs +++ b/web/TokTok/Handlers.hs @@ -7,9 +7,10 @@ module TokTok.Handlers import qualified Data.ByteString.Char8 as BS8 import Data.Maybe (fromMaybe) import qualified GitHub -import GitHub.Tools.AutoMerge (autoMergeAll) +import GitHub.Data.Name (Name (..)) +import GitHub.Tools.AutoMerge (autoMergeRepo) import GitHub.Types (CheckSuite (..), CheckSuiteEvent (..), - Payload (..)) + Payload (..), Repository (..)) import System.Environment (getEnv) @@ -19,6 +20,7 @@ handleEvent (CheckSuiteEventPayload event) -- Get auth token from the $GITHUB_TOKEN environment variable. token <- getEnv "GITHUB_TOKEN" let auth = GitHub.OAuth . BS8.pack $ token - autoMergeAll "TokTok" "TokTok" token auth + let repo = repositoryName . checkSuiteEventRepository $ event + autoMergeRepo "TokTok" "TokTok" (N repo) token auth handleEvent _ = return ()