1 files changed, 86 insertions, 0 deletions
diff --git a/tests/dpop-proof-no-explicit-exp.scm b/tests/dpop-proof-no-explicit-exp.scm
new file mode 100644
index 0000000..c485cac
--- /dev/null
+++ b/tests/dpop-proof-no-explicit-exp.scm
@@ -0,0 +1,86 @@
+;; 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 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)
+             (oop goops))
+
+(define-class <dpop-proof-with-exp> (<dpop-proof>))
+
+(define malicious-jwt-created? #f)
+
+(define-method (token->jwt (token <dpop-proof-with-exp>))
+  (set! malicious-jwt-created? #t)
+  (receive (header payload) (next-method)
+    (values header
+            `((exp . ,(time-second (date->time-utc (exp token))))
+              ,@payload))))
+
+(with-test-environment
+ "dpop-proof-no-explicit-exp"
+ (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 0))
+       (issue <access-token>
+              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 <dpop-proof-with-exp>
+              jwk
+              #:jwk (public-key jwk)
+              #:htm 'GET
+              #:htu (string->uri "https://example.com/res?query")
+              #:validity 3600 ;; Obviously too long: the decoder
+              ;; should ignore this value and make it
+              ;; obsolete after 120 seconds.
+              #:access-token access-token)))
+   (unless malicious-jwt-created?
+     (exit 1))
+   (with-exception-handler
+       (lambda (error)
+         (unless (and (expired? error)
+                      (eqv? (time-second (date->time-utc (error-expiration-date error)))
+                            30)
+                      (eqv? (time-second (date->time-utc (error-current-date error)))
+                            60))
+           (raise-exception error)))
+     (lambda ()
+       (parameterize ((p:current-date 60))
+         (decode <dpop-proof> proof
+                 #:method 'GET
+                 #:uri (string->uri "https://example.com/res?query")
+                 #:cnf/check cnf
+                 #:access-token access-token))
+       (exit 2))
+     #:unwind? #t
+     #:unwind-for-type &expired)))