Password-Manager/delphi-backend/Source/PM.Database.pas

unit PM.Database;

{
  SQLite connection (FireDAC) toward the shared vault.db file.
  CreateSchema mirrors api.php (CREATE TABLE IF NOT EXISTS + ALTER migrations).
  Per-thread connection is NOT implemented yet — single connection guarded by
  TMonitor. Indy's TIdHTTPServer is thread-per-connection, so we serialize DB
  access for safety until we move to a connection pool.
}

interface

uses
  System.SysUtils, System.Classes, System.IOUtils, System.SyncObjs,
  FireDAC.Comp.Client, FireDAC.Stan.Def, FireDAC.Stan.Async,
  FireDAC.Phys.SQLite, FireDAC.DApt, FireDAC.Stan.Param,
  FireDAC.FMXUI.Wait, FireDAC.Stan.Intf, FireDAC.UI.Intf,
  Data.DB;

type
  TPMDatabase = class
  private
    FConn: TFDConnection;
    FLock: TCriticalSection;
    FDBPath: string;
    function ColumnExists(const ATable, AColumn: string): Boolean;
    procedure AddColumnIfMissing(const ATable, AColumn, ADef: string);
    procedure CreateSchema;
    procedure ApplyMigrations;
    procedure CleanupExpired;
  public
    constructor Create(const ADBPath: string);
    destructor Destroy; override;
    procedure Lock;
    procedure Unlock;
    // VACUUM the file when a large fraction of its pages are free (SQLite
    // never shrinks on DELETE — deleting big attachments leaves the file
    // bloated). No-op when the free ratio is low, so the common case pays
    // nothing. Caller must NOT hold the lock or be in a transaction.
    procedure CompactIfBloated;
    property Connection: TFDConnection read FConn;
    property DBPath: string read FDBPath;
  end;

var
  DB: TPMDatabase;

procedure InitDatabase(const ADBPath: string);
procedure DoneDatabase;

// Current time as UTC. SQLite's CURRENT_TIMESTAMP / datetime('now') already
// emit UTC, so every Delphi-written timestamp (created_at, updated_at,
// deleted_at, …) MUST use these — mixing Delphi's local-time Now with the
// SQLite-UTC values silently skews the sync last-write-wins / tombstone
// resurrection arbitration by the machine's UTC offset (see CODE_AUDIT §2.2).
function NowUTC: TDateTime;
function NowUTCStr: string;   // 'yyyy-mm-dd hh:nn:ss' in UTC

implementation

uses
  System.DateUtils;   // TTimeZone for local→UTC conversion

function NowUTC: TDateTime;
begin
  Result := TTimeZone.Local.ToUniversalTime(Now);
end;

function NowUTCStr: string;
begin
  Result := FormatDateTime('yyyy-mm-dd hh:nn:ss', NowUTC);
end;

constructor TPMDatabase.Create(const ADBPath: string);
begin
  inherited Create;
  FDBPath := ADBPath;
  FLock := TCriticalSection.Create;
  FConn := TFDConnection.Create(nil);
  FConn.DriverName := 'SQLite';
  FConn.Params.Values['Database'] := FDBPath;
  FConn.Params.Values['LockingMode'] := 'Normal';
  FConn.Params.Values['Synchronous'] := 'Normal';
  FConn.Params.Values['BusyTimeout'] := '5000';
  FConn.Params.Values['JournalMode'] := 'WAL';
  FConn.Open;
  CreateSchema;
  ApplyMigrations;
  CleanupExpired;
  // Reclaim space left behind by previously-deleted large rows
  // (attachments especially). Only actually rewrites the file when it's
  // meaningfully bloated, so a healthy small vault opens instantly.
  CompactIfBloated;
end;

destructor TPMDatabase.Destroy;
begin
  FConn.Free;
  FLock.Free;
  inherited;
end;

procedure TPMDatabase.CompactIfBloated;
var
  LQ: TFDQuery;
  LFree, LTotal: Int64;
