unit XData.Module.Base;

{$I XData.inc}

interface

uses
  Generics.Collections,
  Classes, SysUtils,
  Bcl.Json.Converters,
  XData.Module.ResourceInfo,
  XData.Security.Interfaces,
  XData.Security.Attributes,
  Sparkle.HttpServer.Context,
  Sparkle.HttpServer.Module,
  Sparkle.Security,
  Sparkle.Uri,
  XData.Model.Classes,
  XData.Payload.Factory;

const
  // these constants must later be changed to another unit
  ApplicationMediaTypeMask = 'application/*';
  TextMediaTypeMask = 'text/*';
  ContentTypeHeader = 'content-type';
  AcceptHeader = 'accept';
  LocationHeader = 'location';
  XHttpMethodOverrideHeader = 'x-http-method-override';
  Header_Origin = 'origin';
  Header_AccessControlRequestMethod = 'access-control-request-method';
  Header_AccessControlRequestHeaders = 'access-control-request-headers';
  Header_AccessControlAllowMethods = 'access-control-allow-methods';
  Header_AccessControlAllowHeaders = 'access-control-allow-headers';
  Header_AccessControlAllowOrigin = 'access-control-allow-origin';
  Header_AccessControlMaxAge = 'access-control-max-age';

type
  TEntitySetPermission = XData.Security.Attributes.TEntitySetPermission;
  TEntitySetPermissions = XData.Security.Attributes.TEntitySetPermissions;

const
  EntitySetPermissionsNone = XData.Security.Attributes.EntitySetPermissionsNone;
  EntitySetPermissionsAll = XData.Security.Attributes.EntitySetPermissionsAll;
  EntitySetPermissionsRead = XData.Security.Attributes.EntitySetPermissionsRead;
  EntitySetPermissionsWrite = XData.Security.Attributes.EntitySetPermissionsWrite;

type
  TXDataPutMode = (Update, Merge);
  TXDataPostMode = (Save, Replicate);
  TXDataFlushMode = (All, Single);
  TXDataRoutingPrecedence = (Crud, Service);
  TInstanceRefSerialization = Bcl.Json.Converters.TInstanceRefSerialization;
  TInstanceTypeSerialization = Bcl.Json.Converters.TInstanceTypeSerialization;
  TUnknownMemberHandling = Bcl.Json.Converters.TUnknownMemberHandling;

  TXDataBaseModule = class;

