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

unit PM.Handler.Auth;

(*
  /register  POST  body {username, masterPassword} -> {message,token,userId,salt,csrfToken}
  /login     POST  body {username, masterPassword} -> {message,token,userId,salt,csrfToken}
  /logout    POST  auth + csrf                     -> {message}
  /reauth    POST  auth + csrf + body{masterPassword} -> {message}

  Hashing strategy:
    - Delphi creates new accounts with PBKDF2-SHA256 100k iterations (hash_algo='pbkdf2'),
      same format as PHP hash_pbkdf2. PHP can verify these too.
    - For login, we read hash_algo:
        pbkdf2 -> verify natively
        bcrypt -> reject with clear message (bcrypt verify not implemented yet)
*)

interface

implementation

uses
  System.SysUtils, System.JSON, System.Classes,
  FireDAC.Comp.Client,
  IdCustomHTTPServer,
  PM.Router, PM.JSON, PM.Database, PM.Crypto,
  PM.Session, PM.RateLimit, PM.Audit;

const
  PBKDF2_ITERATIONS = 100000;
  DEFAULT_FOLDERS: array[0..4] of string = ('All', 'Social', 'Banking', 'Work', 'Personal');

procedure EnsureDefaultFolders(AUserId: Integer);
var
  LQ: TFDQuery;
  I: Integer;
begin
  DB.Lock;
  try
    LQ := TFDQuery.Create(nil);
    try
      LQ.Connection := DB.Connection;
      LQ.SQL.Text :=
        'INSERT OR IGNORE INTO folders (user_id, name) VALUES (:uid, :name)';
      for I := Low(DEFAULT_FOLDERS) to High(DEFAULT_FOLDERS) do
      begin
        LQ.ParamByName('uid').AsInteger := AUserId;
        LQ.ParamByName('name').AsString := DEFAULT_FOLDERS[I];
        LQ.ExecSQL;
      end;
    finally
      LQ.Free;
    end;
  finally
    DB.Unlock;
  end;
end;

procedure SendAuthSuccess(AResponse: TIdHTTPResponseInfo;
  AUserId: Integer; const AToken, ASalt, ACSRFToken: string);
var
  LObj: TJSONObject;
begin
  LObj := TJSONObject.Create;
  LObj.AddPair('message',   'OK');
  LObj.AddPair('token',     AToken);
  LObj.AddPair('userId',    TJSONNumber.Create(AUserId));
  LObj.AddPair('salt',      ASalt);
  LObj.AddPair('csrfToken', ACSRFToken);
  TJSONHelper.SendJSON(AResponse, LObj);
end;

// ===== /register =============================================================

procedure HandleRegister(ARequest: TIdHTTPRequestInfo;
  AResponse: TIdHTTPResponseInfo; const AParams: TArray<string>);
var
  LBody: TJSONObject;
  LUser, LPwd, LSalt, LHash, LToken, LCSRF, LIP: string;
  LQ: TFDQuery;
  LUserId: Integer;
