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

unit PMA.VaultPatch;
{
  Modifier UN champ d'UNE entree dans l'instantane, sans toucher au reste.

  LA CONTRAINTE QUI GOUVERNE CETTE UNITE. TVault ne lit qu'une partie des
  champs : il ignore `content_b64` des pieces jointes, `created_at`, l'avatar du
  compte, les tombstones, et tout ce que le poste ajoutera demain. Reserialiser
  le coffre a partir de ce qu'il a compris EFFACERAIT tout cela - et le poste
  adopterait cette version amputee au tirage suivant, la fusion etant un
  dernier-ecrit-gagne sur `updated_at`. La perte serait silencieuse et
  definitive.

  Donc on ne reconstruit rien : on prend le JSON RECU, on change une valeur
  dedans, et on rend le reste tel quel. Ce que le telephone ne comprend pas
  voyage intact, par construction plutot que par vigilance.

  COROLLAIRE SUR LA FUSION. Comme le patch s'applique a l'instantane qu'on
  vient de tirer, il n'y a pas de fusion a ecrire : ce qui n'est pas touche est
  deja la version la plus recente du serveur. Le seul conflit possible est
  qu'un autre appareil publie entre notre lecture et notre ecriture, et Gitea
  le refuse par le sha (409) - il suffit alors de recommencer.
}

interface

uses
  System.SysUtils, System.JSON, System.DateUtils;

type
  EPMAPatch = class(Exception);

/// Remplace AField de l'entree AUuid par AValue, et bump `updated_at`.
/// Rend le JSON complet, tout le reste inchange. Leve si l'entree est absente -
/// ce qui veut dire que le distant ne la contient pas (supprimee ailleurs), et
/// ecrire quand meme la ferait reapparaitre.
function PatchEntryField(const APlainJson, AUuid, AField, AValue: string): string;

/// Un instantane vide, au nom de ce compte. Sert a l'inscription depuis le
/// telephone : meme forme que ce qu'ecrit le poste, pour qu'un coffre ne
/// naisse pas dans un dialecte a part.
function NewEmptySnapshot(const AUsername: string): string;

/// Ajoute une entree a l'instantane et rend le JSON complet.
///
/// LA MEME FORME QUE CE QU'ECRIT LE POSTE, cles vides comprises : une entree
/// nee ici sera relue la-bas, et une cle absente ne se comporte pas toujours
/// comme une cle vide. `folder` vaut 'All' parce que c'est le dossier par
/// defaut du poste, pas parce que c'est joli.
///
/// Un uuid neuf, et lui seul : pas de tombstone, on ne supprime pas encore.
function AddEntry(const APlainJson, ATitle, ASite, AUsername, APassword,
  AKind: string): string;

/// Retire une entree de l'instantane et laisse une PIERRE TOMBALE a sa place.
///
/// LES DEUX, SINON RIEN. Retirer la ligne sans la tombstone ne supprime pas :
/// le poste tient toujours la sienne, et le prochain tirage la ramenerait comme
/// une entree qu'on n'a jamais eue. C'est la tombstone qui dit "celle-ci a ete
/// supprimee, et a telle heure" - et l'heure compte, parce que l'arbitrage du
/// poste garde une entree modifiee APRES la suppression plutot que de la tuer
/// une seconde fois.
///
/// SANS RETOUR depuis le telephone : il n'y a pas de corbeille ici. Celle du
/// poste est un drapeau `deleted` qui ne voyage pas dans la synchronisation ;
/// une suppression qui s'y arreterait ne se propagerait donc nulle part.
function DeleteEntry(const APlainJson, AUuid: string): string;

/// Horodatage UTC au format que tout le reste emploie (toISOString cote JS).
/// MELANGER heure locale et UTC a deja decale l'arbitrage de la fusion une
/// fois : il n'y a qu'une source d'heure ici, et elle est en UTC.
function NowUtcIso: string;

implementation

function NowUtcIso: string;
begin
  Result := FormatDateTime('yyyy-mm-dd"T"hh:nn:ss.zzz"Z"',
    TTimeZone.Local.ToUniversalTime(Now));
end;

function NewEmptySnapshot(const AUsername: string): string;
var
  LRoot: TJSONObject;
begin
  LRoot := TJSONObject.Create;
  try
    // Les memes cles que buildSyncSnapshot, tableaux vides compris : un lecteur
    // qui trouve la cle absente et un lecteur qui la trouve vide ne se
    // comportent pas forcement pareil, et ce coffre sera lu par le poste.
    LRoot.AddPair('version', TJSONNumber.Create(1));
    LRoot.AddPair('snapshot_at', NowUtcIso);
    LRoot.AddPair('username', AUsername);
    LRoot.AddPair('folders', TJSONArray.Create);
    LRoot.AddPair('avatar_b64', '');
    LRoot.AddPair('entries', TJSONArray.Create);
    LRoot.AddPair('tombstones', TJSONArray.Create);
    Result := LRoot.ToJSON;
  finally
    LRoot.Free;
  end;
end;

function DeleteEntry(const APlainJson, AUuid: string): string;
var
  LRoot, LEntry, LStone: TJSONObject;
  LEntries, LStones: TJSONArray;
  I: Integer;
  LFound: Boolean;
