Files
Password-Manager/delphi-backend/Handlers/PM.Handler.Entries.pas
T
Zaki 40b3154a34 feat: MFA tools, single-instance, tray polish, prefs persistence
Session highlights:

- feat(prefs): DPAPI-backed key/value store (PM.UserPrefs) — fixes
  rememberedUsername being lost across reboots due to the random
  ephemeral HTTP port changing the localStorage origin every launch.
  Bridge cmd://prefs/{get,set} round-trips through Delphi.

- feat(tray): icon visible from startup (NIM_ADD at constructor, not
  at first minimize). Tray context menu themed via uxtheme!135
  SetPreferredAppMode so it follows the app's dark/light setting.

- feat(single-instance): named mutex + RegisterWindowMessage broadcast.
  Second launch posts WM_PMSHOW to HWND_BROADCAST and exits; the
  running bridge restores the window from tray. Mutex lives in Local\
  namespace so distinct Windows users can still each run one.

- feat(mfa): Authenticator sidebar view (live TOTP codes for every
  entry with a secret) + standalone TOTP generator modal (paste
  base32 / otpauth:// URI, or generate a random 20-byte secret).

- feat(sidebar): Folders / Tags / Tools sections collapsible with
  chevron toggle. Badge counts stay visible when collapsed. State
  persisted in settings_json (synced across devices).

- feat(autofill): hotkey when vault is locked now restores the app
  and focuses the master password input instead of no-op'ing
  silently. Cleaner UX for the common "I hit Ctrl+Shift+L but the
  vault was locked" path.

- feat(quick-unlock): when enabled, skip lockVault on Windows lock /
  sleep. Rationale: the DPAPI blob already gates access via the
  Windows account, so re-locking on top of the OS lock is redundant.
  Idle auto-lock still fires (separate opt-in).

- fix(quick-unlock): re-sync state.quickUnlockEnabled from DPAPI
  source-of-truth at boot, instead of trusting (now-volatile)
  localStorage.

- docs: CLAUDE.md updated with all new modules, bridge commands,
  and the port-ephemeral pitfall.

Co-Authored-By: Claude Opus 4.7 <noreply@anthropic.com>
2026-06-08 21:31:39 +01:00

676 lines
22 KiB
ObjectPascal

unit PM.Handler.Entries;
(*
GET /entries?search=&deleted=0 -> JSON array of entries
POST /entries body {site,username,encrypted_password,iv,folder} -> {id,site,username,folder}
PUT /entries/{id} body {site,username,encrypted_password,iv,folder} -> {message}
DELETE /entries/{id}?permanent=0|1 -> {message}
POST /entries/{id}/restore -> {message}
POST /entries/{id}/favorite -> {message}
DELETE /entries/trash/empty -> {message}
*)
interface
implementation
uses
System.SysUtils, System.JSON, System.StrUtils, System.NetEncoding,
System.Generics.Collections,
Data.DB, FireDAC.Comp.Client, FireDAC.Stan.Param,
IdCustomHTTPServer, IdGlobalProtocols, IdURI,
PM.Router, PM.JSON, PM.Database, PM.Session, PM.Audit, PM.RateLimit;
function GetQueryParam(ARequest: TIdHTTPRequestInfo; const AName: string;
const ADefault: string = ''): string;
begin
Result := ARequest.Params.Values[AName];
if Result = '' then Result := ADefault;
end;
// SQLite DATETIME columns: FireDAC parses to TDateTime internally, then AsString
// would format in system locale (DD/MM/YYYY in French). Force ISO format
// 'yyyy-mm-dd hh:nn:ss' which is what api.php / SQLite text storage uses and
// what the JS frontend parses.
function ISODateTimeField(AField: TField): string;
begin
if AField.IsNull then
Result := ''
else
Result := FormatDateTime('yyyy-mm-dd hh:nn:ss', AField.AsDateTime);
end;
// ===== GET /entries ==========================================================
procedure HandleGetEntries(ARequest: TIdHTTPRequestInfo;
AResponse: TIdHTTPResponseInfo; const AParams: TArray<string>);
var
LUserId: Integer;
LQ: TFDQuery;
LArr: TJSONArray;
LObj: TJSONObject;
LSearch, LDeletedStr: string;
LDeleted: Integer;
begin
try
LUserId := Authenticate(ARequest, AResponse);
except
on ESessionRejected do Exit;
end;
LSearch := GetQueryParam(ARequest, 'search', '');
LDeletedStr := GetQueryParam(ARequest, 'deleted', '0');
if LDeletedStr = '1' then LDeleted := 1 else LDeleted := 0;
LArr := TJSONArray.Create;
DB.Lock;
try
LQ := TFDQuery.Create(nil);
try
LQ.Connection := DB.Connection;
if LSearch <> '' then
begin
LQ.SQL.Text :=
'SELECT * FROM vault_entries ' +
'WHERE user_id = :uid AND deleted = :del ' +
'AND (site LIKE :q OR username LIKE :q) ' +
'ORDER BY updated_at DESC';
LQ.ParamByName('q').AsString := '%' + LSearch + '%';
end
else
begin
LQ.SQL.Text :=
'SELECT * FROM vault_entries ' +
'WHERE user_id = :uid AND deleted = :del ' +
'ORDER BY updated_at DESC';
end;
LQ.ParamByName('uid').AsInteger := LUserId;
LQ.ParamByName('del').AsInteger := LDeleted;
LQ.Open;
while not LQ.Eof do
begin
LObj := TJSONObject.Create;
LObj.AddPair('id', TJSONNumber.Create(LQ.FieldByName('id').AsInteger));
LObj.AddPair('site', LQ.FieldByName('site').AsString);
LObj.AddPair('title', LQ.FieldByName('title').AsString);
LObj.AddPair('username', LQ.FieldByName('username').AsString);
LObj.AddPair('encrypted_password', LQ.FieldByName('encrypted_password').AsString);
LObj.AddPair('iv', LQ.FieldByName('iv').AsString);
LObj.AddPair('encryption_method', LQ.FieldByName('encryption_method').AsString);
LObj.AddPair('folder', LQ.FieldByName('folder').AsString);
LObj.AddPair('deleted', TJSONNumber.Create(LQ.FieldByName('deleted').AsInteger));
if LQ.FieldByName('deleted_at').IsNull then
LObj.AddPair('deleted_at', TJSONNull.Create)
else
LObj.AddPair('deleted_at', ISODateTimeField(LQ.FieldByName('deleted_at')));
LObj.AddPair('favorite', TJSONNumber.Create(LQ.FieldByName('favorite').AsInteger));
LObj.AddPair('tags', LQ.FieldByName('tags').AsString);
// TOTP fields are NULL when the entry has no 2FA configured. We emit
// JSON null instead of '' so the client can distinguish "no TOTP" from
// "TOTP configured with empty ciphertext" (which shouldn't happen).
if LQ.FieldByName('totp_secret').IsNull then
LObj.AddPair('totp_secret', TJSONNull.Create)
else
LObj.AddPair('totp_secret', LQ.FieldByName('totp_secret').AsString);
if LQ.FieldByName('totp_iv').IsNull then
LObj.AddPair('totp_iv', TJSONNull.Create)
else
LObj.AddPair('totp_iv', LQ.FieldByName('totp_iv').AsString);
LObj.AddPair('created_at', ISODateTimeField(LQ.FieldByName('created_at')));
LObj.AddPair('updated_at', ISODateTimeField(LQ.FieldByName('updated_at')));
LArr.Add(LObj);
LQ.Next;
end;
finally
LQ.Free;
end;
finally
DB.Unlock;
end;
TJSONHelper.SendJSON(AResponse, LArr);
end;
// ===== POST /entries =========================================================
procedure HandleCreateEntry(ARequest: TIdHTTPRequestInfo;
AResponse: TIdHTTPResponseInfo; const AParams: TArray<string>);
var
LUserId, LNewId: Integer;
LBody, LObj: TJSONObject;
LSite, LTitle, LUser, LFolder, LEnc, LIV, LTags, LNow, LTotpSec, LTotpIv: string;
LQ: TFDQuery;
begin
try
LUserId := Authenticate(ARequest, AResponse);
RequireCSRF(ARequest, AResponse, LUserId);
except
on ESessionRejected do Exit;
end;
LBody := TJSONHelper.ReadBody(ARequest);
try
LSite := Trim(LBody.GetValue<string>('site', ''));
LTitle := Trim(LBody.GetValue<string>('title', ''));
LUser := Trim(LBody.GetValue<string>('username', ''));
LFolder := Trim(LBody.GetValue<string>('folder', 'All'));
LEnc := LBody.GetValue<string>('encrypted_password', '');
LIV := LBody.GetValue<string>('iv', '');
LTags := Trim(LBody.GetValue<string>('tags', ''));
// TOTP secret + IV — optional. Empty string = no TOTP configured.
LTotpSec := LBody.GetValue<string>('totp_secret', '');
LTotpIv := LBody.GetValue<string>('totp_iv', '');
finally
LBody.Free;
end;
if (LSite = '') or (LEnc = '') then
begin
TJSONHelper.SendError(AResponse, 400, 'Site & password required');
Exit;
end;
LNow := FormatDateTime('yyyy-mm-dd hh:nn:ss', Now);
DB.Lock;
try
LQ := TFDQuery.Create(nil);
try
LQ.Connection := DB.Connection;
LQ.SQL.Text :=
'INSERT INTO vault_entries ' +
'(user_id, site, title, username, encrypted_password, iv, encryption_method, ' +
' folder, tags, totp_secret, totp_iv, created_at, updated_at) ' +
'VALUES (:uid, :s, :tt, :u, :e, :i, ''client'', :f, :t, :ts, :tiv, :c, :c2)';
LQ.ParamByName('uid').AsInteger := LUserId;
LQ.ParamByName('s').AsString := LSite;
LQ.ParamByName('tt').AsString := LTitle;
LQ.ParamByName('u').AsString := LUser;
LQ.ParamByName('e').AsString := LEnc;
LQ.ParamByName('i').AsString := LIV;
LQ.ParamByName('f').AsString := LFolder;
LQ.ParamByName('t').AsString := LTags;
// FireDAC needs an explicit DataType on params that are sometimes
// assigned a string and sometimes Clear()ed to NULL — without a
// prior typed assignment, .Clear raises "data type unknown" on
// SQLite. Declare ftString up front for the optional TOTP fields.
LQ.ParamByName('ts').DataType := ftString;
LQ.ParamByName('tiv').DataType := ftString;
// Store empty TOTP fields as NULL so the GET endpoint emits JSON null
// rather than '' — keeps client-side "has TOTP?" checks unambiguous.
if LTotpSec = '' then
LQ.ParamByName('ts').Clear
else
LQ.ParamByName('ts').AsString := LTotpSec;
if LTotpIv = '' then
LQ.ParamByName('tiv').Clear
else
LQ.ParamByName('tiv').AsString := LTotpIv;
LQ.ParamByName('c').AsString := LNow;
LQ.ParamByName('c2').AsString := LNow;
LQ.ExecSQL;
LNewId := DB.Connection.GetLastAutoGenValue('vault_entries');
finally
LQ.Free;
end;
finally
DB.Unlock;
end;
LogAudit(LUserId, 'add_entry', GetClientIP(ARequest));
LObj := TJSONObject.Create;
LObj.AddPair('id', TJSONNumber.Create(LNewId));
LObj.AddPair('site', LSite);
LObj.AddPair('title', LTitle);
LObj.AddPair('username', LUser);
LObj.AddPair('folder', LFolder);
LObj.AddPair('tags', LTags);
TJSONHelper.SendJSON(AResponse, LObj);
end;
// ===== PUT /entries/{id} =====================================================
procedure HandleUpdateEntry(ARequest: TIdHTTPRequestInfo;
AResponse: TIdHTTPResponseInfo; const AParams: TArray<string>);
var
LUserId, LId: Integer;
LBody: TJSONObject;
LSite, LTitle, LUser, LFolder, LEnc, LIV, LTags, LNow, LTotpSec, LTotpIv: string;
LQ: TFDQuery;
begin
try
LUserId := Authenticate(ARequest, AResponse);
RequireCSRF(ARequest, AResponse, LUserId);
except
on ESessionRejected do Exit;
end;
LId := StrToIntDef(AParams[0], 0);
if LId = 0 then
begin
TJSONHelper.SendError(AResponse, 400, 'Invalid id');
Exit;
end;
LBody := TJSONHelper.ReadBody(ARequest);
try
LSite := Trim(LBody.GetValue<string>('site', ''));
LTitle := Trim(LBody.GetValue<string>('title', ''));
LUser := Trim(LBody.GetValue<string>('username', ''));
LFolder := Trim(LBody.GetValue<string>('folder', 'All'));
LEnc := LBody.GetValue<string>('encrypted_password', '');
LIV := LBody.GetValue<string>('iv', '');
LTags := Trim(LBody.GetValue<string>('tags', ''));
LTotpSec := LBody.GetValue<string>('totp_secret', '');
LTotpIv := LBody.GetValue<string>('totp_iv', '');
finally
LBody.Free;
end;
if (LSite = '') or (LEnc = '') then
begin
TJSONHelper.SendError(AResponse, 400, 'Site & password required');
Exit;
end;
LNow := FormatDateTime('yyyy-mm-dd hh:nn:ss', Now);
DB.Lock;
try
LQ := TFDQuery.Create(nil);
try
LQ.Connection := DB.Connection;
LQ.SQL.Text :=
'UPDATE vault_entries ' +
'SET site=:s, title=:tt, username=:u, encrypted_password=:e, iv=:i, ' +
' folder=:f, tags=:t, totp_secret=:ts, totp_iv=:tiv, ' +
' updated_at=:c ' +
'WHERE id=:id AND user_id=:uid';
LQ.ParamByName('s').AsString := LSite;
LQ.ParamByName('tt').AsString := LTitle;
LQ.ParamByName('u').AsString := LUser;
LQ.ParamByName('e').AsString := LEnc;
LQ.ParamByName('i').AsString := LIV;
LQ.ParamByName('f').AsString := LFolder;
LQ.ParamByName('t').AsString := LTags;
// Declare TOTP param types so .Clear works on first use (FireDAC
// needs an inferred or explicit DataType before NULL binding).
LQ.ParamByName('ts').DataType := ftString;
LQ.ParamByName('tiv').DataType := ftString;
// Clearing TOTP (user removed 2FA from this entry) is signaled by an
// empty string in the request → store NULL in the DB.
if LTotpSec = '' then
LQ.ParamByName('ts').Clear
else
LQ.ParamByName('ts').AsString := LTotpSec;
if LTotpIv = '' then
LQ.ParamByName('tiv').Clear
else
LQ.ParamByName('tiv').AsString := LTotpIv;
LQ.ParamByName('c').AsString := LNow;
LQ.ParamByName('id').AsInteger := LId;
LQ.ParamByName('uid').AsInteger := LUserId;
LQ.ExecSQL;
finally
LQ.Free;
end;
finally
DB.Unlock;
end;
LogAudit(LUserId, 'edit_entry', GetClientIP(ARequest));
TJSONHelper.SendOK(AResponse, 'Updated');
end;
// ===== DELETE /entries/{id} ==================================================
procedure HandleDeleteEntry(ARequest: TIdHTTPRequestInfo;
AResponse: TIdHTTPResponseInfo; const AParams: TArray<string>);
var
LUserId, LId: Integer;
LPermanent: Boolean;
LQ: TFDQuery;
begin
try
LUserId := Authenticate(ARequest, AResponse);
RequireCSRF(ARequest, AResponse, LUserId);
except
on ESessionRejected do Exit;
end;
LId := StrToIntDef(AParams[0], 0);
if LId = 0 then
begin
TJSONHelper.SendError(AResponse, 400, 'Invalid id');
Exit;
end;
LPermanent := GetQueryParam(ARequest, 'permanent', '0') = '1';
DB.Lock;
try
LQ := TFDQuery.Create(nil);
try
LQ.Connection := DB.Connection;
if LPermanent then
LQ.SQL.Text := 'DELETE FROM vault_entries WHERE id=:id AND user_id=:uid'
else
LQ.SQL.Text :=
'UPDATE vault_entries SET deleted=1, deleted_at=datetime(''now'') ' +
'WHERE id=:id AND user_id=:uid';
LQ.ParamByName('id').AsInteger := LId;
LQ.ParamByName('uid').AsInteger := LUserId;
LQ.ExecSQL;
finally
LQ.Free;
end;
finally
DB.Unlock;
end;
if LPermanent then
LogAudit(LUserId, 'permanent_delete', GetClientIP(ARequest))
else
LogAudit(LUserId, 'delete_entry', GetClientIP(ARequest));
TJSONHelper.SendOK(AResponse, 'Deleted');
end;
// ===== POST /entries/{id}/restore ============================================
procedure HandleRestoreEntry(ARequest: TIdHTTPRequestInfo;
AResponse: TIdHTTPResponseInfo; const AParams: TArray<string>);
var
LUserId, LId: Integer;
LQ: TFDQuery;
begin
try
LUserId := Authenticate(ARequest, AResponse);
RequireCSRF(ARequest, AResponse, LUserId);
except
on ESessionRejected do Exit;
end;
LId := StrToIntDef(AParams[0], 0);
if LId = 0 then
begin
TJSONHelper.SendError(AResponse, 400, 'Invalid id');
Exit;
end;
DB.Lock;
try
LQ := TFDQuery.Create(nil);
try
LQ.Connection := DB.Connection;
LQ.SQL.Text :=
'UPDATE vault_entries SET deleted=0, deleted_at=NULL, ' +
' updated_at=datetime(''now'') ' +
'WHERE id=:id AND user_id=:uid';
LQ.ParamByName('id').AsInteger := LId;
LQ.ParamByName('uid').AsInteger := LUserId;
LQ.ExecSQL;
finally
LQ.Free;
end;
finally
DB.Unlock;
end;
LogAudit(LUserId, 'restore_entry', GetClientIP(ARequest));
TJSONHelper.SendOK(AResponse, 'Restored');
end;
// ===== POST /entries/{id}/favorite ===========================================
procedure HandleToggleFavorite(ARequest: TIdHTTPRequestInfo;
AResponse: TIdHTTPResponseInfo; const AParams: TArray<string>);
var
LUserId, LId: Integer;
LQ: TFDQuery;
begin
try
LUserId := Authenticate(ARequest, AResponse);
RequireCSRF(ARequest, AResponse, LUserId);
except
on ESessionRejected do Exit;
end;
LId := StrToIntDef(AParams[0], 0);
if LId = 0 then
begin
TJSONHelper.SendError(AResponse, 400, 'Invalid id');
Exit;
end;
DB.Lock;
try
LQ := TFDQuery.Create(nil);
try
LQ.Connection := DB.Connection;
LQ.SQL.Text :=
'UPDATE vault_entries ' +
'SET favorite = CASE WHEN favorite=1 THEN 0 ELSE 1 END ' +
'WHERE id=:id AND user_id=:uid';
LQ.ParamByName('id').AsInteger := LId;
LQ.ParamByName('uid').AsInteger := LUserId;
LQ.ExecSQL;
finally
LQ.Free;
end;
finally
DB.Unlock;
end;
LogAudit(LUserId, 'toggle_favorite', GetClientIP(ARequest));
TJSONHelper.SendOK(AResponse, 'Toggled');
end;
// ===== DELETE /entries/trash/empty ===========================================
procedure HandleEmptyTrash(ARequest: TIdHTTPRequestInfo;
AResponse: TIdHTTPResponseInfo; const AParams: TArray<string>);
var
LUserId: Integer;
LQ: TFDQuery;
begin
try
LUserId := Authenticate(ARequest, AResponse);
RequireCSRF(ARequest, AResponse, LUserId);
except
on ESessionRejected do Exit;
end;
DB.Lock;
try
LQ := TFDQuery.Create(nil);
try
LQ.Connection := DB.Connection;
LQ.SQL.Text := 'DELETE FROM vault_entries WHERE user_id=:uid AND deleted=1';
LQ.ParamByName('uid').AsInteger := LUserId;
LQ.ExecSQL;
finally
LQ.Free;
end;
finally
DB.Unlock;
end;
LogAudit(LUserId, 'empty_trash', GetClientIP(ARequest));
TJSONHelper.SendOK(AResponse, 'Trash emptied');
end;
// ===== POST /entries/bulk-import =============================================
// Accepts an array of already-encrypted entries (the client encrypts each
// entry with the vault key before posting). Inserts them all in a single
// transaction so a partial failure rolls back cleanly. Used by the JSON / CSV
// import flow — much faster than N sequential POST /entries for large vaults.
procedure HandleBulkImport(ARequest: TIdHTTPRequestInfo;
AResponse: TIdHTTPResponseInfo; const AParams: TArray<string>);
var
LUserId, I, LImported: Integer;
LBody, LObj, LEntry: TJSONObject;
LArr: TJSONArray;
LSite, LTitle, LUser, LFolder, LEnc, LIV, LTags, LTotpSec, LTotpIv, LNow: string;
LQ: TFDQuery;
begin
try
LUserId := Authenticate(ARequest, AResponse);
RequireCSRF(ARequest, AResponse, LUserId);
except
on ESessionRejected do Exit;
end;
LBody := TJSONHelper.ReadBody(ARequest);
try
LArr := LBody.GetValue<TJSONArray>('entries');
if (LArr = nil) or (LArr.Count = 0) then
begin
TJSONHelper.SendError(AResponse, 400, 'Missing or empty entries array');
Exit;
end;
// Sanity cap. A real vault rarely has > 10k entries; if someone uploads
// a 100k-row CSV it's probably an attack or a mistake.
if LArr.Count > 10000 then
begin
TJSONHelper.SendError(AResponse, 413, 'Too many entries (max 10000 per request)');
Exit;
end;
LNow := FormatDateTime('yyyy-mm-dd hh:nn:ss', Now);
LImported := 0;
DB.Lock;
try
DB.Connection.StartTransaction;
try
LQ := TFDQuery.Create(nil);
try
LQ.Connection := DB.Connection;
LQ.SQL.Text :=
'INSERT INTO vault_entries ' +
'(user_id, site, title, username, encrypted_password, iv, encryption_method, ' +
' folder, tags, totp_secret, totp_iv, created_at, updated_at) ' +
'VALUES (:uid, :s, :tt, :u, :e, :i, ''client'', :f, :t, :ts, :tiv, :c, :c2)';
// Declare optional TOTP param types ONCE — the prepared statement
// is reused across every imported entry, and FireDAC needs the
// type set before the first .Clear call would otherwise fail
// for a row without TOTP.
LQ.ParamByName('ts').DataType := ftString;
LQ.ParamByName('tiv').DataType := ftString;
for I := 0 to LArr.Count - 1 do
begin
LEntry := LArr.Items[I] as TJSONObject;
LSite := Trim(LEntry.GetValue<string>('site', ''));
LTitle := Trim(LEntry.GetValue<string>('title', ''));
LUser := Trim(LEntry.GetValue<string>('username', ''));
LFolder := Trim(LEntry.GetValue<string>('folder', 'All'));
LEnc := LEntry.GetValue<string>('encrypted_password', '');
LIV := LEntry.GetValue<string>('iv', '');
LTags := Trim(LEntry.GetValue<string>('tags', ''));
LTotpSec := LEntry.GetValue<string>('totp_secret', '');
LTotpIv := LEntry.GetValue<string>('totp_iv', '');
// Skip silently if a row is missing the minimum required fields
// (site + ciphertext). Better than failing the whole batch on
// one bad row when the user is importing 500+ entries.
if (LSite = '') or (LEnc = '') or (LIV = '') then Continue;
LQ.ParamByName('uid').AsInteger := LUserId;
LQ.ParamByName('s').AsString := LSite;
LQ.ParamByName('tt').AsString := LTitle;
LQ.ParamByName('u').AsString := LUser;
LQ.ParamByName('e').AsString := LEnc;
LQ.ParamByName('i').AsString := LIV;
LQ.ParamByName('f').AsString := LFolder;
LQ.ParamByName('t').AsString := LTags;
if LTotpSec = '' then LQ.ParamByName('ts').Clear
else LQ.ParamByName('ts').AsString := LTotpSec;
if LTotpIv = '' then LQ.ParamByName('tiv').Clear
else LQ.ParamByName('tiv').AsString := LTotpIv;
LQ.ParamByName('c').AsString := LNow;
LQ.ParamByName('c2').AsString := LNow;
LQ.ExecSQL;
Inc(LImported);
end;
finally
LQ.Free;
end;
DB.Connection.Commit;
except
DB.Connection.Rollback;
raise;
end;
finally
DB.Unlock;
end;
finally
LBody.Free;
end;
LogAudit(LUserId, Format('bulk_import %d entries', [LImported]), GetClientIP(ARequest));
LObj := TJSONObject.Create;
LObj.AddPair('imported', TJSONNumber.Create(LImported));
TJSONHelper.SendJSON(AResponse, LObj);
end;
procedure HandleEntriesCount(ARequest: TIdHTTPRequestInfo;
AResponse: TIdHTTPResponseInfo; const AParams: TArray<string>);
var
LUserId, LActive, LTrashed: Integer;
LQ: TFDQuery;
LObj: TJSONObject;
begin
try
LUserId := Authenticate(ARequest, AResponse);
except
on ESessionRejected do Exit;
end;
LActive := 0;
LTrashed := 0;
DB.Lock;
try
LQ := TFDQuery.Create(nil);
try
LQ.Connection := DB.Connection;
LQ.SQL.Text :=
'SELECT deleted, COUNT(*) AS cnt FROM vault_entries ' +
'WHERE user_id = :uid GROUP BY deleted';
LQ.ParamByName('uid').AsInteger := LUserId;
LQ.Open;
while not LQ.Eof do
begin
if LQ.FieldByName('deleted').AsInteger = 0 then
LActive := LQ.FieldByName('cnt').AsInteger
else
LTrashed := LQ.FieldByName('cnt').AsInteger;
LQ.Next;
end;
finally
LQ.Free;
end;
finally
DB.Unlock;
end;
LObj := TJSONObject.Create;
LObj.AddPair('active', TJSONNumber.Create(LActive));
LObj.AddPair('trashed', TJSONNumber.Create(LTrashed));
TJSONHelper.SendJSON(AResponse, LObj);
end;
initialization
// /entries/trash/empty must be registered BEFORE /entries/{id} to win the regex match.
// Same logic for /entries/bulk-import — register before the catch-all /entries/{id}.
Router.Register('DELETE', '/entries/trash/empty', HandleEmptyTrash);
Router.Register('POST', '/entries/bulk-import', HandleBulkImport);
Router.Register('POST', '/entries/(\d+)/restore', HandleRestoreEntry);
Router.Register('POST', '/entries/(\d+)/favorite', HandleToggleFavorite);
Router.Register('GET', '/entries/count', HandleEntriesCount);
Router.Register('GET', '/entries', HandleGetEntries);
Router.Register('POST', '/entries', HandleCreateEntry);
Router.Register('PUT', '/entries/(\d+)', HandleUpdateEntry);
Router.Register('DELETE', '/entries/(\d+)', HandleDeleteEntry);
end.