begin
  LIP := GetClientIP(ARequest);
  if CheckRateLimit(LIP) >= 5 then
  begin
    TJSONHelper.SendError(AResponse, 429, 'Too many attempts. Try again later.');
    Exit;
  end;

  LBody := TJSONHelper.ReadBody(ARequest);
  try
    LUser := Trim(LBody.GetValue<string>('username', ''));
    LPwd  := LBody.GetValue<string>('masterPassword', '');
  finally
    LBody.Free;
  end;

  if (Length(LUser) < 3) or (Length(LPwd) < 8) then
  begin
    TJSONHelper.SendError(AResponse, 400, 'Min 3/8 chars');
    Exit;
  end;

  DB.Lock;
  try
    LQ := TFDQuery.Create(nil);
    try
      LQ.Connection := DB.Connection;
      LQ.SQL.Text := 'SELECT id FROM users WHERE username = :u';
      LQ.ParamByName('u').AsString := LUser;
      LQ.Open;
      if not LQ.IsEmpty then
      begin
        TJSONHelper.SendError(AResponse, 409, 'Username exists');
        Exit;
      end;
    finally
      LQ.Free;
    end;

    LSalt := RandomHex(32);
    LHash := PBKDF2_SHA256_Hex(LPwd, LSalt, PBKDF2_ITERATIONS);

    LQ := TFDQuery.Create(nil);
    try
      LQ.Connection := DB.Connection;
      LQ.SQL.Text :=
        'INSERT INTO users (username, password_hash, salt, hash_algo) ' +
        'VALUES (:u, :h, :s, ''pbkdf2'')';
      LQ.ParamByName('u').AsString := LUser;
      LQ.ParamByName('h').AsString := LHash;
      LQ.ParamByName('s').AsString := LSalt;
      LQ.ExecSQL;
      LUserId := DB.Connection.GetLastAutoGenValue('users');
    finally
      LQ.Free;
    end;
  finally
    DB.Unlock;
  end;

  EnsureDefaultFolders(LUserId);
  CreateSession(LUserId, LToken, LCSRF);
  LogAudit(LUserId, 'register', LIP);
  SendAuthSuccess(AResponse, LUserId, LToken, LSalt, LCSRF);
end;

// ===== /login ================================================================

procedure HandleLogin(ARequest: TIdHTTPRequestInfo;
  AResponse: TIdHTTPResponseInfo; const AParams: TArray<string>);
var
  LBody: TJSONObject;
  LUser, LPwd, LSalt, LStoredHash, LAlgo, LToken, LCSRF, LIP: string;
  LUserId: Integer;
  LQ: TFDQuery;
  LComputed: string;
  LValid: Boolean;
begin
  LIP := GetClientIP(ARequest);
  if CheckRateLimit(LIP) >= 10 then
  begin
    TJSONHelper.SendError(AResponse, 429, 'Too many attempts. Try again later.');
    Exit;
  end;

  LBody := TJSONHelper.ReadBody(ARequest);
  try
    LUser := Trim(LBody.GetValue<string>('username', ''));
    LPwd  := LBody.GetValue<string>('masterPassword', '');
  finally
    LBody.Free;
  end;

  DB.Lock;
  try
    LQ := TFDQuery.Create(nil);
    try
      LQ.Connection := DB.Connection;
      LQ.SQL.Text :=
        'SELECT id, password_hash, salt, hash_algo FROM users WHERE username = :u';
      LQ.ParamByName('u').AsString := LUser;
      LQ.Open;
      if LQ.IsEmpty then
      begin
        RecordAttempt(LIP);
        TJSONHelper.SendError(AResponse, 401, 'Invalid credentials');
        Exit;
      end;
      LUserId     := LQ.FieldByName('id').AsInteger;
      LStoredHash := LQ.FieldByName('password_hash').AsString;
      LSalt       := LQ.FieldByName('salt').AsString;
      LAlgo       := LQ.FieldByName('hash_algo').AsString;
      if LAlgo = '' then LAlgo := 'pbkdf2';
    finally
      LQ.Free;
    end;
  finally
    DB.Unlock;
  end;

  LValid := False;
  if SameText(LAlgo, 'pbkdf2') then
  begin
    LComputed := PBKDF2_SHA256_Hex(LPwd, LSalt, PBKDF2_ITERATIONS);
    LValid := ConstantTimeEquals(LComputed, LStoredHash);
  end
  else if SameText(LAlgo, 'bcrypt') then
  begin
    // Not implemented in Delphi backend yet
    RecordAttempt(LIP);
    LogAudit(LUserId, 'failed_login_bcrypt', LIP);
    TJSONHelper.SendError(AResponse, 501,
      'This account was created with bcrypt (PHP). The Delphi backend does ' +
      'not verify bcrypt yet. Register a new account here, or login via PHP.');
    Exit;
  end;

  if not LValid then
  begin
    RecordAttempt(LIP);
    LogAudit(LUserId, 'failed_login', LIP);
    TJSONHelper.SendError(AResponse, 401, 'Invalid credentials');
    Exit;
  end;

  ClearAttempts(LIP);
  DeleteAllUserSessions(LUserId);
  EnsureDefaultFolders(LUserId);
  CreateSession(LUserId, LToken, LCSRF);
  LogAudit(LUserId, 'login', LIP);
  SendAuthSuccess(AResponse, LUserId, LToken, LSalt, LCSRF);
