#1 2014-10-03 12:54:44

edismo
Member
From: Brazil
Registered: 2013-10-04
Posts: 34

getting json invalid return with two methods called

My application can have two different behave, depending on the customer's network.

Has two classes that implement the same interface.
One of the classes makes access to the database and the other creates a httpclient object to consume the class that makes access to the database.

All methods return RawJSON, when I use a simple structure that uses only one instance of the application class that makes access to the database JSON return is correct.

But when I use two instances of the application (consuming one another) the first return JSON is ok, and in the second the JSON is invalid.

See sample:

IMyInterface = interface (IInvokable)
  function sample: RawJSON;
end;

TMyClassDirect = class (TInterfacedObject, IMyInterface)
public
  function sample: RawJSON;
end;

TMyClassBridge = class (TInterfacedObjectWithCustomCreate, IMyInterface)
private
  fSQLModel: TSQLModel;
  fSQLHttpClient: TSQLHttpClient;
  fMyClassDirect: IMyInterface;
public
  function sample: RawJSON;
  constructor Create; override;
end;

function TMyClassDirect.sample: RawJSON;
var
  MyObject: TMyObject;
begin
  MyObject: = TMyObject.Create;
  MyObject.Foo: = 'bar';
  Result: = ObjectToJson (MyObject);
  FreeAndNil (MyObject);
end;

function TMyClassBridge.sample: RawJSON;
begin
  Result: = fMyClassDirect.Sample;
end;

valid JSON

http://{direct host}:778/root/app/sample 
{"result":[{"Foo":"bar"}]}

invalid JSON

http://{bridge host}:778/root/app/sample
{"result":["Foo":"bar"}]}

The difference is that it lacks the character {.

I hope you understood my explanation of the problem.

I can help?

Offline

#2 2014-10-03 14:36:39

edismo
Member
From: Brazil
Registered: 2013-10-04
Posts: 34

Re: getting json invalid return with two methods called

sorry,

invalid json is

{"result":[{"Foo":"bar"}]]}

not

{"result":["Foo":"bar"}]}

including this character ]

Offline

#3 2014-10-04 10:13:34

ab
Administrator
From: France
Registered: 2010-06-21
Posts: 14,182
Website

Re: getting json invalid return with two methods called

Weird.
Are you sure that your code does not have any other part?
Could you please post here some simple stand alone .dpr to reproduce the issue?

Offline

#4 2014-10-08 12:53:14

edismo
Member
From: Brazil
Registered: 2013-10-04
Posts: 34

Re: getting json invalid return with two methods called

Hi AB,

Below is the code of my example.

Server.dpr

program Server;

uses
  Vcl.Forms,
  MainServer in 'MainServer.pas' {FrmApp},
  mORMot,
  SynCommons,
  main in 'main.pas';

{$R *.res}

begin

  with TSQLLog.Family do begin
    Level := LOG_VERBOSE;
    EchoToConsole := LOG_VERBOSE; // log all events to the console
  end;

  Application.Initialize;
  Application.MainFormOnTaskbar := True;
  Application.CreateForm(TFrmApp, FrmApp);
  ReportMemoryLeaksOnShutdown := True;
  Application.Run;
end.

MainServer (Form)

unit MainServer;

interface

uses
  System.SysUtils, Vcl.Forms, System.Classes, Vcl.Controls, Vcl.StdCtrls,
  Vcl.ExtCtrls,
  main;

type

  TFrmApp = class(TForm)
    BtnConnect: TButton;
    cbBridge: TCheckBox;
    Panel1: TPanel;
    Panel2: TPanel;
    Edit1: TEdit;
    Edit2: TEdit;
    procedure BtnConnectClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    MyServer: TMyHTTPServer;
  public
  end;

var
  FrmApp: TFrmApp;

implementation

{$R *.dfm}

