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
 
    &not-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))