//  TXDataPayloadFormat = (Json, Atom);
  TXDataPayloadFormat = (Json);

  TXDataBaseRequestHandler = class
  private
    FResourceInfo: TXDataResourceInfo;
    FHttpContext: THttpServerContext;
    FModule: TXDataBaseModule;
    FAcceptLoaded: boolean;
    FAcceptList: TArray<string>;
    FAcceptAny: boolean;
    function GetRequest: THttpServerRequest;
    function GetResponse: THttpServerResponse;
    procedure UpdateAcceptList;
    function GetAcceptAny: boolean;
    function GetResourceInfo: TXDataResourceInfo;
    function GetPayloadFormat: TXDataPayloadFormat;
    function GetExpandLevel: integer;
    function GetModel: TXDataModel;
    function HasPermission(Permission: TEntitySetPermission; EntityType: TXDataEntityType = nil): Boolean; overload;
  strict protected
    function ErrorCodeFromClassName(const AClassName: string): string;
    function HasPermission(Action: TXDataAction): Boolean; overload; virtual;
    procedure HandleException(const E: Exception); virtual;
    procedure CheckAcceptApplicationType;
    procedure CheckAcceptTextType;
    procedure OptionsResponse(const AllowMethods: string);
    function RemoveContentTypeParameter(const AContentType: string): string;
  protected
    procedure CheckRequestContentType(const AType: string);
    function PayloadFactory: TXDataPayloadFactory; virtual;
    procedure CleanUp; virtual;
    procedure ProcessRequest; virtual;
  private
    procedure TryExecuteAction(Action: TXDataAction);
    procedure TryRetrieveEntitySet; virtual;
    procedure TryRetrieveEntity; virtual;
    procedure TryRetrieveEntityProperty; virtual;
    procedure TryRetrievePrimitiveProperty; virtual;
    procedure TryRetrieveCollectionProperty; virtual;
    procedure TryRetrieveValue; virtual;
    procedure TryRetrieveStreamProperty; virtual;
    procedure TryRetrieveEntitySchema; virtual;

    procedure TryCreateCollectionPropertyItem; virtual;

    procedure TryCreateEntity; virtual;
    procedure TryUpdateEntity; virtual;
    procedure TryMergeEntity; virtual;
    procedure TryDeleteEntity; virtual;
    procedure TryUpsertEntity; virtual;
    procedure TryReplicateEntity; virtual;

    procedure TryUpdateStreamProperty; virtual;
    procedure TryDeleteStreamProperty; virtual;

    function GetPutMode: TXDataPutMode;
    function GetPostMode: TXDataPostMode;
    function GetFlushMode: TXDataFlushMode;
    function GetRoutingPrecedence: TXDataRoutingPrecedence;
    function GetProxyLoadDepth: Integer;
    function GetProxyListLoadDepth: Integer;
    function GetSerializeInstanceRef: TInstanceRefSerialization;
    function GetSerializeInstanceType: TInstanceTypeSerialization;
    function GetUnknownMemberHandling: TUnknownMemberHandling;
  strict protected
    procedure RetrieveServiceMetadata; virtual;
    procedure RetrieveServiceModel; virtual;
    procedure RetrieveServiceDocument; virtual;

    procedure RetrieveEntitySet; virtual;
    procedure RetrieveEntity; virtual;
    procedure RetrievePrimitiveProperty; virtual;
    procedure RetrieveCollectionProperty; virtual;
    procedure RetrieveValue; virtual;
    procedure RetrieveStreamProperty; virtual;
    procedure RetrieveEntitySchema; virtual;

    procedure CreateCollectionPropertyItem; virtual;

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

    procedure UpdateStreamProperty; virtual;
    procedure DeleteStreamProperty; virtual;

    procedure ExecuteAction; virtual;
  strict protected
    property Module: TXDataBaseModule read FModule;
    property Model: TXDataModel read GetModel;
    property HttpContext: THttpServerContext read FHttpContext;
  public
    constructor Create(const AModule: TXDataBaseModule; const AHttpContext: THttpServerContext); virtual;
    destructor Destroy; override;
    procedure SendErrorResponse(StatusCode: integer; const ErrorCode, ErrorMessage: string); virtual;
    function AcceptContains(const AValue: string): boolean;
    property Request: THttpServerRequest read GetRequest;
    property Response: THttpServerResponse read GetResponse;
    property ResourceInfo: TXDataResourceInfo read GetResourceInfo;
    property AcceptAny: boolean read GetAcceptAny;
    property PayloadFormat: TXDataPayloadFormat read GetPayloadFormat;
    property ExpandLevel: integer read GetExpandLevel;
    property PutMode: TXDataPutMode read GetPutMode;
    property PostMode: TXDataPostMode read GetPostMode;
    property FlushMode: TXDataFlushMode read GetFlushMode;
    property RoutingPrecedence: TXDataRoutingPrecedence read GetRoutingPrecedence;
    property ProxyLoadDepth: Integer read GetProxyLoadDepth;
    property ProxyListLoadDepth: Integer read GetProxyListLoadDepth;
    property SerializeInstanceRef: TInstanceRefSerialization read GetSerializeInstanceRef;
    property SerializeInstanceType: TInstanceTypeSerialization read GetSerializeInstanceType;
    property UnknownMemberHandling: TUnknownMemberHandling read GetUnknownMemberHandling;
  end;

  TXDataBaseModule = class(THttpServerModule)
  private
    FModel: TXDataModel;
    FOwnsModel: boolean;
    FAccessControlAllowOrigin: string;
    FUserName: string;
    FPassword: string;
    FBasicAuthentication: TBasicAuthenticationProvider;
    FBetaFeatures: boolean;
    FPermissions: TDictionary<string, TEntitySetPermissions>;
    FDefaultPermissions: TEntitySetPermissions;
    FPutMode: TXDataPutMode;
    FPostMode: TXDataPostMode;
    FFlushMode: TXDataFlushMode;
    FRoutingPrecedence: TXDataRoutingPrecedence;
    FProxyLoadDepth: Integer;
    FProxyListLoadDepth: Integer;
    FDefaultExpandLevel: integer;
    FSerializeInstanceRef: TInstanceRefSerialization;
    FSerializeInstanceType: TInstanceTypeSerialization;
    FUnknownMemberHandling: TUnknownMemberHandling;
    FEnableEntityKeyAsSegment: Boolean;
  strict protected
    function CreateBaseHandler(const C: THttpServerContext): TXDataBaseRequestHandler; virtual;
  protected
    function HasPermission(Permission: TEntitySetPermission; EntitySet: TXDataEntitySet): Boolean; virtual;
    function GetPayloadFactory(const C: TXDataBaseRequestHandler): TXDataPayloadFactory; virtual; abstract;
    property Model: TXDataModel read FModel;
    property OwnsModel: boolean read FOwnsModel write FOwnsModel;
    property BetaFeatures: boolean read FBetaFeatures write FBetaFeatures;
  public
    constructor Create(const AModel: TXDataModel; const ABaseUrl: string); reintroduce;
    destructor Destroy; override;
    procedure ProcessRequest(const C: THttpServerContext); override;
  public
    procedure SetEntitySetPermissions(const EntitySetName: string; Permissions: TEntitySetPermissions);
    property AccessControlAllowOrigin: string read FAccessControlAllowOrigin write FAccessControlAllowOrigin;
    property UserName: string read FUserName write FUserName;
    property Password: string read FPassword write FPassword;
    property DefaultExpandLevel: integer read FDefaultExpandLevel write FDefaultExpandLevel;
    property PutMode: TXDataPutMode read FPutMode write FPutMode;
    property PostMode: TXDataPostMode read FPostMode write FPostMode;
    property FlushMode: TXDataFlushMode read FFlushMode write FFlushMode;
    property RoutingPrecedence: TXDataRoutingPrecedence read FRoutingPrecedence write FRoutingPrecedence;
    property ProxyLoadDepth: Integer read FProxyLoadDepth write FProxyLoadDepth;
    property ProxyListLoadDepth: Integer read FProxyListLoadDepth write FProxyListLoadDepth;
    property SerializeInstanceRef: TInstanceRefSerialization read FSerializeInstanceRef write FSerializeInstanceRef;
    property SerializeInstanceType: TInstanceTypeSerialization read FSerializeInstanceType write FSerializeInstanceType;
    property UnknownMemberHandling: TUnknownMemberHandling read FUnknownMemberHandling write FUnknownMemberHandling;
    property EnableEntityKeyAsSegment: Boolean read FEnableEntityKeyAsSegment write FEnableEntityKeyAsSegment;
  end;

