diff options
author | Vivien Kraus <vivien@planete-kraus.eu> | 2021-09-15 11:24:11 +0200 |
---|---|---|
committer | Vivien Kraus <vivien@planete-kraus.eu> | 2021-09-15 12:41:49 +0200 |
commit | 244f18a9ebc1d5ed09248f9a2ce25fcdd10da484 (patch) | |
tree | f30d88336ba727519db239626d13a70b00dd9fd4 /src | |
parent | a050fc5ee9c795742fc6bd0830dc657721628eb8 (diff) |
Client API: add a pretty printer
Diffstat (limited to 'src')
-rw-r--r-- | src/scm/webid-oidc/client.scm | 2 | ||||
-rw-r--r-- | src/scm/webid-oidc/client/accounts.scm | 56 | ||||
-rw-r--r-- | src/scm/webid-oidc/client/client.scm | 19 |
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 |