Add WebSocket server/client connection handling, client identification, and…

Add WebSocket server/client connection handling, client identification, and connected-client tracking UI foundation

emiMobileServer/Source/Main.dfm

@@ -2,8 +2,8 @@ object FMain: TFMain
   Left = 0
   Top = 0
   Caption = 'emiMobileServer'
-  ClientHeight = 583
-  ClientWidth = 761
+  ClientHeight = 616
+  ClientWidth = 772
   Color = clBtnFace
   Font.Charset = DEFAULT_CHARSET
   Font.Color = clWindowText
@@ -12,17 +12,53 @@ object FMain: TFMain
   Font.Style = []
   OnClose = FormClose
   DesignSize = (
-    761
-    583)
+    772
+    616)
   TextHeight = 13
-  object memoInfo: TMemo
+  object pgcMain: TPageControl
     Left = 8
     Top = 39
-    Width = 741
-    Height = 535
+    Width = 756
+    Height = 575
+    ActivePage = tabConnectedClients
     Anchors = [akLeft, akTop, akRight, akBottom]
-    ReadOnly = True
-    TabOrder = 0
+    TabOrder = 3
+    ExplicitHeight = 552
+    object tabServerLog: TTabSheet
+      Caption = 'Server Log'
+      object memoInfo: TMemo
+        Left = 0
+        Top = 0
+        Width = 748
+        Height = 547
+        Align = alClient
+        ReadOnly = True
+        ScrollBars = ssVertical
+        TabOrder = 0
+        WordWrap = False
+        ExplicitHeight = 524
+      end
+    end
+    object tabConnectedClients: TTabSheet
+      Caption = 'Connected Clients'
+      ImageIndex = 1
+      object grdConnectedClients: TDBGrid
+        Left = 0
+        Top = 0
+        Width = 748
+        Height = 547
+        Align = alClient
+        DataSource = dsConnectedClients
+        Options = [dgTitles, dgIndicator, dgColumnResize, dgColLines, dgRowLines, dgTabs, dgRowSelect, dgConfirmDelete, dgCancelOnExit, dgTitleClick, dgTitleHotTrack]
+        ReadOnly = True
+        TabOrder = 0
+        TitleFont.Charset = DEFAULT_CHARSET
+        TitleFont.Color = clWindowText
+        TitleFont.Height = -11
+        TitleFont.Name = 'Tahoma'
+        TitleFont.Style = []
+      end
+    end
   end
   object btnApiSwaggerUI: TButton
     Left = 141
@@ -30,7 +66,7 @@ object FMain: TFMain
     Width = 100
     Height = 25
     Caption = 'Api SwaggerUI'
-    TabOrder = 1
+    TabOrder = 0
     OnClick = btnApiSwaggerUIClick
   end
   object btnExit: TButton
@@ -39,7 +75,7 @@ object FMain: TFMain
     Width = 75
     Height = 25
     Caption = 'Exit'
-    TabOrder = 2
+    TabOrder = 1
     OnClick = btnExitClick
   end
   object btnAuthSwaggerUI: TButton
@@ -48,17 +84,51 @@ object FMain: TFMain
     Width = 100
     Height = 25
     Caption = 'Auth SwaggerUI'
-    TabOrder = 3
+    TabOrder = 2
     OnClick = btnAuthSwaggerUIClick
   end
   object initTimer: TTimer
     OnTimer = initTimerTimer
-    Left = 58
-    Top = 398
+    Left = 30
+    Top = 466
   end
   object ExeInfo1: TExeInfo
     Version = '1.6.1.1'