begin
  if AUuid = '' then
    raise EPMAPatch.Create('Entree sans uuid : rien a supprimer chez le distant');

  LRoot := TJSONObject.ParseJSONValue(APlainJson) as TJSONObject;
  if LRoot = nil then
    raise EPMAPatch.Create('Instantane illisible');
  try
    if not LRoot.TryGetValue<TJSONArray>('entries', LEntries) then
      raise EPMAPatch.Create('Instantane sans tableau "entries"');

    LFound := False;
    for I := 0 to LEntries.Count - 1 do
    begin
      if not (LEntries.Items[I] is TJSONObject) then Continue;
      LEntry := LEntries.Items[I] as TJSONObject;
      if LEntry.GetValue<string>('uuid', '') <> AUuid then Continue;
      // Remove REND la valeur retiree : a l'appelant de la liberer.
      LEntries.Remove(I).Free;
      LFound := True;
      Break;
    end;

    if not LFound then
      raise EPMAPatch.CreateFmt(
        'Entree %s absente du distant - supprimee ailleurs ?', [AUuid]);

    // Le tableau peut manquer : un conteneur ecrit par un poste qui n'avait
    // encore rien supprime n'a aucune raison de le porter.
    if not LRoot.TryGetValue<TJSONArray>('tombstones', LStones) then
    begin
      LStones := TJSONArray.Create;
      LRoot.AddPair('tombstones', LStones);
    end;
    LStone := TJSONObject.Create;
    LStone.AddPair('uuid', AUuid);
    LStone.AddPair('deleted_at', NowUtcIso);
    LStones.AddElement(LStone);

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

function AddEntry(const APlainJson, ATitle, ASite, AUsername, APassword,
  AKind: string): string;
var
  LRoot, LEntry: TJSONObject;
  LEntries: TJSONArray;
  LNow: string;
begin
  LRoot := TJSONObject.ParseJSONValue(APlainJson) as TJSONObject;
  if LRoot = nil then
    raise EPMAPatch.Create('Snapshot is not a JSON object');
  try
    LEntries := LRoot.GetValue('entries') as TJSONArray;
    if LEntries = nil then
      raise EPMAPatch.Create('Snapshot has no entries array');

    LNow := NowUtcIso;
    LEntry := TJSONObject.Create;
    // Minuscules et sans accolades : la forme que tout le reste emploie.
    LEntry.AddPair('uuid', LowerCase(Copy(GUIDToString(TGUID.NewGuid), 2, 36)));
    LEntry.AddPair('title', ATitle);
    LEntry.AddPair('site', ASite);
    LEntry.AddPair('username', AUsername);
    // Le corps d'une note EST son mot de passe cote stockage - il n'y a pas de
    // colonne separee, ni ici ni sur le poste.
    LEntry.AddPair('password', APassword);
    LEntry.AddPair('folder', 'All');
    LEntry.AddPair('tags', TJSONArray.Create);
    LEntry.AddPair('totp_secret', '');
    LEntry.AddPair('kind', AKind);
    LEntry.AddPair('template', '');
    LEntry.AddPair('custom_fields', TJSONArray.Create);
    LEntry.AddPair('attachments', TJSONArray.Create);
    LEntry.AddPair('icon_b64', '');
    LEntry.AddPair('icon_custom', TJSONNumber.Create(0));
    LEntry.AddPair('created_at', LNow);
    LEntry.AddPair('updated_at', LNow);
    LEntries.AddElement(LEntry);

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

function PatchEntryField(const APlainJson, AUuid, AField, AValue: string): string;
var
  LRoot, LEntry: TJSONObject;
  LEntries: TJSONArray;
  I: Integer;
  LFound: Boolean;
begin
  if AUuid = '' then
    raise EPMAPatch.Create('Entree sans uuid : rien a retrouver chez le distant');

  LRoot := TJSONObject.ParseJSONValue(APlainJson) as TJSONObject;
  if LRoot = nil then
    raise EPMAPatch.Create('Instantane illisible');
  try
    if not LRoot.TryGetValue<TJSONArray>('entries', LEntries) then
      raise EPMAPatch.Create('Instantane sans tableau "entries"');

    LFound := False;
    for I := 0 to LEntries.Count - 1 do
    begin
      if not (LEntries.Items[I] is TJSONObject) then Continue;
      LEntry := LEntries.Items[I] as TJSONObject;
      if LEntry.GetValue<string>('uuid', '') <> AUuid then Continue;

      // RemovePair puis AddPair : AddPair seul ajouterait un DOUBLON, et le
      // lecteur prendrait le premier - donc l'ancienne valeur.
      LEntry.RemovePair(AField).Free;
      LEntry.AddPair(AField, AValue);

      // Sans ce bump, la modification voyage mais les autres appareils
      // l'ignorent : leur arbitrage compare `updated_at`, et le notre serait
      // reste plus ancien que le leur.
      LEntry.RemovePair('updated_at').Free;
      LEntry.AddPair('updated_at', NowUtcIso);

      LFound := True;
      Break;
    end;

    if not LFound then
      raise EPMAPatch.CreateFmt(
        'Entree %s absente du distant - supprimee ailleurs ?', [AUuid]);

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

end.