Improvements to the JSON-RPC layer, added MAX_REQUEST_SIZE check and config key. UPdated IDE Expert to add the new config key in the generated code.

This commit is contained in:
Daniele Teti 2018-12-17 00:39:29 +01:00
parent 2ec82ee373
commit f64eebff6a
13 changed files with 439 additions and 128 deletions

View File

@ -69,6 +69,7 @@
- Refactored ISAPI sample
- Speed improvement! Removed enhanced visibility for action methods. Now only public and published methods can be used as actions.
- `TMVCController.Create` is `virtual`! Now on your base controllers can be even more powerful!
- New! Added `MAX_REQUEST_SIZE` for limiting the size of the incoming HTTP requests. IDE Expert is updated too!
- New! Added method `TMVCJsonDataObjectsSerializer.ListToJsonArray`
- New! `TMVCResponse` for handle generic (non error) response
- New! `TMVCErrorResponse` for handle generic error response
@ -87,6 +88,7 @@
- Sending wrongly formatted JSON now returns a more correctly `400 Bad Request` and not `500 Internal Server Error` as in the previous versions
- New! Support for Spring4d nullable types (check `samples\renders_spring4d_nullables`)
- New! `TMVCJSONRPCPublisher` allows to easily expose plain Delphi objects (and even datamodules) through a JSON-RPC 2.0 interface!
- *Breaking Change!* The JSON RPC Client layer is now interface based.
## How to correctly get the source

View File

@ -330,6 +330,8 @@ resourcestring
' Config[TMVCConfigKey.ExposeServerSignature] := ''true'';' + sLineBreak +
' // Define a default URL for requests that don''t map to a route or a file (useful for client side web app)' + sLineBreak +
' Config[TMVCConfigKey.FallbackResource] := ''index.html'';' + sLineBreak +
' // Max request size in bytes' + sLineBreak +
' Config[TMVCConfigKey.MaxRequestSize] := IntToStr(TMVCConstants.DEFAULT_MAX_REQUEST_SIZE);' + sLineBreak +
' end);' + sLineBreak +
' FMVC.AddController(%3:s);' + sLineBreak +
' // To enable compression (deflate, gzip) just add this middleware as the last one ' + sLineBreak +

View File

@ -4,7 +4,6 @@ program activerecord_crud;
uses
// FastMM4,
FireDAC.Phys.FB,
System.SysUtils,
MVCFramework.Logger,
@ -14,14 +13,16 @@ uses
Web.WebReq,
Web.WebBroker,
IdHTTPWebBrokerBridge,
WebModuleU in 'WebModuleU.pas' {MyWebModule: TWebModule} ,
WebModuleU in 'WebModuleU.pas' {MyWebModule: TWebModule},
Entities in 'Entities.pas',
FDConnectionConfigU in 'FDConnectionConfigU.pas',
MVCFramework.ActiveRecordController in '..\..\sources\MVCFramework.ActiveRecordController.pas',
MVCFramework.ActiveRecord in '..\..\sources\MVCFramework.ActiveRecord.pas',
MVCFramework.RQL.AST2MySQL in '..\..\sources\MVCFramework.RQL.AST2MySQL.pas',
MVCFramework.RQL.AST2FirebirdSQL in '..\..\sources\MVCFramework.RQL.AST2FirebirdSQL.pas',
EntitiesProcessors in 'EntitiesProcessors.pas';
EntitiesProcessors in 'EntitiesProcessors.pas',
MVCFramework.RQL.AST2InterbaseSQL in '..\..\sources\MVCFramework.RQL.AST2InterbaseSQL.pas',
MVCFramework.RQL.AST2PostgreSQL in '..\..\sources\MVCFramework.RQL.AST2PostgreSQL.pas';
{$R *.res}

View File

@ -125,6 +125,8 @@
<DCCReference Include="..\..\sources\MVCFramework.RQL.AST2MySQL.pas"/>
<DCCReference Include="..\..\sources\MVCFramework.RQL.AST2FirebirdSQL.pas"/>
<DCCReference Include="EntitiesProcessors.pas"/>
<DCCReference Include="..\..\sources\MVCFramework.RQL.AST2InterbaseSQL.pas"/>
<DCCReference Include="..\..\sources\MVCFramework.RQL.AST2PostgreSQL.pas"/>
<BuildConfiguration Include="Release">
<Key>Cfg_2</Key>
<CfgParent>Base</CfgParent>
@ -173,7 +175,7 @@
<Overwrite>true</Overwrite>
</Platform>
</DeployFile>
<DeployFile LocalName="Win32\Debug\activerecord_crud.exe" Configuration="Debug" Class="ProjectOutput">
<DeployFile LocalName="D:\CORSI\ITDEVCON9 Testing Delphi With Python\samples\SUT\bin\activerecord_crud.exe" Configuration="Debug" Class="ProjectOutput">
<Platform Name="Win32">
<RemoteName>activerecord_crud.exe</RemoteName>
<Overwrite>true</Overwrite>

View File

