Subject: [bug#76938] [PATCH Cuirass 09/13] forgejo: Add pull request update procedures.

From: Romain GARBAGE <[email-masked]>
Date: Tue, 11 Mar 2025 11:34:34 +0100

* src/cuirass/forges/forgejo.scm (update-forgejo-pull-request, update-forgejo-pull-request-from-spec): New variables.
* tests/forgejo.scm: Add tests for update-forgejo-pull-request.
---
 src/cuirass/forges/forgejo.scm | 56 ++++++++++++++++++++++
 tests/forgejo.scm              | 85 ++++++++++++++++++++++++++++++++++
 2 files changed, 141 insertions(+)

diff --git a/src/cuirass/forges/forgejo.scm b/src/cuirass/forges/forgejo.scm
index 3e7f375..f84685b 100644
--- a/src/cuirass/forges/forgejo.scm
+++ b/src/cuirass/forges/forgejo.scm
@@ -44,6 +44,9 @@
 
             forgejo-pull-request->specification
 
+            update-forgejo-pull-request
+            update-forgejo-pull-request-from-spec
+
             ;; Used in tests.
             forgejo-request
             %forgejo-port
@@ -278,3 +281,56 @@ JSON. Returns the content of the updated pull-request."
                      #:token token
                      #:method 'PATCH
                      #:body changes))))
+
+;;; Extra helper procedures using the API.
+(define* (update-forgejo-pull-request server token #:key owner
+                                      repository
+                                      pull-request-index
+                                      content)
+  "Update the content of the pull request PULL-REQUEST-INDEX with CONTENT, a
+string. Returns the content of the updated pull-request body."
+  (let* ((previous-body (forgejo-pull-request-body
+                         (forgejo-api-pull-request-get server token
+                                                       #:owner owner
+                                                       #:repository repository
+                                                       #:pull-request-index pull-request-index)))
+         (new-body (string-append previous-body "\n" content))
+         (updated-body (forgejo-pull-request-body
+                        (forgejo-api-pull-request-update server token
+                                                         #:owner owner
+                                                         #:repository repository
+                                                         #:pull-request-index pull-request-index
+                                                         #:changes `((body . ,new-body))))))
+    ;; Ensure new content is the same as expected content.
+    (unless (string=? updated-body new-body)
+      (raise
+       (condition
+        (&forgejo-api-error
+         (message (format #f
+                          "Content not modified as expected.~%Expected content:~%~a~%Actual content:~%~a~%"
+                          new-body
+                          updated-body))))))))
+
+(define (update-forgejo-pull-request-from-spec spec content)
+  "Given SPEC, a specification that was built using
+FORGEJO-PULL-REQUEST->SPECIFICATION, update the pull-request body with
+CONTENT, a string. Returns the content of the updated pull-request body."
+  (let* ((properties (specification-properties spec))
+         (url (string->uri
+               (assoc-ref properties
+                          'pull-request-url)))
+         (server (uri-host url))
+         (token (forge-get-token server
+                                 (assoc-ref properties
+                                            'pull-request-target-namespace)))
+         (owner (assoc-ref properties
+                           'pull-request-target-repository-owner))
+         (repository (assoc-ref properties
+                                'pull-request-target-repository-name))
+         (pull-request-index (assoc-ref properties
+                                        'pull-request-number)))
+    (update-forgejo-pull-request server token
+                                 #:owner owner
+                                 #:repository repository
+                                 #:pull-request-index pull-request-index
+                                 #:content content)))
diff --git a/tests/forgejo.scm b/tests/forgejo.scm
index 0a388ba..8003c7d 100644
--- a/tests/forgejo.scm
+++ b/tests/forgejo.scm
@@ -43,6 +43,7 @@
       \"number\": 1,
       \"state\": \"open\",
       \"url\": \"https://forgejo.instance.test/base-repo/pulls/1\",
+      \"body\": \"Some content.\",
       \"base\": {
         \"label\": \"base-label\",
         \"ref\": \"base-branch\",
@@ -126,3 +127,87 @@
     (api-build-endpoint "pulls/1")
     ;; Assert false since it should return an error.
     #f))
+
+(define updated-body-pull-request-json
+  "{
+    \"action\": \"opened\",
+    \"pull_request\": {
+      \"number\": 1,
+      \"state\": \"open\",
+      \"url\": \"https://forgejo.instance.test/base-repo/pulls/1\",
+      \"body\": \"Some content.\\nNew 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.instance.test/base-repo/project-name.git\",
+          \"html_url\": \"https://forgejo.instance.test/base-repo/project-name\"
+        }
+      },
+      \"head\": {
+        \"label\": \"test-label\",
+        \"ref\": \"test-branch\",
+        \"sha\": \"582af40e8a059fa05c7048a7ac4f2eccbbd0183b\",
+        \"repo\": {
+          \"owner\": {
+            \"login\": \"pr-owner\"
+          },
+          \"name\": \"fork-name\",
+          \"full_name\": \"source-repo/fork-name\",
+          \"clone_url\": \"https://forgejo.instance.test/source-repo/fork-name.git\",
+          \"html_url\": \"https://forgejo.instance.test/source-repo/fork-name\"
+        }
+      }
+    }
+  }")
+
+(test-assert "update-forgejo-pull-request: content not updated by server"
+  (let ((default-response
+          (build-response
+           #:code 200
+           #:reason-phrase "OK"
+           #:headers '((content-type . (application/json  (charset . "utf-8")))))))
+    (with-http-server `((,default-response ,default-pull-request-json)
+                        (,default-response ,default-pull-request-json))
+                      (let* ((url (string->uri (%local-url)))
+                             (hostname (uri-host url))
+                             (scheme (uri-scheme url))
+                             (port (uri-port url)))
+                        (parameterize ((%forge-token-directory "/tmp")
+                                       (%forgejo-port port)
+                                       (%forgejo-scheme scheme))
+                          (guard (c (#t
+                                     c))
+                            (update-forgejo-pull-request hostname "token"
+                                                         #:owner "owner"
+                                                         #:repository "repository"
+                                                         #:pull-request-index 1
+                                                         #:content "New content.")
+                            #f))))))
+
+(test-assert "update-forgejo-pull-request: content properly updated by server"
+  (let ((default-response
+          (build-response
+           #:code 200
+           #:reason-phrase "OK"
+           #:headers '((content-type . (application/json  (charset . "utf-8")))))))
+    (with-http-server `((,default-response ,default-pull-request-json)
+                        (,default-response ,updated-body-pull-request-json))
+                      (let* ((url (string->uri (%local-url)))
+                             (hostname (uri-host url))
+                             (scheme (uri-scheme url))
+                             (port (uri-port url)))
+                        (parameterize ((%forge-token-directory "/tmp")
+                                       (%forgejo-port port)
+                                       (%forgejo-scheme scheme))
+                          (update-forgejo-pull-request hostname "token"
+                                                       #:owner "owner"
+                                                       #:repository "repository"
+                                                       #:pull-request-index 1
+                                                       #:content "New content."))))))
-- 
2.48.1