Client API: add a pretty printer

5 files changed, 118 insertions, 39 deletions

diff --git a/po/disfluid.pot b/po/disfluid.pot
index 2527da6..7a3ceca 100644
--- a/po/disfluid.pot
+++ b/po/disfluid.pot
@@ -8,7 +8,7 @@ msgid ""
 msgstr ""
 "Project-Id-Version: disfluid SNAPSHOT\n"
 "Report-Msgid-Bugs-To: vivien@planete-kraus.eu\n"
-"POT-Creation-Date: 2021-09-15 12:40+0200\n"
+"POT-Creation-Date: 2021-09-15 12:41+0200\n"
 "PO-Revision-Date: YEAR-MO-DA HO:MI+ZONE\n"
 "Last-Translator: FULL NAME <EMAIL@ADDRESS>\n"
 "Language-Team: LANGUAGE <LL@li.org>\n"
@@ -477,78 +477,78 @@ msgstr ""
 msgid "the client manifest is dereferenced from ~s, but it pretends to be ~s"
 msgstr ""
 
-#: src/scm/webid-oidc/client/accounts.scm:254
+#: src/scm/webid-oidc/client/accounts.scm:289
 msgid "The refresh token has expired."
 msgstr ""
 
-#: src/scm/webid-oidc/client/accounts.scm:261
+#: src/scm/webid-oidc/client/accounts.scm:296
 #, scheme-format
 msgid "The token request failed with code ~s (~s)."
 msgstr ""
 
-#: src/scm/webid-oidc/client/accounts.scm:270
+#: src/scm/webid-oidc/client/accounts.scm:305
 msgid "The token response did not set the content type."
 msgstr ""
 
-#: src/scm/webid-oidc/client/accounts.scm:278
+#: src/scm/webid-oidc/client/accounts.scm:313
 msgid "The token endpoint did not respond in UTF-8."
 msgstr ""
 
-#: src/scm/webid-oidc/client/accounts.scm:290
+#: src/scm/webid-oidc/client/accounts.scm:325
 #, scheme-format
 msgid "The token response has content-type ~s, not application/json."
 msgstr ""
 
-#: src/scm/webid-oidc/client/accounts.scm:300
+#: src/scm/webid-oidc/client/accounts.scm:335
 msgid "The token response is not valid JSON."
 msgstr ""
 
-#: src/scm/webid-oidc/client/accounts.scm:314
+#: src/scm/webid-oidc/client/accounts.scm:349
 #, scheme-format
 msgid "The token response did not include an ID token: ~s"
 msgstr ""
 
-#: src/scm/webid-oidc/client/accounts.scm:322
+#: src/scm/webid-oidc/client/accounts.scm:357
 #, scheme-format
 msgid "The token response did not include an access token: ~s\n"
 msgstr ""
 
-#: src/scm/webid-oidc/client/accounts.scm:333
+#: src/scm/webid-oidc/client/accounts.scm:368
 #, scheme-format
 msgid "the ID token signature is invalid: ~a"
 msgstr ""
 
-#: src/scm/webid-oidc/client/accounts.scm:335
+#: src/scm/webid-oidc/client/accounts.scm:370
 msgid "the ID token signature is invalid"
 msgstr ""
 
-#: src/scm/webid-oidc/client/accounts.scm:353
+#: src/scm/webid-oidc/client/accounts.scm:388
 #, scheme-format
 msgid "the ID token delivered by the identity provider for ~s has ~s as webid"
 msgstr ""
 
-#: src/scm/webid-oidc/client/accounts.scm:363
+#: src/scm/webid-oidc/client/accounts.scm:398
 #, scheme-format
 msgid "The ID token delivered by the identity provider ~s is for issuer ~s."
 msgstr ""
 
-#: src/scm/webid-oidc/client/accounts.scm:378
+#: src/scm/webid-oidc/client/accounts.scm:413
 msgid "The issuer is required."
 msgstr ""
 
-#: src/scm/webid-oidc/client/accounts.scm:383
+#: src/scm/webid-oidc/client/accounts.scm:418
 msgid "The optional subject and required issuer should be strings or URI."
 msgstr ""
 
-#: src/scm/webid-oidc/client/accounts.scm:398
+#: src/scm/webid-oidc/client/accounts.scm:454
 msgid "Cannot check the username and/or password."
 msgstr ""
 
