unit XData.Server.Module;

{$I XData.inc}

interface

uses
  Generics.Collections, Classes, SysUtils, System.Rtti, System.TypInfo,
  Bcl.Collections, Bcl.Json,
  Aurelius.Criteria.Base,
  Aurelius.Drivers.Interfaces,
  Aurelius.Engine.ObjectManager,
  Aurelius.Mapping.Explorer,
  Aurelius.Types.Blob,
  Sparkle.HttpServer.Context,
  Sparkle.Security,
  Sparkle.Uri,
  XData.Security.Interfaces,
  XData.Aurelius.CriteriaBuilder,
  XData.Aurelius.Model,
  XData.Json.Converter,
  XData.Json.Solver,
  XData.Module.Base,
  XData.Module.Events,
  XData.Module.QueryInfo,
  XData.Model.Classes,
  XData.Query,
  XData.Payload.Factory,
  XData.Module.ResourceInfo,
  XData.Service.Common;

type
  TXDataServerModule = class;

  TActionResultDestruction = (AllButLists, RootOnly);

  TXDataRequestHandler = class(TXDataBaseRequestHandler)
  private
    FManagedObjects: THashSet<TObject>;
    FActionResultDestruction: TActionResultDestruction;
    FQueryInfos: TList<TXDataQueryInfo>;
    FManagers: TObjectSet<TObjectManager>;
    function GetXModule: TXDataServerModule;
    function GetXModel: TXDataAureliusModel;
    procedure SerializeCriteria(Criteria: TCriteria; Objects: THashSet<TObject>; FireEvents: Boolean);
  strict private
    procedure CheckSinglePath; inline;
    procedure DestroyIfNotInManagers(Entity: TObject; Managers: TObjectSet<TObjectManager>);
    procedure SerializeEntity(const Entity: TObject; BaseType: TXDataEntityType);
    procedure DeserializeEntity(Entity: TObject; BaseType: TXDataEntityType;
      Manager: TObjectManager; Operation: TProc<TObject>);
    function GetEntityFromNavigationPath(const Manager: TObjectManager): TObject;
    procedure GetEntityInfoFromPath(out IdValue: Variant; out AClass: TClass);
    function GetNavigationPropertyList(Entity: TObject): IObjectList;
    procedure UpdateCriteria(const Criteria: TCriteria);
    procedure SetResponseLocationHeader(Entity: TObject);
    function GetConnectionPool: IDBConnectionPool;
    function Events: TXDataModuleEvents;
    procedure NotifyEntityModified(Entity: TObject);
    procedure NotifyEntityModifying(Entity: TObject);
    procedure NotifyEntityGet(Entity: TObject);
    procedure NotifyEntityDeleted(Entity: TObject);
    procedure NotifyEntityDeleting(Entity: TObject);
    procedure NotifyEntityInserted(Entity: TObject);
    procedure NotifyEntityInserting(Entity: TObject);
    procedure NotifyEntityList(Criteria: TCriteria);
    procedure NotifyManagerCreate(var Manager: TObjectManager);
  strict protected
    procedure HandleException(const E: Exception); override;
    function HasPermission(Action: TXDataAction): Boolean; overload; override;
  protected
    function CreateSolver: IJsonReferenceSolver;
    function CreateExpander(AClass: TClass): IJsonExpander;
    function PayloadFactory: TXDataPayloadFactory; override;
    function HasPermission(User: IUserIdentity; Requirements: TList<IAuthorizationRequirement>): Boolean; overload;
    procedure DoFlush(Manager: TObjectManager; AEntity: TObject);
    procedure CleanUp; override;
    function CreateInstance(AClass: TClass): TObject;
    function CurrentManager: TObjectManager;
    function InternalCreateManager(Connection: IDBConnection; Explorer: TMappingExplorer): TObjectManager;
    function GetQueryInfo(AContextType: TXDataEntityType): TXDataQueryInfo;
    procedure CheckAcceptApplicationType;
  strict protected
    // "Event" methods that are called in key points of request processing
    // giving opportunity for descendents to change data and/or abort processing
    procedure OnEntityCreate(Manager: TObjectManager; Entity: TObject); virtual;
    procedure OnEntityReplicate(Manager: TObjectManager; Entity: TObject); virtual;
    procedure OnEntityDelete(Manager: TObjectManager; AClass: TClass; IdValue: Variant); virtual;
    procedure OnEntityUpdate(Manager: TObjectManager; Entity: TObject); virtual;
    procedure OnEntityUpsert(Manager: TObjectManager; Entity: TObject); virtual;
    procedure OnEntityRetrieve(Manager: TObjectManager; Entity: TObject); virtual;
    procedure OnEntityMerge(Manager: TObjectManager; Entity: TObject); virtual;
    procedure OnBeforeEntityUpsert(Manager: TObjectManager; AClass: TClass; IdValue: Variant); virtual;
    procedure OnBeforeEntityUpdate(Manager: TObjectManager; AClass: TClass; IdValue: Variant); virtual;
    procedure OnBeforeEntityMerge(Manager: TObjectManager; Entity: TObject); virtual;
    procedure OnCollectionRetrieve(Manager: TObjectManager; Entity: TObject; Collection: IObjectList); virtual;
    procedure OnEntitySetRetrieve(Manager: TObjectManager; Criteria: TCriteria); virtual;
    procedure OnPrimitivePropertyRetrieve(Manager: TObjectManager; Entity: TObject; Prop: TXDataSimpleProperty); virtual;
    procedure OnValueRetrieve(Manager: TObjectManager; Entity: TObject; Prop: TXDataSimpleProperty; var Value: TValue); virtual;
    procedure OnStreamPropertyRetrieve(Manager: TObjectManager; Entity: TObject; Prop: TXDataSimpleProperty); virtual;
    procedure OnStreamPropertyUpdate(Manager: TObjectManager; Entity: TObject; Prop: TXDataSimpleProperty; var Blob: TBlob); virtual;
  strict protected
    procedure RetrieveEntitySet; override;
    procedure RetrieveEntity; override;
    procedure RetrievePrimitiveProperty; override;
    procedure RetrieveCollectionProperty; override;
    procedure RetrieveValue; override;
    procedure RetrieveStreamProperty; override;
    procedure RetrieveEntitySchema; override;

    procedure CreateCollectionPropertyItem; override;

    procedure CreateEntity; override;
    procedure UpdateEntity; override;
    procedure MergeEntity; override;
    procedure DeleteEntity; override;
    procedure UpsertEntity; override;
    procedure ReplicateEntity; override;

    procedure UpdateStreamProperty; override;
    procedure DeleteStreamProperty; override;

    procedure ExecuteAction; override;
  public
    constructor Create(const AModule: TXDataBaseModule; const AHttpContext: THttpServerContext); override;
    destructor Destroy; override;
    procedure AddManager(AManager: TObjectManager);
    function AbsoluteUrl(const RelativeUrl: string): string;
    property XModel: TXDataAureliusModel read GetXModel;
    property ConnectionPool: IDBConnectionPool read GetConnectionPool;
    property XModule: TXDataServerModule read GetXModule;
    property ManagedObjects: THashSet<TObject> read FManagedObjects;
    property ActionResultDestruction: TActionResultDestruction read FActionResultDestruction write FActionResultDestruction;
  end;

  TSwaggerAuthMode = (None, Jwt);

  TSwaggerOptions = class
  private
    FAuthMode: TSwaggerAuthMode;
  public
    property AuthMode: TSwaggerAuthMode read FAuthMode write FAuthMode;
  end;

  TSwaggerUIExpansion = (List, None, Full);

  TSwaggerUIOptions = class
  private
    FDocExpansion: TSwaggerUIExpansion;
    FShowFilter: Boolean;
  public
    property ShowFilter: Boolean read FShowFilter write FShowFilter;
    property DocExpansion: TSwaggerUIExpansion read FDocExpansion write FDocExpansion;
  end;

  TGetAbsoluteUrlEvent = reference to procedure(const Schema, Authority, Path, RelativeUrl: string; var Url: string);

  TXDataServerModule = class(TXDataBaseModule)
  strict private
    FConnectionPool: IDBConnectionPool;
    FSingleConnection: IDBConnection;
    FPayloadFactories: array[TXDataPayloadFormat] of TXDataPayloadFactory;
    FEvents: TXDataModuleEvents;
    FSwaggerOptions: TSwaggerOptions;
    FSwaggerUIOptions: TSwaggerUIOptions;
    FOnGetAbsoluteUrl: TGetAbsoluteUrlEvent;
    function GetXModel: TXDataAureliusModel;
    procedure ImportServiceImplementations;
    procedure AddServiceImplementation(RttiType: TRttiInstanceType); overload;
    procedure AddImplementationForInterface(RttiType: TRttiInstanceType; IntfType: TRttiInterfaceType);
  protected
    function GetPayloadFactory(const C: TXDataBaseRequestHandler): TXDataPayloadFactory; override;
    procedure DoGetAbsoluteUrl(const Schema, Authority, Path, RelativeUrl: string; var Url: string);
    function HasPermission(Permission: TEntitySetPermission; EntitySet: TXDataEntitySet): Boolean; overload; override;
  strict protected
    function CreateBaseHandler(const C: THttpServerContext): TXDataBaseRequestHandler; override; final;
    function CreateHandler(const C: THttpServerContext): TXDataRequestHandler; virtual;
    function GetDefaultModel: TXDataAureliusModel; virtual;
  public
    constructor Create(const ABaseUrl: string); overload;
    constructor Create(const ABaseUrl: string; AModel: TXDataAureliusModel); overload;
    constructor Create(const ABaseUrl: string; AConnection: IDBConnection); overload;
    constructor Create(const ABaseUrl: string; AConnection: IDBConnection; AModel: TXDataAureliusModel); overload;
    constructor Create(const ABaseUrl: string; AConnectionPool: IDBConnectionPool); overload;
    constructor Create(const ABaseUrl: string; AConnectionPool: IDBConnectionPool; AModel: TXDataAureliusModel); overload;
    destructor Destroy; override;
    function HasEndpoint(Permission: TEntitySetPermission; EntitySet: TXDataEntitySet): Boolean;
    procedure AddServiceImplementation(AClass: TClass); overload;
    property Events: TXDataModuleEvents read FEvents;
    property ConnectionPool: IDBConnectionPool read FConnectionPool;
    property XModel: TXDataAureliusModel read GetXModel;
    property SwaggerOptions: TSwaggerOptions read FSwaggerOptions;
    property SwaggerUIOptions: TSwaggerUIOptions read FSwaggerUIOptions;
    property OnGetAbsoluteUrl: TGetAbsoluteUrlEvent read FOnGetAbsoluteUrl write FOnGetAbsoluteUrl;
  end;

  TXDataOperationContext = class
  strict private
    class threadvar _Context: TXDataOperationContext;
  strict private
    FConnectionPool: IDBConnectionPool;
    {$IFDEF AUTOREFCOUNT}[Weak]{$ENDIF}
    FHandler: TXDataRequestHandler;
  private
    FManager: TObjectManager;
    FConnection: IDBConnection;
    class procedure SetCurrent(const Value: TXDataOperationContext);
    class procedure FreeContext;
  protected
    constructor Create(AConnectionPool: IDBConnectionPool;
      AHandler: TXDataRequestHandler); reintroduce;
  public
    class function Current: TXDataOperationContext;
    function GetConnectionPool: IDBConnectionPool;
    function Connection: IDBConnection;
    function GetManager: TObjectManager;
    function CreateManager: TObjectManager; overload;
    function CreateManager(Connection: IDBConnection): TObjectManager; overload;
    function CreateManager(Connection: IDBConnection; Explorer: TMappingExplorer): TObjectManager; overload;
    function CreateManager(Explorer: TMappingExplorer): TObjectManager; overload;
    function CreateCriteria<T: class>(Query: TXDataQuery; BaseClass: TClass = nil): TCriteria<T>; overload;
    function CreateCriteria<T: class>(Manager: TObjectManager; Query: TXDataQuery; BaseClass: TClass = nil): TCriteria<T>; overload;
    function CreateCriteria<T: class>(Manager: TObjectManager; Query: TXDataQuery;
      Model: TXDataAureliusModel; BaseClass: TClass = nil): TCriteria<T>; overload;
    function CreateCriteria<T: class>(Manager: TObjectManager; Query: TXDataQuery;
      Model: TXDataAureliusModel; BaseType: TXDataStructuredType): TCriteria<T>; overload;
    procedure AddManager(AManager: TObjectManager);
    function Request: THttpServerRequest;
    function Response: THttpServerResponse;
    function Handler: TXDataRequestHandler;
  end;

  TActionExecuter = class
  strict private
    FHandler: TXDataRequestHandler;
    FActionSelection: TXDataActionSelection;
    property Handler: TXDataRequestHandler read FHandler;
    function XModel: TXDataAureliusModel;
    function Request: THttpServerRequest;
    function Response: THttpServerResponse;
    function ManagedObjects: THashSet<TObject>;
    function GetAction: TXDataAction;
    function GetActionInfo: TXDataAureliusActionInfo;
  strict private
    function CreateServiceInterface: TValue;
    procedure ReadQueryParams(Params: IXDataActionParams);
    procedure ReadPathParams(PathParams: TList<string>; Params: IXDataActionParams);
    procedure ReadBodyParams(Params: IXDataActionParams);
    procedure ReadStreamParam(Params: IXDataActionParams);
    function BuildArgs(Params: IXDataActionParams): TArray<TValue>;
    procedure SendStreamResult(Stream: TStream);
    procedure SendCriteriaResult(Criteria: TCriteria);
    procedure SendResult(const ResultValue: TValue; const Args: TArray<TValue>);
  public
    procedure Execute;
    constructor Create(AHandler: TXDataRequestHandler; AActionSelection: TXDataActionSelection);
    property Action: TXDataAction read GetAction;
    property ActionInfo: TXDataAureliusActionInfo read GetActionInfo;
  end;

  TXDataPutMode = XData.Module.Base.TXDataPutMode;
  TXDataPostMode = XData.Module.Base.TXDataPostMode;
  TXDataFlushMode = XData.Module.Base.TXDataFlushMode;
  TXDataRoutingPrecedence = XData.Module.Base.TXDataRoutingPrecedence;
  TEntitySetPermission = XData.Module.Base.TEntitySetPermission;
  TEntitySetPermissions = XData.Module.Base.TEntitySetPermissions;
  TInstanceRefSerialization = XData.Module.Base.TInstanceRefSerialization;
  TInstanceTypeSerialization = XData.Module.Base.TInstanceTypeSerialization;
  TUnknownMemberHandling = XData.Module.Base.TUnknownMemberHandling;

  IXDataAuthorizationContext = interface(IAuthorizationContext)
  ['{102916A3-9259-44B7-A746-8817CAC302CE}']
    function GetHandler: TXDataRequestHandler;
    property Handler: TXDataRequestHandler read GetHandler;
  end;

  TXDataAuthorizationContext = class(TInterfacedObject, IXDataAuthorizationContext, IAuthorizationContext)
  strict private
    FHandler: TXDataRequestHandler;
    function GetHandler: TXDataRequestHandler;
    function GetUser: IUserIdentity;
  public
    constructor Create(AHandler: TXDataRequestHandler); reintroduce;
    property Handler: TXDataRequestHandler read GetHandler;
  end;

