unit ServerByHeader.Module;

interface

uses
  System.SysUtils, System.Classes, System.Generics.Collections,
  Aurelius.Drivers.SQLite,
  Aurelius.Drivers.Interfaces, XData.Server.Module, Sparkle.Comp.Server,
  Sparkle.Comp.JwtMiddleware, XData.Comp.Server, XData.Comp.ConnectionPool,
  Sparkle.Comp.HttpSysDispatcher, Aurelius.Comp.Connection,
  Sparkle.Comp.CorsMiddleware, Sparkle.HttpServer.Module,
  Sparkle.HttpServer.Context,
  MultiDBConnectionPool;

type
  TServerByHeaderModule = class(TDataModule)
    SparkleHttpSysDispatcher1: TSparkleHttpSysDispatcher;
    XDataServer1: TXDataServer;
    XDataServer1CORS: TSparkleCorsMiddleware;
    procedure DataModuleCreate(Sender: TObject);
    procedure XDataServer1GetPoolInterface(Sender: TObject;
      var Pool: IDBConnectionPool);
  private
    { Private declarations }
    FMultiPool: IMultiDBConnectionPool;
    function CreateConnectionPool(const DBName: string): IDBConnectionPool;
  public
    { Public declarations }
    procedure StartServer;
    procedure StopServer;
    function IsRunning: Boolean;
    procedure AddDatabase(DBName: string);
    procedure RemoveDatabase(DBName: string);
  end;

const
  DefaultServerUrl = 'http://localhost:2001/tms/multitenant/';

var
  ServerByHeaderModule: TServerByHeaderModule;

implementation

uses
  XData.OpenApi.Service,
  XData.Aurelius.ConnectionPool,
  DatabaseUtils;

{%CLASSGROUP 'System.Classes.TPersistent'}

{$R *.dfm}

{ TServerByHeaderModule }

procedure TServerByHeaderModule.AddDatabase(DBName: string);
var
  Pool: IDBConnectionPool;
begin
  Pool := CreateConnectionPool(DBName);
  DatabaseUtils.UpdateDatabase(Pool.GetConnection);
  FMultiPool.AddOrSetPool(DBName, Pool);
end;

function TServerByHeaderModule.CreateConnectionPool(
  const DBName: string): IDBConnectionPool;
begin
  // Just create your connection pool the way you do normally
  // Each connection pool should have its specific connection settings to point
  // to the correct database
  Result := TDBConnectionPool.Create(10,
    function: IDBConnection
    begin
      Result := TSQLiteNativeConnectionAdapter.Create(DBName + '.db');
    end
  );
end;

procedure TServerByHeaderModule.DataModuleCreate(Sender: TObject);
begin
  FMultiPool := TMultiDBConnectionPool.Create('database-name');
end;

function TServerByHeaderModule.IsRunning: Boolean;
begin
  Result := SparkleHttpSysDispatcher1.Active;
end;

procedure TServerByHeaderModule.RemoveDatabase(DBName: string);
begin
  FMultiPool.RemovePool(DBName);
end;

procedure TServerByHeaderModule.StartServer;
begin
  XDataServer1.BaseUrl := DefaultServerUrl;

  // Enable OpenAPI/Swagger support
  RegisterOpenApiService;

  SparkleHttpSysDispatcher1.Start;
end;

procedure TServerByHeaderModule.StopServer;
begin
  SparkleHttpSysDispatcher1.Stop;
end;

procedure TServerByHeaderModule.XDataServer1GetPoolInterface(Sender: TObject;
  var Pool: IDBConnectionPool);
begin
  Pool := FMultiPool;
end;

end.
