Delphi/delphimvcframework
1
0
Fork 0
mirror of https://github.com/danieleteti/delphimvcframework.git synced 2024-11-15 07:45:54 +01:00
Code Issues Actions Packages Projects Releases Wiki Activity

Small refactoring to JSONRPC classes

Browse Source
This commit is contained in:
Daniele Teti 2024-10-10 00:13:07 +02:00
parent bc065284f8
commit 4e2cc963f4
8 changed files with 121 additions and 69 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

44
samples/jsonrpc/async_client/MainClientFormU.pas
View File

@ -328,16 +328,24 @@ begin
lReq.Params.Add(edtUserName.Text);
FExecutor.ExecuteRequestAsync('/jsonrpc', lReq,
procedure(Resp: IJSONRPCResponse)
var
lJSON: TJsonObject;
begin
// Remember that TObject descendants (but TDataset, TJDOJSONObject and TJDOJSONArray)
// are serialized as JSON objects
lJSON := Resp.Result.AsObject as TJsonObject;
lbPerson.Items.Add('First Name:'.PadRight(15) + lJSON.S['firstname']);
lbPerson.Items.Add('Last Name:'.PadRight(15) + lJSON.S['lastname']);
lbPerson.Items.Add('Married:'.PadRight(15) + lJSON.B['married'].ToString(TUseBoolStrs.True));
lbPerson.Items.Add('DOB:'.PadRight(15) + DateToStr(lJSON.D['dob']));
// are serialized as JSON objects, so you can always read the JSON object
// lJSON := Resp.Result.AsObject as TJsonObject;
// lbPerson.Items.Add('First Name:'.PadRight(15) + lJSON.S['firstname']);
// lbPerson.Items.Add('Last Name:'.PadRight(15) + lJSON.S['lastname']);
// lbPerson.Items.Add('Married:'.PadRight(15) + lJSON.B['married'].ToString(TUseBoolStrs.True));
// lbPerson.Items.Add('DOB:'.PadRight(15) + DateToStr(lJSON.D['dob']));
var lPerson := TPerson.Create;
try
Resp.ResultAs(lPerson);
lbPerson.Items.Add('First Name:'.PadRight(15) + lPerson.FirstName);
lbPerson.Items.Add('Last Name:'.PadRight(15) + lPerson.LastName);
lbPerson.Items.Add('Married:'.PadRight(15) + lPerson.Married.ToString(TUseBoolStrs.True));
lbPerson.Items.Add('DOB:'.PadRight(15) + DateToStr(lPerson.DOB));
finally
lPerson.Free;
end;
end);
end;
@ -790,8 +798,7 @@ begin
procedure(Resp: IJSONRPCResponse)
begin
FDMemTable1.Active := True;
FDMemTable1.LoadFromTValue(Resp.Result);
FDMemTable1.First;
FDMemTable1.LoadFromJSONRPCResponse(Resp);
end,
procedure(Exc: Exception)
begin
@ -814,32 +821,27 @@ begin
Sleep(1000 + Random(3000));
end;
Log.Debug('REQUEST : ' + JSONRPCObject.ToString(True), 'jsonrpc');
end);
FExecutor.SetOnReceiveResponseAsync(
end)
.SetOnReceiveResponseAsync(
procedure(Req, Resp: IJSONRPCObject)
begin
Log.Debug('>> OnReceiveResponse // start', 'jsonrpc');
Log.Debug(' REQUEST : ' + Req.ToString(True), 'jsonrpc');
Log.Debug(' RESPONSE: ' + Resp.ToString(True), 'jsonrpc');
Log.Debug('<< OnReceiveResponse // end', 'jsonrpc');
end);
FExecutor.SetOnReceiveHTTPResponseAsync(
end)
.SetOnReceiveHTTPResponseAsync(
procedure(HTTPResp: IHTTPResponse)
begin
Log.Debug('RESPONSE: ' + HTTPResp.ContentAsString(), 'jsonrpc');
end);
FExecutor.SetConfigureHTTPClientAsync(
end)
.SetConfigureHTTPClientAsync(
procedure (HTTPClient: THTTPClient)
begin
HTTPClient.ResponseTimeout := 20000;
HTTPClient.CustomHeaders['X-DMVCFRAMEWORK'] := 'DMVCFRAMEWORK_VERSION ' + DMVCFRAMEWORK_VERSION;
end);
dtNextMonday.Date := Date;
// these are the methods to handle http headers in JSONRPC
// the following line and the check on the server is just for demo