const
  EntitySetPermissionsNone = XData.Module.Base.EntitySetPermissionsNone;
  EntitySetPermissionsAll = XData.Module.Base.EntitySetPermissionsAll;
  EntitySetPermissionsRead = XData.Module.Base.EntitySetPermissionsRead;
  EntitySetPermissionsWrite = XData.Module.Base.EntitySetPermissionsWrite;

var
  _FixEntityModifyingOnUpsert: Boolean;

implementation

uses
  Aurelius.Criteria.Projections,
  Aurelius.Mapping.Metadata,
  Aurelius.Mapping.Optimization,
  Bcl.Json.Writer,
  Bcl.Rtti.Utils,
  Sparkle.Http.Headers,
  Sparkle.Utils,
  XData.Aurelius.ConnectionPool,
  XData.Aurelius.ModelBuilder,
  XData.Bind.Converter,
  XData.Consts,
  XData.Criteria.ExpandVisitor,
  XData.JSchema.Builder,
  XData.JSchema.Classes,
  XData.JSchema.Writer,
  XData.Module.Exceptions,
  XData.Payload.Reader,
  XData.Payload.Writer,
  XData.Payload.Json.Factory,
  XData.Query.Expression,
  XData.Service.Internal,
  XData.Sys.Exceptions,
  XData.Utils;

{ TServerReferenceSolver }

type
  EReferenceNotFound = class(EXDataException)
  public
    constructor Create(const Ref: string);
  end;

  TServerReferenceSolver = class(TInterfacedObject, IJsonReferenceSolver)
  strict private
    {$IFDEF AUTOREFCOUNT}[Weak]{$ENDIF}
    FContext: TXDataRequestHandler;
    function LoadProxyFromAnotherManager(Clazz: TClass; Id: Variant;
      MemberInfo: TRttiOptimization): TObject;
    function LoadBlobFromAnotherManager(Clazz: TClass; Id: Variant;
      MemberInfo: TRttiOptimization): TArray<Byte>;
  public
    constructor Create(AContext: TXDataRequestHandler);
    function SolveReference(const Ref: string; RttiInfo: TRttiOptimization; ADepth: integer): TObject;
    function SolveBlob(const Ref: string; RttiInfo: TRttiOptimization): TArray<byte>;
  end;

  TServerExpander = class(TInterfacedObject, IJsonExpander)
  private
    {$IFDEF AUTOREFCOUNT}[Weak]{$ENDIF}
    FHandler: TXDataRequestHandler;
    FExpandProps: THashSet<TXDataProperty>;
    FEntityType: TXDataEntityType;
    function ExpandProps: THashSet<TXDataProperty>;
  public
    constructor Create(AHandler: TXDataRequestHandler; AEntityType: TXDataEntityType);
    destructor Destroy; override;
    function MustExpand(Prop: TXDataProperty): Boolean;
  end;

{ EReferenceNotFound }

constructor EReferenceNotFound.Create(const Ref: string);
begin
  inherited CreateFmt('Reference "%s" not found', [Ref]);
end;

{ TServerReferenceSolver }

constructor TServerReferenceSolver.Create(AContext: TXDataRequestHandler);
begin
  FContext := AContext;
end;

function TServerReferenceSolver.LoadBlobFromAnotherManager(Clazz: TClass;
  Id: Variant; MemberInfo: TRttiOptimization): TArray<Byte>;
var
  TempManager: TObjectManager;
  Manager: TObjectManager;
  ParentEntity: TObject;
  Blob: TBlob;
begin
  Manager := FContext.CurrentManager;
  TempManager := FContext.InternalCreateManager(Manager.Connection, Manager.Explorer);
  try
    ParentEntity := TempManager.Find(Clazz, Id);
    Blob := Manager.Explorer.GetMemberValue(ParentEntity, MemberInfo).AsType<TBlob>;
    Result := Blob.AsBytes;
  finally
    TempManager.Free;
  end;
end;

function TServerReferenceSolver.LoadProxyFromAnotherManager(Clazz: TClass;
  Id: Variant; MemberInfo: TRttiOptimization): TObject;
var
  TempManager: TObjectManager;
  Manager: TObjectManager;
  ParentEntity: TObject;
  TempObject: TObject;
  SourceList, TargetList: IObjectList;
  I: Integer;
begin
  Manager := FContext.CurrentManager;
  TempManager := FContext.InternalCreateManager(Manager.Connection, Manager.Explorer);
  try
    ParentEntity := TempManager.Find(Clazz, Id);
    Manager.Explorer.ForceProxyLoad(ParentEntity, MemberInfo);
    TempObject := Manager.Explorer.GetMemberValue(ParentEntity, MemberInfo).AsObject;
    if TempObject = nil then
      Result := TempObject
    else
      if IsObjectList(TempObject.ClassType) then
      begin
        Result := FContext.CreateInstance(TempObject.ClassType);
        try
          SourceList := AsObjectList(TempObject);
          TargetList := AsObjectList(Result);
          for I := 0 to SourceList.Count - 1 do
          begin
            TargetList.Add(Manager.Find(
              SourceList.Item(I).ClassType,
              Manager.Explorer.GetIdValue(SourceList.Item(I))
            ));
          end;
        except
          Result.Free;
          raise;
        end;
      end else
        Result := Manager.Find(TempObject.ClassType, Manager.Explorer.GetIdValue(TempObject));
  finally
    TempManager.Free;
  end;
end;

function TServerReferenceSolver.SolveBlob(const Ref: string; RttiInfo: TRttiOptimization): TArray<byte>;
var
  IdValue: Variant;
  Clazz: TClass;
  EntitySetName, PropName: string;
  P: Integer;
  Prop: TXDataSimpleProperty;
  Blob: TBlob;
  Entity: TObject;
  MemberInfo: TRttiOptimization;
begin
  // Most part of this code is a copy from SolveReference method
  P := Pos('/', Ref);
  if P = 0 then
    raise EReferenceNotFound.Create(Ref);
  EntitySetName := Copy(Ref, 1, P - 1);
  PropName := Copy(Ref, P + 1, MaxInt);
  EntitySetName := TSparkleUtils.PercentDecode(EntitySetName);
  PropName := TSparkleUtils.PercentDecode(PropName);

  FContext.XModel.ParseCanonicalUrl(EntitySetName, Clazz, IdValue);

  // code duplicated from GetEntityFromNavigationPath. We could unify this later
  Entity := FContext.CurrentManager.Find(Clazz, IdValue);
  if Entity = nil then
    raise EReferenceNotFound.Create(Ref);

  Prop := FContext.XModel.GetEntityTypeByClass(Clazz).FindProperty(PropName);
  if Prop = nil then
    raise EReferenceNotFound.Create(Ref);

  MemberInfo := FContext.XModel.GetPropertyInfo(Prop).RttiInfo;
  Blob := FContext.XModel.GetPropertyBlobValue(Entity, Prop);

  // Very trick thing to avoid stack overflow. See SolveReference for detailed info
  if not Blob.Available and
    (FContext.XModel.Explorer.GetBlobController(Blob, MemberInfo) is TDeserializerBlobController) then
    Result := LoadBlobFromAnotherManager(Clazz, IdValue, MemberInfo)
  else
    Result := Blob.AsBytes;
end;

function TServerReferenceSolver.SolveReference(const Ref: string; RttiInfo: TRttiOptimization; ADepth: integer): TObject;
var
  IdValue: Variant;
  Clazz: TClass;
  EntitySetName, PropName: string;
  P: Integer;
  NavProp: TXDataNavigationProperty;
  EntityList: TObject;
  SourceList, TargetList: IObjectList;
  I: Integer;
  MemberInfo: TRttiOptimization;