-#: src/scm/webid-oidc/client/accounts.scm:408
+#: src/scm/webid-oidc/client/accounts.scm:464
 msgid "The subject should be a string or URI."
 msgstr ""
 
-#: src/scm/webid-oidc/client/accounts.scm:422
+#: src/scm/webid-oidc/client/accounts.scm:478
 msgid "The issuer should be a string or URI."
 msgstr ""
 
@@ -563,7 +563,7 @@ msgstr ""
 msgid "You already have an account for ~a issued by ~a."
 msgstr ""
 
-#: src/scm/webid-oidc/client/client.scm:87
+#: src/scm/webid-oidc/client/client.scm:106
 msgid ""
 "Client ID and redirect URIs should be URIs, and key pair should be a key "
 "pair.."
diff --git a/po/fr.po b/po/fr.po
index 7422bb2..71788d1 100644
--- a/po/fr.po
+++ b/po/fr.po
@@ -2,7 +2,7 @@ msgid ""
 msgstr ""
 "Project-Id-Version: webid-oidc 0.0.0\n"
 "Report-Msgid-Bugs-To: vivien@planete-kraus.eu\n"
-"POT-Creation-Date: 2021-09-15 12:40+0200\n"
+"POT-Creation-Date: 2021-09-15 12:41+0200\n"
 "PO-Revision-Date: 2021-09-15 12:41+0200\n"
 "Last-Translator: Vivien Kraus <vivien@planete-kraus.eu>\n"
 "Language-Team: French <vivien@planete-kraus.eu>\n"
@@ -497,83 +497,83 @@ msgstr "impossible de télécharger le manifeste client ~s"
 msgid "the client manifest is dereferenced from ~s, but it pretends to be ~s"
 msgstr "le manifeste client est déréférencé depuis ~s, mais il prétend être ~s"
 
-#: src/scm/webid-oidc/client/accounts.scm:254
+#: src/scm/webid-oidc/client/accounts.scm:289
 msgid "The refresh token has expired."
 msgstr "le jeton de rafraîchissement a expiré."
 
-#: src/scm/webid-oidc/client/accounts.scm:261
+#: src/scm/webid-oidc/client/accounts.scm:296
 #, scheme-format
 msgid "The token request failed with code ~s (~s)."
 msgstr "La requête de jeton a échoué avec un code ~s (~s)."
 
-#: src/scm/webid-oidc/client/accounts.scm:270
+#: src/scm/webid-oidc/client/accounts.scm:305
 msgid "The token response did not set the content type."
 msgstr "Le jeton de réponse n’a pas défini de type de contenu."
 
-#: src/scm/webid-oidc/client/accounts.scm:278
+#: src/scm/webid-oidc/client/accounts.scm:313
 msgid "The token endpoint did not respond in UTF-8."
 msgstr "Le terminal de jetonn n’a pas répondu en UTF-8."
 
-#: src/scm/webid-oidc/client/accounts.scm:290
+#: src/scm/webid-oidc/client/accounts.scm:325
 #, scheme-format
 msgid "The token response has content-type ~s, not application/json."
 msgstr "La réponse de jeton a un type de contenu ~s, pas application/json."
 
-#: src/scm/webid-oidc/client/accounts.scm:300
+#: src/scm/webid-oidc/client/accounts.scm:335
 msgid "The token response is not valid JSON."
 msgstr "La réponse de jeton n’est pas un JSON valide."
 
-#: src/scm/webid-oidc/client/accounts.scm:314
+#: src/scm/webid-oidc/client/accounts.scm:349
 #, scheme-format
 msgid "The token response did not include an ID token: ~s"
 msgstr "La réponse de jeton n’a pas inclus de jeton d’ID : ~s"
 
-#: src/scm/webid-oidc/client/accounts.scm:322
+#: src/scm/webid-oidc/client/accounts.scm:357
 #, scheme-format
 msgid "The token response did not include an access token: ~s\n"
 msgstr "La réponse de jeton n’a pas inclus de jeton d’accès : ~s\n"
 
-#: src/scm/webid-oidc/client/accounts.scm:333
+#: src/scm/webid-oidc/client/accounts.scm:368
 #, scheme-format
 msgid "the ID token signature is invalid: ~a"
 msgstr "la signature du jeton d’ID est invalide : ~a"
 