4
samples/jsonrpc/async_client/jsonrpcclient_async.dpr
View File

@ -4,9 +4,9 @@ uses
Vcl.Forms,
MainClientFormU in 'MainClientFormU.pas' {MainForm},
RandomUtilsU in '..\..\commons\RandomUtilsU.pas',
BusinessObjectsU in '..\..\commons\BusinessObjectsU.pas',
CommonTypesU in '..\CommonTypesU.pas',
WaitingFormU in 'WaitingFormU.pas' {WaitingForm};
WaitingFormU in 'WaitingFormU.pas' {WaitingForm},
BusinessObjectsU in '..\..\commons\BusinessObjectsU.pas';
{$R *.res}

2
samples/jsonrpc/async_client/jsonrpcclient_async.dproj
View File

@ -108,12 +108,12 @@
<FormType>dfm</FormType>
</DCCReference>
<DCCReference Include="..\..\commons\RandomUtilsU.pas"/>
<DCCReference Include="..\..\commons\BusinessObjectsU.pas"/>
<DCCReference Include="..\CommonTypesU.pas"/>
<DCCReference Include="WaitingFormU.pas">
<Form>WaitingForm</Form>
<FormType>dfm</FormType>
</DCCReference>
<DCCReference Include="..\..\commons\BusinessObjectsU.pas"/>
<BuildConfiguration Include="Base">
<Key>Base</Key>
</BuildConfiguration>

4
samples/jsonrpc/jsonrpcserver/MyObjectU.pas
View File

@ -33,7 +33,8 @@ uses
BusinessObjectsU,
FireDAC.Comp.Client,
MVCFramework.Serializer.Commons,
MVCFramework.Commons, MVCFramework, MVCFramework.JSONRPC, CommonTypesU;
MVCFramework.Commons, MVCFramework,
MVCFramework.JSONRPC, CommonTypesU;
type
@ -49,6 +50,7 @@ type
procedure OnAfterCallHook(const Context: TWebContext; const JSONResponse: TJDOJsonObject);
public
[MVCDoc('You know, returns aValue1 - aValue2')]
[MVCJSONRPCAllowGET]
function Subtract(Value1, Value2: Integer): Integer;
[MVCDoc('Returns the revers of the string passed as input')]
function ReverseString(const aString: string; const aUpperCase: Boolean): string;

32
samples/jsonrpc/sync_client/MainClientFormU.pas
View File

