;; 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 reverse-proxy-anonymous)
  #:use-module (webid-oidc server endpoint)
  #:use-module (webid-oidc server endpoint reverse-proxy)
  #:use-module (webid-oidc testing)
  #:use-module (webid-oidc offloading)
  #:use-module ((webid-oidc parameters) #:prefix p:)
  #:use-module (oop goops)
  #:use-module (web server)
  #:use-module (web request)
  #:use-module (web response)
  #:use-module (web uri)
  #:use-module (ice-9 match)
  #:use-module (ice-9 receive)
  #:use-module (srfi srfi-26)
  #:use-module (rnrs bytevectors)
  #:declarative? #t
  #:duplicates (merge-generics))

(with-test-environment
 "reverse-proxy-anonymous"
 (lambda ()
   (define request-characters-reversed '())
   (define (push-char c)
     (set! request-characters-reversed
           `(,c ,@request-characters-reversed)))
   (define (push-string str)
     (for-each push-char (string->list str)))
   (define chars-to-read
     (string->list
      (call-with-output-string
        (lambda (port)
          (let ((updated
                 (write-response (build-response
                                  #:headers '((content-type text/plain)))
                                 port)))
            (write-response-body updated (string->utf8 "Hello!")))))))
   (parameterize
       ((p:current-date 0)
        (open-socket-for-uri
         (lambda _
           (make-soft-port
            (vector
             ;; Request character is written:
             push-char
             ;; Request string is written:
             push-string
             ;; Flushing output:
             (lambda () #t)
             ;; Get one character:
             (lambda ()
               (match chars-to-read
                 ((next rest ...)
                  (set! chars-to-read rest)
                  next)
                 (else
                  (call-with-input-string "" read)))) ;; EOF
             ;; Close the port:
             (lambda () #t))
            "rw"))))
     (with-threads
      (let ((reverse-proxy
             (make <reverse-proxy>
               #:backend-uri (string->uri "https://example.com")
               #:authentication-header 'test))
            (request
             (build-request
              (string->uri "https://example.com")
              #:headers '((content-type text/plain)
                          (test . "https://attack.com/profile/card#me"))
              #:meta '()))
            (request-body (string->utf8 "Hello, world!")))
        (receive (response response-body response-meta)
            (handle reverse-proxy request request-body)
          (unless (eqv? (response-code response) 200)
            (exit 1))
          (let ((request-read
                 (list->string (reverse request-characters-reversed)))
                (expected-request
                 (call-with-output-string
                   (lambda (port)
                     (write-request-body
                      (write-request
                       (build-request
                        (string->uri "https://example.com")
                        #:headers '((host . ("example.com" . #f))
                                    (content-type text/plain)))
                       port)
                      request-body)))))
            (unless (equal? request-read expected-request)
              (format (current-error-port) "Expected request:
~s
Actual request:
~s
"
                      expected-request request-read)
              (exit 2)))
          (set! response-body
                (read-response-body response))
          (unless (null? chars-to-read)
            (format (current-error-port) "Remaining chars to read: ~s\n"
                    (list->string chars-to-read))
            (exit 3))
          (unless (equal? response-body (string->utf8 "Hello!"))
            (exit 4))
          (primitive-exit 0))))
     (sleep 120)
     (format (current-error-port) "Test timeout.\n")
     (exit 5))))