Negociate a token (client)

3 files changed, 242 insertions, 1 deletions

diff --git a/tests/Makefile.am b/tests/Makefile.am
index 6d0df35..52a0083 100644
--- a/tests/Makefile.am
+++ b/tests/Makefile.am
@@ -37,7 +37,9 @@ TESTS = %reldir%/load-library.scm \
   %reldir%/token-endpoint-issue.scm \
   %reldir%/token-endpoint-refresh.scm \
   %reldir%/provider-confirmation.scm \
-  %reldir%/resource-server.scm
+  %reldir%/resource-server.scm \
+  %reldir%/client-authorization.scm \
+  %reldir%/client-token.scm
 
 EXTRA_DIST += $(TESTS) %reldir%/ChangeLog
 
diff --git a/tests/client-authorization.scm b/tests/client-authorization.scm
new file mode 100644
index 0000000..ed02edf
--- /dev/null
+++ b/tests/client-authorization.scm
@@ -0,0 +1,118 @@
+(use-modules (webid-oidc client)
+             (webid-oidc testing)
+             ((webid-oidc stubs) #:prefix stubs:)
+             (web uri)
+             (web response)
+             (srfi srfi-19)
+             (ice-9 optargs)
+             (ice-9 receive)
+             (ice-9 hash-table))
+
+;; We need to test different things.
+
+;; 1. It works when passed a host
+;; 2. It works when passed a webid with foreign identity providers
+;; 3. It works when passed a webid without foreign identity providers
+
+(with-test-environment
+ "client-authorization"
+ (lambda ()
+   (define* (http-get uri #:key (headers '()))
+     (cond
+      ;; 1. We pass a host name
+      ((equal? uri (string->uri "https://case-1.client-authorization.scm/.well-known/openid-configuration"))
+       (values
+        (build-response #:headers `((content-type application/json)))
+        (stubs:scm->json-string
+         `((jwks_uri . "https://case-1.client-authorization.scm/keys")
+           (authorization_endpoint . "https://case-1.client-authorization.scm/authorize")
+           (token_endpoint . "https://case-1.client-authorization.scm/token")))))
+      ;; It’s not a webid
+      ((equal? uri (string->uri "https://case-1.client-authorization.scm"))
+       (values
+        (build-response #:code 404 #:reason-phrase "Not Found")
+        #f))
+      ;; 2. We first dereference the webid
+      ((equal? uri (string->uri "https://case-2.client-authorization.scm/profile/card#me"))
+       (values
+        (build-response #:headers `((content-type text/turtle)))
+        "<#me> <http://www.w3.org/ns/solid/terms#oidcIssuer> <https://one.identity.provider>, <https://another.identity.provider> ."))
+      ;; and we get the config of all IPs
+      ((equal? uri (string->uri "https://case-2.client-authorization.scm/.well-known/openid-configuration"))
+       (values
+        (build-response #:headers `((content-type application/json)))
+        (stubs:scm->json-string
+         `((jwks_uri . "https://case-2.client-authorization.scm/keys")
+           (authorization_endpoint . "https://case-2.client-authorization.scm/authorize")
+           (token_endpoint . "https://case-2.client-authorization.scm/token")))))
+      ((equal? uri (string->uri "https://one.identity.provider/.well-known/openid-configuration"))
+       (values
+        (build-response #:headers `((content-type application/json)))
+        (stubs:scm->json-string
+         `((jwks_uri . "https://one.identity.provider/keys")
+           (authorization_endpoint . "https://one.identity.provider/authorize")
+           (token_endpoint . "https://one.identity.provider/token")))))
+      ((equal? uri (string->uri "https://another.identity.provider/.well-known/openid-configuration"))
+       (values
+        (build-response #:headers `((content-type application/json)))
+        (stubs:scm->json-string
+         `((jwks_uri . "https://another.identity.provider/keys")
+           (authorization_endpoint . "https://another.identity.provider/authorize")
+           (token_endpoint . "https://another.identity.provider/token")))))
+      ;; 3. The webid has no IPs.
+      ((equal? uri (string->uri "https://case-3.client-authorization.scm/profile/card#me"))
+       (values
+        (build-response #:headers `((content-type text/turtle)))
+        ""))
+      ;; so we query the host of the webid.
+      ((equal? uri (string->uri "https://case-3.client-authorization.scm/.well-known/openid-configuration"))
+       (values
+        (build-response #:headers `((content-type application/json)))
+        (stubs:scm->json-string
+         `((jwks_uri . "https://case-3.client-authorization.scm/keys")
+           (authorization_endpoint . "https://case-3.client-authorization.scm/authorize")
+           (token_endpoint . "https://case-3.client-authorization.scm/token")))))
+      (else
+       (format (current-error-port) "Unexpected GET query of URI ~a.\n" (uri->string uri))
+       (exit 1))))
+   (let ((case-1 (authorize "case-1.client-authorization.scm"
+                            #:client-id "https://app.client-authorization.scm"
+                            #:redirect-uri "https://app.client-authorization.scm/redirected"
+                            #:state "integrity&check"
+                            #:http-get http-get))
+         (case-2 (authorize "https://case-2.client-authorization.scm/profile/card#me"
+                            #:client-id "https://app.client-authorization.scm"
+                            #:redirect-uri "https://app.client-authorization.scm/redirected"
+                            #:state "integrity&check"
+                            #:http-get http-get))
+         (case-3 (authorize "https://case-3.client-authorization.scm/profile/card#me"
+                            #:client-id "https://app.client-authorization.scm"
+                            #:redirect-uri "https://app.client-authorization.scm/redirected"
+                            #:state "integrity&check"
+                            #:http-get http-get))
+         (expected-1
+          `(("https://case-1.client-authorization.scm"
+             . ,(string->uri "https://case-1.client-authorization.scm/authorize?client_id=https%3A%2F%2Fapp.client-authorization.scm&redirect_uri=https%3A%2F%2Fapp.client-authorization.scm%2Fredirected&state=integrity%26check"))))
+         (expected-2
+          `(("https://case-2.client-authorization.scm"
+             . ,(string->uri "https://case-2.client-authorization.scm/authorize?client_id=https%3A%2F%2Fapp.client-authorization.scm&redirect_uri=https%3A%2F%2Fapp.client-authorization.scm%2Fredirected&state=integrity%26check"))
+            ("https://one.identity.provider"
+             . ,(string->uri "https://one.identity.provider/authorize?client_id=https%3A%2F%2Fapp.client-authorization.scm&redirect_uri=https%3A%2F%2Fapp.client-authorization.scm%2Fredirected&state=integrity%26check"))
+            ("https://another.identity.provider"
+             . ,(string->uri "https://another.identity.provider/authorize?client_id=https%3A%2F%2Fapp.client-authorization.scm&redirect_uri=https%3A%2F%2Fapp.client-authorization.scm%2Fredirected&state=integrity%26check"))))
+         (expected-3
+          `(("https://case-3.client-authorization.scm"
+             . ,(string->uri "https://case-3.client-authorization.scm/authorize?client_id=https%3A%2F%2Fapp.client-authorization.scm&redirect_uri=https%3A%2F%2Fapp.client-authorization.scm%2Fredirected&state=integrity%26check")))))
+     (unless (equal? case-1 expected-1)
+       (format (current-error-port) "Case 1 failed:\n~s\n~s\n\n"
+               case-1 expected-1)
+       (exit 2))
+     (unless (equal? (hash-map->list cons (alist->hash-table case-2))
+                     (hash-map->list cons (alist->hash-table expected-2)))
+       (format (current-error-port) "Case 2 failed:\n~s\n~s\n\n"
+               case-2 expected-2)
+       (exit 3))
+     (unless (equal? case-3 expected-3)
+       (format (current-error-port) "Case 3 failed:\n~s\n~s\n\n"
+               case-3 expected-3)
+       (exit 4)))))
diff --git a/tests/client-token.scm b/tests/client-token.scm
new file mode 100644
index 0000000..02f5ec7
--- /dev/null
+++ b/tests/client-token.scm
@@ -0,0 +1,121 @@
+(use-modules (webid-oidc client)
+             (webid-oidc testing)
+             (webid-oidc token-endpoint)
+             (webid-oidc jwk)
+             (webid-oidc jti)
+             (webid-oidc authorization-code)
+             (webid-oidc oidc-configuration)
+             (webid-oidc jws)
+             (webid-oidc oidc-id-token)
+             (web uri)
+             (web request)
+             (web response)
+             (srfi srfi-19)
+             (ice-9 optargs)
+             (ice-9 receive)
+             (ice-9 hash-table))
+
+(with-test-environment
+ "client-token"
+ (lambda ()
+   (define the-current-time 0)
+   (define issuer-key (generate-key #:n-size 2048))
+   (define issuer-configuration
+     (make-oidc-configuration
+      "https://issuer.client-token.scm/keys"
+      "https://issuer.client-token.scm/authorize"
+      "https://issuer.client-token.scm/token"))
+   (define token-endpoint (make-token-endpoint
+                           (string->uri "https://issuer.client-token.scm/token")
+                           (string->uri "https://issuer.client-token.scm")
+                           'RS256
+                           issuer-key
+                           3600 ;; 1 hour
+                           (make-jti-list)
+                           #:current-time (lambda () the-current-time)))
+   (define client-key (generate-key #:n-size 2048))
+   (define authorization-code
+     (issue-authorization-code 'RS256  issuer-key 120
+                               (string->uri "https://client-token.scm/profile/card#me")
+                               (string->uri "https://app.client-token.scm/app#id")))
+   (define* (http-get uri #:key (headers '()))
+     (cond
+      ((equal? uri (string->uri "https://issuer.client-token.scm/.well-known/openid-configuration"))
+       (serve-oidc-configuration
+        (time-utc->date (make-time time-utc 0 (+ the-current-time 3600)))
+        issuer-configuration))
+      ((equal? uri (string->uri "https://issuer.client-token.scm/keys"))
+       (serve-jwks
+        (time-utc->date (make-time time-utc 0 (+ the-current-time 3600)))
+        (make-jwks (list issuer-key))))
+      (else
+       (format (current-error-port) "GET request to ~a: error.\n" (uri->string uri))
+       (exit 1))))
+   (define* (http-post uri #:key (body #f) (headers '()))
+     (unless (equal? uri (oidc-configuration-token-endpoint issuer-configuration))
+       (format (current-error-port)
+               "Wrong URI for token negociation: ~a (expected ~a).\n"
+               (uri->string uri)
+               (uri->string
+                (oidc-configuration-token-endpoint
+                 issuer-configuration)))
+       (exit 2))
+     (unless (equal? body (format #f "grant_type=authorization_code&code=~a"
+                                  authorization-code))
+       (format (current-error-port)
+               "Wrong body: ~s\n" body)
+       (exit 3))
+     (unless (equal?
+              (assoc-ref headers 'content-type)
+              '(application/x-www-form-urlencoded))
+       (format (current-error-port)
+               "Wrong content type: ~s\n" (assoc-ref headers 'content-type))
+       (exit 4))
+     (let ((request
+            (build-request uri
+                           #:method 'POST
+                           #:headers headers
+                           #:port (open-input-string body)))
+           (request-body body))
+       (token-endpoint request request-body)))
+   (let ((response
+          (token "https://issuer.client-token.scm"
+                 client-key
+                 #:authorization-code authorization-code
+                 #:http-get http-get
+                 #:http-post http-post
+                 #:current-time (lambda () the-current-time))))
+     (let ((id-token (assq-ref response 'id_token))
+           (access-token (assq-ref response 'access_token))
+           (token-type (assq-ref response 'token_type))
+           (token-expiration (assq-ref response 'expires_in))
+           (refresh-token (assq-ref response 'refresh_token)))
+       (let ((id-token-dec (id-token-decode id-token #:http-get http-get))
+             (access-token-dec (jws-decode access-token (lambda (jws) issuer-key))))
+         (unless id-token-dec
+           (format (current-error-port) "Could not decode the ID token from ~s (~s)"
+                   id-token response)
+           (exit 5))
+         (unless access-token-dec
+           (format (current-error-port) "Could not decode the access token from ~s (~s)"
+                   access-token response)
+           (exit 6))
+         (unless refresh-token
+           (format (current-error-port) "There does not seem to be a refresh token in ~s"
+                   response)
+           (exit 6))
+         (unless (equal? (id-token-webid id-token-dec)
+                         (string->uri "https://client-token.scm/profile/card#me"))
+           (exit 7))
+         (unless (equal? (id-token-iss id-token-dec)
+                         (string->uri "https://issuer.client-token.scm"))
+           (exit 8))
+         (unless (equal? (id-token-aud id-token-dec)
+                         (string->uri "https://app.client-token.scm/app#id"))
+           (exit 9))
+         ;; It’s not the job of the client to check that the access
+         ;; token is correct; TODO: add a check with a resource
+         ;; server.
+
+         ;; TODO: try to negociate a refresh token.
+         )))))