;; 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 <https://www.gnu.org/licenses/>.

(use-modules (webid-oidc client)
             (webid-oidc testing)
             (webid-oidc token-endpoint)
             (webid-oidc jwk)
             (webid-oidc authorization-code)
             (webid-oidc oidc-configuration)
             (webid-oidc jws)
             (webid-oidc oidc-id-token)
             ((webid-oidc parameters) #:prefix p:)
             (web uri)
             (web request)
             (web response)
             (srfi srfi-19)
             (ice-9 optargs)
             (ice-9 receive)
             (ice-9 hash-table))

(with-test-environment
 "client-token"
 (lambda ()
   (define the-current-time 0)
   (parameterize ((p:current-date (lambda () the-current-time)))
     (define issuer-key (generate-key #:n-size 2048))
     (define issuer-configuration
       (make-oidc-configuration
        "https://issuer.client-token.scm/keys"
        "https://issuer.client-token.scm/authorize"
        "https://issuer.client-token.scm/token"))
     (define token-endpoint (make-token-endpoint
                             (string->uri "https://issuer.client-token.scm/token")
                             (string->uri "https://issuer.client-token.scm")
                             'RS256
                             issuer-key
                             3600))
     (define client-key (generate-key #:n-size 2048))
     (define authorization-code
       (issue-authorization-code 'RS256  issuer-key 120
                                 (string->uri "https://client-token.scm/profile/card#me")
                                 (string->uri "https://app.client-token.scm/app#id")))
     (define* (http-get uri #:key (headers '()))
       (cond
        ((equal? uri (string->uri "https://issuer.client-token.scm/.well-known/openid-configuration"))
         (serve-oidc-configuration
          (time-utc->date (make-time time-utc 0 (+ the-current-time 3600)))
          issuer-configuration))
        ((equal? uri (string->uri "https://issuer.client-token.scm/keys"))
         (serve-jwks
          (time-utc->date (make-time time-utc 0 (+ the-current-time 3600)))
          (make-jwks (list issuer-key))))
        (else
         (format (current-error-port) "GET request to ~a: error.\n" (uri->string uri))
         (exit 1))))
     (define* (http-post uri #:key (body #f) (headers '()))
       (unless (equal? uri (oidc-configuration-token-endpoint issuer-configuration))
         (format (current-error-port)
                 "Wrong URI for token negociation: ~a (expected ~a).\n"
                 (uri->string uri)
                 (uri->string
                  (oidc-configuration-token-endpoint
                   issuer-configuration)))
         (exit 2))
       (unless (equal? body (format #f "grant_type=authorization_code&code=~a"
                                    authorization-code))
         (format (current-error-port)
                 "Wrong body: ~s\n" body)
         (exit 3))
       (unless (equal?
                (assoc-ref headers 'content-type)
                '(application/x-www-form-urlencoded))
         (format (current-error-port)
                 "Wrong content type: ~s\n" (assoc-ref headers 'content-type))
         (exit 4))
       (let ((request
              (build-request uri
                             #:method 'POST
                             #:headers headers
                             #:port (open-input-string body)))
             (request-body body))
         (receive (response response-body user error)
             (token-endpoint request request-body)
           (values response response-body))))
     (let ((response
            (token "https://issuer.client-token.scm"
                   client-key
                   #:authorization-code authorization-code
                   #:http-get http-get
                   #:http-post http-post)))
       (let ((id-token (assq-ref response 'id_token))
             (access-token (assq-ref response 'access_token))
             (token-type (assq-ref response 'token_type))
             (token-expiration (assq-ref response 'expires_in))
             (refresh-token (assq-ref response 'refresh_token)))
         (let ((id-token-dec (id-token-decode id-token #:http-get http-get))
               (access-token-dec (jws-decode access-token (lambda (jws) issuer-key))))
           (unless id-token-dec
             (format (current-error-port) "Could not decode the ID token from ~s (~s)"
                     id-token response)
             (exit 5))
           (unless access-token-dec
             (format (current-error-port) "Could not decode the access token from ~s (~s)"
                     access-token response)
             (exit 6))
           (unless refresh-token
             (format (current-error-port) "There does not seem to be a refresh token in ~s"
                     response)
             (exit 6))
           (unless (equal? (id-token-webid id-token-dec)
                           (string->uri "https://client-token.scm/profile/card#me"))
             (exit 7))
           (unless (equal? (id-token-iss id-token-dec)
                           (string->uri "https://issuer.client-token.scm"))
             (exit 8))
           (unless (equal? (id-token-aud id-token-dec)
                           (string->uri "https://app.client-token.scm/app#id"))
             (exit 9))
           ;; It’s not the job of the client to check that the access
           ;; token is correct; TODO: add a check with a resource
           ;; server.

           ;; TODO: try to negociate a refresh token.
           ))))))