;; 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 . (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 () #:module-name '(tests dpop-proof-no-explicit-iat)) (define malicious-jwt-created? #f) (define-method (token->jwt (token )) (set! malicious-jwt-created? #t) ;; Omit the iat field; check that we don’t provide a default (receive (header payload) (next-method) (values header (filter (match-lambda (('iat . _) #f) (else #t)) payload)))) (with-test-environment "dpop-proof-no-explicit-iat" (lambda () (define jwk (generate-key #:n-size 2048)) (define idp-key (generate-key #:n-size 2048)) (define cnf (jkt jwk)) (define access-token (parameterize ((p:current-date 10)) (issue idp-key #:webid (string->uri "https://data.provider/subject") #:iss (string->uri "https://identity.provider") #:client-key jwk #:client-id (string->uri "https://client")))) (define proof (parameterize ((p:current-date 0)) (issue jwk #:jwk (public-key jwk) #:htm 'GET #:htu (string->uri "https://example.com/res?query") #:access-token access-token))) (unless malicious-jwt-created? (exit 1)) (with-exception-handler (lambda (error) (unless (invalid-jws? error) ;; iat should not be missing (exit 2))) (lambda () (parameterize ((p:current-date 180)) (decode proof #:method 'GET #:uri (string->uri "https://example.com/res?query") #:cnf/check cnf #:access-token access-token)) (exit 3)) #:unwind? #t #:unwind-for-type &invalid-jws)))