implementation

uses
  Types, StrUtils, System.Character,
  Sparkle.Http.Headers,
  Bcl.Json.Writer,
  Bcl.Json.Serializer,
  XData.Consts,
  XData.Payload.Writer,
  XData.Module.Exceptions,
  XData.Sys.Exceptions,
  XData.Utils;

{ TXDataBaseModule }

constructor TXDataBaseModule.Create(const AModel: TXDataModel;
  const ABaseUrl: string);
var
  SelfPtr: Pointer;
begin
  inherited Create(ABaseUrl);
  FModel := AModel;
  FOwnsModel := false;
  FPermissions := TDictionary<string, TEntitySetPermissions>.Create;
  FDefaultPermissions := EntitySetPermissionsAll;
  FPutMode := TXDataPutMode.Merge; // default now
  FPostMode := TXDataPostMode.Save; // temporary default, we will change to replicavte
  FFlushMode := TXDataFlushMode.All;
  FRoutingPrecedence := TXDataRoutingPrecedence.Crud;
  FUnknownMemberHandling := TUnknownMemberHandling.Error;
  SelfPtr := Self;
  FBasicAuthentication := TSimpleBasicAuthenticationProvider.Create(
    function(AUserName, APassword: string): boolean
    var
      Module: TXDataBaseModule;
    begin
      Module := TXDataBaseModule(SelfPtr);
      Result := (Module.UserName = AUserName) and (Module.Password = APassword);
    end
  );
end;

function TXDataBaseModule.CreateBaseHandler(const C: THttpServerContext): TXDataBaseRequestHandler;
begin
  Result := TXDataBaseRequestHandler.Create(Self, C);
end;

destructor TXDataBaseModule.Destroy;
begin
  if OwnsModel then
    FModel.Free;
  FBasicAuthentication.Free;
  FPermissions.Free;
  inherited;
end;

function TXDataBaseModule.HasPermission(Permission: TEntitySetPermission;
  EntitySet: TXDataEntitySet): Boolean;
var
  Permissions: TEntitySetPermissions;
begin
  if not FPermissions.TryGetValue(LowerCase(EntitySet.Name), Permissions) then
    Permissions := FDefaultPermissions;
  Result := Permission in Permissions;
end;

procedure TXDataBaseModule.ProcessRequest(const C: THttpServerContext);
var
  Context: TXDataBaseRequestHandler;
begin
  C.Response.Headers.SetValue(XDataHeaderVersion, '2');
  if (UserName <> '') and (Password <> '') then
  begin
    if not FBasicAuthentication.Authenticate(C) then
    begin
      C.Response.StatusCode := 401;
      C.Response.Headers.SetValue('www-authenticate', 'Basic');
      Exit;
    end;
  end;

  Context := CreateBaseHandler(C);
  try
    Context.ProcessRequest;
  finally
    Context.Free;
  end;
end;

procedure TXDataBaseModule.SetEntitySetPermissions(const EntitySetName: string;
  Permissions: TEntitySetPermissions);
begin
  if EntitySetName = '*' then
    FDefaultPermissions := Permissions
  else
    FPermissions.AddOrSetValue(LowerCase(EntitySetName), Permissions);
end;

//procedure TXDataBaseModule.RetrieveServiceMetadata(const C: TXDataHttpContext);
//var
//  EdmModel: TEdmxRoot;
//  Writer: TEdmxWriter;
//  Stream: TMemoryStream;
//begin
//  Stream := TMemoryStream.Create;
//  try
//    EdmModel := TEdmxRoot.Create;
//    try
//      TModelConverter.ConvertModelToEdm(FModel, EdmModel);
//      Writer := TEdmxWriter.Create(Stream);
//      try
//        Writer.Version := TCsdlVersion.Csdl30;
//        Writer.WriteEdmx(EdmModel);
//      finally
//        Writer.Free;
//      end;
//    finally
//      EdmModel.Free;
//    end;
//    C.Response.StatusCode := 200;
//    C.Response.ContentType := XmlMediaType;
//    CheckApplicationType(C);
//    C.Response.Content.CopyFrom(Stream, 0);
//  finally
//    Stream.Free;
//  end;
//end;

{ TXDataHttpContext }

function TXDataBaseRequestHandler.AcceptContains(const AValue: string): boolean;
var
  AcceptValue: string;
begin
  UpdateAcceptList;
  for AcceptValue in FAcceptList do
    if Lowercase(AValue) = AcceptValue then
      Exit(true);
  Result := false;
end;

procedure TXDataBaseRequestHandler.CheckAcceptApplicationType;
begin
  if not (AcceptAny or AcceptContains(Response.ContentType) or AcceptContains(ApplicationMediaTypeMask)) then
    raise EXDataHttpUnsupportedMediaType.Create(Request.Headers.Get(AcceptHeader));
end;

procedure TXDataBaseRequestHandler.CheckAcceptTextType;
begin
  if not (AcceptAny or AcceptContains(Response.ContentType) or AcceptContains(TextMediaTypeMask)) then
    raise EXDataHttpUnsupportedMediaType.Create(Request.Headers.Get(AcceptHeader));
end;

procedure TXDataBaseRequestHandler.CheckRequestContentType(const AType: string);
var
  ContentType: string;
