Find Restyled PRs by head only

Given a PR with head pb/fix, we'd locate a Restyled PR by looking for
one where:

    base == pb/fix &&
      head == restyled/pb/fix

This is a very precise search but fails if GitHub has automatically
switches the base after pb/fix was merged, as it so helpfully does.

We could update this to,

    (base == pb/fix || base == {default branch}) &&
      head == restyled/pb/fix

But that seems complicated, and would miss a case of a Restyling on a
branch-from-branch situation.

We could simplify to,

    head == restyled/pb/fix

But false-positives are scary, considering they could result in a
force-push over a user's unrelated Pull Request.

Therefore, we'll do

    head == restyled/pb/fix &&
      user =~ ^restyled-io

Having the check on user will prevent force-pushes onto users no matter
how well this works (or not).

Fixes #150.

src/Restyler/RestyledPullRequest.hs

@@ -13,6 +13,7 @@ import Restyler.Prelude
 
 import Control.Monad.Trans.Maybe (MaybeT(..), runMaybeT)
 import qualified Data.Set as Set
+import qualified Data.Text as T
 import GitHub.Endpoints.GitData.References (deleteReferenceR)
 import GitHub.Endpoints.Issues.Labels (addLabelsToIssueR)
 import GitHub.Endpoints.PullRequests
@@ -24,8 +25,8 @@ import GitHub.Endpoints.PullRequests
     , Owner
     , Repo
     , SimplePullRequest(..)
+    , SimpleUser(..)
     , createPullRequestR
-    , optionsBase
     , optionsHead
     , pullRequestsForR
     , toPathPart
@@ -103,8 +104,16 @@ findRestyledPullRequest pullRequest =
     ref = pullRequestRestyledHeadRef pullRequest
     legacyRef = pullRequestLocalHeadRef pullRequest <> "-restyled"
 
-    findExisting r = existingRestyledPullRequest pullRequest r
-        <$> MaybeT (findSiblingPullRequest pullRequest r)
+    findExisting r = do
+        pr <- MaybeT $ findSiblingPullRequest pullRequest r
+        guard $ openedByUs pr
+        pure $ existingRestyledPullRequest pullRequest r pr
+
+    openedByUs =
+        ("restyled-io" `T.isPrefixOf`)
+            . untagName
+            . simpleUserLogin
+            . simplePullRequestUser
 
 createRestyledPullRequest
     :: ( HasLogFunc env
@@ -214,10 +223,7 @@ editRestyledPullRequestState state pr
 findSiblingPullRequest
     :: HasGitHub env => PullRequest -> Text -> RIO env (Maybe SimplePullRequest)
 findSiblingPullRequest pr ref =
-    runGitHubFirst
-        $ pullRequestsForR owner repo
-        $ optionsBase (pullRequestRestyledBaseRef pr)
-        <> optionsHead qualifiedRef
+    runGitHubFirst $ pullRequestsForR owner repo $ optionsHead qualifiedRef
   where
     owner = pullRequestOwnerName pr
     repo = pullRequestRepoName pr