mirror of
https://github.com/nix-community/nixpkgs-update.git
synced 2024-09-11 14:05:43 +03:00
Merge pull request #311 from rhendric/rhendric/update-prs
Reuse an existing auto-update PR
This commit is contained in:
commit
1039275a97
34
src/GH.hs
34
src/GH.hs
@ -2,6 +2,7 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE QuasiQuotes #-}
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
{-# LANGUAGE TupleSections #-}
|
||||
{-# OPTIONS_GHC -fno-warn-type-defaults #-}
|
||||
|
||||
module GH
|
||||
@ -15,10 +16,12 @@ module GH
|
||||
openAutoUpdatePR,
|
||||
openPullRequests,
|
||||
pr,
|
||||
prUpdate,
|
||||
)
|
||||
where
|
||||
|
||||
import Control.Applicative (some)
|
||||
import Data.Aeson (FromJSON)
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.Text.Encoding as T
|
||||
import qualified Data.Vector as V
|
||||
@ -43,10 +46,10 @@ releaseUrl env url = do
|
||||
urlParts <- parseURL url
|
||||
gReleaseUrl (authFrom env) urlParts
|
||||
|
||||
pr :: MonadIO m => UpdateEnv -> Text -> Text -> Text -> Text -> ExceptT Text m Text
|
||||
pr :: MonadIO m => UpdateEnv -> Text -> Text -> Text -> Text -> ExceptT Text m (Bool, Text)
|
||||
pr env title body prHead base = do
|
||||
ExceptT $
|
||||
bimap (T.pack . show) (GH.getUrl . GH.pullRequestUrl)
|
||||
bimap (T.pack . show) ((False, ) . GH.getUrl . GH.pullRequestUrl)
|
||||
<$> ( liftIO $
|
||||
( GH.github
|
||||
(authFrom env)
|
||||
@ -58,6 +61,33 @@ pr env title body prHead base = do
|
||||
)
|
||||
)
|
||||
|
||||
prUpdate :: forall m. MonadIO m => UpdateEnv -> Text -> Text -> Text -> Text -> ExceptT Text m (Bool, Text)
|
||||
prUpdate env title body prHead base = do
|
||||
let runRequest :: FromJSON a => GH.Request k a -> ExceptT Text m a
|
||||
runRequest = ExceptT . fmap (first (T.pack . show)) . liftIO . GH.github (authFrom env)
|
||||
let inNixpkgs f = f (N "nixos") (N "nixpkgs")
|
||||
|
||||
prs <- runRequest $
|
||||
inNixpkgs GH.pullRequestsForR (GH.optionsHead prHead) GH.FetchAll
|
||||
|
||||
case V.toList prs of
|
||||
[] -> pr env title body prHead base
|
||||
|
||||
(_:_:_) -> throwE $ "Too many open PRs from " <> prHead
|
||||
|
||||
[thePR] -> do
|
||||
let withExistingPR :: (GH.Name GH.Owner -> GH.Name GH.Repo -> GH.IssueNumber -> a) -> a
|
||||
withExistingPR f = inNixpkgs f (GH.simplePullRequestNumber thePR)
|
||||
|
||||
_ <- runRequest $
|
||||
withExistingPR GH.updatePullRequestR $
|
||||
GH.EditPullRequest (Just title) Nothing Nothing Nothing Nothing
|
||||
|
||||
_ <- runRequest $
|
||||
withExistingPR GH.createCommentR body
|
||||
|
||||
return (True, GH.getUrl $ GH.simplePullRequestUrl thePR)
|
||||
|
||||
data URLParts = URLParts
|
||||
{ owner :: GH.Name GH.Owner,
|
||||
repo :: GH.Name GH.Repo,
|
||||
|
18
src/Git.hs
18
src/Git.hs
@ -2,7 +2,7 @@
|
||||
{-# LANGUAGE TemplateHaskell #-}
|
||||
|
||||
module Git
|
||||
( checkAutoUpdateBranchDoesntExist,
|
||||
( findAutoUpdateBranchMessage,
|
||||
mergeBase,
|
||||
cleanAndResetTo,
|
||||
cleanup,
|
||||
@ -187,14 +187,16 @@ mergeBase = do
|
||||
(procGit ["merge-base", "upstream/master", "upstream/staging"])
|
||||
& fmap T.strip
|
||||
|
||||
checkAutoUpdateBranchDoesntExist :: MonadIO m => Text -> ExceptT Text m ()
|
||||
checkAutoUpdateBranchDoesntExist pName = do
|
||||
-- Return Nothing if a remote branch for this package doesn't exist. If a
|
||||
-- branch does exist, return a Just of its last commit message.
|
||||
findAutoUpdateBranchMessage :: MonadIO m => Text -> ExceptT Text m (Maybe Text)
|
||||
findAutoUpdateBranchMessage pName = do
|
||||
remoteBranches <-
|
||||
readProcessInterleavedNoIndexIssue_ (procGit ["branch", "--remote"])
|
||||
& fmapRT (T.lines >>> fmap T.strip)
|
||||
when
|
||||
(("origin/" <> branchPrefix <> pName) `elem` remoteBranches)
|
||||
(throwE "Update branch already on origin.")
|
||||
readProcessInterleavedNoIndexIssue_ (procGit ["branch", "--remote", "--format=%(refname:short) %(subject)"])
|
||||
& fmapRT (T.lines >>> fmap (T.strip >>> T.breakOn " "))
|
||||
return $
|
||||
lookup ("origin/" <> branchPrefix <> pName) remoteBranches
|
||||
& fmap (T.drop 1)
|
||||
|
||||
inNixpkgsRepo :: IO Bool
|
||||
inNixpkgsRepo = do
|
||||
|
@ -23,8 +23,10 @@ import CVE (CVE, cveID, cveLI)
|
||||
import qualified Check
|
||||
import Control.Concurrent
|
||||
import Control.Exception (IOException, catch, bracket)
|
||||
import Control.Monad.Writer (execWriterT, tell)
|
||||
import qualified Data.ByteString.Lazy.Char8 as BSL
|
||||
import Data.Maybe (fromJust)
|
||||
import Data.Monoid (Alt(..))
|
||||
import qualified Data.Set as S
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.Text.IO as T
|
||||
@ -252,13 +254,22 @@ updateAttrPath log mergeBase updateEnv@UpdateEnv {..} attrPath = do
|
||||
successOrFailure <- runExceptT $ do
|
||||
hasUpdateScript <- Nix.hasUpdateScript attrPath
|
||||
|
||||
whenBatch updateEnv do
|
||||
Skiplist.attrPath attrPath
|
||||
when pr do
|
||||
liftIO $ log "Checking auto update branch doesn't exist..."
|
||||
Git.checkAutoUpdateBranchDoesntExist packageName
|
||||
unless hasUpdateScript do
|
||||
GH.checkExistingUpdatePR updateEnv attrPath
|
||||
existingCommitMsg <- fmap getAlt . execWriterT $
|
||||
whenBatch updateEnv do
|
||||
Skiplist.attrPath attrPath
|
||||
when pr do
|
||||
liftIO $ log "Checking auto update branch..."
|
||||
mbLastCommitMsg <- lift $ Git.findAutoUpdateBranchMessage packageName
|
||||
tell $ Alt mbLastCommitMsg
|
||||
unless hasUpdateScript do
|
||||
case mbLastCommitMsg of
|
||||
Nothing -> liftIO $ log "No auto update branch exists"
|
||||
Just msg -> do
|
||||
lift $ tryAssert
|
||||
"An auto update branch exists targeting the same version"
|
||||
(not $ U.titleTargetsSameVersion updateEnv msg)
|
||||
liftIO $ log "An auto update branch exists but it is out of date"
|
||||
lift $ GH.checkExistingUpdatePR updateEnv attrPath
|
||||
|
||||
unless hasUpdateScript do
|
||||
Nix.assertNewerVersion updateEnv
|
||||
@ -354,6 +365,13 @@ updateAttrPath log mergeBase updateEnv@UpdateEnv {..} attrPath = do
|
||||
whenBatch updateEnv do
|
||||
when pr do
|
||||
when hasUpdateScript do
|
||||
tryAssert
|
||||
"An auto update branch exists targeting the same version"
|
||||
(not $ any (U.titleTargetsSameVersion updateEnv) existingCommitMsg)
|
||||
|
||||
-- Note that this check looks for PRs with the same old and new
|
||||
-- version numbers, so it won't stop us from updating an existing PR
|
||||
-- if this run updates the package to a newer version.
|
||||
GH.checkExistingUpdatePR updateEnv' attrPath
|
||||
|
||||
Nix.build attrPath
|
||||
@ -371,7 +389,7 @@ updateAttrPath log mergeBase updateEnv@UpdateEnv {..} attrPath = do
|
||||
if Outpaths.numPackageRebuilds opDiff <= 500
|
||||
then "master"
|
||||
else "staging"
|
||||
publishPackage log updateEnv' oldSrcUrl newSrcUrl attrPath result opReport prBase rewriteMsgs
|
||||
publishPackage log updateEnv' oldSrcUrl newSrcUrl attrPath result opReport prBase rewriteMsgs (isJust existingCommitMsg)
|
||||
|
||||
case successOrFailure of
|
||||
Left failure -> do
|
||||
@ -389,8 +407,9 @@ publishPackage ::
|
||||
Text ->
|
||||
Text ->
|
||||
[Text] ->
|
||||
Bool ->
|
||||
ExceptT Text IO ()
|
||||
publishPackage log updateEnv oldSrcUrl newSrcUrl attrPath result opReport prBase rewriteMsgs = do
|
||||
publishPackage log updateEnv oldSrcUrl newSrcUrl attrPath result opReport prBase rewriteMsgs branchExists = do
|
||||
cachixTestInstructions <- doCachix log updateEnv result
|
||||
resultCheckReport <-
|
||||
case Skiplist.checkResult (packageName updateEnv) of
|
||||
@ -411,6 +430,7 @@ publishPackage log updateEnv oldSrcUrl newSrcUrl attrPath result opReport prBase
|
||||
then liftIO $ NixpkgsReview.runReport log commitRev
|
||||
else return ""
|
||||
-- Try to push it three times
|
||||
-- (these pushes use --force, so it doesn't matter if branchExists is True)
|
||||
when
|
||||
(doPR . options $ updateEnv)
|
||||
(Git.push updateEnv <|> Git.push updateEnv <|> Git.push updateEnv)
|
||||
@ -441,7 +461,12 @@ publishPackage log updateEnv oldSrcUrl newSrcUrl attrPath result opReport prBase
|
||||
if (doPR . options $ updateEnv)
|
||||
then do
|
||||
let ghUser = GH.untagName . githubUser . options $ updateEnv
|
||||
pullRequestUrl <- GH.pr updateEnv (prTitle updateEnv attrPath) prMsg (ghUser <> ":" <> (branchName updateEnv)) prBase
|
||||
let mkPR = if branchExists then GH.prUpdate else GH.pr
|
||||
(reusedPR, pullRequestUrl) <- mkPR updateEnv (prTitle updateEnv attrPath) prMsg (ghUser <> ":" <> (branchName updateEnv)) prBase
|
||||
when branchExists $ liftIO $ log
|
||||
if reusedPR
|
||||
then "Updated existing PR"
|
||||
else "Reused existing auto update branch, but no corresponding open PR was found, so created a new PR"
|
||||
liftIO $ log pullRequestUrl
|
||||
else liftIO $ T.putStrLn prMsg
|
||||
|
||||
|
@ -24,6 +24,7 @@ module Utils
|
||||
runLog,
|
||||
srcOrMain,
|
||||
stripQuotes,
|
||||
titleTargetsSameVersion,
|
||||
tRead,
|
||||
whenBatch,
|
||||
regDirMode,
|
||||
@ -136,6 +137,11 @@ prTitle updateEnv attrPath =
|
||||
nV = newVersion updateEnv
|
||||
in T.strip [interpolate| $attrPath: $oV -> $nV |]
|
||||
|
||||
titleTargetsSameVersion :: UpdateEnv -> Text -> Bool
|
||||
titleTargetsSameVersion updateEnv = T.isSuffixOf [interpolate| -> $nV |]
|
||||
where
|
||||
nV = newVersion updateEnv
|
||||
|
||||
regDirMode :: FileMode
|
||||
regDirMode =
|
||||
directoryMode .|. ownerModes .|. groupModes .|. otherReadMode
|
||||
|
Loading…
Reference in New Issue
Block a user