@ -1,7 +1,7 @@
<Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
<PropertyGroup>
<ProjectGuid>{F8576ED6-649F-4E28-B364-1F60687C75F2}</ProjectGuid>
<ProjectVersion>18.4</ProjectVersion>
<ProjectVersion>18.5</ProjectVersion>
<FrameworkType>VCL</FrameworkType>
<MainSource>activerecord_showcase.dpr</MainSource>
<Base>True</Base>
@ -84,9 +84,9 @@
<PropertyGroup Condition="'$(Cfg_1_Win32)'!=''">
<DCC_RemoteDebug>false</DCC_RemoteDebug>
<AppEnableRuntimeThemes>true</AppEnableRuntimeThemes>
<AppEnableHighDPI>true</AppEnableHighDPI>
<VerInfo_IncludeVerInfo>true</VerInfo_IncludeVerInfo>
<VerInfo_Locale>1033</VerInfo_Locale>
<AppDPIAwarenessMode>PerMonitor</AppDPIAwarenessMode>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_2)'!=''">
<DCC_LocalDebugSymbols>false</DCC_LocalDebugSymbols>
@ -96,7 +96,7 @@
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_2_Win32)'!=''">
<AppEnableRuntimeThemes>true</AppEnableRuntimeThemes>
<AppEnableHighDPI>true</AppEnableHighDPI>
<AppDPIAwarenessMode>PerMonitor</AppDPIAwarenessMode>
</PropertyGroup>
<ItemGroup>
<DelphiCompile Include="$(MainSource)">
@ -156,7 +156,6 @@
<Operation>1</Operation>
</Platform>
<Platform Name="Win32">
<RemoteDir>Contents\MacOS</RemoteDir>
<Operation>0</Operation>
</Platform>
</DeployClass>
@ -166,6 +165,12 @@
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="AndroidFileProvider">
<Platform Name="Android">
<RemoteDir>res\xml</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="AndroidGDBServer">
<Platform Name="Android">
<RemoteDir>library\lib\armeabi-v7a</RemoteDir>
@ -202,6 +207,12 @@
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="AndroidSplashStylesV21">
<Platform Name="Android">
<RemoteDir>res\values-v21</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="Android_DefaultAppIcon">
<Platform Name="Android">
<RemoteDir>res\drawable</RemoteDir>
@ -280,6 +291,11 @@
<Operation>1</Operation>
<Extensions>.framework</Extensions>
</Platform>
<Platform Name="OSX64">
<RemoteDir>Contents\MacOS</RemoteDir>
<Operation>1</Operation>
<Extensions>.framework</Extensions>
</Platform>
<Platform Name="Win32">
<Operation>0</Operation>
</Platform>
@ -302,6 +318,11 @@
<Operation>1</Operation>
<Extensions>.dylib</Extensions>
</Platform>
<Platform Name="OSX64">
<RemoteDir>Contents\MacOS</RemoteDir>
<Operation>1</Operation>
<Extensions>.dylib</Extensions>
</Platform>
<Platform Name="Win32">
<Operation>0</Operation>
<Extensions>.dll;.bpl</Extensions>
@ -325,6 +346,11 @@
<Operation>1</Operation>
<Extensions>.dylib</Extensions>
</Platform>
<Platform Name="OSX64">
<RemoteDir>Contents\MacOS</RemoteDir>
<Operation>1</Operation>
<Extensions>.dylib</Extensions>
</Platform>
<Platform Name="Win32">
<Operation>0</Operation>
<Extensions>.bpl</Extensions>
@ -347,6 +373,10 @@
<RemoteDir>Contents\Resources\StartUp\</RemoteDir>
<Operation>0</Operation>
</Platform>
<Platform Name="OSX64">
<RemoteDir>Contents\Resources\StartUp\</RemoteDir>
<Operation>0</Operation>
</Platform>
<Platform Name="Win32">
<Operation>0</Operation>
</Platform>
@ -483,23 +513,41 @@
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="ProjectOSXDebug">
<Platform Name="OSX64">
<RemoteDir>..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="ProjectOSXEntitlements">
<Platform Name="OSX32">
<RemoteDir>..\</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="OSX64">
<RemoteDir>..\</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="ProjectOSXInfoPList">
<Platform Name="OSX32">
<RemoteDir>Contents</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="OSX64">
<RemoteDir>Contents</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="ProjectOSXResource">
<Platform Name="OSX32">
<RemoteDir>Contents\Resources</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="OSX64">
<RemoteDir>Contents\Resources</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Required="true" Name="ProjectOutput">
<Platform Name="Android">
@ -522,6 +570,10 @@
<RemoteDir>Contents\MacOS</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="OSX64">
<RemoteDir>Contents\MacOS</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="Win32">
<Operation>0</Operation>
</Platform>
@ -561,6 +613,7 @@
<ProjectRoot Platform="Win32" Name="$(PROJECTNAME)"/>
<ProjectRoot Platform="OSX32" Name="$(PROJECTNAME).app"/>
<ProjectRoot Platform="Android" Name="$(PROJECTNAME)"/>
<ProjectRoot Platform="OSX64" Name="$(PROJECTNAME).app"/>
<ProjectRoot Platform="iOSSimulator" Name="$(PROJECTNAME).app"/>
</Deployment>
<Platforms>

View File

