unit XData.Client;

{$I XData.inc}

interface

uses
  Generics.Collections, System.TypInfo, System.Rtti, System.Types,
  Aurelius.Mapping.Optimization,
  Bcl.Json.Classes,
  Bcl.Json.Converters,
  Bcl.Json.Deserializer,
  Bcl.Json.Reader,
  Sparkle.Http.Client,
  XData.Aurelius.Model,
  XData.Model.Classes,
  XData.Payload.Json.Factory,
  XData.Sys.Exceptions;

type
  EXDataClientException = class(EXDataException);

  EXDataVirtualInterfaceFailed = class(EXDataClientException)
  public
    constructor Create(ATypeInfo: PTypeInfo);
  end;

  EXDataInterfaceServiceNotFound = class(EXDataClientException)
  public
    constructor Create(ATypeInfo: PTypeInfo);
  end;

  EXDataOperationNotFound = class(EXDataClientException)
  public
    constructor Create(const AInterfaceName, AName: string);
  end;

  EXDataWrongParameterCount = class(EXDataClientException)
  public
    constructor Create(Action: TXDataAction; PassedParameters: integer);
  end;

  EXDataWrongRouteParams = class(EXDataClientException)
  public
    constructor Create(Action: TXDataAction);
  end;

  EXDataMissingLocationHeader = class(EXDataClientException)
  public
    constructor Create(const RequestUrl: string);
  end;

  EXDataInvalidLocationHeader = class(EXDataClientException)
  public
    constructor Create(const RequestUrl, LocationHeader: string);
  end;

  EXDataClientRequestException = class(EXDataClientException)
  strict private
    FReq: THttpRequest;
    FResp: THttpResponse;
    FModel: TXDataAureliusModel;
    FErrorCode: string;
    FErrorMessage: string;
    FStatusCode: integer;
    FInfo: TJElement;
    procedure UpdateErrorDetail;
  public
    constructor Create(Req: THttpRequest; Resp: THttpResponse; Model: TXDataAureliusModel);
    destructor Destroy; override;
    property ErrorCode: string read FErrorCode;
    property ErrorMessage: string read FErrorMessage;
    property StatusCode: integer read FStatusCode;
    property Info: TJElement read FInfo;
  end;

  EXDataOperationRequestException = class(EXDataClientRequestException)
  end;

  EXDataGetRequestException = class(EXDataClientRequestException)
  end;

  TInstanceOwnership = (None, Entities);

  TXDataClient = class
  strict private
    FUri: string;
    FModel: TXDataAureliusModel;
    FHttpClient: THttpClient;
    FFactory: TXDataPayloadJsonFactory;
    FReturnedEntities: TObjectList<TObject>;
    FReturnedInstancesOwnership: TInstanceOwnership;
    FMaxEagerFetchDepth: integer;
    FPassword: string;
    FUserName: string;
    FBasicAuth: string;
    FIgnoreUnknownProperties: Boolean;
    procedure GetServiceInterface(TypeInfo: PTypeInfo; out Intf);
    procedure SetReturnedInstancesOwnership(const Value: TInstanceOwnership);
    function GetReturnedEntities: TList<TObject>;
    procedure SetPassword(const Value: string);
    procedure SetUserName(const Value: string);
    procedure UpdateBasicAuth;
    procedure SetIdFromResponse(Entity: TObject; Req: THttpRequest; Resp: THttpResponse);
  private
    FForceProxyLoading: Boolean;
    FForceBlobLoading: Boolean;
    function DeserializeValue(Deserializer: TJsonDeserializer; Reader: TJsonReader;
      const ATypeToken: TTypeToken): TValue;
    function ReadObjectResult(Req: THttpRequest; Resp: THttpResponse;
      ResultToken: TTypeToken): TValue;
    procedure WriteInstanceBody(AObject: TObject; Req: THttpRequest; AType: TXDataEntityType);
    function CreateHttpRequest: THttpRequest;
    function RequestUrl(const RelativeUrl: string): string;
    function List(Clazz: TClass; const Query: string; ListClass: TClass): TValue; overload;
  protected
    function DoSend(Req: THttpRequest): THttpResponse;
    procedure ReturnedEntityCreated(AObject: TObject);
    procedure Merge(Entity: TObject);
    property Model: TXDataAureliusModel read FModel;
    property MaxEagerFetchDepth: integer read FMaxEagerFetchDepth write FMaxEagerFetchDepth;
    property BasicAuth: string read FBasicAuth;
    property ForceProxyLoading: boolean read FForceProxyLoading write FForceProxyLoading;
    property ForceBlobLoading: Boolean read FForceBlobLoading write FForceBlobLoading;
  public
    constructor Create; overload;
    constructor Create(AModel: TXDataAureliusModel); overload;
    destructor Destroy; override;
    function Get<E: class; T>(Id: T): E; overload;
    function Get<E: class>(Id: TValue): E; overload;
    function Get(Clazz: TClass; IdValue: TValue): TObject; overload;
    function List<E: class>(const Query: string = ''): TList<E>; overload;
    function List(Clazz: TClass; const Query: string = ''): TList<TObject>; overload;
    function Count(Clazz: TClass; const Query: string = ''): Integer;
    procedure Post(Entity: TObject);
    procedure Put(Entity: TObject);
    procedure Delete(Entity: TObject);
    function Service<T>: T;
    property HttpClient: THttpClient read FHttpClient;
    property Uri: string read FUri write FUri;
    property IgnoreUnknownProperties: Boolean read FIgnoreUnknownProperties write FIgnoreUnknownProperties default False;
    property ReturnedInstancesOwnership: TInstanceOwnership read FReturnedInstancesOwnership write SetReturnedInstancesOwnership;
    property ReturnedEntities: TList<TObject> read GetReturnedEntities;
    property UserName: string read FUserName write SetUserName;
    property Password: string read FPassword write SetPassword;
  end;

  TXDataInvoker = class
  strict private
    {$IFDEF AUTOREFCOUNT}[Weak]{$ENDIF}
    FClient: TXDataClient;
    FAction: TXDataAction;
    property Action: TXDataAction read FAction;
  strict private
    function CreateHttpRequest: THttpRequest;
    function RequestUrl(const RelativeUrl: string): string;
    function Model: TXDataAureliusModel;
    function ForceProxyLoading: Boolean;
    function ForceBlobLoading: Boolean;
    function DoSend(Req: THttpRequest): THttpResponse;
    procedure ReturnedEntityCreated(AObject: TObject);
    function DeserializeValue(Deserializer: TJsonDeserializer; Reader: TJsonReader;
      const ATypeToken: TTypeToken): TValue;
  strict private
    function BuildQueryString(Args: TArray<TValue>): string;
    function GetPathParamValues(Args: TArray<TValue>): TStringDynArray;
    function BuildUrlRoute(Args: TArray<TValue>): string;
    procedure SetParamStreamBody(Req: THttpRequest; const Args: TArray<TValue>; ArgIndex: Integer);
    procedure SetJsonParamsBody(Req: THttpRequest; const Args: TArray<TValue>);
    procedure SetJsonObjectBody(Req: THttpRequest; const Args: TArray<TValue>);
    procedure ReadActionResult(Req: THttpRequest; Resp: THttpResponse;
      Action: TXDataAction; var ResultValue: TValue; const Args: TArray<TValue>);
  public
    constructor Create(AClient: TXDataClient; AAction: TXDataAction);
    procedure Execute(const Args: TArray<TValue>; out Result: TValue);
  end;