begin
  ContentType := RemoveContentTypeParameter(Request.Headers.Get(ContentTypeHeader));
  if not ((ContentType = '') or SameText(ContentType, AType)) then
    raise EXDataHttpUnsupportedMediaType.Create(ContentType);
end;

procedure TXDataBaseRequestHandler.CleanUp;
begin
end;

constructor TXDataBaseRequestHandler.Create(const AModule: TXDataBaseModule; const AHttpContext: THttpServerContext);
begin
  FHttpContext := AHttpContext;
  FModule := AModule;
  FResourceInfo := TXDataResourceInfo.Create(FModule.Model, AModule.GetRelativeSegments(AHttpContext.Request.Uri),
    AModule.EnableEntityKeyAsSegment);
  FResourceInfo.ServiceFirst := RoutingPrecedence = TXDataRoutingPrecedence.Service;
  FResourceInfo.HttpMethod := AHttpContext.Request.Method;
end;

procedure TXDataBaseRequestHandler.CreateCollectionPropertyItem;
begin

end;

procedure TXDataBaseRequestHandler.CreateEntity;
begin

end;

procedure TXDataBaseRequestHandler.DeleteEntity;
begin

end;

procedure TXDataBaseRequestHandler.DeleteStreamProperty;
begin

end;

destructor TXDataBaseRequestHandler.Destroy;
begin
  FResourceInfo.Free;
  inherited;
end;

function TXDataBaseRequestHandler.ErrorCodeFromClassName(
  const AClassName: string): string;
begin
  if (Length(AClassName) > 2) and (AClassName[1] = 'E') and
    {$IFDEF DELPHIXE4_LVL}
    AClassName[2].IsUpper
    {$ELSE}
    IsUpper(AClassName[2])
    {$ENDIF}
    then
    Result := Copy(AClassName, 2, MaxInt)
  else
    Result := AClassName;
end;

procedure TXDataBaseRequestHandler.ExecuteAction;
begin

end;

function TXDataBaseRequestHandler.GetAcceptAny: boolean;
begin
  UpdateAcceptList;
  Result := FAcceptAny;
end;

function TXDataBaseRequestHandler.GetExpandLevel: integer;
var
  Level: integer;
begin
  if Request.Headers.Exists(XDataHeaderExpandLevel)
    and TryStrToInt(Request.Headers.Get(XDataHeaderExpandLevel), Level) then
    Result := Level
  else
  if Request.Headers.Exists(XDataHeaderExpandLevel2)
    and TryStrToInt(Request.Headers.Get(XDataHeaderExpandLevel2), Level) then
    Result := Level
  else
    Result := FModule.DefaultExpandLevel;
end;

function TXDataBaseRequestHandler.GetModel: TXDataModel;
begin
  Result := FModule.Model;
end;

function TXDataBaseRequestHandler.GetPayloadFormat: TXDataPayloadFormat;
begin
  Result := TXDataPayloadFormat.Json; // only json for now

//  case QueryInfo.Format of
//    TQueryPayloadFormat.Atom, TQueryPayloadFormat.Xml:
//      Result := TXDataPayloadFormat.Atom;
//    TQueryPayloadFormat.VerboseJson, TQueryPayloadFormat.Json:
//      Result := TXDataPayloadFormat.Json;
////    TQueryPayloadFormat.Custom: ;
//  else
////    Result := DefaultPayloadFormat;
//    Result := TXDataPayloadFormat.Json;
//
//    // Quick parsing of accept header. For now let's keep it simple on interpreting it.
//    // Even web browsers don't use Accept header very strictly, so let's just look for "json" words
//    if Request.Headers.Exists('accept') then
//    begin
//      if (Result <> TXDataPayloadFormat.Json) then
//        if Pos('application/json', Request.Headers.Get('accept')) > 0 then
//          Result := TXDataPayloadFormat.Json;
//      if (Result <> TXDataPayloadFormat.Atom) then
//        if (Pos('application/atom+xml', Request.Headers.Get('accept')) > 0)then
//          Result := TXDataPayloadFormat.Atom;
//    end;
//  end;
end;

function TXDataBaseRequestHandler.GetProxyListLoadDepth: Integer;
var
  HeaderValue: string;
begin
  if Request.Headers.GetIfExists(XDataHeaderProxyListLoadDepth, HeaderValue) then
  begin
    if not TryStrToInt(HeaderValue, Result) then
      raise EXDataHttpInvalidHeaderValue.Create(XDataHeaderProxyListLoadDepth, HeaderValue);
  end
  else
    Result := FModule.ProxyListLoadDepth;
end;

function TXDataBaseRequestHandler.GetProxyLoadDepth: Integer;
var
  HeaderValue: string;
begin
  if Request.Headers.GetIfExists(XDataHeaderProxyLoadDepth, HeaderValue) then
  begin
    if not TryStrToInt(HeaderValue, Result) then
      raise EXDataHttpInvalidHeaderValue.Create(XDataHeaderProxyLoadDepth, HeaderValue);
  end
  else
    Result := FModule.ProxyLoadDepth;
end;

function TXDataBaseRequestHandler.GetPutMode: TXDataPutMode;
var
  HeaderValue: string;
begin
  if Request.Headers.GetIfExists(XDataHeaderPutMode, HeaderValue) then
  begin
    if SameText(HeaderValue, 'update') then
      Result := TXDataPutMode.Update
    else
    if SameText(HeaderValue, 'merge') then
      Result := TXDataPutMode.Merge
    else
      raise EXDataHttpInvalidHeaderValue.Create(XDataHeaderPutMode, HeaderValue);
  end
  else
    Result := FModule.PutMode;