@ -26,8 +26,6 @@ unit MVCFramework.ActiveRecord;
interface
uses
System.Generics.Defaults,
System.Generics.Collections,
@ -113,7 +111,6 @@ type
constructor Create; virtual;
end;
TMVCActiveRecord = class
private
fConn: TFDConnection;
@ -221,8 +218,8 @@ type
function GetPK: TValue;
class function GetByPK<T: TMVCActiveRecord, constructor>(const aValue: int64): T; overload;
class function GetByPK(const aClass: TMVCActiveRecordClass; const aValue: int64): TMVCActiveRecord; overload;
class function Select<T: TMVCActiveRecord, constructor>(const SQL: string; const Params: array of Variant; const Options: TMVCActiveRecordLoadOptions = [])
: TObjectList<T>; overload;
class function Select<T: TMVCActiveRecord, constructor>(const SQL: string; const Params: array of Variant;
const Options: TMVCActiveRecordLoadOptions = []): TObjectList<T>; overload;
class function Select(const aClass: TMVCActiveRecordClass; const SQL: string; const Params: array of Variant)
: TMVCActiveRecordList; overload;
class function Select(const aClass: TMVCActiveRecordClass; const SQL: string; const Params: array of Variant;
@ -970,6 +967,10 @@ begin
begin
aRTTIField.SetValue(Self, aField.AsLongWord);
end;
ftFMTBcd:
begin
aRTTIField.SetValue(Self, BCDtoCurrency(aField.AsBCD));
end;
ftDate:
begin
aRTTIField.SetValue(Self, Trunc(aField.AsDateTime));
@ -1267,7 +1268,8 @@ begin
if TMVCActiveRecordLoadOption.loIgnoreNotExistentFields in aOptions then
continue
else
raise EMVCActiveRecord.CreateFmt('Field [%s] not found in dataset. [HINT] If you dont need it, use loIgnoreNotExistentFields', [lItem.Value]);
raise EMVCActiveRecord.CreateFmt
('Field [%s] not found in dataset. [HINT] If you dont need it, use loIgnoreNotExistentFields', [lItem.value]);
end;
MapColumnToTValue(lItem.value, lField, lItem.Key);
end;
@ -1387,7 +1389,8 @@ begin
end;
class function TMVCActiveRecord.Select<T>(const SQL: string; const Params: array of Variant; const Options: TMVCActiveRecordLoadOptions): TObjectList<T>;
class function TMVCActiveRecord.Select<T>(const SQL: string; const Params: array of Variant;
const Options: TMVCActiveRecordLoadOptions): TObjectList<T>;
var
lDataSet: TDataSet;
lAR: TMVCActiveRecord;
@ -1546,13 +1549,13 @@ var
begin
lAR := T.Create;
try
if not SQLWhere.Trim.IsEmpty then
if SQLWhere.Trim.IsEmpty() or SQLWhere.Trim.StartsWith('/*limit*/') or SQLWhere.Trim.StartsWith('/*sort*/') then
begin
Result := Select<T>(lAR.GenerateSelectSQL + ' WHERE ' + SQLWhere, Params);
Result := Select<T>(lAR.GenerateSelectSQL + SQLWhere, Params);
end
else
begin
Result := Select<T>(lAR.GenerateSelectSQL, Params);
Result := Select<T>(lAR.GenerateSelectSQL + ' WHERE ' + SQLWhere, Params);
end;
finally
lAR.Free;

View File

@ -108,6 +108,9 @@ type
SSE_RETRY_DEFAULT = 100;
SSE_LAST_EVENT_ID = 'Last-Event-ID';
URL_MAPPED_PARAMS_ALLOWED_CHARS = ' àèéùòì@\[\]\{\}\(\)\=;&#\.\_\,%\w\d\x2D\x3A';
OneMiB = 1048576;
OneKiB = 1024;
DEFAULT_MAX_REQUEST_SIZE = OneMiB * 5; //5 MiB
end;
TMVCConfigKey = record
@ -127,6 +130,7 @@ type
SessionType = 'session_type';
FallbackResource = 'fallback_resource';
MaxEntitiesRecordCount = 'max_entities_record_count';
MaxRequestSize = 'max_request_size'; //bytes
end;
// http://www.w3.org/Protocols/rfc2616/rfc2616-sec10.html

View File

@ -57,7 +57,7 @@ type
AFieldNamePolicy: TFieldNamePolicy = TFieldNamePolicy.fpLowerCase); overload;
procedure LoadFromJSONArrayString(AJSONArrayString: string;
AFieldNamePolicy: TFieldNamePolicy = TFieldNamePolicy.fpLowerCase); overload;
procedure LoadFromJSONArray(AJSONArray: TJSONArray; AIgnoredFields: TArray<string>;
procedure LoadFromJSONArray(AJSONArray: TJSONArray;
AFieldNamePolicy: TFieldNamePolicy = TFieldNamePolicy.fpLowerCase); overload;
procedure LoadFromJSONObjectString(AJSONObjectString: string); overload;
procedure LoadFromJSONObjectString(AJSONObjectString: string; AIgnoredFields: TArray<string>); overload;
@ -196,23 +196,33 @@ begin
end;
end;
procedure TDataSetHelper.LoadFromJSONArray(AJSONArray: TJSONArray; AIgnoredFields: TArray<string>;
AFieldNamePolicy: TFieldNamePolicy);
begin
Self.DisableControls;
try
raise Exception.Create('Not Implemented');
finally
Self.EnableControls;
end;
end;
procedure TDataSetHelper.LoadFromJSONArrayString(AJSONArrayString: string; AIgnoredFields: TArray<string>;
AFieldNamePolicy: TFieldNamePolicy);
begin
AppendFromJSONArrayString(AJSONArrayString, AIgnoredFields, AFieldNamePolicy);
end;
procedure TDataSetHelper.LoadFromJSONArray(AJSONArray: TJSONArray; AFieldNamePolicy: TFieldNamePolicy);
var
lSerializer: TMVCJsonDataObjectsSerializer;
lBookmark: TArray<Byte>;
begin
lBookmark := Self.Bookmark;
Self.DisableControls;
try
lSerializer := TMVCJsonDataObjectsSerializer.Create;
try
lSerializer.JsonArrayToDataSet(AJSONArray, Self, nil, ncAsIs);
finally
lSerializer.Free;
end;
if Self.BookmarkValid(lBookmark) then
Self.GotoBookmark(lBookmark);
finally
Self.EnableControls;
end;
end;
procedure TDataSetHelper.LoadFromJSONArrayString(AJSONArrayString: string; AFieldNamePolicy: TFieldNamePolicy);
begin
AppendFromJSONArrayString(AJSONArrayString, TArray<string>.Create(), AFieldNamePolicy);
@ -243,17 +253,6 @@ var
begin
lSerializer := TMVCJsonDataObjectsSerializer.Create;
lSerializer.DeserializeDataSetRecord(AJSONObjectString, Self, nil, ncAsIs);
// JV := TJSONObject.ParseJSONValue(AJSONObjectString);
// try
// if JV is TJSONObject then
// LoadFromJSONObject(TJSONObject(JV), AIgnoredFields)
// else
// raise EMapperException.Create
// ('Extected JSONObject in LoadFromJSONObjectString');
// finally
// JV.Free;
// end;
end;
procedure TDataSetHelper.LoadFromJSONObject(AJSONObject: TJSONObject; AFieldNamePolicy: TFieldNamePolicy);
@ -409,4 +408,3 @@ begin
end;
end.

View File

@ -35,8 +35,8 @@ uses
type
IMVCJSONRPCExecutor = interface
['{55415094-9D28-4707-AEC5-5FCF925E82BC}']
function ExecuteRequest(const aJSONRPCRequest: TJSONRPCRequest): TJSONRPCResponse;
procedure ExecuteNotification(const aJSONRPCNotification: TJSONRPCNotification);
function ExecuteRequest(const aJSONRPCRequest: IJSONRPCRequest): IJSONRPCResponse;
procedure ExecuteNotification(const aJSONRPCNotification: IJSONRPCNotification);
// Http headers handling
procedure AddHTTPHeader(const aNetHeader: TNetHeader);
procedure ClearHTTPHeaders;
@ -51,12 +51,12 @@ type
FHTTPRequestHeaders: TList<TNetHeader>;
function GetHTTPRequestHeaders: TList<TNetHeader>;
protected
function InternalExecute(const aJSONRPCObject: TJSONRPCObject): TJSONRPCResponse;
function InternalExecute(const aJSONRPCObject: IJSONRPCObject): IJSONRPCResponse;
public
constructor Create(const aURL: string; const aRaiseExceptionOnError: Boolean = True); virtual;
destructor Destroy; override;
function ExecuteRequest(const aJSONRPCRequest: TJSONRPCRequest): TJSONRPCResponse;
procedure ExecuteNotification(const aJSONRPCNotification: TJSONRPCNotification);
function ExecuteRequest(const aJSONRPCRequest: IJSONRPCRequest): IJSONRPCResponse;
procedure ExecuteNotification(const aJSONRPCNotification: IJSONRPCNotification);
// Http headers handling
procedure AddHTTPHeader(const aNetHeader: TNetHeader);
procedure ClearHTTPHeaders;
@ -69,7 +69,7 @@ uses
System.Classes,
System.SysUtils;
procedure JSONRPCExec(const aJSONRPCURL: string; const aJSONRPCRequest: TJSONRPCRequest; out aJSONRPCResponse: TJSONRPCResponse);
procedure JSONRPCExec(const aJSONRPCURL: string; const aJSONRPCRequest: IJSONRPCRequest; out aJSONRPCResponse: IJSONRPCResponse);
var
lSS: TStringStream;
lHttpResp: IHTTPResponse;
@ -85,14 +85,9 @@ begin
if (lHttpResp.StatusCode <> 204) then
begin
aJSONRPCResponse := TJSONRPCResponse.Create;
try
aJSONRPCResponse.AsJSONString := lHttpResp.ContentAsString;
if Assigned(aJSONRPCResponse.Error) then
raise Exception.CreateFmt('Error [%d]: %s', [aJSONRPCResponse.Error.Code, aJSONRPCResponse.Error.ErrMessage]);
except
aJSONRPCResponse.Free;
raise;
end;
aJSONRPCResponse.AsJSONString := lHttpResp.ContentAsString;
if Assigned(aJSONRPCResponse.Error) then
raise Exception.CreateFmt('Error [%d]: %s', [aJSONRPCResponse.Error.Code, aJSONRPCResponse.Error.ErrMessage]);
end;
finally
lHTTP.Free;
@ -133,13 +128,13 @@ begin
inherited;
end;
procedure TMVCJSONRPCExecutor.ExecuteNotification(const aJSONRPCNotification: TJSONRPCNotification);
procedure TMVCJSONRPCExecutor.ExecuteNotification(const aJSONRPCNotification: IJSONRPCNotification);
begin
if InternalExecute(aJSONRPCNotification as TJSONRPCObject) <> nil then
raise EMVCJSONRPCException.Create('A "notification" cannot returns a response. Use ExecuteRequest instead.');
end;
function TMVCJSONRPCExecutor.ExecuteRequest(const aJSONRPCRequest: TJSONRPCRequest): TJSONRPCResponse;
function TMVCJSONRPCExecutor.ExecuteRequest(const aJSONRPCRequest: IJSONRPCRequest): IJSONRPCResponse;
begin
Result := InternalExecute(aJSONRPCRequest);
end;
@ -165,11 +160,11 @@ begin
end;
end;
function TMVCJSONRPCExecutor.InternalExecute(const aJSONRPCObject: TJSONRPCObject): TJSONRPCResponse;
function TMVCJSONRPCExecutor.InternalExecute(const aJSONRPCObject: IJSONRPCObject): IJSONRPCResponse;
var
lSS: TStringStream;
lHttpResp: IHTTPResponse;
lJSONRPCResponse: TJSONRPCResponse;
lJSONRPCResponse: IJSONRPCResponse;
lCustomHeaders: TNetHeaders;
begin
lCustomHeaders := [];
@ -187,15 +182,10 @@ begin
if (lHttpResp.StatusCode <> HTTP_STATUS.NoContent) then
begin
lJSONRPCResponse := TJSONRPCResponse.Create;
try
lJSONRPCResponse.AsJSONString := lHttpResp.ContentAsString;
if Assigned(lJSONRPCResponse.Error) and FRaiseExceptionOnError then
raise Exception.CreateFmt('Error [%d]: %s', [lJSONRPCResponse.Error.Code, lJSONRPCResponse.Error.ErrMessage]);
Result := lJSONRPCResponse;
except
lJSONRPCResponse.Free;
raise;
end;
lJSONRPCResponse.AsJSONString := lHttpResp.ContentAsString;
if Assigned(lJSONRPCResponse.Error) and FRaiseExceptionOnError then
raise Exception.CreateFmt('Error [%d]: %s', [lJSONRPCResponse.Error.Code, lJSONRPCResponse.Error.ErrMessage]);
Result := lJSONRPCResponse;
end;
finally
lSS.Free;

View File

@ -72,85 +72,139 @@ type
procedure Build(const aJSON: TJsonObject); virtual; abstract;
{ IMVCJSONRPCMessage }
function AsJSONRPCMessage: string;
public
function AsJSON: TJsonObject; virtual;
end;
TJSONRPCObject = class(TObject)
IJSONRPCObject = interface
['{98E161EE-B106-4023-8722-3C2CB1B4CE87}']
procedure SetJsonString(const Value: string);
function GetJSONString: string;
function GetJSON: TJsonObject;
procedure SetJSON(const Value: TJsonObject);
property AsJSON: TJsonObject 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 GetJSON: TJsonObject; virtual;
procedure SetJSON(const Value: TJsonObject); virtual;
public
constructor Create; virtual;
property AsJSON: TJsonObject read GetJSON write SetJSON;
property AsJSONString: string read GetJSONString write SetJsonString;
public
constructor Create; virtual;
end;
TJSONRPCNotification = class(TJSONRPCObject)
protected type
TJSONRPCRequestParams = TList<TValue>;
TJSONRPCRequestParams = TList<TValue>;
IJSONRPCNotification = interface(IJSONRPCObject)
['{FAA65A29-3305-4303-833E-825BDBD3FF7F}']
procedure SetMethod(const Value: string);
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;
procedure SetMethod(const Value: string);
protected
function GetMethod: string;
function GetParams: TJSONRPCRequestParams;
function GetJSON: TJsonObject; override;
property Method: string read GetMethod write SetMethod;
property Params: TJSONRPCRequestParams read GetParams;
public
constructor Create; override;
constructor Create; overload; override;
constructor Create(const aMethod: String); reintroduce; overload;
destructor Destroy; override;
property Method: string read FMethod write SetMethod;
property Params: TJSONRPCRequestParams read FParams;
end;
{$SCOPEDENUMS ON}
TJSONRPCRequestType = (Request, Notification);
TJSONRPCRequest = class(TJSONRPCNotification)
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)
private
FID: TValue;
function GetRequestType: TJSONRPCRequestType;
function GetID: TValue;
protected
procedure SetJSON(const JSON: TJsonObject); override;
function GetJSON: TJsonObject; override;
procedure SetID(const Value: TValue);
public
constructor Create; override;
destructor Destroy; override;
property RequestType: TJSONRPCRequestType read GetRequestType;
property RequestID: TValue read FID write SetID;
property RequestID: TValue read GetID write SetID;
public
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;
TJSONRPCResponse = class(TJSONRPCObject)
private type
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;
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;
function ResultAsJSONObject: TJsonObject;
function ResultAsJSONArray: TJsonArray;
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;
procedure SetID(const Value: TValue);
procedure SetResult(const Value: TValue);
procedure SetError(const Value: TJSONRPCResponseError);
function GetResult: TValue;
protected
function GetJSON: TJsonObject; override;
procedure SetJSON(const JSON: TJsonObject); override;
procedure SetID(const Value: TValue);
procedure SetResult(const Value: TValue);
procedure SetError(const Value: TJSONRPCResponseError);
function GetError: TJSONRPCResponseError;
function GetID: TValue;
function ResultAsJSONObject: TJsonObject;
function ResultAsJSONArray: TJsonArray;
function IsError: Boolean;
property Result: TValue read GetResult write SetResult;
property Error: TJSONRPCResponseError read GetError write SetError;
property RequestID: TValue read GetID write SetID;
public
constructor Create; override;
destructor Destroy; override;
property Result: TValue read FResult write SetResult;
property Error: TJSONRPCResponseError read FError write SetError;
property RequestID: TValue read FID write SetID;
end;
EMVCJSONRPCInvalidVersion = class(Exception)
@ -220,6 +274,11 @@ type
[MVCConsumes(TMVCMediaType.APPLICATION_JSON)]
[MVCProduces(TMVCMediaType.APPLICATION_JSON)]
procedure Index; virtual;
[MVCPath]
[MVCHTTPMethods([httpGET])]
[MVCProduces(TMVCMediaType.TEXT_PLAIN)]
procedure GetProxyCode; virtual;
constructor Create; overload; override;
destructor Destroy; override;
end;
@ -229,15 +288,31 @@ type
constructor Create(const RPCInstance: TObject; const Owns: Boolean = True); reintroduce; overload;
end;
TJSONRPCProxyGenerator = class abstract
public
constructor Create; virtual;
procedure StartGeneration; virtual;
procedure EndGeneration; virtual;
procedure VisitMethod(const aRTTIMethod: TRttiMethod); virtual; abstract;
function GetCode: String; virtual; abstract;
end;
TJSONRPCProxyGeneratorClass = class of TJSONRPCProxyGenerator;
procedure RegisterJSONRPCProxyGenerator(const aLanguage: String; const aClass: TJSONRPCProxyGeneratorClass);
implementation
uses
MVCFramework.Serializer.Intf, MVCFramework.Logger,
System.TypInfo, MVCFramework.DuckTyping,
MVCFramework.Serializer.JsonDataObjects.CustomTypes;
MVCFramework.Serializer.jsondataobjects.CustomTypes;
const
CALL_TYPE: array[mkProcedure..mkFunction] of string = ('PROCEDURE','FUNCTION');
CALL_TYPE: array [mkProcedure .. mkFunction] of string = ('PROCEDURE', 'FUNCTION');
var
GProxyGeneratorsRegister: TDictionary<String, TJSONRPCProxyGeneratorClass>;
function JSONDataValueToTValue(const JSONDataValue: TJsonDataValueHelper): TValue;
begin
@ -260,6 +335,7 @@ begin
end;
jdtObject:
begin
{ TODO -oDanieleT -cGeneral : Can be deserialized in a PODO? }
Result := TJsonObject.Parse(JSONDataValue.ObjectValue.ToJSON) as TJsonObject;
end;
jdtInt:
@ -343,14 +419,15 @@ begin
fOwsRPCInstance := False;
end;
function TMVCJSONRPCController.CreateError(const RequestID: TValue; const ErrorCode: Integer; const message: string): TJsonObject;
function TMVCJSONRPCController.CreateError(const RequestID: TValue; const ErrorCode: Integer; const message: string)
: TJsonObject;
var
lErrResp: TJSONRPCResponse;
begin
lErrResp := TJSONRPCResponse.Create;
try
lErrResp.RequestID := RequestID;
lErrResp.Error := TJSONRPCResponse.TJSONRPCResponseError.Create;
lErrResp.Error := TJSONRPCResponseError.Create;
lErrResp.Error.Code := ErrorCode;
lErrResp.Error.ErrMessage := message;
Result := lErrResp.AsJSON;
@ -363,21 +440,23 @@ function TMVCJSONRPCController.CreateRequest(const JSON: TJsonObject): TJSONRPCR
var
I: Integer;
lParams: TJsonArray;
lReqID: TValue;
lMethodName: String;
begin
try
Result := TJSONRPCRequest.Create;
if JSON.Types[JSONRPC_ID] = jdtString then
Result.RequestID := JSON.S[JSONRPC_ID]
lReqID := JSON.S[JSONRPC_ID]
else if JSON.Types[JSONRPC_ID] = jdtInt then
Result.RequestID := JSON.I[JSONRPC_ID]
lReqID := JSON.I[JSONRPC_ID]
else if JSON.Types[JSONRPC_ID] = jdtLong then
Result.RequestID := JSON.L[JSONRPC_ID]
lReqID := JSON.L[JSONRPC_ID]
else if JSON.Types[JSONRPC_ID] = jdtULong then
Result.RequestID := JSON.U[JSONRPC_ID]
lReqID := JSON.U[JSONRPC_ID]
else
Result.RequestID := TValue.Empty;
lReqID := TValue.Empty;
Result.Method := JSON.S[JSONRPC_METHOD];
lMethodName := JSON.S[JSONRPC_METHOD];
Result := TJSONRPCRequest.Create(lReqID, lMethodName);
if JSON.Types[JSONRPC_PARAMS] = jdtArray then
begin
@ -431,6 +510,54 @@ begin
end;
end;
procedure TMVCJSONRPCController.GetProxyCode;
var
lLanguage: string;
lClass: TJSONRPCProxyGeneratorClass;
lGenerator: TJSONRPCProxyGenerator;
lRTTI: TRTTIContext;
lRTTIType: TRttiType;
lMethod: TRttiMethod;
begin
if not Context.Request.QueryStringParamExists('language') then
begin
raise EMVCJSONRPCException.Create('Query string parameter "language" is required');
end;
lLanguage := Context.Request.Params['language'].ToLower;
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
lRTTIType := lRTTI.GetType(fRPCInstance.ClassType);
lGenerator.StartGeneration();
for lMethod in lRTTIType.GetMethods do
begin
lGenerator.VisitMethod(lMethod);
end;
lGenerator.EndGeneration();
Context.Response.ContentType := 'text/plain';
Render(lGenerator.GetCode);
finally
lRTTI.Free;
end;
finally
lGenerator.Free;
end;
end;
function TMVCJSONRPCController.GetSerializer: TMVCJsonDataObjectsSerializer;
begin
if not Assigned(fSerializer) then
@ -474,20 +601,24 @@ begin
lRTTIMethod := lRTTIType.GetMethod(lMethod);
if Assigned(lRTTIMethod) then
begin
if (lRTTIMethod.Visibility <> mvPublic) or (not (lRTTIMethod.MethodKind in [mkProcedure, mkFunction])) then
if (lRTTIMethod.Visibility <> mvPublic) or (not(lRTTIMethod.MethodKind in [mkProcedure, mkFunction])) then
begin
LogW(Format('Method "%s" cannot be called. Only public functions or procedures can be called. ', [lMethod]));
LogW(Format('Method "%s" cannot be called. Only public functions or procedures can be called. ',
[lMethod]));
raise EMVCJSONRPCMethodNotFound.Create(lMethod);
end;
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');
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
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');
raise EMVCJSONRPCInvalidParams.Create
('Cannot call a function using a JSON-RPC notification. [HINT] Use requests for functions and notifications for procedures');
end;
InjectParams(lJSONRPCReq, lRTTIMethod);
@ -524,7 +655,8 @@ begin
end
else
begin
LogW(Format('Method "%s" has not be found in %s. Only public methods can be invoked.', [lMethod, fRPCInstance.QualifiedClassName]));
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
@ -561,12 +693,12 @@ begin
ResponseStatus(500);
end;
Render(CreateError(lReqID, E.JSONRPCErrorCode, E.message), True);
LogE(Format('[JSON-RPC][CLS %s][ERR %d][MSG "%s"]',[E.ClassName, E.JSONRPCErrorCode,E.Message]));
LogE(Format('[JSON-RPC][CLS %s][ERR %d][MSG "%s"]', [E.ClassName, E.JSONRPCErrorCode, E.message]));
end;
on E: Exception do
begin
Render(CreateError(lReqID, 0, E.message), True);
LogE(Format('[JSON-RPC][CLS %s][MSG "%s"]',[E.ClassName, E.Message]));
LogE(Format('[JSON-RPC][CLS %s][MSG "%s"]', [E.ClassName, E.message]));
end;
end;
end;
@ -586,7 +718,8 @@ end;
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');
inherited Create
('Parse error. Invalid JSON was received by the server. An error occurred on the server while parsing the JSON text');
FJSONRPCErrorCode := -32700;
end;
@ -633,6 +766,18 @@ 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;
@ -683,6 +828,12 @@ begin
end;
end;
constructor TJSONRPCNotification.Create(const aMethod: String);
begin
Create;
Method := aMethod;
end;
destructor TJSONRPCNotification.Destroy;
var
lValue: TValue;
@ -713,6 +864,16 @@ begin
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;
@ -734,6 +895,16 @@ begin
inherited;
end;
function TJSONRPCResponse.GetError: TJSONRPCResponseError;
begin
Result := FError;
end;
function TJSONRPCResponse.GetID: TValue;
begin
Result := FID;
end;
function TJSONRPCResponse.GetJSON: TJsonObject;
begin
Result := inherited;
@ -775,6 +946,26 @@ begin
end;
end;
function TJSONRPCResponse.GetResult: TValue;
begin
Result := FResult;
end;
function TJSONRPCResponse.IsError: Boolean;
begin
Result := Assigned(FError);
end;
function TJSONRPCResponse.ResultAsJSONArray: TJsonArray;
begin
Result := Self.Result.AsObject as TJsonArray;
end;
function TJSONRPCResponse.ResultAsJSONObject: TJsonObject;
begin
Result := Self.Result.AsObject as TJsonObject;
end;
procedure TJSONRPCResponse.SetError(const Value: TJSONRPCResponseError);
begin
FError := Value;
@ -882,18 +1073,23 @@ end;
{ TJSONRPCResponseError }
procedure TJSONRPCResponse.TJSONRPCResponseError.SetCode(const Value: Integer);
procedure TJSONRPCResponseError.SetCode(const Value: Integer);
begin
FCode := Value;
end;
procedure TJSONRPCResponse.TJSONRPCResponseError.SetMessage(const Value: string);
procedure TJSONRPCResponseError.SetMessage(const Value: string);
begin
FMessage := Value;
end;
{ TJSONRPCMessage }
function TJSONRPCRequest.GetID: TValue;
begin
Result := FID;
end;
function TJSONRPCRequest.GetJSON: TJsonObject;
begin
Result := inherited GetJSON;
@ -917,4 +1113,36 @@ begin
end;
{ TJSONRPCProxyGenerator }
constructor TJSONRPCProxyGenerator.Create;
begin
inherited;
end;
procedure RegisterJSONRPCProxyGenerator(const aLanguage: String; const aClass: TJSONRPCProxyGeneratorClass);
begin
if not Assigned(GProxyGeneratorsRegister) then
begin
GProxyGeneratorsRegister := TDictionary<String, TJSONRPCProxyGeneratorClass>.Create();
end;
GProxyGeneratorsRegister.AddOrSetValue(aLanguage.ToLower, aClass);
end;
procedure TJSONRPCProxyGenerator.EndGeneration;
begin
// do nothing
end;
procedure TJSONRPCProxyGenerator.StartGeneration;
begin
// do nothing
end;
initialization
finalization
FreeAndNil(GProxyGeneratorsRegister);
end.