implementation

uses
  System.SysUtils, System.Classes,
  Aurelius.Global.Config,
  Aurelius.Mapping.Explorer,
  Aurelius.Mapping.Metadata,
  Bcl.Json,
  Bcl.Rtti.Utils,
  Bcl.Utils,
  Sparkle.Json.Reader,
  Sparkle.Json.Writer,
  Sparkle.Utils,
  Sparkle.Uri,
  XData.Aurelius.ModelBuilder,
  XData.Bind.Converter,
  XData.Consts,
  XData.Json.Serializer,
  XData.Json.Deserializer,
  XData.Json.Solver,
  XData.Service.Common,
  XData.Service.Internal,
  XData.Utils;

{ EXDataVirtualInterfaceFailed }

constructor EXDataVirtualInterfaceFailed.Create(ATypeInfo: PTypeInfo);
begin
  inherited CreateFmt('Error when creating virtual interface. Could not retrieve interface "%s"', [GetTypeName(ATypeInfo)]);
end;

{ EXDataInterfaceServiceNotFound }

constructor EXDataInterfaceServiceNotFound.Create(ATypeInfo: PTypeInfo);
begin
  inherited CreateFmt('Interface "%s" not registered as a service contract.', [GetTypeName(ATypeInfo)]);
end;

{ EXDataOperationNotFound }

constructor EXDataOperationNotFound.Create(const AInterfaceName, AName: string);
begin
  inherited CreateFmt('Operation "%s.%s" not found in model.', [AInterfaceName, AName]);
end;

{ EXDataWrongParameterCount }

constructor EXDataWrongParameterCount.Create(Action: TXDataAction; PassedParameters: integer);
begin
  inherited CreateFmt('Incorret parameter count for Operation "%s.%s". Expected: %d, actual: %d',
    [Action.Controller.Name, Action.Name, Action.Parameters.Count, PassedParameters]);
end;

{ TXDataMissingLocationHeader }

constructor EXDataMissingLocationHeader.Create(const RequestUrl: string);
begin
  inherited CreateFmt('Missing Location header after POSTing to address "%s"', [RequestUrl]);
end;

{ EXDataInvalidLocationHeader }

constructor EXDataInvalidLocationHeader.Create(const RequestUrl, LocationHeader: string);
begin
  inherited CreateFmt('Invalid Location header after POSTing to address "%s". Header value "%s"',
    [RequestUrl, LocationHeader]);
end;

{ EXDataClientRequestException }

constructor EXDataClientRequestException.Create(Req: THttpRequest; Resp: THttpResponse; Model: TXDataAureliusModel);
var
  Msg: string;
begin
  FReq := Req;
  FResp := Resp;
  FModel := Model;
  FStatusCode := Resp.StatusCode;
  UpdateErrorDetail;
  Msg := 'XData server request error.' + sLineBreak + 'Uri: ' + Req.Uri;
  Msg := Msg + sLineBreak + 'Status code: ' + IntToStr(Resp.StatusCode);
  if ErrorCode <> '' then
    Msg := Msg + sLineBreak + 'Error Code: ' + ErrorCode;
  if ErrorMessage <> '' then
    Msg := Msg + sLineBreak + ErrorMessage;
  inherited Create(Msg);
end;

destructor EXDataClientRequestException.Destroy;
begin
  FInfo.Free;
  inherited;
end;

procedure EXDataClientRequestException.UpdateErrorDetail;
var
  Error: TJObject;
