unit PM.Handler.Recovery;

(*
  Recovery key endpoints — one-time-use code that wraps the user's AES vault
  key for emergency access when the master password is lost.

  Threat model:
    The server stores only SHA-256(code), never the plaintext. The wrapped_key
    is AES-GCM ciphertext of the user's vault key under a KEK derived from
    PBKDF2(code, kdf_salt, 600k). Without the plaintext code, the server
    cannot unwrap the key on its own. The user is the only party that ever
    has access to the plaintext, and only once (right after generation).

  Single use:
    Redeeming the recovery key deletes the row. The user is expected to set
    a fresh master password and generate a new recovery key immediately
    after, which the client does automatically via change-master-password
    + setup.

    GET    /recovery-key/status            -> { configured: bool, created_at? }
    POST   /recovery-key/setup             body { masterPassword, codeHash,
                                                  kdfSalt, wrappedKey, wrappedIv } -> { message }
    DELETE /recovery-key                   -> { message }
    POST   /recovery-key/redeem            body { username, code } -> session +
                                                  { wrappedKey, wrappedIv, kdfSalt, salt,
                                                    kdfIterations, token, csrfToken, userId }
                                              (NO session auth — this IS the auth)
*)

interface

implementation

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

// Verifies the user's master password against their current stored hash.
// Accepts EITHER plaintext (legacy clients) OR a precomputed verifier
// (ZK clients). Used by /recovery-key/setup so a stolen session token
// alone can't set up a recovery backdoor.
function VerifyMasterPassword(AUserId: Integer;
  const APwd, AVerifier: string;
  out AUsername: string): Boolean;
const
  HASH_ALGO_LEGACY  = 'pbkdf2';
  HASH_ALGO_CURRENT = 'pbkdf2-sha256';
  PBKDF2_ITERATIONS = 100000;
var
  LQ: TFDQuery;
  LStoredHash, LSalt, LAlgo, LComputed: string;
  LIters: Integer;
begin
  Result := False;
  AUsername := '';
  DB.Lock;
  try
    LQ := TFDQuery.Create(nil);
    try
      LQ.Connection := DB.Connection;
      LQ.SQL.Text :=
        'SELECT username, password_hash, salt, hash_algo, kdf_iterations ' +
        'FROM users WHERE id = :uid';
      LQ.ParamByName('uid').AsInteger := AUserId;
      LQ.Open;
      if LQ.IsEmpty then Exit;
      AUsername   := LQ.FieldByName('username').AsString;
      LStoredHash := LQ.FieldByName('password_hash').AsString;
      LSalt       := LQ.FieldByName('salt').AsString;
      LAlgo       := LQ.FieldByName('hash_algo').AsString;
      LIters      := LQ.FieldByName('kdf_iterations').AsInteger;
      if LAlgo = '' then LAlgo := HASH_ALGO_LEGACY;
      if LIters <= 0 then LIters := PBKDF2_ITERATIONS;
    finally
      LQ.Free;
    end;
  finally
    DB.Unlock;
  end;

  if AVerifier <> '' then
  begin
    // ZK: client computed PBKDF2 hex locally. Server only does the wrap.
    if Length(AVerifier) <> 64 then Exit;
    if SameText(LAlgo, HASH_ALGO_LEGACY) then
      Result := ConstantTimeEquals(AVerifier, LStoredHash)
    else if SameText(LAlgo, HASH_ALGO_CURRENT) then
      Result := ConstantTimeEquals(SHA256Hex(AVerifier), LStoredHash);
    Exit;
  end;

  // Plaintext fallback (legacy client).
  if SameText(LAlgo, HASH_ALGO_LEGACY) then
  begin
    LComputed := PBKDF2_SHA256_Hex(APwd, LSalt, LIters);
    Result := ConstantTimeEquals(LComputed, LStoredHash);
  end
  else if SameText(LAlgo, HASH_ALGO_CURRENT) then
  begin
    LComputed := SHA256Hex(PBKDF2_SHA256_Hex(APwd, LSalt, LIters));
    Result := ConstantTimeEquals(LComputed, LStoredHash);
  end;
