diff options
-rw-r--r-- | doc/webid-oidc.texi | 12 | ||||
-rw-r--r-- | po/fr.po | 88 | ||||
-rw-r--r-- | po/webid-oidc.pot | 64 | ||||
-rw-r--r-- | src/scm/webid-oidc/Makefile.am | 6 | ||||
-rw-r--r-- | src/scm/webid-oidc/errors.scm | 51 | ||||
-rw-r--r-- | src/scm/webid-oidc/jwk.scm | 112 |
6 files changed, 273 insertions, 60 deletions
diff --git a/doc/webid-oidc.texi b/doc/webid-oidc.texi index c7bfa5b..46ca253 100644 --- a/doc/webid-oidc.texi +++ b/doc/webid-oidc.texi @@ -151,6 +151,18 @@ The identifier @var{crv} does not identify an elliptic curve. @var{value} does not identify a JWK. @end deftp +@deftp {exception type} ¬-a-public-jwk @var{value} @var{cause} +@var{value} does not identify a public JWK. +@end deftp + +@deftp {exception type} ¬-a-private-jwk @var{value} @var{cause} +@var{value} does not identify a private JWK. +@end deftp + +@deftp {exception type} ¬-a-jwks @var{value} @var{cause} +@var{value} does not identify a set of public keys. +@end deftp + @deftp {exception type} &unsupported-alg @var{value} @var{value} does not identify a valid hash algorithm. @end deftp @@ -126,82 +126,112 @@ msgstr "Utilisation : generate-random [NOMBRE D'OCTETS]\n" msgid "Usage: generate-key [NUMBER OF BITS | CURVE]\n" msgstr "Utilisation : generate-key [NOMBRE DE BITS | COURBE]\n" -#: src/scm/webid-oidc/errors.scm:75 +#: src/scm/webid-oidc/errors.scm:105 msgid "that’s how it is" msgstr "c’est comme ça" -#: src/scm/webid-oidc/errors.scm:80 +#: src/scm/webid-oidc/errors.scm:110 #, scheme-format msgid "the value ~s is not a base64 string (because ~a)" msgstr "la valeur ~s n’est pas une chaîne base64 (parce que ~a)" -#: src/scm/webid-oidc/errors.scm:83 +#: src/scm/webid-oidc/errors.scm:113 #, scheme-format msgid "the value ~s is not JSON (because ~a)" msgstr "la valeur ~s n’est pas du JSON (parce que ~a)" -#: src/scm/webid-oidc/errors.scm:86 +#: src/scm/webid-oidc/errors.scm:116 #, scheme-format msgid "the value ~s does not identify an elleptic curve" msgstr "la valeur ~s n’identifie pas une courbe elliptique" -#: src/scm/webid-oidc/errors.scm:91 +#: src/scm/webid-oidc/errors.scm:121 #, scheme-format msgid "the value ~s does not identify a JWK (because ~a)" msgstr "la valeur ~s n’identifie pas une JWK (parce que ~a)" -#: src/scm/webid-oidc/errors.scm:93 +#: src/scm/webid-oidc/errors.scm:123 #, scheme-format msgid "the value ~s does not identify a JWK" msgstr "la valeur ~s n’identifie pas une JWK" -#: src/scm/webid-oidc/errors.scm:96 +#: src/scm/webid-oidc/errors.scm:128 +#, scheme-format +msgid "the value ~s does not identify a public JWK (because ~a)" +msgstr "la valeur ~s n’identifie pas une JWK publique (parce que ~a)" + +#: src/scm/webid-oidc/errors.scm:130 +#, scheme-format +msgid "the value ~s does not identify a public JWK" +msgstr "la valeur ~s n’identifie pas une JWK publique" + +#: src/scm/webid-oidc/errors.scm:135 +#, scheme-format +msgid "the value ~s does not identify a private JWK (because ~a)" +msgstr "la valeur ~s n’identifie pas une JWK privée (parce que ~a)" + +#: src/scm/webid-oidc/errors.scm:137 +#, scheme-format +msgid "the value ~s does not identify a private JWK" +msgstr "la valeur ~s n’identifie pas une JWK privée" + +#: src/scm/webid-oidc/errors.scm:142 +#, scheme-format +msgid "the value ~s does not identify a JWKS (because ~a)" +msgstr "la valeur ~s n’identifie pas un JWKS (parce que ~a)" + +#: src/scm/webid-oidc/errors.scm:144 +#, scheme-format +msgid "the value ~s does not identify a JWKS" +msgstr "la valeur ~s n’identifie pas un JWKS" + +#: src/scm/webid-oidc/errors.scm:147 #, scheme-format msgid "the value ~s does not identify a hash algorithm" msgstr "la valeur ~s n’identifie pas un algorithme de hachage" -#: src/scm/webid-oidc/errors.scm:101 +#: src/scm/webid-oidc/errors.scm:152 msgid "that’s it" msgstr "c’est tout" -#: src/scm/webid-oidc/errors.scm:105 +#: src/scm/webid-oidc/errors.scm:156 #, scheme-format msgid "~a and ~a" msgstr "~a et ~a" -#: src/scm/webid-oidc/errors.scm:108 +#: src/scm/webid-oidc/errors.scm:159 #, scheme-format msgid "~a, ~a" msgstr "~a, ~a" -#: src/scm/webid-oidc/errors.scm:112 +#: src/scm/webid-oidc/errors.scm:163 msgid "there is an undefined variable" msgstr "il y a une variable non définie" -#: src/scm/webid-oidc/errors.scm:114 +#: src/scm/webid-oidc/errors.scm:165 #, scheme-format msgid "the origin is ~a" msgstr "l’origine est ~a" -#: src/scm/webid-oidc/errors.scm:117 +#: src/scm/webid-oidc/errors.scm:168 #, scheme-format msgid "a message is attached: ~a" msgstr "un message est attaché : ~a" -#: src/scm/webid-oidc/errors.scm:120 +#: src/scm/webid-oidc/errors.scm:171 #, scheme-format msgid "the values ~s are problematic" msgstr "les valeurs ~s sont problématiques" -#: src/scm/webid-oidc/errors.scm:123 +#: src/scm/webid-oidc/errors.scm:174 msgid "there is a kind and args" msgstr "il y a un type et des arguments" -#: src/scm/webid-oidc/errors.scm:125 +#: src/scm/webid-oidc/errors.scm:176 msgid "there is an assertion failure" msgstr "il y a un échec d’assertion" -#: src/scm/webid-oidc/errors.scm:127 +#: src/scm/webid-oidc/errors.scm:178 #, scheme-format msgid "Unhandled exception type ~a." msgstr "Type d’exception non pris en charge ~a." @@ -211,30 +241,6 @@ msgstr "Type d’exception non pris en charge ~a." #~ msgstr "la valeur ~s n’est pas du Turtle (parce que ~a)" #, scheme-format -#~ msgid "the value ~s does not identify a public JWK (because ~a)" -#~ msgstr "la valeur ~s n’identifie pas une JWK publique (parce que ~a)" - -#, scheme-format -#~ msgid "the value ~s does not identify a public JWK" -#~ msgstr "la valeur ~s n’identifie pas une JWK publique" - -#, scheme-format -#~ msgid "the value ~s does not identify a private JWK (because ~a)" -#~ msgstr "la valeur ~s n’identifie pas une JWK privée (parce que ~a)" - -#, scheme-format -#~ msgid "the value ~s does not identify a private JWK" -#~ msgstr "la valeur ~s n’identifie pas une JWK privée" - -#, scheme-format -#~ msgid "the value ~s does not identify a JWKS (because ~a)" -#~ msgstr "la valeur ~s n’identifie pas un JWKS (parce que ~a)" - -#, scheme-format -#~ msgid "the value ~s does not identify a JWKS" -#~ msgstr "la valeur ~s n’identifie pas un JWKS" - -#, scheme-format #~ msgid "the value ~s is not an alist or misses key ~s" #~ msgstr "la valeur ~s n’est pas une alist ou il manque la clé ~s" diff --git a/po/webid-oidc.pot b/po/webid-oidc.pot index 83704c4..606b5e0 100644 --- a/po/webid-oidc.pot +++ b/po/webid-oidc.pot @@ -122,82 +122,112 @@ msgstr "" msgid "Usage: generate-key [NUMBER OF BITS | CURVE]\n" msgstr "" -#: src/scm/webid-oidc/errors.scm:75 +#: src/scm/webid-oidc/errors.scm:105 msgid "that’s how it is" msgstr "" -#: src/scm/webid-oidc/errors.scm:80 +#: src/scm/webid-oidc/errors.scm:110 #, scheme-format msgid "the value ~s is not a base64 string (because ~a)" msgstr "" -#: src/scm/webid-oidc/errors.scm:83 +#: src/scm/webid-oidc/errors.scm:113 #, scheme-format msgid "the value ~s is not JSON (because ~a)" msgstr "" -#: src/scm/webid-oidc/errors.scm:86 +#: src/scm/webid-oidc/errors.scm:116 #, scheme-format msgid "the value ~s does not identify an elleptic curve" msgstr "" -#: src/scm/webid-oidc/errors.scm:91 +#: src/scm/webid-oidc/errors.scm:121 #, scheme-format msgid "the value ~s does not identify a JWK (because ~a)" msgstr "" -#: src/scm/webid-oidc/errors.scm:93 +#: src/scm/webid-oidc/errors.scm:123 #, scheme-format msgid "the value ~s does not identify a JWK" msgstr "" -#: src/scm/webid-oidc/errors.scm:96 +#: src/scm/webid-oidc/errors.scm:128 +#, scheme-format +msgid "the value ~s does not identify a public JWK (because ~a)" +msgstr "" + +#: src/scm/webid-oidc/errors.scm:130 +#, scheme-format +msgid "the value ~s does not identify a public JWK" +msgstr "" + +#: src/scm/webid-oidc/errors.scm:135 +#, scheme-format +msgid "the value ~s does not identify a private JWK (because ~a)" +msgstr "" + +#: src/scm/webid-oidc/errors.scm:137 +#, scheme-format +msgid "the value ~s does not identify a private JWK" +msgstr "" + +#: src/scm/webid-oidc/errors.scm:142 +#, scheme-format +msgid "the value ~s does not identify a JWKS (because ~a)" +msgstr "" + +#: src/scm/webid-oidc/errors.scm:144 +#, scheme-format +msgid "the value ~s does not identify a JWKS" +msgstr "" + +#: src/scm/webid-oidc/errors.scm:147 #, scheme-format msgid "the value ~s does not identify a hash algorithm" msgstr "" -#: src/scm/webid-oidc/errors.scm:101 +#: src/scm/webid-oidc/errors.scm:152 msgid "that’s it" msgstr "" -#: src/scm/webid-oidc/errors.scm:105 +#: src/scm/webid-oidc/errors.scm:156 #, scheme-format msgid "~a and ~a" msgstr "" -#: src/scm/webid-oidc/errors.scm:108 +#: src/scm/webid-oidc/errors.scm:159 #, scheme-format msgid "~a, ~a" msgstr "" -#: src/scm/webid-oidc/errors.scm:112 +#: src/scm/webid-oidc/errors.scm:163 msgid "there is an undefined variable" msgstr "" -#: src/scm/webid-oidc/errors.scm:114 +#: src/scm/webid-oidc/errors.scm:165 #, scheme-format msgid "the origin is ~a" msgstr "" -#: src/scm/webid-oidc/errors.scm:117 +#: src/scm/webid-oidc/errors.scm:168 #, scheme-format msgid "a message is attached: ~a" msgstr "" -#: src/scm/webid-oidc/errors.scm:120 +#: src/scm/webid-oidc/errors.scm:171 #, scheme-format msgid "the values ~s are problematic" msgstr "" -#: src/scm/webid-oidc/errors.scm:123 +#: src/scm/webid-oidc/errors.scm:174 msgid "there is a kind and args" msgstr "" -#: src/scm/webid-oidc/errors.scm:125 +#: src/scm/webid-oidc/errors.scm:176 msgid "there is an assertion failure" msgstr "" -#: src/scm/webid-oidc/errors.scm:127 +#: src/scm/webid-oidc/errors.scm:178 #, scheme-format msgid "Unhandled exception type ~a." msgstr "" diff --git a/src/scm/webid-oidc/Makefile.am b/src/scm/webid-oidc/Makefile.am index e74b26c..8c504d2 100644 --- a/src/scm/webid-oidc/Makefile.am +++ b/src/scm/webid-oidc/Makefile.am @@ -1,9 +1,11 @@ dist_webidoidcmod_DATA += \ %reldir%/errors.scm \ %reldir%/stubs.scm \ - %reldir%/testing.scm + %reldir%/testing.scm \ + %reldir%/jwk.scm webidoidcgo_DATA += \ %reldir%/errors.go \ %reldir%/stubs.go \ - %reldir%/testing.go + %reldir%/testing.go \ + %reldir%/jwk.go diff --git a/src/scm/webid-oidc/errors.scm b/src/scm/webid-oidc/errors.scm index b575a77..a690088 100644 --- a/src/scm/webid-oidc/errors.scm +++ b/src/scm/webid-oidc/errors.scm @@ -54,6 +54,36 @@ (raise-exception ((record-constructor ¬-a-jwk) value cause))) +(define-public ¬-a-public-jwk + (make-exception-type + '¬-a-public-jwk + &external-error + '(value cause))) + +(define-public (raise-not-a-public-jwk value cause) + (raise-exception + ((record-constructor ¬-a-public-jwk) value cause))) + +(define-public ¬-a-private-jwk + (make-exception-type + '¬-a-private-jwk + &external-error + '(value cause))) + +(define-public (raise-not-a-private-jwk value cause) + (raise-exception + ((record-constructor ¬-a-private-jwk) value cause))) + +(define-public ¬-a-jwks + (make-exception-type + '¬-a-jwks + &external-error + '(value cause))) + +(define-public (raise-not-a-jwks value cause) + (raise-exception + ((record-constructor ¬-a-jwks) value cause))) + (define-public &unsupported-alg (make-exception-type '&unsupported-alg @@ -92,6 +122,27 @@ (get 'value) cause) (format #f (G_ "the value ~s does not identify a JWK") (get 'value))))) + ((¬-a-public-jwk) + (let ((cause (get 'cause))) + (if cause + (format #f (G_ "the value ~s does not identify a public JWK (because ~a)") + (get 'value) cause) + (format #f (G_ "the value ~s does not identify a public JWK") + (get 'value))))) + ((¬-a-private-jwk) + (let ((cause (get 'cause))) + (if cause + (format #f (G_ "the value ~s does not identify a private JWK (because ~a)") + (get 'value) cause) + (format #f (G_ "the value ~s does not identify a private JWK") + (get 'value))))) + ((¬-a-jwks) + (let ((cause (get 'cause))) + (if cause + (format #f (G_ "the value ~s does not identify a JWKS (because ~a)") + (get 'value) cause) + (format #f (G_ "the value ~s does not identify a JWKS") + (get 'value))))) ((&unsupported-alg) (format #f (G_ "the value ~s does not identify a hash algorithm") (get 'value))) diff --git a/src/scm/webid-oidc/jwk.scm b/src/scm/webid-oidc/jwk.scm new file mode 100644 index 0000000..1ad54ad --- /dev/null +++ b/src/scm/webid-oidc/jwk.scm @@ -0,0 +1,112 @@ +(define-module (webid-oidc jwk) + #:use-module ((webid-oidc stubs) #:prefix stubs:) + #:use-module (webid-oidc errors) + #:use-module (json)) + +(define-public (the-jwk x) + (with-exception-handler + (lambda (cause) + (raise-not-a-jwk x cause)) + (lambda () + (let ((kty (stubs:kty x))) + (unless (or (eq? kty 'EC) (eq? kty 'RSA)) + (throw 'really-not-a-jwk)) + x)))) + +(define-public (jwk? x) + (false-if-exception + (and (the-jwk x) #t))) + +(define-public (kty x) + (stubs:kty (the-jwk x))) + +(define-public (the-public-jwk x) + (with-exception-handler + (lambda (cause) + (raise-not-a-public-jwk x cause)) + (lambda () + (let ((key (the-jwk x))) + (let ((crv (assq-ref key 'crv)) + (x (assq-ref key 'x)) + (y (assq-ref key 'y)) + (n (assq-ref key 'n)) + (e (assq-ref key 'e))) + (let ((ec-part `((crv . ,crv) + (x . ,x) + (y . ,y))) + (rsa-part `((n . ,n) + (e . ,e)))) + (case (stubs:kty ec-part) + ((EC) ec-part) + ((RSA) rsa-part)))))))) + +(define-public (jwk-public? key) + (false-if-exception + (and (the-public-jwk x) #t))) + +(define-public (strip key) + (with-exception-handler + (lambda (cause) + (raise-not-a-public-jwk key cause)) + (lambda () + (stubs:strip-key key)))) + +(define-public (jkt x) + (stubs:jkt (the-public-jwk x))) + +(define-public (make-rsa-public-key n e) + (the-public-jwk + `((n . ,n) + (e . ,e)))) + +(define-public (make-rsa-private-key d p q dp dq qi) + (the-jwk + `((d . ,d) + (p . ,p) + (q . ,q) + (dp . ,dp) + (dq . ,dq) + (qi . ,qi)))) + +(define-public (make-ec-point crv x y) + (if (symbol? crv) + (make-ec-point (symbol->string crv) x y) + (the-public-jwk + `((crv . ,crv) + (x . ,x) + (y . ,y))))) + +(define-public (make-ec-scalar crv d) + (if (symbol? crv) + (make-ec-scalar (symbol->string crv) d) + (the-jwk + `((crv . ,crv) + (d . ,d))))) + +(define-public generate-key stubs:generate-key) + +(define (the-public-keys keys) + (map the-public-key keys)) + +(define-public (the-jwks jwks) + (let ((keys (vector->list (assoc-ref jwks 'keys)))) + (unless keys + (raise-not-a-jwks jwks #f)) + (with-exception-handler + (lambda (cause) + (raise-not-a-jwks jwks cause)) + (lambda () + `((keys . ,(list->vector (the-public-keys keys)))))))) + +(define-public (jwks? jwks) + (false-if-exception + (and (the-jwks jwks) #t))) + +(define-public (make-jwks keys) + (if (vector? keys) + (make-jwks (vector->list keys)) + (let ((pubs (list->vector (map strip keys)))) + (the-jwks `((keys . ,pubs)))))) + +(define-public (jwks-keys jwks) + (vector->list (assq-ref (the-jwks jwks) keys))) |