begin
  FLock.Enter;
  try
    LFree := 0; LTotal := 0;
    LQ := TFDQuery.Create(nil);
    try
      LQ.Connection := FConn;
      LQ.SQL.Text := 'PRAGMA freelist_count';
      LQ.Open; if not LQ.IsEmpty then LFree := LQ.Fields[0].AsLargeInt;
      LQ.Close;
      LQ.SQL.Text := 'PRAGMA page_count';
      LQ.Open; if not LQ.IsEmpty then LTotal := LQ.Fields[0].AsLargeInt;
      LQ.Close;
    finally
      LQ.Free;
    end;
    // Rewrite only when >20% of the pages are free AND there's at least a
    // few MB to reclaim (avoids churning a tiny vault). VACUUM can't run
    // inside a transaction, so this must be called outside one.
    if (LTotal > 0) and (LFree * 5 > LTotal) and (LFree > 512) then
      FConn.ExecSQL('VACUUM');
  finally
    FLock.Leave;
  end;
end;

procedure TPMDatabase.Lock;
begin
  FLock.Enter;
end;

procedure TPMDatabase.Unlock;
begin
  FLock.Leave;
end;

procedure TPMDatabase.CreateSchema;
begin
  FConn.ExecSQL(
    'CREATE TABLE IF NOT EXISTS users (' +
    '  id INTEGER PRIMARY KEY AUTOINCREMENT,' +
    '  username TEXT UNIQUE NOT NULL,' +
    '  password_hash TEXT NOT NULL,' +
    '  salt TEXT NOT NULL,' +
    '  created_at DATETIME DEFAULT CURRENT_TIMESTAMP,' +
    '  hash_algo TEXT DEFAULT ''pbkdf2''' +
    ')');
  FConn.ExecSQL(
    'CREATE TABLE IF NOT EXISTS folders (' +
    '  id INTEGER PRIMARY KEY AUTOINCREMENT,' +
    '  user_id INTEGER NOT NULL,' +
    '  name TEXT NOT NULL,' +
    '  created_at DATETIME DEFAULT CURRENT_TIMESTAMP,' +
    '  FOREIGN KEY (user_id) REFERENCES users(id) ON DELETE CASCADE,' +
    '  UNIQUE(user_id, name)' +
    ')');
  FConn.ExecSQL(
    'CREATE TABLE IF NOT EXISTS vault_entries (' +
    '  id INTEGER PRIMARY KEY AUTOINCREMENT,' +
    '  user_id INTEGER NOT NULL,' +
    '  site TEXT NOT NULL,' +
    '  username TEXT NOT NULL,' +
    '  encrypted_password TEXT NOT NULL,' +
    '  iv TEXT NOT NULL,' +
    '  encryption_method TEXT DEFAULT ''server'',' +
    '  folder TEXT DEFAULT ''All'',' +
    '  deleted INTEGER DEFAULT 0,' +
    '  deleted_at DATETIME,' +
    '  favorite INTEGER DEFAULT 0,' +
    '  created_at DATETIME DEFAULT CURRENT_TIMESTAMP,' +
    '  updated_at DATETIME DEFAULT CURRENT_TIMESTAMP' +
    ')');
  FConn.ExecSQL(
    'CREATE TABLE IF NOT EXISTS sessions (' +
    '  id INTEGER PRIMARY KEY AUTOINCREMENT,' +
    '  user_id INTEGER NOT NULL,' +
    '  token_hash TEXT UNIQUE NOT NULL,' +
    '  csrf_token TEXT,' +
    '  created_at DATETIME DEFAULT CURRENT_TIMESTAMP,' +
    '  expires_at DATETIME NOT NULL,' +
    '  FOREIGN KEY (user_id) REFERENCES users(id) ON DELETE CASCADE' +
    ')');
  FConn.ExecSQL(
    'CREATE TABLE IF NOT EXISTS login_attempts (' +
    '  id INTEGER PRIMARY KEY AUTOINCREMENT,' +
    '  ip TEXT NOT NULL,' +
    '  attempted_at DATETIME DEFAULT CURRENT_TIMESTAMP' +
    ')');
  // Per-username lockout state, complementing the per-IP login_attempts
  // counter. On a loopback-only deployment the per-IP counter is mostly
  // useless (everyone hits 127.0.0.1), so the per-username counter is the
  // real defense against brute-force.
  // - failed_count: total failures since the last successful auth
  // - locked_until: timestamp the account becomes available again (NULL = not locked)
  // - last_attempt_at / _ip: forensic info for the audit log
  FConn.ExecSQL(
    'CREATE TABLE IF NOT EXISTS account_lockouts (' +
    '  username TEXT PRIMARY KEY,' +
    '  failed_count INTEGER NOT NULL DEFAULT 0,' +
    '  locked_until DATETIME,' +
    '  last_attempt_at DATETIME DEFAULT CURRENT_TIMESTAMP,' +
    '  last_attempt_ip TEXT' +
    ')');
  // Recovery key — per-user single-use code that wraps the current AES
  // vault key, used to recover access if the master password is forgotten.
  // The plaintext code is shown to the user exactly once at setup; the
  // server only ever sees SHA-256(code) for lookup. wrapped_key is the
  // user''s AES key encrypted (AES-GCM) under a KEK derived from
  // PBKDF2(code, kdf_salt, 600k). Single-use: redeem deletes the row.
  FConn.ExecSQL(
    'CREATE TABLE IF NOT EXISTS recovery_keys (' +
    '  user_id     INTEGER PRIMARY KEY,' +
    '  code_hash   TEXT NOT NULL,' +
    '  kdf_salt    TEXT NOT NULL,' +
    '  wrapped_key TEXT NOT NULL,' +
    '  wrapped_iv  TEXT NOT NULL,' +
    '  created_at  DATETIME DEFAULT CURRENT_TIMESTAMP,' +
    '  FOREIGN KEY (user_id) REFERENCES users(id) ON DELETE CASCADE' +
    ')');
  FConn.ExecSQL(
    'CREATE TABLE IF NOT EXISTS audit_log (' +
    '  id INTEGER PRIMARY KEY AUTOINCREMENT,' +
    '  user_id INTEGER,' +
    '  action TEXT NOT NULL,' +
    '  ip TEXT,' +
    '  created_at DATETIME DEFAULT CURRENT_TIMESTAMP' +
    ')');
  FConn.ExecSQL(
    'CREATE TABLE IF NOT EXISTS passkey_challenges (' +
    '  id INTEGER PRIMARY KEY AUTOINCREMENT,' +
    '  user_id INTEGER,' +
    '  challenge BLOB NOT NULL,' +
    '  type TEXT NOT NULL,' +
    '  created_at DATETIME DEFAULT CURRENT_TIMESTAMP' +
    ')');
  FConn.ExecSQL(
    'CREATE TABLE IF NOT EXISTS passkey_credentials (' +
    '  id INTEGER PRIMARY KEY AUTOINCREMENT,' +
    '  user_id INTEGER NOT NULL,' +
    '  credential_id BLOB NOT NULL UNIQUE,' +
    '  public_key BLOB NOT NULL,' +
    '  counter INTEGER DEFAULT 0,' +
    '  created_at DATETIME DEFAULT CURRENT_TIMESTAMP,' +
    '  FOREIGN KEY (user_id) REFERENCES users(id) ON DELETE CASCADE' +
    ')');
  // Password history — keeps the last N versions of each entry's
  // encrypted_password + iv. Populated by HandleUpdateEntry before each
  // PUT overwrites the row; pruned to 20 entries per row after each insert.
  // kind mirrors vault_entries.kind so notes can be restored too.
  FConn.ExecSQL(
    'CREATE TABLE IF NOT EXISTS entries_password_history (' +
    '  id INTEGER PRIMARY KEY AUTOINCREMENT,' +
    '  entry_id INTEGER NOT NULL,' +
    '  user_id INTEGER NOT NULL,' +
    '  encrypted_password TEXT NOT NULL,' +
    '  iv TEXT NOT NULL,' +
    '  kind TEXT NOT NULL DEFAULT ''login'',' +
    '  changed_at DATETIME DEFAULT CURRENT_TIMESTAMP,' +
    '  FOREIGN KEY (entry_id) REFERENCES vault_entries(id) ON DELETE CASCADE,' +
    '  FOREIGN KEY (user_id)  REFERENCES users(id)         ON DELETE CASCADE' +
    ')');
  FConn.ExecSQL(
    'CREATE INDEX IF NOT EXISTS idx_history_entry ' +
    '  ON entries_password_history(entry_id, changed_at DESC)');
  // Per-entry encrypted file attachments (PDFs, images of backup codes,
  // etc.). encrypted_blob is the AES-GCM ciphertext of the raw file bytes,
  // base64-encoded. Filename + mime + size_bytes are stored in cleartext
  // for the listing UI — knowingly leaked metadata in exchange for not
  // having to decrypt every entry on list render.
  FConn.ExecSQL(
    'CREATE TABLE IF NOT EXISTS entry_attachments (' +
    '  id INTEGER PRIMARY KEY AUTOINCREMENT,' +
    '  user_id INTEGER NOT NULL,' +
    '  entry_id INTEGER NOT NULL,' +
    '  filename TEXT NOT NULL,' +
    '  mime TEXT,' +
    '  size_bytes INTEGER NOT NULL,' +
    '  encrypted_blob TEXT NOT NULL,' +
    '  iv TEXT NOT NULL,' +
    '  created_at DATETIME DEFAULT CURRENT_TIMESTAMP,' +
    '  FOREIGN KEY (user_id)  REFERENCES users(id)         ON DELETE CASCADE,' +
    '  FOREIGN KEY (entry_id) REFERENCES vault_entries(id) ON DELETE CASCADE' +
    ')');
  FConn.ExecSQL(
    'CREATE INDEX IF NOT EXISTS idx_attachments_entry ' +
    '  ON entry_attachments(entry_id)');
