Skip to content

E
emiMobile
Commit b47e6601 by Mac Stephens
Options

Improve mobile reliability, map controls, and WebSocket recovery

parent ab0baace
Showing with 1443 additions and 144 deletions
emiMobileServer/Source/Main.dfm
......@@ -87,7 +87,7 @@ object FMain: TFMain
Top = 18
Width = 141
Height = 25
Caption = 'Disconnect Selected Client'
Caption = 'Refresh Client'
TabOrder = 0
OnClick = btnDisconnectClientClick
end
......
emiMobileServer/Source/WebSocket.Manager.pas
......@@ -7,11 +7,14 @@ uses
System.SysUtils,
System.JSON,
System.Generics.Collections,
Vcl.ExtCtrls,
VCL.TMSFNCWebSocketServer,
VCL.TMSFNCWebSocketCommon;
const
WEBSOCKET_PORT = 8091;
HEARTBEAT_TIMEOUT_MS = 75000;
HEARTBEAT_SWEEP_INTERVAL_MS = 10000;
type
TConnectedClientSnapshot = record
......@@ -25,11 +28,17 @@ type
FConnectionId: string;
FUserId: string;
FConnectedAt: TDateTime;
FLastSeenAt: TDateTime;
FHeartbeatSeen: Boolean;
FClosing: Boolean;
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 LastSeenAt: TDateTime read FLastSeenAt write FLastSeenAt;
property HeartbeatSeen: Boolean read FHeartbeatSeen write FHeartbeatSeen;
property Closing: Boolean read FClosing write FClosing;
property Connection: TTMSFNCWebSocketServerConnection read FConnection write FConnection;
end;
......@@ -40,8 +49,14 @@ type
FServer: TTMSFNCWebSocketServer;
FClients: TObjectList<TConnectedClient>;
FClientsLock: TObject;
FSendLock: TObject;
FHeartbeatTimer: TTimer;
FOnClientsChanged: TClientsChangedEvent;
function TrySendTextToClient(const AConnectionId, AMessage: string;
ALogFailure: Boolean = True): Boolean;
function TryCloseClient(const AConnectionId: string): Boolean;
procedure HeartbeatTimer(Sender: TObject);
procedure NotifyClientsChanged;
procedure HandshakeResponseSent(Sender: TObject; AConnection: TTMSFNCWebSocketServerConnection);
procedure MessageReceived(Sender: TObject; AConnection: TTMSFNCWebSocketConnection; const AMessage: string);
......@@ -63,6 +78,7 @@ type
implementation
uses
System.DateUtils,
Common.Logging;
constructor TWebSocketManager.Create;
......@@ -70,6 +86,7 @@ begin
inherited Create;
FClientsLock := TObject.Create;
FSendLock := TObject.Create;
FClients := TObjectList<TConnectedClient>.Create(True);
FServer := TTMSFNCWebSocketServer.Create;
......@@ -78,13 +95,21 @@ begin
FServer.OnHandshakeResponseSent := HandshakeResponseSent;
FServer.OnMessageReceived := MessageReceived;
FServer.OnDisconnect := ClientDisconnected;
FHeartbeatTimer := TTimer.Create(nil);
FHeartbeatTimer.Enabled := False;
FHeartbeatTimer.Interval := HEARTBEAT_SWEEP_INTERVAL_MS;
FHeartbeatTimer.OnTimer := HeartbeatTimer;
end;
destructor TWebSocketManager.Destroy;
begin
FHeartbeatTimer.Enabled := False;
Stop;
FHeartbeatTimer.Free;
FServer.Free;
FClients.Free;
FSendLock.Free;
FClientsLock.Free;
inherited;
......@@ -93,94 +118,173 @@ end;
procedure TWebSocketManager.Start;
begin
FServer.Active := True;
FHeartbeatTimer.Enabled := True;
end;
procedure TWebSocketManager.Stop;
begin
if Assigned(FHeartbeatTimer) then
FHeartbeatTimer.Enabled := False;
FServer.Active := False;
end;
procedure TWebSocketManager.Broadcast(AMessage: string);
function TWebSocketManager.TrySendTextToClient(const AConnectionId,
AMessage: string; ALogFailure: Boolean): Boolean;
var
connections: TArray<TTMSFNCWebSocketServerConnection>;
i: Integer;
client: TConnectedClient;
connection: TTMSFNCWebSocketServerConnection;
begin
TMonitor.Enter(FClientsLock);
Result := False;
connection := nil;
// TMS owns and frees the connection immediately after its disconnect
// callback returns. Holding FSendLock makes that callback wait until the
// send has completed, while FClientsLock protects the registry lookup.
TMonitor.Enter(FSendLock);
try
SetLength(connections, FClients.Count);
TMonitor.Enter(FClientsLock);
try
for client in FClients do
begin
if SameText(client.ConnectionId, AConnectionId) then
begin
if not client.Closing then
connection := client.Connection;
Break;
end;
end;
finally
TMonitor.Exit(FClientsLock);
end;
for i := 0 to FClients.Count - 1 do
connections[i] := FClients[i].Connection;
finally
TMonitor.Exit(FClientsLock);
end;
if not Assigned(connection) then
Exit;
for i := 0 to Length(connections) - 1 do
begin
try
connections[i].Send(AMessage);
connection.Send(AMessage);
Result := True;
except
on E: Exception do
Logger.Log(2, 'WebSocket broadcast failed: ' + E.Message);
begin
if ALogFailure then
Logger.Log(2, 'WebSocket send failed: ' + E.Message);
end;
end;
finally
TMonitor.Exit(FSendLock);
end;
end;
procedure TWebSocketManager.DisconnectClient(AConnectionId: string);
function TWebSocketManager.TryCloseClient(
const AConnectionId: string): Boolean;
var
client: TConnectedClient;
connection: TTMSFNCWebSocketServerConnection;
begin
Result := False;
connection := nil;
TMonitor.Enter(FClientsLock);
TMonitor.Enter(FSendLock);
try
for client in FClients do
begin
if SameText(client.ConnectionId, AConnectionId) then
TMonitor.Enter(FClientsLock);
try
for client in FClients do
begin
connection := client.Connection;
Break;
if SameText(client.ConnectionId, AConnectionId) then
begin
client.Closing := True;
connection := client.Connection;
Break;
end;
end;
finally
TMonitor.Exit(FClientsLock);
end;
if not Assigned(connection) then
Exit;
try
connection.SendClose;
Result := True;
except
on E: Exception do
Logger.Log(2, 'WebSocket close failed: ' + E.Message);
end;
finally
TMonitor.Exit(FClientsLock);
TMonitor.Exit(FSendLock);
end;
if Assigned(connection) then
connection.SendClose;
end;
procedure TWebSocketManager.SendMessageToClient(AConnectionId, AText: string);
procedure TWebSocketManager.HeartbeatTimer(Sender: TObject);
var
staleConnectionIds: TList<string>;
client: TConnectedClient;
connection: TTMSFNCWebSocketServerConnection;
json: TJSONObject;
connectionId: string;
checkTime: TDateTime;
begin
connection := nil;
TMonitor.Enter(FClientsLock);
staleConnectionIds := TList<string>.Create;
try
for client in FClients do
begin
if SameText(client.ConnectionId, AConnectionId) then
checkTime := Now;
TMonitor.Enter(FClientsLock);
try
for client in FClients do
begin
connection := client.Connection;
Break;
if client.HeartbeatSeen and (not client.Closing) and
(MilliSecondsBetween(checkTime, client.LastSeenAt) >= HEARTBEAT_TIMEOUT_MS) then
begin
client.Closing := True;
staleConnectionIds.Add(client.ConnectionId);
end;
end;
finally
TMonitor.Exit(FClientsLock);
end;
for connectionId in staleConnectionIds do
begin
Logger.Log(2, 'WebSocket client heartbeat timeout: ' + connectionId);
TryCloseClient(connectionId);
end;
finally
staleConnectionIds.Free;
end;
end;
procedure TWebSocketManager.Broadcast(AMessage: string);
var
connectionIds: TArray<string>;
i: Integer;
begin
TMonitor.Enter(FClientsLock);
try
SetLength(connectionIds, FClients.Count);
for i := 0 to FClients.Count - 1 do
connectionIds[i] := FClients[i].ConnectionId;
finally
TMonitor.Exit(FClientsLock);
end;
if not Assigned(connection) then
Exit;
for i := 0 to Length(connectionIds) - 1 do
TrySendTextToClient(connectionIds[i], AMessage);
end;
procedure TWebSocketManager.DisconnectClient(AConnectionId: string);
begin
TryCloseClient(AConnectionId);
end;
procedure TWebSocketManager.SendMessageToClient(AConnectionId, AText: string);
var
json: TJSONObject;
begin
json := TJSONObject.Create;
try
json.AddPair('message', 'test_message');
json.AddPair('text', AText);
connection.Send(json.ToJSON);
TrySendTextToClient(AConnectionId, json.ToJSON);
finally
json.Free;
end;
......@@ -202,6 +306,9 @@ begin
client := TConnectedClient.Create;
client.ConnectionId := GUIDToString(guid);
client.ConnectedAt := Now;
client.LastSeenAt := client.ConnectedAt;
client.HeartbeatSeen := False;
client.Closing := False;
client.Connection := AConnection;
TMonitor.Enter(FClientsLock);
......@@ -225,6 +332,7 @@ var
userId: string;
connectionId: string;
client: TConnectedClient;
response: TJSONObject;
begin
json := TJSONObject.ParseJSONValue(AMessage);
try
......@@ -234,10 +342,12 @@ begin
if not json.TryGetValue<string>('message', messageType) then
Exit;
if messageType <> 'identify' then
if (not SameText(messageType, 'identify')) and
(not SameText(messageType, 'heartbeat')) then
Exit;
if not json.TryGetValue<string>('userId', userId) then
if SameText(messageType, 'identify') and
(not json.TryGetValue<string>('userId', userId)) then
Exit;
client := TConnectedClient(TTMSFNCWebSocketServerConnection(AConnection).UserData);
......@@ -250,14 +360,32 @@ begin
if FClients.IndexOf(client) < 0 then
Exit;
client.UserId := userId;
client.LastSeenAt := Now;
connectionId := client.ConnectionId;
if SameText(messageType, 'identify') then
client.UserId := userId
else
client.HeartbeatSeen := True;
finally
TMonitor.Exit(FClientsLock);
end;
Logger.Log(1, 'WebSocket client identified: ' + connectionId + ' - ' + userId);
NotifyClientsChanged;
if SameText(messageType, 'identify') then
begin
Logger.Log(1, 'WebSocket client identified: ' + connectionId + ' - ' + userId);
NotifyClientsChanged;
end
else
begin
response := TJSONObject.Create;
try
response.AddPair('message', 'heartbeat_ack');
TrySendTextToClient(connectionId, response.ToJSON, False);
finally
response.Free;
end;
end;
finally
json.Free;
end;
......@@ -271,20 +399,32 @@ var
userId: string;
begin
serverConnection := TTMSFNCWebSocketServerConnection(AConnection);
client := TConnectedClient(serverConnection.UserData);
connectionId := '';
userId := '';
if not Assigned(client) then
Exit;
// TMS frees AConnection immediately after this callback returns. Matching
// the safe-send lock here keeps every active send inside that lifetime.
TMonitor.Enter(FSendLock);
try
client := TConnectedClient(serverConnection.UserData);
if not Assigned(client) then
Exit;
connectionId := client.ConnectionId;
userId := client.UserId;
serverConnection.UserData := nil;
TMonitor.Enter(FClientsLock);
try
if FClients.IndexOf(client) < 0 then
Exit;
TMonitor.Enter(FClientsLock);
try
FClients.Remove(client);
connectionId := client.ConnectionId;
userId := client.UserId;
serverConnection.UserData := nil;
FClients.Remove(client);
finally
TMonitor.Exit(FClientsLock);
end;
finally
TMonitor.Exit(FClientsLock);
TMonitor.Exit(FSendLock);
end;
Logger.Log(1, 'WebSocket client disconnected: ' + connectionId + ' - ' + userId);
......@@ -310,4 +450,4 @@ begin
end;
end;
end.
\ No newline at end of file
end.
emiMobileServer/bin/emiMobileServer.ini
[Settings]
LogFileNum=153
LogFileNum=155
webClientVersion=0.9.4.1
[Database]
......
webEMIMobile/Module.Websocket.pas
......@@ -3,13 +3,24 @@
interface
uses
System.SysUtils, System.Classes, WEBLib.WebSocketClient, Web, WEBLib.Controls, WEBLib.Modules,
Auth.Service, JS;
System.SysUtils, System.Classes, WEBLib.WebSocketClient, Web, WEBLib.Controls,
WEBLib.Modules, Auth.Service, JS;
type
// Handler signature: receives the fully parsed JSON object for one push message.
TWsDataHandler = procedure(aData: TJSObject) of object;
TWsConnectionState = (
wcsStopped,
wcsConnecting,
wcsConnected,
wcsReconnecting,
wcsOffline
);
TWsConnectionStateHandler = procedure(AState: TWsConnectionState) of object;
TWsNotifyHandler = procedure of object;
TdmWebsocket = class(TWebDataModule)
procedure WebDataModuleCreate(Sender: TObject);
procedure WebDataModuleDestroy(Sender: TObject);
......@@ -25,24 +36,83 @@ type
AData: TBytes);
procedure DispatchMessage(const AMessage: string);
procedure AttemptConnect;
procedure ScheduleReconnect(AImmediate: Boolean);
procedure RequestSocketRestart(AImmediate: Boolean);
procedure ScheduleHeartbeat(ADelayMs: Integer);
procedure SendHeartbeat;
procedure SendHeartbeatAck;
procedure NoteSocketActivity;
procedure HandleAuthenticationExpired;
procedure SetConnectionState(AState: TWsConnectionState);
procedure CancelReconnectTimer;
procedure CancelConnectTimeout;
procedure CancelHeartbeatTimer;
procedure CancelHeartbeatTimeout;
procedure CancelAllTimers;
procedure RegisterLifecycleListeners;
procedure UnregisterLifecycleListeners;
procedure AttachSocketEvents;
procedure DetachSocketEvents(ASocket: TWebSocketClient);
procedure ReplaceSocket(ACreateReplacement: Boolean);
procedure HandlePause(Event: TJSEvent);
procedure HandleResume(Event: TJSEvent);
procedure HandleVisibilityChange(Event: TJSEvent);
procedure HandleOnline(Event: TJSEvent);
procedure HandleOffline(Event: TJSEvent);
procedure EnterPausedState;
procedure ResumeFromPausedState;
function ConfigureSocket: Boolean;
function AuthenticationIsValid: Boolean;
function BrowserIsOnline: Boolean;
function DocumentIsHidden: Boolean;
function NextReconnectDelayMs: Integer;
function AddJitter(ABaseMs: Integer): Integer;
function UrlEncode(const AValue: string): string;
FBaseWsUrl: string;
FState: TWsConnectionState;
FStarted: Boolean;
FPaused: Boolean;
FConnecting: Boolean;
FTransportMayBeActive: Boolean;
FAttemptedConnection: Boolean;
FHasConnected: Boolean;
FRecoveryPending: Boolean;
FHeartbeatOutstanding: Boolean;
FAuthenticationNotified: Boolean;
FDestroyingManager: Boolean;
FLifecycleListenersRegistered: Boolean;
FReconnectAttempt: Integer;
FReconnectTimerId: NativeInt;
FConnectTimeoutId: NativeInt;
FHeartbeatTimerId: NativeInt;
FHeartbeatTimeoutId: NativeInt;
FOnBadgeCounts: TWsDataHandler;
FOnUnitMap: TWsDataHandler;
FOnComplaintMap: TWsDataHandler;
FOnUnitList: TWsDataHandler;
FOnBadgeCounts: TWsDataHandler;
FOnUnitMap: TWsDataHandler;
FOnComplaintMap: TWsDataHandler;
FOnUnitList: TWsDataHandler;
FOnComplaintList: TWsDataHandler;
FOnStateChanged: TWsConnectionStateHandler;
FOnRecoveryRequired: TWsNotifyHandler;
FOnAuthenticationExpired: TWsNotifyHandler;
public
EMiMobileWebSocketClient: TWebSocketClient;
procedure Connect(const AWsUrl: string);
procedure Stop;
// Assign these before calling Connect so that pushes are routed immediately.
property OnBadgeCounts: TWsDataHandler read FOnBadgeCounts write FOnBadgeCounts;
property OnUnitMap: TWsDataHandler read FOnUnitMap write FOnUnitMap;
property OnComplaintMap: TWsDataHandler read FOnComplaintMap write FOnComplaintMap;
property OnUnitList: TWsDataHandler read FOnUnitList write FOnUnitList;
// Assign these before calling Connect so pushes and state changes are routed immediately.
property OnBadgeCounts: TWsDataHandler read FOnBadgeCounts write FOnBadgeCounts;
property OnUnitMap: TWsDataHandler read FOnUnitMap write FOnUnitMap;
property OnComplaintMap: TWsDataHandler read FOnComplaintMap write FOnComplaintMap;
property OnUnitList: TWsDataHandler read FOnUnitList write FOnUnitList;
property OnComplaintList: TWsDataHandler read FOnComplaintList write FOnComplaintList;
property OnStateChanged: TWsConnectionStateHandler read FOnStateChanged write FOnStateChanged;
property OnRecoveryRequired: TWsNotifyHandler read FOnRecoveryRequired write FOnRecoveryRequired;
property OnAuthenticationExpired: TWsNotifyHandler read FOnAuthenticationExpired write FOnAuthenticationExpired;
property State: TWsConnectionState read FState;
end;
var
......@@ -54,23 +124,105 @@ implementation
{$R *.dfm}
procedure TdmWebsocket.Connect(const AWsUrl: string);
const
CONNECT_TIMEOUT_MS = 15000;
HEARTBEAT_INTERVAL_MS = 20000;
HEARTBEAT_TIMEOUT_MS = 10000;
function TdmWebsocket.AddJitter(ABaseMs: Integer): Integer;
begin
Result := ABaseMs;
asm
Result = ABaseMs + Math.round(((Math.random() * 0.2) - 0.1) * ABaseMs);
end;
if Result < 250 then
Result := 250;
end;
function TdmWebsocket.AuthenticationIsValid: Boolean;
begin
Result := False;
try
Result := AuthService.Authenticated and (not AuthService.TokenExpired);
except
Result := False;
end;
end;
function TdmWebsocket.BrowserIsOnline: Boolean;
begin
Result := True;
asm
if ((typeof navigator !== 'undefined') && ('onLine' in navigator)) {
Result = navigator.onLine !== false;
}
end;
end;
procedure TdmWebsocket.CancelAllTimers;
begin
CancelReconnectTimer;
CancelConnectTimeout;
CancelHeartbeatTimer;
CancelHeartbeatTimeout;
end;
procedure TdmWebsocket.CancelConnectTimeout;
begin
if FConnectTimeoutId = 0 then
Exit;
window.clearTimeout(FConnectTimeoutId);
FConnectTimeoutId := 0;
end;
procedure TdmWebsocket.CancelHeartbeatTimeout;
begin
if FHeartbeatTimeoutId = 0 then
Exit;
window.clearTimeout(FHeartbeatTimeoutId);
FHeartbeatTimeoutId := 0;
end;
procedure TdmWebsocket.CancelHeartbeatTimer;
begin
if FHeartbeatTimerId = 0 then
Exit;
window.clearTimeout(FHeartbeatTimerId);
FHeartbeatTimerId := 0;
end;
procedure TdmWebsocket.CancelReconnectTimer;
begin
if FReconnectTimerId = 0 then
Exit;
window.clearTimeout(FReconnectTimerId);
FReconnectTimerId := 0;
end;
function TdmWebsocket.ConfigureSocket: Boolean;
var
Rest, HostPort, Scheme, Path, Token: string;
ColonSlashSlash, SlashPos, ColonPos: Integer;
begin
if AWsUrl = '' then
Exit;
Result := False;
// Parse ws://host:port/path or wss://host:port/path
ColonSlashSlash := Pos('://', AWsUrl);
ColonSlashSlash := Pos('://', FBaseWsUrl);
if ColonSlashSlash = 0 then
Exit;
Scheme := LowerCase(Copy(AWsUrl, 1, ColonSlashSlash - 1));
Rest := Copy(AWsUrl, ColonSlashSlash + 3, MaxInt);
Scheme := LowerCase(Copy(FBaseWsUrl, 1, ColonSlashSlash - 1));
if (Scheme <> 'ws') and (Scheme <> 'wss') then
Exit;
Rest := Copy(FBaseWsUrl, ColonSlashSlash + 3, MaxInt);
SlashPos := Pos('/', Rest);
if SlashPos > 0 then
begin
HostPort := Copy(Rest, 1, SlashPos - 1);
......@@ -82,14 +234,18 @@ begin
Path := '/';
end;
// Append JWT token as query param — browsers can't set Authorization headers on WebSocket.
if HostPort = '' then
Exit;
// Browsers cannot add an Authorization header during a WebSocket handshake.
// Build this path for every attempt so a stale token is never reused.
Token := AuthService.GetToken;
if Token <> '' then
begin
if Pos('?', Path) > 0 then
Path := Path + '&token=' + Token
Path := Path + '&token=' + UrlEncode(Token)
else
Path := Path + '?token=' + Token;
Path := Path + '?token=' + UrlEncode(Token);
end;
EMiMobileWebSocketClient.PathName := Path;
......@@ -99,9 +255,11 @@ begin
begin
EMiMobileWebSocketClient.HostName := Copy(HostPort, 1, ColonPos - 1);
if Scheme = 'wss' then
EMiMobileWebSocketClient.Port := StrToIntDef(Copy(HostPort, ColonPos + 1, MaxInt), 443)
EMiMobileWebSocketClient.Port := StrToIntDef(
Copy(HostPort, ColonPos + 1, MaxInt), 443)
else
EMiMobileWebSocketClient.Port := StrToIntDef(Copy(HostPort, ColonPos + 1, MaxInt), 80);
EMiMobileWebSocketClient.Port := StrToIntDef(
Copy(HostPort, ColonPos + 1, MaxInt), 80);
end
else
begin
......@@ -112,12 +270,209 @@ begin
EMiMobileWebSocketClient.Port := 80;
end;
console.log('WS: connecting to ' + AWsUrl);
EMiMobileWebSocketClient.UseSSL := Scheme = 'wss';
Result := True;
end;
procedure TdmWebsocket.Connect(const AWsUrl: string);
begin
if Trim(AWsUrl) = '' then
begin
Stop;
console.log('WS: no WebSocket URL configured');
Exit;
end;
if FStarted and SameText(FBaseWsUrl, AWsUrl) then
begin
if FPaused or (FState = wcsConnected) or (FState = wcsConnecting) or
(FReconnectTimerId <> 0) then
Exit;
ScheduleReconnect(True);
Exit;
end;
if FStarted then
begin
FBaseWsUrl := AWsUrl;
FRecoveryPending := True;
FReconnectAttempt := 0;
RequestSocketRestart(True);
Exit;
end;
FBaseWsUrl := AWsUrl;
FStarted := True;
FPaused := DocumentIsHidden;
FConnecting := False;
FAttemptedConnection := False;
FHasConnected := False;
FRecoveryPending := False;
FHeartbeatOutstanding := False;
FAuthenticationNotified := False;
FReconnectAttempt := 0;
if FPaused then
begin
SetConnectionState(wcsStopped);
Exit;
end;
if not AuthenticationIsValid then
begin
HandleAuthenticationExpired;
Exit;
end;
if not BrowserIsOnline then
begin
SetConnectionState(wcsOffline);
Exit;
end;
AttemptConnect;
end;
procedure TdmWebsocket.AttemptConnect;
begin
if (not FStarted) or FPaused or FDestroyingManager then
Exit;
if FConnecting or (FState = wcsConnected) then
Exit;
if not AuthenticationIsValid then
begin
HandleAuthenticationExpired;
Exit;
end;
if not BrowserIsOnline then
begin
SetConnectionState(wcsOffline);
Exit;
end;
if FTransportMayBeActive then
begin
RequestSocketRestart(True);
Exit;
end;
if not Assigned(EMiMobileWebSocketClient) then
begin
EMiMobileWebSocketClient := TWebSocketClient.Create(Self);
AttachSocketEvents;
end;
if not ConfigureSocket then
begin
console.log('WS: invalid WebSocket URL');
FStarted := False;
SetConnectionState(wcsStopped);
Exit;
end;
if FAttemptedConnection then
SetConnectionState(wcsReconnecting)
else
SetConnectionState(wcsConnecting);
FAttemptedConnection := True;
FConnecting := True;
FTransportMayBeActive := True;
CancelConnectTimeout;
FConnectTimeoutId := window.setTimeout(
procedure
begin
FConnectTimeoutId := 0;
if (not FStarted) or FPaused or (not FConnecting) then
Exit;
console.log('WS: connection attempt timed out');
FConnecting := False;
FRecoveryPending := True;
RequestSocketRestart(False);
end,
CONNECT_TIMEOUT_MS);
try
console.log('WS: connection attempt');
EMiMobileWebSocketClient.Connect;
except
on E: Exception do
begin
console.log('WS: connection attempt failed: ' + E.Message);
FConnecting := False;
FRecoveryPending := True;
RequestSocketRestart(False);
end;
end;
end;
procedure TdmWebsocket.AttachSocketEvents;
begin
if not Assigned(EMiMobileWebSocketClient) then
Exit;
EMiMobileWebSocketClient.OnConnect := EMiMobileWebSocketClientConnect;
EMiMobileWebSocketClient.OnDisconnect := EMiMobileWebSocketClientDisconnect;
EMiMobileWebSocketClient.OnDataReceived := EMiMobileWebSocketClientDataReceived;
EMiMobileWebSocketClient.OnMessageReceived := EMiMobileWebSocketClientMessageReceived;
EMiMobileWebSocketClient.OnBinaryDataReceived := EMiMobileWebSocketClientBinaryDataReceived;
end;
EMiMobileWebSocketClient.UseSSL := (Scheme = 'wss');
EMiMobileWebSocketClient.Active := True;
procedure TdmWebsocket.DetachSocketEvents(ASocket: TWebSocketClient);
begin
if not Assigned(ASocket) then
Exit;
console.log('WS: Active set to true');
ASocket.OnConnect := nil;
ASocket.OnDisconnect := nil;
ASocket.OnDataReceived := nil;
ASocket.OnMessageReceived := nil;
ASocket.OnBinaryDataReceived := nil;
end;
procedure TdmWebsocket.ReplaceSocket(ACreateReplacement: Boolean);
var
oldSocket: TWebSocketClient;
begin
oldSocket := EMiMobileWebSocketClient;
EMiMobileWebSocketClient := nil;
if Assigned(oldSocket) then
begin
DetachSocketEvents(oldSocket);
try
oldSocket.Disconnect;
except
on E: Exception do
console.log('WS: disconnect failed: ' + E.Message);
end;
oldSocket.Free;
end;
FTransportMayBeActive := False;
if ACreateReplacement and (not FDestroyingManager) then
begin
EMiMobileWebSocketClient := TWebSocketClient.Create(Self);
AttachSocketEvents;
end;
end;
function TdmWebsocket.DocumentIsHidden: Boolean;
begin
Result := False;
asm
if (typeof document !== 'undefined') {
Result = !!document.hidden;
}
end;
end;
procedure TdmWebsocket.DispatchMessage(const AMessage: string);
......@@ -148,6 +503,15 @@ begin
messageType := string(obj['message']);
if SameText(messageType, 'heartbeat_ack') then
Exit;
if SameText(messageType, 'heartbeat') then
begin
SendHeartbeatAck;
Exit;
end;
if SameText(messageType, 'test_message') then
begin
messageText := string(obj['text']);
......@@ -187,51 +551,552 @@ end;
procedure TdmWebsocket.EMiMobileWebSocketClientBinaryDataReceived(
Sender: TObject; AData: TBytes);
begin
if Sender <> EMiMobileWebSocketClient then
Exit;
if not AuthenticationIsValid then
begin
HandleAuthenticationExpired;
Exit;
end;
NoteSocketActivity;
console.log('WS: binary data received (ignored)');
end;
procedure TdmWebsocket.EMiMobileWebSocketClientConnect(Sender: TObject);
var
msg: TJSObject;
payload: TJSObject;
userId: string;
recoveryRequired: Boolean;
begin
if Sender <> EMiMobileWebSocketClient then
Exit;
if (not FStarted) or FDestroyingManager then
begin
ReplaceSocket(False);
Exit;
end;
if FPaused then
begin
SetConnectionState(wcsStopped);
ReplaceSocket(True);
Exit;
end;
if not BrowserIsOnline then
begin
SetConnectionState(wcsOffline);
ReplaceSocket(True);
Exit;
end;
if not AuthenticationIsValid then
begin
HandleAuthenticationExpired;
Exit;
end;
try
payload := AuthService.TokenPayload;
if not Assigned(payload) then
begin
HandleAuthenticationExpired;
Exit;
end;
userId := JS.toString(payload.Properties['user_name']);
if (Trim(userId) = '') or SameText(userId, 'undefined') or
SameText(userId, 'null') then
begin
HandleAuthenticationExpired;
Exit;
end;
msg := TJSObject.new;
msg['message'] := 'identify';
msg['userId'] := userId;
EMiMobileWebSocketClient.Send(TJSJSON.stringify(msg));
except
on E: Exception do
begin
console.log('WS: identify failed: ' + E.Message);
FConnecting := False;
FRecoveryPending := True;
RequestSocketRestart(False);
Exit;
end;
end;
console.log('WS: connected');
CancelConnectTimeout;
CancelReconnectTimer;
FConnecting := False;
FTransportMayBeActive := True;
FHeartbeatOutstanding := False;
FReconnectAttempt := 0;
FAuthenticationNotified := False;
msg := TJSObject.new;
msg['message'] := 'identify';
msg['userId'] := JS.toString(AuthService.TokenPayload.Properties['user_name']);
recoveryRequired := FRecoveryPending or FHasConnected;
FRecoveryPending := False;
FHasConnected := True;
EMiMobileWebSocketClient.Send(TJSJSON.stringify(msg));
SetConnectionState(wcsConnected);
ScheduleHeartbeat(1000);
if recoveryRequired and Assigned(FOnRecoveryRequired) then
FOnRecoveryRequired;
end;
procedure TdmWebsocket.EMiMobileWebSocketClientDataReceived(Sender: TObject;
Origin: string; SocketData: TJSObjectRecord);
begin
if Sender <> EMiMobileWebSocketClient then
Exit;
// Text messages arrive via EMiMobileWebSocketClientMessageReceived.
end;
procedure TdmWebsocket.EMiMobileWebSocketClientDisconnect(Sender: TObject);
begin
if Sender <> EMiMobileWebSocketClient then
Exit;
console.log('WS: disconnected');
CancelConnectTimeout;
CancelHeartbeatTimer;
CancelHeartbeatTimeout;
FConnecting := False;
FTransportMayBeActive := False;
FHeartbeatOutstanding := False;
if (not FStarted) or FDestroyingManager then
begin
SetConnectionState(wcsStopped);
Exit;
end;
if FPaused then
begin
SetConnectionState(wcsStopped);
Exit;
end;
if not BrowserIsOnline then
begin
SetConnectionState(wcsOffline);
Exit;
end;
FRecoveryPending := True;
ScheduleReconnect(False);
end;
procedure TdmWebsocket.EMiMobileWebSocketClientMessageReceived(Sender: TObject;
AMessage: string);
begin
if Sender <> EMiMobileWebSocketClient then
Exit;
if not AuthenticationIsValid then
begin
HandleAuthenticationExpired;
Exit;
end;
NoteSocketActivity;
DispatchMessage(AMessage);
end;
procedure TdmWebsocket.EnterPausedState;
begin
if FPaused then
Exit;
FPaused := True;
FRecoveryPending := FStarted;
FConnecting := False;
FHeartbeatOutstanding := False;
CancelAllTimers;
SetConnectionState(wcsStopped);
ReplaceSocket(True);
end;
procedure TdmWebsocket.HandleAuthenticationExpired;
var
notifyAuthenticationExpired: Boolean;
begin
notifyAuthenticationExpired := not FAuthenticationNotified;
FAuthenticationNotified := True;
FStarted := False;
FPaused := False;
FConnecting := False;
FHeartbeatOutstanding := False;
CancelAllTimers;
SetConnectionState(wcsStopped);
ReplaceSocket(False);
if notifyAuthenticationExpired and Assigned(FOnAuthenticationExpired) then
FOnAuthenticationExpired;
end;
procedure TdmWebsocket.HandleOffline(Event: TJSEvent);
begin
if (not FStarted) or FPaused then
Exit;
FRecoveryPending := True;
FConnecting := False;
FHeartbeatOutstanding := False;
CancelAllTimers;
SetConnectionState(wcsOffline);
ReplaceSocket(True);
end;
procedure TdmWebsocket.HandleOnline(Event: TJSEvent);
begin
if (not FStarted) or FPaused then
Exit;
if not AuthenticationIsValid then
begin
HandleAuthenticationExpired;
Exit;
end;
FRecoveryPending := True;
FReconnectAttempt := 0;
if FTransportMayBeActive then
RequestSocketRestart(True)
else
ScheduleReconnect(True);
end;
procedure TdmWebsocket.HandlePause(Event: TJSEvent);
begin
EnterPausedState;
end;
procedure TdmWebsocket.HandleResume(Event: TJSEvent);
begin
ResumeFromPausedState;
end;
procedure TdmWebsocket.HandleVisibilityChange(Event: TJSEvent);
begin
if DocumentIsHidden then
EnterPausedState
else
ResumeFromPausedState;
end;
function TdmWebsocket.NextReconnectDelayMs: Integer;
var
baseDelay: Integer;
begin
case FReconnectAttempt of
0: baseDelay := 1000;
1: baseDelay := 2000;
2: baseDelay := 5000;
3: baseDelay := 10000;
else
baseDelay := 30000;
end;
Inc(FReconnectAttempt);
Result := AddJitter(baseDelay);
end;
procedure TdmWebsocket.NoteSocketActivity;
begin
if FState <> wcsConnected then
Exit;
FHeartbeatOutstanding := False;
CancelHeartbeatTimeout;
ScheduleHeartbeat(HEARTBEAT_INTERVAL_MS);
end;
procedure TdmWebsocket.RegisterLifecycleListeners;
begin
if FLifecycleListenersRegistered then
Exit;
Document.addEventListener('pause', @HandlePause);
Document.addEventListener('resume', @HandleResume);
Document.addEventListener('visibilitychange', @HandleVisibilityChange);
window.addEventListener('online', @HandleOnline);
window.addEventListener('offline', @HandleOffline);
FLifecycleListenersRegistered := True;
end;
procedure TdmWebsocket.RequestSocketRestart(AImmediate: Boolean);
begin
if (not FStarted) or FPaused or FDestroyingManager then
Exit;
if not AuthenticationIsValid then
begin
HandleAuthenticationExpired;
Exit;
end;
if not BrowserIsOnline then
begin
SetConnectionState(wcsOffline);
Exit;
end;
FRecoveryPending := True;
FConnecting := False;
FHeartbeatOutstanding := False;
CancelConnectTimeout;
CancelHeartbeatTimer;
CancelHeartbeatTimeout;
SetConnectionState(wcsReconnecting);
// Detach and retire the current component before a replacement is opened.
// A late browser close from the old socket then has neither live handlers
// nor a matching Sender, so it cannot change the new connection's state.
ReplaceSocket(True);
ScheduleReconnect(AImmediate);
end;
procedure TdmWebsocket.ResumeFromPausedState;
begin
if not FStarted then
Exit;
FPaused := False;
FRecoveryPending := True;
FReconnectAttempt := 0;
if not AuthenticationIsValid then
begin
HandleAuthenticationExpired;
Exit;
end;
if not BrowserIsOnline then
begin
SetConnectionState(wcsOffline);
Exit;
end;
if FTransportMayBeActive then
RequestSocketRestart(True)
else
ScheduleReconnect(True);
end;
procedure TdmWebsocket.ScheduleHeartbeat(ADelayMs: Integer);
begin
CancelHeartbeatTimer;
if (not FStarted) or FPaused or (FState <> wcsConnected) then
Exit;
FHeartbeatTimerId := window.setTimeout(
procedure
begin
FHeartbeatTimerId := 0;
SendHeartbeat;
end,
ADelayMs);
end;
procedure TdmWebsocket.ScheduleReconnect(AImmediate: Boolean);
var
delayMs: Integer;
begin
if (not FStarted) or FPaused or FDestroyingManager then
Exit;
if not AuthenticationIsValid then
begin
HandleAuthenticationExpired;
Exit;
end;
if not BrowserIsOnline then
begin
SetConnectionState(wcsOffline);
Exit;
end;
if AImmediate then
CancelReconnectTimer
else if FReconnectTimerId <> 0 then
Exit;
if AImmediate then
delayMs := 0
else
delayMs := NextReconnectDelayMs;
if FAttemptedConnection then
SetConnectionState(wcsReconnecting)
else
SetConnectionState(wcsConnecting);
FReconnectTimerId := window.setTimeout(
procedure
begin
FReconnectTimerId := 0;
AttemptConnect;
end,
delayMs);
end;
procedure TdmWebsocket.SendHeartbeat;
var
msg: TJSObject;
begin
if (not FStarted) or FPaused or (FState <> wcsConnected) then
Exit;
if not AuthenticationIsValid then
begin
HandleAuthenticationExpired;
Exit;
end;
msg := TJSObject.new;
msg['message'] := 'heartbeat';
try
EMiMobileWebSocketClient.Send(TJSJSON.stringify(msg));
except
on E: Exception do
begin
console.log('WS: heartbeat send failed: ' + E.Message);
RequestSocketRestart(False);
Exit;
end;
end;
FHeartbeatOutstanding := True;
CancelHeartbeatTimeout;
FHeartbeatTimeoutId := window.setTimeout(
procedure
begin
FHeartbeatTimeoutId := 0;
if (not FStarted) or FPaused or
(FState <> wcsConnected) or (not FHeartbeatOutstanding) then
Exit;
console.log('WS: heartbeat timed out');
FHeartbeatOutstanding := False;
RequestSocketRestart(False);
end,
HEARTBEAT_TIMEOUT_MS);
end;
procedure TdmWebsocket.SendHeartbeatAck;
var
msg: TJSObject;
begin
if (not FStarted) or FPaused or (FState <> wcsConnected) then
Exit;
msg := TJSObject.new;
msg['message'] := 'heartbeat_ack';
try
EMiMobileWebSocketClient.Send(TJSJSON.stringify(msg));
except
on E: Exception do
begin
console.log('WS: heartbeat acknowledgement failed: ' + E.Message);
RequestSocketRestart(False);
end;
end;
end;
procedure TdmWebsocket.SetConnectionState(AState: TWsConnectionState);
begin
if FState = AState then
Exit;
FState := AState;
if (not FDestroyingManager) and Assigned(FOnStateChanged) then
FOnStateChanged(AState);
end;
procedure TdmWebsocket.Stop;
begin
FStarted := False;
FPaused := False;
FConnecting := False;
FRecoveryPending := False;
FHeartbeatOutstanding := False;
CancelAllTimers;
SetConnectionState(wcsStopped);
ReplaceSocket(False);
end;
procedure TdmWebsocket.UnregisterLifecycleListeners;
begin
if not FLifecycleListenersRegistered then
Exit;
Document.removeEventListener('pause', @HandlePause);
Document.removeEventListener('resume', @HandleResume);
Document.removeEventListener('visibilitychange', @HandleVisibilityChange);
window.removeEventListener('online', @HandleOnline);
window.removeEventListener('offline', @HandleOffline);
FLifecycleListenersRegistered := False;
end;
function TdmWebsocket.UrlEncode(const AValue: string): string;
begin
Result := '';
asm
Result = encodeURIComponent(AValue);
end;
end;
procedure TdmWebsocket.WebDataModuleCreate(Sender: TObject);
begin
console.log('WS: datamodule created');
EMiMobileWebSocketClient.OnConnect := EMiMobileWebSocketClientConnect;
EMiMobileWebSocketClient.OnDisconnect := EMiMobileWebSocketClientDisconnect;
EMiMobileWebSocketClient.OnMessageReceived := EMiMobileWebSocketClientMessageReceived;
FState := wcsStopped;
FReconnectTimerId := 0;
FConnectTimeoutId := 0;
FHeartbeatTimerId := 0;
FHeartbeatTimeoutId := 0;
AttachSocketEvents;
RegisterLifecycleListeners;
end;
procedure TdmWebsocket.WebDataModuleDestroy(Sender: TObject);
begin
FDestroyingManager := True;
UnregisterLifecycleListeners;
Stop;
FOnBadgeCounts := nil;
FOnUnitMap := nil;
FOnComplaintMap := nil;
FOnUnitList := nil;
FOnComplaintList := nil;
FOnStateChanged := nil;
FOnRecoveryRequired := nil;
FOnAuthenticationExpired := nil;
if dmWebsocket = Self then
dmWebsocket := nil;
end;
end.
webEMIMobile/View.Complaints.pas
......@@ -39,6 +39,8 @@ type
FSelectProc: TSelectProc;
FLoading: Boolean;
FFirstLoad: Boolean;
FRefreshPending: Boolean;
FPendingWsData: TJSObject;
[async] procedure GetComplaints;
procedure HandleListClick(e: TJSMouseEvent);
procedure ShowHideBusinessRows;
......@@ -59,6 +61,8 @@ procedure TFViewComplaints.WebFormCreate(Sender: TObject);
begin
Document.addEventListener('click', @HandleListClick);
FFirstLoad := True;
FRefreshPending := False;
FPendingWsData := nil;
GetComplaints;
asm
if (!window.showComplaintDetails) {
......@@ -178,12 +182,32 @@ begin
HideSpinner('spinner');
FFirstLoad := False;
end;
if Assigned(FPendingWsData) then
begin
respObj := FPendingWsData;
FPendingWsData := nil;
ApplyWsData(respObj);
end;
if FRefreshPending then
begin
FRefreshPending := False;
GetComplaints;
end;
end;
end;
procedure TFViewComplaints.RefreshData;
begin
Console.Log('Complaints.RefreshData');
if FLoading then
begin
FRefreshPending := True;
Exit;
end;
GetComplaints;
end;
......@@ -192,7 +216,10 @@ var
complaintsCount: Integer;
begin
if FLoading then
begin
FPendingWsData := aRespObj;
Exit;
end;
xdwdsComplaints.Close;
xdwdsComplaints.SetJsonData(aRespObj['data']);
......
webEMIMobile/View.Main.html
......@@ -11,12 +11,31 @@
<span id="lbl_main_title" class="navbar-brand text-light mb-0 ms-1"></span>
</div>
<!-- Right: Connection / Logout -->
<!-- Right: Connection / Menu -->
<div class="d-flex align-items-center gap-2 ms-auto">
<span id="view.main.lblconnection" class="navbar-text text-light small"></span>
<span id="view.main.version" class="navbar-text text-light small opacity-75"></span>
<button id="btn_logout" type="button" class="btn btn-outline-light btn-sm">Logout</button>
<span id="view.main.lblconnection"
class="connection-status connection-status-connecting"
role="status"
aria-live="polite"
aria-atomic="true"
aria-label="Live updates: Connecting"
title="Live updates: Connecting">
<span class="connection-status-dot" aria-hidden="true"></span>
<span id="view.main.lblconnectiontext" class="connection-status-text">Connecting</span>
</span>
<div class="dropdown">
<button type="button"
class="btn btn-outline-light btn-sm"
data-bs-toggle="dropdown"
aria-expanded="false"
aria-label="Menu">
<i class="fas fa-bars" aria-hidden="true"></i>
</button>
<ul class="dropdown-menu dropdown-menu-end">
<li><button id="btn_logout" type="button" class="dropdown-item">Logout</button></li>
</ul>
</div>
</div>
</div>
</nav>
......
webEMIMobile/View.Main.pas
......@@ -54,7 +54,11 @@ type
FDetailsForm: TWebForm;
FArchiveForm: TWebForm;
FLogoutProc: TLogoutProc;
FBadgeRefreshInProgress: Boolean;
FBadgeRefreshPending: Boolean;
FPendingWsBadgeCounts: TJSObject;
[async] procedure RefreshBadgesAsync;
procedure ApplyBadgeCounts(aData: TJSObject);
procedure ShowUnitDetails(UnitId: string);
procedure SetHeaderTitle(const title: string);
procedure HideDetailsModal;
......@@ -68,6 +72,10 @@ type
procedure HandleWsComplaintMap(aData: TJSObject);
procedure HandleWsUnitList(aData: TJSObject);
procedure HandleWsComplaintList(aData: TJSObject);
procedure HandleWsConnectionState(AState: TWsConnectionState);
procedure HandleWsRecoveryRequired;
procedure HandleWsAuthenticationExpired;
procedure ResyncLiveData;
type TActivePanel = (apNone, apMap, apUnits, apComplaints);
var
......@@ -84,6 +92,7 @@ type
public
{ Public declarations }
destructor Destroy; override;
class procedure Display(LogoutProc: TLogoutProc);
procedure ShowForm( AFormClass: TWebFormClass );
procedure ShowComplaintDetails(ComplaintId: string);
......@@ -121,15 +130,10 @@ const
procedure TFViewMain.WebFormCreate(Sender: TObject);
var
userName: string;
el: TJSElement;
begin
userName := JS.toString(AuthService.TokenPayload.Properties['user_name']);
lblUsername.Caption := ' ' + userName.ToLower + ' ';
el := Document.getElementById('view.main.version');
if Assigned(el) then
TJSHtmlElement(el).innerText := 'v' + TDMConnection.clientVersion;
FChildForm := nil;
FDetailsForm := nil;
FArchiveForm := nil;
......@@ -139,6 +143,9 @@ begin
FMapRefreshTick := 0;
FUnitsRefreshTick := 0;
FComplaintsRefreshTick := 0;
FBadgeRefreshInProgress := False;
FBadgeRefreshPending := False;
FPendingWsBadgeCounts := nil;
if (not (JS.toBoolean(AuthService.TokenPayload.Properties['user_admin']))) then
lblUsers.Visible := false;
......@@ -175,9 +182,27 @@ begin
dmWebsocket.OnComplaintMap := HandleWsComplaintMap;
dmWebsocket.OnUnitList := HandleWsUnitList;
dmWebsocket.OnComplaintList := HandleWsComplaintList;
dmWebsocket.OnStateChanged := HandleWsConnectionState;
dmWebsocket.OnRecoveryRequired := HandleWsRecoveryRequired;
dmWebsocket.OnAuthenticationExpired := HandleWsAuthenticationExpired;
dmWebsocket.Connect(DMConnection.WsUrl);
end;
destructor TFViewMain.Destroy;
begin
if Assigned(dmWebsocket) and (dmWebsocket.Owner = Self) then
begin
dmWebsocket.Stop;
dmWebsocket.Free;
dmWebsocket := nil;
end;
if FViewMain = Self then
FViewMain := nil;
inherited;
end;
procedure TFViewMain.SetActivePanel(panel: TActivePanel);
begin
FActivePanel := panel;
......@@ -468,10 +493,13 @@ end;
// WebSocket push handlers
// ---------------------------------------------------------------------------
procedure TFViewMain.HandleWsBadgeCounts(aData: TJSObject);
procedure TFViewMain.ApplyBadgeCounts(aData: TJSObject);
var
el: TJSElement;
begin
if not Assigned(aData) then
Exit;
el := Document.getElementById('view.main.badgecomplaints');
if Assigned(el) then
TJSHtmlElement(el).innerText := string(aData['BadgeComplaints']);
......@@ -481,6 +509,17 @@ begin
TJSHtmlElement(el).innerText := string(aData['BadgeUnits']);
end;
procedure TFViewMain.HandleWsBadgeCounts(aData: TJSObject);
begin
if FBadgeRefreshInProgress then
begin
FPendingWsBadgeCounts := aData;
Exit;
end;
ApplyBadgeCounts(aData);
end;
procedure TFViewMain.HandleWsUnitMap(aData: TJSObject);
begin
if Assigned(FMapForm) then
......@@ -505,6 +544,83 @@ begin
FComplaintsForm.ApplyWsData(aData);
end;
procedure TFViewMain.HandleWsConnectionState(AState: TWsConnectionState);
var
statusElement: TJSHTMLElement;
textElement: TJSHTMLElement;
statusText: string;
statusClass: string;
begin
case AState of
wcsConnecting:
begin
statusText := 'Connecting';
statusClass := 'connecting';
end;
wcsConnected:
begin
statusText := 'Connected';
statusClass := 'connected';
end;
wcsReconnecting:
begin
statusText := 'Reconnecting';
statusClass := 'reconnecting';
end;
wcsOffline:
begin
statusText := 'Offline';
statusClass := 'offline';
end;
else
begin
statusText := 'Disconnected';
statusClass := 'stopped';
end;
end;
statusElement := TJSHTMLElement(Document.getElementById('view.main.lblconnection'));
if Assigned(statusElement) then
begin
statusElement.setAttribute('class', 'connection-status connection-status-' + statusClass);
statusElement.setAttribute('aria-label', 'Live updates: ' + statusText);
statusElement.setAttribute('title', 'Live updates: ' + statusText);
end;
textElement := TJSHTMLElement(Document.getElementById('view.main.lblconnectiontext'));
if Assigned(textElement) then
textElement.innerText := statusText;
end;
procedure TFViewMain.HandleWsRecoveryRequired;
begin
ResyncLiveData;
end;
procedure TFViewMain.HandleWsAuthenticationExpired;
begin
if Assigned(dmWebsocket) then
dmWebsocket.Stop;
if Assigned(FLogoutProc) then
FLogoutProc('Your session has expired. Please sign in again.');
end;
procedure TFViewMain.ResyncLiveData;
begin
if (not AuthService.Authenticated) or AuthService.TokenExpired then
begin
HandleWsAuthenticationExpired;
Exit;
end;
Console.Log('WS: resynchronizing live data');
RefreshBadgesAsync;
Inc(FGlobalRefreshTick);
RefreshActivePanelFromTimer;
end;
// ---------------------------------------------------------------------------
procedure TFViewMain.tmrBadgeCountsTimer(Sender: TObject);
......@@ -528,25 +644,52 @@ var
badgeObj: TJSObject;
el: TJSElement;
begin
if FBadgeRefreshInProgress then
begin
FBadgeRefreshPending := True;
Exit;
end;
FBadgeRefreshInProgress := True;
try
resp := await(xdwcBadgeCounts.RawInvokeAsync('IApiService.GetBadgeCounts', []));
badgeObj := TJSObject(resp.Result);
el := Document.getElementById('view.main.badgecomplaints');
if Assigned(el) then
TJSHtmlElement(el).innerText := string(badgeObj['BadgeComplaints']);
el := Document.getElementById('view.main.badgeunits');
if Assigned(el) then
TJSHtmlElement(el).innerText := string(badgeObj['BadgeUnits']);
except
on E: Exception do
try
resp := await(xdwcBadgeCounts.RawInvokeAsync('IApiService.GetBadgeCounts', []));
badgeObj := TJSObject(resp.Result);
if Assigned(FPendingWsBadgeCounts) then
begin
ApplyBadgeCounts(FPendingWsBadgeCounts);
FPendingWsBadgeCounts := nil;
end
else
ApplyBadgeCounts(badgeObj);
except
on E: Exception do
begin
if Assigned(FPendingWsBadgeCounts) then
begin
ApplyBadgeCounts(FPendingWsBadgeCounts);
FPendingWsBadgeCounts := nil;
end
else
begin
el := Document.getElementById('view.main.badgecomplaints');
if Assigned(el) then TJSHtmlElement(el).innerText := '�';
el := Document.getElementById('view.main.badgeunits');
if Assigned(el) then TJSHtmlElement(el).innerText := '�';
end;
Console.Log('Badge refresh error: ' + E.Message);
end;
end;
finally
FBadgeRefreshInProgress := False;
if FBadgeRefreshPending then
begin
el := Document.getElementById('view.main.badgecomplaints');
if Assigned(el) then TJSHtmlElement(el).innerText := '�';
el := Document.getElementById('view.main.badgeunits');
if Assigned(el) then TJSHtmlElement(el).innerText := '�';
Console.Log('Badge refresh error: ' + E.Message);
FBadgeRefreshPending := False;
RefreshBadgesAsync;
end;
end;
end;
......
webEMIMobile/View.Map.dfm
......@@ -62,7 +62,6 @@ object FViewMap: TFViewMap
end
object httpReqGeoJson: TWebHttpRequest
ResponseType = rtText
URL = 'assets/orleanscounty.geojson'
OnResponse = httpReqGeoJsonResponse
Left = 116
Top = 698
......
webEMIMobile/View.Map.html
......@@ -52,16 +52,17 @@
<i class="fa fa-crosshairs"></i>
</button>
<!-- Filters (top-right) -->
<!-- Filters (bottom-right, above recenter) -->
<button id="btn_map_filters"
type="button"
class="btn btn-primary position-absolute top-0 end-0 m-2 shadow"
style="z-index:1000;"
class="btn btn-primary position-absolute end-0 me-2 shadow"
style="z-index:1000; bottom:4.5rem;"
data-bs-toggle="offcanvas"
data-bs-target="#map_filters_offcanvas"
aria-controls="map_filters_offcanvas">
<i class="fa fa-sliders-h"></i>
<span class="d-none d-sm-inline">Filters</span>
aria-controls="map_filters_offcanvas"
aria-label="Map filters"
title="Map filters">
<i class="fa fa-sliders-h" aria-hidden="true"></i>
</button>
</div>
</div>
......
webEMIMobile/View.Map.pas
......@@ -31,6 +31,7 @@ type
FUnitsLoaded: Boolean;
FComplaintsLoaded: Boolean;
FLoadingPoints: Boolean;
FRefreshPending: Boolean;
mapFilters: TMapFilters;
FPendingUnitId: string;
FPendingComplaintId: string;
......@@ -293,10 +294,12 @@ begin
resp := await(xdwcMap.RawInvokeAsync('IApiService.GetUnitMap', []));
root := TJSObject(resp.Result);
unitsData := TJSArray(root['data']);
FUnitsLoaded := True;
FUnitsLoaded := Assigned(unitsData);
except
on E: EXDataClientRequestException do
Console.Log('Units XData error: ' + E.ErrorResult.ErrorMessage);
on E: Exception do
Console.Log('Units error: ' + E.Message);
end;
// --- Fetch Complaints ----------------------------------------------------
......@@ -304,10 +307,12 @@ begin
resp := await(xdwcMap.RawInvokeAsync('IApiService.GetComplaintMap', []));
root := TJSObject(resp.Result);
complaintsData := TJSArray(root['data']);
FComplaintsLoaded := True;
FComplaintsLoaded := Assigned(complaintsData);
except
on E: EXDataClientRequestException do
Console.Log('Complaints XData error: ' + E.ErrorResult.ErrorMessage);
on E: Exception do
Console.Log('Complaints error: ' + E.Message);
end;
// A WebSocket snapshot received while the HTTP requests were in flight is
......@@ -329,8 +334,10 @@ begin
// --- Place markers (BeginUpdate wraps both so the map redraws once) ------
lfMap.BeginUpdate;
try
PlaceUnitMarkers(unitsData);
PlaceComplaintMarkers(complaintsData);
if FUnitsLoaded then
PlaceUnitMarkers(unitsData);
if FComplaintsLoaded then
PlaceComplaintMarkers(complaintsData);
finally
lfMap.EndUpdate;
end;
......@@ -344,6 +351,12 @@ begin
if showBusy then
HideSpinner('spinner');
FLoadingPoints := False;
if FRefreshPending then
begin
FRefreshPending := False;
LoadPointsAsync(False);
end;
end;
end;
......@@ -716,22 +729,17 @@ begin
end;
procedure TFViewMap.btnFindLocationClick(Sender: TObject);
var
coord: TTMSFNCMapsCoordinateRec;
begin
if userLocationMarker = nil then
Exit;
coord := CreateCoordinate(userLocationMarker.Latitude, userLocationMarker.Longitude);
lfMap.SetCenterCoordinate(coord);
FPendingFocusCoord := coord;
FPendingFocusZoom := 17;
FDoFocusZoom := True;
tmrLocate.Enabled := False;
FDoFocusZoom := False;
FPendingFocusMarkerData := '';
FPendingUnitId := '';
FPendingComplaintId := '';
tmrLocate.Interval := 250;
tmrLocate.Enabled := True;
if lfMap.Polygons.Count = 0 then
Exit;
lfMap.ZoomToBounds(lfMap.Polygons.ToCoordinateArray);
end;
......@@ -855,6 +863,13 @@ end;
procedure TFViewMap.RefreshData;
begin
Console.Log('Map.RefreshData');
if FLoadingPoints then
begin
FRefreshPending := True;
Exit;
end;
LoadPointsAsync(False);
end;
......
webEMIMobile/View.Units.pas
......@@ -37,6 +37,8 @@ type
private
FLoading: Boolean;
FFirstLoad: Boolean;
FRefreshPending: Boolean;
FPendingWsData: TJSObject;
[async] procedure GetUnits;
procedure HandleListClick(e: TJSMouseEvent);
public
......@@ -57,6 +59,8 @@ begin
DMConnection.ApiConnection.Connected := True;
Document.addEventListener('click', @HandleListClick);
FFirstLoad := True;
FRefreshPending := False;
FPendingWsData := nil;
GetUnits;
asm
......@@ -158,12 +162,32 @@ begin
FFirstLoad := False;
FLoading := False;
if Assigned(FPendingWsData) then
begin
respObj := FPendingWsData;
FPendingWsData := nil;
ApplyWsData(respObj);
end;
if FRefreshPending then
begin
FRefreshPending := False;
GetUnits;
end;
end;
end;
procedure TFViewUnits.RefreshData;
begin
Console.Log('Units.RefreshData');
if FLoading then
begin
FRefreshPending := True;
Exit;
end;
GetUnits;
end;
......@@ -172,7 +196,10 @@ var
unitCount: Integer;
begin
if FLoading then
begin
FPendingWsData := aRespObj;
Exit;
end;
xdwdsUnits.Close;
xdwdsUnits.SetJsonData(aRespObj['data']);
......
webEMIMobile/css/app.css
......@@ -82,6 +82,70 @@ html, body {
.tab-hidden { display: none !important; }
.connection-status {
display: inline-flex;
align-items: center;
gap: 0.35rem;
min-height: 1.75rem;
padding: 0.2rem 0.55rem;
border: 1px solid rgba(255, 255, 255, 0.35);
border-radius: 999px;
color: #fff;
font-size: 0.75rem;
font-weight: 600;
line-height: 1;
white-space: nowrap;
}
.connection-status-dot {
width: 0.55rem;
height: 0.55rem;
flex: 0 0 auto;
border-radius: 50%;
background-color: #adb5bd;
}
.connection-status-connected .connection-status-dot {
background-color: #75d995;
box-shadow: 0 0 0 0.14rem rgba(117, 217, 149, 0.2);
}
.connection-status-connecting .connection-status-dot,
.connection-status-reconnecting .connection-status-dot {
background-color: #ffd166;
animation: connection-status-pulse 1.4s ease-in-out infinite;
}
.connection-status-offline .connection-status-dot,
.connection-status-stopped .connection-status-dot {
background-color: #ff8b94;
}
@keyframes connection-status-pulse {
0%, 100% { opacity: 0.45; }
50% { opacity: 1; }
}
@media (max-width: 430px) {
.connection-status {
width: 1.75rem;
justify-content: center;
padding-right: 0;
padding-left: 0;
}
.connection-status-text {
display: none;
}
}
@media (prefers-reduced-motion: reduce) {
.connection-status-connecting .connection-status-dot,
.connection-status-reconnecting .connection-status-dot {
animation: none;
}
}
.summary-chevron-icon {
width: 1rem;
height: 1rem;
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment