unit ServerByHeader.Module;

interface

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

type
  TXDataHttpHeaderTenantResolver = class(TInterfacedObject, ITenantResolver)
  strict private
    FHeaderName: string;
  public
    constructor Create(const HeaderName: string);
    function GetTenantId: string;
  end;

  TDBConnectionPoolFactory = class(TInterfacedObject, ITenantDBPoolFactory)
  public
    function CreatePool(const TenantId: string): IDBConnectionPool;
  end;

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

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

var
  ServerByHeaderModule: TServerByHeaderModule;

implementation

uses
  XData.Aurelius.ConnectionPool,
  DatabaseSeed;

{%CLASSGROUP 'System.Classes.TPersistent'}

{$R *.dfm}

{ TServerByHeaderModule }

procedure TServerByHeaderModule.AddTenant(DBName: string);
var
  Pool: IDBConnectionPool;
  Conn: IDBConnection;
begin
  Pool := FMultiPool.GetPool(DBName);
  Conn := Pool.GetConnection;
  TDatabaseManager.Update(Conn);
  SeedDatabase(Conn, DBName);
end;

procedure TServerByHeaderModule.DataModuleCreate(Sender: TObject);
begin
  FMultiPool := TMultiTenantConnectionPool.Create(
    TXDataHttpHeaderTenantResolver.Create('database-name'),
    TDBConnectionPoolFactory.Create
    );
  AddTenant('microsoft');
  AddTenant('apple');
  AddTenant('google');
end;

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

procedure TServerByHeaderModule.StartServer;
begin
  XDataServer1.BaseUrl := DefaultServerUrl;
  SparkleHttpSysDispatcher1.Start;
end;

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

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

{ TXDataHttpHeaderTenantResolver }

constructor TXDataHttpHeaderTenantResolver.Create(const HeaderName: string);
begin
  inherited Create;
  FHeaderName := HeaderName;
end;

function TXDataHttpHeaderTenantResolver.GetTenantId: string;
begin
  Result := THttpServerContext.Current.Request.Headers.Get(FHeaderName);
end;

{ TDBConnectionPoolFactory }

function TDBConnectionPoolFactory.CreatePool(
  const TenantId: 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(TenantId + '.db');
    end
  );
end;

end.
