1 files changed, 30 insertions, 17 deletions

diff --git a/src/scm/webid-oidc/client-manifest.scm b/src/scm/webid-oidc/client-manifest.scm
index 1d855c1..2d1f428 100644
--- a/src/scm/webid-oidc/client-manifest.scm
+++ b/src/scm/webid-oidc/client-manifest.scm
@@ -16,6 +16,7 @@
 
 (define-module (webid-oidc client-manifest)
   #:use-module (webid-oidc errors)
+  #:use-module (webid-oidc server endpoint)
   #:use-module (webid-oidc fetch)
   #:use-module (webid-oidc web-i18n)
   #:use-module (webid-oidc serializable)
@@ -153,9 +154,11 @@
                  (make-exception-with-message
                   (format #f (G_ "the server responded with code ~a")
                           (response-code response)))
-                 (make-message-for-the-user
-                  `(p ,(format #f (W_ "The server hosting your application responded with code ~a.")
-                               (response-code response)))))))
+                 (make-user-message
+                  (call-with-input-string
+                      (format #f (W_ "<p>The server hosting your application responded with code ~a.<p>")
+                              (response-code response))
+                    xml->sxml)))))
              (let ((json-data (stubs:json-string->scm response-body)))
                (let ((new-client-id (assq-ref json-data 'client_id))
                      (redirect-uris (assq-ref json-data 'redirect_uris)))
@@ -164,8 +167,10 @@
                     (make-exception
                      (make-exception-with-message
                       (G_ "the client manifest does not have a client_id field"))
-                     (make-message-for-the-user
-                      `(p ,(W_ "The server hosting your application does not behave correctly, because it lacks the client_id field."))))))
+                     (make-user-message
+                      (call-with-input-string
+                          (format #f (W_ "<p>The server hosting your application does not behave correctly, because it lacks the client_id field.<p>"))
+                        xml->sxml)))))
                  (set! redirect-uris
                        (let fix-redirect-uris ((redirect-uris redirect-uris))
                          (match redirect-uris
@@ -186,15 +191,19 @@
                     (make-exception
                      (make-exception-with-message
                       (G_ "the client manifest does not have a redirect_uris field"))
-                     (make-message-for-the-user
-                      `(p ,(W_ "The server hosting your application does not behave correctly, because it lacks the redirect_uris field."))))))
+                     (make-user-message
+                      (call-with-input-string
+                          (format #f (W_ "<p>The server hosting your application does not behave correctly, because it lacks the redirect_uris field.<p>"))
+                        xml->sxml)))))
                  (unless new-client-id
                    (raise-exception
                     (make-exception
                      (make-exception-with-message
                       (G_ "the client manifest does not have a client_id field"))
-                     (make-message-for-the-user
-                      `(p ,(W_ "The server hosting your application does not behave correctly, because it lacks the client_id field."))))))
+                     (make-user-message
+                      (call-with-input-string
+                          (format #f (W_ "<p>The server hosting your application does not behave correctly, because it lacks the client_id field.<p>"))
+                        xml->sxml)))))
                  (unless (equal? client-id new-client-id)
                    (raise-exception
                     (make-exception
@@ -203,8 +212,10 @@
                       (format #f (G_ "the client manifest under ~s has a client_id of ~s")
                               (uri->string client-id)
                               (uri->string new-client-id)))
-                     (make-message-for-the-user
-                      `(p ,(W_ "The application you want to use does not control the domain name it appears to represent."))))))
+                     (make-user-message
+                      (call-with-input-string
+                          (format #f (W_ "<p>The application you want to use does not control the domain name it appears to represent.</p>"))
+                        xml->sxml)))))
                  (do-initialize new-client-id redirect-uris)))))))
       (else
        (unless (uri? client-id)
@@ -231,16 +242,18 @@
             (format #f (G_ "the client manifest does not allow ~s as a redirection uri")
                     (uri->string redir)))
            (final-user-message
-            (sxml-match
-             (xml->sxml (W_ "<p>The application wants to get your
-authorization through <strong>~s</strong>, which is not
-approved.</p>"))
-             ((*TOP* ,element) element))))
+            (call-with-input-string
+                (format #f (W_ "<p>The application wants to get your
+authorization through <strong>~a</strong>, which is not
+approved.</p>")
+                        (call-with-output-string
+                          (cute sxml->xml `(*TOP* ,(uri->string redir)) <>)))
+              xml->sxml)))
        (raise-exception
         (make-exception
          (make-unauthorized-redirect-uri)
          (make-exception-with-message final-message)
-         (make-message-for-the-user final-user-message)))))
+         (make-user-message final-user-message)))))
     (((? (cute equal? <> redir) redir) _ ...)
      #t)
     ((_ uris ...)