delphimvcframework/unittests/Several/MessagingExtensionsTestU.pas

// ***************************************************************************
//
// Delphi MVC Framework
//
// Copyright (c) 2010-2017 Daniele Teti and the DMVCFramework Team
//
// https://github.com/danieleteti/delphimvcframework
//
// ***************************************************************************
//
// Licensed under the Apache License, Version 2.0 (the "License");
// you may not use this file except in compliance with the License.
// You may obtain a copy of the License at
//
// http://www.apache.org/licenses/LICENSE-2.0
//
// Unless required by applicable law or agreed to in writing, software
// distributed under the License is distributed on an "AS IS" BASIS,
// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
// See the License for the specific language governing permissions and
// limitations under the License.
//
// *************************************************************************** }

unit MessagingExtensionsTestU;

interface

uses
  TestFramework,
  MVCFramework.RESTClient,
  LiveServerTestU;

type
  TMessagingExtensionsTestCase = class(TBaseServerTest)
  published
    procedure TestSubscribeOnATopic;
    procedure TestMultipleSubscribeOnSameTopic;
    procedure TestMultipleSubscribeAndUnsubscribe;
    procedure TestMultipleSubscribeAndUnsubscribeHARD;
    procedure TestSubscribeAndReceive;
  end;

implementation

{$WARN SYMBOL_DEPRECATED OFF}

uses
  System.SysUtils,
{$IF CompilerVersion < 27}
  Data.DBXJSON,
{$ELSE}
  System.JSON,
{$ENDIF}
  System.Classes,
  MVCFramework.Logger, MVCFramework.Commons, Winapi.Windows;

{ TMessagingExtensionsTestCase }

procedure TMessagingExtensionsTestCase.TestMultipleSubscribeAndUnsubscribe;
var
  res: IRESTResponse;
  x: string;
begin
  RESTClient.ReadTimeout(- 1);
  DoLoginWith('guest');
  RESTClient.doPOST('/messages/clients', ['my-unique-id']);
  res := RESTClient.doPOST('/messages/subscriptions/queue/test01', []);
  CheckEquals(HTTP_STATUS.OK, res.ResponseCode, res.ResponseText);
  res := RESTClient.doGET('/messages/subscriptions', []);
  x := Trim(res.BodyAsString);
  CheckEquals('/queue/test01', x);

  res := RESTClient.doPOST('/messages/subscriptions/queue', ['test010']);
  CheckEquals(HTTP_STATUS.OK, res.ResponseCode, res.ResponseText);
  // server shoud not return an error
  res := RESTClient.doGET('/messages/subscriptions', []);
  x := Trim(res.BodyAsString);
  CheckEquals('/queue/test01;/queue/test010', x);

  res := RESTClient.doDELETE('/messages/subscriptions/queue/test01', []);
  CheckEquals(HTTP_STATUS.OK, res.ResponseCode, res.ResponseText);
  // server shoud not return an error
  res := RESTClient.doGET('/messages/subscriptions', []);
  x := Trim(res.BodyAsString);
  CheckEquals('/queue/test010', x);

  CheckEquals(HTTP_STATUS.OK, res.ResponseCode, res.ResponseText);
  // server shod not return an error
  DoLogout;
end;

procedure TMessagingExtensionsTestCase.TestMultipleSubscribeAndUnsubscribeHARD;
var
  res: IRESTResponse;
  x: string;
begin
  RESTClient.ReadTimeout(-1);
  DoLoginWith('guest');
  RESTClient.doPOST('/messages/clients', ['my-unique-id']);
  res := RESTClient.doPOST('/messages/subscriptions/queue', ['test01']);
  res := RESTClient.doPOST('/messages/subscriptions/queue', ['test010']);
  res := RESTClient.doPOST('/messages/subscriptions/queue', ['test0101']);
  res := RESTClient.doPOST('/messages/subscriptions/queue', ['test01010']);
  res := RESTClient.doPOST('/messages/subscriptions/queue', ['test010101']);
  res := RESTClient.doPOST('/messages/subscriptions/queue', ['test0101010']);

  CheckEquals(HTTP_STATUS.OK, res.ResponseCode, res.ResponseText);
  // server shod not return an error
  res := RESTClient.doGET('/messages/subscriptions', []);
  x := Trim(res.BodyAsString);
  CheckEquals
    ('/queue/test01;/queue/test010;/queue/test0101;/queue/test01010;/queue/test010101;/queue/test0101010',
    x);

  res := RESTClient.doDELETE('/messages/subscriptions/queue', ['test010']);
  CheckEquals(HTTP_STATUS.OK, res.ResponseCode, res.ResponseText);
  // server shod not return an error
  res := RESTClient.doGET('/messages/subscriptions', []);
  x := Trim(res.BodyAsString);
  CheckEquals
    ('/queue/test01;/queue/test0101;/queue/test01010;/queue/test010101;/queue/test0101010', x);
  DoLogout;
