Zaki
fa7ea191be
- File: native Save As dialog via Bridge.saveFile (replaces WebView2
browser download popup) for encrypted JSON + CSV exports.
- Auto-backup: silent periodic encrypted JSON to a chosen folder,
user-set interval + retention, separate DPAPI-stored password, runs
5s after unlock if due. New file/* bridge cmds (folder/pick,
file/write, file/listMatch, file/delete).
- Folders: per-folder color + icon (8-swatch palette, 8 icon presets),
drag-reorder via HTML5 DnD with insert-line indicators, edit pencil
on hover. New POST /folders/reorder + PUT /folders/{name}. Folder
chip on cards inherits custom icon + color.
- Recently used: vault_entries.accessed_at + POST /entries/{id}/touch
(debounced 2s), sidebar Tools entry showing top-10 by accessed_at.
- Encrypted attachments: per-entry file storage (5MB cap), AES-GCM
with vault key, native Save As download, paperclip upload in
slideover. New entry_attachments table + PM.Handler.Attachments.
- Password expiry: vault_entries.password_changed_at (conditional bump
via SQL CASE only when ciphertext differs), passwordExpiryDays
setting, "Aged" badge on cards + matching Filters chip.
- Recovery: Print button on generated code modal (A4 printable sheet
via @media print, code in 32px monospace + instructions).
- Audit log viewer (sidebar Tools, GET /audit with pagination cursor).
- Plaintext CSV export + Filters dropdown with 9 predicates.
Co-Authored-By: Claude Opus 4.7 <noreply@anthropic.com>
370 lines
9.8 KiB
ObjectPascal
370 lines
9.8 KiB
ObjectPascal
unit PM.Handler.Folders;
|
|
|
|
(*
|
|
GET /folders -> [{name, color, icon}, ...]
|
|
POST /folders body {name, color?, icon?} -> {message, name}
|
|
PUT /folders/{name} body {color?, icon?} -> {message}
|
|
DELETE /folders/{name} -> {message}
|
|
*)
|
|
|
|
interface
|
|
|
|
implementation
|
|
|
|
uses
|
|
System.SysUtils, System.JSON, System.NetEncoding,
|
|
System.Generics.Collections,
|
|
FireDAC.Comp.Client, FireDAC.Stan.Param,
|
|
IdCustomHTTPServer,
|
|
PM.Router, PM.JSON, PM.Database, PM.Session, PM.Audit, PM.RateLimit;
|
|
|
|
// ===== GET /folders ==========================================================
|
|
|
|
procedure HandleGetFolders(ARequest: TIdHTTPRequestInfo;
|
|
AResponse: TIdHTTPResponseInfo; const AParams: TArray<string>);
|
|
var
|
|
LUserId: Integer;
|
|
LQ: TFDQuery;
|
|
LArr: TJSONArray;
|
|
LObj: TJSONObject;
|
|
begin
|
|
try
|
|
LUserId := Authenticate(ARequest, AResponse);
|
|
except
|
|
on ESessionRejected do Exit;
|
|
end;
|
|
|
|
LArr := TJSONArray.Create;
|
|
DB.Lock;
|
|
try
|
|
LQ := TFDQuery.Create(nil);
|
|
try
|
|
LQ.Connection := DB.Connection;
|
|
LQ.SQL.Text :=
|
|
'SELECT name, color, icon FROM folders ' +
|
|
'WHERE user_id = :uid ORDER BY sort_order, name';
|
|
LQ.ParamByName('uid').AsInteger := LUserId;
|
|
LQ.Open;
|
|
while not LQ.Eof do
|
|
begin
|
|
LObj := TJSONObject.Create;
|
|
LObj.AddPair('name', LQ.FieldByName('name').AsString);
|
|
LObj.AddPair('color', LQ.FieldByName('color').AsString);
|
|
LObj.AddPair('icon', LQ.FieldByName('icon').AsString);
|
|
LArr.Add(LObj);
|
|
LQ.Next;
|
|
end;
|
|
finally
|
|
LQ.Free;
|
|
end;
|
|
finally
|
|
DB.Unlock;
|
|
end;
|
|
TJSONHelper.SendJSON(AResponse, LArr);
|
|
end;
|
|
|
|
// ===== POST /folders =========================================================
|
|
|
|
procedure HandleCreateFolder(ARequest: TIdHTTPRequestInfo;
|
|
AResponse: TIdHTTPResponseInfo; const AParams: TArray<string>);
|
|
var
|
|
LUserId: Integer;
|
|
LBody: TJSONObject;
|
|
LName, LColor, LIcon: string;
|
|
LQ: TFDQuery;
|
|
LObj: TJSONObject;
|
|
begin
|
|
try
|
|
LUserId := Authenticate(ARequest, AResponse);
|
|
RequireCSRF(ARequest, AResponse, LUserId);
|
|
except
|
|
on ESessionRejected do Exit;
|
|
end;
|
|
|
|
LBody := TJSONHelper.ReadBody(ARequest);
|
|
try
|
|
LName := Trim(LBody.GetValue<string>('name', ''));
|
|
LColor := Trim(LBody.GetValue<string>('color', ''));
|
|
LIcon := Trim(LBody.GetValue<string>('icon', ''));
|
|
finally
|
|
LBody.Free;
|
|
end;
|
|
|
|
if LName = '' then
|
|
begin
|
|
TJSONHelper.SendError(AResponse, 400, 'Folder name required');
|
|
Exit;
|
|
end;
|
|
if SameText(LName, 'All') then
|
|
begin
|
|
TJSONHelper.SendError(AResponse, 400, 'Cannot use All');
|
|
Exit;
|
|
end;
|
|
|
|
DB.Lock;
|
|
try
|
|
LQ := TFDQuery.Create(nil);
|
|
try
|
|
LQ.Connection := DB.Connection;
|
|
LQ.SQL.Text :=
|
|
'INSERT INTO folders (user_id, name, color, icon) ' +
|
|
'VALUES (:uid, :name, :color, :icon)';
|
|
LQ.ParamByName('uid').AsInteger := LUserId;
|
|
LQ.ParamByName('name').AsString := LName;
|
|
if LColor = '' then LQ.ParamByName('color').Clear
|
|
else LQ.ParamByName('color').AsString := LColor;
|
|
if LIcon = '' then LQ.ParamByName('icon').Clear
|
|
else LQ.ParamByName('icon').AsString := LIcon;
|
|
try
|
|
LQ.ExecSQL;
|
|
except
|
|
on E: Exception do
|
|
begin
|
|
TJSONHelper.SendError(AResponse, 409, 'Folder exists');
|
|
Exit;
|
|
end;
|
|
end;
|
|
finally
|
|
LQ.Free;
|
|
end;
|
|
finally
|
|
DB.Unlock;
|
|
end;
|
|
|
|
LogAudit(LUserId, 'add_folder', GetClientIP(ARequest));
|
|
LObj := TJSONObject.Create;
|
|
LObj.AddPair('message', 'Created');
|
|
LObj.AddPair('name', LName);
|
|
TJSONHelper.SendJSON(AResponse, LObj);
|
|
end;
|
|
|
|
// ===== PUT /folders/{name} ===================================================
|
|
// Body: {color?, icon?} — pass empty string to clear.
|
|
|
|
procedure HandleUpdateFolder(ARequest: TIdHTTPRequestInfo;
|
|
AResponse: TIdHTTPResponseInfo; const AParams: TArray<string>);
|
|
var
|
|
LUserId: Integer;
|
|
LBody: TJSONObject;
|
|
LName, LColor, LIcon: string;
|
|
LHasColor, LHasIcon: Boolean;
|
|
LQ: TFDQuery;
|
|
begin
|
|
try
|
|
LUserId := Authenticate(ARequest, AResponse);
|
|
RequireCSRF(ARequest, AResponse, LUserId);
|
|
except
|
|
on ESessionRejected do Exit;
|
|
end;
|
|
|
|
if Length(AParams) < 1 then
|
|
begin
|
|
TJSONHelper.SendError(AResponse, 400, 'Folder name required');
|
|
Exit;
|
|
end;
|
|
LName := TNetEncoding.URL.Decode(AParams[0]);
|
|
if SameText(LName, 'All') then
|
|
begin
|
|
TJSONHelper.SendError(AResponse, 400, 'Cannot customise All');
|
|
Exit;
|
|
end;
|
|
|
|
LBody := TJSONHelper.ReadBody(ARequest);
|
|
try
|
|
LHasColor := LBody.GetValue('color') <> nil;
|
|
LHasIcon := LBody.GetValue('icon') <> nil;
|
|
LColor := LBody.GetValue<string>('color', '');
|
|
LIcon := LBody.GetValue<string>('icon', '');
|
|
finally
|
|
LBody.Free;
|
|
end;
|
|
|
|
if not (LHasColor or LHasIcon) then
|
|
begin
|
|
TJSONHelper.SendOK(AResponse, 'No change');
|
|
Exit;
|
|
end;
|
|
|
|
DB.Lock;
|
|
try
|
|
LQ := TFDQuery.Create(nil);
|
|
try
|
|
LQ.Connection := DB.Connection;
|
|
// Build SET clause dynamically based on which fields the caller sent.
|
|
var LSet := '';
|
|
if LHasColor then LSet := 'color = :color';
|
|
if LHasIcon then
|
|
begin
|
|
if LSet <> '' then LSet := LSet + ', ';
|
|
LSet := LSet + 'icon = :icon';
|
|
end;
|
|
LQ.SQL.Text :=
|
|
'UPDATE folders SET ' + LSet +
|
|
' WHERE user_id = :uid AND name = :name';
|
|
LQ.ParamByName('uid').AsInteger := LUserId;
|
|
LQ.ParamByName('name').AsString := LName;
|
|
if LHasColor then
|
|
begin
|
|
if LColor = '' then LQ.ParamByName('color').Clear
|
|
else LQ.ParamByName('color').AsString := LColor;
|
|
end;
|
|
if LHasIcon then
|
|
begin
|
|
if LIcon = '' then LQ.ParamByName('icon').Clear
|
|
else LQ.ParamByName('icon').AsString := LIcon;
|
|
end;
|
|
LQ.ExecSQL;
|
|
if LQ.RowsAffected = 0 then
|
|
begin
|
|
TJSONHelper.SendError(AResponse, 404, 'Not found');
|
|
Exit;
|
|
end;
|
|
finally
|
|
LQ.Free;
|
|
end;
|
|
finally
|
|
DB.Unlock;
|
|
end;
|
|
|
|
LogAudit(LUserId, 'update_folder', GetClientIP(ARequest));
|
|
TJSONHelper.SendOK(AResponse, 'Updated');
|
|
end;
|
|
|
|
// ===== POST /folders/reorder =================================================
|
|
// Body: {names: ["Work", "Personal", "Misc"]} — write sort_order = index+1
|
|
// for each. Names not in the list keep their previous sort_order (so a
|
|
// partial reorder still works after another tab created a folder).
|
|
|
|
procedure HandleReorderFolders(ARequest: TIdHTTPRequestInfo;
|
|
AResponse: TIdHTTPResponseInfo; const AParams: TArray<string>);
|
|
var
|
|
LUserId: Integer;
|
|
LBody: TJSONObject;
|
|
LArr: TJSONArray;
|
|
LQ: TFDQuery;
|
|
I: Integer;
|
|
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>('names');
|
|
if (LArr = nil) or (LArr.Count = 0) then
|
|
begin
|
|
TJSONHelper.SendError(AResponse, 400, 'names array required');
|
|
Exit;
|
|
end;
|
|
DB.Lock;
|
|
try
|
|
LQ := TFDQuery.Create(nil);
|
|
try
|
|
LQ.Connection := DB.Connection;
|
|
LQ.SQL.Text :=
|
|
'UPDATE folders SET sort_order = :ord ' +
|
|
'WHERE user_id = :uid AND name = :name';
|
|
for I := 0 to LArr.Count - 1 do
|
|
begin
|
|
LQ.ParamByName('uid').AsInteger := LUserId;
|
|
LQ.ParamByName('ord').AsInteger := I + 1;
|
|
LQ.ParamByName('name').AsString := LArr.Items[I].Value;
|
|
LQ.ExecSQL;
|
|
end;
|
|
finally
|
|
LQ.Free;
|
|
end;
|
|
finally
|
|
DB.Unlock;
|
|
end;
|
|
finally
|
|
LBody.Free;
|
|
end;
|
|
|
|
LogAudit(LUserId, 'reorder_folders', GetClientIP(ARequest));
|
|
TJSONHelper.SendOK(AResponse, 'Reordered');
|
|
end;
|
|
|
|
// ===== DELETE /folders/{name} ================================================
|
|
|
|
procedure HandleDeleteFolder(ARequest: TIdHTTPRequestInfo;
|
|
AResponse: TIdHTTPResponseInfo; const AParams: TArray<string>);
|
|
var
|
|
LUserId: Integer;
|
|
LName: string;
|
|
LQ: TFDQuery;
|
|
LChanges: Integer;
|
|
begin
|
|
try
|
|
LUserId := Authenticate(ARequest, AResponse);
|
|
RequireCSRF(ARequest, AResponse, LUserId);
|
|
except
|
|
on ESessionRejected do Exit;
|
|
end;
|
|
|
|
if Length(AParams) < 1 then
|
|
begin
|
|
TJSONHelper.SendError(AResponse, 400, 'Folder name required');
|
|
Exit;
|
|
end;
|
|
LName := TNetEncoding.URL.Decode(AParams[0]);
|
|
|
|
if SameText(LName, 'All') then
|
|
begin
|
|
TJSONHelper.SendError(AResponse, 400, 'Cannot delete All');
|
|
Exit;
|
|
end;
|
|
|
|
DB.Lock;
|
|
try
|
|
LQ := TFDQuery.Create(nil);
|
|
try
|
|
LQ.Connection := DB.Connection;
|
|
LQ.SQL.Text := 'DELETE FROM folders WHERE user_id = :uid AND name = :name';
|
|
LQ.ParamByName('uid').AsInteger := LUserId;
|
|
LQ.ParamByName('name').AsString := LName;
|
|
LQ.ExecSQL;
|
|
LChanges := LQ.RowsAffected;
|
|
finally
|
|
LQ.Free;
|
|
end;
|
|
|
|
if LChanges = 0 then
|
|
begin
|
|
TJSONHelper.SendError(AResponse, 404, 'Not found');
|
|
Exit;
|
|
end;
|
|
|
|
// Reassign entries from the deleted folder to 'All'
|
|
LQ := TFDQuery.Create(nil);
|
|
try
|
|
LQ.Connection := DB.Connection;
|
|
LQ.SQL.Text :=
|
|
'UPDATE vault_entries SET folder = ''All'' ' +
|
|
'WHERE user_id = :uid AND folder = :name';
|
|
LQ.ParamByName('uid').AsInteger := LUserId;
|
|
LQ.ParamByName('name').AsString := LName;
|
|
LQ.ExecSQL;
|
|
finally
|
|
LQ.Free;
|
|
end;
|
|
finally
|
|
DB.Unlock;
|
|
end;
|
|
|
|
LogAudit(LUserId, 'delete_folder', GetClientIP(ARequest));
|
|
TJSONHelper.SendOK(AResponse, 'Deleted');
|
|
end;
|
|
|
|
initialization
|
|
Router.Register('GET', '/folders', HandleGetFolders);
|
|
Router.Register('POST', '/folders', HandleCreateFolder);
|
|
Router.Register('POST', '/folders/reorder', HandleReorderFolders);
|
|
Router.Register('PUT', '/folders/(.+)', HandleUpdateFolder);
|
|
Router.Register('DELETE', '/folders/(.+)', HandleDeleteFolder);
|
|
|
|
end.
|