blob: 3a30dacfac2f517a0fe8bfa5779eaaa89b323427 (
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
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
113
114
115
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))))))))
|