end;

function TPMDatabase.ColumnExists(const ATable, AColumn: string): Boolean;
var
  LQ: TFDQuery;
begin
  Result := False;
  LQ := TFDQuery.Create(nil);
  try
    LQ.Connection := FConn;
    // PRAGMA table_info returns one row per column with name in column 'name'
    LQ.SQL.Text := 'PRAGMA table_info(' + ATable + ')';
    LQ.Open;
    while not LQ.Eof do
    begin
      if SameText(LQ.FieldByName('name').AsString, AColumn) then
        Exit(True);
      LQ.Next;
    end;
  finally
    LQ.Free;
  end;
end;

procedure TPMDatabase.AddColumnIfMissing(const ATable, AColumn, ADef: string);
begin
  if not ColumnExists(ATable, AColumn) then
    FConn.ExecSQL('ALTER TABLE ' + ATable + ' ADD COLUMN ' + AColumn + ' ' + ADef);
end;

procedure TPMDatabase.ApplyMigrations;
begin
  // Idempotent: only ALTER when the column is actually missing — no exception
  // bubbling up to the debugger like api.php's try/catch did.
  AddColumnIfMissing('vault_entries', 'encryption_method', 'TEXT DEFAULT ''server''');
  AddColumnIfMissing('vault_entries', 'folder',            'TEXT DEFAULT ''All''');
  AddColumnIfMissing('vault_entries', 'deleted',           'INTEGER DEFAULT 0');
  AddColumnIfMissing('vault_entries', 'deleted_at',        'DATETIME');
  AddColumnIfMissing('vault_entries', 'favorite',          'INTEGER DEFAULT 0');
  // UI V2: tags stored as comma-separated TEXT (e.g. "work,important,2fa").
  // Simple format, search via LIKE %tag%. Frontend handles parsing/joining.
  AddColumnIfMissing('vault_entries', 'tags',              'TEXT DEFAULT ''''');
  // Optional human-friendly display name. When empty, the UI falls back
  // to `site`. Lets the user store the raw URL/host (used for autofill
  // domain matching) while showing something nicer on cards/slideovers.
  AddColumnIfMissing('vault_entries', 'title',             'TEXT DEFAULT ''''');
  // TOTP (2FA) — RFC 6238. Secret + IV are AES-GCM ciphertext / IV pair
  // encrypted client-side with the user's master-derived key, exactly like
  // encrypted_password. The server treats them as opaque blobs and never
  // sees the plaintext secret. NULL = no TOTP configured for this entry.
  AddColumnIfMissing('vault_entries', 'totp_secret',       'TEXT');
  AddColumnIfMissing('vault_entries', 'totp_iv',           'TEXT');
  // Entry kind: 'login' (default — site/user/encrypted_password/iv/totp)
  // or 'note' (free-text secure note — body stored in encrypted_password
  // + iv, site/username/totp_* unused). Legacy rows default to 'login'.
  AddColumnIfMissing('vault_entries', 'kind',              'TEXT DEFAULT ''login''');
  // Custom fields: opaque encrypted JSON array of
  //   [{label, value, is_secret}, ...]
  // Same crypto pipeline as encrypted_password (AES-GCM with the vault
  // key). NULL = no custom fields configured. The server treats both
  // columns as opaque ciphertext + IV.
  AddColumnIfMissing('vault_entries', 'custom_fields',     'TEXT');
  AddColumnIfMissing('vault_entries', 'custom_fields_iv',  'TEXT');
  // Cached favicon as a base64 data URI (e.g. "data:image/png;base64,...").
  // Fetched on demand by the Delphi favicon proxy when the user opts in.
  // NULL = no icon cached → JS falls back to the first-letter avatar.
  AddColumnIfMissing('vault_entries', 'icon_b64',          'TEXT');
  // Tracked client-side via POST /entries/:id/touch on copy/open. Powers
  // the sidebar "Recent" view. NULL = never accessed since the column
  // landed (legacy rows).
  AddColumnIfMissing('vault_entries', 'accessed_at',       'DATETIME');
  // Bumped to CURRENT_TIMESTAMP only when encrypted_password actually
  // changes (distinct from updated_at which fires on any edit). Powers
  // the "aged password" badge. Legacy rows: NULL → JS falls back to
  // updated_at, then created_at.
  AddColumnIfMissing('vault_entries', 'password_changed_at', 'DATETIME');
  // Pinned entries float to the top of every view, regardless of sort.
  // Independent from favorite (which is a filter, not a sort override).
  AddColumnIfMissing('vault_entries', 'pinned',             'INTEGER DEFAULT 0');
  // Template identifier: empty/NULL = generic login or note; otherwise a
  // string like 'credit-card', 'ssh-key', 'server', 'recovery-codes'.
  // Drives the card/table label so notes-with-fields read as "Credit card"
  // instead of the generic "Encrypted note" placeholder.
  AddColumnIfMissing('vault_entries', 'template',           'TEXT');
  // Stable identity that survives export/import + cross-device sync.
  // SQLite `id` is autoincrement local-only — useless to match the same
  // logical entry across two installs. Populate existing rows with a
  // fresh UUID v4 below so the migration is non-destructive.
  AddColumnIfMissing('vault_entries', 'uuid',               'TEXT');
  FConn.ExecSQL(
    'CREATE INDEX IF NOT EXISTS idx_entries_uuid ' +
    '  ON vault_entries(uuid)');
  // Backfill UUIDs for legacy rows that landed before the column existed.
  // SQLite has no native uuid() — emit one via hex(randomblob) + manual
  // dashes (RFC 4122 v4 = 8-4-4-4-12 hex, version nibble forced to 4,
  // variant nibble high bits 10).
  FConn.ExecSQL(
    'UPDATE vault_entries SET uuid = ' +
    '  lower(hex(randomblob(4))) || ''-'' || ' +
    '  lower(hex(randomblob(2))) || ''-4'' || ' +
    '  substr(lower(hex(randomblob(2))), 2) || ''-'' || ' +
    '  substr(''89ab'', 1 + (abs(random()) % 4), 1) || ' +
    '  substr(lower(hex(randomblob(2))), 2) || ''-'' || ' +
    '  lower(hex(randomblob(6))) ' +
    'WHERE uuid IS NULL OR uuid = ''''');
  // Tombstones: every hard-delete inserts a row here so the sync engine
  // can propagate deletes to other devices without leaving deleted
  // entries to silently reappear at next pull.
  FConn.ExecSQL(
    'CREATE TABLE IF NOT EXISTS entry_tombstones (' +
    '  id INTEGER PRIMARY KEY AUTOINCREMENT,' +
    '  user_id INTEGER NOT NULL,' +
    '  uuid TEXT NOT NULL,' +
    '  deleted_at DATETIME DEFAULT CURRENT_TIMESTAMP,' +
    '  FOREIGN KEY (user_id) REFERENCES users(id) ON DELETE CASCADE,' +
    '  UNIQUE(user_id, uuid)' +
    ')');
  FConn.ExecSQL(
    'CREATE INDEX IF NOT EXISTS idx_tombstones_user ' +
    '  ON entry_tombstones(user_id, deleted_at DESC)');
  // Per-folder customisation. NULL = no override → JS uses the default
  // accent + i-folder symbol.
  AddColumnIfMissing('folders',       'color',             'TEXT');
  AddColumnIfMissing('folders',       'icon',              'TEXT');
  // Manual sort order from drag-reorder. 0 = legacy/never reordered →
  // falls back to alphabetical secondary sort in GET /folders.
  AddColumnIfMissing('folders',       'sort_order',        'INTEGER DEFAULT 0');
  AddColumnIfMissing('users',         'hash_algo',         'TEXT DEFAULT ''pbkdf2''');
  // PBKDF2 iteration count per user. Legacy rows (predating this column)
  // default to 100000 — the value used by api.php / the early Delphi build.
  // New accounts created here use the current PBKDF2_ITERATIONS_TARGET
  // (600 000 as of 2026). Login flow transparently re-hashes legacy users
  // and re-encrypts their entries on the client side.
  AddColumnIfMissing('users',         'kdf_iterations',    'INTEGER DEFAULT 100000');
  AddColumnIfMissing('recovery_keys', 'remaining_uses',    'INTEGER DEFAULT 5');
  // Server-side preferences blob (JSON). Synced across devices on login,
  // saved on every change from the JS settings panel. Device-specific
  // toggles (quick-unlock DPAPI, Win32 autofill hotkey) intentionally stay
  // in localStorage and are NOT included here.
  AddColumnIfMissing('users',         'settings_json',     'TEXT DEFAULT ''{}''');
  // Profile picture: base64 data URI (nullable). Cosmetic, not encrypted.
  // Kept in its own column rather than settings_json so it isn't shipped
  // on every settings GET/PUT (an image is 5-50 KB).
  AddColumnIfMissing('users',         'avatar_b64',        'TEXT');
  AddColumnIfMissing('sessions',      'csrf_token',        'TEXT');
end;

procedure TPMDatabase.CleanupExpired;
begin
  FConn.ExecSQL('DELETE FROM sessions WHERE expires_at < datetime(''now'')');
  FConn.ExecSQL('DELETE FROM login_attempts WHERE attempted_at < datetime(''now'', ''-15 minutes'')');
  FConn.ExecSQL('DELETE FROM audit_log WHERE created_at < datetime(''now'', ''-30 days'')');
  // Account lockout entries: prune rows that are no longer locked AND haven't
  // been touched in 30 days (the user clearly isn't being attacked anymore).
  // Active lockouts and recent attempts are preserved.
  FConn.ExecSQL(
    'DELETE FROM account_lockouts ' +
    'WHERE (locked_until IS NULL OR locked_until < datetime(''now'')) ' +
    'AND last_attempt_at < datetime(''now'', ''-30 days'')');
  FConn.ExecSQL('DELETE FROM passkey_challenges WHERE created_at < datetime(''now'', ''-10 minutes'')');
end;

procedure InitDatabase(const ADBPath: string);
begin
  if DB = nil then
    DB := TPMDatabase.Create(ADBPath);
end;

procedure DoneDatabase;
begin
  FreeAndNil(DB);
end;

initialization
finalization
  DoneDatabase;
end.