freepascal.compiler/packages/fcl-web/examples/fcm/webclient/webclient.lpr

{
    This file is part of the Free Component Library
    Copyright (c) 2024 by Michael Van Canneyt [email protected]

    FCM Messaging demo - web client

    See the file COPYING.FPC, included in this distribution,
    for details about the copyright.

    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.

 **********************************************************************}

program webclient;

{$mode objfpc}
{$externalclasses}

uses
  BrowserConsole, JS, Classes, SysUtils, weborworker, Web, browserapp, firebaseapp,
  module.messagingservice, service.messagingserver, fprpcclient;

Type

  { TDemoApp }

  TDemoApp = class(TBrowserApplication)
  private
    procedure HandleReceivedMessage(aMessage: TJSObject);
    procedure HaveToken(aToken: string);
    procedure requestPermission;
    procedure SendToken(aToken: string);
    procedure ShowToken(aToken: string);
  Public
    pnlToken : TJSHTMLElement;
    lblToken : TJSHTMLElement;
    edtMessage : TJSHTMLInputElement;
    btnSend: TJSHTMLButtonElement;
    btnRegister:TJSHTMLButtonElement;
    App : TFirebaseApp;
    Reg: weborworker.TJSServiceWorkerRegistration;
    Procedure DoRun; override;
    procedure handleregister(event : TJSEvent); async;
    procedure handlesend(event : TJSEvent); async;
  end;

var
  Application : TDemoApp;
  config : TJSObject; external name 'firebaseConfig';

Const
  TheVAPIDKey = 'The VAPID key for your FCM application';

{ TDemoApp }


procedure TDemoApp.HandleReceivedMessage(aMessage: TJSObject);
begin
  if assigned(aMessage) then
    console.debug('Message received: ',aMessage);
end;

procedure TDemoApp.DoRun;


begin
  RPCModule:=TRPCModule.Create(Self);
  pnlToken:=GetHTMLElement('pnlToken');
  lblToken:=GetHTMLElement('lblToken');
  edtMessage:=TJSHTMLInputElement(GetHTMLElement('edtMessage'));
  btnSend:=TJSHTMLButtonElement(GetHTMLElement('btnSend'));
  btnSend.addEventListener('click',@HandleSend);
  btnRegister:=TJSHTMLButtonElement(GetHTMLElement('btnRegister'));
  btnRegister.addEventListener('click',@HandleRegister);
  Writeln('Initializing application...');
  App:=Firebase.initializeApp(config);
  App.messaging.onMessage(@HandleReceivedMessage);
  Window.Navigator.serviceWorker.register('firebase-messaging-sw.js')._then(function (js : JSValue) :JSValue
    begin
    reg:=weborworker.TJSServiceWorkerRegistration(js);
    if assigned(Reg) then
      Writeln('Registered service worker...')
    end,function (js : JSValue) :JSValue
    begin
      Writeln('Unable to register service worker')
    end);
end;

procedure TDemoApp.ShowToken(aToken : string);
begin
  pnlToken.classlist.remove('is-hidden');
  lblToken.innerText:=aToken;
  Writeln(aToken);
end;

procedure TDemoApp.SendToken(aToken : string);

  procedure DoOK(aResult: JSValue);
  begin
    Writeln('Registered token on server');
  end;

  procedure DoFail(Sender: TObject; const aError: TRPCError);
  begin
    Writeln('Failed to register token on server: '+aError.Message);
  end;

begin
  Writeln('Sending token to server: ',aToken);
  RPCModule.Service.RegisterSubscription(aToken,@DoOK,@DoFail);

end;

procedure TDemoApp.HaveToken(aToken : string);

begin
  Showtoken(aToken);
  Sendtoken(aToken);
  btnSend.disabled:=False;
  btnRegister.disabled:=False;
end;

procedure TDemoApp.requestPermission;

 function onpermission (permission : jsvalue) : jsvalue;

 var
   token : string;

 begin
   if (permission='granted') then
     begin
     writeln('Notification permission granted.');
     handleregister(nil);
     end;
 end;

begin
  Writeln('Requesting permission...');
  TJSNotification.requestPermission()._then(@OnPermission)
end;

procedure TDemoApp.handleregister(event: TJSEvent);

var
  Token : string;
  opt : TMessagingGetTokenOptions;

begin
  opt:=TMessagingGetTokenOptions.New;
  opt.serviceworkerRegistration:=self.Reg;
  opt.vapidKey:=TheVAPIDKey;
  Token:=Await(App.messaging.getToken(opt));
  if (token='') then
    RequestPermission
  else
    HaveToken(token);
end;

procedure TDemoApp.handlesend(event: TJSEvent);

  procedure DoOK(aResult: JSValue);
  begin
    Writeln('Message transferred to server for sending');
  end;

  procedure DoFail(Sender: TObject; const aError: TRPCError);
  begin
    Writeln('Failed to transfer message to server for sending: '+aError.Message);
  end;

var
  Msg : TJSObject;

begin
  Msg:=New([
    'title','Free Pascal FCM demo',
    'body',edtMessage.Value,
    'image','https://www.freepascal.org/favicon.png'
  ]);
  RPCModule.Service.SendNotification(Msg,@DoOK,@DoFail);
end;

begin
  Application:=TDemoApp.Create(Nil);
  Application.Initialize;
  Application.Run;
end.