unit XData.Module.ResourceInfo;

interface

uses
  Generics.Collections,
  Sparkle.Uri,
  XData.Model.Classes;

type
  TNavigationPathItem = class
  strict private
    FNavProp: TXDataNavigationProperty;
  public
    constructor Create(const ANavProp: TXDataNavigationProperty);
    property NavProp: TXDataNavigationProperty read FNavProp;
  end;

  TXDataResourceType = (Error, EntitySet, Entity, SimpleProperty, CollectionProperty,
    EntityProperty, StreamProperty, PropertyValue, Metadata, ServiceDocument, Reference,
    Action, EntitySchema, Model);

  TResourcePath = class
  strict private
    FNavPath: TList<TNavigationPathItem>;
    FKey: string;
  public
    constructor Create; overload;
    destructor Destroy; override;
    property Key: string read FKey write FKey;
    property NavPath: TList<TNavigationPathItem> read FNavPath;
  end;

  TXDataActionSelection = class
  private
    FAction: TXDataAction;
    FPathParams: TList<string>;
  public
    constructor Create(AAction: TXDataAction; APathParams: TList<string>);
    destructor Destroy; override;
    property Action: TXDataAction read FAction write FAction;


    /// <summary>
    ///   Contains the values of path parameters passed in the request URL.
    /// </summary>
    /// <remarks>
    ///   <para>
    ///     If the action route is, for example, <c>
    ///     /customers/{id}/orders/{orderid}</c>, and the request URL is <c>
    ///     /customer/1/orders/50</c>, this property will hold the values <c>
    ///     1</c> and <c>50</c>, respectively.
    ///   </para>
    ///   <para>
    ///     It can also include implicit parameters after the specified
    ///     action route, for example, a request url <c>
    ///     /customer/1/orders/50/abc</c>, the available values will be <c>1</c>
    ///     , <c>50</c> and <c>abc</c>.
    ///   </para>
    /// </remarks>
    property PathParams: TList<string> read FPathParams;
  end;

  TXDataControllerSelection = class
  private
    FController: TXDataController;
  public
    constructor Create(AController: TXDataController);
    destructor Destroy; override;
    property Controller: TXDataController read FController write FController;
  end;

  TXDataResourceInfo = class
  strict private
    FSegments: TUriSegmentStack;
    FPath: TList<TResourcePath>;
    FModel: TXDataModel;
    FResourceType: TXDataResourceType;
    FEntitySet: TXDataEntitySet;
    FReferenceNavProp: TXDataNavigationProperty;
    FFinalProp: TXDataSimpleProperty;
    FFinalCollection: TXDataNavigationProperty;
    FActions: TList<TXDataActionSelection>;
    FControllers: TList<TXDataControllerSelection>;
    FErrorMessage: string;
    FErrorCode: integer;
    FSolved: boolean;
    FIsCount: Boolean;
    FEnableEntityKeyAsSegment: Boolean;
    FTempPathParams: TList<string>;
    FIsRoot: Boolean;
    FServiceFirst: Boolean;
    FHttpMethod: string;
    procedure FindActions(AControllers: TList<TXDataControllerSelection>; CheckHttpMethod: Boolean);
    procedure FindControllers;
    function FindServices(CheckHttpMethod: Boolean): Boolean;
    function MatchRouteInfo(RouteInfo: TXDataRouteInfo; TempPathParams: TList<string>): Boolean;
    property Segments: TUriSegmentStack read FSegments;
  strict private
    procedure ErrorInvalidEntitySetOperation;
    procedure ErrorTooManyReferenceSegments;
    procedure ErrorTooManyPropertySegments;
    procedure ErrorUnknownResource(const PropName: string);
    procedure ErrorUnknownEntitySet(const Name: string);
    procedure ErrorUnknownPath(const Name: string);
  strict private
    procedure DoEntitySet;
    procedure DoEntity;
    procedure DoProperty;
    procedure DoPropertyValue;
    procedure DoStreamProperty;
    procedure DoCollectionProperty;
    procedure DoCollectionPropertyCount;
    procedure DoMetadata;
    procedure DoModel;
    procedure DoServiceDocument;
    procedure DoReference;
    procedure DoEntitySetCount;
    procedure DoEntitySchema;
    procedure DoAction;
  strict private
    procedure PushPath(const APath: TResourcePath);
    function PeekPath: TResourcePath;
  strict private
    procedure SolveEntitySet(AEntitySet: TXDataEntitySet);
    procedure SolveEntity(AType: TXDataEntityType);
    procedure SolveProperty(AProp: TXDataSimpleProperty);
    procedure SolveNavigationProperty(ANavProp: TXDataNavigationProperty);
    procedure SolveRef(ANavProp: TXDataNavigationProperty);
  public
    constructor Create(const AModel: TXDataModel; const ASegments: TArray<string>;
      AEnableEntityKeyAsSegment: Boolean = False);
    destructor Destroy; override;
    procedure Solve;
    property ServiceFirst: Boolean read FServiceFirst write FServiceFirst;
    property HttpMethod: string read FHttpMethod write FHttpMethod;
    property Solved: boolean read FSolved;
    property Path: TList<TResourcePath> read FPath;
    property IsCount: Boolean read FIsCount;
    property ErrorCode: integer read FErrorCode;
    property ErrorMessage: string read FErrorMessage;
    // result properties
    property EntitySet: TXDataEntitySet read FEntitySet;
    property ResourceType: TXDataResourceType read FResourceType;
    property ReferenceNavProp: TXDataNavigationProperty read FReferenceNavProp;
    property FinalProp: TXDataSimpleProperty read FFinalProp;
    property FinalCollection: TXDataNavigationProperty read FFinalCollection;
    property Actions: TList<TXDataActionSelection> read FActions;
    property IsRoot: Boolean read FIsRoot;