begin
  // Rigorously, this code should simulate a full request to the server, so
  // we could solve references to absolute url (http://blabla) and even references to
  // arbitrary Url (not only those URL with format "<entityset>(<key>)".
  // But for now, let's keep it simple and leave it this quick and (very) dirty way
  // This code solved two very specific formats:
  //   "EntitySetName(Id)" - canonical url;
  //   or
  //   "EntitySetName(Id)/PropName" - proxy url.
  P := Pos('/', Ref);
  if P = 0 then
  begin
    EntitySetName := Ref;
    PropName := ''
  end
  else
  begin
    EntitySetName := Copy(Ref, 1, P - 1);
    PropName := Copy(Ref, P + 1, MaxInt);
  end;
  EntitySetName := TSparkleUtils.PercentDecode(EntitySetName);
  PropName := TSparkleUtils.PercentDecode(PropName);

  FContext.XModel.ParseCanonicalUrl(EntitySetName, Clazz, IdValue);

  // code duplicated from GetEntityFromNavigationPath. We could unify this later
  Result := FContext.CurrentManager.Find(Clazz, IdValue);
  if (Result <> nil) and (PropName <> '') then
  begin
    NavProp := FContext.XModel.GetEntityTypeByClass(Clazz).FindNavigationProperty(PropName);
    if NavProp = nil then
      raise EReferenceNotFound.Create(Ref);

    // Now it can get tricky. Suppose the following situation at server side:
    //
    //   Manager.Merge(Entity)
    //   Entity.Prop;
    //
    // Entity contains a proxy for Prop property, and it's this proxy (TServerReferenceSolver)
    // because it was sent by the client. Since a Merge was performed, Entity is already
    // in the manager now. The Find method above won't hit the database, but just return
    // the instance in the manager. And if we try to load the proxy now, it's still
    // the same old proxy we have. This will call a stack overflow, because we're trying
    // to load a proxy here by forcing to load a proxy hoping that the second proxy
    // will be created from a hit in database.
    // So, in summary, if the property is a proxy, if it's not available and if it's
    // a TServerReferenceSolver, then we need to create a separate manager, force the loading
    // of the proxy there, get the class/id of all those proxies and the reload them in
    // this original manager.
    // We're loading a proxy from a reference of format
    // "Entity(Id)/Prop". It might be possible that Entity(Id) was already in manager
    // because it was previously Merged (or Updated)
    MemberInfo := FContext.XModel.GetNavPropInfo(NavProp).RttiInfo;
    if MemberInfo.IsProxy and
      FContext.XModel.Explorer.HasUnloadedProxy(Result, MemberInfo)
      and (FContext.XModel.Explorer.GetProxyController(Result, MemberInfo) is TDeserializerProxyController) then
    begin
      Result := LoadProxyFromAnotherManager(Clazz, IdValue, MemberInfo);
    end
    else
    begin
      Result := FContext.XModel.GetNavigationPropertyValue(Result, NavProp, true);

      // If it's a list, then create a specific list object to return in the proxy.
      // This is the expected behavior for LoadProxyValue (which what is calling SolveReference)
      // If we return directly, the list will be referrenced in two different places
      if (Result <> nil) and IsObjectList(Result.ClassType) then
      begin
        EntityList := FContext.CreateInstance(Result.ClassType);
        try
          SourceList := AsObjectList(Result);
          TargetList := AsObjectList(EntityList);
          for I := 0 to SourceList.Count - 1 do
            TargetList.Add(SourceList.Item(I));
          Result := EntityList;
        except
          EntityList.Free;
          raise;
        end;
      end;
    end;
  end;
  if Result = nil then
    raise EReferenceNotFound.Create(Ref);
end;

{ TServerExpander }

constructor TServerExpander.Create(AHandler: TXDataRequestHandler;
  AEntityType: TXDataEntityType);
begin
  FHandler := AHandler;
  FEntityType := AEntityType;
end;

destructor TServerExpander.Destroy;
begin
  FExpandProps.Free;
  inherited;
end;

function TServerExpander.ExpandProps: THashSet<TXDataProperty>;
var
  Visitor: TQueryExpandVisitor;
  Info: TQueryExpandInfo;
begin
  if FExpandProps = nil then
  begin
    FExpandProps := THashSet<TXDataProperty>.Create;
    Visitor := TQueryExpandVisitor.Create(FHandler.XModel, FEntityType, FExpandProps);
    try
      for Info in FHandler.GetQueryInfo(FEntityType).ExpandItems do
        Info.Expression.Accept(Visitor);
    finally
      Visitor.Free;
    end;
  end;
  Result := FExpandProps;
end;

function TServerExpander.MustExpand(Prop: TXDataProperty): Boolean;
begin
  Result := ExpandProps.Contains(Prop);
end;

{ TXDataServerModule }

procedure TXDataServerModule.AddServiceImplementation(AClass: TClass);
var
  C: TRttiContext;
  RttiType: TRttiType;
begin
  C := TRttiContext.Create;
  try
    RttiType := C.GetType(AClass);
    if (RttiType <> nil) and (RttiType.IsInstance) then
      AddServiceImplementation(RttiType.AsInstance)
    else
      raise EXDataInvalidServiceType.Create(AClass.ClassInfo);
  finally
    C.Free;
  end;
end;

constructor TXDataServerModule.Create(const ABaseUrl: string; AConnectionPool: IDBConnectionPool; AModel: TXDataAureliusModel);
var
  F: TXDataPayloadFormat;
begin
  FSwaggerOptions := TSwaggerOptions.Create;
  FSwaggerUIOptions := TSwaggerUIOptions.Create;
  if AModel = nil then
    AModel := GetDefaultModel;
  inherited Create(AModel, ABaseUrl);
  FConnectionPool := AConnectionPool;
  for F := Low(TXDataPayloadFormat) to High(TXDataPayloadFormat) do
    case F of
//      TXDataPayloadFormat.Atom:
//        FPayloadFactories[F] := TXDataPayloadAtomFactory.Create(Self.Model, ABaseUrl);
      TXDataPayloadFormat.Json:
        FPayloadFactories[F] := TXDataPayloadJsonFactory.Create(Self.Model, ABaseUrl);
    else
      FPayloadFactories[F] := nil;
    end;
  ImportServiceImplementations;
  FEvents := TXDataModuleEvents.Create;
end;

constructor TXDataServerModule.Create(const ABaseUrl: string);
begin
  Create(ABaseUrl, IDBConnectionPool(nil), nil);
end;

constructor TXDataServerModule.Create(const ABaseUrl: string; AModel: TXDataAureliusModel);
begin
  Create(ABaseUrl, IDBConnectionPool(nil), AModel);
end;

function TXDataServerModule.CreateBaseHandler(const C: THttpServerContext): TXDataBaseRequestHandler;
begin
  Result := CreateHandler(C);
end;

function TXDataServerModule.CreateHandler(const C: THttpServerContext): TXDataRequestHandler;
begin
  Result := TXDataRequestHandler.Create(Self, C);
end;

constructor TXDataServerModule.Create(const ABaseUrl: string; AConnection: IDBConnection);
begin
  Create(ABaseUrl, AConnection, nil);
end;

constructor TXDataServerModule.Create(const ABaseUrl: string; AConnection: IDBConnection; AModel: TXDataAureliusModel);
begin
  FSingleConnection := AConnection; // keep reference
  Create(ABaseUrl,
    TDBConnectionPool.Create(1,
      function: IDBConnection
      begin
        Result := AConnection
      end),
    AModel);
end;

constructor TXDataServerModule.Create(const ABaseUrl: string; AConnectionPool: IDBConnectionPool);
begin
  Create(ABaseUrl, AConnectionPool, nil);
end;

procedure TXDataServerModule.AddImplementationForInterface(RttiType: TRttiInstanceType;
  IntfType: TRttiInterfaceType);
var
  Controller: TXDataController;
begin
  Controller := XModel.FindControllerByInterface(IntfType.Handle);
  if Controller <> nil then
    Controller.ServiceClass := RttiType.MetaclassType;
end;

procedure TXDataServerModule.AddServiceImplementation(RttiType: TRttiInstanceType);
var
  IntfType: TRttiInterfaceType;
begin
  for IntfType in RttiType.GetImplementedInterfaces do
    AddImplementationForInterface(RttiType, IntfType);
end;

destructor TXDataServerModule.Destroy;
var
  F: TXDataPayloadFormat;
begin
  for F := Low(TXDataPayloadFormat) to High(TXDataPayloadFormat) do
    FPayloadFactories[F].Free;
  FEvents.Free;
  FSwaggerOptions.Free;
  FSwaggerUIOptions.Free;
  inherited;
end;

procedure TXDataServerModule.DoGetAbsoluteUrl(const Schema, Authority, Path,
  RelativeUrl: string; var Url: string);
begin
  if Assigned(FOnGetAbsoluteUrl) then
    FOnGetAbsoluteUrl(Schema, Authority, Path, RelativeUrl, Url);
end;

function TXDataServerModule.GetXModel: TXDataAureliusModel;
begin
  Result := TXDataAureliusModel(inherited Model);
end;

function TXDataServerModule.HasEndpoint(Permission: TEntitySetPermission;
  EntitySet: TXDataEntitySet): Boolean;
begin
  // If the entity set has any requirement, then it "has" the endpoint.
  // This means the endpoint is available, as long as the user has proper permission
  // If the entity set doesn't have any requirement, then the presence of the endpoint
  // depends on the EntitySetPermissions setting.
  if XModel.GetEntitySetInfo(EntitySet).HasRequirements(Permission) then
    Result := True
  else
    // must call inherited here, to avoid the logic for requirements
    Result := inherited HasPermission(Permission, EntitySet);
end;

function TXDataServerModule.HasPermission(Permission: TEntitySetPermission;
  EntitySet: TXDataEntitySet): Boolean;
var
  Info: TXDataAureliusEntitySetInfo;
  Context: TXDataOperationContext;
begin
  // if the entity set has requirements, we will override (ignore) the behavior defined
  // by EntitySetPermissions and DefaultEntitySetPermissions
  Info := XModel.GetEntitySetInfo(EntitySet);
  if not Info.HasRequirements then
    Exit(inherited HasPermission(Permission, EntitySet));

  Context := TXDataOperationContext.Current;
  if Context = nil then
    Exit(False);

  Result := Context.Handler.HasPermission(Context.Request.User, Info.Requirements[Permission]);
end;

function TXDataServerModule.GetDefaultModel: TXDataAureliusModel;
begin
  Result := TXDataAureliusModel.Default;
end;

function TXDataServerModule.GetPayloadFactory(const C: TXDataBaseRequestHandler): TXDataPayloadFactory;
begin
  Result := FPayloadFactories[C.PayloadFormat];
end;

procedure TXDataServerModule.ImportServiceImplementations;
var
  C: TRttiContext;
  RttiType: TRttiType;
  A: TCustomAttribute;
begin
  C := TRttiContext.Create;
  try
    for RttiType in C.GetTypes do
      if RttiType is TRttiInstanceType then
        for A in RttiType.GetAttributes do
          if A is ServiceImplementationAttribute then
          begin
            AddServiceImplementation(TRttiInstanceType(RttiType));
            break;
          end;
  finally
    C.Free;
  end;
end;

{ TXDataOperationContext }

procedure TXDataOperationContext.AddManager(AManager: TObjectManager);
begin
  FHandler.AddManager(AManager);
end;

function TXDataOperationContext.Connection: IDBConnection;
begin
  if FConnection = nil then
    FConnection := GetConnectionPool.GetConnection;
  Result := FConnection;
end;

constructor TXDataOperationContext.Create(AConnectionPool: IDBConnectionPool;
  AHandler: TXDataRequestHandler);
begin
  FConnectionPool := AConnectionPool;
  FHandler := AHandler;
end;

function TXDataOperationContext.CreateCriteria<T>(Manager: TObjectManager; Query: TXDataQuery;
  Model: TXDataAureliusModel; BaseClass: TClass): TCriteria<T>;
