Initial import

2026-08-14 21:47:23 +02:00
parent 8538f57678
commit 40ad35b418
22 changed files with 5319 additions and 1 deletions
@@ -0,0 +1,244 @@
+#lang racket/base
+
+(require db
+         racket/file
+         racket/path
+         racket/string
+         "config.rkt"
+         "todo.rkt")
+
+(provide current-schema-version
+         database-schema-version
+         migrate-database!)
+
+(define current-schema-version 3)
+
+(define schema-1-statements
+  (list
+   #<<SQL
+CREATE TABLE IF NOT EXISTS users (
+  id BIGSERIAL PRIMARY KEY,
+  username TEXT NOT NULL UNIQUE,
+  display_name TEXT NOT NULL,
+  password_hash TEXT NOT NULL,
+  role TEXT NOT NULL CHECK(role IN ('reader', 'editor', 'admin')),
+  enabled BOOLEAN NOT NULL DEFAULT TRUE,
+  created_at BIGINT NOT NULL,
+  updated_at BIGINT NOT NULL
+)
+SQL
+   #<<SQL
+CREATE TABLE IF NOT EXISTS sessions (
+  token_hash TEXT PRIMARY KEY,
+  user_id BIGINT NOT NULL REFERENCES users(id) ON DELETE CASCADE,
+  csrf_token TEXT NOT NULL,
+  created_at BIGINT NOT NULL,
+  expires_at BIGINT NOT NULL
+)
+SQL
+   "CREATE INDEX IF NOT EXISTS sessions_expires_idx ON sessions(expires_at)"
+   #<<SQL
+CREATE TABLE IF NOT EXISTS pages (
+  id BIGSERIAL PRIMARY KEY,
+  slug TEXT NOT NULL UNIQUE,
+  title TEXT NOT NULL,
+  markdown TEXT NOT NULL,
+  tags TEXT NOT NULL DEFAULT '[]',
+  current_version BIGINT NOT NULL DEFAULT 1,
+  created_at BIGINT NOT NULL,
+  updated_at BIGINT NOT NULL,
+  created_by TEXT NOT NULL,
+  updated_by TEXT NOT NULL,
+  archived BOOLEAN NOT NULL DEFAULT FALSE,
+  archived_at BIGINT,
+  archived_by TEXT,
+  search_document TSVECTOR NOT NULL
+)
+SQL
+   "CREATE INDEX IF NOT EXISTS pages_search_idx ON pages USING GIN(search_document)"
+   "CREATE INDEX IF NOT EXISTS pages_title_idx ON pages(lower(title))"
+   #<<SQL
+CREATE TABLE IF NOT EXISTS page_versions (
+  id BIGSERIAL PRIMARY KEY,
+  page_id BIGINT NOT NULL REFERENCES pages(id) ON DELETE CASCADE,
+  version BIGINT NOT NULL,
+  title TEXT NOT NULL,
+  markdown TEXT NOT NULL,
+  tags TEXT NOT NULL DEFAULT '[]',
+  author TEXT NOT NULL,
+  action TEXT NOT NULL,
+  summary TEXT NOT NULL,
+  created_at BIGINT NOT NULL,
+  UNIQUE(page_id, version)
+)
+SQL
+   "CREATE INDEX IF NOT EXISTS page_versions_page_idx ON page_versions(page_id, version DESC)"
+   #<<SQL
+CREATE TABLE IF NOT EXISTS attachments (
+  id BIGSERIAL PRIMARY KEY,
+  page_id BIGINT NOT NULL REFERENCES pages(id) ON DELETE CASCADE,
+  original_name TEXT NOT NULL,
+  stored_name TEXT NOT NULL,
+  size BIGINT NOT NULL,
+  uploaded_at BIGINT NOT NULL,
+  uploaded_by TEXT NOT NULL,
+  UNIQUE(page_id, stored_name)
+)
+SQL
+   ))
+
+(define (table-exists? db name)
+  (if (query-maybe-value db "SELECT to_regclass($1) IS NOT NULL" (string-append "public." name))
+      #t
+      #f))
+
+(define (ensure-schema-table! db)
+  (query-exec db
+              #<<SQL
+CREATE TABLE IF NOT EXISTS wiki_schema (
+  version INTEGER PRIMARY KEY,
+  applied_at BIGINT NOT NULL
+)
+SQL
+              ))
+
+(define (database-schema-version db)
+  (if (table-exists? db "wiki_schema")
+      (query-value db "SELECT COALESCE(MAX(version), 0) FROM wiki_schema")
+      0))
+
+(define (record-schema-version! db version)
+  (query-exec db
+              "INSERT INTO wiki_schema(version, applied_at) VALUES ($1, $2) ON CONFLICT (version) DO NOTHING"
+              version
+              (current-seconds)))
+
+(define (recognize-schema-1? db)
+  (and (table-exists? db "users")
+       (table-exists? db "sessions")
+       (table-exists? db "pages")
+       (table-exists? db "page_versions")
+       (table-exists? db "attachments")))
+
+(define (install-schema-1! db)
+  (for ((statement (in-list schema-1-statements)))
+    (query-exec db statement))
+  (ensure-schema-table! db)
+  (record-schema-version! db 1))
+
+(define (recognize-or-install-schema-1! db)
+  (cond
+    ((table-exists? db "wiki_schema")
+     (void))
+    ((recognize-schema-1? db)
+     (ensure-schema-table! db)
+     (record-schema-version! db 1))
+    (else
+     (install-schema-1! db))))
+
+(define (legacy-mime-type stored-name)
+  (define lower (string-downcase stored-name))
+  (cond
+    ((regexp-match? #px"[.]png$" lower) "image/png")
+    ((regexp-match? #px"[.](jpg|jpeg)$" lower) "image/jpeg")
+    ((regexp-match? #px"[.]gif$" lower) "image/gif")
+    ((regexp-match? #px"[.]webp$" lower) "image/webp")
+    ((regexp-match? #px"[.]pdf$" lower) "application/pdf")
+    ((regexp-match? #px"[.]txt$" lower) "text/plain; charset=utf-8")
+    (else "application/octet-stream")))
+
+(define (migrate-1->2! db config)
+  (query-exec db "ALTER TABLE attachments ADD COLUMN IF NOT EXISTS mime_type TEXT")
+  (query-exec db "ALTER TABLE attachments ADD COLUMN IF NOT EXISTS content BYTEA")
+  (define rows
+    (query-rows db
+                #<<SQL
+SELECT a.id, p.slug, a.stored_name, a.content
+FROM attachments a
+JOIN pages p ON p.id = a.page_id
+ORDER BY a.id
+SQL
+                ))
+  (for ((row (in-list rows)))
+    (define attachment-id (vector-ref row 0))
+    (define slug (vector-ref row 1))
+    (define stored-name (vector-ref row 2))
+    (define content (vector-ref row 3))
+    (unless (bytes? content)
+      (define path (build-path (uploads-directory config) slug stored-name))
+      (unless (file-exists? path)
+        (error 'migrate-database!
+               "schema 1 -> 2 cannot migrate attachment ~a: missing file ~a"
+               stored-name
+               (path->string path)))
+      (define bytes (file->bytes path))
+      (query-exec db
+                  "UPDATE attachments SET content = $1, mime_type = $2, size = $3 WHERE id = $4"
+                  bytes
+                  (legacy-mime-type stored-name)
+                  (bytes-length bytes)
+                  attachment-id)))
+  (query-exec db "UPDATE attachments SET mime_type = 'application/octet-stream' WHERE mime_type IS NULL")
+  (query-exec db "ALTER TABLE attachments ALTER COLUMN mime_type SET NOT NULL")
+  (query-exec db "ALTER TABLE attachments ALTER COLUMN content SET NOT NULL")
+  (record-schema-version! db 2))
+
+
+(define (replace-page-todos! db page-id markdown)
+  (query-exec db "DELETE FROM todo_items WHERE page_id = $1" page-id)
+  (for ((item (in-list (extract-todos markdown))))
+    (query-exec db
+                #<<SQL
+INSERT INTO todo_items(page_id, item_number, line_number, text)
+VALUES ($1, $2, $3, $4)
+SQL
+                page-id
+                (hash-ref item 'number)
+                (hash-ref item 'line)
+                (hash-ref item 'text))))
+
+(define (migrate-2->3! db)
+  (query-exec db
+              #<<SQL
+CREATE TABLE IF NOT EXISTS todo_items (
+  id BIGSERIAL PRIMARY KEY,
+  page_id BIGINT NOT NULL REFERENCES pages(id) ON DELETE CASCADE,
+  item_number INTEGER NOT NULL,
+  line_number INTEGER NOT NULL,
+  text TEXT NOT NULL,
+  UNIQUE(page_id, item_number)
+)
+SQL
+              )
+  (query-exec db "CREATE INDEX IF NOT EXISTS todo_items_page_idx ON todo_items(page_id, item_number)")
+  (for ((row (in-list (query-rows db "SELECT id, markdown FROM pages WHERE archived = FALSE"))))
+    (replace-page-todos! db (vector-ref row 0) (vector-ref row 1)))
+  (record-schema-version! db 3))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Bring a racket-wiki PostgreSQL database to the current schema.
+; pre    : db is a writable PostgreSQL connection and config identifies the
+;          data directory used by older racket-wiki versions.
+; post   : Every required migration has been applied in order and recorded.
+; result : The resulting schema version.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (migrate-database! db config)
+  (call-with-transaction
+   db
+   (λ ()
+     (recognize-or-install-schema-1! db)
+     (define version (database-schema-version db))
+     (when (< version 1)
+       (error 'migrate-database! "unable to determine the existing wiki database schema"))
+     (when (= version 1)
+       (migrate-1->2! db config))
+     (define after-attachments (database-schema-version db))
+     (when (= after-attachments 2)
+       (migrate-2->3! db))
+     (define resulting-version (database-schema-version db))
+     (when (> resulting-version current-schema-version)
+       (error 'migrate-database!
+              "database schema ~a is newer than this racket-wiki supports (~a)"
+              resulting-version
+              current-schema-version))
+     resulting-version)))