Add the refresh token code

4 files changed, 136 insertions, 1 deletions

diff --git a/tests/Makefile.am b/tests/Makefile.am
index 8ccfa68..a42529b 100644
--- a/tests/Makefile.am
+++ b/tests/Makefile.am
@@ -26,7 +26,10 @@ TESTS = %reldir%/load-library.scm \
   %reldir%/dpop-proof-replay.scm \
   %reldir%/client-manifest-public.scm \
   %reldir%/client-manifest.scm \
-  %reldir%/client-manifest-fraudulent.scm
+  %reldir%/client-manifest-fraudulent.scm \
+  %reldir%/refresh-token.scm \
+  %reldir%/too-many-refresh-tokens.scm \
+  %reldir%/refresh-token-with-wrong-key.scm
 
 EXTRA_DIST += $(TESTS)
 
@@ -38,6 +41,7 @@ clean-local: %canon_reldir%-clean-local
 
 %canon_reldir%-clean-local:
 	rm -rf %reldir%/*.cache
+	rm -rf %reldir%/*.home
 
 AM_TESTS_ENVIRONMENT = $(top_builddir)/pre-inst-env
 SCM_LOG_COMPILER = $(GUILE)
diff --git a/tests/refresh-token-with-wrong-key.scm b/tests/refresh-token-with-wrong-key.scm
new file mode 100644
index 0000000..2609e1e
--- /dev/null
+++ b/tests/refresh-token-with-wrong-key.scm
@@ -0,0 +1,29 @@
+(use-modules (webid-oidc refresh-token)
+             (webid-oidc testing)
+             (webid-oidc jwk)
+             (webid-oidc errors)
+             (web uri)
+             (srfi srfi-19)
+             (web response)
+             (ice-9 optargs)
+             (ice-9 receive))
+
+(with-test-environment
+ "refresh-token-with-wrong-key"
+ (lambda ()
+   (define first-key (generate-key #:n-size 2048))
+   (define second-key (generate-key #:n-size 2048))
+   (define sub (string->uri "https://subject"))
+   (define aud (string->uri "https://audience"))
+   (define refresh-token (issue-refresh-token sub aud (jkt first-key)))
+   (with-exception-handler
+       (lambda (error)
+         (unless ((record-predicate &invalid-key-for-refresh-token) error)
+           (exit 1)))
+     (lambda ()
+       (with-refresh-token refresh-token second-key
+                           (lambda (sub aud)
+                             (exit 2)))
+       (exit 3))
+     #:unwind? #t
+     #:unwind-for-type &invalid-key-for-refresh-token)))
diff --git a/tests/refresh-token.scm b/tests/refresh-token.scm
new file mode 100644
index 0000000..1586d4f
--- /dev/null
+++ b/tests/refresh-token.scm
@@ -0,0 +1,52 @@
+(use-modules (webid-oidc refresh-token)
+             (webid-oidc testing)
+             (webid-oidc errors)
+             (webid-oidc jwk)
+             (web uri)
+             (srfi srfi-19)
+             (web response)
+             (ice-9 optargs)
+             (ice-9 receive))
+
+(with-test-environment
+ "refresh-token"
+ (lambda ()
+   (define sub-a (string->uri "https://subject.a"))
+   (define sub-b (string->uri "https://subject.b"))
+   (define aud-a (string->uri "https://client.a"))
+   (define aud-b (string->uri "https://client.b"))
+   (define key-a (generate-key #:n-size 2048))
+   (define key-b (generate-key #:n-size 2048))
+   (define refresh-a (issue-refresh-token sub-a aud-a (jkt key-a)))
+   (define refresh-b (issue-refresh-token sub-b aud-b (jkt key-b)))
+   (unless (string? refresh-a)
+     (exit 2))
+   (unless (string? refresh-b)
+     (exit 3))
+   (unless
+       (with-refresh-token refresh-a key-a
+                           (lambda (sub aud)
+                             (unless (equal? sub-a sub)
+                               (exit 4))
+                             (unless (equal? aud-a aud)
+                               (exit 5))))
+     (exit 6))
+   (unless
+       (with-refresh-token refresh-b key-b
+                           (lambda (sub aud)
+                             (unless (equal? sub-b sub)
+                               (exit 7))
+                             (unless (equal? aud-b aud)
+                               (exit 8))))
+     (exit 9))
+   (remove-refresh-token sub-b aud-b)
+   (with-exception-handler
+       (lambda (error)
+         (unless ((record-predicate &invalid-refresh-token) error)
+           (exit 10)))
+     (lambda ()
+       (with-refresh-token refresh-b key-b
+                           (lambda (sub aud)
+                             (exit 11))))
+     #:unwind? #t
+     #:unwind-for-type &invalid-refresh-token)))
diff --git a/tests/too-many-refresh-tokens.scm b/tests/too-many-refresh-tokens.scm
new file mode 100644
index 0000000..cd1cbdc
--- /dev/null
+++ b/tests/too-many-refresh-tokens.scm
@@ -0,0 +1,50 @@
+(use-modules (webid-oidc refresh-token)
+             (webid-oidc testing)
+             (webid-oidc errors)
+             (webid-oidc jwk)
+             (web uri)
+             (srfi srfi-19)
+             (web response)
+             (ice-9 optargs)
+             (ice-9 receive))
+
+(define (issue-n-refresh-tokens key n)
+  (if (<= n 0)
+      '()
+      (let ((next
+             (issue-refresh-token
+              (string->uri (format #f "https://subject-~a.com" (+ n 1)))
+              (string->uri (format #f "https://client-~a.com" (+ n 1)))
+              (jkt key))))
+        (cons next
+              (issue-n-refresh-tokens key (- n 1))))))
+
+(with-test-environment
+ "too-many-refresh-tokens"
+ (lambda ()
+   (let* ((key (generate-key #:n-size 2048))
+          (refresh-tokens (list->vector (issue-n-refresh-tokens key 21))))
+     (let ((first-refresh-token (vector-ref refresh-tokens 0))
+           (second-refresh-token (vector-ref refresh-tokens 20)))
+       (with-exception-handler
+           (lambda (error)
+             (unless ((record-predicate &invalid-refresh-token) error)
+               (exit 1)))
+         (lambda ()
+           (with-refresh-token first-refresh-token key
+                               (lambda (sub aud)
+                                 ;; It has been made invalid!
+                                 (exit 1))))
+         #:unwind? #t
+         #:unwind-for-type &invalid-refresh-token)
+       (unless (with-refresh-token second-refresh-token key
+                                   (lambda (sub aud)
+                                     (format (current-error-port)
+                                             "~a / ~a\n"
+                                             (uri->string sub)
+                                             (uri->string aud))
+                                     (unless (equal? sub (string->uri "https://subject-2.com"))
+                                       (exit 2))
+                                     (unless (equal? aud (string->uri "https://client-2.com"))
+                                       (exit 3))))
+         (exit 4))))))