2017-03-01 21:40:57 +01:00
|
|
|
|
// ***************************************************************************
|
|
|
|
|
//
|
|
|
|
|
// Delphi MVC Framework
|
|
|
|
|
//
|
2021-04-21 20:03:13 +02:00
|
|
|
|
// Copyright (c) 2010-2021 Daniele Teti and the DMVCFramework Team
|
2017-03-01 21:40:57 +01:00
|
|
|
|
//
|
|
|
|
|
// https://github.com/danieleteti/delphimvcframework
|
|
|
|
|
//
|
|
|
|
|
// ***************************************************************************
|
|
|
|
|
//
|
|
|
|
|
// Licensed under the Apache License, Version 2.0 (the "License");
|
|
|
|
|
// you may not use this file except in compliance with the License.
|
|
|
|
|
// You may obtain a copy of the License at
|
|
|
|
|
//
|
|
|
|
|
// http://www.apache.org/licenses/LICENSE-2.0
|
|
|
|
|
//
|
|
|
|
|
// Unless required by applicable law or agreed to in writing, software
|
|
|
|
|
// distributed under the License is distributed on an "AS IS" BASIS,
|
|
|
|
|
// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
|
|
|
|
|
// See the License for the specific language governing permissions and
|
|
|
|
|
// limitations under the License.
|
|
|
|
|
//
|
|
|
|
|
// *************************************************************************** }
|
|
|
|
|
unit TestServerControllerU;
|
|
|
|
|
|
2017-06-02 00:10:31 +02:00
|
|
|
|
{$HINTS OFF}
|
|
|
|
|
|
2017-03-01 21:40:57 +01:00
|
|
|
|
interface
|
|
|
|
|
|
2018-08-08 17:11:45 +02:00
|
|
|
|
uses
|
|
|
|
|
MVCFramework,
|
|
|
|
|
System.SysUtils,
|
2020-04-21 17:04:04 +02:00
|
|
|
|
MVCFramework.Commons, FireDAC.Comp.Client, Data.DB;
|
2017-03-01 21:40:57 +01:00
|
|
|
|
|
|
|
|
|
type
|
|
|
|
|
|
|
|
|
|
[MVCPath('/')]
|
|
|
|
|
TTestServerController = class(TMVCController)
|
|
|
|
|
private
|
|
|
|
|
FFormatSettings: TFormatSettings;
|
2020-04-21 17:04:04 +02:00
|
|
|
|
fDataSet: TFDMemTable;
|
2017-03-01 21:40:57 +01:00
|
|
|
|
protected
|
|
|
|
|
procedure MVCControllerAfterCreate; override;
|
2020-04-21 17:04:04 +02:00
|
|
|
|
function GetDataSet: TDataSet;
|
|
|
|
|
procedure MVCControllerBeforeDestroy; override;
|
2017-03-01 21:40:57 +01:00
|
|
|
|
public
|
|
|
|
|
[MVCPath('/req/with/params/($par1)/($par2)/($par3)')]
|
|
|
|
|
[MVCHTTPMethod([httpGET, httpDELETE])]
|
2018-10-23 16:18:34 +02:00
|
|
|
|
procedure ReqWithParams;
|
2017-03-01 21:40:57 +01:00
|
|
|
|
|
|
|
|
|
[MVCPath('/echo/($par1)/($par2)/($par3)')]
|
|
|
|
|
[MVCHTTPMethod([httpPOST, httpPUT, httpPATCH])]
|
2017-09-26 01:02:09 +02:00
|
|
|
|
procedure EchoBody;
|
2017-03-01 21:40:57 +01:00
|
|
|
|
|
|
|
|
|
[MVCPath('/session/($value)')]
|
|
|
|
|
[MVCHTTPMethod([httpPOST])]
|
2017-09-26 01:02:09 +02:00
|
|
|
|
procedure SessionSet;
|
2017-03-01 21:40:57 +01:00
|
|
|
|
|
|
|
|
|
[MVCPath('/session')]
|
|
|
|
|
[MVCHTTPMethod([httpGET])]
|
|
|
|
|
procedure SessionGet;
|
|
|
|
|
|
|
|
|
|
[MVCPath('/headers')]
|
2018-10-23 16:18:34 +02:00
|
|
|
|
procedure EchoHeaders;
|
2017-03-01 21:40:57 +01:00
|
|
|
|
|
|
|
|
|
[MVCPath('/lotofcookies')]
|
2018-10-23 16:18:34 +02:00
|
|
|
|
procedure GenerateCookies;
|
2017-03-01 21:40:57 +01:00
|
|
|
|
|
|
|
|
|
[MVCPath('/dataset/($datasetname)')]
|
2018-10-23 16:18:34 +02:00
|
|
|
|
procedure DataSetHandling;
|
2017-03-01 21:40:57 +01:00
|
|
|
|
|
|
|
|
|
[MVCPath('/login/($username)')]
|
|
|
|
|
// this is only for test!!!!
|
|
|
|
|
procedure Login;
|
|
|
|
|
|
|
|
|
|
[MVCPath('/logout')]
|
|
|
|
|
// this is only for test!!!!
|
|
|
|
|
procedure Logout;
|
|
|
|
|
|
|
|
|
|
[MVCPath('/encoding')]
|
|
|
|
|
[MVCHTTPMethod([httpGET])]
|
|
|
|
|
// this is only for test!!!!
|
2018-10-23 16:18:34 +02:00
|
|
|
|
procedure TestCharset;
|
2017-03-01 21:40:57 +01:00
|
|
|
|
|
|
|
|
|
[MVCPath('/testconsumes')]
|
|
|
|
|
[MVCHTTPMethod([httpGET, httpPOST, httpPUT])]
|
|
|
|
|
[MVCConsumes('application/json')]
|
|
|
|
|
[MVCProduces('application/json', 'utf-8')]
|
2017-09-26 01:02:09 +02:00
|
|
|
|
procedure TestConsumesProduces;
|
2017-03-01 21:40:57 +01:00
|
|
|
|
|
|
|
|
|
[MVCPath('/testconsumes/textiso8859_1')]
|
|
|
|
|
[MVCHTTPMethod([httpPOST, httpPUT])]
|
|
|
|
|
[MVCConsumes(TMVCMediaType.TEXT_PLAIN)]
|
2017-09-08 16:59:02 +02:00
|
|
|
|
[MVCProduces(TMVCMediaType.TEXT_PLAIN, TMVCCharset.ISO88591)]
|
2017-03-01 21:40:57 +01:00
|
|
|
|
procedure TestConsumesProducesTextISO8859_1;
|
|
|
|
|
|
|
|
|
|
[MVCPath('/testconsumes')]
|
|
|
|
|
[MVCHTTPMethod([httpGET, httpPOST, httpPUT])]
|
|
|
|
|
[MVCConsumes('text/plain')]
|
2019-03-05 20:55:37 +01:00
|
|
|
|
[MVCProduces('text/plain', 'utf-8')]
|
2018-10-23 16:18:34 +02:00
|
|
|
|
procedure TestConsumesProducesText;
|
2017-03-01 21:40:57 +01:00
|
|
|
|
|
2020-03-08 17:54:10 +01:00
|
|
|
|
[MVCPath('/adapter/testconsumejson')]
|
2017-03-01 21:40:57 +01:00
|
|
|
|
[MVCHTTPMethod([httpGET])]
|
|
|
|
|
[MVCConsumes('application/json')]
|
|
|
|
|
[MVCProduces('application/json', 'utf-8')]
|
2017-09-26 01:02:09 +02:00
|
|
|
|
procedure TestConsumeJSON;
|
2017-03-01 21:40:57 +01:00
|
|
|
|
|
2019-03-08 09:33:41 +01:00
|
|
|
|
[MVCPath('/people/renderaction')]
|
|
|
|
|
[MVCHTTPMethod([httpGET])]
|
|
|
|
|
procedure TestGetPersonsHateos;
|
|
|
|
|
|
2017-03-01 21:40:57 +01:00
|
|
|
|
[MVCPath('/people/($id)')]
|
|
|
|
|
[MVCHTTPMethod([httpGET])]
|
2018-10-23 16:18:34 +02:00
|
|
|
|
procedure TestGetPersonByID;
|
2017-03-01 21:40:57 +01:00
|
|
|
|
|
|
|
|
|
[MVCPath('/people/($id)/asfields')]
|
|
|
|
|
[MVCHTTPMethod([httpGET])]
|
2018-10-23 16:18:34 +02:00
|
|
|
|
procedure TestGetPersonByIDAsFields;
|
2017-03-01 21:40:57 +01:00
|
|
|
|
|
|
|
|
|
[MVCPath('/customers/list')]
|
|
|
|
|
[MVCHTTPMethod([httpPOST])]
|
|
|
|
|
procedure TestJSONArrayAsObjectList;
|
|
|
|
|
|
|
|
|
|
[MVCPath('/people')]
|
|
|
|
|
[MVCHTTPMethod([httpGET, httpPOST, httpPUT])]
|
2018-10-23 16:18:34 +02:00
|
|
|
|
procedure TestGetPersons;
|
2017-03-01 21:40:57 +01:00
|
|
|
|
|
|
|
|
|
[MVCPath('/wrappedpeople')]
|
|
|
|
|
[MVCHTTPMethod([httpGET])]
|
2018-10-23 16:18:34 +02:00
|
|
|
|
procedure TestGetWrappedPeople;
|
2017-03-01 21:40:57 +01:00
|
|
|
|
|
|
|
|
|
[MVCPath('/objects')]
|
|
|
|
|
[MVCHTTPMethod([httpPOST, httpPUT])]
|
|
|
|
|
[MVCProduces('application/json')]
|
2018-10-23 16:18:34 +02:00
|
|
|
|
procedure TestPOSTObject;
|
2017-03-01 21:40:57 +01:00
|
|
|
|
|
2019-06-25 17:32:30 +02:00
|
|
|
|
[MVCPath('/customerecho')]
|
|
|
|
|
[MVCHTTPMethod([httpPOST])]
|
|
|
|
|
[MVCProduces('application/json')]
|
|
|
|
|
procedure TestCustomerEcho;
|
|
|
|
|
|
2017-03-01 21:40:57 +01:00
|
|
|
|
[MVCPath('/speed')]
|
|
|
|
|
[MVCHTTPMethod([httpGET])]
|
2018-10-23 16:18:34 +02:00
|
|
|
|
procedure TestHelloWorld;
|
2017-03-01 21:40:57 +01:00
|
|
|
|
|
|
|
|
|
[MVCPath('/path1/($id)')]
|
|
|
|
|
[MVCPath('/path2/($id)/2/($par)')]
|
|
|
|
|
[MVCPath('/path3/($id)/2/($par)/3')]
|
|
|
|
|
[MVCPath('/path4/($id)/2/($par)/3/4')]
|
|
|
|
|
[MVCHTTPMethod([httpPOST, httpPUT])]
|
2018-10-23 16:18:34 +02:00
|
|
|
|
procedure TestMultiplePaths;
|
2017-03-01 21:40:57 +01:00
|
|
|
|
|
|
|
|
|
{ Strongly typed actions }
|
|
|
|
|
[MVCPath('/typed/string1/($value)')]
|
|
|
|
|
procedure TestTypedActionString1(value: string);
|
|
|
|
|
|
|
|
|
|
[MVCPath('/typed/integer1/($value)')]
|
|
|
|
|
procedure TestTypedActionInteger1(value: Integer);
|
|
|
|
|
|
|
|
|
|
[MVCPath('/typed/int641/($value)')]
|
|
|
|
|
procedure TestTypedActionInt641(value: Int64);
|
|
|
|
|
|
|
|
|
|
[MVCPath('/typed/single1/($value)')]
|
|
|
|
|
procedure TestTypedActionSingle1(value: Single);
|
|
|
|
|
|
|
|
|
|
[MVCPath('/typed/double1/($value)')]
|
|
|
|
|
procedure TestTypedActionDouble1(value: Double);
|
|
|
|
|
|
|
|
|
|
[MVCPath('/typed/extended1/($value)')]
|
|
|
|
|
procedure TestTypedActionExtended1(value: Extended);
|
|
|
|
|
|
|
|
|
|
[MVCPath('/typed/all/($ParString)/($ParInteger)/($ParInt64)/($ParSingle)/($ParDouble)/($ParExtended)')]
|
2019-03-05 20:55:37 +01:00
|
|
|
|
procedure TestTypedActionAllTypes(ParString: string; ParInteger: Integer; ParInt64: Int64; ParSingle: Single;
|
|
|
|
|
ParDouble: Double; ParExtended: Extended);
|
2017-03-01 21:40:57 +01:00
|
|
|
|
|
|
|
|
|
[MVCPath('/typed/tdatetime1/($value)')]
|
|
|
|
|
procedure TestTypedActionTDateTime1(value: TDateTime);
|
|
|
|
|
|
|
|
|
|
[MVCPath('/typed/tdate1/($value)')]
|
|
|
|
|
procedure TestTypedActionTDate1(value: TDate);
|
|
|
|
|
|
|
|
|
|
[MVCPath('/typed/ttime1/($value)')]
|
|
|
|
|
procedure TestTypedActionTTime1(value: TTime);
|
|
|
|
|
|
2020-04-09 16:04:45 +02:00
|
|
|
|
[MVCPath('/typed/tguid1/($value)')]
|
|
|
|
|
procedure TestTypedActionTGuid1(value: TGUID);
|
|
|
|
|
|
2017-03-01 21:40:57 +01:00
|
|
|
|
[MVCPath('/typed/booleans/($bool1)/($bool2)/($bool3)/($bool4)')]
|
|
|
|
|
procedure TestTypedActionBooleans(bool1, bool2, bool3, bool4: Boolean);
|
|
|
|
|
|
|
|
|
|
[MVCPath('/renderstreamandfreewithownerfalse')]
|
|
|
|
|
procedure TestRenderStreamAndFreeWithOwnerFalse;
|
|
|
|
|
|
|
|
|
|
[MVCPath('/renderstreamandfreewithownertrue')]
|
|
|
|
|
procedure TestRenderStreamAndFreeWithOwnerTrue;
|
|
|
|
|
|
2018-10-31 01:07:23 +01:00
|
|
|
|
[MVCPath('/stringdictionary')]
|
|
|
|
|
procedure TestStringDictionary;
|
|
|
|
|
|
2020-11-27 15:13:17 +01:00
|
|
|
|
[MVCPath('/entitywitharrays')]
|
|
|
|
|
procedure TestEntityWithArrays;
|
|
|
|
|
|
2019-03-05 20:55:37 +01:00
|
|
|
|
[MVCPath('/image/png')]
|
|
|
|
|
[MVCHTTPMethod([httpGET])]
|
|
|
|
|
procedure TestGetImagePng;
|
|
|
|
|
|
2020-04-21 17:04:04 +02:00
|
|
|
|
[MVCPath('/objectdict')]
|
|
|
|
|
procedure TestObjectDict;
|
|
|
|
|
|
2020-09-08 15:25:44 +02:00
|
|
|
|
// exception rendering
|
|
|
|
|
[MVCPath('/exception/emvcexception1')]
|
2020-09-06 15:38:25 +02:00
|
|
|
|
procedure TestEMVCException1;
|
|
|
|
|
|
2020-09-08 15:25:44 +02:00
|
|
|
|
[MVCPath('/exception/emvcexception2')]
|
|
|
|
|
procedure TestEMVCException2;
|
|
|
|
|
|
|
|
|
|
[MVCPath('/exception/emvcexception3')]
|
|
|
|
|
procedure TestEMVCException3;
|
|
|
|
|
|
|
|
|
|
[MVCPath('/exception/emvcexception4')]
|
|
|
|
|
procedure TestEMVCException4;
|
|
|
|
|
|
2020-02-05 23:46:38 +01:00
|
|
|
|
// Nullables Tests
|
2020-02-03 12:11:42 +01:00
|
|
|
|
[MVCHTTPMethod([httpPOST])]
|
|
|
|
|
[MVCPath('/nullables/pingpong')]
|
|
|
|
|
procedure TestDeserializeAndSerializeNullables;
|
|
|
|
|
|
|
|
|
|
[MVCHTTPMethod([httpGET])]
|
|
|
|
|
[MVCPath('/nullables/getsingle')]
|
|
|
|
|
procedure TestSerializeNullables;
|
|
|
|
|
|
2020-02-03 13:19:55 +01:00
|
|
|
|
[MVCHTTPMethod([httpGET])]
|
|
|
|
|
[MVCPath('/nullables/getsinglewithnulls')]
|
|
|
|
|
procedure TestSerializeNullablesWithNulls;
|
|
|
|
|
|
2019-09-01 20:35:19 +02:00
|
|
|
|
// Response Objects Tests
|
|
|
|
|
[MVCHTTPMethod([httpPOST])]
|
|
|
|
|
[MVCPath('/responses/created')]
|
|
|
|
|
procedure TestResponseCreated;
|
|
|
|
|
|
|
|
|
|
[MVCHTTPMethod([httpPOST])]
|
|
|
|
|
[MVCPath('/responses/accepted')]
|
|
|
|
|
procedure TestResponseAccepted;
|
|
|
|
|
|
|
|
|
|
[MVCHTTPMethod([httpGET])]
|
|
|
|
|
[MVCPath('/responses/nocontent')]
|
|
|
|
|
procedure TestResponseNoContent;
|
2020-03-08 17:54:10 +01:00
|
|
|
|
|
|
|
|
|
[MVCHTTPMethod([httpGET])]
|
2020-09-16 15:56:14 +02:00
|
|
|
|
[MVCPath('/issue338/($projectid)')]
|
2020-03-08 17:54:10 +01:00
|
|
|
|
procedure GetProject;
|
|
|
|
|
|
|
|
|
|
[MVCHTTPMethod([httpGET])]
|
2020-09-16 15:56:14 +02:00
|
|
|
|
[MVCPath('/issue338/($projectid)/pictures/($imageuuid)')]
|
2020-03-08 17:54:10 +01:00
|
|
|
|
procedure GetImage;
|
2020-04-13 16:22:15 +02:00
|
|
|
|
|
2021-04-21 20:03:13 +02:00
|
|
|
|
{ injectable parameters }
|
|
|
|
|
[MVCHTTPMethod([httpGET])]
|
|
|
|
|
[MVCPath('/injectable10')]
|
|
|
|
|
procedure GetInject10(
|
|
|
|
|
const [MVCFromQueryString('parstring')] ParString: String;
|
|
|
|
|
const [MVCFromQueryString('parinteger')] ParInteger: Integer;
|
|
|
|
|
const [MVCFromQueryString('parint64')] ParInt64: Int64;
|
|
|
|
|
const [MVCFromQueryString('partdate')] ParTDate: TDate;
|
|
|
|
|
const [MVCFromQueryString('parttime')] ParTTime: TTime;
|
|
|
|
|
const [MVCFromQueryString('partdatetime')] ParTDateTime: TDateTime;
|
|
|
|
|
const [MVCFromQueryString('parbool')] ParBool: Boolean
|
|
|
|
|
);
|
|
|
|
|
|
|
|
|
|
[MVCHTTPMethod([httpGET])]
|
|
|
|
|
[MVCPath('/injectable20')]
|
|
|
|
|
procedure GetInject20(
|
|
|
|
|
const [MVCFromHeader('parstring')] ParString: String;
|
|
|
|
|
const [MVCFromHeader('parinteger')] ParInteger: Integer;
|
|
|
|
|
const [MVCFromHeader('parint64')] ParInt64: Int64;
|
|
|
|
|
const [MVCFromHeader('partdate')] ParTDate: TDate;
|
|
|
|
|
const [MVCFromHeader('parttime')] ParTTime: TTime;
|
|
|
|
|
const [MVCFromHeader('partdatetime')] ParTDateTime: TDateTime;
|
|
|
|
|
const [MVCFromHeader('parbool')] ParBool: Boolean
|
|
|
|
|
);
|
|
|
|
|
|
|
|
|
|
|
2020-04-13 16:22:15 +02:00
|
|
|
|
{ templates }
|
|
|
|
|
[MVCHTTPMethod([httpGET])]
|
|
|
|
|
[MVCPath('/website/list')]
|
|
|
|
|
procedure Tmpl_ListOfDataUsingDatasets;
|
|
|
|
|
|
2020-09-08 15:25:44 +02:00
|
|
|
|
{ issues }
|
|
|
|
|
[MVCHTTPMethod([httpGET])]
|
|
|
|
|
[MVCPath('/issues/406')]
|
|
|
|
|
procedure TestIssue406;
|
2017-03-01 21:40:57 +01:00
|
|
|
|
end;
|
|
|
|
|
|
|
|
|
|
[MVCPath('/private')]
|
|
|
|
|
TTestPrivateServerController = class(TMVCController)
|
|
|
|
|
public
|
|
|
|
|
[MVCPath('/role1')]
|
2018-10-23 16:18:34 +02:00
|
|
|
|
procedure OnlyRole1;
|
2017-03-01 21:40:57 +01:00
|
|
|
|
[MVCPath('/role1session')]
|
|
|
|
|
[MVCHTTPMethods([httpGET])]
|
2018-10-23 16:18:34 +02:00
|
|
|
|
procedure OnlyRole1Session;
|
2017-03-01 21:40:57 +01:00
|
|
|
|
[MVCPath('/role2')]
|
2018-10-23 16:18:34 +02:00
|
|
|
|
procedure OnlyRole2;
|
2017-03-01 21:40:57 +01:00
|
|
|
|
end;
|
|
|
|
|
|
2020-03-08 17:54:10 +01:00
|
|
|
|
[MVCPath('/exception/fault')]
|
2018-08-08 17:11:45 +02:00
|
|
|
|
TTestFaultController = class(TMVCController)
|
|
|
|
|
public
|
|
|
|
|
[MVCPath]
|
|
|
|
|
procedure NeverExecuted;
|
|
|
|
|
constructor Create; override;
|
|
|
|
|
end;
|
|
|
|
|
|
2020-03-08 17:54:10 +01:00
|
|
|
|
[MVCPath('/exception/fault2')]
|
2018-08-08 17:11:45 +02:00
|
|
|
|
TTestFault2Controller = class(TTestFaultController)
|
|
|
|
|
public
|
|
|
|
|
[MVCPath]
|
|
|
|
|
procedure NeverExecuted;
|
|
|
|
|
constructor Create; override;
|
|
|
|
|
end;
|
|
|
|
|
|
2017-03-01 21:40:57 +01:00
|
|
|
|
implementation
|
|
|
|
|
|
|
|
|
|
uses
|
2019-06-25 17:32:30 +02:00
|
|
|
|
JsonDataObjects,
|
2018-11-24 16:56:21 +01:00
|
|
|
|
System.JSON,
|
2018-08-08 17:11:45 +02:00
|
|
|
|
Web.HTTPApp,
|
|
|
|
|
BusinessObjectsU,
|
|
|
|
|
Generics.Collections,
|
|
|
|
|
MVCFramework.Serializer.Commons,
|
|
|
|
|
MVCFramework.Serializer.Defaults,
|
|
|
|
|
MVCFramework.DuckTyping,
|
2019-03-05 20:55:37 +01:00
|
|
|
|
System.IOUtils,
|
2020-11-27 15:13:17 +01:00
|
|
|
|
System.Classes, MVCFramework.Tests.Serializer.Entities;
|
2017-03-01 21:40:57 +01:00
|
|
|
|
|
|
|
|
|
{ TTestServerController }
|
|
|
|
|
|
2018-10-23 16:18:34 +02:00
|
|
|
|
procedure TTestServerController.DataSetHandling;
|
2017-03-01 21:40:57 +01:00
|
|
|
|
begin
|
2018-10-23 16:18:34 +02:00
|
|
|
|
case Context.Request.HTTPMethod of
|
2017-03-01 21:40:57 +01:00
|
|
|
|
httpGET:
|
|
|
|
|
begin
|
|
|
|
|
|
|
|
|
|
end;
|
|
|
|
|
httpPOST:
|
|
|
|
|
begin
|
|
|
|
|
end;
|
|
|
|
|
httpPUT:
|
|
|
|
|
begin
|
|
|
|
|
end;
|
|
|
|
|
httpDELETE:
|
|
|
|
|
begin
|
|
|
|
|
end;
|
|
|
|
|
httpHEAD:
|
|
|
|
|
begin
|
|
|
|
|
end;
|
|
|
|
|
httpOPTIONS:
|
|
|
|
|
begin
|
|
|
|
|
end;
|
|
|
|
|
end;
|
|
|
|
|
end;
|
|
|
|
|
|
2017-09-26 01:02:09 +02:00
|
|
|
|
procedure TTestServerController.EchoBody;
|
2017-03-01 21:40:57 +01:00
|
|
|
|
var
|
|
|
|
|
JSON: TJSONObject;
|
|
|
|
|
begin
|
2017-09-26 01:02:09 +02:00
|
|
|
|
JSON := TJSONObject.ParseJSONValue(Context.Request.Body) as TJSONObject;
|
2017-03-01 21:40:57 +01:00
|
|
|
|
JSON.AddPair('echo', 'from server');
|
2017-03-20 19:31:42 +01:00
|
|
|
|
Render(JSON, True);
|
2017-03-01 21:40:57 +01:00
|
|
|
|
end;
|
|
|
|
|
|
2018-10-23 16:18:34 +02:00
|
|
|
|
procedure TTestServerController.EchoHeaders;
|
2017-03-01 21:40:57 +01:00
|
|
|
|
begin
|
2018-10-23 16:18:34 +02:00
|
|
|
|
Context.Response.ContentType := TMVCMediaType.TEXT_PLAIN;
|
|
|
|
|
Render(Context.Request.Headers['ACCEPT']);
|
2017-03-01 21:40:57 +01:00
|
|
|
|
end;
|
|
|
|
|
|
2018-10-23 16:18:34 +02:00
|
|
|
|
procedure TTestServerController.GenerateCookies;
|
2017-03-01 21:40:57 +01:00
|
|
|
|
var
|
|
|
|
|
c: TCookie;
|
|
|
|
|
v: string;
|
|
|
|
|
begin
|
2018-10-23 16:18:34 +02:00
|
|
|
|
v := Context.Request.Cookie('usersettings');
|
2017-03-01 21:40:57 +01:00
|
|
|
|
|
2018-10-23 16:18:34 +02:00
|
|
|
|
c := Context.Response.Cookies.Add;
|
2017-03-01 21:40:57 +01:00
|
|
|
|
c.Name := 'usersettings1';
|
|
|
|
|
c.value := 'usersettings1-value';
|
|
|
|
|
c.Path := '/usersettings1';
|
|
|
|
|
c.Expires := 0;
|
|
|
|
|
|
2018-10-23 16:18:34 +02:00
|
|
|
|
c := Context.Response.Cookies.Add;
|
2017-03-01 21:40:57 +01:00
|
|
|
|
c.Name := 'usersettings2';
|
|
|
|
|
c.value := 'usersettings2-value';
|
|
|
|
|
c.Path := '/usersettings2';
|
|
|
|
|
c.Expires := 0;
|
|
|
|
|
|
2018-10-23 16:18:34 +02:00
|
|
|
|
c := Context.Response.Cookies.Add;
|
2017-03-01 21:40:57 +01:00
|
|
|
|
c.Name := 'usersettings3';
|
|
|
|
|
c.value := 'usersettings3-value';
|
|
|
|
|
c.Path := '/usersettings3';
|
|
|
|
|
c.Expires := 0;
|
|
|
|
|
|
2018-10-23 16:18:34 +02:00
|
|
|
|
c := Context.Response.Cookies.Add;
|
2017-03-01 21:40:57 +01:00
|
|
|
|
c.Name := 'usersettings4';
|
|
|
|
|
c.value := 'usersettings4-value';
|
|
|
|
|
c.Path := '/usersettings4';
|
|
|
|
|
c.Expires := 0;
|
|
|
|
|
|
|
|
|
|
end;
|
|
|
|
|
|
2020-04-21 17:04:04 +02:00
|
|
|
|
function TTestServerController.GetDataSet: TDataSet;
|
|
|
|
|
begin
|
|
|
|
|
Result := TFDMemTable.Create(nil);
|
|
|
|
|
TFDMemTable(Result).LoadFromFile(TPath.Combine(AppPath, 'customers.json'));
|
|
|
|
|
end;
|
|
|
|
|
|
2020-03-08 17:54:10 +01:00
|
|
|
|
procedure TTestServerController.GetImage;
|
|
|
|
|
begin
|
|
|
|
|
// do nothing
|
|
|
|
|
end;
|
|
|
|
|
|
2020-09-16 15:56:14 +02:00
|
|
|
|
|
2021-04-21 20:03:13 +02:00
|
|
|
|
procedure TTestServerController.GetInject10(const ParString: String;
|
|
|
|
|
const ParInteger: Integer; const ParInt64: Int64; const ParTDate: TDate;
|
|
|
|
|
const ParTTime: TTime; const ParTDateTime: TDateTime; const ParBool: Boolean);
|
|
|
|
|
var
|
|
|
|
|
lJObj: TJDOJsonObject;
|
|
|
|
|
begin
|
|
|
|
|
lJObj := TJDOJsonObject.Create;
|
|
|
|
|
lJObj.S['ParString'] := ParString;
|
|
|
|
|
lJObj.I['ParInteger'] := ParInteger;
|
|
|
|
|
lJObj.L['ParInt64'] := ParInt64;
|
|
|
|
|
lJObj.S['ParTDate'] := DateToISODate(ParTDate);
|
|
|
|
|
lJObj.S['ParTTime'] := TimeToISOTime(ParTTime);
|
|
|
|
|
lJObj.S['ParTDateTime'] := DateTimeToISOTimeStamp(ParTDateTime);
|
|
|
|
|
lJObj.B['ParBool'] := ParBool;
|
|
|
|
|
Render(lJObj);
|
|
|
|
|
end;
|
|
|
|
|
|
|
|
|
|
procedure TTestServerController.GetInject20(const ParString: String;
|
|
|
|
|
const ParInteger: Integer; const ParInt64: Int64; const ParTDate: TDate;
|
|
|
|
|
const ParTTime: TTime; const ParTDateTime: TDateTime; const ParBool: Boolean);
|
|
|
|
|
var
|
|
|
|
|
lJObj: TJDOJsonObject;
|
|
|
|
|
begin
|
|
|
|
|
lJObj := TJDOJsonObject.Create;
|
|
|
|
|
lJObj.S['ParString'] := ParString;
|
|
|
|
|
lJObj.I['ParInteger'] := ParInteger;
|
|
|
|
|
lJObj.L['ParInt64'] := ParInt64;
|
|
|
|
|
lJObj.S['ParTDate'] := DateToISODate(ParTDate);
|
|
|
|
|
lJObj.S['ParTTime'] := TimeToISOTime(ParTTime);
|
|
|
|
|
lJObj.S['ParTDateTime'] := DateTimeToISOTimeStamp(ParTDateTime);
|
|
|
|
|
lJObj.B['ParBool'] := ParBool;
|
|
|
|
|
Render(lJObj);
|
|
|
|
|
end;
|
|
|
|
|
|
2020-03-08 17:54:10 +01:00
|
|
|
|
procedure TTestServerController.GetProject;
|
|
|
|
|
begin
|
|
|
|
|
// do nothing
|
|
|
|
|
end;
|
|
|
|
|
|
2017-03-01 21:40:57 +01:00
|
|
|
|
procedure TTestServerController.Login;
|
|
|
|
|
begin
|
|
|
|
|
if Context.SessionStarted then
|
|
|
|
|
raise EMVCException.Create('Session already started');
|
|
|
|
|
Session['username'] := Context.Request.Params['username'];
|
|
|
|
|
if not Context.SessionStarted then
|
|
|
|
|
raise EMVCException.Create('Session still not started');
|
|
|
|
|
end;
|
|
|
|
|
|
|
|
|
|
procedure TTestServerController.Logout;
|
|
|
|
|
begin
|
|
|
|
|
if not Context.SessionStarted then
|
|
|
|
|
raise EMVCException.Create('Session not available');
|
|
|
|
|
Context.SessionStop(false);
|
|
|
|
|
if Context.SessionStarted then
|
|
|
|
|
raise EMVCException.Create('Session still available');
|
|
|
|
|
end;
|
|
|
|
|
|
|
|
|
|
procedure TTestServerController.MVCControllerAfterCreate;
|
|
|
|
|
begin
|
|
|
|
|
FFormatSettings.DecimalSeparator := '.';
|
|
|
|
|
end;
|
|
|
|
|
|
2020-04-21 17:04:04 +02:00
|
|
|
|
procedure TTestServerController.MVCControllerBeforeDestroy;
|
|
|
|
|
begin
|
|
|
|
|
inherited;
|
|
|
|
|
|
|
|
|
|
end;
|
|
|
|
|
|
2018-10-23 16:18:34 +02:00
|
|
|
|
procedure TTestServerController.ReqWithParams;
|
2017-03-01 21:40:57 +01:00
|
|
|
|
begin
|
2019-03-05 20:55:37 +01:00
|
|
|
|
Render(TJSONObject.Create.AddPair('par1', Context.Request.Params['par1']).AddPair('par2',
|
|
|
|
|
Context.Request.Params['par2']).AddPair('par3', Context.Request.Params['par3']).AddPair('method',
|
|
|
|
|
Context.Request.HTTPMethodAsString));
|
2017-03-01 21:40:57 +01:00
|
|
|
|
end;
|
|
|
|
|
|
|
|
|
|
procedure TTestServerController.SessionGet;
|
|
|
|
|
var
|
|
|
|
|
s: string;
|
|
|
|
|
begin
|
|
|
|
|
ContentType := Context.Request.Accept;
|
|
|
|
|
s := Session['value'];
|
|
|
|
|
Render(s);
|
|
|
|
|
end;
|
|
|
|
|
|
2017-09-26 01:02:09 +02:00
|
|
|
|
procedure TTestServerController.SessionSet;
|
2017-03-01 21:40:57 +01:00
|
|
|
|
begin
|
2017-09-26 01:02:09 +02:00
|
|
|
|
Session['value'] := Context.Request.Params['value'];
|
2017-03-01 21:40:57 +01:00
|
|
|
|
end;
|
|
|
|
|
|
2017-09-26 01:02:09 +02:00
|
|
|
|
procedure TTestServerController.TestConsumeJSON;
|
2017-03-01 21:40:57 +01:00
|
|
|
|
begin
|
|
|
|
|
Render(TJSONObject.ParseJSONValue('{"key":"Hello World"}'));
|
|
|
|
|
end;
|
|
|
|
|
|
2017-09-26 01:02:09 +02:00
|
|
|
|
procedure TTestServerController.TestConsumesProduces;
|
2017-03-01 21:40:57 +01:00
|
|
|
|
begin
|
|
|
|
|
Render('Hello World');
|
|
|
|
|
end;
|
|
|
|
|
|
2018-10-23 16:18:34 +02:00
|
|
|
|
procedure TTestServerController.TestConsumesProducesText;
|
2017-03-01 21:40:57 +01:00
|
|
|
|
begin
|
|
|
|
|
Render('Hello World');
|
|
|
|
|
end;
|
|
|
|
|
|
|
|
|
|
procedure TTestServerController.TestConsumesProducesTextISO8859_1;
|
|
|
|
|
begin
|
|
|
|
|
Render(Context.Request.Body);
|
|
|
|
|
end;
|
|
|
|
|
|
2019-06-25 17:32:30 +02:00
|
|
|
|
procedure TTestServerController.TestCustomerEcho;
|
|
|
|
|
var
|
|
|
|
|
lCustomer: TCustomer;
|
|
|
|
|
begin
|
|
|
|
|
lCustomer := Context.Request.BodyAs<TCustomer>();
|
|
|
|
|
// lCustomer.Logo.SaveToFile('pippo_server_before.bmp');
|
|
|
|
|
lCustomer.Name := lCustomer.Name + ' changed';
|
2020-02-05 23:46:38 +01:00
|
|
|
|
{$IFNDEF LINUX}
|
2019-06-25 17:32:30 +02:00
|
|
|
|
lCustomer.Logo.Canvas.TextOut(10, 10, 'Changed');
|
2020-02-05 23:46:38 +01:00
|
|
|
|
{$ENDIF}
|
2019-06-25 17:32:30 +02:00
|
|
|
|
// lCustomer.Logo.SaveToFile('pippo_server_after.bmp');
|
|
|
|
|
Render(lCustomer, True);
|
|
|
|
|
end;
|
|
|
|
|
|
2020-02-03 12:11:42 +01:00
|
|
|
|
procedure TTestServerController.TestDeserializeAndSerializeNullables;
|
|
|
|
|
var
|
|
|
|
|
lNullablesTest: TNullablesTest;
|
|
|
|
|
begin
|
|
|
|
|
lNullablesTest := Context.Request.BodyAs<TNullablesTest>;
|
|
|
|
|
Render(lNullablesTest);
|
|
|
|
|
end;
|
|
|
|
|
|
2020-09-06 15:38:25 +02:00
|
|
|
|
procedure TTestServerController.TestEMVCException1;
|
|
|
|
|
begin
|
|
|
|
|
raise EMVCException.Create('message');
|
|
|
|
|
end;
|
|
|
|
|
|
2020-09-08 15:25:44 +02:00
|
|
|
|
procedure TTestServerController.TestEMVCException2;
|
|
|
|
|
begin
|
|
|
|
|
raise EMVCException.Create(HTTP_STATUS.BadRequest, 'message');
|
|
|
|
|
end;
|
|
|
|
|
|
|
|
|
|
procedure TTestServerController.TestEMVCException3;
|
|
|
|
|
begin
|
|
|
|
|
raise EMVCException.Create(HTTP_STATUS.Created, 999, 'message');
|
|
|
|
|
end;
|
|
|
|
|
|
|
|
|
|
procedure TTestServerController.TestEMVCException4;
|
|
|
|
|
begin
|
|
|
|
|
raise EMVCException.Create('message', 'detailedmessage', 999, HTTP_STATUS.Created, ['erritem1', 'erritem2']);
|
|
|
|
|
end;
|
|
|
|
|
|
2020-11-27 15:13:17 +01:00
|
|
|
|
procedure TTestServerController.TestEntityWithArrays;
|
|
|
|
|
var
|
|
|
|
|
lObj: TEntityWithArray;
|
|
|
|
|
begin
|
|
|
|
|
lObj := Context.Request.BodyAs<TEntityWithArray>;
|
|
|
|
|
try
|
|
|
|
|
lObj.Names := lObj.Names + ['added'];
|
|
|
|
|
lObj.Values := lObj.Values + [99];
|
|
|
|
|
lObj.Booleans := lObj.Booleans + [true];
|
|
|
|
|
Render(lObj, False);
|
|
|
|
|
finally
|
|
|
|
|
lObj.Free;
|
|
|
|
|
end;
|
|
|
|
|
end;
|
|
|
|
|
|
2018-10-23 16:18:34 +02:00
|
|
|
|
procedure TTestServerController.TestCharset;
|
2017-03-01 21:40:57 +01:00
|
|
|
|
var
|
2019-06-25 17:32:30 +02:00
|
|
|
|
Obj: TJDOJSONObject;
|
2017-03-01 21:40:57 +01:00
|
|
|
|
begin
|
2017-10-16 22:57:27 +02:00
|
|
|
|
ContentType := BuildContentType(TMVCMediaType.APPLICATION_JSON, TMVCCharset.UTF_8);
|
2019-06-25 17:32:30 +02:00
|
|
|
|
Obj := TJDOJSONObject.Create;
|
|
|
|
|
try
|
|
|
|
|
Obj.s['name1'] := 'j<>rn';
|
|
|
|
|
Obj.s['name2'] := '<27>to je Unicode?';
|
|
|
|
|
Obj.s['name3'] := '<27><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>';
|
|
|
|
|
Render(Obj, false);
|
|
|
|
|
finally
|
|
|
|
|
Obj.Free;
|
|
|
|
|
end;
|
2017-03-01 21:40:57 +01:00
|
|
|
|
end;
|
|
|
|
|
|
2019-03-05 20:55:37 +01:00
|
|
|
|
procedure TTestServerController.TestGetImagePng;
|
2020-04-07 10:37:33 +02:00
|
|
|
|
var
|
|
|
|
|
lFName: string;
|
2019-03-05 20:55:37 +01:00
|
|
|
|
begin
|
|
|
|
|
ContentType := TMVCMediaType.IMAGE_PNG;
|
2020-04-21 17:04:04 +02:00
|
|
|
|
lFName := TPath.Combine(AppPath, 'sample.png');
|
2020-04-07 10:37:33 +02:00
|
|
|
|
Render(TFile.OpenRead(lFName));
|
2019-03-05 20:55:37 +01:00
|
|
|
|
end;
|
|
|
|
|
|
2018-10-23 16:18:34 +02:00
|
|
|
|
procedure TTestServerController.TestGetPersonByID;
|
2017-03-01 21:40:57 +01:00
|
|
|
|
var
|
|
|
|
|
PersonList: TObjectList<TPerson>;
|
|
|
|
|
ID: Integer;
|
|
|
|
|
begin
|
2018-10-23 16:18:34 +02:00
|
|
|
|
ID := Context.Request.Params['id'].ToInteger;
|
2017-03-01 21:40:57 +01:00
|
|
|
|
PersonList := TPerson.GetList;
|
|
|
|
|
try
|
|
|
|
|
Render(PersonList[ID - 1], false);
|
|
|
|
|
finally
|
|
|
|
|
PersonList.Free;
|
|
|
|
|
end;
|
|
|
|
|
end;
|
|
|
|
|
|
2018-10-23 16:18:34 +02:00
|
|
|
|
procedure TTestServerController.TestGetPersonByIDAsFields;
|
2017-03-01 21:40:57 +01:00
|
|
|
|
var
|
|
|
|
|
PersonList: TObjectList<TPerson>;
|
|
|
|
|
ID: Integer;
|
|
|
|
|
begin
|
|
|
|
|
raise Exception.Create('Not implemented');
|
2018-10-23 16:18:34 +02:00
|
|
|
|
ID := Context.Request.Params['id'].ToInteger;
|
2017-03-01 21:40:57 +01:00
|
|
|
|
PersonList := TPerson.GetList;
|
|
|
|
|
try
|
2017-06-02 00:10:31 +02:00
|
|
|
|
// Render(PersonList[ID - 1], false, TDMVCSerializationType.Fields);
|
2017-03-01 21:40:57 +01:00
|
|
|
|
finally
|
|
|
|
|
PersonList.Free;
|
|
|
|
|
end;
|
|
|
|
|
end;
|
|
|
|
|
|
2018-10-23 16:18:34 +02:00
|
|
|
|
procedure TTestServerController.TestGetPersons;
|
2017-03-01 21:40:57 +01:00
|
|
|
|
var
|
|
|
|
|
Person: TPerson;
|
|
|
|
|
begin
|
2018-10-23 16:18:34 +02:00
|
|
|
|
case Context.Request.HTTPMethod of
|
2017-03-01 21:40:57 +01:00
|
|
|
|
httpGET:
|
2017-08-21 15:31:31 +02:00
|
|
|
|
Render<TPerson>(TPerson.GetList, True);
|
2017-03-01 21:40:57 +01:00
|
|
|
|
httpPOST:
|
|
|
|
|
begin
|
2018-10-23 16:18:34 +02:00
|
|
|
|
Person := Context.Request.BodyAs<TPerson>();
|
2017-03-01 21:40:57 +01:00
|
|
|
|
Render(Person);
|
|
|
|
|
end;
|
|
|
|
|
httpPUT:
|
|
|
|
|
;
|
|
|
|
|
end;
|
|
|
|
|
|
|
|
|
|
end;
|
|
|
|
|
|
2019-03-08 09:33:41 +01:00
|
|
|
|
procedure TTestServerController.TestGetPersonsHateos;
|
|
|
|
|
begin
|
|
|
|
|
Render<TPerson>(TPerson.GetList, True,
|
2019-05-09 20:53:52 +02:00
|
|
|
|
procedure(const Person: TPerson; const Links: IMVCLinks)
|
2019-03-08 09:33:41 +01:00
|
|
|
|
begin
|
2020-09-08 15:25:44 +02:00
|
|
|
|
Links.AddRefLink.Add(HATEOAS.HREF, '/api/people/' + Person.ID.ToString).Add(HATEOAS.REL, 'test0')
|
2019-05-09 20:53:52 +02:00
|
|
|
|
.Add(HATEOAS._TYPE, 'application/json');
|
2020-09-08 15:25:44 +02:00
|
|
|
|
Links.AddRefLink.Add(HATEOAS.HREF, '/api/test/' + Person.ID.ToString).Add(HATEOAS.REL, 'test1').Add(HATEOAS._TYPE,
|
|
|
|
|
'application/json')
|
2019-03-08 09:33:41 +01:00
|
|
|
|
end);
|
|
|
|
|
end;
|
|
|
|
|
|
2018-10-23 16:18:34 +02:00
|
|
|
|
procedure TTestServerController.TestGetWrappedPeople;
|
2017-03-01 21:40:57 +01:00
|
|
|
|
var
|
|
|
|
|
LWrappedList: IWrappedList;
|
|
|
|
|
lObj: TObject;
|
|
|
|
|
begin
|
2018-10-23 16:18:34 +02:00
|
|
|
|
if not Context.Request.QueryStringParamExists('count') then
|
|
|
|
|
begin
|
|
|
|
|
lObj := TPerson.GetList;
|
|
|
|
|
end
|
|
|
|
|
else
|
|
|
|
|
begin
|
|
|
|
|
lObj := TPerson.GetList(Context.Request.ParamsAsInt64['count']);
|
|
|
|
|
end;
|
2017-03-01 21:40:57 +01:00
|
|
|
|
try
|
|
|
|
|
LWrappedList := WrapAsList(lObj);
|
2017-03-20 19:31:42 +01:00
|
|
|
|
Render(LWrappedList);
|
2017-03-01 21:40:57 +01:00
|
|
|
|
finally
|
|
|
|
|
lObj.Free;
|
|
|
|
|
end;
|
|
|
|
|
end;
|
|
|
|
|
|
2018-10-23 16:18:34 +02:00
|
|
|
|
procedure TTestServerController.TestHelloWorld;
|
2017-03-01 21:40:57 +01:00
|
|
|
|
begin
|
|
|
|
|
ContentType := 'text/plain';
|
|
|
|
|
Render('hello world');
|
|
|
|
|
end;
|
|
|
|
|
|
2020-09-08 15:25:44 +02:00
|
|
|
|
procedure TTestServerController.TestIssue406;
|
|
|
|
|
begin
|
|
|
|
|
Render(HTTP_STATUS.UnprocessableEntity, TMVCErrorResponseItem.Create('The Message'));
|
|
|
|
|
end;
|
|
|
|
|
|
2017-03-01 21:40:57 +01:00
|
|
|
|
procedure TTestServerController.TestJSONArrayAsObjectList;
|
|
|
|
|
var
|
2019-06-25 17:32:30 +02:00
|
|
|
|
lUsers: TObjectList<TCustomer>;
|
2017-03-01 21:40:57 +01:00
|
|
|
|
begin
|
2019-06-25 17:32:30 +02:00
|
|
|
|
lUsers := Context.Request.BodyAsListOf<TCustomer>();
|
2017-03-01 21:40:57 +01:00
|
|
|
|
try
|
2019-06-25 17:32:30 +02:00
|
|
|
|
lUsers.OwnsObjects := True;
|
|
|
|
|
if (lUsers.Count = 3000) then
|
2017-03-01 21:40:57 +01:00
|
|
|
|
Render('Success!')
|
|
|
|
|
else
|
|
|
|
|
Render('Error!');
|
|
|
|
|
finally
|
2019-06-25 17:32:30 +02:00
|
|
|
|
FreeAndNil(lUsers);
|
2017-03-01 21:40:57 +01:00
|
|
|
|
end;
|
|
|
|
|
end;
|
|
|
|
|
|
2018-10-23 16:18:34 +02:00
|
|
|
|
procedure TTestServerController.TestMultiplePaths;
|
2017-03-01 21:40:57 +01:00
|
|
|
|
begin
|
|
|
|
|
ContentType := TMVCMediaType.TEXT_PLAIN;
|
2018-10-23 16:18:34 +02:00
|
|
|
|
Render(Context.Request.Params['id']);
|
2017-03-01 21:40:57 +01:00
|
|
|
|
end;
|
|
|
|
|
|
2020-04-21 17:04:04 +02:00
|
|
|
|
procedure TTestServerController.TestObjectDict;
|
|
|
|
|
var
|
|
|
|
|
lDict: IMVCObjectDictionary;
|
|
|
|
|
begin
|
2020-09-08 15:25:44 +02:00
|
|
|
|
lDict := ObjectDict(True).Add('ncUpperCase_List', GetDataSet, nil, dstAllRecords, ncUpperCase)
|
|
|
|
|
.Add('ncLowerCase_List', GetDataSet, nil, dstAllRecords, ncLowerCase).Add('ncCamelCase_List', GetDataSet, nil,
|
|
|
|
|
dstAllRecords, ncCamelCase).Add('ncPascalCase_List', GetDataSet, nil, dstAllRecords, ncPascalCase)
|
|
|
|
|
.Add('ncUpperCase_Single', GetDataSet, nil, dstSingleRecord, ncUpperCase).Add('ncLowerCase_Single', GetDataSet, nil,
|
|
|
|
|
dstSingleRecord, ncLowerCase).Add('ncCamelCase_Single', GetDataSet, nil, dstSingleRecord, ncCamelCase)
|
|
|
|
|
.Add('ncPascalCase_Single', GetDataSet, nil, dstSingleRecord, ncPascalCase).Add('meta', StrDict(['page'], ['1']));
|
2020-04-21 17:04:04 +02:00
|
|
|
|
Render(lDict);
|
|
|
|
|
end;
|
|
|
|
|
|
2018-10-23 16:18:34 +02:00
|
|
|
|
procedure TTestServerController.TestPOSTObject;
|
2017-03-01 21:40:57 +01:00
|
|
|
|
var
|
|
|
|
|
Person: TPerson;
|
|
|
|
|
begin
|
2018-10-23 16:18:34 +02:00
|
|
|
|
Person := Context.Request.BodyAs<TPerson>();
|
2017-03-01 21:40:57 +01:00
|
|
|
|
Render(Person);
|
|
|
|
|
end;
|
|
|
|
|
|
|
|
|
|
procedure TTestServerController.TestRenderStreamAndFreeWithOwnerFalse;
|
|
|
|
|
var
|
|
|
|
|
LStream: TMemoryStream;
|
|
|
|
|
begin
|
|
|
|
|
LStream := TMemoryStream.Create;
|
|
|
|
|
try
|
|
|
|
|
Render(LStream, false);
|
|
|
|
|
finally
|
|
|
|
|
LStream.Free;
|
|
|
|
|
end;
|
|
|
|
|
end;
|
|
|
|
|
|
|
|
|
|
procedure TTestServerController.TestRenderStreamAndFreeWithOwnerTrue;
|
|
|
|
|
var
|
|
|
|
|
LStream: TMemoryStream;
|
|
|
|
|
begin
|
|
|
|
|
LStream := TMemoryStream.Create;
|
|
|
|
|
Render(LStream, True);
|
|
|
|
|
end;
|
|
|
|
|
|
2019-09-01 20:35:19 +02:00
|
|
|
|
procedure TTestServerController.TestResponseAccepted;
|
|
|
|
|
begin
|
2020-03-31 00:47:35 +02:00
|
|
|
|
Render202Accepted('http://pippo.it/1234', '1234', 'thisisthereason');
|
2019-09-01 20:35:19 +02:00
|
|
|
|
end;
|
|
|
|
|
|
|
|
|
|
procedure TTestServerController.TestResponseCreated;
|
|
|
|
|
begin
|
2020-03-31 00:47:35 +02:00
|
|
|
|
Render201Created('thisisthelocation', 'thisisthereason');
|
2019-09-01 20:35:19 +02:00
|
|
|
|
end;
|
|
|
|
|
|
|
|
|
|
procedure TTestServerController.TestResponseNoContent;
|
|
|
|
|
begin
|
2020-03-31 00:47:35 +02:00
|
|
|
|
Render204NoContent('thisisthereason');
|
2019-09-01 20:35:19 +02:00
|
|
|
|
end;
|
|
|
|
|
|
2020-02-03 12:11:42 +01:00
|
|
|
|
procedure TTestServerController.TestSerializeNullables;
|
|
|
|
|
var
|
|
|
|
|
lObj: TNullablesTest;
|
|
|
|
|
begin
|
|
|
|
|
lObj := TNullablesTest.Create();
|
|
|
|
|
lObj.LoadSomeData;
|
|
|
|
|
Render(lObj);
|
|
|
|
|
end;
|
|
|
|
|
|
2020-02-03 13:19:55 +01:00
|
|
|
|
procedure TTestServerController.TestSerializeNullablesWithNulls;
|
|
|
|
|
var
|
|
|
|
|
lObj: TNullablesTest;
|
|
|
|
|
begin
|
|
|
|
|
lObj := TNullablesTest.Create();
|
|
|
|
|
Render(lObj);
|
|
|
|
|
end;
|
|
|
|
|
|
2018-10-31 01:07:23 +01:00
|
|
|
|
procedure TTestServerController.TestStringDictionary;
|
|
|
|
|
var
|
|
|
|
|
lDict: TMVCStringDictionary;
|
|
|
|
|
begin
|
|
|
|
|
lDict := Context.Request.BodyAs<TMVCStringDictionary>;
|
|
|
|
|
try
|
|
|
|
|
lDict['fromserver'] := 'changed';
|
|
|
|
|
Render(lDict, false);
|
|
|
|
|
finally
|
|
|
|
|
lDict.Free;
|
|
|
|
|
end;
|
|
|
|
|
end;
|
|
|
|
|
|
2019-03-05 20:55:37 +01:00
|
|
|
|
procedure TTestServerController.TestTypedActionAllTypes(ParString: string; ParInteger: Integer; ParInt64: Int64;
|
2019-03-08 09:33:41 +01:00
|
|
|
|
ParSingle: Single; ParDouble: Double; ParExtended: Extended);
|
2017-03-01 21:40:57 +01:00
|
|
|
|
var
|
|
|
|
|
lJObj: TJSONObject;
|
|
|
|
|
begin
|
|
|
|
|
lJObj := TJSONObject.Create;
|
|
|
|
|
lJObj.AddPair('ParString', ParString);
|
|
|
|
|
lJObj.AddPair('ParInteger', TJSONNumber.Create(ParInteger));
|
|
|
|
|
lJObj.AddPair('ParInt64', TJSONNumber.Create(ParInt64));
|
|
|
|
|
lJObj.AddPair('ParSingle', TJSONNumber.Create(ParSingle));
|
|
|
|
|
lJObj.AddPair('ParDouble', TJSONNumber.Create(ParDouble));
|
|
|
|
|
lJObj.AddPair('ParExtended', TJSONNumber.Create(ParExtended));
|
|
|
|
|
Render(lJObj);
|
|
|
|
|
end;
|
|
|
|
|
|
|
|
|
|
procedure TTestServerController.TestTypedActionDouble1(value: Double);
|
|
|
|
|
begin
|
|
|
|
|
ContentType := TMVCMediaType.TEXT_PLAIN;
|
|
|
|
|
Render(FloatToStr(value, FFormatSettings) + ' modified from server');
|
|
|
|
|
end;
|
|
|
|
|
|
|
|
|
|
procedure TTestServerController.TestTypedActionExtended1(value: Extended);
|
|
|
|
|
begin
|
|
|
|
|
ContentType := TMVCMediaType.TEXT_PLAIN;
|
|
|
|
|
Render(FloatToStr(value, FFormatSettings) + ' modified from server');
|
|
|
|
|
end;
|
|
|
|
|
|
|
|
|
|
procedure TTestServerController.TestTypedActionSingle1(value: Single);
|
|
|
|
|
begin
|
|
|
|
|
ContentType := TMVCMediaType.TEXT_PLAIN;
|
|
|
|
|
Render(FloatToStr(value, FFormatSettings) + ' modified from server');
|
|
|
|
|
end;
|
|
|
|
|
|
|
|
|
|
procedure TTestServerController.TestTypedActionInt641(value: Int64);
|
|
|
|
|
begin
|
|
|
|
|
ContentType := TMVCMediaType.TEXT_PLAIN;
|
|
|
|
|
Render(value.ToString + ' modified from server');
|
|
|
|
|
end;
|
|
|
|
|
|
|
|
|
|
procedure TTestServerController.TestTypedActionInteger1(value: Integer);
|
|
|
|
|
begin
|
|
|
|
|
ContentType := TMVCMediaType.TEXT_PLAIN;
|
|
|
|
|
Render(value.ToString + ' modified from server');
|
|
|
|
|
end;
|
|
|
|
|
|
|
|
|
|
procedure TTestServerController.TestTypedActionString1(value: string);
|
|
|
|
|
begin
|
|
|
|
|
ContentType := TMVCMediaType.TEXT_PLAIN;
|
2020-03-04 19:56:01 +01:00
|
|
|
|
Render('*' + value + '*');
|
2017-03-01 21:40:57 +01:00
|
|
|
|
end;
|
|
|
|
|
|
|
|
|
|
procedure TTestServerController.TestTypedActionTDate1(value: TDate);
|
|
|
|
|
begin
|
|
|
|
|
ContentType := TMVCMediaType.TEXT_PLAIN;
|
2017-05-25 16:57:49 +02:00
|
|
|
|
Render(DateToISODate(value) + ' modified from server');
|
2017-03-01 21:40:57 +01:00
|
|
|
|
end;
|
|
|
|
|
|
|
|
|
|
procedure TTestServerController.TestTypedActionTDateTime1(value: TDateTime);
|
|
|
|
|
begin
|
|
|
|
|
ContentType := TMVCMediaType.TEXT_PLAIN;
|
2017-05-25 16:57:49 +02:00
|
|
|
|
Render(DateTimeToISOTimeStamp(value) + ' modified from server');
|
2017-03-01 21:40:57 +01:00
|
|
|
|
end;
|
|
|
|
|
|
2020-04-09 16:04:45 +02:00
|
|
|
|
procedure TTestServerController.TestTypedActionTGuid1(value: TGUID);
|
|
|
|
|
begin
|
|
|
|
|
ContentType := TMVCMediaType.TEXT_PLAIN;
|
|
|
|
|
Render(GuidToString(value) + ' modified from server');
|
|
|
|
|
end;
|
|
|
|
|
|
2018-08-08 17:11:45 +02:00
|
|
|
|
procedure TTestServerController.TestTypedActionBooleans(bool1, bool2, bool3, bool4: Boolean);
|
2017-03-01 21:40:57 +01:00
|
|
|
|
begin
|
|
|
|
|
ContentType := TMVCMediaType.TEXT_PLAIN;
|
2019-03-05 20:55:37 +01:00
|
|
|
|
Render(Format('%s.%s.%s.%s', [BoolToStr(bool1, True), BoolToStr(bool2, True), BoolToStr(bool3, True),
|
|
|
|
|
BoolToStr(bool4, True)]));
|
2017-03-01 21:40:57 +01:00
|
|
|
|
end;
|
|
|
|
|
|
|
|
|
|
procedure TTestServerController.TestTypedActionTTime1(value: TTime);
|
|
|
|
|
begin
|
|
|
|
|
ContentType := TMVCMediaType.TEXT_PLAIN;
|
2017-05-25 16:57:49 +02:00
|
|
|
|
Render(TimeToISOTime(value) + ' modified from server');
|
2017-03-01 21:40:57 +01:00
|
|
|
|
end;
|
|
|
|
|
|
2020-04-13 16:22:15 +02:00
|
|
|
|
procedure TTestServerController.Tmpl_ListOfDataUsingDatasets;
|
|
|
|
|
var
|
|
|
|
|
lDS: TFDMemTable;
|
|
|
|
|
begin
|
|
|
|
|
lDS := TFDMemTable.Create(nil);
|
|
|
|
|
try
|
2020-04-21 17:04:04 +02:00
|
|
|
|
var lFName: string := TPath.Combine(AppPath, 'customers.json');
|
2020-04-13 16:22:15 +02:00
|
|
|
|
lDS.LoadFromFile(lFName);
|
|
|
|
|
ViewDataset['customers'] := lDS;
|
|
|
|
|
ViewData['customers2'] := lDS;
|
|
|
|
|
LoadView(['dataset_list']);
|
|
|
|
|
RenderResponseStream;
|
|
|
|
|
finally
|
|
|
|
|
lDS.Free;
|
|
|
|
|
end;
|
|
|
|
|
end;
|
|
|
|
|
|
2017-03-01 21:40:57 +01:00
|
|
|
|
{ TTestPrivateServerController }
|
|
|
|
|
|
2018-10-23 16:18:34 +02:00
|
|
|
|
procedure TTestPrivateServerController.OnlyRole1;
|
2017-03-01 21:40:57 +01:00
|
|
|
|
begin
|
2018-10-23 16:18:34 +02:00
|
|
|
|
Render(Context.LoggedUser.UserName);
|
2017-03-01 21:40:57 +01:00
|
|
|
|
end;
|
|
|
|
|
|
2018-10-23 16:18:34 +02:00
|
|
|
|
procedure TTestPrivateServerController.OnlyRole1Session;
|
2017-03-01 21:40:57 +01:00
|
|
|
|
begin
|
2018-10-23 16:18:34 +02:00
|
|
|
|
if Context.Request.QueryStringParamExists('value') then
|
2017-03-01 21:40:57 +01:00
|
|
|
|
begin
|
2018-10-23 16:18:34 +02:00
|
|
|
|
Session['value'] := Context.Request.Params['value'];
|
2017-03-01 21:40:57 +01:00
|
|
|
|
end
|
|
|
|
|
else
|
|
|
|
|
begin
|
|
|
|
|
Render(Session['value']);
|
|
|
|
|
end;
|
|
|
|
|
end;
|
|
|
|
|
|
2018-10-23 16:18:34 +02:00
|
|
|
|
procedure TTestPrivateServerController.OnlyRole2;
|
2017-03-01 21:40:57 +01:00
|
|
|
|
begin
|
2018-10-23 16:18:34 +02:00
|
|
|
|
Render(Context.LoggedUser.UserName);
|
2017-03-01 21:40:57 +01:00
|
|
|
|
end;
|
|
|
|
|
|
2018-08-08 17:11:45 +02:00
|
|
|
|
{ TTestFaultController }
|
|
|
|
|
|
|
|
|
|
constructor TTestFaultController.Create;
|
|
|
|
|
begin
|
|
|
|
|
inherited;
|
|
|
|
|
raise Exception.Create('BOOOM!!!');
|
|
|
|
|
end;
|
|
|
|
|
|
|
|
|
|
procedure TTestFaultController.NeverExecuted;
|
|
|
|
|
begin
|
|
|
|
|
// do nothing
|
|
|
|
|
end;
|
|
|
|
|
|
|
|
|
|
{ TTestFault2Controller }
|
|
|
|
|
|
|
|
|
|
constructor TTestFault2Controller.Create;
|
|
|
|
|
begin
|
|
|
|
|
inherited;
|
|
|
|
|
end;
|
|
|
|
|
|
|
|
|
|
procedure TTestFault2Controller.NeverExecuted;
|
|
|
|
|
begin
|
2018-10-23 16:18:34 +02:00
|
|
|
|
// do nothing
|
2018-08-08 17:11:45 +02:00
|
|
|
|
end;
|
|
|
|
|
|
2017-03-01 21:40:57 +01:00
|
|
|
|
end.
|