Restructure the client API

The client API had several problems:
- using records instead of GOOPS means that we aren’t flexible enough
to introduce accounts protected by a password, for a multi-user
application;
- saving the user database to disk means we can’t have a proper
immutable API;
- it was difficult to predict when the users database would change,
and inform the user interface about this change;
- it had two different ways to negociate an access token, one when we
had a refresh token and one when we did not;
- it was supposed to either use account objects or a subject / issuer
pair, now we only use account objects.

3 files changed, 484 insertions, 457 deletions

diff --git a/src/scm/webid-oidc/client/Makefile.am b/src/scm/webid-oidc/client/Makefile.am
index ccb7e35..583193e 100644
--- a/src/scm/webid-oidc/client/Makefile.am
+++ b/src/scm/webid-oidc/client/Makefile.am
@@ -15,7 +15,9 @@
 # along with this program.  If not, see <https://www.gnu.org/licenses/>.
 
 dist_clientwebidoidcmod_DATA += \
-  %reldir%/accounts.scm
+  %reldir%/accounts.scm \
+  %reldir%/client.scm
 
 clientwebidoidcgo_DATA += \
-  %reldir%/accounts.go
+  %reldir%/accounts.go \
+  %reldir%/client.go
diff --git a/src/scm/webid-oidc/client/accounts.scm b/src/scm/webid-oidc/client/accounts.scm
index cd69c59..f978257 100644
--- a/src/scm/webid-oidc/client/accounts.scm
+++ b/src/scm/webid-oidc/client/accounts.scm
@@ -1,3 +1,19 @@
+;; disfluid, implementation of the Solid specification
+;; Copyright (C) 2021  Vivien Kraus
+
+;; This program is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU Affero General Public License as
+;; published by the Free Software Foundation, either version 3 of the
+;; License, or (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU Affero General Public License for more details.
+
+;; You should have received a copy of the GNU Affero General Public License
+;; along with this program.  If not, see <https://www.gnu.org/licenses/>.
+
 (define-module (webid-oidc client accounts)
   #:use-module (sxml simple)
   #:use-module (sxml match)
@@ -5,6 +21,7 @@
   #:use-module (ice-9 exceptions)
   #:use-module (ice-9 i18n)
   #:use-module (ice-9 receive)
+  #:use-module (ice-9 optargs)
   #:use-module (srfi srfi-9)
   #:use-module (srfi srfi-19)
   #:use-module (webid-oidc errors)
@@ -14,24 +31,31 @@
   #:use-module ((webid-oidc oidc-configuration) #:prefix cfg:)
   #:use-module ((webid-oidc jwk) #:prefix jwk:)
   #:use-module ((webid-oidc dpop-proof) #:prefix dpop:)
+  #:use-module ((webid-oidc client client) #:prefix client:)
   #:use-module (web uri)
   #:use-module (web response)
   #:use-module (web client)
   #:use-module (rnrs bytevectors)
+  #:use-module (oop goops)
   #:declarative? #t
   #:export
   (
    <account>
-   make-account
-   account?
-   account-subject
-   account-issuer
-   account-id-token
-   account-access-token
-   account-refresh-token
-   account-keypair
+   subject set-subject
+   issuer set-issuer
+   id-token set-id-token
+   access-token set-access-token
+   refresh-token set-refresh-token
+   key-pair set-key-pair
+
+   <protected-account>
+   username set-username
+   encrypted-password set-encrypted-password
+   check-credentials
 
    authorization-process
+   authorization-state
+   anonymous-http-request
 
    &authorization-code-required
    make-authorization-code-required
@@ -48,12 +72,13 @@
    token-request-response
    token-request-response-body
 
-   read-accounts
-   save-account
-   delete-account
+   &login-failed
+   make-login-failed
+   login-failed?
+
    invalidate-access-token
    invalidate-refresh-token
-   login
+   refresh
    )
   #:declarative? #t)
 
@@ -100,453 +125,361 @@
          (make-exception-with-message final-message))
         #:continuable? #t)))))
 
-(define-record-type <account>
-  (make-account subject issuer id-token access-token refresh-token keypair)
-  account?
-  (subject account-subject)
-  (issuer account-issuer)
-  (id-token account-id-token)
-  (access-token account-access-token)
-  (refresh-token account-refresh-token)
-  (keypair account-keypair))
-
-(define (load-account-arguments subject issuer arguments)
-  (let collect-arguments ((id-token #f)
-                          (access-token #f)
-                          (refresh-token #f)
-                          (keypair #f)
-                          (arguments arguments))
-    (match arguments
-      (()
-       (make-account subject
-                     issuer
-                     id-token
-                     access-token
-                     refresh-token
-                     keypair))
-      ((hd tl ...)
-       (sxml-match
-        hd
-        ((disfluid:id-token (@ (alg ,alg) (sub ,sub) (aud ,aud) (nonce ,nonce) (iat ,iat) (exp ,exp)))
-         (collect-arguments
-          (id:the-id-token
-           `(((alg . ,alg))
-             . ((webid . ,(uri->string subject))
-                (iss . ,(uri->string issuer))
-                (sub . ,sub)
-                (aud . ,aud)
-                (nonce . ,nonce)
-                (iat . ,(string->number iat))
-                (exp . ,(string->number exp)))))
-          access-token
-          refresh-token
-          keypair
-          tl))
-        ((disfluid:access-token (@ (access-token ,access-token)))
-         (collect-arguments
-          id-token
-          access-token
-          refresh-token
-          keypair
-          tl))
-        ((disfluid:refresh-token (@ (refresh-token ,refresh-token)))
-         (collect-arguments
-          id-token
-          access-token
-          refresh-token
-          keypair
-          tl))
-        ((disfluid:rsa-keypair (@ (n ,n) (e (,e "AQAB"))
-                                  (d ,d) (p ,p) (q ,q) (dp ,dp) (dq ,dq) (qi ,qi)))
-         (collect-arguments
-          id-token
-          access-token
-          refresh-token
-          `(,@(jwk:make-rsa-public-key n e)
-            ,@(jwk:make-rsa-private-key d p q dp dq qi))
-          tl))
-        ((disfluid:ec-keypair (@ (crv ,crv) (x ,x) (y ,y) (d ,d)))
-         (collect-arguments
-          id-token
-          access-token
-          refresh-token
-          `(,@(jwk:make-ec-point crv x y)
-            ,@(jwk:make-ec-scalar crv d))
-          tl)))))))
-
-(define (read-accounts)
-  (let generate-list
-      ((content
-        (catch #t
-          (lambda ()
-            (call-with-input-file (string-append (p:data-home) "/profiles.xml")
-              (lambda (port)
-                (xml->sxml port
-                           #:namespaces '((disfluid . "https://disfluid.planete-kraus.eu/client-account/v1"))
-                           #:trim-whitespace? #t))))
-          (lambda error
-            '(*TOP*
-              (disfluid:accounts)))))
-       (parsed-accounts '()))
-    (sxml-match
-     content
-     ((*TOP*
-       (disfluid:accounts))
-      (reverse parsed-accounts))
-     ((*TOP*
-       (disfluid:accounts
-        (disfluid:account
-         (@ (subject ,subject)
-            (issuer ,issuer))
-         ,arguments ...)
-        ,other-accounts ...))
-      (let ((account (load-account-arguments
-                      (string->uri subject)
-                      (string->uri issuer) arguments)))
-        (generate-list
-         `(*TOP* (disfluid:accounts ,@other-accounts))
-         `(,account ,@parsed-accounts))))
-     ((*TOP*
-       (disfluid:accounts
-        ,whatever
-        ,other-accounts ...))
-      (generate-list `(*TOP* (disfluid:accounts ,@other-accounts)) parsed-accounts))
-     ((*TOP*
-       ,whatever)
-      (generate-list `(*TOP* (disfluid:accounts)) parsed-accounts)))))
-
-(define (update-accounts transformer)
-  (stubs:atomically-update-file
-   (string-append (p:data-home) "/profiles.xml")
-   (string-append (p:data-home) "/profiles.xml.lock")
-   (lambda (port)
-     (let ((old-accounts (read-accounts)))
-       (let ((new-accounts (transformer old-accounts)))
-         (chmod port #o600)
-         (sxml->xml
-          `(*TOP*
-            (accounts
-             (@ (xmlns "https://disfluid.planete-kraus.eu/client-account/v1"))
-             ,@(map (match-lambda
-                      (($ <account> subject issuer id-token access-token refresh-token keypair)
-                       (when (string? subject)
-                         (set! subject (string->uri subject)))
-                       (when (string? issuer)
-                         (set! issuer (string->uri issuer)))
-                       `(account
-                         (@ (subject ,(uri->string subject))
-                            (issuer ,(uri->string issuer)))
-                         ,@(if id-token
-                               `((id-token (@ (alg ,(symbol->string (id:id-token-alg id-token)))
-                                              (sub ,(id:id-token-sub id-token))
-                                              (aud ,(uri->string (id:id-token-aud id-token)))
-                                              (nonce ,(id:id-token-nonce id-token))
-                                              (iat
-                                               ,(number->string
-                                                 (time-second
-                                                  (date->time-utc
-                                                   (id:id-token-iat id-token)))))
-                                              (exp
-                                               ,(number->string
-                                                 (time-second
-                                                  (date->time-utc
-                                                   (id:id-token-exp id-token))))))))
-                               '())
-                         ,@(if access-token
-                               `((access-token (@ (access-token ,access-token))))
-                               '())
-                         ,@(if refresh-token
-                               `((refresh-token (@ (refresh-token ,refresh-token))))
-                               '())
-                         ,@(if keypair
-                               (case (jwk:kty keypair)
-                                 ((RSA)
-                                  `((rsa-keypair (@ (n ,(assq-ref keypair 'n))
-                                                    (e ,(assq-ref keypair 'e))
-                                                    (d ,(assq-ref keypair 'd))
-                                                    (p ,(assq-ref keypair 'p))
-                                                    (q ,(assq-ref keypair 'q))
-                                                    (dp ,(assq-ref keypair 'dp))
-                                                    (dq ,(assq-ref keypair 'dq))
-                                                    (qi ,(assq-ref keypair 'qi))))))
-                                 ((EC)
-                                  `((ec-keypair (@ (crv ,(symbol->string (assq-ref keypair 'crv)))
-                                                   (x ,(assq-ref keypair 'x))
-                                                   (y ,(assq-ref keypair 'y))
-                                                   (d ,(assq-ref keypair 'd)))))))))))
-                    new-accounts)))
-          port))))))
-
-(define (filter-out account old-accounts)
-  (match account
-    (($ <account> subject issuer _ _ _ _)
-     (filter
-      (match-lambda
-        (($ <account> other-subject other-issuer _ _ _ _)
-         ;; Keep it only if this is not the same user
-         (or (not (equal? other-subject subject))
-             (not (equal? other-issuer issuer)))))
-      old-accounts))))
-
-(define (save-account account)
-  (update-accounts
-   (lambda (old-accounts)
-     `(,account
-       ,@(filter-out account old-accounts))))
-  account)
-
-(define (delete-account account)
-  (update-accounts
-   (lambda (old-accounts)
-     (filter-out account old-accounts))))
-
-(define invalidate-access-token
-  (match-lambda
-    (($ <account> subject issuer _ _ refresh-token keypair)
-     (make-account subject issuer #f #f refresh-token keypair))))
-
-(define invalidate-refresh-token
-  (match-lambda
-    (($ <account> subject issuer id-token access-token _ keypair)
-     (make-account subject issuer id-token access-token #f keypair))))
+(define authorization-state
+  (make-parameter #f))
+
+(define anonymous-http-request
+  (make-parameter http-request))
 
 (define (http-request->http-get http-request)
   (lambda* (uri . all-args)
     (apply http-request uri #:method 'GET all-args)))
 
-;; subject is optional. If the user is unknown, ask for an issuer and
-;; pass #f as subject.
-(define* (login subject issuer
-                #:key
-                (http-request http-request)
-                (state #f)
-                client-id
-                client-key
-                redirect-uri)
-  (let ((all-accounts (if subject
-                          ;; we’re expected to know the subject
-                          (read-accounts)
-                          ;; we’re not expected to know the subject
-                          ;; anyway.
-                          '())))
-    (let find-access-token ((accounts (read-accounts))
-                            (available-refresh-token #f))
-      (match accounts
-        (() ;; No access token available (or no ID token, or no key):
-         ;; requires authorization.
-         (receive (authorization-endpoint token-endpoint)
-             (let ((configuration
-                    (cfg:get-oidc-configuration
-                     (uri-host issuer)
-                     #:userinfo (uri-userinfo issuer)
-                     #:port (uri-port issuer)
-                     #:http-get (http-request->http-get http-request))))
-               (values 
-                (cfg:oidc-configuration-authorization-endpoint configuration)
-                (cfg:oidc-configuration-token-endpoint configuration)))
-           (let ((grant-type
-                  (if available-refresh-token
-                      "refresh_token"
-                      "authorization_code"))
-                 (grant
-                  (or available-refresh-token
-                      ;; Negociate an authorization code
-                      (let ((authorization-uri
-                             (build-uri
-                              (uri-scheme authorization-endpoint)
-                              #:userinfo (uri-userinfo authorization-endpoint)
-                              #:host (uri-host authorization-endpoint)
-                              #:port (uri-port authorization-endpoint)
-                              #:path (uri-path authorization-endpoint)
-                              #:query
-                              (string-join
-                               (map (match-lambda
-                                      ((key . value)
-                                       (string-join `(,(symbol->string key)
-                                                      ,(uri-encode value))
-                                                    "=")))
-                                    `((client_id . ,(uri->string client-id))
-                                      (redirect_uri . ,(uri->string redirect-uri))
-                                      ,@(if state
-                                            `((state . ,state))
-                                            '())))
-                               "&"))))
-                        ((authorization-process) authorization-uri #:issuer issuer))))
-                 (dpop-proof
-                  (dpop:issue-dpop-proof
-                   client-key
-                   #:alg (case (jwk:kty client-key)
-                           ((EC) 'ES256)
-                           ((RSA) 'RS256))
-                   #:htm 'POST
-                   #:htu token-endpoint)))
-             ;; Post the token request with the correct grant:
-             (receive (response response-body)
-                 (http-request token-endpoint
-                               #:method 'POST
-                               #:body
-                               (string-join
-                                (map
-                                 (match-lambda
+(define (http-get-implementation)
+  (http-request->http-get (anonymous-http-request)))
+
+(define-class <account> ()
+  (subject #:init-keyword #:subject #:getter subject)
+  (issuer #:init-keyword #:issuer #:getter issuer)
+  (id-token #:init-keyword #:id-token #:getter id-token #:init-value #f)
+  (access-token #:init-keyword #:access-token #:getter access-token #:init-value #f)
+  (refresh-token #:init-keyword #:refresh-token #:getter refresh-token #:init-value #f)
+  (key-pair #:init-keyword #:key-pair #:getter key-pair))
+
+(define-method (equal? (a <account>) (b <account>))
+  (and (equal? (subject a) (subject b))
+       (equal? (issuer a) (issuer b))
+       (equal? (id-token a) (id-token b))
+       (equal? (access-token a) (access-token b))
+       (equal? (refresh-token a) (refresh-token b))
+       (equal? (key-pair a) (key-pair b))))
+
+(define-exception-type
+  &login-failed
+  &external-error
+  make-login-failed
+  login-failed?)
+
+(define-method (initialize (account <account>) initargs)
+  (next-method)
+  (let-keywords
+   initargs #t
+   ((subject #f)
+    (issuer #f)
+    (id-token #f)
+    (access-token #f)
+    (refresh-token #f)
+    (key-pair #f))
+   (match `(,subject ,issuer)
+     (((or (? string? (= string->uri (? uri? subject)))
+           (? uri? subject))
+       (or (? string? (= string->uri (? uri? issuer)))
+           (? uri? issuer)))
+      (slot-set! account 'subject subject)
+      (slot-set! account 'issuer issuer))
+     ((#f
+       (or (? string? (= string->uri (? uri? issuer)))
+           (? uri? issuer)))
+      ;; Create the account
+      (let ((client (client:client)))
+        (receive (authorization-endpoint token-endpoint)
+            (let ((configuration
+                   (cfg:get-oidc-configuration
+                    (uri-host issuer)
+                    #:userinfo (uri-userinfo issuer)
+                    #:port (uri-port issuer)
+                    #:http-get (http-get-implementation))))
+              (values
+               (cfg:oidc-configuration-authorization-endpoint configuration)
+               (cfg:oidc-configuration-token-endpoint configuration)))
+          (receive (grant-type grant)
+              (if refresh-token
+                  (values "refresh_token" refresh-token)
+                  (values
+                   "authorization_code"
+                   (let ((authorization-uri
+                          (build-uri
+                           (uri-scheme authorization-endpoint)
+                           #:userinfo (uri-userinfo authorization-endpoint)
+                           #:host (uri-host authorization-endpoint)
+                           #:port (uri-port authorization-endpoint)
+                           #:path (uri-path authorization-endpoint)
+                           #:query
+                           (string-join
+                            (map (match-lambda
                                    ((key . value)
-                                    (string-append (uri-encode key)
-                                                   "="
-                                                   (uri-encode value))))
-                                 `(("grant_type" . ,grant-type)
-                                   (,(if available-refresh-token
-                                         "refresh_token"
-                                         "code") . ,grant)))
-                                "&")
-                               #:headers
-                               `((content-type application/x-www-form-urlencoded)
-                                 (dpop . ,dpop-proof)))
-               ;; Check that the token endpoint responded correctly.
-               (when (eqv? (response-code response) 403)
-                 (when subject
-                   (save-account
-                    (invalidate-refresh-token
-                     (make-account subject issuer #f #f #f #f))))
-                 (let ((final-message
-                        (format #f (G_ "The refresh token has expired."))))
-                   (raise-exception
-                    (make-exception
-                     (make-refresh-token-expired)
-                     (make-exception-with-message final-message)))))
-               (unless (eqv? (response-code response) 200)
-                 (let ((final-message
-                        (format #f (G_ "The token request failed with code ~s (~s).")
-                                (response-code response)
-                                (response-reason-phrase response))))
-                   (raise-exception
-                    (make-exception
-                     (make-token-request-failed response response-body)
-                     (make-exception-with-message final-message)))))
-               (unless (response-content-type response)
-                 (let ((final-message
-                        (format #f (G_ "The token response did not set the content type."))))
-                   (raise-exception
-                    (make-exception
-                     (make-token-request-failed response response-body)
-                     (make-exception-with-message final-message)))))
-               (with-exception-handler
-                   (lambda (encoding-error)
-                     (let ((final-message
-                            (format #f (G_ "The token endpoint did not respond in UTF-8."))))
-                       (raise-exception
-                        (make-exception
-                         (make-token-request-failed response response-body)
-                         (make-exception-with-message final-message)
-                         encoding-error))))
-                 (lambda ()
-                   (when (bytevector? response-body)
-                     (set! response-body (utf8->string response-body)))))
-               (unless (eq? (car (response-content-type response))
-                            'application/json)
-                 (let ((final-message
-                        (format #f (G_ "The token response has content-type ~s, not application/json.")
-                                (response-content-type response))))
-                   (raise-exception
-                    (make-exception
-                     (make-token-request-failed response response-body)
-                     (make-exception-with-message final-message)))))
-               (let ((data
-                      (with-exception-handler
-                          (lambda (json-error)
-                            (let ((final-message
-                                   (format #f (G_ "The token response is not valid JSON."))))
-                              (raise-exception
-                               (make-exception
-                                (make-token-request-failed response response-body)
-                                (make-exception-with-message final-message)
-                                json-error))))
-                        (lambda ()
-                          (stubs:json-string->scm response-body)))))
-                 (let ((id-token (assq-ref data 'id_token))
-                       (access-token (assq-ref data 'access_token))
-                       (refresh-token (assq-ref data 'refresh_token)))
-                   (unless id-token
-                     (let ((final-message
-                            (format #f (G_ "The token response did not include an ID token: ~s")
-                                    data)))
-                       (raise-exception
-                        (make-exception
-                         (make-token-request-failed response response-body)
-                         (make-exception-with-message final-message)))))
-                   (unless access-token
-                     (let ((final-message
-                            (format #f (G_ "The token response did not include an access token: ~s
+                                    (string-join `(,(symbol->string key)
+                                                   ,(uri-encode value))
+                                                 "=")))
+                                 `((client_id . ,(uri->string (client:client-id client)))
+                                   (redirect_uri . ,(uri->string (client:client-redirect-uri client)))
+                                   ,@(let ((state (authorization-state)))
+                                       (if state
+                                           `((state . ,state))
+                                           '()))))
+                            "&"))))
+                     ((authorization-process) authorization-uri #:issuer issuer))))
+            (unless key-pair
+              (set! key-pair (client:client-key-pair client)))
+            (let ((dpop-proof
+                   (dpop:issue-dpop-proof
+                    key-pair
+                    #:alg (case (jwk:kty key-pair)
+                            ((EC) 'ES256)
+                            ((RSA) 'RS256))
+                    #:htm 'POST
+                    #:htu token-endpoint)))
+              (receive (response response-body)
+                  ((anonymous-http-request) token-endpoint
+                   #:method 'POST
+                   #:body
+                   (string-join
+                    (map
+                     (match-lambda
+                       ((key . value)
+                        (string-append (uri-encode key)
+                                       "="
+                                       (uri-encode value))))
+                     `(("grant_type" . ,grant-type)
+                       (,(if (equal? grant-type "refresh_token")
+                             "refresh_token"
+                             "code") . ,grant)))
+                    "&")
+                   #:headers
+                   `((content-type application/x-www-form-urlencoded)
+                     (dpop . ,dpop-proof)))
+                ;; Check that the token endpoint responded correctly.
+                (when (eqv? (response-code response) 403)
+                  (let ((final-message
+                         (format #f (G_ "The refresh token has expired."))))
+                    (raise-exception
+                     (make-exception
+                      (make-refresh-token-expired)
+                      (make-exception-with-message final-message)))))
+                (unless (eqv? (response-code response) 200)
+                  (let ((final-message
+                         (format #f (G_ "The token request failed with code ~s (~s).")
+                                 (response-code response)
+                                 (response-reason-phrase response))))
+                    (raise-exception
+                     (make-exception
+                      (make-token-request-failed response response-body)
+                      (make-exception-with-message final-message)))))
+                (unless (response-content-type response)
+                  (let ((final-message
+                         (format #f (G_ "The token response did not set the content type."))))
+                    (raise-exception
+                     (make-exception
+                      (make-token-request-failed response response-body)
+                      (make-exception-with-message final-message)))))
+                (with-exception-handler
+                    (lambda (encoding-error)
+                      (let ((final-message
+                             (format #f (G_ "The token endpoint did not respond in UTF-8."))))
+                        (raise-exception
+                         (make-exception
+                          (make-token-request-failed response response-body)
+                          (make-exception-with-message final-message)
+                          encoding-error))))
+                  (lambda ()
+                    (when (bytevector? response-body)
+                      (set! response-body (utf8->string response-body)))))
+                (unless (eq? (car (response-content-type response))
+                             'application/json)
+                  (let ((final-message
+                         (format #f (G_ "The token response has content-type ~s, not application/json.")
+                                 (response-content-type response))))
+                    (raise-exception
+                     (make-exception
+                      (make-token-request-failed response response-body)
+                      (make-exception-with-message final-message)))))
+                (let ((data
+                       (with-exception-handler
+                           (lambda (json-error)
+                             (let ((final-message
+                                    (format #f (G_ "The token response is not valid JSON."))))
+                               (raise-exception
+                                (make-exception
+                                 (make-token-request-failed response response-body)
+                                 (make-exception-with-message final-message)
+                                 json-error))))
+                         (lambda ()
+                           (stubs:json-string->scm response-body)))))
+                  (set! id-token (assq-ref data 'id_token))
+                  (set! access-token (assq-ref data 'access_token))
+                  (set! refresh-token
+                        (assq-ref data 'refresh_token))
+                  (unless id-token
+                    (let ((final-message
+                           (format #f (G_ "The token response did not include an ID token: ~s")
+                                   data)))
+                      (raise-exception
+                       (make-exception
+                        (make-token-request-failed response response-body)
+                        (make-exception-with-message final-message)))))
+                  (unless access-token
+                    (let ((final-message
+                           (format #f (G_ "The token response did not include an access token: ~s
 ")
-                                    data)))
-                       (raise-exception
-                        (make-exception
-                         (make-token-request-failed response response-body)
-                         (make-exception-with-message final-message)))))
-                   (with-exception-handler
-                       (lambda (decoding-error)
-                         (let ((final-message
-                                (if (exception-with-message? decoding-error)
-                                    (format #f (G_ "the ID token signature is invalid: ~a")
-                                            (exception-message decoding-error))
-                                    (format #f (G_ "the ID token signature is invalid")))))
-                           (raise-exception
-                            (make-exception
-                             (make-token-request-failed response response-body)
-                             (make-exception-with-message final-message)
-                             decoding-error))))
-                     (lambda ()
-                       (set! id-token
-                             (id:id-token-decode id-token
-                                                 #:http-get
-                                                 (http-request->http-get http-request)))))
-                   ;; We are not interested in the ID token
-                   ;; signature anymore, because it won’t be
-                   ;; transmitted to other parties and we know that
-                   ;; it is valid.
-                   (when (and subject
-                              (not (equal? subject (id:id-token-webid id-token))))
-                     (let ((final-message
-                            (format #f (G_ "the ID token delivered by the identity provider for ~s has ~s as webid")
-                                    (uri->string subject)
-                                    (id:id-token-webid id-token))))
-                       (raise-exception
-                        (make-exception
-                         (make-token-request-failed response response-body)
-                         (make-exception-with-message final-message)))))
-                   (when (not (equal? issuer (id:id-token-iss id-token)))
-                     (let ((final-message
-                            (format #f (G_ "The ID token delivered by the identity provider ~s is for issuer ~s.")
-                                    (uri->string issuer)
-                                    (id:id-token-iss id-token))))
-                       (raise-exception
-                        (make-exception
-                         (make-token-request-failed response response-body)
-                         (make-exception-with-message final-message)))))
-                   (make-account
-                    (id:id-token-webid id-token)
-                    issuer
-                    id-token
-                    access-token
-                    refresh-token
-                    client-key)))))))
-        ;; There is an account with an access token that was still
-        ;; valid last time we used it.
-        ((($ <account> hd-subject hd-issuer hd-id-token hd-access-token hd-refresh-token hd-keypair) tl ...)
-         (cond
-          ((and (equal? hd-subject subject)
-                (equal? hd-issuer issuer)
-                hd-id-token
-                hd-access-token
-                hd-keypair)
-           ;; We can use it as is.
-           (make-account hd-subject hd-issuer
-                         hd-id-token hd-access-token hd-refresh-token hd-keypair))
-          ((and (equal? hd-subject subject)
-                (equal? hd-issuer issuer))
-           ;; We know that user, but the access token has been
-           ;; invalidated. If it still has a refresh token, maybe try
-           ;; it.
-           (find-access-token '() hd-refresh-token))
-          (else
-           ;; We can’t even use this refresh token, so we will try
-           ;; with the previous one.
-           (find-access-token tl available-refresh-token))))))))
+                                   data)))
+                      (raise-exception
+                       (make-exception
+                        (make-token-request-failed response response-body)
+                        (make-exception-with-message final-message)))))
+                  (with-exception-handler
+                      (lambda (decoding-error)
+                        (let ((final-message
+                               (if (exception-with-message? decoding-error)
+                                   (format #f (G_ "the ID token signature is invalid: ~a")
+                                           (exception-message decoding-error))
+                                   (format #f (G_ "the ID token signature is invalid")))))
+                          (raise-exception
+                           (make-exception
+                            (make-token-request-failed response response-body)
+                            (make-exception-with-message final-message)
+                            decoding-error))))
+                    (lambda ()
+                      (set! id-token
+                            (id:id-token-decode id-token
+                                                #:http-get
+                                                (http-request->http-get (anonymous-http-request))))))
+                  ;; We are not interested in the ID token
+                  ;; signature anymore, because it won’t be
+                  ;; transmitted to other parties and we know that
+                  ;; it is valid.
+                  (when (and subject
+                             (not (equal? subject (id:id-token-webid id-token))))
+                    (let ((final-message
+                           (format #f (G_ "the ID token delivered by the identity provider for ~s has ~s as webid")
+                                   (uri->string subject)
+                                   (id:id-token-webid id-token))))
+                      (raise-exception
+                       (make-exception
+                        (make-token-request-failed response response-body)
+                        (make-exception-with-message final-message)))))
+                  (set! subject (id:id-token-webid id-token))
+                  (when (not (equal? issuer (id:id-token-iss id-token)))
+                    (let ((final-message
+                           (format #f (G_ "The ID token delivered by the identity provider ~s is for issuer ~s.")
+                                   (uri->string issuer)
+                                   (id:id-token-iss id-token))))
+                      (raise-exception
+                       (make-exception
+                        (make-token-request-failed response response-body)
+                        (make-exception-with-message final-message)))))
+                  (slot-set! account 'subject subject)
+                  (slot-set! account 'issuer issuer)
+                  (slot-set! account 'id-token id-token)
+                  (slot-set! account 'access-token access-token)
+                  (slot-set! account 'refresh-token refresh-token)
+                  (slot-set! account 'key-pair key-pair))))))))
+     ((#f #f)
+      (scm-error 'wrong-type-arg "make <account>"
+                 (G_ "The issuer is required.")
+                 '()
+                 (list issuer)))
+     (else
+      (scm-error 'wrong-type-arg "make <account>"
+                 (G_ "The optional subject and required issuer should be strings or URI.")
+                 '()
+                 (list subject issuer))))))
+
+(define-class <protected-account> (<account>)
+  (username #:init-keyword #:username #:getter username)
+  (encrypted-password #:init-keyword #:encrypted-password #:getter encrypted-password))
+
+(define-method (check-credentials (account <protected-account>) (username <string>) (password <string>))
+  (let ((c (crypt password (encrypted-password account))))
+    (unless (string=? c (encrypted-password account))
+      (raise-exception
+       (make-exception
+        (make-login-failed)
+        (make-exception-with-message
+         (G_ "Cannot check the username and/or password.")))))))
+
+(define-method (set-subject (a <account>) uri)
+  (let ((ret (shallow-clone a))
+        (uri
+         (match uri
+           ((? uri? uri) uri)
+           ((? string? (= string->uri (? uri? uri))) uri)
+           (else
+            (scm-error 'wrong-type-arg "set-subject"
+                       (G_ "The subject should be a string or URI.")
+                       '()
+                       (list subject))))))
+    (slot-set! ret 'subject uri)
+    ret))
+
+(define-method (set-issuer (a <account>) uri)
+  (let ((ret (shallow-clone a))
+        (uri
+         (match uri
+           ((? uri? uri) uri)
+           ((? string? (= string->uri (? uri? uri))) uri)
+           (else
+            (scm-error 'wrong-type-arg "set-issuer"
+                       (G_ "The issuer should be a string or URI.")
+                       '()
+                       (list issuer))))))
+    (slot-set! ret 'issuer uri)
+    ret))
+
+(define-method (set-id-token (a <account>) id-token)
+  (let ((ret (shallow-clone a)))
+    (slot-set! ret 'id-token id-token)
+    ret))
+
+(define-method (set-access-token (a <account>) access-token)
+  (let ((ret (shallow-clone a)))
+    (slot-set! ret 'access-token access-token)
+    ret))
+
+(define-method (set-refresh-token (a <account>) refresh-token)
+  (let ((ret (shallow-clone a)))
+    (slot-set! ret 'refresh-token refresh-token)
+    ret))
+
+(define-method (set-key-pair (a <account>) key-pair)
+  (let ((ret (shallow-clone a)))
+    (slot-set! ret 'key-pair key-pair)
+    ret))
+
+(define-method (set-username (a <protected-account>) username)
+  (let ((ret (shallow-clone a)))
+    (slot-set! ret 'username username)
+    ret))
+
+(define-method (set-encrypted-password (a <protected-account>) encrypted-password)
+  (let ((ret (shallow-clone a)))
+    (slot-set! ret 'encrypted-password encrypted-password)
+    ret))
+
+(define-method (invalidate-access-token (a <account>))
+  (set-id-token
+   (set-access-token a #f)
+   #f))
+
+(define-method (invalidate-refresh-token (a <account>))
+  (set-refresh-token a #f))
+
+(define-method (refresh (a <account>))
+  ;; Fill the holes made by invalidate-access-token
+  (let ((full
+         (make <account>
+           #:issuer (issuer a)
+           #:refresh-token (refresh-token a)
+           #:key-pair (key-pair a))))
+    (unless (equal? (subject a) (subject full))
+      (set! a (set-subject a (subject full))))
+    (unless (equal? (issuer a) (issuer full))
+      (set! a (set-issuer a (issuer full))))
+    (unless (equal? (id-token a) (id-token full))
+      (set! a (set-id-token a (id-token full))))
+    (unless (equal? (access-token a) (access-token full))
+      (set! a (set-access-token a (access-token full))))
+    (unless (equal? (refresh-token a) (refresh-token full))
+      (set! a (set-refresh-token a (refresh-token full))))
+    (unless (equal? (key-pair a) (key-pair full))
+      (set! a (set-key-pair a (key-pair full))))
+    a))
diff --git a/src/scm/webid-oidc/client/client.scm b/src/scm/webid-oidc/client/client.scm
new file mode 100644
index 0000000..66f8b74
--- /dev/null
+++ b/src/scm/webid-oidc/client/client.scm
@@ -0,0 +1,92 @@
+;; disfluid, implementation of the Solid specification
+;; Copyright (C) 2021  Vivien Kraus
+
+;; This program is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU Affero General Public License as
+;; published by the Free Software Foundation, either version 3 of the
+;; License, or (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU Affero General Public License for more details.
+
+;; You should have received a copy of the GNU Affero General Public License
+;; along with this program.  If not, see <https://www.gnu.org/licenses/>.
+
+(define-module (webid-oidc client client)
+  #:use-module (webid-oidc errors)
+  #:use-module (webid-oidc provider-confirmation)
+  #:use-module (webid-oidc oidc-configuration)
+  #:use-module (webid-oidc oidc-id-token)
+  #:use-module (webid-oidc dpop-proof)
+  #:use-module (webid-oidc web-i18n)
+  #:use-module ((webid-oidc jwk) #:prefix jwk:)
+  #:use-module ((webid-oidc parameters) #:prefix p:)
+  #:use-module ((webid-oidc stubs) #:prefix stubs:)
+  #:use-module ((webid-oidc config) #:prefix cfg:)
+  #:use-module ((webid-oidc client accounts) #:prefix client:)
+  #:use-module (web uri)
+  #:use-module (web client)
+  #:use-module (web request)
+  #:use-module (web response)
+  #:use-module (web server)
+  #:use-module (web http)
+  #:use-module (ice-9 optargs)
+  #:use-module (ice-9 receive)
+  #:use-module (srfi srfi-9)
+  #:use-module (srfi srfi-19)
+  #:use-module (srfi srfi-26)
+  #:use-module (rnrs bytevectors)
+  #:use-module (ice-9 i18n)
+  #:use-module (ice-9 getopt-long)
+  #:use-module (ice-9 suspendable-ports)
+  #:use-module (ice-9 match)
+  #:use-module (sxml simple)
+  #:use-module (oop goops)
+  #:export
+  (
+   <client>
+   client-id
+   client-key-pair
+   client-redirect-uri
+
+   client
+   )
+  #:declarative? #t)
+
+(define-class <client> ()
+  (client-id #:init-keyword #:client-id #:getter client-id)
+  (key-pair #:init-keyword #:key-pair #:getter client-key-pair)
+  (redirect-uri #:init-keyword #:redirect-uri #:getter client-redirect-uri))
+
+(define-method (initialize (client <client>) initargs)
+  (next-method)
+  (let-keywords
+   initargs #t
+   ((client-id #f)
+    (key-pair #t) ;; We’ll generate one if not #f
+    (redirect-uri #f))
+   (let convert-args ((client-id client-id)
+                      (key-pair key-pair)
+                      (redirect-uri redirect-uri))
+     (match `(,client-id ,key-pair ,redirect-uri)
+       (((or (? string? (= string->uri (? uri? client-id)))
+             (? uri? client-id))
+         (? jwk:jwk? client-key)
+         (or (? string? (= string->uri (? uri? redirect-uri)))
+             (? uri? redirect-uri)))
+        (begin
+          (slot-set! client 'client-id client-id)
+          (slot-set! client 'key-pair client-key)
+          (slot-set! client 'redirect-uri redirect-uri)))
+       ((_ #t _)
+        (convert-args client-id (jwk:generate-key #:n-size 2048) redirect-uri))
+       (else
+        (scm-error 'wrong-type-arg "make <account>"
+                   (G_ "Client ID and redirect URIs should be URIs, and key pair should be a key pair..")
+                   '()
+                   (list client-id key-pair redirect-uri)))))))
+
+(define client
+  (make-parameter #f))