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

[+] Improved ThreadSafeQueue

Browse Source 
[+] Added MVCJSONRPCAllowGET attribute
This commit is contained in:
Daniele Teti 2021-02-23 18:00:32 +01:00
parent 7093035347
commit 244c70084e
15 changed files with 706 additions and 400 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitignore vendored
View File

@ -105,3 +105,4 @@ samples/winecellarclient_mobile/Android64/
samples/middleware_analytics/Win32/
*.txt
unittests/general/Several/bin/pgsql/testdatadir/
unittests/general/Several/Win32/Debug/sqlitetest.db

5
lib/loggerpro/ThreadSafeQueueU.pas
View File

@ -151,7 +151,7 @@ end;
function TThreadSafeQueue<T>.Enqueue(const Item: T): Boolean;
const
cRetryCount: Byte = 5;
cRetryCount: Byte = 20;
var
lCount: Integer;
begin
@ -162,13 +162,12 @@ begin
lCount := 0;
while lCount < cRetryCount do
begin
Sleep(lCount * 10);
Sleep(lCount * lCount * lCount * 10); //let's slow down the enqueue call using a cubic function
fCriticalSection.Enter;
try
if fQueue.Count >= fMaxSize then
begin
Inc(lCount);
// Sleep(lCount * 10);
Continue;
end;
fQueue.Enqueue(Item);

6
samples/jsonrpc_with_published_objects/MainClientFormU.dfm
View File

@ -341,10 +341,14 @@ object MainForm: TMainForm
Top = 202
Width = 304
Height = 367
ActivePage = TabSheet3
ActivePage = TabSheet4
TabOrder = 3
object TabSheet3: TTabSheet
Caption = 'Get DataSet'
ExplicitLeft = 0
ExplicitTop = 0
ExplicitWidth = 0
ExplicitHeight = 0
object edtFilter: TEdit
Left = 3
Top = 5

33
samples/jsonrpc_with_published_objects/MainClientFormU.pas
View File

@ -123,6 +123,7 @@ uses
JsonDataObjects,
MVCFramework.Serializer.Commons,
MVCFramework.Commons,
MVCFramework.Logger,
MVCFramework.Serializer.Defaults,
MVCFramework.DataSet.Utils,
BusinessObjectsU,
@ -131,7 +132,6 @@ uses
{$R *.dfm}
procedure TMainForm.btnAddDayClick(Sender: TObject);
var
lReq: IJSONRPCRequest;
@ -226,7 +226,7 @@ begin
lReq := TJSONRPCRequest.Create(1234);
lReq.Method := 'invalidmethod2';
lReq.Params.Add(1);
lResp := FExecutor.ExecuteRequest('/jsonrpc', lReq);
lResp := FExecutor.ExecuteNotification('/jsonrpc', lReq);
ShowMessage(lResp.Error.ErrMessage);
end;
@ -423,7 +423,7 @@ var
begin
FDMemTable1.Active := False;
lReq := TJSONRPCRequest.Create(Random(1000), 'getmulti');
lResp := FExecutor.ExecuteRequest('/jsonrpc', lReq);
lResp := FExecutor.ExecuteRequest('/jsonrpc', lReq, jrpcGET);
lMultiDS := TMultiDataset.Create;
try
@ -461,7 +461,7 @@ begin
FDMemTable1.Active := False;
lReq := TJSONRPCRequest.Create(Random(1000), 'getcustomers');
lReq.Params.AddByName('FilterString', edtFilter.Text);
lResp := FExecutor.ExecuteRequest('/jsonrpc', lReq);
lResp := FExecutor.ExecuteRequest('/jsonrpc', lReq, jrpcGET);
FDMemTable1.Active := True;
FDMemTable1.LoadFromTValue(lResp.Result);
FDMemTable1.First;
@ -470,10 +470,29 @@ end;
procedure TMainForm.FormCreate(Sender: TObject);
begin
FExecutor := TMVCJSONRPCExecutor.Create('http://localhost:8080');
/// jsonrpc');
// FExecutor2 := TMVCJSONRPCExecutor.Create('http://localhost:8080/rpcdatamodule');
dtNextMonday.Date := Date;
FExecutor.SetOnSendCommand(
procedure(JSONRPCObject: IJSONRPCObject)
begin
Log.Debug('REQUEST : ' + JSONRPCObject.ToString(True), 'jsonrpc');
end);
FExecutor.SetOnReceiveResponse(
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.SetOnReceiveHTTPResponse(
procedure(HTTPResp: IHTTPResponse)
begin
Log.Debug('RESPONSE: ' + HTTPResp.ContentAsString(), 'jsonrpc');
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
Assert(FExecutor.HTTPHeadersCount = 0);

4
samples/jsonrpc_with_published_objects/MyObjectU.pas
View File

@ -36,7 +36,6 @@ uses
MVCFramework.Commons, MVCFramework, MVCFramework.JSONRPC;
type
TMyObject = class
private
function GetCustomersDataset: TFDMemTable;
@ -57,8 +56,11 @@ type
function GetNextMonday(const aDate: TDate): TDate;
function PlayWithDatesAndTimes(const aJustAFloat: Double; const aTime: TTime; const aDate: TDate;
const aDateAndTime: TDateTime): TDateTime;
[MVCJSONRPCAllowGET]
function GetCustomers(FilterString: string): TDataset;
[MVCJSONRPCAllowGET]
function GetMulti: TMultiDataset;
[MVCJSONRPCAllowGET]
function GetStringDictionary: TMVCStringDictionary;
function GetUser(aUserName: string): TPerson;
function SavePerson(const Person: TJsonObject): Integer;

4
samples/wincellarclient_withrestadapter/MainFMX.pas
View File

@ -98,7 +98,7 @@ begin
PrototypeBindSource1.Cancel;
acWineList.Execute;
ChangeTabActionWineList.ExecuteTarget(Sender);
end, nil, nil, true);
end, nil, true);
if Wine.id > 0 then
WineRESTService.UpdateWineById(Wine.id, Wine, AsynchReq)
else
@ -114,7 +114,7 @@ begin
begin
WinesAdapter.SetList(AValue.AsType<TWines>);
WinesAdapter.Active := true;
end, nil, nil, true);
end, nil, true);
WineRESTService.GetWineList(AsynchReq);
end;

18
samples/wincellarclient_withrestadapter/ProjectGroupServerAndClient.groupproj
View File

@ -9,9 +9,6 @@
<Projects Include="..\winecellarserver\WineCellarServer.dproj">
<Dependencies/>
</Projects>
<Projects Include="..\winecellarclient_mobile\WinesClient.dproj">
<Dependencies/>
</Projects>
<Projects Include="..\winecellarclient\WineCellarClient.dproj">
<Dependencies/>
</Projects>
@ -41,15 +38,6 @@
<Target Name="WineCellarServer:Make">
<MSBuild Projects="..\winecellarserver\WineCellarServer.dproj" Targets="Make"/>
</Target>
<Target Name="WinesClient">
<MSBuild Projects="..\winecellarclient_mobile\WinesClient.dproj"/>
</Target>
<Target Name="WinesClient:Clean">
<MSBuild Projects="..\winecellarclient_mobile\WinesClient.dproj" Targets="Clean"/>
</Target>
<Target Name="WinesClient:Make">
<MSBuild Projects="..\winecellarclient_mobile\WinesClient.dproj" Targets="Make"/>
</Target>
<Target Name="WineCellarClient">
<MSBuild Projects="..\winecellarclient\WineCellarClient.dproj"/>
</Target>
@ -60,13 +48,13 @@
<MSBuild Projects="..\winecellarclient\WineCellarClient.dproj" Targets="Make"/>
</Target>
<Target Name="Build">
<CallTarget Targets="WineCellarClientRESTAdapter;WineCellarServer;WinesClient;WineCellarClient"/>
<CallTarget Targets="WineCellarClientRESTAdapter;WineCellarServer;WineCellarClient"/>
</Target>
<Target Name="Clean">
<CallTarget Targets="WineCellarClientRESTAdapter:Clean;WineCellarServer:Clean;WinesClient:Clean;WineCellarClient:Clean"/>
<CallTarget Targets="WineCellarClientRESTAdapter:Clean;WineCellarServer:Clean;WineCellarClient:Clean"/>
</Target>
<Target Name="Make">
<CallTarget Targets="WineCellarClientRESTAdapter:Make;WineCellarServer:Make;WinesClient:Make;WineCellarClient:Make"/>
<CallTarget Targets="WineCellarClientRESTAdapter:Make;WineCellarServer:Make;WineCellarClient:Make"/>
</Target>
<Import Project="$(BDS)\Bin\CodeGear.Group.Targets" Condition="Exists('$(BDS)\Bin\CodeGear.Group.Targets')"/>
</Project>

277
samples/wincellarclient_withrestadapter/WineCellarClientRESTAdapter.dproj
View File