//    property FinalType: TXDataEntityType read FFinalType;
  end;

implementation

uses
  SysUtils, Math,
  XData.Utils;

{ TXDataResourceInfo }

constructor TXDataResourceInfo.Create(const AModel: TXDataModel;
  const ASegments: TArray<string>; AEnableEntityKeyAsSegment: Boolean = False);
begin
  FModel := AModel;
  FSegments := TUriSegmentStack.Create(ASegments);
  FPath := TObjectList<TResourcePath>.Create(true);
  FActions := TObjectList<TXDataActionSelection>.Create;
  FControllers := TObjectList<TXDataControllerSelection>.Create;
  FEnableEntityKeyAsSegment := AEnableEntityKeyAsSegment;
  FTempPathParams := TList<string>.Create;
end;

destructor TXDataResourceInfo.Destroy;
begin
  FActions.Free;
  FControllers.Free;
  FPath.Free;
  FSegments.Free;
  FTempPathParams.Free;
  inherited;
end;

procedure TXDataResourceInfo.DoAction;
begin
  FResourceType := TXDataResourceType.Action;
end;

procedure TXDataResourceInfo.DoCollectionProperty;
begin
  FResourceType := TXDataResourceType.CollectionProperty;
end;

procedure TXDataResourceInfo.DoCollectionPropertyCount;
begin
  FResourceType := TXDataResourceType.CollectionProperty;
  FIsCount := True;
end;

procedure TXDataResourceInfo.DoEntitySetCount;
begin
  FResourceType := TXDataResourceType.EntitySet;
  FIsCount := True;
end;

procedure TXDataResourceInfo.DoEntity;
begin
  Assert(PeekPath <> nil);
  if PeekPath.NavPath.Count = 0 then
    FResourceType := TXDataResourceType.Entity
  else
    FResourceType := TXDataResourceType.EntityProperty;
end;

procedure TXDataResourceInfo.DoEntitySchema;
begin
  FResourceType := TXDataResourceType.EntitySchema;
end;

procedure TXDataResourceInfo.DoEntitySet;
begin
  FResourceType := TXDataResourceType.EntitySet;
end;

procedure TXDataResourceInfo.DoReference;
begin
  FResourceType := TXDataResourceType.Reference;
end;

procedure TXDataResourceInfo.DoMetadata;
begin
  FResourceType := TXDataResourceType.Metadata;
