Define an XML-loadable meta-class

1 files changed, 8 insertions, 62 deletions

diff --git a/src/scm/webid-oidc/client/accounts.scm b/src/scm/webid-oidc/client/accounts.scm
index 31d105d..9546263 100644
--- a/src/scm/webid-oidc/client/accounts.scm
+++ b/src/scm/webid-oidc/client/accounts.scm
@@ -28,6 +28,7 @@
   #:use-module (webid-oidc errors)
   #:use-module (webid-oidc web-i18n)
   #:use-module (webid-oidc jws)
+  #:use-module (webid-oidc serializable)
   #:use-module ((webid-oidc parameters) #:prefix p:)
   #:use-module ((webid-oidc stubs) #:prefix stubs:)
   #:use-module ((webid-oidc oidc-id-token) #:prefix id:)
@@ -80,8 +81,6 @@
    invalidate-access-token
    invalidate-refresh-token
    refresh
-
-   ->sexp
    )
   #:declarative? #t)
 
@@ -128,12 +127,14 @@
   (make-parameter #f))
 
 (define-class <account> ()
-  (subject #:init-keyword #:subject #:getter subject)
-  (issuer #:init-keyword #:issuer #:getter issuer)
+  (subject #:init-keyword #:subject #:getter subject #:->sxml uri->string)
+  (issuer #:init-keyword #:issuer #:getter issuer #:->sxml uri->string)
   (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))
+  (key-pair #:init-keyword #:key-pair #:getter key-pair)
+  #:metaclass <plugin-class>
+  #:module-name '(webid-oidc client accounts))
 
 (define-method (equal? (a <account>) (b <account>))
   (and (equal? (subject a) (subject b))
@@ -143,41 +144,6 @@
        (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) (webid-oidc jwk) (webid-oidc jws) (webid-oidc oidc-id-token))
-     (make <account>
-       #:subject ,(uri->string (subject account))
-       #:issuer ,(uri->string (issuer account))
-       ,@(let ((id-token (id-token account)))
-           (if id-token
-               (receive (header payload) (token->jwk id-token)
-                 `(#:id-token (make <id-token>
-                                #:jws-header (quote ,header)
-                                #:jws-payload (quote ,payload))))
-               '()))
-       ,@(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 (jwk->key (quote ,(key->jwk (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
@@ -403,28 +369,8 @@
 
 (define-class <protected-account> (<account>)
   (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)))
+  (encrypted-password #:init-keyword #:encrypted-password #:getter encrypted-password)
+  #:module-name '(webid-oidc client accounts))
 
 (define-method (check-credentials (account <protected-account>) (username <string>) (password <string>))
   (let ((c (crypt password (encrypted-password account))))