unit XData.OpenApi.Builder;

interface

uses
  System.IOUtils, System.SysUtils, System.TypInfo, Generics.Collections, System.Classes,
  System.Rtti,
  OpenAPI.Document,
  OpenAPI.Classes,
  OpenAPI.Classes.Parameter,
  OpenAPI.Classes.Path,
  OpenAPI.Classes.Operation,
  OpenAPI.Types,
  XData.Aurelius.Model,
  XData.Consts,
  XData.JSchema.Classes,
  XData.JSchema.Builder,
  XData.JSchema.Generators,
  XData.Model.Classes,
  XData.Server.Module;

type
  TOpenApiBuilder = class
  private const
    SuccessfulResponse = 'Successful response';
    NotFoundResponse = 'Entity not found';
  private
    FModel: TXDataAureliusModel;
    FDocument: TOpenApiDocument;
    FExcludeOperations: Boolean;
    FExcludeEntities: Boolean;
    function BuildSchema(const ATypeToken: TTypeToken): TJsonSchema;
  private
    procedure BuildFromAction(Action: TXDataAction);
    function ActionInputSchema(Action: TXDataAction): TJsonSchema;
    function ActionOutputSchema(Action: TXDataAction): TJsonSchema;
    function ActionSingleObjectResult(Action: TXDataAction): Boolean;
  private
    procedure BuildFromEntitySet(EntitySet: TXDataEntitySet);
    procedure AddCriteriaParameters(Operation: TOperation);
    procedure AddKeyParameters(Operation: TOperation; KeyNames: TArray<string>;
      KeyProps: TXDataSimplePropertyArray);
  public
    constructor Create(AModel: TXDataAureliusModel);
    procedure Build;
    function GetDocument: TOpenApiDocument;
    property Document: TOpenApiDocument read FDocument;
    property Model: TXDataAureliusModel read FModel;
    property ExcludeOperations: Boolean read FExcludeOperations write FExcludeOperations;
    property ExcludeEntities: Boolean read FExcludeEntities write FExcludeEntities;
  end;


implementation

{ TOpenApiBuilder }

function TOpenApiBuilder.GetDocument: TOpenApiDocument;
begin
  FDocument := TOpenApiDocument.Create;
  try
    Build;
  except
    FDocument.Free;
    raise;
  end;
  Result := FDocument;
end;

function TOpenApiBuilder.ActionInputSchema(Action: TXDataAction): TJsonSchema;
var
  Schema: TObjectSchema;
  ParamDef: TXDataParamDef;
begin
  // Obs: see XData.Payload.Json.Reader -> TJsonResultReader.ReadParams
  // and XData.Server.Module.ExecuteAction and XData.Client.OnInvoke
  if (Action.Parameters.Count = 1) and Action.Parameters[0].RttiType.IsInstance then
    Result := BuildSchema(Action.Parameters[0].RttiType.Handle)
  else
  begin
    Schema := TObjectSchema.Create;
    try
      for ParamDef in Action.Parameters do
        if (ParamDef.BindingMode = TBindingMode.FromBody) and ParamDef.Input then
        begin
          Schema.Properties[ParamDef.Name] := BuildSchema(ParamDef.RttiType.Handle);
          Schema.Required.Add(ParamDef.Name);
        end;
    except
      Schema.Free;
      raise;
    end;
    Result := Schema;
  end;
end;

function TOpenApiBuilder.ActionOutputSchema(Action: TXDataAction): TJsonSchema;
var
  Schema: TObjectSchema;
  ParamDef: TXDataParamDef;
begin
  // Obs: see XData.Payload.Json.Writer -> TJsonResultWriter.WriteResult
  // and XData.Server.Module.ExecuteAction and XData.Client.OnInvoke
  if ActionSingleObjectResult(Action) then
    Result := BuildSchema(Action.ReturnType.Handle)
  else
  begin
    Schema := TObjectSchema.Create;
    try
      // Property that contains return type
      if Action.ReturnType <> nil then
      begin
        if Action.HasOutputParams then
          Schema.Properties[JsonResultParam] := BuildSchema(Action.ReturnType.Handle)
        else
          Schema.Properties[JsonResultValue] := BuildSchema(Action.ReturnType.Handle);
      end;

      // Parameters passed by reference
      for ParamDef in Action.Parameters do
        if ParamDef.Output then
          Schema.Properties[ParamDef.Name] := BuildSchema(ParamDef.RttiType.Handle);
    except
      Schema.Free;
      raise;
    end;
    Result := Schema;
  end;
end;

function TOpenApiBuilder.ActionSingleObjectResult(
  Action: TXDataAction): Boolean;
begin
  Result := Action.IsResultSingleObject and not
    Model.Explorer.IsValueList(Action.ReturnType.AsInstance.MetaclassType);
end;

