kam-mobile/code/GameDiagnosticsReport.pas

unit GameDiagnosticsReport;

{$mode objfpc}{$H+}{$codepage utf8}

interface

type
  TDiagnosticStatus = (dsNotRun, dsPass, dsFail);

  TDiagnosticStageId = (
    dsiResourceExists,
    dsiResourceOpen,
    dsiCallerStreamLoad,
    dsiStreamState,
    dsiSeekReadConsistency
  );

  TTerrainReadinessDiagnosticStageId = (
    trsiRxTilesLoad,
    trsiMapStreamLoad,
    trsiMapHeader,
    trsiTileRecords
  );

  TOptionalString = record
    HasValue: Boolean;
    Value: string;
  end;

  TOptionalInt64 = record
    HasValue: Boolean;
    Value: Int64;
  end;

  TOptionalBoolean = record
    HasValue: Boolean;
    Value: Boolean;
  end;

  TOptionalDiagnosticStageId = record
    HasValue: Boolean;
    Value: TDiagnosticStageId;
  end;

  TOptionalTerrainReadinessDiagnosticStageId = record
    HasValue: Boolean;
    Value: TTerrainReadinessDiagnosticStageId;
  end;

  TDiagnosticError = record
    Present: Boolean;
    ClassName: TOptionalString;
    MessageText: TOptionalString;
  end;

  TFileIODiagnosticStreamResult = record
    Size: TOptionalInt64;
    PositionAfterLoad: TOptionalInt64;
    ReadOffset: TOptionalInt64;
    RequestedReadCount: TOptionalInt64;
    FirstReadCount: TOptionalInt64;
    PositionAfterFirstRead: TOptionalInt64;
    SeekBackPosition: TOptionalInt64;
    SecondReadCount: TOptionalInt64;
    PositionAfterSecondRead: TOptionalInt64;
    RepeatEqual: TOptionalBoolean;
  end;

  TFileIODiagnosticResult = record
    Status: TDiagnosticStatus;
    FailureStage: TOptionalDiagnosticStageId;
    Error: TDiagnosticError;
    Stages: array[TDiagnosticStageId] of TDiagnosticStatus;
    Stream: TFileIODiagnosticStreamResult;
  end;

  TTerrainReadinessDiagnosticEvidence = record
    RxTilesLoaded: TOptionalBoolean;
    GeneratedTransitionsReady: TOptionalBoolean;
    MapX: TOptionalInt64;
    MapY: TOptionalInt64;
    GameRev: TOptionalInt64;
    ExpectedTileCount: TOptionalInt64;
    CompletedTileCount: TOptionalInt64;
  end;

  TTerrainReadinessDiagnosticResult = record
    Status: TDiagnosticStatus;
    FailureStage: TOptionalTerrainReadinessDiagnosticStageId;
    Error: TDiagnosticError;
    Stages: array[TTerrainReadinessDiagnosticStageId] of TDiagnosticStatus;
    Evidence: TTerrainReadinessDiagnosticEvidence;
  end;

  TDiagnosticApplicationMetadata = record
    Name: string;
    PackageName: string;
    Version: string;
    VersionCode: Int64;
    BuildId: TOptionalString;
  end;

  TDiagnosticRuntimeMetadata = record
    Platform: string;
    OsVersion: TOptionalString;
    DeviceModel: TOptionalString;
    CpuArch: TOptionalString;
  end;

  TDiagnosticSelectedMapMetadata = record
    RelativePath: string;
    Url: string;
  end;

  TDiagnosticReportState = record
    ApplicationInfo: TDiagnosticApplicationMetadata;
    RuntimeInfo: TDiagnosticRuntimeMetadata;
    SelectedMap: TDiagnosticSelectedMapMetadata;
    OverallStatus: TDiagnosticStatus;
    FileIO: TFileIODiagnosticResult;
    TerrainReadiness: TTerrainReadinessDiagnosticResult;
  end;

function CurrentDiagnosticReport: TDiagnosticReportState;
procedure ReplaceFileIODiagnosticResult(const AResult: TFileIODiagnosticResult);
procedure ReplaceTerrainReadinessDiagnosticResult(
  const AResult: TTerrainReadinessDiagnosticResult);
function DiagnosticStatusToken(const AStatus: TDiagnosticStatus): string;
function DiagnosticStageIdToken(const AStage: TDiagnosticStageId): string;
function TerrainReadinessDiagnosticStageIdToken(
  const AStage: TTerrainReadinessDiagnosticStageId): string;
function DiagnosticReportJsonSnapshot: string;

implementation

uses
  fpjson, GameSelectedMap;

var
  CurrentFileIO: TFileIODiagnosticResult;
  CurrentTerrainReadiness: TTerrainReadinessDiagnosticResult;

function DiagnosticStatusToken(const AStatus: TDiagnosticStatus): string;
begin
  case AStatus of
    dsNotRun: Result := 'NOT_RUN';
    dsPass: Result := 'PASS';
    dsFail: Result := 'FAIL';
  end;
end;