@ -1,13 +1,13 @@
<Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
<PropertyGroup>
<ProjectGuid>{399F33CB-E12B-4804-BAA0-F6E31262A9E7}</ProjectGuid>
<ProjectVersion>18.8</ProjectVersion>
<ProjectVersion>19.1</ProjectVersion>
<FrameworkType>FMX</FrameworkType>
<MainSource>WineCellarClientRESTAdapter.dpr</MainSource>
<Base>True</Base>
<Config Condition="'$(Config)'==''">Debug</Config>
<Platform Condition="'$(Platform)'==''">Win32</Platform>
<TargetedPlatforms>36887</TargetedPlatforms>
<TargetedPlatforms>32787</TargetedPlatforms>
<AppType>Application</AppType>
</PropertyGroup>
<PropertyGroup Condition="'$(Config)'=='Base' or '$(Base)'!=''">
@ -23,16 +23,6 @@
<CfgParent>Base</CfgParent>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="('$(Platform)'=='OSX32' and '$(Base)'=='true') or '$(Base_OSX32)'!=''">
<Base_OSX32>true</Base_OSX32>
<CfgParent>Base</CfgParent>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="('$(Platform)'=='OSX64' and '$(Base)'=='true') or '$(Base_OSX64)'!=''">
<Base_OSX64>true</Base_OSX64>
<CfgParent>Base</CfgParent>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="('$(Platform)'=='Win32' and '$(Base)'=='true') or '$(Base_Win32)'!=''">
<Base_Win32>true</Base_Win32>
<CfgParent>Base</CfgParent>
@ -48,18 +38,6 @@
<CfgParent>Base</CfgParent>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="('$(Platform)'=='OSX32' and '$(Cfg_1)'=='true') or '$(Cfg_1_OSX32)'!=''">
<Cfg_1_OSX32>true</Cfg_1_OSX32>
<CfgParent>Cfg_1</CfgParent>
<Cfg_1>true</Cfg_1>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="('$(Platform)'=='OSX64' and '$(Cfg_1)'=='true') or '$(Cfg_1_OSX64)'!=''">
<Cfg_1_OSX64>true</Cfg_1_OSX64>
<CfgParent>Cfg_1</CfgParent>
<Cfg_1>true</Cfg_1>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="('$(Platform)'=='Win32' and '$(Cfg_1)'=='true') or '$(Cfg_1_Win32)'!=''">
<Cfg_1_Win32>true</Cfg_1_Win32>
<CfgParent>Cfg_1</CfgParent>
@ -89,18 +67,6 @@
<Cfg_2>true</Cfg_2>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="('$(Platform)'=='OSX32' and '$(Cfg_2)'=='true') or '$(Cfg_2_OSX32)'!=''">
<Cfg_2_OSX32>true</Cfg_2_OSX32>
<CfgParent>Cfg_2</CfgParent>
<Cfg_2>true</Cfg_2>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="('$(Platform)'=='OSX64' and '$(Cfg_2)'=='true') or '$(Cfg_2_OSX64)'!=''">
<Cfg_2_OSX64>true</Cfg_2_OSX64>
<CfgParent>Cfg_2</CfgParent>
<Cfg_2>true</Cfg_2>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="('$(Platform)'=='Win32' and '$(Cfg_2)'=='true') or '$(Cfg_2_Win32)'!=''">
<Cfg_2_Win32>true</Cfg_2_Win32>
<CfgParent>Cfg_2</CfgParent>
@ -180,20 +146,6 @@
<DCC_ShowGeneralMessages>true</DCC_ShowGeneralMessages>
<VerInfo_Build>1</VerInfo_Build>
</PropertyGroup>
<PropertyGroup Condition="'$(Base_OSX32)'!=''">
<VerInfo_IncludeVerInfo>true</VerInfo_IncludeVerInfo>
<DCC_UsePackage>fmxhrh;FireDACSqliteDriver;FireDACDSDriver;DBXSqliteDriver;FireDACPgDriver;fmx;IndySystem;tethering;DataSnapClient;DataSnapServer;DataSnapCommon;DBXInterBaseDriver;DataSnapProviderClient;DbxCommonDriver;dbxcds;fmxFireDAC;DBXOracleDriver;dsnap;IndyIPServer;fmxase;IndyCore;CloudService;IndyIPCommon;FireDACIBDriver;DataSnapFireDAC;FireDACDBXDriver;soapserver;dsnapxml;FireDACInfxDriver;FireDACASADriver;bindcompfmx;FireDACODBCDriver;RESTBackendComponents;rtl;dbrtl;DbxClientDriver;FireDACCommon;bindcomp;xmlrtl;DataSnapNativeClient;ibxpress;IndyProtocols;DBXMySQLDriver;FireDACCommonDriver;bindcompdbx;bindengine;soaprtl;FireDAC;DBXInformixDriver;FireDACMSSQLDriver;DataSnapServerMidas;DBXFirebirdDriver;inet;fmxobj;FireDACMySQLDriver;soapmidas;DBXSybaseASADriver;FireDACOracleDriver;fmxdae;RESTComponents;DataSnapIndy10ServerTransport;dbexpress;IndyIPClient;$(DCC_UsePackage)</DCC_UsePackage>
<VerInfo_Keys>CFBundleName=$(MSBuildProjectName);CFBundleDisplayName=$(MSBuildProjectName);CFBundleIdentifier=$(MSBuildProjectName);CFBundleVersion=1.0.0;CFBundlePackageType=APPL;CFBundleSignature=????;CFBundleAllowMixedLocalizations=YES;CFBundleExecutable=$(MSBuildProjectName);NSHighResolutionCapable=true;LSApplicationCategoryType=public.app-category.utilities;NSContactsUsageDescription=The reason for accessing the contacts;CFBundleShortVersionString=1.0.0;NSLocationUsageDescription=The reason for accessing the location information of the user</VerInfo_Keys>
</PropertyGroup>
<PropertyGroup Condition="'$(Base_OSX64)'!=''">
<VerInfo_Keys>CFBundleName=$(MSBuildProjectName);CFBundleDisplayName=$(MSBuildProjectName);CFBundleIdentifier=$(MSBuildProjectName);CFBundleVersion=1.0.0;CFBundlePackageType=APPL;CFBundleSignature=????;CFBundleAllowMixedLocalizations=YES;CFBundleExecutable=$(MSBuildProjectName);NSHighResolutionCapable=true;LSApplicationCategoryType=public.app-category.utilities;NSContactsUsageDescription=The reason for accessing the contacts;CFBundleShortVersionString=1.0.0;NSLocationUsageDescription=The reason for accessing the location information of the user</VerInfo_Keys>
<BT_BuildType>Debug</BT_BuildType>
<VerInfo_IncludeVerInfo>true</VerInfo_IncludeVerInfo>
<Base_OSX32>true</Base_OSX32>
<CfgParent>Base</CfgParent>
<Base>true</Base>
<DCC_UsePackage>fmxhrh;FireDACSqliteDriver;FireDACDSDriver;DBXSqliteDriver;FireDACPgDriver;fmx;IndySystem;tethering;DataSnapClient;DataSnapServer;DataSnapCommon;DBXInterBaseDriver;DataSnapProviderClient;DbxCommonDriver;dbxcds;fmxFireDAC;DBXOracleDriver;dsnap;IndyIPServer;fmxase;IndyCore;CloudService;IndyIPCommon;FireDACIBDriver;DataSnapFireDAC;FireDACDBXDriver;soapserver;dsnapxml;FireDACInfxDriver;FireDACASADriver;bindcompfmx;FireDACODBCDriver;RESTBackendComponents;rtl;dbrtl;DbxClientDriver;FireDACCommon;bindcomp;xmlrtl;DataSnapNativeClient;ibxpress;IndyProtocols;DBXMySQLDriver;FireDACCommonDriver;bindcompdbx;bindengine;soaprtl;FireDAC;DBXInformixDriver;FireDACMSSQLDriver;DataSnapServerMidas;DBXFirebirdDriver;inet;fmxobj;FireDACMySQLDriver;soapmidas;DBXSybaseASADriver;FireDACOracleDriver;fmxdae;RESTComponents;DataSnapIndy10ServerTransport;dbexpress;IndyIPClient;$(DCC_UsePackage);$(DCC_UsePackage)</DCC_UsePackage>
</PropertyGroup>
<PropertyGroup Condition="'$(Base_Win32)'!=''">
<UWP_DelphiLogo44>$(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_44.png</UWP_DelphiLogo44>
<UWP_DelphiLogo150>$(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_150.png</UWP_DelphiLogo150>
@ -219,14 +171,6 @@
<DCC_DebugInfoInExe>true</DCC_DebugInfoInExe>
<DCC_RemoteDebug>true</DCC_RemoteDebug>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_1_OSX32)'!=''">
<BT_BuildType>Debug</BT_BuildType>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_1_OSX64)'!=''">
<Cfg_1_OSX32>true</Cfg_1_OSX32>
<CfgParent>Cfg_1</CfgParent>
<Cfg_1>true</Cfg_1>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_1_Win32)'!=''">
<BT_BuildType>Debug</BT_BuildType>
<VerInfo_Locale>1033</VerInfo_Locale>
@ -252,14 +196,6 @@
<DCC_DebugInformation>0</DCC_DebugInformation>
<VerInfo_Build>1</VerInfo_Build>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_2_OSX32)'!=''">
<BT_BuildType>Debug</BT_BuildType>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_2_OSX64)'!=''">
<Cfg_2_OSX32>true</Cfg_2_OSX32>
<CfgParent>Cfg_2</CfgParent>
<Cfg_2>true</Cfg_2>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_2_Win32)'!=''">
<DCC_ShowGeneralMessages>true</DCC_ShowGeneralMessages>
<VerInfo_IncludeVerInfo>true</VerInfo_IncludeVerInfo>
@ -879,6 +815,32 @@
<Operation>0</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iOS_AppStore1024">
<Platform Name="iOSDevice64">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPad_AppIcon152">
<Platform Name="iOSDevice64">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPad_AppIcon167">
<Platform Name="iOSDevice64">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPad_Launch1024">
<Platform Name="iOSDevice32">
<Operation>1</Operation>
@ -1011,6 +973,16 @@
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPad_Launch2x">
<Platform Name="iOSDevice64">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPad_Launch768">
<Platform Name="iOSDevice32">
<Operation>1</Operation>
@ -1033,6 +1005,66 @@
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPad_LaunchDark2x">
<Platform Name="iOSDevice64">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPad_Notification40">
<Platform Name="iOSDevice64">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPad_Setting58">
<Platform Name="iOSDevice64">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPad_SpotLight80">
<Platform Name="iOSDevice64">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPhone_AppIcon120">
<Platform Name="iOSDevice64">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPhone_AppIcon180">
<Platform Name="iOSDevice64">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPhone_Launch1125">
<Platform Name="iOSDevice32">
<Operation>1</Operation>
@ -1132,6 +1164,16 @@
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPhone_Launch2x">
<Platform Name="iOSDevice64">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPhone_Launch320">
<Platform Name="iOSDevice32">
<Operation>1</Operation>
@ -1143,6 +1185,16 @@
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPhone_Launch3x">
<Platform Name="iOSDevice64">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPhone_Launch640">
<Platform Name="iOSDevice32">
<Operation>1</Operation>
@ -1187,6 +1239,86 @@
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPhone_LaunchDark2x">
<Platform Name="iOSDevice64">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPhone_LaunchDark3x">
<Platform Name="iOSDevice64">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPhone_Notification40">
<Platform Name="iOSDevice64">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPhone_Notification60">
<Platform Name="iOSDevice64">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPhone_Setting58">
<Platform Name="iOSDevice64">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPhone_Setting87">
<Platform Name="iOSDevice64">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPhone_Spotlight120">
<Platform Name="iOSDevice64">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPhone_Spotlight80">
<Platform Name="iOSDevice64">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="ProjectAndroidManifest">
<Platform Name="Android">
<Operation>1</Operation>
@ -1234,6 +1366,16 @@
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="ProjectiOSLaunchScreen">
<Platform Name="iOSDevice64">
<RemoteDir>..\$(PROJECTNAME).launchscreen</RemoteDir>
<Operation>64</Operation>
</Platform>
<Platform Name="iOSSimulator">
<RemoteDir>..\$(PROJECTNAME).launchscreen</RemoteDir>
<Operation>64</Operation>
</Platform>
</DeployClass>
<DeployClass Name="ProjectiOSResource">
<Platform Name="iOSDevice32">
<Operation>1</Operation>
@ -1362,8 +1504,7 @@
<Platforms>
<Platform value="Android">True</Platform>
<Platform value="Android64">True</Platform>
<Platform value="OSX32">True</Platform>
<Platform value="OSX64">True</Platform>
<Platform value="Linux64">False</Platform>
<Platform value="Win32">True</Platform>
<Platform value="Win64">True</Platform>
</Platforms>

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

