diff --git a/README.md b/README.md index 491f8221..0fa624ac 100644 --- a/README.md +++ b/README.md @@ -69,6 +69,7 @@ - Refactored ISAPI sample - Speed improvement! Removed enhanced visibility for action methods. Now only public and published methods can be used as actions. - `TMVCController.Create` is `virtual`! Now on your base controllers can be even more powerful! +- New! Added `MAX_REQUEST_SIZE` for limiting the size of the incoming HTTP requests. IDE Expert is updated too! - New! Added method `TMVCJsonDataObjectsSerializer.ListToJsonArray` - New! `TMVCResponse` for handle generic (non error) response - New! `TMVCErrorResponse` for handle generic error response @@ -87,6 +88,7 @@ - Sending wrongly formatted JSON now returns a more correctly `400 Bad Request` and not `500 Internal Server Error` as in the previous versions - New! Support for Spring4d nullable types (check `samples\renders_spring4d_nullables`) - New! `TMVCJSONRPCPublisher` allows to easily expose plain Delphi objects (and even datamodules) through a JSON-RPC 2.0 interface! +- *Breaking Change!* The JSON RPC Client layer is now interface based. ## How to correctly get the source diff --git a/ideexpert/DMVC.Expert.CodeGen.Templates.pas b/ideexpert/DMVC.Expert.CodeGen.Templates.pas index 3128a814..9ea2aede 100644 --- a/ideexpert/DMVC.Expert.CodeGen.Templates.pas +++ b/ideexpert/DMVC.Expert.CodeGen.Templates.pas @@ -330,6 +330,8 @@ resourcestring ' Config[TMVCConfigKey.ExposeServerSignature] := ''true'';' + sLineBreak + ' // Define a default URL for requests that don''t map to a route or a file (useful for client side web app)' + sLineBreak + ' Config[TMVCConfigKey.FallbackResource] := ''index.html'';' + sLineBreak + + ' // Max request size in bytes' + sLineBreak + + ' Config[TMVCConfigKey.MaxRequestSize] := IntToStr(TMVCConstants.DEFAULT_MAX_REQUEST_SIZE);' + sLineBreak + ' end);' + sLineBreak + ' FMVC.AddController(%3:s);' + sLineBreak + ' // To enable compression (deflate, gzip) just add this middleware as the last one ' + sLineBreak + diff --git a/samples/activerecord_crud/activerecord_crud.dpr b/samples/activerecord_crud/activerecord_crud.dpr index 302be9c2..e81dd1ba 100644 --- a/samples/activerecord_crud/activerecord_crud.dpr +++ b/samples/activerecord_crud/activerecord_crud.dpr @@ -4,7 +4,6 @@ program activerecord_crud; uses - // FastMM4, FireDAC.Phys.FB, System.SysUtils, MVCFramework.Logger, @@ -14,14 +13,16 @@ uses Web.WebReq, Web.WebBroker, IdHTTPWebBrokerBridge, - WebModuleU in 'WebModuleU.pas' {MyWebModule: TWebModule} , + WebModuleU in 'WebModuleU.pas' {MyWebModule: TWebModule}, Entities in 'Entities.pas', FDConnectionConfigU in 'FDConnectionConfigU.pas', MVCFramework.ActiveRecordController in '..\..\sources\MVCFramework.ActiveRecordController.pas', MVCFramework.ActiveRecord in '..\..\sources\MVCFramework.ActiveRecord.pas', MVCFramework.RQL.AST2MySQL in '..\..\sources\MVCFramework.RQL.AST2MySQL.pas', MVCFramework.RQL.AST2FirebirdSQL in '..\..\sources\MVCFramework.RQL.AST2FirebirdSQL.pas', - EntitiesProcessors in 'EntitiesProcessors.pas'; + EntitiesProcessors in 'EntitiesProcessors.pas', + MVCFramework.RQL.AST2InterbaseSQL in '..\..\sources\MVCFramework.RQL.AST2InterbaseSQL.pas', + MVCFramework.RQL.AST2PostgreSQL in '..\..\sources\MVCFramework.RQL.AST2PostgreSQL.pas'; {$R *.res} diff --git a/samples/activerecord_crud/activerecord_crud.dproj b/samples/activerecord_crud/activerecord_crud.dproj index 66dcb3fa..dde2818c 100644 --- a/samples/activerecord_crud/activerecord_crud.dproj +++ b/samples/activerecord_crud/activerecord_crud.dproj @@ -125,6 +125,8 @@ + + Cfg_2 Base @@ -173,7 +175,7 @@ true - + activerecord_crud.exe true diff --git a/samples/activerecord_showcase/activerecord_showcase.dproj b/samples/activerecord_showcase/activerecord_showcase.dproj index 27f134d3..95d9cb05 100644 --- a/samples/activerecord_showcase/activerecord_showcase.dproj +++ b/samples/activerecord_showcase/activerecord_showcase.dproj @@ -1,7 +1,7 @@  {F8576ED6-649F-4E28-B364-1F60687C75F2} - 18.4 + 18.5 VCL activerecord_showcase.dpr True @@ -84,9 +84,9 @@ false true - true true 1033 + PerMonitor false @@ -96,7 +96,7 @@ true - true + PerMonitor @@ -156,7 +156,6 @@ 1 - Contents\MacOS 0 @@ -166,6 +165,12 @@ 1 + + + res\xml + 1 + + library\lib\armeabi-v7a @@ -202,6 +207,12 @@ 1 + + + res\values-v21 + 1 + + res\drawable @@ -280,6 +291,11 @@ 1 .framework + + Contents\MacOS + 1 + .framework + 0 @@ -302,6 +318,11 @@ 1 .dylib + + Contents\MacOS + 1 + .dylib + 0 .dll;.bpl @@ -325,6 +346,11 @@ 1 .dylib + + Contents\MacOS + 1 + .dylib + 0 .bpl @@ -347,6 +373,10 @@ Contents\Resources\StartUp\ 0 + + Contents\Resources\StartUp\ + 0 + 0 @@ -483,23 +513,41 @@ 1 + + + ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF + 1 + + ..\ 1 + + ..\ + 1 + Contents 1 + + Contents + 1 + Contents\Resources 1 + + Contents\Resources + 1 + @@ -522,6 +570,10 @@ Contents\MacOS 1 + + Contents\MacOS + 1 + 0 @@ -561,6 +613,7 @@ + diff --git a/sources/MVCFramework.ActiveRecord.pas b/sources/MVCFramework.ActiveRecord.pas index c691a932..69340324 100644 --- a/sources/MVCFramework.ActiveRecord.pas +++ b/sources/MVCFramework.ActiveRecord.pas @@ -26,8 +26,6 @@ unit MVCFramework.ActiveRecord; interface - - uses System.Generics.Defaults, System.Generics.Collections, @@ -113,7 +111,6 @@ type constructor Create; virtual; end; - TMVCActiveRecord = class private fConn: TFDConnection; @@ -221,8 +218,8 @@ type function GetPK: TValue; class function GetByPK(const aValue: int64): T; overload; class function GetByPK(const aClass: TMVCActiveRecordClass; const aValue: int64): TMVCActiveRecord; overload; - class function Select(const SQL: string; const Params: array of Variant; const Options: TMVCActiveRecordLoadOptions = []) - : TObjectList; overload; + class function Select(const SQL: string; const Params: array of Variant; + const Options: TMVCActiveRecordLoadOptions = []): TObjectList; overload; class function Select(const aClass: TMVCActiveRecordClass; const SQL: string; const Params: array of Variant) : TMVCActiveRecordList; overload; class function Select(const aClass: TMVCActiveRecordClass; const SQL: string; const Params: array of Variant; @@ -970,6 +967,10 @@ begin begin aRTTIField.SetValue(Self, aField.AsLongWord); end; + ftFMTBcd: + begin + aRTTIField.SetValue(Self, BCDtoCurrency(aField.AsBCD)); + end; ftDate: begin aRTTIField.SetValue(Self, Trunc(aField.AsDateTime)); @@ -1267,7 +1268,8 @@ begin if TMVCActiveRecordLoadOption.loIgnoreNotExistentFields in aOptions then continue else - raise EMVCActiveRecord.CreateFmt('Field [%s] not found in dataset. [HINT] If you dont need it, use loIgnoreNotExistentFields', [lItem.Value]); + raise EMVCActiveRecord.CreateFmt + ('Field [%s] not found in dataset. [HINT] If you dont need it, use loIgnoreNotExistentFields', [lItem.value]); end; MapColumnToTValue(lItem.value, lField, lItem.Key); end; @@ -1387,7 +1389,8 @@ begin end; -class function TMVCActiveRecord.Select(const SQL: string; const Params: array of Variant; const Options: TMVCActiveRecordLoadOptions): TObjectList; +class function TMVCActiveRecord.Select(const SQL: string; const Params: array of Variant; + const Options: TMVCActiveRecordLoadOptions): TObjectList; var lDataSet: TDataSet; lAR: TMVCActiveRecord; @@ -1546,13 +1549,13 @@ var begin lAR := T.Create; try - if not SQLWhere.Trim.IsEmpty then + if SQLWhere.Trim.IsEmpty() or SQLWhere.Trim.StartsWith('/*limit*/') or SQLWhere.Trim.StartsWith('/*sort*/') then begin - Result := Select(lAR.GenerateSelectSQL + ' WHERE ' + SQLWhere, Params); + Result := Select(lAR.GenerateSelectSQL + SQLWhere, Params); end else begin - Result := Select(lAR.GenerateSelectSQL, Params); + Result := Select(lAR.GenerateSelectSQL + ' WHERE ' + SQLWhere, Params); end; finally lAR.Free; diff --git a/sources/MVCFramework.Commons.pas b/sources/MVCFramework.Commons.pas index 37201c7b..37656a5b 100644 --- a/sources/MVCFramework.Commons.pas +++ b/sources/MVCFramework.Commons.pas @@ -108,6 +108,9 @@ type SSE_RETRY_DEFAULT = 100; SSE_LAST_EVENT_ID = 'Last-Event-ID'; URL_MAPPED_PARAMS_ALLOWED_CHARS = ' àèéùòì@\[\]\{\}\(\)\=;&#\.\_\,%\w\d\x2D\x3A'; + OneMiB = 1048576; + OneKiB = 1024; + DEFAULT_MAX_REQUEST_SIZE = OneMiB * 5; //5 MiB end; TMVCConfigKey = record @@ -127,6 +130,7 @@ type SessionType = 'session_type'; FallbackResource = 'fallback_resource'; MaxEntitiesRecordCount = 'max_entities_record_count'; + MaxRequestSize = 'max_request_size'; //bytes end; // http://www.w3.org/Protocols/rfc2616/rfc2616-sec10.html diff --git a/sources/MVCFramework.DataSet.Utils.pas b/sources/MVCFramework.DataSet.Utils.pas index 4c8f6c72..3229114e 100644 --- a/sources/MVCFramework.DataSet.Utils.pas +++ b/sources/MVCFramework.DataSet.Utils.pas @@ -57,7 +57,7 @@ type AFieldNamePolicy: TFieldNamePolicy = TFieldNamePolicy.fpLowerCase); overload; procedure LoadFromJSONArrayString(AJSONArrayString: string; AFieldNamePolicy: TFieldNamePolicy = TFieldNamePolicy.fpLowerCase); overload; - procedure LoadFromJSONArray(AJSONArray: TJSONArray; AIgnoredFields: TArray; + procedure LoadFromJSONArray(AJSONArray: TJSONArray; AFieldNamePolicy: TFieldNamePolicy = TFieldNamePolicy.fpLowerCase); overload; procedure LoadFromJSONObjectString(AJSONObjectString: string); overload; procedure LoadFromJSONObjectString(AJSONObjectString: string; AIgnoredFields: TArray); overload; @@ -196,23 +196,33 @@ begin end; end; -procedure TDataSetHelper.LoadFromJSONArray(AJSONArray: TJSONArray; AIgnoredFields: TArray; - AFieldNamePolicy: TFieldNamePolicy); -begin - Self.DisableControls; - try - raise Exception.Create('Not Implemented'); - finally - Self.EnableControls; - end; -end; - procedure TDataSetHelper.LoadFromJSONArrayString(AJSONArrayString: string; AIgnoredFields: TArray; AFieldNamePolicy: TFieldNamePolicy); begin AppendFromJSONArrayString(AJSONArrayString, AIgnoredFields, AFieldNamePolicy); end; +procedure TDataSetHelper.LoadFromJSONArray(AJSONArray: TJSONArray; AFieldNamePolicy: TFieldNamePolicy); +var + lSerializer: TMVCJsonDataObjectsSerializer; + lBookmark: TArray; +begin + lBookmark := Self.Bookmark; + Self.DisableControls; + try + lSerializer := TMVCJsonDataObjectsSerializer.Create; + try + lSerializer.JsonArrayToDataSet(AJSONArray, Self, nil, ncAsIs); + finally + lSerializer.Free; + end; + if Self.BookmarkValid(lBookmark) then + Self.GotoBookmark(lBookmark); + finally + Self.EnableControls; + end; +end; + procedure TDataSetHelper.LoadFromJSONArrayString(AJSONArrayString: string; AFieldNamePolicy: TFieldNamePolicy); begin AppendFromJSONArrayString(AJSONArrayString, TArray.Create(), AFieldNamePolicy); @@ -243,17 +253,6 @@ var begin lSerializer := TMVCJsonDataObjectsSerializer.Create; lSerializer.DeserializeDataSetRecord(AJSONObjectString, Self, nil, ncAsIs); - - // JV := TJSONObject.ParseJSONValue(AJSONObjectString); - // try - // if JV is TJSONObject then - // LoadFromJSONObject(TJSONObject(JV), AIgnoredFields) - // else - // raise EMapperException.Create - // ('Extected JSONObject in LoadFromJSONObjectString'); - // finally - // JV.Free; - // end; end; procedure TDataSetHelper.LoadFromJSONObject(AJSONObject: TJSONObject; AFieldNamePolicy: TFieldNamePolicy); @@ -409,4 +408,3 @@ begin end; end. - diff --git a/sources/MVCFramework.JSONRPC.Client.pas b/sources/MVCFramework.JSONRPC.Client.pas index 841329c4..81cdfe0f 100644 --- a/sources/MVCFramework.JSONRPC.Client.pas +++ b/sources/MVCFramework.JSONRPC.Client.pas @@ -35,8 +35,8 @@ uses type IMVCJSONRPCExecutor = interface ['{55415094-9D28-4707-AEC5-5FCF925E82BC}'] - function ExecuteRequest(const aJSONRPCRequest: TJSONRPCRequest): TJSONRPCResponse; - procedure ExecuteNotification(const aJSONRPCNotification: TJSONRPCNotification); + function ExecuteRequest(const aJSONRPCRequest: IJSONRPCRequest): IJSONRPCResponse; + procedure ExecuteNotification(const aJSONRPCNotification: IJSONRPCNotification); // Http headers handling procedure AddHTTPHeader(const aNetHeader: TNetHeader); procedure ClearHTTPHeaders; @@ -51,12 +51,12 @@ type FHTTPRequestHeaders: TList; function GetHTTPRequestHeaders: TList; protected - function InternalExecute(const aJSONRPCObject: TJSONRPCObject): TJSONRPCResponse; + function InternalExecute(const aJSONRPCObject: IJSONRPCObject): IJSONRPCResponse; public constructor Create(const aURL: string; const aRaiseExceptionOnError: Boolean = True); virtual; destructor Destroy; override; - function ExecuteRequest(const aJSONRPCRequest: TJSONRPCRequest): TJSONRPCResponse; - procedure ExecuteNotification(const aJSONRPCNotification: TJSONRPCNotification); + function ExecuteRequest(const aJSONRPCRequest: IJSONRPCRequest): IJSONRPCResponse; + procedure ExecuteNotification(const aJSONRPCNotification: IJSONRPCNotification); // Http headers handling procedure AddHTTPHeader(const aNetHeader: TNetHeader); procedure ClearHTTPHeaders; @@ -69,7 +69,7 @@ uses System.Classes, System.SysUtils; -procedure JSONRPCExec(const aJSONRPCURL: string; const aJSONRPCRequest: TJSONRPCRequest; out aJSONRPCResponse: TJSONRPCResponse); +procedure JSONRPCExec(const aJSONRPCURL: string; const aJSONRPCRequest: IJSONRPCRequest; out aJSONRPCResponse: IJSONRPCResponse); var lSS: TStringStream; lHttpResp: IHTTPResponse; @@ -85,14 +85,9 @@ begin if (lHttpResp.StatusCode <> 204) then begin aJSONRPCResponse := TJSONRPCResponse.Create; - try - aJSONRPCResponse.AsJSONString := lHttpResp.ContentAsString; - if Assigned(aJSONRPCResponse.Error) then - raise Exception.CreateFmt('Error [%d]: %s', [aJSONRPCResponse.Error.Code, aJSONRPCResponse.Error.ErrMessage]); - except - aJSONRPCResponse.Free; - raise; - end; + aJSONRPCResponse.AsJSONString := lHttpResp.ContentAsString; + if Assigned(aJSONRPCResponse.Error) then + raise Exception.CreateFmt('Error [%d]: %s', [aJSONRPCResponse.Error.Code, aJSONRPCResponse.Error.ErrMessage]); end; finally lHTTP.Free; @@ -133,13 +128,13 @@ begin inherited; end; -procedure TMVCJSONRPCExecutor.ExecuteNotification(const aJSONRPCNotification: TJSONRPCNotification); +procedure TMVCJSONRPCExecutor.ExecuteNotification(const aJSONRPCNotification: IJSONRPCNotification); begin if InternalExecute(aJSONRPCNotification as TJSONRPCObject) <> nil then raise EMVCJSONRPCException.Create('A "notification" cannot returns a response. Use ExecuteRequest instead.'); end; -function TMVCJSONRPCExecutor.ExecuteRequest(const aJSONRPCRequest: TJSONRPCRequest): TJSONRPCResponse; +function TMVCJSONRPCExecutor.ExecuteRequest(const aJSONRPCRequest: IJSONRPCRequest): IJSONRPCResponse; begin Result := InternalExecute(aJSONRPCRequest); end; @@ -165,11 +160,11 @@ begin end; end; -function TMVCJSONRPCExecutor.InternalExecute(const aJSONRPCObject: TJSONRPCObject): TJSONRPCResponse; +function TMVCJSONRPCExecutor.InternalExecute(const aJSONRPCObject: IJSONRPCObject): IJSONRPCResponse; var lSS: TStringStream; lHttpResp: IHTTPResponse; - lJSONRPCResponse: TJSONRPCResponse; + lJSONRPCResponse: IJSONRPCResponse; lCustomHeaders: TNetHeaders; begin lCustomHeaders := []; @@ -187,15 +182,10 @@ begin if (lHttpResp.StatusCode <> HTTP_STATUS.NoContent) then begin lJSONRPCResponse := TJSONRPCResponse.Create; - try - lJSONRPCResponse.AsJSONString := lHttpResp.ContentAsString; - if Assigned(lJSONRPCResponse.Error) and FRaiseExceptionOnError then - raise Exception.CreateFmt('Error [%d]: %s', [lJSONRPCResponse.Error.Code, lJSONRPCResponse.Error.ErrMessage]); - Result := lJSONRPCResponse; - except - lJSONRPCResponse.Free; - raise; - end; + lJSONRPCResponse.AsJSONString := lHttpResp.ContentAsString; + if Assigned(lJSONRPCResponse.Error) and FRaiseExceptionOnError then + raise Exception.CreateFmt('Error [%d]: %s', [lJSONRPCResponse.Error.Code, lJSONRPCResponse.Error.ErrMessage]); + Result := lJSONRPCResponse; end; finally lSS.Free; diff --git a/sources/MVCFramework.JSONRPC.pas b/sources/MVCFramework.JSONRPC.pas index 9d2f9b8a..8ef561d7 100644 --- a/sources/MVCFramework.JSONRPC.pas +++ b/sources/MVCFramework.JSONRPC.pas @@ -72,85 +72,139 @@ type procedure Build(const aJSON: TJsonObject); virtual; abstract; { IMVCJSONRPCMessage } function AsJSONRPCMessage: string; - public function AsJSON: TJsonObject; virtual; end; - TJSONRPCObject = class(TObject) + IJSONRPCObject = interface + ['{98E161EE-B106-4023-8722-3C2CB1B4CE87}'] + procedure SetJsonString(const Value: string); + function GetJSONString: string; + function GetJSON: TJsonObject; + procedure SetJSON(const Value: TJsonObject); + property AsJSON: TJsonObject read GetJSON write SetJSON; + property AsJSONString: string read GetJSONString write SetJsonString; + end; + + TJSONRPCObject = class(TInterfacedObject, IJSONRPCObject) protected procedure SetJsonString(const Value: string); virtual; function GetJSONString: string; virtual; function GetJSON: TJsonObject; virtual; procedure SetJSON(const Value: TJsonObject); virtual; - public - constructor Create; virtual; property AsJSON: TJsonObject read GetJSON write SetJSON; property AsJSONString: string read GetJSONString write SetJsonString; + public + constructor Create; virtual; end; - TJSONRPCNotification = class(TJSONRPCObject) - protected type - TJSONRPCRequestParams = TList; + TJSONRPCRequestParams = TList; + + IJSONRPCNotification = interface(IJSONRPCObject) + ['{FAA65A29-3305-4303-833E-825BDBD3FF7F}'] + procedure SetMethod(const Value: string); + function GetMethod: string; + function GetParams: TJSONRPCRequestParams; + property Method: string read GetMethod write SetMethod; + property Params: TJSONRPCRequestParams read GetParams; + end; + + TJSONRPCNotification = class(TJSONRPCObject, IJSONRPCObject, IJSONRPCNotification) protected FMethod: string; FParams: TJSONRPCRequestParams; procedure SetMethod(const Value: string); - protected + function GetMethod: string; + function GetParams: TJSONRPCRequestParams; function GetJSON: TJsonObject; override; + property Method: string read GetMethod write SetMethod; + property Params: TJSONRPCRequestParams read GetParams; public - constructor Create; override; + constructor Create; overload; override; + constructor Create(const aMethod: String); reintroduce; overload; destructor Destroy; override; - property Method: string read FMethod write SetMethod; - property Params: TJSONRPCRequestParams read FParams; end; {$SCOPEDENUMS ON} TJSONRPCRequestType = (Request, Notification); - TJSONRPCRequest = class(TJSONRPCNotification) + IJSONRPCRequest = interface(IJSONRPCNotification) + ['{D8318032-0261-4273-B99D-121899AD52FB}'] + function GetRequestType: TJSONRPCRequestType; + function GetID: TValue; + procedure SetID(const Value: TValue); + property RequestType: TJSONRPCRequestType read GetRequestType; + property RequestID: TValue read GetID write SetID; + end; + + TJSONRPCRequest = class(TJSONRPCNotification, IJSONRPCRequest) private FID: TValue; function GetRequestType: TJSONRPCRequestType; + function GetID: TValue; protected procedure SetJSON(const JSON: TJsonObject); override; function GetJSON: TJsonObject; override; procedure SetID(const Value: TValue); - public - constructor Create; override; - destructor Destroy; override; property RequestType: TJSONRPCRequestType read GetRequestType; - property RequestID: TValue read FID write SetID; + property RequestID: TValue read GetID write SetID; + public + constructor Create(const aID: TValue; const aMethod: String); overload; virtual; + constructor Create(const aID: TValue); overload; virtual; + constructor Create; reintroduce; overload; virtual; + destructor Destroy; override; end; - TJSONRPCResponse = class(TJSONRPCObject) - private type - TJSONRPCResponseError = class - private - FCode: Integer; - FMessage: string; - procedure SetCode(const Value: Integer); - procedure SetMessage(const Value: string); - public - property Code: Integer read FCode write SetCode; - property ErrMessage: string read FMessage write SetMessage; - end; + TJSONRPCResponseError = class + private + FCode: Integer; + FMessage: string; + procedure SetCode(const Value: Integer); + procedure SetMessage(const Value: string); + public + property Code: Integer read FCode write SetCode; + property ErrMessage: string read FMessage write SetMessage; + end; + + IJSONRPCResponse = interface(IJSONRPCObject) + ['{69B43409-14DC-4A36-9E12-425A1626FF3C}'] + function GetID: TValue; + procedure SetID(const Value: TValue); + function GetResult: TValue; + procedure SetResult(const Value: TValue); + function GetError: TJSONRPCResponseError; + procedure SetError(const Value: TJSONRPCResponseError); + function IsError: Boolean; + function ResultAsJSONObject: TJsonObject; + function ResultAsJSONArray: TJsonArray; + property Result: TValue read GetResult write SetResult; + property Error: TJSONRPCResponseError read GetError write SetError; + property RequestID: TValue read GetID write SetID; + end; + + TJSONRPCResponse = class(TJSONRPCObject, IJSONRPCResponse) private FResult: TValue; FError: TJSONRPCResponseError; FID: TValue; - procedure SetID(const Value: TValue); - procedure SetResult(const Value: TValue); - procedure SetError(const Value: TJSONRPCResponseError); + function GetResult: TValue; protected function GetJSON: TJsonObject; override; procedure SetJSON(const JSON: TJsonObject); override; + procedure SetID(const Value: TValue); + procedure SetResult(const Value: TValue); + procedure SetError(const Value: TJSONRPCResponseError); + function GetError: TJSONRPCResponseError; + function GetID: TValue; + function ResultAsJSONObject: TJsonObject; + function ResultAsJSONArray: TJsonArray; + function IsError: Boolean; + property Result: TValue read GetResult write SetResult; + property Error: TJSONRPCResponseError read GetError write SetError; + property RequestID: TValue read GetID write SetID; public constructor Create; override; destructor Destroy; override; - property Result: TValue read FResult write SetResult; - property Error: TJSONRPCResponseError read FError write SetError; - property RequestID: TValue read FID write SetID; end; EMVCJSONRPCInvalidVersion = class(Exception) @@ -220,6 +274,11 @@ type [MVCConsumes(TMVCMediaType.APPLICATION_JSON)] [MVCProduces(TMVCMediaType.APPLICATION_JSON)] procedure Index; virtual; + + [MVCPath] + [MVCHTTPMethods([httpGET])] + [MVCProduces(TMVCMediaType.TEXT_PLAIN)] + procedure GetProxyCode; virtual; constructor Create; overload; override; destructor Destroy; override; end; @@ -229,15 +288,31 @@ type constructor Create(const RPCInstance: TObject; const Owns: Boolean = True); reintroduce; overload; end; + TJSONRPCProxyGenerator = class abstract + public + constructor Create; virtual; + procedure StartGeneration; virtual; + procedure EndGeneration; virtual; + procedure VisitMethod(const aRTTIMethod: TRttiMethod); virtual; abstract; + function GetCode: String; virtual; abstract; + end; + + TJSONRPCProxyGeneratorClass = class of TJSONRPCProxyGenerator; + +procedure RegisterJSONRPCProxyGenerator(const aLanguage: String; const aClass: TJSONRPCProxyGeneratorClass); + implementation uses MVCFramework.Serializer.Intf, MVCFramework.Logger, System.TypInfo, MVCFramework.DuckTyping, - MVCFramework.Serializer.JsonDataObjects.CustomTypes; + MVCFramework.Serializer.jsondataobjects.CustomTypes; const - CALL_TYPE: array[mkProcedure..mkFunction] of string = ('PROCEDURE','FUNCTION'); + CALL_TYPE: array [mkProcedure .. mkFunction] of string = ('PROCEDURE', 'FUNCTION'); + +var + GProxyGeneratorsRegister: TDictionary; function JSONDataValueToTValue(const JSONDataValue: TJsonDataValueHelper): TValue; begin @@ -260,6 +335,7 @@ begin end; jdtObject: begin + { TODO -oDanieleT -cGeneral : Can be deserialized in a PODO? } Result := TJsonObject.Parse(JSONDataValue.ObjectValue.ToJSON) as TJsonObject; end; jdtInt: @@ -343,14 +419,15 @@ begin fOwsRPCInstance := False; end; -function TMVCJSONRPCController.CreateError(const RequestID: TValue; const ErrorCode: Integer; const message: string): TJsonObject; +function TMVCJSONRPCController.CreateError(const RequestID: TValue; const ErrorCode: Integer; const message: string) + : TJsonObject; var lErrResp: TJSONRPCResponse; begin lErrResp := TJSONRPCResponse.Create; try lErrResp.RequestID := RequestID; - lErrResp.Error := TJSONRPCResponse.TJSONRPCResponseError.Create; + lErrResp.Error := TJSONRPCResponseError.Create; lErrResp.Error.Code := ErrorCode; lErrResp.Error.ErrMessage := message; Result := lErrResp.AsJSON; @@ -363,21 +440,23 @@ function TMVCJSONRPCController.CreateRequest(const JSON: TJsonObject): TJSONRPCR var I: Integer; lParams: TJsonArray; + lReqID: TValue; + lMethodName: String; begin try - Result := TJSONRPCRequest.Create; if JSON.Types[JSONRPC_ID] = jdtString then - Result.RequestID := JSON.S[JSONRPC_ID] + lReqID := JSON.S[JSONRPC_ID] else if JSON.Types[JSONRPC_ID] = jdtInt then - Result.RequestID := JSON.I[JSONRPC_ID] + lReqID := JSON.I[JSONRPC_ID] else if JSON.Types[JSONRPC_ID] = jdtLong then - Result.RequestID := JSON.L[JSONRPC_ID] + lReqID := JSON.L[JSONRPC_ID] else if JSON.Types[JSONRPC_ID] = jdtULong then - Result.RequestID := JSON.U[JSONRPC_ID] + lReqID := JSON.U[JSONRPC_ID] else - Result.RequestID := TValue.Empty; + lReqID := TValue.Empty; - Result.Method := JSON.S[JSONRPC_METHOD]; + lMethodName := JSON.S[JSONRPC_METHOD]; + Result := TJSONRPCRequest.Create(lReqID, lMethodName); if JSON.Types[JSONRPC_PARAMS] = jdtArray then begin @@ -431,6 +510,54 @@ begin end; end; +procedure TMVCJSONRPCController.GetProxyCode; +var + lLanguage: string; + lClass: TJSONRPCProxyGeneratorClass; + lGenerator: TJSONRPCProxyGenerator; + lRTTI: TRTTIContext; + lRTTIType: TRttiType; + lMethod: TRttiMethod; +begin + if not Context.Request.QueryStringParamExists('language') then + begin + raise EMVCJSONRPCException.Create('Query string parameter "language" is required'); + end; + + lLanguage := Context.Request.Params['language'].ToLower; + + if not Assigned(GProxyGeneratorsRegister) then + begin + raise EMVCJSONRPCException.Create + ('No Proxy Generators have been registered. [HINT] Use RegisterJSONRPCProxyGenerator function'); + end; + + if not GProxyGeneratorsRegister.TryGetValue(lLanguage, lClass) then + begin + raise EMVCJSONRPCException.CreateFmt('Unknown language [%s]', [lLanguage]); + end; + + lGenerator := lClass.Create; + try + lRTTI := TRTTIContext.Create; + try + lRTTIType := lRTTI.GetType(fRPCInstance.ClassType); + lGenerator.StartGeneration(); + for lMethod in lRTTIType.GetMethods do + begin + lGenerator.VisitMethod(lMethod); + end; + lGenerator.EndGeneration(); + Context.Response.ContentType := 'text/plain'; + Render(lGenerator.GetCode); + finally + lRTTI.Free; + end; + finally + lGenerator.Free; + end; +end; + function TMVCJSONRPCController.GetSerializer: TMVCJsonDataObjectsSerializer; begin if not Assigned(fSerializer) then @@ -474,20 +601,24 @@ begin lRTTIMethod := lRTTIType.GetMethod(lMethod); if Assigned(lRTTIMethod) then begin - if (lRTTIMethod.Visibility <> mvPublic) or (not (lRTTIMethod.MethodKind in [mkProcedure, mkFunction])) then + if (lRTTIMethod.Visibility <> mvPublic) or (not(lRTTIMethod.MethodKind in [mkProcedure, mkFunction])) then begin - LogW(Format('Method "%s" cannot be called. Only public functions or procedures can be called. ', [lMethod])); + LogW(Format('Method "%s" cannot be called. Only public functions or procedures can be called. ', + [lMethod])); raise EMVCJSONRPCMethodNotFound.Create(lMethod); end; if (lJSONRPCReq.RequestType = TJSONRPCRequestType.Request) and (lRTTIMethod.MethodKind <> mkFunction) then begin - raise EMVCJSONRPCInvalidParams.Create('Cannot call a procedure using a JSON-RPC request. [HINT] Use requests for functions and notifications for procedures'); + raise EMVCJSONRPCInvalidParams.Create + ('Cannot call a procedure using a JSON-RPC request. [HINT] Use requests for functions and notifications for procedures'); end; - if (lJSONRPCReq.RequestType = TJSONRPCRequestType.Notification) and (lRTTIMethod.MethodKind <> mkProcedure) then + if (lJSONRPCReq.RequestType = TJSONRPCRequestType.Notification) and (lRTTIMethod.MethodKind <> mkProcedure) + then begin - raise EMVCJSONRPCInvalidParams.Create('Cannot call a function using a JSON-RPC notification. [HINT] Use requests for functions and notifications for procedures'); + raise EMVCJSONRPCInvalidParams.Create + ('Cannot call a function using a JSON-RPC notification. [HINT] Use requests for functions and notifications for procedures'); end; InjectParams(lJSONRPCReq, lRTTIMethod); @@ -524,7 +655,8 @@ begin end else begin - LogW(Format('Method "%s" has not be found in %s. Only public methods can be invoked.', [lMethod, fRPCInstance.QualifiedClassName])); + LogW(Format('Method "%s" has not be found in %s. Only public methods can be invoked.', + [lMethod, fRPCInstance.QualifiedClassName])); raise EMVCJSONRPCMethodNotFound.Create(lMethod); end; finally @@ -561,12 +693,12 @@ begin ResponseStatus(500); end; Render(CreateError(lReqID, E.JSONRPCErrorCode, E.message), True); - LogE(Format('[JSON-RPC][CLS %s][ERR %d][MSG "%s"]',[E.ClassName, E.JSONRPCErrorCode,E.Message])); + LogE(Format('[JSON-RPC][CLS %s][ERR %d][MSG "%s"]', [E.ClassName, E.JSONRPCErrorCode, E.message])); end; on E: Exception do begin Render(CreateError(lReqID, 0, E.message), True); - LogE(Format('[JSON-RPC][CLS %s][MSG "%s"]',[E.ClassName, E.Message])); + LogE(Format('[JSON-RPC][CLS %s][MSG "%s"]', [E.ClassName, E.message])); end; end; end; @@ -586,7 +718,8 @@ end; constructor EMVCJSONRPCParseError.Create; begin - inherited Create('Parse error. Invalid JSON was received by the server. An error occurred on the server while parsing the JSON text'); + inherited Create + ('Parse error. Invalid JSON was received by the server. An error occurred on the server while parsing the JSON text'); FJSONRPCErrorCode := -32700; end; @@ -633,6 +766,18 @@ end; { TJSONRPCRequest } +constructor TJSONRPCRequest.Create(const aID: TValue; const aMethod: String); +begin + inherited Create(aMethod); + SetID(aID); +end; + +constructor TJSONRPCRequest.Create(const aID: TValue); +begin + inherited Create; + SetID(aID); +end; + constructor TJSONRPCRequest.Create; begin inherited Create; @@ -683,6 +828,12 @@ begin end; end; +constructor TJSONRPCNotification.Create(const aMethod: String); +begin + Create; + Method := aMethod; +end; + destructor TJSONRPCNotification.Destroy; var lValue: TValue; @@ -713,6 +864,16 @@ begin end; end; +function TJSONRPCNotification.GetMethod: string; +begin + Result := FMethod; +end; + +function TJSONRPCNotification.GetParams: TJSONRPCRequestParams; +begin + Result := FParams; +end; + procedure TJSONRPCNotification.SetMethod(const Value: string); begin FMethod := Value; @@ -734,6 +895,16 @@ begin inherited; end; +function TJSONRPCResponse.GetError: TJSONRPCResponseError; +begin + Result := FError; +end; + +function TJSONRPCResponse.GetID: TValue; +begin + Result := FID; +end; + function TJSONRPCResponse.GetJSON: TJsonObject; begin Result := inherited; @@ -775,6 +946,26 @@ begin end; end; +function TJSONRPCResponse.GetResult: TValue; +begin + Result := FResult; +end; + +function TJSONRPCResponse.IsError: Boolean; +begin + Result := Assigned(FError); +end; + +function TJSONRPCResponse.ResultAsJSONArray: TJsonArray; +begin + Result := Self.Result.AsObject as TJsonArray; +end; + +function TJSONRPCResponse.ResultAsJSONObject: TJsonObject; +begin + Result := Self.Result.AsObject as TJsonObject; +end; + procedure TJSONRPCResponse.SetError(const Value: TJSONRPCResponseError); begin FError := Value; @@ -882,18 +1073,23 @@ end; { TJSONRPCResponseError } -procedure TJSONRPCResponse.TJSONRPCResponseError.SetCode(const Value: Integer); +procedure TJSONRPCResponseError.SetCode(const Value: Integer); begin FCode := Value; end; -procedure TJSONRPCResponse.TJSONRPCResponseError.SetMessage(const Value: string); +procedure TJSONRPCResponseError.SetMessage(const Value: string); begin FMessage := Value; end; { TJSONRPCMessage } +function TJSONRPCRequest.GetID: TValue; +begin + Result := FID; +end; + function TJSONRPCRequest.GetJSON: TJsonObject; begin Result := inherited GetJSON; @@ -917,4 +1113,36 @@ begin end; +{ TJSONRPCProxyGenerator } + +constructor TJSONRPCProxyGenerator.Create; +begin + inherited; +end; + +procedure RegisterJSONRPCProxyGenerator(const aLanguage: String; const aClass: TJSONRPCProxyGeneratorClass); +begin + if not Assigned(GProxyGeneratorsRegister) then + begin + GProxyGeneratorsRegister := TDictionary.Create(); + end; + GProxyGeneratorsRegister.AddOrSetValue(aLanguage.ToLower, aClass); +end; + +procedure TJSONRPCProxyGenerator.EndGeneration; +begin + // do nothing +end; + +procedure TJSONRPCProxyGenerator.StartGeneration; +begin + // do nothing +end; + +initialization + +finalization + +FreeAndNil(GProxyGeneratorsRegister); + end. diff --git a/sources/MVCFramework.RQL.AST2FirebirdSQL.pas b/sources/MVCFramework.RQL.AST2FirebirdSQL.pas index e7fdeba0..1ca0008a 100644 --- a/sources/MVCFramework.RQL.AST2FirebirdSQL.pas +++ b/sources/MVCFramework.RQL.AST2FirebirdSQL.pas @@ -119,7 +119,7 @@ end; function TRQLFirebirdCompiler.RQLLimitToSQL(const aRQLLimit: TRQLLimit): string; begin // firebird ROWS requires Start > 0. Limit function is 0 based, so we have to add 1 to start. - Result := Format(' ROWS %d to %d', [aRQLLimit.Start + 1, aRQLLimit.Start + aRQLLimit.Count]); + Result := Format(' /*limit*/ ROWS %d to %d', [aRQLLimit.Start + 1, aRQLLimit.Start + aRQLLimit.Count]); end; function TRQLFirebirdCompiler.RQLLogicOperatorToSQL(const aRQLFIlter: TRQLLogicOperator): string; @@ -159,7 +159,7 @@ function TRQLFirebirdCompiler.RQLSortToSQL(const aRQLSort: TRQLSort): string; var I: Integer; begin - Result := ' ORDER BY'; + Result := ' /*sort*/ ORDER BY'; for I := 0 to aRQLSort.Fields.Count - 1 do begin if I > 0 then diff --git a/sources/MVCFramework.Serializer.JsonDataObjects.pas b/sources/MVCFramework.Serializer.JsonDataObjects.pas index 68660483..424dcf90 100644 --- a/sources/MVCFramework.Serializer.JsonDataObjects.pas +++ b/sources/MVCFramework.Serializer.JsonDataObjects.pas @@ -109,6 +109,7 @@ type procedure TValueToJsonElement(const Value: TValue; const JSON: TJsonObject; const KeyName: string); procedure AppendTValueToJsonArray(const Value: TValue; const JSONArr: TJsonArray); function StringToJSON(const aValue: string): TJsonObject; +procedure JsonObjectToObject(const AJsonObject: TJsonObject; const AObject: TObject; const AType: TMVCSerializationType; const AIgnoredAttributes: TMVCIgnoredList); implementation @@ -1221,5 +1222,17 @@ begin end; end; +procedure JsonObjectToObject(const AJsonObject: TJsonObject; const AObject: TObject; const AType: TMVCSerializationType; const AIgnoredAttributes: TMVCIgnoredList); +var + lSer: TMVCJsonDataObjectsSerializer; +begin + lSer := TMVCJsonDataObjectsSerializer.Create; + try + lSer.JsonObjectToObject(AJsonObject, AObject, AType, AIgnoredAttributes); + finally + lSer.Free; + end; +end; + end. diff --git a/sources/MVCFramework.pas b/sources/MVCFramework.pas index f42eafe1..864071f2 100644 --- a/sources/MVCFramework.pas +++ b/sources/MVCFramework.pas @@ -605,6 +605,7 @@ type FViewEngineClass: TMVCViewEngineClass; FWebModule: TWebModule; FConfig: TMVCConfig; + FConfigCache_MaxRequestSize: Int64; FSerializers: TDictionary; FMiddlewares: TList; FControllers: TObjectList; @@ -619,6 +620,7 @@ type function GetViewEngineClass: TMVCViewEngineClass; protected procedure ConfigDefaultValues; virtual; + procedure SaveCacheConfigValues; procedure LoadSystemControllers; virtual; procedure FixUpWebModule; procedure ExecuteBeforeRoutingMiddleware(const AContext: TWebContext; var AHandled: Boolean); @@ -1587,6 +1589,7 @@ begin Config[TMVCConfigKey.SessionType] := 'memory'; Config[TMVCConfigKey.IndexDocument] := 'index.html'; Config[TMVCConfigKey.MaxEntitiesRecordCount] := '20'; + Config[TMVCConfigKey.MaxRequestSize] := IntToStr(TMVCConstants.DEFAULT_MAX_REQUEST_SIZE); FMediaTypes.Add('.html', TMVCMediaType.TEXT_HTML); FMediaTypes.Add('.htm', TMVCMediaType.TEXT_HTML); @@ -1626,7 +1629,7 @@ begin AConfigAction(FConfig); LogExitMethod('Custom configuration method'); end; - + SaveCacheConfigValues; RegisterDefaultsSerializers; LoadSystemControllers; end; @@ -1663,6 +1666,12 @@ var begin Result := False; + ARequest.ReadTotalContent; + if ARequest.ContentLength > fConfigCache_MaxRequestSize then + begin + raise EMVCException.CreateFmt('Request size exceeded the max allowed size [%d KiB]', [(FConfigCache_MaxRequestSize div 1024)]); + end; + LParamsTable := TMVCRequestParamsTable.Create; try LContext := TWebContext.Create(ARequest, AResponse, FConfig, FSerializers); @@ -2127,6 +2136,11 @@ begin Result := SendSessionCookie(AContext, SId); end; +procedure TMVCEngine.SaveCacheConfigValues; +begin + FConfigCache_MaxRequestSize := StrToInt64Def(Config[TMVCConfigKey.MaxRequestSize], TMVCConstants.DEFAULT_MAX_REQUEST_SIZE); +end; + class function TMVCEngine.SendSessionCookie(const AContext: TWebContext; const ASessionId: string): string; var Cookie: TCookie; @@ -2904,3 +2918,4 @@ finalization FreeAndNil(_MVCGlobalActionParamsCache); end. +