end;

procedure TXDataResourceInfo.DoModel;
begin
  FResourceType := TXDataResourceType.Model;
end;

procedure TXDataResourceInfo.DoProperty;
begin
  FResourceType := TXDataResourceType.SimpleProperty;
end;

procedure TXDataResourceInfo.DoPropertyValue;
begin
  FResourceType := TXDataResourceType.PropertyValue;
end;

procedure TXDataResourceInfo.DoServiceDocument;
begin
  FResourceType := TXDataResourceType.ServiceDocument;
end;

procedure TXDataResourceInfo.DoStreamProperty;
begin
  FResourceType := TXDataResourceType.StreamProperty;
end;

procedure TXDataResourceInfo.ErrorUnknownPath(const Name: string);
begin
  FErrorCode := 404;
  FErrorMessage := Format('Unknown path "%s"', [Name]);
end;

procedure TXDataResourceInfo.ErrorInvalidEntitySetOperation;
begin
  FErrorCode := 404;
  FErrorMessage := 'Unknown entity set operation';
end;

procedure TXDataResourceInfo.ErrorTooManyReferenceSegments;
begin
  FErrorCode := 400;
  FErrorMessage := 'Too many path segments after $ref';
end;

procedure TXDataResourceInfo.ErrorTooManyPropertySegments;
begin
  FErrorCode := 400;
  FErrorMessage := 'Too many path segments after property resource';
end;

procedure TXDataResourceInfo.ErrorUnknownEntitySet(const Name: string);
begin
  FErrorCode := 404;
  FErrorMessage := Format('Unknown entity set "%s"', [Name]);
end;

procedure TXDataResourceInfo.ErrorUnknownResource(const PropName: string);
begin
  FErrorCode := 404;
  FErrorMessage := Format('Unknown path resource "%s"', [PropName]);
end;

procedure TXDataResourceInfo.FindActions(AControllers: TList<TXDataControllerSelection>;
  CheckHttpMethod: Boolean);
var
  Action: TXDataAction;
  LSegmentIndex: Integer;
  MaxPriority: Integer;
  ControllerInfo: TXDataControllerSelection;
begin
  FActions.Clear;
  MaxPriority := 0;
  for ControllerInfo in AControllers do
    for Action in ControllerInfo.Controller.Actions do
    begin
      if CheckHttpMethod and (Action.HttpMethod <> FHttpMethod) then
        Continue;

      // Match action and check if the number of exact matched segments
      // is equal or higher what we found so far
      FTempPathParams.Clear;
      if MatchRouteInfo(Action.RouteInfo, FTempPathParams) and (Action.RouteInfo.Priority >= MaxPriority) then
      begin
        // if the number of matched segments is bigger than all previous ones,
        // remove previous actions added
        if Action.RouteInfo.Priority > MaxPriority then
        begin
          FActions.Clear;
          MaxPriority := Action.RouteInfo.Priority;
        end;

        // Add remaining implicit path parameters
        for LSegmentIndex := Action.RouteInfo.SegmentCount to Segments.Count - 1 do
          if Segments.Peek(LSegmentIndex) <> '' then
            FTempPathParams.Add(Segments.Peek(LSegmentIndex));

        // Check if the number of path params found is allowed
        if (FTempPathParams.Count >= Action.RequiredPathParamCount)
          and (FTempPathParams.Count <= Action.PathParamCount) then
            FActions.Add(TXDataActionSelection.Create(Action, FTempPathParams));
      end;
    end;
end;

procedure TXDataResourceInfo.FindControllers;
var
  Schema: TXDataSchema;
  Controller: TXDataController;
  MaxPriority: Integer;
begin
  FControllers.Clear;
  MaxPriority := 0;
  for Schema in FModel.Schemas do
    for Controller in Schema.Controllers do
    begin
      // Match Controller and check if the number of exact matched segments
      // is equal or higher what we found so far
      FTempPathParams.Clear;
      if MatchRouteInfo(Controller.RouteInfo2, FTempPathParams) and (Controller.RouteInfo2.Priority >= MaxPriority) then
      begin
        // if the number of matched segments is bigger than all previous ones,
        // remove previous Controllers added
        if Controller.RouteInfo2.Priority > MaxPriority then
        begin
          FControllers.Clear;
          MaxPriority := Controller.RouteInfo2.Priority;
        end;
        FControllers.Add(TXDataControllerSelection.Create(Controller));
      end;
    end;
