Password-Manager/android-client/PMA.WebUI.pas

unit PMA.WebUI;
{
  La page HTML et les donnees qu'on lui envoie.

  POURQUOI HTML. Les controles FMX n'ont pas de gabarit fiable sur mobile :
  la journee a vu disparaitre tour a tour la ligne de liste, l'invite de
  recherche, la ligne de detail, selon le style charge. Le reste - arrondis,
  ordre d'alignement, HitTest qui avale un appui, vues natives qui se peignent
  par-dessus - se re-decouvre a chaque ecran. Le moteur du systeme rend la
  meme interface en quelques lignes de CSS, gere l'arabe et le bidirectionnel
  seul, et c'est deja le langage de l'interface du poste Windows.

  CE QUI RESTE EN DELPHI : Keystore, biometrie, presse-papiers sensible,
  FLAG_SECURE, reseau et dechiffrement. Le moteur n'est qu'une surface
  d'affichage - il ne detient jamais de quoi ouvrir le coffre.

  CE QUI PART VERS LA PAGE. La liste porte les noms, sites et identifiants,
  soit ce qui est deja a l'ecran, et AUCUN mot de passe : copier depuis une
  ligne envoie un indice, Delphi copie depuis le coffre. Seule l'entree
  ouverte a ses valeurs dans le tas JS, une a la fois.
}

interface

uses
  PMA.Vault;

/// La page, telle qu'embarquee dans le .res. ASCII pur - voir l'en-tete de
/// app.html : le chemin de chargement de FMX ne transporte pas l'encodage.
function PageHtml: string;

/// Ce que la liste affiche et cherche. Les indices sont ceux du coffre, pas
/// ceux de la liste : la page filtre et trie sans rien redemander, donc les
/// deux ne coincident plus des la premiere frappe.
function VaultToJson(AVault: TVault): string;

/// Les lignes d'une entree, dans l'ordre d'affichage.
function DetailToJson(const AEntry: TVaultEntry): string;

/// Une ligne du detail par son rang, dans le MEME ordre que DetailToJson : la
/// page renvoie un rang, jamais une valeur, et Delphi relit le clair chez lui.
/// Faux si le rang ne designe rien.
function DetailRowAt(const AEntry: TVaultEntry; AIndex: Integer;
  out ACaption, AValue: string): Boolean;

implementation

uses
  // System.Types pour RT_RCDATA, que Winapi.Windows fournirait sur un poste.
  System.SysUtils, System.Classes, System.Types, System.JSON, System.Character;

{$R 'web\web.res' 'web\web.rc'}

function PageHtml: string;
var
  LStream: TResourceStream;
  LBytes: TBytes;
begin
  LStream := TResourceStream.Create(HInstance, 'PMAPP', RT_RCDATA);
  try
    SetLength(LBytes, LStream.Size);
    LStream.ReadBuffer(LBytes, LStream.Size);
    Result := TEncoding.UTF8.GetString(LBytes);
  finally
    LStream.Free;
  end;
end;

function HumanSize(ABytes: Int64): string;
begin
  if ABytes >= 1024 * 1024 then
    Result := Format('%.1f MB', [ABytes / (1024 * 1024)])
  else if ABytes >= 1024 then
    Result := Format('%.0f KB', [ABytes / 1024])
  else
    Result := Format('%d B', [ABytes]);
end;

/// Premiere lettre du nom affiche, pour la pastille sans icone.
function Initial(const AName: string): string;
var
  LCh: Char;
begin
  Result := '?';
  for LCh in AName do
    if LCh.IsLetterOrDigit then Exit(LCh.ToUpper);
end;

function VaultToJson(AVault: TVault): string;
var
  LRoot: TJSONObject;
  LEntries, LFolders: TJSONArray;
  LObj: TJSONObject;
  LIdx: TArray<Integer>;
  I: Integer;
  E: TVaultEntry;
  LFolder: string;
begin
  LRoot := TJSONObject.Create;
  try
    LEntries := TJSONArray.Create;
    LRoot.AddPair('entries', LEntries);

    // Search('') rend les vivantes, deja triees par nom affiche. La page
    // conserve cet ordre : trier de nouveau en JS demanderait de repliquer
    // la meme convention de comparaison pour rien.
    LIdx := AVault.Search('');
    for I := 0 to High(LIdx) do
    begin
      E := AVault.Entry(LIdx[I]);
      LObj := TJSONObject.Create;
      LObj.AddPair('i', TJSONNumber.Create(LIdx[I]));
      LObj.AddPair('name', E.Display);
      // Le site s'il existe, sinon l'identifiant : deux fois la meme chaine
      // sur deux lignes n'apprendrait rien.
      if E.Site <> '' then LObj.AddPair('sub', E.Site)
      else if E.Username <> E.Display then LObj.AddPair('sub', E.Username)
      else LObj.AddPair('sub', '');
      LObj.AddPair('folder', E.Folder);
      // Corpus de recherche pre-assemble et en minuscules : la page cherche a
      // chaque frappe, autant ne pas recomposer la meme chaine a chaque fois.
      // Il couvre ce que couvrait TVault.Search - nom, site, identifiant,
      // etiquettes - donc l'identifiant reste trouvable meme quand la ligne
      // affiche le site.
      LObj.AddPair('s', (E.Title + ' ' + E.Site + ' ' + E.Username + ' ' +
                         E.Tags).ToLower);
      LObj.AddPair('icon', E.IconB64);
      LObj.AddPair('initial', Initial(E.Display));
      LObj.AddPair('hasUser', TJSONBool.Create(E.Username <> ''));
      LObj.AddPair('isNote', TJSONBool.Create(E.IsNote));
      LEntries.AddElement(LObj);
    end;

    LFolders := TJSONArray.Create;
    LRoot.AddPair('folders', LFolders);
    for LFolder in AVault.Folders do
      LFolders.Add(LFolder);

    Result := LRoot.ToJSON;
  finally
    LRoot.Free;
  end;