end;

// ===== GET /recovery-key/status ==============================================
procedure HandleStatus(ARequest: TIdHTTPRequestInfo;
  AResponse: TIdHTTPResponseInfo; const AParams: TArray<string>);
var
  LUserId: Integer;
  LQ: TFDQuery;
  LObj: TJSONObject;
  LConfigured: Boolean;
  LCreatedAt: string;
begin
  try
    LUserId := Authenticate(ARequest, AResponse);
  except
    on ESessionRejected do Exit;
  end;

  LConfigured := False;
  LCreatedAt  := '';
  var RemainingUses: Integer := 0;
  DB.Lock;
  try
    LQ := TFDQuery.Create(nil);
    try
      LQ.Connection := DB.Connection;
      LQ.SQL.Text :=
        'SELECT created_at, remaining_uses FROM recovery_keys WHERE user_id = :uid';
      LQ.ParamByName('uid').AsInteger := LUserId;
      LQ.Open;
      if not LQ.IsEmpty then
      begin
        LConfigured := True;
        LCreatedAt := LQ.FieldByName('created_at').AsString;
        RemainingUses := LQ.FieldByName('remaining_uses').AsInteger;
      end;
    finally
      LQ.Free;
    end;
  finally
    DB.Unlock;
  end;

  LObj := TJSONObject.Create;
  LObj.AddPair('configured', TJSONBool.Create(LConfigured));
  if LConfigured then LObj.AddPair('created_at', LCreatedAt);
  if LConfigured then LObj.AddPair('remaining_uses', TJSONNumber.Create(RemainingUses));
  TJSONHelper.SendJSON(AResponse, LObj);
end;

// ===== POST /recovery-key/setup ==============================================
procedure HandleSetup(ARequest: TIdHTTPRequestInfo;
  AResponse: TIdHTTPResponseInfo; const AParams: TArray<string>);
var
  LUserId: Integer;
  LBody: TJSONObject;
  LPwd, LVerifier, LCodeHash, LKdfSalt, LWrappedKey, LWrappedIv, LIP, LUser: string;
  LQ: TFDQuery;
begin
  try
    LUserId := Authenticate(ARequest, AResponse);
    RequireCSRF(ARequest, AResponse, LUserId);
  except
    on ESessionRejected do Exit;
  end;

  LIP := GetClientIP(ARequest);
  LBody := TJSONHelper.ReadBody(ARequest);
  try
    LPwd        := LBody.GetValue<string>('masterPassword', '');
    LVerifier   := LBody.GetValue<string>('verifier', '');
    LCodeHash   := LBody.GetValue<string>('codeHash', '');
    LKdfSalt    := LBody.GetValue<string>('kdfSalt', '');
    LWrappedKey := LBody.GetValue<string>('wrappedKey', '');
    LWrappedIv  := LBody.GetValue<string>('wrappedIv', '');
  finally
    LBody.Free;
  end;

  // Length sanity: SHA-256 hex = 64; kdf salt hex = 64; wrapped pieces are
  // base64 — minimal length check to weed out obvious garbage.
  if (Length(LCodeHash) <> 64) or (Length(LKdfSalt) <> 64) or
     (LWrappedKey = '') or (LWrappedIv = '') then
  begin
    TJSONHelper.SendError(AResponse, 400, 'Invalid recovery payload');
    Exit;
  end;

  if not VerifyMasterPassword(LUserId, LPwd, LVerifier, LUser) then
  begin
    RecordFailedAccountAttempt(LUser, LIP);
    LogAudit(LUserId, 'failed_recovery_setup', LIP);
    TJSONHelper.SendError(AResponse, 401, 'Invalid master password');
    Exit;
  end;

  DB.Lock;
  try
    LQ := TFDQuery.Create(nil);
    try
      LQ.Connection := DB.Connection;
      // INSERT-or-replace via DELETE+INSERT (portable, avoids the UPSERT
      // syntax we saw FireDAC choke on for the lockout table earlier).
      LQ.SQL.Text := 'DELETE FROM recovery_keys WHERE user_id = :uid';
      LQ.ParamByName('uid').AsInteger := LUserId;
      LQ.ExecSQL;

      LQ.SQL.Text :=
        'INSERT INTO recovery_keys ' +
        '  (user_id, code_hash, kdf_salt, wrapped_key, wrapped_iv, remaining_uses) ' +
        'VALUES (:uid, :ch, :ks, :wk, :wi, 5)';
      LQ.ParamByName('uid').AsInteger := LUserId;
      LQ.ParamByName('ch').AsString   := LCodeHash;
      LQ.ParamByName('ks').AsString   := LKdfSalt;
      LQ.ParamByName('wk').AsString   := LWrappedKey;
      LQ.ParamByName('wi').AsString   := LWrappedIv;
      LQ.ExecSQL;
    finally
      LQ.Free;
    end;
  finally
    DB.Unlock;
  end;

  LogAudit(LUserId, 'recovery_setup', LIP);
  TJSONHelper.SendOK(AResponse, 'Recovery key configured');
