mirror of
https://github.com/danieleteti/delphimvcframework.git
synced 2024-11-15 15:55:54 +01:00
789 lines
28 KiB
ObjectPascal
789 lines
28 KiB
ObjectPascal
// ***************************************************************************
|
|
//
|
|
// Delphi MVC Framework
|
|
//
|
|
// Copyright (c) 2010-2024 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 MVCFramework.JSONRPC.Client;
|
|
|
|
interface
|
|
|
|
uses
|
|
MVCFramework.JSONRPC,
|
|
System.Net.HttpClient,
|
|
System.Net.URLClient,
|
|
System.Generics.Collections,
|
|
System.SysUtils,
|
|
MVCFramework.Commons,
|
|
JsonDataObjects;
|
|
|
|
type
|
|
TJSONRPCResponseHandlerProc = reference to procedure(JSONRPCResponse: IJSONRPCResponse);
|
|
TJSONRPCErrorHandlerProc = reference to procedure(Exc: Exception);
|
|
|
|
IMVCJSONRPCExecutor = interface
|
|
['{55415094-9D28-4707-AEC5-5FCF925E82BC}']
|
|
//sync
|
|
function ExecuteRequest(
|
|
const aJSONRPCRequest: IJSONRPCRequest;
|
|
const UseVerb: TJSONRPCHTTPVerb = jrpcDefault): IJSONRPCResponse; overload;
|
|
function ExecuteRequest(
|
|
const aLastEndPointSegment: string;
|
|
const aJSONRPCRequest: IJSONRPCRequest;
|
|
const UseVerb: TJSONRPCHTTPVerb = jrpcDefault): IJSONRPCResponse; overload;
|
|
function ExecuteNotification(
|
|
const aJSONRPCNotification: IJSONRPCNotification;
|
|
const UseVerb: TJSONRPCHTTPVerb = jrpcDefault): IJSONRPCResponse; overload;
|
|
function ExecuteNotification(
|
|
const aLastEndPointSegment: string;
|
|
const aJSONRPCNotification: IJSONRPCNotification;
|
|
const UseVerb: TJSONRPCHTTPVerb = jrpcDefault): IJSONRPCResponse; overload;
|
|
function HTTPResponse: IHTTPResponse;
|
|
// Http headers handling
|
|
procedure AddHTTPHeader(const aNetHeader: TNetHeader);
|
|
procedure ClearHTTPHeaders;
|
|
function HTTPHeadersCount: Integer;
|
|
function SetOnNeedClientCertificate(const aOnNeedClientCertificate: TNeedClientCertificateEvent)
|
|
: IMVCJSONRPCExecutor;
|
|
function SetOnValidateServerCertificate(const aOnValidateServerCertificate: TValidateCertificateEvent)
|
|
: IMVCJSONRPCExecutor;
|
|
function ConfigureHTTPClient(const aConfigProc: TProc<THTTPClient>): IMVCJSONRPCExecutor;
|
|
//events
|
|
//sync
|
|
function SetOnReceiveData(const aOnReceiveData: TReceiveDataEvent): IMVCJSONRPCExecutor;
|
|
function SetOnReceiveResponse(const aOnReceiveResponseProc: TProc<IJSONRPCObject, IJSONRPCObject>)
|
|
: IMVCJSONRPCExecutor;
|
|
function SetOnSendCommand(const aOnSendCommandProc: TProc<IJSONRPCObject>): IMVCJSONRPCExecutor;
|
|
function SetOnReceiveHTTPResponse(const aOnReceiveHTTPResponse: TProc<IHTTPResponse>): IMVCJSONRPCExecutor;
|
|
//end events
|
|
//"constructors"
|
|
function CreateRequest(const MethodName: String; const RequestID: UInt64): IJSONRPCRequest; overload;
|
|
function CreateRequest(const MethodName: String; const RequestID: String): IJSONRPCRequest; overload;
|
|
function CreateNotification(const MethodName: String): IJSONRPCNotification;
|
|
end;
|
|
|
|
IMVCJSONRPCExecutorAsync = interface
|
|
['{16E930C2-0318-48A3-9633-614FB5BF8BAE}']
|
|
//async
|
|
procedure ExecuteRequestAsync(
|
|
const aJSONRPCRequest: IJSONRPCRequest;
|
|
const AJSONRPCResponseHandler: TJSONRPCResponseHandlerProc;
|
|
const AJSONRPCErrorHandler: TJSONRPCErrorHandlerProc = nil;
|
|
const UseVerb: TJSONRPCHTTPVerb = jrpcDefault); overload;
|
|
procedure ExecuteRequestAsync(
|
|
const aLastEndPointSegment: string;
|
|
const aJSONRPCRequest: IJSONRPCRequest;
|
|
const AJSONRPCResponseHandler: TJSONRPCResponseHandlerProc;
|
|
const AJSONRPCErrorHandler: TJSONRPCErrorHandlerProc = nil;
|
|
const UseVerb: TJSONRPCHTTPVerb = jrpcDefault); overload;
|
|
procedure ExecuteNotificationAsync(
|
|
const aJSONRPCNotification: IJSONRPCNotification;
|
|
const AJSONRPCErrorHandler: TJSONRPCErrorHandlerProc = nil;
|
|
const UseVerb: TJSONRPCHTTPVerb = jrpcDefault); overload;
|
|
procedure ExecuteNotificationAsync(
|
|
const aLastEndPointSegment: string;
|
|
const aJSONRPCNotification: IJSONRPCNotification;
|
|
const AJSONRPCErrorHandler: TJSONRPCErrorHandlerProc = nil;
|
|
const UseVerb: TJSONRPCHTTPVerb = jrpcDefault); overload;
|
|
// end async
|
|
// http headers handling
|
|
procedure AddHTTPHeader(const aNetHeader: TNetHeader);
|
|
procedure ClearHTTPHeaders;
|
|
function HTTPHeadersCount: Integer;
|
|
function SetOnNeedClientCertificate(const aOnNeedClientCertificate: TNeedClientCertificateEvent)
|
|
: IMVCJSONRPCExecutor;
|
|
function SetOnValidateServerCertificate(const aOnValidateServerCertificate: TValidateCertificateEvent)
|
|
: IMVCJSONRPCExecutor;
|
|
//events
|
|
function CreateRequest(const MethodName: String; const RequestID: UInt64): IJSONRPCRequest; overload;
|
|
function CreateRequest(const MethodName: String; const RequestID: String): IJSONRPCRequest; overload;
|
|
function CreateNotification(const MethodName: String): IJSONRPCNotification;
|
|
//async
|
|
function SetOnReceiveResponseAsync(const aOnReceiveResponseAsyncProc: TProc<IJSONRPCObject, IJSONRPCObject>)
|
|
: IMVCJSONRPCExecutorAsync;
|
|
function SetOnSendCommandAsync(const aOnSendCommandAsyncProc: TProc<IJSONRPCObject>): IMVCJSONRPCExecutorAsync;
|
|
function SetOnReceiveHTTPResponseAsync(const aOnReceiveHTTPResponseAsync: TProc<IHTTPResponse>): IMVCJSONRPCExecutorAsync;
|
|
function SetOnBeginAsyncRequest(const Proc: TProc): IMVCJSONRPCExecutorAsync;
|
|
function SetOnEndAsyncRequest(const Proc: TProc): IMVCJSONRPCExecutorAsync;
|
|
/// <summary>
|
|
/// Invoked internally just before each async requests/notifications.
|
|
/// Use it to customize properties and events of HTTP client used in async operations.
|
|
/// </summary>
|
|
function SetConfigureHTTPClientAsync(const aConfigProcAsync: TProc<THTTPClient>): IMVCJSONRPCExecutorAsync;
|
|
//end events
|
|
end;
|
|
|
|
|
|
TMVCJSONRPCExecutor = class(TInterfacedObject, IMVCJSONRPCExecutor, IMVCJSONRPCExecutorAsync)
|
|
private
|
|
fDefaultHTTPVerb: TJSONRPCHTTPVerb;
|
|
fURL: string;
|
|
fHTTP: THTTPClient;
|
|
fRaiseExceptionOnError: Boolean;
|
|
fHTTPRequestHeaders: TList<TNetHeader>;
|
|
fHTTPResponse: IHTTPResponse;
|
|
|
|
//the following sync events are used only with sync execution
|
|
fOnReceiveResponse: TProc<IJSONRPCObject, IJSONRPCObject>;
|
|
fOnReceiveHTTPResponse: TProc<IHTTPResponse>;
|
|
fOnSendCommand: TProc<IJSONRPCObject>;
|
|
//end sync events
|
|
|
|
//the following async events are used only with async execution
|
|
fOnReceiveHTTPResponseAsync: TProc<IHTTPResponse>;
|
|
fOnSendCommandAsync: TProc<IJSONRPCObject>;
|
|
fOnReceiveResponseAsync: TProc<IJSONRPCObject, IJSONRPCObject>;
|
|
fOnBeginAsyncRequest: TProc;
|
|
fOnEndAsyncRequest: TProc;
|
|
fConfigProcAsync: TProc<THTTPClient>;
|
|
//end async events
|
|
function GetHTTPRequestHeaders: TList<TNetHeader>;
|
|
procedure DoBeginAsyncRequest;
|
|
procedure DoEndAsyncRequest;
|
|
protected
|
|
function GetQueryStringParameters(const aJSONRPCObject: IJSONRPCObject): String;
|
|
function HTTPResponse: IHTTPResponse;
|
|
|
|
//sync
|
|
function InternalExecute(
|
|
const aEndPoint: string;
|
|
const aJSONRPCObject: IJSONRPCObject;
|
|
const UseVerb: TJSONRPCHTTPVerb): IJSONRPCResponse;
|
|
function ExecuteRequest(
|
|
const aJSONRPCRequest: IJSONRPCRequest;
|
|
const UseVerb: TJSONRPCHTTPVerb): IJSONRPCResponse; overload;
|
|
function ExecuteRequest(
|
|
const aLastEndPointSegment: string;
|
|
const aJSONRPCRequest: IJSONRPCRequest;
|
|
const UseVerb: TJSONRPCHTTPVerb): IJSONRPCResponse; overload;
|
|
function ExecuteNotification(const aJSONRPCNotification: IJSONRPCNotification; const UseVerb: TJSONRPCHTTPVerb)
|
|
: IJSONRPCResponse; overload;
|
|
function ExecuteNotification(const aLastEndPointSegment: string; const aJSONRPCNotification: IJSONRPCNotification;
|
|
const UseVerb: TJSONRPCHTTPVerb): IJSONRPCResponse; overload;
|
|
//async
|
|
procedure InternalExecuteAsync(
|
|
const AEndPoint: string;
|
|
const AJSONRPCObject: IJSONRPCObject;
|
|
const AJSONRPCResponseHandler: TJSONRPCResponseHandlerProc;
|
|
const AJSONRPCErrorHandler: TJSONRPCErrorHandlerProc;
|
|
const UseVerb: TJSONRPCHTTPVerb);
|
|
procedure ExecuteRequestAsync(
|
|
const aJSONRPCRequest: IJSONRPCRequest;
|
|
const AJSONRPCResponseHandler: TJSONRPCResponseHandlerProc;
|
|
const AJSONRPCErrorHandler: TJSONRPCErrorHandlerProc;
|
|
const UseVerb: TJSONRPCHTTPVerb); overload;
|
|
procedure ExecuteRequestAsync(
|
|
const aLastEndPointSegment: string;
|
|
const AJSONRPCRequest: IJSONRPCRequest;
|
|
const AJSONRPCResponseHandler: TJSONRPCResponseHandlerProc;
|
|
const AJSONRPCErrorHandler: TJSONRPCErrorHandlerProc;
|
|
const UseVerb: TJSONRPCHTTPVerb); overload;
|
|
procedure ExecuteNotificationAsync(
|
|
const AJSONRPCNotification: IJSONRPCNotification;
|
|
const AJSONRPCErrorHandler: TJSONRPCErrorHandlerProc;
|
|
const UseVerb: TJSONRPCHTTPVerb); overload;
|
|
procedure ExecuteNotificationAsync(
|
|
const ALastEndPointSegment: string;
|
|
const AJSONRPCNotification: IJSONRPCNotification;
|
|
const AJSONRPCErrorHandler: TJSONRPCErrorHandlerProc;
|
|
const UseVerb: TJSONRPCHTTPVerb); overload;
|
|
function SetOnBeginAsyncRequest(const Proc: TProc): IMVCJSONRPCExecutorAsync;
|
|
function SetOnEndAsyncRequest(const Proc: TProc): IMVCJSONRPCExecutorAsync;
|
|
// Http headers handling
|
|
procedure AddHTTPHeader(const aNetHeader: TNetHeader);
|
|
procedure ClearHTTPHeaders;
|
|
function HTTPHeadersCount: Integer;
|
|
function CreateRequest(const MethodName: String; const RequestID: UInt64): IJSONRPCRequest; overload;
|
|
function CreateRequest(const MethodName: String; const RequestID: String): IJSONRPCRequest; overload;
|
|
function CreateNotification(const MethodName: String): IJSONRPCNotification;
|
|
//events
|
|
//sync
|
|
function SetOnReceiveData(const aOnReceiveData: TReceiveDataEvent): IMVCJSONRPCExecutor;
|
|
function SetOnReceiveResponse(const aOnReceiveResponseProc: TProc<IJSONRPCObject, IJSONRPCObject>)
|
|
: IMVCJSONRPCExecutor;
|
|
function SetOnSendCommand(const aOnSendCommandProc: TProc<IJSONRPCObject>): IMVCJSONRPCExecutor;
|
|
function SetOnNeedClientCertificate(const aOnNeedClientCertificate: TNeedClientCertificateEvent)
|
|
: IMVCJSONRPCExecutor;
|
|
function SetOnValidateServerCertificate(const aOnValidateServerCertificate: TValidateCertificateEvent)
|
|
: IMVCJSONRPCExecutor;
|
|
function SetOnReceiveHTTPResponse(const aOnReceiveHTTPResponse: TProc<IHTTPResponse>): IMVCJSONRPCExecutor;
|
|
//async
|
|
function SetOnReceiveResponseAsync(const aOnReceiveResponseAsyncProc: TProc<IJSONRPCObject, IJSONRPCObject>): IMVCJSONRPCExecutorAsync;
|
|
function SetOnSendCommandAsync(const aOnSendCommandAsyncProc: TProc<IJSONRPCObject>): IMVCJSONRPCExecutorAsync;
|
|
function SetOnReceiveHTTPResponseAsync(const aOnReceiveHTTPResponseAsync: TProc<IHTTPResponse>): IMVCJSONRPCExecutorAsync;
|
|
function SetConfigureHTTPClientAsync(const aConfigProcAsync: TProc<THTTPClient>): IMVCJSONRPCExecutorAsync;
|
|
//end events
|
|
function ConfigureHTTPClient(const aConfigProc: TProc<THTTPClient>): IMVCJSONRPCExecutor;
|
|
public
|
|
constructor Create(const aURL: string;
|
|
const aRaiseExceptionOnError: Boolean = True;
|
|
const aDefaultHTTPVerb: TJSONRPCHTTPVerb = jrpcDefault); virtual;
|
|
destructor Destroy; override;
|
|
end;
|
|
|
|
implementation
|
|
|
|
uses
|
|
System.Classes, System.Types, MVCFramework.AsyncTask;
|
|
|
|
procedure JSONRPCExec(const aJSONRPCURL: string; const aJSONRPCRequest: IJSONRPCRequest;
|
|
out aJSONRPCResponse: IJSONRPCResponse);
|
|
var
|
|
lSS: TStringStream;
|
|
lHttpResp: IHTTPResponse;
|
|
lHTTP: THTTPClient;
|
|
begin
|
|
lSS := TStringStream.Create(aJSONRPCRequest.AsJSONString);
|
|
try
|
|
lSS.Position := 0;
|
|
lHTTP := THTTPClient.Create;
|
|
try
|
|
lHttpResp := lHTTP.Post(aJSONRPCURL, lSS, nil, [TNetHeader.Create('content-type', 'application/json'),
|
|
TNetHeader.Create('accept', 'application/json')]);
|
|
if (lHttpResp.StatusCode <> 204) then
|
|
begin
|
|
aJSONRPCResponse := TJSONRPCResponse.Create;
|
|
aJSONRPCResponse.AsJSONString := lHttpResp.ContentAsString;
|
|
if Assigned(aJSONRPCResponse.Error) then
|
|
raise Exception.CreateFmt('Error [%d]: %s', [aJSONRPCResponse.Error.Code, aJSONRPCResponse.Error.ErrMessage]);
|
|
end;
|
|
finally
|
|
lHTTP.Free;
|
|
end;
|
|
finally
|
|
lSS.Free;
|
|
end;
|
|
end;
|
|
|
|
{ TMVCJSONRPCExecutor }
|
|
|
|
procedure TMVCJSONRPCExecutor.AddHTTPHeader(const aNetHeader: TNetHeader);
|
|
begin
|
|
GetHTTPRequestHeaders.Add(aNetHeader);
|
|
end;
|
|
|
|
procedure TMVCJSONRPCExecutor.ClearHTTPHeaders;
|
|
begin
|
|
if Assigned(fHTTPRequestHeaders) then
|
|
begin
|
|
fHTTPRequestHeaders.Clear;
|
|
end;
|
|
end;
|
|
|
|
function TMVCJSONRPCExecutor.ConfigureHTTPClient(const aConfigProc: TProc<THTTPClient>): IMVCJSONRPCExecutor;
|
|
begin
|
|
aConfigProc(fHTTP);
|
|
Result := Self;
|
|
end;
|
|
|
|
constructor TMVCJSONRPCExecutor.Create(const aURL: string; const aRaiseExceptionOnError: Boolean = True;
|
|
const aDefaultHTTPVerb: TJSONRPCHTTPVerb = jrpcDefault);
|
|
begin
|
|
inherited Create;
|
|
fRaiseExceptionOnError := aRaiseExceptionOnError;
|
|
fURL := aURL;
|
|
fDefaultHTTPVerb := aDefaultHTTPVerb;
|
|
fHTTP := THTTPClient.Create;
|
|
{$IF defined(BERLINORBETTER)}
|
|
fHTTP.ResponseTimeout := MaxInt;
|
|
{$ENDIF}
|
|
fHTTPRequestHeaders := nil;
|
|
SetOnReceiveResponse(nil)
|
|
.SetOnReceiveData(nil)
|
|
.SetOnNeedClientCertificate(nil)
|
|
.SetOnValidateServerCertificate(nil);
|
|
end;
|
|
|
|
function TMVCJSONRPCExecutor.CreateNotification(
|
|
const MethodName: String): IJSONRPCNotification;
|
|
begin
|
|
Result := TJSONRPCNotification.Create(MethodName);
|
|
end;
|
|
|
|
function TMVCJSONRPCExecutor.CreateRequest(const MethodName,
|
|
RequestID: String): IJSONRPCRequest;
|
|
begin
|
|
Result := TJSONRPCRequest.Create(RequestID, MethodName);
|
|
end;
|
|
|
|
function TMVCJSONRPCExecutor.CreateRequest(const MethodName: String;
|
|
const RequestID: UInt64): IJSONRPCRequest;
|
|
begin
|
|
Result := TJSONRPCRequest.Create(RequestID, MethodName);
|
|
end;
|
|
|
|
destructor TMVCJSONRPCExecutor.Destroy;
|
|
begin
|
|
fHTTP.Free;
|
|
fHTTPRequestHeaders.Free;
|
|
inherited;
|
|
end;
|
|
|
|
procedure TMVCJSONRPCExecutor.DoBeginAsyncRequest;
|
|
begin
|
|
if Assigned(fOnBeginAsyncRequest) then
|
|
begin
|
|
TThread.Queue(nil,
|
|
procedure
|
|
begin
|
|
fOnBeginAsyncRequest();
|
|
end);
|
|
end;
|
|
end;
|
|
|
|
procedure TMVCJSONRPCExecutor.DoEndAsyncRequest;
|
|
begin
|
|
if Assigned(fOnEndAsyncRequest) then
|
|
begin
|
|
TThread.Queue(nil,
|
|
procedure
|
|
begin
|
|
fOnEndAsyncRequest();
|
|
end);
|
|
end;
|
|
end;
|
|
|
|
function TMVCJSONRPCExecutor.ExecuteNotification(const aJSONRPCNotification: IJSONRPCNotification;
|
|
const UseVerb: TJSONRPCHTTPVerb): IJSONRPCResponse;
|
|
begin
|
|
Result := ExecuteNotification('', aJSONRPCNotification, UseVerb);
|
|
end;
|
|
|
|
function TMVCJSONRPCExecutor.ExecuteRequest(const aJSONRPCRequest: IJSONRPCRequest; const UseVerb: TJSONRPCHTTPVerb)
|
|
: IJSONRPCResponse;
|
|
begin
|
|
Result := ExecuteRequest('', aJSONRPCRequest, UseVerb);
|
|
end;
|
|
|
|
function TMVCJSONRPCExecutor.GetHTTPRequestHeaders: TList<TNetHeader>;
|
|
begin
|
|
if not Assigned(fHTTPRequestHeaders) then
|
|
begin
|
|
fHTTPRequestHeaders := TList<TNetHeader>.Create;
|
|
end;
|
|
Result := fHTTPRequestHeaders;
|
|
end;
|
|
|
|
function TMVCJSONRPCExecutor.GetQueryStringParameters(const aJSONRPCObject: IJSONRPCObject): String;
|
|
var
|
|
lJObj: TJDOJsonObject;
|
|
begin
|
|
lJObj := aJSONRPCObject.AsJSON;
|
|
try
|
|
Result := 'jsonrpc=' + URLEncode(lJObj.S['jsonrpc']);
|
|
Result := Result + '&method=' + URLEncode(lJObj.S['method']);
|
|
if lJObj.Contains('id') then
|
|
begin
|
|
Result := Result + '&id=' + URLEncode(lJObj.S['id']);
|
|
end;
|
|
|
|
if lJObj.Contains('params') then
|
|
begin
|
|
if lJObj.Types['params'] = jdtArray then
|
|
begin
|
|
Result := Result + '¶ms=' + URLEncode(lJObj.A['params'].ToJSON());
|
|
end
|
|
else
|
|
begin
|
|
Result := Result + '¶ms=' + URLEncode(lJObj.O['params'].ToJSON());
|
|
end;
|
|
end;
|
|
finally
|
|
lJObj.Free;
|
|
end;
|
|
end;
|
|
|
|
function TMVCJSONRPCExecutor.HTTPHeadersCount: Integer;
|
|
begin
|
|
if Assigned(fHTTPRequestHeaders) then
|
|
begin
|
|
Result := fHTTPRequestHeaders.Count;
|
|
end
|
|
else
|
|
begin
|
|
Result := 0;
|
|
end;
|
|
end;
|
|
|
|
function TMVCJSONRPCExecutor.InternalExecute(
|
|
const aEndPoint: string;
|
|
const aJSONRPCObject: IJSONRPCObject;
|
|
const UseVerb: TJSONRPCHTTPVerb): IJSONRPCResponse;
|
|
var
|
|
lSS: TStringStream;
|
|
lHttpResp: IHTTPResponse;
|
|
lJSONRPCResponse: IJSONRPCResponse;
|
|
lCustomHeaders: TNetHeaders;
|
|
begin
|
|
lCustomHeaders := [];
|
|
if Assigned(fHTTPRequestHeaders) then
|
|
begin
|
|
lCustomHeaders := fHTTPRequestHeaders.ToArray;
|
|
end;
|
|
|
|
Result := nil;
|
|
lSS := TStringStream.Create(aJSONRPCObject.AsJSONString, TEncoding.UTF8);
|
|
try
|
|
lSS.Position := 0;
|
|
if Assigned(fOnSendCommand) then
|
|
begin
|
|
fOnSendCommand(aJSONRPCObject);
|
|
end;
|
|
fHTTPResponse := nil;
|
|
|
|
case UseVerb of
|
|
jrpcPOST, jrpcDefault:
|
|
begin
|
|
lHttpResp := fHTTP.Post(fURL + aEndPoint, lSS, nil,
|
|
[TNetHeader.Create('content-type', 'application/json;charset=utf8'), TNetHeader.Create('accept',
|
|
'application/json;charset=utf8')] + lCustomHeaders);
|
|
end;
|
|
jrpcGET:
|
|
begin
|
|
lHttpResp := fHTTP.Get(fURL + aEndPoint + '?' + GetQueryStringParameters(aJSONRPCObject), nil,
|
|
[TNetHeader.Create('accept', 'application/json;charset=utf8')] + lCustomHeaders);
|
|
end;
|
|
end;
|
|
|
|
fHTTPResponse := lHttpResp;
|
|
if Assigned(fOnReceiveHTTPResponse) then
|
|
begin
|
|
fOnReceiveHTTPResponse(fHTTPResponse);
|
|
end;
|
|
lJSONRPCResponse := nil;
|
|
if lHttpResp.StatusCode = HTTP_STATUS.NoContent then
|
|
begin
|
|
lJSONRPCResponse := TJSONRPCNullResponse.Create;
|
|
end
|
|
else
|
|
begin
|
|
if fHTTPResponse.HeaderValue['content-type'].Contains(TMVCMediaType.APPLICATION_JSON) then
|
|
begin
|
|
lJSONRPCResponse := TJSONRPCResponse.Create;
|
|
lJSONRPCResponse.AsJSONString := lHttpResp.ContentAsString;
|
|
end;
|
|
end;
|
|
fHTTPResponse := lHttpResp;
|
|
if Assigned(fOnReceiveResponse) then
|
|
begin
|
|
fOnReceiveResponse(aJSONRPCObject, lJSONRPCResponse);
|
|
end;
|
|
|
|
if lJSONRPCResponse = nil then
|
|
begin
|
|
raise EMVCJSONRPCException.CreateFmt('[PROTOCOL EXCEPTION][%d: %s]: %s',
|
|
[fHTTPResponse.StatusCode,
|
|
fHTTPResponse.StatusText,
|
|
fHTTPResponse.ContentAsString()]);
|
|
end;
|
|
|
|
if Assigned(lJSONRPCResponse.Error) and fRaiseExceptionOnError then
|
|
raise EMVCJSONRPCRemoteException.Create(
|
|
lJSONRPCResponse.Error.Code,
|
|
lJSONRPCResponse.Error.ErrMessage,
|
|
lJSONRPCResponse.Error.Data
|
|
);
|
|
Result := lJSONRPCResponse;
|
|
finally
|
|
lSS.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TMVCJSONRPCExecutor.InternalExecuteAsync(
|
|
const AEndPoint: string;
|
|
const AJSONRPCObject: IJSONRPCObject;
|
|
const AJSONRPCResponseHandler: TJSONRPCResponseHandlerProc;
|
|
const AJSONRPCErrorHandler: TJSONRPCErrorHandlerProc;
|
|
const UseVerb: TJSONRPCHTTPVerb);
|
|
var
|
|
lCustomHeaders: TNetHeaders;
|
|
lProc: TProc;
|
|
lURL: String;
|
|
begin
|
|
lCustomHeaders := [];
|
|
if Assigned(fHTTPRequestHeaders) then
|
|
begin
|
|
lCustomHeaders := fHTTPRequestHeaders.ToArray;
|
|
end;
|
|
|
|
|
|
lURL := fURL;
|
|
lProc := procedure
|
|
var
|
|
lSS: TStringStream;
|
|
lHttpResp: IHTTPResponse;
|
|
lJSONRPCResponse: IJSONRPCResponse;
|
|
lEx: Pointer;
|
|
lExceptionAddress: Pointer;
|
|
lHTTP: THTTPClient;
|
|
begin
|
|
lHTTP := THTTPClient.Create;
|
|
try
|
|
if Assigned(fConfigProcAsync) then
|
|
begin
|
|
fConfigProcAsync(lHttp);
|
|
end;
|
|
lHTTP.OnNeedClientCertificate := fHTTP.OnNeedClientCertificate;
|
|
lHTTP.OnReceiveData := fHTTP.OnReceiveData;
|
|
lHTTP.OnValidateServerCertificate := fHTTP.OnValidateServerCertificate;
|
|
lSS := TStringStream.Create(AJSONRPCObject.AsJSONString, TEncoding.UTF8);
|
|
try
|
|
lSS.Position := 0;
|
|
fHTTPResponse := nil;
|
|
try
|
|
DoBeginAsyncRequest;
|
|
try
|
|
if Assigned(fOnSendCommandAsync) then
|
|
begin
|
|
fOnSendCommandAsync(AJSONRPCObject);
|
|
end;
|
|
case UseVerb of
|
|
jrpcPOST, jrpcDefault:
|
|
begin
|
|
lHttpResp := lHTTP.Post(lURL + aEndPoint, lSS, nil,
|
|
[TNetHeader.Create('content-type', 'application/json;charset=utf8'), TNetHeader.Create('accept',
|
|
'application/json;charset=utf8')] + lCustomHeaders);
|
|
end;
|
|
jrpcGET:
|
|
begin
|
|
lHttpResp := lHTTP.Get(lURL + aEndPoint + '?' + GetQueryStringParameters(AJSONRPCObject), nil,
|
|
[TNetHeader.Create('accept', 'application/json;charset=utf8')] + lCustomHeaders);
|
|
end;
|
|
end;
|
|
|
|
if Assigned(fOnReceiveHTTPResponseAsync) then
|
|
begin
|
|
fOnReceiveHTTPResponseAsync(lHttpResp);
|
|
end;
|
|
lJSONRPCResponse := nil;
|
|
|
|
if lHttpResp.StatusCode = HTTP_STATUS.NoContent then
|
|
begin
|
|
lJSONRPCResponse := TJSONRPCNullResponse.Create;
|
|
end
|
|
else
|
|
begin
|
|
if lHttpResp.HeaderValue['content-type'].Contains(TMVCMediaType.APPLICATION_JSON) then
|
|
begin
|
|
lJSONRPCResponse := TJSONRPCResponse.Create;
|
|
lJSONRPCResponse.AsJSONString := lHttpResp.ContentAsString;
|
|
end
|
|
else
|
|
begin
|
|
raise EMVCJSONRPCProtocolException.CreateFmt(
|
|
'Expected content-type "%s", got "%s"',
|
|
[
|
|
TMVCMediaType.APPLICATION_JSON,
|
|
lHttpResp.HeaderValue['content-type']
|
|
]);
|
|
end;
|
|
end;
|
|
|
|
if Assigned(fOnReceiveResponseAsync) then
|
|
begin
|
|
fOnReceiveResponseAsync(aJSONRPCObject, lJSONRPCResponse);
|
|
end;
|
|
|
|
if Assigned(lJSONRPCResponse.Error) then
|
|
begin
|
|
raise EMVCJSONRPCRemoteException.Create(
|
|
lJSONRPCResponse.Error.Code,
|
|
lJSONRPCResponse.Error.ErrMessage,
|
|
lJSONRPCResponse.Error.Data
|
|
);
|
|
end;
|
|
finally
|
|
DoEndAsyncRequest;
|
|
end;
|
|
if Assigned(AJSONRPCResponseHandler) then
|
|
begin
|
|
TThread.Queue(nil,
|
|
procedure
|
|
begin
|
|
AJSONRPCResponseHandler(lJSONRPCResponse);
|
|
end);
|
|
end;
|
|
except
|
|
lEx := AcquireExceptionObject;
|
|
lExceptionAddress := ExceptAddr;
|
|
TThread.Queue(nil,
|
|
procedure
|
|
var
|
|
lCurrException: Exception;
|
|
begin
|
|
lCurrException := Exception(lEx);
|
|
try
|
|
if Assigned(AJSONRPCErrorHandler) then
|
|
AJSONRPCErrorHandler(lCurrException)
|
|
else
|
|
gDefaultTaskErrorHandler(lCurrException, lExceptionAddress);
|
|
finally
|
|
FreeAndNil(lCurrException);
|
|
end;
|
|
end);
|
|
end;
|
|
finally
|
|
lSS.Free;
|
|
end;
|
|
finally
|
|
lHTTP.Free;
|
|
end;
|
|
end; //end proc
|
|
TThread.CreateAnonymousThread(lProc).Start;
|
|
end;
|
|
|
|
function TMVCJSONRPCExecutor.HTTPResponse: IHTTPResponse;
|
|
begin
|
|
Result := fHTTPResponse;
|
|
end;
|
|
|
|
function TMVCJSONRPCExecutor.SetConfigureHTTPClientAsync(
|
|
const aConfigProcAsync: TProc<THTTPClient>): IMVCJSONRPCExecutorAsync;
|
|
begin
|
|
fConfigProcAsync := aConfigProcAsync;
|
|
Result := Self;
|
|
end;
|
|
|
|
function TMVCJSONRPCExecutor.SetOnBeginAsyncRequest(
|
|
const Proc: TProc): IMVCJSONRPCExecutorAsync;
|
|
begin
|
|
fOnBeginAsyncRequest := Proc;
|
|
Result := Self;
|
|
end;
|
|
|
|
function TMVCJSONRPCExecutor.SetOnEndAsyncRequest(
|
|
const Proc: TProc): IMVCJSONRPCExecutorAsync;
|
|
begin
|
|
fOnEndAsyncRequest := Proc;
|
|
Result := Self;
|
|
end;
|
|
|
|
function TMVCJSONRPCExecutor.SetOnNeedClientCertificate(const aOnNeedClientCertificate: TNeedClientCertificateEvent)
|
|
: IMVCJSONRPCExecutor;
|
|
begin
|
|
fHTTP.OnNeedClientCertificate := aOnNeedClientCertificate;
|
|
Result := Self;
|
|
end;
|
|
|
|
function TMVCJSONRPCExecutor.SetOnReceiveData(const aOnReceiveData: TReceiveDataEvent): IMVCJSONRPCExecutor;
|
|
begin
|
|
fHTTP.OnReceiveData := aOnReceiveData;
|
|
Result := Self;
|
|
end;
|
|
|
|
|
|
function TMVCJSONRPCExecutor.SetOnReceiveHTTPResponse(const aOnReceiveHTTPResponse: TProc<IHTTPResponse>)
|
|
: IMVCJSONRPCExecutor;
|
|
begin
|
|
fOnReceiveHTTPResponse := aOnReceiveHTTPResponse;
|
|
Result := Self;
|
|
end;
|
|
|
|
function TMVCJSONRPCExecutor.SetOnReceiveHTTPResponseAsync(
|
|
const aOnReceiveHTTPResponseAsync: TProc<IHTTPResponse>): IMVCJSONRPCExecutorAsync;
|
|
begin
|
|
fOnReceiveHTTPResponseAsync := aOnReceiveHTTPResponseAsync;
|
|
Result := Self;
|
|
end;
|
|
|
|
function TMVCJSONRPCExecutor.SetOnReceiveResponse(const aOnReceiveResponseProc: TProc<IJSONRPCObject, IJSONRPCObject>)
|
|
: IMVCJSONRPCExecutor;
|
|
begin
|
|
fOnReceiveResponse := aOnReceiveResponseProc;
|
|
Result := Self;
|
|
end;
|
|
|
|
function TMVCJSONRPCExecutor.SetOnReceiveResponseAsync(
|
|
const aOnReceiveResponseAsyncProc: TProc<IJSONRPCObject, IJSONRPCObject>): IMVCJSONRPCExecutorAsync;
|
|
begin
|
|
fOnReceiveResponseAsync := aOnReceiveResponseAsyncProc;
|
|
Result := Self;
|
|
end;
|
|
|
|
function TMVCJSONRPCExecutor.SetOnSendCommand(const aOnSendCommandProc: TProc<IJSONRPCObject>): IMVCJSONRPCExecutor;
|
|
begin
|
|
fOnSendCommand := aOnSendCommandProc;
|
|
Result := Self;
|
|
end;
|
|
|
|
function TMVCJSONRPCExecutor.SetOnSendCommandAsync(
|
|
const aOnSendCommandAsyncProc: TProc<IJSONRPCObject>): IMVCJSONRPCExecutorAsync;
|
|
begin
|
|
fOnSendCommandAsync := aOnSendCommandAsyncProc;
|
|
Result := Self;
|
|
end;
|
|
|
|
function TMVCJSONRPCExecutor.SetOnValidateServerCertificate(const aOnValidateServerCertificate
|
|
: TValidateCertificateEvent): IMVCJSONRPCExecutor;
|
|
begin
|
|
fHTTP.OnValidateServerCertificate := aOnValidateServerCertificate;
|
|
Result := Self;
|
|
end;
|
|
|
|
function TMVCJSONRPCExecutor.ExecuteNotification(const aLastEndPointSegment: string;
|
|
const aJSONRPCNotification: IJSONRPCNotification; const UseVerb: TJSONRPCHTTPVerb): IJSONRPCResponse;
|
|
begin
|
|
Result := InternalExecute(aLastEndPointSegment, aJSONRPCNotification as TJSONRPCObject, UseVerb);
|
|
end;
|
|
|
|
procedure TMVCJSONRPCExecutor.ExecuteNotificationAsync(
|
|
const aJSONRPCNotification: IJSONRPCNotification;
|
|
const AJSONRPCErrorHandler: TJSONRPCErrorHandlerProc;
|
|
const UseVerb: TJSONRPCHTTPVerb);
|
|
begin
|
|
ExecuteNotificationAsync('', aJSONRPCNotification, AJSONRPCErrorHandler, UseVerb);
|
|
end;
|
|
|
|
procedure TMVCJSONRPCExecutor.ExecuteNotificationAsync(
|
|
const aLastEndPointSegment: string;
|
|
const aJSONRPCNotification: IJSONRPCNotification;
|
|
const AJSONRPCErrorHandler: TJSONRPCErrorHandlerProc;
|
|
const UseVerb: TJSONRPCHTTPVerb);
|
|
begin
|
|
InternalExecuteAsync(aLastEndPointSegment, aJSONRPCNotification as TJSONRPCObject, nil, AJSONRPCErrorHandler, UseVerb);
|
|
end;
|
|
|
|
function TMVCJSONRPCExecutor.ExecuteRequest(const aLastEndPointSegment: string; const aJSONRPCRequest: IJSONRPCRequest;
|
|
const UseVerb: TJSONRPCHTTPVerb): IJSONRPCResponse;
|
|
begin
|
|
Result := InternalExecute(aLastEndPointSegment, aJSONRPCRequest, UseVerb);
|
|
end;
|
|
|
|
procedure TMVCJSONRPCExecutor.ExecuteRequestAsync(
|
|
const aLastEndPointSegment: string; const aJSONRPCRequest: IJSONRPCRequest;
|
|
const AJSONRPCResponseHandler: TJSONRPCResponseHandlerProc;
|
|
const AJSONRPCErrorHandler: TJSONRPCErrorHandlerProc;
|
|
const UseVerb: TJSONRPCHTTPVerb);
|
|
begin
|
|
InternalExecuteAsync(aLastEndPointSegment, aJSONRPCRequest, AJSONRPCResponseHandler, AJSONRPCErrorHandler, UseVerb);
|
|
end;
|
|
|
|
procedure TMVCJSONRPCExecutor.ExecuteRequestAsync(
|
|
const AJSONRPCRequest: IJSONRPCRequest;
|
|
const AJSONRPCResponseHandler: TJSONRPCResponseHandlerProc;
|
|
const AJSONRPCErrorHandler: TJSONRPCErrorHandlerProc;
|
|
const UseVerb: TJSONRPCHTTPVerb);
|
|
begin
|
|
ExecuteRequestAsync('', aJSONRPCRequest, AJSONRPCResponseHandler, AJSONRPCErrorHandler, UseVerb);
|
|
end;
|
|
|
|
end.
|