Client API: add a pretty printer

3 files changed, 77 insertions, 0 deletions

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