delphimvcframework/unittests/general/TestServer/TestServerControllerU.pas
2023-09-05 12:29:38 +02:00

1588 lines
42 KiB
ObjectPascal
Raw Blame History

// ***************************************************************************
//
// Delphi MVC Framework
//
// Copyright (c) 2010-2023 Daniele Teti and the DMVCFramework Team
//
// 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;
{$HINTS OFF}
interface
uses
MVCFramework,
System.SysUtils,
MVCFramework.Commons,
FireDAC.Comp.Client,
System.Generics.Collections,
Data.DB,
BusinessObjectsU, MVCFramework.Serializer.Commons, System.Classes,
System.UITypes;
type
[MVCPath]
[MVCPath('/donotusethis')]
TTestServerController = class(TMVCController)
private
FFormatSettings: TFormatSettings;
fDataSet: TFDMemTable;
protected
procedure MVCControllerAfterCreate; override;
procedure MVCControllerBeforeDestroy; override;
public
class function GetDataSet: TDataSet;
[MVCPath('/req/with/params/($par1)/($par2)/($par3)')]
[MVCHTTPMethod([httpGET, httpDELETE])]
procedure ReqWithParams;
[MVCPath('/echo/($par1)/($par2)/($par3)')]
[MVCHTTPMethod([httpPOST, httpPUT, httpPATCH])]
procedure EchoBody;
[MVCPath('/session/($value)')]
[MVCHTTPMethod([httpPOST])]
procedure SessionSet;
[MVCPath('/session')]
[MVCHTTPMethod([httpGET])]
procedure SessionGet;
[MVCPath('/headers')]
procedure EchoHeaders;
[MVCPath('/lotofcookies')]
procedure GenerateCookies;
[MVCPath('/dataset/($datasetname)')]
procedure DataSetHandling;
[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!!!!
procedure TestCharset;
[MVCPath('/testconsumes')]
[MVCHTTPMethod([httpGET, httpPOST, httpPUT])]
[MVCConsumes('application/json')]
[MVCProduces('application/json', 'utf-8')]
procedure TestConsumesProduces;
[MVCPath('/testconsumes/textiso8859_1')]
[MVCHTTPMethod([httpPOST, httpPUT])]
[MVCConsumes(TMVCMediaType.TEXT_PLAIN)]
[MVCProduces(TMVCMediaType.TEXT_PLAIN, TMVCCharset.ISO88591)]
procedure TestConsumesProducesTextISO8859_1;
[MVCPath('/testconsumes')]
[MVCHTTPMethod([httpGET, httpPOST, httpPUT])]
[MVCConsumes('text/plain')]
[MVCProduces('text/plain', 'utf-8')]
procedure TestConsumesProducesText;
[MVCPath('/adapter/testconsumejson')]
[MVCHTTPMethod([httpGET])]
[MVCConsumes('application/json')]
[MVCProduces('application/json', 'utf-8')]
procedure TestConsumeJSON;
[MVCPath('/people/renderaction')]
[MVCHTTPMethod([httpGET])]
procedure TestGetPersonsHateos;
[MVCPath('/people/($id)')]
[MVCHTTPMethod([httpGET])]
procedure TestGetPersonByID;
[MVCPath('/people/($id)/asfields')]
[MVCHTTPMethod([httpGET])]
procedure TestGetPersonByIDAsFields;
[MVCPath('/customers/list')]
[MVCHTTPMethod([httpPOST])]
procedure TestJSONArrayAsObjectList;
[MVCPath('/people')]
[MVCHTTPMethod([httpGET, httpPOST, httpPUT])]
procedure TestGetPersons;
[MVCPath('/wrappedpeople')]
[MVCHTTPMethod([httpGET])]
procedure TestGetWrappedPeople;
[MVCPath('/objects')]
[MVCHTTPMethod([httpPOST, httpPUT])]
[MVCProduces('application/json')]
procedure TestPOSTObject;
[MVCPath('/customerecho')]
[MVCHTTPMethod([httpPOST])]
[MVCProduces('application/json')]
procedure TestCustomerEcho;
[MVCPath('/customerecho2')]
[MVCHTTPMethod([httpPOST])]
[MVCProduces('application/json')]
procedure TestCustomerEchoWithRootNode;
[MVCPath('/customerechobodyfor')]
[MVCHTTPMethod([httpPOST])]
[MVCProduces('application/json')]
procedure TestCustomerEchoBodyFor;
[MVCPath('/echowithallverbs')]
[MVCHTTPMethod([httpGET, httpPOST, httpPUT, httpDELETE, httpPATCH, httpTRACE])]
[MVCProduces('application/json')]
procedure TestWithAllVerbs;
[MVCPath('/speed')]
[MVCHTTPMethod([httpGET])]
procedure TestHelloWorld;
[MVCPath('/path1/($id)')]
[MVCPath('/path2/($id)/2/($par)')]
[MVCPath('/path3/($id)/2/($par)/3')]
[MVCPath('/path4/($id)/2/($par)/3/4')]
[MVCHTTPMethod([httpPOST, httpPUT])]
procedure TestMultiplePaths;
{ 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)')]
procedure TestTypedActionAllTypes(ParString: string; ParInteger: Integer; ParInt64: Int64; ParSingle: Single;
ParDouble: Double; ParExtended: Extended);
[MVCPath('/typed/tdatetime1/($value)')]
procedure TestTypedActionTDateTime1(value: TDateTime);
[MVCPath('/typed/tdate1/($value)')]
procedure TestTypedActionTDate1(value: TDate);
[MVCPath('/typed/ttime1/($value)')]
procedure TestTypedActionTTime1(value: TTime);
[MVCPath('/typed/tguid1/($value)')]
procedure TestTypedActionTGuid1(value: TGUID);
[MVCPath('/typed/booleans/($bool1)/($bool2)/($bool3)/($bool4)')]
procedure TestTypedActionBooleans(bool1, bool2, bool3, bool4: Boolean);
[MVCPath('/renderstreamandfreewithownerfalse')]
procedure TestRenderStreamAndFreeWithOwnerFalse;
[MVCPath('/renderstreamandfreewithownertrue')]
procedure TestRenderStreamAndFreeWithOwnerTrue;
[MVCPath('/stringdictionary')]
procedure TestStringDictionary;
[MVCPath('/entitywitharrays')]
procedure TestEntityWithArrays;
[MVCPath('/image/png')]
[MVCHTTPMethod([httpGET])]
procedure TestGetImagePng;
[MVCPath('/objectdict')]
procedure TestObjectDict;
// exception rendering
[MVCPath('/exception/emvcexception1')]
procedure TestEMVCException1;
[MVCPath('/exception/emvcexception2')]
procedure TestEMVCException2;
[MVCPath('/exception/emvcexception3')]
procedure TestEMVCException3;
[MVCPath('/exception/emvcexception4')]
procedure TestEMVCException4;
// Nullables Tests
[MVCHTTPMethod([httpPOST])]
[MVCPath('/nullables/pingpong')]
procedure TestDeserializeAndSerializeNullables;
[MVCHTTPMethod([httpGET])]
[MVCPath('/nullables/getsingle')]
procedure TestSerializeNullables;
[MVCHTTPMethod([httpGET])]
[MVCPath('/nullables/getsinglewithnulls')]
procedure TestSerializeNullablesWithNulls;
// Response Objects Tests
[MVCHTTPMethod([httpPOST])]
[MVCPath('/responses/created')]
procedure TestResponseCreated;
[MVCHTTPMethod([httpPOST])]
[MVCPath('/responses/accepted')]
procedure TestResponseAccepted;
[MVCHTTPMethod([httpGET])]
[MVCPath('/responses/nocontent')]
procedure TestResponseNoContent;
[MVCHTTPMethod([httpGET])]
[MVCPath('/issue338/($projectid)')]
procedure GetProject;
[MVCHTTPMethod([httpGET])]
[MVCPath('/issue338/($projectid)/pictures/($imageuuid)')]
procedure GetImage;
[MVCHTTPMethod([httpGET])]
[MVCPath('/issue492/($stringvalue)')]
procedure GetIssue492;
[MVCHTTPMethod([httpGET])]
[MVCPath('/issue542/($stringvalue)')]
procedure GetIssue542;
[MVCHTTPMethod([httpGET])]
[MVCPath('/issue552')]
procedure TestIssue552GUIDSupport;
[MVCHTTPMethod([httpPOST])]
[MVCPath('/guidserializationecho')]
procedure TestGUIDSerializationEcho;
{ 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
);
[MVCHTTPMethod([httpPOST])]
[MVCPath('/injectable30')]
procedure PostInject30(const [MVCFromBody] Person: TPerson);
[MVCHTTPMethod([httpPOST])]
[MVCPath('/injectable40/married/($Married)/id/($ID)')]
procedure PostInject40(
const Married: Boolean;
const ID: Int64;
const [MVCFromBody] Person: TPerson;
const [MVCFromQueryString('FirstName')] FirstName: String;
const [MVCFromHeader('LastName')] LastName: String;
const [MVCFromCookie('DOB')] DOB: TDate
);
[MVCHTTPMethod([httpPOST])]
[MVCPath('/injectable50')]
procedure PostInject50(const [MVCFromBody] People: TObjectList<TPerson>);
[MVCHTTPMethod([httpPOST])]
[MVCPath('/programmerex')]
procedure CreateProgrammerEx(const [MVCFromBody] ProgrammerEx: TProgrammerEx);
[MVCHTTPMethod([httpPOST])]
[MVCPath('/programmerex2')]
procedure CreateProgrammerEx2(const [MVCFromBody] ProgrammerEx2: TProgrammerEx2);
[MVCHTTPMethod([httpGET])]
[MVCPath('/ignoredfieldstest')]
procedure RenderProgrammerWithIgnoredFields(
const [MVCFromQueryString('ignoredfieldscsv','')] IgnoredFieldsCSV: String);
[MVCHTTPMethod([httpGET])]
[MVCPath('/ignoredfieldstestdataset')]
procedure RenderDataSetWithIgnoredFields(
const [MVCFromQueryString('ignoredfieldscsv','')] IgnoredFieldsCSV: String);
{ templates }
[MVCHTTPMethod([httpGET])]
[MVCPath('/website/list')]
procedure Tmpl_ListOfDataUsingDatasets;
{ issues }
[MVCHTTPMethod([httpGET])]
[MVCPath('/issues/406')]
procedure TestIssue406;
[MVCHTTPMethod([httpGET])]
[MVCPath('/issues/526')]
procedure TestIssue526;
[MVCHTTPMethod([httpGET])]
[MVCPath('/issues/542')]
procedure TestIssue542;
end;
[MVCPath('/private')]
TTestPrivateServerController = class(TMVCController)
public
[MVCPath('/role1')]
procedure OnlyRole1;
[MVCPath('/role1session')]
[MVCHTTPMethods([httpGET])]
procedure OnlyRole1Session;
[MVCPath('/role2')]
procedure OnlyRole2;
end;
[MVCPath('/exception/fault')]
TTestFaultController = class(TMVCController)
public
[MVCPath]
procedure NeverExecuted;
constructor Create; override;
end;
[MVCPath('/exception/fault2')]
TTestFault2Controller = class(TTestFaultController)
public
[MVCPath]
procedure NeverExecuted;
constructor Create; override;
end;
[MVCPath]
[MVCPath('/api/v1')]
[MVCPath('/api/v2')]
TTestMultiPathController = class(TMVCController)
public
[MVCPath]
[MVCPath('/action1')]
[MVCPath('/action2')]
procedure Action1or2;
end;
// action result types
[MVCNameCase(ncLowerCase)]
TSum = class
private
fValue: Integer;
public
property Value: Integer read fValue write fValue;
end;
[MVCNameCase(ncLowerCase)]
TComplexObject = class
private
fValue: Integer;
FPeople: TPeople;
FPerson: TPerson;
procedure SetPeople(const Value: TPeople);
procedure SetPerson(const Value: TPerson);
public
destructor Destroy; override;
property Value: Integer read fValue write fValue;
property Person: TPerson read FPerson write SetPerson;
property People: TPeople read FPeople write SetPeople;
end;
[MVCNameCase(ncCamelCase)]
TPersonRec = record
FirstName, LastName: String;
Age: Integer;
class function Create: TPersonRec; static;
end;
// action result types - end
[MVCPath('/api/v1/actionresult')]
TTestActionResultController = class(TMVCController)
public
{ actions returning records }
[MVCPath('/sums/($a)/($b)')]
[MVCHTTPMethod([httpGET])]
function GetObject(a,b: Integer): TSum;
[MVCPath('/records/single')]
function GetSingleRecord: TPersonRec;
[MVCPath('/records/multiple')]
function GetMultipleRecords: TArray<TPersonRec>;
[MVCPath('/complex')]
[MVCHTTPMethod([httpGET])]
function GetComplexObject: TComplexObject;
[MVCPath('/people')]
[MVCHTTPMethod([httpGET])]
function GetPeople: TObjectList<TPerson>;
[MVCPath('/people/($id)')]
[MVCHTTPMethod([httpGET])]
function GetPerson(id: Integer): IPerson;
[MVCPath('/photo')]
[MVCHTTPMethod([httpGET])]
function GetPhoto: TStream;
[MVCPath('/string')]
[MVCHTTPMethod([httpGET])]
function GetString: String;
[MVCPath('/enum')]
[MVCHTTPMethod([httpGET])]
function GetEnum: TFontStyle;
[MVCPath('/bool')]
[MVCHTTPMethod([httpGET])]
function GetBool: Boolean;
[MVCPath('/float')]
[MVCHTTPMethod([httpGET])]
function GetFloat: Double;
[MVCPath('/strdict')]
[MVCHTTPMethod([httpGET])]
function GetStrDict: TMVCStringDictionary;
[MVCPath('/TSimpleRecord')]
[MVCHTTPMethod([httpGET])]
function GetTSimpleRecord: TSimpleRecord;
[MVCPath('/ArrayOf/TSimpleRecord')]
[MVCHTTPMethod([httpGET])]
function GetArrayOfTSimpleRecord: TArray<TSimpleRecord>;
[MVCPath('/TComplexRecord')]
[MVCHTTPMethod([httpGET])]
function GetTComplexRecord: TComplexRecord;
[MVCPath('/ArrayOf/TComplexRecord')]
[MVCHTTPMethod([httpGET])]
function GetArrayOfTComplexRecord: TComplexRecordArray;
[MVCPath('/dataset/single')]
[MVCHTTPMethod([httpGET])]
function GetDataSetSingle: TDataSet;
[MVCPath('/dataset/multiple')]
[MVCHTTPMethod([httpGET])]
function GetDataSetMultiple: IMVCObjectDictionary;
{ using IMVCResponse }
[MVCPath('/mvcresponse/message')]
function GetMVCResponseSimple: IMVCResponse;
[MVCPath('/mvcresponse/data')]
function GetMVCResponseWithData: IMVCResponse;
[MVCPath('/mvcresponse/data/message')]
function GetMVCResponseWithDataAndMessage: IMVCResponse;
[MVCPath('/mvcresponse/json')]
function GetMVCResponseWithJSON: IMVCResponse;
[MVCPath('/mvcresponse/list')]
function GetMVCResponseWithObjectList: IMVCResponse;
[MVCPath('/mvcresponse/dictionary')]
function GetMVCResponseWithObjectDictionary: IMVCResponse;
[MVCPath('/mvcresponse/error')]
function GetMVCErrorResponse: IMVCResponse;
[MVCPath('/mvcresponse/message/builder/headers')]
function GetMVCResponseSimpleBuilderWithHeaders: IMVCResponse;
end;
implementation
uses
JsonDataObjects,
System.JSON,
Web.HTTPApp,
Generics.Collections,
MVCFramework.Serializer.Defaults,
MVCFramework.DuckTyping,
System.IOUtils, MVCFramework.Tests.Serializer.Entities, System.DateUtils;
{ TTestServerController }
procedure TTestServerController.CreateProgrammerEx(
const ProgrammerEx: TProgrammerEx);
begin
Render(ProgrammerEx, False);
end;
procedure TTestServerController.CreateProgrammerEx2(
const ProgrammerEx2: TProgrammerEx2);
begin
Render(ProgrammerEx2, False);
end;
procedure TTestServerController.DataSetHandling;
begin
case Context.Request.HTTPMethod of
httpGET:
begin
end;
httpPOST:
begin
end;
httpPUT:
begin
end;
httpDELETE:
begin
end;
httpHEAD:
begin
end;
httpOPTIONS:
begin
end;
end;
end;
procedure TTestServerController.EchoBody;
var
JSON: TJSONObject;
begin
JSON := TJSONObject.ParseJSONValue(Context.Request.Body) as TJSONObject;
JSON.AddPair('echo', 'from server');
Render(JSON, True);
end;
procedure TTestServerController.EchoHeaders;
begin
Context.Response.ContentType := TMVCMediaType.TEXT_PLAIN;
Render(Context.Request.Headers['ACCEPT']);
end;
procedure TTestServerController.GenerateCookies;
var
c: TCookie;
v: string;
begin
v := Context.Request.Cookie('usersettings');
c := Context.Response.Cookies.Add;
c.Name := 'usersettings1';
c.value := 'usersettings1-value';
c.Path := '/usersettings1';
c.Expires := 0;
c := Context.Response.Cookies.Add;
c.Name := 'usersettings2';
c.value := 'usersettings2-value';
c.Path := '/usersettings2';
c.Expires := 0;
c := Context.Response.Cookies.Add;
c.Name := 'usersettings3';
c.value := 'usersettings3-value';
c.Path := '/usersettings3';
c.Expires := 0;
c := Context.Response.Cookies.Add;
c.Name := 'usersettings4';
c.value := 'usersettings4-value';
c.Path := '/usersettings4';
c.Expires := 0;
end;
class function TTestServerController.GetDataSet: TDataSet;
begin
Result := TFDMemTable.Create(nil);
TFDMemTable(Result).LoadFromFile(TPath.Combine(AppPath, 'customers.json'));
end;
procedure TTestServerController.GetImage;
begin
// do nothing
end;
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;
procedure TTestServerController.GetIssue492;
begin
// do nothing
end;
procedure TTestServerController.GetIssue542;
begin
// do nothing
end;
procedure TTestServerController.GetProject;
begin
// do nothing
end;
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;
if Context.SessionStarted then
raise EMVCException.Create('Session still available');
end;
procedure TTestServerController.MVCControllerAfterCreate;
begin
FFormatSettings.DecimalSeparator := '.';
end;
procedure TTestServerController.MVCControllerBeforeDestroy;
begin
inherited;
end;
procedure TTestServerController.PostInject30(const Person: TPerson);
begin
Render(Person, False);
end;
procedure TTestServerController.PostInject40(
const Married: Boolean;
const ID: Int64;
const [MVCFromBody] Person: TPerson;
const [MVCFromQueryString('FirstName')] FirstName: String;
const [MVCFromHeader('LastName')] LastName: String;
const [MVCFromCookie('DOB')] DOB: TDate
);
begin
Person.FirstName := FirstName;
Person.LastName := LastName;
Person.DOB := DOB;
Person.Married := Married;
Person.ID := ID;
Render(Person, False);
end;
procedure TTestServerController.PostInject50(
const People: TObjectList<TPerson>);
begin
Render<TPerson>(People, False);
end;
procedure TTestServerController.RenderDataSetWithIgnoredFields(
const IgnoredFieldsCSV: String);
var
lDict: IMVCObjectDictionary;
lIgnoredFields: TMVCIgnoredList;
begin
lIgnoredFields := TMVCIgnoredList(IgnoredFieldsCSV.Split([';',',']));
lDict := ObjectDict(True)
.Add('ncUpperCase_List', GetDataSet, nil, dstAllRecords, ncUpperCase, lIgnoredFields)
.Add('ncLowerCase_List', GetDataSet, nil, dstAllRecords, ncLowerCase, lIgnoredFields)
.Add('ncCamelCase_List', GetDataSet, nil, dstAllRecords, ncCamelCase, lIgnoredFields)
.Add('ncPascalCase_List', GetDataSet, nil, dstAllRecords, ncPascalCase, lIgnoredFields)
.Add('ncUpperCase_Single', GetDataSet, nil, dstSingleRecord, ncUpperCase, lIgnoredFields)
.Add('ncLowerCase_Single', GetDataSet, nil, dstSingleRecord, ncLowerCase, lIgnoredFields)
.Add('ncCamelCase_Single', GetDataSet, nil, dstSingleRecord, ncCamelCase, lIgnoredFields)
.Add('ncPascalCase_Single', GetDataSet, nil, dstSingleRecord, ncPascalCase, lIgnoredFields)
.Add('meta', StrDict(['page'], ['1']));
Render(lDict);
end;
procedure TTestServerController.RenderProgrammerWithIgnoredFields(
const IgnoredFieldsCSV: String);
begin
Render(ObjectDict().Add(
'data',
TProgrammerEx.GetNew('Daniele','Teti', EncodeDate(1979,11,4),True),
nil,
TMVCIgnoredList(IgnoredFieldsCSV.Split([';',',']))))
end;
procedure TTestServerController.ReqWithParams;
begin
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));
end;
procedure TTestServerController.SessionGet;
var
s: string;
begin
ContentType := TMVCMediaType.TEXT_PLAIN;
s := Session['value'];
Render(s);
end;
procedure TTestServerController.SessionSet;
begin
Session['value'] := Context.Request.Params['value'];
end;
procedure TTestServerController.TestConsumeJSON;
begin
Render(TJSONObject.ParseJSONValue('{"key":"Hello World"}'));
end;
procedure TTestServerController.TestConsumesProduces;
begin
Render('Hello World');
end;
procedure TTestServerController.TestConsumesProducesText;
begin
Render('Hello World');
end;
procedure TTestServerController.TestConsumesProducesTextISO8859_1;
begin
Render(Context.Request.Body);
end;
procedure TTestServerController.TestCustomerEcho;
var
lCustomer: TCustomer;
begin
lCustomer := Context.Request.BodyAs<TCustomer>();
// lCustomer.Logo.SaveToFile('pippo_server_before.bmp');
lCustomer.Name := lCustomer.Name + ' changed';
{$IFNDEF LINUX}
//lCustomer.Logo.Canvas.TextOut(10, 10, 'Changed');
{$ENDIF}
// lCustomer.Logo.SaveToFile('pippo_server_after.bmp');
Render(lCustomer, True);
end;
procedure TTestServerController.TestCustomerEchoBodyFor;
var
lCustomer: TCustomer;
begin
lCustomer := TCustomer.Create;
try
Context.Request.BodyFor<TCustomer>(lCustomer);
lCustomer.Name := lCustomer.Name + ' changed';
Render(lCustomer, False);
finally
lCustomer.Free;
end;
end;
procedure TTestServerController.TestCustomerEchoWithRootNode;
var
lCustomer1, lCustomer2: TCustomer;
begin
lCustomer1 := Context.Request.BodyAs<TCustomer>('customer1');
try
lCustomer2 := Context.Request.BodyAs<TCustomer>('customer2');
try
Render(ObjectDict(False)
.Add('customer1', lCustomer1)
.Add('customer2', lCustomer2));
finally
lCustomer2.Free;
end;
finally
lCustomer1.Free;
end;
end;
procedure TTestServerController.TestDeserializeAndSerializeNullables;
var
lNullablesTest: TNullablesTest;
begin
lNullablesTest := Context.Request.BodyAs<TNullablesTest>;
Render(lNullablesTest);
end;
procedure TTestServerController.TestEMVCException1;
begin
raise EMVCException.Create('message');
end;
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;
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;
procedure TTestServerController.TestCharset;
var
Obj: TJDOJSONObject;
begin
ContentType := BuildContentType(TMVCMediaType.APPLICATION_JSON, TMVCCharset.UTF_8);
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;
end;
procedure TTestServerController.TestGetImagePng;
var
lFName: string;
begin
ContentType := TMVCMediaType.IMAGE_PNG;
lFName := TPath.Combine(AppPath, 'sample.png');
Render(TFile.OpenRead(lFName));
end;
procedure TTestServerController.TestGetPersonByID;
var
PersonList: TObjectList<TPerson>;
ID: Integer;
begin
ID := Context.Request.Params['id'].ToInteger;
PersonList := TPerson.GetList;
try
Render(PersonList[ID - 1], false);
finally
PersonList.Free;
end;
end;
procedure TTestServerController.TestGetPersonByIDAsFields;
var
PersonList: TObjectList<TPerson>;
ID: Integer;
begin
raise Exception.Create('Not implemented');
ID := Context.Request.Params['id'].ToInteger;
PersonList := TPerson.GetList;
try
// Render(PersonList[ID - 1], false, TDMVCSerializationType.Fields);
finally
PersonList.Free;
end;
end;
procedure TTestServerController.TestGetPersons;
var
Person: TPerson;
begin
case Context.Request.HTTPMethod of
httpGET:
Render<TPerson>(TPerson.GetList, True);
httpPOST:
begin
Person := Context.Request.BodyAs<TPerson>();
Render(Person);
end;
httpPUT:
;
end;
end;
procedure TTestServerController.TestGetPersonsHateos;
begin
Render<TPerson>(TPerson.GetList, True,
procedure(const Person: TPerson; const Links: IMVCLinks)
begin
Links.AddRefLink.Add(HATEOAS.HREF, '/api/people/' + Person.ID.ToString).Add(HATEOAS.REL, 'test0')
.Add(HATEOAS._TYPE, 'application/json');
Links.AddRefLink.Add(HATEOAS.HREF, '/api/test/' + Person.ID.ToString).Add(HATEOAS.REL, 'test1').Add(HATEOAS._TYPE,
'application/json')
end);
end;
procedure TTestServerController.TestGetWrappedPeople;
var
LWrappedList: IWrappedList;
lObj: TObject;
begin
if not Context.Request.QueryStringParamExists('count') then
begin
lObj := TPerson.GetList;
end
else
begin
lObj := TPerson.GetList(Context.Request.ParamsAsInt64['count']);
end;
try
LWrappedList := WrapAsList(lObj);
Render(LWrappedList);
finally
lObj.Free;
end;
end;
procedure TTestServerController.TestGUIDSerializationEcho;
var
lEnt: TEntityWithGUIDs;
begin
lEnt := Context.Request.BodyAs<TEntityWithGUIDs>;
try
Render(lEnt, False);
finally
lEnt.Free;
end;
end;
procedure TTestServerController.TestHelloWorld;
begin
ContentType := 'text/plain';
Render('hello world');
end;
procedure TTestServerController.TestIssue406;
begin
Render(HTTP_STATUS.UnprocessableEntity, TMVCErrorResponseItem.Create('The Message'));
end;
procedure TTestServerController.TestIssue526;
begin
ContentType := 'application/fhir+xml; fhirVersion=4.0';
ResponseStream.Append('OK');
RenderResponseStream;
end;
procedure TTestServerController.TestIssue542;
var
lJSON: TJDOJSONObject;
begin
lJSON := TJDOJSONObject.Create;
try
lJSON.S['QueryStringParams_DelimitedText'] := Context.Request.QueryStringParams.DelimitedText;
lJSON.S['QueryStringParam_par1'] := Context.Request.QueryStringParam('par1');
lJSON.S['QueryStringParam_par2'] := Context.Request.QueryStringParam('par2');
lJSON.I['QueryParams_Count'] := Context.Request.QueryParams.Count;
lJSON.S['QueryParams_par1'] := Context.Request.QueryParams['par1'];
lJSON.S['QueryParams_par2'] := Context.Request.QueryParams['par2'];
Render(lJSON, False);
finally
lJSON.Free;
end;
end;
procedure TTestServerController.TestIssue552GUIDSupport;
var
lObj: TEntityWithGUIDs;
begin
lObj := TEntityWithGUIDs.Create(False);
lObj.GUID := StringToGUID('{75ADE43E-F8C1-4F66-B714-D04726FD2C21}');
lObj.NullableGUID := StringToGUID('{7B17F2DD-6ED5-40A4-A334-8ED877A6803E}');
lObj.NullableGUID2.Clear;
Render(lObj);
end;
procedure TTestServerController.TestJSONArrayAsObjectList;
var
lUsers: TObjectList<TCustomer>;
begin
lUsers := Context.Request.BodyAsListOf<TCustomer>();
try
lUsers.OwnsObjects := True;
if (lUsers.Count = 3000) then
Render('Success!')
else
Render('Error!');
finally
FreeAndNil(lUsers);
end;
end;
procedure TTestServerController.TestMultiplePaths;
begin
ContentType := TMVCMediaType.TEXT_PLAIN;
Render(Context.Request.Params['id']);
end;
procedure TTestServerController.TestObjectDict;
var
lDict: IMVCObjectDictionary;
begin
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']));
Render(lDict);
end;
procedure TTestServerController.TestPOSTObject;
var
Person: TPerson;
begin
Person := Context.Request.BodyAs<TPerson>();
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;
procedure TTestServerController.TestResponseAccepted;
begin
Render202Accepted('http://pippo.it/1234', '1234', 'thisisthereason');
end;
procedure TTestServerController.TestResponseCreated;
begin
Render201Created('thisisthelocation', 'thisisthereason');
end;
procedure TTestServerController.TestResponseNoContent;
begin
Render204NoContent('thisisthereason');
end;
procedure TTestServerController.TestSerializeNullables;
var
lObj: TNullablesTest;
begin
lObj := TNullablesTest.Create();
lObj.LoadSomeData;
Render(lObj);
end;
procedure TTestServerController.TestSerializeNullablesWithNulls;
var
lObj: TNullablesTest;
begin
lObj := TNullablesTest.Create();
Render(lObj);
end;
procedure TTestServerController.TestStringDictionary;
var
lDict: TMVCStringDictionary;
begin
lDict := Context.Request.BodyAs<TMVCStringDictionary>;
try
lDict['fromserver'] := 'changed';
Render(lDict, false);
finally
lDict.Free;
end;
end;
procedure TTestServerController.TestTypedActionAllTypes(ParString: string; ParInteger: Integer; ParInt64: Int64;
ParSingle: Single; ParDouble: Double; ParExtended: Extended);
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;
Render('*' + value + '*');
end;
procedure TTestServerController.TestTypedActionTDate1(value: TDate);
begin
ContentType := TMVCMediaType.TEXT_PLAIN;
Render(DateToISODate(value) + ' modified from server');
end;
procedure TTestServerController.TestTypedActionTDateTime1(value: TDateTime);
begin
ContentType := TMVCMediaType.TEXT_PLAIN;
Render(DateTimeToISOTimeStamp(value) + ' modified from server');
end;
procedure TTestServerController.TestTypedActionTGuid1(value: TGUID);
begin
ContentType := TMVCMediaType.TEXT_PLAIN;
Render(GuidToString(value) + ' modified from server');
end;
procedure TTestServerController.TestTypedActionBooleans(bool1, bool2, bool3, bool4: Boolean);
begin
ContentType := TMVCMediaType.TEXT_PLAIN;
Render(Format('%s.%s.%s.%s', [BoolToStr(bool1, True), BoolToStr(bool2, True), BoolToStr(bool3, True),
BoolToStr(bool4, True)]));
end;
procedure TTestServerController.TestTypedActionTTime1(value: TTime);
begin
ContentType := TMVCMediaType.TEXT_PLAIN;
Render(TimeToISOTime(value) + ' modified from server');
end;
procedure TTestServerController.TestWithAllVerbs;
var
lPerson: TPerson;
begin
lPerson := Context.Request.BodyAs<TPerson>();
Render(lPerson, True);
end;
procedure TTestServerController.Tmpl_ListOfDataUsingDatasets;
var
lDS: TFDMemTable;
begin
lDS := TFDMemTable.Create(nil);
try
var lFName: string := TPath.Combine(AppPath, 'customers.json');
lDS.LoadFromFile(lFName);
ViewDataset['customers'] := lDS;
ViewData['customers2'] := lDS;
LoadView(['dataset_list']);
RenderResponseStream;
finally
lDS.Free;
end;
end;
{ TTestPrivateServerController }
procedure TTestPrivateServerController.OnlyRole1;
begin
Render(Context.LoggedUser.UserName);
end;
procedure TTestPrivateServerController.OnlyRole1Session;
begin
if Context.Request.QueryStringParamExists('value') then
begin
Session['value'] := Context.Request.Params['value'];
end
else
begin
Render(Session['value']);
end;
end;
procedure TTestPrivateServerController.OnlyRole2;
begin
Render(Context.LoggedUser.UserName);
end;
{ 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
// do nothing
end;
{ TTestMultiPathController }
procedure TTestMultiPathController.Action1or2;
begin
Render(HTTP_STATUS.OK);
end;
{ TTestActionResultController }
function TTestActionResultController.GetArrayOfTComplexRecord: TComplexRecordArray;
begin
SetLength(Result,3);
Result[0] := TComplexRecord.Create;
Result[1] := TComplexRecord.Create;
Result[2] := TComplexRecord.Create;
Result[0].StringProperty := 'item 0';
Result[1].StringProperty := 'item 1';
Result[2].StringProperty := 'item 2';
end;
function TTestActionResultController.GetArrayOfTSimpleRecord: TArray<TSimpleRecord>;
begin
SetLength(Result, 3);
Result[0] := TSimpleRecord.Create;
Result[1] := TSimpleRecord.Create;
Result[2] := TSimpleRecord.Create;
end;
function TTestActionResultController.GetBool: Boolean;
begin
Result := True;
end;
function TTestActionResultController.GetComplexObject: TComplexObject;
begin
Result := TComplexObject.Create;
Result.Value := 1234;
Result.Person := TPerson.GetNew('Danielem', 'Teti', EncodeDate(1920,12,23), True);
Result.People := TPerson.GetList();
end;
function TTestActionResultController.GetDataSetMultiple: IMVCObjectDictionary;
begin
Result :=
ObjectDict()
.Add('ds1', TTestServerController.GetDataSet)
.Add('ds2', TTestServerController.GetDataSet);
end;
function TTestActionResultController.GetDataSetSingle: TDataSet;
begin
Result := TTestServerController.GetDataSet;
end;
function TTestActionResultController.GetEnum: TFontStyle;
begin
Result := TFontStyle.fsBold;
end;
function TTestActionResultController.GetFloat: Double;
begin
Result := 3.1415;
end;
function TTestActionResultController.GetMultipleRecords: TArray<TPersonRec>;
begin
SetLength(Result, 3);
Result[0] := TPersonRec.Create;
Result[1] := TPersonRec.Create;
Result[2] := TPersonRec.Create;
Result[0].Age := 20;
Result[1].Age := 30;
Result[2].Age := 40;
end;
function TTestActionResultController.GetPeople: TObjectList<TPerson>;
begin
Result := TPerson.GetList();
end;
function TTestActionResultController.GetPerson(id: Integer): IPerson;
begin
Result := TInterfacedPerson.Create('Daniele Teti', 20, 2010);
end;
function TTestActionResultController.GetPhoto: TStream;
begin
Context.Response.ContentType := TMVCMediaType.IMAGE_X_PNG;
Result := TFileStream.Create('sample.png', fmOpenRead or fmShareDenyNone);
end;
function TTestActionResultController.GetSingleRecord: TPersonRec;
begin
Result := TPersonRec.Create;
end;
function TTestActionResultController.GetStrDict: TMVCStringDictionary;
begin
Result := StrDict.Add('first_name','Daniele').Add('last_name','Teti');
end;
function TTestActionResultController.GetString: String;
begin
Result := 'Hello World';
end;
function TTestActionResultController.GetTComplexRecord: TComplexRecord;
begin
Result := TComplexRecord.Create;
end;
function TTestActionResultController.GetTSimpleRecord: TSimpleRecord;
begin
Result := TSimpleRecord.Create;
end;
function TTestActionResultController.GetObject(a, b: Integer): TSum;
begin
StatusCode := 201;
Context.Response.SetCustomHeader('X-CUSTOM-HEADER','CARBONARA');
Result := TSum.Create;
Result.Value := a + b;
end;
function TTestActionResultController.GetMVCErrorResponse: IMVCResponse;
begin
raise EMVCException.Create(HTTP_STATUS.BadGateway, 1001, 'Error Message');
end;
function TTestActionResultController.GetMVCResponseSimple: IMVCResponse;
begin
Result := MVCResponseBuilder
.StatusCode(HTTP_STATUS.OK)
.Body('My Message')
.Build;
end;
function TTestActionResultController.GetMVCResponseSimpleBuilderWithHeaders: IMVCResponse;
begin
Result := MVCResponseBuilder
.StatusCode(HTTP_STATUS.Created)
.Header('header1', 'Hello World')
.Header('header2', 'foo bar')
.Body('My Message')
.Build;
end;
function TTestActionResultController.GetMVCResponseWithData: IMVCResponse;
begin
Result := MVCResponseBuilder
.StatusCode(HTTP_STATUS.OK)
.Body(TPerson.GetNew('Daniele','Teti', EncodeDate(1979,11,4), True))
.Build;
end;
function TTestActionResultController.GetMVCResponseWithDataAndMessage: IMVCResponse;
begin
Result := MVCResponseBuilder
.StatusCode(HTTP_STATUS.OK)
.Body('This is a message') //<< Message
.Body(TPerson.GetNew('Daniele','Teti', EncodeDate(1979,11,4), True)) //<< Data
.Body(ObjectDict().Add('person', TPerson.GetNew('Daniele','Teti', EncodeDate(1979,11,4), True)))
.Build;
end;
function TTestActionResultController.GetMVCResponseWithObjectDictionary: IMVCResponse;
begin
Result := MVCResponseBuilder
.StatusCode(HTTP_STATUS.OK)
.Body(ObjectDict()
.Add('people1', TObjectList<TPerson>.Create([
TPerson.Create('Daniele','Teti', 99),
TPerson.Create('Peter','Parker', 25),
TPerson.Create('Bruce','Banner', 45)
])
)
.Add('people2', TObjectList<TPerson>.Create([
TPerson.Create('Daniele','Teti', 99),
TPerson.Create('Peter','Parker', 25),
TPerson.Create('Bruce','Banner', 45)
])
)
)
.Build;
end;
function TTestActionResultController.GetMVCResponseWithObjectList: IMVCResponse;
begin
Result := MVCResponseBuilder
.StatusCode(HTTP_STATUS.OK)
.Body(TObjectList<TPerson>.Create([
TPerson.Create('Daniele','Teti', 99),
TPerson.Create('Peter','Parker', 25),
TPerson.Create('Bruce','Banner', 45)
])
).Build;
end;
function TTestActionResultController.GetMVCResponseWithJSON: IMVCResponse;
begin
Result := MVCResponseBuilder
.StatusCode(HTTP_STATUS.OK)
.Body(StrToJSONObject('{"name":"Daniele","surname":"Teti"}'))
.Build;
end;
{ TComplexObject }
destructor TComplexObject.Destroy;
begin
FPerson.Free;
FPeople.Free;
inherited;
end;
procedure TComplexObject.SetPeople(const Value: TPeople);
begin
FPeople := Value;
end;
procedure TComplexObject.SetPerson(const Value: TPerson);
begin
FPerson := Value;
end;
{ TPersonRec }
class function TPersonRec.Create: TPersonRec;
begin
Result.FirstName := 'Daniele';
Result.LastName := 'Teti';
Result.Age := 99;
end;
end.