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

unit PM.Handler.Attachments;

(*
  Encrypted file attachments per entry.

  GET    /entries/{id}/attachments         -> [{id, filename, mime, size_bytes, created_at}, ...]
  POST   /entries/{id}/attachments         body {filename, mime, encrypted_blob, iv, size_bytes}
                                            -> {id, filename, mime, size_bytes, created_at}
  GET    /attachments/{id}                  -> {id, filename, mime, size_bytes, encrypted_blob, iv}
  DELETE /attachments/{id}                  -> {message}

  encrypted_blob is the base64-encoded AES-GCM ciphertext of the raw file
  bytes, produced by the JS client with the per-user vault key. Server
  never sees plaintext.

  Per-attachment cap: ~10 MB of ciphertext-as-base64 (≈ 7.5 MB raw file).
  Heavier attachments aren't appropriate for SQLite TEXT storage anyway.
*)

interface

implementation

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

const
  MAX_ATTACHMENT_B64 = 10 * 1024 * 1024;   // 10 MB of base64 text

function GetClientIP(ARequest: TIdHTTPRequestInfo): string;
begin
  Result := ARequest.RemoteIP;
  if Result = '' then Result := '127.0.0.1';
end;

// Ownership check: returns True iff the entry exists and belongs to LUserId.
function EntryBelongsToUser(LEntryId, LUserId: Integer): Boolean;
var
  LQ: TFDQuery;
begin
  LQ := TFDQuery.Create(nil);
  try
    LQ.Connection := DB.Connection;
    LQ.SQL.Text :=
      'SELECT 1 FROM vault_entries WHERE id = :id AND user_id = :uid';
    LQ.ParamByName('id').AsInteger  := LEntryId;
    LQ.ParamByName('uid').AsInteger := LUserId;
    LQ.Open;
    Result := not LQ.Eof;
  finally
    LQ.Free;
  end;
end;

// ===== GET /entries/{id}/attachments =========================================

procedure HandleListAttachments(ARequest: TIdHTTPRequestInfo;
  AResponse: TIdHTTPResponseInfo; const AParams: TArray<string>);
var
  LUserId, LEntryId: Integer;
  LQ: TFDQuery;
  LArr: TJSONArray;
  LObj: TJSONObject;
begin
  try
    LUserId := Authenticate(ARequest, AResponse);
  except
    on ESessionRejected do Exit;
  end;

  LEntryId := StrToIntDef(AParams[0], 0);
  if LEntryId = 0 then
  begin
    TJSONHelper.SendError(AResponse, 400, 'Invalid entry id');
    Exit;
  end;

  LArr := TJSONArray.Create;
  DB.Lock;
  try
    if not EntryBelongsToUser(LEntryId, LUserId) then
    begin
      TJSONHelper.SendError(AResponse, 404, 'Entry not found');
      LArr.Free;
      Exit;
    end;
    LQ := TFDQuery.Create(nil);
    try
      LQ.Connection := DB.Connection;
      LQ.SQL.Text :=
        'SELECT id, filename, mime, size_bytes, created_at ' +
        'FROM entry_attachments WHERE entry_id = :eid AND user_id = :uid ' +
        'ORDER BY created_at DESC';
      LQ.ParamByName('eid').AsInteger := LEntryId;
      LQ.ParamByName('uid').AsInteger := LUserId;
      LQ.Open;
      while not LQ.Eof do
      begin
        LObj := TJSONObject.Create;
        LObj.AddPair('id',         TJSONNumber.Create(LQ.FieldByName('id').AsInteger));
        LObj.AddPair('filename',   LQ.FieldByName('filename').AsString);
        LObj.AddPair('mime',       LQ.FieldByName('mime').AsString);
        LObj.AddPair('size_bytes', TJSONNumber.Create(LQ.FieldByName('size_bytes').AsInteger));
        LObj.AddPair('created_at',
          FormatDateTime('yyyy-mm-dd"T"hh:nn:ss', LQ.FieldByName('created_at').AsDateTime));
        LArr.Add(LObj);
        LQ.Next;
      end;
    finally
      LQ.Free;
    end;
  finally
    DB.Unlock;
  end;
  TJSONHelper.SendJSON(AResponse, LArr);
end;

// ===== POST /entries/{id}/attachments ========================================

procedure HandleCreateAttachment(ARequest: TIdHTTPRequestInfo;
  AResponse: TIdHTTPResponseInfo; const AParams: TArray<string>);
var
  LUserId, LEntryId, LNewId: Integer;
  LBody: TJSONObject;
  LFilename, LMime, LBlob, LIv: string;
  LSize: Integer;
  LQ: TFDQuery;
  LObj: TJSONObject;