procedure TFrmApp.BtnConnectClick(Sender: TObject);
begin
  if (cbBridge.Checked) then
  begin
    IP_Bridge := Edit2.Text;
    Porta_Bridge := Edit1.Text;
  end;

  if Assigned(MyServer) then
  begin
    FreeAndNil(MyServer);
    BtnConnect.caption := 'Desconectado';
  end else
  begin

    MyServer := TMyHTTPServer.Create('773', 1);
    if (cbBridge.Checked) then
      MyServer.ServiceRegister(TMyClassBridge, TypeInfo(IMyInterface), '1')
    else
      MyServer.ServiceRegister(TMyClassDirect, TypeInfo(IMyInterface), '1');

    BtnConnect.caption := 'Connect';
  end;
end;

procedure TFrmApp.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  FreeAndNil(MyServer);
end;

end.

Main.pas

unit main;

interface

uses
  SynCommons, mORMot, mORMotHttpServer, mORMotHttpClient;


type

  TMyService = class(TSQLRestServerFullMemory)
  published
    procedure myapp(Ctxt: TSQLRestServerURIContext);
  end;

  TMyHTTPServer = class(TSQLHttpServer)
  private
    oModel: TSQLModel;
    oSQLRestServerFullMemory: TMyService;
  public
    function ServiceRegister(AImplementationClass: TInterfacedClass; const AInterfaces: PTypeInfo;
      const AContractExpected: RawUTF8): boolean;
    constructor Create(const APorta: RawUTF8; AThreadPoolCount: Integer); reintroduce;
    destructor Destroy; override;
  end;

  TMyHTTPClient = class
  private
    oSQLModel1: TSQLModel;
    oSQLHttpClient1: TSQLHttpClient;
    FIPServidor: String;
    FPortaMultiEmpresa: String;
  public
    constructor Create(const AIPServidor: String; const APortaServidor: String); overload;
    function HttpServerConnect: Boolean;
    function GetInterface(AInterface: PTypeInfo; const AVersaoInterface: RawUTF8; out Obj): Boolean;
    function ServerTimeStampSynchronize: Boolean;
    procedure CloseConnection;
  end;

  TMyObject = class
  private
    FFoo: RawUTF8;
  published
    property foo: RawUTF8 read FFoo write FFoo;
  end;

  IMyInterface = interface(IInvokable)
  ['{E6C6ADFD-5977-4759-B400-AA4140F1D683}']
    function sample: RawJSON;
  end;

  TMyClassDirect = class(TInterfacedObject, IMyInterface)
  public
    function sample: RawJSON;
  end;

  TMyClassBridge = class(TInterfacedObjectWithCustomCreate, IMyInterface)
  protected
    FInstanciaInterface: IMyInterface;
    oHTTPClient: TMyHTTPClient;
  public
    function sample: RawJSON;
    constructor Create; override;
    destructor Destroy; override;
  end;

var
  IP_Bridge: String;
  Porta_Bridge: String;

implementation

uses
  System.SysUtils, MainServer, Vcl.Forms, Winapi.Windows;

{ TMyClassBridge }

constructor TMyClassBridge.Create;
begin
  inherited;
  oHTTPClient := TMyHTTPClient.Create(IP_Bridge, Porta_Bridge);
  oHTTPClient.HttpServerConnect;
  oHTTPClient.GetInterface(TypeInfo(IMyInterface), '1', FInstanciaInterface);
end;

destructor TMyClassBridge.Destroy;
begin
  FreeAndNil(oHTTPClient);
  inherited;
end;

function TMyClassBridge.sample: RawJSON;
var
  iEmpresaTerminal: Cardinal;
begin
  try
    Result := FInstanciaInterface.sample;
  except
    on E:Exception do
      Result := E.Message;
  end;
end;

{ TMyClassDirect }

function TMyClassDirect.sample: RawJSON;
var
  MyObject: TMyObject;
begin

  MyObject := TMyObject.Create;
  MyObject.foo := 'bar';

  Result := ObjectToJson(MyObject, []);

  FreeAndNil(MyObject);