var
  BaseType: TXDataStructuredType;
begin
  if BaseClass <> nil then
    BaseType := Handler.XModel.GetInstanceTypeByClass(BaseClass)
  else
    BaseType := nil;
  Result := CreateCriteria<T>(Manager, Query, Model, BaseType);
end;

function TXDataOperationContext.CreateCriteria<T>(Manager: TObjectManager; Query: TXDataQuery;
  Model: TXDataAureliusModel; BaseType: TXDataStructuredType): TCriteria<T>;
var
  QueryInfo: TXDataQueryInfo;
  Builder: TXDataCriteriaBuilder;
  TargetType: TXDataEntityType;
begin
  TargetType := Model.GetEntityTypeByClass(T);
  if BaseType = nil then
    BaseType := TargetType;

  QueryInfo := TXDataQueryInfo.Create(BaseType, Query);
  try
    QueryInfo.Solve;
    Builder := TXDataCriteriaBuilder.Create(Model, QueryInfo);
    try
      Result := Manager.Find<T>;
      try
        Builder.UpdateCriteria(Result);
      except
        Result.Free;
        raise;
      end;
    finally
      Builder.Free;
    end;
  finally
    QueryInfo.Free;
  end;
end;

function TXDataOperationContext.CreateCriteria<T>(Manager: TObjectManager; Query: TXDataQuery;
  BaseClass: TClass): TCriteria<T>;
begin
  Result := CreateCriteria<T>(Manager, Query, Handler.XModel, BaseClass);
end;

function TXDataOperationContext.CreateCriteria<T>(Query: TXDataQuery; BaseClass: TClass): TCriteria<T>;
begin
  Result := CreateCriteria<T>(GetManager, Query, BaseClass);
end;

function TXDataOperationContext.CreateManager: TObjectManager;
begin
  Result := CreateManager(nil, nil);
end;

function TXDataOperationContext.CreateManager(
  Connection: IDBConnection): TObjectManager;
begin
  Result := CreateManager(Connection, nil);
end;

function TXDataOperationContext.CreateManager(Connection: IDBConnection;
  Explorer: TMappingExplorer): TObjectManager;
begin
  if Connection = nil then
    Connection := Self.Connection;
  if Explorer = nil then                            
    Explorer := FHandler.XModel.Explorer;
  Result := FHandler.InternalCreateManager(Connection, Explorer);
  AddManager(Result);
  Result.ProxyLoadDepth := FHandler.ProxyLoadDepth;
  Result.ProxyListLoadDepth := FHandler.ProxyListLoadDepth;
end;

function TXDataOperationContext.CreateManager(
  Explorer: TMappingExplorer): TObjectManager;
begin
  Result := CreateManager(nil, Explorer);
end;

class function TXDataOperationContext.Current: TXDataOperationContext;
begin
  Result := _Context;
end;

class procedure TXDataOperationContext.FreeContext;
begin
  _Context.Free;
  _Context := nil;
end;

function TXDataOperationContext.GetConnectionPool: IDBConnectionPool;
begin
  Result := FConnectionPool;
end;

function TXDataOperationContext.GetManager: TObjectManager;
begin
  if FManager = nil then
    FManager := CreateManager;
  Result := FManager;
end;

function TXDataOperationContext.Handler: TXDataRequestHandler;
begin
  Result := FHandler;
end;

function TXDataOperationContext.Request: THttpServerRequest;
begin
  Result := Handler.Request;
end;

function TXDataOperationContext.Response: THttpServerResponse;
begin
  Result := Handler.Response;
end;

class procedure TXDataOperationContext.SetCurrent(const Value: TXDataOperationContext);
begin
  _Context := Value;
end;

{ TXDataRequestHandler }

function TXDataRequestHandler.AbsoluteUrl(const RelativeUrl: string): string;
var
  Scheme: string;
  Authority: string;
  Path: string;
begin
  Scheme := Request.Uri.Scheme;
  Authority := Request.Uri.Authority; // Module.BaseUri.Authority,
  Path := Module.BaseUri.OriginalPath;

  Result := TXDataUtils.CombineUrlFast(
    Format('%s://%s%s', [Scheme, Authority, Path]),
    RelativeUrl
  );

  XModule.DoGetAbsoluteUrl(Scheme, Authority, Path, RelativeUrl, Result);
end;

procedure TXDataRequestHandler.AddManager(AManager: TObjectManager);
begin
  if FManagers = nil then
    FManagers := TObjectSet<TObjectManager>.Create(True);
  FManagers.Add(AManager);
end;

procedure TXDataRequestHandler.CheckAcceptApplicationType;
begin
  inherited CheckAcceptApplicationType;
end;

procedure TXDataRequestHandler.CheckSinglePath;
begin
  if ResourceInfo.Path.Count > 1 then
    raise EXDataHttpUnsupportedPath.Create(Self);
end;

procedure TXDataRequestHandler.CleanUp;
var
  Obj: TObject;
begin
  // Put this code in CleanUp, not Destroy, because errors might
  // raise from this due to user errors (objects being destroyed twice)
  // So it's out of our control and might happen often. However, if we do that,
  // the destruction code will not continue, context will not be destroyed,
  // connection will not be released, being locked in the pool
  for Obj in FManagedObjects do
    DestroyIfNotInManagers(Obj, FManagers);
end;

constructor TXDataRequestHandler.Create(const AModule: TXDataBaseModule;
  const AHttpContext: THttpServerContext);
begin
  inherited Create(AModule, AHttpContext);
  TXDataOperationContext.SetCurrent(TXDataOperationContext.Create(ConnectionPool, Self));
  FQueryInfos := TObjectList<TXDataQueryInfo>.Create;
  FManagedObjects := THashSet<TObject>.Create;
end;

procedure TXDataRequestHandler.CreateCollectionPropertyItem;
var
  Manager: TObjectManager;
  Parent: TObject;
  Items: IObjectList;
  BaseType: TXDataEntityType;
  Entity: TObject;
  Transaction: IDBTransaction;
begin
  Manager := CurrentManager;
  Transaction := Manager.Connection.BeginTransaction;
  try
    // retrieve the object and the collection
    Parent := GetEntityFromNavigationPath(Manager);
    Items := GetNavigationPropertyList(Parent);

    // Create and deserialize from Json payload and add the new object in the collection
    // The deserializer will automatically instantiate the object based on xdata.type annotation
    BaseType := TXDataEntityCollectionType(ResourceInfo.FinalCollection.Target).ItemType;
    DeserializeEntity(nil, BaseType, Manager,
      procedure(DeserializedObject: TObject)
      begin
        Entity := DeserializedObject;

        NotifyEntityModifying(Parent);
        NotifyEntityInserting(Entity);

        Items.Add(Entity);
        Manager.Update(Parent);
        DoFlush(Manager, Parent);
      end
    );

    // refresh object to write it back to the client
    Manager.Refresh(Entity);
    Transaction.Commit;
  except
    Transaction.Rollback;
    raise;
  end;

  NotifyEntityModified(Parent);
  NotifyEntityInserted(Entity);

  // Send respose
  Response.StatusCode := 201;
  SetResponseLocationHeader(Entity);
  SerializeEntity(Entity, BaseType);
end;

procedure TXDataRequestHandler.CreateEntity;
var
  Manager: TObjectManager;
  Entity: TObject;
  BaseType: TXDataEntityType;
  Transaction: IDBTransaction;
begin
  Manager := CurrentManager;
  Transaction := Manager.Connection.BeginTransaction;
  try
    // Create and deserialize from Json payload and perform changes
    // The deseriailzer will automatically instantiate the object based o xdata.type annotation
    BaseType := ResourceInfo.EntitySet.EntityType;
    DeserializeEntity(nil, BaseType, Manager,
      procedure(DeserializedObject: TObject)
      begin
        Entity := DeserializedObject;
        OnEntityCreate(Manager, Entity);
        NotifyEntityInserting(Entity);
        Manager.Save(Entity);
      end
    );

    // refresh object to write it back to the client
    Manager.Refresh(Entity);
    Transaction.Commit;
  except
    Transaction.Rollback;
    raise;
  end;
  NotifyEntityInserted(Entity);

  // Send response
  Response.StatusCode := 201;
  SetResponseLocationHeader(Entity);
  SerializeEntity(Entity, BaseType);
end;

function TXDataRequestHandler.CreateInstance(AClass: TClass): TObject;
begin
  Result := XModel.Explorer.ObjectFactory.CreateInstance(AClass);
end;

function TXDataRequestHandler.InternalCreateManager(Connection: IDBConnection;
  Explorer: TMappingExplorer): TObjectManager;
begin
  Result := TObjectManager.Create(Connection, Explorer);
  try
    NotifyManagerCreate(Result);  
  except
    Result.Free;
    raise;
  end;
end;

function TXDataRequestHandler.CurrentManager: TObjectManager;
begin
  Result := TXDataOperationContext.Current.GetManager;
end;

function TXDataRequestHandler.CreateSolver: IJsonReferenceSolver;
begin
  Result := TServerReferenceSolver.Create(Self);
end;

procedure TXDataRequestHandler.DeleteEntity;
var
  Manager: TObjectManager;
  Entity: TObject;
  IdValue: Variant;
  Clazz: TClass;
  Transaction: IDBTransaction;
begin
  // Get the key predicated provided in URL
  GetEntityInfoFromPath(IdValue, Clazz);
  Manager := CurrentManager;
  Manager.DeferDestruction := True;
  Transaction := Manager.Connection.BeginTransaction;
  try
    OnEntityDelete(Manager, Clazz, IdValue);
    Entity := GetEntityFromNavigationPath(Manager);
    NotifyEntityDeleting(Entity);
    Manager.Remove(Entity);
    Transaction.Commit;
  except
    Transaction.Rollback;
    raise;
  end;
  NotifyEntityDeleted(Entity);

  Response.StatusCode := 204;
end;

procedure TXDataRequestHandler.DeleteStreamProperty;
var
  Manager: TObjectManager;
  Entity: TObject;
  BlobValue: TBlob;
  Transaction: IDBTransaction;
begin
  Manager := CurrentManager;
  Transaction := Manager.Connection.BeginTransaction;
  try
    Entity := GetEntityFromNavigationPath(Manager);
    Assert(ResourceInfo.FinalProp <> nil);
    Assert(ResourceInfo.FinalProp.TypeKind = TXTypeKind.xtStream);

    // clear blob content, set in property and save changes
    BlobValue.Clear;
    XModel.SetPropertyBlobValue(Entity, ResourceInfo.FinalProp, BlobValue);
    NotifyEntityModifying(Entity);
    DoFlush(Manager, Entity);
    Transaction.Commit;
  except
    Transaction.Rollback;
    raise;
  end;
  NotifyEntityModified(Entity);
  Response.StatusCode := 204;
end;

procedure TXDataRequestHandler.DeserializeEntity(Entity: TObject; BaseType: TXDataEntityType;
  Manager: TObjectManager; Operation: TProc<TObject>);
var
  Stream: TStream;
  Reader: IEntityReader;
begin
  // must deserialize based on Entity or BaseType
  Assert((Entity = nil) xor (BaseType = nil));
  Stream := TBytesStream.Create(Request.Content);
  try
    Reader := PayloadFactory.CreateEntityReader(Stream, CreateSolver, ManagedObjects);
    Reader.SetUnknownMemberHandling(UnknownMemberHandling);
    CheckRequestContentType(Reader.ContentType);
    if Entity <> nil then
    begin
      Reader.ReadEntity(Entity);
      Operation(Entity);
    end
    else
      Operation(Reader.CreateEntity(BaseType));
  finally
    Stream.Free;
  end;