procedure TOpenApiBuilder.AddCriteriaParameters(Operation: TOperation);
begin
  Operation.AddParameter('$filter', TLocation.Query, TStringSchema.Create);
  Operation.AddParameter('$orderby', TLocation.Query, TStringSchema.Create);
  Operation.AddParameter('$top', TLocation.Query, TIntegerSchema.Create);
  Operation.AddParameter('$skip', TLocation.Query, TIntegerSchema.Create);
  Operation.AddParameter('$expand', TLocation.Query, TStringSchema.Create);
end;

procedure TOpenApiBuilder.AddKeyParameters(Operation: TOperation; KeyNames:
  TArray<string>; KeyProps: TXDataSimplePropertyArray);
var
  I: Integer;
  KeyProp: TXDataSimpleProperty;
begin
  for I := 0 to Length(KeyProps) - 1 do
  begin
    KeyProp := KeyProps[I];
    Operation.AddParameter(KeyNames[I], TLocation.Path,
      BuildSchema(Model.GetPropertyInfo(KeyProp).RttiInfo.RealType.Handle),
      '', True);
  end;
end;

procedure TOpenApiBuilder.Build;
var
  Schema: TXDataSchema;
  Controller: TXDataController;
  Action: TXDataAction;
  EntitySet: TXDataEntitySet;
begin
//  Document.Info.Title := 'XDataSwaggerTest';
//  Document.Info.Version := '1.0';
//  Document.Host := 'localhost:2001';
//  Document.BasePath := '/tms/music';

  for Schema in Model.Schemas do
  begin
    // Generate Service Operations
    if not ExcludeOperations then
      for Controller in Schema.Controllers do
        for Action in Controller.Actions do
          BuildFromAction(Action);

    // Generate Entities
    if not ExcludeEntities then
      for EntitySet in Model.DefaultEntityContainer.EntitySets do
        BuildFromEntitySet(EntitySet);
  end;
end;

procedure TOpenApiBuilder.BuildFromAction(Action: TXDataAction);
var
  Path: TPathItem;
  PathName: string;
  Operation: TOperation;
  ParamDef: TXDataParamDef;
begin
  // Build path name
  if Action.Controller.Name <> '' then
    PathName := PathName + '/' + Action.Controller.Name;
  if Action.Name <> '' then
    PathName := PathName + '/' + Action.Name;
  if PathName = '' then
    PathName := '/';

  // Create the path item for the action
  Path := Document.AddPath(PathName);
  Operation := Path.GetOperation(Action.HttpMethod);
  if Action.Controller.Name <> '' then
    Operation.Tags.Add(Action.Controller.Name);

  // General info about the operation
  Operation.Summary := ''; //Format('Executes "%s" operation', [Action.RttiMethodFullName]);
  Operation.Description := '';
  Operation.OperationId := Action.OperationId;

  // Specify request body parameter
  if Action.IsParamStream then
  begin
    Operation.Consumes.Add(MultiPartFormDataMediaType);
    Operation.AddParameter('Input', TLocation.FormData, TFileSchema.Create);
  end
  else
  begin
    if Action.HasBinding(TBindingMode.FromBody) then
    begin
      Operation.Consumes.Add(JsonMediaType);
      Operation.BodyParameter(ActionInputSchema(Action));
    end;

    // Create query parameters
    for ParamDef in Action.Parameters do
      if ParamDef.BindingMode = TBindingMode.FromURI then
        Operation.AddParameter(ParamDef.Name, TLocation.Query,
          BuildSchema(ParamDef.RttiType.Handle), '', ParamDef.Input);
  end;

  // Specify response type
  if Action.IsResultStream then
  begin
    Operation.Responses.Add('200', TResponse.Create(SuccessfulResponse, TFileSchema.Create));
  end
  else
  if Action.IsResultCriteria then
  begin
    Operation.Responses.Add('200', TResponse.Create(SuccessfulResponse, BuildSchema(TList<TObject>)));
  end
  else
  begin
    if (Action.ReturnType <> nil) or Action.HasOutputParams then
    begin
      Operation.Produces.Add(JsonMediaType);
      Operation.Responses.Add('200', TResponse.Create(SuccessfulResponse, ActionOutputSchema(Action)));
    end
    else
      Operation.Responses.Add('204', TResponse.Create(SuccessfulResponse));
      //  if ActionSingleObjectResult(Action) then
      //    Operation.Responses.Add('404', TResponse.Create('Null object'));
  end;
end;

procedure TOpenApiBuilder.BuildFromEntitySet(EntitySet: TXDataEntitySet);
var
  Path: TPathItem;
  BasePath: string;
  Operation: TOperation;
  Clazz: TClass;
  KeyProp: TXDataSimpleProperty;
  KeyProps: TXDataSimplePropertyArray;
  KeyNames: TArray<string>;
  I: Integer;
