diff options
| author | Vivien Kraus <vivien@planete-kraus.eu> | 2021-09-17 22:21:05 +0200 |
|---|---|---|
| committer | Vivien Kraus <vivien@planete-kraus.eu> | 2021-09-21 22:25:03 +0200 |
| commit | 76c90440b7a65d1ec43685a3b6c25facd11030b1 (patch) | |
| tree | 8c28d31d700cdbe9ec32a8d65b12489ffd9a5203 /src | |
| parent | 55195e4659339f56036c2f98d06cfd59a0141514 (diff) | |
JWK: serialize and deserialize to and from SXML
Diffstat (limited to 'src')
| -rw-r--r-- | src/scm/webid-oidc/jwk.scm | 43 |
1 files changed, 43 insertions, 0 deletions
diff --git a/src/scm/webid-oidc/jwk.scm b/src/scm/webid-oidc/jwk.scm index f06818d..f1078aa 100644 --- a/src/scm/webid-oidc/jwk.scm +++ b/src/scm/webid-oidc/jwk.scm @@ -28,6 +28,7 @@ #:use-module (web client) #:use-module (rnrs bytevectors) #:use-module (oop goops) + #:use-module (sxml match) #:declarative? #t #:export ( @@ -50,6 +51,8 @@ generate-key serve get-jwks + ->sxml + sxml->key ¬-a-jwk make-not-a-jwk @@ -432,6 +435,46 @@ (define (generate-key . args) (jwk->key (apply stubs:generate-key args))) +(define (key->sxml key) + `(jwk + (@ (xmlns "https://disfluid.planete-kraus.eu/Public_002dkey-cryptography.html#Public_002dkey-cryptography") + ,@(map (match-lambda ((key . value) `(,key ,value))) (key->jwk key))))) + +(define-method (->sxml (key <key-pair>)) + (key->sxml key)) + +(define-method (->sxml (key <private-key>)) + (key->sxml key)) + +(define-method (->sxml (key <public-key>)) + (key->sxml key)) + +(define (sxml->key sxml) + (define (attributes->key attributes) + (jwk->key + (map (match-lambda ((key value) `(,key . ,value))) attributes))) + (let analyze ((tree sxml)) + (sxml-match + tree + ((*TOP* + (*PI* . ,pi) + . ,rest) + (analyze `(*TOP* . ,rest))) + ((*TOP* + (jwk (@ (xmlns "https://disfluid.planete-kraus.eu/Public_002dkey-cryptography.html#Public_002dkey-cryptography:jwk") . ,attributes))) + (analyze `(*TOP* (https://disfluid.planete-kraus.eu/Public_002dkey-cryptography.html#Public_002dkey-cryptography:jwk (@ . ,attributes))))) + ((*TOP* + (https://disfluid.planete-kraus.eu/Public_002dkey-cryptography.html#Public_002dkey-cryptography:jwk (@ . ,attributes))) + (attributes->key attributes)) + ((jwk . ,rest) + (analyze + `(*TOP* + (jwk . ,rest)))) + ((https://disfluid.planete-kraus.eu/Public_002dkey-cryptography.html#Public_002dkey-cryptography:jwk . ,rest) + (analyze + `(*TOP* + (https://disfluid.planete-kraus.eu/Public_002dkey-cryptography.html#Public_002dkey-cryptography:jwk . ,rest))))))) + (define-class <jwks> () (keys #:init-keyword #:keys #:accessor keys)) |