;; 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 (webid-oidc server endpoint hello)
  #:use-module (webid-oidc errors)
  #:use-module (webid-oidc server endpoint)
  #:use-module (webid-oidc provider-confirmation)
  #:use-module ((webid-oidc parameters) #:prefix p:)
  #:use-module ((webid-oidc config) #:prefix cfg:)
  #:use-module (web request)
  #:use-module (web response)
  #:use-module (web uri)
  #:use-module (web server)
  #:use-module (web client)
  #:use-module (ice-9 optargs)
  #:use-module (ice-9 receive)
  #:use-module (webid-oidc web-i18n)
  #:use-module (ice-9 getopt-long)
  #:use-module (ice-9 suspendable-ports)
  #:use-module (ice-9 control)
  #:use-module (ice-9 match)
  #:use-module (ice-9 exceptions)
  #:use-module (sxml simple)
  #:use-module (srfi srfi-19)
  #:use-module (srfi srfi-26)
  #:use-module (oop goops)
  #:duplicates (merge-generics)
  #:declarative? #t
  #:export
  (
   <greeter>
   ))

(define-class <greeter> (<endpoint>))

(define-method (handle (endpoint <greeter>) request request-body)
  (let ((user (assq-ref (request-meta request) 'user)))
    (unless user
      (raise-exception
       (make-exception
        (make-web-exception 401 (W_ "reason-phrase|Unauthorized"))
        (make-user-message
         (call-with-input-string
             (format #f (W_ "<p>You are not authentified.</p>"))
           xml->sxml)))))
    (let ((page
           `(*TOP*
             (*PI* xml "version=\"1.0\" encoding=\"utf-8\"")
             (html (@ (xmlns "http://www.w3.org/1999/xhtml")
                      (xml:lang ,(W_ "xml-lang|en")))
                   (body
                    ,(xml->sxml
                      (format #f (W_ "<h1>Hello, ~a!</h1>")
                              (call-with-output-string
                                (lambda (port)
                                  (sxml->xml
                                   `(a (@ (href ,(uri->string user)))
                                       ,(uri->string user))
                                   port)))))
                    ,(xml->sxml
                      (format #f (W_ "<p>You are authenticated with Solid.</p>"))))))))
      (values
       (build-response
        #:headers `((content-type application/xhtml+xml)))
       (call-with-output-string
         (cute sxml->xml page <>))
       '()))))