1 files changed, 45 insertions, 10 deletions

diff --git a/guix-qa-frontpage/issue.scm b/guix-qa-frontpage/issue.scm
index 1f20e22..345aafe 100644
--- a/guix-qa-frontpage/issue.scm
+++ b/guix-qa-frontpage/issue.scm
@@ -45,12 +45,16 @@
 (define bad-status 'important-checks-failing)
 (define needs-looking-at-status 'needs-looking-at)
 (define unknown-status 'unknown)
+(define failed-to-apply-patches-status 'failed-to-apply-patches)
+(define guix-data-service-failed-status 'guix-data-service-failed)
 
 (define %overall-statuses
   (list reviewed-looks-good-status
         good-status
         unknown-status
         needs-looking-at-status
+        failed-to-apply-patches-status
+        guix-data-service-failed-status
         bad-status))
 
 (define (status-index status)
@@ -62,8 +66,10 @@
   (list-ref %overall-statuses
             (apply max (map status-index statuses))))
 
-(define (issue-patches-overall-status derivation-changes-counts
+(define (issue-patches-overall-status patches-failed-to-apply?
                                       builds-missing?
+                                      derivation-changes
+                                      comparison-details
                                       mumi-tags
                                       debbugs-usertags)
   (define %systems-to-consider
@@ -72,7 +78,23 @@
       "aarch64-linux"
       "armhf-linux"))
 
-  (define builds-status
+  (define (guix-data-service-failed?)
+    (and=>
+     (assq-ref comparison-details 'exception)
+     (lambda (exception)
+       (and=>
+        (assq-ref comparison-details 'invalid_query_parameters)
+        (lambda (invalid-params)
+          (and=>
+           (assoc-ref invalid-params "target_commit")
+           (lambda (target-commit)
+             (eq? (assq-ref target-commit 'error)
+                  'failed-to-process-revision))))))))
+
+  (define (builds-status)
+    (define derivation-changes-counts
+      (assq-ref derivation-changes 'counts))
+
     (if builds-missing?
         unknown-status
         (if (null? derivation-changes-counts)
@@ -121,8 +143,12 @@
   ;; information
   (if (eq? tags-status reviewed-looks-good-status)
       reviewed-looks-good-status
-      (worst-status (list builds-status
-                          tags-status))))
+      (cond
+       (patches-failed-to-apply? failed-to-apply-patches-status)
+       ((guix-data-service-failed?) guix-data-service-failed-status)
+       (else
+        (worst-status (list (builds-status)
+                            tags-status))))))
 
 (define (issue-data number)
   (let* ((base-and-target-refs
@@ -290,12 +316,21 @@
                  database
                  'issue-patches-overall-status
                  (lambda _
-                   (issue-patches-overall-status
-                    (assq-ref derivation-changes 'counts)
-                    builds-missing?
-                    (assq-ref (assq-ref series-data 'mumi)
-                              'tags)
-                    (assq-ref series-data 'usertags)))
+                   (let ((patches-failed-to-apply?
+                          (and
+                           (not base-and-target-refs)
+                           (not (eq? (select-create-branch-for-issue-log
+                                      database
+                                      issue-number)
+                                     #f)))))
+                     (issue-patches-overall-status
+                      patches-failed-to-apply?
+                      builds-missing?
+                      derivation-changes
+                      comparison-details
+                      (assq-ref (assq-ref series-data 'mumi)
+                                'tags)
+                      (assq-ref series-data 'usertags))))
                  #:args (list issue-number)
                  #:ttl 0)))
             #:unwind? #t)))