begin
  if SameText(FResp.ContentType, JsonMediaType) then
  begin
    FInfo := TJson.Deserialize<TJElement>(FResp.ContentAsStream);
    if FInfo.IsObject and FInfo.AsObject.Contains('error')
      and FInfo.AsObject['error'].IsObject then
    begin
      Error := FInfo.AsObject['error'].AsObject;
      if Error.Contains('code') then
        FErrorCode := Error['code'].AsString;
      if Error.Contains('message') then
        FErrorMessage := Error['message'].AsString;
    end;
  end else
  begin
    FErrorCode := '';
    FErrorMessage := FResp.StatusReason;
  end;
end;

{ TClientReferenceSolver }

type
  TClientReferenceSolver = class(TInterfacedObject, IJsonReferenceSolver)
  strict private
    FClient: TXDataClient;
    property Client: TXDataClient read FClient;
  public
    constructor Create(AClient: TXDataClient);
    function SolveBlob(const Ref: string; RttiInfo: TRttiOptimization): TArray<byte>;
    function SolveReference(const Ref: string; RttiInfo: TRttiOptimization; ADepth: integer): TObject;
  end;

{ TXDataClient }

constructor TXDataClient.Create;
begin
  Create(nil);
end;

function TXDataClient.Count(Clazz: TClass; const Query: string): Integer;
var
  Req: THttpRequest;
  Resp: THttpResponse;
  EntityType: TXDataEntityType;
begin
  EntityType := Model.GetEntityTypeByClass(Clazz);
  {$IFNDEF DELPHITOKYO_LVL}
  Result := 0;
  {$ENDIF}
  Resp := nil;
  Req := CreateHttpRequest;
  try
    Req.Uri := RequestUrl(TSparkleUtils.PercentEncode(
      Model.EntitySetUrl(Model.DefaultEntitySet(EntityType))
    ));
    Req.Uri := TSparkleUtils.CombineUrlFast(Req.Uri, '$count');
    if Query <> '' then
      Req.Uri := Req.Uri + '?' + Query;
    Resp := DoSend(Req);
    if (Resp.StatusCode <> 200) then
      raise EXDataGetRequestException.Create(Req, Resp, Model);

    Result := StrToInt(TEncoding.UTF8.GetString(Resp.ContentAsBytes));
  finally
    Resp.Free;
    Req.Free;
  end;
end;

constructor TXDataClient.Create(AModel: TXDataAureliusModel);
begin
  FModel := AModel;
  if FModel = nil then
    FModel := TXDataAureliusModel.Default;
  FHttpClient := THttpClient.Create;
  FFactory := TXDataPayloadJsonFactory.Create(Self.Model, '');
  FReturnedEntities := TObjectList<TObject>.Create(true);
  FReturnedInstancesOwnership := TInstanceOwnership.Entities;
  FMaxEagerFetchDepth := TGlobalConfigs.GetInstance.MaxEagerFetchDepth;
  UpdateBasicAuth;
end;

function TXDataClient.CreateHttpRequest: THttpRequest;
begin
  Result := HttpClient.CreateRequest;
  Result.Headers.SetValue(XDataHeaderExpandLevel, IntToStr(MaxEagerFetchDepth));
  if BasicAuth <> '' then
    Result.Headers.SetValue('authorization', BasicAuth);
end;

procedure TXDataClient.Delete(Entity: TObject);
var
  Req: THttpRequest;
  Resp: THttpResponse;
begin
  Resp := nil;
  Req := CreateHttpRequest;
  try
    Req.Uri :=  RequestUrl(TSparkleUtils.PercentEncode(Model.CanonicalUrl(Entity)));
    Req.Method := 'DELETE';
    Resp := DoSend(Req);
    if (Resp.StatusCode <> 204) then
      raise EXDataGetRequestException.Create(Req, Resp, Model);
  finally
    Resp.Free;
    Req.Free;
  end;
end;

function TXDataClient.DeserializeValue(Deserializer: TJsonDeserializer;
  Reader: TJsonReader; const ATypeToken: TTypeToken): TValue;
var
  List: TValue;
begin
  // Special case due to backward compatibility. If it's a list,
  // then we will create it ourselves, instead of letting the deserializer to create it.
  // This way the list creation will not fire OnObjectCreated event and the list
  // will not be destroyed by the XDataClient/deserializer
  if Model.Explorer.IsValueList(ATypeToken.GetClass) then
  begin
    List := Model.Explorer.ObjectFactory.CreateInstance(ATypeToken.GetClass);
    try
      Deserializer.Read(Reader, List, ATypeToken);
      Result := List;
    except
      {$IFNDEF AUTOREFCOUNT}
      List.AsObject.Free;
      {$ENDIF}
      raise;
    end;
  end
  else
    Result := Deserializer.Read(Reader, ATypeToken);
end;

destructor TXDataClient.Destroy;
begin
  FHttpClient.Free;
  FFactory.Free;
  FReturnedEntities.Free;
  inherited;
end;

function TXDataClient.DoSend(Req: THttpRequest): THttpResponse;
begin
  Result := HttpClient.Send(Req);
end;

function TXDataClient.Get(Clazz: TClass; IdValue: TValue): TObject;
var
  Req: THttpRequest;
  Resp: THttpResponse;
