From f468808646a7bb8733f2f912c13c6bd166277193 Mon Sep 17 00:00:00 2001
From: Vivien Kraus <vivien@planete-kraus.eu>
Date: Thu, 11 Nov 2021 16:08:51 +0000
Subject: Client API: also bind the account class.

---
 src/scm/webid-oidc/client/reverse-stubs.scm | 56 +++++++++++++++++++++++++++++
 1 file changed, 56 insertions(+)

(limited to 'src/scm/webid-oidc/client/reverse-stubs.scm')

diff --git a/src/scm/webid-oidc/client/reverse-stubs.scm b/src/scm/webid-oidc/client/reverse-stubs.scm
index faecf83..a87eb68 100644
--- a/src/scm/webid-oidc/client/reverse-stubs.scm
+++ b/src/scm/webid-oidc/client/reverse-stubs.scm
@@ -19,6 +19,7 @@
   #:use-module (webid-oidc client accounts)
   #:use-module (webid-oidc client application)
   #:use-module (webid-oidc jwk)
+  #:use-module (webid-oidc oidc-id-token)
   #:use-module ((webid-oidc stubs) #:prefix stubs:)
   #:duplicates (merge-generics)
   #:declarative? #t
@@ -28,6 +29,15 @@
    get-client-id
    get-client-jwk
    get-client-redirect-uri
+
+   make-account-full
+   get-account-subject
+   get-account-issuer
+   get-account-key-pair
+   get-account-id-token-header
+   get-account-id-token
+   get-account-access-token
+   get-account-refresh-token
    ))
 
 (define (make-client client-id jwk redirect-uri)
@@ -48,3 +58,49 @@
 
 (define (get-redirect-uri client)
   (uri->string (redirect-uri client)))
+
+(define (make-account-full subject issuer key-pair id-token-header id-token access-token refresh-token)
+  (make <account>
+    #:subject (string->uri subject)
+    #:issuer (string->uri issuer)
+    #:key-pair (jwk->key (stubs:json-string->scm key-pair))
+    #:id-token
+    (and id-token-header id-token
+         (make <id-token>
+           #:jwt-header (stubs:json-string->scm id-token-header)
+           #:jwt-payload (stubs:json-string->scm id-token)))
+    #:access-token access-token
+    #:refresh-token refresh-token))
+
+(define (get-account-subject account)
+  (uri->string (subject account)))
+
+(define (get-account-issuer account)
+  (uri->string (issuer account)))
+
+(define (get-account-key-pair account)
+  (stubs:scm->json-string (key->jwk (key-pair account))))
+
+(define (get-account-id-token-header account)
+  (receive (id-token-header id-token)
+      (let ((id (id-token account)))
+        (if id
+            (token->jwt id)
+            (values #f #f)))
+    (and id-token-header
+         (stubs:scm->json-string id-token-header))))
+
+(define (get-account-id-token account)
+  (receive (id-token-header id-token)
+      (let ((id (id-token account)))
+        (if id
+            (token->jwt id)
+            (values #f #f)))
+    (and id-token
+         (stubs:scm->json-string id-token))))
+
+(define (get-account-access-token account)
+  (access-token account))
+
+(define (get-account-refresh-token account)
+  (refresh-token account))
-- 
cgit v1.2.3