Implement the resource server verification code

2 files changed, 86 insertions, 1 deletions

diff --git a/tests/Makefile.am b/tests/Makefile.am
index 1d6cf14..6d0df35 100644
--- a/tests/Makefile.am
+++ b/tests/Makefile.am
@@ -36,7 +36,8 @@ TESTS = %reldir%/load-library.scm \
   %reldir%/authorization-endpoint-submit-form.scm \
   %reldir%/token-endpoint-issue.scm \
   %reldir%/token-endpoint-refresh.scm \
-  %reldir%/provider-confirmation.scm
+  %reldir%/provider-confirmation.scm \
+  %reldir%/resource-server.scm
 
 EXTRA_DIST += $(TESTS) %reldir%/ChangeLog
 
diff --git a/tests/resource-server.scm b/tests/resource-server.scm
new file mode 100644
index 0000000..52a08b7
--- /dev/null
+++ b/tests/resource-server.scm
@@ -0,0 +1,84 @@
+(use-modules (webid-oidc provider-confirmation)
+             (webid-oidc jti)
+             (webid-oidc jwk)
+             (webid-oidc jws)
+             (webid-oidc oidc-configuration)
+             (webid-oidc access-token)
+             (webid-oidc dpop-proof)
+             (webid-oidc resource-server)
+             (webid-oidc testing)
+             (web uri)
+             (web request)
+             (srfi srfi-19)
+             (web response)
+             (ice-9 optargs)
+             (ice-9 receive))
+
+(with-test-environment
+ "resource-server"
+ (lambda ()
+   (define jti (make-jti-list))
+   (define client-key (generate-key #:n-size 2048))
+   (define idp-key (generate-key #:n-size 2048))
+   (define jwks (make-jwks (list idp-key)))
+   (define jwks-uri (string->uri "https://identity.provider/keys"))
+   (define oidc-config
+     (make-oidc-configuration
+      jwks-uri
+      (string->uri "https://identity.provider/authorize")
+      (string->uri "https://identity.provider/token")))
+   (define oidc-config-uri
+     (string->uri
+      "https://identity.provider/.well-known/openid-configuration"))
+   (define subject (string->uri "https://identity.provider/subject#me"))
+   (define* (http-get uri #:key (headers '()))
+     (define exp (time-utc->date (make-time time-utc 0 3600)))
+     (cond ((equal? uri oidc-config-uri)
+            (serve-oidc-configuration exp oidc-config))
+           ((equal? uri jwks-uri)
+            (serve-jwks exp jwks))
+           (else (exit 1))))
+   (define access-token
+     (issue-access-token
+      idp-key
+      #:alg 'RS256
+      #:webid subject
+      #:iss "https://identity.provider"
+      #:iat 10
+      #:exp 3610
+      #:client-key client-key
+      #:client-id "https://client"))
+   (define uri (string->uri "https://resource.server/resource"))
+   (define server-uri (string->uri "https://resource.server/"))
+   (define method 'GET)
+   (define dpop-proof
+     (issue-dpop-proof
+      client-key
+      #:alg 'RS256
+      #:htm method
+      #:htu uri
+      #:iat (time-utc->date (make-time time-utc 0 15))))
+   (define rq
+     (call-with-input-string
+         (format #f "GET /resource HTTP/1.1\r\n\
+Host: resource.server\r\n\
+User-Agent: Test Suite\r\n\
+Upgrade-Insecure-Requests: 1\r\n\
+Cache-Control: max-age=0\r\n\
+Authorization: DPoP ~a\r\n\
+DPoP: ~a\r\n\r\n"
+                 access-token
+                 dpop-proof)
+       read-request))
+   (define rq-body "")
+   (define authenticator
+     (make-authenticator
+      jti
+      #:server-uri server-uri
+      #:current-time (lambda () (make-time time-utc 0 20))
+      #:http-get http-get))
+   (define parsed (authenticator rq rq-body))
+   (unless (uri? parsed)
+     (exit 2))
+   (unless (equal? parsed subject)
+     (exit 3))))