end;

function TXDataBaseRequestHandler.GetPostMode: TXDataPostMode;
var
  HeaderValue: string;
begin
  if Request.Headers.GetIfExists(XDataHeaderPostMode, HeaderValue) then
  begin
    if SameText(HeaderValue, 'save') then
      Result := TXDataPostMode.Save
    else
    if SameText(HeaderValue, 'replicate') then
      Result := TXDataPostMode.Replicate
    else
      raise EXDataHttpInvalidHeaderValue.Create(XDataHeaderPostMode, HeaderValue);
  end
  else
    Result := FModule.PostMode;
end;

function TXDataBaseRequestHandler.GetFlushMode: TXDataFlushMode;
var
  HeaderValue: string;
begin
  if Request.Headers.GetIfExists(XDataHeaderFlushMode, HeaderValue) then
  begin
    if SameText(HeaderValue, 'all') then
      Result := TXDataFlushMode.All
    else
    if SameText(HeaderValue, 'single') then
      Result := TXDataFlushMode.Single
    else
      raise EXDataHttpInvalidHeaderValue.Create(XDataHeaderFlushMode, HeaderValue);
  end
  else
    Result := FModule.FlushMode;
end;

function TXDataBaseRequestHandler.GetRequest: THttpServerRequest;
begin
  Result := FHttpContext.Request;
end;

function TXDataBaseRequestHandler.GetResourceInfo: TXDataResourceInfo;
begin
  if not FResourceInfo.Solved then
    FResourceInfo.Solve;
  Result := FResourceInfo;
end;

function TXDataBaseRequestHandler.GetResponse: THttpServerResponse;
begin
  Result := FHttpContext.Response;
end;

function TXDataBaseRequestHandler.GetRoutingPrecedence: TXDataRoutingPrecedence;
begin
  Result := FModule.RoutingPrecedence;
end;

function TXDataBaseRequestHandler.GetSerializeInstanceRef: TInstanceRefSerialization;
var
  HeaderValue: string;
begin
  if Request.Headers.GetIfExists(XDataSerializeInstanceRef, HeaderValue) then
  begin
    if SameText(HeaderValue, 'always') then
      Result := TInstanceRefSerialization.Always
    else
    if SameText(HeaderValue, 'ifrecursive') then
      Result := TInstanceRefSerialization.IfRecursive
//    else
//    if SameText(HeaderValue, 'never') then
//      Result := TInstanceRefSerialization.Never
    else
      raise EXDataHttpInvalidHeaderValue.Create(XDataSerializeInstanceRef, HeaderValue);
  end
  else
    Result := FModule.SerializeInstanceRef;
end;

function TXDataBaseRequestHandler.GetSerializeInstanceType: TInstanceTypeSerialization;
var
  HeaderValue: string;
begin
  if Request.Headers.GetIfExists(XDataSerializeInstanceType, HeaderValue) then
  begin
    if SameText(HeaderValue, 'always') then
      Result := TInstanceTypeSerialization.Always
    else
    if SameText(HeaderValue, 'ifneeded') then
      Result := TInstanceTypeSerialization.IfNeeded
//    else
//    if SameText(HeaderValue, 'never') then
//      Result := TInstanceRefSerialization.Never
    else
      raise EXDataHttpInvalidHeaderValue.Create(XDataSerializeInstanceType, HeaderValue);
  end
  else
    Result := FModule.SerializeInstanceType;
end;

function TXDataBaseRequestHandler.GetUnknownMemberHandling: TUnknownMemberHandling;
//var
//  HeaderValue: string;
begin
//  if Request.Headers.GetIfExists(XDataUnknownMemberHandling, HeaderValue) then
//  begin
//    if SameText(HeaderValue, 'igore') then
//      Result := TUnknownMemberHandling.Ignore
//    else
//    if SameText(HeaderValue, 'error') then
//      Result := TUnknownMemberHandling.Error
//    else
//      raise EXDataHttpInvalidHeaderValue.Create(XDataUnknownMemberHandling, HeaderValue);
//  end
//  else
    Result := FModule.UnknownMemberHandling;
end;

procedure TXDataBaseRequestHandler.HandleException(const E: Exception);
begin
  SendErrorResponse(500, ErrorCodeFromClassName(E.ClassName), E.Message);
end;

function TXDataBaseRequestHandler.HasPermission(Action: TXDataAction): Boolean;
begin
  Result := True;
end;

function TXDataBaseRequestHandler.HasPermission(
  Permission: TEntitySetPermission; EntityType: TXDataEntityType): Boolean;
var
  EntitySet: TXDataEntitySet;
begin
  if EntityType = nil then
    EntitySet := ResourceInfo.EntitySet
  else
    EntitySet := Model.DefaultEntitySet(EntityType);

  if EntitySet = nil then Exit(False);
  Result := Module.HasPermission(Permission, EntitySet);
end;

procedure TXDataBaseRequestHandler.MergeEntity;
begin

end;

procedure TXDataBaseRequestHandler.OptionsResponse(const AllowMethods: string);
begin
  Response.Headers.SetValue(Header_AccessControlAllowMethods, AllowMethods);
  Response.StatusCode := 200;
end;

function TXDataBaseRequestHandler.PayloadFactory: TXDataPayloadFactory;
begin
  Result := nil;
  Assert(false, 'Implement PayloadFactory');
end;

