summaryrefslogtreecommitdiff
path: root/tests/jws.scm
blob: cfd57b157b22aa3f356b89703307f6a97fbee4c1 (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
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
;; webid-oidc, implementation of the Solid specification
;; Copyright (C) 2020, 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 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.")))))