diff options
author | Vivien Kraus <vivien@planete-kraus.eu> | 2021-09-21 15:27:56 +0200 |
---|---|---|
committer | Vivien Kraus <vivien@planete-kraus.eu> | 2021-09-21 22:31:14 +0200 |
commit | 3be4b418a4ec1e94d28401810ff8629ddc86adf9 (patch) | |
tree | 9dd3e895e87ff9ad1c875e98dcb796995315f92f /src/scm/webid-oidc | |
parent | e910b3ba2ded990a5193f7ea0cfad525332e4171 (diff) |
Serialize and deserialize tokens to and from SXML
Diffstat (limited to 'src/scm/webid-oidc')
-rw-r--r-- | src/scm/webid-oidc/jws.scm | 36 |
1 files changed, 36 insertions, 0 deletions
diff --git a/src/scm/webid-oidc/jws.scm b/src/scm/webid-oidc/jws.scm index af83c90..22dabdd 100644 --- a/src/scm/webid-oidc/jws.scm +++ b/src/scm/webid-oidc/jws.scm @@ -29,6 +29,7 @@ #:use-module (ice-9 match) #:use-module (ice-9 optargs) #:use-module (web uri) + #:use-module (sxml match) #:use-module (oop goops) #:declarative? #t #:re-export @@ -83,6 +84,9 @@ encode issue + ->sxml + sxml->token + )) (define-exception-type @@ -600,3 +604,35 @@ (define* (issue token-class issuer-key . args) (encode (apply make token-class #:signing-key issuer-key args) issuer-key)) + +(define-method (->sxml (token <token>)) + (receive (header payload) (token->jwt token) + `(token + (@ (xmlns "https://disfluid.planete-kraus.eu/Tokens.html#Tokens") + (header ,(stubs:scm->json-string header)) + (payload ,(stubs:scm->json-string payload)))))) + +(define (sxml->token token-class fragment) + (let analyze ((tree fragment)) + (sxml-match + tree + ((*TOP* + (token (@ (xmlns "https://disfluid.planete-kraus.eu/Tokens.html#Tokens") + (header ,header) + (payload ,payload))) + . ,rest) + (analyze `(*TOP* + (https://disfluid.planete-kraus.eu/Tokens.html#Tokens:token + (@ (header ,header) + (payload ,payload)))))) + ((*TOP* + (https://disfluid.planete-kraus.eu/Tokens.html#Tokens:token + (@ (header ,header) + (payload ,payload)))) + (make token-class #:jwk-header header #:jwk-payload payload)) + ((*TOP* ,whatever . ,rest) + (analyze `(*TOP* ,@rest))) + ((*TOP*) + (fail (G_ "cannot parse a token"))) + (,_ + (analyze `(*TOP* ,tree)))))) |