From e910b3ba2ded990a5193f7ea0cfad525332e4171 Mon Sep 17 00:00:00 2001
From: Vivien Kraus <vivien@planete-kraus.eu>
Date: Mon, 20 Sep 2021 11:25:29 +0200
Subject: JWS: use GOOPS

---
 src/scm/webid-oidc/token-endpoint.scm | 45 ++++++++++++++++++++---------------
 1 file changed, 26 insertions(+), 19 deletions(-)

(limited to 'src/scm/webid-oidc/token-endpoint.scm')

diff --git a/src/scm/webid-oidc/token-endpoint.scm b/src/scm/webid-oidc/token-endpoint.scm
index 81f8e48..292df4d 100644
--- a/src/scm/webid-oidc/token-endpoint.scm
+++ b/src/scm/webid-oidc/token-endpoint.scm
@@ -38,6 +38,8 @@
   #:use-module (rnrs bytevectors)
   #:use-module (sxml simple)
   #:use-module (sxml match)
+  #:use-module (oop goops)
+  #:duplicates (merge-generics)
   #:declarative? #t
   #:export
   (
@@ -177,7 +179,7 @@
                    port)))))))
        thunk))))
 
-(define (make-token-endpoint token-endpoint-uri iss jwk validity)
+(define (make-token-endpoint token-endpoint-uri iss issuer-key validity)
   (lambda (request request-body)
     (when (bytevector? request-body)
       (set! request-body (utf8->string request-body)))
@@ -213,10 +215,11 @@
                                #:path (uri-path (request-uri request))
                                #:query (uri-query (request-uri request)))))
            (let ((grant-type (assoc-ref form-args "grant_type"))
-                 (dpop (dpop-proof-decode
-                        method uri
-                        (assq-ref (request-headers request) 'dpop)
-                        (lambda (jkt) #t))))
+                 (dpop (decode <dpop-proof> (assq-ref (request-headers request) 'dpop)
+                               #:method method
+                               #:uri uri
+                               #:cnf/check
+                               (lambda (jkt) #t))))
              (unless (and grant-type (string? grant-type))
                (let ((final-message 
                       (format #f (G_ "missing grant type")))
@@ -248,9 +251,16 @@
                                    (make-no-authorization-code)
                                    (make-exception-with-message final-message)
                                    (make-message-for-the-user final-user-message)))))
-                             (authorization-code-decode str jwk))))
-                      (values (authorization-code-webid code)
-                              (authorization-code-client-id code))))
+                             (with-exception-handler
+                                 (lambda (error)
+                                   (raise-exception
+                                    (make-exception
+                                     (make-invalid-authorization-code)
+                                     error)))
+                               (lambda ()
+                                 (decode <authorization-code> str
+                                         #:issuer-key issuer-key))))))
+                      (values (webid code) (client-id code))))
                    ((refresh_token)
                     (let ((refresh-token (assoc-ref form-args "refresh_token")))
                       (unless refresh-token
@@ -268,7 +278,7 @@
                             (make-message-for-the-user final-user-message)))))
                       (refresh:with-refresh-token
                        refresh-token
-                       (dpop-proof-jwk dpop)
+                       (jwk dpop)
                        values)))
                    (else
                     (let ((final-message
@@ -288,26 +298,23 @@
                (let* ((iat (time-second (date->time-utc current-time)))
                       (exp (+ iat validity)))
                  (let ((id-token
-                        (issue-id-token
-                         jwk
+                        (issue <id-token>
+                         issuer-key
                          #:webid webid
-                         #:sub (uri->string webid)
                          #:iss iss
-                         #:aud client-id
-                         #:validity 3600))
+                         #:aud client-id))
                        (access-token
-                        (issue-access-token
-                         jwk
+                        (issue <access-token>
+                         issuer-key
                          #:webid webid
                          #:iss iss
-                         #:validity 3600
-                         #:client-key (dpop-proof-jwk dpop)
+                         #:client-key (jwk dpop)
                          #:client-id client-id))
                        (refresh-token
                         (if (equal? grant-type "refresh_token")
                             (assoc-ref form-args "refresh_token")
                             (refresh:issue-refresh-token webid client-id
-                                                         (jkt (dpop-proof-jwk dpop))))))
+                                                         (jkt (jwk dpop))))))
                    (values
                     (build-response #:headers '((content-type application/json)
                                                 (cache-control (no-cache no-store)))
-- 
cgit v1.2.3