delphimvcframework/sources/MVCFramework.JSONRPC.pas

2284 lines
66 KiB
ObjectPascal
Raw Normal View History

// ***************************************************************************
//
// Delphi MVC Framework
//
// Copyright (c) 2010-2020 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.
//
// *************************************************************************** }
2017-09-24 19:40:40 +02:00
unit MVCFramework.JSONRPC;
{
JSON-RPC over HTTP implemented as described here
https://www.jsonrpc.org/historical/json-rpc-over-http.html
}
2017-09-24 19:40:40 +02:00
interface
uses
System.Classes,
Data.DB,
System.SysUtils,
jsondataobjects,
MVCFramework,
MVCFramework.Commons,
System.Rtti,
System.Generics.Collections,
MVCFramework.Serializer.Commons,
MVCFramework.Serializer.jsondataobjects;
2017-09-24 19:40:40 +02:00
const
JSONRPC_VERSION = '2.0';
JSONRPC_HEADER = 'jsonrpc';
JSONRPC_METHOD = 'method';
JSONRPC_PARAMS = 'params';
JSONRPC_ID = 'id';
JSONRPC_RESULT = 'result';
JSONRPC_ERROR = 'error';
JSONRPC_CODE = 'code';
JSONRPC_MESSAGE = 'message';
JSONRPC_DATA = 'data';
2020-03-24 17:55:25 +01:00
const
JSONRPC_HOOKS_ON_BEFORE_ROUTING = 'OnBeforeRoutingHook';
JSONRPC_HOOKS_ON_BEFORE_CALL = 'OnBeforeCallHook';
2020-08-05 09:50:06 +02:00
JSONRPC_HOOKS_ON_AFTER_CALL = 'OnAfterCallHook';
JSONRPC_HOOKS_METHOD_NAMES: array [0 .. 2] of string = (JSONRPC_HOOKS_ON_BEFORE_ROUTING, JSONRPC_HOOKS_ON_BEFORE_CALL,
JSONRPC_HOOKS_ON_AFTER_CALL);
2020-03-24 17:55:25 +01:00
{
http://www.jsonrpc.org/historical/json-rpc-over-http.html#response-codes
HTTP Status code message
500 -32700 Parse error.
400 -32600 Invalid Request.
404 -32601 Method not found.
500 -32602 Invalid params.
500 -32603 Internal error.
500 -32099..-32000 Server error.
}
JSONRPC_ERR_PARSE_ERROR = -32700;
JSONRPC_ERR_INVALID_REQUEST = -32600;
JSONRPC_ERR_METHOD_NOT_FOUND = -32601;
JSONRPC_ERR_INVALID_PARAMS = -32602;
JSONRPC_ERR_INTERNAL_ERROR = -32603;
JSONRPC_ERR_SERVER_ERROR_LOWERBOUND = -32099;
JSONRPC_ERR_SERVER_ERROR_UPPERBOUND = -32000;
JSONRPC_USER_ERROR = JSONRPC_ERR_SERVER_ERROR_LOWERBOUND;
2017-09-24 19:40:40 +02:00
type
TJSONRPCHTTPVerb = (jrpcDefault, jrpcGET, jrpcPOST);
MVCJSONRPCAllowGET = class(TCustomAttribute)
end;
IMVCJSONRPCMessage = interface
['{73B8D463-75E1-404B-8437-EF4B3C950D2F}']
function AsJSONRPCMessage: string;
end;
TMVCJSONRPCMessage = class abstract(TInterfacedObject, IMVCJSONRPCMessage)
2017-09-24 19:40:40 +02:00
private
2019-01-08 12:48:27 +01:00
fJSON: TJDOJsonObject;
2017-09-24 19:40:40 +02:00
protected
2019-01-08 12:48:27 +01:00
class procedure CheckVersion(const aJSON: TJDOJsonObject);
class procedure CheckMethod(const aJSON: TJDOJsonObject);
class procedure CheckID(const aJSON: TJDOJsonObject; out aIsNotification: Boolean);
constructor Create; overload;
2019-01-08 12:48:27 +01:00
procedure Build(const aJSON: TJDOJsonObject); virtual; abstract;
{ IMVCJSONRPCMessage }
function AsJSONRPCMessage: string;
2019-01-08 12:48:27 +01:00
function AsJSON: TJDOJsonObject; virtual;
end;
IJSONRPCObject = interface
['{98E161EE-B106-4023-8722-3C2CB1B4CE87}']
procedure SetJsonString(const Value: string);
function GetJSONString: string;
2019-01-08 12:48:27 +01:00
function GetJSON: TJDOJsonObject;
2020-03-24 17:55:25 +01:00
function ToString(const Compact: Boolean): string;
2019-01-08 12:48:27 +01:00
procedure SetJSON(const Value: TJDOJsonObject);
property AsJSON: TJDOJsonObject read GetJSON write SetJSON;
property AsJSONString: string read GetJSONString write SetJsonString;
end;
TJSONRPCObject = class(TInterfacedObject, IJSONRPCObject)
protected
procedure SetJsonString(const Value: string); virtual;
function GetJSONString: string; virtual;
function ToString(const Compact: Boolean): string; reintroduce; virtual;
2019-01-08 12:48:27 +01:00
function GetJSON: TJDOJsonObject; virtual;
procedure SetJSON(const Value: TJDOJsonObject); virtual;
property AsJSON: TJDOJsonObject read GetJSON write SetJSON;
property AsJSONString: string read GetJSONString write SetJsonString;
public
constructor Create; virtual;
end;
TJSONRPCParamDataType = (pdtString, pdtInteger, pdtLongInteger, pdTJDOJsonObject, pdtJSONArray, pdtBoolean, pdtDate,
pdtTime, pdtDateTime, pdtFloat, pdtObject);
2019-01-08 12:48:27 +01:00
TJSONRPCRequestParams = class
private
function GetItem(const Index: Integer): TValue;
function GetItemDataType(const Index: Integer): TJSONRPCParamDataType;
protected
2020-05-02 16:39:32 +02:00
fParamValues: TList<TValue>;
fParamNames: TList<string>;
fParamTypes: TList<TJSONRPCParamDataType>;
private
procedure CheckNotNames;
procedure CheckBalancedParams;
function GetItemName(const Index: Integer): string;
2019-01-08 12:48:27 +01:00
public
constructor Create; virtual;
destructor Destroy; override;
procedure Clear;
function Count: Integer;
2020-03-24 17:55:25 +01:00
property Items[const index: Integer]: TValue read GetItem; default;
property ItemsType[const index: Integer]: TJSONRPCParamDataType read GetItemDataType;
2020-05-02 16:39:32 +02:00
property ItemsName[const index: Integer]: string read GetItemName;
2019-01-08 12:48:27 +01:00
function ToArray: TArray<TValue>;
2020-03-24 17:55:25 +01:00
procedure Add(const Value: string); overload;
2019-01-08 12:48:27 +01:00
procedure Add(const Value: Integer); overload;
procedure Add(const Value: TJDOJsonObject); overload;
procedure Add(const Value: TJDOJsonArray); overload;
procedure Add(const Value: Boolean); overload;
procedure Add(const Value: TDate); overload;
procedure Add(const Value: TTime); overload;
procedure Add(const Value: TDateTime); overload;
procedure Add(const Value: Double); overload;
procedure Add(const Value: TValue; const ParamType: TJSONRPCParamDataType); overload;
2020-05-02 16:39:32 +02:00
procedure AddByName(const Name: string; const Value: string); overload;
procedure AddByName(const Name: string; const Value: Integer); overload;
procedure AddByName(const Name: string; const Value: TJDOJsonObject); overload;
procedure AddByName(const Name: string; const Value: TJDOJsonArray); overload;
procedure AddByName(const Name: string; const Value: Boolean); overload;
procedure AddByName(const Name: string; const Value: TDate); overload;
procedure AddByName(const Name: string; const Value: TTime); overload;
procedure AddByName(const Name: string; const Value: TDateTime); overload;
procedure AddByName(const Name: string; const Value: Double); overload;
procedure AddByName(const Name: string; const Value: TValue; const ParamType: TJSONRPCParamDataType); overload;
2019-01-08 12:48:27 +01:00
end;
IJSONRPCNotification = interface(IJSONRPCObject)
['{FAA65A29-3305-4303-833E-825BDBD3FF7F}']
procedure SetMethod(const Value: string);
2019-01-08 12:48:27 +01:00
procedure FillParameters(const JSON: TJDOJsonObject; const RTTIMethod: TRTTIMethod);
function GetMethod: string;
function GetParams: TJSONRPCRequestParams;
property Method: string read GetMethod write SetMethod;
property Params: TJSONRPCRequestParams read GetParams;
end;
TJSONRPCNotification = class(TJSONRPCObject, IJSONRPCObject, IJSONRPCNotification)
protected
FMethod: string;
FParams: TJSONRPCRequestParams;
2019-01-08 12:48:27 +01:00
procedure FillParameters(const JSON: TJDOJsonObject; const RTTIMethod: TRTTIMethod);
procedure SetMethod(const Value: string);
function GetMethod: string;
function GetParams: TJSONRPCRequestParams;
2019-01-08 12:48:27 +01:00
function GetJSON: TJDOJsonObject; override;
property Method: string read GetMethod write SetMethod;
property Params: TJSONRPCRequestParams read GetParams;
2017-09-24 19:40:40 +02:00
public
constructor Create; overload; override;
2020-03-24 17:55:25 +01:00
constructor Create(const aMethod: string); reintroduce; overload;
destructor Destroy; override;
2017-09-24 19:40:40 +02:00
end;
{$SCOPEDENUMS ON}
TJSONRPCRequestType = (Request, Notification);
IJSONRPCRequest = interface(IJSONRPCNotification)
['{D8318032-0261-4273-B99D-121899AD52FB}']
function GetRequestType: TJSONRPCRequestType;
function GetID: TValue;
procedure SetID(const Value: TValue);
property RequestType: TJSONRPCRequestType read GetRequestType;
property RequestID: TValue read GetID write SetID;
end;
TJSONRPCRequest = class(TJSONRPCNotification, IJSONRPCRequest)
2017-09-24 19:40:40 +02:00
private
FID: TValue;
function GetRequestType: TJSONRPCRequestType;
function GetID: TValue;
protected
2019-01-08 12:48:27 +01:00
procedure SetJSON(const JSON: TJDOJsonObject); override;
function GetJSON: TJDOJsonObject; override;
procedure SetID(const Value: TValue);
property RequestType: TJSONRPCRequestType read GetRequestType;
property RequestID: TValue read GetID write SetID;
public
2020-03-24 17:55:25 +01:00
constructor Create(const aID: TValue; const aMethod: string); overload; virtual;
constructor Create(const aID: TValue); overload; virtual;
constructor Create; reintroduce; overload; virtual;
destructor Destroy; override;
end;
TJSONRPCResponseError = class
private
FCode: Integer;
FMessage: string;
procedure SetCode(const Value: Integer);
procedure SetMessage(const Value: string);
public
property Code: Integer read FCode write SetCode;
property ErrMessage: string read FMessage write SetMessage;
end;
IJSONRPCResponse = interface(IJSONRPCObject)
['{69B43409-14DC-4A36-9E12-425A1626FF3C}']
function GetID: TValue;
procedure SetID(const Value: TValue);
function GetResult: TValue;
procedure SetResult(const Value: TValue);
function GetError: TJSONRPCResponseError;
procedure SetError(const Value: TJSONRPCResponseError);
function IsError: Boolean;
2019-01-08 12:48:27 +01:00
function ResultAsJSONObject: TJDOJsonObject;
function ResultAsJSONArray: TJDOJsonArray;
property Result: TValue read GetResult write SetResult;
property Error: TJSONRPCResponseError read GetError write SetError;
property RequestID: TValue read GetID write SetID;
end;
TJSONRPCResponse = class(TJSONRPCObject, IJSONRPCResponse)
private
FResult: TValue;
FError: TJSONRPCResponseError;
FID: TValue;
2017-09-24 19:40:40 +02:00
protected
2020-08-06 17:40:56 +02:00
function GetResult: TValue;
2019-01-08 12:48:27 +01:00
function GetJSON: TJDOJsonObject; override;
procedure SetJSON(const JSON: TJDOJsonObject); override;
procedure SetID(const Value: TValue);
procedure SetResult(const Value: TValue);
procedure SetError(const Value: TJSONRPCResponseError);
function GetError: TJSONRPCResponseError;
function GetID: TValue;
2019-01-08 12:48:27 +01:00
function ResultAsJSONObject: TJDOJsonObject;
function ResultAsJSONArray: TJDOJsonArray;
function IsError: Boolean;
property Result: TValue read GetResult write SetResult;
property Error: TJSONRPCResponseError read GetError write SetError;
property RequestID: TValue read GetID write SetID;
2017-09-24 19:40:40 +02:00
public
constructor Create; override;
2017-09-24 19:40:40 +02:00
destructor Destroy; override;
end;
2020-08-06 17:40:56 +02:00
TJSONRPCNullResponse = class(TJSONRPCObject, IJSONRPCResponse)
private
FError: TJSONRPCResponseError;
procedure RaiseErrorForNullObject;
protected
function ToString(const Compact: Boolean): string; override;
2020-08-06 17:40:56 +02:00
function GetJSONString: string; override;
procedure SetJsonString(const Value: string); override;
function GetJSON: TJDOJsonObject; override;
procedure SetJSON(const JSON: TJDOJsonObject); override;
procedure SetID(const Value: TValue);
procedure SetResult(const Value: TValue);
procedure SetError(const Value: TJSONRPCResponseError);
function GetError: TJSONRPCResponseError;
function GetID: TValue;
function GetResult: TValue;
function ResultAsJSONObject: TJDOJsonObject;
function ResultAsJSONArray: TJDOJsonArray;
function IsError: Boolean;
property Result: TValue read GetResult write SetResult;
property Error: TJSONRPCResponseError read GetError write SetError;
property RequestID: TValue read GetID write SetID;
end;
2017-09-24 19:40:40 +02:00
EMVCJSONRPCInvalidVersion = class(Exception)
end;
EMVCJSONRPCException = class(Exception)
end;
EMVCJSONRPCErrorResponse = class abstract(Exception)
protected
fJSONRPCErrorCode: Integer;
2017-09-24 19:40:40 +02:00
public
property JSONRPCErrorCode: Integer read fJSONRPCErrorCode;
2017-09-24 19:40:40 +02:00
end;
2020-03-25 22:27:29 +01:00
EMVCJSONRPCError = class(EMVCJSONRPCErrorResponse)
public
constructor Create(const ErrCode: Integer; const Msg: string);
2020-09-18 12:23:44 +02:00
constructor CreateFmt(const ErrCode: Integer; const Msg: string; const Args: array of const);
2020-03-25 22:27:29 +01:00
end;
EMVCJSONRPCParseError = class(EMVCJSONRPCErrorResponse)
2017-09-24 19:40:40 +02:00
public
constructor Create;
procedure AfterConstruction; override;
2017-09-24 19:40:40 +02:00
end;
EMVCJSONRPCInvalidRequest = class(EMVCJSONRPCErrorResponse)
2017-09-24 19:40:40 +02:00
public
2020-03-24 17:55:25 +01:00
constructor Create(const Message: string = ''); overload;
procedure AfterConstruction; override;
2017-09-24 19:40:40 +02:00
end;
EMVCJSONRPCMethodNotFound = class(EMVCJSONRPCErrorResponse)
2017-09-24 19:40:40 +02:00
public
constructor Create(const MethodName: string);
procedure AfterConstruction; override;
2017-09-24 19:40:40 +02:00
end;
EMVCJSONRPCInvalidParams = class(EMVCJSONRPCErrorResponse)
2017-09-24 19:40:40 +02:00
public
2019-01-08 12:48:27 +01:00
constructor Create(const Message: string);
procedure AfterConstruction; override;
2017-09-24 19:40:40 +02:00
end;
EMVCJSONRPCInternalError = class(EMVCJSONRPCErrorResponse)
2017-09-24 19:40:40 +02:00
public
constructor Create;
procedure AfterConstruction; override;
2017-09-24 19:40:40 +02:00
end;
{ -32000 to -32099 Server error Reserved for implementation-defined server-errors. }
EMVCJSONRPCServerError = class(EMVCJSONRPCErrorResponse)
2017-09-24 19:40:40 +02:00
public
2019-01-08 12:48:27 +01:00
constructor Create(const JSONRPCError: Integer; const Message: string);
2017-09-24 19:40:40 +02:00
end;
2019-01-08 12:48:27 +01:00
TMVCJSONObject = TJDOJsonObject;
2017-09-24 19:40:40 +02:00
TMVCJSONArray = TJDOJsonArray;
TMVCJSONRPCController = class(TMVCController)
private
fSerializer: TMVCJsonDataObjectsSerializer;
fRPCInstance: TObject;
fOwsRPCInstance: Boolean;
function GetSerializer: TMVCJsonDataObjectsSerializer;
function GetDeclaredMethod(lMethod: string; lRTTIType: TRttiType): TRTTIMethod;
function GetInheritedMethod(lMethod: string; lRTTIType: TRttiType): TRTTIMethod;
2017-09-24 19:40:40 +02:00
protected
function CreateError(const RequestID: TValue; const ErrorCode: Integer; const Message: string): TJDOJsonObject;
function CreateResponse(const RequestID: TValue; const Value: TValue): TJSONRPCResponse;
2019-01-08 12:48:27 +01:00
function CreateRequest(const JSON: TJDOJsonObject): IJSONRPCRequest;
function JSONObjectAs<T: class, constructor>(const JSON: TJDOJsonObject): T;
function CanBeRemotelyInvoked(const RTTIMethod: TRTTIMethod): Boolean;
2019-05-16 00:16:55 +02:00
procedure ForEachInvokableMethod(const aProc: TProc<TRTTIMethod>);
procedure TryToCallMethod(const aRTTIType: TRttiType; const MethodName: string; const Parameter: TJDOJsonObject);
function GetJSONRPCPayload(const Request: TMVCWebRequest): TJsonObject;
2017-09-24 19:40:40 +02:00
public
[MVCPath]
[MVCHTTPMethods([httpPOST, httpGET])]
2017-09-24 19:40:40 +02:00
[MVCConsumes(TMVCMediaType.APPLICATION_JSON)]
[MVCProduces(TMVCMediaType.APPLICATION_JSON)]
procedure Index; virtual;
[MVCPath('/describe')]
[MVCHTTPMethods([httpGET])]
procedure GetPublishedMethodList; virtual;
[MVCPath('/proxy')]
[MVCHTTPMethods([httpGET])]
procedure GetProxyCode; virtual;
constructor Create; overload; override;
destructor Destroy; override;
2017-09-24 19:40:40 +02:00
end;
TMVCJSONRPCPublisher = class(TMVCJSONRPCController)
public
constructor Create(const RPCInstance: TObject; const Owns: Boolean = True); reintroduce; overload;
end;
TJSONRPCProxyGenerator = class abstract
public
constructor Create; virtual;
2020-03-24 17:55:25 +01:00
procedure StartGeneration(const aClassName: string); virtual;
procedure EndGeneration; virtual;
2019-01-08 12:48:27 +01:00
procedure VisitMethod(const aRTTIMethod: TRTTIMethod); virtual; abstract;
2020-03-24 17:55:25 +01:00
function GetCode: string; virtual; abstract;
end;
TJSONRPCProxyGeneratorClass = class of TJSONRPCProxyGenerator;
procedure RegisterJSONRPCProxyGenerator(const aLanguage: string; const aClass: TJSONRPCProxyGeneratorClass);
2017-09-24 19:40:40 +02:00
implementation
uses
MVCFramework.Serializer.Intf,
MVCFramework.Logger,
System.TypInfo,
MVCFramework.Rtti.Utils,
MVCFramework.DuckTyping,
MVCFramework.Serializer.jsondataobjects.CustomTypes;
const
CALL_TYPE: array [mkProcedure .. mkFunction] of string = ('PROCEDURE', 'FUNCTION');
var
2020-03-24 17:55:25 +01:00
GProxyGeneratorsRegister: TDictionary<string, TJSONRPCProxyGeneratorClass>;
function IsReservedMethodName(const MethodName: string): Boolean;
var
lMethod: string;
begin
Result := False;
for lMethod in JSONRPC_HOOKS_METHOD_NAMES do
begin
if SameText(MethodName, lMethod) then
begin
Exit(True);
end;
end;
end;
2019-01-08 12:48:27 +01:00
procedure AppendTValueToJsonArray(const Value: TValue; const ParamType: TJSONRPCParamDataType;
const JSONArr: TJDOJsonArray);
var
lSer: TMVCJsonDataObjectsSerializer;
lJArr: TJDOJsonArray;
LJObj: TJDOJsonObject;
lOrdinalValue: Int64;
begin
case ParamType of
pdtInteger:
begin
JSONArr.Add(Value.AsInteger);
end;
pdtFloat:
begin
JSONArr.Add(Value.AsExtended);
end;
pdtDateTime:
begin
JSONArr.Add(DateTimeToISOTimeStamp(FloatToDateTime(Value.AsExtended)));
2019-01-08 12:48:27 +01:00
end;
pdtDate:
begin
JSONArr.Add(DateToISODate(FloatToDateTime(Value.AsExtended)));
2019-01-08 12:48:27 +01:00
end;
pdtTime:
begin
JSONArr.Add(TimeToISOTime(FloatToDateTime(Value.AsExtended)));
2019-01-08 12:48:27 +01:00
end;
pdtString:
begin
JSONArr.Add(Value.AsString);
end;
pdtLongInteger:
begin
JSONArr.Add(Value.AsInt64);
end;
pdtBoolean:
begin
if not Value.TryAsOrdinal(lOrdinalValue) then
begin
raise EMVCException.Create('Invalid ordinal parameter');
end;
JSONArr.Add(lOrdinalValue = 1);
end;
pdTJDOJsonObject:
begin
JSONArr.Add((Value.AsObject as TJDOJsonObject).Clone as TJDOJsonObject);
end;
pdtJSONArray:
begin
JSONArr.Add((Value.AsObject as TJDOJsonArray).Clone as TJDOJsonArray);
end;
pdtObject:
begin
if Value.AsObject is TDataSet then
begin
lSer := TMVCJsonDataObjectsSerializer.Create;
try
lJArr := TJDOJsonArray.Create;
JSONArr.Add(lJArr);
lSer.DataSetToJsonArray(TDataSet(Value.AsObject), lJArr, TMVCNameCase.ncLowerCase, []);
finally
lSer.Free;
end
end
else
begin
lSer := TMVCJsonDataObjectsSerializer.Create;
try
LJObj := lSer.SerializeObjectToJSON(Value.AsObject, TMVCSerializationType.stProperties, [], nil);
2019-01-08 12:48:27 +01:00
JSONArr.Add(LJObj);
finally
lSer.Free;
end;
end;
end;
else
raise EMVCException.Create('Invalid type');
end;
end;
procedure AppendTValueToJsonObject(const Value: TValue; const Name: string; const ParamType: TJSONRPCParamDataType;
const JSONObj: TJDOJsonObject);
2020-05-02 16:39:32 +02:00
var
lSer: TMVCJsonDataObjectsSerializer;
lOrdinalValue: Int64;
begin
case ParamType of
pdtInteger:
begin
JSONObj.I[name] := Value.AsInteger;
end;
pdtFloat:
begin
JSONObj.F[name] := Value.AsExtended;
end;
pdtDateTime:
begin
JSONObj.S[name] := DateTimeToISOTimeStamp(FloatToDateTime(Value.AsExtended));
end;
pdtDate:
begin
JSONObj.S[name] := DateToISODate(FloatToDateTime(Value.AsExtended));
end;
pdtTime:
begin
JSONObj.S[name] := TimeToISOTime(FloatToDateTime(Value.AsExtended));
end;
pdtString:
begin
JSONObj.S[name] := Value.AsString;
end;
pdtLongInteger:
begin
JSONObj.L[name] := Value.AsInt64;
end;
pdtBoolean:
begin
if not Value.TryAsOrdinal(lOrdinalValue) then
begin
raise EMVCException.Create('Invalid ordinal parameter');
end;
JSONObj.B[name] := lOrdinalValue = 1;
end;
pdTJDOJsonObject:
begin
JSONObj.O[name] := (Value.AsObject as TJDOJsonObject).Clone as TJDOJsonObject;
end;
pdtJSONArray:
begin
JSONObj.A[name] := (Value.AsObject as TJDOJsonArray).Clone as TJDOJsonArray;
end;
pdtObject:
begin
if Value.AsObject is TDataSet then
begin
lSer := TMVCJsonDataObjectsSerializer.Create;
try
lSer.DataSetToJsonArray(TDataSet(Value.AsObject), JSONObj.A[name], TMVCNameCase.ncLowerCase, []);
2020-05-02 16:39:32 +02:00
finally
lSer.Free;
end
end
else
begin
lSer := TMVCJsonDataObjectsSerializer.Create;
try
JSONObj.O[name] := lSer.SerializeObjectToJSON(Value.AsObject, TMVCSerializationType.stProperties, [], nil);
2020-05-02 16:39:32 +02:00
finally
lSer.Free;
end;
end;
end;
else
raise EMVCException.Create('Invalid type');
end;
end;
2019-01-08 12:48:27 +01:00
function JSONDataValueToTValue(const JSONDataValue: TJsonDataValueHelper): TValue; overload;
begin
case JSONDataValue.Typ of
jdtString:
begin
Result := JSONDataValue.Value;
end;
jdtFloat:
begin
Result := JSONDataValue.FloatValue;
end;
jdtBool:
begin
Result := JSONDataValue.BoolValue;
end;
jdtArray:
begin
2019-01-08 12:48:27 +01:00
Result := JSONDataValue.ArrayValue.Clone as TJDOJsonArray;
end;
jdtObject:
begin
2019-05-16 00:16:55 +02:00
if JSONDataValue.IsNull then
Result := nil
else
Result := JSONDataValue.ObjectValue.Clone as TJDOJsonObject;
end;
jdtInt:
begin
Result := JSONDataValue.IntValue;
end;
jdtLong:
begin
Result := JSONDataValue.LongValue;
end;
jdtULong:
begin
Result := JSONDataValue.ULongValue;
end;
else
raise EMVCJSONRPCException.CreateFmt('Invalid parameter type [%d]', [Ord(JSONDataValue.Typ)]);
end;
end;
2020-03-24 17:55:25 +01:00
function BuildDeclaration(const RTTIParameter: TRttiParameter): string;
2019-01-08 12:48:27 +01:00
begin
Result := RTTIParameter.Name + ': ' + RTTIParameter.ParamType.Name;
end;
procedure JSONDataValueToTValueParam(const JSONDataValue: TJsonDataValueHelper; const RTTIParameter: TRttiParameter;
const JSONRPCRequestParams: TJSONRPCRequestParams);
2019-01-08 12:48:27 +01:00
begin
case RTTIParameter.ParamType.TypeKind of
2019-03-19 12:06:13 +01:00
tkString, tkUString {$IF CompilerVersion > 28}, tkAnsiString {$ENDIF}:
2019-01-08 12:48:27 +01:00
begin
if JSONDataValue.Typ <> jdtString then
begin
raise EMVCJSONRPCInvalidParams.Create('Invalid param type for [' + BuildDeclaration(RTTIParameter) + ']');
2019-01-08 12:48:27 +01:00
end;
JSONRPCRequestParams.Add(JSONDataValue.Value);
end;
tkFloat:
begin
if SameText(RTTIParameter.ParamType.Name, 'TDate') then
begin
JSONRPCRequestParams.Add(ISODateToDate(JSONDataValue.Value), pdtDate);
end
else if SameText(RTTIParameter.ParamType.Name, 'TDateTime') then
2019-01-08 12:48:27 +01:00
begin
if JSONDataValue.Value.Contains('T') then
JSONRPCRequestParams.Add(JSONDataValue.UtcDateTimeValue, pdtDateTime)
else
JSONRPCRequestParams.Add(ISOTimeStampToDateTime(JSONDataValue.Value), pdtDateTime);
2019-01-08 12:48:27 +01:00
end
else if SameText(RTTIParameter.ParamType.Name, 'TTime') then
2019-01-08 12:48:27 +01:00
begin
JSONRPCRequestParams.Add(ISOTimeToTime(JSONDataValue.Value), pdtTime);
end
else
begin
// handle integer types passed where a float is expected
// FIX https://github.com/danieleteti/delphimvcframework/issues/270
case JSONDataValue.Typ of
jdtInt:
JSONRPCRequestParams.Add(JSONDataValue.IntValue, pdtFloat);
jdtLong:
JSONRPCRequestParams.Add(JSONDataValue.LongValue, pdtFloat);
jdtULong:
JSONRPCRequestParams.Add(JSONDataValue.ULongValue, pdtFloat);
else
begin
if JSONDataValue.Typ <> jdtFloat then
begin
raise EMVCJSONRPCInvalidRequest.Create(BuildDeclaration(RTTIParameter));
end;
JSONRPCRequestParams.Add(JSONDataValue.FloatValue, pdtFloat);
end;
2019-01-08 12:48:27 +01:00
end;
end
end;
tkEnumeration:
begin
if JSONDataValue.Typ <> jdtBool then
begin
raise EMVCJSONRPCInvalidRequest.Create(BuildDeclaration(RTTIParameter));
end;
JSONRPCRequestParams.Add(JSONDataValue.BoolValue, pdtBoolean);
end;
tkClass:
begin
if (SameText(RTTIParameter.ParamType.Name, TJDOJsonArray.ClassName)) then
begin
JSONRPCRequestParams.Add(JSONDataValue.ArrayValue.Clone, pdtJSONArray);
end
else if SameText(RTTIParameter.ParamType.Name, TJDOJsonObject.ClassName) then
2019-01-08 12:48:27 +01:00
begin
JSONRPCRequestParams.Add(JSONDataValue.ObjectValue.Clone as TJDOJsonObject, pdTJDOJsonObject);
2019-01-08 12:48:27 +01:00
end
else
begin
{ TODO -oDanieleT -cGeneral : Automatically inject the dseserialized version of arbitrary object? }
raise EMVCJSONRPCInvalidRequest.Create(BuildDeclaration(RTTIParameter));
end;
end;
tkInteger:
begin
if JSONDataValue.Typ <> jdtInt then
begin
raise EMVCJSONRPCInvalidRequest.Create(BuildDeclaration(RTTIParameter));
end;
JSONRPCRequestParams.Add(JSONDataValue.IntValue, pdtInteger);
end;
tkInt64:
begin
if JSONDataValue.Typ = jdtInt then
begin
JSONRPCRequestParams.Add(JSONDataValue.IntValue, pdtInteger);
end
else if JSONDataValue.Typ = jdtLong then
2019-01-08 12:48:27 +01:00
begin
JSONRPCRequestParams.Add(JSONDataValue.LongValue, pdtLongInteger);
2019-01-08 12:48:27 +01:00
end
else if JSONDataValue.Typ = jdtULong then
2019-01-08 12:48:27 +01:00
begin
JSONRPCRequestParams.Add(JSONDataValue.ULongValue, pdtLongInteger);
end
else
begin
raise EMVCJSONRPCInvalidRequest.Create(BuildDeclaration(RTTIParameter));
end;
end;
else
begin
raise EMVCJSONRPCInvalidRequest.CreateFmt('Invalid parameter type for [%s]', [BuildDeclaration(RTTIParameter)]);
end;
2019-01-08 12:48:27 +01:00
end;
end;
2017-09-24 19:40:40 +02:00
{ TMVCJSONRPCMessage }
2019-01-08 12:48:27 +01:00
function TMVCJSONRPCMessage.AsJSON: TJDOJsonObject;
2017-09-24 19:40:40 +02:00
begin
Result := TMVCJSONObject.Create;
Result.S[JSONRPC_HEADER] := JSONRPC_VERSION;
end;
function TMVCJSONRPCMessage.AsJSONRPCMessage: string;
begin
Result := fJSON.ToJSON();
end;
class procedure TMVCJSONRPCMessage.CheckID(const aJSON: TMVCJSONObject; out aIsNotification: Boolean);
2017-09-24 19:40:40 +02:00
begin
{
id
An identifier established by the Client that MUST contain a String, Number, or NULL value if included.
If it is not included it is assumed to be a notification.
The value SHOULD normally not be Null [1] and Numbers SHOULD NOT contain fractional parts [2]
}
aIsNotification := not aJSON.Contains(JSONRPC_ID);
if not aIsNotification then
begin
if not(aJSON.Types[JSONRPC_ID] in [jdtString, jdtInt, jdtLong, jdtULong, jdtNone]) then
raise EMVCJSONRPCException.Create('Message is not a notification but its ''id'' property is not valid');
2017-09-24 19:40:40 +02:00
end;
end;
class procedure TMVCJSONRPCMessage.CheckMethod(const aJSON: TMVCJSONObject);
2017-09-24 19:40:40 +02:00
begin
if (aJSON.Types[JSONRPC_METHOD] <> jdtString) then
raise EMVCJSONRPCException.Create('Invalid ''method''');
end;
class procedure TMVCJSONRPCMessage.CheckVersion(const aJSON: TMVCJSONObject);
2017-09-24 19:40:40 +02:00
begin
if not Assigned(aJSON) then
raise EMVCJSONRPCException.Create('JSON not assigned');
if aJSON.S[JSONRPC_HEADER] <> JSONRPC_VERSION then
raise EMVCJSONRPCInvalidVersion.Create(JSONRPC_HEADER + ' must be "2.0"');
end;
constructor TMVCJSONRPCMessage.Create;
2017-09-24 19:40:40 +02:00
begin
inherited Create;
end;
{ TMVCJSONRPCController }
2017-09-24 19:40:40 +02:00
constructor TMVCJSONRPCPublisher.Create(const RPCInstance: TObject; const Owns: Boolean);
begin
inherited Create;
fRPCInstance := RPCInstance;
fOwsRPCInstance := Owns;
end;
2019-01-08 12:48:27 +01:00
// procedure TMVCJSONRPCController.CheckInputParametersTypes(aRTTIMethod: TRTTIMethod);
// var
// lParam: TRttiParameter;
// begin
// for lParam in aRTTIMethod.GetParameters do
// begin
// if lParam.ParamType.TypeKind in [tkClass] then
// begin
// if not(SameText(lParam.ParamType.QualifiedName, 'JsonDataObjects.TJDOJsonObject') or
// SameText(lParam.ParamType.QualifiedClassName, 'JsonDataObjects.TJDOJsonArray')) then
// begin
// raise EMVCJSONRPCException.Create('Parameter [' + lParam.Name + ': ' + lParam.ParamType.QualifiedName +
// '] is not allowed as input parameter');
// end;
// end;
// end;
//
// end;
function TMVCJSONRPCController.CanBeRemotelyInvoked(const RTTIMethod: TRTTIMethod): Boolean;
begin
Result := (RTTIMethod.Visibility = mvPublic) and (RTTIMethod.MethodKind in [mkProcedure, mkFunction]);
Result := Result and not IsReservedMethodName(RTTIMethod.Name);
end;
constructor TMVCJSONRPCController.Create;
begin
inherited Create;
fRPCInstance := Self;
fOwsRPCInstance := False;
end;
function TMVCJSONRPCController.CreateError(const RequestID: TValue; const ErrorCode: Integer; const Message: string)
: TJDOJsonObject;
var
lErrResp: TJSONRPCResponse;
2017-09-24 19:40:40 +02:00
begin
lErrResp := TJSONRPCResponse.Create;
try
lErrResp.RequestID := RequestID;
lErrResp.Error := TJSONRPCResponseError.Create;
lErrResp.Error.Code := ErrorCode;
lErrResp.Error.ErrMessage := message;
Result := lErrResp.AsJSON;
finally
lErrResp.Free;
end;
2017-09-24 19:40:40 +02:00
end;
2019-01-08 12:48:27 +01:00
function TMVCJSONRPCController.CreateRequest(const JSON: TJDOJsonObject): IJSONRPCRequest;
var
lReqID: TValue;
2020-03-24 17:55:25 +01:00
lMethodName: string;
2017-09-24 19:40:40 +02:00
begin
2019-01-08 12:48:27 +01:00
if JSON.Types[JSONRPC_ID] = jdtString then
lReqID := JSON.S[JSONRPC_ID]
else if JSON.Types[JSONRPC_ID] = jdtInt then
2019-01-08 12:48:27 +01:00
lReqID := JSON.I[JSONRPC_ID]
else if JSON.Types[JSONRPC_ID] = jdtLong then
2019-01-08 12:48:27 +01:00
lReqID := JSON.L[JSONRPC_ID]
else if JSON.Types[JSONRPC_ID] = jdtULong then
2019-01-08 12:48:27 +01:00
lReqID := JSON.U[JSONRPC_ID]
else
lReqID := TValue.Empty;
2019-01-08 12:48:27 +01:00
lMethodName := JSON.S[JSONRPC_METHOD];
Result := TJSONRPCRequest.Create(lReqID, lMethodName);
{
if JSON.Types[JSONRPC_PARAMS] = jdtArray then
begin
2019-01-08 12:48:27 +01:00
lParams := JSON.A[JSONRPC_PARAMS];
for I := 0 to lParams.Count - 1 do
begin
Result.Params.Add(JSONDataValueToTValue(lParams[I]));
end;
end
else if JSON.Types[JSONRPC_PARAMS] <> jdtNone then
begin
2019-01-08 12:48:27 +01:00
raise EMVCJSONRPCException.Create('Params must be a JSON array or null');
end;
2019-01-08 12:48:27 +01:00
}
2017-09-24 19:40:40 +02:00
end;
function TMVCJSONRPCController.CreateResponse(const RequestID: TValue; const Value: TValue): TJSONRPCResponse;
2017-09-24 19:40:40 +02:00
begin
Result := TJSONRPCResponse.Create;
Result.RequestID := RequestID;
Result.Result := Value;
2017-09-24 19:40:40 +02:00
end;
destructor TMVCJSONRPCController.Destroy;
begin
if Assigned(fRPCInstance) and fOwsRPCInstance then
begin
fRPCInstance.Free;
end;
fSerializer.Free;
inherited;
end;
function TMVCJSONRPCController.GetDeclaredMethod(lMethod: string; lRTTIType: TRttiType): TRTTIMethod;
var
lRTTIDeclaredMethods: TArray<TRTTIMethod>;
I: Integer;
begin
Result := nil;
lRTTIDeclaredMethods := lRTTIType.GetDeclaredMethods;
for I := 0 to Length(lRTTIType.GetDeclaredMethods) - 1 do
begin
if SameText(lRTTIDeclaredMethods[I].Name, lMethod) then
begin
Result := lRTTIDeclaredMethods[I];
Break;
end;
end;
end;
function TMVCJSONRPCController.GetInheritedMethod(lMethod: string; lRTTIType: TRttiType): TRTTIMethod;
var
lRTTIMethod: TRTTIMethod;
begin
Result := nil;
lRTTIMethod := lRTTIType.GetMethod(lMethod);
if Assigned(lRTTIMethod) then
begin
if TMVCSerializerHelper.HasAttribute<MVCInheritableAttribute>(lRTTIMethod) then
begin
Result := lRTTIMethod;
end;
end;
end;
function TMVCJSONRPCController.GetJSONRPCPayload(const Request: TMVCWebRequest): TJsonObject;
var
lParams: string;
lJ: TJsonBaseObject;
begin
// https://www.simple-is-better.org/json-rpc/transport_http.html#get-request
// http get :8080/jsonrpc jsonrpc==2 method==subtract params=={\"Value1\":10,\"Value2\":3} id==1234
// http get :8080/jsonrpc jsonrpc==2 id==1234 method==subtract params==[10,3]
Result := TJsonObject.Create;
try
Result.S['jsonrpc'] := Request.QueryStringParam('jsonrpc');
Result.S['method'] := Request.QueryStringParam('method');
if Request.QueryStringParamExists('id') then
begin
Result.S['id'] := Request.QueryStringParam('id');
end;
lParams := Request.QueryStringParam('params');
lJ := TJsonObject.Parse(lParams);
if lJ is TJsonArray then
Result.A['params'] := TJsonArray(lJ)
else
Result.O['params'] := TJsonObject(lJ);
except
Result.Free;
raise
end;
end;
2019-05-16 00:16:55 +02:00
procedure TMVCJSONRPCController.ForEachInvokableMethod(const aProc: TProc<TRTTIMethod>);
var
lRTTI: TRTTIContext;
lRTTIType: TRttiType;
lRTTIMethodList: TArray<TRTTIMethod>;
lRTTIMethod: TRTTIMethod;
lGeneratedMethods: TList<String>;
function MethodSign(const RTTIMethod: TRTTIMethod): String;
begin
Result := RTTIMethod.ToString.ToLower;
end;
2019-05-16 00:16:55 +02:00
begin
lGeneratedMethods := TList<String>.Create;
2019-05-16 00:16:55 +02:00
try
lRTTI := TRTTIContext.Create;
try
lRTTIType := lRTTI.GetType(fRPCInstance.ClassType);
lRTTIMethodList := lRTTIType.GetDeclaredMethods;
for lRTTIMethod in lRTTIMethodList do
2019-05-16 00:16:55 +02:00
begin
if CanBeRemotelyInvoked(lRTTIMethod) then
begin
aProc(lRTTIMethod);
lGeneratedMethods.Add(MethodSign(lRTTIMethod));
end;
2019-05-16 00:16:55 +02:00
end;
lRTTIMethodList := lRTTIType.BaseType.GetMethods;
for lRTTIMethod in lRTTIMethodList do
2019-05-16 00:16:55 +02:00
begin
if TMVCSerializerHelper.HasAttribute<MVCInheritableAttribute>(lRTTIMethod) and CanBeRemotelyInvoked(lRTTIMethod)
and (not lGeneratedMethods.Contains(MethodSign(lRTTIMethod))) then
begin
aProc(lRTTIMethod);
end;
2019-05-16 00:16:55 +02:00
end;
finally
lRTTI.Free;
2019-05-16 00:16:55 +02:00
end;
finally
lGeneratedMethods.Free;
2019-05-16 00:16:55 +02:00
end;
end;
procedure TMVCJSONRPCController.GetProxyCode;
var
lLanguage: string;
lClass: TJSONRPCProxyGeneratorClass;
lGenerator: TJSONRPCProxyGenerator;
lRTTI: TRTTIContext;
2020-08-05 09:50:06 +02:00
lContentType: string;
begin
2019-05-16 00:16:55 +02:00
lLanguage := Context.Request.Params['language'].ToLower;
if lLanguage.IsEmpty then
begin
2019-05-16 00:16:55 +02:00
lLanguage := 'delphi';
end;
2020-08-05 09:50:06 +02:00
if Context.Request.QueryStringParamExists('content-type') then
begin
lContentType := Context.Request.Params['content-type'];
end
else
begin
lContentType := 'text/plain';
end;
if not Assigned(GProxyGeneratorsRegister) then
begin
raise EMVCJSONRPCException.Create
('No Proxy Generators have been registered. [HINT] Use RegisterJSONRPCProxyGenerator function');
end;
if not GProxyGeneratorsRegister.TryGetValue(lLanguage, lClass) then
begin
raise EMVCJSONRPCException.CreateFmt('Unknown language [%s]', [lLanguage]);
end;
lGenerator := lClass.Create;
try
lRTTI := TRTTIContext.Create;
try
2019-05-16 00:16:55 +02:00
lGenerator.StartGeneration(fRPCInstance.ClassType.ClassName);
ForEachInvokableMethod(
procedure(aRTTIMethod: TRTTIMethod)
begin
lGenerator.VisitMethod(aRTTIMethod);
end);
lGenerator.EndGeneration();
2020-08-05 09:50:06 +02:00
Context.Response.ContentType := lContentType;
Render(lGenerator.GetCode);
finally
lRTTI.Free;
end;
finally
lGenerator.Free;
end;
end;
procedure TMVCJSONRPCController.GetPublishedMethodList;
begin
ResponseStream.AppendLine('// ' + StringOfChar('*', 80));
ResponseStream.AppendLine('// Generated by ' + DMVCFRAMEWORK_VERSION + ' at ' +
FormatDateTime('yyyy-mm-dd hh:nn:ss', Now));
ResponseStream.AppendLine('// ' + StringOfChar('*', 80));
ResponseStream.AppendLine('');
2019-05-16 00:16:55 +02:00
ForEachInvokableMethod(
procedure(aRTTIMethod: TRTTIMethod)
var
lAtt: MVCDocAttribute;
lLines: TArray<String>;
lLine: String;
begin
if IsReservedMethodName(aRTTIMethod.Name) then
begin
Exit;
end;
lAtt := TRTTIUtils.GetAttribute<MVCDocAttribute>(aRTTIMethod);
if Assigned(lAtt) then
begin
lLines := lAtt.Value.Split([sLineBreak]);
for lLine in lLines do
begin
ResponseStream.AppendLine('// ' + lLine);
end;
end;
ResponseStream.AppendLine(aRTTIMethod.ToString + ';');
2019-05-16 00:16:55 +02:00
end);
RenderResponseStream;
end;
function TMVCJSONRPCController.GetSerializer: TMVCJsonDataObjectsSerializer;
begin
if not Assigned(fSerializer) then
fSerializer := TMVCJsonDataObjectsSerializer.Create;
Result := fSerializer;
end;
procedure TMVCJSONRPCController.Index;
2017-09-24 19:40:40 +02:00
var
2019-01-08 12:48:27 +01:00
lJSONRPCReq: IJSONRPCRequest;
2017-09-24 19:40:40 +02:00
lMethod: string;
lRTTI: TRTTIContext;
lRTTIType: TRttiType;
2019-01-08 12:48:27 +01:00
lRTTIMethod: TRTTIMethod;
2017-09-24 19:40:40 +02:00
lRes: TValue;
2019-01-08 12:48:27 +01:00
lJSONRPCResponse: IJSONRPCResponse;
2017-09-24 19:40:40 +02:00
lParamsToInject: TArray<TValue>;
lReqID: TValue;
2019-01-08 12:48:27 +01:00
lJSON: TJDOJsonObject;
2020-03-24 17:55:25 +01:00
lJSONResp: TJDOJsonObject;
2020-08-05 09:50:06 +02:00
lBeforeCallHookHasBeenInvoked: Boolean;
lAfterCallHookHasBeenInvoked: Boolean;
lTypeAttrs: TArray<TCustomAttribute>;
lHTTPVerb: TMVCHTTPMethodType;
lAllMethodsCallableWithGET: Boolean;
2017-09-24 19:40:40 +02:00
begin
2020-08-05 09:50:06 +02:00
lBeforeCallHookHasBeenInvoked := False;
lAfterCallHookHasBeenInvoked := False;
lAllMethodsCallableWithGET := False;
lRTTIType := nil;
lReqID := TValue.Empty;
2017-09-24 19:40:40 +02:00
SetLength(lParamsToInject, 0);
2020-03-24 17:55:25 +01:00
lRTTI := TRTTIContext.Create;
2017-09-24 19:40:40 +02:00
try
2020-03-24 17:55:25 +01:00
try
lHTTPVerb := Context.Request.HTTPMethod;
case lHTTPVerb of
httpGET:
begin
lJSON := GetJSONRPCPayload(Context.Request);
end;
httpPOST:
begin
lJSON := StrToJSONObject(Context.Request.Body);
end;
else
raise EMVCJSONRPCInvalidRequest.Create('Only POST and GET Allowed');
end;
try
2020-03-24 17:55:25 +01:00
if not Assigned(lJSON) then
2020-08-05 09:50:06 +02:00
begin
2020-03-24 17:55:25 +01:00
raise EMVCJSONRPCParseError.Create;
2020-08-05 09:50:06 +02:00
end;
lRTTIType := lRTTI.GetType(fRPCInstance.ClassType);
if lHTTPVerb = httpGET then
begin
lTypeAttrs := lRTTIType.GetAttributes;
lAllMethodsCallableWithGET := (Length(lTypeAttrs) > 0) and
TMVCSerializerHelper.AttributeExists<MVCJSONRPCAllowGET>(lTypeAttrs);
end;
2020-03-24 17:55:25 +01:00
lJSONRPCReq := CreateRequest(lJSON);
lMethod := lJSONRPCReq.Method;
2020-08-05 09:50:06 +02:00
if IsReservedMethodName(lMethod) then
2020-03-24 17:55:25 +01:00
begin
2020-08-05 09:50:06 +02:00
raise EMVCJSONRPCInvalidRequest.CreateFmt
('Requested method name [%s] is reserved and cannot be called remotely', [lMethod]);
2020-03-24 17:55:25 +01:00
end;
2020-08-05 09:50:06 +02:00
TryToCallMethod(lRTTIType, JSONRPC_HOOKS_ON_BEFORE_ROUTING, lJSON);
2020-03-24 17:55:25 +01:00
if lJSONRPCReq.RequestType = TJSONRPCRequestType.Request then
begin
if lJSONRPCReq.RequestID.IsEmpty then
raise EMVCJSONRPCInvalidRequest.Create;
lReqID := lJSONRPCReq.RequestID;
end;
lRTTIMethod := GetDeclaredMethod(lMethod, lRTTIType);
if not Assigned(lRTTIMethod) then
begin
lRTTIMethod := GetInheritedMethod(lMethod, lRTTIType);
end;
if Assigned(lRTTIMethod) then
2017-09-24 19:40:40 +02:00
begin
if (lJSONRPCReq.RequestType = TJSONRPCRequestType.Request) and (lRTTIMethod.MethodKind <> mkFunction) then
begin
raise EMVCJSONRPCInvalidParams.Create
('Cannot call a procedure using a JSON-RPC request. [HINT] Use requests for functions and notifications for procedures');
end;
if (lJSONRPCReq.RequestType = TJSONRPCRequestType.Notification) and (lRTTIMethod.MethodKind <> mkProcedure)
then
begin
raise EMVCJSONRPCInvalidParams.Create
('Cannot call a function using a JSON-RPC notification. [HINT] Use requests for functions and notifications for procedures');
end;
2020-08-05 09:50:06 +02:00
if not CanBeRemotelyInvoked(lRTTIMethod) then
begin
LogW(Format('Method [%s] cannot remotely invoked. Only public functions or procedures can be called.',
2020-08-05 09:50:06 +02:00
[lMethod]));
raise EMVCJSONRPCMethodNotFound.Create(lMethod);
end;
if (lHTTPVerb = httpGET) and (not lAllMethodsCallableWithGET) then
begin
lTypeAttrs := lRTTIMethod.GetAttributes;
if (Length(lTypeAttrs) = 0) or (not TMVCSerializerHelper.AttributeExists<MVCJSONRPCAllowGET>(lTypeAttrs))
then
begin
raise EMVCJSONRPCError.Create(JSONRPC_ERR_INVALID_REQUEST, 'Method callable with POST only');
end;
end;
2020-05-02 16:39:32 +02:00
try
lJSONRPCReq.FillParameters(lJSON, lRTTIMethod);
except
on Ex: EMVCJSONRPCErrorResponse do
begin
raise EMVCJSONRPCInvalidParams.Create('Cannot map all parameters to remote method. ' + Ex.Message);
2020-05-02 16:39:32 +02:00
end;
end;
2020-08-05 09:50:06 +02:00
lJSONResp := nil;
// try
TryToCallMethod(lRTTIType, JSONRPC_HOOKS_ON_BEFORE_CALL, lJSON);
lBeforeCallHookHasBeenInvoked := True;
try
2020-08-05 09:50:06 +02:00
LogD('[JSON-RPC][CALL][' + CALL_TYPE[lRTTIMethod.MethodKind] + '][' + fRPCInstance.ClassName + '.' +
lRTTIMethod.Name + ']');
lRes := lRTTIMethod.Invoke(fRPCInstance, lJSONRPCReq.Params.ToArray);
except
on E: EInvalidCast do
begin
raise EMVCJSONRPCInvalidParams.Create('Check your input parameters types');
end;
2020-05-02 16:39:32 +02:00
on Ex: EMVCJSONRPCInvalidRequest do
begin
raise EMVCJSONRPCInvalidParams.Create(Ex.Message);
end;
end;
case lJSONRPCReq.RequestType of
TJSONRPCRequestType.Notification:
begin
ResponseStatus(HTTP_STATUS.NoContent);
end;
TJSONRPCRequestType.Request:
begin
lJSONRPCResponse := CreateResponse(lJSONRPCReq.RequestID, lRes);
2019-01-08 12:48:27 +01:00
ResponseStatus(200);
2020-03-24 17:55:25 +01:00
lJSONResp := lJSONRPCResponse.AsJSON;
end;
else
raise EMVCJSONRPCException.Create('Invalid RequestType');
2017-09-24 19:40:40 +02:00
end;
2020-08-05 09:50:06 +02:00
// finally
// if lBeforeCallHookHasBeenInvoked then
// begin
// TryToCallMethod(lRTTIType, JSONRPC_HOOKS_ON_AFTER_CALL, lJSONResp);
// lAfterCallHookHasBeenInvoked := True;
// end;
// if lJSONResp <> nil then
// begin
// try
// Render(lJSONResp);
// except
// try
// lJSONResp.Free;
// except
// // do nothing
// end;
// end;
// end;
// end;
end
else
begin
LogW(Format('Method "%s" has not be found in %s. Only public methods can be invoked.',
[lMethod, fRPCInstance.QualifiedClassName]));
raise EMVCJSONRPCMethodNotFound.Create(lMethod);
end;
finally
2020-08-05 09:50:06 +02:00
FreeAndNil(lJSON);
end;
2020-03-24 17:55:25 +01:00
except
on E: EMVCJSONRPCErrorResponse do
begin
{
http://www.jsonrpc.org/historical/json-rpc-over-http.html#response-codes
HTTP Status code message
500 -32700 Parse error.
400 -32600 Invalid Request.
404 -32601 Method not found.
500 -32602 Invalid params.
500 -32603 Internal error.
500 -32099..-32000 Server error.
}
case E.JSONRPCErrorCode of
JSONRPC_ERR_PARSE_ERROR:
ResponseStatus(500);
JSONRPC_ERR_INVALID_REQUEST:
ResponseStatus(400);
JSONRPC_ERR_METHOD_NOT_FOUND:
ResponseStatus(404);
JSONRPC_ERR_INVALID_PARAMS:
ResponseStatus(500);
JSONRPC_ERR_INTERNAL_ERROR:
ResponseStatus(500);
JSONRPC_ERR_SERVER_ERROR_LOWERBOUND .. JSONRPC_ERR_SERVER_ERROR_UPPERBOUND:
ResponseStatus(500);
end;
2020-08-05 09:50:06 +02:00
lJSONResp := CreateError(lReqID, E.JSONRPCErrorCode, E.Message);
LogE(Format('[JSON-RPC][CLS %s][ERR %d][MSG "%s"]', [E.ClassName, E.JSONRPCErrorCode, E.Message]));
2020-03-24 17:55:25 +01:00
end;
on Ex: Exception do // use another name for exception variable, otherwise E is nil!!
begin
2020-08-05 09:50:06 +02:00
lJSONResp := CreateError(lReqID, 0, Ex.Message);
2020-03-24 17:55:25 +01:00
LogE(Format('[JSON-RPC][CLS %s][MSG "%s"]', [Ex.ClassName, Ex.Message]));
2017-09-24 19:40:40 +02:00
end;
2020-08-05 09:50:06 +02:00
end; // except
if lBeforeCallHookHasBeenInvoked and (not lAfterCallHookHasBeenInvoked) then
begin
try
TryToCallMethod(lRTTIType, JSONRPC_HOOKS_ON_AFTER_CALL, lJSONResp);
except
on E: Exception do
begin
FreeAndNil(lJSONResp);
if E is EMVCJSONRPCErrorResponse then
lJSONResp := CreateError(lReqID, EMVCJSONRPCErrorResponse(E).JSONRPCErrorCode, E.Message)
else
lJSONResp := CreateError(lReqID, 0, E.Message);
end;
end;
end;
2020-08-05 09:50:06 +02:00
Render(lJSONResp, True);
2020-03-24 17:55:25 +01:00
finally
lRTTI.Free;
2017-09-24 19:40:40 +02:00
end;
end;
2019-01-08 12:48:27 +01:00
function TMVCJSONRPCController.JSONObjectAs<T>(const JSON: TJDOJsonObject): T;
begin
Result := T.Create;
try
GetSerializer.JsonObjectToObject(JSON, Result, TMVCSerializationType.stProperties, []);
except
Result.Free;
raise;
end;
end;
procedure TMVCJSONRPCController.TryToCallMethod(const aRTTIType: TRttiType; const MethodName: string;
const Parameter: TJDOJsonObject);
2020-03-24 17:55:25 +01:00
var
lHookMethod: TRTTIMethod;
2020-08-05 09:50:06 +02:00
lHookSecondParam: TRttiParameter;
lHookSecondParamType: string;
lHookFirstParam: TRttiParameter;
lHookFirstParamType: string;
2020-03-24 17:55:25 +01:00
begin
if not Assigned(aRTTIType) then
begin
Exit;
end;
2020-03-24 17:55:25 +01:00
lHookMethod := aRTTIType.GetMethod(MethodName);
if Assigned(lHookMethod) then
begin
2020-08-05 09:50:06 +02:00
if (Length(lHookMethod.GetParameters) <> 2) then
begin
raise EMVCJSONRPCException.CreateFmt('Invalid signature for [%s] Hook method [HINT: procedure ' +
'%s.%s(const Context: TWebContext; const Value: TJDOJsonObject)',
2020-08-05 09:50:06 +02:00
[MethodName, fRPCInstance.ClassName, MethodName]);
end;
lHookFirstParam := lHookMethod.GetParameters[0];
lHookSecondParam := lHookMethod.GetParameters[1];
lHookFirstParamType := lHookFirstParam.ParamType.ToString.ToLower;
lHookSecondParamType := lHookSecondParam.ParamType.ToString.ToLower;
if (lHookMethod.MethodKind <> mkProcedure) then
raise EMVCJSONRPCException.CreateFmt
('Invalid signature for [%s] Hook method [HINT: Hook methods MUST have the following signature "procedure ' +
'%s.%s(const Context: TWebContext; const Value: TJDOJsonObject)"',
2020-08-05 09:50:06 +02:00
[MethodName, fRPCInstance.ClassName, MethodName]);
if ((lHookSecondParamType <> 'tjdojsonobject') and (lHookSecondParamType <> 'tjsonobject')) or
(lHookSecondParam.Flags * [pfConst, pfAddress] <> [pfConst, pfAddress]) then
raise EMVCJSONRPCException.CreateFmt('Invalid signature for [%s] Hook method [HINT: procedure ' +
'%s.%s(const Context: TWebContext; const Value: TJDOJsonObject)',
2020-08-05 09:50:06 +02:00
[MethodName, fRPCInstance.ClassName, MethodName]);
if (lHookFirstParamType <> 'twebcontext') or (lHookFirstParam.Flags * [pfConst, pfAddress] <> [pfConst, pfAddress])
then
raise EMVCJSONRPCException.CreateFmt('Invalid signature for [%s] Hook method [HINT: procedure ' +
'%s.%s(const Context: TWebContext; const Value: TJDOJsonObject)',
2020-08-05 09:50:06 +02:00
[MethodName, fRPCInstance.ClassName, MethodName]);
LogD('[JSON-RPC][HOOK][' + fRPCInstance.ClassName + '.' + MethodName + ']');
lHookMethod.Invoke(fRPCInstance, [Self.Context, Parameter])
2020-03-24 17:55:25 +01:00
end;
end;
2017-09-24 19:40:40 +02:00
{ EMVCJSONRPCParseError }
procedure EMVCJSONRPCParseError.AfterConstruction;
begin
inherited;
fJSONRPCErrorCode := JSONRPC_ERR_PARSE_ERROR;
end;
2017-09-24 19:40:40 +02:00
constructor EMVCJSONRPCParseError.Create;
begin
inherited Create
('Parse error. Invalid JSON was received by the server. An error occurred on the server while parsing the JSON text');
2017-09-24 19:40:40 +02:00
end;
{ EMVCJSONRPCInvalidRequest }
procedure EMVCJSONRPCInvalidRequest.AfterConstruction;
begin
inherited;
fJSONRPCErrorCode := JSONRPC_ERR_INVALID_REQUEST;
end;
2020-03-24 17:55:25 +01:00
constructor EMVCJSONRPCInvalidRequest.Create(const Message: string);
2019-01-08 12:48:27 +01:00
var
lMsg: string;
2017-09-24 19:40:40 +02:00
begin
2019-01-08 12:48:27 +01:00
lMsg := 'Invalid Request. The JSON sent is not a valid Request object.';
2020-03-24 17:55:25 +01:00
if not message.IsEmpty then
2019-01-08 12:48:27 +01:00
begin
2020-03-24 17:55:25 +01:00
lMsg := lMsg + ' [HINT] ' + message;
2019-01-08 12:48:27 +01:00
end;
inherited Create(lMsg);
2017-09-24 19:40:40 +02:00
end;
{ EMVCJSONRPCMethodNotFound }
procedure EMVCJSONRPCMethodNotFound.AfterConstruction;
begin
inherited;
fJSONRPCErrorCode := JSONRPC_ERR_METHOD_NOT_FOUND;
end;
constructor EMVCJSONRPCMethodNotFound.Create(const MethodName: string);
2017-09-24 19:40:40 +02:00
begin
inherited CreateFmt('Method [%s] not found. The method does not exist or is not available.', [MethodName]);
2017-09-24 19:40:40 +02:00
end;
{ EMVCJSONRPCInvalidParams }
procedure EMVCJSONRPCInvalidParams.AfterConstruction;
begin
inherited;
fJSONRPCErrorCode := JSONRPC_ERR_INVALID_PARAMS;
end;
2019-01-08 12:48:27 +01:00
constructor EMVCJSONRPCInvalidParams.Create(const Message: string);
2017-09-24 19:40:40 +02:00
begin
inherited Create('Invalid params. [hint: ' + message + ']');
end;
{ EMVCJSONRPCInternalError }
procedure EMVCJSONRPCInternalError.AfterConstruction;
begin
inherited;
fJSONRPCErrorCode := JSONRPC_ERR_INTERNAL_ERROR;
end;
2017-09-24 19:40:40 +02:00
constructor EMVCJSONRPCInternalError.Create;
begin
inherited Create('Internal JSON-RPC error');
end;
{ EMVCJSONRPCServerError }
constructor EMVCJSONRPCServerError.Create(const JSONRPCError: Integer; const Message: string);
2017-09-24 19:40:40 +02:00
begin
inherited Create(message);
fJSONRPCErrorCode := JSONRPCError;
2017-09-24 19:40:40 +02:00
end;
{ TJSONRPCRequest }
constructor TJSONRPCRequest.Create(const aID: TValue; const aMethod: string);
begin
inherited Create(aMethod);
SetID(aID);
end;
constructor TJSONRPCRequest.Create(const aID: TValue);
begin
inherited Create;
SetID(aID);
end;
constructor TJSONRPCRequest.Create;
begin
inherited Create;
2020-08-05 09:50:06 +02:00
Self.FID := TValue.Empty;
end;
destructor TJSONRPCRequest.Destroy;
begin
inherited;
end;
function TJSONRPCRequest.GetRequestType: TJSONRPCRequestType;
begin
if FID.IsEmpty then
Result := TJSONRPCRequestType.Notification
else
Result := TJSONRPCRequestType.Request;
end;
procedure TJSONRPCRequest.SetJSON(const JSON: TJDOJsonObject);
begin
if JSON.Types[JSONRPC_ID] = jdtString then
RequestID := JSON.S[JSONRPC_ID]
else if JSON.Types[JSONRPC_ID] = jdtInt then
RequestID := JSON.I[JSONRPC_ID]
else if JSON.Types[JSONRPC_ID] = jdtLong then
RequestID := JSON.L[JSONRPC_ID]
else if JSON.Types[JSONRPC_ID] = jdtULong then
RequestID := JSON.U[JSONRPC_ID]
else
RequestID := TValue.Empty;
Method := JSON.S[JSONRPC_METHOD];
Params.Clear;
end;
constructor TJSONRPCNotification.Create(const aMethod: string);
begin
Create;
Method := aMethod;
end;
destructor TJSONRPCNotification.Destroy;
2019-01-08 12:48:27 +01:00
begin
FParams.Free;
inherited;
end;
procedure TJSONRPCNotification.FillParameters(const JSON: TJDOJsonObject; const RTTIMethod: TRTTIMethod);
var
2019-01-08 12:48:27 +01:00
lRTTIMethodParams: TArray<TRttiParameter>;
lRTTIMethodParam: TRttiParameter;
lJSONParams: TJDOJsonArray;
2020-05-02 16:39:32 +02:00
lJSONNamedParams: TJDOJsonObject;
2019-01-08 12:48:27 +01:00
I: Integer;
2020-05-02 16:39:32 +02:00
lUseNamedParams: Boolean;
function GetJsonDataValueHelper(const JSONNamedParams: TJsonObject; const JsonPropName: string): TJsonDataValueHelper;
var
I: Integer;
lName: string;
begin
for I := 0 to JSONNamedParams.Count - 1 do
begin
lName := JSONNamedParams.Names[I];
if SameText(lName, JsonPropName) then
begin
Exit(JSONNamedParams.Values[lName]);
end;
end;
raise EJsonException.CreateFmt('Cannot find parameter [%s] in params object', [JsonPropName]);
end;
begin
2020-05-02 16:39:32 +02:00
lUseNamedParams := False;
2019-01-08 12:48:27 +01:00
lJSONParams := nil;
2020-05-02 16:39:32 +02:00
lJSONNamedParams := nil;
2019-01-08 12:48:27 +01:00
Params.Clear;
if JSON.Types[JSONRPC_PARAMS] = jdtArray then
begin
2019-01-08 12:48:27 +01:00
lJSONParams := JSON.A[JSONRPC_PARAMS];
2020-05-02 16:39:32 +02:00
lUseNamedParams := False;
end
else if JSON.Types[JSONRPC_PARAMS] = jdtObject then
begin
lJSONNamedParams := JSON.O[JSONRPC_PARAMS];
lUseNamedParams := True;
2019-01-08 12:48:27 +01:00
end
else if JSON.Types[JSONRPC_PARAMS] <> jdtNone then
2019-01-08 12:48:27 +01:00
begin
raise EMVCJSONRPCException.Create('Params must be a JSON array or null');
end;
lRTTIMethodParams := RTTIMethod.GetParameters;
2020-05-02 16:39:32 +02:00
if lUseNamedParams then
begin
if (Length(lRTTIMethodParams) > 0) and (not Assigned(lJSONNamedParams)) then
raise EMVCJSONRPCInvalidParams.CreateFmt('Wrong parameters count. Expected [%d] got [%d].',
2020-05-02 16:39:32 +02:00
[Length(lRTTIMethodParams), 0]);
if Assigned(lJSONNamedParams) and (Length(lRTTIMethodParams) <> lJSONNamedParams.Count) then
raise EMVCJSONRPCInvalidParams.CreateFmt('Wrong parameters count. Expected [%d] got [%d].',
2020-05-02 16:39:32 +02:00
[Length(lRTTIMethodParams), lJSONNamedParams.Count]);
end
else
begin
if (Length(lRTTIMethodParams) > 0) and (not Assigned(lJSONParams)) then
raise EMVCJSONRPCInvalidParams.CreateFmt('Wrong parameters count. Expected [%d] got [%d].',
2020-05-02 16:39:32 +02:00
[Length(lRTTIMethodParams), 0]);
if Assigned(lJSONParams) and (Length(lRTTIMethodParams) <> lJSONParams.Count) then
raise EMVCJSONRPCInvalidParams.CreateFmt('Wrong parameters count. Expected [%d] got [%d].',
2020-05-02 16:39:32 +02:00
[Length(lRTTIMethodParams), lJSONParams.Count]);
end;
2019-01-08 12:48:27 +01:00
for lRTTIMethodParam in lRTTIMethodParams do
begin
if lRTTIMethodParam.Flags * [pfVar, pfOut, pfArray, pfReference] <> [] then
raise EMVCJSONRPCInvalidParams.CreateFmt
('Parameter modifier not supported for formal parameter [%s]. Only const and value modifiers are allowed.',
[lRTTIMethodParam.Name]);
end;
// scroll json params and rttimethod params and find the best match
if Assigned(lJSONParams) then
begin
2020-05-02 16:39:32 +02:00
// positional params
2019-01-08 12:48:27 +01:00
for I := 0 to lJSONParams.Count - 1 do
begin
JSONDataValueToTValueParam(lJSONParams[I], lRTTIMethodParams[I], Params);
end;
2020-05-02 16:39:32 +02:00
end
else if Assigned(lJSONNamedParams) then
begin
// named params
for I := 0 to lJSONNamedParams.Count - 1 do
begin
JSONDataValueToTValueParam(GetJsonDataValueHelper(lJSONNamedParams, lRTTIMethodParams[I].Name.ToLower),
{ lJSONNamedParams.Values[lRTTIMethodParams[I].Name.ToLower], }
lRTTIMethodParams[I], Params);
2020-05-02 16:39:32 +02:00
end;
end;
end;
2019-01-08 12:48:27 +01:00
function TJSONRPCNotification.GetJSON: TJDOJsonObject;
var
I: Integer;
begin
if FMethod.IsEmpty then
raise EMVCJSONRPCException.Create('JSON-RPC "Method" cannot be empty');
Result := inherited;
Result.S[JSONRPC_METHOD] := FMethod;
if FParams.Count > 0 then
begin
2020-05-02 16:39:32 +02:00
if FParams.fParamNames.Count = 0 then
begin // positional params
for I := 0 to FParams.Count - 1 do
begin
AppendTValueToJsonArray(FParams.fParamValues[I], FParams.fParamTypes[I], Result.A[JSONRPC_PARAMS]);
2020-05-02 16:39:32 +02:00
end;
end
else
begin // named params
for I := 0 to FParams.Count - 1 do
begin
AppendTValueToJsonObject(FParams.fParamValues[I], FParams.fParamNames[I], FParams.fParamTypes[I],
Result.O[JSONRPC_PARAMS]);
2020-05-02 16:39:32 +02:00
end;
end;
end;
end;
function TJSONRPCNotification.GetMethod: string;
begin
Result := FMethod;
end;
function TJSONRPCNotification.GetParams: TJSONRPCRequestParams;
begin
Result := FParams;
end;
procedure TJSONRPCNotification.SetMethod(const Value: string);
begin
FMethod := Value;
end;
{ TJSONRCPResponse }
constructor TJSONRPCResponse.Create;
begin
inherited;
FError := nil;
end;
destructor TJSONRPCResponse.Destroy;
begin
FreeAndNil(FError);
if FResult.IsObject then
FResult.AsObject.Free;
inherited;
end;
function TJSONRPCResponse.GetError: TJSONRPCResponseError;
begin
Result := FError;
end;
function TJSONRPCResponse.GetID: TValue;
begin
Result := FID;
end;
2019-01-08 12:48:27 +01:00
function TJSONRPCResponse.GetJSON: TJDOJsonObject;
var
lSer: TMVCJsonDataObjectsSerializer;
begin
Result := inherited;
// Must generate something like the following:
// {"jsonrpc": "2.0", "error": {"code": -32601, "message": "Method not found"}, "id": "1"}
if FID.IsEmpty then
begin
Result.Values[JSONRPC_ID] := jdtNone;
end
else if FID.IsType<string> then
begin
Result.S[JSONRPC_ID] := FID.AsString;
end
else if FID.IsType<Int32> then
begin
Result.I[JSONRPC_ID] := FID.AsInteger;
end
else if FID.IsType<Int64> then
begin
Result.I[JSONRPC_ID] := FID.AsInt64;
end
else
raise EMVCJSONRPCException.Create('ID can be only Int32, Int64 or String');
try
if Assigned(FError) then
begin
Result.O[JSONRPC_ERROR].I[JSONRPC_CODE] := FError.Code;
Result.O[JSONRPC_ERROR].S[JSONRPC_MESSAGE] := FError.ErrMessage;
end
else
begin
lSer := TMVCJsonDataObjectsSerializer.Create;
try
lSer.TValueToJsonObjectProperty(Result, JSONRPC_RESULT, FResult, TMVCSerializationType.stDefault, [], nil);
finally
lSer.Free;
end;
end;
except
Result.Free;
raise;
end;
end;
function TJSONRPCResponse.GetResult: TValue;
begin
Result := FResult;
end;
function TJSONRPCResponse.IsError: Boolean;
begin
Result := Assigned(FError);
end;
2019-01-08 12:48:27 +01:00
function TJSONRPCResponse.ResultAsJSONArray: TJDOJsonArray;
begin
2019-01-08 12:48:27 +01:00
Result := Self.Result.AsObject as TJDOJsonArray;
end;
2019-01-08 12:48:27 +01:00
function TJSONRPCResponse.ResultAsJSONObject: TJDOJsonObject;
begin
2019-05-16 00:16:55 +02:00
// self.AsJSON
if Self.Result.IsEmpty then
Result := nil
else
Result := Self.Result.AsObject as TJDOJsonObject;
end;
procedure TJSONRPCResponse.SetError(const Value: TJSONRPCResponseError);
begin
FError := Value;
end;
procedure TJSONRPCResponse.SetID(const Value: TValue);
begin
FID := Value;
end;
2020-05-02 16:39:32 +02:00
procedure TJSONRPCResponse.SetJSON(const JSON: TJDOJsonObject);
begin
if JSON.Types[JSONRPC_ID] = jdtString then
RequestID := JSON.S[JSONRPC_ID]
else if JSON.Types[JSONRPC_ID] = jdtInt then
RequestID := JSON.I[JSONRPC_ID]
else if JSON.Types[JSONRPC_ID] = jdtLong then
RequestID := JSON.L[JSONRPC_ID]
else if JSON.Types[JSONRPC_ID] = jdtULong then
RequestID := JSON.U[JSONRPC_ID]
else
RequestID := TValue.Empty;
if JSON.Contains(JSONRPC_RESULT) then
begin
FreeAndNil(FError);
FResult := JSONDataValueToTValue(JSON.Values[JSONRPC_RESULT]);
end
else
begin
FResult := TValue.Empty;
if JSON.Contains(JSONRPC_ERROR) then
begin
FError := TJSONRPCResponseError.Create;
FError.Code := JSON.O[JSONRPC_ERROR].I[JSONRPC_CODE];
FError.ErrMessage := JSON.O[JSONRPC_ERROR].S[JSONRPC_MESSAGE];
end
else
begin
raise EMVCJSONRPCException.Create('Response message must have ''result'' or ''error''.' + sLineBreak +
'Raw message is: ' + sLineBreak + JSON.ToJSON());
end;
end;
end;
procedure TJSONRPCResponse.SetResult(const Value: TValue);
begin
FResult := Value;
end;
{ TJSONRPCNotification }
constructor TJSONRPCNotification.Create;
begin
inherited;
FParams := TJSONRPCRequestParams.Create;
end;
constructor TJSONRPCObject.Create;
begin
inherited;
end;
2019-01-08 12:48:27 +01:00
function TJSONRPCObject.GetJSON: TJDOJsonObject;
begin
2019-01-08 12:48:27 +01:00
Result := TJDOJsonObject.Create;
Result.S[JSONRPC_HEADER] := JSONRPC_VERSION;
end;
function TJSONRPCObject.GetJSONString: string;
begin
2019-05-16 00:16:55 +02:00
Result := ToString(True);
end;
procedure TJSONRPCRequest.SetID(const Value: TValue);
begin
FID := Value;
end;
procedure TJSONRPCObject.SetJSON(const Value: TJDOJsonObject);
begin
// not implemented
raise Exception.Create('This method must be overwritten by child');
end;
procedure TJSONRPCObject.SetJsonString(const Value: string);
var
2019-01-08 12:48:27 +01:00
lJSON: TJDOJsonObject;
begin
try
2019-01-08 12:48:27 +01:00
lJSON := TJDOJsonObject.Parse(Value) as TJDOJsonObject;
except
raise EMVCJSONRPCParseError.Create;
end;
try
AsJSON := lJSON;
finally
lJSON.Free;
end;
end;
function TJSONRPCObject.ToString(const Compact: Boolean): string;
2019-05-16 00:16:55 +02:00
var
lJSON: TJDOJsonObject;
begin
lJSON := GetJSON;
try
Result := lJSON.ToJSON(Compact);
finally
lJSON.Free;
end;
end;
{ TJSONRPCResponseError }
procedure TJSONRPCResponseError.SetCode(const Value: Integer);
begin
FCode := Value;
end;
procedure TJSONRPCResponseError.SetMessage(const Value: string);
begin
FMessage := Value;
end;
{ TJSONRPCMessage }
function TJSONRPCRequest.GetID: TValue;
begin
Result := FID;
end;
2019-01-08 12:48:27 +01:00
function TJSONRPCRequest.GetJSON: TJDOJsonObject;
begin
Result := inherited GetJSON;
2020-08-06 17:40:56 +02:00
try
if not FID.IsEmpty then
begin
2020-08-06 17:40:56 +02:00
if FID.IsType<string> then
begin
Result.S[JSONRPC_ID] := FID.AsString;
end
else if FID.IsType<Int32> then
begin
Result.I[JSONRPC_ID] := FID.AsInteger;
end
else if FID.IsType<Int64> then
begin
Result.I[JSONRPC_ID] := FID.AsInt64;
end
else
raise EMVCJSONRPCException.Create('ID can be only Int32, Int64 or String');
end
else
2020-08-06 17:40:56 +02:00
begin
raise EMVCJSONRPCException.Create('ID cannot be empty in a JSON-RPC request');
end;
except
Result.Free;
raise;
end;
end;
{ TJSONRPCProxyGenerator }
constructor TJSONRPCProxyGenerator.Create;
begin
inherited;
end;
procedure RegisterJSONRPCProxyGenerator(const aLanguage: string; const aClass: TJSONRPCProxyGeneratorClass);
begin
if not Assigned(GProxyGeneratorsRegister) then
begin
2020-03-24 17:55:25 +01:00
GProxyGeneratorsRegister := TDictionary<string, TJSONRPCProxyGeneratorClass>.Create();
end;
GProxyGeneratorsRegister.AddOrSetValue(aLanguage.ToLower, aClass);
end;
procedure TJSONRPCProxyGenerator.EndGeneration;
begin
// do nothing
end;
2020-05-02 16:39:32 +02:00
procedure TJSONRPCProxyGenerator.StartGeneration(const aClassName: string);
begin
// do nothing
end;
2019-01-08 12:48:27 +01:00
{ TJSONRPCRequestParams }
2020-05-02 16:39:32 +02:00
procedure TJSONRPCRequestParams.Add(const Value: TJDOJsonArray);
2019-01-08 12:48:27 +01:00
begin
Add(Value, pdtJSONArray);
end;
2020-05-02 16:39:32 +02:00
procedure TJSONRPCRequestParams.Add(const Value: TJDOJsonObject);
2019-01-08 12:48:27 +01:00
begin
Add(Value, pdTJDOJsonObject);
end;
2020-05-02 16:39:32 +02:00
procedure TJSONRPCRequestParams.Add(const Value: Integer);
2019-01-08 12:48:27 +01:00
begin
Add(Value, pdtInteger);
end;
2020-05-02 16:39:32 +02:00
procedure TJSONRPCRequestParams.Add(const Value: string);
2019-01-08 12:48:27 +01:00
begin
Add(Value, pdtString);
end;
2020-05-02 16:39:32 +02:00
procedure TJSONRPCRequestParams.Add(const Value: Boolean);
2019-01-08 12:48:27 +01:00
begin
Add(Value, pdtBoolean);
end;
2020-05-02 16:39:32 +02:00
procedure TJSONRPCRequestParams.Add(const Value: Double);
2019-01-08 12:48:27 +01:00
begin
Add(Value, pdtFloat);
end;
2020-05-02 16:39:32 +02:00
procedure TJSONRPCRequestParams.Add(const Value: TDateTime);
2019-01-08 12:48:27 +01:00
begin
Add(Value, pdtDateTime);
end;
2020-05-02 16:39:32 +02:00
procedure TJSONRPCRequestParams.Add(const Value: TTime);
2019-01-08 12:48:27 +01:00
begin
Add(Value, pdtTime);
end;
2020-05-02 16:39:32 +02:00
procedure TJSONRPCRequestParams.Add(const Value: TDate);
2019-01-08 12:48:27 +01:00
begin
Add(Value, pdtDate);
end;
2020-05-02 16:39:32 +02:00
procedure TJSONRPCRequestParams.CheckBalancedParams;
begin
if fParamNames.Count <> fParamValues.Count then
begin
raise EMVCJSONRPCException.Create('Cannot mix positional with named parameters');
end;
end;
procedure TJSONRPCRequestParams.CheckNotNames;
begin
if fParamNames.Count > 0 then
begin
raise EMVCJSONRPCException.Create('Cannot mix positional with named parameters');
end;
end;
2019-01-08 12:48:27 +01:00
procedure TJSONRPCRequestParams.Clear;
begin
2020-05-02 16:39:32 +02:00
fParamValues.Clear;
fParamTypes.Clear;
fParamNames.Clear;
2019-01-08 12:48:27 +01:00
end;
function TJSONRPCRequestParams.Count: Integer;
begin
2020-05-02 16:39:32 +02:00
Result := fParamValues.Count;
2019-01-08 12:48:27 +01:00
end;
constructor TJSONRPCRequestParams.Create;
begin
inherited Create;
2020-05-02 16:39:32 +02:00
fParamValues := TList<TValue>.Create;
fParamTypes := TList<TJSONRPCParamDataType>.Create;
fParamNames := TList<string>.Create;
2019-01-08 12:48:27 +01:00
end;
destructor TJSONRPCRequestParams.Destroy;
var
lValue: TValue;
begin
2020-05-02 16:39:32 +02:00
for lValue in fParamValues do
2019-01-08 12:48:27 +01:00
begin
if lValue.IsObject then
lValue.AsObject.Free;
end;
2020-05-02 16:39:32 +02:00
fParamValues.Free;
fParamTypes.Free;
fParamNames.Free;
2019-01-08 12:48:27 +01:00
inherited;
end;
function TJSONRPCRequestParams.GetItem(const Index: Integer): TValue;
2019-01-08 12:48:27 +01:00
begin
2020-05-02 16:39:32 +02:00
Result := fParamValues[index];
2019-01-08 12:48:27 +01:00
end;
function TJSONRPCRequestParams.GetItemDataType(const Index: Integer): TJSONRPCParamDataType;
2019-01-08 12:48:27 +01:00
begin
2020-05-02 16:39:32 +02:00
Result := fParamTypes[index];
end;
function TJSONRPCRequestParams.GetItemName(const Index: Integer): string;
begin
Result := fParamNames[index];
2019-01-08 12:48:27 +01:00
end;
function TJSONRPCRequestParams.ToArray: TArray<TValue>;
begin
2020-05-02 16:39:32 +02:00
Result := fParamValues.ToArray;
2019-01-08 12:48:27 +01:00
end;
2020-05-02 16:39:32 +02:00
procedure TJSONRPCRequestParams.Add(const Value: TValue; const ParamType: TJSONRPCParamDataType);
begin
CheckNotNames;
fParamValues.Add(Value);
fParamTypes.Add(ParamType);
end;
procedure TJSONRPCRequestParams.AddByName(const Name: string; const Value: Boolean);
2020-05-02 16:39:32 +02:00
begin
AddByName(name, Value, TJSONRPCParamDataType.pdtBoolean);
end;
procedure TJSONRPCRequestParams.AddByName(const Name: string; const Value: TJDOJsonArray);
2020-05-02 16:39:32 +02:00
begin
AddByName(name, Value, TJSONRPCParamDataType.pdtJSONArray);
end;
procedure TJSONRPCRequestParams.AddByName(const Name: string; const Value: TJDOJsonObject);
2020-05-02 16:39:32 +02:00
begin
AddByName(name, Value, TJSONRPCParamDataType.pdTJDOJsonObject);
end;
procedure TJSONRPCRequestParams.AddByName(const Name: string; const Value: Integer);
2020-05-02 16:39:32 +02:00
begin
AddByName(name, Value, TJSONRPCParamDataType.pdtInteger);
end;
procedure TJSONRPCRequestParams.AddByName(const Name, Value: string);
begin
AddByName(name, Value, TJSONRPCParamDataType.pdtString);
end;
procedure TJSONRPCRequestParams.AddByName(const Name: string; const Value: TValue;
const ParamType: TJSONRPCParamDataType);
2020-05-02 16:39:32 +02:00
begin
CheckBalancedParams;
fParamNames.Add(LowerCase(name));
fParamValues.Add(Value);
fParamTypes.Add(ParamType);
end;
procedure TJSONRPCRequestParams.AddByName(const Name: string; const Value: Double);
2020-05-02 16:39:32 +02:00
begin
AddByName(name, Value, TJSONRPCParamDataType.pdtFloat);
end;
procedure TJSONRPCRequestParams.AddByName(const Name: string; const Value: TDateTime);
2020-05-02 16:39:32 +02:00
begin
AddByName(name, Value, TJSONRPCParamDataType.pdtDateTime);
end;
procedure TJSONRPCRequestParams.AddByName(const Name: string; const Value: TTime);
2020-05-02 16:39:32 +02:00
begin
AddByName(name, Value, TJSONRPCParamDataType.pdtTime);
end;
procedure TJSONRPCRequestParams.AddByName(const Name: string; const Value: TDate);
2019-01-08 12:48:27 +01:00
begin
2020-05-02 16:39:32 +02:00
AddByName(name, Value, TJSONRPCParamDataType.pdtDate);
2019-01-08 12:48:27 +01:00
end;
2020-03-25 22:27:29 +01:00
{ EMVCJSONRPCException }
constructor EMVCJSONRPCError.Create(const ErrCode: Integer; const Msg: string);
2020-03-25 22:27:29 +01:00
begin
inherited Create(Msg);
fJSONRPCErrorCode := ErrCode;
end;
2020-08-06 17:40:56 +02:00
{ TJSONRPCNullResponse }
function TJSONRPCNullResponse.GetError: TJSONRPCResponseError;
begin
Result := FError;
end;
function TJSONRPCNullResponse.GetID: TValue;
begin
RaiseErrorForNullObject;
end;
function TJSONRPCNullResponse.GetJSON: TJDOJsonObject;
begin
Result := nil;
RaiseErrorForNullObject;
end;
function TJSONRPCNullResponse.GetJSONString: string;
begin
RaiseErrorForNullObject;
end;
function TJSONRPCNullResponse.GetResult: TValue;
begin
RaiseErrorForNullObject;
end;
function TJSONRPCNullResponse.IsError: Boolean;
begin
Result := False;
end;
procedure TJSONRPCNullResponse.RaiseErrorForNullObject;
begin
raise EMVCJSONRPCException.Create('Invalid Call for NULL object');
end;
function TJSONRPCNullResponse.ResultAsJSONArray: TJDOJsonArray;
begin
Result := nil;
RaiseErrorForNullObject;
end;
function TJSONRPCNullResponse.ResultAsJSONObject: TJDOJsonObject;
begin
Result := nil;
RaiseErrorForNullObject;
end;
procedure TJSONRPCNullResponse.SetError(const Value: TJSONRPCResponseError);
begin
FError := Value;
end;
procedure TJSONRPCNullResponse.SetID(const Value: TValue);
begin
RaiseErrorForNullObject;
end;
procedure TJSONRPCNullResponse.SetJSON(const JSON: TJDOJsonObject);
begin
RaiseErrorForNullObject;
end;
procedure TJSONRPCNullResponse.SetJsonString(const Value: string);
begin
RaiseErrorForNullObject;
end;
procedure TJSONRPCNullResponse.SetResult(const Value: TValue);
begin
RaiseErrorForNullObject;
end;
function TJSONRPCNullResponse.ToString(const Compact: Boolean): string;
begin
Result := '';
end;
constructor EMVCJSONRPCError.CreateFmt(const ErrCode: Integer; const Msg: string; const Args: array of const);
2020-09-18 12:23:44 +02:00
begin
inherited CreateFmt(Msg, Args);
fJSONRPCErrorCode := ErrCode;
end;
initialization
finalization
FreeAndNil(GProxyGeneratorsRegister);
2017-09-24 19:40:40 +02:00
end.