-    Left = 256
-    Top = 402
+    Left = 32
+    Top = 530
+  end
+  object tblConnectedClients: TFDMemTable
+    Active = True
+    FieldDefs = <
+      item
+        Name = 'ConnectionId'
+        DataType = ftString
+        Size = 20
+      end
+      item
+        Name = 'UserId'
+        DataType = ftString
+        Size = 20
+      end
+      item
+        Name = 'ConnectedAt'
+        DataType = ftDateTime
+      end>
+    IndexDefs = <>
+    FetchOptions.AssignedValues = [evMode]
+    FetchOptions.Mode = fmAll
+    ResourceOptions.AssignedValues = [rvSilentMode]
+    ResourceOptions.SilentMode = True
+    UpdateOptions.AssignedValues = [uvCheckRequired, uvAutoCommitUpdates]
+    UpdateOptions.CheckRequired = False
+    UpdateOptions.AutoCommitUpdates = True
+    StoreDefs = True
+    Left = 134
+    Top = 473
+  end
+  object dsConnectedClients: TDataSource
+    DataSet = tblConnectedClients
+    Left = 136
+    Top = 527
   end
 end

emiMobileServer/Source/Main.pas

@@ -7,16 +7,27 @@ uses
   System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs,
   Vcl.StdCtrls, Vcl.ExtCtrls, System.Generics.Collections, System.IniFiles,
   Auth.Service, Auth.Server.Module, Api.Server.Module, App.Server.Module,
-  ExeInfo, Api.Service;
+  ExeInfo, Api.Service, Vcl.ComCtrls, WebSocket.Manager,
+  VCL.TMSFNCWebSocketCommon, VCL.TMSFNCCustomComponent,
+  VCL.TMSFNCWebSocketClient, WEBLib.WebSocketClient, FireDAC.Stan.Intf,
+  FireDAC.Stan.Option, FireDAC.Stan.Param, FireDAC.Stan.Error, FireDAC.DatS,
+  FireDAC.Phys.Intf, FireDAC.DApt.Intf, Data.DB, Vcl.Grids, Vcl.DBGrids,
+  FireDAC.Comp.DataSet, FireDAC.Comp.Client;
 
 type
   TFMain = class(TForm)
-    memoInfo: TMemo;
     btnApiSwaggerUI: TButton;
     btnExit: TButton;
     initTimer: TTimer;
     btnAuthSwaggerUI: TButton;
     ExeInfo1: TExeInfo;
+    pgcMain: TPageControl;
+    tabServerLog: TTabSheet;
+    tabConnectedClients: TTabSheet;
+    memoInfo: TMemo;
+    tblConnectedClients: TFDMemTable;
+    dsConnectedClients: TDataSource;
+    grdConnectedClients: TDBGrid;
     procedure btnApiSwaggerUIClick(Sender: TObject);
     procedure btnExitClick(Sender: TObject);
     procedure ContactFormData(AText: String);
@@ -24,6 +35,7 @@ type
     procedure initTimerTimer(Sender: TObject);
     procedure btnAuthSwaggerUIClick(Sender: TObject);
   strict private
+    FWebSocketManager: TWebSocketManager;
     procedure StartServers;
     function LogValue(const LabelName: string; const Value: string; FromIni: Boolean): string;
   private
@@ -93,6 +105,9 @@ end;
 
 procedure TFMain.FormClose(Sender: TObject; var Action: TCloseAction);
 begin
+  FWebSocketManager.OnClientsChanged := nil;
+  FWebSocketManager.Free;
+
   ServerConfig.Free;
   IniEntries.Free;
   AuthServerModule.Free;
@@ -138,6 +153,10 @@ begin
 
     AppServerModule := TAppServerModule.Create(Self);
     AppServerModule.StartAppServer(ServerConfig.url);
+
+    FWebSocketManager := TWebSocketManager.Create;
+    FWebSocketManager.Start;
+    Logger.Log(1, 'WebSocket server started on port 8091');
   except
     on E: Exception do
       Logger.Log(2, 'Failed to start server modules: ' + E.Message);

emiMobileServer/Source/WebSocket.Manager.pas

