1 files changed, 31 insertions, 29 deletions
diff --git a/src/scm/webid-oidc/client/gui/authorization-prompt.scm b/src/scm/webid-oidc/client/gui/authorization-prompt.scm
index 8e9ab81..cd32489 100644
--- a/src/scm/webid-oidc/client/gui/authorization-prompt.scm
+++ b/src/scm/webid-oidc/client/gui/authorization-prompt.scm
@@ -33,6 +33,8 @@
   #:use-module ((webid-oidc config) #:prefix config:)
   #:use-module (webid-oidc client client)
   #:use-module (webid-oidc client accounts)
+  #:use-module (webid-oidc client application)
+  #:use-module ((webid-oidc client gui settings) #:prefix settings:)
   #:use-module (webid-oidc jwk)
   #:use-module (webid-oidc oidc-id-token)
   #:use-module (web uri)
@@ -43,7 +45,7 @@
   #:duplicates (merge-generics)
   #:export
   (
-   make-authorization-prompt
+   ->widget
    ))
 
 (push-duplicate-handler! 'merge-generics)
@@ -52,11 +54,10 @@
 (use-typelibs ("GdkPixbuf" "2.0")
               ("Gtk" "3.0"))
 
-(define (make-authorization-prompt uri)
-  ;; Return 3 values:
-  ;; - the builder
-  ;; - the whole widget
-  ;; - a 2-value function (reason, continuation) to add a handler
+(define format:format
+  (@ (ice-9 format) format))
+
+(define-method (->widget (prompt <authorization-prompt>))
   (let ((builder
          (builder:new-from-file
           (string-append config:uidir "/authorization-prompt.glade"))))
@@ -69,26 +70,27 @@
           (entry
            (builder:get-object builder "authorization_code_entry"))
           (ok
-           (builder:get-object builder "ok_button"))
-          (reasons '())
-          (handlers '()))
-      (let ((handle (lambda (reason continuation)
-                      (label:set-text reason-label
-                                      ((@ (ice-9 format) format) #f
-                                       (G_ "Your authorization is required: ~a")
-                                       (if (null? reasons)
-                                           reason
-                                           (format #f (G_ "~a, and ~a")
-                                                   (string-join (reverse reasons) ", ")
-                                                   reason))))
-                      (set! reasons `(,reason ,@reasons))
-                      (set! handlers `(,continuation ,@handlers)))))
-        (link-button:set-uri link-button (uri->string uri))
-        ((@ (gi) connect) entry activate
-         (lambda _
-           (button:clicked ok)))
-        ((@ (gi) connect) ok clicked
-         (lambda _
-           (let ((code (entry:get-text entry)))
-             ((@ (srfi srfi-1) for-each) (cute <> code) (reverse handlers)))))
-        (values builder whole-widget handle)))))
+           (builder:get-object builder "ok_button")))
+      (label:set-text reason-label
+                      (format:format #f (G_ "Your authorization is required: ~a")
+                                     (reason prompt)))
+      (link-button:set-uri link-button (uri->string (authorization-uri prompt)))
+      ((@ (gi) connect) entry activate
+       (lambda _
+         (button:clicked ok)))
+      ((@ (gi) connect) ok clicked
+       (lambda _
+         (let ((code (entry:get-text entry)))
+           (widget:set-sensitive entry #f)
+           (widget:set-sensitive ok #f)
+           (receive (_ new-state)
+               (fold-authorization-prompts
+                (settings:application-state)
+                (match-lambda*
+                  ((_ p)
+                   (values #t
+                           (and (equal? p (authorization-uri prompt))
+                                code))))
+                #t)
+             (settings:application-state new-state)))))
+      (values builder whole-widget))))