end;

function TXDataResourceInfo.FindServices(CheckHttpMethod: Boolean): Boolean;
begin
  FControllers.Clear;
  FindControllers;
  FindActions(FControllers, CheckHttpMethod);
  Result := FActions.Count > 0;
  if Result then
    DoAction;
end;

function TXDataResourceInfo.MatchRouteInfo(RouteInfo: TXDataRouteInfo;
  TempPathParams: TList<string>): Boolean;
var
  LIndex: Integer;
  LSegment: TXDataRouteSegment;
  LSegmentValue: string;
begin
  for LIndex := 0 to RouteInfo.SegmentCount - 1 do
  begin
    LSegment := RouteInfo.Segments[LIndex];
    LSegmentValue := Segments.Peek(LIndex);
    if LSegment.IsParam and (LSegmentValue <> '') then
      TempPathParams.Add(LSegmentValue)
    else
    if not SameText(LSegment.Value, LSegmentValue) then
      Exit(False);
  end;
  Result := True;
end;

function TXDataResourceInfo.PeekPath: TResourcePath;
begin
  if FPath.Count > 0 then
    Result := FPath.Last
  else
    Result := nil;
end;

procedure TXDataResourceInfo.PushPath(const APath: TResourcePath);
begin
  FPath.Add(APath);
end;

procedure TXDataResourceInfo.Solve;
var
  Name, Key: string;
  Path: string;
begin
  FResourceType := TXDataResourceType.Error;
  FSolved := true;
  FIsRoot := Segments.Count = 0;

  if ServiceFirst and FindServices(True) then
    Exit;

  if SameText(Segments.Peek, '$metadata') and (Segments.Count = 1) then
    DoMetadata
  else
  if SameText(Segments.Peek, '$model') and (Segments.Count = 1) then
    DoModel
  else
  begin
    // check if path is in format Name(key)
    Path := Segments.Peek;
    if TXDataUtils.GetNameAndKey(Path, Name, Key) then
    begin
      Self.FEntitySet := FModel.FindEntitySet(Name);
      if Self.EntitySet <> nil then
      begin
        Segments.Pop;
        PushPath(TResourcePath.Create);
        PeekPath.Key := Key;
        SolveEntity(EntitySet.EntityType);
      end else
        ErrorUnknownEntitySet(Name);
    end
    else
    begin
      // check for simple name in path.
      // Search for entity sets or controllers
      Self.FEntitySet := FModel.FindEntitySet(Path);
      if Self.EntitySet <> nil then
      begin
        Segments.Pop;
        PushPath(TResourcePath.Create);
        SolveEntitySet(Self.EntitySet);
      end
      else
      begin
        if not ServiceFirst and FindServices(False) then
          Exit;

        if IsRoot then
          DoServiceDocument
        else
          ErrorUnknownPath(Segments.ToString);
      end;
    end;
  end;
end;

procedure TXDataResourceInfo.SolveEntitySet(AEntitySet: TXDataEntitySet);
var
  I: Integer;
  Keys: TXDataSimplePropertyArray;
begin
  if Segments.Count = 0 then
    DoEntitySet
  else
  if SameText(Segments.Peek, '$count') and (Segments.Count = 1) then
    DoEntitySetCount
  else
  if SameText(Segments.Peek, '$schema') and (Segments.Count = 1) then
    DoEntitySchema
  else
  if FEnableEntityKeyAsSegment then
  begin
    Keys := EntitySet.EntityType.KeyScalarProperties;
    Assert(Length(Keys) > 0);
    PeekPath.Key := Segments.Pop;
    for I := 1 to Length(Keys) - 1 do
      PeekPath.Key := PeekPath.Key + ',' + Segments.Pop;
    SolveEntity(EntitySet.EntityType);
  end
  else
    ErrorInvalidEntitySetOperation; // support entity set operation later here