end;

/// Les lignes d'une entree. UN SEUL ENDROIT decide de leur composition et de
/// leur ordre : DetailToJson et DetailValues en dependent tous les deux, et
/// un ecart entre eux ferait copier la valeur de la ligne voisine.
type
  TDetailRow = record
    Caption, Value: string;
    Secret: Boolean;
    /// Modifiable depuis le telephone. UN SEUL champ l'est pour l'instant - le
    /// mot de passe - et c'est deliberé : creer ou supprimer une entree
    /// demanderait des tombstones et la generation d'uuid, alors que changer un
    /// mot de passe couvre l'essentiel du besoin sans rien de tout cela.
    /// Marque ICI plutot que reconnu au libelle cote page : un intitule est de
    /// la prose, et le jour ou il change la page cesserait silencieusement de
    /// proposer la modification.
    Editable: Boolean;
  end;

function BuildRows(const E: TVaultEntry): TArray<TDetailRow>;
var
  LRows: TArray<TDetailRow>;
  I: Integer;
  LMeta: string;

  procedure Add(const ACaption, AValue: string; ASecret: Boolean;
    AEditable: Boolean = False);
  begin
    if AValue = '' then Exit;   // une ligne vide n'apprend rien
    SetLength(LRows, Length(LRows) + 1);
    LRows[High(LRows)].Caption  := ACaption;
    LRows[High(LRows)].Value    := AValue;
    LRows[High(LRows)].Secret   := ASecret;
    LRows[High(LRows)].Editable := AEditable;
  end;

begin
  Add('Site', E.Site, False);
  Add('Username', E.Username, False);
  // Le corps d'une note est range dans le champ mot de passe : meme donnee,
  // autre intitule, et pas de raison de la masquer comme un secret.
  // Seule la ligne du mot de passe est modifiable. Le corps d'une note le
  // serait en principe, mais il se saisit sur plusieurs lignes - un autre
  // controle, une autre fois.
  if E.IsNote then Add('Content', E.Password, False)
              else Add('Password', E.Password, True, True);

  for I := 0 to High(E.Fields) do
    Add(E.Fields[I].Caption, E.Fields[I].Value, E.Fields[I].Secret);

  // Les pieces jointes ne sont pas encore enregistrables sur le telephone,
  // mais taire leur existence serait pire : on saurait sur le poste qu'une
  // entree porte un document, et pas ici.
  for I := 0 to High(E.Attachments) do
    Add('Attachment  -  ' + HumanSize(E.Attachments[I].SizeBytes),
        E.Attachments[I].FileName, False);

  LMeta := E.Folder;
  if E.Tags <> '' then
  begin
    if LMeta <> '' then LMeta := LMeta + '  -  ';
    LMeta := LMeta + E.Tags;
  end;
  Add('Folder / tags', LMeta, False);
  Add('Type', E.Template, False);
  // Horodatage tel quel : de l'ISO 8601 UTC, lisible, et le reformater
  // demanderait de decider d'un fuseau alors qu'il n'y a rien a arbitrer.
  Add('Updated', E.UpdatedAt, False);

  Result := LRows;
end;

function DetailToJson(const AEntry: TVaultEntry): string;
var
  LRoot: TJSONObject;
  LArr: TJSONArray;
  LObj: TJSONObject;
  LRows: TArray<TDetailRow>;
  I: Integer;
begin
  LRows := BuildRows(AEntry);
  LRoot := TJSONObject.Create;
  try
    LRoot.AddPair('title', AEntry.Display);
    LRoot.AddPair('totp', TJSONBool.Create(AEntry.Totp <> ''));
    LArr := TJSONArray.Create;
    LRoot.AddPair('rows', LArr);
    for I := 0 to High(LRows) do
    begin
      LObj := TJSONObject.Create;
      LObj.AddPair('c', LRows[I].Caption);
      LObj.AddPair('v', LRows[I].Value);
      LObj.AddPair('s', TJSONBool.Create(LRows[I].Secret));
      if LRows[I].Editable then LObj.AddPair('e', TJSONBool.Create(True));
      LArr.AddElement(LObj);
    end;
    Result := LRoot.ToJSON;
  finally
    LRoot.Free;
  end;
end;

function DetailRowAt(const AEntry: TVaultEntry; AIndex: Integer;
  out ACaption, AValue: string): Boolean;
var
  LRows: TArray<TDetailRow>;
begin
  LRows := BuildRows(AEntry);
  Result := (AIndex >= 0) and (AIndex <= High(LRows));
  if not Result then Exit;
  ACaption := LRows[AIndex].Caption;
  AValue := LRows[AIndex].Value;
end;

end.