@ -32,17 +32,20 @@ uses
System.Net.URLClient,
System.Generics.Collections,
System.SysUtils,
MVCFramework.Commons;
MVCFramework.Commons,
JsonDataObjects;
type
IMVCJSONRPCExecutor = interface
['{55415094-9D28-4707-AEC5-5FCF925E82BC}']
function ExecuteRequest(const aJSONRPCRequest: IJSONRPCRequest): IJSONRPCResponse; overload;
function ExecuteRequest(const aLastEndPointSegment: string; const aJSONRPCRequest: IJSONRPCRequest)
: IJSONRPCResponse; overload;
function ExecuteNotification(const aJSONRPCNotification: IJSONRPCNotification): IJSONRPCResponse; overload;
function ExecuteNotification(const aLastEndPointSegment: string; const aJSONRPCNotification: IJSONRPCNotification)
function ExecuteRequest(const aJSONRPCRequest: IJSONRPCRequest; const UseVerb: TJSONRPCHTTPVerb = jrpcDefault)
: IJSONRPCResponse; overload;
function ExecuteRequest(const aLastEndPointSegment: string; const aJSONRPCRequest: IJSONRPCRequest;
const UseVerb: TJSONRPCHTTPVerb = jrpcDefault): IJSONRPCResponse; overload;
function ExecuteNotification(const aJSONRPCNotification: IJSONRPCNotification;
const UseVerb: TJSONRPCHTTPVerb = jrpcDefault): IJSONRPCResponse; overload;
function ExecuteNotification(const aLastEndPointSegment: string; const aJSONRPCNotification: IJSONRPCNotification;
const UseVerb: TJSONRPCHTTPVerb = jrpcDefault): IJSONRPCResponse; overload;
function HTTPResponse: IHTTPResponse;
// Http headers handling
procedure AddHTTPHeader(const aNetHeader: TNetHeader);
@ -56,28 +59,35 @@ type
: IMVCJSONRPCExecutor;
function SetOnValidateServerCertificate(const aOnValidateServerCertificate: TValidateCertificateEvent)
: IMVCJSONRPCExecutor;
function SetOnReceiveHTTPResponse(const aOnReceiveHTTPResponse: TProc<IHTTPResponse>): IMVCJSONRPCExecutor;
function ConfigureHTTPClient(const aConfigProc: TProc<THTTPClient>): IMVCJSONRPCExecutor;
end;
TMVCJSONRPCExecutor = class(TInterfacedObject, IMVCJSONRPCExecutor)
private
fDefaultHTTPVerb: TJSONRPCHTTPVerb;
fURL: string;
fHTTP: THTTPClient;
fRaiseExceptionOnError: Boolean;
fHTTPRequestHeaders: TList<TNetHeader>;
fHTTPResponse: IHTTPResponse;
fOnReceiveResponse: TProc<IJSONRPCObject, IJSONRPCObject>;
fOnReceiveHTTPResponse: TProc<IHTTPResponse>;
fOnSendCommand: TProc<IJSONRPCObject>;
function GetHTTPRequestHeaders: TList<TNetHeader>;
protected
function GetQueryStringParameters(const aJSONRPCObject: IJSONRPCObject): String;
function HTTPResponse: IHTTPResponse;
function InternalExecute(const aEndPoint: string; const aJSONRPCObject: IJSONRPCObject): IJSONRPCResponse;
function ExecuteRequest(const aJSONRPCRequest: IJSONRPCRequest): IJSONRPCResponse; overload;
function ExecuteRequest(const aLastEndPointSegment: string; const aJSONRPCRequest: IJSONRPCRequest)
function InternalExecute(const aEndPoint: string; const aJSONRPCObject: IJSONRPCObject;
const UseVerb: TJSONRPCHTTPVerb): IJSONRPCResponse;
function ExecuteRequest(const aJSONRPCRequest: IJSONRPCRequest; const UseVerb: TJSONRPCHTTPVerb)
: IJSONRPCResponse; overload;
function ExecuteNotification(const aJSONRPCNotification: IJSONRPCNotification): IJSONRPCResponse; overload;
function ExecuteNotification(const aLastEndPointSegment: string; const aJSONRPCNotification: IJSONRPCNotification)
function ExecuteRequest(const aLastEndPointSegment: string; const aJSONRPCRequest: IJSONRPCRequest;
const UseVerb: TJSONRPCHTTPVerb): IJSONRPCResponse; overload;
function ExecuteNotification(const aJSONRPCNotification: IJSONRPCNotification; const UseVerb: TJSONRPCHTTPVerb)
: IJSONRPCResponse; overload;
function ExecuteNotification(const aLastEndPointSegment: string; const aJSONRPCNotification: IJSONRPCNotification;
const UseVerb: TJSONRPCHTTPVerb): IJSONRPCResponse; overload;
// Http headers handling
procedure AddHTTPHeader(const aNetHeader: TNetHeader);
procedure ClearHTTPHeaders;
@ -90,9 +100,11 @@ type
: IMVCJSONRPCExecutor;
function SetOnValidateServerCertificate(const aOnValidateServerCertificate: TValidateCertificateEvent)
: IMVCJSONRPCExecutor;
function SetOnReceiveHTTPResponse(const aOnReceiveHTTPResponse: TProc<IHTTPResponse>): IMVCJSONRPCExecutor;
function ConfigureHTTPClient(const aConfigProc: TProc<THTTPClient>): IMVCJSONRPCExecutor;
public
constructor Create(const aURL: string; const aRaiseExceptionOnError: Boolean = True); virtual;
constructor Create(const aURL: string; const aRaiseExceptionOnError: Boolean = True;
const aDefaultHTTPVerb: TJSONRPCHTTPVerb = jrpcDefault); virtual;
destructor Destroy; override;
end;
@ -113,8 +125,8 @@ begin
lSS.Position := 0;
lHTTP := THTTPClient.Create;
try
lHttpResp := lHTTP.Post(aJSONRPCURL, lSS, nil,
[TNetHeader.Create('content-type', 'application/json'), TNetHeader.Create('accept', 'application/json')]);
lHttpResp := lHTTP.Post(aJSONRPCURL, lSS, nil, [TNetHeader.Create('content-type', 'application/json'),
TNetHeader.Create('accept', 'application/json')]);
if (lHttpResp.StatusCode <> 204) then
begin
aJSONRPCResponse := TJSONRPCResponse.Create;
@ -145,24 +157,22 @@ begin
end;
end;
function TMVCJSONRPCExecutor.ConfigureHTTPClient(
const aConfigProc: TProc<THTTPClient>): IMVCJSONRPCExecutor;
function TMVCJSONRPCExecutor.ConfigureHTTPClient(const aConfigProc: TProc<THTTPClient>): IMVCJSONRPCExecutor;
begin
aConfigProc(fHTTP);
end;
constructor TMVCJSONRPCExecutor.Create(const aURL: string; const aRaiseExceptionOnError: Boolean = True);
constructor TMVCJSONRPCExecutor.Create(const aURL: string; const aRaiseExceptionOnError: Boolean = True;
const aDefaultHTTPVerb: TJSONRPCHTTPVerb = jrpcDefault);
begin
inherited Create;
fRaiseExceptionOnError := aRaiseExceptionOnError;
fURL := aURL;
fDefaultHTTPVerb := aDefaultHTTPVerb;
fHTTP := THTTPClient.Create;
fHTTP.ResponseTimeout := MaxInt;
fHTTPRequestHeaders := nil;
SetOnReceiveResponse(nil)
.SetOnReceiveData(nil)
.SetOnNeedClientCertificate(nil)
.SetOnValidateServerCertificate(nil);
SetOnReceiveResponse(nil).SetOnReceiveData(nil).SetOnNeedClientCertificate(nil).SetOnValidateServerCertificate(nil);
end;
destructor TMVCJSONRPCExecutor.Destroy;
@ -172,14 +182,16 @@ begin
inherited;
end;
function TMVCJSONRPCExecutor.ExecuteNotification(const aJSONRPCNotification: IJSONRPCNotification): IJSONRPCResponse;
function TMVCJSONRPCExecutor.ExecuteNotification(const aJSONRPCNotification: IJSONRPCNotification;
const UseVerb: TJSONRPCHTTPVerb): IJSONRPCResponse;
begin
Result := ExecuteNotification('', aJSONRPCNotification);
Result := ExecuteNotification('', aJSONRPCNotification, UseVerb);
end;
function TMVCJSONRPCExecutor.ExecuteRequest(const aJSONRPCRequest: IJSONRPCRequest): IJSONRPCResponse;
function TMVCJSONRPCExecutor.ExecuteRequest(const aJSONRPCRequest: IJSONRPCRequest; const UseVerb: TJSONRPCHTTPVerb)
: IJSONRPCResponse;
begin
Result := ExecuteRequest('', aJSONRPCRequest);
Result := ExecuteRequest('', aJSONRPCRequest, UseVerb);
end;
function TMVCJSONRPCExecutor.GetHTTPRequestHeaders: TList<TNetHeader>;
@ -191,6 +203,35 @@ begin
Result := fHTTPRequestHeaders;
end;
function TMVCJSONRPCExecutor.GetQueryStringParameters(const aJSONRPCObject: IJSONRPCObject): String;
var
lJObj: TJDOJsonObject;
begin
lJObj := aJSONRPCObject.AsJSON;
try
Result := 'jsonrpc=' + TURI.URLEncode(lJObj.S['jsonrpc']);
Result := Result + '&method=' + TURI.URLEncode(lJObj.S['method']);
if lJObj.Contains('id') then
begin
Result := Result + '&id=' + TURI.URLEncode(lJObj.S['id']);
end;
if lJObj.Contains('params') then
begin
if lJObj.Types['params'] = jdtArray then
begin
Result := Result + '&params=' + TURI.URLEncode(lJObj.A['params'].ToJSON());
end
else
begin
Result := Result + '&params=' + TURI.URLEncode(lJObj.O['params'].ToJSON());
end;
end;
finally
lJObj.Free;
end;
end;
function TMVCJSONRPCExecutor.HTTPHeadersCount: Integer;
begin
if Assigned(fHTTPRequestHeaders) then
@ -203,13 +244,14 @@ begin
end;
end;
function TMVCJSONRPCExecutor.InternalExecute(const aEndPoint: string; const aJSONRPCObject: IJSONRPCObject)
: IJSONRPCResponse;
function TMVCJSONRPCExecutor.InternalExecute(const aEndPoint: string; const aJSONRPCObject: IJSONRPCObject;
const UseVerb: TJSONRPCHTTPVerb): IJSONRPCResponse;
var
lSS: TStringStream;
lHttpResp: IHTTPResponse;
lJSONRPCResponse: IJSONRPCResponse;
lCustomHeaders: TNetHeaders;
lQueryStringParams: string;
begin
lCustomHeaders := [];
if Assigned(fHTTPRequestHeaders) then
@ -226,10 +268,26 @@ begin
fOnSendCommand(aJSONRPCObject);
end;
fHTTPResponse := nil;
lHttpResp := fHTTP.Post(fURL + aEndPoint, lSS, nil,
[TNetHeader.Create('content-type', 'application/json;charset=utf8'),
TNetHeader.Create('accept', 'application/json;charset=utf8')] + lCustomHeaders);
case UseVerb of
jrpcPOST, jrpcDefault:
begin
lHttpResp := fHTTP.Post(fURL + aEndPoint, lSS, nil,
[TNetHeader.Create('content-type', 'application/json;charset=utf8'), TNetHeader.Create('accept',
'application/json;charset=utf8')] + lCustomHeaders);
end;
jrpcGET:
begin
lHttpResp := fHTTP.Get(fURL + aEndPoint + '?' + GetQueryStringParameters(aJSONRPCObject), nil,
[TNetHeader.Create('accept', 'application/json;charset=utf8')] + lCustomHeaders);
end;
end;
fHTTPResponse := lHttpResp;
if Assigned(fOnReceiveHTTPResponse) then
begin
fOnReceiveHTTPResponse(fHTTPResponse);
end;
lJSONRPCResponse := nil;
if lHttpResp.StatusCode = HTTP_STATUS.NoContent then
begin
@ -276,13 +334,19 @@ begin
Result := Self;
end;
function TMVCJSONRPCExecutor.SetOnReceiveData(
const aOnReceiveData: TReceiveDataEvent): IMVCJSONRPCExecutor;
function TMVCJSONRPCExecutor.SetOnReceiveData(const aOnReceiveData: TReceiveDataEvent): IMVCJSONRPCExecutor;
begin
fHTTP.OnReceiveData := aOnReceiveData;
Result := Self;
end;
function TMVCJSONRPCExecutor.SetOnReceiveHTTPResponse(const aOnReceiveHTTPResponse: TProc<IHTTPResponse>)
: IMVCJSONRPCExecutor;
begin
fOnReceiveHTTPResponse := aOnReceiveHTTPResponse;
Result := Self;
end;
function TMVCJSONRPCExecutor.SetOnReceiveResponse(const aOnReceiveResponseProc: TProc<IJSONRPCObject, IJSONRPCObject>)
: IMVCJSONRPCExecutor;
begin
@ -290,8 +354,7 @@ begin
Result := Self;
end;
function TMVCJSONRPCExecutor.SetOnSendCommand(
const aOnSendCommandProc: TProc<IJSONRPCObject>): IMVCJSONRPCExecutor;
function TMVCJSONRPCExecutor.SetOnSendCommand(const aOnSendCommandProc: TProc<IJSONRPCObject>): IMVCJSONRPCExecutor;
begin
fOnSendCommand := aOnSendCommandProc;
Result := Self;
@ -305,15 +368,15 @@ begin
end;
function TMVCJSONRPCExecutor.ExecuteNotification(const aLastEndPointSegment: string;
const aJSONRPCNotification: IJSONRPCNotification): IJSONRPCResponse;
const aJSONRPCNotification: IJSONRPCNotification; const UseVerb: TJSONRPCHTTPVerb): IJSONRPCResponse;
begin
Result := InternalExecute(aLastEndPointSegment, aJSONRPCNotification as TJSONRPCObject);
Result := InternalExecute(aLastEndPointSegment, aJSONRPCNotification as TJSONRPCObject, UseVerb);
end;
function TMVCJSONRPCExecutor.ExecuteRequest(const aLastEndPointSegment: string;
const aJSONRPCRequest: IJSONRPCRequest): IJSONRPCResponse;
function TMVCJSONRPCExecutor.ExecuteRequest(const aLastEndPointSegment: string; const aJSONRPCRequest: IJSONRPCRequest;
const UseVerb: TJSONRPCHTTPVerb): IJSONRPCResponse;
begin
Result := InternalExecute(aLastEndPointSegment, aJSONRPCRequest);
Result := InternalExecute(aLastEndPointSegment, aJSONRPCRequest, UseVerb);
end;
end.

230
sources/MVCFramework.JSONRPC.pas
View File