end;

procedure TMessagingExtensionsTestCase.TestMultipleSubscribeOnSameTopic;
var
  res: IRESTResponse;
begin
  DoLoginWith('guest');
  RESTClient.doPOST('/messages/clients', ['my-unique-id']);
  res := RESTClient.doPOST('/messages/subscriptions/queue/test01', []);
  CheckEquals(HTTP_STATUS.OK, res.ResponseCode, res.ResponseText);
  res := RESTClient.doPOST('/messages/subscriptions/queue/test01', []);
  CheckEquals(HTTP_STATUS.OK, res.ResponseCode, res.ResponseText);
  // server shoud not return an error
  DoLogout;
end;

procedure TMessagingExtensionsTestCase.TestSubscribeAndReceive;
var
  res: IRESTResponse;
  messages: TJSONArray;
  sid: string;
  RMessageCount: Integer;
  I: Integer;
  o: TJSONObject;
  J: Integer;
  LUnique: string;
const
  MSG_COUNT = 10;
begin
  LUnique := GetTickCount.ToString;

  DoLoginWith('guest');
  RESTClient.doPOST('/messages/clients', ['my-unique-' + LUnique]);
  RESTClient.doPOST('/messages', ['subscriptions', 'queue', 'test01']);
  RESTClient.doPOST('/messages', ['subscriptions', 'queue', 'test02']);
  RESTClient.ReadTimeout(- 1);
  sid := RESTClient.SessionID;
  TThread.CreateAnonymousThread(
    procedure
    var
      RESTC: TRESTClient;
      I: Integer;
    begin
      TThread.Sleep(1000);
      RESTC := TRESTClient.Create('localhost', 9999);
      try
        RESTC.doPOST('/messages/clients', ['my-other-unique-' + LUnique]);
        RESTC.ReadTimeout(60 * 1000 * 30);
        RESTC.doGET('/login', ['guest']);
        for I := 1 to MSG_COUNT do
        begin
          RESTC.doPOST('/messages/queue/test02', [], TJSONObject.Create(TJSONPair.Create('hello',
            TJSONNumber.Create(I))));
          RESTC.doPOST('/messages/queue/test01', [], TJSONObject.Create(TJSONPair.Create('hello',
            TJSONNumber.Create(I))));
        end;
      finally
        RESTC.Free;
      end;
    end).Start;

  RMessageCount := 0;
  for J := 1 to MSG_COUNT * 2 do
  begin
    res := RESTClient.doGET('/messages', []);
    if res.ResponseCode = HTTP_STATUS.OK then
    begin
      CheckIs(res.BodyAsJsonObject.Get('_timeout').JsonValue, TJSONFalse);
      CheckNotNull(res.BodyAsJsonObject.Get('_timestamp'), '_timestamp is not set');
      CheckNotNull(res.BodyAsJsonObject.Get('messages'), 'messages is not set');
      CheckIs(res.BodyAsJsonObject.Get('messages').JsonValue, TJSONArray,
        'Messages is not a TJSONArray');
      messages := res.BodyAsJsonObject.Get('messages').JsonValue as TJSONArray;
      if messages.Size > 0 then
        for I := 0 to messages.Size - 1 do
        begin
          o := messages.Get(I) as TJSONObject;
          logw(o.Get('message').ToString);
        end;
      RMessageCount := RMessageCount + messages.Size;
    end;
    if res.ResponseCode = HTTP_STATUS.RequestTimeout then // receive timeout
      break;
  end;
  CheckEquals(MSG_COUNT * 2, RMessageCount, 'message count');
  res := RESTClient.doGET('/messages', []);
  CheckIs(res.BodyAsJsonObject.Get('_timeout').JsonValue, TJSONTrue);
  DoLogout;
end;

procedure TMessagingExtensionsTestCase.TestSubscribeOnATopic;
var
  res: IRESTResponse;
begin
  DoLoginWith('guest');
  RESTClient.doPOST('/messages/clients', ['my-unique-id']);
  res := RESTClient.doPOST('/messages/subscriptions/queue/test01', []);
  CheckEquals(HTTP_STATUS.OK, res.ResponseCode, res.ResponseText);
  res := RESTClient.doDELETE('/messages/subscriptions/queue/test01', []);
  CheckEquals(HTTP_STATUS.OK, res.ResponseCode, res.ResponseText);
  DoLogout;
end;

initialization

{$IFDEF USE_MESSAGING}
  RegisterTest(TMessagingExtensionsTestCase.Suite);
{$ENDIF}

finalization

end.