function DiagnosticStageIdToken(const AStage: TDiagnosticStageId): string;
begin
  case AStage of
    dsiResourceExists: Result := 'resource_exists';
    dsiResourceOpen: Result := 'resource_open';
    dsiCallerStreamLoad: Result := 'caller_stream_load';
    dsiStreamState: Result := 'stream_state';
    dsiSeekReadConsistency: Result := 'seek_read_consistency';
  end;
end;

function TerrainReadinessDiagnosticStageIdToken(
  const AStage: TTerrainReadinessDiagnosticStageId): string;
begin
  case AStage of
    trsiRxTilesLoad: Result := 'rx_tiles_load';
    trsiMapStreamLoad: Result := 'map_stream_load';
    trsiMapHeader: Result := 'map_header';
    trsiTileRecords: Result := 'tile_records';
  end;
end;

function CurrentDiagnosticReport: TDiagnosticReportState;
begin
  Result.ApplicationInfo.Name := 'kam_mobile';
  Result.ApplicationInfo.PackageName := 'org.kammobile.kamremake';
  Result.ApplicationInfo.Version := '0.4.0';
  Result.ApplicationInfo.VersionCode := 30;
  Result.ApplicationInfo.BuildId.HasValue := False;
  Result.RuntimeInfo.Platform := 'android';
  Result.RuntimeInfo.OsVersion.HasValue := False;
  Result.RuntimeInfo.DeviceModel.HasValue := False;
  Result.RuntimeInfo.CpuArch.HasValue := False;
  Result.SelectedMap.RelativePath := SelectedMapRelativePath;
  Result.SelectedMap.Url := SelectedMapUrl;
  Result.FileIO := CurrentFileIO;
  Result.TerrainReadiness := CurrentTerrainReadiness;
  if (Result.FileIO.Status = dsFail)
    or (Result.TerrainReadiness.Status = dsFail) then
    Result.OverallStatus := dsFail
  else if (Result.FileIO.Status = dsPass)
    and (Result.TerrainReadiness.Status = dsPass) then
    Result.OverallStatus := dsPass
  else
    Result.OverallStatus := dsNotRun;
end;

procedure ReplaceFileIODiagnosticResult(const AResult: TFileIODiagnosticResult);
begin
  CurrentFileIO := AResult;
end;

procedure ReplaceTerrainReadinessDiagnosticResult(
  const AResult: TTerrainReadinessDiagnosticResult);
begin
  CurrentTerrainReadiness := AResult;
end;

function OptionalStringJson(const AValue: TOptionalString): TJSONData;
begin
  if AValue.HasValue then
    Result := TJSONString.Create(AValue.Value)
  else
    Result := TJSONNull.Create;
end;

function OptionalInt64Json(const AValue: TOptionalInt64): TJSONData;
begin
  if AValue.HasValue then
    Result := TJSONIntegerNumber.Create(AValue.Value)
  else
    Result := TJSONNull.Create;
end;

function OptionalBooleanJson(const AValue: TOptionalBoolean): TJSONData;
begin
  if AValue.HasValue then
    Result := TJSONBoolean.Create(AValue.Value)
  else
    Result := TJSONNull.Create;
end;

function DiagnosticReportJsonSnapshot: string;
var
  State: TDiagnosticReportState;
  Root, ObjectValue, Action, Stage, Stream: TJSONObject;
  Actions, Stages: TJSONArray;
  StageId: TDiagnosticStageId;
  TerrainStageId: TTerrainReadinessDiagnosticStageId;
  Evidence: TJSONObject;
