#! /run/current-system/profile/bin/guile
;;;-*-guile-scheme-*-;;; !#


;;; Remove srfi-1 and srfi-19 dependency after deleting temporary upgrade 0-1
;;; remove (modules utils)
;;; Remove function time-13-to-10



(define-module (modules migrations-sqlite3)
  #:use-module (artanis artanis)
  #:use-module (artanis config)
  #:use-module (modules settings)
  #:use-module (srfi srfi-1)
  #:use-module (srfi srfi-19)
  #:use-module (modules utils)
  #:export (initialize-sqlite3-database))


(define (initialize-sqlite3-database conn mtable)
    (migrate conn mtable)
    (migrate-mods mtable))

(define (get-database-version conn mtable)
  (case (get-conf '(db dbd))
    ((sqlite3)
     (DB-query conn (format #f "PRAGMA user_version;"))
     (cdar (DB-get-top-row conn)))
    ((postgresql)
     ((mtable 'create 'metadata '((key text)
                                  (val text))
              #:if-exists? 'ignore #:engine #f)
      'valid?)
     (let ((ver (mtable 'get 'metadata #:columns '(val) #:condition (where #:key "version"))))
       (if (null? ver)
         (begin (mtable 'set 'metadata #:key "version" #:val 0)
                0)
         (string->number (cdar ver)))))))
(define (set-database-version conn mtable new-version)
  (case (get-conf '(db dbd))
    ((sqlite3)
     (DB-query conn (format #f "PRAGMA user_version=~a;" new-version)))
    ((postgresql)
     (mtable 'set 'metadata #:val new-version #:condition (where #:key "version")))))

(define latest-database-version 4)

(define (new-database conn mtable)
  (format #t "Initializing new database ...\n")
  ((mtable 'create 'cooldowns '((ip text)
                                (tier1 integer)
                                (tier2 integer)
                                (counter integer))
           #:if-exists? 'ignore #:engine #f)
   'valid?)
  ((mtable 'create 'banlist '((ip text)
                              (session text)
                              (expiration integer))
           #:if-exists? 'ignore #:engine #f)
   'valid?)
  ((mtable 'create 'boards '((id integer)
                             (board text)
                             (threadcount integer))
           #:primary-keys '(id) #:if-exists? 'ignore #:engine #f)
   'valid?)
  ((mtable 'create 'threads '((id integer)
                              (sticky integer)
                              (board text)
                              (threadnum integer)
                              (postcount integer)
                              (subject text)
                              (date text)
                              (ctime integer)
                              (btime integer)
                              (old integer))
           #:primary-keys '(id) #:if-exists? 'ignore #:engine #f)
   'valid?)
  ((mtable 'create 'posts '((id integer)
                            (board text)
                            (threadnum integer)
                            (postnum integer)
                            (ip text)
                            (session text)
                            (name text)
                            (date text)
                            (ctime integer)
                            (image text)
                            (thumb text)
                            (iname text)
                            (size text)
                            (comment text)
                            (subposts integer))
           #:primary-keys '(id) #:if-exists? 'ignore #:engine #f)
   'valid?)
  ((mtable 'create 'subposts '((id integer)
                               (board text)
                               (threadnum integer)
                               (postnum integer)
                               (ip text)
                               (session text)
                               (name text)
                               (date text)
                               (ctime integer)
                               (comment text))
           #:primary-keys '(id) #:if-exists? 'ignore #:engine #f)
   'valid?)
  ((mtable 'create 'mods '((id integer)
                           (session text)
                           (ctime integer)
                           (name text)
                           (permissions text)
                           (password text))
           #:primary-keys '(id) #:if-exists? 'ignore #:engine #f)
   'valid?)
  ((mtable 'create 'notes '((id integer)
                            (type text) ; Type is note, news, notice, or public. Notice = note with * read permissions, public = note with * write permissions
                            (name text)
                            (read text)
                            (write text)
                            (subject text)
                            (ctime integer)
                            (btime integer)
                            (date text)
                            (edited text)
                            (body text))
           #:primary-keys '(id) #:if-exists? 'ignore #:engine #f)
   'valid?)

  (set-database-version conn mtable latest-database-version)
  (migrate conn mtable))

(define (migrate conn mtable)
  (let ((version (get-database-version conn mtable)))
    (format #t "\n\nDatabase Version: ~a\n" version)
    (case version
      ((0) (new-database conn mtable))
      ((1) (format #t "Bumping(no change) database to version ~a...\n" (+ version 1))
           (set-database-version conn mtable (+ version 1))
           (migrate conn mtable))
      ((2) (format #t "Migrating database to version ~a...\n" (+ version 1))
           (DB-query conn (format #f "ALTER TABLE posts ADD COLUMN subposts INTEGER DEFAULT ~a;" 0))
           ((mtable 'create 'subposts '((id integer)
                                        (board text)
                                        (threadnum integer)
                                        (postnum integer)
                                        (ip text)
                                        (session text)
                                        (name text)
                                        (date text)
                                        (ctime integer)
                                        (comment text))
                    #:primary-keys '(id) #:if-exists? 'ignore #:engine #f)
            'valid?)
           (set-database-version conn mtable (+ version 1))
           (migrate conn mtable))
      ((3) (format #t "Migrating database to version ~a...\n" (+ version 1))
           (DB-query conn (format #f "ALTER TABLE threads ADD COLUMN old INTEGER DEFAULT ~a;" 0))
           ((mtable 'create 'banlist '((ip text)
                                       (session text)
                                       (expiration integer))
                    #:if-exists? 'ignore #:engine #f)
            'valid?)
           (DB-query conn (format #f "ALTER TABLE threads ADD COLUMN sticky INTEGER DEFAULT ~a;" 0))
           (set-database-version conn mtable (+ version 1))
           (migrate conn mtable))
      ((4) (format #t "Database is latest version.\n")))))

(define (migrate-mods mtable)
  ;(format #t "Mod table up to date.\n"))
  (let ((existing-mods (map cdar (mtable 'get 'mods #:columns '(name)))))
    (for-each (lambda (mod)
                (unless (member (car mod) existing-mods)
                  (mtable 'set 'mods #:session "none" #:ctime (get-timestamp13) #:name (car mod) #:permissions (cadr mod) #:password (caddr mod))))
              mods)))
