unit XData.Payload.Json.Reader;

interface

uses
  Generics.Collections, TypInfo,
  XData.Aurelius.Model,
  Bcl.Json.Converters,
  Bcl.Json.Reader,
  XData.Json.Deserializer,
  XData.Model.Classes,
  XData.Payload.Reader,
  XData.Service.Common;

type
  TXDataJsonPayloadReader = class(TXDataPayloadReader)
  strict protected
    function XModel: TXDataAureliusModel;
  end;

  TJsonEntityReader = class(TXDataJsonPayloadReader, IEntityReader)
  strict private
    FReader: TJsonReader;
    FDeserializer: TXDataJsonServerDeserializer;
  protected
    property JReader: TJsonReader read FReader;
    property Deserializer: TXDataJsonServerDeserializer read FDeserializer;
  public
    procedure AfterConstruction; override;
    destructor Destroy; override;
    procedure ReadEntity(Target: TObject);
    function CreateEntity(const BaseType: TXDataEntityType): TObject;
    function ContentType: string; override;
    procedure SetUnknownMemberHandling(Value: TUnknownMemberHandling);
  end;

  TJsonPropertyReader = class(TXDataJsonPayloadReader, IPropertyReader)
  strict private
    FEntityReader: TJsonEntityReader;
  public
    procedure AfterConstruction; override;
    destructor Destroy; override;
    procedure ReadProperty(const AObject: TObject; const AProp: TXDataSimpleProperty);
    function ContentType: string; override;
  end;

  TJsonParamsReader = class(TXDataJsonPayloadReader, IParamsReader)
  strict private
    FReader: TJsonReader;
    FDeserializer: TXDataJsonServerDeserializer;
  protected
    property JReader: TJsonReader read FReader;
    property Deserializer: TXDataJsonServerDeserializer read FDeserializer;
  public
    procedure AfterConstruction; override;
    destructor Destroy; override;
    procedure ReadParams(const Action: TXDataAction; Params: IXDataActionParams);
    function ContentType: string; override;
    procedure SetUnknownMemberHandling(Value: TUnknownMemberHandling);
  end;

  TJsonErrorReader = class(TXDataJsonPayloadReader, IErrorReader)
  strict private
    FReader: TJsonReader;
  strict protected
    property JReader: TJsonReader read FReader;
  public
    procedure AfterConstruction; override;
    destructor Destroy; override;
    procedure ReadError(var ErrorCode, ErrorMessage: string);
    function ContentType: string; override;
  end;

implementation

uses
  System.Rtti,
  Bcl.Collections,
  XData.Consts,
  XData.Service.Internal;

{ TXDataJsonPayloadReader }

function TXDataJsonPayloadReader.XModel: TXDataAureliusModel;
begin
  Result := TXDataAureliusModel(Model);
end;

{ TJsonEntityReader }

procedure TJsonEntityReader.AfterConstruction;
var
  ManagedObjectsPtr: Pointer;
begin
  inherited;
  FReader := TJsonReader.Create(Self.Stream);
  FDeserializer := TXDataJsonServerDeserializer.Create(XModel, Solver);

  ManagedObjectsPtr := Self.ManagedObjects;
  FDeserializer.OnObjectCreated := procedure(Obj: TObject)
    begin
      if ManagedObjectsPtr <> nil then
        THashSet<TObject>(ManagedObjectsPtr).Add(Obj);
    end;
end;

function TJsonEntityReader.ContentType: string;
begin
  Result := JsonMediaType;
end;

destructor TJsonEntityReader.Destroy;
begin
  FDeserializer.Free;
  FReader.Free;
  inherited;
end;

procedure TJsonEntityReader.ReadEntity(Target: TObject);
var
  Value: TValue;
begin
  Assert(Target <> nil);
  Value := Target;
  Deserializer.Read(JReader, Value, Target.ClassType);
end;

procedure TJsonEntityReader.SetUnknownMemberHandling(
  Value: TUnknownMemberHandling);
begin
  Deserializer.SetUnknownMemberHandling(Value);
end;

function TJsonEntityReader.CreateEntity(const BaseType: TXDataEntityType): TObject;
begin
  Result := Deserializer.CreateObject(JReader, BaseType);
end;

{ TJsonPropertyReader }

procedure TJsonPropertyReader.AfterConstruction;
begin
  inherited;
  FEntityReader := TJsonEntityReader.Create(Stream, Model, BaseUrl, nil, ManagedObjects);
