unit Api.Server.Module;

interface

uses
  System.SysUtils, System.Classes, System.Generics.Collections,
  Aurelius.Drivers.SQLite,
  Aurelius.Comp.Connection,
  Aurelius.Drivers.Interfaces,
  XData.Aurelius.ConnectionPool, XData.Server.Module, Sparkle.Comp.Server,
  XData.Comp.Server, XData.Comp.ConnectionPool, Sparkle.Comp.HttpSysDispatcher,
  Sparkle.Comp.JwtMiddleware, Sparkle.Middleware.Jwt, Aurelius.Criteria.Linq,
  Sparkle.HttpServer.Module, Sparkle.HttpServer.Context,
  Sparkle.Comp.CompressMiddleware, Sparkle.Comp.CorsMiddleware,
  Sparkle.Comp.GenericMiddleware;

type
  TApiServerModule = class(TDataModule)
    AureliusConnection1: TAureliusConnection;
    SparkleHttpSysDispatcher1: TSparkleHttpSysDispatcher;
    XDataConnectionPool1: TXDataConnectionPool;
    XDataServer1: TXDataServer;
    XDataServer1Logging: TSparkleGenericMiddleware;
    XDataServer1CORS: TSparkleCorsMiddleware;
    XDataServer1JWT: TSparkleJwtMiddleware;
    XDataServer1Compress: TSparkleCompressMiddleware;
    procedure XDataServer1EntityInserting(Sender: TObject;
      Args: TEntityInsertingArgs);
    procedure XDataServer1EntityModifying(Sender: TObject;
      Args: TEntityModifyingArgs);
    procedure XDataServer1EntityDeleting(Sender: TObject;
      Args: TEntityDeletingArgs);
    procedure DataModuleCreate(Sender: TObject);
    procedure XDataServer1LoggingMiddlewareCreate(Sender: TObject;
      var Middleware: IHttpServerMiddleware);
    procedure XDataServer1JWTGetSecret(Sender: TObject; var Secret: string);
  private
    { Private declarations }
  public
    { Public declarations }
    procedure StartApiServer(ABaseUrl: string);
  end;

const
  SERVER_PATH_SEGMENT = 'api';

implementation

uses
  Sparkle.HttpServer.Request,
  Sparkle.Middleware.Cors,
  Sparkle.Middleware.Compress,
  XData.OpenApi.Service,
  XData.Sys.Exceptions,
  Common.DatabaseUtils,
  Common.Logging,
  Common.Middleware.Logging,
  Common.Config;

{%CLASSGROUP 'Vcl.Controls.TControl'}

{$R *.dfm}

{ TApiServerModule }

function IsAdmin(Request: THttpServerRequest): Boolean;
var
  User: IUserIdentity;
begin
  User := Request.User;
  Result := (User <> nil) and User.Claims.Exists('admin') and User.Claims['admin'].AsBoolean;
end;

procedure TApiServerModule.DataModuleCreate(Sender: TObject);
var
  Conn: IDBConnection;
begin
  Conn := XDataConnectionPool1.GetPoolInterface.GetConnection;
  UpdateDatabase(Conn);
end;

procedure TApiServerModule.StartApiServer(ABaseUrl: string);
var
  Url: string;
begin
  RegisterOpenApiService;

  Url := ABaseUrl;
  if not Url.EndsWith('/') then
    Url := Url + '/';
  Url := Url + SERVER_PATH_SEGMENT;

  XDataServer1.BaseUrl := Url;

  SparkleHttpSysDispatcher1.Start;
  Logger.Log(Format('Api server module listening at "%s"', [Url]));
end;

procedure TApiServerModule.XDataServer1EntityDeleting(Sender: TObject;
  Args: TEntityDeletingArgs);
begin
  if not IsAdmin(Args.Handler.Request) then
    raise EXDataHttpForbidden.Create('Non-admin user cannot delete records');
end;

procedure TApiServerModule.XDataServer1EntityInserting(Sender: TObject;
  Args: TEntityInsertingArgs);
begin
  if not IsAdmin(Args.Handler.Request) then
    raise EXDataHttpForbidden.Create('Non-admin user cannot insert records');
end;

procedure TApiServerModule.XDataServer1EntityModifying(Sender: TObject;
  Args: TEntityModifyingArgs);
begin
  if not IsAdmin(Args.Handler.Request) then
    raise EXDataHttpForbidden.Create('Non-admin user cannot modify records');
end;

procedure TApiServerModule.XDataServer1LoggingMiddlewareCreate(Sender: TObject;
  var Middleware: IHttpServerMiddleware);
begin
  Middleware := TLoggingMiddleware.Create(Logger);
end;

procedure TApiServerModule.XDataServer1JWTGetSecret(Sender: TObject;
  var Secret: string);
begin
  Secret := ServerConfig.JwtTokenSecret;
end;

end.
