Password-Manager/delphi-backend/Handlers/PM.Handler.Folders.pas

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,
  Data.DB,
  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;
      // Pre-declare type so .Clear (NULL) doesn't leave the param
      // untyped — FireDAC SQLite rejects untyped params at Prepare.
      LQ.ParamByName('color').DataType := ftString;
      LQ.ParamByName('icon').DataType  := ftString;
      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
        LQ.ParamByName('color').DataType := ftString;
        if LColor = '' then LQ.ParamByName('color').Clear
        else                LQ.ParamByName('color').AsString := LColor;
      end;
      if LHasIcon then
      begin
        LQ.ParamByName('icon').DataType := ftString;
        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 :=
        // Bump updated_at (UTC) so the folder reassignment propagates on sync
        // (last-write-wins) — otherwise other devices keep the entries in the
        // just-deleted folder because the timestamp didn't move.
        'UPDATE vault_entries SET folder = ''All'', updated_at = datetime(''now'') ' +
        '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.