end;

function TJsonPropertyReader.ContentType: string;
begin
  Result := JsonMediaType;
end;

destructor TJsonPropertyReader.Destroy;
begin
  FEntityReader.Free;
  inherited;
end;

procedure TJsonPropertyReader.ReadProperty(const AObject: TObject;
  const AProp: TXDataSimpleProperty);
begin
//  FEntityWriter.Writer
//    .WriteBeginObject
//    .WriteName('value');
//  FEntityWriter.Serializer.WritePropertyValue(AObject, AProp);
//  FEntityWriter.Writer.WriteEndObject;
end;

{ TJsonParamsReader }

procedure TJsonParamsReader.AfterConstruction;
var
  ManagedObjectsPtr: Pointer;
begin
  inherited;
  FReader := TJsonReader.Create(Self.Stream);
  FDeserializer := TXDataJsonServerDeserializer.Create(XModel, Solver);

  ManagedObjectsPtr := Self.ManagedObjects;
  FDeserializer.OnObjectCreated := procedure(Obj: TObject)
    begin
      if ManagedObjectsPtr <> nil then
        THashSet<TObject>(ManagedObjectsPtr).Add(Obj);
    end;
end;

function TJsonParamsReader.ContentType: string;
begin
  Result := JsonMediaType;
end;

destructor TJsonParamsReader.Destroy;
begin
  FDeserializer.Free;
  FReader.Free;
  inherited;
end;

procedure TJsonParamsReader.ReadParams(const Action: TXDataAction; Params: IXDataActionParams);
var
  ParamDef: TXDataParamDef;
  Value: TValue;
  JParamName: string;
begin
  // special case - when action has only one body parameter and is a single object param, we can read it directly from the payload
  // it will not be wrapped in a { "paramname": <> } object
  // the client-side equivalent of this code is in XData.Client OnInvoke method, check there if you change something here
  if (Action.BodyParamCount = 1) and Action.BodyParams[0].RttiType.IsInstance then
  begin
    ParamDef := Action.BodyParams[0];
    Value := Deserializer.Read(JReader, ParamDef.RttiType.AsInstance.MetaclassType);
    Params.SetValue(ParamDef.Name, Value);
  end
  else
  if not JReader.EOF then
  begin
    JReader.ReadBeginObject;
    while JReader.HasNext do
    begin
      JParamName := JReader.ReadName;
      ParamDef := Action.FindParameter(JParamName);
      // special case: if action has only one parameter, we can also accept "value" as the param name
      if (ParamDef = nil) and (Action.BodyParamCount = 1) and (JParamName = JsonParamValue) then
        ParamDef := Action.BodyParams[0];

      if (ParamDef <> nil) and (ParamDef.BindingMode = TBindingMode.FromBody) then
      begin
        Value := Deserializer.Read(JReader, ParamDef.RttiType.Handle);
        Params.SetValue(ParamDef.Name, Value);
      end else
        JReader.SkipValue;
    end;
    JReader.ReadEndObject;
  end;
end;

procedure TJsonParamsReader.SetUnknownMemberHandling(
  Value: TUnknownMemberHandling);
begin
  Deserializer.SetUnknownMemberHandling(Value);
end;

{ TJsonErrorReader }

procedure TJsonErrorReader.AfterConstruction;
begin
  inherited;
  FReader := TJsonReader.Create(Self.Stream);
end;

function TJsonErrorReader.ContentType: string;
begin
  Result := JsonMediaType;
end;

destructor TJsonErrorReader.Destroy;
begin
  FReader.Free;
  inherited;
end;

procedure TJsonErrorReader.ReadError(var ErrorCode, ErrorMessage: string);
var
  Name: string;
begin
  ErrorCode := '';
  ErrorMessage := '';
  if JReader.Peek = TJsonToken.BeginObject then
  begin
    JReader.ReadBeginObject;
    while JReader.HasNext do
    begin
      if JReader.ReadName = 'error' then
      begin
        JReader.ReadBeginObject;
        while JReader.HasNext do
        begin
          Name := JReader.ReadName;
          if Name = 'code' then
            ErrorCode := JReader.ReadString
          else
          if Name = 'message' then
            ErrorMessage := JReader.ReadString
          else
            JReader.SkipValue;
        end;
        JReader.ReadEndObject;
      end
      else
        JReader.SkipValue;
    end;
    JReader.ReadEndObject;
  end;
end;

end.