-#: src/scm/webid-oidc/client/accounts.scm:335
+#: src/scm/webid-oidc/client/accounts.scm:370
 msgid "the ID token signature is invalid"
 msgstr "la signature du jeton d’ID est invalide"
 
-#: src/scm/webid-oidc/client/accounts.scm:353
+#: src/scm/webid-oidc/client/accounts.scm:388
 #, scheme-format
 msgid "the ID token delivered by the identity provider for ~s has ~s as webid"
 msgstr ""
 "le jeton d’ID délivré par le fournisseur d’identité pour ~s a ~s pour webid"
 
-#: src/scm/webid-oidc/client/accounts.scm:363
+#: src/scm/webid-oidc/client/accounts.scm:398
 #, scheme-format
 msgid "The ID token delivered by the identity provider ~s is for issuer ~s."
 msgstr ""
 "Le jeton d’ID délivré par le fournisseur d’identité ~s est pour l’émetteur "
 "~s."
 
-#: src/scm/webid-oidc/client/accounts.scm:378
+#: src/scm/webid-oidc/client/accounts.scm:413
 msgid "The issuer is required."
 msgstr "L’émetteur est requis."
 
-#: src/scm/webid-oidc/client/accounts.scm:383
+#: src/scm/webid-oidc/client/accounts.scm:418
 msgid "The optional subject and required issuer should be strings or URI."
 msgstr ""
 "Le sujet optionnel et émetteur doivent être des chaînes de caractère ou des "
 "URIs."
 
-#: src/scm/webid-oidc/client/accounts.scm:398
+#: src/scm/webid-oidc/client/accounts.scm:454
 msgid "Cannot check the username and/or password."
 msgstr "Impossible de vérifier le nom d’utilisateur et/ou le mot de passe."
 
-#: src/scm/webid-oidc/client/accounts.scm:408
+#: src/scm/webid-oidc/client/accounts.scm:464
 msgid "The subject should be a string or URI."
 msgstr "Le sujet doit être une chaîne de caractères ou une URI."
 
-#: src/scm/webid-oidc/client/accounts.scm:422
+#: src/scm/webid-oidc/client/accounts.scm:478
 msgid "The issuer should be a string or URI."
 msgstr "L’émetteur doit être une chaîne de caractères ou une URI."
 
@@ -581,14 +581,16 @@ msgstr "L’émetteur doit être une chaîne de caractères ou une URI."
 #, scheme-format
 msgid ""
 "You already have an account for ~a issued by ~a and it is currently selected."
-msgstr "Vous avez déjà un compte pour ~a émis par ~a et il est actuellement sélectionné."
+msgstr ""
+"Vous avez déjà un compte pour ~a émis par ~a et il est actuellement "
+"sélectionné."
 
 #: src/scm/webid-oidc/client/application.scm:286
 #, scheme-format
 msgid "You already have an account for ~a issued by ~a."
 msgstr "Vous avez déjà un compte pour ~a émis par ~a."
 
-#: src/scm/webid-oidc/client/client.scm:87
+#: src/scm/webid-oidc/client/client.scm:106
 msgid ""
 "Client ID and redirect URIs should be URIs, and key pair should be a key "
 "pair.."
diff --git a/src/scm/webid-oidc/client.scm b/src/scm/webid-oidc/client.scm
index d340e41..52a33a4 100644
--- a/src/scm/webid-oidc/client.scm
+++ b/src/scm/webid-oidc/client.scm
@@ -56,6 +56,8 @@
    (account:authorization-process . authorization-process)
    (account:authorization-state . authorization-state)
    (account:anonymous-http-request . anonymous-http-request)
+
+   (client:->sexp . ->sexp)
    )
   #:export
   (
diff --git a/src/scm/webid-oidc/client/accounts.scm b/src/scm/webid-oidc/client/accounts.scm
index f978257..626cc6a 100644
--- a/src/scm/webid-oidc/client/accounts.scm
+++ b/src/scm/webid-oidc/client/accounts.scm
@@ -22,6 +22,7 @@
   #:use-module (ice-9 i18n)
   #:use-module (ice-9 receive)
   #:use-module (ice-9 optargs)
+  #:use-module (ice-9 pretty-print)
   #:use-module (srfi srfi-9)
   #:use-module (srfi srfi-19)
   #:use-module (webid-oidc errors)
@@ -79,6 +80,8 @@
    invalidate-access-token
    invalidate-refresh-token
    refresh
+
+   ->sexp
    )
   #:declarative? #t)
 
