JWK: the default signature algorithm "alg" is now a key parameter

1 files changed, 61 insertions, 65 deletions

diff --git a/src/scm/webid-oidc/identity-provider.scm b/src/scm/webid-oidc/identity-provider.scm
index cf06b62..7973917 100644
--- a/src/scm/webid-oidc/identity-provider.scm
+++ b/src/scm/webid-oidc/identity-provider.scm
@@ -80,73 +80,69 @@
                 (lambda (port)
                   (stubs:scm->json (key->jwk k) port #:pretty #t)))
                k)))))
-    (let ((alg
-           (if (eq? (kty key) 'RSA)
-               'RS256
-               'ES256)))
-      (let ((authorization-endpoint
-             (make-authorization-endpoint subject encrypted-password alg key 120
-                                          #:http-get http-get))
-            (token-endpoint
-             (make-token-endpoint token-endpoint-uri issuer alg key 3600))
-            (openid-configuration
-             `((jwks_uri . ,(uri->string jwks-uri))
-               (authorization_endpoint . ,(uri->string authorization-endpoint-uri))
-               (token_endpoint . ,(uri->string token-endpoint-uri))
-               (solid_oidc_supported . "https://solidproject.org/TR/solid-oidc")))
-            (openid-configuration-uri
-             (build-uri 'https
-                        #:host (uri-host issuer)
-                        #:path "/.well-known/openid-configuration")))
-        (lambda (request request-body)
-          (let ((uri (request-uri request))
-                (current-time ((p:current-date))))
-            (parameterize ((web-locale request))
-              (cond ((same-uri? uri openid-configuration-uri)
-                     (let* ((current-sec (time-second (date->time-utc current-time)))
-                            (exp-sec (+ current-sec 3600))
-                            (exp (time-utc->date
-                                  (make-time time-utc 0 exp-sec))))
-                       (serve-oidc-configuration exp openid-configuration)))
-                    ((same-uri? uri jwks-uri)
-                     (let* ((current-sec (time-second (date->time-utc current-time)))
-                            (exp-sec (+ current-sec 3600))
-                            (exp (time-utc->date
-                                  (make-time time-utc 0 exp-sec))))
-                       (serve (make <jwks> #:keys (list key)) exp)))
-                    ((same-uri? uri authorization-endpoint-uri #:skip-query #t)
-                     (authorization-endpoint request request-body))
-                    ((same-uri? uri token-endpoint-uri)
-                     (token-endpoint request request-body))
-                    ((same-uri? uri subject)
-                     (values
-                      (build-response #:headers '((content-type text/turtle))
-                                      #:port #f)
-                      (format #f
-                              "@prefix foaf: <http://xmlns.com/foaf/0.1/> .
+    (let ((authorization-endpoint
+           (make-authorization-endpoint subject encrypted-password key 120
+                                        #:http-get http-get))
+          (token-endpoint
+           (make-token-endpoint token-endpoint-uri issuer key 3600))
+          (openid-configuration
+           `((jwks_uri . ,(uri->string jwks-uri))
+             (authorization_endpoint . ,(uri->string authorization-endpoint-uri))
+             (token_endpoint . ,(uri->string token-endpoint-uri))
+             (solid_oidc_supported . "https://solidproject.org/TR/solid-oidc")))
+          (openid-configuration-uri
+           (build-uri 'https
+                      #:host (uri-host issuer)
+                      #:path "/.well-known/openid-configuration")))
+      (lambda (request request-body)
+        (let ((uri (request-uri request))
+              (current-time ((p:current-date))))
+          (parameterize ((web-locale request))
+            (cond ((same-uri? uri openid-configuration-uri)
+                   (let* ((current-sec (time-second (date->time-utc current-time)))
+                          (exp-sec (+ current-sec 3600))
+                          (exp (time-utc->date
+                                (make-time time-utc 0 exp-sec))))
+                     (serve-oidc-configuration exp openid-configuration)))
+                  ((same-uri? uri jwks-uri)
+                   (let* ((current-sec (time-second (date->time-utc current-time)))
+                          (exp-sec (+ current-sec 3600))
+                          (exp (time-utc->date
+                                (make-time time-utc 0 exp-sec))))
+                     (serve (make <jwks> #:keys (list key)) exp)))
+                  ((same-uri? uri authorization-endpoint-uri #:skip-query #t)
+                   (authorization-endpoint request request-body))
+                  ((same-uri? uri token-endpoint-uri)
+                   (token-endpoint request request-body))
+                  ((same-uri? uri subject)
+                   (values
+                    (build-response #:headers '((content-type text/turtle))
+                                    #:port #f)
+                    (format #f
+                            "@prefix foaf: <http://xmlns.com/foaf/0.1/> .
 @prefix rdfs: <http://www.w3.org/2000/01/rdf-schema#> .
 
 <#~a> a foaf:Person ;
   rdfs:comment \"It works. Now you should use another service to serve that resource.\" .
 "
-                              (uri-fragment subject))))
-                    (else
-                     (values
-                      (build-response #:code 404
-                                      #:reason-phrase (W_ "reason-phrase|Not Found")
-                                      #:headers '((content-type application/xhtml+xml)))
-                      (with-output-to-string
-                        (lambda ()
-                          (sxml->xml
-                           `(*TOP* (*PI* xml "version=\"1.0\" encoding=\"utf-8\"")
-                                   (html (@ (xmlns "http://www.w3.org/1999/xhtml")
-                                            (xml:lang ,(W_ "xml-lang|en")))
-                                         (body
-                                          ,(sxml-match
-                                            (xml->sxml
-                                             (W_ (format #f "<h1>Resource not found</h1>")))
-                                            ((*TOP* ,title) title))
-                                          ,(sxml-match
-                                            (xml->sxml
-                                             (W_ (format #f "<p>This OpenID Connect identity provider does not know the resource you are requesting.</p>")))
-                                            ((*TOP* ,p) p))))))))))))))))))
+                            (uri-fragment subject))))
+                  (else
+                   (values
+                    (build-response #:code 404
+                                    #:reason-phrase (W_ "reason-phrase|Not Found")
+                                    #:headers '((content-type application/xhtml+xml)))
+                    (with-output-to-string
+                      (lambda ()
+                        (sxml->xml
+                         `(*TOP* (*PI* xml "version=\"1.0\" encoding=\"utf-8\"")
+                                 (html (@ (xmlns "http://www.w3.org/1999/xhtml")
+                                          (xml:lang ,(W_ "xml-lang|en")))
+                                       (body
+                                        ,(sxml-match
+                                          (xml->sxml
+                                           (W_ (format #f "<h1>Resource not found</h1>")))
+                                          ((*TOP* ,title) title))
+                                        ,(sxml-match
+                                          (xml->sxml
+                                           (W_ (format #f "<p>This OpenID Connect identity provider does not know the resource you are requesting.</p>")))
+                                          ((*TOP* ,p) p)))))))))))))))))