begin
  try
    LUserId := Authenticate(ARequest, AResponse);
    RequireCSRF(ARequest, AResponse, LUserId);
  except
    on ESessionRejected do Exit;
  end;

  LEntryId := StrToIntDef(AParams[0], 0);
  if LEntryId = 0 then
  begin
    TJSONHelper.SendError(AResponse, 400, 'Invalid entry id');
    Exit;
  end;

  LBody := TJSONHelper.ReadBody(ARequest);
  try
    LFilename := Trim(LBody.GetValue<string>('filename',       ''));
    LMime     :=      LBody.GetValue<string>('mime',           '');
    LBlob     :=      LBody.GetValue<string>('encrypted_blob', '');
    LIv       :=      LBody.GetValue<string>('iv',             '');
    LSize     :=      LBody.GetValue<Integer>('size_bytes',    0);
  finally
    LBody.Free;
  end;

  if (LFilename = '') or (LBlob = '') or (LIv = '') then
  begin
    TJSONHelper.SendError(AResponse, 400, 'Missing required fields');
    Exit;
  end;
  if Length(LBlob) > MAX_ATTACHMENT_B64 then
  begin
    TJSONHelper.SendError(AResponse, 413, 'Attachment too large (max ~7.5 MB raw)');
    Exit;
  end;

  DB.Lock;
  try
    if not EntryBelongsToUser(LEntryId, LUserId) then
    begin
      TJSONHelper.SendError(AResponse, 404, 'Entry not found');
      Exit;
    end;
    LQ := TFDQuery.Create(nil);
    try
      LQ.Connection := DB.Connection;
      LQ.SQL.Text :=
        'INSERT INTO entry_attachments ' +
        '(user_id, entry_id, filename, mime, size_bytes, encrypted_blob, iv) ' +
        'VALUES (:uid, :eid, :name, :mime, :sz, :blob, :iv)';
      LQ.ParamByName('uid').AsInteger    := LUserId;
      LQ.ParamByName('eid').AsInteger    := LEntryId;
      // Force ftWideString / ftMemo so unicode filenames (Arabic,
      // Chinese, emoji…) survive the round-trip. The default ftString
      // inferred from .AsString maps to ANSI on SQLite and replaces
      // anything outside the local codepage with '?'.
      LQ.ParamByName('name').DataType    := ftWideString;
      LQ.ParamByName('name').AsWideString := LFilename;
      LQ.ParamByName('mime').DataType    := ftWideString;
      LQ.ParamByName('mime').AsWideString := LMime;
      LQ.ParamByName('sz').AsInteger     := LSize;
      LQ.ParamByName('blob').DataType    := ftMemo;
      LQ.ParamByName('blob').Value       := LBlob;
      LQ.ParamByName('iv').AsString      := LIv;
      LQ.ExecSQL;
      LNewId := DB.Connection.GetLastAutoGenValue('entry_attachments');
    finally
      LQ.Free;
    end;
  finally
    DB.Unlock;
  end;

  LogAudit(LUserId, 'add_attachment', GetClientIP(ARequest));
  LObj := TJSONObject.Create;
  LObj.AddPair('id',         TJSONNumber.Create(LNewId));
  LObj.AddPair('filename',   LFilename);
  LObj.AddPair('mime',       LMime);
  LObj.AddPair('size_bytes', TJSONNumber.Create(LSize));
  LObj.AddPair('created_at', FormatDateTime('yyyy-mm-dd"T"hh:nn:ss', Now));
  TJSONHelper.SendJSON(AResponse, LObj);
end;

// ===== GET /attachments/{id} =================================================

procedure HandleGetAttachment(ARequest: TIdHTTPRequestInfo;
  AResponse: TIdHTTPResponseInfo; const AParams: TArray<string>);
var
  LUserId, LId: Integer;
  LQ: TFDQuery;
  LObj: TJSONObject;
begin
  try
    LUserId := Authenticate(ARequest, AResponse);
  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 :=
        'SELECT id, filename, mime, size_bytes, encrypted_blob, iv ' +
        'FROM entry_attachments WHERE id = :id AND user_id = :uid';
      LQ.ParamByName('id').AsInteger  := LId;
      LQ.ParamByName('uid').AsInteger := LUserId;
      LQ.Open;
      if LQ.Eof then
      begin
        TJSONHelper.SendError(AResponse, 404, 'Not found');
        Exit;
      end;
      LObj := TJSONObject.Create;
      LObj.AddPair('id',             TJSONNumber.Create(LQ.FieldByName('id').AsInteger));
      LObj.AddPair('filename',       LQ.FieldByName('filename').AsString);
      LObj.AddPair('mime',           LQ.FieldByName('mime').AsString);
      LObj.AddPair('size_bytes',     TJSONNumber.Create(LQ.FieldByName('size_bytes').AsInteger));
      LObj.AddPair('encrypted_blob', LQ.FieldByName('encrypted_blob').AsString);
      LObj.AddPair('iv',             LQ.FieldByName('iv').AsString);
      TJSONHelper.SendJSON(AResponse, LObj);
    finally
      LQ.Free;
    end;
  finally
    DB.Unlock;
  end;
