unit Ws.Server.Module;

interface

uses
  System.SysUtils, System.Classes,
  XData.Server.Module,
  XData.Comp.Server,
  Sparkle.Comp.Server,
  Sparkle.Comp.HttpSysDispatcher,
  Sparkle.Comp.CorsMiddleware,
  Sparkle.Comp.GenericMiddleware,
  Sparkle.HttpServer.Module,
  Sparkle.HttpServer.Context;

type
  TWsServerModule = class(TDataModule)
    SparkleHttpSysDispatcher3: TSparkleHttpSysDispatcher;
    XDataServer1: TXDataServer;
    XDataServer1Logging: TSparkleGenericMiddleware;
    XDataServer1CORS: TSparkleCorsMiddleware;

    procedure XDataServer1LoggingMiddlewareCreate(Sender: TObject;
      var Middleware: IHttpServerMiddleware);
  private
    { Private declarations }
  public
    { Public declarations }
    procedure StartWsServer(ABaseUrl: string; AModelName: string);
  end;

const
  SERVER_PATH_SEGMENT = 'ws';

var
  WsServerModule: TWsServerModule;

implementation

uses
  Sparkle.HttpServer.Request,
  Sparkle.Middleware.Cors,
  Sparkle.Middleware.Compress,
  XData.OpenApi.Service,
  XData.Sys.Exceptions,
  Common.Logging,
  Common.Middleware.Logging,
  Common.Config, Vcl.Forms, IniFiles,
  System.Rtti,
  Ws.Service,
  Ws.ServiceImpl;

{%CLASSGROUP 'Vcl.Controls.TControl'}

{$R *.dfm}

{ TWsServerModule }



procedure TWsServerModule.StartWsServer(ABaseUrl: string; AModelName: string);
var
  Url: string;
  ctx: TRttiContext;
  t: TRttiType;
  attr: TCustomAttribute;
  m: TRttiMethod;
  s: string;
begin
  Logger.Log(1, 'WS-DIAG: StartWsServer enter, AModelName=[' + AModelName + ']');
  Logger.Log(1, 'WS-DIAG: XDataServer1.ModelName before=[' + XDataServer1.ModelName + ']');

  ctx := TRttiContext.Create;
  try
    t := ctx.GetType(TypeInfo(IWebSocketService));
    if t = nil then
      Logger.Log(1, 'WS-DIAG: IWebSocketService RTTI=NIL')
    else
    begin
      Logger.Log(1, 'WS-DIAG: IWebSocketService RTTI.Name=[' + t.Name + ']');
      s := '';
      for attr in t.GetAttributes do
        s := s + attr.ClassName + ' ';
      Logger.Log(1, 'WS-DIAG: IWebSocketService attrs=[' + s + ']');
      s := '';
      for m in t.GetMethods do
      begin
        s := s + m.Name + '(';
        var ma := '';
        for attr in m.GetAttributes do
          ma := ma + attr.ClassName + ' ';
        s := s + ma + ') ';
      end;
      Logger.Log(1, 'WS-DIAG: IWebSocketService methods=[' + s + ']');
    end;
  finally
    ctx.Free;
  end;
  RegisterOpenApiService;
  Logger.Log(1, 'WS-DIAG: RegisterOpenApiService done');
  Url := ABaseUrl;
  if not Url.EndsWith('/') then
    Url := Url + '/';
  Url := Url + SERVER_PATH_SEGMENT;
  XDataServer1.BaseUrl := Url;
  Logger.Log(1, 'WS-DIAG: about to set ModelName to [' + AModelName + ']');
  try
    XDataServer1.ModelName := AModelName;
    Logger.Log(1, 'WS-DIAG: ModelName set, current value=[' + XDataServer1.ModelName + ']');
  except
    on E: Exception do
      Logger.Log(1, 'WS-DIAG: ModelName assignment FAILED: ' + E.ClassName + ': ' + E.Message);
  end;
  SparkleHttpSysDispatcher3.Start;
  Logger.Log(1, Format('Ws server module listening at "%s"', [Url]));
end;

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

end.
