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

unit PM.Handler.Settings;

(*
  GET  /settings   -> {<arbitrary JSON object stored as-is>}
  PUT  /settings   body: {<arbitrary JSON object>}  -> {message:"OK"}

  Persists a per-user preferences blob (users.settings_json). The server
  treats the body as opaque JSON — schema lives in the JS layer. Any client
  reading it should tolerate unknown keys for forward compatibility.

  Device-specific toggles (quick-unlock DPAPI, autofill hotkey) deliberately
  stay in localStorage on the client and are NOT included in this blob.
*)

interface

implementation

uses
  System.SysUtils, System.JSON, System.Classes,
  Data.DB, FireDAC.Comp.Client, FireDAC.Stan.Param,
  IdCustomHTTPServer,
  PM.Router, PM.JSON, PM.Session, PM.Database;

procedure HandleGetSettings(ARequest: TIdHTTPRequestInfo;
  AResponse: TIdHTTPResponseInfo; const AParams: TArray<string>);
var
  LUserId: Integer;
  LQ: TFDQuery;
  LRaw: string;
  LObj: TJSONValue;
begin
  LUserId := Authenticate(ARequest, AResponse);

  DB.Lock;
  try
    LQ := TFDQuery.Create(nil);
    try
      LQ.Connection := DB.Connection;
      LQ.SQL.Text := 'SELECT settings_json FROM users WHERE id = :uid';
      LQ.ParamByName('uid').AsInteger := LUserId;
      LQ.Open;
      if LQ.IsEmpty then
        LRaw := '{}'
      else
        LRaw := LQ.FieldByName('settings_json').AsString;
    finally
      LQ.Free;
    end;
  finally
    DB.Unlock;
  end;

  if Trim(LRaw) = '' then LRaw := '{}';

  // Validate so a corrupt row doesn't return malformed JSON to the client.
  LObj := TJSONObject.ParseJSONValue(LRaw);
  if LObj = nil then LObj := TJSONObject.Create;
  TJSONHelper.SendJSON(AResponse, LObj);   // SendJSON frees the object
end;

procedure HandlePutSettings(ARequest: TIdHTTPRequestInfo;
  AResponse: TIdHTTPResponseInfo; const AParams: TArray<string>);
var
  LUserId: Integer;
  LBody: TJSONObject;
  LSerialized: string;
  LQ: TFDQuery;
begin
  LUserId := Authenticate(ARequest, AResponse);
  RequireCSRF(ARequest, AResponse, LUserId);

  LBody := TJSONHelper.ReadBody(ARequest);
  try
    // Re-serialize to a canonical compact form (strips comments / extra
    // whitespace, and guarantees what we store is valid JSON).
    LSerialized := LBody.ToJSON;
  finally
    LBody.Free;
  end;

  // Soft cap to protect the row from a runaway client (typical settings
  // blob is a few hundred bytes; 16 KB leaves room for future flags).
  if Length(LSerialized) > 16384 then
  begin
    TJSONHelper.SendError(AResponse, 413, 'Settings payload too large');
    Exit;
  end;

  DB.Lock;
  try
    LQ := TFDQuery.Create(nil);
    try
      LQ.Connection := DB.Connection;
      LQ.SQL.Text := 'UPDATE users SET settings_json = :s WHERE id = :uid';
      LQ.ParamByName('s').AsString    := LSerialized;
      LQ.ParamByName('uid').AsInteger := LUserId;
      LQ.ExecSQL;
    finally
      LQ.Free;
    end;
  finally
    DB.Unlock;
  end;

  TJSONHelper.SendOK(AResponse);
end;

// GET /avatar -> { avatar_b64: <data-uri or ''> }
// Fetched once at login (enterApp) so the image isn't re-sent on every
// settings save.
procedure HandleGetAvatar(ARequest: TIdHTTPRequestInfo;
  AResponse: TIdHTTPResponseInfo; const AParams: TArray<string>);
var
  LUserId: Integer;
  LQ: TFDQuery;
  LObj: TJSONObject;
  LVal: string;
begin
  LUserId := Authenticate(ARequest, AResponse);

  DB.Lock;
  try
    LQ := TFDQuery.Create(nil);
    try
      LQ.Connection := DB.Connection;
      LQ.SQL.Text := 'SELECT avatar_b64 FROM users WHERE id = :uid';
      LQ.ParamByName('uid').AsInteger := LUserId;
      LQ.Open;
      if LQ.IsEmpty then LVal := '' else LVal := LQ.FieldByName('avatar_b64').AsString;
    finally
      LQ.Free;
    end;
  finally
    DB.Unlock;
  end;

  LObj := TJSONObject.Create;
  LObj.AddPair('avatar_b64', LVal);
  TJSONHelper.SendJSON(AResponse, LObj);
end;

// POST /avatar  body: { avatar_b64: <data-uri> }  ('' clears it)
procedure HandleSetAvatar(ARequest: TIdHTTPRequestInfo;
  AResponse: TIdHTTPResponseInfo; const AParams: TArray<string>);
var
  LUserId: Integer;
  LBody: TJSONObject;
  LVal: string;
  LQ: TFDQuery;
begin
  LUserId := Authenticate(ARequest, AResponse);
  RequireCSRF(ARequest, AResponse, LUserId);

  LBody := TJSONHelper.ReadBody(ARequest);
  try
    LVal := LBody.GetValue<string>('avatar_b64', '');
  finally
    LBody.Free;
  end;

  // Cap ~700 KB base64 (~512 KB raw) — the client downscales to a small
  // square before upload, so anything larger is a bug or an attack.
  if Length(LVal) > 720000 then
  begin
    TJSONHelper.SendError(AResponse, 413, 'Avatar too large');
    Exit;
  end;

  DB.Lock;
  try
    LQ := TFDQuery.Create(nil);
    try
      LQ.Connection := DB.Connection;
      LQ.SQL.Text := 'UPDATE users SET avatar_b64 = :a WHERE id = :uid';
      LQ.ParamByName('a').DataType := ftMemo;
      if LVal = '' then LQ.ParamByName('a').Clear
      else              LQ.ParamByName('a').Value := LVal;
      LQ.ParamByName('uid').AsInteger := LUserId;
      LQ.ExecSQL;
    finally
      LQ.Free;
    end;
  finally
    DB.Unlock;
  end;

  TJSONHelper.SendOK(AResponse);
end;

initialization
  Router.Register('GET', '/settings', HandleGetSettings);
  Router.Register('PUT', '/settings', HandlePutSettings);
  Router.Register('GET',  '/avatar', HandleGetAvatar);
  Router.Register('POST', '/avatar', HandleSetAvatar);

end.