;; 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/>.

(define-module (tests client-workflow)
  #:use-module ((webid-oidc client) #:prefix client:)
  #:use-module ((webid-oidc client accounts) #:prefix client:)
  #:use-module ((webid-oidc jwk) #:prefix jwk:)
  #:use-module (webid-oidc testing)
  #:use-module (webid-oidc oidc-configuration)
  #:use-module (webid-oidc server endpoint)
  #:use-module (webid-oidc server endpoint resource-server)
  #:use-module (webid-oidc server endpoint identity-provider)
  #:use-module (webid-oidc server endpoint client)
  #:use-module (webid-oidc server endpoint authentication)
  #:use-module ((webid-oidc stubs) #:prefix stubs:)
  #:use-module ((webid-oidc refresh-token) #:prefix refresh:)
  #:use-module (webid-oidc simulation)
  #:use-module ((webid-oidc parameters) #:prefix p:)
  #:use-module (web uri)
  #:use-module (web request)
  #:use-module (web response)
  #:use-module (srfi srfi-19)
  #:use-module (srfi srfi-26)
  #:use-module (ice-9 optargs)
  #:use-module (ice-9 receive)
  #:use-module (ice-9 hash-table)
  #:use-module (ice-9 match)
  #:use-module (oop goops)
  #:declarative? #t
  #:duplicates (merge-generics))

;; In this example, a user firsts requests an account, then logs in
;; with a refresh token, then logs out, but we can still revive per
;; account, then the refresh token gets banned.

(define <client:client> client:<client>)
(define <client:account> client:<account>)

(define (display-log simulation)
  (format (current-error-port) "Log:\n")
  (for-each
   (match-lambda
     ((request request-body response response-body)
      (format (current-error-port) "~s ~s (~s): ~s ~s\n"
              (request-method request)
              (uri->string (request-uri request))
              request-body
              (response-code response)
              (response-reason-phrase response))))
   (sim:simulation-scroll-log! simulation))
  (exit 42))

(with-test-environment
 "client-workflow"
 (lambda ()
   (let ((simulation
          (make <simulation>
            #:endpoint
            (make <router>
              #:routed
              (list
               (make <identity-provider>
                 #:host "server.client-workflow.scm"
                 #:oidc-discovery
                 (make <oidc-discovery>
                   #:path "/.well-known/openid-configuration"
                   #:configuration
                   (make <oidc-configuration>
                     #:jwks-uri "https://server.client-workflow.scm/keys"
                     #:authorization-endpoint "https://server.client-workflow.scm/authorize"
                     #:token-endpoint "https://server.client-workflow.scm/token"))
                 #:authorization-endpoint
                 (make <authorization-endpoint>
                   #:path "/authorize"
                   #:subject "https://server.client-workflow.scm/alice#me"
                   #:encrypted-password (crypt "password" "$6$password")
                   #:key-file (string-append (p:data-home) "/key-file.jwk"))
                 #:token-endpoint
                 (make <token-endpoint>
                   #:path "/token"
                   #:issuer "https://server.client-workflow.scm"
                   #:key-file (string-append (p:data-home) "/key-file.jwk"))
                 #:jwks-endpoint
                 (make <jwks-endpoint>
                   #:path "/keys"
                   #:key-file (string-append (p:data-home) "/key-file.jwk"))
                 #:default
                 (make <authenticator>
                   #:backend
                   (make <resource-server>
                     #:server-name "https://server.client-workflow.scm"
                     #:owner "https://server.client-workflow.scm/alice#me")
                   #:server-uri "https://server.client-workflow.scm"))
               (make <client-id>
                 #:host "client.client-workflow.scm"
                 #:client-id "https://client.client-workflow.scm/id"
                 #:redirect-uris '("https://client.client-workflow.scm/authorized")
                 #:client-name "Client workflow test"
                 #:client-uri "https://client.client-workflow.scm/about"
                 #:grant-types '(authorization_code refresh_token)
                 #:response-types '(code))))))
         (account #f))
     (parameterize ((client:client
                     (make <client:client>
                       #:client-id "https://client.client-workflow.scm/id"
                       #:redirect-uri
                       (string->uri "https://client.client-workflow.scm/authorized")))
                    (p:anonymous-http-request
                     (cute (@ (webid-oidc simulation) request) simulation <...>)))
       (parameterize ((p:current-date 0)
                      (client:authorization-process
                       (lambda* (uri #:key reason)
                         (grant-authorization simulation uri))))
         (receive (new-account response response-body)
             (begin
               (set! account
                     (make <client:account> #:issuer "https://server.client-workflow.scm"))
               (client:request account
                               (string->uri "https://server.client-workflow.scm/")))
           (set! account new-account)
           (unless (eqv? (response-code response) 200)
             ;; Only Alice can read that resource.
             (exit 3)))
         (match (scroll-log! simulation)
           ;; 1. The client gets the oidc configuration of the
           ;; server.

           ;; 2. The browser gets redirected to the authorization
           ;; URI and POSTs the authorization form. The server makes
           ;; a request to the client ID, which replies first.

           ;; 3. The authorization request completes.

           ;; 4. The client exchanges the authorization code for a
           ;; refresh token.

           ;; 5. and 6. The client decodes the ID token and requests
           ;; the server keys.

           ;; 7. and 8. While the client is waiting for the final response to
           ;; complete, the server checks the access token validity by
           ;; querying the identity provider for its key.

           ;; 9. The client sends the signed request to the / URI of
           ;; the server.
           (((get-oidc-config-request _ get-oidc-config-response _)
             (get-client-id-request _ get-client-id-response _)
             (authorization-request _ authorization-response _)
             (token-request _ token-response _)
             _ _ ;; the client gets the key
             _ _ ;; the resource server gets the key
             (final-request _ final-response _))
            (unless
                (and
                 ;; 1. Get the authorization endpoint.
                 (equal? (request-uri get-oidc-config-request)
                         (string->uri "https://server.client-workflow.scm/.well-known/openid-configuration"))
                 (eqv? (response-code get-oidc-config-response) 200)
                 ;; 2. The server checks the client ID.
                 (equal? (request-uri get-client-id-request)
                         (string->uri "https://client.client-workflow.scm/id"))
                 (eqv? (response-code get-client-id-response) 200)
                 ;; 3. The authorization request completes.
                 (string-prefix?
                  "https://server.client-workflow.scm/authorize?"
                  (uri->string (request-uri authorization-request)))
                 (eq? (request-method authorization-request) 'POST)
                 (eqv? (response-code authorization-response) 302)
                 (string-prefix?
                  "https://client.client-workflow.scm/authorized?"
                  (uri->string (response-location authorization-response)))
                 ;; 4. Token negociation.
                 (equal? (request-uri token-request)
                         (string->uri "https://server.client-workflow.scm/token"))
                 (eqv? (response-code token-response) 200)
                 ;; 5. The final request.
                 (equal? (request-uri final-request)
                         (string->uri "https://server.client-workflow.scm/"))
                 (eqv? (response-code final-response) 200))
              (exit 4)))))
       ;; 1 hour later, the access token should have expired.
       (parameterize ((p:current-date 3600))
         (receive (new-account response response-body)
             (client:request account (string->uri "https://server.client-workflow.scm/"))
           (set! account new-account)
           (unless (eqv? (response-code response) 200)
             ;; Only Alice can read that resource.
             (exit 5)))
         (match (scroll-log! simulation)
           ;; 1. and 2. The client starts sending the request, the server
           ;; querries the identity provider and keys.

           ;; 3. The client directly sends the request. It fails because
           ;; the access token expired.

           ;; 4. The client queries the OIDC configuration to get the
           ;; token endpoint.

           ;; 5. The client gets an access token from the refresh token.

           ;; 6. 7. The client decodes the ID token, by getting the keys
           ;; again.

           ;; 8. and 9. The client starts sending the new request, the
           ;; server checks the access token.

           ;; 10. The client sends the request again, and it succeeds.
           ((_
             _
             (naively-try-request _ naively-try-response _)
             (get-token-endpoint-request _ get-token-endpoint-response _)
             (refresh-request _ refresh-response _)
             _ _ _ _
             (with-new-refresh-token-request _ with-new-refresh-token-response _))
            (unless
                (and
                 ;; 3. The client realizes that the access token is
                 ;; expired.
                 (equal? (request-uri naively-try-request)
                         (string->uri "https://server.client-workflow.scm/"))
                 (eqv? (response-code naively-try-response) 401)
                 (eqv? (time-second (date->time-utc (response-date naively-try-response)))
                       3600)
                 ;; 4. The client discovers the token endpoint.
                 (equal? (request-uri get-token-endpoint-request)
                         (string->uri "https://server.client-workflow.scm/.well-known/openid-configuration"))
                 (eqv? (response-code get-token-endpoint-response) 200)
                 ;; 5. Refresh the access token.
                 (equal? (request-uri refresh-request)
                         (string->uri "https://server.client-workflow.scm/token"))
                 (eqv? (response-code refresh-response) 200)
                 ;; 10. Send again.
                 (equal? (request-uri with-new-refresh-token-request)
                         (string->uri "https://server.client-workflow.scm/"))
                 (eqv? (response-code with-new-refresh-token-response) 200))
              (exit 6)))))
       ;; Wait another hour, and we’ll need to update the refresh
       ;; token again, but this time it’s not there anymore.
       (parameterize ((p:current-date 7200))
         (refresh:remove-refresh-token
          (string->uri "https://server.client-workflow.scm/alice#me")
          (string->uri "https://client.client-workflow.scm/id"))
         (with-exception-handler
             (lambda (error)
               (unless (client:refresh-token-expired? error)
                 (exit 7)))
           (lambda ()
             (client:request account (string->uri "https://server.client-workflow.scm/"))
             (exit 8))
           #:unwind? #t
           #:unwind-for-type client:&refresh-token-expired)
         (match (scroll-log! simulation)
           ;; 1. and 2. The client starts sending the request, the server
           ;; querries the identity provider and keys.

           ;; 3. The client directly sends the request. It fails
           ;; because the access token expired.

           ;; 4. The client queries the OIDC configuration to get the
           ;; token endpoint.

           ;; 5. The client sends the token request, but it fails with
           ;; 403.
           ((_
             _
             (naively-try-request _ naively-try-response _)
             (get-token-endpoint-request _ get-token-endpoint-response _)
             (refresh-request _ refresh-response _))
            ;; 3. The client realizes that the access token is
            ;; expired.
            (equal? (request-uri naively-try-request)
                    (string->uri "https://server.client-workflow.scm/"))
            (eqv? (response-code naively-try-response) 401)
            (eqv? (time-second (date->time-utc (response-date naively-try-response)))
                  7200)
            ;; 4. The client discovers the token endpoint.
            (equal? (request-uri get-token-endpoint-request)
                    (string->uri "https://server.client-workflow.scm/.well-known/openid-configuration"))
            (eqv? (response-code get-token-endpoint-response) 200)
            ;; 5. The client tries to refresh.
            (equal? (request-uri refresh-request)
                    (string->uri "https://server.client-workflow.scm/token"))
            (eqv? (response-code refresh-response) 403))))))))