fpc/packages/fcl-web/examples/fcm/server/module.messaging.pp

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

    FCM (Firebase Cloud Messaging) - JSON-RPC interface for webclient

    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.

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

unit module.messaging;

{$mode ObjFPC}{$H+}

interface

uses
  Classes, SysUtils, fpjsonrpc, fpjson, fpfcmtypes, fpfcmclient;

type

  { TdmMessaging }

  TdmMessaging = class(TDataModule)
    RegisterSubscription: TJSONRPCHandler;
    SendNotification: TJSONRPCHandler;
    procedure RegisterSubscriptionExecute(Sender: TObject; const Params: TJSONData; out Res: TJSONData);
    procedure SendNotificationExecute(Sender: TObject; const Params: TJSONData; out Res: TJSONData);
  private
    class function ConfigDir: String;
    function AccessTokenFile: string;
    function DeviceTokensFileName: String;
    procedure HandleNewAccessToken(Sender: TObject; const aToken: TBearerToken);
    function LoadLastToken: UTF8String;
  public
    procedure SendMessage(Msg: TNotificationmessage);
    procedure SaveToken(const aToken: UTF8String);
  end;

var
  dmMessaging: TdmMessaging;

implementation

{$R *.lfm}

{ TdmMessaging }


class Function TdmMessaging.ConfigDir : String;

begin
  Result:=ExtractFilePath(ParamStr(0));
end;

Function TdmMessaging.DeviceTokensFileName : String;
begin
  Result:=ConfigDir+'device-tokens.txt';
end;

Function TdmMessaging.AccessTokenFile : string;

begin
  Result:=ConfigDir+'access-token.json';
end;

procedure TdmMessaging.HandleNewAccessToken(Sender: TObject; const aToken: TBearerToken);

begin
  aToken.SaveToFile(AccessTokenFile);
end;

procedure TdmMessaging.SaveToken(const aToken : UTF8String);

var
  L : TStrings;
  FN : String;

begin
  FN:=DeviceTokensFileName;
  L:=TStringList.Create;
  try
    if FileExists(FN) then
      L.LoadFromFile(FN);
    L.Add(aToken);
    L.SaveToFile(FN);
  finally
    L.Free;
  end;
end;

function TdmMessaging.LoadLastToken : UTF8String;

var
  L : TStrings;
  FN : String;

begin
  FN:=DeviceTokensFileName;
  L:=TStringList.Create;
  try
    if fileExists(fn) then
      L.LoadFromFile(FN);
    if L.Count=0 then
      Raise Exception.Create('No tokens registered');
    Result:=L[L.Count-1];
  finally
    L.Free;
  end;
end;

procedure TdmMessaging.RegisterSubscriptionExecute(Sender: TObject; const Params: TJSONData; out Res: TJSONData);

var
  Parms: TJSONArray absolute params;
  aToken : UTF8String;

begin
  If Parms.Count<>1 then
    Raise Exception.Create('Invalid param count');
  if Parms[0].JSONType=JTString then
    // FCM token
    aToken:=Parms[0].AsString
  else if Parms[0].JSONType=jtObject then
    aToken:=Parms[0].AsJSON
  else
    Raise Exception.Create('Invalid param type for token');
  SaveToken(aToken);
  Res:=TJSONBoolean.Create(True);
end;

procedure TdmMessaging.SendMessage(Msg : TNotificationmessage);

var
  Sender : TFCMClient;
  aConfig, aToken : String;

begin
  aToken:=LoadLastToken;
  Sender:=TFCMClient.Create(Self);
  try
    aConfig:=ChangeFileExt(paramstr(0),'-serviceaccount.json');
    Sender.LogFile:=ChangeFileExt(paramstr(0),'.log');
    Sender.InitServiceAccount(aConfig,'');
    Sender.OnNewBearerToken:=@HandleNewAccessToken;
    if FileExists(AccessTokenFile) then
      Sender.BearerToken.LoadFromFile(AccessTokenFile);
    Sender.Send(Msg,aToken);
  finally
    Sender.Free;
  end;
end;

procedure TdmMessaging.SendNotificationExecute(Sender: TObject; const Params: TJSONData; out Res: TJSONData);

var
  Parms: TJSONArray absolute params;
  Obj : TJSONObject;
  Msg : TNotificationMessage;

begin
  If Parms.Count<>1 then
    Raise Exception.Create('Invalid param count');
  if Parms[0].JSONType<>jtObject then
    Raise Exception.Create('Invalid notification');
  Obj:=Parms.Objects[0];
  Msg:=TNotificationMessage.Create;
  try
    Msg.Title:=Obj.Get('title',Msg.Title);
    Msg.Body:=Obj.Get('body',Msg.Body);
    Msg.Image:=Obj.Get('image',Msg.Image);
    SendMessage(Msg);
  finally
    Msg.Free;
  end;
end;

initialization
  JSONRPCHandlerManager.RegisterDatamodule(TdmMessaging, 'Messaging');
end.