end;

// ===== GET /attachments/all ==================================================
// Lightweight listing of every attachment id+iv for the current user.
// Used by the master-pw rotation flow to enumerate what needs re-encryption.
// No blob shipped — fetched per-id only when the client is ready to re-encrypt.

procedure HandleListAllAttachments(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 id, entry_id FROM entry_attachments ' +
        'WHERE user_id = :uid';
      LQ.ParamByName('uid').AsInteger := LUserId;
      LQ.Open;
      while not LQ.Eof do
      begin
        LObj := TJSONObject.Create;
        LObj.AddPair('id',       TJSONNumber.Create(LQ.FieldByName('id').AsInteger));
        LObj.AddPair('entry_id', TJSONNumber.Create(LQ.FieldByName('entry_id').AsInteger));
        LArr.Add(LObj);
        LQ.Next;
      end;
    finally
      LQ.Free;
    end;
  finally
    DB.Unlock;
  end;
  TJSONHelper.SendJSON(AResponse, LArr);
end;

// ===== PUT /attachments/{id} =================================================
// Update only the ciphertext + iv. Used by master-pw rotation to swap to
// the new vault key. Filename/mime/size stay untouched.

procedure HandleUpdateAttachmentBlob(ARequest: TIdHTTPRequestInfo;
  AResponse: TIdHTTPResponseInfo; const AParams: TArray<string>);
var
  LUserId, LId: Integer;
  LBody: TJSONObject;
  LBlob, LIv: 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
    LBlob := LBody.GetValue<string>('encrypted_blob', '');
    LIv   := LBody.GetValue<string>('iv',             '');
  finally
    LBody.Free;
  end;

  if (LBlob = '') or (LIv = '') then
  begin
    TJSONHelper.SendError(AResponse, 400, 'Missing encrypted_blob / iv');
    Exit;
  end;
  if Length(LBlob) > MAX_ATTACHMENT_B64 then
  begin
    TJSONHelper.SendError(AResponse, 413, 'Attachment too large');
    Exit;
  end;

  DB.Lock;
  try
    LQ := TFDQuery.Create(nil);
    try
      LQ.Connection := DB.Connection;
      LQ.SQL.Text :=
        'UPDATE entry_attachments SET encrypted_blob = :blob, iv = :iv ' +
        'WHERE id = :id AND user_id = :uid';
      LQ.ParamByName('id').AsInteger  := LId;
      LQ.ParamByName('uid').AsInteger := LUserId;
      LQ.ParamByName('blob').AsString := LBlob;
      LQ.ParamByName('iv').AsString   := LIv;
      LQ.ExecSQL;
      if LQ.RowsAffected = 0 then
      begin
        TJSONHelper.SendError(AResponse, 404, 'Not found');
        Exit;
      end;
    finally
      LQ.Free;
    end;
  finally
    DB.Unlock;
  end;
  TJSONHelper.SendOK(AResponse, 'Updated');
end;

// ===== DELETE /attachments/{id} ==============================================

procedure HandleDeleteAttachment(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 :=
        'DELETE FROM entry_attachments WHERE id = :id AND user_id = :uid';
      LQ.ParamByName('id').AsInteger  := LId;
      LQ.ParamByName('uid').AsInteger := LUserId;
      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, 'delete_attachment', GetClientIP(ARequest));
  TJSONHelper.SendOK(AResponse, 'Deleted');
end;

initialization
  Router.Register('GET',    '/entries/(\d+)/attachments', HandleListAttachments);
  Router.Register('POST',   '/entries/(\d+)/attachments', HandleCreateAttachment);
  Router.Register('GET',    '/attachments/all',            HandleListAllAttachments);
  Router.Register('GET',    '/attachments/(\d+)',          HandleGetAttachment);
  Router.Register('PUT',    '/attachments/(\d+)',          HandleUpdateAttachmentBlob);
  Router.Register('DELETE', '/attachments/(\d+)',          HandleDeleteAttachment);

end.