end;

// ===== DELETE /recovery-key ==================================================
procedure HandleDelete(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 recovery_keys WHERE user_id = :uid';
      LQ.ParamByName('uid').AsInteger := LUserId;
      LQ.ExecSQL;
    finally
      LQ.Free;
    end;
  finally
    DB.Unlock;
  end;

  LogAudit(LUserId, 'recovery_delete', GetClientIP(ARequest));
  TJSONHelper.SendOK(AResponse, 'Recovery key removed');
end;

// ===== POST /recovery-key/redeem =============================================
// No session auth required — this is the entry point when the user CAN'T log
// in. Per-IP rate limit + per-account lockout still apply: an attacker can't
// brute-force the (high-entropy) recovery code by trying every possible
// value without hitting the lockout.
procedure HandleRedeem(ARequest: TIdHTTPRequestInfo;
  AResponse: TIdHTTPResponseInfo; const AParams: TArray<string>);
var
  LBody, LObj: TJSONObject;
  LUser, LCode, LCodeHash, LIP, LStoredHash, LKdfSalt, LWrappedKey, LWrappedIv,
    LSalt, LToken, LCSRF, LAlgo: string;
  LUserId, LKdfIters, LCurrentUses, LNewUses: Integer;
  LQ: TFDQuery;
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', ''));
    LCode := Trim(LBody.GetValue<string>('code', ''));
  finally
    LBody.Free;
  end;

  if (LUser = '') or (LCode = '') then
  begin
    TJSONHelper.SendError(AResponse, 400, 'Username and code required');
    Exit;
  end;

  if RejectIfAccountLocked(AResponse, LUser) then Exit;

  LCodeHash := SHA256Hex(LCode);

  DB.Lock;
  try
    LQ := TFDQuery.Create(nil);
    try
      LQ.Connection := DB.Connection;
      // Join to users to look up by username + verify the code in one shot.
      LQ.SQL.Text :=
        'SELECT u.id, u.salt, u.kdf_iterations, u.hash_algo, ' +
        '       rk.code_hash, rk.kdf_salt, rk.wrapped_key, rk.wrapped_iv, rk.remaining_uses ' +
        'FROM users u ' +
        'LEFT JOIN recovery_keys rk ON rk.user_id = u.id ' +
        'WHERE u.username = :u';
      LQ.ParamByName('u').AsString := LUser;
      LQ.Open;
      if LQ.IsEmpty then
      begin
        RecordAttempt(LIP);
        RecordFailedAccountAttempt(LUser, LIP);
        TJSONHelper.SendError(AResponse, 401, 'Invalid username or recovery code');
        Exit;
      end;
      LUserId      := LQ.FieldByName('id').AsInteger;
      LSalt        := LQ.FieldByName('salt').AsString;
      LKdfIters    := LQ.FieldByName('kdf_iterations').AsInteger;
      LAlgo        := LQ.FieldByName('hash_algo').AsString;
      LStoredHash  := LQ.FieldByName('code_hash').AsString;
      LKdfSalt     := LQ.FieldByName('kdf_salt').AsString;
      LWrappedKey  := LQ.FieldByName('wrapped_key').AsString;
      LWrappedIv   := LQ.FieldByName('wrapped_iv').AsString;
      LCurrentUses := LQ.FieldByName('remaining_uses').AsInteger;
    finally
      LQ.Free;
    end;

    if (LStoredHash = '') or (LKdfSalt = '') or (LWrappedKey = '') then
    begin
      // User exists but no recovery row.
      DB.Unlock;
      try
        RecordAttempt(LIP);
        RecordFailedAccountAttempt(LUser, LIP);
      finally
        DB.Lock;
      end;
      TJSONHelper.SendError(AResponse, 401, 'Invalid username or recovery code');
      Exit;
    end;

    if not ConstantTimeEquals(LCodeHash, LStoredHash) then
    begin
      DB.Unlock;
      try
        RecordAttempt(LIP);
        RecordFailedAccountAttempt(LUser, LIP);
      finally
        DB.Lock;
      end;
      LogAudit(LUserId, 'failed_recovery_redeem', LIP);
      TJSONHelper.SendError(AResponse, 401, 'Invalid username or recovery code');
      Exit;
    end;

    // Code matches. Decrement remaining_uses ; if it drops to 0, delete
    // the row (last use). The row is also deleted when the user
    // successfully changes their master password (in PM.Handler.Auth).
    LNewUses := LCurrentUses - 1;
    LQ := TFDQuery.Create(nil);
    try
      LQ.Connection := DB.Connection;
      if LNewUses <= 0 then
      begin
        LQ.SQL.Text := 'DELETE FROM recovery_keys WHERE user_id = :uid';
        LQ.ParamByName('uid').AsInteger := LUserId;
      end
      else
      begin
        LQ.SQL.Text := 'UPDATE recovery_keys SET remaining_uses = :u WHERE user_id = :uid';
        LQ.ParamByName('u').AsInteger   := LNewUses;
        LQ.ParamByName('uid').AsInteger := LUserId;
      end;
      LQ.ExecSQL;
    finally
      LQ.Free;
    end;
  finally
    DB.Unlock;
  end;

  ClearAttempts(LIP);
  ClearAccountLockout(LUser);
  CreateSession(LUserId, LToken, LCSRF);
  LogAudit(LUserId, 'recovery_redeem', LIP);

  LObj := TJSONObject.Create;
  LObj.AddPair('message',       'OK');
  LObj.AddPair('userId',        TJSONNumber.Create(LUserId));
  LObj.AddPair('token',         LToken);
  LObj.AddPair('csrfToken',     LCSRF);
  LObj.AddPair('salt',          LSalt);
  LObj.AddPair('kdfIterations', TJSONNumber.Create(LKdfIters));
  LObj.AddPair('hashAlgo',      LAlgo);
  LObj.AddPair('wrappedKey',    LWrappedKey);
  LObj.AddPair('wrappedIv',     LWrappedIv);
  LObj.AddPair('kdfSalt',       LKdfSalt);
  LObj.AddPair('remainingUses', TJSONNumber.Create(LNewUses));
  TJSONHelper.SendJSON(AResponse, LObj);
end;

initialization
  Router.Register('GET',    '/recovery-key/status', HandleStatus);
  Router.Register('POST',   '/recovery-key/setup',  HandleSetup);
  Router.Register('DELETE', '/recovery-key',        HandleDelete);
  Router.Register('POST',   '/recovery-key/redeem', HandleRedeem);

end.