summaryrefslogtreecommitdiff
path: root/src/scm/webid-oidc/client/reverse-stubs.scm
diff options
context:
space:
mode:
Diffstat (limited to 'src/scm/webid-oidc/client/reverse-stubs.scm')
-rw-r--r--src/scm/webid-oidc/client/reverse-stubs.scm56
1 files changed, 56 insertions, 0 deletions
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))