;;
;; brminv.scm
;;
;; Main program of Brm Inventory - the server.
;;
;; ISC License
;;
;; Copyright 2023-2025 Brmlab, z.s.
;; Dominik Pantůček <dominik.pantucek@trustica.cz>
;;
;; Permission to use, copy, modify, and/or distribute this software
;; for any purpose with or without fee is hereby granted, provided
;; that the above copyright notice and this permission notice appear
;; in all copies.
;; 
;; THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL
;; WARRANTIES WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED
;; WARRANTIES OF MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE
;; AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT, INDIRECT, OR
;; CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS
;; OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT,
;; NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN
;; CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
;;

(import frontend
	command-line
	texts
	spiffy
	openssl
	(chicken tcp)
	intarweb
	uri-common
	(chicken string))

(define -port- (make-parameter #f))
(define -certificate- (make-parameter #f))
(define -key- (make-parameter #f))
(define -user- (make-parameter #f))
(define -group- (make-parameter #f))

(command-line
 print-help
 (-h () "This help"
     (print banner-line)
     (newline)
     (print "Command-line options:")
     (print-help)
     (newline)
     (exit 0))
 (-license () "Show licensing terms"
	   (print banner-line)
	   (newline)
	   (print license)
	   (exit 0))
 ""
 "Configuration options:"
 (-p (port) "Listen port"
     (-port- (string->number port)))
 (-c (cert) "Certificate"
     (-certificate- cert))
 (-k (key) "Private key"
     (-key- key))
 )

(define ssl? (and (-certificate-) (-key-) #t))
(define port (or (-port-) (if ssl? 443 80)))

(print banner-line)
(print "Port: " port)
(print "SSL: " ssl?)
(when ssl?
  (print "  Certificate:" (-certificate-))
  (print "  Key:" (-key-)))

(define listener
  (if ssl?
      (ssl-listen port)
      (tcp-listen port)))

(when ssl?
  (ssl-load-certificate-chain! listener (-certificate-))
  (ssl-load-private-key! listener (-key-)))

(when (and (-user-) (-group-))
  (switch-user/group (-user-) (-group-)))

(define (handle-request-by-path path)
  (print (->string path-lst) (length path))
  (define body
    (cond ((equal? path-lst '(/ ""))
	   (print "index")
	   )
	  (else
	   "error"))))

(define (handle-api-calls)
  #f)

(handle-not-found
 (lambda (path)
   (define upath (string-intersperse (map ->string (cdr (uri-path (request-uri (current-request))))) "/"))
   (cond ((equal? upath "")
	  (send-response #:body (frontend-lookup "index.html")))
	 (else
	  (let ((maybe-asset (frontend-lookup upath #f)))
	    (cond (maybe-asset
		   (send-response
		    #:headers (let ((ext (car (reverse (string-split upath ".")))))
				(cond ((equal? ext "css")
				       '((content-type #("text/css" ()))))
				      ((equal? ext "js")
				       '((content-type #("text/javascript" ()))))
				      (else
				       '())))
		    #:body maybe-asset))
		  (else
		   (when (not (handle-api-calls))
		     (send-response #:body (frontend-lookup "index.html"))))))))))

(accept-loop listener
	     (if ssl?
		 ssl-accept
		 tcp-accept))