end;

{ TMyService }

procedure TMyService.myapp(Ctxt: TSQLRestServerURIContext);
var
  sFileName: TFileName;
begin
  sFileName := Ctxt.ResourceFileName;

  if sFileName = '' then
    Ctxt.Redirect('myapp/index.html')
  else
    Ctxt.ReturnFile(ExtractFilePath(Application.ExeName) + sFileName, true);

end;

{ TMyHTTPServer }

constructor TMyHTTPServer.Create(const APorta: RawUTF8; AThreadPoolCount: Integer);
begin
  oModel := TSQLModel.Create([], 'app');
  oSQLRestServerFullMemory := TMyService.Create(oModel, '', false, false);
  inherited Create(APorta, [oSQLRestServerFullMemory], '+', useHttpApiRegisteringURI, AThreadPoolCount);
end;

function TMyHTTPServer.ServiceRegister(AImplementationClass: TInterfacedClass; const AInterfaces: PTypeInfo;
  const AContractExpected: RawUTF8): boolean;
begin
  oSQLRestServerFullMemory.ServiceRegister(AImplementationClass,
    [AInterfaces], sicSingle).ContractExpected := AContractExpected;
  Result := true;
end;

destructor TMyHTTPServer.Destroy;
begin
  FreeAndNil(oModel);
  FreeAndNil(oSQLRestServerFullMemory);
  inherited;
end;

{ TMyHTTPClient }

procedure TMyHTTPClient.CloseConnection;
begin
  FreeAndNil(oSQLHttpClient1);
  oSQLHttpClient1 := nil;
  FreeAndNil(oSQLModel1);
  oSQLModel1 := nil;
end;

constructor TMyHTTPClient.Create(const AIPServidor,
  APortaServidor: String);
begin
  inherited Create;
  FIPServidor := AIPServidor;
  FPortaMultiEmpresa := APortaServidor;
end;

function TMyHTTPClient.GetInterface(AInterface: PTypeInfo;
  const AVersaoInterface: RawUTF8; out Obj): Boolean;
var
  sInterfaceName: RawUTF8;
begin
  Result := False;
  try
    if (HttpServerConnect) then
    begin
      sInterfaceName := Copy(AInterface.Name, 2, Length(AInterface.Name));

      if not(Assigned(oSQLHttpClient1.Services[sInterfaceName])) then
        Result := oSQLHttpClient1.ServiceRegister(AInterface, sicSingle, AVersaoInterface) <> nil;

      if (Result) then
        Result := oSQLHttpClient1.Services[sInterfaceName].Get(Obj);
    end;
  except
    on E:Exception do
    begin
      Result := False;
    end;
  end;
end;

function TMyHTTPClient.HttpServerConnect: Boolean;
var
  i: integer;
begin
  if (Assigned(oSQLHttpClient1)) then
    CloseConnection;

  for i := 1 to 2 do
  begin
    try
      if Assigned(oSQLModel1) then
        oSQLModel1.Free;

      oSQLModel1 := TSQLModel.Create([], 'app');
      oSQLHttpClient1 := TSQLHttpClient.Create(FIpServidor, FPortaMultiEmpresa ,
        oSQLModel1, False, '', '', 30000, 30000);

      Break;
    except
      on e: Exception do
      begin
        if i = 1 then
        begin
          oSQLHttpClient1.Free;
          oSQLModel1.Free;
        end
        else
          raise;
      end;
    end;
  end;

  Result := Assigned(oSQLHttpClient1) and (oSQLHttpClient1.ServerTimeStamp > 0);

  if (not(Result)) then
    raise Exception.Create('Connection server fail. ' +
      oSQLHttpClient1.LastErrorMessage + ' error code: ' +
      IntToStr(oSQLHttpClient1.LastErrorCode))

end;

function TMyHTTPClient.ServerTimeStampSynchronize: Boolean;
var
  dServerDateTime: TDateTime;
  dSystemTime: TSystemTime;
