;; webid-oidc, implementation of the Solid specification ;; Copyright (C) 2020, 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 . (use-modules (webid-oidc client-manifest) (webid-oidc cache) (webid-oidc testing) (webid-oidc errors) (web uri) (srfi srfi-19) (web response) (ice-9 optargs) (ice-9 receive)) (with-test-environment "client-manifest" (lambda () (define what-to-respond (build-response #:headers '((content-type application/ld+json)))) (define what-to-respond-body "{ \"client_id\" : \"https://app.example.com/id#app\", \"redirect_uris\" : [\"https://app.example.com/callback\"], \"client_name\" : \"Solid Application Name\", \"client_uri\" : \"https://app.example.com/\", \"logo_uri\" : \"https://app.example.com/logo.png\", \"tos_uri\" : \"https://app.example.com/tos.html\", \"scope\" : \"openid profile offline_access\", \"grant_types\" : [\"refresh_token\",\"authorization_code\"], \"response_types\" : [\"code\"], \"default_max_age\" : 60000, \"require_auth_time\" : true }") (define* (respond uri #:key (headers '())) (unless (equal? headers '()) (exit 1)) (when (string? uri) (set! uri (string->uri uri))) (unless (equal? uri (string->uri "https://app.example.com/id#app")) (exit 2)) (values what-to-respond what-to-respond-body)) (define cache-http-get (with-cache #:http-get respond)) (define mf (get-client-manifest (string->uri "https://app.example.com/id#app") #:http-get cache-http-get)) (define id (client-manifest-client-id mf)) (unless (equal? id (string->uri "https://app.example.com/id#app")) (exit 3)) (unless (client-manifest-check-redirect-uri mf "https://app.example.com/callback") (exit 4)) (with-exception-handler (lambda (error) (unless ((record-predicate &unauthorized-redirection-uri) error) (exit 5))) (lambda () (client-manifest-check-redirect-uri mf "https://fraudulent-app.example.com/callback") (exit 55)) #:unwind? #t #:unwind-for-type &unauthorized-redirection-uri) (receive (response response-body) (serve-client-manifest (time-utc->date (make-time time-utc 0 3600)) mf) (unless (equal? (response-content-type response) '(application/ld+json)) (exit 6)) (set! what-to-respond response) (set! what-to-respond-body response-body) (let ((re-parsed (get-client-manifest (string->uri "https://app.example.com/id#app") #:http-get cache-http-get))) (map (lambda (key) (unless (equal? (assq-ref mf key) (assq-ref re-parsed key)) (exit 9))) '(client_id redirect_uris client_name client_uri logo_uri tos_uri scope grant_types response_types default_max_age require_auth_time))))))