begin
  Clazz := Model.GetEntityTypeClass(EntitySet.EntityType);

  // Build path name
  BasePath := '/' + Model.EntitySetUrl(EntitySet);

  // Create path for entity set
  Path := Document.AddPath(BasePath);

  // ListEntities operation: GET operation on entity set
  Operation := Path.Get;
  Operation.Tags.Add(EntitySet.Name);
  Operation.OperationId := 'List' + EntitySet.Name;
  AddCriteriaParameters(Operation);
  Operation.Produces.Add(JsonMediaType);
  Operation.Responses.Add('200', TResponse.Create(SuccessfulResponse,
    BuildSchema(TTypeToken.Create(TypeInfo(TList<TObject>), Clazz.ClassInfo))
  ));

  // CreateEntity operation: POST operation on entity set
  Operation := Path.Post;
  Operation.Tags.Add(EntitySet.Name);
  Operation.OperationId := 'Create' + EntitySet.Name;
  Operation.Consumes.Add(JsonMediaType);
  Operation.BodyParameter(BuildSchema(Clazz.ClassInfo));
  Operation.Produces.Add(JsonMediaType);
  // consider adding location header
  Operation.Responses.Add('201', TResponse.Create(SuccessfulResponse,
    BuildSchema(Clazz.ClassInfo)));

  { Now let's add operations related to a single entity. We need to change the path }

  // First find and define the id parameters
  KeyProps := Model.GetKeyScalarProperties(EntitySet.EntityType);
  BasePath := BasePath + '(';
  SetLength(KeyNames, Length(KeyProps));
  for I := 0 to Length(KeyProps) - 1 do
  begin
    KeyProp := KeyProps[I];
    if I > 0 then
      BasePath := BasePath + ', ';
    KeyNames[I] := KeyProp.Name;
    if KeyProp.Parent <> EntitySet.EntityType then
      KeyNames[I] := KeyProp.Parent.Name + '_' + KeyNames[I];
    BasePath := BasePath + '{' + KeyNames[I] + '}';
  end;
  BasePath := BasePath + ')';

  // Now create the path
  Path := Document.AddPath(BasePath);

  // RetrieveEntity operation: GET operation on entity
  Operation := Path.Get;
  Operation.Tags.Add(EntitySet.Name);
  Operation.OperationId := 'Retrieve' + EntitySet.Name;
  AddKeyParameters(Operation, KeyNames, KeyProps);
  Operation.Produces.Add(JsonMediaType);
  Operation.Responses.Add('200', TResponse.Create(SuccessfulResponse,
    BuildSchema(Clazz.ClassInfo)));
  Operation.Responses.Add('404', TResponse.Create(NotFoundResponse, nil));

  // UpdateEntity operation: PUT operation on entity
  Operation := Path.Put;
  Operation.Tags.Add(EntitySet.Name);
  Operation.OperationId := 'Update' + EntitySet.Name;
  AddKeyParameters(Operation, KeyNames, KeyProps);
  Operation.Consumes.Add(JsonMediaType);
  Operation.BodyParameter(BuildSchema(Clazz.ClassInfo));
  Operation.Produces.Add(JsonMediaType);
  Operation.Responses.Add('200', TResponse.Create(SuccessfulResponse,
    BuildSchema(Clazz.ClassInfo)));

  // MergeEntity operation: PATCH operation on entity
  Operation := Path.Patch;
  Operation.Tags.Add(EntitySet.Name);
  Operation.OperationId := 'Merge' + EntitySet.Name;
  AddKeyParameters(Operation, KeyNames, KeyProps);
  Operation.Consumes.Add(JsonMediaType);
  Operation.BodyParameter(BuildSchema(Clazz.ClassInfo));
  Operation.Produces.Add(JsonMediaType);
  Operation.Responses.Add('200', TResponse.Create(SuccessfulResponse,
    BuildSchema(Clazz.ClassInfo)));

  // DeleteEntity operation: PATCH operation on entity
  Operation := Path.Delete;
  Operation.Tags.Add(EntitySet.Name);
  Operation.OperationId := 'Delete' + EntitySet.Name;
  AddKeyParameters(Operation, KeyNames, KeyProps);
  Operation.Responses.Add('204', TResponse.Create(SuccessfulResponse, nil));
end;

function TOpenApiBuilder.BuildSchema(const ATypeToken: TTypeToken): TJsonSchema;
var
  JSBuilder: TXDataJSchemaBuilder;
begin
  JSBuilder := TXDataJSchemaBuilder.Create(Model);
  try
    JSBuilder.Generators.Definitions := FDocument.Definitions;
    Result := JSBuilder.Generators.ProcessRef(ATypeToken);
  finally
    JSBuilder.Free;
  end;
end;

constructor TOpenApiBuilder.Create(AModel: TXDataAureliusModel);
begin
  FModel := AModel;
end;

end.