+unit WebSocket.Manager;
+
+interface
+
+uses
+  System.Classes,
+  System.SysUtils,
+  System.JSON,
+  System.Generics.Collections,
+  VCL.TMSFNCWebSocketServer,
+  VCL.TMSFNCWebSocketCommon;
+
+type
+  TConnectedClientSnapshot = record
+    ConnectionId: string;
+    UserId: string;
+    ConnectedAt: TDateTime;
+  end;
+
+  TConnectedClient = class
+  private
+    FConnectionId: string;
+    FUserId: string;
+    FConnectedAt: TDateTime;
+    FConnection: TTMSFNCWebSocketServerConnection;
+  public
+    property ConnectionId: string read FConnectionId write FConnectionId;
+    property UserId: string read FUserId write FUserId;
+    property ConnectedAt: TDateTime read FConnectedAt write FConnectedAt;
+    property Connection: TTMSFNCWebSocketServerConnection
+      read FConnection write FConnection;
+  end;
+
+  TClientsChangedEvent = procedure of object;
+
+  TWebSocketManager = class
+  private
+    FServer: TTMSFNCWebSocketServer;
+    FClients: TObjectList<TConnectedClient>;
+    FClientsLock: TObject;
+    FOnClientsChanged: TClientsChangedEvent;
+
+    procedure NotifyClientsChanged;
+    procedure HandshakeResponseSent(Sender: TObject;
+      AConnection: TTMSFNCWebSocketServerConnection);
+    procedure MessageReceived(Sender: TObject;
+      AConnection: TTMSFNCWebSocketConnection; const AMessage: string);
+    procedure ClientDisconnected(Sender: TObject;
+      AConnection: TTMSFNCWebSocketConnection);
+  public
+    constructor Create;
+    destructor Destroy; override;
+
+    procedure Start;
+    procedure Stop;
+    function GetClientSnapshots: TArray<TConnectedClientSnapshot>;
+
+    property OnClientsChanged: TClientsChangedEvent
+      read FOnClientsChanged write FOnClientsChanged;
+  end;
+
+implementation
+
+uses
+  Common.Logging;
+
+const
+  WEBSOCKET_PORT = 8091;
+
+constructor TWebSocketManager.Create;
+begin
+  inherited Create;
+
+  FClientsLock := TObject.Create;
+  FClients := TObjectList<TConnectedClient>.Create(True);
+
+  FServer := TTMSFNCWebSocketServer.Create;
+  FServer.Port := WEBSOCKET_PORT;
+  FServer.UseSSL := False;
+  FServer.OnHandshakeResponseSent := HandshakeResponseSent;
+  FServer.OnMessageReceived := MessageReceived;
+  FServer.OnDisconnect := ClientDisconnected;
+end;
+
+destructor TWebSocketManager.Destroy;
+begin
+  Stop;
+  FServer.Free;
+  FClients.Free;
+  FClientsLock.Free;
+
+  inherited;
+end;
+
+procedure TWebSocketManager.Start;
+begin
+  FServer.Active := True;
+end;
+
+procedure TWebSocketManager.Stop;
+begin
+  FServer.Active := False;
+end;
+
+procedure TWebSocketManager.NotifyClientsChanged;
+begin
+  if Assigned(FOnClientsChanged) then
+    FOnClientsChanged;
+end;
+
+procedure TWebSocketManager.HandshakeResponseSent(Sender: TObject;
+  AConnection: TTMSFNCWebSocketServerConnection);
+var
+  client: TConnectedClient;
+  guid: TGUID;
+begin
+  CreateGUID(guid);
+
+  client := TConnectedClient.Create;
+  client.ConnectionId := GUIDToString(guid);
+  client.ConnectedAt := Now;
+  client.Connection := AConnection;
+
+  TMonitor.Enter(FClientsLock);
+  try
+    FClients.Add(client);
+  finally
+    TMonitor.Exit(FClientsLock);
+  end;
+
+  AConnection.OwnsUserData := False;
+  AConnection.UserData := client;
+
+  Logger.Log(1, 'WebSocket client connected: ' + client.ConnectionId);
+  NotifyClientsChanged;
+end;
+
+procedure TWebSocketManager.MessageReceived(Sender: TObject;
+  AConnection: TTMSFNCWebSocketConnection; const AMessage: string);
+var
+  json: TJSONValue;
+  messageType: string;
+  userId: string;
+  connectionId: string;
+  client: TConnectedClient;
+begin
+  json := TJSONObject.ParseJSONValue(AMessage);
+  try
+    if not Assigned(json) then
+      Exit;
+
+    if not json.TryGetValue<string>('message', messageType) then
+      Exit;
+
+    if messageType <> 'identify' then
+      Exit;
+
+    if not json.TryGetValue<string>('userId', userId) then
+      Exit;
+
+    client := TConnectedClient(
+      TTMSFNCWebSocketServerConnection(AConnection).UserData
+    );
+
+    if not Assigned(client) then
+      Exit;
+
+    TMonitor.Enter(FClientsLock);
+    try
+      if FClients.IndexOf(client) < 0 then
+        Exit;
+
+      client.UserId := userId;
+      connectionId := client.ConnectionId;
+    finally
+      TMonitor.Exit(FClientsLock);
+    end;
+
+    Logger.Log(1, 'WebSocket client identified: ' +
+      connectionId + ' - ' + userId);
+
+    NotifyClientsChanged;
+  finally
+    json.Free;
+  end;
+end;
+
+procedure TWebSocketManager.ClientDisconnected(Sender: TObject;
+  AConnection: TTMSFNCWebSocketConnection);
+var
+  serverConnection: TTMSFNCWebSocketServerConnection;
+  client: TConnectedClient;
+  connectionId: string;
+  userId: string;
+begin
+  serverConnection := TTMSFNCWebSocketServerConnection(AConnection);
+  client := TConnectedClient(serverConnection.UserData);
+
+  if not Assigned(client) then
+    Exit;
+
+  connectionId := client.ConnectionId;
+  userId := client.UserId;
+  serverConnection.UserData := nil;
+
+  TMonitor.Enter(FClientsLock);
+  try
+    FClients.Remove(client);
+  finally
+    TMonitor.Exit(FClientsLock);
+  end;
+
+  Logger.Log(1, 'WebSocket client disconnected: ' +
+    connectionId + ' - ' + userId);
+
+  NotifyClientsChanged;
+end;
+
+function TWebSocketManager.GetClientSnapshots:
+  TArray<TConnectedClientSnapshot>;
+var
+  i: Integer;
+begin
+  TMonitor.Enter(FClientsLock);
+  try
+    SetLength(Result, FClients.Count);
+
+    for i := 0 to FClients.Count - 1 do
+    begin
+      Result[i].ConnectionId := FClients[i].ConnectionId;
+      Result[i].UserId := FClients[i].UserId;
+      Result[i].ConnectedAt := FClients[i].ConnectedAt;
+    end;
+  finally
+    TMonitor.Exit(FClientsLock);
+  end;
+end;
+
+end.