end;

// ===== /logout ===============================================================

procedure HandleLogout(ARequest: TIdHTTPRequestInfo;
  AResponse: TIdHTTPResponseInfo; const AParams: TArray<string>);
var
  LUserId: Integer;
  LToken, LAuth: string;
begin
  try
    LUserId := Authenticate(ARequest, AResponse);
    RequireCSRF(ARequest, AResponse, LUserId);
  except
    on ESessionRejected do Exit;
  end;

  LAuth := ARequest.RawHeaders.Values['Authorization'];
  if LAuth.StartsWith('Bearer ', True) then
  begin
    LToken := Copy(LAuth, 8, MaxInt);
    DeleteSessionByTokenHash(SHA256Hex(LToken));
  end;

  LogAudit(LUserId, 'logout', GetClientIP(ARequest));
  TJSONHelper.SendOK(AResponse, 'Logged out');
end;

// ===== /reauth ===============================================================

procedure HandleReauth(ARequest: TIdHTTPRequestInfo;
  AResponse: TIdHTTPResponseInfo; const AParams: TArray<string>);
var
  LUserId: Integer;
  LBody: TJSONObject;
  LPwd, LStoredHash, LSalt, LAlgo, LIP, LComputed: string;
  LQ: TFDQuery;
  LValid: Boolean;
begin
  try
    LUserId := Authenticate(ARequest, AResponse);
    RequireCSRF(ARequest, AResponse, LUserId);
  except
    on ESessionRejected do Exit;
  end;

  LIP := GetClientIP(ARequest);
  if CheckRateLimit(LIP) >= 5 then
  begin
    TJSONHelper.SendError(AResponse, 429, 'Too many attempts. Try again later.');
    Exit;
  end;

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

  DB.Lock;
  try
    LQ := TFDQuery.Create(nil);
    try
      LQ.Connection := DB.Connection;
      LQ.SQL.Text := 'SELECT password_hash, salt, hash_algo FROM users WHERE id = :uid';
      LQ.ParamByName('uid').AsInteger := LUserId;
      LQ.Open;
      if LQ.IsEmpty then
      begin
        RecordAttempt(LIP);
        TJSONHelper.SendError(AResponse, 401, 'User not found');
        Exit;
      end;
      LStoredHash := LQ.FieldByName('password_hash').AsString;
      LSalt       := LQ.FieldByName('salt').AsString;
      LAlgo       := LQ.FieldByName('hash_algo').AsString;
      if LAlgo = '' then LAlgo := 'pbkdf2';
    finally
      LQ.Free;
    end;
  finally
    DB.Unlock;
  end;

  LValid := False;
  if SameText(LAlgo, 'pbkdf2') then
  begin
    LComputed := PBKDF2_SHA256_Hex(LPwd, LSalt, PBKDF2_ITERATIONS);
    LValid := ConstantTimeEquals(LComputed, LStoredHash);
  end;

  if not LValid then
  begin
    RecordAttempt(LIP);
    LogAudit(LUserId, 'failed_reauth', LIP);
    TJSONHelper.SendError(AResponse, 401, 'Invalid password');
    Exit;
  end;

  ClearAttempts(LIP);
  LogAudit(LUserId, 'reauth', LIP);
  TJSONHelper.SendOK(AResponse, 'OK');
end;

initialization
  Router.Register('POST', '/register', HandleRegister);
  Router.Register('POST', '/login',    HandleLogin);
  Router.Register('POST', '/logout',   HandleLogout);
  Router.Register('POST', '/reauth',   HandleReauth);

end.