Support downloading of attachments.
[software/mumi.git] / mumi / web / controller.scm
index efc63586a229f22ecdc1378d9f449907b1901fb6..ad6c63af6dfb787f7c8c10d4e2ee3e0333765723 100644 (file)
@@ -1,5 +1,5 @@
 ;;; mumi -- Mediocre, uh, mail interface
-;;; Copyright © 2016, 2017 Ricardo Wurmus <rekado@elephly.net>
+;;; Copyright © 2016, 2017, 2018 Ricardo Wurmus <rekado@elephly.net>
 ;;;
 ;;; This program is free software: you can redistribute it and/or
 ;;; modify it under the terms of the GNU Affero General Public License
 
 (define-module (mumi web controller)
   #:use-module (ice-9 match)
+  #:use-module (ice-9 pretty-print)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-26)
   #:use-module (web request)
   #:use-module (web uri)
-  #:use-module (mu)
   #:use-module (mumi messages)
   #:use-module (mumi web render)
+  #:use-module (mumi web download)
   #:use-module (mumi web util)
   #:use-module (mumi web view html)
   #:export (controller))
         target
         (list functions ...)))
 
+(define (render-with-error-handling page message)
+  (apply render-html (page))
+  ;; (catch #t
+  ;;   (lambda ()
+  ;;     (receive (sxml headers)
+  ;;         (pretty-print (page))
+  ;;       (render-html sxml headers)))
+  ;;   (lambda (key . args)
+  ;;     (format #t "ERROR: ~a ~a\n"
+  ;;             key args)
+  ;;     (render-html (error-page message))))
+  )
+
 (define (controller request body)
   (match-lambda
     ((GET)
-     (render-html (index)))
+     (apply render-html (index)))
     ((GET "search")
      (let ((query (-> request
                       request-uri
              (string-null? (string-trim query)))
          (redirect '()))
 
-        ((string-prefix? "patch:" query) =>
-         (lambda _ (redirect (list "patch" (string-drop query 6)))))
-        
-        ;; Search for matching messages and return list of patch
-        ;; reports that belong to them.
+        ;; For convenience
+        ((string-prefix? "id:" query) =>
+         (lambda _ (redirect (list "issue" (string-drop query (string-length "id:"))))))
+        ((string-prefix? "#" query) =>
+         (lambda _ (redirect (list "issue" (string-drop query (string-length "#"))))))
+        ((string->number query) =>
+         (lambda _ (redirect (list "issue" query))))
+
+        ;; Search for matching messages and return list of bug reports
+        ;; that belong to them.
         (else
-         (let ((messages (unique-reports (mu:message-list query 100))))
-           (render-html (patch-list query messages)))))))
-    ((GET "patch" (? string->number id))
-     (let ((messages (patch-messages id)))
-       (if (null? messages)
-           (render-html (unknown id))
-           (render-html (patch-page id messages)))))
-    ((GET "patch" not-an-id)
-     (render-html (unknown not-an-id)))
+         (render-with-error-handling
+          (lambda ()
+            (list-of-matching-bugs query
+                                   (match (process-query query)
+                                     ((#:terms terms
+                                       #:attributes attrs
+                                       #:filters '())
+                                      (search-bugs (string-join terms)
+                                                   #:attributes attrs))
+                                     ;; Fetch more messages if there
+                                     ;; are local filters to increase
+                                     ;; the chance of finding some
+                                     ;; that pass the filter.
+                                     ((#:terms terms
+                                       #:attributes attrs
+                                       #:filters fs)
+                                      (let ((str (string-join terms)))
+                                        (filter (lambda (bug)
+                                                  (every (lambda (f) (f bug)) fs))
+                                                (search-bugs (string-join terms)
+                                                             #:attributes attrs
+                                                             #:max 800)))))))
+          `(p "Could not search for " (strong ,query) "."))))))
+    ((GET "issue" (? string->number id))
+     (render-with-error-handling
+      (lambda () (or (and=> (fetch-bug id) issue-page)
+                (unknown id)))
+      `(p "Could not access issue #" (strong ,id) ".")))
+    ((GET "issue" (? string->number id)
+          "attachment" (? string->number msg-num)
+          (? string->number path) ...)
+     (handle-download (string->number id)
+                      (string->number msg-num)
+                      (map string->number path)))
+    ((GET "issue" not-an-id)
+     (apply render-html (unknown not-an-id)))
+    ((GET "help")
+     (apply render-html (help)))
     ((GET path ...)
-     (render-static-asset path))))
+     (render-static-asset request))))