summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--po/disfluid.pot31
-rw-r--r--po/fr.po33
-rw-r--r--src/scm/webid-oidc/jwk.scm39
3 files changed, 72 insertions, 31 deletions
diff --git a/po/disfluid.pot b/po/disfluid.pot
index d9126b9..e933d84 100644
--- a/po/disfluid.pot
+++ b/po/disfluid.pot
@@ -8,7 +8,7 @@ msgid ""
msgstr ""
"Project-Id-Version: disfluid SNAPSHOT\n"
"Report-Msgid-Bugs-To: vivien@planete-kraus.eu\n"
-"POT-Creation-Date: 2021-09-17 14:13+0200\n"
+"POT-Creation-Date: 2021-09-17 18:38+0200\n"
"PO-Revision-Date: YEAR-MO-DA HO:MI+ZONE\n"
"Last-Translator: FULL NAME <EMAIL@ADDRESS>\n"
"Language-Team: LANGUAGE <LL@li.org>\n"
@@ -1040,54 +1040,59 @@ msgstr ""
msgid "a replay has been detected with JTI ~s"
msgstr ""
-#: src/scm/webid-oidc/jwk.scm:141
+#: src/scm/webid-oidc/jwk.scm:143
msgid "the point and scalar are not on the same curve"
msgstr ""
-#: src/scm/webid-oidc/jwk.scm:236
+#: src/scm/webid-oidc/jwk.scm:238
#, scheme-format
msgid "the JWK is invalid: ~a"
msgstr ""
-#: src/scm/webid-oidc/jwk.scm:238
+#: src/scm/webid-oidc/jwk.scm:240
msgid "the JWK is invalid"
msgstr ""
-#: src/scm/webid-oidc/jwk.scm:247
+#: src/scm/webid-oidc/jwk.scm:249
msgid "cannot compute the key type"
msgstr ""
-#: src/scm/webid-oidc/jwk.scm:284
+#: src/scm/webid-oidc/jwk.scm:308
msgid "it is built as an RSA key or key pair, but it is not"
msgstr ""
-#: src/scm/webid-oidc/jwk.scm:292
+#: src/scm/webid-oidc/jwk.scm:316
msgid "it is built as an elliptic curve key or key pair, but it is not"
msgstr ""
-#: src/scm/webid-oidc/jwk.scm:365
+#: src/scm/webid-oidc/jwk.scm:357
+#, scheme-format
+msgid "the key advertises a key type of ~s, but actually it is ~s"
+msgstr ""
+
+#: src/scm/webid-oidc/jwk.scm:396
msgid "this is neither a RSA key nor an elliptic curve key"
msgstr ""
-#: src/scm/webid-oidc/jwk.scm:402
+#: src/scm/webid-oidc/jwk.scm:433
#, scheme-format
msgid "cannot fetch a JWKS: ~a"
msgstr ""
-#: src/scm/webid-oidc/jwk.scm:404
+#: src/scm/webid-oidc/jwk.scm:435
msgid "cannot fetch a JWKS"
msgstr ""
-#: src/scm/webid-oidc/jwk.scm:408
+#: src/scm/webid-oidc/jwk.scm:439
#, scheme-format
msgid "the request failed with ~s ~s"
msgstr ""
-#: src/scm/webid-oidc/jwk.scm:413
+#: src/scm/webid-oidc/jwk.scm:444
msgid "missing content-type"
msgstr ""
-#: src/scm/webid-oidc/jwk.scm:418
+#: src/scm/webid-oidc/jwk.scm:449
#, scheme-format
msgid "invalid content-type: ~s"
msgstr ""
diff --git a/po/fr.po b/po/fr.po
index 42ef469..0b7b882 100644
--- a/po/fr.po
+++ b/po/fr.po
@@ -2,8 +2,8 @@ msgid ""
msgstr ""
"Project-Id-Version: webid-oidc 0.0.0\n"
"Report-Msgid-Bugs-To: vivien@planete-kraus.eu\n"
-"POT-Creation-Date: 2021-09-17 14:13+0200\n"
-"PO-Revision-Date: 2021-09-17 14:15+0200\n"
+"POT-Creation-Date: 2021-09-17 18:38+0200\n"
+"PO-Revision-Date: 2021-09-17 18:38+0200\n"
"Last-Translator: Vivien Kraus <vivien@planete-kraus.eu>\n"
"Language-Team: French <vivien@planete-kraus.eu>\n"
"Language: fr\n"
@@ -1123,58 +1123,63 @@ msgstr "Non Trouvé"
msgid "a replay has been detected with JTI ~s"
msgstr "une redite a été détectée avec le JTI ~s"
-#: src/scm/webid-oidc/jwk.scm:141
+#: src/scm/webid-oidc/jwk.scm:143
msgid "the point and scalar are not on the same curve"
msgstr "le point et le scalaire ne sont pas sur la même courbe elliptique"
-#: src/scm/webid-oidc/jwk.scm:236
+#: src/scm/webid-oidc/jwk.scm:238
#, scheme-format
msgid "the JWK is invalid: ~a"
msgstr "le JWK est invalide : ~a"
-#: src/scm/webid-oidc/jwk.scm:238
+#: src/scm/webid-oidc/jwk.scm:240
msgid "the JWK is invalid"
msgstr "le JWK est invalide"
-#: src/scm/webid-oidc/jwk.scm:247
+#: src/scm/webid-oidc/jwk.scm:249
msgid "cannot compute the key type"
msgstr "impossible de calculer le type de clé"
-#: src/scm/webid-oidc/jwk.scm:284
+#: src/scm/webid-oidc/jwk.scm:308
msgid "it is built as an RSA key or key pair, but it is not"
msgstr ""
"elle est construite comme une clé ou paire de clés RSA, mais ce n’en est pas "
"une"
-#: src/scm/webid-oidc/jwk.scm:292
+#: src/scm/webid-oidc/jwk.scm:316
msgid "it is built as an elliptic curve key or key pair, but it is not"
msgstr ""
"elle est construite comme une clé ou paire de clés sur une courbe "
"elliptique, mais ce n’en est pas une"
-#: src/scm/webid-oidc/jwk.scm:365
+#: src/scm/webid-oidc/jwk.scm:357
+#, scheme-format
+msgid "the key advertises a key type of ~s, but actually it is ~s"
+msgstr "la clé publie un type de clé ~s, mais c’est en fait ~s"
+
+#: src/scm/webid-oidc/jwk.scm:396
msgid "this is neither a RSA key nor an elliptic curve key"
msgstr "ce n’est ni une clé RSA ni une clé sur une courbe elliptique"
-#: src/scm/webid-oidc/jwk.scm:402
+#: src/scm/webid-oidc/jwk.scm:433
#, scheme-format
msgid "cannot fetch a JWKS: ~a"
msgstr "impossible de télécharger un JWKS : ~a"
-#: src/scm/webid-oidc/jwk.scm:404
+#: src/scm/webid-oidc/jwk.scm:435
msgid "cannot fetch a JWKS"
msgstr "impossible de télécharger un JWKS"
-#: src/scm/webid-oidc/jwk.scm:408
+#: src/scm/webid-oidc/jwk.scm:439
#, scheme-format
msgid "the request failed with ~s ~s"
msgstr "la requête a échoué avec ~s ~s"
-#: src/scm/webid-oidc/jwk.scm:413
+#: src/scm/webid-oidc/jwk.scm:444
msgid "missing content-type"
msgstr "type de contenu manquant"
-#: src/scm/webid-oidc/jwk.scm:418
+#: src/scm/webid-oidc/jwk.scm:449
#, scheme-format
msgid "invalid content-type: ~s"
msgstr "type de contenu invalide : ~s"
diff --git a/src/scm/webid-oidc/jwk.scm b/src/scm/webid-oidc/jwk.scm
index 7675d04..e0308cb 100644
--- a/src/scm/webid-oidc/jwk.scm
+++ b/src/scm/webid-oidc/jwk.scm
@@ -21,6 +21,8 @@
#:use-module (ice-9 receive)
#:use-module (ice-9 optargs)
#:use-module (ice-9 exceptions)
+ #:use-module (ice-9 hash-table)
+ #:use-module (ice-9 match)
#:use-module (srfi srfi-19)
#:use-module (web response)
#:use-module (web client)
@@ -248,11 +250,30 @@
kty))))
(define-method (key->jwk (key <key-pair>))
- (append (key->jwk (public-key key))
- (key->jwk (private-key key))))
+ ;; kty and crv fields are present in both the public and private
+ ;; key, but they must not be duplicated, and we want to keep all
+ ;; fields in order.
+ (let ((with-duplicates
+ (append (key->jwk (public-key key))
+ (key->jwk (private-key key)))))
+ (let ((lookup
+ (alist->hash-table with-duplicates)))
+ (let keep-unique-in-order ((order (map car with-duplicates))
+ (constructed '()))
+ (match order
+ (()
+ (reverse constructed))
+ ((hd tl ...)
+ (let ((found (hash-ref lookup hd)))
+ (when found
+ (hash-remove! lookup hd))
+ (if found
+ (keep-unique-in-order tl `((,hd . ,found) ,@constructed))
+ (keep-unique-in-order tl constructed)))))))))
(define-method (key->jwk (key <rsa-private-key>))
- `((d . ,(rsa-d key))
+ `((kty . ,(symbol->string (kty key)))
+ (d . ,(rsa-d key))
(p . ,(rsa-p key))
(q . ,(rsa-q key))
(dp . ,(rsa-dp key))
@@ -260,16 +281,19 @@
(qi . ,(rsa-qi key))))
(define-method (key->jwk (key <rsa-public-key>))
- `((n . ,(rsa-n key))
+ `((kty . ,(symbol->string (kty key)))
+ (n . ,(rsa-n key))
(e . ,(rsa-e key))))
(define-method (key->jwk (key <ec-point>))
`((crv . ,(symbol->string (ec-crv key)))
+ (kty . ,(symbol->string (kty key)))
(x . ,(ec-x key))
(y . ,(ec-y key))))
(define-method (key->jwk (key <ec-scalar>))
`((crv . ,(symbol->string (ec-crv key)))
+ (kty . ,(symbol->string (kty key)))
(z . ,(ec-z key))))
(define-method (check-key key)
@@ -325,6 +349,13 @@
(define (jwk->key fields)
(let ((kty (stubs:kty fields)))
+ (let ((explicit-kty (assq-ref fields 'kty)))
+ (when (and kty explicit-kty (not (eq? kty (string->symbol explicit-kty))))
+ (raise-exception
+ (make-exception
+ (make-not-a-jwk)
+ (make-exception-with-message (format #f (G_ "the key advertises a key type of ~s, but actually it is ~s")
+ explicit-kty kty))))))
(case kty
((RSA)
(let ((d (assq-ref fields 'd))
generated by cgit v1.2.3 (git 2.44.0) at 2024-07-01 02:14:56 +0000