@ -59,8 +59,8 @@ const
JSONRPC_HOOKS_ON_BEFORE_ROUTING = 'OnBeforeRoutingHook';
JSONRPC_HOOKS_ON_BEFORE_CALL = 'OnBeforeCallHook';
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);
JSONRPC_HOOKS_METHOD_NAMES: array [0 .. 2] of string = (JSONRPC_HOOKS_ON_BEFORE_ROUTING, JSONRPC_HOOKS_ON_BEFORE_CALL,
JSONRPC_HOOKS_ON_AFTER_CALL);
{
http://www.jsonrpc.org/historical/json-rpc-over-http.html#response-codes
@ -81,6 +81,11 @@ const
JSONRPC_ERR_SERVER_ERROR_UPPERBOUND = -32000;
type
TJSONRPCHTTPVerb = (jrpcDefault, jrpcGET, jrpcPOST);
MVCJSONRPCAllowGET = class(TCustomAttribute)
end;
IMVCJSONRPCMessage = interface
['{73B8D463-75E1-404B-8437-EF4B3C950D2F}']
function AsJSONRPCMessage: string;
@ -115,7 +120,7 @@ type
protected
procedure SetJsonString(const Value: string); virtual;
function GetJSONString: string; virtual;
function ToString(const Compact: Boolean): string; reintroduce;
function ToString(const Compact: Boolean): string; reintroduce; virtual;
function GetJSON: TJDOJsonObject; virtual;
procedure SetJSON(const Value: TJDOJsonObject); virtual;
property AsJSON: TJDOJsonObject read GetJSON write SetJSON;
@ -124,8 +129,8 @@ type
constructor Create; virtual;
end;
TJSONRPCParamDataType = (pdtString, pdtInteger, pdtLongInteger, pdTJDOJsonObject, pdtJSONArray,
pdtBoolean, pdtDate, pdtTime, pdtDateTime, pdtFloat, pdtObject);
TJSONRPCParamDataType = (pdtString, pdtInteger, pdtLongInteger, pdTJDOJsonObject, pdtJSONArray, pdtBoolean, pdtDate,
pdtTime, pdtDateTime, pdtFloat, pdtObject);
TJSONRPCRequestParams = class
private
@ -167,8 +172,7 @@ type
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;
procedure AddByName(const Name: string; const Value: TValue; const ParamType: TJSONRPCParamDataType); overload;
end;
IJSONRPCNotification = interface(IJSONRPCObject)
@ -286,6 +290,7 @@ type
FError: TJSONRPCResponseError;
procedure RaiseErrorForNullObject;
protected
function ToString(const Compact: Boolean): string; override;
function GetJSONString: string; override;
procedure SetJsonString(const Value: string); override;
function GetJSON: TJDOJsonObject; override;
@ -373,18 +378,17 @@ type
function GetDeclaredMethod(lMethod: string; lRTTIType: TRttiType): TRTTIMethod;
function GetInheritedMethod(lMethod: string; lRTTIType: TRttiType): TRTTIMethod;
protected
function CreateError(const RequestID: TValue; const ErrorCode: Integer; const Message: string)
: TJDOJsonObject;
function CreateError(const RequestID: TValue; const ErrorCode: Integer; const Message: string): TJDOJsonObject;
function CreateResponse(const RequestID: TValue; const Value: TValue): TJSONRPCResponse;
function CreateRequest(const JSON: TJDOJsonObject): IJSONRPCRequest;
function JSONObjectAs<T: class, constructor>(const JSON: TJDOJsonObject): T;
function CanBeRemotelyInvoked(const RTTIMethod: TRTTIMethod): Boolean;
procedure ForEachInvokableMethod(const aProc: TProc<TRTTIMethod>);
procedure TryToCallMethod(const aRTTIType: TRttiType; const MethodName: string;
const Parameter: TJDOJsonObject);
procedure TryToCallMethod(const aRTTIType: TRttiType; const MethodName: string; const Parameter: TJDOJsonObject);
function GetJSONRPCPayload(const Request: TMVCWebRequest): TJsonObject;
public
[MVCPath]
[MVCHTTPMethods([httpPOST])]
[MVCHTTPMethods([httpPOST, httpGET])]
[MVCConsumes(TMVCMediaType.APPLICATION_JSON)]
[MVCProduces(TMVCMediaType.APPLICATION_JSON)]
procedure Index; virtual;
@ -402,8 +406,7 @@ type
TMVCJSONRPCPublisher = class(TMVCJSONRPCController)
public
constructor Create(const RPCInstance: TObject; const Owns: Boolean = True);
reintroduce; overload;
constructor Create(const RPCInstance: TObject; const Owns: Boolean = True); reintroduce; overload;
end;
TJSONRPCProxyGenerator = class abstract
@ -417,8 +420,7 @@ type
TJSONRPCProxyGeneratorClass = class of TJSONRPCProxyGenerator;
procedure RegisterJSONRPCProxyGenerator(const aLanguage: string;
const aClass: TJSONRPCProxyGeneratorClass);
procedure RegisterJSONRPCProxyGenerator(const aLanguage: string; const aClass: TJSONRPCProxyGeneratorClass);
implementation
@ -520,8 +522,7 @@ begin
begin
lSer := TMVCJsonDataObjectsSerializer.Create;
try
LJObj := lSer.SerializeObjectToJSON(Value.AsObject,
TMVCSerializationType.stProperties, [], nil);
LJObj := lSer.SerializeObjectToJSON(Value.AsObject, TMVCSerializationType.stProperties, [], nil);
JSONArr.Add(LJObj);
finally
lSer.Free;
@ -533,8 +534,8 @@ begin
end;
end;
procedure AppendTValueToJsonObject(const Value: TValue; const Name: string;
const ParamType: TJSONRPCParamDataType; const JSONObj: TJDOJsonObject);
procedure AppendTValueToJsonObject(const Value: TValue; const Name: string; const ParamType: TJSONRPCParamDataType;
const JSONObj: TJDOJsonObject);
var
lSer: TMVCJsonDataObjectsSerializer;
lOrdinalValue: Int64;
@ -590,8 +591,7 @@ begin
begin
lSer := TMVCJsonDataObjectsSerializer.Create;
try
lSer.DataSetToJsonArray(TDataSet(Value.AsObject), JSONObj.A[name],
TMVCNameCase.ncLowerCase, []);
lSer.DataSetToJsonArray(TDataSet(Value.AsObject), JSONObj.A[name], TMVCNameCase.ncLowerCase, []);
finally
lSer.Free;
end
@ -600,8 +600,7 @@ begin
begin
lSer := TMVCJsonDataObjectsSerializer.Create;
try
JSONObj.O[name] := lSer.SerializeObjectToJSON(Value.AsObject,
TMVCSerializationType.stProperties, [], nil);
JSONObj.O[name] := lSer.SerializeObjectToJSON(Value.AsObject, TMVCSerializationType.stProperties, [], nil);
finally
lSer.Free;
end;
@ -660,16 +659,15 @@ begin
Result := RTTIParameter.Name + ': ' + RTTIParameter.ParamType.Name;
end;
procedure JSONDataValueToTValueParam(const JSONDataValue: TJsonDataValueHelper;
const RTTIParameter: TRttiParameter; const JSONRPCRequestParams: TJSONRPCRequestParams);
procedure JSONDataValueToTValueParam(const JSONDataValue: TJsonDataValueHelper; const RTTIParameter: TRttiParameter;
const JSONRPCRequestParams: TJSONRPCRequestParams);
begin
case RTTIParameter.ParamType.TypeKind of
tkString, tkUString {$IF CompilerVersion > 28}, tkAnsiString {$ENDIF}:
begin
if JSONDataValue.Typ <> jdtString then
begin
raise EMVCJSONRPCInvalidParams.Create('Invalid param type for [' +
BuildDeclaration(RTTIParameter) + ']');
raise EMVCJSONRPCInvalidParams.Create('Invalid param type for [' + BuildDeclaration(RTTIParameter) + ']');
end;
JSONRPCRequestParams.Add(JSONDataValue.Value);
end;
@ -728,8 +726,7 @@ begin
end
else if SameText(RTTIParameter.ParamType.Name, TJDOJsonObject.ClassName) then
begin
JSONRPCRequestParams.Add(JSONDataValue.ObjectValue.Clone as TJDOJsonObject,
pdTJDOJsonObject);
JSONRPCRequestParams.Add(JSONDataValue.ObjectValue.Clone as TJDOJsonObject, pdTJDOJsonObject);
end
else
begin
@ -767,8 +764,7 @@ begin
end;
else
begin
raise EMVCJSONRPCInvalidRequest.CreateFmt('Invalid parameter type for [%s]',
[BuildDeclaration(RTTIParameter)]);
raise EMVCJSONRPCInvalidRequest.CreateFmt('Invalid parameter type for [%s]', [BuildDeclaration(RTTIParameter)]);
end;
end;
end;
@ -786,8 +782,7 @@ begin
Result := fJSON.ToJSON();
end;
class procedure TMVCJSONRPCMessage.CheckID(const aJSON: TMVCJSONObject;
out aIsNotification: Boolean);
class procedure TMVCJSONRPCMessage.CheckID(const aJSON: TMVCJSONObject; out aIsNotification: Boolean);
begin
{
id
@ -799,8 +794,7 @@ begin
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');
raise EMVCJSONRPCException.Create('Message is not a notification but its ''id'' property is not valid');
end;
end;
@ -853,8 +847,7 @@ end;
function TMVCJSONRPCController.CanBeRemotelyInvoked(const RTTIMethod: TRTTIMethod): Boolean;
begin
Result := (RTTIMethod.Visibility = mvPublic) and
(RTTIMethod.MethodKind in [mkProcedure, mkFunction]);
Result := (RTTIMethod.Visibility = mvPublic) and (RTTIMethod.MethodKind in [mkProcedure, mkFunction]);
Result := Result and not IsReservedMethodName(RTTIMethod.Name);
end;
@ -865,8 +858,8 @@ begin
fOwsRPCInstance := False;
end;
function TMVCJSONRPCController.CreateError(const RequestID: TValue; const ErrorCode: Integer;
const Message: string): TJDOJsonObject;
function TMVCJSONRPCController.CreateError(const RequestID: TValue; const ErrorCode: Integer; const Message: string)
: TJDOJsonObject;
var
lErrResp: TJSONRPCResponse;
begin
@ -917,8 +910,7 @@ begin
}
end;
function TMVCJSONRPCController.CreateResponse(const RequestID: TValue; const Value: TValue)
: TJSONRPCResponse;
function TMVCJSONRPCController.CreateResponse(const RequestID: TValue; const Value: TValue): TJSONRPCResponse;
begin
Result := TJSONRPCResponse.Create;
Result.RequestID := RequestID;
@ -935,8 +927,7 @@ begin
inherited;
end;
function TMVCJSONRPCController.GetDeclaredMethod(lMethod: string; lRTTIType: TRttiType)
: TRTTIMethod;
function TMVCJSONRPCController.GetDeclaredMethod(lMethod: string; lRTTIType: TRttiType): TRTTIMethod;
var
lRTTIDeclaredMethods: TArray<TRTTIMethod>;
I: Integer;
@ -953,8 +944,7 @@ begin
end;
end;
function TMVCJSONRPCController.GetInheritedMethod(lMethod: string; lRTTIType: TRttiType)
: TRTTIMethod;
function TMVCJSONRPCController.GetInheritedMethod(lMethod: string; lRTTIType: TRttiType): TRTTIMethod;
var
lRTTIMethod: TRTTIMethod;
begin
@ -969,6 +959,34 @@ begin
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;
procedure TMVCJSONRPCController.ForEachInvokableMethod(const aProc: TProc<TRTTIMethod>);
var
lRTTI: TRTTIContext;
@ -976,10 +994,11 @@ var
lRTTIMethodList: TArray<TRTTIMethod>;
lRTTIMethod: TRTTIMethod;
lGeneratedMethods: TList<String>;
function MethodSign(const RTTIMethod: TRttiMethod): String;
function MethodSign(const RTTIMethod: TRTTIMethod): String;
begin
Result := RTTIMethod.ToString.ToLower;
end;
begin
lGeneratedMethods := TList<String>.Create;
@ -1000,9 +1019,8 @@ begin
lRTTIMethodList := lRTTIType.BaseType.GetMethods;
for lRTTIMethod in lRTTIMethodList do
begin
if TMVCSerializerHelper.HasAttribute<MVCInheritableAttribute>(lRTTIMethod) and
CanBeRemotelyInvoked(lRTTIMethod) and
(not lGeneratedMethods.Contains(MethodSign(lRTTIMethod))) then
if TMVCSerializerHelper.HasAttribute<MVCInheritableAttribute>(lRTTIMethod) and CanBeRemotelyInvoked(lRTTIMethod)
and (not lGeneratedMethods.Contains(MethodSign(lRTTIMethod))) then
begin
aProc(lRTTIMethod);
end;
@ -1124,22 +1142,47 @@ var
lJSONResp: TJDOJsonObject;
lBeforeCallHookHasBeenInvoked: Boolean;
lAfterCallHookHasBeenInvoked: Boolean;
lTypeAttrs: TArray<TCustomAttribute>;
lHTTPVerb: TMVCHTTPMethodType;
lAllMethodsCallableWithGET: Boolean;
begin
lBeforeCallHookHasBeenInvoked := False;
lAfterCallHookHasBeenInvoked := False;
lAllMethodsCallableWithGET := False;
lRTTIType := nil;
lReqID := TValue.Empty;
SetLength(lParamsToInject, 0);
lRTTI := TRTTIContext.Create;
try
try
lJSON := StrToJSONObject(Context.Request.Body);
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
if not Assigned(lJSON) then
begin
raise EMVCJSONRPCParseError.Create;
end;
lRTTIType := lRTTI.GetType(fRPCInstance.ClassType);
if lHTTPVerb = httpGET then
begin
lTypeAttrs := lRTTIType.GetAttributes;
lAllMethodsCallableWithGET := (Length(lTypeAttrs) > 0) and
TMVCSerializerHelper.AttributeExists<MVCJSONRPCAllowGET>(lTypeAttrs);
end;
lJSONRPCReq := CreateRequest(lJSON);
lMethod := lJSONRPCReq.Method;
@ -1166,15 +1209,14 @@ begin
if Assigned(lRTTIMethod) then
begin
if (lJSONRPCReq.RequestType = TJSONRPCRequestType.Request) and
(lRTTIMethod.MethodKind <> mkFunction) then
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
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');
@ -1182,19 +1224,27 @@ begin
if not CanBeRemotelyInvoked(lRTTIMethod) then
begin
LogW(Format
('Method [%s] cannot remotely invoked. Only public functions or procedures can be called.',
LogW(Format('Method [%s] cannot remotely invoked. Only public functions or procedures can be called.',
[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;
try
lJSONRPCReq.FillParameters(lJSON, lRTTIMethod);
except
on Ex: EMVCJSONRPCErrorResponse do
begin
raise EMVCJSONRPCInvalidParams.Create('Cannot map all parameters to remote method. ' +
Ex.Message);
raise EMVCJSONRPCInvalidParams.Create('Cannot map all parameters to remote method. ' + Ex.Message);
end;
end;
@ -1289,8 +1339,7 @@ begin
ResponseStatus(500);
end;
lJSONResp := CreateError(lReqID, E.JSONRPCErrorCode, E.Message);
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 Ex: Exception do // use another name for exception variable, otherwise E is nil!!
begin
@ -1331,8 +1380,8 @@ begin
end;
end;
procedure TMVCJSONRPCController.TryToCallMethod(const aRTTIType: TRttiType;
const MethodName: string; const Parameter: TJDOJsonObject);
procedure TMVCJSONRPCController.TryToCallMethod(const aRTTIType: TRttiType; const MethodName: string;
const Parameter: TJDOJsonObject);
var
lHookMethod: TRTTIMethod;
lHookSecondParam: TRttiParameter;
@ -1349,8 +1398,8 @@ begin
begin
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)',
raise EMVCJSONRPCException.CreateFmt('Invalid signature for [%s] Hook method [HINT: procedure ' +
'%s.%s(const Context: TWebContext; const Value: TJDOJsonObject)',
[MethodName, fRPCInstance.ClassName, MethodName]);
end;
@ -1361,20 +1410,21 @@ begin
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)"',
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)"',
[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)',
raise EMVCJSONRPCException.CreateFmt('Invalid signature for [%s] Hook method [HINT: procedure ' +
'%s.%s(const Context: TWebContext; const Value: TJDOJsonObject)',
[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)',
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)',
[MethodName, fRPCInstance.ClassName, MethodName]);
LogD('[JSON-RPC][HOOK][' + fRPCInstance.ClassName + '.' + MethodName + ']');
@ -1426,8 +1476,7 @@ end;
constructor EMVCJSONRPCMethodNotFound.Create(const MethodName: string);
begin
inherited CreateFmt('Method [%s] not found. The method does not exist or is not available.',
[MethodName]);
inherited CreateFmt('Method [%s] not found. The method does not exist or is not available.', [MethodName]);
end;
{ EMVCJSONRPCInvalidParams }
@ -1525,8 +1574,7 @@ begin
inherited;
end;
procedure TJSONRPCNotification.FillParameters(const JSON: TJDOJsonObject;
const RTTIMethod: TRTTIMethod);
procedure TJSONRPCNotification.FillParameters(const JSON: TJDOJsonObject; const RTTIMethod: TRTTIMethod);
var
lRTTIMethodParams: TArray<TRttiParameter>;
lRTTIMethodParam: TRttiParameter;
@ -1534,8 +1582,7 @@ var
lJSONNamedParams: TJDOJsonObject;
I: Integer;
lUseNamedParams: Boolean;
function GetJsonDataValueHelper(const JSONNamedParams: TJsonObject; const JsonPropName: string)
: TJsonDataValueHelper;
function GetJsonDataValueHelper(const JSONNamedParams: TJsonObject; const JsonPropName: string): TJsonDataValueHelper;
var
I: Integer;
lName: string;
@ -1615,8 +1662,7 @@ begin
// named params
for I := 0 to lJSONNamedParams.Count - 1 do
begin
JSONDataValueToTValueParam(GetJsonDataValueHelper(lJSONNamedParams,
lRTTIMethodParams[I].Name.ToLower),
JSONDataValueToTValueParam(GetJsonDataValueHelper(lJSONNamedParams, lRTTIMethodParams[I].Name.ToLower),
{ lJSONNamedParams.Values[lRTTIMethodParams[I].Name.ToLower], }
lRTTIMethodParams[I], Params);
end;
@ -1637,16 +1683,15 @@ begin
begin // positional params
for I := 0 to FParams.Count - 1 do
begin
AppendTValueToJsonArray(FParams.fParamValues[I], FParams.fParamTypes[I],
Result.A[JSONRPC_PARAMS]);
AppendTValueToJsonArray(FParams.fParamValues[I], FParams.fParamTypes[I], Result.A[JSONRPC_PARAMS]);
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]);
AppendTValueToJsonObject(FParams.fParamValues[I], FParams.fParamNames[I], FParams.fParamTypes[I],
Result.O[JSONRPC_PARAMS]);
end;
end;
end;
@ -1804,8 +1849,8 @@ begin
end
else
begin
raise EMVCJSONRPCException.Create('Response message must have ''result'' or ''error''.' +
sLineBreak + 'Raw message is: ' + sLineBreak + JSON.ToJSON());
raise EMVCJSONRPCException.Create('Response message must have ''result'' or ''error''.' + sLineBreak +
'Raw message is: ' + sLineBreak + JSON.ToJSON());
end;
end;
end;
@ -1935,8 +1980,7 @@ begin
inherited;
end;
procedure RegisterJSONRPCProxyGenerator(const aLanguage: string;
const aClass: TJSONRPCProxyGeneratorClass);
procedure RegisterJSONRPCProxyGenerator(const aLanguage: string; const aClass: TJSONRPCProxyGeneratorClass);
begin
if not Assigned(GProxyGeneratorsRegister) then
begin
@ -2217,8 +2261,12 @@ begin
RaiseErrorForNullObject;
end;
constructor EMVCJSONRPCError.CreateFmt(const ErrCode: Integer;
const Msg: string; const Args: array of const);
function TJSONRPCNullResponse.ToString(const Compact: Boolean): string;
begin
Result := '';
end;
constructor EMVCJSONRPCError.CreateFmt(const ErrCode: Integer; const Msg: string; const Args: array of const);
begin
inherited CreateFmt(Msg, Args);
fJSONRPCErrorCode := ErrCode;

8
sources/MVCFramework.Serializer.Commons.pas
View File

@ -190,8 +190,8 @@ type
class function ApplyNameCase(const NameCase: TMVCNameCase; const Value: string): string; static;
class function GetKeyName(const AField: TRttiField; const AType: TRttiType): string; overload; static;
class function GetKeyName(const AProperty: TRttiProperty; const AType: TRttiType): string; overload; static;
class function HasAttribute<T: class>(const AMember: TRttiNamedObject): Boolean; overload; static;
class function HasAttribute<T: class>(const AMember: TRttiNamedObject; out AAttribute: T): Boolean;
class function HasAttribute<T: class>(const AMember: TRttiObject): Boolean; overload; static;
class function HasAttribute<T: class>(const AMember: TRttiObject; out AAttribute: T): Boolean;
overload; static;
class function AttributeExists<T: TCustomAttribute>(const AAttributes: TArray<TCustomAttribute>; out AAttribute: T)
: Boolean; overload; static;
@ -807,7 +807,7 @@ begin
Result := Result.Remove(0, 2).ToLower;
end;
class function TMVCSerializerHelper.HasAttribute<T>(const AMember: TRttiNamedObject): Boolean;
class function TMVCSerializerHelper.HasAttribute<T>(const AMember: TRttiObject): Boolean;
var
Attrs: TArray<TCustomAttribute>;
Attr: TCustomAttribute;
@ -821,7 +821,7 @@ begin
Exit(True);
end;
class function TMVCSerializerHelper.HasAttribute<T>(const AMember: TRttiNamedObject; out AAttribute: T): Boolean;
class function TMVCSerializerHelper.HasAttribute<T>(const AMember: TRttiObject; out AAttribute: T): Boolean;
var
Attrs: TArray<TCustomAttribute>;
Attr: TCustomAttribute;

3
unittests/general/Several/DMVCFrameworkTests.dproj
View File

@ -141,14 +141,13 @@
<VerInfo_Locale>1033</VerInfo_Locale>
<AppEnableRuntimeThemes>true</AppEnableRuntimeThemes>
<DCC_ExeOutput>.\bin</DCC_ExeOutput>
<Debugger_RunParams>--include:lru</Debugger_RunParams>
<Debugger_RunParams>--include:this</Debugger_RunParams>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_5_Win32)'!=''">
<DCC_Define>CI;$(DCC_Define)</DCC_Define>
<VerInfo_Locale>1033</VerInfo_Locale>
<AppEnableRuntimeThemes>true</AppEnableRuntimeThemes>
<DCC_ExeOutput>.\bin</DCC_ExeOutput>
<Debugger_RunParams>--include:this</Debugger_RunParams>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_6)'!=''">
<DCC_Define>LINUX_SERVER;$(DCC_Define)</DCC_Define>

