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
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
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)))
|
