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;
    property Connection: TFDConnection read FConn;
    property DBPath: string read FDBPath;
  end;

var
  DB: TPMDatabase;

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

implementation

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;
end;

destructor TPMDatabase.Destroy;
begin
  FConn.Free;
  FLock.Free;
  inherited;
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' +
    ')');
  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' +
    ')');
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 ''''');
  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('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.