procedure TXDataBaseRequestHandler.ProcessRequest;
var
  Method: THttpMethod;
  XMethod: string;
  I: Integer;
  OptionsMethods: string;
begin
  try
    try
      Method := Request.MethodType;
      XMethod := Request.Method;

      // Method tunneling
      if (Method = THttpMethod.Post) and Request.Headers.Exists(XHttpMethodOverrideHeader) then
      begin
        XMethod := Request.Headers.Get(XHttpMethodOverrideHeader);
        if XMethod = 'PATCH' then
          Method := THttpMethod.Patch
        else
        if XMethod = 'PUT' then
          Method := THttpMethod.Put
        else
        if XMethod = 'DELETE' then
          Method := THttpMethod.Delete
        else
          raise EXDataHttpUnsupportedTunneledMethod.Create(XMethod);
      end;

      Response.StatusCode := 404; // status code

      // CORS support
      if Request.Headers.Exists(Header_Origin) and (Module.AccessControlAllowOrigin <> '') then
      begin
        if (Module.AccessControlAllowOrigin = '*') or (SameText(Request.Headers.Get(Header_Origin), Module.AccessControlAllowOrigin)) then
        begin
          Response.Headers.SetValue(Header_AccessControlAllowOrigin, Module.AccessControlAllowOrigin);

          if Request.Headers.Exists(Header_AccessControlRequestMethod) then
            Response.Headers.SetValue(Header_AccessControlAllowMethods, Request.Headers.Get(Header_AccessControlRequestMethod));

          if Request.Headers.Exists(Header_AccessControlRequestHeaders) then
            Response.Headers.SetValue(Header_AccessControlAllowHeaders, Request.Headers.Get(Header_AccessControlRequestHeaders));

          if Method = THttpMethod.Options then
            Response.Headers.SetValue(Header_AccessControlMaxAge, '1728000');
        end;
      end;

      case ResourceInfo.ResourceType of
        TXDataResourceType.EntitySet:
          case Method of
            THttpMethod.Get: TryRetrieveEntitySet;
            THttpMethod.Post:
              case PostMode of
                TXDataPostMode.Save: TryCreateEntity;
                TXDataPostMode.Replicate: TryReplicateEntity;
              end;
            THttpMethod.Options: OptionsResponse('GET,POST,OPTIONS');
          else
            Response.StatusCode := 405; // method not allowed
          end;

        TXDataResourceType.Entity:
          case Method of
            THttpMethod.Get: TryRetrieveEntity;
            THttpMethod.Put:
              case PutMode of
                TXDataPutMode.Update: TryUpdateEntity;
                TXDataPutMode.Merge: TryUpsertEntity;
              end;
            THttpMethod.Patch: TryMergeEntity;
            THttpMethod.Delete: TryDeleteEntity;
            THttpMethod.Options: OptionsResponse('GET,PUT,PATCH,DELETE,OPTIONS');
          else
            if not Module.BetaFeatures then
            begin
              Response.StatusCode := 405; // method not allowed
            end else
            begin
              if Request.Method = 'MERGE' then
                TryUpsertEntity
              else
                Response.StatusCode := 405;
            end;
          end;

        TXDataResourceType.EntityProperty:
          case Method of
            THttpMethod.Get: TryRetrieveEntityProperty;
            THttpMethod.Options: OptionsResponse('GET,OPTIONS');
          else
            Response.StatusCode := 405; // method not allowed
          end;

        TXDataResourceType.SimpleProperty:
          case Method of
            THttpMethod.Get: TryRetrievePrimitiveProperty;
            THttpMethod.Options: OptionsResponse('GET,OPTIONS');
          else
            Response.StatusCode := 405; // method not allowed
          end;

        TXDataResourceType.CollectionProperty:
          case Method of
            THttpMethod.Get: TryRetrieveCollectionProperty;
            THttpMethod.Post: TryCreateCollectionPropertyItem;
            THttpMethod.Options: OptionsResponse('GET,POST,OPTIONS');
          else
            Response.StatusCode := 405; // method not allowed
          end;

        TXDataResourceType.PropertyValue:
          case Method of
            THttpMethod.Get: TryRetrieveValue;
            THttpMethod.Options: OptionsResponse('GET,OPTIONS');
          else
            Response.StatusCode := 405; // method not allowed
          end;

        TXDataResourceType.StreamProperty:
          case Method of
            THttpMethod.Get: TryRetrieveStreamProperty;
            THttpMethod.Put,
            THttpMethod.Patch: TryUpdateStreamProperty;
            THttpMethod.Delete: TryDeleteStreamProperty;
            THttpMethod.Options: OptionsResponse('GET,PUT,PATCH,DELETE,OPTIONS');
          else
            Response.StatusCode := 405;
          end;

        TXDataResourceType.Action:
          begin
            if Method = THttpMethod.Options then
            begin
              OptionsMethods := 'OPTIONS';
              for I := 0 to ResourceInfo.Actions.Count - 1 do
                if not ContainsText(OptionsMethods, ResourceInfo.Actions[I].Action.HttpMethod) then
                  OptionsMethods := OptionsMethods + ',' + ResourceInfo.Actions[I].Action.HttpMethod;
              OptionsResponse(OptionsMethods);
            end
            else
            begin
              // remove actions that do not match http method
              I := 0;
              while I < ResourceInfo.Actions.Count do
              begin
                if ResourceInfo.Actions[I].Action.HttpMethod <> XMethod then
                  ResourceInfo.Actions.Delete(I)
                else
                  Inc(I);
              end;

              // Move this check to ExecuteAction when support for overloaded methods
              // is implemented. We might have more than one action and parameters will
              // define which action will be executed
              if ResourceInfo.Actions.Count = 1 then
                TryExecuteAction(ResourceInfo.Actions[0].Action)
              else
              if ResourceInfo.Actions.Count = 0 then
                Response.StatusCode := 405
              else
                raise EXDataHttpAmbiguousActionError.Create(ResourceInfo.Actions[0].Action.OperationId);
            end;
          end;

        TXDataResourceType.Metadata:
          case Method of
            THttpMethod.Get:
              Response.StatusCode := 404; // we will not return metadata for now
  //              RetrieveServiceMetadata(Context);
            THttpMethod.Options: OptionsResponse('GET,OPTIONS');
          else
            Response.StatusCode := 405; // method not allowed
          end;

        TXDataResourceType.Model:
          case Method of
            THttpMethod.Get:
              RetrieveServiceModel;
            THttpMethod.Options: OptionsResponse('GET,OPTIONS');
          else
            Response.StatusCode := 405; // method not allowed
          end;

        TXDataResourceType.EntitySchema:
          case Method of
            THttpMethod.Get: TryRetrieveEntitySchema;
            THttpMethod.Options: OptionsResponse('GET');
          else
            Response.StatusCode := 405; // method not allowed
          end;

        TXDataResourceType.ServiceDocument:
          case Method of
            THttpMethod.Get: RetrieveServiceDocument;
            THttpMethod.Options: OptionsResponse('GET,OPTIONS');
          else
            Response.StatusCode := 405; // method not allowed
          end;

  //      TXDataResourceType.Reference: ;
  //
      else
        raise EXDataHttpUrlInfoError.Create(Self);
      end;
    finally
      CleanUp;
    end;
  except
    on E: Exception do
      HandleException(E);
  end;
