diff options
author | Vivien Kraus <vivien@planete-kraus.eu> | 2021-09-23 12:21:03 +0200 |
---|---|---|
committer | Vivien Kraus <vivien@planete-kraus.eu> | 2021-10-01 12:32:20 +0200 |
commit | 98de254d3c77feadad464f77f51f9cad5993a9f8 (patch) | |
tree | 95d959724e449588e1707075263b9d25719f10d2 /tests | |
parent | ca67854900dbf0f7200e75c73f32900a8fe0b63e (diff) |
Define an XML-loadable meta-class
Diffstat (limited to 'tests')
-rw-r--r-- | tests/Makefile.am | 3 | ||||
-rw-r--r-- | tests/dpop-proof-no-explicit-exp.scm | 33 | ||||
-rw-r--r-- | tests/dpop-proof-no-explicit-iat.scm | 33 | ||||
-rw-r--r-- | tests/xml-accounts.scm | 116 | ||||
-rw-r--r-- | tests/xml-keys.scm | 12 |
5 files changed, 162 insertions, 35 deletions
diff --git a/tests/Makefile.am b/tests/Makefile.am index 99c834d..2f5c1d6 100644 --- a/tests/Makefile.am +++ b/tests/Makefile.am @@ -65,7 +65,8 @@ TESTS = %reldir%/load-library.scm \ %reldir%/acl.scm \ %reldir%/crud.scm \ %reldir%/preconditions.scm \ - %reldir%/xml-keys.scm + %reldir%/xml-keys.scm \ + %reldir%/xml-accounts.scm EXTRA_DIST += $(TESTS) %reldir%/ChangeLog diff --git a/tests/dpop-proof-no-explicit-exp.scm b/tests/dpop-proof-no-explicit-exp.scm index 5a4ccbc..83541a2 100644 --- a/tests/dpop-proof-no-explicit-exp.scm +++ b/tests/dpop-proof-no-explicit-exp.scm @@ -14,22 +14,25 @@ ;; 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 dpop-proof) - (webid-oidc access-token) - (webid-oidc jwk) - (webid-oidc jws) - (webid-oidc testing) - (webid-oidc errors) - ((webid-oidc stubs) #:prefix stubs:) - ((webid-oidc parameters) #:prefix p:) - (web uri) - (srfi srfi-19) - (web response) - (ice-9 receive) - (ice-9 optargs) - (oop goops)) +(define-module (tests dpop-proof-no-explicit-exp) + #:use-module (webid-oidc dpop-proof) + #:use-module (webid-oidc access-token) + #:use-module (webid-oidc jwk) + #:use-module (webid-oidc jws) + #:use-module (webid-oidc testing) + #:use-module (webid-oidc errors) + #:use-module ((webid-oidc stubs) #:prefix stubs:) + #:use-module ((webid-oidc parameters) #:prefix p:) + #:use-module (web uri) + #:use-module (srfi srfi-19) + #:use-module (web response) + #:use-module (ice-9 receive) + #:use-module (ice-9 optargs) + #:use-module (oop goops) + #:declarative? #t) -(define-class <dpop-proof-with-exp> (<dpop-proof>)) +(define-class <dpop-proof-with-exp> (<dpop-proof>) + #:module-name '(tests dpop-proof-no-explicit-exp)) (define-method (initialize (token <dpop-proof-with-exp>) initargs) (next-method) diff --git a/tests/dpop-proof-no-explicit-iat.scm b/tests/dpop-proof-no-explicit-iat.scm index 671dfa0..7c09195 100644 --- a/tests/dpop-proof-no-explicit-iat.scm +++ b/tests/dpop-proof-no-explicit-iat.scm @@ -14,22 +14,25 @@ ;; 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 dpop-proof) - (webid-oidc access-token) - (webid-oidc jwk) - (webid-oidc jws) - (webid-oidc testing) - (webid-oidc errors) - ((webid-oidc stubs) #:prefix stubs:) - ((webid-oidc parameters) #:prefix p:) - (web uri) - (srfi srfi-19) - (web response) - (ice-9 receive) - (ice-9 match) - (oop goops)) +(define-module (tests dpop-proof-no-explicit-iat) + #:use-module (webid-oidc dpop-proof) + #:use-module (webid-oidc access-token) + #:use-module (webid-oidc jwk) + #:use-module (webid-oidc jws) + #:use-module (webid-oidc testing) + #:use-module (webid-oidc errors) + #:use-module ((webid-oidc stubs) #:prefix stubs:) + #:use-module ((webid-oidc parameters) #:prefix p:) + #:use-module (web uri) + #:use-module (srfi srfi-19) + #:use-module (web response) + #:use-module (ice-9 receive) + #:use-module (ice-9 match) + #:use-module (oop goops) + #:declarative? #t) -(define-class <dpop-proof-without-iat> (<dpop-proof>)) +(define-class <dpop-proof-without-iat> (<dpop-proof>) + #:module-name '(tests dpop-proof-no-explicit-iat)) (define malicious-jwt-created? #f) 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)))))))) diff --git a/tests/xml-keys.scm b/tests/xml-keys.scm index 0e2baeb..691af4a 100644 --- a/tests/xml-keys.scm +++ b/tests/xml-keys.scm @@ -17,14 +17,18 @@ (use-modules (webid-oidc jwk) (sxml simple) (webid-oidc testing) + (webid-oidc serializable) (oop goops)) +(define (xml->key xml) + (call-with-input-string xml read/xml)) + (with-test-environment "xml-keys" (lambda () (let ((key-xml "<?xml version=\"1.0\" encoding=\"utf-8\"?> -<jwk xmlns=\"https://disfluid.planete-kraus.eu/Public_002dkey-cryptography.html#Public_002dkey-cryptography\" +<ec-point xmlns=\"webid-oidc/jwk\" kty=\"EC\" x=\"l8tFrhx-34tV3hRICRDY9zCkDlpBhF42UQUfWVAWBFs\" y=\"9VE4jf_Ok_o64zbTTlcuNJajHmt6v9TDVrU0CdvGRDA\" @@ -33,15 +37,15 @@ #:crv 'P-256 #:x "l8tFrhx-34tV3hRICRDY9zCkDlpBhF42UQUfWVAWBFs" #:y "9VE4jf_Ok_o64zbTTlcuNJajHmt6v9TDVrU0CdvGRDA"))) - (let ((parsed-once (sxml->key (xml->sxml key-xml))) + (let ((parsed-once (xml->key key-xml)) (printed-once (call-with-output-string (lambda (port) (sxml->xml (->sxml key) port))))) - (let ((parsed-twice (sxml->key (xml->sxml printed-once))) + (let ((parsed-twice (xml->key printed-once)) (printed-twice (call-with-output-string (lambda (port) (sxml->xml (->sxml parsed-once) port))))) - (let ((parsed-thrice (sxml->key (xml->sxml printed-twice))) + (let ((parsed-thrice (xml->key printed-twice)) (printed-thrice (call-with-output-string (lambda (port) (sxml->xml (->sxml parsed-twice) port))))) |