unit PMA.Biometric;
{
  Fine couche au-dessus de FMX.BiometricAuth.

  On passe par le service FMX plutot que par BiometricPrompt en JNI direct :
  le rappel de BiometricPrompt exige une classe Java implementant une
  interface, donc un .jar a compiler et embarquer. FMX fournit deja ce pont.

  MODELE RETENU : la cle du Keystore est creee avec une validite APRES
  authentification (quelques dizaines de secondes). L'utilisateur s'authentifie,
  puis la cle devient utilisable pendant ce delai. C'est plus simple qu'un
  CryptoObject lie a chaque operation, et suffisant ici : la fenetre est courte
  et l'application est au premier plan pendant ce temps.

  L'APPEL DOIT SE FAIRE SUR LE THREAD PRINCIPAL - il affiche un dialogue
  systeme. Le travail lourd (dechiffrement) part ensuite dans un thread.
}

interface

uses
  System.SysUtils;

type
  /// boUnavailable : l'appareil ne PEUT PAS authentifier - aucune empreinte,
  ///   aucun code. La cle sous authentification est alors definitivement
  ///   inutilisable, et le cache qu'elle protege aussi.
  /// boFailed : la tentative a echoue pour une autre raison, y compris une
  ///   exception de la couche Java. Ne dit RIEN sur l'appareil, donc ne
  ///   justifie jamais de detruire quoi que ce soit.
  TBioOutcome = (boOK, boUnavailable, boFailed, boCancelled);

/// L'appareil peut-il authentifier (empreinte, visage, ou code de
/// verrouillage) ? False signifie qu'aucune protection n'est configuree.
function BiometricAvailable: Boolean;

/// Pourquoi la derniere tentative a echoue. Vide apres un succes.
///
/// Existe parce qu'un echec avale sinon sa propre cause : un TBioOutcome ne
/// distingue pas « l'appareil n'a aucune protection » de « la couche Java a
/// leve quelque chose », et l'appelant prend des decisions opposees dans les
/// deux cas - dont celle d'effacer le cache.
function LastBiometricError: string;

/// Demande l'authentification puis appelle AThen. Non bloquant : le resultat
/// arrive par le rappel, sur le thread principal.
/// Si l'appareil ne sait pas authentifier, AThen est appele avec boUnavailable
/// SANS refuser l'acces - a l'appelant de decider. Un telephone sans
/// verrouillage ne peut de toute facon pas proteger la cle.
procedure AuthenticateThen(const APrompt: string; const AThen: TProc<TBioOutcome>);

implementation

// La clause uses de l'implementation doit venir AVANT toute declaration :
// placee apres, Delphi ne s'en plaint qu'a la derniere ligne du fichier.
{$IF DEFINED(ANDROID)}
uses
  FMX.BiometricAuth, FMX.Platform;
{$ENDIF}

var
  FLastError: string = '';

function LastBiometricError: string;
begin
  Result := FLastError;
end;

{$IF DEFINED(ANDROID)}
const
  // DeviceCredential inclus : un telephone protege par un schema ou un code,
  // sans empreinte enrolee, doit rester utilisable. C'est le cas courant.
  WANTED_STRENGTHS = [TBiometricStrength.Strong,
                      TBiometricStrength.DeviceCredential];

/// Recupere le service ET pose les forces d'authentification.
///
/// L'ORDRE N'EST PAS COSMETIQUE. Le service Android construit son masque
/// d'authentificateurs a partir de ces forces, et son champ demarre a
/// l'ensemble VIDE - le constructeur ne l'initialise pas. Interroger
/// CanAuthenticate avant de les poser revient donc a demander
/// canAuthenticate(0), qui ne repond jamais « disponible », quel que soit ce
/// que l'appareil sait faire.
function AcquireService(out ASvc: IFMXBiometricAuthService): Boolean;
begin
  Result := TPlatformServices.Current.SupportsPlatformService(
              IFMXBiometricAuthService, ASvc);
  if Result then
    ASvc.SetBiometricStrengths(WANTED_STRENGTHS);
end;
{$ENDIF}

function BiometricAvailable: Boolean;
{$IF DEFINED(ANDROID)}
var
  LSvc: IFMXBiometricAuthService;
begin
  // try/except et non un simple test : CanAuthenticate LEVE une
  // java.lang.SecurityException si USE_BIOMETRIC manque au manifeste, au lieu
  // de repondre False. Sans cette garde, un manifeste incomplet ne se traduit
  // pas par « pas de biometrie » mais par une boite d'exception en pleine
  // ouverture du coffre.
  FLastError := '';
  try
    if not AcquireService(LSvc) then
    begin
      FLastError := 'biometric service missing from the platform';
      Exit(False);
    end;
    Result := LSvc.CanAuthenticate;
    if not Result then
      FLastError := 'CanAuthenticate: no usable protection';
  except
    on E: Exception do
    begin
      FLastError := E.ClassName + ': ' + E.Message;
      Result := False;
    end;
  end;
end;
{$ELSE}
begin
  Result := False;
end;
{$ENDIF}

procedure AuthenticateThen(const APrompt: string; const AThen: TProc<TBioOutcome>);
{$IF DEFINED(ANDROID)}
var
  LSvc: IFMXBiometricAuthService;
  LProps: TBiometricPromptProperties;
begin
  if not Assigned(AThen) then Exit;

  // AcquireService pose les forces ; CanAuthenticate n'a de sens qu'apres.
  FLastError := '';
  if not AcquireService(LSvc) then
  begin
    FLastError := 'biometric service missing from the platform';
    AThen(boFailed);   // pas boUnavailable : on ne sait rien de l'appareil
    Exit;
  end;
  try
    if not LSvc.CanAuthenticate then
    begin
      // Reponse NETTE du systeme : l'appareil n'a rien pour authentifier.
      FLastError := 'CanAuthenticate: no usable protection';
      AThen(boUnavailable);
      Exit;
    end;
  except
    on E: Exception do
    begin
      FLastError := E.ClassName + ': ' + E.Message;
      AThen(boFailed);
      Exit;
    end;
  end;

  LProps := Default(TBiometricPromptProperties);
  LProps.Title := 'Unlock the vault';
  LProps.Description := APrompt;
  LProps.CancelButtonText := 'Cancel';
  LSvc.SetPromptProperties(LProps);

  // Meme raison que plus haut : ce qui remonte de la couche Java doit
  // ressortir en TBioOutcome, jamais en exception - l'appelant a un chemin
  // pour chaque issue, il n'en a aucun pour une exception.
  try
    LSvc.Authenticate(
      procedure
      begin
        AThen(boOK);
      end,
      procedure(const AFailReason: TBiometricFailReason; const AMessage: string)
      begin
        if AFailReason = TBiometricFailReason.Cancelled then
          AThen(boCancelled)
        else
          AThen(boFailed);
      end);
  except
    on E: Exception do
    begin
      FLastError := E.ClassName + ': ' + E.Message;
      AThen(boFailed);
    end;
  end;
end;
{$ELSE}
begin
  if Assigned(AThen) then AThen(boUnavailable);
end;
{$ENDIF}

end.