end;

function TXDataBaseRequestHandler.RemoveContentTypeParameter(
  const AContentType: string): string;
var
  P: integer;
begin
  P := Pos(';', AContentType);
  if P > 0 then
    Result := Trim(Copy(AContentType, 1, P - 1))
  else
    Result := Trim(AContentType);
end;

procedure TXDataBaseRequestHandler.RetrieveCollectionProperty;
begin

end;

procedure TXDataBaseRequestHandler.RetrieveEntity;
begin

end;

procedure TXDataBaseRequestHandler.RetrieveEntitySchema;
begin

end;

procedure TXDataBaseRequestHandler.RetrieveEntitySet;
begin

end;

procedure TXDataBaseRequestHandler.RetrievePrimitiveProperty;
begin

end;

procedure TXDataBaseRequestHandler.RetrieveServiceDocument;
var
  Stream: TStream;
  Writer: IServiceDocumentWriter;
begin
  Stream := TMemoryStream.Create;
  try
    Writer := PayloadFactory.CreateServiceDocumentWriter(Stream);
    Response.ContentType := Writer.ContentType;
    CheckAcceptApplicationType;
    Writer.WriteDocument;
    Writer.Flush;
    Response.StatusCode := 200;
    Response.ContentLength := Stream.Size;
    Response.Content.CopyFrom(Stream, 0);
  finally
    Writer := nil;
    Stream.Free;
  end;
end;

procedure TXDataBaseRequestHandler.RetrieveServiceMetadata;
begin

end;

procedure TXDataBaseRequestHandler.RetrieveServiceModel;
var
  Stream: TStream;
  W: TJsonWriter;
  Serializer: TJsonSerializer;
begin
  Stream := TMemoryStream.Create;
  try
    Response.ContentType := JsonMediaType;
    CheckAcceptApplicationType;

    { Write content }
    W := TJsonWriter.Create(Stream);
    try
      W.IndentLength := JsonDefaultIndent;
      Serializer := TJsonSerializer.Create;
      try
        Serializer.Write(Model, W);
      finally
        Serializer.Free;
      end;
      W.Flush;
    finally
      W.Free;
    end;

    Response.StatusCode := 200;
    Response.ContentLength := Stream.Size;
    Response.Content.CopyFrom(Stream, 0);
  finally
    Stream.Free;
  end;
end;

procedure TXDataBaseRequestHandler.RetrieveStreamProperty;
begin

end;

procedure TXDataBaseRequestHandler.RetrieveValue;
begin

end;

procedure TXDataBaseRequestHandler.SendErrorResponse(StatusCode: integer;
  const ErrorCode, ErrorMessage: string);
var
  Writer: IErrorWriter;
  Stream: TStream;
begin
  Stream := TMemoryStream.Create;
  try
    Writer := PayloadFactory.CreateErrorWriter(Stream);
    Response.ContentType := Writer.ContentType;
    Writer.WriteError(ErrorCode, ErrorMessage);
    Writer.Flush;
    if StatusCode = 0 then
      StatusCode := 500;
    Response.StatusCode := StatusCode;
    Response.ContentLength := Stream.Size;
    Response.Content.CopyFrom(Stream, 0);
  finally
    Stream.Free;
  end;
end;

procedure TXDataBaseRequestHandler.TryCreateCollectionPropertyItem;
var
  CollectionItemType: TXDataEntityType;
begin
  CollectionItemType := TXDataEntityCollectionType(ResourceInfo.FinalCollection.Target).ItemType;

  if (CollectionItemType <> nil) and HasPermission(TEntitySetPermission.Modify)
    and HasPermission(TEntitySetPermission.Insert, CollectionItemType) then
    CreateCollectionPropertyItem
  else
    Response.StatusCode := 403;