View File

@ -119,7 +119,7 @@ end;
function TRQLFirebirdCompiler.RQLLimitToSQL(const aRQLLimit: TRQLLimit): string;
begin
// firebird ROWS requires Start > 0. Limit function is 0 based, so we have to add 1 to start.
Result := Format(' ROWS %d to %d', [aRQLLimit.Start + 1, aRQLLimit.Start + aRQLLimit.Count]);
Result := Format(' /*limit*/ ROWS %d to %d', [aRQLLimit.Start + 1, aRQLLimit.Start + aRQLLimit.Count]);
end;
function TRQLFirebirdCompiler.RQLLogicOperatorToSQL(const aRQLFIlter: TRQLLogicOperator): string;
@ -159,7 +159,7 @@ function TRQLFirebirdCompiler.RQLSortToSQL(const aRQLSort: TRQLSort): string;
var
I: Integer;
begin
Result := ' ORDER BY';
Result := ' /*sort*/ ORDER BY';
for I := 0 to aRQLSort.Fields.Count - 1 do
begin
if I > 0 then

View File

@ -109,6 +109,7 @@ type
procedure TValueToJsonElement(const Value: TValue; const JSON: TJsonObject; const KeyName: string);
procedure AppendTValueToJsonArray(const Value: TValue; const JSONArr: TJsonArray);
function StringToJSON(const aValue: string): TJsonObject;
procedure JsonObjectToObject(const AJsonObject: TJsonObject; const AObject: TObject; const AType: TMVCSerializationType; const AIgnoredAttributes: TMVCIgnoredList);
implementation
@ -1221,5 +1222,17 @@ begin
end;
end;
procedure JsonObjectToObject(const AJsonObject: TJsonObject; const AObject: TObject; const AType: TMVCSerializationType; const AIgnoredAttributes: TMVCIgnoredList);
var
lSer: TMVCJsonDataObjectsSerializer;
begin
lSer := TMVCJsonDataObjectsSerializer.Create;
try
lSer.JsonObjectToObject(AJsonObject, AObject, AType, AIgnoredAttributes);
finally
lSer.Free;
end;
end;
end.

