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;
    /// LE NOM DU CHAMP DANS L'INSTANTANE, vide si la ligne ne se modifie pas.
    ///
    /// Il porte les deux choses a la fois : qu'on puisse editer, et quoi
    /// editer. Marque ICI plutot que devine du libelle cote page : un intitule
    /// est de la prose, et le jour ou il change la page enverrait un nom de
    /// champ inexistant - ou, pire, cesserait silencieusement de proposer la
    /// modification.
    ///
    /// Supprimer une entree n'y figure pas : cela demande des tombstones, et
    /// c'est l'etape 3 de la §7.
    Field: string;
  end;

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

  procedure Add(const ACaption, AValue: string; ASecret: Boolean;
    const AField: string = '');
  begin
    // Une ligne vide n'apprend rien - SAUF si elle se remplit. Un identifiant
    // absent qu'on ne peut pas ajouter serait une impasse.
    if (AValue = '') and (AField = '') then Exit;
    SetLength(LRows, Length(LRows) + 1);
    LRows[High(LRows)].Caption := ACaption;
    LRows[High(LRows)].Value   := AValue;
    LRows[High(LRows)].Secret  := ASecret;
    LRows[High(LRows)].Field   := AField;
  end;

begin
  Add('Name', E.Title, False, 'title');
  // 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.
  //
  // Un site et un identifiant n'ont aucun sens pour une note. Les proposer
  // vides reviendrait a inviter a remplir ce que rien n'affichera jamais.
  if E.IsNote then
    Add('Content', E.Password, False, 'password')
  else
  begin
    Add('Site', E.Site, False, 'site');
    Add('Username', E.Username, False, 'username');
    Add('Password', E.Password, True, 'password');
  end;

  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));
      // 'e' porte le nom du champ, et sa presence vaut "modifiable".
      if LRows[I].Field <> '' then LObj.AddPair('e', LRows[I].Field);
      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.