blob: 502daf2fce86066184b53bf4b36739613c4aa262 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
|
(use-modules (webid-oidc stubs)
(webid-oidc jws)
(webid-oidc testing))
(with-test-environment
"jws"
(lambda ()
(let* ((key (json-string->scm "{\"kty\":\"RSA\",\"e\":\"AQAB\",\"kid\":\"db7cdbbf-0ca3-48da-abf6-8f34002a4651\",\"n\":\"nzyis1ZjfNB0bBgKFMSvvkTtwlvBsaJq7S5wA-kzeVOVpVWwkWdVha4s38XM_pa_yr47av7-z3VTmvDRyAHcaT92whREFpLv9cj5lTeJSibyr_Mrm_YtjCZVWgaOYIhwrXwKLqPr_11inWsAkfIytvHWTxZYEcXLgAXFuUuaS3uF9gEiNQwzGTU1v0FqkqTBr4B8nW3HCN47XUu0t8Y0e-lf4s4OxQawWD79J9_5d3Ry0vbV3Am1FtGJiJvOwRsIfVChDpYStTcHTCMqtvWbV6L11BWkpzGXSW4Hv43qa-GSYOD2QU68Mb59oSk2OB-BtOLpJofmbGEGgvmwyCI9Mw\"}"))
(other-key (generate-key #:n-size 2048))
(encoded "eyJhbGciOiJQUzI1NiIsInR5cCI6IkpXVCJ9.eyJzdWIiOiIxMjM0NTY3ODkwIiwibmFtZSI6IkpvaG4gRG9lIiwiYWRtaW4iOnRydWUsImlhdCI6MTUxNjIzOTAyMn0.hZnl5amPk_I3tb4O-Otci_5XZdVWhPlFyVRvcqSwnDo_srcysDvhhKOD01DigPK1lJvTSTolyUgKGtpLqMfRDXQlekRsF4XhAjYZTmcynf-C-6wO5EI4wYewLNKFGGJzHAknMgotJFjDi_NCVSjHsW3a10nTao1lB82FRS305T226Q0VqNVJVWhE4G0JQvi2TssRtCxYTqzXVt22iDKkXeZJARZ1paXHGV5Kd1CljcZtkNZYIGcwnj65gvuCwohbkIxAnhZMJXCLaVvHqv9l-AAUV7esZvkQR1IpwBAiDQJh4qxPjFGylyXrHMqh5NlT_pWL2ZoULWTg_TJjMO9TuQ")
(expected-alg "PS256")
(expected-typ "JWT")
(expected-sub "1234567890")
(expected-name "John Doe")
(expected-admin #t)
(expected-iat 1516239022)
(parsed (jws-decode encoded (lambda (jws)
(and (jws? jws)
key))))
(parsed-header (jws-header parsed))
(parsed-payload (jws-payload parsed))
(alg (jws-alg parsed))
(typ (assq-ref parsed-header 'typ))
(sub (assq-ref parsed-payload 'sub))
(name (assq-ref parsed-payload 'name))
(admin (assq-ref parsed-payload 'admin))
(iat (assq-ref parsed-payload 'iat))
(re-encoded (jws-encode parsed other-key))
(re-parsed (jws-decode re-encoded (lambda (jws) other-key)))
(re-parsed-header (jws-header re-parsed))
(re-parsed-payload (jws-payload re-parsed))
(re-alg (jws-alg re-parsed))
(re-typ (assq-ref re-parsed-header 'typ))
(re-sub (assq-ref re-parsed-payload 'sub))
(re-name (assq-ref re-parsed-payload 'name))
(re-admin (assq-ref re-parsed-payload 'admin))
(re-iat (assq-ref re-parsed-payload 'iat)))
(unless (and (equal? alg expected-alg)
(equal? re-alg expected-alg)
(equal? typ expected-typ)
(equal? re-typ expected-typ)
(equal? sub expected-sub)
(equal? re-sub expected-sub)
(equal? name expected-name)
(equal? re-name expected-name)
(equal? admin expected-admin)
(equal? re-admin expected-admin)
(equal? iat expected-iat)
(equal? re-iat expected-iat))
(format (current-error-port)
"The JWS test failed.")))))
|