summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorVivien Kraus <vivien@planete-kraus.eu>2021-09-23 12:21:03 +0200
committerVivien Kraus <vivien@planete-kraus.eu>2021-10-01 12:32:20 +0200
commit98de254d3c77feadad464f77f51f9cad5993a9f8 (patch)
tree95d959724e449588e1707075263b9d25719f10d2
parentca67854900dbf0f7200e75c73f32900a8fe0b63e (diff)
Define an XML-loadable meta-class
-rw-r--r--doc/disfluid.texi74
-rw-r--r--po/POTFILES.in1
-rw-r--r--po/disfluid.pot216
-rw-r--r--po/fr.po223
-rw-r--r--src/scm/webid-oidc/Makefile.am6
-rw-r--r--src/scm/webid-oidc/access-token.scm8
-rw-r--r--src/scm/webid-oidc/authorization-code.scm6
-rw-r--r--src/scm/webid-oidc/client.scm2
-rw-r--r--src/scm/webid-oidc/client/accounts.scm70
-rw-r--r--src/scm/webid-oidc/client/client.scm25
-rw-r--r--src/scm/webid-oidc/dpop-proof.scm6
-rw-r--r--src/scm/webid-oidc/jwk.scm73
-rw-r--r--src/scm/webid-oidc/jws.scm58
-rw-r--r--src/scm/webid-oidc/oidc-configuration.scm9
-rw-r--r--src/scm/webid-oidc/oidc-id-token.scm14
-rw-r--r--src/scm/webid-oidc/serializable.scm207
-rw-r--r--tests/Makefile.am3
-rw-r--r--tests/dpop-proof-no-explicit-exp.scm33
-rw-r--r--tests/dpop-proof-no-explicit-iat.scm33
-rw-r--r--tests/xml-accounts.scm116
-rw-r--r--tests/xml-keys.scm12
21 files changed, 735 insertions, 460 deletions
diff --git a/doc/disfluid.texi b/doc/disfluid.texi
index a73a5c7..06af9e4 100644
--- a/doc/disfluid.texi
+++ b/doc/disfluid.texi
@@ -69,6 +69,7 @@ is tracked in the Guix channel
* Running an Identity Provider::
* Running a Resource Server::
* Running a client::
+* Serialization to (S)XML::
* Exceptional conditions::
* GNU Free Documentation License::
* Index::
@@ -440,26 +441,6 @@ Return an alist with known parameter names for JSON.
Parse @var{jwk} as a key or a key pair.
@end deffn
-It is also possible to serialize and deserialize the key to and from
-SXML.
-
-@deftypefn {Generic method} <list> ->sxml (@var{key} @code{<public-key>})
-@deftypefnx {Generic method} <list> ->sxml (@var{key} @code{<private-key>})
-@deftypefnx {Generic method} <list> ->sxml (@var{key} @code{<key-pair>})
-Convert @var{key} to an SXML representation that can be parsed back
-with @code{sxml->key}.
-@end deftypefn
-
-@deffn function sxml->key @var{sxml}
-Parse the @var{sxml} fragment back to a key or a key pair. For this to
-work, you need to not touch the
-@url{https://disfluid.planete-kraus.eu/Public_002dkey-cryptography.html#Public_002dkey-cryptography}
-prefix. So, if you pass a @code{jwk} element, it should be
-@code{https://disfluid.planete-kraus.eu/Public_002dkey-cryptography.html#Public_002dkey-cryptography:jwk},
-or @code{jwk} with an explicit @code{xmlns} attribute containing
-@url{https://disfluid.planete-kraus.eu/Public_002dkey-cryptography.html#Public_002dkey-cryptography}.
-@end deffn
-
@deftypefn {Generic method} <symbol> kty (@var{key} @code{<rsa-key-pair>})
@deftypefnx {Generic method} <symbol> kty (@var{key} @code{<rsa-public-key>})
@deftypefnx {Generic method} <symbol> kty (@var{key} @code{<rsa-private-key>})
@@ -635,17 +616,6 @@ Return two alists, following the JSON representation from srfi-180:
one for the header, and then one for the payload.
@end deffn
-A token can also be serialized as SXML.
-
-@deffn {Generic} ->sxml @var{token}
-Convert @var{token} to an SXML representation.
-@end deffn
-
-@deffn {function} sxml->token @var{token-class} @var{sxml}
-Construct and return a token of class @var{token-class} from
-@var{sxml}.
-@end deffn
-
@deffn {Generic} lookup-keys @var{token} @var{args}
Return the set of keys that could be used to sign @var{token}, as a
public key, a list of keys, or a JWKS. @var{args} is a list of keyword
@@ -1858,6 +1828,48 @@ the @var{client-name} to your application name and @var{client-uri} to
point to where to a presentation of your application.
@end deffn
+@node Serialization to (S)XML
+@chapter Serialization to (S)XML
+
+The @emph{(webid-oidc serializable)} module provides tools to have
+serialization to SXML and deserialization from XML.
+
+@deftp {Class} <plugin-class> (<class>) @var{module-name} @var{direct-name}
+This metaclass permits to register plugins. @var{module-name} is the
+name of a module that defines the class, and @var{direct-name} is the
+class name without the surrounding angle brackets. Please note that
+all plugin classes should be surrounded by angle brackets.
+
+Most GOOPS classes defined in this program are actually plugin classes.
+
+Serialization works for each slot by serializing other plugin classes
+the normal way, and other values are simply represented as strings
+with @code{display}.
+
+Deserialization works by loading the module containing the target
+class, collecting a value for each slot (a string for
+non-plugin-class-valued slots), and making an instance of that class
+with all collected values. The initialization function should accept
+strings values, for objects that are not of a plugin class.
+
+Since most scheme data types written by @code{display} cannot be read
+in a meaningful way, you may add a @code{#:->sxml} slot option with a
+function taking the slot value and either returning a string that the
+initialization function can parse, or an SXML fragment. For instance,
+if a slot should contain an URI value, you would pass @code{#:->sxml
+uri->string} as options to the slot definition, and accept a string
+value in the initialization function, that you would convert to an URI
+with @code{string->uri}.
+@end deftp
+
+@deffn {function} read/xml @var{port}
+Read the XML document at @var{port} and deserialize it.
+@end deffn
+
+@deffn {function} ->sxml @var{object}
+Convert @var{object} to an SXML fragment.
+@end deffn
+
@node Exceptional conditions
@chapter Exceptional conditions
diff --git a/po/POTFILES.in b/po/POTFILES.in
index fd3266b..ae71785 100644
--- a/po/POTFILES.in
+++ b/po/POTFILES.in
@@ -57,6 +57,7 @@ src/scm/webid-oidc/rdf-index.scm
src/scm/webid-oidc/refresh-token.scm
src/scm/webid-oidc/resource-server.scm
src/scm/webid-oidc/reverse-proxy.scm
+src/scm/webid-oidc/serializable.scm
src/scm/webid-oidc/serve.scm
src/scm/webid-oidc/server/create.scm
src/scm/webid-oidc/server/delete.scm
diff --git a/po/disfluid.pot b/po/disfluid.pot
index 2a4b334..c624063 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-22 14:08+0200\n"
+"POT-Creation-Date: 2021-09-23 17:43+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"
@@ -122,54 +122,54 @@ msgid ""
"webid_oidc_random_init first.\n"
msgstr ""
-#: src/scm/webid-oidc/access-token.scm:71
+#: src/scm/webid-oidc/access-token.scm:73
#, scheme-format
msgid "invalid access token: ~a"
msgstr ""
-#: src/scm/webid-oidc/access-token.scm:73
+#: src/scm/webid-oidc/access-token.scm:75
msgid "invalid access token"
msgstr ""
-#: src/scm/webid-oidc/access-token.scm:115
-#: src/scm/webid-oidc/authorization-code.scm:93
-#: src/scm/webid-oidc/oidc-id-token.scm:98
+#: src/scm/webid-oidc/access-token.scm:117
+#: src/scm/webid-oidc/authorization-code.scm:95
+#: src/scm/webid-oidc/oidc-id-token.scm:108
msgid "#:webid should be an URI"
msgstr ""
-#: src/scm/webid-oidc/access-token.scm:120
+#: src/scm/webid-oidc/access-token.scm:122
msgid "#:client-id should be an URI"
msgstr ""
-#: src/scm/webid-oidc/access-token.scm:125
+#: src/scm/webid-oidc/access-token.scm:127
msgid "#:cnf/jkt should be a string"
msgstr ""
-#: src/scm/webid-oidc/access-token.scm:130
+#: src/scm/webid-oidc/access-token.scm:132
msgid "#:aud should be exactly \"solid\""
msgstr ""
-#: src/scm/webid-oidc/access-token.scm:148
+#: src/scm/webid-oidc/access-token.scm:150
msgid ""
"when making an access token either its required fields (#:alg, #:webid, #:"
"iss, #:aud, #:client-id, #:cnf/jkt, #:iat and #:exp) or (#:jwt-header and #:"
"jwt-payload) should be passed"
msgstr ""
-#: src/scm/webid-oidc/authorization-code.scm:69
+#: src/scm/webid-oidc/authorization-code.scm:71
#, scheme-format
msgid "invalid authorization code: ~a"
msgstr ""
-#: src/scm/webid-oidc/authorization-code.scm:71
+#: src/scm/webid-oidc/authorization-code.scm:73
msgid "invalid authorization code"
msgstr ""
-#: src/scm/webid-oidc/authorization-code.scm:98
+#: src/scm/webid-oidc/authorization-code.scm:100
msgid "#:client-id should be a string"
msgstr ""
-#: src/scm/webid-oidc/authorization-code.scm:112
+#: src/scm/webid-oidc/authorization-code.scm:114
msgid ""
"when making an authorization code either its required fields (#:webid and #:"
"client-id) or (#:jwt-header and #:jwt-payload) should be passed"
@@ -360,78 +360,78 @@ msgstr ""
msgid "the client manifest is dereferenced from ~s, but it pretends to be ~s"
msgstr ""
-#: src/scm/webid-oidc/client/accounts.scm:273
+#: src/scm/webid-oidc/client/accounts.scm:239
msgid "The refresh token has expired."
msgstr ""
-#: src/scm/webid-oidc/client/accounts.scm:280
+#: src/scm/webid-oidc/client/accounts.scm:246
#, scheme-format
msgid "The token request failed with code ~s (~s)."
msgstr ""
-#: src/scm/webid-oidc/client/accounts.scm:289
+#: src/scm/webid-oidc/client/accounts.scm:255
msgid "The token response did not set the content type."
msgstr ""
-#: src/scm/webid-oidc/client/accounts.scm:297
+#: src/scm/webid-oidc/client/accounts.scm:263
msgid "The token endpoint did not respond in UTF-8."
msgstr ""
-#: src/scm/webid-oidc/client/accounts.scm:309
+#: src/scm/webid-oidc/client/accounts.scm:275
#, scheme-format
msgid "The token response has content-type ~s, not application/json."
msgstr ""
-#: src/scm/webid-oidc/client/accounts.scm:319
+#: src/scm/webid-oidc/client/accounts.scm:285
msgid "The token response is not valid JSON."
msgstr ""
-#: src/scm/webid-oidc/client/accounts.scm:333
+#: src/scm/webid-oidc/client/accounts.scm:299
#, scheme-format
msgid "The token response did not include an ID token: ~s"
msgstr ""
-#: src/scm/webid-oidc/client/accounts.scm:341
+#: src/scm/webid-oidc/client/accounts.scm:307
#, scheme-format
msgid "The token response did not include an access token: ~s\n"
msgstr ""
-#: src/scm/webid-oidc/client/accounts.scm:352
+#: src/scm/webid-oidc/client/accounts.scm:318
#, scheme-format
msgid "the ID token signature is invalid: ~a"
msgstr ""
-#: src/scm/webid-oidc/client/accounts.scm:354
+#: src/scm/webid-oidc/client/accounts.scm:320
msgid "the ID token signature is invalid"
msgstr ""
-#: src/scm/webid-oidc/client/accounts.scm:370
+#: src/scm/webid-oidc/client/accounts.scm:336
#, scheme-format
msgid "the ID token delivered by the identity provider for ~s has ~s as webid"
msgstr ""
-#: src/scm/webid-oidc/client/accounts.scm:380
+#: src/scm/webid-oidc/client/accounts.scm:346
#, scheme-format
msgid "The ID token delivered by the identity provider ~s is for issuer ~s."
msgstr ""
-#: src/scm/webid-oidc/client/accounts.scm:395
+#: src/scm/webid-oidc/client/accounts.scm:361
msgid "The issuer is required."
msgstr ""
-#: src/scm/webid-oidc/client/accounts.scm:400
+#: src/scm/webid-oidc/client/accounts.scm:366
msgid "The optional subject and required issuer should be strings or URI."
msgstr ""
-#: src/scm/webid-oidc/client/accounts.scm:436
+#: src/scm/webid-oidc/client/accounts.scm:382
msgid "Cannot check the username and/or password."
msgstr ""
-#: src/scm/webid-oidc/client/accounts.scm:446
+#: src/scm/webid-oidc/client/accounts.scm:392
msgid "The subject should be a string or URI."
msgstr ""
-#: src/scm/webid-oidc/client/accounts.scm:460
+#: src/scm/webid-oidc/client/accounts.scm:406
msgid "The issuer should be a string or URI."
msgstr ""
@@ -451,7 +451,7 @@ msgstr ""
msgid "You already have an account for ~a issued by ~a."
msgstr ""
-#: src/scm/webid-oidc/client/client.scm:106
+#: src/scm/webid-oidc/client/client.scm:91
msgid ""
"Client ID and redirect URIs should be URIs, and key pair should be a key "
"pair.."
@@ -465,63 +465,63 @@ msgstr ""
msgid "Hello, world!"
msgstr ""
-#: src/scm/webid-oidc/dpop-proof.scm:110
+#: src/scm/webid-oidc/dpop-proof.scm:111
#, scheme-format
msgid "the DPoP proof is signed for ~s, but it is issued to ~s"
msgstr ""
-#: src/scm/webid-oidc/dpop-proof.scm:155
+#: src/scm/webid-oidc/dpop-proof.scm:157
#, scheme-format
msgid "invalid DPoP proof: ~a"
msgstr ""
-#: src/scm/webid-oidc/dpop-proof.scm:157
+#: src/scm/webid-oidc/dpop-proof.scm:159
msgid "invalid DPoP proof token"
msgstr ""
-#: src/scm/webid-oidc/dpop-proof.scm:195
+#: src/scm/webid-oidc/dpop-proof.scm:197
msgid "#:typ should be exactly \"dpop+jwt\""
msgstr ""
-#: src/scm/webid-oidc/dpop-proof.scm:200
+#: src/scm/webid-oidc/dpop-proof.scm:202
msgid "#:jwk should be a public key"
msgstr ""
-#: src/scm/webid-oidc/dpop-proof.scm:205
+#: src/scm/webid-oidc/dpop-proof.scm:207
msgid "#:htm should be a symbol"
msgstr ""
-#: src/scm/webid-oidc/dpop-proof.scm:211
+#: src/scm/webid-oidc/dpop-proof.scm:213
msgid "when present, #:ath should be a string"
msgstr ""
-#: src/scm/webid-oidc/dpop-proof.scm:232
+#: src/scm/webid-oidc/dpop-proof.scm:234
msgid ""
"when making a DPoP proof, either its required fields (#:typ, #:jwk, #:htm "
"and #:htu) or (#:jwt-header and #:jwt-payload) should be passed"
msgstr ""
-#: src/scm/webid-oidc/dpop-proof.scm:265
+#: src/scm/webid-oidc/dpop-proof.scm:267
#, scheme-format
msgid "the DPoP proof is signed for access through ~s, but it is used with ~s"
msgstr ""
-#: src/scm/webid-oidc/dpop-proof.scm:275
+#: src/scm/webid-oidc/dpop-proof.scm:277
#, scheme-format
msgid ""
"the DPoP proof should go along with an access token hashed to ~s, not ~s"
msgstr ""
-#: src/scm/webid-oidc/dpop-proof.scm:283 src/scm/webid-oidc/dpop-proof.scm:290
+#: src/scm/webid-oidc/dpop-proof.scm:285 src/scm/webid-oidc/dpop-proof.scm:292
msgid "the DPoP proof is signed with the wrong key"
msgstr ""
-#: src/scm/webid-oidc/dpop-proof.scm:288
+#: src/scm/webid-oidc/dpop-proof.scm:290
#, scheme-format
msgid "the DPoP proof is signed with the wrong key: ~a"
msgstr ""
-#: src/scm/webid-oidc/dpop-proof.scm:299
+#: src/scm/webid-oidc/dpop-proof.scm:301
msgid "the cnf/check function returned #f"
msgstr ""
@@ -867,59 +867,59 @@ msgstr ""
msgid "a replay has been detected with JTI ~s"
msgstr ""
-#: src/scm/webid-oidc/jwk.scm:147
+#: src/scm/webid-oidc/jwk.scm:158
msgid "the point and scalar are not on the same curve"
msgstr ""
-#: src/scm/webid-oidc/jwk.scm:259
+#: src/scm/webid-oidc/jwk.scm:274
#, scheme-format
msgid "the JWK is invalid: ~a"
msgstr ""
-#: src/scm/webid-oidc/jwk.scm:261
+#: src/scm/webid-oidc/jwk.scm:276
msgid "the JWK is invalid"
msgstr ""
-#: src/scm/webid-oidc/jwk.scm:270
+#: src/scm/webid-oidc/jwk.scm:285
msgid "cannot compute the key type"
msgstr ""
-#: src/scm/webid-oidc/jwk.scm:331
+#: src/scm/webid-oidc/jwk.scm:346
msgid "it is built as an RSA key or key pair, but it is not"
msgstr ""
-#: src/scm/webid-oidc/jwk.scm:339
+#: src/scm/webid-oidc/jwk.scm:354
msgid "it is built as an elliptic curve key or key pair, but it is not"
msgstr ""
-#: src/scm/webid-oidc/jwk.scm:381
+#: src/scm/webid-oidc/jwk.scm:396
#, scheme-format
msgid "the key advertises a key type of ~s, but actually it is ~s"
msgstr ""
-#: src/scm/webid-oidc/jwk.scm:430
+#: src/scm/webid-oidc/jwk.scm:445
msgid "this is neither a RSA key nor an elliptic curve key"
msgstr ""
-#: src/scm/webid-oidc/jwk.scm:507
+#: src/scm/webid-oidc/jwk.scm:482
#, scheme-format
msgid "cannot fetch a JWKS: ~a"
msgstr ""
-#: src/scm/webid-oidc/jwk.scm:509
+#: src/scm/webid-oidc/jwk.scm:484
msgid "cannot fetch a JWKS"
msgstr ""
-#: src/scm/webid-oidc/jwk.scm:513
+#: src/scm/webid-oidc/jwk.scm:488
#, scheme-format
msgid "the request failed with ~s ~s"
msgstr ""
-#: src/scm/webid-oidc/jwk.scm:518
+#: src/scm/webid-oidc/jwk.scm:493
msgid "missing content-type"
msgstr ""
-#: src/scm/webid-oidc/jwk.scm:523
+#: src/scm/webid-oidc/jwk.scm:498
#, scheme-format
msgid "invalid content-type: ~s"
msgstr ""
@@ -935,189 +935,185 @@ msgid ""
"be passed"
msgstr ""
-#: src/scm/webid-oidc/jws.scm:206
+#: src/scm/webid-oidc/jws.scm:214
msgid "#:iat should be a date"
msgstr ""
-#: src/scm/webid-oidc/jws.scm:211
+#: src/scm/webid-oidc/jws.scm:219
msgid "#:exp should be a date"
msgstr ""
-#: src/scm/webid-oidc/jws.scm:221
+#: src/scm/webid-oidc/jws.scm:229
msgid ""
"when making a time-bound token, either its required fields (#:iat, and "
"either #:exp or #:validity) or (#:jwt-header and #:jwt-payload) should be "
"passed"
msgstr ""
-#: src/scm/webid-oidc/jws.scm:249
+#: src/scm/webid-oidc/jws.scm:258
msgid "#:iss should be an URI"
msgstr ""
-#: src/scm/webid-oidc/jws.scm:260
+#: src/scm/webid-oidc/jws.scm:269
msgid ""
"when making an OIDC token, either its required #:iss field or (#:jwt-header "
"and #:jwt-payload) should be passed"
msgstr ""
-#: src/scm/webid-oidc/jws.scm:304
+#: src/scm/webid-oidc/jws.scm:314
msgid "#:nonce should be a string"
msgstr ""
-#: src/scm/webid-oidc/jws.scm:313
+#: src/scm/webid-oidc/jws.scm:323
msgid ""
"when making a single-use token, either its required #:nonce field or (#:jwt-"
"header and #:jwt-payload) should be passed"
msgstr ""
-#: src/scm/webid-oidc/jws.scm:358
+#: src/scm/webid-oidc/jws.scm:368
msgid "the encoded JWS is not in 3 parts"
msgstr ""
-#: src/scm/webid-oidc/jws.scm:369
+#: src/scm/webid-oidc/jws.scm:379
#, scheme-format
msgid ""
"the encoded JWS header or payload is not a JSON object encoded in base64: ~a"
msgstr ""
-#: src/scm/webid-oidc/jws.scm:371
+#: src/scm/webid-oidc/jws.scm:381
msgid ""
"the encoded JWS header or payload is not a JSON object encoded in base64"
msgstr ""
-#: src/scm/webid-oidc/jws.scm:430
+#: src/scm/webid-oidc/jws.scm:440
msgid "the JWS is not signed by any of the expected set of public keys"
msgstr ""
-#: src/scm/webid-oidc/jws.scm:441
+#: src/scm/webid-oidc/jws.scm:451
#, scheme-format
msgid "while verifying the JWS signature: ~a"
msgstr ""
-#: src/scm/webid-oidc/jws.scm:443
+#: src/scm/webid-oidc/jws.scm:453
msgid "an unexpected error happened while verifying a JWS"
msgstr ""
-#: src/scm/webid-oidc/jws.scm:479
+#: src/scm/webid-oidc/jws.scm:489
#, scheme-format
msgid "I cannot query the identity provider configuration: ~a"
msgstr ""
-#: src/scm/webid-oidc/jws.scm:481
+#: src/scm/webid-oidc/jws.scm:491
msgid "I cannot query the identity provider configuration"
msgstr ""
-#: src/scm/webid-oidc/jws.scm:497
+#: src/scm/webid-oidc/jws.scm:507
#, scheme-format
msgid "I cannot query the JWKS URI of the identity provider: ~a"
msgstr ""
-#: src/scm/webid-oidc/jws.scm:499
+#: src/scm/webid-oidc/jws.scm:509
msgid "I cannot query the JWKS URI of the identity provider"
msgstr ""
-#: src/scm/webid-oidc/jws.scm:522
+#: src/scm/webid-oidc/jws.scm:532
#, scheme-format
msgid "the token is signed in the future, ~a, relative to current ~a"
msgstr ""
-#: src/scm/webid-oidc/jws.scm:531
+#: src/scm/webid-oidc/jws.scm:541
#, scheme-format
msgid "the token expired ~a, which is in the past (from ~a)"
msgstr ""
-#: src/scm/webid-oidc/jws.scm:554
+#: src/scm/webid-oidc/jws.scm:564
#, scheme-format
msgid "cannot decode a JWS: ~a"
msgstr ""
-#: src/scm/webid-oidc/jws.scm:556
+#: src/scm/webid-oidc/jws.scm:566
msgid "cannot decode a JWS"
msgstr ""
-#: src/scm/webid-oidc/jws.scm:574
+#: src/scm/webid-oidc/jws.scm:584
#, scheme-format
msgid "cannot encode a JWS: ~a"
msgstr ""
-#: src/scm/webid-oidc/jws.scm:576
+#: src/scm/webid-oidc/jws.scm:586
msgid "cannot encode a JWS"
msgstr ""
-#: src/scm/webid-oidc/jws.scm:623
-msgid "cannot parse a token"
-msgstr ""
-
-#: src/scm/webid-oidc/oidc-configuration.scm:118
+#: src/scm/webid-oidc/oidc-configuration.scm:121
msgid "#:jwks-uri should be an URI"
msgstr ""
-#: src/scm/webid-oidc/oidc-configuration.scm:123
+#: src/scm/webid-oidc/oidc-configuration.scm:126
msgid "#:token-endpoint should be an URI"
msgstr ""
-#: src/scm/webid-oidc/oidc-configuration.scm:128
+#: src/scm/webid-oidc/oidc-configuration.scm:131
msgid "#:authorization-endpoint should be an URI"
msgstr ""
-#: src/scm/webid-oidc/oidc-configuration.scm:133
+#: src/scm/webid-oidc/oidc-configuration.scm:136
msgid ""
"#:solid-oidc-supported should be exactly 'https://solidproject.org/TR/solid-"
"oidc'"
msgstr ""
-#: src/scm/webid-oidc/oidc-configuration.scm:142
+#: src/scm/webid-oidc/oidc-configuration.scm:145
msgid "#:server should be an URI"
msgstr ""
-#: src/scm/webid-oidc/oidc-configuration.scm:159
+#: src/scm/webid-oidc/oidc-configuration.scm:162
#, scheme-format
msgid "cannot fetch the OIDC configuration: ~a"
msgstr ""
-#: src/scm/webid-oidc/oidc-configuration.scm:161
+#: src/scm/webid-oidc/oidc-configuration.scm:164
msgid "cannot fetch the OIDC configuration"
msgstr ""
-#: src/scm/webid-oidc/oidc-configuration.scm:165
+#: src/scm/webid-oidc/oidc-configuration.scm:168
#, scheme-format
msgid "the server responded with ~s ~s"
msgstr ""
-#: src/scm/webid-oidc/oidc-configuration.scm:170
+#: src/scm/webid-oidc/oidc-configuration.scm:173
msgid "there is no content-type"
msgstr ""
-#: src/scm/webid-oidc/oidc-configuration.scm:175
+#: src/scm/webid-oidc/oidc-configuration.scm:178
#, scheme-format
msgid "unexpected content-type: ~s"
msgstr ""
-#: src/scm/webid-oidc/oidc-configuration.scm:185
+#: src/scm/webid-oidc/oidc-configuration.scm:188
msgid ""
"when making an OIDC configuration, either its required #:jwks-uri, #:"
"authorization-endpoint and #:token-endpoint fields or #:server or #:json-"
"data should be passed"
msgstr ""
-#: src/scm/webid-oidc/oidc-id-token.scm:70
+#: src/scm/webid-oidc/oidc-id-token.scm:80
#, scheme-format
msgid "invalid OIDC ID token: ~a"
msgstr ""
-#: src/scm/webid-oidc/oidc-id-token.scm:72
+#: src/scm/webid-oidc/oidc-id-token.scm:82
msgid "invalid OIDC id token"
msgstr ""
-#: src/scm/webid-oidc/oidc-id-token.scm:103
+#: src/scm/webid-oidc/oidc-id-token.scm:113
msgid "#:sub should be a string"
msgstr ""
-#: src/scm/webid-oidc/oidc-id-token.scm:108
+#: src/scm/webid-oidc/oidc-id-token.scm:118
msgid "#:aud should be a string"
msgstr ""
-#: src/scm/webid-oidc/oidc-id-token.scm:124
+#: src/scm/webid-oidc/oidc-id-token.scm:134
msgid ""
"when making an ID token either its required fields (#:alg, #:webid, #:iss, #:"
"sub, #:aud, #:iat and #:exp) or (#:jwt-header and #:jwt-payload) should be "
@@ -1900,10 +1896,26 @@ msgstr ""
msgid "reason-phrase|Not Acceptable"
msgstr ""
-#: src/scm/webid-oidc/reverse-proxy.scm:57
+#: src/scm/webid-oidc/reverse-proxy.scm:58
msgid "#:endpoint argument is not present or not an URI."
msgstr ""
+#: src/scm/webid-oidc/serializable.scm:58
+msgid "a plugin class should have an explicit #:name and #:module-name"
+msgstr ""
+
+#: src/scm/webid-oidc/serializable.scm:61
+msgid "#:name should be a symbol"
+msgstr ""
+
+#: src/scm/webid-oidc/serializable.scm:71
+msgid "#:module-name should be a list of symbols"
+msgstr ""
+
+#: src/scm/webid-oidc/serializable.scm:76
+msgid "plugin class names should be surrounded by <angle brackets>"
+msgstr ""
+
#: src/scm/webid-oidc/serve.scm:77
msgid "content negociation failed while serving a request"
msgstr ""
diff --git a/po/fr.po b/po/fr.po
index 7338871..d880b91 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-22 14:08+0200\n"
-"PO-Revision-Date: 2021-09-22 14:10+0200\n"
+"POT-Creation-Date: 2021-09-23 17:43+0200\n"
+"PO-Revision-Date: 2021-09-23 17:44+0200\n"
"Last-Translator: Vivien Kraus <vivien@planete-kraus.eu>\n"
"Language-Team: French <vivien@planete-kraus.eu>\n"
"Language: fr\n"
@@ -126,34 +126,34 @@ msgstr ""
"Le module aléatoire n'a pas été initialisé. Veuillez appeler "
"webid_oidc_random_init d'abort.\n"
-#: src/scm/webid-oidc/access-token.scm:71
+#: src/scm/webid-oidc/access-token.scm:73
#, scheme-format
msgid "invalid access token: ~a"
msgstr "jeton d’accès invalide : ~a"
-#: src/scm/webid-oidc/access-token.scm:73
+#: src/scm/webid-oidc/access-token.scm:75
msgid "invalid access token"
msgstr "jeton d’accès invalide"
-#: src/scm/webid-oidc/access-token.scm:115
-#: src/scm/webid-oidc/authorization-code.scm:93
-#: src/scm/webid-oidc/oidc-id-token.scm:98
+#: src/scm/webid-oidc/access-token.scm:117
+#: src/scm/webid-oidc/authorization-code.scm:95
+#: src/scm/webid-oidc/oidc-id-token.scm:108
msgid "#:webid should be an URI"
msgstr "#:webid doit être une URI"
-#: src/scm/webid-oidc/access-token.scm:120
+#: src/scm/webid-oidc/access-token.scm:122
msgid "#:client-id should be an URI"
msgstr "#:client-id doit être une URI"
-#: src/scm/webid-oidc/access-token.scm:125
+#: src/scm/webid-oidc/access-token.scm:127
msgid "#:cnf/jkt should be a string"
msgstr "#:cnf/jkt doit être une chaîne de caractères"
-#: src/scm/webid-oidc/access-token.scm:130
+#: src/scm/webid-oidc/access-token.scm:132
msgid "#:aud should be exactly \"solid\""
msgstr "#:aud doit être exactement « solid »"
-#: src/scm/webid-oidc/access-token.scm:148
+#: src/scm/webid-oidc/access-token.scm:150
msgid ""
"when making an access token either its required fields (#:alg, #:webid, #:"
"iss, #:aud, #:client-id, #:cnf/jkt, #:iat and #:exp) or (#:jwt-header and #:"
@@ -163,20 +163,20 @@ msgstr ""
"nécessaires (#:alg, #:webid, #:iss, #:aud, #:client-id, #:cnf/jkt, #:iat et "
"#:exp) soit (#:jwt-header et #:jwt-payload)"
-#: src/scm/webid-oidc/authorization-code.scm:69
+#: src/scm/webid-oidc/authorization-code.scm:71
#, scheme-format
msgid "invalid authorization code: ~a"
msgstr "jeton d’autorisation invalide : ~a"
-#: src/scm/webid-oidc/authorization-code.scm:71
+#: src/scm/webid-oidc/authorization-code.scm:73
msgid "invalid authorization code"
msgstr "jeton d’autorisation invalide"
-#: src/scm/webid-oidc/authorization-code.scm:98
+#: src/scm/webid-oidc/authorization-code.scm:100
msgid "#:client-id should be a string"
msgstr "#:client-id doit être une chaîne de caractères"
-#: src/scm/webid-oidc/authorization-code.scm:112
+#: src/scm/webid-oidc/authorization-code.scm:114
msgid ""
"when making an authorization code either its required fields (#:webid and #:"
"client-id) or (#:jwt-header and #:jwt-payload) should be passed"
@@ -378,83 +378,83 @@ msgstr "impossible de télécharger le manifeste client ~s"
msgid "the client manifest is dereferenced from ~s, but it pretends to be ~s"
msgstr "le manifeste client est déréférencé depuis ~s, mais il prétend être ~s"
-#: src/scm/webid-oidc/client/accounts.scm:273
+#: src/scm/webid-oidc/client/accounts.scm:239
msgid "The refresh token has expired."
msgstr "le jeton de rafraîchissement a expiré."
-#: src/scm/webid-oidc/client/accounts.scm:280
+#: src/scm/webid-oidc/client/accounts.scm:246
#, scheme-format
msgid "The token request failed with code ~s (~s)."
msgstr "La requête de jeton a échoué avec un code ~s (~s)."
-#: src/scm/webid-oidc/client/accounts.scm:289
+#: src/scm/webid-oidc/client/accounts.scm:255
msgid "The token response did not set the content type."
msgstr "Le jeton de réponse n’a pas défini de type de contenu."
-#: src/scm/webid-oidc/client/accounts.scm:297
+#: src/scm/webid-oidc/client/accounts.scm:263
msgid "The token endpoint did not respond in UTF-8."
msgstr "Le terminal de jetonn n’a pas répondu en UTF-8."
-#: src/scm/webid-oidc/client/accounts.scm:309
+#: src/scm/webid-oidc/client/accounts.scm:275
#, scheme-format
msgid "The token response has content-type ~s, not application/json."
msgstr "La réponse de jeton a un type de contenu ~s, pas application/json."
-#: src/scm/webid-oidc/client/accounts.scm:319
+#: src/scm/webid-oidc/client/accounts.scm:285
msgid "The token response is not valid JSON."
msgstr "La réponse de jeton n’est pas un JSON valide."
-#: src/scm/webid-oidc/client/accounts.scm:333
+#: src/scm/webid-oidc/client/accounts.scm:299
#, scheme-format
msgid "The token response did not include an ID token: ~s"
msgstr "La réponse de jeton n’a pas inclus de jeton d’ID : ~s"
-#: src/scm/webid-oidc/client/accounts.scm:341
+#: src/scm/webid-oidc/client/accounts.scm:307
#, scheme-format
msgid "The token response did not include an access token: ~s\n"
msgstr "La réponse de jeton n’a pas inclus de jeton d’accès : ~s\n"
-#: src/scm/webid-oidc/client/accounts.scm:352
+#: src/scm/webid-oidc/client/accounts.scm:318
#, scheme-format
msgid "the ID token signature is invalid: ~a"
msgstr "la signature du jeton d’ID est invalide : ~a"
-#: src/scm/webid-oidc/client/accounts.scm:354
+#: src/scm/webid-oidc/client/accounts.scm:320
msgid "the ID token signature is invalid"
msgstr "la signature du jeton d’ID est invalide"
-#: src/scm/webid-oidc/client/accounts.scm:370
+#: src/scm/webid-oidc/client/accounts.scm:336
#, scheme-format
msgid "the ID token delivered by the identity provider for ~s has ~s as webid"
msgstr ""
"le jeton d’ID délivré par le fournisseur d’identité pour ~s a ~s pour webid"
-#: src/scm/webid-oidc/client/accounts.scm:380
+#: src/scm/webid-oidc/client/accounts.scm:346
#, scheme-format
msgid "The ID token delivered by the identity provider ~s is for issuer ~s."
msgstr ""
"Le jeton d’ID délivré par le fournisseur d’identité ~s est pour l’émetteur "
"~s."
-#: src/scm/webid-oidc/client/accounts.scm:395
+#: src/scm/webid-oidc/client/accounts.scm:361
msgid "The issuer is required."
msgstr "L’émetteur est requis."
-#: src/scm/webid-oidc/client/accounts.scm:400
+#: src/scm/webid-oidc/client/accounts.scm:366
msgid "The optional subject and required issuer should be strings or URI."
msgstr ""
"Le sujet optionnel et émetteur doivent être des chaînes de caractère ou des "
"URIs."
-#: src/scm/webid-oidc/client/accounts.scm:436
+#: src/scm/webid-oidc/client/accounts.scm:382
msgid "Cannot check the username and/or password."
msgstr "Impossible de vérifier le nom d’utilisateur et/ou le mot de passe."
-#: src/scm/webid-oidc/client/accounts.scm:446
+#: src/scm/webid-oidc/client/accounts.scm:392
msgid "The subject should be a string or URI."
msgstr "Le sujet doit être une chaîne de caractères ou une URI."
-#: src/scm/webid-oidc/client/accounts.scm:460
+#: src/scm/webid-oidc/client/accounts.scm:406
msgid "The issuer should be a string or URI."
msgstr "L’émetteur doit être une chaîne de caractères ou une URI."
@@ -476,7 +476,7 @@ msgstr ""
msgid "You already have an account for ~a issued by ~a."
msgstr "Vous avez déjà un compte pour ~a émis par ~a."
-#: src/scm/webid-oidc/client/client.scm:106
+#: src/scm/webid-oidc/client/client.scm:91
msgid ""
"Client ID and redirect URIs should be URIs, and key pair should be a key "
"pair.."
@@ -492,37 +492,37 @@ msgstr "Bonjour, le monde !\n"
msgid "Hello, world!"
msgstr "Bonjour, le monde !"
-#: src/scm/webid-oidc/dpop-proof.scm:110
+#: src/scm/webid-oidc/dpop-proof.scm:111
#, scheme-format
msgid "the DPoP proof is signed for ~s, but it is issued to ~s"
msgstr "la preuve DPoP est signée pour ~s, mais elle est émise pour ~s"
-#: src/scm/webid-oidc/dpop-proof.scm:155
+#: src/scm/webid-oidc/dpop-proof.scm:157
#, scheme-format
msgid "invalid DPoP proof: ~a"
msgstr "preuve DPoP invalide : ~a"
-#: src/scm/webid-oidc/dpop-proof.scm:157
+#: src/scm/webid-oidc/dpop-proof.scm:159
msgid "invalid DPoP proof token"
msgstr "jeton de preuve DPoP invalide"
-#: src/scm/webid-oidc/dpop-proof.scm:195
+#: src/scm/webid-oidc/dpop-proof.scm:197
msgid "#:typ should be exactly \"dpop+jwt\""
msgstr "#:typ doit être exactement « dpop+jwt »"
-#: src/scm/webid-oidc/dpop-proof.scm:200
+#: src/scm/webid-oidc/dpop-proof.scm:202
msgid "#:jwk should be a public key"
msgstr "#:jwk doit être une clé publique"
-#: src/scm/webid-oidc/dpop-proof.scm:205
+#: src/scm/webid-oidc/dpop-proof.scm:207
msgid "#:htm should be a symbol"
msgstr "#:htm doit être un symbole"
-#: src/scm/webid-oidc/dpop-proof.scm:211
+#: src/scm/webid-oidc/dpop-proof.scm:213
msgid "when present, #:ath should be a string"
msgstr "si présent, #:ath doit être une chaîne de caractères"
-#: src/scm/webid-oidc/dpop-proof.scm:232
+#: src/scm/webid-oidc/dpop-proof.scm:234
msgid ""
"when making a DPoP proof, either its required fields (#:typ, #:jwk, #:htm "
"and #:htu) or (#:jwt-header and #:jwt-payload) should be passed"
@@ -530,14 +530,14 @@ msgstr ""
"lors de la création d’une preuve DPoP, il faut passer soit les champs requis "
"(#:typ, #:jwk, #:htm et #:htu) soit (#:jwt-header et #:jwt-payload)"
-#: src/scm/webid-oidc/dpop-proof.scm:265
+#: src/scm/webid-oidc/dpop-proof.scm:267
#, scheme-format
msgid "the DPoP proof is signed for access through ~s, but it is used with ~s"
msgstr ""
"la preuve DPoP est signée pour un accès avec ~s, mais elle est utilisée avec "
"~s"
-#: src/scm/webid-oidc/dpop-proof.scm:275
+#: src/scm/webid-oidc/dpop-proof.scm:277
#, scheme-format
msgid ""
"the DPoP proof should go along with an access token hashed to ~s, not ~s"
@@ -545,16 +545,16 @@ msgstr ""
"la preuve DPoP devrait être accompagnée d’un jeton d’accès de condensat ~s, "
"pas ~s"
-#: src/scm/webid-oidc/dpop-proof.scm:283 src/scm/webid-oidc/dpop-proof.scm:290
+#: src/scm/webid-oidc/dpop-proof.scm:285 src/scm/webid-oidc/dpop-proof.scm:292
msgid "the DPoP proof is signed with the wrong key"
msgstr "la preuve DPoP est signée avec la mauvaise clé"
-#: src/scm/webid-oidc/dpop-proof.scm:288
+#: src/scm/webid-oidc/dpop-proof.scm:290
#, scheme-format
msgid "the DPoP proof is signed with the wrong key: ~a"
msgstr "la preuve DPoP est signée avec la mauvaise clé : ~a"
-#: src/scm/webid-oidc/dpop-proof.scm:299
+#: src/scm/webid-oidc/dpop-proof.scm:301
msgid "the cnf/check function returned #f"
msgstr "la fonction cnf/check a retourné #f"
@@ -946,63 +946,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:147
+#: src/scm/webid-oidc/jwk.scm:158
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:259
+#: src/scm/webid-oidc/jwk.scm:274
#, scheme-format
msgid "the JWK is invalid: ~a"
msgstr "le JWK est invalide : ~a"
-#: src/scm/webid-oidc/jwk.scm:261
+#: src/scm/webid-oidc/jwk.scm:276
msgid "the JWK is invalid"
msgstr "le JWK est invalide"
-#: src/scm/webid-oidc/jwk.scm:270
+#: src/scm/webid-oidc/jwk.scm:285
msgid "cannot compute the key type"
msgstr "impossible de calculer le type de clé"
-#: src/scm/webid-oidc/jwk.scm:331
+#: src/scm/webid-oidc/jwk.scm:346
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:339
+#: src/scm/webid-oidc/jwk.scm:354
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:381
+#: src/scm/webid-oidc/jwk.scm:396
#, 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:430
+#: src/scm/webid-oidc/jwk.scm:445
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:507
+#: src/scm/webid-oidc/jwk.scm:482
#, scheme-format
msgid "cannot fetch a JWKS: ~a"
msgstr "impossible de télécharger un JWKS : ~a"
-#: src/scm/webid-oidc/jwk.scm:509
+#: src/scm/webid-oidc/jwk.scm:484
msgid "cannot fetch a JWKS"
msgstr "impossible de télécharger un JWKS"
-#: src/scm/webid-oidc/jwk.scm:513
+#: src/scm/webid-oidc/jwk.scm:488
#, scheme-format
msgid "the request failed with ~s ~s"
msgstr "la requête a échoué avec ~s ~s"
-#: src/scm/webid-oidc/jwk.scm:518
+#: src/scm/webid-oidc/jwk.scm:493
msgid "missing content-type"
msgstr "type de contenu manquant"
-#: src/scm/webid-oidc/jwk.scm:523
+#: src/scm/webid-oidc/jwk.scm:498
#, scheme-format
msgid "invalid content-type: ~s"
msgstr "type de contenu invalide : ~s"
@@ -1020,15 +1020,15 @@ msgstr ""
"lors de la création d’un jeton il faut passer soit #:alg soit (#:jwt-header "
"et #:jwt-payload)"
-#: src/scm/webid-oidc/jws.scm:206
+#: src/scm/webid-oidc/jws.scm:214
msgid "#:iat should be a date"
msgstr "#:iat doit être une date"
-#: src/scm/webid-oidc/jws.scm:211
+#: src/scm/webid-oidc/jws.scm:219
msgid "#:exp should be a date"
msgstr "#:exp doit être une date"
-#: src/scm/webid-oidc/jws.scm:221
+#: src/scm/webid-oidc/jws.scm:229
msgid ""
"when making a time-bound token, either its required fields (#:iat, and "
"either #:exp or #:validity) or (#:jwt-header and #:jwt-payload) should be "
@@ -1038,11 +1038,11 @@ msgstr ""
"champs requis (#:iat et soit #:exp soit #:validity) soit (#:jwt-header et #:"
"jwt-payload)"
-#: src/scm/webid-oidc/jws.scm:249
+#: src/scm/webid-oidc/jws.scm:258
msgid "#:iss should be an URI"
msgstr "#:iss doit être une URI"
-#: src/scm/webid-oidc/jws.scm:260
+#: src/scm/webid-oidc/jws.scm:269
msgid ""
"when making an OIDC token, either its required #:iss field or (#:jwt-header "
"and #:jwt-payload) should be passed"
@@ -1050,11 +1050,11 @@ msgstr ""
"lors de la création d’un jeton OIDC, il faut passer soit le champs requis #:"
"iss soit (#:jwt-header et #:jwt-payload)"
-#: src/scm/webid-oidc/jws.scm:304
+#: src/scm/webid-oidc/jws.scm:314
msgid "#:nonce should be a string"
msgstr "#:nonce doit être une chaîne de caractères"
-#: src/scm/webid-oidc/jws.scm:313
+#: src/scm/webid-oidc/jws.scm:323
msgid ""
"when making a single-use token, either its required #:nonce field or (#:jwt-"
"header and #:jwt-payload) should be passed"
@@ -1062,11 +1062,11 @@ msgstr ""
"lors de la création d’un jeton à usage unique, il faut soit passer le champs "
"requis #:nonce soit (#:jwt-header et #:jwt-payload)"
-#: src/scm/webid-oidc/jws.scm:358
+#: src/scm/webid-oidc/jws.scm:368
msgid "the encoded JWS is not in 3 parts"
msgstr "le JWS encodé n’est pas en 3 parties"
-#: src/scm/webid-oidc/jws.scm:369
+#: src/scm/webid-oidc/jws.scm:379
#, scheme-format
msgid ""
"the encoded JWS header or payload is not a JSON object encoded in base64: ~a"
@@ -1074,91 +1074,87 @@ msgstr ""
"l’en-tête ou la charge utile du JWS encodé n’est pas un objet JSON encodé en "
"base64 : ~a"
-#: src/scm/webid-oidc/jws.scm:371
+#: src/scm/webid-oidc/jws.scm:381
msgid ""
"the encoded JWS header or payload is not a JSON object encoded in base64"
msgstr ""
"l’en-tête ou la charge utile du JWS encodé n’est pas un objet JSON encodé en "
"base64"
-#: src/scm/webid-oidc/jws.scm:430
+#: src/scm/webid-oidc/jws.scm:440
msgid "the JWS is not signed by any of the expected set of public keys"
msgstr "le JWS n’est signé par aucune des clés attendues"
-#: src/scm/webid-oidc/jws.scm:441
+#: src/scm/webid-oidc/jws.scm:451
#, scheme-format
msgid "while verifying the JWS signature: ~a"
msgstr "en vérifiant la signature du JWS : ~a"
-#: src/scm/webid-oidc/jws.scm:443
+#: src/scm/webid-oidc/jws.scm:453
msgid "an unexpected error happened while verifying a JWS"
msgstr "une erreur inattendue est survenue pendant la vérification d’un JWS"
-#: src/scm/webid-oidc/jws.scm:479
+#: src/scm/webid-oidc/jws.scm:489
#, scheme-format
msgid "I cannot query the identity provider configuration: ~a"
msgstr ""
"je ne peux pas requêter la configuration du fournisseur d’identité : ~a"
-#: src/scm/webid-oidc/jws.scm:481
+#: src/scm/webid-oidc/jws.scm:491
msgid "I cannot query the identity provider configuration"
msgstr "je ne peux pas requêter la configuration du fournisseur d’identité"
-#: src/scm/webid-oidc/jws.scm:497
+#: src/scm/webid-oidc/jws.scm:507
#, scheme-format
msgid "I cannot query the JWKS URI of the identity provider: ~a"
msgstr "je ne peux pas requêter l’URI de JWKS du fournisseur d’identité : ~a"
-#: src/scm/webid-oidc/jws.scm:499
+#: src/scm/webid-oidc/jws.scm:509
msgid "I cannot query the JWKS URI of the identity provider"
msgstr "impossible de requêter l’URI de JWKS du fournisseur d’identité"
-#: src/scm/webid-oidc/jws.scm:522
+#: src/scm/webid-oidc/jws.scm:532
#, scheme-format
msgid "the token is signed in the future, ~a, relative to current ~a"
msgstr ""
"le jeton est signé dans le futur, ~a, par rapport à la date courante, ~a"
-#: src/scm/webid-oidc/jws.scm:531
+#: src/scm/webid-oidc/jws.scm:541
#, scheme-format
msgid "the token expired ~a, which is in the past (from ~a)"
msgstr "le jeton a expiré le ~a, qui est dans le passé (depuis ~a)"
-#: src/scm/webid-oidc/jws.scm:554
+#: src/scm/webid-oidc/jws.scm:564
#, scheme-format
msgid "cannot decode a JWS: ~a"
msgstr "impossible de décoder un JWS : ~a"
-#: src/scm/webid-oidc/jws.scm:556
+#: src/scm/webid-oidc/jws.scm:566
msgid "cannot decode a JWS"
msgstr "impossible de décoder un JWS"
-#: src/scm/webid-oidc/jws.scm:574
+#: src/scm/webid-oidc/jws.scm:584
#, scheme-format
msgid "cannot encode a JWS: ~a"
msgstr "impossible d’encoder un JWS : ~a"
-#: src/scm/webid-oidc/jws.scm:576
+#: src/scm/webid-oidc/jws.scm:586
msgid "cannot encode a JWS"
msgstr "impossible d’encoder un JWS"
-#: src/scm/webid-oidc/jws.scm:623
-msgid "cannot parse a token"
-msgstr "impossible d’analyser le jeton"
-
-#: src/scm/webid-oidc/oidc-configuration.scm:118
+#: src/scm/webid-oidc/oidc-configuration.scm:121
msgid "#:jwks-uri should be an URI"
msgstr "#:jwks-uri doit être une URI"
-#: src/scm/webid-oidc/oidc-configuration.scm:123
+#: src/scm/webid-oidc/oidc-configuration.scm:126
msgid "#:token-endpoint should be an URI"
msgstr "#:token-endpoint doit être une URI"
-#: src/scm/webid-oidc/oidc-configuration.scm:128
+#: src/scm/webid-oidc/oidc-configuration.scm:131
msgid "#:authorization-endpoint should be an URI"
msgstr "#:authorization-endpoint doit être une URI"
-#: src/scm/webid-oidc/oidc-configuration.scm:133
+#: src/scm/webid-oidc/oidc-configuration.scm:136
msgid ""
"#:solid-oidc-supported should be exactly 'https://solidproject.org/TR/solid-"
"oidc'"
@@ -1166,34 +1162,34 @@ msgstr ""
"#:solid-oidc-supported doit être exactement « https://solidproject.org/TR/"
"solid-oidc »"
-#: src/scm/webid-oidc/oidc-configuration.scm:142
+#: src/scm/webid-oidc/oidc-configuration.scm:145
msgid "#:server should be an URI"
msgstr "#:server doit être une URI"
-#: src/scm/webid-oidc/oidc-configuration.scm:159
+#: src/scm/webid-oidc/oidc-configuration.scm:162
#, scheme-format
msgid "cannot fetch the OIDC configuration: ~a"
msgstr "impossible de télécharger la configuration OIDC : ~a"
-#: src/scm/webid-oidc/oidc-configuration.scm:161
+#: src/scm/webid-oidc/oidc-configuration.scm:164
msgid "cannot fetch the OIDC configuration"
msgstr "impossible de télécharger la configuration OIDC"
-#: src/scm/webid-oidc/oidc-configuration.scm:165
+#: src/scm/webid-oidc/oidc-configuration.scm:168
#, scheme-format
msgid "the server responded with ~s ~s"
msgstr "le serveur a répondu ~s ~s"
-#: src/scm/webid-oidc/oidc-configuration.scm:170
+#: src/scm/webid-oidc/oidc-configuration.scm:173
msgid "there is no content-type"
msgstr "il n’y a pas de type de contenu"
-#: src/scm/webid-oidc/oidc-configuration.scm:175
+#: src/scm/webid-oidc/oidc-configuration.scm:178
#, scheme-format
msgid "unexpected content-type: ~s"
msgstr "type de contenu inattendu : ~s"
-#: src/scm/webid-oidc/oidc-configuration.scm:185
+#: src/scm/webid-oidc/oidc-configuration.scm:188
msgid ""
"when making an OIDC configuration, either its required #:jwks-uri, #:"
"authorization-endpoint and #:token-endpoint fields or #:server or #:json-"
@@ -1203,24 +1199,24 @@ msgstr ""
"requis #:jwks-uri, #:authorization-endpoint et #:token-endpoint, soit #:"
"server, soit #:json-data"
-#: src/scm/webid-oidc/oidc-id-token.scm:70
+#: src/scm/webid-oidc/oidc-id-token.scm:80
#, scheme-format
msgid "invalid OIDC ID token: ~a"
msgstr "jeton d’identité OIDC invalide : ~a"
-#: src/scm/webid-oidc/oidc-id-token.scm:72
+#: src/scm/webid-oidc/oidc-id-token.scm:82
msgid "invalid OIDC id token"
msgstr "jeton d’identité OIDC invalide"
-#: src/scm/webid-oidc/oidc-id-token.scm:103
+#: src/scm/webid-oidc/oidc-id-token.scm:113
msgid "#:sub should be a string"
msgstr "#:sub doit être une chaîne de caractères"
-#: src/scm/webid-oidc/oidc-id-token.scm:108
+#: src/scm/webid-oidc/oidc-id-token.scm:118
msgid "#:aud should be a string"
msgstr "#:aud doit être une chaîne de caractères"
-#: src/scm/webid-oidc/oidc-id-token.scm:124
+#: src/scm/webid-oidc/oidc-id-token.scm:134
msgid ""
"when making an ID token either its required fields (#:alg, #:webid, #:iss, #:"
"sub, #:aud, #:iat and #:exp) or (#:jwt-header and #:jwt-payload) should be "
@@ -2251,10 +2247,28 @@ msgstr "Type de Média Non Supporté"
msgid "reason-phrase|Not Acceptable"
msgstr "Inacceptable"
-#: src/scm/webid-oidc/reverse-proxy.scm:57
+#: src/scm/webid-oidc/reverse-proxy.scm:58
msgid "#:endpoint argument is not present or not an URI."
msgstr "l’argument de #:endpoint n’est pas présent, ou pas une URI."
+#: src/scm/webid-oidc/serializable.scm:58
+msgid "a plugin class should have an explicit #:name and #:module-name"
+msgstr ""
+"une classe de plugin doit avoir un nom #:name et un nom de module #:module-"
+"name explicite"
+
+#: src/scm/webid-oidc/serializable.scm:61
+msgid "#:name should be a symbol"
+msgstr "#:name doit être un symbole"
+
+#: src/scm/webid-oidc/serializable.scm:71
+msgid "#:module-name should be a list of symbols"
+msgstr "#:module-name doit être une liste de symboles"
+
+#: src/scm/webid-oidc/serializable.scm:76
+msgid "plugin class names should be surrounded by <angle brackets>"
+msgstr "un nom de classe de plugin doit être entouré par des <chevrons>"
+
#: src/scm/webid-oidc/serve.scm:77
msgid "content negociation failed while serving a request"
msgstr "la négociation de contenu a échoué pour le service d’une requête"
@@ -2379,6 +2393,9 @@ msgstr ""
"<p>Vous voulez utiliser <pre>~s</pre> comme type d’offre, mais ce n’est pas "
"supporté.</p>"
+#~ msgid "cannot parse a token"
+#~ msgstr "impossible d’analyser le jeton"
+
#, scheme-format
#~ msgid "~a: Warning: loading XML catalog from the web, ~s.\n"
#~ msgstr "~a : Attention : chargement d’un catalogue XML depuis le web, ~s.\n"
diff --git a/src/scm/webid-oidc/Makefile.am b/src/scm/webid-oidc/Makefile.am
index 5ffac04..92429f7 100644
--- a/src/scm/webid-oidc/Makefile.am
+++ b/src/scm/webid-oidc/Makefile.am
@@ -49,7 +49,8 @@ dist_webidoidcmod_DATA += \
%reldir%/catalog.scm \
%reldir%/parameters.scm \
%reldir%/simulation.scm \
- %reldir%/web-i18n.scm
+ %reldir%/web-i18n.scm \
+ %reldir%/serializable.scm
webidoidcgo_DATA += \
%reldir%/errors.go \
@@ -86,7 +87,8 @@ webidoidcgo_DATA += \
%reldir%/catalog.go \
%reldir%/parameters.go \
%reldir%/simulation.go \
- %reldir%/web-i18n.go
+ %reldir%/web-i18n.go \
+ %reldir%/serializable.go
EXTRA_DIST += %reldir%/ChangeLog
diff --git a/src/scm/webid-oidc/access-token.scm b/src/scm/webid-oidc/access-token.scm
index d40e0da..9bd5ff7 100644
--- a/src/scm/webid-oidc/access-token.scm
+++ b/src/scm/webid-oidc/access-token.scm
@@ -19,6 +19,7 @@
#:use-module (webid-oidc errors)
#:use-module (webid-oidc jwk)
#:use-module (webid-oidc web-i18n)
+ #:use-module (webid-oidc serializable)
#:use-module ((webid-oidc stubs) #:prefix stubs:)
#:use-module ((webid-oidc parameters) #:prefix p:)
#:use-module (web uri)
@@ -55,10 +56,11 @@
invalid-access-token?)
(define-class <access-token> (<time-bound-token> <oidc-token>)
- (webid #:init-keyword #:webid #:accessor webid)
+ (webid #:init-keyword #:webid #:accessor webid #:->sxml uri->string)
(aud #:init-keyword #:aud #:accessor aud)
- (client-id #:init-keyword #:client-id #:accessor client-id)
- (cnf/jkt #:init-keyword #:cnf/jkt #:accessor cnf/jkt))
+ (client-id #:init-keyword #:client-id #:accessor client-id #:->sxml uri->string)
+ (cnf/jkt #:init-keyword #:cnf/jkt #:accessor cnf/jkt)
+ #:module-name '(webid-oidc access-token))
(define-method (initialize (token <access-token>) initargs)
(with-exception-handler
diff --git a/src/scm/webid-oidc/authorization-code.scm b/src/scm/webid-oidc/authorization-code.scm
index 13b7ac4..7abf68b 100644
--- a/src/scm/webid-oidc/authorization-code.scm
+++ b/src/scm/webid-oidc/authorization-code.scm
@@ -20,6 +20,7 @@
#:use-module (webid-oidc jws)
#:use-module (webid-oidc jwk)
#:use-module (webid-oidc jti)
+ #:use-module (webid-oidc serializable)
#:use-module ((webid-oidc parameters) #:prefix p:)
#:use-module (web uri)
#:use-module (srfi srfi-19)
@@ -55,8 +56,9 @@
invalid-authorization-code?)
(define-class <authorization-code> (<single-use-token>)
- (webid #:init-keyword #:webid #:accessor webid)
- (client-id #:init-keyword #:client-id #:accessor client-id))
+ (webid #:init-keyword #:webid #:accessor webid #:->sxml uri->string)
+ (client-id #:init-keyword #:client-id #:accessor client-id #:->sxml uri->string)
+ #:module-name '(webid-oidc authorization-code))
(define-method (initialize (token <authorization-code>) initargs)
(with-exception-handler
diff --git a/src/scm/webid-oidc/client.scm b/src/scm/webid-oidc/client.scm
index 7eb8fe3..ab40a7c 100644
--- a/src/scm/webid-oidc/client.scm
+++ b/src/scm/webid-oidc/client.scm
@@ -53,8 +53,6 @@
(client:client . client)
(account:authorization-process . authorization-process)
(account:authorization-state . authorization-state)
-
- (client:->sexp . ->sexp)
)
#:export
(
diff --git a/src/scm/webid-oidc/client/accounts.scm b/src/scm/webid-oidc/client/accounts.scm
index 31d105d..9546263 100644
--- a/src/scm/webid-oidc/client/accounts.scm
+++ b/src/scm/webid-oidc/client/accounts.scm
@@ -28,6 +28,7 @@
#:use-module (webid-oidc errors)
#:use-module (webid-oidc web-i18n)
#:use-module (webid-oidc jws)
+ #:use-module (webid-oidc serializable)
#:use-module ((webid-oidc parameters) #:prefix p:)
#:use-module ((webid-oidc stubs) #:prefix stubs:)
#:use-module ((webid-oidc oidc-id-token) #:prefix id:)
@@ -80,8 +81,6 @@
invalidate-access-token
invalidate-refresh-token
refresh
-
- ->sexp
)
#:declarative? #t)
@@ -128,12 +127,14 @@
(make-parameter #f))
(define-class <account> ()
- (subject #:init-keyword #:subject #:getter subject)
- (issuer #:init-keyword #:issuer #:getter issuer)
+ (subject #:init-keyword #:subject #:getter subject #:->sxml uri->string)
+ (issuer #:init-keyword #:issuer #:getter issuer #:->sxml uri->string)
(id-token #:init-keyword #:id-token #:getter id-token #:init-value #f)
(access-token #:init-keyword #:access-token #:getter access-token #:init-value #f)
(refresh-token #:init-keyword #:refresh-token #:getter refresh-token #:init-value #f)
- (key-pair #:init-keyword #:key-pair #:getter key-pair))
+ (key-pair #:init-keyword #:key-pair #:getter key-pair)
+ #:metaclass <plugin-class>
+ #:module-name '(webid-oidc client accounts))
(define-method (equal? (a <account>) (b <account>))
(and (equal? (subject a) (subject b))
@@ -143,41 +144,6 @@
(equal? (refresh-token a) (refresh-token b))
(equal? (key-pair a) (key-pair b))))
-(define-method (->sexp (account <account>))
- `(begin
- (use-modules (oop goops) (webid-oidc client accounts) (webid-oidc jwk) (webid-oidc jws) (webid-oidc oidc-id-token))
- (make <account>
- #:subject ,(uri->string (subject account))
- #:issuer ,(uri->string (issuer account))
- ,@(let ((id-token (id-token account)))
- (if id-token
- (receive (header payload) (token->jwk id-token)
- `(#:id-token (make <id-token>
- #:jws-header (quote ,header)
- #:jws-payload (quote ,payload))))
- '()))
- ,@(let ((access-token (access-token account)))
- (if access-token
- `(#:access-token ,access-token)
- '()))
- ,@(let ((refresh-token (refresh-token account)))
- (if refresh-token
- `(#:refresh-token ,refresh-token)
- '()))
- #:key-pair (jwk->key (quote ,(key->jwk (key-pair account)))))))
-
-(define-method (write (account <account>) port)
- (let ((code (->sexp account)))
- (pretty-print code port)))
-
-(define-method (display (account <account>) port)
- (format port "#<<account> subject=~a issuer=~a id-token?=~a access-token?=~a refresh-token?=~a>"
- (uri->string (subject account))
- (uri->string (issuer account))
- (and (id-token account) #t)
- (and (access-token account) #t)
- (and (refresh-token account) #t)))
-
(define-exception-type
&login-failed
&external-error
@@ -403,28 +369,8 @@
(define-class <protected-account> (<account>)
(username #:init-keyword #:username #:getter username)
- (encrypted-password #:init-keyword #:encrypted-password #:getter encrypted-password))
-
-(define-method (->sexp (account <protected-account>))
- (match (next-method)
- (('begin
- '(use-modules (oop goops) (webid-oidc client accounts))
- ('make '<account> initializers ...))
- `(begin
- (use-modules (oop goops) (webid-oidc client accounts))
- (make <protected-account>
- #:username ,(username account)
- #:encrypted-password ,(encrypted-password account)
- ,@initializers)))))
-
-(define-method (display (account <protected-account>) port)
- (format port "#<<protected-account> subject=~a issuer=~a username=~a id-token?=~a access-token?=~a refresh-token?=~a>"
- (uri->string (subject account))
- (uri->string (issuer account))
- (username account)
- (and (id-token account) #t)
- (and (access-token account) #t)
- (and (refresh-token account) #t)))
+ (encrypted-password #:init-keyword #:encrypted-password #:getter encrypted-password)
+ #:module-name '(webid-oidc client accounts))
(define-method (check-credentials (account <protected-account>) (username <string>) (password <string>))
(let ((c (crypt password (encrypted-password account))))
diff --git a/src/scm/webid-oidc/client/client.scm b/src/scm/webid-oidc/client/client.scm
index 3d02630..7c54cad 100644
--- a/src/scm/webid-oidc/client/client.scm
+++ b/src/scm/webid-oidc/client/client.scm
@@ -20,6 +20,7 @@
#:use-module (webid-oidc oidc-id-token)
#:use-module (webid-oidc dpop-proof)
#:use-module (webid-oidc web-i18n)
+ #:use-module (webid-oidc serializable)
#:use-module ((webid-oidc jwk) #:prefix jwk:)
#:use-module ((webid-oidc parameters) #:prefix p:)
#:use-module ((webid-oidc stubs) #:prefix stubs:)
@@ -51,33 +52,17 @@
client-redirect-uri
client
-
- ->sexp
)
#:declarative? #t)
(define <jwk:key-pair> jwk:<key-pair>)
(define-class <client> ()
- (client-id #:init-keyword #:client-id #:getter client-id)
+ (client-id #:init-keyword #:client-id #:getter client-id #:->sxml uri->string)
(key-pair #:init-keyword #:key-pair #:getter client-key-pair)
- (redirect-uri #:init-keyword #:redirect-uri #:getter client-redirect-uri))
-
-(define-method (->sexp (client <client>))
- `(begin
- (use-modules (oop goops) (webid-oidc client) (webid-oidc jwk))
- (make <client>
- #:client-id ,(uri->string (client-id client))
- #:key-pair (jwk->key (quote ,(key->jwk (client-key-pair client))))
- #:redirect-uri ,(uri->string (client-redirect-uri client)))))
-
-(define-method (write (client <client>) port)
- (pretty-print (->sexp client) port))
-
-(define-method (display (client <client>) port)
- (format port "#<<client> client-id=~a redirect-uri=~a>"
- (uri->string (client-id client))
- (uri->string (client-redirect-uri client))))
+ (redirect-uri #:init-keyword #:redirect-uri #:getter client-redirect-uri #:->sxml uri->string)
+ #:metaclass <plugin-class>
+ #:module-name '(webid-oidc client client))
(define-method (initialize (client <client>) initargs)
(next-method)
diff --git a/src/scm/webid-oidc/dpop-proof.scm b/src/scm/webid-oidc/dpop-proof.scm
index c492436..f8d97c3 100644
--- a/src/scm/webid-oidc/dpop-proof.scm
+++ b/src/scm/webid-oidc/dpop-proof.scm
@@ -19,6 +19,7 @@
#:use-module (webid-oidc errors)
#:use-module (webid-oidc jwk)
#:use-module (webid-oidc jti)
+ #:use-module (webid-oidc serializable)
#:use-module ((webid-oidc stubs) #:prefix stubs:)
#:use-module ((webid-oidc parameters) #:prefix p:)
#:use-module (webid-oidc web-i18n)
@@ -132,8 +133,9 @@
(typ #:init-keyword #:typ #:accessor typ)
(jwk #:init-keyword #:jwk #:accessor jwk)
(htm #:init-keyword #:htm #:accessor htm)
- (htu #:init-keyword #:htu #:accessor htu)
- (ath #:init-keyword #:ath #:accessor ath))
+ (htu #:init-keyword #:htu #:accessor htu #:->sxml uri->string)
+ (ath #:init-keyword #:ath #:accessor ath)
+ #:module-name '(webid-oidc dpop-proof))
(define-method (default-validity (proof <dpop-proof>))
(p:dpop-proof-validity))
diff --git a/src/scm/webid-oidc/jwk.scm b/src/scm/webid-oidc/jwk.scm
index 04e50f2..661db1c 100644
--- a/src/scm/webid-oidc/jwk.scm
+++ b/src/scm/webid-oidc/jwk.scm
@@ -19,6 +19,7 @@
#:use-module ((webid-oidc parameters) #:prefix p:)
#:use-module (webid-oidc errors)
#:use-module (webid-oidc web-i18n)
+ #:use-module (webid-oidc serializable)
#:use-module (ice-9 receive)
#:use-module (ice-9 optargs)
#:use-module (ice-9 exceptions)
@@ -51,8 +52,6 @@
generate-key
serve
get-jwks
- ->sxml
- sxml->key
&not-a-jwk
make-not-a-jwk
@@ -76,18 +75,26 @@
not-a-jwks?)
(define-class <private-key> ()
- (alg #:init-keyword #:alg #:accessor alg))
+ (alg #:init-keyword #:alg #:accessor alg)
+ #:metaclass <plugin-class>
+ #:module-name '(webid-oidc jwk))
-(define-class <public-key> ())
+(define-class <public-key> ()
+ #:metaclass <plugin-class>
+ #:module-name '(webid-oidc jwk))
(define-class <key-pair> ()
(public-key #:init-keyword #:public-key #:accessor public-key)
- (private-key #:init-keyword #:private-key #:accessor private-key))
+ (private-key #:init-keyword #:private-key #:accessor private-key)
+ #:metaclass <plugin-class>
+ #:module-name '(webid-oidc jwk))
-(define-class <rsa-key-pair> (<key-pair>))
+(define-class <rsa-key-pair> (<key-pair>)
+ #:module-name '(webid-oidc jwk))
(define-class <ec-key-pair> (<key-pair>)
- (crv #:init-keyword #:crv #:accessor ec-crv))
+ (crv #:init-keyword #:crv #:accessor ec-crv)
+ #:module-name '(webid-oidc jwk))
(define-class <rsa-private-key> (<private-key>)
(d #:init-keyword #:d #:accessor rsa-d)
@@ -95,20 +102,24 @@
(q #:init-keyword #:q #:accessor rsa-q)
(dp #:init-keyword #:dp #:accessor rsa-dp)
(dq #:init-keyword #:dq #:accessor rsa-dq)
- (qi #:init-keyword #:qi #:accessor rsa-qi))
+ (qi #:init-keyword #:qi #:accessor rsa-qi)
+ #:module-name '(webid-oidc jwk))
(define-class <rsa-public-key> (<public-key>)
(n #:init-keyword #:n #:accessor rsa-n)
- (e #:init-keyword #:e #:accessor rsa-e))
+ (e #:init-keyword #:e #:accessor rsa-e)
+ #:module-name '(webid-oidc jwk))
(define-class <ec-scalar> (<private-key>)
(crv #:init-keyword #:crv #:accessor ec-crv)
- (z #:init-keyword #:z #:accessor ec-z))
+ (z #:init-keyword #:z #:accessor ec-z)
+ #:module-name '(webid-oidc jwk))
(define-class <ec-point> (<public-key>)
(crv #:init-keyword #:crv #:accessor ec-crv)
(x #:init-keyword #:x #:accessor ec-x)
- (y #:init-keyword #:y #:accessor ec-y))
+ (y #:init-keyword #:y #:accessor ec-y)
+ #:module-name '(webid-oidc jwk))
(define-method (initialize-key-pair (key <key-pair>) (public <rsa-public-key>) (private <rsa-private-key>))
(set! (public-key key) public)
@@ -439,46 +450,6 @@
(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))
diff --git a/src/scm/webid-oidc/jws.scm b/src/scm/webid-oidc/jws.scm
index e0eba54..7e6b15d 100644
--- a/src/scm/webid-oidc/jws.scm
+++ b/src/scm/webid-oidc/jws.scm
@@ -20,6 +20,7 @@
#:use-module (webid-oidc web-i18n)
#:use-module (webid-oidc jti)
#:use-module (webid-oidc oidc-configuration)
+ #:use-module (webid-oidc serializable)
#:use-module ((webid-oidc stubs) #:prefix stubs:)
#:use-module ((webid-oidc parameters) #:prefix p:)
#:use-module (rnrs bytevectors)
@@ -84,9 +85,6 @@
encode
issue
- ->sxml
- sxml->token
-
))
(define-exception-type
@@ -96,7 +94,9 @@
invalid-jws?)
(define-class <token> ()
- (alg #:init-keyword #:alg #:accessor alg))
+ (alg #:init-keyword #:alg #:accessor alg)
+ #:metaclass <plugin-class>
+ #:module-name '(webid-oidc jws))
(define (key-alg key)
(alg key))
@@ -151,9 +151,13 @@
(define-method (no-applicable-method (generic <generic-with-default>) args)
(apply values (slot-ref generic 'neutral)))
+(define (date->sxml date)
+ (number->string (time-second (date->time-utc date))))
+
(define-class <time-bound-token> (<token>)
- (iat #:init-keyword #:iat #:accessor iat)
- (exp #:init-keyword #:exp #:accessor exp))
+ (iat #:init-keyword #:iat #:accessor iat #:->sxml date->sxml)
+ (exp #:init-keyword #:exp #:accessor exp #:->sxml date->sxml)
+ #:module-name '(webid-oidc jws))
(define default-validity
(make <generic-with-default>
@@ -180,6 +184,8 @@
(jwt-header jwt-header)
(jwt-payload jwt-payload))
(cond
+ ((string? iat)
+ (do-initialize (string->number iat) exp validity jwt-header jwt-payload))
((integer? iat)
(do-initialize (make-time time-utc 0 iat) exp validity jwt-header jwt-payload))
((time? iat)
@@ -191,6 +197,8 @@
validity
jwt-header
jwt-payload))
+ ((string? exp)
+ (do-initialize iat (string->number exp) validity jwt-header jwt-payload))
((integer? exp)
(do-initialize iat (make-time time-utc 0 exp) validity jwt-header jwt-payload))
((time? exp)
@@ -221,7 +229,8 @@
(G_ "when making a time-bound token, either its required fields (#:iat, and either #:exp or #:validity) or (#:jwt-header and #:jwt-payload) should be passed")))))))))
(define-class <oidc-token> (<token>)
- (iss #:init-keyword #:iss #:accessor iss))
+ (iss #:init-keyword #:iss #:accessor iss #:->sxml uri->string)
+ #:module-name '(webid-oidc jws))
(define-method (default-validity (token <oidc-token>))
(let ((next (next-method))
@@ -260,7 +269,8 @@
(G_ "when making an OIDC token, either its required #:iss field or (#:jwt-header and #:jwt-payload) should be passed")))))))))
(define-class <single-use-token> (<time-bound-token>)
- (nonce #:init-keyword #:nonce #:accessor nonce))
+ (nonce #:init-keyword #:nonce #:accessor nonce)
+ #:module-name '(webid-oidc jws))
(define-method (default-validity (token <single-use-token>))
(let ((next (next-method))
@@ -591,35 +601,3 @@
(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))))))
diff --git a/src/scm/webid-oidc/oidc-configuration.scm b/src/scm/webid-oidc/oidc-configuration.scm
index d0d1e20..094bf8a 100644
--- a/src/scm/webid-oidc/oidc-configuration.scm
+++ b/src/scm/webid-oidc/oidc-configuration.scm
@@ -18,6 +18,7 @@
#:use-module (webid-oidc jwk)
#:use-module (webid-oidc errors)
#:use-module (webid-oidc web-i18n)
+ #:use-module (webid-oidc serializable)
#:use-module ((webid-oidc stubs) #:prefix stubs:)
#:use-module ((webid-oidc parameters) #:prefix p:)
#:use-module (web uri)
@@ -53,9 +54,11 @@
invalid-oidc-configuration?)
(define-class <oidc-configuration> ()
- (jwks-uri #:init-keyword #:jwks-uri #:accessor jwks-uri)
- (authorization-endpoint #:init-keyword #:authorization-endpoint #:accessor authorization-endpoint)
- (token-endpoint #:init-keyword #:token-endpoint #:accessor token-endpoint))
+ (jwks-uri #:init-keyword #:jwks-uri #:accessor jwks-uri #:->jwks uri->string)
+ (authorization-endpoint #:init-keyword #:authorization-endpoint #:accessor authorization-endpoint #:->jwks uri->string)
+ (token-endpoint #:init-keyword #:token-endpoint #:accessor token-endpoint #:->jwks uri->string)
+ #:metaclass <plugin-class>
+ #:module-name '(webid-oidc oidc-configuration))
(define-method (initialize (cfg <oidc-configuration>) initargs)
(next-method)
diff --git a/src/scm/webid-oidc/oidc-id-token.scm b/src/scm/webid-oidc/oidc-id-token.scm
index 19e22d7..17a3299 100644
--- a/src/scm/webid-oidc/oidc-id-token.scm
+++ b/src/scm/webid-oidc/oidc-id-token.scm
@@ -20,6 +20,7 @@
#:use-module (webid-oidc jwk)
#:use-module (webid-oidc jti)
#:use-module (webid-oidc web-i18n)
+ #:use-module (webid-oidc serializable)
#:use-module ((webid-oidc stubs) #:prefix stubs:)
#:use-module ((webid-oidc parameters) #:prefix p:)
#:use-module (web uri)
@@ -55,9 +56,18 @@
invalid-id-token?)
(define-class <id-token> (<single-use-token> <oidc-token>)
- (webid #:init-keyword #:webid #:accessor webid)
+ (webid #:init-keyword #:webid #:accessor webid #:->sxml uri->string)
(sub #:init-keyword #:sub #:accessor sub)
- (aud #:init-keyword #:aud #:accessor aud))
+ (aud #:init-keyword #:aud #:accessor aud #:->sxml uri->string)
+ #:metaclass <plugin-class>
+ #:module-name '(webid-oidc oidc-id-token))
+
+(define-method (equal? (x <id-token>) (y <id-token>))
+ (and (equal? (alg x) (alg y))
+ (equal? (iat x) (iat y))
+ (equal? ((@ (webid-oidc jws) exp) x) ((@ (webid-oidc jws) exp) y))
+ (equal? (nonce x) (nonce y))
+ (equal? (iss x) (iss y))))
(define-method (initialize (token <id-token>) initargs)
(with-exception-handler
diff --git a/src/scm/webid-oidc/serializable.scm b/src/scm/webid-oidc/serializable.scm
new file mode 100644
index 0000000..f05206c
--- /dev/null
+++ b/src/scm/webid-oidc/serializable.scm
@@ -0,0 +1,207 @@
+;; disfluid, implementation of the Solid specification
+;; Copyright (C) 2021 Vivien Kraus
+
+;; This program is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU Affero General Public License as
+;; published by the Free Software Foundation, either version 3 of the
+;; License, or (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU Affero General Public License for more details.
+
+;; You should have received a copy of the GNU Affero General Public License
+;; along with this program. If not, see <https://www.gnu.org/licenses/>.
+
+(define-module (webid-oidc serializable)
+ #:use-module (oop goops)
+ #:use-module (ice-9 optargs)
+ #:use-module (ice-9 match)
+ #:use-module (ice-9 receive)
+ #:use-module (webid-oidc web-i18n)
+ #:use-module (webid-oidc errors)
+ #:use-module (sxml ssax)
+ #:use-module (srfi srfi-1)
+ #:use-module (srfi srfi-26)
+ #:use-module (web uri)
+ #:declarative? #t
+ #:export
+ (
+ <plugin-class> module-name direct-name
+ read/xml
+ ->sxml
+ ))
+
+(define-class <plugin-class> (<class>)
+ (module-name #:init-keyword #:module-name #:getter module-name)
+ (direct-name #:getter direct-name))
+
+(define (check-class-name name)
+ (let ((chars (string->list (symbol->string name))))
+ (match chars
+ ((#\< next-chars ...)
+ (let ((rev (reverse next-chars)))
+ (match rev
+ ((#\> middle-chars ...)
+ (string->symbol (list->string (reverse middle-chars))))
+ (else #f))))
+ (else #f))))
+
+(define-method (initialize (class <plugin-class>) initargs)
+ (next-method)
+ (let-keywords
+ initargs #t
+ ((module-name #f)
+ (name #f))
+ (unless (and name module-name)
+ (fail (G_ "a plugin class should have an explicit #:name and #:module-name")))
+ (unless (symbol? name)
+ (scm-error 'wrong-type-arg "make"
+ (G_ "#:name should be a symbol")
+ '()
+ (list name)))
+ (let check-module-name ((module-name module-name))
+ (match module-name
+ (() #t)
+ (((? symbol? hd) tl ...)
+ (check-module-name tl))
+ (else
+ (scm-error 'wrong-type-arg "make"
+ (G_ "#:module-name should be a list of symbols")
+ '()
+ (list module-name)))))
+ (let ((direct-name (check-class-name name)))
+ (unless direct-name
+ (fail (G_ "plugin class names should be surrounded by <angle brackets>")))
+ (slot-set! class 'direct-name direct-name))
+ (slot-set! class 'module-name module-name)))
+
+(define-class <parser-state> ())
+
+(define-class <parser-reading-element> (<parser-state>)
+ (namespace #:init-keyword #:namespace #:accessor namespace)
+ (init-class #:init-keyword #:init-class #:accessor init-class)
+ (init-args-reverse #:init-keyword #:init-args-reverse #:accessor init-args-reverse))
+
+(define-class <parser-reading-extended-attribute> (<parser-state>)
+ (attribute-name #:init-keyword #:attribute-name #:accessor attribute-name)
+ (attribute-value #:init-keyword #:attribute-value #:accessor attribute-value #:init-value #f))
+
+(define-class <parser-root> (<parser-reading-extended-attribute>))
+
+(define-method (new-level-seed elem-gi attributes namespaces expected-content (state <parser-reading-extended-attribute>))
+ (match elem-gi
+ ((namespace . local-name)
+ (let ((namespace-parsed
+ (map string->symbol
+ (split-and-decode-uri-path (symbol->string namespace))))
+ (local-name
+ (string->symbol
+ (string-append "<" (symbol->string local-name) ">"))))
+ (let ((class
+ (module-ref (resolve-interface namespace-parsed) local-name))
+ (initargs (reverse attributes)))
+ (make <parser-reading-element>
+ #:namespace namespace
+ #:init-class class
+ #:init-args-reverse initargs))))
+ (else state)))
+
+(define-method (new-level-seed elem-gi attributes namespaces expected-content (state <parser-reading-element>))
+ (match elem-gi
+ (((? (cute eq? <> (namespace state))) . local-name)
+ (make <parser-reading-extended-attribute>
+ #:attribute-name local-name))
+ (else state)))
+
+(define-method (finish-element elem-gi attributes namespaces (parent-seed <parser-reading-element>) (seed <parser-reading-extended-attribute>))
+ (let ((ret (shallow-clone parent-seed)))
+ (set! (init-args-reverse ret)
+ `((,(attribute-name seed) . ,(attribute-value seed))
+ ,@(init-args-reverse ret)))
+ ret))
+
+(define-method (finish-element elem-gi attributes namespaces (parent-seed <parser-reading-extended-attribute>) (seed <parser-reading-element>))
+ (let* ((class (init-class seed))
+ (with-slots
+ (filter-map
+ (match-lambda
+ ((name . value)
+ (let ((slot (class-slot-definition class name)))
+ (and slot `(,slot . ,value)))))
+ (reverse (init-args-reverse seed))))
+ (initializable/non-initializable
+ (receive (initializable non-initializable)
+ (partition (match-lambda
+ ((slot . value)
+ (slot-definition-init-keyword slot)))
+ with-slots)
+ (let collect-initializable ((initializable initializable)
+ (collected '()))
+ (match initializable
+ (()
+ `(,(reverse collected)
+ . ,(map (match-lambda
+ ((slot . value)
+ (lambda (x)
+ (slot-set! x (slot-definition-name slot) value))))
+ non-initializable)))
+ (((slot . value) initializable ...)
+ (collect-initializable
+ initializable
+ `(,value ,(slot-definition-init-keyword slot) ,@collected)))))))
+ (initializable (car initializable/non-initializable))
+ (non-initializable (cdr initializable/non-initializable)))
+ (let ((object (apply make class initializable)))
+ (for-each (lambda (finish!) (finish! object)) non-initializable)
+ (let ((ret (shallow-clone parent-seed)))
+ (set! (attribute-value ret) object)
+ ret))))
+
+(define-method (char-data-handler string1 string2 (seed <parser-reading-extended-attribute>))
+ (match (attribute-value seed)
+ ((or (? not (= (const "") existing))
+ (? string? existing))
+ (let ((ret (shallow-clone seed)))
+ (set! (attribute-value ret)
+ (string-append
+ existing
+ string1
+ string2))
+ ret))
+ (else seed)))
+
+(define-method (char-data-handler string1 string2 (seed <parser-reading-element>))
+ seed)
+
+(define read/xml
+ (let ((parser
+ (ssax:make-parser
+ NEW-LEVEL-SEED new-level-seed
+ FINISH-ELEMENT finish-element
+ CHAR-DATA-HANDLER char-data-handler)))
+ (lambda (port)
+ (attribute-value (parser port (make <parser-root>))))))
+
+(define (->sxml object)
+ (let ((class (class-of object)))
+ (if (is-a? class <plugin-class>)
+ (let ((namespace
+ (encode-and-join-uri-path
+ (map symbol->string (module-name class)))))
+ (let ((all-slots (class-slots class)))
+ (define (get-slot-value slot)
+ (let ((name (slot-definition-name slot)))
+ (let-keywords
+ (slot-definition-options slot) #t
+ ((->sxml ->sxml))
+ (catch 'slot-unbound
+ (lambda ()
+ (let ((value (slot-ref object name)))
+ `((,name ,(->sxml value)))))
+ (lambda _
+ '())))))
+ `(,(direct-name class) (@ (xmlns ,namespace))
+ ,@(apply append (map get-slot-value all-slots)))))
+ (call-with-output-string (lambda (port) (display object port))))))
diff --git a/tests/Makefile.am b/tests/Makefile.am
index 99c834d..2f5c1d6 100644
--- a/tests/Makefile.am
+++ b/tests/Makefile.am
@@ -65,7 +65,8 @@ TESTS = %reldir%/load-library.scm \
%reldir%/acl.scm \
%reldir%/crud.scm \
%reldir%/preconditions.scm \
- %reldir%/xml-keys.scm
+ %reldir%/xml-keys.scm \
+ %reldir%/xml-accounts.scm
EXTRA_DIST += $(TESTS) %reldir%/ChangeLog
diff --git a/tests/dpop-proof-no-explicit-exp.scm b/tests/dpop-proof-no-explicit-exp.scm
index 5a4ccbc..83541a2 100644
--- a/tests/dpop-proof-no-explicit-exp.scm
+++ b/tests/dpop-proof-no-explicit-exp.scm
@@ -14,22 +14,25 @@
;; You should have received a copy of the GNU Affero General Public License
;; along with this program. If not, see <https://www.gnu.org/licenses/>.
-(use-modules (webid-oidc dpop-proof)
- (webid-oidc access-token)
- (webid-oidc jwk)
- (webid-oidc jws)
- (webid-oidc testing)
- (webid-oidc errors)
- ((webid-oidc stubs) #:prefix stubs:)
- ((webid-oidc parameters) #:prefix p:)
- (web uri)
- (srfi srfi-19)
- (web response)
- (ice-9 receive)
- (ice-9 optargs)
- (oop goops))
+(define-module (tests dpop-proof-no-explicit-exp)
+ #:use-module (webid-oidc dpop-proof)
+ #:use-module (webid-oidc access-token)
+ #:use-module (webid-oidc jwk)
+ #:use-module (webid-oidc jws)
+ #:use-module (webid-oidc testing)
+ #:use-module (webid-oidc errors)
+ #:use-module ((webid-oidc stubs) #:prefix stubs:)
+ #:use-module ((webid-oidc parameters) #:prefix p:)
+ #:use-module (web uri)
+ #:use-module (srfi srfi-19)
+ #:use-module (web response)
+ #:use-module (ice-9 receive)
+ #:use-module (ice-9 optargs)
+ #:use-module (oop goops)
+ #:declarative? #t)
-(define-class <dpop-proof-with-exp> (<dpop-proof>))
+(define-class <dpop-proof-with-exp> (<dpop-proof>)
+ #:module-name '(tests dpop-proof-no-explicit-exp))
(define-method (initialize (token <dpop-proof-with-exp>) initargs)
(next-method)
diff --git a/tests/dpop-proof-no-explicit-iat.scm b/tests/dpop-proof-no-explicit-iat.scm
index 671dfa0..7c09195 100644
--- a/tests/dpop-proof-no-explicit-iat.scm
+++ b/tests/dpop-proof-no-explicit-iat.scm
@@ -14,22 +14,25 @@
;; You should have received a copy of the GNU Affero General Public License
;; along with this program. If not, see <https://www.gnu.org/licenses/>.
-(use-modules (webid-oidc dpop-proof)
- (webid-oidc access-token)
- (webid-oidc jwk)
- (webid-oidc jws)
- (webid-oidc testing)
- (webid-oidc errors)
- ((webid-oidc stubs) #:prefix stubs:)
- ((webid-oidc parameters) #:prefix p:)
- (web uri)
- (srfi srfi-19)
- (web response)
- (ice-9 receive)
- (ice-9 match)
- (oop goops))
+(define-module (tests dpop-proof-no-explicit-iat)
+ #:use-module (webid-oidc dpop-proof)
+ #:use-module (webid-oidc access-token)
+ #:use-module (webid-oidc jwk)
+ #:use-module (webid-oidc jws)
+ #:use-module (webid-oidc testing)
+ #:use-module (webid-oidc errors)
+ #:use-module ((webid-oidc stubs) #:prefix stubs:)
+ #:use-module ((webid-oidc parameters) #:prefix p:)
+ #:use-module (web uri)
+ #:use-module (srfi srfi-19)
+ #:use-module (web response)
+ #:use-module (ice-9 receive)
+ #:use-module (ice-9 match)
+ #:use-module (oop goops)
+ #:declarative? #t)
-(define-class <dpop-proof-without-iat> (<dpop-proof>))
+(define-class <dpop-proof-without-iat> (<dpop-proof>)
+ #:module-name '(tests dpop-proof-no-explicit-iat))
(define malicious-jwt-created? #f)
diff --git a/tests/xml-accounts.scm b/tests/xml-accounts.scm
new file mode 100644
index 0000000..3a30dac
--- /dev/null
+++ b/tests/xml-accounts.scm
@@ -0,0 +1,116 @@
+;; disfluid, implementation of the Solid specification
+;; Copyright (C) 2021 Vivien Kraus
+
+;; This program is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU Affero General Public License as
+;; published by the Free Software Foundation, either version 3 of the
+;; License, or (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU Affero General Public License for more details.
+
+;; You should have received a copy of the GNU Affero General Public License
+;; along with this program. If not, see <https://www.gnu.org/licenses/>.
+
+(use-modules (webid-oidc client accounts)
+ (webid-oidc jwk)
+ (webid-oidc oidc-id-token)
+ (sxml simple)
+ (webid-oidc testing)
+ (webid-oidc serializable)
+ (web uri)
+ (oop goops))
+
+(define (xml->account xml)
+ (call-with-input-string xml read/xml))
+
+(with-test-environment
+ "xml-accounts"
+ (lambda ()
+ (let ((account-xml
+ "<?xml version=\"1.0\" encoding=\"utf-8\"?>
+<account xmlns=\"webid-oidc/client/accounts\"
+ subject=\"https://example.com/profile/card#me\"
+ issuer=\"https://example.com\"
+ access-token=\"xxx\"
+ refresh-token=\"xxx\">
+ <id-token>
+ <id-token xmlns=\"webid-oidc/oidc-id-token\"
+ alg=\"RS256\"
+ webid=\"https://example.com/profile/card#me\"
+ iss=\"https://example.com\"
+ sub=\"toto\"
+ aud=\"https://client.example.com/app-id\"
+ iat=\"0\"
+ exp=\"3600\"
+ nonce=\"xxxxx\" />
+ </id-token>
+ <key-pair>
+ <rsa-key-pair xmlns=\"webid-oidc/jwk\">
+ <public-key>
+ <rsa-public-key
+ n=\"zopuG9oxFDbs6dntfGBBm6F1tU4Cy80lWpMOL3Je1ks9RHixn8_vlswdW-YM_jUdfhdH4VdQ5ergV2flOtTZ3agVGxMZWtdS8WxKNkmeyr1mVchRB7Hzl1kLYWClkBeoQ2Bi3vDCxTsdz9q3x7610wnRbcAHhtxq_Wm4vlYqXm7MJ5eMXzAdkNaBMgjt38fbOssH8vXqq57nvIZ2kyjAW_cvPixEQR3w6Py_nBzElJDgDO59x9SsRbVn_5qpqPK9vi4RPpKmIVpT3ww_ChJjZZHRYWbKmVyX15xfSRK0zQBtbbYVxqwZyUx8lkxoNKSXkcwcPdumqrYekzMx8eiaFQ\"
+ e=\"AQAB\" />
+ </public-key>
+ <private-key>
+ <rsa-private-key
+ d=\"HGhh2KbcFUGwuEFnLrI2k-dTP0qpi8p9lsWfL9t1O9hBZweKtsZs17rfVuJ_av93PP6Kvm26DMWPcbYyizL3fEtAC-dGl34CRH52fp0FoDEIwEe7DWnmbSysKgqW-wil9g5tyugmgeYtpYcZu_l5HLu--G9vGZd7h7tg050aWr52-sacRkiKtgiLiw2Ih994eJcosHRVvmjsjUsq43L_nbW5js82bgQ0SilG_JwUeEmLG6kcFt0PDKuyGCS8Wj-ctp51i9u0jwTHXENrF7uzevaXFqDIObRQg_jX15_ma95qAXHT3cFAIKn-FE0HF3BsWsPo3NwUBb9E29psCxsXyQ\"
+ p=\"0HCTOPqbglzNRQZ0qwN5axRIK6pRAxY2tSKUsTVIyZhVQbDQ2AWiMt2-uk7XY_IP9AtnGEnSONT2BigVph0sLOUwJA1XdHDxOcoIGUUhAAdgD7gHtiX1-4Y5PPUXGDuJ2XgMG0VCWgDbiY-H7St4l8Lhne8AEmtZShAWW6nRZu8\"
+ q=\"_aruFkAI2UUY7IwcBrnFif4xfFvQS2r1Q0tlshgDbxq5-bE7sWFoenDe522Paiq1_aMBsfJN8PovB8LDiYKwRc68CIEdMQsyVd0LqdrJ4Jgg_7XB8gQOcy-qexgQzADTR642sWpDeAvcKujqcMxouZGtcYGNy0rMtcBOp29ALzs\"
+ dp=\"s8YkdCRRM6JuuHXU8hpRAnW_uUlwDcV-8cMdk6ltWdI01i92MJrLRivScEXHp8AC2m1rQZuJ4NJsTusLoPXQP_h8CNwo7ZjrtPf2_DSPPcMeqvACVqtu-LzPaS_J93CCeDn91xdpHs9WidJtXbT8kYfXp6uW2EwV-rbdUbmpjak\"
+ dq=\"g5u1XxHmBWPWJJQkzlB_7rJVVmIEVbyudzWdE6Nl1LUXHDcZ81PIcw4wd_3d1IVIWsnBzWMbkRUcZXhlHukRL4atA_SJArL-cJH4xS1gZAhJxqG0eC4mmRh36Nl5jX44IA6BDddGHfh5SEIDsHY9N1oflK5UtM6gGwQlSrVrpZU\"
+ qi=\"ebz0a-3PHrZx4U1npQCGajUDWqJgvvbqx-cGVK8k3f6LB25l2CWEal5WjoSWw4mbN8tUcOx8Q8DwB2lR90eY_gvMV1gg-zuiC8B2_XPHcn84Mmr-sJRcqoesECsABcosn0EH8IrKpuiZniGcNXh1kC5UlmyvPjOlEJhXuNPwk38\" />
+ </private-key>
+ </rsa-key-pair>
+ </key-pair>
+</account>
+")
+ (account (make <account>
+ #:subject (string->uri "https://example.com/profile/card#me")
+ #:issuer (string->uri "https://example.com")
+ #:access-token "xxx"
+ #:refresh-token "xxx"
+ #:id-token
+ (make <id-token>
+ #:alg 'RS256
+ #:webid (string->uri "https://example.com/profile/card#me")
+ #:iss (string->uri "https://example.com")
+ #:sub "toto"
+ #:aud (string->uri "https://client.example.com/app-id")
+ #:iat 0
+ #:exp 3600
+ #:nonce "xxxxx")
+ #:key-pair
+ (make <rsa-key-pair>
+ #:public-key
+ (make <rsa-public-key>
+ #:n "zopuG9oxFDbs6dntfGBBm6F1tU4Cy80lWpMOL3Je1ks9RHixn8_vlswdW-YM_jUdfhdH4VdQ5ergV2flOtTZ3agVGxMZWtdS8WxKNkmeyr1mVchRB7Hzl1kLYWClkBeoQ2Bi3vDCxTsdz9q3x7610wnRbcAHhtxq_Wm4vlYqXm7MJ5eMXzAdkNaBMgjt38fbOssH8vXqq57nvIZ2kyjAW_cvPixEQR3w6Py_nBzElJDgDO59x9SsRbVn_5qpqPK9vi4RPpKmIVpT3ww_ChJjZZHRYWbKmVyX15xfSRK0zQBtbbYVxqwZyUx8lkxoNKSXkcwcPdumqrYekzMx8eiaFQ"
+ #:e "AQAB")
+ #:private-key
+ (make <rsa-private-key>
+ #:d "HGhh2KbcFUGwuEFnLrI2k-dTP0qpi8p9lsWfL9t1O9hBZweKtsZs17rfVuJ_av93PP6Kvm26DMWPcbYyizL3fEtAC-dGl34CRH52fp0FoDEIwEe7DWnmbSysKgqW-wil9g5tyugmgeYtpYcZu_l5HLu--G9vGZd7h7tg050aWr52-sacRkiKtgiLiw2Ih994eJcosHRVvmjsjUsq43L_nbW5js82bgQ0SilG_JwUeEmLG6kcFt0PDKuyGCS8Wj-ctp51i9u0jwTHXENrF7uzevaXFqDIObRQg_jX15_ma95qAXHT3cFAIKn-FE0HF3BsWsPo3NwUBb9E29psCxsXyQ"
+ #:p "0HCTOPqbglzNRQZ0qwN5axRIK6pRAxY2tSKUsTVIyZhVQbDQ2AWiMt2-uk7XY_IP9AtnGEnSONT2BigVph0sLOUwJA1XdHDxOcoIGUUhAAdgD7gHtiX1-4Y5PPUXGDuJ2XgMG0VCWgDbiY-H7St4l8Lhne8AEmtZShAWW6nRZu8"
+ #:q "_aruFkAI2UUY7IwcBrnFif4xfFvQS2r1Q0tlshgDbxq5-bE7sWFoenDe522Paiq1_aMBsfJN8PovB8LDiYKwRc68CIEdMQsyVd0LqdrJ4Jgg_7XB8gQOcy-qexgQzADTR642sWpDeAvcKujqcMxouZGtcYGNy0rMtcBOp29ALzs"
+ #:dp "s8YkdCRRM6JuuHXU8hpRAnW_uUlwDcV-8cMdk6ltWdI01i92MJrLRivScEXHp8AC2m1rQZuJ4NJsTusLoPXQP_h8CNwo7ZjrtPf2_DSPPcMeqvACVqtu-LzPaS_J93CCeDn91xdpHs9WidJtXbT8kYfXp6uW2EwV-rbdUbmpjak"
+ #:dq "g5u1XxHmBWPWJJQkzlB_7rJVVmIEVbyudzWdE6Nl1LUXHDcZ81PIcw4wd_3d1IVIWsnBzWMbkRUcZXhlHukRL4atA_SJArL-cJH4xS1gZAhJxqG0eC4mmRh36Nl5jX44IA6BDddGHfh5SEIDsHY9N1oflK5UtM6gGwQlSrVrpZU"
+ #:qi "ebz0a-3PHrZx4U1npQCGajUDWqJgvvbqx-cGVK8k3f6LB25l2CWEal5WjoSWw4mbN8tUcOx8Q8DwB2lR90eY_gvMV1gg-zuiC8B2_XPHcn84Mmr-sJRcqoesECsABcosn0EH8IrKpuiZniGcNXh1kC5UlmyvPjOlEJhXuNPwk38")))))
+ (let ((parsed-once (xml->account account-xml))
+ (printed-once (call-with-output-string
+ (lambda (port)
+ (sxml->xml (->sxml account) port)))))
+ (let ((parsed-twice (xml->account printed-once))
+ (printed-twice (call-with-output-string
+ (lambda (port)
+ (sxml->xml (->sxml parsed-once) port)))))
+ (let ((parsed-thrice (xml->account printed-twice))
+ (printed-thrice (call-with-output-string
+ (lambda (port)
+ (sxml->xml (->sxml parsed-twice) port)))))
+ (unless (and (equal? parsed-once account)
+ (equal? parsed-twice parsed-once)
+ (equal? parsed-thrice parsed-twice)
+ (equal? printed-twice printed-once)
+ (equal? printed-thrice printed-twice))
+ (exit 1))))))))
diff --git a/tests/xml-keys.scm b/tests/xml-keys.scm
index 0e2baeb..691af4a 100644
--- a/tests/xml-keys.scm
+++ b/tests/xml-keys.scm
@@ -17,14 +17,18 @@
(use-modules (webid-oidc jwk)
(sxml simple)
(webid-oidc testing)
+ (webid-oidc serializable)
(oop goops))
+(define (xml->key xml)
+ (call-with-input-string xml read/xml))
+
(with-test-environment
"xml-keys"
(lambda ()
(let ((key-xml
"<?xml version=\"1.0\" encoding=\"utf-8\"?>
-<jwk xmlns=\"https://disfluid.planete-kraus.eu/Public_002dkey-cryptography.html#Public_002dkey-cryptography\"
+<ec-point xmlns=\"webid-oidc/jwk\"
kty=\"EC\"
x=\"l8tFrhx-34tV3hRICRDY9zCkDlpBhF42UQUfWVAWBFs\"
y=\"9VE4jf_Ok_o64zbTTlcuNJajHmt6v9TDVrU0CdvGRDA\"
@@ -33,15 +37,15 @@
#:crv 'P-256
#:x "l8tFrhx-34tV3hRICRDY9zCkDlpBhF42UQUfWVAWBFs"
#:y "9VE4jf_Ok_o64zbTTlcuNJajHmt6v9TDVrU0CdvGRDA")))
- (let ((parsed-once (sxml->key (xml->sxml key-xml)))
+ (let ((parsed-once (xml->key key-xml))
(printed-once (call-with-output-string
(lambda (port)
(sxml->xml (->sxml key) port)))))
- (let ((parsed-twice (sxml->key (xml->sxml printed-once)))
+ (let ((parsed-twice (xml->key printed-once))
(printed-twice (call-with-output-string
(lambda (port)
(sxml->xml (->sxml parsed-once) port)))))
- (let ((parsed-thrice (sxml->key (xml->sxml printed-twice)))
+ (let ((parsed-thrice (xml->key printed-twice))
(printed-thrice (call-with-output-string
(lambda (port)
(sxml->xml (->sxml parsed-twice) port)))))