JWS: use GOOPS

1 files changed, 37 insertions, 18 deletions

diff --git a/tests/token-endpoint-issue.scm b/tests/token-endpoint-issue.scm
index c80658c..0815c30 100644
--- a/tests/token-endpoint-issue.scm
+++ b/tests/token-endpoint-issue.scm
@@ -43,11 +43,10 @@
    (define validity 3600)
    (define authz
      (parameterize ((p:current-date 0))
-       (issue-authorization-code
-        key
-        #:validity 120
-        #:webid subject
-        #:client-id client)))
+       (issue <authorization-code>
+              key
+              #:webid subject
+              #:client-id client)))
    (define endpoint
      (make-token-endpoint
       (string->uri "https://token-endpoint-issue.scm/token")
@@ -56,11 +55,12 @@
        ;; The code is fake!
        (let ((dpop
               (parameterize ((p:current-date 0))
-                (issue-dpop-proof
-                 client-key
-                 #:htm 'POST
-                 #:htu (string->uri
-                        "https://token-endpoint-issue.scm/token")))))
+                (issue <dpop-proof>
+                       client-key
+                       #:jwk (public-key client-key)
+                       #:htm 'POST
+                       #:htu (string->uri
+                              "https://token-endpoint-issue.scm/token")))))
          (parameterize ((p:current-date 0))
            (endpoint
             (build-request (string->uri
@@ -75,11 +75,12 @@
      (receive (response response-body . _)
          (let ((dpop
                 (parameterize ((p:current-date 10))
-                  (issue-dpop-proof
-                   client-key
-                   #:htm 'POST
-                   #:htu (string->uri
-                          "https://token-endpoint-issue.scm/token")))))
+                  (issue <dpop-proof>
+                         client-key
+                         #:jwk (public-key client-key)
+                         #:htm 'POST
+                         #:htu (string->uri
+                                "https://token-endpoint-issue.scm/token")))))
            (parameterize ((p:current-date 10))
              (endpoint
               (build-request (string->uri
@@ -101,11 +102,29 @@
              (exit 6))
            (unless refresh-token-enc
              (exit 7))
-           (let ((access-token (jws-decode access-token-enc
-                                           (lambda (h) key))))
+           (let ((access-token
+                  (parameterize ((p:current-date 20))
+                    (decode <access-token> access-token-enc
+                            #:http-request
+                            (lambda* (uri . args)
+                              (cond
+                               ((equal? uri (string->uri "https://issuer.token-endpoint-issue.scm/.well-known/openid-configuration"))
+                                (values (build-response #:headers '((content-type application/json)))
+                                        "{
+  \"jwks_uri\": \"https://token-endpoint-issue.scm/keys\",
+  \"token_endpoint\": \"https://token-endpoint-issue.scm/token\",
+  \"authorization_endpoint\": \"https://token-endpoint-issue.scm/authorize\",
+  \"solid_oidc_supported\": \"https://solidproject.org/TR/solid-oidc\"
+}"))
+                               ((equal? uri (string->uri "https://token-endpoint-issue.scm/keys"))
+                                (values (build-response #:headers '((content-type application/json)))
+                                        (stubs:scm->json-string `((keys . ,(list->vector (list (key->jwk key))))))))
+                               (else
+                                (format (current-error-port) "Unknown URI: ~s\n" (uri->string uri))
+                                (exit 11))))))))
              (unless access-token
                (exit 8))
-             (let ((access-token-cnf/jkt (access-token-cnf/jkt access-token)))
+             (let ((access-token-cnf/jkt (cnf/jkt access-token)))
                (unless access-token-cnf/jkt
                  (exit 9))
                (unless (string=? access-token-cnf/jkt (jkt client-key))