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

JSON-RPC named parameters support

Browse Source
This commit is contained in:
Daniele Teti 2020-05-02 16:39:32 +02:00
parent c9e3525b2a
commit ddc5f4d97d
15 changed files with 691 additions and 213 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

136
README.md
View File

@ -278,17 +278,16 @@ end;
>ObjectDict is the suggested way to renders data. However, the other ones are still there and works as usual.
- New! Added SQLGenerator and RQL compiler for PostgreSQL, SQLite and MSSQLServer (in addition to MySQL, MariaDB, Firebird and Interbase)
- New! *MVCNameAs* attribute got the param `Fixed` (default: false). If Fixed is true, then the name is not processed by the `MVCNameCase` attribute assigned to the owner type.
- New! *MVCNameAs* attribute got the param `Fixed` (default: false). If `Fixed` is true, then the name is not processed by the `MVCNameCase` attribute assigned to the owner type.
- New! Added support for interfaces serialization - now it is possible to serialize Spring4D collections (thanks to [João Antônio Duarte](https://github.com/joaoduarte19))
- New! Added support for Spring4D Nullable Types - check (thanks to [João Antônio Duarte](https://github.com/joaoduarte19))
- New! Added `OnRouterLog` event to log custom information for each request (thanks to [Andrea Ciotti](https://github.com/andreaciotti) for the first implementation and its PR)
- New! Optionally load system controllers (those who provide `/describeserver.info`, `/describeplatform.info` and `/serverconfig.info` system actions) setting `Config[TMVCConfigKey.LoadSystemControllers] := 'false';` in the configuration block.
- Added `TMVCJSONRPCExecutor.ConfigHTTPClient` to fully customize the inner `THTTPClient` (e.g. `ConnectionTimeout`, `ResponseTimeout` and so on)
- Improved! Now the router consider `Accept:*/*` compatible for every `MVCProduces` values
- Improved! Greatly improved support for [HATEOAS](https://en.wikipedia.org/wiki/HATEOAS) in renders. Check `TRenderSampleController.GetPeople_AsObjectList_HATEOS` and all the others actions end with `HATEOS` in `renders.dproj` sample)
```delphi
//Now is really easy to add "_links" property automatically for each collection element while rendering
//Now is really easy to add "links" property automatically for each collection element while rendering
Render<TPerson>(People, True,
procedure(const APerson: TPerson; const Links: IMVCLinks)
begin
@ -369,24 +368,6 @@ end;
- Improved! Exceptions rendering while using MIME types different to `application/json`.
- Improved! JSONRPC Automatic Object Publishing can not invoke inherited methods if not explicitly defined with `MVCInheritable` attribute.
- New! JSONRPC Hooks for published objects
```delphi
//Called before as soon as the HTTP arrives
procedure TMyPublishedObject.OnBeforeRouting(const JSON: TJDOJsonObject);
//Called before the invoked method
procedure TMyPublishedObject.OnBeforeCall(const JSONRequest: TJDOJsonObject);
//Called just before to send response to the client
procedure TMyPublishedObject.OnBeforeSendResponse(const JSONResponse: TJDOJsonObject);
```
- SSL Server support for `TMVCListener` (Thanks to [Sven Harazim](https://github.com/landrix))
- Improved! Datasets serialization speed improvement. In some case the performance [improves of 2 order of magnitude](https://github.com/danieleteti/delphimvcframework/issues/205#issuecomment-479513158). (Thanks to https://github.com/pedrooliveira01)
@ -397,8 +378,6 @@ end;
- New! `TMVCActiveRecord` can handle non autogenerated primary key.
- New! Calling `<jsonrpcendpoint>/describe` returns the methods list available for that endpoint.
- New! Experimental (alpha stage) support for Android servers!
- New! Added support for `X-HTTP-Method-Override` to work behind corporate firewalls.
@ -479,55 +458,69 @@ end;
- New! The **MVCAREntitiesGenerator** can optionally register all the generated entities also in the `ActiveRecordMappingRegistry` (Thanks to [Fabrizio Bitti](https://twitter.com/fabriziobitti) from [bit Time Software](http://www.bittime.it))
- Fixed! [issue38](https://github.com/danieleteti/delphimvcframework/issues/38)
- **JSON-RPC Improvements**
- Fixed! [issue184](https://github.com/danieleteti/delphimvcframework/issues/184)
- New! Added `TMVCJSONRPCExecutor.ConfigHTTPClient` to fully customize the inner `THTTPClient` (e.g. `ConnectionTimeout`, `ResponseTimeout` and so on)
- Fixed! [issue278](https://github.com/danieleteti/delphimvcframework/issues/278)
- Improved! JSONRPC Automatic Object Publishing can not invoke inherited methods if not explicitly defined with `MVCInheritable` attribute.
- Fixed! [issue164](https://github.com/danieleteti/delphimvcframework/issues/164)
- New! Calling `<jsonrpcendpoint>/describe` returns the methods list available for that endpoint.
- Fixed! [issue182](https://github.com/danieleteti/delphimvcframework/issues/182)
- New! Full support for named parameters in JSON-RPC call (server and client)
- Fixed! [issue232](https://github.com/danieleteti/delphimvcframework/issues/232) (Thanks to [João Antônio Duarte](https://github.com/joaoduarte19))
- Positional parameters example
- Fixed! [issue289](https://github.com/danieleteti/delphimvcframework/issues/289) (Thanks to [João Antônio Duarte](https://github.com/joaoduarte19))
```delphi
procedure TMainForm.btnSubtractClick(Sender: TObject);
var
lReq: IJSONRPCRequest;
lResp: IJSONRPCResponse;
begin
lReq := TJSONRPCRequest.Create;
lReq.Method := 'subtract';
lReq.RequestID := Random(1000);
lReq.Params.Add(StrToInt(edtValue1.Text));
lReq.Params.Add(StrToInt(edtValue2.Text));
lResp := FExecutor.ExecuteRequest(lReq);
edtResult.Text := lResp.Result.AsInteger.ToString;
end;
```
- Fixed! [issue291](https://github.com/danieleteti/delphimvcframework/issues/291) (Thanks to [João Antônio Duarte](https://github.com/joaoduarte19))
- Named parameters example
- Fixed! [issue305](https://github.com/danieleteti/delphimvcframework/issues/305) (Thanks to [João Antônio Duarte](https://github.com/joaoduarte19))
```delphi
procedure TMainForm.btnSubtractWithNamedParamsClick(Sender: TObject);
var
lReq: IJSONRPCRequest;
lResp: IJSONRPCResponse;
begin
lReq := TJSONRPCRequest.Create;
lReq.Method := 'subtract';
lReq.RequestID := Random(1000);
lReq.Params.AddByName('Value1', StrToInt(Edit1.Text));
lReq.Params.AddByName('Value2', StrToInt(Edit2.Text));
lResp := FExecutor.ExecuteRequest(lReq);
Edit3.Text := lResp.Result.AsInteger.ToString;
end;
```
- Fixed! [issue312](https://github.com/danieleteti/delphimvcframework/issues/312)
- Check [official JSONRPC 2.0 documentation](https://www.jsonrpc.org/specification#examples) for more examples.
- Fixed! [issue330](https://github.com/danieleteti/delphimvcframework/issues/330)
- New! JSONRPC Hooks for published objects
- Fixed! [issue333](https://github.com/danieleteti/delphimvcframework/issues/333)
```delphi
//Called before as soon as the HTTP arrives
procedure TMyPublishedObject.OnBeforeRouting(const JSON: TJDOJsonObject);
- Fixed! [issue334](https://github.com/danieleteti/delphimvcframework/issues/334)
//Called before the invoked method
procedure TMyPublishedObject.OnBeforeCall(const JSONRequest: TJDOJsonObject);
- Fixed! [issue336](https://github.com/danieleteti/delphimvcframework/issues/336)
//Called just before to send response to the client
procedure TMyPublishedObject.OnBeforeSendResponse(const JSONResponse: TJDOJsonObject);
- Fixed! [issue337](https://github.com/danieleteti/delphimvcframework/issues/337)
```
- Fixed! [issue338](https://github.com/danieleteti/delphimvcframework/issues/338)
- Fixed! [issue345](https://github.com/danieleteti/delphimvcframework/issues/345)
- Fixed! [issue349](https://github.com/danieleteti/delphimvcframework/issues/349)
- Fixed! [issue350](https://github.com/danieleteti/delphimvcframework/issues/350)
- Fixed! [issue355](https://github.com/danieleteti/delphimvcframework/issues/355)
- Fixed! [issue356](https://github.com/danieleteti/delphimvcframework/issues/356)
- Fixed! [issue362](https://github.com/danieleteti/delphimvcframework/issues/362)
- Fixed! [issue363](https://github.com/danieleteti/delphimvcframework/issues/363)
- Fixed! [issue364](https://github.com/danieleteti/delphimvcframework/issues/364) (Thanks to [João Antônio Duarte](https://github.com/joaoduarte19))
- Fixed! [issue366](https://github.com/danieleteti/delphimvcframework/issues/366)
- **Breaking Change!** In `MVCActiveRecord` attribute `MVCPrimaryKey` has been removed and merged with `MVCTableField`, so now `TMVCActiveRecordFieldOption` is a set of `foPrimaryKey`, `foAutoGenerated`, `foTransient` (check `activerecord_showcase.dproj` sample).
@ -535,8 +528,6 @@ end;
- **Deprecated!** `TDataSetHolder` is deprecated! Use the shining new `ObjectDict(boolean)` instead.
- Fixed! Has been patched a serious security bug affecting deployment configurations which uses internal WebServer to serve static files (do not affect all Apache, IIS or proxied deployments). Thanks to **Stephan Munz** to have discovered it. *Update to dmvcframework-3.2-RC5+ is required for all such kind of deployments.*
- Added ability to serialize/deserialize types enumerated by an array of mapped values (Thanks to [João Antônio Duarte](https://github.com/joaoduarte19))
```delphi
@ -581,6 +572,35 @@ end;
|Delphi 10.1 Berlin| `packages\d101\dmvcframework_group.groupproj`|
|Delphi 10.0 Seattle| `packages\d100\dmvcframework_group.groupproj`|
### Bug Fixes in 3.2.0-boron
- Fixed! [issue38](https://github.com/danieleteti/delphimvcframework/issues/38)
- Fixed! [issue184](https://github.com/danieleteti/delphimvcframework/issues/184)
- Fixed! [issue278](https://github.com/danieleteti/delphimvcframework/issues/278)
- Fixed! [issue164](https://github.com/danieleteti/delphimvcframework/issues/164)
- Fixed! [issue182](https://github.com/danieleteti/delphimvcframework/issues/182)
- Fixed! [issue232](https://github.com/danieleteti/delphimvcframework/issues/232) (Thanks to [João Antônio Duarte](https://github.com/joaoduarte19))
- Fixed! [issue289](https://github.com/danieleteti/delphimvcframework/issues/289) (Thanks to [João Antônio Duarte](https://github.com/joaoduarte19))
- Fixed! [issue291](https://github.com/danieleteti/delphimvcframework/issues/291) (Thanks to [João Antônio Duarte](https://github.com/joaoduarte19))
- Fixed! [issue305](https://github.com/danieleteti/delphimvcframework/issues/305) (Thanks to [João Antônio Duarte](https://github.com/joaoduarte19))
- Fixed! [issue312](https://github.com/danieleteti/delphimvcframework/issues/312)
- Fixed! [issue330](https://github.com/danieleteti/delphimvcframework/issues/330)
- Fixed! [issue333](https://github.com/danieleteti/delphimvcframework/issues/333)
- Fixed! [issue334](https://github.com/danieleteti/delphimvcframework/issues/334)
- Fixed! [issue336](https://github.com/danieleteti/delphimvcframework/issues/336)
- Fixed! [issue337](https://github.com/danieleteti/delphimvcframework/issues/337)
- Fixed! [issue338](https://github.com/danieleteti/delphimvcframework/issues/338)
- Fixed! [issue345](https://github.com/danieleteti/delphimvcframework/issues/345)
- Fixed! [issue349](https://github.com/danieleteti/delphimvcframework/issues/349)
- Fixed! [issue350](https://github.com/danieleteti/delphimvcframework/issues/350)
- Fixed! [issue355](https://github.com/danieleteti/delphimvcframework/issues/355)
- Fixed! [issue356](https://github.com/danieleteti/delphimvcframework/issues/356)
- Fixed! [issue362](https://github.com/danieleteti/delphimvcframework/issues/362)
- Fixed! [issue363](https://github.com/danieleteti/delphimvcframework/issues/363)
- Fixed! [issue364](https://github.com/danieleteti/delphimvcframework/issues/364) (Thanks to [João Antônio Duarte](https://github.com/joaoduarte19))
- Fixed! [issue366](https://github.com/danieleteti/delphimvcframework/issues/366)
- Fixed! Has been patched a serious security bug affecting deployment configurations which uses internal WebServer to serve static files (do not affect all Apache, IIS or proxied deployments). Thanks to **Stephan Munz** to have discovered it. *Update to dmvcframework-3.2-RC5+ is required for all such kind of deployments.*
## DelphiMVCFramework 3.1.0-lithium (Current Release)
- New! Added `TMVCActiveRecord` framework (check sample `activerecord_showcase` and `activerecord_crud`)

BIN
docs/favicons/favicon_io.zip Normal file
View File

Binary file not shown.

45
samples/jsonrpc_with_published_objects/MainClientFormU.dfm
View File

@ -2,7 +2,7 @@ object MainForm: TMainForm
Left = 0
Top = 0
Caption = 'JSON-RPC 2.0 Client'
ClientHeight = 527
ClientHeight = 546
ClientWidth = 842
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
@ -18,7 +18,7 @@ object MainForm: TMainForm
Left = 0
Top = 0
Width = 842
Height = 527
Height = 546
ActivePage = TabSheet1
Align = alClient
TabOrder = 0
@ -28,7 +28,7 @@ object MainForm: TMainForm
Left = 3
Top = 22
Width = 815
Height = 124
Height = 174
Caption = 'Simple Types'
TabOrder = 0
object edtValue1: TEdit
@ -206,10 +206,43 @@ object MainForm: TMainForm
TabOrder = 16
OnClick = btnWithJSONClick
end
object Edit1: TEdit
Left = 17
Top = 136
Width = 32
Height = 21
TabOrder = 17
Text = '42'
end
object Edit2: TEdit
Left = 55
Top = 136
Width = 26
Height = 21
TabOrder = 18
Text = '10'
end
object btnSubtractWithNamedParams: TButton
Left = 87
Top = 134
Width = 160
Height = 25
Caption = 'Subtract (named params)'
TabOrder = 19
OnClick = btnSubtractWithNamedParamsClick
end
object Edit3: TEdit
Left = 253
Top = 136
Width = 27
Height = 21
ReadOnly = True
TabOrder = 20
end
end
object GroupBox2: TGroupBox
Left = 3
Top = 162
Top = 202
Width = 489
Height = 159
Caption = 'Returning Objects'
@ -247,7 +280,7 @@ object MainForm: TMainForm
end
object GroupBox3: TGroupBox
Left = 504
Top = 162
Top = 202
Width = 314
Height = 310
Caption = 'Returning Datasets'
@ -284,7 +317,7 @@ object MainForm: TMainForm
end
object GroupBox4: TGroupBox
Left = 3
Top = 343
Top = 383
Width = 489
Height = 129
Caption = 'Passing Objects as parameters'

33
samples/jsonrpc_with_published_objects/MainClientFormU.pas
View File

@ -77,6 +77,10 @@ type
btnDates: TButton;
btnFloatsTests: TButton;
btnWithJSON: TButton;
Edit1: TEdit;
Edit2: TEdit;
btnSubtractWithNamedParams: TButton;
Edit3: TEdit;
procedure btnSubstractClick(Sender: TObject);
procedure btnReverseStringClick(Sender: TObject);
procedure edtGetCustomersClick(Sender: TObject);
@ -92,6 +96,7 @@ type
procedure btnDatesClick(Sender: TObject);
procedure btnFloatsTestsClick(Sender: TObject);
procedure btnWithJSONClick(Sender: TObject);
procedure btnSubtractWithNamedParamsClick(Sender: TObject);
private
FExecutor: IMVCJSONRPCExecutor;
FExecutor2: IMVCJSONRPCExecutor;
@ -241,8 +246,8 @@ begin
lReq := TJSONRPCRequest.Create;
lReq.Method := 'reversestring';
lReq.RequestID := Random(1000);
lReq.Params.Add(edtReverseString.Text);
lReq.Params.Add(CheckBox1.Checked);
lReq.Params.AddByName('aString', edtReverseString.Text);
lReq.Params.AddByName('aUpperCase', CheckBox1.Checked);
lResp := FExecutor.ExecuteRequest(lReq);
edtReversedString.Text := lResp.Result.AsString;
end;
@ -257,7 +262,7 @@ begin
lReq.Method := 'saveperson';
lReq.RequestID := Random(1000);
lPerson := TPerson.Create;
lReq.Params.Add(lPerson, pdtObject);
lReq.Params.AddByName('Person', lPerson, pdtObject);
lPerson.FirstName := edtFirstName.Text;
lPerson.LastName := edtLastName.Text;
lPerson.Married := chkMarried.Checked;
@ -311,6 +316,20 @@ begin
edtResult.Text := lResp.Result.AsInteger.ToString;
end;
procedure TMainForm.btnSubtractWithNamedParamsClick(Sender: TObject);
var
lReq: IJSONRPCRequest;
lResp: IJSONRPCResponse;
begin
lReq := TJSONRPCRequest.Create;
lReq.Method := 'subtract';
lReq.RequestID := Random(1000);
lReq.Params.AddByName('Value1', StrToInt(Edit1.Text));
lReq.Params.AddByName('Value2', StrToInt(Edit2.Text));
lResp := FExecutor.ExecuteRequest(lReq);
Edit3.Text := lResp.Result.AsInteger.ToString;
end;
procedure TMainForm.btnWithJSONClick(Sender: TObject);
var
lPerson: TJsonObject;
@ -337,7 +356,7 @@ var
begin
FDMemTable1.Active := False;
lReq := TJSONRPCRequest.Create(Random(1000), 'getcustomers');
lReq.Params.Add(edtFilter.Text);
lReq.Params.AddByName('FilterString', edtFilter.Text);
lResp := FExecutor.ExecuteRequest(lReq);
FDMemTable1.Active := True;
FDMemTable1.LoadFromTValue(lResp.Result);
@ -352,11 +371,11 @@ begin
// 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);
Assert(FExecutor.HTTPHeadersCount = 0);
FExecutor.AddHTTPHeader(TNetHeader.Create('x-token', TGUID.NewGuid.ToString));
assert(FExecutor.HTTPHeadersCount = 1);
Assert(FExecutor.HTTPHeadersCount = 1);
FExecutor.ClearHTTPHeaders;
assert(FExecutor.HTTPHeadersCount = 0);
Assert(FExecutor.HTTPHeadersCount = 0);
FExecutor.AddHTTPHeader(TNetHeader.Create('x-token', TGUID.NewGuid.ToString));
end;

18
samples/jsonrpc_with_published_objects/MyObjectU.pas
View File

@ -58,18 +58,18 @@ type
const JSONResponse: TJDOJsonObject);
public
[MVCDoc('You know, returns aValue1 - aValue2')]
function Subtract(aValue1, aValue2: Integer): Integer;
function Subtract(Value1, Value2: Integer): Integer;
[MVCDoc('Returns the revers of the string passed as input')]
function ReverseString(const aString: string; const aUpperCase: Boolean): string;
[MVCDoc('Returns the next monday starting from aDate')]
function GetNextMonday(const aDate: TDate): TDate;
function PlayWithDatesAndTimes(const aJustAFloat: Double; const aTime: TTime; const aDate: TDate;
const aDateAndTime: TDateTime): TDateTime;
function GetCustomers(aString: string): TDataset;
function GetCustomers(FilterString: string): TDataset;
function GetMulti: TMultiDataset;
function GetStringDictionary: TMVCStringDictionary;
function GetUser(aUserName: string): TPerson;
function SavePerson(const aPerson: TJsonObject): Integer;
function SavePerson(const Person: TJsonObject): Integer;
function FloatsTest(const aDouble: Double; const aExtended: Extended): Extended;
procedure DoSomething;
function SaveObjectWithJSON(const WithJSON: TJsonObject): TJsonObject;
@ -123,15 +123,15 @@ begin
Result := aDouble + aExtended;
end;
function TMyObject.GetCustomers(aString: string): TDataset;
function TMyObject.GetCustomers(FilterString: string): TDataset;
var
lMT: TFDMemTable;
begin
lMT := GetCustomersDataset;
try
if not aString.IsEmpty then
if not FilterString.IsEmpty then
begin
lMT.Filter := aString;
lMT.Filter := FilterString;
lMT.Filtered := True;
end;
lMT.First;
@ -269,7 +269,7 @@ begin
end;
end;
function TMyObject.SavePerson(const aPerson: TJsonObject): Integer;
function TMyObject.SavePerson(const Person: TJsonObject): Integer;
// var
// lPerson: TPerson;
begin
@ -284,9 +284,9 @@ begin
Result := Random(1000);
end;
function TMyObject.Subtract(aValue1, aValue2: Integer): Integer;
function TMyObject.Subtract(Value1, Value2: Integer): Integer;
begin
Result := aValue1 - aValue2;
Result := Value1 - Value2;
end;
{ TData }

2
sources/MVCFramework.Commons.pas
View File

@ -120,7 +120,7 @@ type
OneMiB = 1048576;
OneKiB = 1024;
DEFAULT_MAX_REQUEST_SIZE = OneMiB * 5; // 5 MiB
HATEOAS_PROP_NAME = '_links';
HATEOAS_PROP_NAME = 'links';
X_HTTP_Method_Override = 'X-HTTP-Method-Override';
end;

344
sources/MVCFramework.JSONRPC.pas
View File

@ -136,8 +136,13 @@ type
function GetItem(const Index: Integer): TValue;
function GetItemDataType(const Index: Integer): TJSONRPCParamDataType;
protected
FParamsValue: TList<TValue>;
FParamsType: TList<TJSONRPCParamDataType>;
fParamValues: TList<TValue>;
fParamNames: TList<string>;
fParamTypes: TList<TJSONRPCParamDataType>;
private
procedure CheckNotNames;
procedure CheckBalancedParams;
function GetItemName(const Index: Integer): string;
public
constructor Create; virtual;
destructor Destroy; override;
@ -145,6 +150,7 @@ type
function Count: Integer;
property Items[const index: Integer]: TValue read GetItem; default;
property ItemsType[const index: Integer]: TJSONRPCParamDataType read GetItemDataType;
property ItemsName[const index: Integer]: string read GetItemName;
function ToArray: TArray<TValue>;
procedure Add(const Value: string); overload;
procedure Add(const Value: Integer); overload;
@ -156,6 +162,16 @@ type
procedure Add(const Value: TDateTime); overload;
procedure Add(const Value: Double); overload;
procedure Add(const Value: TValue; const ParamType: TJSONRPCParamDataType); overload;
procedure AddByName(const Name: string; const Value: string); overload;
procedure AddByName(const Name: string; const Value: Integer); overload;
procedure AddByName(const Name: string; const Value: TJDOJsonObject); overload;
procedure AddByName(const Name: string; const Value: TJDOJsonArray); overload;
procedure AddByName(const Name: string; const Value: Boolean); overload;
procedure AddByName(const Name: string; const Value: TDate); overload;
procedure AddByName(const Name: string; const Value: TTime); overload;
procedure AddByName(const Name: string; const Value: TDateTime); overload;
procedure AddByName(const Name: string; const Value: Double); overload;
procedure AddByName(const Name: string; const Value: TValue; const ParamType: TJSONRPCParamDataType); overload;
end;
IJSONRPCNotification = interface(IJSONRPCObject)
@ -498,6 +514,84 @@ begin
end;
end;
procedure AppendTValueToJsonObject(const Value: TValue; const Name: string; const ParamType: TJSONRPCParamDataType;
const JSONObj: TJDOJsonObject);
var
lSer: TMVCJsonDataObjectsSerializer;
lOrdinalValue: Int64;
begin
case ParamType of
pdtInteger:
begin
JSONObj.I[name] := Value.AsInteger;
end;
pdtFloat:
begin
JSONObj.F[name] := Value.AsExtended;
end;
pdtDateTime:
begin
JSONObj.S[name] := DateTimeToISOTimeStamp(FloatToDateTime(Value.AsExtended));
end;
pdtDate:
begin
JSONObj.S[name] := DateToISODate(FloatToDateTime(Value.AsExtended));
end;
pdtTime:
begin
JSONObj.S[name] := TimeToISOTime(FloatToDateTime(Value.AsExtended));
end;
pdtString:
begin
JSONObj.S[name] := Value.AsString;
end;
pdtLongInteger:
begin
JSONObj.L[name] := Value.AsInt64;
end;
pdtBoolean:
begin
if not Value.TryAsOrdinal(lOrdinalValue) then
begin
raise EMVCException.Create('Invalid ordinal parameter');
end;
JSONObj.B[name] := lOrdinalValue = 1;
end;
pdTJDOJsonObject:
begin
JSONObj.O[name] := (Value.AsObject as TJDOJsonObject).Clone as TJDOJsonObject;
end;
pdtJSONArray:
begin
JSONObj.A[name] := (Value.AsObject as TJDOJsonArray).Clone as TJDOJsonArray;
end;
pdtObject:
begin
if Value.AsObject is TDataSet then
begin
lSer := TMVCJsonDataObjectsSerializer.Create;
try
lSer.DataSetToJsonArray(TDataSet(Value.AsObject), JSONObj.A[name], TMVCNameCase.ncLowerCase, []);
finally
lSer.Free;
end
end
else
begin
lSer := TMVCJsonDataObjectsSerializer.Create;
try
JSONObj.O[name] := lSer.SerializeObjectToJSON(Value.AsObject,
TMVCSerializationType.stProperties, [], nil);
finally
lSer.Free;
end;
end;
end;
else
raise EMVCException.Create('Invalid type');
end;
end;
function JSONDataValueToTValue(const JSONDataValue: TJsonDataValueHelper): TValue; overload;
begin
case JSONDataValue.Typ of
@ -1048,7 +1142,15 @@ begin
('Cannot call a function using a JSON-RPC notification. [HINT] Use requests for functions and notifications for procedures');
end;
try
lJSONRPCReq.FillParameters(lJSON, lRTTIMethod);
except
on Ex: EMVCJSONRPCErrorResponse do
begin
raise EMVCJSONRPCInvalidParams.Create('Cannot map all parameters to remote method. ' + Ex.Message);
end;
end;
try
TryToCallMethod(lRTTIType, JSONRPC_HOOKS_ON_BEFORE_CALL, lJSON, 'JSONRequest');
LogD('[JSON-RPC][CALL][' + CALL_TYPE[lRTTIMethod.MethodKind] + '] ' + lRTTIMethod.Name);
@ -1058,6 +1160,10 @@ begin
begin
raise EMVCJSONRPCInvalidParams.Create('Check your input parameters types');
end;
on Ex: EMVCJSONRPCInvalidRequest do
begin
raise EMVCJSONRPCInvalidParams.Create(Ex.Message);
end;
end;
case lJSONRPCReq.RequestType of
@ -1365,23 +1471,29 @@ begin
end;
procedure TJSONRPCNotification.FillParameters(
const
JSON:
TJDOJsonObject;
const
RTTIMethod:
TRTTIMethod);
const JSON: TJDOJsonObject;
const RTTIMethod: TRTTIMethod);
var
lRTTIMethodParams: TArray<TRttiParameter>;
lRTTIMethodParam: TRttiParameter;
lJSONParams: TJDOJsonArray;
lJSONNamedParams: TJDOJsonObject;
I: Integer;
lUseNamedParams: Boolean;
begin
lUseNamedParams := False;
lJSONParams := nil;
lJSONNamedParams := nil;
Params.Clear;
if JSON.Types[JSONRPC_PARAMS] = jdtArray then
begin
lJSONParams := JSON.A[JSONRPC_PARAMS];
lUseNamedParams := False;
end
else if JSON.Types[JSONRPC_PARAMS] = jdtObject then
begin
lJSONNamedParams := JSON.O[JSONRPC_PARAMS];
lUseNamedParams := True;
end
else
if JSON.Types[JSONRPC_PARAMS] <> jdtNone then
@ -1390,12 +1502,27 @@ begin
end;
lRTTIMethodParams := RTTIMethod.GetParameters;
if lUseNamedParams then
begin
if (Length(lRTTIMethodParams) > 0) and (not Assigned(lJSONNamedParams)) then
raise EMVCJSONRPCInvalidParams.CreateFmt('Wrong parameters count. Expected %d got %d.',
[Length(lRTTIMethodParams), 0]);
if Assigned(lJSONNamedParams) and (Length(lRTTIMethodParams) <> lJSONNamedParams.Count) then
raise EMVCJSONRPCInvalidParams.CreateFmt('Wrong parameters count. Expected %d got %d.',
[Length(lRTTIMethodParams), lJSONNamedParams.Count]);
end
else
begin
if (Length(lRTTIMethodParams) > 0) and (not Assigned(lJSONParams)) then
raise EMVCJSONRPCInvalidParams.CreateFmt('Wrong parameters count. Expected %d got %d.',
[Length(lRTTIMethodParams), 0]);
if Assigned(lJSONParams) and (Length(lRTTIMethodParams) <> lJSONParams.Count) then
raise EMVCJSONRPCInvalidParams.CreateFmt('Wrong parameters count. Expected %d got %d.',
[Length(lRTTIMethodParams), lJSONParams.Count]);
end;
for lRTTIMethodParam in lRTTIMethodParams do
begin
if lRTTIMethodParam.Flags * [pfVar, pfOut, pfArray, pfReference] <> [] then
@ -1407,10 +1534,19 @@ begin
// scroll json params and rttimethod params and find the best match
if Assigned(lJSONParams) then
begin
// positional params
for I := 0 to lJSONParams.Count - 1 do
begin
JSONDataValueToTValueParam(lJSONParams[I], lRTTIMethodParams[I], Params);
end;
end
else if Assigned(lJSONNamedParams) then
begin
// named params
for I := 0 to lJSONNamedParams.Count - 1 do
begin
JSONDataValueToTValueParam(lJSONNamedParams.Values[lRTTIMethodParams[I].Name.ToLower], lRTTIMethodParams[I], Params);
end;
end;
end;
@ -1424,11 +1560,25 @@ begin
Result.S[JSONRPC_METHOD] := FMethod;
if FParams.Count > 0 then
begin
if FParams.fParamNames.Count = 0 then
begin // positional params
for I := 0 to FParams.Count - 1 do
begin
AppendTValueToJsonArray(FParams.FParamsValue[I], FParams.FParamsType[I],
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]);
end;
end;
end;
end;
@ -1560,10 +1710,7 @@ begin
FID := Value;
end;
procedure TJSONRPCResponse.SetJSON(
const
JSON:
TJDOJsonObject);
procedure TJSONRPCResponse.SetJSON(const JSON: TJDOJsonObject);
begin
if JSON.Types[JSONRPC_ID] = jdtString then
RequestID := JSON.S[JSONRPC_ID]
@ -1762,117 +1909,106 @@ begin
// do nothing
end;
procedure TJSONRPCProxyGenerator.StartGeneration(
const
aClassName:
string);
procedure TJSONRPCProxyGenerator.StartGeneration(const aClassName: string);
begin
// do nothing
end;
{ TJSONRPCRequestParams }
procedure TJSONRPCRequestParams.Add(
const
Value:
TJDOJsonArray);
procedure TJSONRPCRequestParams.Add(const Value: TJDOJsonArray);
begin
Add(Value, pdtJSONArray);
end;
procedure TJSONRPCRequestParams.Add(
const
Value:
TJDOJsonObject);
procedure TJSONRPCRequestParams.Add(const Value: TJDOJsonObject);
begin
Add(Value, pdTJDOJsonObject);
end;
procedure TJSONRPCRequestParams.Add(
const
Value:
Integer);
procedure TJSONRPCRequestParams.Add(const Value: Integer);
begin
Add(Value, pdtInteger);
end;
procedure TJSONRPCRequestParams.Add(
const
Value:
string);
procedure TJSONRPCRequestParams.Add(const Value: string);
begin
Add(Value, pdtString);
end;
procedure TJSONRPCRequestParams.Add(
const
Value:
Boolean);
procedure TJSONRPCRequestParams.Add(const Value: Boolean);
begin
Add(Value, pdtBoolean);
end;
procedure TJSONRPCRequestParams.Add(
const
Value:
Double);
procedure TJSONRPCRequestParams.Add(const Value: Double);
begin
Add(Value, pdtFloat);
end;
procedure TJSONRPCRequestParams.Add(
const
Value:
TDateTime);
procedure TJSONRPCRequestParams.Add(const Value: TDateTime);
begin
Add(Value, pdtDateTime);
end;
procedure TJSONRPCRequestParams.Add(
const
Value:
TTime);
procedure TJSONRPCRequestParams.Add(const Value: TTime);
begin
Add(Value, pdtTime);
end;
procedure TJSONRPCRequestParams.Add(
const
Value:
TDate);
procedure TJSONRPCRequestParams.Add(const Value: TDate);
begin
Add(Value, pdtDate);
end;
procedure TJSONRPCRequestParams.CheckBalancedParams;
begin
if fParamNames.Count <> fParamValues.Count then
begin
raise EMVCJSONRPCException.Create('Cannot mix positional with named parameters');
end;
end;
procedure TJSONRPCRequestParams.CheckNotNames;
begin
if fParamNames.Count > 0 then
begin
raise EMVCJSONRPCException.Create('Cannot mix positional with named parameters');
end;
end;
procedure TJSONRPCRequestParams.Clear;
begin
FParamsValue.Clear;
FParamsType.Clear;
fParamValues.Clear;
fParamTypes.Clear;
fParamNames.Clear;
end;
function TJSONRPCRequestParams.Count: Integer;
begin
Result := FParamsValue.Count;
Result := fParamValues.Count;
end;
constructor TJSONRPCRequestParams.Create;
begin
inherited Create;
FParamsValue := TList<TValue>.Create;
FParamsType := TList<TJSONRPCParamDataType>.Create;
fParamValues := TList<TValue>.Create;
fParamTypes := TList<TJSONRPCParamDataType>.Create;
fParamNames := TList<string>.Create;
end;
destructor TJSONRPCRequestParams.Destroy;
var
lValue: TValue;
begin
for lValue in FParamsValue do
for lValue in fParamValues do
begin
if lValue.IsObject then
lValue.AsObject.Free;
end;
FParamsValue.Free;
FParamsType.Free;
fParamValues.Free;
fParamTypes.Free;
fParamNames.Free;
inherited;
end;
@ -1881,7 +2017,7 @@ function TJSONRPCRequestParams.GetItem(
Index:
Integer): TValue;
begin
Result := FParamsValue[index];
Result := fParamValues[index];
end;
function TJSONRPCRequestParams.GetItemDataType(
@ -1889,24 +2025,86 @@ function TJSONRPCRequestParams.GetItemDataType(
Index:
Integer): TJSONRPCParamDataType;
begin
Result := FParamsType[index];
Result := fParamTypes[index];
end;
function TJSONRPCRequestParams.GetItemName(const Index: Integer): string;
begin
Result := fParamNames[index];
end;
function TJSONRPCRequestParams.ToArray: TArray<TValue>;
begin
Result := FParamsValue.ToArray;
Result := fParamValues.ToArray;
end;
procedure TJSONRPCRequestParams.Add(
const
Value:
TValue;
const
ParamType:
TJSONRPCParamDataType);
procedure TJSONRPCRequestParams.Add(const Value: TValue; const ParamType: TJSONRPCParamDataType);
begin
FParamsValue.Add(Value);
FParamsType.Add(ParamType);
CheckNotNames;
fParamValues.Add(Value);
fParamTypes.Add(ParamType);
end;
procedure TJSONRPCRequestParams.AddByName(const Name: string;
const Value: Boolean);
begin
AddByName(name, Value, TJSONRPCParamDataType.pdtBoolean);
end;
procedure TJSONRPCRequestParams.AddByName(const Name: string;
const Value: TJDOJsonArray);
begin
AddByName(name, Value, TJSONRPCParamDataType.pdtJSONArray);
end;
procedure TJSONRPCRequestParams.AddByName(const Name: string;
const Value: TJDOJsonObject);
begin
AddByName(name, Value, TJSONRPCParamDataType.pdTJDOJsonObject);
end;
procedure TJSONRPCRequestParams.AddByName(const Name: string;
const Value: Integer);
begin
AddByName(name, Value, TJSONRPCParamDataType.pdtInteger);
end;
procedure TJSONRPCRequestParams.AddByName(const Name, Value: string);
begin
AddByName(name, Value, TJSONRPCParamDataType.pdtString);
end;
procedure TJSONRPCRequestParams.AddByName(const Name: string;
const Value: TValue; const ParamType: TJSONRPCParamDataType);
begin
CheckBalancedParams;
fParamNames.Add(LowerCase(name));
fParamValues.Add(Value);
fParamTypes.Add(ParamType);
end;
procedure TJSONRPCRequestParams.AddByName(const Name: string;
const Value: Double);
begin
AddByName(name, Value, TJSONRPCParamDataType.pdtFloat);
end;
procedure TJSONRPCRequestParams.AddByName(const Name: string;
const Value: TDateTime);
begin
AddByName(name, Value, TJSONRPCParamDataType.pdtDateTime);
end;
procedure TJSONRPCRequestParams.AddByName(const Name: string;
const Value: TTime);
begin
AddByName(name, Value, TJSONRPCParamDataType.pdtTime);
end;
procedure TJSONRPCRequestParams.AddByName(const Name: string;
const Value: TDate);
begin
AddByName(name, Value, TJSONRPCParamDataType.pdtDate);
end;
{ EMVCJSONRPCException }

12
sources/MVCFramework.Middleware.StaticFiles.pas
View File

@ -40,7 +40,7 @@ type
/// <summary>
/// URL segment that represents the path to static files
/// </summary>
STATIC_FILES_PATH = '/';
STATIC_FILES_PATH = '/static';
/// <summary>
/// Physical path of the root folder that contains the static files
@ -91,7 +91,8 @@ implementation
uses
System.SysUtils,
System.IOUtils;
System.NetEncoding,
System.IOUtils, System.Classes;
{ TMVCStaticFilesMiddleware }
@ -194,6 +195,13 @@ begin
AHandled := SendStaticFileIfPresent(AContext, lFileName);
end;
// if (not AHandled) and lPathInfo.EndsWith('favicon.ico') then
// begin
// AContext.Response.SetContentStream(TBytesStream.Create(TNetEncoding.Base64.DecodeStringToBytes(DMVC_FAVICON)),
// TMVCMediaType.IMAGE_X_ICON);
// AHandled := True;
// end;
if (not AHandled) and fSPAWebAppSupport and AContext.Request.ClientPreferHTML and (not fIndexDocument.IsEmpty) then
begin
lFileName := TPath.GetFullPath(TPath.Combine(fDocumentRoot, fIndexDocument));

5
sources/MVCFramework.Serializer.JsonDataObjects.CustomTypes.pas
View File

@ -458,6 +458,11 @@ begin
case lObj.DataSetSerializationType of
dstSingleRecord:
begin
if TDataSet(lObj.Data).Eof then
begin
raise EMVCSerializationException.Create(HTTP_STATUS.InternalServerError,
'Cannot serialize a single record of an empty dataset');
end;
fCurrentSerializer.InternalSerializeDataSetRecord(
TDataSet(lObj.Data),
lOutObject.O[lName],

42
unittests/general/Several/JSONRPCTestsU.pas
View File

@ -37,6 +37,10 @@ type
[Test]
procedure TestRequestWithArrayParameters;
[Test]
procedure TestRequestWithNamedParameters;
[Test]
procedure TestRequestWithMixedParamaters;
[Test]
procedure TestRequestWithNoParameters;
[Test]
procedure TestRequestWithMalformedJSON;
@ -88,6 +92,44 @@ begin
end, EMVCJSONRPCParseError);
end;
procedure TTestJSONRPC.TestRequestWithMixedParamaters;
var
lReq: IJSONRPCRequest;
begin
lReq := TJSONRPCRequest.Create;
lReq.Method := 'subtract';
Assert.WillRaise(
procedure
begin
lReq.Params.AddByName('par1', 42);
lReq.Params.Add(42);
end, EMVCJSONRPCException);
lReq := TJSONRPCRequest.Create;
lReq.Method := 'subtract';
Assert.WillRaise(
procedure
begin
lReq.Params.Add(42);
lReq.Params.AddByName('par1', 42);
end, EMVCJSONRPCException);
end;
procedure TTestJSONRPC.TestRequestWithNamedParameters;
var
lReq: IJSONRPCRequest;
begin
lReq := TJSONRPCRequest.Create;
lReq.Method := 'subtract';
lReq.Params.AddByName('par1', 42);
lReq.Params.AddByName('PAR2', 23);
lReq.RequestID := 1;
Assert.AreEqual(1, lReq.RequestID.AsInteger);
Assert.AreEqual('par1', lReq.Params.ItemsName[0]);
Assert.AreEqual('par2', lReq.Params.ItemsName[1]);
Assert.AreEqual('subtract', lReq.Method);
end;
procedure TTestJSONRPC.TestRequestWithNoParameters;
var
lReq: IJSONRPCRequest;

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

@ -220,7 +220,10 @@ type
// test web server
[Test]
procedure TestDirectoryTraversal1;
[Test]
procedure TestDirectoryTraversal2;
[Test]
procedure TestSPASupport;
// test server side views
[Test]
procedure TestViewDataViewDataSet;
@ -242,10 +245,18 @@ type
[Test]
procedure TestRequestWithParams_I_I_ret_I;
[Test]
procedure TestRequestWithNamedParams_I_I_ret_I;
[Test]
procedure TestRequestWithParams_I_I_I_ret_O;
[Test]
procedure TestRequestWithNamedParams_I_I_I_ret_O;
[Test]
procedure TestRequestWithWrongNamedParams;
[Test]
procedure TestRequest_S_I_ret_S;
[Test]
procedure TestRequest_NamedParams_S_I_ret_S;
[Test]
procedure TestRequestWithParams_I_I_ret_A;
[Test]
procedure TestRequestWithParams_DT_T_ret_DT;
@ -1408,6 +1419,53 @@ begin
end;
end;
procedure TServerTest.TestDirectoryTraversal2;
var
lRes: IRESTResponse;
I: Integer;
lUrl: string;
begin
lRes := RESTClient
.Accept(TMVCMediaType.TEXT_HTML)
.doGET('/static/index.html', []);
Assert.areEqual(200, lRes.ResponseCode, '/static/index.html');
lRes := RESTClient
.Accept(TMVCMediaType.TEXT_HTML)
.doGET('/static.html', []);
Assert.areEqual(200, lRes.ResponseCode, '/static.html');
lRes := RESTClient
.Accept(TMVCMediaType.TEXT_HTML)
.doGET('/static/', []);
Assert.areEqual(200, lRes.ResponseCode, '/static/');
lRes := RESTClient
.Accept(TMVCMediaType.TEXT_HTML)
.doGET('/static', []);
Assert.areEqual(200, lRes.ResponseCode, '/static');
lRes := RESTClient
.Accept(TMVCMediaType.TEXT_HTML)
.doGET('/static/..\..\donotdeleteme.txt', []);
Assert.areEqual(404, lRes.ResponseCode);
lRes := RESTClient
.Accept(TMVCMediaType.TEXT_HTML)
.doGET('/static/../../donotdeleteme.txt', []);
Assert.areEqual(404, lRes.ResponseCode);
lUrl := 'Windows\win.ini';
for I := 1 to 30 do
begin
lUrl := '..\' + lUrl;
lRes := RESTClient
.Accept(TMVCMediaType.TEXT_HTML)
.doGET('/' + lUrl, []);
Assert.areEqual(404, lRes.ResponseCode, 'Fail with: ' + '/' + lUrl);
end;
end;
procedure TServerTest.TestSerializeAndDeserializeNullables;
var
lRes: IRESTResponse;
@ -1544,6 +1602,46 @@ begin
DoLogout;
end;
procedure TServerTest.TestSPASupport;
var
lRes: IRESTResponse;
I: Integer;
lUrl: string;
begin
lRes := RESTClient
.Accept(TMVCMediaType.TEXT_HTML)
.doGET('/static/index.html', []);
Assert.areEqual(200, lRes.ResponseCode);
Assert.Contains(lRes.BodyAsString, 'This is a TEXT file');
lRes := RESTClient
.Accept(TMVCMediaType.TEXT_HTML)
.doGET('/static/', []);
Assert.areEqual(200, lRes.ResponseCode, '/static/');
Assert.Contains(lRes.BodyAsString, 'This is a TEXT file');
lRes := RESTClient
.Accept(TMVCMediaType.TEXT_HTML)
.doGET('/static/..\..\donotdeleteme.txt', []);
Assert.areEqual(404, lRes.ResponseCode, '/static/..\..\donotdeleteme.txt');
lRes := RESTClient
.Accept(TMVCMediaType.TEXT_HTML)
.doGET('/static/../../donotdeleteme.txt', []);
Assert.areEqual(404, lRes.ResponseCode, '/static/../../donotdeleteme.txt');
Assert.Contains(lRes.Error.ExceptionMessage, 'Not Found', true);
lUrl := 'Windows\win.ini';
for I := 1 to 30 do
begin
lUrl := '..\' + lUrl;
lRes := RESTClient
.Accept(TMVCMediaType.TEXT_HTML)
.doGET('/' + lUrl, []);
Assert.areEqual(404, lRes.ResponseCode, 'Fail with: ' + '/' + lUrl);
end;
end;
procedure TServerTest.TestStringDictionary;
var
lRes: IRESTResponse;
@ -1853,6 +1951,65 @@ begin
Assert.areEqual(2000, lYear);
end;
procedure TJSONRPCServerTest.TestRequestWithWrongNamedParams;
var
lReq: IJSONRPCRequest;
lRPCResp: IJSONRPCResponse;
begin
lReq := TJSONRPCRequest.Create;
lReq.Method := 'add';
lReq.Params.AddByName('wrongname1', 3);
lReq.Params.AddByName('wrongname2', 4);
lReq.Params.AddByName('wrongname3', 5);
lReq.RequestID := 1234;
lRPCResp := FExecutor.ExecuteRequest(lReq);
Assert.isTrue(lRPCResp.IsError);
Assert.Contains(lRPCResp.Error.ErrMessage, 'cannot map all parameter', true);
end;
procedure TJSONRPCServerTest.TestRequestWithNamedParams_I_I_I_ret_O;
var
lReq: IJSONRPCRequest;
lRPCResp: IJSONRPCResponse;
lS: string;
begin
lReq := TJSONRPCRequest.Create;
lReq.Method := 'add';
lReq.Params.AddByName('value1', 3);
lReq.Params.AddByName('value2', 4);
lReq.Params.AddByName('value3', 5);
lReq.RequestID := 1234;
lRPCResp := FExecutor.ExecuteRequest(lReq);
lS := (lRPCResp.Result.AsObject as TJDOJsonObject).ToJSON();
Assert.areEqual(12, TJDOJsonObject(lRPCResp.Result.AsObject).I['res']);
lRPCResp := FExecutor2.ExecuteRequest(lReq);
lS := (lRPCResp.Result.AsObject as TJDOJsonObject).ToJSON();
Assert.areEqual(12, TJDOJsonObject(lRPCResp.Result.AsObject).I['res']);
end;
procedure TJSONRPCServerTest.TestRequestWithNamedParams_I_I_ret_I;
var
lReq: IJSONRPCRequest;
lResp: IJSONRPCResponse;
begin
lReq := TJSONRPCRequest.Create;
lReq.RequestID := 1234;
lReq.Method := 'subtract';
lReq.Params.AddByName('Value1', 18);
lReq.Params.AddByName('Value2', 8);
lResp := FExecutor.ExecuteRequest(lReq);
Assert.areEqual(10, lResp.Result.AsInteger);
Assert.areEqual(1234, lResp.RequestID.AsInteger);
lResp := FExecutor2.ExecuteRequest(lReq);
Assert.areEqual(10, lResp.Result.AsInteger);
Assert.areEqual(1234, lResp.RequestID.AsInteger);
end;
procedure TJSONRPCServerTest.TestRequestWithoutParams;
var
lReq: IJSONRPCNotification;
@ -1874,6 +2031,7 @@ begin
lReq.Method := 'subtract';
lReq.Params.Add(18);
lReq.Params.Add(8);
lResp := FExecutor.ExecuteRequest(lReq);
Assert.areEqual(10, lResp.Result.AsInteger);
Assert.areEqual(1234, lResp.RequestID.AsInteger);
@ -1939,6 +2097,24 @@ begin
Assert.areEqual(12, TJDOJsonObject(lRPCResp.Result.AsObject).I['res']);
end;
procedure TJSONRPCServerTest.TestRequest_NamedParams_S_I_ret_S;
var
lReq: IJSONRPCRequest;
lRPCResp: IJSONRPCResponse;
begin
lReq := TJSONRPCRequest.Create;
lReq.Method := 'MultiplyString';
lReq.Params.AddByName('aString', 'Daniele');
lReq.Params.AddByName('Multiplier', 4);
lReq.RequestID := 1234;
lRPCResp := FExecutor.ExecuteRequest(lReq);
Assert.isFalse(lRPCResp.IsError);
Assert.areEqual('DanieleDanieleDanieleDaniele', lRPCResp.Result.AsString);
lRPCResp := FExecutor2.ExecuteRequest(lReq);
Assert.areEqual('DanieleDanieleDanieleDaniele', lRPCResp.Result.AsString);
end;
procedure TJSONRPCServerTest.TestRequest_S_I_ret_S;
var
lReq: IJSONRPCRequest;

26
unittests/general/TestServer/TestServer.dproj
View File

@ -28,17 +28,6 @@
<CfgParent>Base</CfgParent>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="'$(Config)'=='Release' or '$(Cfg_1)'!=''">
<Cfg_1>true</Cfg_1>
<CfgParent>Base</CfgParent>
<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>
<Cfg_1>true</Cfg_1>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="'$(Config)'=='CI' or '$(Cfg_2)'!=''">
<Cfg_2>true</Cfg_2>
<CfgParent>Base</CfgParent>
@ -117,17 +106,6 @@
<PropertyGroup Condition="'$(Base_Win64)'!=''">
<Icon_MainIcon>TestServer_Icon.ico</Icon_MainIcon>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_1)'!=''">
<DCC_Define>RELEASE;$(DCC_Define)</DCC_Define>
<DCC_DebugInformation>0</DCC_DebugInformation>
<DCC_LocalDebugSymbols>false</DCC_LocalDebugSymbols>
<DCC_SymbolReferenceInfo>0</DCC_SymbolReferenceInfo>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_1_Win32)'!=''">
<VerInfo_Locale>1033</VerInfo_Locale>
<VerInfo_Keys>CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=;ProgramID=com.embarcadero.$(MSBuildProjectName)</VerInfo_Keys>
<Icon_MainIcon>TestServer_Icon.ico</Icon_MainIcon>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_2)'!=''">
<DCC_Define>DEBUG;$(DCC_Define)</DCC_Define>
<DCC_Optimize>false</DCC_Optimize>
@ -171,10 +149,6 @@
<BuildConfiguration Include="Base">
<Key>Base</Key>
</BuildConfiguration>
<BuildConfiguration Include="Release">
<Key>Cfg_1</Key>
<CfgParent>Base</CfgParent>
</BuildConfiguration>
</ItemGroup>
<ProjectExtensions>
<Borland.Personality>Delphi.Personality.12</Borland.Personality>

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

@ -8,18 +8,18 @@ uses
type
TTestJSONRPCController = class(TMVCJSONRPCController)
public
function Subtract(aValue1, aValue2: Int64): Integer;
function Subtract(Value1, Value2: Int64): Integer;
procedure MyNotify;
function Add(aValue1, aValue2, aValue3: Int64): TJsonObject;
function Add(Value1, Value2, Value3: Int64): TJsonObject;
function GetListFromTo(aFrom, aTo: Int64): TJsonArray;
function MultiplyString(aString: string; Multiplier: Int64): string;
end;
TTestJSONRPCClass = class(TObject)
public
function Subtract(aValue1, aValue2: Int64): Integer;
function Subtract(Value1, Value2: Int64): Integer;
procedure MyNotify;
function Add(aValue1, aValue2, aValue3: Int64): TJsonObject;
function Add(Value1, Value2, Value3: Int64): TJsonObject;
function GetListFromTo(aFrom, aTo: Int64): TJsonArray;
function MultiplyString(aString: string; Multiplier: Int64): string;
function AddTimeToDateTime(aDateTime: TDateTime; aTime: TTime): TDateTime;
@ -32,10 +32,10 @@ uses
{ TTestJSONRPCController }
function TTestJSONRPCController.Add(aValue1, aValue2, aValue3: Int64): TJsonObject;
function TTestJSONRPCController.Add(Value1, Value2, Value3: Int64): TJsonObject;
begin
Result := TJsonObject.Create;
Result.I['res'] := aValue1 + aValue2 + aValue3;
Result.I['res'] := Value1 + Value2 + Value3;
end;
function TTestJSONRPCController.GetListFromTo(aFrom, aTo: Int64): TJsonArray;
@ -65,17 +65,17 @@ begin
Self.ClassName;
end;
function TTestJSONRPCController.Subtract(aValue1, aValue2: Int64): Integer;
function TTestJSONRPCController.Subtract(Value1, Value2: Int64): Integer;
begin
Result := aValue1 - aValue2;
Result := Value1 - Value2;
end;
{ TTestJSONRPCClass }
function TTestJSONRPCClass.Add(aValue1, aValue2, aValue3: Int64): TJsonObject;
function TTestJSONRPCClass.Add(Value1, Value2, Value3: Int64): TJsonObject;
begin
Result := TJsonObject.Create;
Result.I['res'] := aValue1 + aValue2 + aValue3;
Result.I['res'] := Value1 + Value2 + Value3;
end;
function TTestJSONRPCClass.AddTimeToDateTime(aDateTime: TDateTime;
@ -111,9 +111,9 @@ begin
Self.ClassName;
end;
function TTestJSONRPCClass.Subtract(aValue1, aValue2: Int64): Integer;
function TTestJSONRPCClass.Subtract(Value1, Value2: Int64): Integer;
begin
Result := aValue1 - aValue2;
Result := Value1 - Value2;
end;
end.

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

@ -98,7 +98,9 @@ begin
Result := TTestFault2Controller.Create; // this will raise an exception
end)
.AddMiddleware(TMVCSpeedMiddleware.Create)
.AddMiddleware(TMVCStaticFilesMiddleware.Create('/', '..\www'))
.AddMiddleware(TMVCStaticFilesMiddleware.Create('/', '..\www', 'index.html', False))
.AddMiddleware(TMVCStaticFilesMiddleware.Create('/static', '..\www', 'index.html', False))
.AddMiddleware(TMVCStaticFilesMiddleware.Create('/spa', '..\www', 'index.html', True))
.AddMiddleware(TMVCBasicAuthenticationMiddleware.Create(TBasicAuthHandler.Create))
.AddMiddleware(TMVCCustomAuthenticationMiddleware.Create(TCustomAuthHandler.Create, '/system/users/logged'))
.AddMiddleware(TMVCCompressionMiddleware.Create);

1
unittests/general/TestServer/www/static.html Normal file
View File

@ -0,0 +1 @@
This is a TEXT file named STATIC.html