;; 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 client) #:prefix client:)
             ((webid-oidc client accounts) #:prefix client:)
             ((webid-oidc jwk) #:prefix jwk:)
             (webid-oidc testing)
             ((webid-oidc stubs) #:prefix stubs:)
             ((webid-oidc refresh-token) #:prefix refresh:)
             ((webid-oidc simulation) #:prefix sim:)
             ((webid-oidc parameters) #:prefix p:)
             (web uri)
             (web request)
             (web response)
             (srfi srfi-19)
             (srfi srfi-26)
             (ice-9 optargs)
             (ice-9 receive)
             (ice-9 hash-table)
             (ice-9 match))

;; 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 (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 (sim:make-simulation)))
     (sim:add-server! simulation
                      (string->uri "https://server@client-workflow.scm")
                      (string->uri "https://server@client-workflow.scm/alice#me"))
     (sim:add-client! simulation
                      (string->uri "https://client@client-workflow.scm")
                      (string->uri "https://client@client-workflow.scm/id")
                      (string->uri "https://client@client-workflow.scm/authorized")
                      "Client workflow test"
                      (string->uri "https://client@client-workflow.scm/about"))
     (let ((client (client:make-client
                    (string->uri "https://client@client-workflow.scm/id")
                    (jwk:generate-key #:n-size 2048)
                    (string->uri "https://client@client-workflow.scm/authorized"))))
       (parameterize ((p:current-date 0)
                      (client:authorization-process
                       (lambda* (uri #:key issuer)
                         (sim:grant-authorization simulation uri))))
         (receive (response response-body)
             (let ((handler
                    (client:request client #f
                                    (string->uri "https://server@client-workflow.scm")
                                    #:http-request (cute sim:request simulation <...>))))
               (handler (build-request (string->uri "https://server@client-workflow.scm/"))
                        #f))
           (unless (eqv? (response-code response) 200)
             ;; Only Alice can read that resource.
             (exit 3)))
         (match (sim:simulation-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 (response response-body)
             (let ((handler
                    (client:request client
                                    (string->uri "https://server@client-workflow.scm/alice#me")
                                    (string->uri "https://server@client-workflow.scm")
                                    #:http-request (cute sim:request simulation <...>))))
               (handler (build-request (string->uri "https://server@client-workflow.scm/"))
                        #f))
           (unless (eqv? (response-code response) 200)
             ;; Only Alice can read that resource.
             (exit 5)))
         (match (sim:simulation-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 ()
             (let ((handler
                    (client:request client
                                    (string->uri "https://server@client-workflow.scm/alice#me")
                                    (string->uri "https://server@client-workflow.scm")
                                    #:http-request (cute sim:request simulation <...>))))
               (handler (build-request (string->uri "https://server@client-workflow.scm/"))
                        #f))
             (exit 8))
           #:unwind? #t
           #:unwind-for-type client:&refresh-token-expired)
         (match (sim:simulation-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))))))))