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,
  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('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);
        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, LUser, LFolder, LEnc, LIV, LTags, 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
    LSite   := Trim(LBody.GetValue<string>('site', ''));
    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', ''));
  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, username, encrypted_password, iv, encryption_method, ' +
        ' folder, tags, created_at, updated_at) ' +
        'VALUES (:uid, :s, :u, :e, :i, ''client'', :f, :t, :c, :c2)';
      LQ.ParamByName('uid').AsInteger := LUserId;
      LQ.ParamByName('s').AsString  := LSite;
      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;
      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('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, LUser, LFolder, LEnc, LIV, LTags, LNow: 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', ''));
    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', ''));
  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, username=:u, encrypted_password=:e, iv=:i, ' +
        '    folder=:f, tags=:t, updated_at=:c ' +
        'WHERE id=:id AND user_id=:uid';
      LQ.ParamByName('s').AsString    := LSite;
      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;
      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;

initialization
  // /entries/trash/empty must be registered BEFORE /entries/{id} to win the regex match
  Router.Register('DELETE', '/entries/trash/empty',  HandleEmptyTrash);
  Router.Register('POST',   '/entries/(\d+)/restore',  HandleRestoreEntry);
  Router.Register('POST',   '/entries/(\d+)/favorite', HandleToggleFavorite);
  Router.Register('GET',    '/entries',               HandleGetEntries);
  Router.Register('POST',   '/entries',               HandleCreateEntry);
  Router.Register('PUT',    '/entries/(\d+)',         HandleUpdateEntry);
  Router.Register('DELETE', '/entries/(\d+)',         HandleDeleteEntry);

end.