end;

destructor TXDataRequestHandler.Destroy;
begin
  FManagedObjects.Free;
  TXDataOperationContext.FreeContext;
  FManagers.Free;
  FQueryInfos.Free;
  inherited;
end;

procedure TXDataRequestHandler.DestroyIfNotInManagers(Entity: TObject;
  Managers: TObjectSet<TObjectManager>);
{$IFDEF AUTOREFCOUNT}
begin
end;
{$ELSE}
var
  Manager: TObjectManager;
begin
  if Entity = nil then Exit;
  if Managers <> nil then
    for Manager in Managers do
      if Manager.IsAttached(Entity) then
        Exit;
  Entity.Free;
end;
{$ENDIF}

procedure TXDataRequestHandler.DoFlush(Manager: TObjectManager;
  AEntity: TObject);
begin
  case FlushMode of
    TXDataFlushMode.Single: Manager.Flush(AEntity);
  else
    { TXDataFlushMode.All: }
    Manager.Flush;
  end;
end;

function TXDataRequestHandler.Events: TXDataModuleEvents;
begin
  Result := XModule.Events;
end;

procedure TXDataRequestHandler.ExecuteAction;
var
  Executer: TActionExecuter;
begin
  Assert(ResourceInfo.Actions.Count = 1);
  Executer := TActionExecuter.Create(Self, ResourceInfo.Actions[0]);
  try
    Executer.Execute;
  finally
    Executer.Free;
  end;
end;

function TXDataRequestHandler.GetConnectionPool: IDBConnectionPool;
begin
  Result := XModule.ConnectionPool;
end;

function TXDataRequestHandler.GetEntityFromNavigationPath(const Manager: TObjectManager): TObject;
var
  Clazz: TClass;
  IdValue: Variant;
  Entity: TObject;
  PathItem: TNavigationPathItem;
  Criteria: TCriteria;
begin
  // Attention: this code is duplicated in TServerReferenceSolver. Should be unified later
  // if you change this, be sure to revise TServerReferenceSolver as well.
  GetEntityInfoFromPath(IdValue, Clazz);
  Criteria := Manager.CreateCriteria(Clazz);
  try
    Criteria.AutoDestroy := false;
    Criteria.Add(TIdentifierEqExpression.Create(IdValue));
    UpdateCriteria(Criteria); // for the $expand option
    Entity := Criteria.UniqueResult<TObject>;
  finally
    Criteria.Free;
  end;

  for PathItem in ResourceInfo.Path[0].NavPath do
    if Entity <> nil then
      Entity := XModel.GetNavigationPropertyValue(Entity, PathItem.NavProp, true)
    else
      break;
  if Entity = nil then
    raise EXDataHttpEntityNotFound.Create(Self);

  Result := Entity;
end;

procedure TXDataRequestHandler.GetEntityInfoFromPath(out IdValue: Variant; out AClass: TClass);
begin
  CheckSinglePath;
  Assert(ResourceInfo.Path.Count = 1);
  IdValue := XModel.KeyPredicateToId(ResourceInfo.Path[0].Key, ResourceInfo.EntitySet.EntityType);
  AClass := XModel.GetEntityTypeInfo(ResourceInfo.EntitySet.EntityType).Clazz;
end;

function TXDataRequestHandler.GetNavigationPropertyList(Entity: TObject): IObjectList;
begin
  Assert(ResourceInfo.FinalCollection <> nil);
  Assert(ResourceInfo.FinalCollection.Target is TXDataEntityCollectionType);
  Result := XModel.GetNavigationPropertyAsList(Entity, ResourceInfo.FinalCollection, true);
end;

function TXDataRequestHandler.GetQueryInfo(AContextType: TXDataEntityType): TXDataQueryInfo;
begin
  Result := TXDataQueryInfo.Create(AContextType, HttpContext.Request.Uri.OriginalQuery);
  FQueryInfos.Add(Result);
  Result.Solve;
end;

function TXDataRequestHandler.GetXModel: TXDataAureliusModel;
begin
  Result := TXDataAureliusModel(Self.Model);
end;

function TXDataRequestHandler.GetXModule: TXDataServerModule;
begin
  Result := TXDataServerModule(Self.Module);
end;

procedure TXDataRequestHandler.HandleException(const E: Exception);
var
  Action: TModuleExceptionAction;
  StatusCode: Integer;
  ErrorCode: string;
  ErrorMessage: string;

  Args: TModuleExceptionArgs;
  Listener: TModuleExceptionProc;
begin
  // Prepare default values
  StatusCode := 500;
  ErrorCode := ErrorCodeFromClassName(E.ClassName);
  ErrorMessage := E.Message;
  Action := TModuleExceptionAction.SendError;
  if E is EXDataHttpException then
  begin
    StatusCode := EXDataHttpException(E).StatusCode;
    ErrorCode := EXDataHttpException(E).ErrorCode;
  end
  else
  if E is EXDataException then
    ErrorCode := EXDataException(E).ErrorCode;

  // Fire event listeners that might modify default values
  if Events.OnModuleException.HasListeners then
  begin
    Args := TModuleExceptionArgs.Create(Self, E, StatusCode, ErrorCode, ErrorMessage, Action);
    try
      for Listener in Events.OnModuleException.Listeners do
        Listener(Args);
      StatusCode := Args.StatusCode;
      ErrorCode := Args.ErrorCode;
      ErrorMessage := Args.ErrorMessage;
      Action := Args.Action;
    finally
      Args.Free;
    end;
  end;

  // Now handle the error properly
  case Action of
    TModuleExceptionAction.SendError:
      SendErrorResponse(StatusCode, ErrorCode, ErrorMessage);
    TModuleExceptionAction.RaiseException:
      raise E;

    // ignore if different
  end;

end;

function TXDataRequestHandler.HasPermission(Action: TXDataAction): Boolean;
begin
  Result := HasPermission(Request.User, XModel.GetActionInfo(Action).Requirements);
end;

function TXDataRequestHandler.HasPermission(User: IUserIdentity;
  Requirements: TList<IAuthorizationRequirement>): Boolean;
var
  Requirement: IAuthorizationRequirement;
  Context: IXDataAuthorizationContext;
  ReqResult: IRequirementResult;
begin
  if Requirements.Count = 0 then
    Exit(True);
  
  Context := TXDataAuthorizationContext.Create(Self);
  for Requirement in Requirements do
  begin
    ReqResult := Requirement.Check(Context);
    if not ((ReqResult <> nil) and ReqResult.Succeeded) then
      Exit(False);
  end;
  Result := True;
end;

procedure TXDataRequestHandler.MergeEntity;
var
  Manager: TObjectManager;
  Entity: TObject;
  Transaction: IDBTransaction;
begin
  Manager := CurrentManager;
  Transaction := Manager.Connection.BeginTransaction;
  try
    // Retrieve existing entity from database so we can merge
    // (keep existing properties and change only properties declared in payload
    Entity := GetEntityFromNavigationPath(Manager);

    OnBeforeEntityMerge(Manager, Entity);
    // update the object properties from Json payload and perform changes
    DeserializeEntity(Entity, nil, Manager,
      procedure(DeserializedObject: TObject)
      begin
        OnEntityMerge(Manager, Entity);
        NotifyEntityModifying(Entity);
        DoFlush(Manager, Entity);
      end
    );

    // refresh object to write it back to the client
    Manager.Refresh(Entity);
    Transaction.Commit;
  except
    Transaction.Rollback;
    raise;
  end;
  NotifyEntityModified(Entity);

  // Send response
  Response.StatusCode := 200;
  SerializeEntity(Entity, ResourceInfo.EntitySet.EntityType);
end;

function TXDataRequestHandler.CreateExpander(AClass: TClass): IJsonExpander;
var
  EntityType: TXDataEntityType;
begin
  if XModel.Explorer.IsObjectList(AClass) then
    AClass := TRttiUtils.GetInstance.GetSurroundedClass(AClass);
  EntityType := XModel.FindEntityTypeByClass(AClass);
  if EntityType = nil then
    Exit(nil);
  if GetQueryInfo(EntityType).ExpandItems.Count = 0 then
    Exit(nil);

  Result := TServerExpander.Create(Self, EntityType)
end;

procedure TXDataRequestHandler.NotifyEntityDeleted(Entity: TObject);
var
  Args: TEntityDeletedArgs;
  Listener: TEntityDeletedProc;
begin
  if Events.OnEntityDeleted.HasListeners then
  begin
    Args := TEntityDeletedArgs.Create(Self, Entity);
    try
      for Listener in Events.OnEntityDeleted.Listeners do
        Listener(Args);
    finally
      Args.Free;
    end;
  end;
end;

procedure TXDataRequestHandler.NotifyEntityDeleting(Entity: TObject);
var
  Args: TEntityDeletingArgs;
  Listener: TEntityDeletingProc;
begin
  if Events.OnEntityDeleting.HasListeners then
  begin
    Args := TEntityDeletingArgs.Create(Self, Entity);
    try
      for Listener in Events.OnEntityDeleting.Listeners do
        Listener(Args);
    finally
      Args.Free;
    end;
  end;
end;

procedure TXDataRequestHandler.NotifyEntityGet(Entity: TObject);
var
  Args: TEntityGetArgs;
  Listener: TEntityGetProc;
begin
  if Events.OnEntityGet.HasListeners then
  begin
    Args := TEntityGetArgs.Create(Self, Entity);
    try
      for Listener in Events.OnEntityGet.Listeners do
        Listener(Args);
    finally
      Args.Free;
    end;
  end;
end;

procedure TXDataRequestHandler.NotifyEntityInserted(Entity: TObject);
var
  Args: TEntityInsertedArgs;
  Listener: TEntityInsertedProc;
begin
  if Events.OnEntityInserted.HasListeners then
  begin
    Args := TEntityInsertedArgs.Create(Self, Entity);
    try
      for Listener in Events.OnEntityInserted.Listeners do
        Listener(Args);
    finally
      Args.Free;
    end;
  end;
end;

procedure TXDataRequestHandler.NotifyEntityInserting(Entity: TObject);
var
  Args: TEntityInsertingArgs;
  Listener: TEntityInsertingProc;
begin
  if Events.OnEntityInserting.HasListeners then
  begin
    Args := TEntityInsertingArgs.Create(Self, Entity);
    try
      for Listener in Events.OnEntityInserting.Listeners do
        Listener(Args);
    finally
      Args.Free;
    end;
  end;
end;

procedure TXDataRequestHandler.NotifyEntityList(Criteria: TCriteria);
var
  Args: TEntityListArgs;
  Listener: TEntityListProc;
begin
  if Events.OnEntityList.HasListeners then
  begin
    Args := TEntityListArgs.Create(Self, Criteria);
    try
      for Listener in Events.OnEntityList.Listeners do
        Listener(Args);
    finally
      Args.Free;
    end;
  end;
end;

procedure TXDataRequestHandler.NotifyEntityModified(Entity: TObject);
var
  Args: TEntityModifiedArgs;
  Listener: TEntityModifiedProc;
begin
  if Events.OnEntityModified.HasListeners then
  begin
    Args := TEntityModifiedArgs.Create(Self, Entity);
    try
      for Listener in Events.OnEntityModified.Listeners do
        Listener(Args);
    finally
      Args.Free;
    end;
  end;
end;

procedure TXDataRequestHandler.NotifyEntityModifying(Entity: TObject);
var
  Args: TEntityModifyingArgs;
  Listener: TEntityModifyingProc;
begin
  if Events.OnEntityModifying.HasListeners then
  begin
    Args := TEntityModifyingArgs.Create(Self, Entity);
    try
      for Listener in Events.OnEntityModifying.Listeners do
        Listener(Args);
    finally
      Args.Free;
    end;
  end;