320
unittests/general/Several/LiveServerTestU.pas
View File

@ -137,10 +137,10 @@ type
[Test]
procedure TestBasicAuth01;
[Test]
//[Category('this')]
// [Category('this')]
procedure TestEntityWithArrays;
[Test]
//[Category('this')]
// [Category('this')]
procedure TestEntityWithEmptyArrays;
[Test]
procedure TestBasicAuth02;
@ -257,14 +257,16 @@ type
end;
[TestFixture]
[Category('jsonrpc')]
TJSONRPCServerTest = class(TObject)
protected
FExecutor: IMVCJSONRPCExecutor;
FExecutor2: IMVCJSONRPCExecutor;
FExecutor3: IMVCJSONRPCExecutor;
procedure InitExecutors; virtual;
public
[Setup]
procedure Setup;
procedure Setup; virtual;
[Test]
procedure TestRequestWithoutParams;
[Test]
@ -274,6 +276,7 @@ type
[Test]
procedure TestRequestToNotFoundMethod;
[Test]
[Category('this')]
procedure TestRequestWithParams_I_I_ret_I;
[Test]
procedure TestRequestWithNamedParams_I_I_ret_I;
@ -313,6 +316,13 @@ type
end;
[TestFixture]
[Category('jsonrpc')]
TJSONRPCServerWithGETTest = class(TJSONRPCServerTest)
protected
procedure InitExecutors; override;
end;
implementation
uses
@ -338,7 +348,8 @@ uses
MVCFramework.Serializer.JsonDataObjects.OptionalCustomTypes,
Vcl.Graphics
{$ENDIF}
, TestConstsU, MVCFramework.Tests.Serializer.Entities;
, TestConstsU, MVCFramework.Tests.Serializer.Entities,
MVCFramework.Logger;
function GetServer: string;
begin
@ -397,10 +408,7 @@ begin
procedure(E: Exception)
begin
OK := false;
end)
.AddPathParam('par1', 1)
.AddPathParam('par2', 2)
.AddPathParam('par3', 3)
end).AddPathParam('par1', 1).AddPathParam('par2', 2).AddPathParam('par3', 3)
.Delete('/req/with/params/($par1)/($par2)/($par3)');
// wait for thred finish
@ -435,10 +443,7 @@ begin
end,
procedure(E: Exception)
begin
end)
.AddPathParam('par1', 1)
.AddPathParam('par2', 2)
.AddPathParam('par3', 3)
end).AddPathParam('par1', 1).AddPathParam('par2', 2).AddPathParam('par3', 3)
.Get('/req/with/params/($par1)/($par2)/($par3)');
// wait for thred finish
@ -476,11 +481,7 @@ begin
end,
procedure(E: Exception)
begin
end)
.AddPathParam('par1', 1)
.AddPathParam('par2', 2)
.AddPathParam('par3', 3)
.Post('/echo/($par1)/($par2)/($par3)',
end).AddPathParam('par1', 1).AddPathParam('par2', 2).AddPathParam('par3', 3).Post('/echo/($par1)/($par2)/($par3)',
TSystemJSON.JSONValueToString(System.JSON.TJSONObject.Create(TJSONPair.Create('from client', 'hello world'))));
// wait for thred finish
@ -517,11 +518,7 @@ begin
end,
procedure(E: Exception)
begin
end)
.AddPathParam('par1', 1)
.AddPathParam('par2', 2)
.AddPathParam('par3', 3)
.Put('/echo/($par1)/($par2)/($par3)',
end).AddPathParam('par1', 1).AddPathParam('par2', 2).AddPathParam('par3', 3).Put('/echo/($par1)/($par2)/($par3)',
TSystemJSON.JSONValueToString(System.JSON.TJSONObject.Create(System.JSON.TJSONPair.Create('from client',
'hello world'))));
@ -543,7 +540,7 @@ var
lRes: IMVCRESTResponse;
begin
RESTClient.SetBasicAuthorization('user1', 'user1');
Assert.AreEqual('Basic dXNlcjE6dXNlcjE=', RESTClient.Authorization);
Assert.areEqual('Basic dXNlcjE6dXNlcjE=', RESTClient.Authorization);
lRes := RESTClient.Get('/private/role1');
Assert.areEqual<Integer>(HTTP_STATUS.OK, lRes.StatusCode);
end;
@ -631,7 +628,7 @@ var
lRes: IMVCRESTResponse;
begin
lRes := RESTClient.Get('/privatecustom/role1');
Assert.AreEqual<Integer>(HTTP_STATUS.Unauthorized, lRes.StatusCode);
Assert.areEqual<Integer>(HTTP_STATUS.Unauthorized, lRes.StatusCode);
Assert.areEqual('/system/users/logged', lRes.HeaderValue('X-LOGIN-URL'));
Assert.areEqual('POST', lRes.HeaderValue('X-LOGIN-METHOD'));
@ -686,14 +683,14 @@ begin
lJSON.AddPair('password', 'user1');
lRes := RESTClient.Accept('text/html').Post('/system/users/logged', TSystemJSON.JSONValueToString(lJSON, false));
SplitContentMediaTypeAndCharset(lRes.ContentType, lContentType, lContentCharset);
Assert.AreEqual(lContentType, TMVCMediaType.APPLICATION_JSON);
Assert.areEqual(lContentType, TMVCMediaType.APPLICATION_JSON);
Assert.areEqual<Integer>(HTTP_STATUS.OK, lRes.StatusCode);
Assert.areEqual('/system/users/logged', lRes.HeaderValue('X-LOGOUT-URL'));
Assert.areEqual('DELETE', lRes.HeaderValue('X-LOGOUT-METHOD'));
Assert.areEqual('{"status":"OK"}', lRes.Content);
lCookieValue := lRes.CookieByName(TMVCConstants.SESSION_TOKEN_NAME).Value;
Assert.AreNotEqual('', lCookieValue, 'Session cookie not returned after login');
Assert.isFalse(lCookieValue.Contains('invalid'), 'Returned an invalid session token');
Assert.IsFalse(lCookieValue.Contains('invalid'), 'Returned an invalid session token');
lRes := RESTClient.Get('/privatecustom/role2');
Assert.areEqual<Integer>(HTTP_STATUS.Forbidden, lRes.StatusCode,
@ -714,7 +711,7 @@ begin
lJSON := System.JSON.TJSONObject.Create;
try
// no request body
lRes := RESTClient.AddBody('',TMVCMediaType.APPLICATION_JSON).Post('/system/users/logged');
lRes := RESTClient.AddBody('', TMVCMediaType.APPLICATION_JSON).Post('/system/users/logged');
Assert.areEqual<Integer>(HTTP_STATUS.BadRequest, lRes.StatusCode,
'Empty request body doesn''t return HTTP 400 Bad Request');
@ -777,7 +774,8 @@ begin
Assert.areEqual('', lCustomer.ContactFirst);
Assert.areEqual('', lCustomer.ContactLast);
lCustomer.Logo.SaveToFile('customer_logo_after_received.bmp');
Assert.areEqual('de2a29ec62fc1f0b3abbb6b74223d214', THashMD5.GetHashStringFromFile('customer_logo_after_received.bmp'));
Assert.areEqual('de2a29ec62fc1f0b3abbb6b74223d214',
THashMD5.GetHashStringFromFile('customer_logo_after_received.bmp'));
finally
lCustomer.Free;
end;
@ -788,7 +786,7 @@ var
lRes: IMVCRESTResponse;
lJSON: System.JSON.TJSONObject;
lLogoutUrl: string;
lPass: Boolean;
lPass: boolean;
lCookie: TCookie;
begin
lJSON := System.JSON.TJSONObject.Create;
@ -801,12 +799,12 @@ begin
lLogoutUrl := lRes.HeaderValue('X-LOGOUT-URL');
lRes := RESTClient.Delete(lLogoutUrl);
lPass := False;
lPass := false;
for lCookie in lRes.Cookies do
begin
if lCookie.Value.Contains('invalid') then
begin
lPass := True;
lPass := true;
Break;
end;
end;
@ -939,8 +937,8 @@ var
begin
lObj1 := TEntityWithArray.Create;
try
lObj1.Names := ['one','two','three'];
lObj1.Values := [1,2,3];
lObj1.Names := ['one', 'two', 'three'];
lObj1.Values := [1, 2, 3];
lObj1.Booleans := [true, false];
lBody := GetDefaultSerializer.SerializeObject(lObj1);
@ -949,22 +947,22 @@ begin
try
GetDefaultSerializer.DeserializeObject(lRes.Content, lObj2);
Assert.AreEqual(4, Length(lObj2.Names));
Assert.AreEqual(lObj1.Names[0], lObj2.Names[0]);
Assert.AreEqual(lObj1.Names[1], lObj2.Names[1]);
Assert.AreEqual(lObj1.Names[2], lObj2.Names[2]);
Assert.AreEqual('added', lObj2.Names[3]);
Assert.areEqual(4, Length(lObj2.Names));
Assert.areEqual(lObj1.Names[0], lObj2.Names[0]);
Assert.areEqual(lObj1.Names[1], lObj2.Names[1]);
Assert.areEqual(lObj1.Names[2], lObj2.Names[2]);
Assert.areEqual('added', lObj2.Names[3]);
Assert.AreEqual(4, Length(lObj2.Values));
Assert.AreEqual(lObj1.Values[0], lObj2.Values[0]);
Assert.AreEqual(lObj1.Values[1], lObj2.Values[1]);
Assert.AreEqual(lObj1.Values[2], lObj2.Values[2]);
Assert.AreEqual(99, lObj2.Values[3]);
Assert.areEqual(4, Length(lObj2.Values));
Assert.areEqual(lObj1.Values[0], lObj2.Values[0]);
Assert.areEqual(lObj1.Values[1], lObj2.Values[1]);
Assert.areEqual(lObj1.Values[2], lObj2.Values[2]);
Assert.areEqual(99, lObj2.Values[3]);
Assert.AreEqual(3, Length(lObj2.Booleans));
Assert.AreEqual(lObj1.Booleans[0], lObj2.Booleans[0]);
Assert.AreEqual(lObj1.Booleans[1], lObj2.Booleans[1]);
Assert.AreEqual(True, lObj2.Booleans[2]);
Assert.areEqual(3, Length(lObj2.Booleans));
Assert.areEqual(lObj1.Booleans[0], lObj2.Booleans[0]);
Assert.areEqual(lObj1.Booleans[1], lObj2.Booleans[1]);
Assert.areEqual(true, lObj2.Booleans[2]);
finally
lObj2.Free;
end;
@ -983,19 +981,19 @@ begin
try
lBody := GetDefaultSerializer.SerializeObject(lObj1);
lRes := RESTClient.Post('/entitywitharrays', lBody);
lRes := RESTClient.Post('/entitywitharrays', lBody);
lObj2 := TEntityWithArray.Create;
try
GetDefaultSerializer.DeserializeObject(lRes.Content, lObj2);
Assert.AreEqual(1, Length(lObj2.Names));
Assert.AreEqual('added', lObj2.Names[0]);
Assert.areEqual(1, Length(lObj2.Names));
Assert.areEqual('added', lObj2.Names[0]);
Assert.AreEqual(1, Length(lObj2.Values));
Assert.AreEqual(99, lObj2.Values[0]);
Assert.areEqual(1, Length(lObj2.Values));
Assert.areEqual(99, lObj2.Values[0]);
Assert.AreEqual(1, Length(lObj2.Booleans));
Assert.AreEqual(True, lObj2.Booleans[0]);
Assert.areEqual(1, Length(lObj2.Booleans));
Assert.areEqual(true, lObj2.Booleans[0]);
finally
lObj2.Free;
end;
@ -1054,7 +1052,7 @@ begin
for I := 0 to lJSONArr.Count - 1 do
begin
lJSONObj := lJSONArr.Items[I] as System.JSON.TJSONObject;
Assert.isFalse(lJSONObj.GetValue<string>('firstname').IsEmpty);
Assert.IsFalse(lJSONObj.GetValue<string>('firstname').IsEmpty);
end;
finally
lJSONArr.Free;
@ -1079,17 +1077,15 @@ begin
for lCompType in CompressionTypes do
begin
RESTClient.AcceptEncoding(lCompType);
lRes := RESTClient
.AddQueryStringParam('count', 100)
.Get('/wrappedpeople');
lRes := RESTClient.AddQueryStringParam('count', 100).Get('/wrappedpeople');
Assert.areEqual(CompressionTypeResult[j], lRes.HeaderValue('Content-Encoding'));
lJSONArr := TMVCJsonDataObjectsSerializer.ParseArray(lRes.Content);
try
for I := 0 to lJSONArr.Count - 1 do
begin
Assert.isFalse(lJSONArr.O[I].S['firstname'].IsEmpty);
Assert.isFalse(lJSONArr.O[I].S['lastname'].IsEmpty);
Assert.isFalse(lJSONArr.O[I].S['dob'].IsEmpty);
Assert.IsFalse(lJSONArr.O[I].S['firstname'].IsEmpty);
Assert.IsFalse(lJSONArr.O[I].S['lastname'].IsEmpty);
Assert.IsFalse(lJSONArr.O[I].S['dob'].IsEmpty);
Assert.areEqual<TJsonDataType>(jdtBool, lJSONArr.O[I].Types['married']);
end;
finally
@ -1128,13 +1124,13 @@ begin
lRes := RESTClient.Accept(TMVCMediaType.TEXT_HTML).Get('/static.html');
Assert.areEqual(404, lRes.StatusCode, '/static.html');
lRes := RESTClient.HandleRedirects(False).Accept(TMVCMediaType.TEXT_HTML).Get('/static');
lRes := RESTClient.HandleRedirects(false).Accept(TMVCMediaType.TEXT_HTML).Get('/static');
Assert.areEqual(301, lRes.StatusCode, '/static');
lRes := RESTClient.Accept(TMVCMediaType.TEXT_HTML).Get('/static/');
Assert.areEqual(200, lRes.StatusCode, '/static/');
lRes := RESTClient.HandleRedirects(False).Accept(TMVCMediaType.TEXT_HTML).Get('/static/folder1');
lRes := RESTClient.HandleRedirects(false).Accept(TMVCMediaType.TEXT_HTML).Get('/static/folder1');
Assert.areEqual(301, lRes.StatusCode, '/static/folder1');
lRes := RESTClient.Accept(TMVCMediaType.TEXT_HTML).Get('/static/folder1/');
@ -1202,8 +1198,7 @@ begin
P.LastName := StringOfChar('*', 1000);
P.DOB := EncodeDate(1979, 1, 1);
P.Married := true;
r := RESTClient.Accept(TMVCMediaType.APPLICATION_JSON)
.Post('/objects', GetDefaultSerializer.SerializeObject(P));
r := RESTClient.Accept(TMVCMediaType.APPLICATION_JSON).Post('/objects', GetDefaultSerializer.SerializeObject(P));
finally
P.Free;
end;
@ -1300,8 +1295,7 @@ begin
P.DOB := EncodeDate(1979, 1, 1);
P.Married := true;
try
r := RESTClient.Accept(TMVCMediaType.APPLICATION_JSON)
.Post('/objects', GetDefaultSerializer.SerializeObject(P)
r := RESTClient.Accept(TMVCMediaType.APPLICATION_JSON).Post('/objects', GetDefaultSerializer.SerializeObject(P)
{ Mapper.ObjectToJSONObject(P) }
);
except
@ -1338,10 +1332,7 @@ var
begin
JSON := System.JSON.TJSONObject.Create;
JSON.AddPair('client', 'clientdata');
r := RESTClient
.AddPathParam('par1', 1)
.AddPathParam('par2', 2)
.AddPathParam('par3', 3)
r := RESTClient.AddPathParam('par1', 1).AddPathParam('par2', 2).AddPathParam('par3', 3)
.Post('/echo/($par1)/($par2)/($par3)', TSystemJSON.JSONValueToString(JSON));
JSON := TSystemJSON.StringAsJSONObject(r.Content);
try
@ -1368,16 +1359,14 @@ var
lContentType: string;
lContentCharset: string;
begin
res := RESTClient
.Accept('application/json')
.Post('/testconsumes', TSystemJSON.JSONValueToString(TJSONString.Create('Hello World')),
BuildContentType('application/json', 'utf-8'));
res := RESTClient.Accept('application/json').Post('/testconsumes',
TSystemJSON.JSONValueToString(TJSONString.Create('Hello World')), BuildContentType('application/json', 'utf-8'));
Assert.areEqual<Integer>(HTTP_STATUS.OK, res.StatusCode);
Assert.areEqual('Hello World', res.Content);
SplitContentMediaTypeAndCharset(res.ContentType, lContentType, lContentCharset);
Assert.AreEqual(lContentType, TMVCMediaType.APPLICATION_JSON, True);
Assert.AreEqual(lContentCharset, TMVCCharSet.UTF_8, True);
Assert.areEqual(lContentType, TMVCMediaType.APPLICATION_JSON, true);
Assert.areEqual(lContentCharset, TMVCCharSet.UTF_8, true);
end;
procedure TServerTest.TestProducesConsumes02;
@ -1386,17 +1375,13 @@ var
lContentType: string;
lContentCharset: string;
begin
res := RESTClient
.Accept('text/plain')
.Post('/testconsumes', 'Hello World', 'text/plain');
res := RESTClient.Accept('text/plain').Post('/testconsumes', 'Hello World', 'text/plain');
Assert.areEqual('Hello World', res.Content);
SplitContentMediaTypeAndCharset(res.ContentType, lContentType, lContentCharset);
Assert.AreEqual(lContentType, TMVCMediaType.TEXT_PLAIN, True);
Assert.AreEqual(lContentCharset, TMVCCharSet.UTF_8, True);
Assert.areEqual(lContentType, TMVCMediaType.TEXT_PLAIN, true);
Assert.areEqual(lContentCharset, TMVCCharSet.UTF_8, true);
res := RESTClient
.Accept('text/plain')
.Post('/testconsumes', '{"name": "Daniele"}');
res := RESTClient.Accept('text/plain').Post('/testconsumes', '{"name": "Daniele"}');
Assert.areEqual<Integer>(HTTP_STATUS.NotFound, res.StatusCode);
end;
@ -1406,25 +1391,22 @@ var
lContentType: string;
lContentCharset: string;
begin
res := RESTClient
.Accept(TMVCMediaType.TEXT_PLAIN)
.Post('/testconsumes/textiso8859_1', 'àèéìòù', BuildContentType(TMVCMediaType.TEXT_PLAIN, TMVCCharSet.ISO88591));
res := RESTClient.Accept(TMVCMediaType.TEXT_PLAIN).Post('/testconsumes/textiso8859_1', 'àèéìòù',
BuildContentType(TMVCMediaType.TEXT_PLAIN, TMVCCharSet.ISO88591));
Assert.areEqual<Integer>(HTTP_STATUS.OK, res.StatusCode);
// Assert.AreNotEqual('àèéìòù', res.Content, 'non iso8859-1 text is rendered ok whan should not');
// Assert.AreNotEqual('àèéìòù', res.Content, 'non iso8859-1 text is rendered ok whan should not');
SplitContentMediaTypeAndCharset(res.ContentType, lContentType, lContentCharset);
Assert.AreEqual(lContentType, TMVCMediaType.TEXT_PLAIN);
Assert.AreEqual(lContentCharset, TMVCCharset.ISO88591);
Assert.areEqual(lContentType, TMVCMediaType.TEXT_PLAIN);
Assert.areEqual(lContentCharset, TMVCCharSet.ISO88591);
res := RESTClient
.Accept(TMVCMediaType.TEXT_PLAIN)
.Post('/testconsumes/textiso8859_1', 'this is an iso8859-1 text',
BuildContentType(TMVCMediaType.TEXT_PLAIN, TMVCCharSet.ISO88591));
res := RESTClient.Accept(TMVCMediaType.TEXT_PLAIN).Post('/testconsumes/textiso8859_1', 'this is an iso8859-1 text',
BuildContentType(TMVCMediaType.TEXT_PLAIN, TMVCCharSet.ISO88591));
Assert.areEqual<Integer>(HTTP_STATUS.OK, res.StatusCode);
SplitContentMediaTypeAndCharset(res.ContentType, lContentType, lContentCharset);
Assert.areEqual('this is an iso8859-1 text', res.Content);
Assert.AreEqual(lContentType, TMVCMediaType.TEXT_PLAIN);
Assert.AreEqual(lContentCharset, TMVCCharset.ISO88591);
Assert.areEqual(lContentType, TMVCMediaType.TEXT_PLAIN);
Assert.areEqual(lContentCharset, TMVCCharSet.ISO88591);
end;
procedure TServerTest.TestPUTWithParamsAndJSONBody;
@ -1434,10 +1416,7 @@ var
begin
JSON := System.JSON.TJSONObject.Create;
JSON.AddPair('client', 'clientdata');
r := RESTClient
.AddPathParam('par1', 1)
.AddPathParam('par2', 2)
.AddPathParam('par3', 3)
r := RESTClient.AddPathParam('par1', 1).AddPathParam('par2', 2).AddPathParam('par3', 3)
.Put('/echo/($par1)/($par2)/($par3)', TSystemJSON.JSONValueToString(JSON));
JSON := TSystemJSON.StringAsJSONObject(r.Content);
@ -1456,12 +1435,8 @@ var
begin
JSON := System.JSON.TJSONObject.Create;
JSON.AddPair('client', 'clientdata');
r := RESTClient
.AddHeader(TMVCConstants.X_HTTP_Method_Override, 'PUT')
.AddPathParam('par1', 1)
.AddPathParam('par2', 2)
.AddPathParam('par3', 3)
.Post('/echo/($par1)/($par2)/($par3)', TSystemJSON.JSONValueToString(JSON));
r := RESTClient.AddHeader(TMVCConstants.X_HTTP_Method_Override, 'PUT').AddPathParam('par1', 1).AddPathParam('par2', 2)
.AddPathParam('par3', 3).Post('/echo/($par1)/($par2)/($par3)', TSystemJSON.JSONValueToString(JSON));
JSON := TSystemJSON.StringAsJSONObject(r.Content);
try
@ -1497,10 +1472,7 @@ begin
r := RESTClient.Get('/req/with/params');
Assert.areEqual<Integer>(HTTP_STATUS.NotFound, r.StatusCode, '/req/with/params');
r := RESTClient
.AddPathParam('par1', '1')
.AddPathParam('par2', '2')
.AddPathParam('par3', '3')
r := RESTClient.AddPathParam('par1', '1').AddPathParam('par2', '2').AddPathParam('par3', '3')
.Get('/req/with/params/($par1)/($par2)/($par3)');
Assert.areEqual<Integer>(HTTP_STATUS.OK, r.StatusCode);
@ -1514,25 +1486,15 @@ begin
lJSON.Free;
end;
r := RESTClient
.AddPathParam('par1', 1)
.AddPathParam('par2', 2)
.AddPathParam('par3', 3)
r := RESTClient.AddPathParam('par1', 1).AddPathParam('par2', 2).AddPathParam('par3', 3)
.Post('/req/with/params/($par1)/($par2)/($par3)');
Assert.areEqual<Integer>(HTTP_STATUS.NotFound, r.StatusCode);
r := RESTClient
.AddPathParam('par1', 1)
.AddPathParam('par2', 2)
.AddPathParam('par3', 3)
r := RESTClient.AddPathParam('par1', 1).AddPathParam('par2', 2).AddPathParam('par3', 3)
.Put('/req/with/params/($par1)/($par2)/($par3)');
Assert.areEqual<Integer>(HTTP_STATUS.NotFound, r.StatusCode);
r := RESTClient
.AddPathParam('par1', 1)
.AddPathParam('par2', 2)
.AddPathParam('par3', 3)
r := RESTClient.AddPathParam('par1', 1).AddPathParam('par2', 2).AddPathParam('par3', 3)
.Delete('/req/with/params/($par1)/($par2)/($par3)');
Assert.areEqual<Integer>(HTTP_STATUS.OK, r.StatusCode);
lJSON := TSystemJSON.StringAsJSONObject(r.Content);
@ -1551,13 +1513,10 @@ procedure TServerTest.TestReqWithURLMappedParams(const par1, par2, par3: string)
var
r: IMVCRESTResponse;
begin
r := RESTClient
.AddPathParam('par1', par1)
.AddPathParam('par2', par2)
.AddPathParam('par3', par3)
r := RESTClient.AddPathParam('par1', par1).AddPathParam('par2', par2).AddPathParam('par3', par3)
.Get('/req/with/params/($par1)/($par2)/($par3)');
Assert.areEqual<Integer>(HTTP_STATUS.OK, r.StatusCode,
Format('URL mapped fails for these characters: "%s","%s","%s"', [par1, par2, par3]));
Assert.areEqual<Integer>(HTTP_STATUS.OK, r.StatusCode, Format('URL mapped fails for these characters: "%s","%s","%s"',
[par1, par2, par3]));
end;
procedure TServerTest.TestResponseAccepted;
@ -1636,17 +1595,17 @@ begin
lNullableTest := TNullablesTest.Create();
try
lSer.DeserializeObject(lRes.Content, lNullableTest);
Assert.isFalse(lNullableTest.f_int2.HasValue);
Assert.isFalse(lNullableTest.f_int4.HasValue);
Assert.isFalse(lNullableTest.f_int8.HasValue);
Assert.isFalse(lNullableTest.f_date.HasValue);
Assert.isFalse(lNullableTest.f_time.HasValue);
Assert.isFalse(lNullableTest.f_datetime.HasValue);
Assert.isFalse(lNullableTest.f_bool.HasValue);
Assert.isFalse(lNullableTest.f_float4.HasValue);
Assert.isFalse(lNullableTest.f_float8.HasValue);
Assert.isFalse(lNullableTest.f_string.HasValue);
Assert.isFalse(lNullableTest.f_currency.HasValue);
Assert.IsFalse(lNullableTest.f_int2.HasValue);
Assert.IsFalse(lNullableTest.f_int4.HasValue);
Assert.IsFalse(lNullableTest.f_int8.HasValue);
Assert.IsFalse(lNullableTest.f_date.HasValue);
Assert.IsFalse(lNullableTest.f_time.HasValue);
Assert.IsFalse(lNullableTest.f_datetime.HasValue);
Assert.IsFalse(lNullableTest.f_bool.HasValue);
Assert.IsFalse(lNullableTest.f_float4.HasValue);
Assert.IsFalse(lNullableTest.f_float8.HasValue);
Assert.IsFalse(lNullableTest.f_string.HasValue);
Assert.IsFalse(lNullableTest.f_currency.HasValue);
{ TODO -oDanieleT -cGeneral : Compare streams too }
// Assert.AreEqual('0123456789', lNullableTest.f_blob.Value, 0);
finally
@ -1700,7 +1659,7 @@ begin
lRes := RESTClient.Accept(TMVCMediaType.TEXT_HTML).Get('/static/');
Assert.areEqual(200, lRes.StatusCode, '/static/');
lRes := RESTClient.HandleRedirects(False).Accept(TMVCMediaType.TEXT_HTML).Get('/static');
lRes := RESTClient.HandleRedirects(false).Accept(TMVCMediaType.TEXT_HTML).Get('/static');
Assert.areEqual(301, lRes.StatusCode, '/static');
Assert.areEqual('/static/', lRes.HeaderValue('Location'), 'Wrong redirect');
end;
@ -1857,7 +1816,7 @@ begin
c1.Accept(TMVCMediaType.APPLICATION_JSON);
res := c1.Post('/session/daniele teti'); // imposto un valore in sessione
S := res.HeaderValue('Set-Cookie');
Assert.isFalse(S.Contains('Expires'), 'Session cookie contains "expires" attribute');
Assert.IsFalse(S.Contains('Expires'), 'Session cookie contains "expires" attribute');
res := c1.Get('/session'); // rileggo il valore dalla sessione
Assert.areEqual('daniele teti', res.Content);
c1.Accept(TMVCMediaType.TEXT_PLAIN);
@ -2199,16 +2158,36 @@ end;
{ TJSONRPCServerTest }
procedure TJSONRPCServerTest.Setup;
procedure TJSONRPCServerTest.InitExecutors;
begin
FExecutor := TMVCJSONRPCExecutor.Create('http://' + TEST_SERVER_ADDRESS + ':9999/jsonrpc', false);
FExecutor2 := TMVCJSONRPCExecutor.Create('http://' + TEST_SERVER_ADDRESS + ':9999/jsonrpcclass', false);
FExecutor3 := TMVCJSONRPCExecutor.Create('http://' + TEST_SERVER_ADDRESS + ':9999/jsonrpcclass1', false);
end;
procedure TJSONRPCServerTest.Setup;
begin
InitExecutors;
for var Ex in [FExecutor, FExecutor2, FExecutor3] do
begin
FExecutor.SetOnSendCommand(
procedure(JSONRPCObject: IJSONRPCObject)
begin
LogD('[JSONRPC REQUEST] : ' + JSONRPCObject.ToString(true));
end);
FExecutor.SetOnReceiveHTTPResponse(
procedure(HTTPResp: IHTTPResponse)
begin
LogD('[JSONRPC RESPONSE]: ' + HTTPResp.ContentAsString());
end);
end;
end;
procedure TJSONRPCServerTest.TestHooks;
begin
var lRequest1: IJSONRPCRequest := TJSONRPCRequest.Create(1234, 'request1');
var
lRequest1: IJSONRPCRequest := TJSONRPCRequest.Create(1234, 'request1');
var
lResp := FExecutor3.ExecuteRequest(lRequest1);
Assert.areEqual('OnBeforeRoutingHook|OnBeforeCallHook|OnAfterCallHook',
@ -2219,11 +2198,12 @@ procedure TJSONRPCServerTest.TestHooksNotif;
var
lResp: IJSONRPCResponse;
begin
var lNotif: IJSONRPCNotification := TJSONRPCNotification.Create('Notif1');
var
lNotif: IJSONRPCNotification := TJSONRPCNotification.Create('Notif1');
lResp := FExecutor3.ExecuteNotification(lNotif);
Assert.areEqual('OnBeforeRoutingHook|OnBeforeCallHook|OnAfterCallHook',
FExecutor3.HTTPResponse.HeaderValue['x-history']);
Assert.isFalse(lResp.IsError);
Assert.IsFalse(lResp.IsError);
Assert.WillRaise(
procedure
begin
@ -2235,7 +2215,8 @@ procedure TJSONRPCServerTest.TestHooksNotifWhenOnAfterCallHookRaisesError;
var
lResp: IJSONRPCResponse;
begin
var lNotif: IJSONRPCNotification := TJSONRPCNotification.Create('error_OnAfterCallHook');
var
lNotif: IJSONRPCNotification := TJSONRPCNotification.Create('error_OnAfterCallHook');
lResp := FExecutor3.ExecuteNotification(lNotif);
Assert.areEqual('', FExecutor3.HTTPResponse.HeaderValue['x-history']);
Assert.isTrue(lResp.IsError);
@ -2250,7 +2231,8 @@ procedure TJSONRPCServerTest.TestHooksNotifWhenOnBeforeCallHookRaisesError;
var
lResp: IJSONRPCResponse;
begin
var lNotif: IJSONRPCNotification := TJSONRPCNotification.Create('error_OnBeforeCallHook');
var
lNotif: IJSONRPCNotification := TJSONRPCNotification.Create('error_OnBeforeCallHook');
lResp := FExecutor3.ExecuteNotification(lNotif);
Assert.areEqual('', FExecutor3.HTTPResponse.HeaderValue['x-history']);
Assert.isTrue(lResp.IsError);
@ -2265,7 +2247,8 @@ procedure TJSONRPCServerTest.TestHooksNotifWhenOnBeforeRoutingHookRaisesError;
var
lResp: IJSONRPCResponse;
begin
var lNotif: IJSONRPCNotification := TJSONRPCNotification.Create('error_OnBeforeRoutingHook');
var
lNotif: IJSONRPCNotification := TJSONRPCNotification.Create('error_OnBeforeRoutingHook');
lResp := FExecutor3.ExecuteNotification(lNotif);
Assert.areEqual('', FExecutor3.HTTPResponse.HeaderValue['x-history']);
Assert.isTrue(lResp.IsError);
@ -2280,7 +2263,8 @@ procedure TJSONRPCServerTest.TestHooksWhenMethodRaisesError;
var
lResp: IJSONRPCResponse;
begin
var lRequest1: IJSONRPCRequest := TJSONRPCRequest.Create(1234, 'RequestWithError');
var
lRequest1: IJSONRPCRequest := TJSONRPCRequest.Create(1234, 'RequestWithError');
lResp := FExecutor3.ExecuteRequest(lRequest1);
Assert.areEqual('OnBeforeRoutingHook|OnBeforeCallHook|OnAfterCallHook|error',
FExecutor3.HTTPResponse.HeaderValue['x-history']);
@ -2289,7 +2273,8 @@ end;
procedure TJSONRPCServerTest.TestHooksWhenOnAfterCallHookRaisesError;
begin
var lRequest1: IJSONRPCRequest := TJSONRPCRequest.Create(1234, 'error_OnAfterCallHook');
var
lRequest1: IJSONRPCRequest := TJSONRPCRequest.Create(1234, 'error_OnAfterCallHook');
var
lResp := FExecutor3.ExecuteRequest(lRequest1);
Assert.isTrue(lResp.IsError, lResp.ToString(true));
@ -2298,7 +2283,8 @@ end;
procedure TJSONRPCServerTest.TestHooksWhenOnBeforeCallHookRaisesError;
begin
var lRequest1: IJSONRPCRequest := TJSONRPCRequest.Create(1234, 'error_OnBeforeCallHook');
var
lRequest1: IJSONRPCRequest := TJSONRPCRequest.Create(1234, 'error_OnBeforeCallHook');
var
lResp := FExecutor3.ExecuteRequest(lRequest1);
Assert.isTrue(lResp.IsError, lResp.ToString(true));
@ -2308,7 +2294,8 @@ end;
procedure TJSONRPCServerTest.TestHooksWhenOnBeforeRoutingHookRaisesError;
begin
var lRequest1: IJSONRPCRequest := TJSONRPCRequest.Create(1234, 'error_OnBeforeRoutingHook');
var
lRequest1: IJSONRPCRequest := TJSONRPCRequest.Create(1234, 'error_OnBeforeRoutingHook');
var
lResp := FExecutor3.ExecuteRequest(lRequest1);
Assert.isTrue(lResp.IsError, lResp.ToString(true));
@ -2445,7 +2432,7 @@ begin
lReq.Method := 'MyRequest';
lReq.RequestID := 1234;
lResp := FExecutor.ExecuteRequest(lReq);
Assert.isFalse(lResp.IsError);
Assert.IsFalse(lResp.IsError);
Assert.isTrue(lResp.Result.AsBoolean);
end;
@ -2461,12 +2448,12 @@ begin
lReq.Params.Add(8);
lResp := FExecutor.ExecuteRequest(lReq);
Assert.areEqual(10, lResp.Result.AsInteger);
Assert.areEqual(1234, lResp.RequestID.AsInteger);
Assert.areEqual(10, lResp.Result.AsInteger, '(step1.1)');
Assert.areEqual(1234, lResp.RequestID.AsInteger, '(step1.2)');
lResp := FExecutor2.ExecuteRequest(lReq);
Assert.areEqual(10, lResp.Result.AsInteger);
Assert.areEqual(1234, lResp.RequestID.AsInteger);
Assert.areEqual(10, lResp.Result.AsInteger, '(step2.1)');
Assert.areEqual(1234, lResp.RequestID.AsInteger, '(step2.2)');
end;
procedure TJSONRPCServerTest.TestRequestWithParams_I_I_ret_A;
@ -2536,7 +2523,7 @@ begin
lReq.Params.AddByName('Multiplier', 4);
lReq.RequestID := 1234;
lRPCResp := FExecutor.ExecuteRequest(lReq);
Assert.isFalse(lRPCResp.IsError);
Assert.IsFalse(lRPCResp.IsError);
Assert.areEqual('DanieleDanieleDanieleDaniele', lRPCResp.Result.AsString);
lRPCResp := FExecutor2.ExecuteRequest(lReq);
@ -2560,9 +2547,22 @@ begin
Assert.areEqual('DanieleDanieleDanieleDaniele', lRPCResp.Result.AsString);
end;
{ TJSONRPCServerWithGETTest }
procedure TJSONRPCServerWithGETTest.InitExecutors;
begin
FExecutor := TMVCJSONRPCExecutor.Create('http://' + TEST_SERVER_ADDRESS + ':9999/jsonrpcwithget',
false, jrpcGet);
FExecutor2 := TMVCJSONRPCExecutor.Create('http://' + TEST_SERVER_ADDRESS + ':9999/jsonrpcclasswithget',
false, jrpcGet);
FExecutor3 := TMVCJSONRPCExecutor.Create('http://' + TEST_SERVER_ADDRESS + ':9999/jsonrpcclass1withget',
false, jrpcGet);
end;
initialization
TDUnitX.RegisterTestFixture(TServerTest);
TDUnitX.RegisterTestFixture(TJSONRPCServerTest);
TDUnitX.RegisterTestFixture(TJSONRPCServerWithGETTest);
end.

44
unittests/general/TestServer/TestServerControllerJSONRPCU.pas
View File

@ -8,24 +8,46 @@ uses
type
TTestJSONRPCController = class(TMVCJSONRPCController)
public
[MVCInheritable]
function Subtract(Value1, Value2: Int64): Integer;
[MVCInheritable]
procedure MyNotify;
[MVCInheritable]
function MyRequest: Boolean;
[MVCInheritable]
function Add(Value1, Value2, Value3: Int64): TJsonObject;
[MVCInheritable]
function GetListFromTo(aFrom, aTo: Int64): TJsonArray;
[MVCInheritable]
function MultiplyString(aString: string; Multiplier: Int64): string;
end;
[MVCJSONRPCAllowGET]
TTestJSONRPCControllerWithGet = class(TTestJSONRPCController)
end;
TTestJSONRPCClass = class(TObject)
public
[MVCInheritable]
function Subtract(Value1, Value2: Int64): Integer;
[MVCInheritable]
procedure MyNotify;
[MVCInheritable]
function Add(Value1, Value2, Value3: Int64): TJsonObject;
[MVCInheritable]
function GetListFromTo(aFrom, aTo: Int64): TJsonArray;
[MVCInheritable]
function MultiplyString(aString: string; Multiplier: Int64): string;
[MVCInheritable]
function AddTimeToDateTime(aDateTime: TDateTime; aTime: TTime): TDateTime;
end;
[MVCJSONRPCAllowGET]
TTestJSONRPCClassWithGET = class(TTestJSONRPCClass)
end;
TTestJSONRPCHookClass = class(TObject)
private
fJSONReq: TJsonObject;
@ -35,16 +57,27 @@ type
procedure OnBeforeRoutingHook(const Context: TWebContext; const JSON: TJsonObject);
procedure OnBeforeCallHook(const Context: TWebContext; const JSON: TJsonObject);
procedure OnAfterCallHook(const Context: TWebContext; const JSON: TJsonObject);
[MVCInheritable]
function error_OnBeforeRoutingHook: Boolean;
[MVCInheritable]
function error_OnBeforeCallHook: Boolean;
[MVCInheritable]
function error_OnAfterCallHook: Boolean;
[MVCInheritable]
procedure Notif1;
[MVCInheritable]
procedure NotifWithError;
[MVCInheritable]
function Request1: string;
[MVCInheritable]
function RequestWithError: string;
end;
[MVCJSONRPCAllowGET]
TTestJSONRPCHookClassWithGet = class(TTestJSONRPCHookClass)
end;
implementation
uses
@ -67,8 +100,7 @@ begin
Result.Add(I);
end;
function TTestJSONRPCController.MultiplyString(aString: string;
Multiplier: Int64): string;
function TTestJSONRPCController.MultiplyString(aString: string; Multiplier: Int64): string;
var
I: Integer;
begin
@ -103,8 +135,7 @@ begin
Result.I['res'] := Value1 + Value2 + Value3;
end;
function TTestJSONRPCClass.AddTimeToDateTime(aDateTime: TDateTime;
aTime: TTime): TDateTime;
function TTestJSONRPCClass.AddTimeToDateTime(aDateTime: TDateTime; aTime: TTime): TDateTime;
begin
Result := aDateTime + aTime;
end;
@ -118,8 +149,7 @@ begin
Result.Add(I);
end;
function TTestJSONRPCClass.MultiplyString(aString: string;
Multiplier: Int64): string;
function TTestJSONRPCClass.MultiplyString(aString: string; Multiplier: Int64): string;
var
I: Integer;
begin

12
unittests/general/TestServer/WebModuleUnit.pas
View File

@ -87,6 +87,7 @@ begin
.AddController(TTestServerControllerActionFilters)
.AddController(TTestPrivateServerControllerCustomAuth)
.AddController(TTestJSONRPCController, '/jsonrpc')
.AddController(TTestJSONRPCControllerWithGet, '/jsonrpcwithget')
.PublishObject(
function: TObject
begin
@ -94,9 +95,20 @@ begin
end, '/jsonrpcclass')
.PublishObject(
function: TObject
begin
Result := TTestJSONRPCClassWithGET.Create
end, '/jsonrpcclasswithget')
.PublishObject(
function: TObject
begin
Result := TTestJSONRPCHookClass.Create
end, '/jsonrpcclass1')
.PublishObject(
function: TObject
begin
Result := TTestJSONRPCHookClassWithGet.Create
end, '/jsonrpcclass1withget')
.AddController(TTestFaultController) // this will raise an exception
.AddController(TTestFault2Controller,
function: TMVCController