begin
  {$IFNDEF DELPHITOKYO_LVL}
  Result := nil;
  {$ENDIF}
  Resp := nil;
  Req := CreateHttpRequest;
  try
    Req.Uri :=  RequestUrl(TSparkleUtils.PercentEncode(Model.CanonicalUrl(Clazz, IdValue)));
    Resp := DoSend(Req);
    if Resp.StatusCode = 200 then
    begin
      Result := ReadObjectResult(Req, Resp, Clazz).AsObject;
    end
    else
    if Resp.StatusCode = 404 then
      Result := nil
    else
      raise EXDataGetRequestException.Create(Req, Resp, Model);
  finally
    Resp.Free;
    Req.Free;
  end;
end;

function TXDataClient.Get<E, T>(Id: T): E;
begin
  Result := Get<E>(TValue.From<T>(Id));
end;

function TXDataClient.Get<E>(Id: TValue): E;
begin
  Result := E(Get(TClass(E), Id));
end;

function TXDataClient.GetReturnedEntities: TList<TObject>;
begin
  Result := FReturnedEntities;
end;

procedure TXDataClient.GetServiceInterface(TypeInfo: PTypeInfo; out Intf);
var
  V: TVirtualInterface;
  TypeData: PTypeData;
  Controller: TXDataController;
begin
  if TypeInfo.Kind <> tkInterface then
    raise EXDataInvalidServiceType.Create(TypeInfo);

  TypeData := GetTypeData(TypeInfo);
  if not (ifHasGuid in TypeData.IntfFlags) then
    raise EXDataServiceInterfaceWithoutGuid.Create(TypeInfo);

  Controller := Model.FindControllerByInterface(TypeInfo);
  if Controller = nil then
    raise EXDataInterfaceServiceNotFound.Create(TypeInfo);

  V := TVirtualInterface.Create(TypeInfo);
  if V.QueryInterface(TypeData.Guid, Intf) <> S_OK then
    raise EXDataVirtualInterfaceFailed.Create(TypeInfo);

  V.OnInvoke := procedure(Method: TRttiMethod; const Args: TArray<TValue>; out Result: TValue)
    var
      Invoker: TXDataInvoker;
      Action: TXDataAction;
      I: Integer;
    begin
      Action := nil;
      for I := 0 to Controller.Actions.Count - 1 do
        if SameText(Model.GetActionInfo(Controller.Actions[I]).Method.Name, Method.Name) then
        begin
          Action := Controller.Actions[I];
          break;
        end;
      if Action = nil then
        raise EXDataOperationNotFound.Create(Model.GetControllerInfo(Controller).InterfaceTypeName, Method.Name);

      Invoker := TXDataInvoker.Create(Self, Action);
      try
        Invoker.Execute(Args, Result);
      finally
        Invoker.Free;
      end;
    end;
end;

function TXDataClient.List(Clazz: TClass; const Query: string): TList<TObject>;
begin
  Result := List(Clazz, Query, TList<TObject>).AsType<TList<TObject>>;
end;

function TXDataClient.List(Clazz: TClass; const Query: string; ListClass: TClass): TValue;
var
  Req: THttpRequest;
  Resp: THttpResponse;
  EntityType: TXDataEntityType;
begin
  EntityType := Model.GetEntityTypeByClass(Clazz);
  Result := nil;
  Resp := nil;
  Req := CreateHttpRequest;
  try
    Req.Uri :=  RequestUrl(TSparkleUtils.PercentEncode(
      Model.EntitySetUrl(Model.DefaultEntitySet(EntityType))
    ));
    if Query <> '' then
      Req.Uri := Req.Uri + '?' + Query;
    Resp := DoSend(Req);
    if (Resp.StatusCode <> 200) then
      raise EXDataGetRequestException.Create(Req, Resp, Model);

    Result :=
      ReadObjectResult(Req, Resp,
        TTypeToken.Create(ListClass.ClassInfo, Clazz.ClassInfo)
      );
  finally
    Resp.Free;
    Req.Free;
  end;
end;

function TXDataClient.List<E>(const Query: string): TList<E>;
begin
  Result := List(TClass(E), Query, TList<E>).AsType<TList<E>>;
end;

procedure TXDataClient.Merge(Entity: TObject);
var
  Req: THttpRequest;
  Resp: THttpResponse;
  Clazz: TClass;
  EntityType: TXDataEntityType;
begin
  Clazz := Entity.ClassType;
  EntityType := Model.GetEntityTypeByClass(Clazz);
  Resp := nil;
  Req := CreateHttpRequest;
  try
    Req.Uri :=  RequestUrl(TSparkleUtils.PercentEncode(Model.CanonicalUrl(Entity)));
    Req.Method := 'MERGE';
    WriteInstanceBody(Entity, Req, EntityType);
    Resp := DoSend(Req);
    if (Resp.StatusCode <> 200) and (Resp.StatusCode <> 201) then
      raise EXDataGetRequestException.Create(Req, Resp, Model);

    // Get id xdata.server.module
    if Resp.StatusCode = 201 then
      SetIdFromResponse(Entity, Req, Resp);
  finally
    Resp.Free;
    Req.Free;
  end;
end;

procedure TXDataClient.Post(Entity: TObject);
var
  Req: THttpRequest;
  Resp: THttpResponse;
  Clazz: TClass;
  EntityType: TXDataEntityType;