@ -312,12 +312,22 @@ begin
raise Exception.Create(lResp.Error.ErrMessage);
// Remember that TObject descendants (but TDataset, TJDOJSONObject and TJDOJSONArray)
// are serialized as JSON objects
lJSON := lResp.Result.AsObject as TJsonObject;
lbPerson.Items.Add('First Name:'.PadRight(15) + lJSON.S['firstname']);
lbPerson.Items.Add('Last Name:'.PadRight(15) + lJSON.S['lastname']);
lbPerson.Items.Add('Married:'.PadRight(15) + lJSON.B['married'].ToString(TUseBoolStrs.True));
lbPerson.Items.Add('DOB:'.PadRight(15) + DateToStr(lJSON.D['dob']));
// are serialized as JSON objects, so you can always read the JSON object
// lJSON := Resp.Result.AsObject as TJsonObject;
// lbPerson.Items.Add('First Name:'.PadRight(15) + lJSON.S['firstname']);
// lbPerson.Items.Add('Last Name:'.PadRight(15) + lJSON.S['lastname']);
// lbPerson.Items.Add('Married:'.PadRight(15) + lJSON.B['married'].ToString(TUseBoolStrs.True));
// lbPerson.Items.Add('DOB:'.PadRight(15) + DateToStr(lJSON.D['dob']));
var lPerson := TPerson.Create;
try
lResp.ResultAs(lPerson);
lbPerson.Items.Add('First Name:'.PadRight(15) + lPerson.FirstName);
lbPerson.Items.Add('Last Name:'.PadRight(15) + lPerson.LastName);
lbPerson.Items.Add('Married:'.PadRight(15) + lPerson.Married.ToString(TUseBoolStrs.True));
lbPerson.Items.Add('DOB:'.PadRight(15) + DateToStr(lPerson.DOB));
finally
lPerson.Free;
end;
end;
procedure TMainForm.btnInvalid1Click(Sender: TObject);
@ -510,16 +520,18 @@ procedure TMainForm.btnSubtractWithNamedParamsClick(Sender: TObject);
var
lReq: IJSONRPCRequest;
lResp: IJSONRPCResponse;
lExecutor: IMVCJSONRPCExecutor;
begin
lReq := TJSONRPCRequest.Create;
lReq.Method := 'subtract';
lReq.RequestID := Random(1000);
lExecutor := TMVCJSONRPCExecutor.Create('http://localhost:8080');
lReq := lExecutor.CreateRequest('subtract', Random(1000));
lReq.Params.AddByName('Value1', StrToInt(Edit1.Text));
lReq.Params.AddByName('Value2', StrToInt(Edit2.Text));
lResp := FExecutor.ExecuteRequest('/jsonrpc', lReq);
lResp := lExecutor.ExecuteRequest('/jsonrpc', lReq, jrpcGET);
Edit3.Text := lResp.Result.AsInteger.ToString;
end;
procedure TMainForm.btnWithJSONClick(Sender: TObject);
var
lPerson: TJsonObject;

14
sources/MVCFramework.DataSet.Utils.pas
View File

@ -39,13 +39,14 @@ uses
MVCFramework.Commons,
MVCFramework.Serializer.Commons,
MVCFramework.RESTClient.Intf,
MVCFramework.RESTClient;
MVCFramework.RESTClient, MVCFramework.JSONRPC;
type
TFieldNamePolicy = (fpLowerCase, fpUpperCase, fpAsIs);
TDataSetHelper = class helper for TDataSet
public
procedure LoadFromJSONRPCResponse(const Value: IJSONRPCResponse; const aNameCase: TMVCNameCase = TMVCNameCase.ncUseDefault);
procedure LoadFromTValue(const Value: TValue;
const aNameCase: TMVCNameCase = TMVCNameCase.ncUseDefault);
function AsJSONArray(FieldNameCase: TMVCNameCase = TMVCNameCase.ncUseDefault): string;
@ -189,9 +190,15 @@ begin
('LoadFromTValue requires a TValue containing a TJDOJsonArray');
lSer := TMVCJsonDataObjectsSerializer.Create;
try
DisableControls;
try
lSer.JsonArrayToDataSet(TJSONArray(Value.AsObject), Self, [],
TMVCNameCase.ncUseDefault);
First;
finally
EnableControls;
end;
finally
lSer.Free;
end;
@ -464,6 +471,11 @@ begin
TMVCIgnoredList(IgnoredFields), FieldNameCase);
end;
procedure TDataSetHelper.LoadFromJSONRPCResponse(const Value: IJSONRPCResponse; const aNameCase: TMVCNameCase);
begin
LoadFromTValue(Value.Result, aNameCase);
end;
procedure TDataSetHelper.LoadFromJSONObject(const JSONObject: TJSONObject;
const FieldNameCase: TMVCNameCase);
begin