View File

@ -605,6 +605,7 @@ type
FViewEngineClass: TMVCViewEngineClass;
FWebModule: TWebModule;
FConfig: TMVCConfig;
FConfigCache_MaxRequestSize: Int64;
FSerializers: TDictionary<string, IMVCSerializer>;
FMiddlewares: TList<IMVCMiddleware>;
FControllers: TObjectList<TMVCControllerDelegate>;
@ -619,6 +620,7 @@ type
function GetViewEngineClass: TMVCViewEngineClass;
protected
procedure ConfigDefaultValues; virtual;
procedure SaveCacheConfigValues;
procedure LoadSystemControllers; virtual;
procedure FixUpWebModule;
procedure ExecuteBeforeRoutingMiddleware(const AContext: TWebContext; var AHandled: Boolean);
@ -1587,6 +1589,7 @@ begin
Config[TMVCConfigKey.SessionType] := 'memory';
Config[TMVCConfigKey.IndexDocument] := 'index.html';
Config[TMVCConfigKey.MaxEntitiesRecordCount] := '20';
Config[TMVCConfigKey.MaxRequestSize] := IntToStr(TMVCConstants.DEFAULT_MAX_REQUEST_SIZE);
FMediaTypes.Add('.html', TMVCMediaType.TEXT_HTML);
FMediaTypes.Add('.htm', TMVCMediaType.TEXT_HTML);
@ -1626,7 +1629,7 @@ begin
AConfigAction(FConfig);
LogExitMethod('Custom configuration method');
end;
SaveCacheConfigValues;
RegisterDefaultsSerializers;
LoadSystemControllers;
end;
@ -1663,6 +1666,12 @@ var
begin
Result := False;
ARequest.ReadTotalContent;
if ARequest.ContentLength > fConfigCache_MaxRequestSize then
begin
raise EMVCException.CreateFmt('Request size exceeded the max allowed size [%d KiB]', [(FConfigCache_MaxRequestSize div 1024)]);
end;
LParamsTable := TMVCRequestParamsTable.Create;
try
LContext := TWebContext.Create(ARequest, AResponse, FConfig, FSerializers);
@ -2127,6 +2136,11 @@ begin
Result := SendSessionCookie(AContext, SId);
end;
procedure TMVCEngine.SaveCacheConfigValues;
begin
FConfigCache_MaxRequestSize := StrToInt64Def(Config[TMVCConfigKey.MaxRequestSize], TMVCConstants.DEFAULT_MAX_REQUEST_SIZE);
end;
class function TMVCEngine.SendSessionCookie(const AContext: TWebContext; const ASessionId: string): string;
var
Cookie: TCookie;
@ -2904,3 +2918,4 @@ finalization
FreeAndNil(_MVCGlobalActionParamsCache);
end.