emiMobileServer/bin/emiMobileServer.ini

 [Settings]
-LogFileNum=729
+LogFileNum=738
 webClientVersion=9.4.0
 
 [Database]

emiMobileServer/emiMobileServer.dpr

@@ -21,7 +21,8 @@ uses
   Auth.ServiceImpl in 'Source\Auth.ServiceImpl.pas',
   Api.ServiceImpl in 'Source\Api.ServiceImpl.pas',
   App.Server.Module in 'Source\App.Server.Module.pas' {AppServerModule: TDataModule},
-  Common.Ini in 'Source\Common.Ini.pas';
+  Common.Ini in 'Source\Common.Ini.pas',
+  WebSocket.Manager in 'Source\WebSocket.Manager.pas';
 
 type
   TMemoLogAppender = class( TInterfacedObject, ILogAppender )

emiMobileServer/emiMobileServer.dproj

@@ -165,6 +165,7 @@
             <DesignClass>TDataModule</DesignClass>
         </DCCReference>
         <DCCReference Include="Source\Common.Ini.pas"/>
+        <DCCReference Include="Source\WebSocket.Manager.pas"/>
         <BuildConfiguration Include="Base">
             <Key>Base</Key>
         </BuildConfiguration>
@@ -193,7 +194,7 @@
                 </Excluded_Packages>
             </Delphi.Personality>
             <Deployment Version="5">
-                <DeployFile LocalName="emiMobileServer.exe" Configuration="Debug" Class="ProjectOutput">
+                <DeployFile LocalName="bin\emiMobileServer.exe" Configuration="Debug" Class="ProjectOutput">
                     <Platform Name="Win32">
                         <RemoteName>emiMobileServer.exe</RemoteName>
                         <Overwrite>true</Overwrite>