@@ -154,6 +157,38 @@
        (equal? (refresh-token a) (refresh-token b))
        (equal? (key-pair a) (key-pair b))))
 
+(define-method (->sexp (account <account>))
+  `(begin
+     (use-modules (oop goops) (webid-oidc client accounts))
+     (make <account>
+       #:subject ,(uri->string (subject account))
+       #:issuer ,(uri->string (issuer account))
+       ,@(let ((id-token (id-token account)))
+           (if id-token
+               `(#:id-token (quote ,id-token))
+               '()))
+       ,@(let ((access-token (access-token account)))
+           (if access-token
+               `(#:access-token ,access-token)
+               '()))
+       ,@(let ((refresh-token (refresh-token account)))
+           (if refresh-token
+               `(#:refresh-token ,refresh-token)
+               '()))
+       #:key-pair (quote ,(key-pair account)))))
+
+(define-method (write (account <account>) port)
+  (let ((code (->sexp account)))
+    (pretty-print code port)))
+
+(define-method (display (account <account>) port)
+  (format port "#<<account> subject=~a issuer=~a id-token?=~a access-token?=~a refresh-token?=~a>"
+          (uri->string (subject account))
+          (uri->string (issuer account))
+          (and (id-token account) #t)
+          (and (access-token account) #t)
+          (and (refresh-token account) #t)))
+
 (define-exception-type
   &login-failed
   &external-error
@@ -388,6 +423,27 @@
   (username #:init-keyword #:username #:getter username)
   (encrypted-password #:init-keyword #:encrypted-password #:getter encrypted-password))
 
+(define-method (->sexp (account <protected-account>))
+  (match (next-method)
+    (('begin
+       '(use-modules (oop goops) (webid-oidc client accounts))
+       ('make '<account> initializers ...))
+     `(begin
+        (use-modules (oop goops) (webid-oidc client accounts))
+        (make <protected-account>
+          #:username ,(username account)
+          #:encrypted-password ,(encrypted-password account)
+          ,@initializers)))))
+
+(define-method (display (account <protected-account>) port)
+  (format port "#<<protected-account> subject=~a issuer=~a username=~a id-token?=~a access-token?=~a refresh-token?=~a>"
+          (uri->string (subject account))
+          (uri->string (issuer account))
+          (username account)
+          (and (id-token account) #t)
+          (and (access-token account) #t)
+          (and (refresh-token account) #t)))
+
 (define-method (check-credentials (account <protected-account>) (username <string>) (password <string>))
   (let ((c (crypt password (encrypted-password account))))
     (unless (string=? c (encrypted-password account))
diff --git a/src/scm/webid-oidc/client/client.scm b/src/scm/webid-oidc/client/client.scm
index 66f8b74..1bf1c7c 100644
--- a/src/scm/webid-oidc/client/client.scm
+++ b/src/scm/webid-oidc/client/client.scm
@@ -34,6 +34,7 @@
   #:use-module (web http)
   #:use-module (ice-9 optargs)
   #:use-module (ice-9 receive)
+  #:use-module (ice-9 pretty-print)
   #:use-module (srfi srfi-9)
   #:use-module (srfi srfi-19)
   #:use-module (srfi srfi-26)
@@ -52,6 +53,8 @@
    client-redirect-uri
 
    client
+
+   ->sexp
    )
   #:declarative? #t)
 
@@ -60,6 +63,22 @@
   (key-pair #:init-keyword #:key-pair #:getter client-key-pair)
   (redirect-uri #:init-keyword #:redirect-uri #:getter client-redirect-uri))
 
+(define-method (->sexp (client <client>))
+  `(begin
+     (use-modules (oop goops) (webid-oidc client))
+     (make <client>
+       #:client-id ,(uri->string (client-id client))
+       #:key-pair (quote ,(client-key-pair client))
+       #:redirect-uri ,(uri->string (client-redirect-uri client)))))
+
+(define-method (write (client <client>) port)
+  (pretty-print (->sexp client) port))
+
+(define-method (display (client <client>) port)
+  (format port "#<<client> client-id=~a redirect-uri=~a>"
+          (uri->string (client-id client))
+          (uri->string (client-redirect-uri client))))
+
 (define-method (initialize (client <client>) initargs)
   (next-method)
   (let-keywords