1
sources/MVCFramework.JSONRPC.Client.pas
View File

@ -74,6 +74,7 @@ type
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;

63
sources/MVCFramework.JSONRPC.pas
View File

@ -41,9 +41,8 @@ uses
MVCFramework.Commons,
System.Rtti,
System.Generics.Collections,
MVCFramework.Serializer.Commons,
MVCFramework.Serializer.JsonDataObjects,
System.SysUtils;
System.SysUtils, MVCFramework.Serializer.Commons;
const
JSONRPC_VERSION = '2.0';
@ -265,7 +264,7 @@ type
function IsError: Boolean;
function ResultAsJSONObject: TJDOJsonObject;
function ResultAsJSONArray: TJDOJsonArray;
procedure ResultAs(Obj: TObject);
procedure ResultAs(const Obj: TObject; Serialization: TMVCSerializationType = TMVCSerializationType.stDefault);
property Result: TValue read GetResult write SetResult;
property Error: TJSONRPCResponseError read GetError write SetError;
property RequestID: TValue read GetID write SetID;
@ -287,7 +286,7 @@ type
function GetID: TValue;
function ResultAsJSONObject: TJDOJsonObject;
function ResultAsJSONArray: TJDOJsonArray;
procedure ResultAs(Obj: TObject);
procedure ResultAs(const Obj: TObject; Serialization: TMVCSerializationType = TMVCSerializationType.stDefault);
function IsError: Boolean;
property Result: TValue read GetResult write SetResult;
property Error: TJSONRPCResponseError read GetError write SetError;
@ -316,7 +315,7 @@ type
procedure CheckForError;
function ResultAsJSONObject: TJDOJsonObject;
function ResultAsJSONArray: TJDOJsonArray;
procedure ResultAs(Obj: TObject);
procedure ResultAs(const Obj: TObject; Serialization: TMVCSerializationType);
function IsError: Boolean;
property Result: TValue read GetResult write SetResult;
property Error: TJSONRPCResponseError read GetError write SetError;
@ -908,6 +907,8 @@ var
lTValueArr: TArray<TValue>;
lItemRTTIType: TRttiType;
I: Integer;
lMVCList: IMVCList;
lClazz: TClass;
begin
ParamIsRecord := False;
ParamRecordPointer := nil;
@ -1017,7 +1018,7 @@ begin
end;
tkClass:
begin
if (SameText(RTTIParameter.ParamType.Name, TJDOJsonArray.ClassName)) then
if SameText(RTTIParameter.ParamType.Name, TJDOJsonArray.ClassName) then
begin
ParamValue := JSONDataValue.ArrayValue.Clone;
end
@ -1031,14 +1032,34 @@ begin
try
ParamValue := TRTTIUtils.CreateObject(RTTIParameter.ParamType);
try
if JSONDataValue.Typ = jdtArray then
begin
if not TDuckTypedList.CanBeWrappedAsList(ParamValue.AsObject, lMVCList) then
begin
raise EMVCJSONRPCInvalidRequest.Create(BuildDeclaration(RTTIParameter));
end
else
begin
lClazz := lSer.GetObjectTypeOfGenericList(RTTIParameter.ParamType.Handle);
if lClazz = nil then
begin
raise EMVCJSONRPCError.Create(JSONRPC_ERR_INTERNAL_ERROR, 'Cannot detect items tyoe in array parameter ' + RTTIParameter.ParamType.ToString);
end;
lSer.JsonArrayToList(JSONDataValue.ArrayValue, lMVCList, lClazz, TMVCSerializationType.stProperties, nil);
end;
end
else
begin
lSer.JsonObjectToObject(
JSONDataValue.ObjectValue,
ParamValue.AsObject,
TMVCSerializationType.stDefault,
nil
);
end;
except
ParamValue.AsObject.Free;
ParamValue := nil;
raise;
end;
finally
@ -1496,7 +1517,7 @@ begin
end;
end;
lAllowGetAtt := TRTTIUtils.GetAttribute<MVCJSONRPCAllowGET>(aRTTIMethod);
lSB.Append('// ' + aRTTIMethod.Name + ' is invokable with POST');
lSB.Append('// "' + aRTTIMethod.Name + '" is invokable with POST');
if Assigned(lAllowGetAtt) then
begin
lSB.AppendLine(' and GET');
@ -1506,6 +1527,7 @@ begin
lSB.AppendLine(' only');
end;
lSB.AppendLine(aRTTIMethod.ToString + ';');
lSB.AppendLine;
end);
Result := lSB.ToString;
finally
@ -1558,15 +1580,6 @@ begin
end;
lRTTIType := lRTTI.GetType(fRPCInstance.ClassType);
if lHTTPVerb = httpGET then
begin
lIsMethodCallableWithGET := TMVCSerializerHelper.AttributeExists<MVCJSONRPCAllowGET>(lRTTIType.GetAttributes);
if not lIsMethodCallableWithGET then
begin
raise EMVCJSONRPCError.Create(JSONRPC_ERR_INVALID_REQUEST, 'Method callable with POST only');
end;
end;
lJSONRPCReq := CreateRequest(lJSON);
lMethod := lJSONRPCReq.Method;
@ -1613,6 +1626,15 @@ begin
raise EMVCJSONRPCMethodNotFound.Create(lMethod);
end;
if lHTTPVerb = httpGET then
begin
lIsMethodCallableWithGET := TMVCSerializerHelper.AttributeExists<MVCJSONRPCAllowGET>(lRTTIMethod.GetAttributes);
if not lIsMethodCallableWithGET then
begin
raise EMVCJSONRPCError.Create(JSONRPC_ERR_INVALID_REQUEST, 'Method callable with POST only');
end;
end;
lRes := InvokeMethod(fRPCInstance, lRTTIType, lRTTIMethod, lJSON, lBeforeCallHookHasBeenInvoked);
case lJSONRPCReq.RequestType of
TJSONRPCRequestType.Notification:
@ -1631,7 +1653,7 @@ begin
end
else
begin
LogW(Format('Method "%s" has not be found in %s. Only public methods can be invoked.',
LogW(Format('Method "%s" has not be found in "%s" - [HINT] Only public methods can be invoked.',
[lMethod, fRPCInstance.QualifiedClassName]));
raise EMVCJSONRPCMethodNotFound.Create(lMethod);
end;
@ -1682,6 +1704,7 @@ begin
end;
on Ex: Exception do // use another name for exception variable, otherwise E is nil!!
begin
ResponseStatus(HTTP_STATUS.InternalServerError);
//lJSONResp := CreateError(lReqID, 0, Ex.Message);
LogE(Format('[JSON-RPC][CLS %s][MSG "%s"]', [Ex.ClassName, Ex.Message]));
if Assigned(fExceptionHandler) then
@ -2328,13 +2351,13 @@ begin
Result := Assigned(FError);
end;
procedure TJSONRPCResponse.ResultAs(Obj: TObject);
procedure TJSONRPCResponse.ResultAs(const Obj: TObject; Serialization: TMVCSerializationType);
var
lSer: TMVCJsonDataObjectsSerializer;
begin
lSer := TMVCJsonDataObjectsSerializer.Create(nil);
try
lSer.JsonObjectToObject(ResultAsJSONObject, Obj, TMVCSerializationType.stDefault, []);
lSer.JsonObjectToObject(ResultAsJSONObject, Obj, Serialization, []);
finally
lSer.Free;
end;
@ -2822,7 +2845,7 @@ begin
raise EMVCJSONRPCException.Create('Invalid Call for NULL object');
end;
procedure TJSONRPCNullResponse.ResultAs(Obj: TObject);
procedure TJSONRPCNullResponse.ResultAs(const Obj: TObject; Serialization: TMVCSerializationType);
begin
RaiseErrorForNullObject;
end;