end;

procedure TXDataBaseRequestHandler.TryCreateEntity;
begin
  if HasPermission(TEntitySetPermission.Insert) then
    CreateEntity
  else
    Response.StatusCode := 403;
end;

procedure TXDataBaseRequestHandler.TryDeleteEntity;
begin
  if HasPermission(TEntitySetPermission.Delete) then
    DeleteEntity
  else
    Response.StatusCode := 403;
end;

procedure TXDataBaseRequestHandler.TryDeleteStreamProperty;
begin
  if HasPermission(TEntitySetPermission.Modify) then
    DeleteStreamProperty
  else
    Response.StatusCode := 403;
end;

procedure TXDataBaseRequestHandler.TryExecuteAction(Action: TXDataAction);
begin
  if HasPermission(Action) then
    ExecuteAction
  else
    Response.StatusCode := 403;
end;

procedure TXDataBaseRequestHandler.TryMergeEntity;
begin
  if HasPermission(TEntitySetPermission.Modify) then
    MergeEntity
  else
    Response.StatusCode := 403;
end;

procedure TXDataBaseRequestHandler.TryRetrieveCollectionProperty;
var
  CollectionItemType: TXDataEntityType;
begin
  CollectionItemType := TXDataEntityCollectionType(ResourceInfo.FinalCollection.Target).ItemType;

  if (CollectionItemType <> nil) and HasPermission(TEntitySetPermission.Get)
    and HasPermission(TEntitySetPermission.List, CollectionItemType) then
    RetrieveCollectionProperty
  else
    Response.StatusCode := 403;
end;

procedure TXDataBaseRequestHandler.TryRetrieveEntity;
begin
  if HasPermission(TEntitySetPermission.Get) then
    RetrieveEntity
  else
    Response.StatusCode := 403;
end;

procedure TXDataBaseRequestHandler.TryRetrieveEntityProperty;
begin
  if HasPermission(TEntitySetPermission.Get) and
    HasPermission(TEntitySetPermission.Get, ResourceInfo.Path[0].NavPath[0].NavProp.Target) then
    RetrieveEntity
  else
    Response.StatusCode := 403;
end;

procedure TXDataBaseRequestHandler.TryRetrieveEntitySchema;
begin
//  if HasPermission(TEntitySetPermission.Schema) then
//    RetrieveEntitySchema
//  else
//    Response.StatusCode := 403;
    Response.StatusCode := 404;
end;

procedure TXDataBaseRequestHandler.TryRetrieveEntitySet;
begin
  if HasPermission(TEntitySetPermission.List) then
    RetrieveEntitySet
  else
    Response.StatusCode := 403;
end;

procedure TXDataBaseRequestHandler.TryRetrievePrimitiveProperty;
begin
  if HasPermission(TEntitySetPermission.Get) then
    RetrievePrimitiveProperty
  else
    Response.StatusCode := 403;
end;

procedure TXDataBaseRequestHandler.TryRetrieveStreamProperty;
begin
  if HasPermission(TEntitySetPermission.Get) then
    RetrieveStreamProperty
  else
    Response.StatusCode := 403;
end;

procedure TXDataBaseRequestHandler.TryRetrieveValue;
begin
  if HasPermission(TEntitySetPermission.Get) then
    RetrieveValue
  else
    Response.StatusCode := 403;
end;

procedure TXDataBaseRequestHandler.TryUpdateEntity;
begin
  if HasPermission(TEntitySetPermission.Modify) then
    UpdateEntity
  else
    Response.StatusCode := 403;
end;

procedure TXDataBaseRequestHandler.TryUpdateStreamProperty;
begin
  if HasPermission(TEntitySetPermission.Modify) then
    UpdateStreamProperty
  else
    Response.StatusCode := 403;
end;

procedure TXDataBaseRequestHandler.TryUpsertEntity;
begin
  if HasPermission(TEntitySetPermission.Modify)
    and HasPermission(TEntitySetPermission.Insert) then
    UpsertEntity
  else
    Response.StatusCode := 403;
end;

procedure TXDataBaseRequestHandler.TryReplicateEntity;
begin
  if HasPermission(TEntitySetPermission.Modify)
    and HasPermission(TEntitySetPermission.Insert) then
    ReplicateEntity
  else
    Response.StatusCode := 403;
end;

procedure TXDataBaseRequestHandler.UpdateAcceptList;
var
  Accept: string;
  LocalList: TStringDynArray;
  I: integer;
begin
  if FAcceptLoaded then Exit;
  if Request.Headers.Exists(AcceptHeader) then
  begin
    Accept := Request.Headers.Get(AcceptHeader);
    LocalList := SplitString(Accept, ',');
    SetLength(FAcceptList, Length(LocalList));
    for I := 0 to Length(LocalList) - 1 do
    begin
      FAcceptList[I] := LowerCase(RemoveContentTypeParameter(LocalList[I]));
      if FAcceptList[I] = '*/*' then
        FAcceptAny := true;
    end;
  end else
    FAcceptAny := true;
  FAcceptLoaded := true;
end;

procedure TXDataBaseRequestHandler.UpdateEntity;
begin

end;

procedure TXDataBaseRequestHandler.UpdateStreamProperty;
begin

end;

procedure TXDataBaseRequestHandler.UpsertEntity;
begin

end;

procedure TXDataBaseRequestHandler.ReplicateEntity;
begin

end;

end.