begin
  try
    Result := HttpServerConnect and oSQLHttpClient1.ServerTimeStampSynchronize;

    if (Result) then
    begin
      dServerDateTime := TimeLogToDateTime(oSQLHttpClient1.ServerTimeStamp);
      if (dServerDateTime > 0) then
      begin
        DateTimeToSystemTime(dServerDateTime, dSystemTime);
        SetLocalTime(dSystemTime);
      end;
    end;
  finally
    CloseConnection;
  end;
end;

end.

Json Valid (Direct)
http://127.0.0.1:773/app/MyInterface/sample

{"result":[{"foo":"bar"}]}

Json InValid (Bridge)
http://127.0.0.1:773/app/MyInterface/sample

{"result":[{"foo":"bar"}]]}

Offline

#5 2014-10-08 16:43:15

ab
Administrator
From: France
Registered: 2010-06-21
Posts: 14,182
Website

Re: getting json invalid return with two methods called

Could you please create a new ticket?
Do not forget to link this forum thread, as reference.

Thanks a lot for the feedback, and for taking the time to send some program to reproduce the issue!

Offline

#6 2014-10-08 17:14:53

edismo
Member
From: Brazil
Registered: 2013-10-04
Posts: 34

Re: getting json invalid return with two methods called

Thanks AB.

I'm glad to help.

Ticket UUID: 4cf639afe6b45925a76260106c976c217947a9a3

Offline

#7 2014-10-28 17:59:36

edismo
Member
From: Brazil
Registered: 2013-10-04
Posts: 34

Re: getting json invalid return with two methods called

hi AB,

I tried to change to solve the problem.
Tests for Service oriented architecture passed.

unit: mORMot.pas
class: TSQLRestServerURIContext
method: ServiceResultEnd

See if this is correct:

procedure TSQLRestServerURIContext.ServiceResultEnd(WR: TTextWriter; ID: integer);
const JSONSEND_WITHID: array[boolean] of RawUTF8 = ('],"id":','},"id":');
      JSONSEND_NOID: array[boolean] of AnsiChar = (']','}');
begin // InternalExecuteSOAByInterface has set ForceServiceResultAsJSONObject
  if (ID=0) and (WR.lastchar <> JSONSEND_NOID[ForceServiceResultAsJSONObject]) then
      WR.Add(JSONSEND_NOID[ForceServiceResultAsJSONObject])
  else if (WR.lastchar <> JSONSEND_WITHID[ForceServiceResultAsJSONObject]) then
  begin
    WR.AddString(JSONSEND_WITHID[ForceServiceResultAsJSONObject]);
    WR.Add(ID); // only used in sicClientDriven mode
  end;
  WR.Add('}');
end;

Offline

#8 2014-10-28 18:12:50

edismo
Member
From: Brazil
Registered: 2013-10-04
Posts: 34

Re: getting json invalid return with two methods called

Sorry,

else if condition will never be true.
Changed to

 else if (WR.lastchar <> JSONSEND_WITHID[ForceServiceResultAsJSONObject][1]) then

But the tests did not pass.

 2.7. Service oriented architecture:
  - Weak interfaces: 56 assertions passed  405us
  - Service initialization: 243 assertions passed  2.30ms
  - Direct call: 583,392 assertions passed  24.99ms
  - Server side: 583,411 assertions passed  25.31ms

! Exception EInterfaceFactoryException raised with messsage:
!  Invalid TInterfacedObjectFake.FakeCall() for IComplexCalculator.Collections:
Invalid returned JSON content: expects {"result":...}

Offline

#9 2014-10-29 07:52:42

ab
Administrator
From: France
Registered: 2010-06-21
Posts: 14,182
Website

Re: getting json invalid return with two methods called

Should be fixed by http://synopse.info/fossil/info/ec20618d437

This was a more general issue about RawJSON decoding.

Thanks for the report.

Offline

Board footer

Powered by FluxBB