#!/usr/bin/chicken-csi -s
(import spiffy
        cgi-handler
        uri-common
        intarweb
        (only chicken.format format)
        (only chicken.string  string-split string-intersperse ->string)
        (only chicken.file file-exists? directory)
        (only chicken.pathname
              make-pathname pathname-extension
              pathname-file pathname-directory)
        (only chicken.tcp tcp-listen tcp-accept)
        (only chicken.io read-line)
        (only chicken.sort sort)
        (only srfi-13 string-join string-null?)
        (only srfi-18 thread-start!)
        (only openssl
              ssl-listen* ssl-accept
              ssl-load-certificate-chain! ssl-load-private-key!)
        (only matchable match)
        (only nrepl nrepl nrepl-loop)
        (only inotify init! clean-up! add-watch! next-events!))

;; TODO: favicon
(spiffy-group "http")
(spiffy-user "http")
(root-path "/srv/http/dieggsy-domains")

(access-log "/var/log/spiffy/access.log")
(error-log "/var/log/spiffy/error.log")
(debug-log "/var/log/spiffy/debug.log")

(define cgit (cgi-handler* "/usr/lib/cgit/cgit.cgi"))

(define ssl-listener
  (ssl-listen* port: 443
               certificate:  "/etc/letsencrypt/live/dieggsy.com/fullchain.pem"
               private-key:  "/etc/letsencrypt/live/dieggsy.com/privkey.pem"))
(define http-listener (tcp-listen 80))

;; (ssl-load-certificate-chain! ssl-listener "/etc/letsencrypt/live/dieggsy.com/fullchain.pem")
;; (ssl-load-private-key! ssl-listener "/etc/letsencrypt/live/dieggsy.com/privkey.pem")

(switch-user/group (spiffy-user) (spiffy-group))

;; Don't serve org files, these are internal to generate html
(file-extension-handlers
 `(("org" . ,(lambda (p) (handle-not-found p)))))

(handle-not-found
 (lambda (path)
   (send-status 'not-found
                "
There seems to be nothing here!
")))

;; TODO: Modularize this per website?
(define (make-generic-handler root fn)
  (lambda (continue)
    (let* ((req (current-request))
           (uri (request-uri req))
           (path (uri-path uri))
           (scheme (uri-scheme uri)))
      (if (eqv? scheme 'http)
          (match path
            ;; Handle let's encrypt certs
            (('/ ".well-known" "acme-challenge" . rest)
             (parameterize ((root-path root))
               (continue)))
            ;; Redirect to https
            (else
             (let ((new-u (update-uri uri scheme: 'https)))
               (with-headers `((location ,new-u))
                             (lambda () (send-status 'moved-permanently))))))
          ;; HTTPS
          (match path
            (('/ (and subdir (or "css" "image" "js")) filename)
             (continue))
            (else (fn continue root uri)))))))

(define (blog-fn continue root uri)
  (match (uri-path uri)
    (('/ (and subdir (or "prime" "fibonacci")) nth)
     (parameterize ((root-path root))
       (send-static-file (make-pathname "fun" subdir "html"))))
    (else
     (parameterize ((root-path root))
       (continue)))))

(define (paste-fn continue root uri)
  (match (uri-path uri)
    ;; TODO
    (('/ (or "" "pastes.html"))
     (parameterize ((root-path root))
       (continue)))
    (('/ title . raw)
     (let* ((raw? (and (not (null? raw)) (car raw)))
            (subdir (if raw? "raw" "html"))
            (ext (if raw? "txt" "html"))
            (fname (make-pathname #f title ext))
            (new-path `(/ ,subdir ,fname))
            (new-uri (update-uri uri path: new-path)))
       (parameterize ((root-path root)
                      (current-request (update-request (current-request)
                                                       uri: new-uri)))
         (continue))))))

(define (wiki-fn continue root uri)
  (parameterize ((root-path root))
    (continue)))

(define handle-blog (make-generic-handler "/srv/http/dieggsy-domains/blog" blog-fn))
(define handle-paste (make-generic-handler  "/srv/http/dieggsy-domains/paste" paste-fn))
(define handle-wiki (make-generic-handler "/srv/http/dieggsy-domains/wiki" wiki-fn))
(define (handle-cgit continue)
  (parameterize
      ((root-path "/srv/git")
       (handle-directory cgit)
       (handle-not-found
        (lambda (p)
          (let* ((uri (request-uri (current-request)))
                 (path (string-intersperse (cdr (uri-path uri)) "/")))
            (parameterize ((current-pathinfo (string-split path "/")))
              (cgit path))))))
    (continue)))

(vhost-map `(("dieggsy.com" . ,(lambda (c) (handle-blog c)))
             ("paste.dieggsy.com" . ,(lambda (c) (handle-paste c)))
             ("wiki.dieggsy.com" . ,(lambda (c) (handle-wiki c)))
             ("code.dieggsy.com" . ,(lambda (c) (handle-cgit c)))
             ("www.dieggsy.com" .
              ,(lambda (c)
                 (let* ((old-u (request-uri (current-request)))
                        (new-u (update-uri old-u host: "dieggsy.com")))
                   (with-headers `((location ,new-u))
                                 (lambda () (send-status 'moved-permanently))))))))

;; Watch for pastes - if a new one is created, re-generate the listing in
;; pastes.html (for paste.dieggsy.com homepage)
(init!)
(on-exit clean-up!)
(add-watch! (make-pathname (root-path) "paste/raw") '(move create delete))
(define (watch-paste)
  (next-events!)
  (call-with-output-file (make-pathname (root-path) "paste/pastes" "html")
    (lambda (p)
      (display
       (string-join
        (map
         (lambda (f)
           (let ((f (pathname-file f)))
             (format "
~a
" f f)))
         (sort (directory (make-pathname (root-path) "paste/raw")) string>?))
        "\n")
       p)))
  (watch-paste))

;; Generate pastes homepage
(thread-start! watch-paste)
;; Start on HTTP
(thread-start! (lambda ()
                 (parameterize ((server-port 80))
                   (accept-loop http-listener tcp-accept))))
;; Start on SSL
(parameterize ((server-port 443))
  (accept-loop ssl-listener ssl-accept))