begin
  Clazz := Entity.ClassType;
  EntityType := Model.GetEntityTypeByClass(Clazz);
  Resp := nil;
  Req := CreateHttpRequest;
  try
    Req.Uri :=  RequestUrl(TSparkleUtils.PercentEncode(
      Model.EntitySetUrl(Model.DefaultEntitySet(EntityType))
    ));
    Req.Method := 'POST';
    WriteInstanceBody(Entity, Req, EntityType);
    Resp := DoSend(Req);
    if (Resp.StatusCode <> 201) then
      raise EXDataGetRequestException.Create(Req, Resp, Model);

    // Get id xdata.server.module
    SetIdFromResponse(Entity, Req, Resp);

//    ReadInstanceResult(Entity, Resp, EntityType);
  finally
    Resp.Free;
    Req.Free;
  end;
end;

procedure TXDataClient.Put(Entity: TObject);
var
  Req: THttpRequest;
  Resp: THttpResponse;
  Clazz: TClass;
  EntityType: TXDataEntityType;
begin
  Clazz := Entity.ClassType;
  EntityType := Model.GetEntityTypeByClass(Clazz);
  Resp := nil;
  Req := CreateHttpRequest;
  try
    Req.Uri :=  RequestUrl(TSparkleUtils.PercentEncode(Model.CanonicalUrl(Entity)));
    Req.Method := 'PUT';
    WriteInstanceBody(Entity, Req, EntityType);
    Resp := DoSend(Req);
    if (Resp.StatusCode <> 200) then
      raise EXDataGetRequestException.Create(Req, Resp, Model);
  finally
    Resp.Free;
    Req.Free;
  end;
end;

function TXDataClient.ReadObjectResult(Req: THttpRequest; Resp: THttpResponse;
  ResultToken: TTypeToken): TValue;
var
  Deserializer: TXDataJsonClientDeserializer;
  JReader: TJsonReader;
  JName: string;
begin
  Result := nil;
  Deserializer := nil;
  JReader := TJsonReader.Create(Resp.ContentAsStream);
  try
    Deserializer := TXDataJsonClientDeserializer.Create(Model, TClientReferenceSolver.Create(Self));
    if IgnoreUnknownProperties then
      Deserializer.SetUnknownMemberHandling(TUnknownMemberHandling.Ignore);
    Deserializer.OnObjectCreated := ReturnedEntityCreated;

    if not ResultToken.IsClass or Model.Explorer.IsValueList(ResultToken.GetClass) then
    begin
      if Resp.StatusCode = 404 then
        raise EXDataOperationRequestException.Create(Req, Resp, Model);
      JReader.ReadBeginObject;
      while JReader.HasNext do
      begin
        JName := JReader.ReadName;
        if JName = JsonResultValue then
          Result := DeserializeValue(Deserializer, JReader, ResultToken)
        else
          JReader.SkipValue;
      end;
      JReader.ReadEndObject;
    end
    else
    begin
      if Resp.StatusCode = 404 then
        Result := nil
      else
        Result := DeserializeValue(Deserializer, JReader, ResultToken);
    end;
  finally
    Deserializer.Free;
    JReader.Free;
  end;
end;

function TXDataClient.RequestUrl(const RelativeUrl: string): string;
begin
  Result := TXDataUtils.CombineUrlFast(Self.Uri, RelativeUrl);
end;

procedure TXDataClient.ReturnedEntityCreated(AObject: TObject);
begin
  FReturnedEntities.Add(AObject);
end;

function TXDataClient.Service<T>: T;
begin
  GetServiceInterface(TypeInfo(T), Result);
end;

procedure TXDataClient.SetIdFromResponse(Entity: TObject;
  Req: THttpRequest; Resp: THttpResponse);
var
  Uri: TUri;
  Len: integer;
  IdValue: Variant;
  Clazz: TClass;
  EntityType: TEntityType;
begin
  if not Resp.Headers.Exists('location') then
    raise EXDataMissingLocationHeader.Create(Req.Uri);

  Clazz := Entity.ClassType;
  EntityType := Model.Explorer.EntityTypeFromClass(Clazz);
  Uri := TUri.Create(Resp.Headers.Get('location'));
  try
    Len := Length(Uri.Segments);
    if Len = 0 then
      raise EXDataInvalidLocationHeader.Create(Req.Uri, Resp.Headers.Get('location'));
    Model.ParseCanonicalUrl(Uri.Segments[Len - 1], Clazz, IdValue);
  finally
    Uri.Free;
  end;

  // If the server generates the id, the set it now
  if not EntityType.SafeId.IsUserAssignedId then
    EntityType.SetIdValue(Entity, IdValue);
end;

procedure TXDataClient.SetPassword(const Value: string);
begin
  FPassword := Value;
  UpdateBasicAuth;
end;

procedure TXDataClient.SetReturnedInstancesOwnership(const Value: TInstanceOwnership);
begin
  FReturnedInstancesOwnership := Value;
  FReturnedEntities.OwnsObjects := ReturnedInstancesOwnership <> TInstanceOwnership.None;
end;

procedure TXDataClient.SetUserName(const Value: string);
begin
  FUserName := Value;
  UpdateBasicAuth;
end;

procedure TXDataClient.UpdateBasicAuth;
begin
  if (UserName <> '') and (Password <> '') then
    FBasicAuth := TSparkleUtils.BasicAuthHeaderValue(UserName, Password)
  else
    FBasicAuth := '';
end;

procedure TXDataClient.WriteInstanceBody(AObject: TObject; Req: THttpRequest;
  AType: TXDataEntityType);
var
  JWriter: TJsonWriter;
  Serializer: TXDataJsonClientSerializer;
  Stream: TBytesStream;