end;

procedure TXDataRequestHandler.NotifyManagerCreate(var Manager: TObjectManager);
var
  Args: TManagerCreateArgs;
  Listener: TManagerCreateProc;
begin
  if Events.OnManagerCreate.HasListeners then
  begin
    Args := TManagerCreateArgs.Create(Self, Manager);
    try
      for Listener in Events.OnManagerCreate.Listeners do
        Listener(Args);
      Manager := Args.Manager;
    finally
      Args.Free;
    end;
  end;
end;

procedure TXDataRequestHandler.OnBeforeEntityMerge(Manager: TObjectManager; Entity: TObject);
begin

end;

procedure TXDataRequestHandler.OnBeforeEntityUpdate(Manager: TObjectManager; AClass: TClass;
  IdValue: Variant);
begin

end;

procedure TXDataRequestHandler.OnBeforeEntityUpsert(Manager: TObjectManager; AClass: TClass;
  IdValue: Variant);
begin

end;

procedure TXDataRequestHandler.OnCollectionRetrieve(Manager: TObjectManager; Entity: TObject;
  Collection: IObjectList);
begin

end;

procedure TXDataRequestHandler.OnEntityReplicate(Manager: TObjectManager; Entity: TObject);
begin

end;

procedure TXDataRequestHandler.OnEntityCreate(Manager: TObjectManager; Entity: TObject);
begin

end;

procedure TXDataRequestHandler.OnEntityDelete(Manager: TObjectManager; AClass: TClass;
  IdValue: Variant);
begin

end;

procedure TXDataRequestHandler.OnEntityMerge(Manager: TObjectManager; Entity: TObject);
begin

end;

procedure TXDataRequestHandler.OnEntityRetrieve(Manager: TObjectManager; Entity: TObject);
begin

end;

procedure TXDataRequestHandler.OnEntitySetRetrieve(Manager: TObjectManager; Criteria: TCriteria);
begin

end;

procedure TXDataRequestHandler.OnEntityUpdate(Manager: TObjectManager; Entity: TObject);
begin

end;

procedure TXDataRequestHandler.OnEntityUpsert(Manager: TObjectManager; Entity: TObject);
begin

end;

procedure TXDataRequestHandler.OnPrimitivePropertyRetrieve(Manager: TObjectManager; Entity: TObject;
  Prop: TXDataSimpleProperty);
begin

end;

procedure TXDataRequestHandler.OnStreamPropertyRetrieve(Manager: TObjectManager; Entity: TObject;
  Prop: TXDataSimpleProperty);
begin

end;

procedure TXDataRequestHandler.OnStreamPropertyUpdate(Manager: TObjectManager; Entity: TObject;
  Prop: TXDataSimpleProperty; var Blob: TBlob);
begin

end;

procedure TXDataRequestHandler.OnValueRetrieve(Manager: TObjectManager; Entity: TObject;
  Prop: TXDataSimpleProperty; var Value: TValue);
begin

end;

function TXDataRequestHandler.PayloadFactory: TXDataPayloadFactory;
begin
  Result := XModule.GetPayloadFactory(Self);
end;

procedure TXDataRequestHandler.RetrieveCollectionProperty;
var
  Manager: TObjectManager;
  Writer: IEntityCollectionWriter;
  Stream: TMemoryStream;
  Entity: TObject;
  Entities: IObjectList;
  I: integer;
begin
  Manager := CurrentManager;
  Entity := GetEntityFromNavigationPath(Manager);
  Entities := GetNavigationPropertyList(Entity);
  OnCollectionRetrieve(Manager, Entity, Entities);
  NotifyEntityGet(Entity);

  if ResourceInfo.IsCount then
  begin
    // if IsCount, then we should just return the number of records, not the record themselves
    CheckAcceptTextType;
    Response.ContentType := 'text/plain';
    Response.StatusCode := 200;
    Response.Close(TEncoding.UTF8.GetBytes(IntToStr(Entities.Count)));
  end
  else
  begin
    Stream := TMemoryStream.Create;
    try
      Writer := PayloadFactory.CreateEntityCollectionWriter(Stream);
      Writer.SetExpandLevel(ExpandLevel);
      Writer.SetExpander(CreateExpander(Entity.ClassType));
      Writer.SetSerializeInstanceRef(SerializeInstanceRef);
      Writer.SetSerializeInstanceType(SerializeInstanceType);
      Response.ContentType := Writer.ContentType;
      CheckAcceptApplicationType;
      Writer.Start(XModel.GetEntityTypeInfo(
        TXDataEntityCollectionType(ResourceInfo.FinalCollection.Target).ItemType).Clazz
      );
      for I := 0 to Entities.Count - 1 do
        Writer.SerializeItem(Entities.Item(I));
      Writer.Finish;
      Writer.Flush;
      Response.StatusCode := 200;
      Response.ContentLength := Stream.Size;
      Response.Content.CopyFrom(Stream, 0);
    finally
      Writer := nil;
      Stream.Free;
    end;
  end;
end;

procedure TXDataRequestHandler.RetrieveEntity;
var
  Manager: TObjectManager;
  Entity: TObject;
  BaseType: TXDataEntityType;
begin
  Manager := CurrentManager;
  Entity := GetEntityFromNavigationPath(Manager);
  OnEntityRetrieve(Manager, Entity);
  NotifyEntityGet(Entity);
  Response.StatusCode := 200;
  if ResourceInfo.Path[0].NavPath.Count > 0  then
    BaseType := ResourceInfo.Path[0].NavPath.Last.NavProp.Target
  else
    BaseType := ResourceInfo.EntitySet.EntityType;

  SerializeEntity(Entity, BaseType);
end;

procedure TXDataRequestHandler.RetrieveEntitySchema;
var
  Clazz: TClass;
  JSBuilder: TXDataJSchemaBuilder;
  JWriter: TJsonWriter;
  Schema: TJsonSchema;
  Stream: TStream;
  SchemaWriter: TJSchemaWriter;
begin
  Clazz := XModel.GetEntityTypeInfo(ResourceInfo.EntitySet.EntityType).Clazz;
  Schema := nil;
  JSBuilder := TXDataJSchemaBuilder.Create(XModel);
  try
    // create the schema
    Schema := JSBuilder.Build(Clazz.ClassInfo);

    Response.StatusCode := 200;

    // Serialize the schema
    Stream := TMemoryStream.Create;
    try
      JWriter := TJsonWriter.Create(Stream);
      try
        SchemaWriter := TJSchemaWriter.Create(JWriter);
        try
          SchemaWriter.WriteSchema(Schema);
        finally
          SchemaWriter.Free;
        end;

        Response.ContentType := JsonMediaType;
        CheckAcceptApplicationType;
        JWriter.Flush;
      finally
        JWriter.Free;
      end;
      Response.ContentLength := Stream.Size;
      Response.Content.CopyFrom(Stream, 0);
    finally
      Stream.Free;
    end;

  finally
    JSBuilder.Free;
    Schema.Free;
  end;
end;

procedure TXDataRequestHandler.RetrieveEntitySet;
var
  EntityType: TEntityType;
  Criteria: TCriteria;
begin
  EntityType := XModel.GetEntityTypeInfo(ResourceInfo.EntitySet.EntityType).EntityType;
  Criteria := TCriteria.Create(EntityType, CurrentManager);
  try
    Criteria.AutoDestroy := False;
    SerializeCriteria(Criteria, ManagedObjects, True);
  finally
    Criteria.Free;
  end;
end;

procedure TXDataRequestHandler.RetrievePrimitiveProperty;
var
  Manager: TObjectManager;
  Writer: IPropertyWriter;
  Stream: TMemoryStream;
  Entity: TObject;
begin
  Manager := CurrentManager;
  Entity := GetEntityFromNavigationPath(Manager);
  Assert(ResourceInfo.FinalProp <> nil);
  OnPrimitivePropertyRetrieve(Manager, Entity, ResourceInfo.FinalProp);
  NotifyEntityGet(Entity);

  Stream := TMemoryStream.Create;
  try
    Writer := PayloadFactory.CreatePropertyWriter(Stream);
    Response.ContentType := Writer.ContentType;
    CheckAcceptApplicationType;
    Writer.WriteProperty(Entity, ResourceInfo.FinalProp);
    Writer.Flush;
    Response.StatusCode := 200;
    Response.ContentLength := Stream.Size;
    Response.Content.CopyFrom(Stream, 0);
  finally
    Writer := nil;
    Stream.Free;
  end;
end;

procedure TXDataRequestHandler.RetrieveStreamProperty;
var
  Manager: TObjectManager;
  Entity: TObject;
  BlobValue: TBlob;
begin
  Manager := CurrentManager;
  Entity := GetEntityFromNavigationPath(Manager);
  Assert(ResourceInfo.FinalProp <> nil);
  Assert(ResourceInfo.FinalProp.TypeKind  = TXTypeKind.xtStream);
  OnStreamPropertyRetrieve(Manager, Entity, ResourceInfo.FinalProp);
  NotifyEntityGet(Entity);

  // return blob content, with no content-type
  BlobValue := XModel.GetPropertyBlobValue(Entity, ResourceInfo.FinalProp);
  if BlobValue.Size > 0 then
    Response.StatusCode := 200
  else
    Response.StatusCode := 204;
  BlobValue.SaveToStream(Response.Content);
end;

procedure TXDataRequestHandler.RetrieveValue;
var
  Manager: TObjectManager;
  Stream: TMemoryStream;
  Entity: TObject;
  Value: TValue;
//  Info: TXDataAureliusPropInfo;
  B: TBytes;
begin
  Manager := CurrentManager;
  Entity := GetEntityFromNavigationPath(Manager);
  Assert(ResourceInfo.FinalProp <> nil);
  Stream := TMemoryStream.Create;
  try
    Response.ContentType := 'text/plain';
    CheckAcceptTextType;
//      Info := XModel.GetPropertyInfo(ResourceInfo.FinalProp);
    Value := XModel.GetPropertyValue(Entity, ResourceInfo.FinalProp);
    OnValueRetrieve(Manager, Entity, ResourceInfo.FinalProp, Value);
    NotifyEntityGet(Entity);

    if not Value.IsEmpty then
    begin
      if TRttiUtils.GetInstance.IsString(Value) then
        B := TEncoding.UTF8.GetBytes(Value.AsString)
      else
        B := TEncoding.UTF8.GetBytes(AnsiDequotedStr(TJson.Serialize(Value), '"'));
//        B := TEncoding.UTF8.GetBytes(Info.Converter.ValueToXml(Value, ResourceInfo.FinalProp));
      Stream.Write(B[0], Length(B));
      Response.StatusCode := 200;
      Response.ContentLength := Stream.Size;
      Response.Content.CopyFrom(Stream, 0);
    end else
      Response.StatusCode := 204;
  finally
    Stream.Free;
  end;
end;

procedure TXDataRequestHandler.SerializeCriteria(Criteria: TCriteria;
  Objects: THashSet<TObject>; FireEvents: Boolean);
var
  Manager: TObjectManager;
  CriteriaCount: TCriteria;
  Writer: IEntityCollectionWriter;
  Cursor: ICriteriaCursor;
  Stream: TMemoryStream;
  EntityCount: Int64;
  CountResult: TCriteriaResult;
  Obj: TObject;
  ResultClass: TClass;
  QueryInfo: TXDataQueryInfo;
