diff --git a/samples/jsonrpc/async_client/MainClientFormU.pas b/samples/jsonrpc/async_client/MainClientFormU.pas
index 64cca346..fc63c244 100644
--- a/samples/jsonrpc/async_client/MainClientFormU.pas
+++ b/samples/jsonrpc/async_client/MainClientFormU.pas
@@ -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)
+ .SetConfigureHTTPClientAsync(
+ procedure (HTTPClient: THTTPClient)
+ begin
+ HTTPClient.ResponseTimeout := 20000;
+ HTTPClient.CustomHeaders['X-DMVCFRAMEWORK'] := 'DMVCFRAMEWORK_VERSION ' + DMVCFRAMEWORK_VERSION;
end);
-
- FExecutor.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
diff --git a/samples/jsonrpc/async_client/jsonrpcclient_async.dpr b/samples/jsonrpc/async_client/jsonrpcclient_async.dpr
index 6e1ffbec..3c8ab849 100644
--- a/samples/jsonrpc/async_client/jsonrpcclient_async.dpr
+++ b/samples/jsonrpc/async_client/jsonrpcclient_async.dpr
@@ -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}
diff --git a/samples/jsonrpc/async_client/jsonrpcclient_async.dproj b/samples/jsonrpc/async_client/jsonrpcclient_async.dproj
index ce72d308..aab46e3b 100644
--- a/samples/jsonrpc/async_client/jsonrpcclient_async.dproj
+++ b/samples/jsonrpc/async_client/jsonrpcclient_async.dproj
@@ -108,12 +108,12 @@
dfm
-
dfm
+
Base
diff --git a/samples/jsonrpc/jsonrpcserver/MyObjectU.pas b/samples/jsonrpc/jsonrpcserver/MyObjectU.pas
index 817955bb..c1310f28 100644
--- a/samples/jsonrpc/jsonrpcserver/MyObjectU.pas
+++ b/samples/jsonrpc/jsonrpcserver/MyObjectU.pas
@@ -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;
diff --git a/samples/jsonrpc/sync_client/MainClientFormU.pas b/samples/jsonrpc/sync_client/MainClientFormU.pas
index b4fac2d5..deb91edf 100644
--- a/samples/jsonrpc/sync_client/MainClientFormU.pas
+++ b/samples/jsonrpc/sync_client/MainClientFormU.pas
@@ -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;
diff --git a/sources/MVCFramework.DataSet.Utils.pas b/sources/MVCFramework.DataSet.Utils.pas
index d5d45000..30c27469 100644
--- a/sources/MVCFramework.DataSet.Utils.pas
+++ b/sources/MVCFramework.DataSet.Utils.pas
@@ -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;
@@ -190,8 +191,14 @@ begin
lSer := TMVCJsonDataObjectsSerializer.Create;
try
- lSer.JsonArrayToDataSet(TJSONArray(Value.AsObject), Self, [],
- TMVCNameCase.ncUseDefault);
+ 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
diff --git a/sources/MVCFramework.JSONRPC.Client.pas b/sources/MVCFramework.JSONRPC.Client.pas
index b7917cde..50b20640 100644
--- a/sources/MVCFramework.JSONRPC.Client.pas
+++ b/sources/MVCFramework.JSONRPC.Client.pas
@@ -74,6 +74,7 @@ type
function SetOnSendCommand(const aOnSendCommandProc: TProc): IMVCJSONRPCExecutor;
function SetOnReceiveHTTPResponse(const aOnReceiveHTTPResponse: TProc): 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;
diff --git a/sources/MVCFramework.JSONRPC.pas b/sources/MVCFramework.JSONRPC.pas
index a74a947c..1fdd3049 100644
--- a/sources/MVCFramework.JSONRPC.pas
+++ b/sources/MVCFramework.JSONRPC.pas
@@ -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;
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
- lSer.JsonObjectToObject(
- JSONDataValue.ObjectValue,
- ParamValue.AsObject,
- TMVCSerializationType.stDefault,
- nil
- );
+ 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
@@ -1480,7 +1501,7 @@ begin
lAtt: MVCDocAttribute;
lLines: TArray;
lLine: String;
- lAllowGetAtt: MVCJSONRPCAllowGET;
+ lAllowGetAtt: MVCJSONRPCAllowGET;
begin
if IsReservedMethodName(aRTTIMethod.Name) then
begin
@@ -1496,7 +1517,7 @@ begin
end;
end;
lAllowGetAtt := TRTTIUtils.GetAttribute(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(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(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;