begin
  JWriter := nil;
  Serializer := nil;
  Stream := TBytesStream.Create;
  try
    JWriter := TJsonWriter.Create(Stream);
    Serializer := TXDataJsonClientSerializer.Create(Self.Model);
    Serializer.ForceProxyLoading := Self.ForceProxyLoading;
    Serializer.ForceBlobLoading := Self.ForceBlobLoading;
    Serializer.Write(AObject, Model.GetEntityTypeInfo(AType).Clazz, JWriter);
    JWriter.Flush;
    Req.SetContent(Copy(Stream.Bytes, 0, Stream.Size));
  finally
    Serializer.Free;
    JWriter.Free;
    Stream.Free;
  end;
end;

{ TClientReferenceSolver }

constructor TClientReferenceSolver.Create(AClient: TXDataClient);
begin
  FClient := AClient;
end;

function TClientReferenceSolver.SolveBlob(const Ref: string; RttiInfo: TRttiOptimization): TArray<byte>;
var
  Resp: THttpResponse;
  Req: THttpRequest;
begin
  Resp := nil;
  Req := Client.CreateHttpRequest;
  try
    Req.Uri := Client.RequestUrl(Ref);

    Resp := Client.DoSend(Req);
    if (Resp.StatusCode <> 200) and (Resp.StatusCode <> 204) then
      raise EXDataOperationRequestException.Create(Req, Resp, Client.Model);

    Result := Resp.ContentAsBytes;
  finally
    Resp.Free;
    Req.Free;
  end;
end;

function TClientReferenceSolver.SolveReference(const Ref: string; RttiInfo: TRttiOptimization; ADepth: integer): TObject;
var
  Resp: THttpResponse;
  Req: THttpRequest;
  ResultClass: TClass;
begin
  Result := nil;
  if ADepth > FClient.MaxEagerFetchDepth then Exit;

  Resp := nil;
  Req := Client.CreateHttpRequest;
  try
    Req.Uri := Client.RequestUrl(Ref);

    Resp := Client.DoSend(Req);

    if (Resp.StatusCode <> 200) then
      raise EXDataOperationRequestException.Create(Req, Resp, Client.Model);

    ResultClass := RttiInfo.RealType.AsInstance.MetaclassType;
    Result := Client.ReadObjectResult(Req, Resp, ResultClass).AsObject;
  finally
    Resp.Free;
    Req.Free;
  end;
end;

{ TXDataInvoker }

function TXDataInvoker.GetPathParamValues(Args: TArray<TValue>): TStringDynArray;
var
  I: Integer;
  Param: TXDataParamDef;
  ParamIndex: Integer;
begin
  ParamIndex := 0;
  SetLength(Result, Action.Parameters.Count);
  for I := 0 to Action.Parameters.Count - 1 do
    if Action.Parameters[I].BindingMode = TBindingMode.FromPath then
    begin
      Param := Action.Parameters[I];
      if Param.Input and (I <= Length(Args)) then
      begin
        Result[ParamIndex] :=
          TBclUtils.PercentEncode(
            BindValueToUrl(Args[I + 1], Param.RttiType.Handle, Param.UrlConverter)
          );
        Inc(ParamIndex);
      end;
    end;
  Result := Copy(Result, 0, ParamIndex);
end;

function TXDataInvoker.BuildUrlRoute(Args: TArray<TValue>): string;
var
  PathParamValues: TStringDynArray;
  UsedParamValues: array of Boolean;

  procedure AddRouteSegments(RouteInfo: TXDataRouteInfo);
  var
    I: Integer;
  begin
    for I := 0 to RouteInfo.SegmentCount - 1 do
    begin
      if RouteInfo.Segments[I].IsParam then
      begin
        // Segment is a path param
        if RouteInfo.Segments[I].ParamIndex < Length(PathParamValues) then
          Result := Result + PathParamValues[RouteInfo.Segments[I].ParamIndex]
        else
          raise EXDataWrongRouteParams.Create(Action);
        UsedParamValues[RouteInfo.Segments[I].ParamIndex] := True;
      end
      else
        Result := Result + RouteInfo.Segments[I].Value;
      Result := Result + '/';
    end;
  end;

var
  I: Integer;
begin
  PathParamValues := GetPathParamValues(Args);
  SetLength(UsedParamValues, Length(PathParamValues));
  Result := '';

  AddRouteSegments(Action.RouteInfo);

  for I := 0 to Length(UsedParamValues) - 1 do
    if not UsedParamValues[I] then
      Result := Result + PathParamValues[I] + '/';
end;

function TXDataInvoker.BuildQueryString(Args: TArray<TValue>): string;
var
  QueryString: string;

  procedure WriteQueryParam(const Name, Value: string);
  begin
    if QueryString <> '' then
      QueryString := QueryString + '&';
    QueryString := QueryString + TSparkleUtils.PercentEncode(Name) +
      '=' + TSparkleUtils.PercentEncode(Value);
  end;

  procedure WriteObjectToQuery(Obj: TObject; AType: TXDataStructuredType);
  var
    I: Integer;
    Prop: TXDataScalarProperty;
    Value: TValue;
    PropInfo: TXDataAureliusPropInfo;
  begin
    if Obj = nil then Exit;
    
    for I := 0 to AType.ScalarPropertyCount - 1 do
    begin
      Prop := AType.GetScalarProperty(I);
      PropInfo := Model.GetScalarPropertyInfo(Prop);
      Value := TRttiUtils.GetInstance.GetValue(PropInfo.RttiInfo.MemberRef, Obj);
      WriteQueryParam(Prop.Name,
        BindValueToUrl(Value, PropInfo.RttiInfo.RealType.Handle, Prop.UrlConverter));
    end;
  end;

