guix-data-service/tests/forgejo.scm

;;; forgejo.scm -- Test support for Forgejo pull requests
;;; Copyright © 2024, 2025 Romain Garbage <romain.garbage@inria.fr>
;;; Copyright © 2025 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of Cuirass.
;;;
;;; Cuirass is free software: you can redistribute it and/or modify
;;; it under the terms of the GNU General Public License as published by
;;; the Free Software Foundation, either version 3 of the License, or
;;; (at your option) any later version.
;;;
;;; Cuirass is distributed in the hope that it will be useful,
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with Cuirass.  If not, see <http://www.gnu.org/licenses/>.

(define-module (test-forgejo)
  #:use-module (srfi srfi-1)
  #:use-module (srfi srfi-64)
  #:use-module (ice-9 match)
  #:use-module ((ice-9 string-fun) #:select (string-replace-substring))
  #:use-module (guix-data-service database)
  #:use-module (guix-data-service model git-repository)
  #:use-module (guix-data-service model git-commit)
  #:use-module (guix-data-service forgejo))

(define pull-request-url
  "https://forgejo.example.org/base-repo/pulls/1")

(define pull-request-clone-url
  "https://forgejo.example.org/source-repo/fork-name.git")

(define pull-request-commit
  "582af40e8a059fa05c7048a7ac4f2eccbbd0183b")

(define pull-request-new-commit
  (string-reverse pull-request-commit))

(define pull-request-event-json
  (string-append "{
    \"action\": \"opened\",
    \"pull_request\": {
      \"number\": 1,
      \"state\": \"open\",
      \"draft\": false,
      \"url\": \"" pull-request-url "\",
      \"body\": \"Some content.\",
      \"base\": {
        \"label\": \"base-label\",
        \"ref\": \"base-branch\",
        \"sha\": \"666af40e8a059fa05c7048a7ac4f2eccbbd0183b\",
        \"repo\": {
          \"owner\": {
            \"login\": \"project-owner\"
          },
          \"name\": \"project-name\",
          \"full_name\": \"base-repo/project-name\",
          \"clone_url\": \"https://forgejo.example.org/base-repo/project-name.git\",
          \"html_url\": \"https://forgejo.example.org/base-repo/project-name\"
        }
      },
      \"head\": {
        \"label\": \"test-label\",
        \"ref\": \"test-branch\",
        \"sha\": \"" pull-request-commit "\",
        \"repo\": {
          \"owner\": {
            \"login\": \"fork-owner\"
          },
          \"name\": \"fork-name\",
          \"full_name\": \"fork-owner/fork-name\",
          \"clone_url\": \"" pull-request-clone-url "\",
          \"html_url\": \"https://forgejo.example.org/source-repo/fork-name\"
        }
      }
    }
  }"))

(test-begin "forgejo")

(with-postgresql-connection
 "test-forgejo"
 (lambda (conn)
   (check-test-database! conn)

   (with-postgresql-transaction
    conn
    (lambda (conn)
      (test-assert "enqueue-job-for-pull-request, initial commit"
        (let* ((event (json->forgejo-pull-request-event
                       pull-request-event-json))
               (pull (forgejo-pull-request-event-pull-request event)))
          (enqueue-job-for-pull-request conn pull)))

      (test-equal "all-git-repositories"
        `((label . #f)
          (url . ,pull-request-clone-url)
          (link-url . #f)
          (x-git-repo-header . #f)
          (included-branches . #f)
          (excluded-branches . #f)
          (fetch-with-authentication? . #f)   ;authentication disabled for PRs
          (query-substitutes? . #t)
          (poll-interval . #f)
          (job-priority . 0)
          (commit-link-url-template . #f)
          (commit-range-link-url-template . #f)
          (file-link-url-template . #f))
        (match (find (lambda (alist)
                       (equal? (assoc-ref alist 'url) pull-request-clone-url))
                     (all-git-repositories conn))
          ((('id . id) rest ...)
           ;; Since the ID might vary depending on other tests run on this
           ;; database, strip it.
           rest)))

      (test-assert "git-commit-exists?, initial commit"
        (and (git-commit-exists? conn pull-request-commit)
             (not (git-commit-exists? conn pull-request-new-commit))))

      (test-assert "enqueue-job-for-pull-request, updating pull request"
        (let* ((event (json->forgejo-pull-request-event
                       (string-replace-substring pull-request-event-json
                                                 pull-request-commit
                                                 pull-request-new-commit)))
               (pull (forgejo-pull-request-event-pull-request event)))
          (enqueue-job-for-pull-request conn pull)))

      (test-assert "git-commit-exists?, new commit"
        (git-commit-exists? conn pull-request-new-commit))

      (test-assert "mark-pull-request-branch-for-deletion"
        (let* ((event (json->forgejo-pull-request-event
                       pull-request-event-json))
               (pull (forgejo-pull-request-event-pull-request event)))
          (mark-pull-request-branch-for-deletion conn pull))))

    #:always-rollback? #t)))

(test-end)