end;

procedure TXDataResourceInfo.SolveRef(ANavProp: TXDataNavigationProperty);
begin
  if Segments.Count = 0 then
  begin
//    Self.FFinalType := ANavProp.Parent;
    Self.FReferenceNavProp := ANavProp;
    DoReference;
  end
  else
    ErrorTooManyReferenceSegments;
end;

procedure TXDataResourceInfo.SolveNavigationProperty(ANavProp: TXDataNavigationProperty);
begin
  if SameText(Segments.Peek, '$ref') then
  begin
    Segments.Pop; // remove the "$ref" segment
    SolveRef(ANavProp);
  end
  else
  if not ANavProp.Target.IsCollection then
  begin
    PeekPath.NavPath.Add(TNavigationPathItem.Create(ANavProp));

//    SolveEntity(ANavProp.Target);
    // replaced SolveEntity by code here (copied and adapted from SolveEntity) to avoid, for now,
    // accessing multilevel of navigation properties (Order.Customer.City.Country for example)
    // for now, we will only allow one level (Order.Customer).
    if Segments.Count = 0 then
      DoEntity
    else
      ErrorUnknownResource(Segments.Peek);


  end else
  begin
    // collection property
    // for now, the collection property cannot have sub paths. It just retrieves the collection
    if Segments.Count = 0 then
    begin
      Self.FFinalCollection := ANavProp;
      DoCollectionProperty;
    end
    else
    if SameText(Segments.Peek, '$count') and (Segments.Count = 1) then
    begin
      Self.FFinalCollection := ANavProp;
      DoCollectionPropertyCount;
    end
    else
      ErrorTooManyPropertySegments;
  end;
end;

procedure TXDataResourceInfo.SolveProperty(AProp: TXDataSimpleProperty);
begin
  if Segments.Count = 0 then
  begin
    Self.FFinalProp := AProp;
    if AProp.TypeKind = TXTypeKind.xtStream then
      DoStreamProperty
    else
      DoProperty;
  end
  else
  if (Segments.Count = 1) and SameText(Segments.Peek, '$value') and (AProp.TypeKind <> TXTypeKind.xtStream) then
  begin
    Self.FFinalProp := AProp;
    DoPropertyValue;
  end
  else
    ErrorTooManyPropertySegments;
end;

procedure TXDataResourceInfo.SolveEntity(AType: TXDataEntityType);
var
  Prop: TXDataSimpleProperty;
  NavProp: TXDataNavigationProperty;
  PathName: string;
begin
  if Segments.Count = 0 then
  begin
//    Self.FFinalType := AType;
    DoEntity;
  end
  else
  begin
    PathName := Segments.Pop;
    Prop := AType.FindProperty(PathName);
    if Prop <> nil then
      SolveProperty(Prop)
    else
    begin
      NavProp := AType.FindNavigationProperty(PathName);
      if NavProp <> nil then
        SolveNavigationProperty(NavProp)
      else
        ErrorUnknownResource(PathName);
    end;
  end;
end;

{ TResourcePath }

constructor TResourcePath.Create;
begin
  FNavPath := TObjectList<TNavigationPathItem>.Create(true);
end;

destructor TResourcePath.Destroy;
begin
  FNavPath.Free;
  inherited;
end;

{ TNavigationPathItem }

constructor TNavigationPathItem.Create(
  const ANavProp: TXDataNavigationProperty);
begin
  FNavProp := ANavProp;
end;

{ TXDataActionSelection }

constructor TXDataActionSelection.Create(AAction: TXDataAction; APathParams: TList<string>);
begin
  FPathParams := TList<string>.Create(APathParams);
  FAction := AAction;
end;

destructor TXDataActionSelection.Destroy;
begin
  FPathParams.Free;
  inherited;
end;

{ TXDataControllerSelection }

constructor TXDataControllerSelection.Create(AController: TXDataController);
begin
  FController := AController;
end;

destructor TXDataControllerSelection.Destroy;
begin
  inherited;
end;

end.