var
  I: Integer;
  Param: TXDataParamDef;
begin
  // set query string (parameters that are defined to be in uri query string)
  QueryString := '';
  for I := 0 to Action.Parameters.Count - 1 do
    if Action.Parameters[I].BindingMode = TBindingMode.FromURI then
    begin
      Param := Action.Parameters[I];
      if Param.Input and (I <= Length(Args)) then
      begin
        if Param.ParamType is TXDataStructuredType then
        begin
          Assert(Args[I + 1].IsObject);
          WriteObjectToQuery(Args[I + 1].AsObject, TXDataStructuredType(Param.ParamType));
        end
        else
          WriteQueryParam(Param.Name, BindValueToUrl(Args[I + 1], Param.RttiType.Handle, Param.UrlConverter));
      end;
    end;
  if QueryString <> '' then
    QueryString := '?' + QueryString;

  Result := QueryString;
end;

constructor TXDataInvoker.Create(AClient: TXDataClient; AAction: TXDataAction);
begin
  FClient := AClient;
  FAction := AAction;
end;

function TXDataInvoker.CreateHttpRequest: THttpRequest;
begin
  Result := FClient.CreateHttpRequest;
end;

function TXDataInvoker.DeserializeValue(Deserializer: TJsonDeserializer;
  Reader: TJsonReader; const ATypeToken: TTypeToken): TValue;
begin
  Result := FClient.DeserializeValue(Deserializer, Reader, ATypeToken);
end;

function TXDataInvoker.DoSend(Req: THttpRequest): THttpResponse;
begin
  Result := FClient.DoSend(Req);
end;

procedure TXDataInvoker.Execute(const Args: TArray<TValue>; out Result: TValue);
var
  Req: THttpRequest;
  Resp: THttpResponse;
  QueryString: string;
begin
  // check number of parameters
  // note that first item in Args array is not the parameter, but instead always the interface pointer
  if Action.Parameters.Count <> Length(Args) - 1 then
    raise EXDataWrongParameterCount.Create(Action, Length(Args) - 1);

  Resp := nil;
  Req := CreateHttpRequest;
  try
    // Set request uri, method and other parameters before setting message body
    // TODO: Later Uri must be defined based on a more advanced routing system
    QueryString := BuildQueryString(Args);
    Req.Uri := BuildUrlRoute(Args);
    Req.Uri := Req.Uri + QueryString;
    Req.Uri := RequestUrl(Req.Uri);
    Req.Method := Action.HttpMethod;

    if Action.IsParamStream then
      SetParamStreamBody(Req, Args, Action.ParamStreamIndex)
    else
    if Action.BodyParamCount > 0 then
    begin
      // Set content (parameters that are defined to be in the message body)
      // Check for special case: single parameter object and list. Server-side equivalent code for this is
      // in XData.Payload.Json.Reader unit: TJsonParamsReader.ReadParams method
      // Check there if you change something here.
      if (Action.BodyParamCount = 1) and Action.BodyParams[0].RttiType.IsInstance then
        SetJsonObjectBody(Req, Args)
      else
        SetJsonParamsBody(Req, Args);
    end;

    Resp := DoSend(Req);

    // check errors
    if (Resp.StatusCode <> 200) and (Resp.StatusCode <> 204) and (Resp.StatusCode <> 404)
      and (Resp.StatusCode <> 201) then
      raise EXDataOperationRequestException.Create(Req, Resp, Model);

    // has content
    if Action.IsResultStream then
    begin
      if Resp.StatusCode = 404 then
        raise EXDataOperationRequestException.Create(Req, Resp, Model);
      Result := TBytesStream.Create(Resp.ContentAsBytes);
    end
    else
    if Action.IsResultCriteria then
    begin
      raise EXDataClientException.Create('TCriteria result yet not supported in TXDataClient');
    end
    else
    if (Model.GetActionInfo(Action).ReturnType <> nil) or Action.HasOutputParams then
    begin
      if (Resp.StatusCode <> 204) then
        ReadActionResult(Req, Resp, Action, Result, Args);
    end else
    if Resp.StatusCode = 404 then
      raise EXDataOperationRequestException.Create(Req, Resp, Model);
  finally
    Req.Free;
    Resp.Free;
  end;
end;

function TXDataInvoker.ForceBlobLoading: Boolean;
begin
  Result := FClient.ForceBlobLoading;
end;

function TXDataInvoker.ForceProxyLoading: Boolean;
begin
  Result := FClient.ForceProxyLoading;
end;

function TXDataInvoker.Model: TXDataAureliusModel;
begin
  Result := FClient.Model;
end;

procedure TXDataInvoker.ReadActionResult(Req: THttpRequest; Resp: THttpResponse;
  Action: TXDataAction; var ResultValue: TValue; const Args: TArray<TValue>);
var
  Deserializer: TXDataJsonClientDeserializer;
  JReader: TJsonReader;
  JName: string;
  ResultPropName: string;
  ParamIndex: Integer;
  ReturnType: TRttiType;