webEMIMobile/View.Main.dfm

@@ -70,18 +70,6 @@ object FViewMain: TFViewMain
     ElementID = 'pnl_main'
     ChildOrder = 3
     TabOrder = 0
-    object WebButton1: TWebButton
-      Left = 456
-      Top = 20
-      Width = 96
-      Height = 25
-      Caption = 'WebButton1'
-      ElementClassName = 'btn btn-light'
-      ElementFont = efCSS
-      HeightStyle = ssAuto
-      HeightPercent = 100.000000000000000000
-      WidthPercent = 100.000000000000000000
-    end
   end
   object WebMessageDlg1: TWebMessageDlg
     Left = 47
@@ -250,4 +238,13 @@ object FViewMain: TFViewMain
     Left = 42
     Top = 434
   end
+  object wsClient: TWebSocketClient
+    Port = 8091
+    HostName = '127.0.0.1'
+    OnConnect = wsClientConnect
+    OnDisconnect = wsClientDisconnect
+    OnDataReceived = wsClientDataReceived
+    Left = 62
+    Top = 654
+  end
 end

webEMIMobile/View.Main.pas

@@ -6,7 +6,8 @@ uses
   System.SysUtils, System.Classes, JS, Web, WEBLib.Graphics, WEBLib.Controls,
   WEBLib.Forms, WEBLib.Dialogs, WEBLib.ExtCtrls, Vcl.Controls, Vcl.StdCtrls,
   WEBLib.StdCtrls, Data.DB, XData.Web.JsonDataset, XData.Web.Dataset,
-  App.Types, ConnectionModule, XData.Web.Client, View.Map, View.Units, View.Complaints;
+  App.Types, ConnectionModule, XData.Web.Client, View.Map, View.Units, View.Complaints,
+  WEBLib.WebSocketClient;
 
 type
   TFViewMain = class(TWebForm)
@@ -31,8 +32,8 @@ type
     btnDetailsModalClose: TWebButton;
     pnlArchive: TWebPanel;
     btnArchiveModalClose: TWebButton;
-    WebButton1: TWebButton;
     btnLogout: TWebButton;
+    wsClient: TWebSocketClient;
     procedure WebFormCreate(Sender: TObject);
     procedure mnuLogoutClick(Sender: TObject);
     procedure lblLogoutClick(Sender: TObject);
@@ -44,6 +45,10 @@ type
     procedure btnDetailsModalCloseClick(Sender: TObject);
     procedure btnArchiveModalCloseClick(Sender: TObject);
     procedure btnLogoutClick(Sender: TObject);
+    procedure wsClientConnect(Sender: TObject);
+    procedure wsClientDisconnect(Sender: TObject);
+    procedure wsClientDataReceived(Sender: TObject; Origin: string;
+      SocketData: TJSObjectRecord);
   private
     { Private declarations }
     FUserInfo: string;
@@ -150,9 +155,38 @@ begin
   SetActivePanel(apMap);
 
   RefreshBadgesAsync;
+
+  wsClient.Connect;
 end;
 
 
+procedure TFViewMain.wsClientConnect(Sender: TObject);
+var
+  msg: TJSObject;
+begin
+  Console.Log('wsClientConnect fired');
+
+  msg := TJSObject.new;
+  msg['message'] := 'identify';
+  msg['userId'] := JS.toString(
+    AuthService.TokenPayload.Properties['user_name']
+  );
+
+  Console.Log('Sending WebSocket identify');
+  wsClient.Send(TJSJSON.stringify(msg));
+end;
+
+procedure TFViewMain.wsClientDataReceived(Sender: TObject; Origin: string;
+  SocketData: TJSObjectRecord);
+begin
+    console.log('WebSocket message received: ' + SocketData.jsObject.toString);
+end;
+
+procedure TFViewMain.wsClientDisconnect(Sender: TObject);
+begin
+    console.log('WebSocket disconnected');
+end;
+
 procedure TFViewMain.SetActivePanel(panel: TActivePanel);
 begin
   FActivePanel := panel;