begin
  State := CurrentDiagnosticReport;
  Root := TJSONObject.Create;
  try
    Root.Add('schema', 'kam-mobile-diagnostics/1');
    ObjectValue := TJSONObject.Create;
    ObjectValue.Add('name', State.ApplicationInfo.Name);
    ObjectValue.Add('package', State.ApplicationInfo.PackageName);
    ObjectValue.Add('version', State.ApplicationInfo.Version);
    ObjectValue.Add('version_code', State.ApplicationInfo.VersionCode);
    ObjectValue.Add('build_id', OptionalStringJson(State.ApplicationInfo.BuildId));
    Root.Add('application', ObjectValue);
    ObjectValue := TJSONObject.Create;
    ObjectValue.Add('platform', State.RuntimeInfo.Platform);
    ObjectValue.Add('os_version', OptionalStringJson(State.RuntimeInfo.OsVersion));
    ObjectValue.Add('device_model', OptionalStringJson(State.RuntimeInfo.DeviceModel));
    ObjectValue.Add('cpu_arch', OptionalStringJson(State.RuntimeInfo.CpuArch));
    Root.Add('runtime', ObjectValue);
    ObjectValue := TJSONObject.Create;
    ObjectValue.Add('relative_path', State.SelectedMap.RelativePath);
    ObjectValue.Add('url', State.SelectedMap.Url);
    Root.Add('selected_map', ObjectValue);
    Root.Add('overall_status', DiagnosticStatusToken(State.OverallStatus));
    Actions := TJSONArray.Create;
    Action := TJSONObject.Create;
    Action.Add('id', 'file_io');
    Action.Add('status', DiagnosticStatusToken(State.FileIO.Status));
    if State.FileIO.FailureStage.HasValue then
      Action.Add('failure_stage', DiagnosticStageIdToken(State.FileIO.FailureStage.Value))
    else
      Action.Add('failure_stage', TJSONNull.Create);
    if State.FileIO.Error.Present then
    begin
      ObjectValue := TJSONObject.Create;
      ObjectValue.Add('class', OptionalStringJson(State.FileIO.Error.ClassName));
      ObjectValue.Add('message', OptionalStringJson(State.FileIO.Error.MessageText));
      Action.Add('error', ObjectValue);
    end else
      Action.Add('error', TJSONNull.Create);
    Stages := TJSONArray.Create;
    for StageId := Low(TDiagnosticStageId) to High(TDiagnosticStageId) do
    begin
      Stage := TJSONObject.Create;
      Stage.Add('id', DiagnosticStageIdToken(StageId));
      Stage.Add('status', DiagnosticStatusToken(State.FileIO.Stages[StageId]));
      Stages.Add(Stage);
    end;
    Action.Add('stages', Stages);
    Stream := TJSONObject.Create;
    Stream.Add('size', OptionalInt64Json(State.FileIO.Stream.Size));
    Stream.Add('position_after_load', OptionalInt64Json(State.FileIO.Stream.PositionAfterLoad));
    Stream.Add('read_offset', OptionalInt64Json(State.FileIO.Stream.ReadOffset));
    Stream.Add('requested_read_count', OptionalInt64Json(State.FileIO.Stream.RequestedReadCount));
    Stream.Add('first_read_count', OptionalInt64Json(State.FileIO.Stream.FirstReadCount));
    Stream.Add('position_after_first_read', OptionalInt64Json(State.FileIO.Stream.PositionAfterFirstRead));
    Stream.Add('seek_back_position', OptionalInt64Json(State.FileIO.Stream.SeekBackPosition));
    Stream.Add('second_read_count', OptionalInt64Json(State.FileIO.Stream.SecondReadCount));
    Stream.Add('position_after_second_read', OptionalInt64Json(State.FileIO.Stream.PositionAfterSecondRead));
    Stream.Add('repeat_equal', OptionalBooleanJson(State.FileIO.Stream.RepeatEqual));
    Action.Add('stream', Stream);
    Actions.Add(Action);
    Action := TJSONObject.Create;
    Action.Add('id', 'terrain_readiness');
    Action.Add('status', DiagnosticStatusToken(State.TerrainReadiness.Status));
    if State.TerrainReadiness.FailureStage.HasValue then
      Action.Add('failure_stage', TerrainReadinessDiagnosticStageIdToken(
        State.TerrainReadiness.FailureStage.Value))
    else
      Action.Add('failure_stage', TJSONNull.Create);
    if State.TerrainReadiness.Error.Present then
    begin
      ObjectValue := TJSONObject.Create;
      ObjectValue.Add('class', OptionalStringJson(
        State.TerrainReadiness.Error.ClassName));
      ObjectValue.Add('message', OptionalStringJson(
        State.TerrainReadiness.Error.MessageText));
      Action.Add('error', ObjectValue);
    end else
      Action.Add('error', TJSONNull.Create);
    Stages := TJSONArray.Create;
    for TerrainStageId := Low(TTerrainReadinessDiagnosticStageId)
      to High(TTerrainReadinessDiagnosticStageId) do
    begin
      Stage := TJSONObject.Create;
      Stage.Add('id', TerrainReadinessDiagnosticStageIdToken(TerrainStageId));
      Stage.Add('status', DiagnosticStatusToken(
        State.TerrainReadiness.Stages[TerrainStageId]));
      Stages.Add(Stage);
    end;
    Action.Add('stages', Stages);
    Evidence := TJSONObject.Create;
    Evidence.Add('rx_tiles_loaded', OptionalBooleanJson(
      State.TerrainReadiness.Evidence.RxTilesLoaded));
    Evidence.Add('generated_transitions_ready', OptionalBooleanJson(
      State.TerrainReadiness.Evidence.GeneratedTransitionsReady));
    Evidence.Add('map_x', OptionalInt64Json(State.TerrainReadiness.Evidence.MapX));
    Evidence.Add('map_y', OptionalInt64Json(State.TerrainReadiness.Evidence.MapY));
    Evidence.Add('game_rev', OptionalInt64Json(State.TerrainReadiness.Evidence.GameRev));
    Evidence.Add('expected_tile_count', OptionalInt64Json(
      State.TerrainReadiness.Evidence.ExpectedTileCount));
    Evidence.Add('completed_tile_count', OptionalInt64Json(
      State.TerrainReadiness.Evidence.CompletedTileCount));
    Action.Add('evidence', Evidence);
    Actions.Add(Action);
    Root.Add('actions', Actions);
    Result := Root.AsJSON;
  finally
    Root.Free;
  end;
end;

end.