begin
  QueryInfo := GetQueryInfo(XModel.GetEntityTypeByClass(Criteria.Clazz));
  Manager := CurrentManager;
  CriteriaCount := nil;
  try
    if not QueryInfo.IsEmpty then
      UpdateCriteria(Criteria);

    if FireEvents then
    begin
      OnEntitySetRetrieve(Manager, Criteria);
      NotifyEntityList(Criteria);
    end;

    if (QueryInfo.InlineCount = TQueryInlineCount.AllPages) or ResourceInfo.IsCount then
    begin
      CriteriaCount := Criteria.Clone;
      CriteriaCount.AutoDestroy := False;
      CriteriaCount.Take(-1);
      CriteriaCount.Skip(0);
      CriteriaCount.OrderItems.Clear;
      CriteriaCount.SetProjections(TProjections.Sql<Int64>('Count(*)'));
      CountResult := CriteriaCount.UniqueValue;
      try
        EntityCount := CountResult.Values[0];
      finally
        CountResult.Free;
      end;
    end
    else
      EntityCount := -1;

    if ResourceInfo.IsCount then
    begin
      // if IsCount, then we should just return the number of records, not the record themselves
      CheckAcceptTextType;
      Response.ContentType := 'text/plain';
      Response.StatusCode := 200;
      Response.Close(TEncoding.UTF8.GetBytes(IntToStr(EntityCount)));
    end
    else
    begin
      // serialize the results
      Cursor := Criteria.Open;
      Stream := TMemoryStream.Create;
      try
        Writer := PayloadFactory.CreateEntityCollectionWriter(Stream);
        Writer.SetExpandLevel(ExpandLevel);
        Writer.SetExpander(CreateExpander(Criteria.Clazz));
        Writer.SetSerializeInstanceRef(SerializeInstanceRef);
        Writer.SetSerializeInstanceType(SerializeInstanceType);
        if EntityCount >= 0 then
          Writer.SetInlineCount(EntityCount);
        Response.ContentType := Writer.ContentType;
        CheckAcceptApplicationType;
        if Criteria.HasProjection then
          ResultClass := TCriteriaResult
        else
          ResultClass := Criteria.Clazz;
        Writer.Start(ResultClass);
        while Cursor.Next do
        begin
          Obj := Cursor.Fetch;
          if ResultClass = TCriteriaResult then
            Objects.Add(Obj);
          Writer.SerializeItem(Obj);
        end;
        Writer.Finish;
        Writer.Flush;
        Response.StatusCode := 200;
        Response.ContentLength := Stream.Size;
        Response.Content.CopyFrom(Stream, 0);
      finally
        Writer := nil;
        Stream.Free;
        Cursor := nil; // destroy before destroying manager
      end;
    end;
  finally
    CriteriaCount.Free;
  end;
end;

procedure TXDataRequestHandler.SerializeEntity(const Entity: TObject;
  BaseType: TXDataEntityType);
var
  Stream: TStream;
  Writer: IEntityWriter;
begin
  Stream := TMemoryStream.Create;
  try
    Writer := PayloadFactory.CreateEntityWriter(Stream);
    Writer.SetExpandLevel(ExpandLevel);
    Writer.SetExpander(CreateExpander(Entity.ClassType));
    Writer.SetSerializeInstanceRef(SerializeInstanceRef);
    Writer.SetSerializeInstanceType(SerializeInstanceType);
    Response.ContentType := Writer.ContentType;
    CheckAcceptApplicationType;
    Writer.WriteEntity(Entity, XModel.GetEntityTypeInfo(BaseType).Clazz);
    Writer.Flush;
    Response.ContentLength := Stream.Size;
    Response.Content.CopyFrom(Stream, 0);
  finally
    // we need to force writer destruction before Stream because there are some
    // corner cases where upon destruction writer wants to flush content
    // and stream might be destroyed already
    Writer := nil;
    Stream.Free;
  end;
end;

procedure TXDataRequestHandler.SetResponseLocationHeader(Entity: TObject);
begin
  Response.Headers.SetValue(LocationHeader, AbsoluteUrl(
    TSparkleUtils.PercentEncode(XModel.CanonicalUrl(Entity))));
end;

procedure TXDataRequestHandler.UpdateCriteria(const Criteria: TCriteria);
var
  Builder: TXDataCriteriaBuilder;
  EntityType: TXDataEntityType;
begin
  EntityType := Self.XModel.GetEntityTypeByClass(Criteria.Clazz);
  Builder := TXDataCriteriaBuilder.Create(Self.XModel, GetQueryInfo(EntityType));
  try
    Builder.UpdateCriteria(Criteria);
  finally
    Builder.Free;
  end;
end;

procedure TXDataRequestHandler.UpdateEntity;
var
  Manager: TObjectManager;
  Entity: TObject;
  IdValue: Variant;
  Clazz: TClass;
  Transaction: IDBTransaction;
  FindProc: TEntityFinderProc;
begin
  // Get the key predicated provided in URL
  GetEntityInfoFromPath(IdValue, Clazz);
  Manager := CurrentManager;
  Transaction := Manager.Connection.BeginTransaction;
  try
    OnBeforeEntityUpdate(Manager, Clazz, IdValue);

    // add an empty object in memory
    Entity := CreateInstance(Clazz);
    try
      FindProc :=
        function(Clazz: TClass; IdValue: Variant): TObject
        begin
          Result := CreateInstance(Clazz);
          XModel.Explorer.SetIdValue(Result, IdValue, FindProc);
        end;
      XModel.Explorer.SetIdValue(Entity, IdValue, FindProc);

      // we don't need FindProc anymore so clear it right away. If we don't,
      // further errors in this procedure might leave FindProc assigned and might
      // raise a memory leak (a Delphi bug probably?)
      FindProc := nil;
      Manager.Update(Entity);
    except
      Entity.Free;
      raise;
    end;

    // update the object properties from Json payload and perform changes
    DeserializeEntity(Entity, nil, Manager,
      procedure(DeserializedObject: TObject)
      begin
        OnEntityUpdate(Manager, Entity);
        NotifyEntityModifying(Entity);
        DoFlush(Manager, Entity);
      end
    );

    // refresh object to write it back to the client
    Manager.Refresh(Entity);
    Transaction.Commit;
  except
    Transaction.Rollback;
    raise;
  end;
  NotifyEntityModified(Entity);

  // Send response
  Response.StatusCode := 200;
  SerializeEntity(Entity, ResourceInfo.EntitySet.EntityType);
end;

procedure TXDataRequestHandler.UpdateStreamProperty;
var
  Manager: TObjectManager;
  Entity: TObject;
  BlobValue: TBlob;
  Transaction: IDBTransaction;
begin
  Manager := CurrentManager;
  Transaction := Manager.Connection.BeginTransaction;
  try
    Entity := GetEntityFromNavigationPath(Manager);
    Assert(ResourceInfo.FinalProp <> nil);
    Assert(ResourceInfo.FinalProp.TypeKind = TXTypeKind.xtStream);

    // get blob content, set in property and save changes
    BlobValue.AsBytes := Request.Content;

    XModel.SetPropertyBlobValue(Entity, ResourceInfo.FinalProp, BlobValue);
    OnStreamPropertyUpdate(Manager, Entity, ResourceInfo.FinalProp, BlobValue);
    NotifyEntityModifying(Entity);
    DoFlush(Manager, Entity);
    Transaction.Commit;
  except
    Transaction.Rollback;
    raise;
  end;
  NotifyEntityModified(Entity);

  // Send response
  Response.StatusCode := 204;
end;

procedure TXDataRequestHandler.UpsertEntity;
var
  Manager: TObjectManager;
  Entity: TObject;
  IdValue: Variant;
  Clazz: TClass;
  BaseType: TXDataEntityType;
//  HadId: boolean;
  Transaction: IDBTransaction;
begin
  // Get the key predicated provided in URL
  GetEntityInfoFromPath(IdValue, Clazz);
  Manager := CurrentManager;
  Transaction := Manager.Connection.BeginTransaction;
  try
    // Deserialize object tree from JSON payload and merge into manager
    Entity := nil;

//    HadId := false;
    BaseType := ResourceInfo.EntitySet.EntityType;
    OnBeforeEntityUpsert(Manager, Clazz, IdValue);
    DeserializeEntity(nil, BaseType, Manager,
      procedure(DeserializedObject: TObject)
      var
        FindProc: TEntityFinderProc;
      begin
        FindProc :=
          function(Clazz: TClass; IdValue: Variant): TObject
          begin
            Result := CreateInstance(Clazz);
            XModel.Explorer.SetIdValue(Result, IdValue, FindProc);
          end;
        if not XModel.Explorer.HasIdValue(DeserializedObject) then
        begin
          XModel.Explorer.SetIdValue(DeserializedObject, IdValue, FindProc);
        end;
        FindProc := nil; // avoid memory leak

        if not _FixEntityModifyingOnUpsert then
          NotifyEntityModifying(DeserializedObject);
        Entity := Manager.Merge<TObject>(DeserializedObject);
        if _FixEntityModifyingOnUpsert then
          NotifyEntityModifying(Entity);
        OnEntityUpdate(Manager, Entity);
        DoFlush(Manager, Entity);
      end
    );

    // refresh object to write it back to the client
    Manager.Refresh(Entity);
    Transaction.Commit;
  except
    Transaction.Rollback;
    raise;
  end;
  NotifyEntityModified(Entity);

  // send response
//  if HadId then
    Response.StatusCode := 200;
//  else
//  begin
//    Response.StatusCode := 201;
//    SetResponseLocationHeader(Entity);
//  end;
  SerializeEntity(Entity, BaseType);
end;

procedure TXDataRequestHandler.ReplicateEntity;
var
  Manager: TObjectManager;
  Entity: TObject;
//  Clazz: TClass;
  BaseType: TXDataEntityType;
//  HadId: boolean;
  Transaction: IDBTransaction;
begin
  // Get the key predicated provided in URL
  Manager := CurrentManager;
  Transaction := Manager.Connection.BeginTransaction;
  try
    // Deserialize object tree from JSON payload and merge into manager
    Entity := nil;

//    HadId := false;
    BaseType := ResourceInfo.EntitySet.EntityType;
//    OnBeforeEntityUpsert(Manager, Clazz, IdValue);
    DeserializeEntity(nil, BaseType, Manager,
      procedure(DeserializedObject: TObject)
      begin
        NotifyEntityInserting(DeserializedObject);
        Entity := Manager.Replicate<TObject>(DeserializedObject);
        OnEntityReplicate(Manager, Entity);
        DoFlush(Manager, Entity);
      end
    );

    // refresh object to write it back to the client
    Manager.Refresh(Entity);
    Transaction.Commit;
  except
    Transaction.Rollback;
    raise;
  end;
  NotifyEntityInserted(Entity);

  // send response
//  if HadId then
//    Response.StatusCode := 200;
//  else
//  begin
    Response.StatusCode := 201;
    SetResponseLocationHeader(Entity);
//  end;
  SerializeEntity(Entity, BaseType);
end;

{ TXDataAuthorizationContext }

constructor TXDataAuthorizationContext.Create(AHandler: TXDataRequestHandler);
begin
  inherited Create;
  FHandler := AHandler;
end;

function TXDataAuthorizationContext.GetHandler: TXDataRequestHandler;
begin
  Result := FHandler;
end;

function TXDataAuthorizationContext.GetUser: IUserIdentity;
begin
  Result := FHandler.Request.User;
end;

{ TActionExecuter }

function TActionExecuter.BuildArgs(Params: IXDataActionParams): TArray<TValue>;
var
  Args: TArray<TValue>;
  I: Integer;
  ParamDef: TXDataParamDef;