begin
  Deserializer := nil;
  JReader := TJsonReader.Create(Resp.ContentAsStream);
  try
    Deserializer := TXDataJsonClientDeserializer.Create(Model, TClientReferenceSolver.Create(FClient));
    if FClient.IgnoreUnknownProperties then
      Deserializer.SetUnknownMemberHandling(TUnknownMemberHandling.Ignore);
    Deserializer.OnObjectCreated := ReturnedEntityCreated;

    ReturnType := Model.GetActionInfo(Action).ReturnType;
    if Action.IsResultSingleObject
      and not Model.Explorer.IsValueList(ReturnType.AsInstance.MetaclassType)
      and not Action.HasOutputParams then
    begin
      // Special case: a single object being returned and it's not a list
      // then deserialize the object directly.
      // See XData.Payload.Json.Writer.TJsonResultWriter.WriteResult if you change this
      if Resp.StatusCode = 404 then
        ResultValue := nil
      else
        ResultValue := DeserializeValue(Deserializer, JReader, ReturnType.Handle);
    end
    else
    begin
      if Resp.StatusCode = 404 then
        raise EXDataOperationRequestException.Create(Req, Resp, Model);
      if Action.HasOutputParams then
        ResultPropName := JsonResultParam // "result"
      else
        ResultPropName := JsonResultValue; // "value"

      JReader.ReadBeginObject;
      while JReader.HasNext do
      begin
        JName := JReader.ReadName;
        if JName = ResultPropName then
        begin
          if ReturnType <> nil then
            ResultValue := DeserializeValue(Deserializer, JReader, ReturnType.Handle)
          else
            JReader.SkipValue;
        end
        else
        begin
          ParamIndex := Action.IndexOfParameter(JName);
          if ParamIndex >= 0 then
            Args[ParamIndex + 1] := DeserializeValue(Deserializer, JReader, Action.Parameters[ParamIndex].RttiType.Handle)
          else
            JReader.SkipValue;
        end;
      end;
      JReader.ReadEndObject;
    end;
  finally
    Deserializer.Free;
    JReader.Free;
  end;
end;

function TXDataInvoker.RequestUrl(const RelativeUrl: string): string;
begin
  Result := FClient.RequestUrl(RelativeUrl);
end;

procedure TXDataInvoker.ReturnedEntityCreated(AObject: TObject);
begin
  FClient.ReturnedEntityCreated(AObject);
end;

procedure TXDataInvoker.SetJsonObjectBody(Req: THttpRequest; const Args: TArray<TValue>);
var
  JWriter: TJsonWriter;
  Stream: TBytesStream;
  Serializer: TXDataJsonClientSerializer;
begin
  Assert(Action.BodyParamCount = 1);
  JWriter := nil;
  Serializer := nil;
  Stream := TBytesStream.Create;
  try
    JWriter := TJsonWriter.Create(Stream);
    Serializer := TXDataJsonClientSerializer.Create(Self.Model);
    Serializer.ForceProxyLoading := Self.ForceProxyLoading;
    Serializer.ForceBlobLoading := Self.ForceBlobLoading;
    Serializer.Write(
      Args[Action.BodyParams[0].Index + 1].AsObject,
      Action.BodyParams[0].RttiType.AsInstance.MetaclassType,
      JWriter
    );
    JWriter.Flush;
    Req.SetContent(Copy(Stream.Bytes, 0, Stream.Size));
  finally
    Serializer.Free;
    JWriter.Free;
    Stream.Free;
  end;
end;

procedure TXDataInvoker.SetJsonParamsBody(Req: THttpRequest; const Args: TArray<TValue>);
var
  JWriter: TJsonWriter;
  Stream: TBytesStream;
  I: integer;
  Param: TXDataParamDef;
  Serializer: TXDataJsonClientSerializer;
begin
  JWriter := nil;
  Serializer := nil;
  Stream := TBytesStream.Create;
  try
    JWriter := TJsonWriter.Create(Stream);
    Serializer := TXDataJsonClientSerializer.Create(Self.Model);
    Serializer.ForceProxyLoading := Self.ForceProxyLoading;
    Serializer.ForceBlobLoading := Self.ForceBlobLoading;

    JWriter.WriteBeginObject;
    for I := 0 to Action.Parameters.Count - 1 do
      if Action.Parameters[I].BindingMode = TBindingMode.FromBody then
      begin
        Param := Action.Parameters[I];
        if Param.Input and (I <= Length(Args)) then
        begin
          JWriter.WriteName(Param.Name);
          Serializer.Write(Args[I + 1], Param.RttiType.Handle, JWriter);
        end;
      end;

    JWriter.WriteEndObject;
    JWriter.Flush;
    Req.SetContent(Copy(Stream.Bytes, 0, Stream.Size));
  finally
    Serializer.Free;
    JWriter.Free;
    Stream.Free;
  end;
end;

procedure TXDataInvoker.SetParamStreamBody(Req: THttpRequest;
  const Args: TArray<TValue>; ArgIndex: Integer);
var
  BytesStream: TBytesStream;
begin
  BytesStream := TBytesStream.Create;
  try
    BytesStream.CopyFrom(Args[ArgIndex + 1].AsType<TStream>, 0);
    BytesStream.SetSize(BytesStream.Size);
    Req.SetContent(BytesStream.Bytes);
  finally
    BytesStream.Free;
  end;
end;

{ EXDataWrongRouteParams }

constructor EXDataWrongRouteParams.Create(Action: TXDataAction);
begin
  inherited CreateFmt('Invalid number of route params for Operation "%s". ' +
    'Route params: %d, Path params: %d',
    [Action.OperationId, Action.RouteInfo.ParamCount, Action.PathParamCount]);
end;

end.
