#lang racket/base

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; PostgreSQL connection settings and database initialization.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(require db
         racket/file
         racket/port
         "config.rkt"
         "migrations.rkt")

(provide (struct-out database-settings)
         database-settings-exist?
         read-database-settings
         write-database-settings!
         test-database-settings!
         call-with-wiki-database
         initialize-database!
         initialize-database-with-settings!
         database-ready?)

(struct database-settings (server port database user password ssl) #:transparent)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Supporting functions
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; goal   : Check whether PostgreSQL settings have been saved.
; pre    : config is a wiki-config value.
; post   : The settings path has only been inspected.
; result : #t when database.rktd exists, otherwise #f.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (database-settings-exist? config)
  (file-exists? (database-config-path config)))

(define (settings->datum settings)
  (hash 'server (database-settings-server settings)
        'port (database-settings-port settings)
        'database (database-settings-database settings)
        'user (database-settings-user settings)
        'password (database-settings-password settings)
        'ssl (database-settings-ssl settings)))

(define (datum->settings value)
  (database-settings (hash-ref value 'server "localhost")
                     (hash-ref value 'port 5432)
                     (hash-ref value 'database "racket_wiki")
                     (hash-ref value 'user "")
                     (hash-ref value 'password "")
                     (hash-ref value 'ssl 'no)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; goal   : Read the saved PostgreSQL connection settings.
; pre    : config is a wiki-config value.
; post   : The settings file, when present, has only been read.
; result : A database-settings value, or #f when no settings file exists.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (read-database-settings config)
  (and (database-settings-exist? config)
       (call-with-input-file (database-config-path config)
         (λ (in)
           (datum->settings (read in))))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; goal   : Persist PostgreSQL connection settings.
; pre    : config and settings are wiki-config and database-settings values.
; post   : database.rktd contains settings and is private where supported.
; result : void.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (write-database-settings! config settings)
  (make-directory* (wiki-config-data-dir config))
  (call-with-output-file (database-config-path config)
    (λ (out)
      (write (settings->datum settings) out)
      (newline out))
    #:exists 'truncate/replace)
  (with-handlers ((exn:fail? (λ (_e) (void))))
    (file-or-directory-permissions (database-config-path config) #o600))
  (void))

(define (connect settings)
  (let ((password
         (if (string=? (database-settings-password settings) "")
             #f
             (database-settings-password settings))))
    (postgresql-connect #:server (database-settings-server settings)
                        #:port (database-settings-port settings)
                        #:database (database-settings-database settings)
                        #:user (database-settings-user settings)
                        #:password password
                        #:ssl (database-settings-ssl settings))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; goal   : Verify that supplied PostgreSQL settings can execute a query.
; pre    : settings is a database-settings value for a reachable database.
; post   : The temporary connection is closed on success or failure.
; result : void, or a database exception when validation fails.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (test-database-settings! settings)
  (let ((db (connect settings)))
    (dynamic-wind
     void
     (λ () (query-value db "SELECT 1"))
     (λ () (disconnect db)))
    (void)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; goal   : Run a procedure with a fresh PostgreSQL connection.
; pre    : PostgreSQL settings have been saved and proc accepts one connection.
; post   : The connection is closed after proc returns or raises.
; result : The value returned by proc.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (call-with-wiki-database config proc)
  (let ((settings (read-database-settings config)))
    (unless settings
      (error 'call-with-wiki-database "PostgreSQL is not configured"))
    (let ((db (connect settings)))
      (dynamic-wind
       void
       (λ () (proc db))
       (λ () (disconnect db))))))

(define (initialize-on-connection! db config)
  (migrate-database! db config)
  (query-exec db "DELETE FROM sessions WHERE expires_at <= $1" (current-seconds))
  (void))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; goal   : Initialize the wiki schema using explicit PostgreSQL settings.
; pre    : settings can connect to a writable PostgreSQL database.
; post   : Migrations are complete, expired sessions are removed and the connection is closed.
; result : void.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (initialize-database-with-settings! settings config)
  (let ((db (connect settings)))
    (dynamic-wind
     void
     (λ () (initialize-on-connection! db config))
     (λ () (disconnect db)))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; goal   : Initialize the PostgreSQL schema used by racket-wiki.
; pre    : Valid PostgreSQL settings have been saved.
; post   : All wiki tables and indexes exist and expired sessions are removed.
; result : void.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (initialize-database! config)
  (call-with-wiki-database
   config
   (λ (db)
     (initialize-on-connection! db config))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; goal   : Check whether the configured database has the required core tables.
; pre    : config is a wiki-config value.
; post   : The database is unchanged and every temporary connection is closed.
; result : #t when settings and core tables are available, otherwise #f.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (database-ready? config)
  (and (database-settings-exist? config)
       (with-handlers ((exn:fail? (λ (_e) #f)))
         (call-with-wiki-database
          config
          (λ (db)
            (and (query-value db "SELECT to_regclass('public.users') IS NOT NULL")
                 (query-value db "SELECT to_regclass('public.pages') IS NOT NULL")
                 (query-value db "SELECT to_regclass('public.page_versions') IS NOT NULL")
                 (query-value db "SELECT to_regclass('public.concept_maps') IS NOT NULL")
                 (query-value db "SELECT to_regclass('public.sessions') IS NOT NULL")))))))