begin
  SetLength(Args, Action.Parameters.Count);
  for I := 0 to Action.Parameters.Count - 1 do
  begin
    ParamDef := Action.Parameters[I];
    if Params.HasValue(ParamDef.Name) then
    begin
      Args[I] := Params.GetValue(ParamDef.Name);

      // if argument is a var parameter, force it to be exactly same type
      // of the parameter, otherwise a "type mismatch" error will happen.
      // This is rare, one case where this happened is passing a TArray<byte>
      // (and probably any dynamic array) as nil. The server will get it as a TValue.Empty
      // without type info, and a type mismatch error will raise
      if ParamDef.Output and (Args[I].TypeInfo <> ParamDef.RttiType.Handle) then
        Args[I] := Args[I].Cast(ParamDef.RttiType.Handle);
    end
    else
    begin
      if ParamDef.Input then
      begin
        if ParamDef.DefaultValue.IsEmpty then
          raise EXDataHttpMissingParameter.Create(ParamDef.Name)
        else
          Args[I] := ParamDef.DefaultValue;
      end
      else
        TValue.Make(nil, ParamDef.RttiType.Handle, Args[I]);
    end;
  end;

  Result := Args;
end;

constructor TActionExecuter.Create(AHandler: TXDataRequestHandler; AActionSelection: TXDataActionSelection);
begin
  inherited Create;
  FHandler := AHandler;
  FActionSelection := AActionSelection;
end;

function TActionExecuter.CreateServiceInterface: TValue;
var
  ServiceObj: TValue;
  Controller: TXDataController;
begin
  // TODO: later this might be more complex, supporting different lifetime for Service instance,
  // and also creating the instance using different constructors and/or under specific context

  Controller := Action.Controller; // just to make typing easier
  if Controller.ServiceClass = nil then
    raise EXDataHttpMissingServiceImplementation.Create(Controller.Name);
  ServiceObj := Handler.CreateInstance(Controller.ServiceClass);
  try
    if not ServiceObj.TryCast(XModel.GetControllerInfo(Controller).InterfaceType, Result) then
      raise EXDataHttpCannotRetrieveServiceInterface.Create(XModel.GetControllerInfo(Controller).InterfaceTypeName, Controller.ServiceClass.ClassName);
  except
{$IFNDEF AUTOREFCOUNT}
    ServiceObj.AsObject.Free;
{$ENDIF}
    raise;
  end;
end;

procedure TActionExecuter.Execute;
var
  Params: IXDataActionParams;
  ResultValue: TValue;
  ServiceInterface: TValue;
  Args: TArray<TValue>;
begin
  // read params, either from Path, Query or from Body
  Params := TXDataActionParams.Create;
  ReadPathParams(FActionSelection.PathParams, Params);
  if Action.QueryParamCount > 0 then
    ReadQueryParams(Params);
  if Action.IsParamStream then
    ReadStreamParam(Params)
  else
  if Action.BodyParamCount > 0 then
    ReadBodyParams(Params);

  // now build the actual argument values used to invoke the method
  Args := BuildArgs(Params);

  // Create service class instance and invoke
  ServiceInterface := CreateServiceInterface;

  // invoke function
  ResultValue := ActionInfo.Method.Invoke(ServiceInterface, Args);
  try
    // write result
    if Action.IsResultStream then
      SendStreamResult(ResultValue.AsType<TStream>)
    else
    if Action.IsResultCriteria then
      SendCriteriaResult(ResultValue.AsType<TCriteria>)
    else
    if (ActionInfo.ReturnType <> nil) or Action.HasOutputParams then
      SendResult(ResultValue, Args)
    else
      Response.StatusCode := 204;
  finally
    {$IFNDEF AUTOREFCOUNT}
    if ResultValue.IsObject and (ResultValue.AsObject <> nil) and not ManagedObjects.Contains(ResultValue.AsObject) then
      ManagedObjects.Add(ResultValue.AsObject);
    {$ENDIF}
  end;
end;

function TActionExecuter.GetAction: TXDataAction;
begin
  Result := FActionSelection.Action;
end;

function TActionExecuter.GetActionInfo: TXDataAureliusActionInfo;
begin
  Result := XModel.GetActionInfo(Action);
end;

function TActionExecuter.ManagedObjects: THashSet<TObject>;
begin
  Result := Handler.ManagedObjects;
end;

procedure TActionExecuter.ReadBodyParams(Params: IXDataActionParams);
var
  Stream: TStream;
  Reader: IParamsReader;
begin
  Stream := TBytesStream.Create(Request.Content);
  try
    Reader := Handler.PayloadFactory.CreateParamsReader(Stream, Handler.CreateSolver, ManagedObjects);
    Reader.SetUnknownMemberHandling(Handler.UnknownMemberHandling);
    Handler.CheckRequestContentType(Reader.ContentType);
    Reader.ReadParams(Action, Params);
  finally
    Stream.Free;
  end;
end;

procedure TActionExecuter.ReadPathParams(PathParams: TList<string>; Params: IXDataActionParams);
var
  ParamDef: TXDataParamDef;
  Value: TValue;
  I: Integer;
  ValueIndex: Integer;
  Segment: TXDataRouteSegment;
  UsedParamValues: TArray<Boolean>;
begin
  ValueIndex := 0;
  SetLength(UsedParamValues, Action.PathParamCount);
  for I := 0 to Action.RouteInfo.SegmentCount - 1 do
  begin
    Segment := Action.RouteInfo.Segments[I];
    if Segment.IsParam then
    begin
      Assert(Segment.ParamIndex < Action.PathParamCount);
      UsedParamValues[Segment.ParamIndex] := True;
      ParamDef := Action.PathParams[Segment.ParamIndex];
      if ValueIndex < PathParams.Count then
      begin
        Value := BindUrlToValue(PathParams[ValueIndex], ParamDef.RttiType.Handle, ParamDef.UrlConverter);
        Params.SetValue(ParamDef.Name, Value);
        Inc(ValueIndex);
      end;
    end;
  end;
  for I := 0 to Length(UsedParamValues) - 1 do
    if not UsedParamValues[I] then
    begin
      ParamDef := Action.PathParams[I];
      if ValueIndex < PathParams.Count then
      begin
        Value := BindUrlToValue(PathParams[ValueIndex], ParamDef.RttiType.Handle, ParamDef.UrlConverter);
        Params.SetValue(ParamDef.Name, Value);
        Inc(ValueIndex);
      end;
    end;
end;

procedure TActionExecuter.ReadQueryParams(Params: IXDataActionParams);
var
  QueryParams: TArray<TPair<string, string>>;

  function FindQueryValue(const Name: string; var Value: string): Boolean;
  var
    QueryParam: TPair<string, string>;
  begin
    for QueryParam in QueryParams do
      if SameText(QueryParam.Key, Name) then
      begin
        Value := QueryParam.Value;
        Exit(True);
      end;
    Result := False;
  end;

  procedure ReadObjectFromQuery(Obj: TObject; AType: TXDataStructuredType);
  var
    I: Integer;
    Prop: TXDataScalarProperty;
    QueryValue: string;
    Value: TValue;
    PropInfo: TXDataAureliusPropInfo;
  begin
    for I := 0 to AType.ScalarPropertyCount - 1 do
    begin
      Prop := AType.GetScalarProperty(I);
      PropInfo := XModel.GetScalarPropertyInfo(Prop);
      if FindQueryValue(Prop.Name, QueryValue) then
      begin
        Value := BindUrlToValue(QueryValue, PropInfo.RttiInfo.RealType.Handle, Prop.UrlConverter);
        TRttiUtils.GetInstance.SetValue(PropInfo.RttiInfo.MemberRef, Obj, Value);
      end;
    end;
  end;

var
  ParamDef: TXDataParamDef;
  Value: TValue;
  QueryValue: string;
begin
  QueryParams := TSparkleUtils.GetQueryParams(Request.Uri.OriginalQuery);
  for ParamDef in Action.Parameters do
    if ParamDef.BindingMode = TBindingMode.FromURI then
    begin
      if ParamDef.ParamType is TXDataStructuredType then
      begin
        Assert(ParamDef.RttiType.IsInstance);
        Value := Handler.CreateInstance(ParamDef.RttiType.AsInstance.MetaclassType);
        ManagedObjects.Add(Value.AsObject);
        ReadObjectFromQuery(Value.AsObject, TXDataStructuredType(ParamDef.ParamType));
        Params.SetValue(ParamDef.Name, Value);
      end
      else
      if FindQueryValue(ParamDef.Name, QueryValue) then
      begin
        Value := BindUrlToValue(QueryValue, ParamDef.RttiType.Handle, ParamDef.UrlConverter);
        Params.SetValue(ParamDef.Name, Value);
      end;
    end;
end;

procedure TActionExecuter.ReadStreamParam(Params: IXDataActionParams);
var
  ParamDef: TXDataParamDef;
  LStreamParamIndex: Integer;
begin
  LStreamParamIndex := Action.ParamStreamIndex;
  if (LStreamParamIndex < 0) or (LStreamParamIndex >= Action.Parameters.Count) then
    raise EXDataInvalidStreamParamIndex.Create(Action.Name, LStreamParamIndex);
  ParamDef := Action.Parameters[LStreamParamIndex];
  Params.SetValue(ParamDef.Name, Request.ContentStream);
end;

function TActionExecuter.Request: THttpServerRequest;
begin
  Result := Handler.Request;
end;

function TActionExecuter.Response: THttpServerResponse;
begin
  Result := Handler.Response;
end;

procedure TActionExecuter.SendCriteriaResult(Criteria: TCriteria);
begin
  Criteria.AutoDestroy := False;
  Handler.SerializeCriteria(Criteria, ManagedObjects, False);
end;

procedure TActionExecuter.SendResult(const ResultValue: TValue; const Args: TArray<TValue>);
var
  Stream: TStream;
  Writer: IResultWriter;
  Obj: TObject;
begin
  // special case: ensure not found response for entities
  if Action.IsResultSingleObject
    and not XModel.Explorer.IsValueList(ActionInfo.ReturnType.AsInstance.MetaclassType)
    and not Action.HasOutputParams then
      if ResultValue.IsEmpty then
        raise EXDataHttpEntityNotFound.Create(Handler);

  Stream := TMemoryStream.Create;
  try
    Writer := Handler.PayloadFactory.CreateResultWriter(Stream);
    try
      Writer.SetExpandLevel(Handler.ExpandLevel);
      if Action.IsResultSingleObject then
        Writer.SetExpander(Handler.CreateExpander(ActionInfo.ReturnType.AsInstance.MetaclassType));
      Writer.SetSerializeInstanceRef(Handler.SerializeInstanceRef);
      Writer.SetSerializeInstanceType(Handler.SerializeInstanceType);
      Response.ContentType := Writer.ContentType;
      Handler.CheckAcceptApplicationType;
      Writer.WriteResult(ResultValue, Args, Action);
      Writer.Flush;
    finally
      // optimize this!
      if Handler.ActionResultDestruction = TActionResultDestruction.AllButLists then
        for Obj in Writer.WrittenObjects do
          if not ManagedObjects.Contains(Obj) then
            ManagedObjects.Add(Obj);
      Writer := nil; // destroy Writer before Stream!
    end;
    Response.StatusCode := 200;
    Response.ContentLength := Stream.Size;
    Response.Content.CopyFrom(Stream, 0);
  finally
    Stream.Free;
  end;
end;

procedure TActionExecuter.SendStreamResult(Stream: TStream);
begin
  if Stream.Size > 0 then
  begin
    Response.StatusCode := 200;
    Response.ContentLength := Stream.Size;
    Response.Content.CopyFrom(Stream, 0);
  end
  else
    Response.StatusCode := 204;
end;

function TActionExecuter.XModel: TXDataAureliusModel;
begin
  Result := Handler.XModel;
end;

initialization
  _FixEntityModifyingOnUpsert := True;
end.
