diff options
Diffstat (limited to 'tests/xml-accounts.scm')
-rw-r--r-- | tests/xml-accounts.scm | 116 |
1 files changed, 116 insertions, 0 deletions
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)))))))) |