Merge remote-tracking branch 'upstream/master' into new_restclient

README.md

@@ -1,8 +1,6 @@
-
 ![](https://img.shields.io/badge/current%20dmvcframework%20version-3.2.0--boron-blue?style=for-the-badge)
 ![DelphiMVCFramework Logo](docs/dmvcframework_logofacebook.png)
-![](https://img.shields.io/badge/next%20dmvcframework%20version-3.2.1--carbon-red)![GitHub All Releases](https://img.shields.io/github/downloads/danieleteti/delphimvcframework/total?label=releases%20download)
+![](https://img.shields.io/badge/We%20are%20working%20on%20dmvcframework%20new%20version-3.2.1--carbon-red)![GitHub All Releases](https://img.shields.io/github/downloads/danieleteti/delphimvcframework/total?label=releases%20download)
-
 
 # DelphiMVCFramework 3.2.0-boron is [here](https://github.com/danieleteti/delphimvcframework/releases/tag/v3_2_0_boron)!
 
@@ -385,7 +383,117 @@ Congratulations to Daniele Teti and all the staff for the excellent work!" -- Ma
 - Fixed! [issue388](https://github.com/danieleteti/delphimvcframework/issues/388)
 - Fixed! Has been patched a serious security bug affecting deployment configurations which uses internal WebServer to serve static files (do not affect all Apache, IIS or proxied deployments).  Thanks to **Stephan Munz** to have discovered it. *Update to dmvcframework-3.2-RC5+ is required for all such kind of deployments.*
 
+## Changes in upcoming version (3.2.1-carbon)
+
+### Bug Fixes and Improvements
+
+- [docExpansion parameter for Swagger](https://github.com/danieleteti/delphimvcframework/issues/408)
+
+- New `Context: TWebContext` parameter in JSON-RPC Hooks
+
+  ```delphi
+  { Called before any actual routing }
+  procedure OnBeforeRoutingHook(const Context: TWebContext; const JSON: TJsonObject);
+  { Called after routing and before the actual remote method invocation }
+  procedure OnBeforeCallHook(const Context: TWebContext; const JSON: TJsonObject);
+  { Called after actual remote method invocation, even if the method raised an exception }
+  procedure OnAfterCallHook(const Context: TWebContext; const JSON: TJsonObject);
+  ```
+
+- When a JSON-RPC Request returns a `System.Boolean` the `result` will be a JSON `true` or `false` and no `1` or `0` as it was in the `3.2.0-boron`.
+
+- `IMVCJSONRPCExecutor.ExecuteNotification` returns a `IJSONRPCResponse`. In case of error response contains information about the error, in case of successful execution the response is a [Null Object](https://en.wikipedia.org/wiki/Null_object_pattern).
+
+- Added `foReadOnly` and `foWriteOnly` as field options in `MVCTableField` attribute (used by `TMVCActiveRecord`). Currently available field options are:
+
+  - *foPrimaryKey* { it's the primary key of the mapped table }
+  - *foAutoGenerated* { not written, read - similar to foReadOnly but is reloaded after insert and update }
+  - *foTransient* { never stored nor read - managed only at run-time }
+  - *foReadOnly* { not written, read }
+  - *foWriteOnly* { written, not read }
+
+  Now it is possible to declare entities like the followings (or with any other combinations):
+
+  ```delphi
+    [MVCNameCase(ncLowerCase)]
+    [MVCTable('articles')]
+    TArticleWithWriteOnlyFields = class(TCustomEntity)
+    private
+      [MVCTableField('ID', [foPrimaryKey, foAutoGenerated])]
+      fID: NullableInt32;
+      [MVCTableField('description', [foWriteOnly])]
+      fDescription: string;
+      [MVCTableField('price', [foWriteOnly])]
+      fPrice: Integer;
+    public
+      property ID: NullableInt32 read fID write fID;
+      property Description: string read fDescription write fDescription;
+      property Price: Integer read fPrice write fPrice;
+    end;
+  
+    [MVCNameCase(ncLowerCase)]
+    [MVCTable('articles')]
+    TArticleWithReadOnlyFields = class(TCustomEntity)
+    private
+      [MVCTableField('ID', [foPrimaryKey, foReadOnly])]
+      fID: NullableInt32;
+      [MVCTableField('code', [foTransient])]
+      fCode: NullableString;
+      [MVCTableField('description', [foReadOnly])]
+      fDescrizione: string;
+      [MVCTableField('price', [foReadOnly])]
+      fPrice: Currency;
+    public
+      property ID: NullableInt32 read fID write fID;
+      property Code: NullableString read fCode write fCode;
+      property Description: string read fDescription write fDescription;
+      property Price: Currency read fPrice write fPrice;
+    end;
+  ```
+
+- Added the ability to deserialize an object starting from an arbitrary node in the JSON (or other format) present in the request body.
+
+  ```delphi
+  procedure TBooksController.CreateBook;
+  var
+    lBook: TBook;
+  begin
+    //this call deserialize a TBook instance
+    //starting from the 'book' node of
+    //the request body
+    lBook := Context.Request.BodyAs<TBook>('book');
+    try
+      lBook.Insert;
+      Render201Created('/api/books/' + lBook.ID.ToString);
+    finally
+      lBook.Free;
+    end;
+  end;
+  ```
+
+- Improved the primary key type handling for manual handling in MVCActiveRecord.
+
+  ```delphi
+  procedure TMyBaseEntity.OnBeforeInsert;
+  begin
+    inherited;
+    //regardless the name of the PK field
+    //the following code fills the PK with a GUID
+    //Inheriting the other entities from this, all
+    //will inherit this behavior.
+    SetPK(TValue.From<NullableString>(TGUID.NewGuid.ToString));
+    
+    //if the PK was a simple string, the code
+    //should be like the following
+    //SetPK(TGUID.NewGuid.ToString);  
+  end;
+  
+  ```
+
+- Improved `activerecord_showcase` sample.
+
 ## Roadmap
+
 DelphiMVCFramework roadmap is always updated as-soon-as the features planned are implemented. Check the roadmap [here](roadmap.md).
 
 ## Trainings, consultancy or custom development service

contributors.txt

@@ -1,25 +0,0 @@
-Daniele Teti
-Role		:	Founder, Lead Developer
-email		:	d.teti@bittime.it
-blog		: www.danieleteti.it
-company	:	www.bittimeprofessionals.it
-country	:	ITALY
-
-Daniele Spinetti
-Role		:	Expert, Senior Developer
-email		:	d.spinetti@bittime.it
-blog		: www.danielespinetti.it
-company	:	www.bittimeprofessionals.it
-country	:	ITALY
-
-Nick Hodges
-Role		:	Expert, Senior Developer
-blog		: www.nickhodges.com, www.codingindelphi.com/blog/
-company	: www.embarcadero.com
-country	:	USA
-
-Ezequiel Juliano Müller
-Role		:	Expert, Senior Developer
-email		:	ezequieljuliano@gmail.com
-blog		: www.ezequieljuliano.com.br
-country	:	BRAZIL

roadmap.md

@@ -10,7 +10,7 @@ As we are in the detailed planning stages for these features, we will share addi
  - (DONE) Implement Strongly Typed Actions
  - (DONE) Implement Custom Authentication and Authorization Middleware
  - (DONE) Use a middleware to implement response compression for console type projects
- - (INITIAL)Implement Swagger support (we need a good self contained YAML parser/generator...)
+ - (DONE)Implement Swagger support 
  - (DONE) Linux support
  - (DONE) Update Mapper framework to make it extensible and configurable
    - The default mapper interface will be the same as the current version so that no breaking changes happened
@@ -25,7 +25,7 @@ As we are in the detailed planning stages for these features, we will share addi
 - New samples with specific web related use cases:
    - WebWorkers
    - (DONE) Angular2+
-   - React
+   - (DONE) React
 - (DONE) Create "Custom Authentication and Authorization" demo
 - (CANCELED) Complete the [DevGuide](https://danieleteti.gitbooks.io/delphimvcframework/content/) on gitbooks
 - Improve the session mechanism to allows more flexibility

samples/activerecord_showcase/EntitiesU.pas

@@ -46,9 +46,9 @@ type
   [MVCTable('articles')]
   TArticle = class(TCustomEntity)
   private
-    [MVCTableField('ID')]
+    [MVCTableField('ID', [foPrimaryKey, foAutoGenerated])]
     fID: NullableInt32;
-    [MVCTableField('code')]
+    [MVCTableField('code', [foTransient])]
     fCodice: NullableString;
     [MVCTableField('description')]
     fDescrizione: string;
@@ -63,6 +63,41 @@ type
     property Price: Currency read fPrezzo write fPrezzo;
   end;
 
+  [MVCNameCase(ncLowerCase)]
+  [MVCTable('articles')]
+  TArticleWithWriteOnlyFields = class(TCustomEntity)
+  private
+    [MVCTableField('ID', [foPrimaryKey, foAutoGenerated, foReadOnly])]
+    fID: NullableInt32;
+    [MVCTableField('description', [foWriteOnly])]
+    fDescrizione: string;
+    [MVCTableField('price', [foWriteOnly])]
+    fPrice: Integer;
+  public
+    property ID: NullableInt32 read fID write fID;
+    property Description: string read fDescrizione write fDescrizione;
+    property Price: Integer read fPrice write fPrice;
+  end;
+
+  [MVCNameCase(ncLowerCase)]
+  [MVCTable('articles')]
+  TArticleWithReadOnlyFields = class(TCustomEntity)
+  private
+    [MVCTableField('ID', [foPrimaryKey, foReadOnly])]
+    fID: NullableInt32;
+    [MVCTableField('code', [foTransient])]
+    fCodice: NullableString;
+    [MVCTableField('description', [foReadOnly])]
+    fDescrizione: string;
+    [MVCTableField('price', [foReadOnly])]
+    fPrezzo: Currency;
+  public
+    property ID: NullableInt32 read fID write fID;
+    property Code: NullableString read fCodice write fCodice;
+    property Description: string read fDescrizione write fDescrizione;
+    property Price: Currency read fPrezzo write fPrezzo;
+  end;
+
   TOrder = class;
 
   [MVCNameCase(ncLowerCase)]
@@ -108,7 +143,6 @@ type
     fID: Integer;
     [MVCTableField('code', [foTransient])]
     fCode: string;
-    [MVCTableField('', [foTransient])]
     fFormattedCode: string;
     [MVCTableField('description')]
     fCompanyName: string;
@@ -238,6 +272,12 @@ type
     property Note: string read fNote write fNote;
   end;
 
+  [MVCTable('customers_with_code')]
+  TCustomerPlainWithClientPK = class(TCustomerWithCode)
+  protected
+    procedure OnBeforeInsert; override;
+  end;
+
   [MVCNameCase(ncLowerCase)]
   [MVCTable('orders')]
   TOrder = class(TCustomEntity)
@@ -350,7 +390,7 @@ type
 implementation
 
 uses
-  System.SysUtils, Data.DB, MVCFramework.Logger;
+  System.SysUtils, Data.DB, MVCFramework.Logger, System.Rtti;
 
 constructor TArticle.Create;
 begin
@@ -459,7 +499,7 @@ end;
 constructor TNullablesTest.Create;
 begin
   inherited Create;
-  // ff_blob := TMemoryStream.Create;
+  ff_blob := TMemoryStream.Create;
 end;
 
 destructor TNullablesTest.Destroy;
@@ -476,4 +516,16 @@ begin
   Log.Info(ClassName + ' | ' + SQL, 'sql_trace');
 end;
 
+{ TCustomerPlainWithClientPK }
+
+procedure TCustomerPlainWithClientPK.OnBeforeInsert;
+begin
+  inherited;
+  SetPK(TValue.From<NullableString>(TGUID.NewGuid.ToString
+    .Replace('{', '')
+    .Replace('-', '')
+    .Replace('}', '')
+    .Substring(0, 20)));
+end;
+
 end.

samples/activerecord_showcase/MainFormU.dfm

@@ -2,7 +2,7 @@ object MainForm: TMainForm
   Left = 0
   Top = 0
   Caption = 'TMVCActiveRecord - ShowCase'
-  ClientHeight = 587
+  ClientHeight = 640
   ClientWidth = 635
   Color = clBtnFace
   Font.Charset = DEFAULT_CHARSET
@@ -15,7 +15,7 @@ object MainForm: TMainForm
   OnShow = FormShow
   DesignSize = (
     635
-    587)
+    640)
   PixelsPerInch = 96
   TextHeight = 13
   object btnCRUD: TButton
@@ -40,7 +40,7 @@ object MainForm: TMainForm
     Left = 135
     Top = 8
     Width = 492
-    Height = 571
+    Height = 624
     Anchors = [akLeft, akTop, akRight, akBottom]
     Ctl3D = True
     DoubleBuffered = True
@@ -57,6 +57,7 @@ object MainForm: TMainForm
     TabOrder = 2
     WantReturns = False
     WordWrap = False
+    ExplicitHeight = 571
   end
   object btnRelations: TButton
     Left = 8
@@ -158,6 +159,24 @@ object MainForm: TMainForm
     TabOrder = 13
     OnClick = btnCountWithRQLClick
   end
+  object btnReadAndWriteOnly: TButton
+    Left = 8
+    Top = 523
+    Width = 121
+    Height = 33
+    Caption = 'R/O, R/W'
+    TabOrder = 14
+    OnClick = btnReadAndWriteOnlyClick
+  end
+  object btnClientGeneratedPK: TButton
+    Left = 8
+    Top = 562
+    Width = 121
+    Height = 33
+    Caption = 'Client Generated PKs'
+    TabOrder = 15
+    OnClick = btnClientGeneratedPKClick
+  end
   object FDConnection1: TFDConnection
     Left = 176
     Top = 56

samples/activerecord_showcase/MainFormU.pas

@@ -42,6 +42,8 @@ type
     btnCRUDWithStringPKs: TButton;
     btnWithSpaces: TButton;
     btnCountWithRQL: TButton;
+    btnReadAndWriteOnly: TButton;
+    btnClientGeneratedPK: TButton;
     procedure btnCRUDClick(Sender: TObject);
     procedure btnInheritanceClick(Sender: TObject);
     procedure btnMultiThreadingClick(Sender: TObject);
@@ -58,6 +60,8 @@ type
     procedure btnCRUDWithStringPKsClick(Sender: TObject);
     procedure btnWithSpacesClick(Sender: TObject);
     procedure btnCountWithRQLClick(Sender: TObject);
+    procedure btnReadAndWriteOnlyClick(Sender: TObject);
+    procedure btnClientGeneratedPKClick(Sender: TObject);
   private
     procedure Log(const Value: string);
     procedure LoadCustomers;
@@ -88,6 +92,19 @@ const
   CompanySuffix: array [0 .. 5] of string = ('Corp.', 'Inc.', 'Ltd.', 'Srl', 'SPA', 'doo');
   Stuff: array [0 .. 4] of string = ('Burger', 'GAS', 'Motors', 'House', 'Boats');
 
+procedure TMainForm.btnClientGeneratedPKClick(Sender: TObject);
+var
+  lCustomer: TCustomerPlainWithClientPK;
+begin
+  Log('** OnBeforeInsert and SetPK');
+  lCustomer := TCustomerPlainWithClientPK.Create();
+  try
+    lCustomer.Store;
+  finally
+    lCustomer.Free;
+  end;
+end;
+
 procedure TMainForm.btnCountWithRQLClick(Sender: TObject);
 var
   lRQL: string;
@@ -137,7 +154,7 @@ begin
   Log('There are ' + TMVCActiveRecord.Count<TCustomer>().ToString + ' row/s for entity ' + TCustomer.ClassName);
   lCustomer := TCustomer.Create;
   try
-    Log('Entity ' + TCustomer.ClassName + ' is mapped to table ' +  lCustomer.TableName);
+    Log('Entity ' + TCustomer.ClassName + ' is mapped to table ' + lCustomer.TableName);
     lCustomer.CompanyName := 'Google Inc.';
     lCustomer.City := 'Montain View, CA';
     lCustomer.Note := 'Hello there!';
@@ -449,7 +466,12 @@ begin
     lTest.f_int2 := 2;
     lTest.f_int4 := 4;
     lTest.f_int8 := 8;
-    lTest.f_blob := TStringStream.Create('Hello World');
+    with TStreamWriter.Create(lTest.f_blob) do
+      try
+        write('Hello World');
+      finally
+        Free;
+      end;
     lTest.Insert;
     Log('Inserting nulls');
   finally
@@ -474,8 +496,7 @@ begin
     lTest.f_int2 := lTest.f_int2.Value + 2;
     lTest.f_int4 := lTest.f_int4.Value + 4;
     lTest.f_int8 := lTest.f_int8.Value + 8;
-    lTest.f_blob.Free;
+    lTest.f_blob.Size := 0;
-    lTest.f_blob := nil;
     lTest.Update;
   finally
     lTest.Free;
@@ -494,7 +515,7 @@ begin
     Assert(not lTest.f_float4.HasValue);
     Assert(not lTest.f_float8.HasValue);
     Assert(not lTest.f_bool.HasValue);
-    Assert(not Assigned(lTest.f_blob), 'Blob contains a value when should not');
+    Assert(lTest.f_blob.Size = 0, 'Blob contains a value when should not');
     TMVCActiveRecord.DeleteRQL(TNullablesTest, 'eq(f_int2,4)');
   finally
     lTest.Free;
@@ -572,6 +593,65 @@ begin
 
 end;
 
+procedure TMainForm.btnReadAndWriteOnlyClick(Sender: TObject);
+var
+  lArtWO, lArtWO2: TArticleWithWriteOnlyFields;
+  lArtRO: TArticleWithReadOnlyFields;
+  lID: NullableInt32;
+  lArt: TArticle;
+begin
+  lArtWO := TArticleWithWriteOnlyFields.Create();
+  try
+    lArtWO.Description := 'Description1';
+    lArtWO.Price := 12;
+    lArtWO.Insert;
+    Log('Stored TArticleWithWriteOnlyFields');
+    lID := lArtWO.ID;
+
+    lArt := TMVCActiveRecord.GetByPK<TArticle>(lID);
+    try
+      Assert(lArtWO.Description = lArt.Description);
+      Assert(lArtWO.Price = lArt.Price);
+      Log('Check Stored version of TArticleWithWriteOnlyFields');
+
+      Log('Reading data using TArticleWithReadOnlyFields');
+      lArtRO := TMVCActiveRecord.GetByPK<TArticleWithReadOnlyFields>(lID);
+      try
+        Assert(lArtRO.Description = lArt.Description);
+        Assert(lArtRO.Price = lArt.Price);
+        Log('Check Read data of TArticleWithWriteOnlyFields using TArticleWithReadOnlyFields');
+      finally
+        lArtRO.Free;
+      end;
+
+      Log('Reading data using TArticleWithWriteOnlyFields (???)');
+      lArtWO2 := TMVCActiveRecord.GetByPK<TArticleWithWriteOnlyFields>(lID);
+      try
+        Assert(lArtWO2.ID.ValueOrDefault = lID.ValueOrDefault);
+        Assert(lArtWO2.Description = '');
+        Assert(lArtWO2.Price = 0);
+      finally
+        lArtWO2.Free;
+      end;
+    finally
+      lArt.Free;
+    end;
+
+    lArtRO := TArticleWithReadOnlyFields.Create();
+    try
+      lArtRO.Description := 'Description1';
+      lArtRO.Price := 12;
+      ShowMessage('Now an exception will be raised...');
+      lArtRO.Insert; // exception here :-)
+    finally
+      lArtRO.Free;
+    end;
+
+  finally
+    lArtWO.Free;
+  end;
+end;
+
 procedure TMainForm.btnRelationsClick(Sender: TObject);
 var
   lCustomer: TCustomerEx;
@@ -818,7 +898,7 @@ begin
   lCustomer := TCustomerWithTransient.Create;
   try
     {
-      'Code' and City will not be persisted because defined as 'transient'
+      'Code' will not be persisted because defined as 'transient'
     }
     lCustomer.Code := '1234';
     lCustomer.CompanyName := 'Google Inc.';

samples/activerecord_showcase/activerecord_showcase.dproj

@@ -163,13 +163,13 @@
                 </Excluded_Packages>
             </Delphi.Personality>
             <Deployment Version="3">
-                <DeployFile LocalName="bin\activerecord_showcase.exe" Configuration="BUILD" Class="ProjectOutput">
+                <DeployFile LocalName="bin\activerecord_showcase.exe" Configuration="Debug" Class="ProjectOutput">
                     <Platform Name="Win32">
                         <RemoteName>activerecord_showcase.exe</RemoteName>
                         <Overwrite>true</Overwrite>
                     </Platform>
                 </DeployFile>
-                <DeployFile LocalName="bin\activerecord_showcase.exe" Configuration="Debug" Class="ProjectOutput">
+                <DeployFile LocalName="bin\activerecord_showcase.exe" Configuration="BUILD" Class="ProjectOutput">
                     <Platform Name="Win32">
                         <RemoteName>activerecord_showcase.exe</RemoteName>
                         <Overwrite>true</Overwrite>

samples/authenticationauthorization/AuthenticateAuthorize.dproj

@@ -160,8 +160,11 @@
                     <Source Name="MainSource">AuthenticateAuthorize.dpr</Source>
                 </Source>
                 <Excluded_Packages>
-                    <Excluded_Packages Name="$(BDSBIN)\dcloffice2k170.bpl">Microsoft Office 2000 Beispiele für gekapselte Komponenten für Automatisierungsserver</Excluded_Packages>
+                    <Excluded_Packages Name="$(BDSBIN)\bcboffice2k260.bpl">Embarcadero C++Builder Office 2000 Servers Package</Excluded_Packages>
-                    <Excluded_Packages Name="$(BDSBIN)\dclofficexp170.bpl">Microsoft Office XP Beispiele für gekapselte Komponenten für Automation Server</Excluded_Packages>
+                    <Excluded_Packages Name="$(BDSBIN)\bcbofficexp260.bpl">Embarcadero C++Builder Office XP Servers Package</Excluded_Packages>
+                    <Excluded_Packages Name="$(BDSBIN)\dcloffice2k260.bpl">Microsoft Office 2000 Sample Automation Server Wrapper Components</Excluded_Packages>
+                    <Excluded_Packages Name="$(BDSBIN)\dclofficexp260.bpl">Microsoft Office XP Sample Automation Server Wrapper Components</Excluded_Packages>
+                    <Excluded_Packages Name="C:\Program Files (x86)\FastReports\LibD26\dclfrxtee26.bpl">FastReport 6.0 Tee Components</Excluded_Packages>
                 </Excluded_Packages>
             </Delphi.Personality>
             <Deployment Version="3">

samples/authenticationauthorization/AuthenticationU.pas

@@ -24,9 +24,10 @@ implementation
 
 { TMVCAuthorization }
 
-procedure TAuthenticationSample.OnAuthentication(const AContext: TWebContext; const UserName: string; const Password: string;
+procedure TAuthenticationSample.OnAuthentication(const AContext: TWebContext; const UserName: string;
-      UserRoles: System.Generics.Collections.TList<System.string>;
+  const Password: string;
-      var IsValid: Boolean; const SessionData: TSessionData);
+  UserRoles: System.Generics.Collections.TList<System.string>;
+  var IsValid: Boolean; const SessionData: TSessionData);
 begin
   IsValid := UserName.Equals(Password); // hey!, this is just a demo!!!
   if IsValid then
@@ -53,9 +54,9 @@ end;
 
 procedure TAuthenticationSample.OnAuthorization
   (const AContext: TWebContext; UserRoles
-      : System.Generics.Collections.TList<System.string>;
+  : System.Generics.Collections.TList<System.string>;
-      const ControllerQualifiedClassName: string; const ActionName: string;
+  const ControllerQualifiedClassName: string; const ActionName: string;
-      var IsAuthorized: Boolean);
+  var IsAuthorized: Boolean);
 begin
   IsAuthorized := False;
   if ActionName = 'Logout' then
@@ -69,7 +70,7 @@ begin
 end;
 
 procedure TAuthenticationSample.OnRequest(const AContext: TWebContext; const ControllerQualifiedClassName: string;
-      const ActionName: string; var AuthenticationRequired: Boolean);
+  const ActionName: string; var AuthenticationRequired: Boolean);
 begin
   AuthenticationRequired := ControllerQualifiedClassName =
     'AppControllerU.TAdminController';

samples/authenticationauthorization/WebModuleUnit1.pas

@@ -49,7 +49,9 @@ begin
     .AddMiddleware(TMVCBasicAuthenticationMiddleware.Create(TAuthenticationSample.Create))
     .AddMiddleware(TMVCStaticFilesMiddleware.Create(
     '/', { StaticFilesPath }
-    '..\..\www' { DocumentRoot }
+    '..\..\www', { DocumentRoot }
+    'index.html',
+    False { not serving a SPA }
     ));
 end;
 

samples/jsonrpc/MainClientFormU.dfm

@@ -2,7 +2,7 @@ object Form10: TForm10
   Left = 0
   Top = 0
   Caption = 'Form10'
-  ClientHeight = 448
+  ClientHeight = 484
   ClientWidth = 831
   Color = clBtnFace
   Font.Charset = DEFAULT_CHARSET
@@ -14,9 +14,28 @@ object Form10: TForm10
   OnCreate = FormCreate
   PixelsPerInch = 96
   TextHeight = 13
+  object Label2: TLabel
+    AlignWithMargins = True
+    Left = 3
+    Top = 3
+    Width = 825
+    Height = 39
+    Align = alTop
+    Alignment = taCenter
+    Caption = 
+      'Please use the demo available in samples\jsonrpc_with_published_' +
+      'objects\'
+    Font.Charset = DEFAULT_CHARSET
+    Font.Color = clWindowText
+    Font.Height = -21
+    Font.Name = 'Tahoma'
+    Font.Style = []
+    ParentFont = False
+    Layout = tlCenter
+  end
   object GroupBox1: TGroupBox
     Left = 8
-    Top = 16
+    Top = 48
     Width = 815
     Height = 124
     Caption = 'Simple Types'
@@ -164,7 +183,7 @@ object Form10: TForm10
   end
   object GroupBox2: TGroupBox
     Left = 8
-    Top = 146
+    Top = 178
     Width = 489
     Height = 159
     Caption = 'Returning Objects'
@@ -202,7 +221,7 @@ object Form10: TForm10
   end
   object GroupBox3: TGroupBox
     Left = 509
-    Top = 146
+    Top = 178
     Width = 314
     Height = 294
     Caption = 'Returning Datasets'
@@ -239,7 +258,7 @@ object Form10: TForm10
   end
   object GroupBox4: TGroupBox
     Left = 8
-    Top = 311
+    Top = 343
     Width = 489
     Height = 129
     Caption = 'Passing Objects as parameters'
@@ -298,7 +317,7 @@ object Form10: TForm10
   object DataSource1: TDataSource
     DataSet = FDMemTable1
     Left = 767
-    Top = 184
+    Top = 216
   end
   object FDMemTable1: TFDMemTable
     FetchOptions.AssignedValues = [evMode]
@@ -309,7 +328,7 @@ object Form10: TForm10
     UpdateOptions.CheckRequired = False
     UpdateOptions.AutoCommitUpdates = True
     Left = 767
-    Top = 248
+    Top = 280
     object FDMemTable1Code: TIntegerField
       FieldName = 'Code'
     end

samples/jsonrpc/MainClientFormU.pas

@@ -66,6 +66,7 @@ type
     btnInvalid2: TButton;
     btnNotification: TButton;
     btnInvalidMethod: TButton;
+    Label2: TLabel;
     procedure btnSubstractClick(Sender: TObject);
     procedure btnReverseStringClick(Sender: TObject);
     procedure edtGetCustomersClick(Sender: TObject);
@@ -138,25 +139,25 @@ end;
 
 procedure TForm10.btnInvalid1Click(Sender: TObject);
 var
-  lReq: IJSONRPCRequest;
+  lReq: IJSONRPCNotification;
   lResp: IJSONRPCResponse;
 begin
-  lReq := TJSONRPCRequest.Create;
+  lReq := TJSONRPCNotification.Create;
   lReq.Method := 'invalidmethod1';
   lReq.Params.Add(1);
-  lResp := FExecutor.ExecuteRequest(lReq);
+  lResp := FExecutor.ExecuteNotification(lReq);
   ShowMessage(lResp.Error.ErrMessage);
 end;
 
 procedure TForm10.btnInvalid2Click(Sender: TObject);
 var
-  lReq: IJSONRPCRequest;
+  lReq: IJSONRPCNotification;
   lResp: IJSONRPCResponse;
 begin
-  lReq := TJSONRPCRequest.Create;
+  lReq := TJSONRPCNotification.Create;
   lReq.Method := 'invalidmethod2';
   lReq.Params.Add(1);
-  lResp := FExecutor.ExecuteRequest(lReq);
+  lResp := FExecutor.ExecuteNotification(lReq);
   ShowMessage(lResp.Error.ErrMessage);
 end;
 

samples/jsonrpc_with_published_objects/MainClientFormU.dfm

@@ -420,6 +420,37 @@ object MainForm: TMainForm
         end
       end
     end
+    object TabSheet3: TTabSheet
+      Caption = 'Hooks Demo'
+      ImageIndex = 2
+      object btnDoNothing: TButton
+        Left = 24
+        Top = 24
+        Width = 145
+        Height = 33
+        Caption = 'Do Nothing'
+        TabOrder = 0
+        OnClick = btnDoNothingClick
+      end
+      object btnDoNothingError: TButton
+        Left = 24
+        Top = 63
+        Width = 145
+        Height = 33
+        Caption = 'Do Nothing With Errors'
+        TabOrder = 1
+        OnClick = btnDoNothingErrorClick
+      end
+      object btnNotExistent: TButton
+        Left = 24
+        Top = 102
+        Width = 145
+        Height = 33
+        Caption = 'Invalid Method'
+        TabOrder = 2
+        OnClick = btnNotExistentClick
+      end
+    end
   end
   object DataSource1: TDataSource
     DataSet = FDMemTable1

samples/jsonrpc_with_published_objects/MainClientFormU.pas

@@ -81,6 +81,10 @@ type
     Edit2: TEdit;
     btnSubtractWithNamedParams: TButton;
     Edit3: TEdit;
+    TabSheet3: TTabSheet;
+    btnDoNothing: TButton;
+    btnDoNothingError: TButton;
+    btnNotExistent: TButton;
     procedure btnSubstractClick(Sender: TObject);
     procedure btnReverseStringClick(Sender: TObject);
     procedure edtGetCustomersClick(Sender: TObject);
@@ -97,9 +101,13 @@ type
     procedure btnFloatsTestsClick(Sender: TObject);
     procedure btnWithJSONClick(Sender: TObject);
     procedure btnSubtractWithNamedParamsClick(Sender: TObject);
+    procedure btnDoNothingClick(Sender: TObject);
+    procedure btnNotExistentClick(Sender: TObject);
+    procedure btnDoNothingErrorClick(Sender: TObject);
   private
     FExecutor: IMVCJSONRPCExecutor;
     FExecutor2: IMVCJSONRPCExecutor;
+    FExecutor3: IMVCJSONRPCExecutor;
   public
     { Public declarations }
   end;
@@ -121,6 +129,7 @@ uses
 
 {$R *.dfm}
 
+
 procedure TMainForm.btnAddDayClick(Sender: TObject);
 var
   lReq: IJSONRPCRequest;
@@ -160,6 +169,22 @@ begin
 
 end;
 
+procedure TMainForm.btnDoNothingClick(Sender: TObject);
+var
+  lReq: IJSONRPCNotification;
+begin
+  lReq := TJSONRPCNotification.Create('DoSomething');
+  FExecutor3.ExecuteNotification(lReq);
+end;
+
+procedure TMainForm.btnDoNothingErrorClick(Sender: TObject);
+var
+  lReq: IJSONRPCNotification;
+begin
+  lReq := TJSONRPCNotification.Create('DoSomethingWithError');
+  FExecutor3.ExecuteNotification(lReq);
+end;
+
 procedure TMainForm.btnFloatsTestsClick(Sender: TObject);
 var
   lReq: IJSONRPCRequest;
@@ -209,25 +234,25 @@ end;
 
 procedure TMainForm.btnInvalid1Click(Sender: TObject);
 var
-  lReq: IJSONRPCRequest;
+  lReq: IJSONRPCNotification;
   lResp: IJSONRPCResponse;
 begin
-  lReq := TJSONRPCRequest.Create;
+  lReq := TJSONRPCNotification.Create;
   lReq.Method := 'invalidmethod1';
   lReq.Params.Add(1);
-  lResp := FExecutor.ExecuteRequest(lReq);
+  lResp := FExecutor.ExecuteNotification(lReq);
   ShowMessage(lResp.Error.ErrMessage);
 end;
 
 procedure TMainForm.btnInvalid2Click(Sender: TObject);
 var
-  lReq: IJSONRPCRequest;
+  lReq: IJSONRPCNotification;
   lResp: IJSONRPCResponse;
 begin
-  lReq := TJSONRPCRequest.Create;
+  lReq := TJSONRPCNotification.Create;
   lReq.Method := 'invalidmethod2';
   lReq.Params.Add(1);
-  lResp := FExecutor.ExecuteRequest(lReq);
+  lResp := FExecutor.ExecuteNotification(lReq);
   ShowMessage(lResp.Error.ErrMessage);
 end;
 
@@ -361,6 +386,14 @@ begin
   ShowMessage(lPerson.ToJSON(False));
 end;
 
+procedure TMainForm.btnNotExistentClick(Sender: TObject);
+var
+  lReq: IJSONRPCNotification;
+begin
+  lReq := TJSONRPCNotification.Create('blablabla');
+  FExecutor3.ExecuteNotification(lReq);
+end;
+
 procedure TMainForm.edtGetCustomersClick(Sender: TObject);
 var
   lReq: IJSONRPCRequest;
@@ -379,6 +412,8 @@ procedure TMainForm.FormCreate(Sender: TObject);
 begin
   FExecutor := TMVCJSONRPCExecutor.Create('http://localhost:8080/jsonrpc');
   FExecutor2 := TMVCJSONRPCExecutor.Create('http://localhost:8080/rpcdatamodule');
+  FExecutor3 := TMVCJSONRPCExecutor.Create('http://localhost:8080/jsonrpchooks');
+
   dtNextMonday.Date := Date;
 
   // these are the methods to handle http headers in JSONRPC
@@ -389,6 +424,7 @@ begin
   FExecutor.ClearHTTPHeaders;
   Assert(FExecutor.HTTPHeadersCount = 0);
   FExecutor.AddHTTPHeader(TNetHeader.Create('x-token', TGUID.NewGuid.ToString));
+  PageControl1.ActivePageIndex := 0;
 end;
 
 end.

samples/jsonrpc_with_published_objects/MainWebModuleU.pas

@@ -59,6 +59,12 @@ begin
       Result := TdmMain.Create(nil);
     end, '/rpcdatamodule');
 
+  FMVC.PublishObject(
+    function: TObject
+    begin
+      Result := TMyObjectWithHooks.Create;
+    end, '/jsonrpchooks');
+
   FMVC.AddMiddleware(TCORSMiddleware.Create());
 end;
 

samples/jsonrpc_with_published_objects/MyObjectU.pas

@@ -52,10 +52,10 @@ type
     function GetCustomersDataset: TFDMemTable;
     function GetPeopleDataset: TFDMemTable;
   public
-    procedure OnBeforeCall(const JSONRequest: TJDOJsonObject);
+    procedure OnBeforeCall(const Context: TWebContext; const JSONRequest: TJDOJsonObject);
-    procedure OnBeforeRouting(const JSON: TJDOJsonObject);
+    procedure OnBeforeRouting(const Context: TWebContext; const JSON: TJDOJsonObject);
-    procedure OnBeforeSendResponse(
+    procedure OnAfterCallHook(
-  const JSONResponse: TJDOJsonObject);
+  const Context: TWebContext; const JSONResponse: TJDOJsonObject);
   public
     [MVCDoc('You know, returns aValue1 - aValue2')]
     function Subtract(Value1, Value2: Integer): Integer;
@@ -79,6 +79,17 @@ type
 
   end;
 
+  TMyObjectWithHooks = class
+  public
+    // hooks
+    procedure OnBeforeRoutingHook(const Context: TWebContext; const JSON: TJsonObject);
+    procedure OnBeforeCallHook(const Context: TWebContext; const JSON: TJsonObject);
+    procedure OnAfterCallHook(const Context: TWebContext; const JSON: TJsonObject);
+    // dummy method
+    procedure DoSomething;
+    procedure DoSomethingWithError;
+  end;
+
   TUtils = class sealed
     class function JSONObjectAs<T: constructor, class>(const JSON: TJsonObject): T;
   end;
@@ -300,26 +311,53 @@ end;
 
 { TMyObjectWithHooks }
 
-procedure TMyObject.OnBeforeCall(const JSONRequest: TJDOJsonObject);
+procedure TMyObject.OnBeforeCall(const Context: TWebContext; const JSONRequest: TJDOJsonObject);
 begin
   Log.Info('TMyObjectWithHooks.OnBeforeCall >> ', 'jsonrpc');
   Log.Info(JSONRequest.ToJSON(false), 'jsonrpc');
   Log.Info('TMyObjectWithHooks.OnBeforeCall << ', 'jsonrpc');
 end;
 
-procedure TMyObject.OnBeforeRouting(const JSON: TJDOJsonObject);
+procedure TMyObject.OnBeforeRouting(const Context: TWebContext; const JSON: TJDOJsonObject);
 begin
   Log.Info('TMyObjectWithHooks.OnBeforeRouting >> ', 'jsonrpc');
   Log.Info(JSON.ToJSON(false), 'jsonrpc');
   Log.Info('TMyObjectWithHooks.OnBeforeRouting << ', 'jsonrpc');
 end;
 
-procedure TMyObject.OnBeforeSendResponse(
+procedure TMyObject.OnAfterCallHook(
-  const JSONResponse: TJDOJsonObject);
+  const Context: TWebContext; const JSONResponse: TJDOJsonObject);
 begin
   Log.Info('TMyObjectWithHooks.OnBeforeSendResponse >> ', 'jsonrpc');
   Log.Info(JSONResponse.ToJSON(false), 'jsonrpc');
   Log.Info('TMyObjectWithHooks.OnBeforeSendResponse << ', 'jsonrpc');
 end;
 
+{ TMyObjectWithHooks }
+
+procedure TMyObjectWithHooks.DoSomething;
+begin
+  // do nothing
+end;
+
+procedure TMyObjectWithHooks.DoSomethingWithError;
+begin
+  raise Exception.Create('Boom');
+end;
+
+procedure TMyObjectWithHooks.OnAfterCallHook(const Context: TWebContext; const JSON: TJsonObject);
+begin
+  // do nothing
+end;
+
+procedure TMyObjectWithHooks.OnBeforeCallHook(const Context: TWebContext; const JSON: TJsonObject);
+begin
+  // do nothing
+end;
+
+procedure TMyObjectWithHooks.OnBeforeRoutingHook(const Context: TWebContext; const JSON: TJsonObject);
+begin
+  // do nothing
+end;
+
 end.

samples/jsonrpc_with_published_objects/jsonrpcserverwithobjects.dpr

@@ -6,6 +6,7 @@ uses
   System.SysUtils,
   MVCFramework.Logger,
   MVCFramework.Commons,
+  MVCFramework.Console,
   MVCFramework.REPLCommandsHandlerU,
   Web.ReqMulti,
   Web.WebReq,
@@ -65,12 +66,17 @@ begin
     { more info about ListenQueue
       http://www.indyproject.org/docsite/html/frames.html?frmname=topic&frmfile=TIdCustomTCPServer_ListenQueue.html }
     LServer.ListenQueue := 200;
-
+    SaveColors;
+    TextColor(Yellow);
     WriteLn('Write "quit" or "exit" to shutdown the server');
+    RestoreSavedColors;
     repeat
       if lCmd.IsEmpty then
       begin
+        SaveColors;
+        TextColor(Green);
         Write('-> ');
+        RestoreSavedColors;
         ReadLn(lCmd)
       end;
       try
@@ -85,7 +91,10 @@ begin
             end;
           THandleCommandResult.Unknown:
             begin
+              SaveColors;
+              TextColor(Red);
               REPLEmit('Unknown command: ' + lCmd);
+              RestoreSavedColors;
             end;
         end;
       finally
@@ -101,6 +110,7 @@ end;
 begin
   ReportMemoryLeaksOnShutdown := True;
   IsMultiThread := True;
+  TextColor(TConsoleColor.White);
   try
     if WebRequestHandler <> nil then
       WebRequestHandler.WebModuleClass := WebModuleClass;

sources/MVCFramework.ActiveRecord.pas

@@ -58,7 +58,12 @@ type
   end;
 
   TMVCActiveRecordClass = class of TMVCActiveRecord;
-  TMVCActiveRecordFieldOption = (foPrimaryKey, foAutoGenerated, foTransient);
+  TMVCActiveRecordFieldOption = (
+    foPrimaryKey, { it's the primary key of the mapped table }
+    foAutoGenerated, { not written, read - similar to readonly }
+    foTransient, { not written, not read }
+    foReadOnly, { not written, read }
+    foWriteOnly); { written, not read }
   TMVCActiveRecordFieldOptions = set of TMVCActiveRecordFieldOption;
   TMVCEntityAction = (eaCreate, eaRetrieve, eaUpdate, eaDelete);
   TMVCEntityActions = set of TMVCEntityAction;
@@ -81,7 +86,7 @@ type
 
   TFieldInfo = class
   public
-//    TableName: string;
+    // TableName: string;
     FieldName: string;
     FieldOptions: TMVCActiveRecordFieldOptions;
     DataTypeName: string;
@@ -91,11 +96,13 @@ type
 
   TFieldsMap = class(TObjectDictionary<TRTTIField, TFieldInfo>)
   private
-    fNonTransientFieldsCount: Integer;
+    fWritableFieldsCount: Integer;
+    fReadableFieldsCount: Integer;
   public
     constructor Create;
     procedure EndUpdates;
-    property NonTransientFieldsCount: Integer read fNonTransientFieldsCount;
+    property WritableFieldsCount: Integer read fWritableFieldsCount;
+    property ReadableFieldsCount: Integer read fWritableFieldsCount;
     function GetInfoByFieldName(const FieldName: string): TFieldInfo;
   end;
 
@@ -155,7 +162,7 @@ type
     function GetPrimaryKeyIsAutogenerated: Boolean;
     procedure SetPrimaryKeyIsAutogenerated(const Value: Boolean);
     function GetPrimaryKeyFieldType: TFieldType;
-    procedure SetTableName(const Value: String);
+    procedure SetTableName(const Value: string);
   protected
     fRTTIType: TRttiInstanceType;
     fProps: TArray<TRTTIField>;
@@ -282,7 +289,7 @@ type
     procedure AddChildren(const ChildObject: TObject);
     procedure RemoveChildren(const ChildObject: TObject);
     [MVCDoNotSerialize]
-    property TableName: String read fTableName write SetTableName;
+    property TableName: string read fTableName write SetTableName;
     [MVCDoNotSerialize]
     property PrimaryKeyIsAutogenerated: Boolean read GetPrimaryKeyIsAutogenerated write SetPrimaryKeyIsAutogenerated;
     class function GetByPK(const aClass: TMVCActiveRecordClass; const aValue: int64;
@@ -452,7 +459,7 @@ type
     // end-capabilities
     function CreateSQLWhereByRQL(const RQL: string; const Mapping: TMVCFieldsMapping;
       const UseArtificialLimit: Boolean = True;
-      const UseFilterOnly: Boolean = False
+      const UseFilterOnly: Boolean = false
       ): string; virtual; abstract;
     function CreateSelectSQL(const TableName: string; const Map: TFieldsMap;
       const PKFieldName: string; const PKOptions: TMVCActiveRecordFieldOptions): string; virtual; abstract;
@@ -603,6 +610,13 @@ begin
   lName := aName.ToLower;
   lConnKeyName := GetKeyName(lName);
 
+  { If the transaction is not started, initialize TxIsolation as ReadCommitted }
+  if aConnection.Transaction = nil then
+  begin
+    { needed for Delphi 10.4 Sydney+ }
+    aConnection.TxOptions.Isolation := TFDTxIsolation.xiReadCommitted;
+  end;
+
   fMREW.BeginWrite;
   try
     lConnHolder := TConnHolder.Create;
@@ -955,7 +969,7 @@ begin
           begin
             fPrimaryKeyFieldType := ftLargeInt;
           end
-          else if lPrimaryFieldTypeAsStr.EndsWith('integer') then
+          else if lPrimaryFieldTypeAsStr.EndsWith('integer') or lPrimaryFieldTypeAsStr.EndsWith('int32') then
           begin
             fPrimaryKeyFieldType := ftInteger;
           end
@@ -975,9 +989,8 @@ begin
           continue;
         end;
 
-        { TODO -oDanieleT -cGeneral : Definire TFieldInfo per tute le info del field }
         lFieldInfo := TFieldInfo.Create;
-        //lFieldInfo.TableName := fTableName;
+        // lFieldInfo.TableName := fTableName;
         lFieldInfo.FieldName := MVCTableFieldAttribute(lAttribute).FieldName;
         lFieldInfo.FieldOptions := MVCTableFieldAttribute(lAttribute).FieldOptions;
         lFieldInfo.DataTypeName := MVCTableFieldAttribute(lAttribute).DataTypeName;
@@ -1010,10 +1023,11 @@ begin
   OnValidation(TMVCEntityAction.eaCreate);
   OnBeforeInsert;
   OnBeforeInsertOrUpdate;
-  if fMap.NonTransientFieldsCount = 0 then
+  if fMap.WritableFieldsCount = 0 then
   begin
     raise EMVCActiveRecord.CreateFmt
-      ('Cannot insert an entity if all fields are transient. Class [%s] mapped on table [%s]', [ClassName, fTableName]);
+      ('Cannot insert an entity if all fields are not writable or transient. Class [%s] mapped on table [%s]',
+      [ClassName, fTableName]);
   end;
   if (foAutoGenerated in fPrimaryKeyOptions) then
   begin
@@ -1049,7 +1063,7 @@ begin
   lSQL := Self.SQLGenerator.CreateSelectCount(fTableName);
   if not RQL.IsEmpty then
   begin
-    lSQL := lSQL + fSQLGenerator.CreateSQLWhereByRQL(RQL, GetMapping, False, True);
+    lSQL := lSQL + fSQLGenerator.CreateSQLWhereByRQL(RQL, GetMapping, false, True);
   end;
   Result := GetScalar(lSQL, []);
 end;
@@ -1135,19 +1149,24 @@ class function TMVCActiveRecordHelper.GetByPK<T>(const aValue: int64;
   const RaiseExceptionIfNotFound: Boolean = True): T;
 var
   lActiveRecord: TMVCActiveRecord;
+  lLoaded: Boolean;
 begin
   Result := T.Create;
   lActiveRecord := TMVCActiveRecord(Result);
-  if not lActiveRecord.LoadByPK(aValue) then
+
+  try
+    lLoaded := lActiveRecord.LoadByPK(aValue);
+  except
+    FreeAndNil(Result);
+    raise;
+  end;
+
+  if not lLoaded then
   begin
-    Result.Free;
+    FreeAndNil(Result);
     if RaiseExceptionIfNotFound then
     begin
       raise EMVCActiveRecordNotFound.Create('Data not found');
-    end
-    else
-    begin
-      Result := nil;
     end;
   end;
 end;
@@ -2176,23 +2195,14 @@ begin
   if fPrimaryKey.GetValue(Self).Kind = tkRecord then
   begin
     lPKValue := fPrimaryKey.GetValue(Self);
-    if lPKValue.IsType<NullableInt32> then
+    if lPKValue.IsType<NullableInt32> and aValue.IsType<NullableInt32>() then
     begin
       if aValue.IsType<UInt32> then
       begin
         lPKValue := TValue.From<NullableInt32>(IntToNullableInt(aValue.AsInteger));
       end;
-      //
-      // if aValue.AsType<NullableInt32>().HasValue then
-      // begin
-      // lPKValue := aValue;
-      // end
-      // else
-      // begin
-      // lPKValue.AsType<NullableInt32>().Clear;
-      // end;
     end
-    else if lPKValue.IsType<NullableInt64> then
+    else if lPKValue.IsType<NullableInt64> and aValue.IsType<NullableInt64>() then
     begin
       if aValue.AsType<NullableInt64>().HasValue then
       begin
@@ -2203,7 +2213,18 @@ begin
         lPKValue.AsType<NullableInt64>().Clear;
       end;
     end
-    else if lPKValue.IsType<NullableUInt32> then
+    else if lPKValue.IsType<NullableString> and aValue.IsType<NullableString>() then
+    begin
+      if aValue.AsType<NullableString>().HasValue then
+      begin
+        lPKValue := aValue;
+      end
+      else
+      begin
+        lPKValue.AsType<NullableString>().Clear;
+      end;
+    end
+    else if lPKValue.IsType<NullableUInt32> and aValue.IsType<NullableUInt32>() then
     begin
       if aValue.AsType<NullableUInt32>().HasValue then
       begin
@@ -2214,7 +2235,7 @@ begin
         lPKValue.AsType<NullableUInt32>().Clear;
       end;
     end
-    else if lPKValue.IsType<NullableUInt64> then
+    else if lPKValue.IsType<NullableUInt64> and aValue.IsType<NullableUInt64>() then
     begin
       if aValue.AsType<NullableUInt64>().HasValue then
       begin
@@ -2226,7 +2247,9 @@ begin
       end;
     end
     else
-      raise EMVCActiveRecord.Create('Invalid type for primary key');
+    begin
+      raise EMVCActiveRecord.Create('Invalid type for primary key [HINT] Double check if TypeInfo(PK) is equal to TypeInfo(Value)');
+    end;
     fPrimaryKey.SetValue(Self, lPKValue);
   end
   else
@@ -2247,7 +2270,7 @@ begin
   end;
 end;
 
-procedure TMVCActiveRecord.SetTableName(const Value: String);
+procedure TMVCActiveRecord.SetTableName(const Value: string);
 begin
   fTableName := Value;
 end;
@@ -2361,7 +2384,7 @@ begin
   OnValidation(TMVCEntityAction.eaUpdate);
   OnBeforeUpdate;
   OnBeforeInsertOrUpdate;
-  if fMap.NonTransientFieldsCount = 0 then
+  if fMap.WritableFieldsCount = 0 then
   begin
     raise EMVCActiveRecord.CreateFmt
       ('Cannot update an entity if all fields are transient. Class [%s] mapped on table [%s]', [ClassName, fTableName]);
@@ -2378,7 +2401,7 @@ begin
   begin
     fChildren := TObjectList<TObject>.Create(True);
   end;
-  if not(fChildren.Contains(ChildObject)) and (not (ChildObject = Self)) then
+  if not(fChildren.Contains(ChildObject)) and (not(ChildObject = Self)) then
   begin
     fChildren.Add(ChildObject);
   end;
@@ -2659,7 +2682,14 @@ begin
   Result := Copy(Result, 1, Length(Result) - Length(Delimiter));
   if not PKFieldName.IsEmpty then
   begin
-    Result := GetFieldNameForSQL(PKFieldName) + ', ' + Result;
+    if not Result.IsEmpty then
+    begin
+      Result := GetFieldNameForSQL(PKFieldName) + ', ' + Result
+    end
+    else
+    begin
+      Result := GetFieldNameForSQL(PKFieldName)
+    end;
   end;
 end;
 
@@ -2744,20 +2774,27 @@ end;
 constructor TFieldsMap.Create;
 begin
   inherited Create([doOwnsValues]);
-  fNonTransientFieldsCount := 0;
+  fWritableFieldsCount := -1;
+  fReadableFieldsCount := -1;
 end;
 
 procedure TFieldsMap.EndUpdates;
 var
   lPair: TPair<TRTTIField, TFieldInfo>;
 begin
-  fNonTransientFieldsCount := 0;
+  fWritableFieldsCount := 0;
+  fReadableFieldsCount := 0;
   for lPair in Self do
   begin
     lPair.Value.EndUpdates;
-    if not(foTransient in lPair.Value.FieldOptions) then
+    // if not(foTransient in lPair.Value.FieldOptions) then
+    if lPair.Value.Writeable then
     begin
-      Inc(fNonTransientFieldsCount);
+      Inc(fWritableFieldsCount);
+    end;
+    if lPair.Value.Readable then
+    begin
+      Inc(fReadableFieldsCount);
     end;
   end;
 end;
@@ -2781,8 +2818,18 @@ end;
 
 procedure TFieldInfo.EndUpdates;
 begin
-  Writeable := (not FieldName.IsEmpty) and (not((foAutoGenerated in FieldOptions) or (foTransient in FieldOptions)));
+  if FieldName.IsEmpty then
-  Readable := not(foTransient in FieldOptions) and (not FieldName.IsEmpty);
+  begin
+    Writeable := false;
+    Readable := false;
+  end
+  else
+  begin
+    // Writeable := (not (foReadOnly in FieldOptions)) and (not((foAutoGenerated in FieldOptions) or (foTransient in FieldOptions)));
+    Writeable := ((FieldOptions * [foReadOnly, foTransient, foAutoGenerated]) = []);
+    // Readable := (not (foWriteOnly in FieldOptions)) and (not(foTransient in FieldOptions));
+    Readable := (FieldOptions * [foWriteOnly, foTransient]) = [];
+  end;
 end;
 
 initialization

sources/MVCFramework.JSONRPC.Client.pas

@@ -38,7 +38,8 @@ type
   IMVCJSONRPCExecutor = interface
     ['{55415094-9D28-4707-AEC5-5FCF925E82BC}']
     function ExecuteRequest(const aJSONRPCRequest: IJSONRPCRequest): IJSONRPCResponse;
-    procedure ExecuteNotification(const aJSONRPCNotification: IJSONRPCNotification);
+    function ExecuteNotification(const aJSONRPCNotification: IJSONRPCNotification): IJSONRPCResponse;
+    function HTTPResponse: IHTTPResponse;
     // Http headers handling
     procedure AddHTTPHeader(const aNetHeader: TNetHeader);
     procedure ClearHTTPHeaders;
@@ -56,17 +57,19 @@ type
 
   TMVCJSONRPCExecutor = class(TInterfacedObject, IMVCJSONRPCExecutor)
   private
-    FURL: string;
+    fURL: string;
-    FHTTP: THTTPClient;
+    fHTTP: THTTPClient;
-    FRaiseExceptionOnError: Boolean;
+    fRaiseExceptionOnError: Boolean;
-    FHTTPRequestHeaders: TList<TNetHeader>;
+    fHTTPRequestHeaders: TList<TNetHeader>;
+    fHTTPResponse: IHTTPResponse;
     fOnReceiveResponse: TProc<IJSONRPCObject, IJSONRPCObject>;
     fOnSendCommand: TProc<IJSONRPCObject>;
     function GetHTTPRequestHeaders: TList<TNetHeader>;
   protected
+    function HTTPResponse: IHTTPResponse;
     function InternalExecute(const aJSONRPCObject: IJSONRPCObject): IJSONRPCResponse;
     function ExecuteRequest(const aJSONRPCRequest: IJSONRPCRequest): IJSONRPCResponse;
-    procedure ExecuteNotification(const aJSONRPCNotification: IJSONRPCNotification);
+    function ExecuteNotification(const aJSONRPCNotification: IJSONRPCNotification): IJSONRPCResponse;
     // Http headers handling
     procedure AddHTTPHeader(const aNetHeader: TNetHeader);
     procedure ClearHTTPHeaders;
@@ -128,26 +131,26 @@ end;
 
 procedure TMVCJSONRPCExecutor.ClearHTTPHeaders;
 begin
-  if Assigned(FHTTPRequestHeaders) then
+  if Assigned(fHTTPRequestHeaders) then
   begin
-    FHTTPRequestHeaders.Clear;
+    fHTTPRequestHeaders.Clear;
   end;
 end;
 
 function TMVCJSONRPCExecutor.ConfigureHTTPClient(
   const aConfigProc: TProc<THTTPClient>): IMVCJSONRPCExecutor;
 begin
-  aConfigProc(FHTTP);
+  aConfigProc(fHTTP);
 end;
 
 constructor TMVCJSONRPCExecutor.Create(const aURL: string; const aRaiseExceptionOnError: Boolean = True);
 begin
   inherited Create;
-  FRaiseExceptionOnError := aRaiseExceptionOnError;
+  fRaiseExceptionOnError := aRaiseExceptionOnError;
-  FURL := aURL;
+  fURL := aURL;
-  FHTTP := THTTPClient.Create;
+  fHTTP := THTTPClient.Create;
-  FHTTP.ResponseTimeout := MaxInt;
+  fHTTP.ResponseTimeout := MaxInt;
-  FHTTPRequestHeaders := nil;
+  fHTTPRequestHeaders := nil;
   SetOnReceiveResponse(nil)
     .SetOnReceiveData(nil)
     .SetOnNeedClientCertificate(nil)
@@ -156,15 +159,24 @@ end;
 
 destructor TMVCJSONRPCExecutor.Destroy;
 begin
-  FHTTP.Free;
+  fHTTP.Free;
-  FHTTPRequestHeaders.Free;
+  fHTTPRequestHeaders.Free;
   inherited;
 end;
 
-procedure TMVCJSONRPCExecutor.ExecuteNotification(const aJSONRPCNotification: IJSONRPCNotification);
+function TMVCJSONRPCExecutor.ExecuteNotification(const aJSONRPCNotification: IJSONRPCNotification): IJSONRPCResponse;
+// var
+// lResp: IJSONRPCResponse;
 begin
-  if InternalExecute(aJSONRPCNotification as TJSONRPCObject) <> nil then
+  Result := InternalExecute(aJSONRPCNotification as TJSONRPCObject);
-    raise EMVCJSONRPCException.Create('A "notification" cannot returns a response. Use ExecuteRequest instead.');
+  // if Assigned(lResp) then
+  // begin
+  //
+  // end;
+  // if InternalExecute(aJSONRPCNotification as TJSONRPCObject) <> nil then
+  // begin
+  // raise EMVCJSONRPCException.Create('A "notification" cannot returns a response. Use ExecuteRequest instead.');
+  // end;
 end;
 
 function TMVCJSONRPCExecutor.ExecuteRequest(const aJSONRPCRequest: IJSONRPCRequest): IJSONRPCResponse;
@@ -174,18 +186,18 @@ end;
 
 function TMVCJSONRPCExecutor.GetHTTPRequestHeaders: TList<TNetHeader>;
 begin
-  if not Assigned(FHTTPRequestHeaders) then
+  if not Assigned(fHTTPRequestHeaders) then
   begin
-    FHTTPRequestHeaders := TList<TNetHeader>.Create;
+    fHTTPRequestHeaders := TList<TNetHeader>.Create;
   end;
-  Result := FHTTPRequestHeaders;
+  Result := fHTTPRequestHeaders;
 end;
 
 function TMVCJSONRPCExecutor.HTTPHeadersCount: Integer;
 begin
-  if Assigned(FHTTPRequestHeaders) then
+  if Assigned(fHTTPRequestHeaders) then
   begin
-    Result := FHTTPRequestHeaders.Count;
+    Result := fHTTPRequestHeaders.Count;
   end
   else
   begin
@@ -201,9 +213,9 @@ var
   lCustomHeaders: TNetHeaders;
 begin
   lCustomHeaders := [];
-  if Assigned(FHTTPRequestHeaders) then
+  if Assigned(fHTTPRequestHeaders) then
   begin
-    lCustomHeaders := FHTTPRequestHeaders.ToArray;
+    lCustomHeaders := fHTTPRequestHeaders.ToArray;
   end;
 
   Result := nil;
@@ -214,37 +226,49 @@ begin
     begin
       fOnSendCommand(aJSONRPCObject);
     end;
-    lHttpResp := FHTTP.Post(FURL, lSS, nil, [TNetHeader.Create('content-type', 'application/json;charset=utf8'),
+    fHTTPResponse := nil;
+    lHttpResp := fHTTP.Post(fURL, lSS, nil, [TNetHeader.Create('content-type', 'application/json;charset=utf8'),
       TNetHeader.Create('accept', 'application/json;charset=utf8')] + lCustomHeaders);
-    if (lHttpResp.StatusCode <> HTTP_STATUS.NoContent) then
+    fHTTPResponse := lHttpResp;
+    if lHttpResp.StatusCode = HTTP_STATUS.NoContent then
+    begin
+      lJSONRPCResponse := TJSONRPCNullResponse.Create;
+    end
+    else
     begin
       lJSONRPCResponse := TJSONRPCResponse.Create;
       lJSONRPCResponse.AsJSONString := lHttpResp.ContentAsString;
-      if Assigned(fOnReceiveResponse) then
-      begin
-        fOnReceiveResponse(aJSONRPCObject, lJSONRPCResponse);
-      end;
-      if Assigned(lJSONRPCResponse.Error) and FRaiseExceptionOnError then
-        raise EMVCJSONRPCException.CreateFmt('[REMOTE EXCEPTION][%d]: %s',
-          [lJSONRPCResponse.Error.Code, lJSONRPCResponse.Error.ErrMessage]);
-      Result := lJSONRPCResponse;
     end;
+    if Assigned(fOnReceiveResponse) then
+    begin
+      fOnReceiveResponse(aJSONRPCObject, lJSONRPCResponse);
+    end;
+    fHTTPResponse := lHttpResp;
+    if Assigned(lJSONRPCResponse.Error) and fRaiseExceptionOnError then
+      raise EMVCJSONRPCException.CreateFmt('[REMOTE EXCEPTION][%d]: %s',
+        [lJSONRPCResponse.Error.Code, lJSONRPCResponse.Error.ErrMessage]);
+    Result := lJSONRPCResponse;
   finally
     lSS.Free;
   end;
 end;
 
+function TMVCJSONRPCExecutor.HTTPResponse: IHTTPResponse;
+begin
+  Result := fHTTPResponse;
+end;
+
 function TMVCJSONRPCExecutor.SetOnNeedClientCertificate(const aOnNeedClientCertificate: TNeedClientCertificateEvent)
   : IMVCJSONRPCExecutor;
 begin
-  FHTTP.OnNeedClientCertificate := aOnNeedClientCertificate;
+  fHTTP.OnNeedClientCertificate := aOnNeedClientCertificate;
   Result := Self;
 end;
 
 function TMVCJSONRPCExecutor.SetOnReceiveData(
   const aOnReceiveData: TReceiveDataEvent): IMVCJSONRPCExecutor;
 begin
-  FHTTP.OnReceiveData := aOnReceiveData;
+  fHTTP.OnReceiveData := aOnReceiveData;
   Result := Self;
 end;
 
@@ -265,7 +289,7 @@ end;
 function TMVCJSONRPCExecutor.SetOnValidateServerCertificate(const aOnValidateServerCertificate
   : TValidateCertificateEvent): IMVCJSONRPCExecutor;
 begin
-  FHTTP.OnValidateServerCertificate := aOnValidateServerCertificate;
+  fHTTP.OnValidateServerCertificate := aOnValidateServerCertificate;
   Result := Self;
 end;
 

sources/MVCFramework.JSONRPC.pas

@@ -58,9 +58,9 @@ const
 const
   JSONRPC_HOOKS_ON_BEFORE_ROUTING = 'OnBeforeRoutingHook';
   JSONRPC_HOOKS_ON_BEFORE_CALL = 'OnBeforeCallHook';
-  JSONRPC_HOOKS_ON_BEFORE_SEND_RESPONSE = 'OnBeforeSendResponseHook';
+  JSONRPC_HOOKS_ON_AFTER_CALL = 'OnAfterCallHook';
   JSONRPC_HOOKS_METHOD_NAMES: array [0 .. 2] of string = (JSONRPC_HOOKS_ON_BEFORE_ROUTING,
-    JSONRPC_HOOKS_ON_BEFORE_CALL, JSONRPC_HOOKS_ON_BEFORE_SEND_RESPONSE);
+    JSONRPC_HOOKS_ON_BEFORE_CALL, JSONRPC_HOOKS_ON_AFTER_CALL);
 
   {
     http://www.jsonrpc.org/historical/json-rpc-over-http.html#response-codes
@@ -261,8 +261,8 @@ type
     FResult: TValue;
     FError: TJSONRPCResponseError;
     FID: TValue;
-    function GetResult: TValue;
   protected
+    function GetResult: TValue;
     function GetJSON: TJDOJsonObject; override;
     procedure SetJSON(const JSON: TJDOJsonObject); override;
     procedure SetID(const Value: TValue);
@@ -281,6 +281,29 @@ type
     destructor Destroy; override;
   end;
 
+  TJSONRPCNullResponse = class(TJSONRPCObject, IJSONRPCResponse)
+  private
+    FError: TJSONRPCResponseError;
+    procedure RaiseErrorForNullObject;
+  protected
+    function GetJSONString: string; override;
+    procedure SetJsonString(const Value: string); override;
+    function GetJSON: TJDOJsonObject; override;
+    procedure SetJSON(const JSON: TJDOJsonObject); override;
+    procedure SetID(const Value: TValue);
+    procedure SetResult(const Value: TValue);
+    procedure SetError(const Value: TJSONRPCResponseError);
+    function GetError: TJSONRPCResponseError;
+    function GetID: TValue;
+    function GetResult: TValue;
+    function ResultAsJSONObject: TJDOJsonObject;
+    function ResultAsJSONArray: TJDOJsonArray;
+    function IsError: Boolean;
+    property Result: TValue read GetResult write SetResult;
+    property Error: TJSONRPCResponseError read GetError write SetError;
+    property RequestID: TValue read GetID write SetID;
+  end;
+
   EMVCJSONRPCInvalidVersion = class(Exception)
 
   end;
@@ -357,7 +380,7 @@ type
     function CanBeRemotelyInvoked(const RTTIMethod: TRTTIMethod): Boolean;
     procedure ForEachInvokableMethod(const aProc: TProc<TRTTIMethod>);
     procedure TryToCallMethod(const aRTTIType: TRttiType; const MethodName: string;
-      const Parameter: TJDOJsonObject; const ParameterName: string);
+      const Parameter: TJDOJsonObject);
   public
     [MVCPath]
     [MVCHTTPMethods([httpPOST])]
@@ -984,6 +1007,7 @@ var
   lClass: TJSONRPCProxyGeneratorClass;
   lGenerator: TJSONRPCProxyGenerator;
   lRTTI: TRTTIContext;
+  lContentType: string;
 begin
   lLanguage := Context.Request.Params['language'].ToLower;
   if lLanguage.IsEmpty then
@@ -991,6 +1015,15 @@ begin
     lLanguage := 'delphi';
   end;
 
+  if Context.Request.QueryStringParamExists('content-type') then
+  begin
+    lContentType := Context.Request.Params['content-type'];
+  end
+  else
+  begin
+    lContentType := 'text/plain';
+  end;
+
   if not Assigned(GProxyGeneratorsRegister) then
   begin
     raise EMVCJSONRPCException.Create
@@ -1013,7 +1046,7 @@ begin
           lGenerator.VisitMethod(aRTTIMethod);
         end);
       lGenerator.EndGeneration();
-      Context.Response.ContentType := 'text/plain';
+      Context.Response.ContentType := lContentType;
       Render(lGenerator.GetCode);
     finally
       lRTTI.Free;
@@ -1069,7 +1102,11 @@ var
   lReqID: TValue;
   lJSON: TJDOJsonObject;
   lJSONResp: TJDOJsonObject;
+  lBeforeCallHookHasBeenInvoked: Boolean;
+  lAfterCallHookHasBeenInvoked: Boolean;
 begin
+  lBeforeCallHookHasBeenInvoked := False;
+  lAfterCallHookHasBeenInvoked := False;
   lRTTIType := nil;
   lReqID := TValue.Empty;
   SetLength(lParamsToInject, 0);
@@ -1079,20 +1116,21 @@ begin
       lJSON := StrToJSONObject(Context.Request.Body);
       try
         if not Assigned(lJSON) then
+        begin
           raise EMVCJSONRPCParseError.Create;
+        end;
         lRTTIType := lRTTI.GetType(fRPCInstance.ClassType);
-        TryToCallMethod(lRTTIType, JSONRPC_HOOKS_ON_BEFORE_ROUTING, lJSON, 'JSON');
         lJSONRPCReq := CreateRequest(lJSON);
         lMethod := lJSONRPCReq.Method;
 
-        if SameText(lMethod, JSONRPC_HOOKS_ON_BEFORE_ROUTING) or
+        if IsReservedMethodName(lMethod) then
-          SameText(lMethod, JSONRPC_HOOKS_ON_BEFORE_CALL) or
-          SameText(lMethod, JSONRPC_HOOKS_ON_BEFORE_SEND_RESPONSE) then
         begin
-          raise EMVCJSONRPCInvalidRequest.Create
+          raise EMVCJSONRPCInvalidRequest.CreateFmt
-            ('Requested method name is reserved and cannot be called remotely');
+            ('Requested method name [%s] is reserved and cannot be called remotely', [lMethod]);
         end;
 
+        TryToCallMethod(lRTTIType, JSONRPC_HOOKS_ON_BEFORE_ROUTING, lJSON);
+
         if lJSONRPCReq.RequestType = TJSONRPCRequestType.Request then
         begin
           if lJSONRPCReq.RequestID.IsEmpty then
@@ -1108,14 +1146,6 @@ begin
 
         if Assigned(lRTTIMethod) then
         begin
-          if not CanBeRemotelyInvoked(lRTTIMethod) then
-          begin
-            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
@@ -1130,6 +1160,14 @@ begin
               ('Cannot call a function using a JSON-RPC notification. [HINT] Use requests for functions and notifications for procedures');
           end;
 
+          if not CanBeRemotelyInvoked(lRTTIMethod) then
+          begin
+            LogW(Format
+              ('Method [%s] cannot remotely invoked. Only public functions or procedures can be called.',
+              [lMethod]));
+            raise EMVCJSONRPCMethodNotFound.Create(lMethod);
+          end;
+
           try
             lJSONRPCReq.FillParameters(lJSON, lRTTIMethod);
           except
@@ -1140,9 +1178,13 @@ begin
             end;
           end;
 
+          lJSONResp := nil;
+          // try
+          TryToCallMethod(lRTTIType, JSONRPC_HOOKS_ON_BEFORE_CALL, lJSON);
+          lBeforeCallHookHasBeenInvoked := True;
           try
-            TryToCallMethod(lRTTIType, JSONRPC_HOOKS_ON_BEFORE_CALL, lJSON, 'JSONRequest');
+            LogD('[JSON-RPC][CALL][' + CALL_TYPE[lRTTIMethod.MethodKind] + '][' + fRPCInstance.ClassName + '.' +
-            LogD('[JSON-RPC][CALL][' + CALL_TYPE[lRTTIMethod.MethodKind] + '] ' + lRTTIMethod.Name);
+              lRTTIMethod.Name + ']');
             lRes := lRTTIMethod.Invoke(fRPCInstance, lJSONRPCReq.Params.ToArray);
           except
             on E: EInvalidCast do
@@ -1165,21 +1207,30 @@ begin
                 lJSONRPCResponse := CreateResponse(lJSONRPCReq.RequestID, lRes);
                 ResponseStatus(200);
                 lJSONResp := lJSONRPCResponse.AsJSON;
-                try
-                  TryToCallMethod(lRTTIType, JSONRPC_HOOKS_ON_BEFORE_SEND_RESPONSE, lJSONResp,
-                    'JSONResponse');
-                  Render(lJSONResp);
-                except
-                  try
-                    lJSONResp.Free;
-                  except
-                    // do nothing
-                  end;
-                end;
               end;
           else
             raise EMVCJSONRPCException.Create('Invalid RequestType');
           end;
+
+          // finally
+          // if lBeforeCallHookHasBeenInvoked then
+          // begin
+          // TryToCallMethod(lRTTIType, JSONRPC_HOOKS_ON_AFTER_CALL, lJSONResp);
+          // lAfterCallHookHasBeenInvoked := True;
+          // end;
+          // if lJSONResp <> nil then
+          // begin
+          // try
+          // Render(lJSONResp);
+          // except
+          // try
+          // lJSONResp.Free;
+          // except
+          // // do nothing
+          // end;
+          // end;
+          // end;
+          // end;
         end
         else
         begin
@@ -1187,9 +1238,8 @@ begin
             [lMethod, fRPCInstance.QualifiedClassName]));
           raise EMVCJSONRPCMethodNotFound.Create(lMethod);
         end;
-
       finally
-        lJSON.Free;
+        FreeAndNil(lJSON);
       end;
     except
       on E: EMVCJSONRPCErrorResponse do
@@ -1218,28 +1268,33 @@ begin
           JSONRPC_ERR_SERVER_ERROR_LOWERBOUND .. JSONRPC_ERR_SERVER_ERROR_UPPERBOUND:
             ResponseStatus(500);
         end;
-        lJSON := CreateError(lReqID, E.JSONRPCErrorCode, E.Message);
+        lJSONResp := CreateError(lReqID, E.JSONRPCErrorCode, E.Message);
-        try
-          TryToCallMethod(lRTTIType, JSONRPC_HOOKS_ON_BEFORE_SEND_RESPONSE, lJSON, 'JSONResponse');
-          Render(lJSON, False);
-        finally
-          lJSON.Free;
-        end;
         LogE(Format('[JSON-RPC][CLS %s][ERR %d][MSG "%s"]', [E.ClassName, E.JSONRPCErrorCode,
           E.Message]));
       end;
       on Ex: Exception do // use another name for exception variable, otherwise E is nil!!
       begin
-        lJSON := CreateError(lReqID, 0, Ex.Message);
+        lJSONResp := CreateError(lReqID, 0, Ex.Message);
-        try
-          TryToCallMethod(lRTTIType, JSONRPC_HOOKS_ON_BEFORE_SEND_RESPONSE, lJSON, 'JSONResponse');
-          Render(lJSON, False);
-        finally
-          lJSON.Free;
-        end;
         LogE(Format('[JSON-RPC][CLS %s][MSG "%s"]', [Ex.ClassName, Ex.Message]));
       end;
+    end; // except
+
+    if lBeforeCallHookHasBeenInvoked and (not lAfterCallHookHasBeenInvoked) then
+    begin
+      try
+        TryToCallMethod(lRTTIType, JSONRPC_HOOKS_ON_AFTER_CALL, lJSONResp);
+      except
+        on E: Exception do
+        begin
+          FreeAndNil(lJSONResp);
+          if E is EMVCJSONRPCErrorResponse then
+            lJSONResp := CreateError(lReqID, EMVCJSONRPCErrorResponse(E).JSONRPCErrorCode, E.Message)
+          else
+            lJSONResp := CreateError(lReqID, 0, E.Message);
+        end;
+      end;
     end;
+    Render(lJSONResp, True);
   finally
     lRTTI.Free;
   end;
@@ -1257,12 +1312,13 @@ begin
 end;
 
 procedure TMVCJSONRPCController.TryToCallMethod(const aRTTIType: TRttiType;
-const MethodName: string; const Parameter: TJDOJsonObject; const ParameterName: string);
+const MethodName: string; const Parameter: TJDOJsonObject);
 var
   lHookMethod: TRTTIMethod;
-  lHookParam: TRttiParameter;
+  lHookSecondParam: TRttiParameter;
-  lHookParamParamType: string;
+  lHookSecondParamType: string;
-  lHookParamName: string;
+  lHookFirstParam: TRttiParameter;
+  lHookFirstParamType: string;
 begin
   if not Assigned(aRTTIType) then
   begin
@@ -1271,20 +1327,38 @@ begin
   lHookMethod := aRTTIType.GetMethod(MethodName);
   if Assigned(lHookMethod) then
   begin
-    if (Length(lHookMethod.GetParameters) <> 1) then
+    if (Length(lHookMethod.GetParameters) <> 2) then
+    begin
       raise EMVCJSONRPCException.CreateFmt('Invalid signature for [%s] Hook method [HINT: procedure '
-        + '%s.%s(const %s: TJDOJsonObject)', [MethodName, fRPCInstance.ClassName, MethodName,
+        + '%s.%s(const Context: TWebContext; const Value: TJDOJsonObject)',
-        ParameterName]);
+        [MethodName, fRPCInstance.ClassName, MethodName]);
-    lHookParam := lHookMethod.GetParameters[0];
+    end;
-    lHookParamParamType := lHookParam.ParamType.ToString.ToLower;
+
-    lHookParamName := lHookParam.Name.ToLower;
+    lHookFirstParam := lHookMethod.GetParameters[0];
-    if ((lHookParamParamType <> 'tjdojsonobject') and (lHookParamParamType <> 'tjsonobject')) or
+    lHookSecondParam := lHookMethod.GetParameters[1];
-      (lHookParam.Flags * [pfConst, pfAddress] <> [pfConst, pfAddress]) or
+
-      (lHookParamName <> ParameterName.ToLower) then
+    lHookFirstParamType := lHookFirstParam.ParamType.ToString.ToLower;
+    lHookSecondParamType := lHookSecondParam.ParamType.ToString.ToLower;
+
+    if (lHookMethod.MethodKind <> mkProcedure) then
+      raise EMVCJSONRPCException.CreateFmt('Invalid signature for [%s] Hook method [HINT: Hook methods MUST have the following signature "procedure '
+        + '%s.%s(const Context: TWebContext; const Value: TJDOJsonObject)"',
+        [MethodName, fRPCInstance.ClassName, MethodName]);
+
+    if ((lHookSecondParamType <> 'tjdojsonobject') and (lHookSecondParamType <> 'tjsonobject')) or
+      (lHookSecondParam.Flags * [pfConst, pfAddress] <> [pfConst, pfAddress]) then
       raise EMVCJSONRPCException.CreateFmt('Invalid signature for [%s] Hook method [HINT: procedure '
-        + '%s.%s(const %s: TJDOJsonObject)', [MethodName, fRPCInstance.ClassName, MethodName,
+        + '%s.%s(const Context: TWebContext; const Value: TJDOJsonObject)',
-        ParameterName]);
+        [MethodName, fRPCInstance.ClassName, MethodName]);
-    lHookMethod.Invoke(fRPCInstance, [Parameter])
+
+    if (lHookFirstParamType <> 'twebcontext') or
+      (lHookFirstParam.Flags * [pfConst, pfAddress] <> [pfConst, pfAddress]) then
+      raise EMVCJSONRPCException.CreateFmt('Invalid signature for [%s] Hook method [HINT: procedure '
+        + '%s.%s(const Context: TWebContext; const Value: TJDOJsonObject)',
+        [MethodName, fRPCInstance.ClassName, MethodName]);
+
+    LogD('[JSON-RPC][HOOK][' + fRPCInstance.ClassName + '.' + MethodName + ']');
+    lHookMethod.Invoke(fRPCInstance, [Self.Context, Parameter])
   end;
 end;
 
@@ -1387,6 +1461,7 @@ end;
 constructor TJSONRPCRequest.Create;
 begin
   inherited Create;
+  Self.FID := TValue.Empty;
 end;
 
 destructor TJSONRPCRequest.Destroy;
@@ -1798,24 +1873,32 @@ end;
 function TJSONRPCRequest.GetJSON: TJDOJsonObject;
 begin
   Result := inherited GetJSON;
-  if not FID.IsEmpty then
+  try
-  begin
+    if not FID.IsEmpty then
-    if FID.IsType<string> then
     begin
-      Result.S[JSONRPC_ID] := FID.AsString;
+      if FID.IsType<string> then
-    end
+      begin
-    else if FID.IsType<Int32> then
+        Result.S[JSONRPC_ID] := FID.AsString;
-    begin
+      end
-      Result.I[JSONRPC_ID] := FID.AsInteger;
+      else if FID.IsType<Int32> then
-    end
+      begin
-    else if FID.IsType<Int64> then
+        Result.I[JSONRPC_ID] := FID.AsInteger;
-    begin
+      end
-      Result.I[JSONRPC_ID] := FID.AsInt64;
+      else if FID.IsType<Int64> then
+      begin
+        Result.I[JSONRPC_ID] := FID.AsInt64;
+      end
+      else
+        raise EMVCJSONRPCException.Create('ID can be only Int32, Int64 or String');
     end
     else
-      raise EMVCJSONRPCException.Create('ID can be only Int32, Int64 or String');
+    begin
+      raise EMVCJSONRPCException.Create('ID cannot be empty in a JSON-RPC request');
+    end;
+  except
+    Result.Free;
+    raise;
   end;
-
 end;
 
 { TJSONRPCProxyGenerator }
@@ -2032,6 +2115,81 @@ begin
   fJSONRPCErrorCode := ErrCode;
 end;
 
+{ TJSONRPCNullResponse }
+
+function TJSONRPCNullResponse.GetError: TJSONRPCResponseError;
+begin
+  Result := FError;
+end;
+
+function TJSONRPCNullResponse.GetID: TValue;
+begin
+  RaiseErrorForNullObject;
+end;
+
+function TJSONRPCNullResponse.GetJSON: TJDOJsonObject;
+begin
+  Result := nil;
+  RaiseErrorForNullObject;
+end;
+
+function TJSONRPCNullResponse.GetJSONString: string;
+begin
+  RaiseErrorForNullObject;
+end;
+
+function TJSONRPCNullResponse.GetResult: TValue;
+begin
+  RaiseErrorForNullObject;
+end;
+
+function TJSONRPCNullResponse.IsError: Boolean;
+begin
+  Result := False;
+end;
+
+procedure TJSONRPCNullResponse.RaiseErrorForNullObject;
+begin
+  raise EMVCJSONRPCException.Create('Invalid Call for NULL object');
+end;
+
+function TJSONRPCNullResponse.ResultAsJSONArray: TJDOJsonArray;
+begin
+  Result := nil;
+  RaiseErrorForNullObject;
+end;
+
+function TJSONRPCNullResponse.ResultAsJSONObject: TJDOJsonObject;
+begin
+  Result := nil;
+  RaiseErrorForNullObject;
+end;
+
+procedure TJSONRPCNullResponse.SetError(const Value: TJSONRPCResponseError);
+begin
+  FError := Value;
+end;
+
+procedure TJSONRPCNullResponse.SetID(const Value: TValue);
+begin
+  RaiseErrorForNullObject;
+end;
+
+procedure TJSONRPCNullResponse.SetJSON(const JSON: TJDOJsonObject);
+begin
+  RaiseErrorForNullObject;
+end;
+
+procedure TJSONRPCNullResponse.SetJsonString(const Value: string);
+begin
+  RaiseErrorForNullObject;
+end;
+
+procedure TJSONRPCNullResponse.SetResult(const Value: TValue);
+begin
+  RaiseErrorForNullObject;
+end;
+
 initialization
 
 finalization

sources/MVCFramework.JWT.pas

@@ -36,21 +36,83 @@ uses
 
 type
 
-  {$SCOPEDENUMS ON}
+{$SCOPEDENUMS ON}
-
   TJWTCheckableClaim = (ExpirationTime, NotBefore, IssuedAt);
   TJWTCheckableClaims = set of TJWTCheckableClaim;
 
   TJWTRegisteredClaimNames = class sealed
   public
     const
+    /// <summary>
+    /// The "iss" (issuer) claim identifies the principal that issued the
+    /// JWT.  The processing of this claim is generally application specific.
+    /// The "iss" value is a case-sensitive string containing a StringOrURI
+    /// value.  Use of this claim is OPTIONAL.
+    /// </summary>
     Issuer: string = 'iss';
+    /// <summary>
+    /// The "sub" (subject) claim identifies the principal that is the
+    /// subject of the JWT.  The claims in a JWT are normally statements
+    /// about the subject.  The subject value MUST either be scoped to be
+    /// locally unique in the context of the issuer or be globally unique.
+    /// The processing of this claim is generally application specific.  The
+    /// "sub" value is a case-sensitive string containing a StringOrURI
+    /// value.  Use of this claim is OPTIONAL.
+    /// </summary>
     Subject: string = 'sub';
+    /// <summary>
+    /// The "aud" (audience) claim identifies the recipients that the JWT is
+    /// intended for.  Each principal intended to process the JWT MUST
+    /// identify itself with a value in the audience claim.  If the principal
+    /// processing the claim does not identify itself with a value in the
+    /// "aud" claim when this claim is present, then the JWT MUST be
+    /// rejected.  In the general case, the "aud" value is an array of case-
+    /// sensitive strings, each containing a StringOrURI value.  In the
+    /// special case when the JWT has one audience, the "aud" value MAY be a
+    /// single case-sensitive string containing a StringOrURI value.  The
+    /// interpretation of audience values is generally application specific.
+    /// Use of this claim is OPTIONAL.
+    /// </summary>
     Audience: string = 'aud';
+    /// <summary>
+    /// The "exp" (expiration time) claim identifies the expiration time on
+    /// or after which the JWT MUST NOT be accepted for processing.  The
+    /// processing of the "exp" claim requires that the current date/time
+    /// MUST be before the expiration date/time listed in the "exp" claim.
+    /// Implementers MAY provide for some small leeway, usually no more than
+    /// a few minutes, to account for clock skew.  Its value MUST be a number
+    /// containing a NumericDate value.  Use of this claim is OPTIONAL.
+    /// </summary>
     ExpirationTime: string = 'exp';
+    /// <summary>
+    /// The "nbf" (not before) claim identifies the time before which the JWT
+    /// MUST NOT be accepted for processing.  The processing of the "nbf"
+    /// claim requires that the current date/time MUST be after or equal to
+    /// the not-before date/time listed in the "nbf" claim.  Implementers MAY
+    /// provide for some small leeway, usually no more than a few minutes, to
+    /// account for clock skew.  Its value MUST be a number containing a
+    /// NumericDate value.  Use of this claim is OPTIONAL.
+    /// </summary>
     NotBefore: string = 'nbf';
+    /// <summary>
+    /// The "iat" (issued at) claim identifies the time at which the JWT was
+    /// issued.  This claim can be used to determine the age of the JWT.  Its
+    /// value MUST be a number containing a NumericDate value.  Use of this
+    /// claim is OPTIONAL.
+    /// </summary>
     IssuedAt: string = 'iat';
+    /// <summary>
+    /// The "jti" (JWT ID) claim provides a unique identifier for the JWT.
+    /// The identifier value MUST be assigned in a manner that ensures that
+    /// there is a negligible probability that the same value will be
+    /// accidentally assigned to a different data object; if the application
+    /// uses multiple issuers, collisions MUST be prevented among values
+    /// produced by different issuers as well.  The "jti" claim can be used
+    /// to prevent the JWT from being replayed.  The "jti" value is a case-
+    /// sensitive string.  Use of this claim is OPTIONAL.
+    /// </summary>
     JWT_ID: string = 'jti';
+
     Names: array [0 .. 6] of string = (
       'iss',
       'sub',
@@ -213,7 +275,8 @@ type
     /// ExpirationTime will be incremented by LiveValidityWindowInSeconds seconds automatically
     /// if the remaining seconds are less than the LiveValidityWindowInSeconds.
     /// </summary>
-    property LiveValidityWindowInSeconds: Cardinal read GetLiveValidityWindowInSeconds write SetLiveValidityWindowInSeconds;
+    property LiveValidityWindowInSeconds: Cardinal read GetLiveValidityWindowInSeconds
+      write SetLiveValidityWindowInSeconds;
   end;
 
 implementation
@@ -478,7 +541,7 @@ begin
   try
     lPayload := TJDOJSONObject.Create;
     try
-      lHeader.S['alg'] :=  HMACAlgorithm;
+      lHeader.S['alg'] := HMACAlgorithm;
       lHeader.S['typ'] := 'JWT';
       for lRegClaimName in TJWTRegisteredClaimNames.Names do
       begin
@@ -495,7 +558,7 @@ begin
 
       for lCustomClaimName in FCustomClaims.Keys do
       begin
-        lPayload.S[lCustomClaimName] :=  FCustomClaims[lCustomClaimName];
+        lPayload.S[lCustomClaimName] := FCustomClaims[lCustomClaimName];
       end;
 
       lHeaderEncoded := URLSafeB64encode(lHeader.ToString, False, IndyTextEncoding_UTF8);
@@ -623,8 +686,8 @@ begin
     begin
       lIsRegistered := False;
 
-      lName := lJPayload.Names[I];
+      lName := lJPayload.Names[i];
-      lValue := lJPayload.Items[I].Value;
+      lValue := lJPayload.Items[i].Value;
 
       // if is a registered claim, load it in the proper dictionary...
       for j := 0 to high(TJWTRegisteredClaimNames.Names) do

sources/MVCFramework.Middleware.Authentication.RoleBasedAuthHandler.pas

@@ -94,7 +94,7 @@ type
       const AActionName: string; var AHandled: Boolean);
   protected
     procedure OnBeforeControllerAction(AContext: TWebContext; const AControllerQualifiedClassName: string;
-      const AActionName: string; var AHandled: Boolean);
+      const AActionName: string; var AHandled: Boolean); override;
   public
     constructor Create(const AAuthenticationHandler: IMVCAuthenticationHandler;
       const ALoginUrl: string = '/system/users/logged'); override;

sources/MVCFramework.Middleware.Authentication.pas

@@ -61,12 +61,12 @@ type
       const AActionName: string;
       const AHandled: Boolean
       );
+    procedure OnAfterRouting(AContext: TWebContext; const AHandled: Boolean);
   public
     constructor Create(
       const AAuthenticationHandler: IMVCAuthenticationHandler;
       const ARealm: string = 'DelphiMVCFramework REALM'
       ); virtual;
-    procedure OnAfterRouting(AContext: TWebContext; const AHandled: Boolean);
   end;
 
   TMVCCustomAuthenticationMiddleware = class(TInterfacedObject, IMVCMiddleware)
@@ -84,7 +84,7 @@ type
       const AControllerQualifiedClassName: string;
       const AActionName: string;
       var AHandled: Boolean
-      );
+      ); virtual;
 
     procedure OnAfterControllerAction(
       AContext: TWebContext;
@@ -96,7 +96,6 @@ type
       const AHandled: Boolean
       );
 
-
     procedure SendResponse(AContext: TWebContext; var AHandled: Boolean; AHttpStatus: Word = HTTP_STATUS.Unauthorized);
     procedure DoLogin(AContext: TWebContext; var AHandled: Boolean);
     procedure DoLogout(AContext: TWebContext; var AHandled: Boolean);
@@ -149,15 +148,18 @@ procedure TMVCBasicAuthenticationMiddleware.OnBeforeControllerAction(
     if AContext.Request.ClientPreferHTML then
     begin
       AContext.Response.ContentType := TMVCMediaType.TEXT_HTML;
-      AContext.Response.RawWebResponse.Content := Format(CONTENT_HTML_FORMAT, [CONTENT_401_NOT_AUTHORIZED, AContext.Config[TMVCConfigKey.ServerName]]);
+      AContext.Response.RawWebResponse.Content :=
+        Format(CONTENT_HTML_FORMAT, [CONTENT_401_NOT_AUTHORIZED, AContext.Config[TMVCConfigKey.ServerName]]);
     end
     else
     begin
       AContext.Response.ContentType := TMVCMediaType.TEXT_PLAIN;
-      AContext.Response.RawWebResponse.Content := CONTENT_401_NOT_AUTHORIZED + sLineBreak + AContext.Config[TMVCConfigKey.ServerName];
+      AContext.Response.RawWebResponse.Content := CONTENT_401_NOT_AUTHORIZED + sLineBreak + AContext.Config
+        [TMVCConfigKey.ServerName];
     end;
     AContext.Response.StatusCode := HTTP_STATUS.Unauthorized;
     AContext.Response.SetCustomHeader('WWW-Authenticate', 'Basic realm=' + QuotedStr(FRealm));
+    AContext.SessionStop(False);
     AHandled := True;
   end;
 
@@ -167,21 +169,30 @@ procedure TMVCBasicAuthenticationMiddleware.OnBeforeControllerAction(
     if AContext.Request.ClientPreferHTML then
     begin
       AContext.Response.ContentType := TMVCMediaType.TEXT_HTML;
-      AContext.Response.RawWebResponse.Content := Format(CONTENT_HTML_FORMAT, [CONTENT_403_FORBIDDEN, AContext.Config[TMVCConfigKey.ServerName]]);
+      AContext.Response.RawWebResponse.Content :=
+        Format(CONTENT_HTML_FORMAT, [CONTENT_403_FORBIDDEN, AContext.Config[TMVCConfigKey.ServerName]]);
+    end
+    else if AContext.Request.ContentMediaType.StartsWith(TMVCMediaType.APPLICATION_JSON) then
+    begin
+      AContext.Response.ContentType := TMVCMediaType.APPLICATION_JSON;
+      AContext.Response.RawWebResponse.Content :=
+        '{"status":"error", "message":"' + CONTENT_403_FORBIDDEN.Replace('"', '\"') + '"}';
     end
     else
     begin
       AContext.Response.ContentType := TMVCMediaType.TEXT_PLAIN;
-      AContext.Response.RawWebResponse.Content := CONTENT_403_FORBIDDEN + sLineBreak + AContext.Config[TMVCConfigKey.ServerName];
+      AContext.Response.RawWebResponse.Content := CONTENT_403_FORBIDDEN + sLineBreak + AContext.Config
+        [TMVCConfigKey.ServerName];
     end;
     AContext.Response.StatusCode := HTTP_STATUS.Forbidden;
+    AContext.Response.ReasonString := AContext.Config[TMVCConfigKey.ServerName];
     AHandled := True;
   end;
 
 var
   AuthRequired: Boolean;
   IsValid, IsAuthorized: Boolean;
-  AuthHeader: string;
+  AuthHeader, Token: string;
   AuthPieces: TArray<string>;
   RolesList: TList<string>;
   SessionData: TSessionData;
@@ -199,9 +210,15 @@ begin
   if not IsValid then
   begin
     AuthHeader := AContext.Request.Headers['Authorization'];
-    AuthHeader := TMVCSerializerHelper.DecodeString(AuthHeader.Remove(0, 'Basic'.Length).Trim);
+    if AuthHeader.IsEmpty or (not AuthHeader.StartsWith('Basic ', True)) then
+    begin
+      SendWWWAuthenticate;
+      Exit;
+    end;
+    Token := AuthHeader.Remove(0, 'Basic '.Length).Trim;
+    AuthHeader := TMVCSerializerHelper.DecodeString(Token);
     AuthPieces := AuthHeader.Split([':']);
-    if AuthHeader.IsEmpty or (Length(AuthPieces) <> 2) then
+    if Length(AuthPieces) <> 2 then
     begin
       SendWWWAuthenticate;
       Exit;
@@ -211,7 +228,8 @@ begin
     try
       SessionData := TSessionData.Create;
       try
-        FAuthenticationHandler.OnAuthentication(AContext, AuthPieces[0], AuthPieces[1], RolesList, IsValid, SessionData);
+        FAuthenticationHandler.OnAuthentication(AContext, AuthPieces[0], AuthPieces[1], RolesList, IsValid,
+          SessionData);
         if IsValid then
         begin
           AContext.LoggedUser.Roles.AddRange(RolesList);
@@ -232,7 +250,8 @@ begin
 
   IsAuthorized := False;
   if IsValid then
-    FAuthenticationHandler.OnAuthorization(AContext, AContext.LoggedUser.Roles, AControllerQualifiedClassName, AActionName, IsAuthorized);
+    FAuthenticationHandler.OnAuthorization(AContext, AContext.LoggedUser.Roles, AControllerQualifiedClassName,
+      AActionName, IsAuthorized);
 
   if IsAuthorized then
     AHandled := False
@@ -241,7 +260,9 @@ begin
     if IsValid then
       Send403Forbidden
     else
+    begin
       SendWWWAuthenticate;
+    end;
   end;
 end;
 
@@ -249,7 +270,7 @@ procedure TMVCBasicAuthenticationMiddleware.OnBeforeRouting(
   AContext: TWebContext;
   var AHandled: Boolean);
 begin
-  // Implement as needed
+  AHandled := False;
 end;
 
 { TMVCCustomAuthenticationMiddleware }
@@ -281,7 +302,8 @@ begin
     AHandled := True;
     AContext.Response.StatusCode := HTTP_STATUS.BadRequest;
     AContext.Response.ContentType := TMVCMediaType.APPLICATION_JSON;
-    AContext.Response.RawWebResponse.Content := '{"status":"KO", "message":"username and password are mandatory in the body request as json object"}';
+    AContext.Response.RawWebResponse.Content :=
+      '{"status":"error", "message":"username and password are mandatory in the body request as json object"}';
     Exit;
   end;
 
@@ -393,7 +415,8 @@ begin
   end;
 
   IsAuthorized := False;
-  FAuthenticationHandler.OnAuthorization(AContext, AContext.LoggedUser.Roles, AControllerQualifiedClassName, AActionName, IsAuthorized);
+  FAuthenticationHandler.OnAuthorization(AContext, AContext.LoggedUser.Roles, AControllerQualifiedClassName,
+    AActionName, IsAuthorized);
   if IsAuthorized then
     AHandled := False
   else
@@ -412,7 +435,8 @@ begin
   begin
     AHandled := False;
 
-    if (AContext.Request.HTTPMethod = httpPOST) and (AContext.Request.ContentType.StartsWith(TMVCMediaType.APPLICATION_JSON)) then
+    if (AContext.Request.HTTPMethod = httpPOST) and
+      (AContext.Request.ContentType.StartsWith(TMVCMediaType.APPLICATION_JSON)) then
       DoLogin(AContext, AHandled);
 
     if (AContext.Request.HTTPMethod = httpDELETE) then
@@ -433,7 +457,8 @@ begin
   if AContext.Request.ClientPreferHTML then
   begin
     AContext.Response.ContentType := TMVCMediaType.TEXT_HTML;
-    AContext.Response.RawWebResponse.Content := Format(CONTENT_HTML_FORMAT, [IntToStr(AHttpStatus), AContext.Config[TMVCConfigKey.ServerName]]);
+    AContext.Response.RawWebResponse.Content :=
+      Format(CONTENT_HTML_FORMAT, [IntToStr(AHttpStatus), AContext.Config[TMVCConfigKey.ServerName]]);
   end
   else
   begin

sources/MVCFramework.RQL.AST2PostgreSQL.pas

@@ -167,7 +167,14 @@ end;
 
 function TRQLPostgreSQLCompiler.RQLLimitToSQL(const aRQLLimit: TRQLLimit): string;
 begin
-  Result := Format(' /*limit*/ LIMIT %d OFFSET %d', [aRQLLimit.Count, aRQLLimit.Start]);
+  if aRQLLimit.Start = 0 then
+  begin
+    Result := Format(' /*limit*/ LIMIT %d', [aRQLLimit.Count]);
+  end
+  else
+  begin
+    Result := Format(' /*limit*/ LIMIT %d OFFSET %d', [aRQLLimit.Count, aRQLLimit.Start]);
+  end;
 end;
 
 function TRQLPostgreSQLCompiler.RQLLogicOperatorToSQL(const aRQLFIlter: TRQLLogicOperator): string;

sources/MVCFramework.Router.pas

@@ -221,10 +221,15 @@ begin
       LMethods := LRttiType.GetMethods; {do not use GetDeclaredMethods because JSON-RPC rely on this!!}
       for LMethod in LMethods do
       begin
-        if (LMethod.MethodKind <> mkProcedure) or LMethod.IsClassMethod then
+        if LMethod.Visibility <> mvPublic then //2020-08-08
+          Continue;
+        if (LMethod.MethodKind <> mkProcedure) {or LMethod.IsClassMethod} then
           Continue;
 
         LAttributes := LMethod.GetAttributes;
+        if Length(LAttributes) = 0 then
+          Continue;
+
         for LAtt in LAttributes do
         begin
           if LAtt is MVCPathAttribute then
@@ -240,7 +245,7 @@ begin
                 FControllerClazz := LControllerDelegate.Clazz;
                 FControllerCreateAction := LControllerDelegate.CreateAction;
                 LProduceAttribute := GetAttribute<MVCProducesAttribute>(LAttributes);
-                if Assigned(LProduceAttribute) then
+                if LProduceAttribute <> nil then
                 begin
                   AResponseContentMediaType := LProduceAttribute.Value;
                   AResponseContentCharset := LProduceAttribute.Charset;
@@ -396,7 +401,7 @@ var
   FoundOneAttProduces: Boolean;
 begin
   Result := False;
-  if AAccept = '*/*' then
+  if AAccept.Contains('*/*') then //2020-08-08
   begin
     Exit(True);
   end;

sources/MVCFramework.SQLGenerators.Firebird.pas

@@ -91,6 +91,7 @@ var
   lPKInInsert: Boolean;
 begin
   lPKInInsert := (not PKFieldName.IsEmpty) and (not(TMVCActiveRecordFieldOption.foAutoGenerated in PKOptions));
+  lPKInInsert := lPKInInsert and (not(TMVCActiveRecordFieldOption.foReadOnly in PKOptions));
   lSB := TStringBuilder.Create;
   try
     lSB.Append('INSERT INTO ' + TableName + '(');

sources/MVCFramework.SQLGenerators.Interbase.pas

@@ -63,6 +63,7 @@ var
   lPKInInsert: Boolean;
 begin
   lPKInInsert := (not PKFieldName.IsEmpty); // and (not(TMVCActiveRecordFieldOption.foAutoGenerated in PKOptions));
+  lPKInInsert := lPKInInsert and (not(TMVCActiveRecordFieldOption.foReadOnly in PKOptions));
   lSB := TStringBuilder.Create;
   try
     lSB.Append('INSERT INTO ' + TableName + '(');

sources/MVCFramework.SQLGenerators.MSSQL.pas

@@ -88,6 +88,7 @@ var
   lPKInInsert: Boolean;
 begin
   lPKInInsert := (not PKFieldName.IsEmpty) and (not(TMVCActiveRecordFieldOption.foAutoGenerated in PKOptions));
+  lPKInInsert := lPKInInsert and (not(TMVCActiveRecordFieldOption.foReadOnly in PKOptions));
   lSB := TStringBuilder.Create;
   try
     lSB.Append('INSERT INTO ' + TableName + '(');

sources/MVCFramework.SQLGenerators.MySQL.pas

@@ -88,6 +88,7 @@ var
   lPKInInsert: Boolean;
 begin
   lPKInInsert := (not PKFieldName.IsEmpty) and (not(TMVCActiveRecordFieldOption.foAutoGenerated in PKOptions));
+  lPKInInsert := lPKInInsert and (not(TMVCActiveRecordFieldOption.foReadOnly in PKOptions));
   lSB := TStringBuilder.Create;
   try
     lSB.Append('INSERT INTO ' + TableName + '(');

sources/MVCFramework.SQLGenerators.PostgreSQL.pas

@@ -99,6 +99,7 @@ var
   lPKInInsert: Boolean;
 begin
   lPKInInsert := (not PKFieldName.IsEmpty) and (not(TMVCActiveRecordFieldOption.foAutoGenerated in PKOptions));
+  lPKInInsert := lPKInInsert and (not(TMVCActiveRecordFieldOption.foReadOnly in PKOptions));
   lSB := TStringBuilder.Create;
   try
     lSB.Append('INSERT INTO ' + GetTableNameForSQL(TableName) + ' (');
@@ -146,6 +147,11 @@ function TMVCSQLGeneratorPostgreSQL.CreateSelectByPKSQL(
   const Map: TFieldsMap; const PKFieldName: string;
   const PKOptions: TMVCActiveRecordFieldOptions): string;
 begin
+  if PKFieldName.IsEmpty then
+  begin
+    raise EMVCActiveRecord.Create('No primary key provided. [HINT] Define a primary key field adding foPrimaryKey in field options.');
+  end;
+
   Result := CreateSelectSQL(TableName, Map, PKFieldName, PKOptions) + ' WHERE ' +
     GetFieldNameForSQL(PKFieldName) + '= :' + GetParamNameForSQL(PKFieldName); // IntToStr(PrimaryKeyValue);
 end;

sources/MVCFramework.SQLGenerators.Sqlite.pas

@@ -87,6 +87,7 @@ var
   lPKInInsert: Boolean;
 begin
   lPKInInsert := (not PKFieldName.IsEmpty) and (not(TMVCActiveRecordFieldOption.foAutoGenerated in PKOptions));
+  lPKInInsert := lPKInInsert and (not(TMVCActiveRecordFieldOption.foReadOnly in PKOptions));
   lSB := TStringBuilder.Create;
   try
     lSB.Append('INSERT INTO ' + TableName + ' (');

sources/MVCFramework.Serializer.Commons.pas

@@ -736,7 +736,7 @@ var
   Attrs: TArray<TCustomAttribute>;
   Attr: TCustomAttribute;
 begin
-  { TODO -oDanieleT -cGeneral : in un rendering di una lista, quante volte viene chiamata questa funzione?}
+  { TODO -oDanieleT -cGeneral : in un rendering di una lista, quante volte viene chiamata questa funzione? }
   { Tante volte, ma eliminando tutta la logica si guadagnerebbe al massiom il 6% nel caso tipico, forse non vale la pena di aggiungere una cache apposita }
   Result := AProperty.Name;
 
@@ -1006,6 +1006,7 @@ var
   lInternalStream: TStream;
   lSStream: TStringStream;
   lValue: TValue;
+  lStrValue: string;
 {$IF not Defined(TokyoOrBetter)}
   lFieldValue: string;
 {$ENDIF}
@@ -1023,7 +1024,35 @@ begin
   case AField.DataType of
     ftString, ftWideString:
       begin
-        aRTTIField.SetValue(AObject, AField.AsString);
+        // mysql tinytext is identified as string, but raises an Invalid Class Cast
+        // so we need to do some more checks...
+        case aRTTIField.FieldType.TypeKind of
+          tkString, tkUString:
+            begin
+              aRTTIField.SetValue(AObject, AField.AsString);
+            end;
+          tkClass: { mysql - maps a tiny field, identified as string, into a TStream }
+            begin
+              lInternalStream := aRTTIField.GetValue(AObject).AsObject as TStream;
+              if lInternalStream = nil then
+              begin
+                raise EMVCException.CreateFmt('Property target for %s field is nil. [HINT] Initialize the stream before load data', [AField.FieldName]);
+              end;
+              lInternalStream.Size := 0;
+              lStrValue := AField.AsString;
+              if not lStrValue.IsEmpty then
+              begin
+                lInternalStream.Write(lStrValue, Length(lStrValue));
+                lInternalStream.Position := 0;
+              end;
+            end
+        else
+          begin
+            raise EMVCException.CreateFmt('Unsupported FieldType (%d) for field %s',
+              [Ord(AField.DataType), AField.FieldName]);
+          end;
+        end;
+        // aRTTIField.SetValue(AObject, AField.AsString);
       end;
     ftLargeint, ftAutoInc:
       begin

sources/MVCFramework.Serializer.Intf.pas

@@ -118,7 +118,8 @@ type
       const ASerializedObject: string;
       const AObject: TObject;
       const AType: TMVCSerializationType = stDefault;
-      const AIgnoredAttributes: TMVCIgnoredList = nil
+      const AIgnoredAttributes: TMVCIgnoredList = nil;
+      const ARootNode: String = ''
       ); overload;
 
     procedure DeserializeObject(

sources/MVCFramework.Serializer.JsonDataObjects.pas

@@ -135,7 +135,8 @@ type
       const SerializationAction: TMVCDatasetSerializationAction = nil): string;
 
     procedure DeserializeObject(const ASerializedObject: string; const AObject: TObject;
-      const AType: TMVCSerializationType = stDefault; const AIgnoredAttributes: TMVCIgnoredList = []); overload;
+      const AType: TMVCSerializationType = stDefault; const AIgnoredAttributes: TMVCIgnoredList = [];
+      const ARootNode: string = ''); overload;
 
     procedure DeserializeObject(const ASerializedObject: string; const AObject: IInterface;
       const AType: TMVCSerializationType = stDefault; const AIgnoredAttributes: TMVCIgnoredList = []); overload;
@@ -194,6 +195,18 @@ uses
   MVCFramework.DataSet.Utils,
   MVCFramework.Nullables;
 
+function SelectRootNodeOrWholeObject(const RootNode: string; const JSONObject: TJsonObject): TJsonObject; inline;
+begin
+  if RootNode.IsEmpty then
+  begin
+    Result := JSONObject
+  end
+  else
+  begin
+    Result := JSONObject.O[RootNode];
+  end;
+end;
+
 { TMVCJsonDataObjectsSerializer }
 
 procedure TMVCJsonDataObjectsSerializer.AfterConstruction;
@@ -2013,7 +2026,7 @@ end;
 
 procedure TMVCJsonDataObjectsSerializer.DeserializeObject(const ASerializedObject: string;
   const AObject: TObject;
-  const AType: TMVCSerializationType; const AIgnoredAttributes: TMVCIgnoredList);
+  const AType: TMVCSerializationType; const AIgnoredAttributes: TMVCIgnoredList; const ARootNode: string);
 var
   JSONObject: TJDOJsonObject;
   JsonBase: TJsonBaseObject;
@@ -2041,11 +2054,12 @@ begin
   try
     if GetTypeSerializers.ContainsKey(AObject.ClassInfo) then
     begin
-      GetTypeSerializers.Items[AObject.ClassInfo].DeserializeRoot(JSONObject, AObject, []);
+      GetTypeSerializers.Items[AObject.ClassInfo].DeserializeRoot(SelectRootNodeOrWholeObject(ARootNode, JSONObject),
+        AObject, [])
     end
     else
     begin
-      JsonObjectToObject(JSONObject, AObject, GetSerializationType(AObject, AType), AIgnoredAttributes);
+      JsonObjectToObject(SelectRootNodeOrWholeObject(ARootNode, JSONObject), AObject, GetSerializationType(AObject, AType), AIgnoredAttributes);
     end;
   finally
     JSONObject.Free;
@@ -2097,9 +2111,9 @@ begin
 {$IFDEF NEXTGEN}
         lTypeName := PChar(Pointer(Value.TypeInfo.Name))
 {$ELSE}
-        lTypeName := String(Value.TypeInfo.Name);
+        lTypeName := string(Value.TypeInfo.Name);
 {$ENDIF}
-        if (lTypeName = 'TDate') or (lTypeName = 'TDateTime')  or (lTypeName = 'TTime') then
+        if (lTypeName = 'TDate') or (lTypeName = 'TDateTime') or (lTypeName = 'TTime') then
         begin
           JSON.D[KeyName] := Value.AsExtended;
         end
@@ -2118,8 +2132,15 @@ begin
       end;
     tkEnumeration:
       begin
-        Value.TryAsOrdinal(lOrdinalValue);
+        if (Value.TypeInfo = System.TypeInfo(Boolean)) then
-        JSON.I[KeyName] := lOrdinalValue;
+        begin
+          JSON.B[KeyName] := Value.AsBoolean;
+        end
+        else
+        begin
+          Value.TryAsOrdinal(lOrdinalValue);
+          JSON.I[KeyName] := lOrdinalValue;
+        end;
       end;
     tkClass, tkInterface:
       begin

sources/MVCFramework.pas

@@ -88,7 +88,7 @@ uses
 
 type
 
-  TSessionData = TDictionary<String, String>;
+  TSessionData = TDictionary<string, string>;
   TMVCCustomData = TSessionData;
   TMVCBaseViewEngine = class;
   TMVCViewEngineClass = class of TMVCBaseViewEngine;
@@ -348,11 +348,11 @@ type
     function ContentParam(const AName: string): string;
     function Cookie(const AName: string): string;
     function Body: string;
-    function BodyAs<T: class, constructor>: T;
+    function BodyAs<T: class, constructor>(const RootNode: string = ''): T;
     function BodyAsListOf<T: class, constructor>: TObjectList<T>;
     procedure BodyFor<T: class, constructor>(const AObject: T);
     procedure BodyForListOf<T: class, constructor>(const AObjectList: TObjectList<T>);
-//    function HeaderNames: TArray<String>;
+    // function HeaderNames: TArray<String>;
     property RawWebRequest: TWebRequest read FWebRequest;
     property ContentMediaType: string read FContentMediaType;
     property ContentType: string read FContentType;
@@ -606,7 +606,7 @@ type
     FContentCharset: string;
     FResponseStream: TStringBuilder;
     function ToMVCList(const AObject: TObject; AOwnsObject: Boolean = False): IMVCList;
-  public
+  public { this must be public because of entity processors }
     function GetContentType: string;
     function GetStatusCode: Integer;
     procedure SetContentType(const AValue: string);
@@ -756,16 +756,17 @@ type
     property StatusCode: Integer read GetStatusCode write SetStatusCode;
     property ViewModelList: TMVCViewDataObject read GetViewModel;
     property ViewDataSetList: TMVCViewDataSet read GetViewDataSets;
-  public
-    constructor Create; virtual;
-    destructor Destroy; override;
 
-    // procedure PushToView(const AModelName: string; const AModel: string);
     procedure PushObjectToView(const aModelName: string; const AModel: TObject); deprecated 'Use "ViewData"';
     procedure PushDataSetToView(const aModelName: string; const ADataSet: TDataSet); deprecated 'Use "ViewDataSet"';
 
     property ViewData[const aModelName: string]: TObject read GetViewData write SetViewData;
     property ViewDataset[const aDataSetName: string]: TDataSet read GetViewDataset write SetViewDataset;
+
+  public
+    constructor Create; virtual;
+    destructor Destroy; override;
+
   end;
 
   TMVCControllerClazz = class of TMVCController;
@@ -854,7 +855,7 @@ type
     FConfig: TMVCConfig;
     FConfigCache_MaxRequestSize: Int64;
     FConfigCache_ExposeServerSignature: Boolean;
-    FConfigCache_ServerSignature: String;
+    FConfigCache_ServerSignature: string;
     FConfigCache_ExposeXPoweredBy: Boolean;
     FSerializers: TDictionary<string, IMVCSerializer>;
     FMiddlewares: TList<IMVCMiddleware>;
@@ -1144,7 +1145,7 @@ begin
   Result := FBody;
 end;
 
-function TMVCWebRequest.BodyAs<T>: T;
+function TMVCWebRequest.BodyAs<T>(const RootNode: string): T;
 var
   Obj: TObject;
   lSerializer: IMVCSerializer;
@@ -1154,7 +1155,7 @@ begin
   begin
     Obj := TMVCSerializerHelper.CreateObject(TClass(T).QualifiedClassName);
     try
-      lSerializer.DeserializeObject(Body, Obj);
+      lSerializer.DeserializeObject(Body, Obj, TMVCSerializationType.stDefault, nil, RootNode);
       Result := Obj as T;
     except
       on E: Exception do
@@ -1209,19 +1210,19 @@ begin
     end;
 end;
 
-//function TMVCWebRequest.HeaderNames: TArray<String>;
+// function TMVCWebRequest.HeaderNames: TArray<String>;
-//var
+// var
-//  lHeaderList: TIdHeaderList;
+// lHeaderList: TIdHeaderList;
-//  I: Integer;
+// I: Integer;
-//begin
+// begin
-//  EnsureINDY;
+// EnsureINDY;
-//  lHeaderList := THackIdHTTPAppRequest(TMVCIndyWebRequest(Self).RawWebRequest).FRequestInfo.RawHeaders;
+// lHeaderList := THackIdHTTPAppRequest(TMVCIndyWebRequest(Self).RawWebRequest).FRequestInfo.RawHeaders;
-//  SetLength(Result, lHeaderList.Count);
+// SetLength(Result, lHeaderList.Count);
-//  for I := 0 to Pred(lHeaderList.Count) do
+// for I := 0 to Pred(lHeaderList.Count) do
-//  begin
+// begin
-//    Result[I] := lHeaderList.Names[I];
+// Result[I] := lHeaderList.Names[I];
-//  end;
+// end;
-//end;
+// end;
 
 procedure TMVCWebRequest.BodyForListOf<T>(const AObjectList: TObjectList<T>);
 var
@@ -1335,7 +1336,7 @@ end;
 
 procedure TMVCWebRequest.EnsureINDY;
 begin
-  if not (Self is TMVCIndyWebRequest) then
+  if not(Self is TMVCIndyWebRequest) then
   begin
     raise EMVCException.Create(http_status.InternalServerError, 'Method available only in INDY implementation');
   end;
@@ -2111,7 +2112,8 @@ begin
 
   if ARequest.ContentLength > FConfigCache_MaxRequestSize then
   begin
-    raise EMVCException.CreateFmt(HTTP_STATUS.RequestEntityTooLarge, 'Request size exceeded the max allowed size [%d KiB] (1)',
+    raise EMVCException.CreateFmt(http_status.RequestEntityTooLarge,
+      'Request size exceeded the max allowed size [%d KiB] (1)',
       [(FConfigCache_MaxRequestSize div 1024)]);
   end;
 
@@ -2121,7 +2123,8 @@ begin
   // Double check for malicious content-length header
   if ARequest.ContentLength > FConfigCache_MaxRequestSize then
   begin
-    raise EMVCException.CreateFmt(HTTP_STATUS.RequestEntityTooLarge, 'Request size exceeded the max allowed size [%d KiB] (2)',
+    raise EMVCException.CreateFmt(http_status.RequestEntityTooLarge,
+      'Request size exceeded the max allowed size [%d KiB] (2)',
       [(FConfigCache_MaxRequestSize div 1024)]);
   end;
 {$ENDIF}
@@ -2155,7 +2158,7 @@ begin
                   begin
                     Log.ErrorFmt('[%s] %s (Custom message: "%s")',
                       [Ex.Classname, Ex.Message, 'Cannot create controller'], LOGGERPRO_TAG);
-                    raise EMVCException.Create(HTTP_STATUS.InternalServerError, 'Cannot create controller');
+                    raise EMVCException.Create(http_status.InternalServerError, 'Cannot create controller');
                   end;
                 end;
                 lSelectedController.Engine := Self;
@@ -2208,14 +2211,14 @@ begin
               begin
                 if Config[TMVCConfigKey.AllowUnhandledAction] = 'false' then
                 begin
-                  lContext.Response.StatusCode := HTTP_STATUS.NotFound;
+                  lContext.Response.StatusCode := http_status.NotFound;
                   lContext.Response.ReasonString := 'Not Found';
                   fOnRouterLog(lRouter, rlsRouteNotFound, lContext);
                   raise EMVCException.Create(
                     lContext.Response.ReasonString,
                     lContext.Request.HTTPMethodAsString + ' ' + lContext.Request.PathInfo,
                     0,
-                    HTTP_STATUS.NotFound
+                    http_status.NotFound
                     );
                 end
                 else
@@ -2262,12 +2265,12 @@ begin
                   LOGGERPRO_TAG);
                 if Assigned(lSelectedController) then
                 begin
-                  lSelectedController.ResponseStatus(HTTP_STATUS.InternalServerError);
+                  lSelectedController.ResponseStatus(http_status.InternalServerError);
                   lSelectedController.Render(EIO);
                 end
                 else
                 begin
-                  SendRawHTTPStatus(lContext, HTTP_STATUS.InternalServerError,
+                  SendRawHTTPStatus(lContext, http_status.InternalServerError,
                     Format('[%s] %s', [EIO.Classname, EIO.Message]), EIO.Classname);
                 end;
               end;
@@ -2280,12 +2283,12 @@ begin
                   [Ex.Classname, Ex.Message, 'Global Action Exception Handler'], LOGGERPRO_TAG);
                 if Assigned(lSelectedController) then
                 begin
-                  lSelectedController.ResponseStatus(HTTP_STATUS.InternalServerError);
+                  lSelectedController.ResponseStatus(http_status.InternalServerError);
                   lSelectedController.Render(Ex);
                 end
                 else
                 begin
-                  SendRawHTTPStatus(lContext, HTTP_STATUS.InternalServerError,
+                  SendRawHTTPStatus(lContext, http_status.InternalServerError,
                     Format('[%s] %s', [Ex.Classname, Ex.Message]), Ex.Classname);
                 end;
               end;
@@ -2303,12 +2306,12 @@ begin
                 if Assigned(lSelectedController) then
                 begin
                   { middlewares *must* not raise unhandled exceptions }
-                  lSelectedController.ResponseStatus(HTTP_STATUS.InternalServerError);
+                  lSelectedController.ResponseStatus(http_status.InternalServerError);
                   lSelectedController.Render(Ex);
                 end
                 else
                 begin
-                  SendRawHTTPStatus(lContext, HTTP_STATUS.InternalServerError,
+                  SendRawHTTPStatus(lContext, http_status.InternalServerError,
                     Format('[%s] %s', [Ex.Classname, Ex.Message]), Ex.Classname);
                 end;
               end;
@@ -2402,7 +2405,7 @@ var
   lQualifiedName: string;
 begin
   if AContext.Request.SegmentParamsCount <> Length(AActionFormalParams) then
-    raise EMVCException.CreateFmt(HTTP_STATUS.BadRequest,
+    raise EMVCException.CreateFmt(http_status.BadRequest,
       'Parameters count mismatch (expected %d actual %d) for action "%s"',
       [Length(AActionFormalParams), AContext.Request.SegmentParamsCount, AActionName]);
 
@@ -2413,7 +2416,7 @@ begin
 
     if not AContext.Request.SegmentParam(lParamName, lStrValue) then
       raise EMVCException.CreateFmt
-        (HTTP_STATUS.BadRequest, 'Invalid parameter %s for action %s (Hint: Here parameters names are case-sensitive)',
+        (http_status.BadRequest, 'Invalid parameter %s for action %s (Hint: Here parameters names are case-sensitive)',
         [lParamName, AActionName]);
 
     case AActionFormalParams[I].ParamType.TypeKind of
@@ -2423,7 +2426,7 @@ begin
         except
           on E: Exception do
           begin
-            raise EMVCException.CreateFmt(HTTP_STATUS.BadRequest,
+            raise EMVCException.CreateFmt(http_status.BadRequest,
               'Invalid Integer value for param [%s] - [CLASS: %s][MSG: %s]',
               [AActionFormalParams[I].name, E.Classname, E.Message]);
           end;
@@ -2434,7 +2437,7 @@ begin
         except
           on E: Exception do
           begin
-            raise EMVCException.CreateFmt(HTTP_STATUS.BadRequest,
+            raise EMVCException.CreateFmt(http_status.BadRequest,
               'Invalid Int64 value for param [%s] - [CLASS: %s][MSG: %s]',
               [AActionFormalParams[I].name, E.Classname, E.Message]);
           end;
@@ -2455,7 +2458,7 @@ begin
             except
               on E: Exception do
               begin
-                raise EMVCException.CreateFmt(HTTP_STATUS.BadRequest,
+                raise EMVCException.CreateFmt(http_status.BadRequest,
                   'Invalid TDate value for param [%s] - [CLASS: %s][MSG: %s]',
                   [AActionFormalParams[I].name, E.Classname, E.Message]);
               end;
@@ -2470,7 +2473,7 @@ begin
             except
               on E: Exception do
               begin
-                raise EMVCException.CreateFmt(HTTP_STATUS.BadRequest,
+                raise EMVCException.CreateFmt(http_status.BadRequest,
                   'Invalid TDateTime value for param [%s] - [CLASS: %s][MSG: %s]',
                   [AActionFormalParams[I].name, E.Classname, E.Message]);
               end;
@@ -2485,7 +2488,7 @@ begin
             except
               on E: Exception do
               begin
-                raise EMVCException.CreateFmt(HTTP_STATUS.BadRequest,
+                raise EMVCException.CreateFmt(http_status.BadRequest,
                   'Invalid TTime value for param [%s] - [CLASS: %s][MSG: %s]',
                   [AActionFormalParams[I].name, E.Classname, E.Message]);
               end;
@@ -2498,7 +2501,7 @@ begin
             except
               on E: Exception do
               begin
-                raise EMVCException.CreateFmt(HTTP_STATUS.BadRequest,
+                raise EMVCException.CreateFmt(http_status.BadRequest,
                   'Invalid Float value for param [%s] - [CLASS: %s][MSG: %s]',
                   [AActionFormalParams[I].name, E.Classname, E.Message]);
               end;
@@ -2516,14 +2519,14 @@ begin
             else
             begin
               raise EMVCException.CreateFmt
-                (HTTP_STATUS.BadRequest,
+                (http_status.BadRequest,
                 'Invalid boolean value for parameter %s. Boolean parameters accepts only "true"/"false" or "1"/"0".',
                 [lParamName]);
             end;
           end
           else
           begin
-            raise EMVCException.CreateFmt(HTTP_STATUS.BadRequest, 'Invalid type for parameter %s. Allowed types are ' +
+            raise EMVCException.CreateFmt(http_status.BadRequest, 'Invalid type for parameter %s. Allowed types are ' +
               ALLOWED_TYPED_ACTION_PARAMETERS_TYPES, [lParamName]);
           end;
         end;
@@ -2543,7 +2546,7 @@ begin
         end
     else
       begin
-        raise EMVCException.CreateFmt(HTTP_STATUS.BadRequest, 'Invalid type for parameter %s. Allowed types are ' +
+        raise EMVCException.CreateFmt(http_status.BadRequest, 'Invalid type for parameter %s. Allowed types are ' +
           ALLOWED_TYPED_ACTION_PARAMETERS_TYPES, [lParamName]);
       end;
     end;
@@ -2610,7 +2613,7 @@ end;
 
 procedure TMVCEngine.HTTP404(const AContext: TWebContext);
 begin
-  AContext.Response.SetStatusCode(HTTP_STATUS.NotFound);
+  AContext.Response.SetStatusCode(http_status.NotFound);
   AContext.Response.SetContentType(BuildContentType(TMVCMediaType.TEXT_PLAIN,
     AContext.Config[TMVCConfigKey.DefaultContentCharset]));
   AContext.Response.SetReasonString('Not Found');
@@ -2619,7 +2622,7 @@ end;
 
 procedure TMVCEngine.HTTP500(const AContext: TWebContext; const AReasonString: string);
 begin
-  AContext.Response.SetStatusCode(HTTP_STATUS.InternalServerError);
+  AContext.Response.SetStatusCode(http_status.InternalServerError);
   AContext.Response.SetContentType(BuildContentType(TMVCMediaType.TEXT_PLAIN,
     AContext.Config[TMVCConfigKey.DefaultContentCharset]));
   AContext.Response.SetReasonString('Internal server error');
@@ -2680,7 +2683,7 @@ begin
 
   if IsShuttingDown then
   begin
-    AResponse.StatusCode := HTTP_STATUS.ServiceUnavailable;
+    AResponse.StatusCode := http_status.ServiceUnavailable;
     AResponse.ContentType := TMVCMediaType.TEXT_PLAIN;
     AResponse.Content := 'Server is shutting down';
     AHandled := True;
@@ -2695,10 +2698,10 @@ begin
       begin
         Log.ErrorFmt('[%s] %s', [E.Classname, E.Message], LOGGERPRO_TAG);
 
-        AResponse.StatusCode:= HTTP_STATUS.InternalServerError; // default is Internal Server Error
+        AResponse.StatusCode := http_status.InternalServerError; // default is Internal Server Error
         if E is EMVCException then
         begin
-            AResponse.StatusCode:= (E as EMVCException).HttpErrorCode;
+          AResponse.StatusCode := (E as EMVCException).HTTPErrorCode;
         end;
 
         AResponse.Content := E.Message;
@@ -2741,7 +2744,7 @@ procedure TMVCEngine.ResponseErrorPage(const AException: Exception; const AReque
 const AResponse: TWebResponse);
 begin
   AResponse.SetCustomHeader('x-mvc-error', AException.Classname + ': ' + AException.Message);
-  AResponse.StatusCode := HTTP_STATUS.OK;
+  AResponse.StatusCode := http_status.OK;
 
   begin
     AResponse.ContentType := TMVCMediaType.TEXT_PLAIN;
@@ -2755,7 +2758,8 @@ class function TMVCEngine.SendSessionCookie(const AContext: TWebContext): string
 var
   SId: string;
 begin
-  SId := StringReplace(StringReplace(StringReplace(GUIDToString(TGUID.NewGuid), '}', '', []), '{', '', []), '-', '',
+  SId := StringReplace(StringReplace(StringReplace('DT' + GUIDToString(TGUID.NewGuid), '}', '',
+    []), '{', '', []), '-', '',
     [rfReplaceAll]);
   Result := SendSessionCookie(AContext, SId);
 end;
@@ -3132,7 +3136,7 @@ begin
   begin
     raise EMVCException.Create('Cannot send 202 without provide an HREF');
   end;
-  ResponseStatus(HTTP_STATUS.Accepted, Reason);
+  ResponseStatus(http_status.Accepted, Reason);
   Render(TMVCAcceptedResponse.Create(HREF, ID));
 end;
 
@@ -3142,10 +3146,10 @@ begin
   begin
     FContext.Response.CustomHeaders.AddPair('location', Location);
   end;
-  ResponseStatus(HTTP_STATUS.Created, Reason);
+  ResponseStatus(http_status.Created, Reason);
-  {$IF CompilerVersion >= 34}
+{$IF CompilerVersion >= 34}
-  Render(''); //in 10.4 INDY requires something on the content
+  Render(''); // in 10.4 INDY requires something on the content
-  {$ENDIF}
+{$ENDIF}
 end;
 
 procedure TMVCRenderer.Render204NoContent(const Location, Reason: string);
@@ -3154,7 +3158,7 @@ begin
   begin
     FContext.Response.CustomHeaders.AddPair('location', Location);
   end;
-  ResponseStatus(HTTP_STATUS.NoContent, Reason);
+  ResponseStatus(http_status.NoContent, Reason);
 end;
 
 procedure TMVCRenderer.ResponseStatus(const AStatusCode: Integer; const AReasonString: string);
@@ -3442,7 +3446,7 @@ begin
   // setting up the correct SSE headers
   SetContentType('text/event-stream');
   GetContext.Response.SetCustomHeader('Cache-Control', 'no-cache');
-  GetContext.Response.StatusCode := HTTP_STATUS.OK;
+  GetContext.Response.StatusCode := http_status.OK;
 
   // render the response using SSE compliant data format
 
@@ -3509,8 +3513,8 @@ begin
     if AException is EMVCException then
       ResponseStatus(EMVCException(AException).HTTPErrorCode, AException.Message + ' [' + AException.Classname + ']');
 
-    if (GetContext.Response.StatusCode = HTTP_STATUS.OK) then
+    if (GetContext.Response.StatusCode = http_status.OK) then
-      ResponseStatus(HTTP_STATUS.InternalServerError, AException.Message + ' [' + AException.Classname + ']');
+      ResponseStatus(http_status.InternalServerError, AException.Message + ' [' + AException.Classname + ']');
 
     if (not GetContext.Request.IsAjax) and (GetContext.Request.ClientPrefer(TMVCMediaType.TEXT_HTML)) then
     begin

unittests/general/Several/DMVCFrameworkTests.dpr

@@ -5,25 +5,29 @@ program DMVCFrameworkTests;
 {$APPTYPE CONSOLE}
 {$ENDIF}{$ENDIF}{$STRONGLINKTYPES ON}
 
+
 uses
   System.SysUtils,
-  {$IFDEF GUI_TESTRUNNER}
+{$IFDEF GUI_TESTRUNNER}
   Vcl.Forms,
   DUnitX.Loggers.GUI.Vcl,
-  {$ENDIF }
+  // Fmx.Forms,
-  {$IFDEF CONSOLE_TESTRUNNER}
+  // DUNitX.Loggers.GUIX,
+{$ENDIF }
+{$IFDEF CONSOLE_TESTRUNNER}
   DUnitX.Loggers.Console,
-  {$ENDIF }
+{$ENDIF }
-  DUnitX.Loggers.Xml.NUnit,
+  // DUnitX.Loggers.Xml.NUnit,
   DUnitX.TestFramework,
   FrameworkTestsU in 'FrameworkTestsU.pas',
   LiveServerTestU in 'LiveServerTestU.pas',
   BOs in 'BOs.pas',
   TestServerControllerU in '..\TestServer\TestServerControllerU.pas',
   RESTAdapterTestsU in 'RESTAdapterTestsU.pas',
-  MVCFramework.Tests.WebModule2 in '..\StandaloneServer\MVCFramework.Tests.WebModule2.pas' {TestWebModule2: TWebModule},
+  MVCFramework.Tests.WebModule2
+    in '..\StandaloneServer\MVCFramework.Tests.WebModule2.pas' {TestWebModule2: TWebModule} ,
   MVCFramework.Tests.StandaloneServer in '..\StandaloneServer\MVCFramework.Tests.StandaloneServer.pas',
-  MVCFramework.Tests.WebModule1 in '..\RESTClient\MVCFramework.Tests.WebModule1.pas' {TestWebModule1: TWebModule},
+  MVCFramework.Tests.WebModule1 in '..\RESTClient\MVCFramework.Tests.WebModule1.pas' {TestWebModule1: TWebModule} ,
   MVCFramework.Tests.RESTClient in '..\RESTClient\MVCFramework.Tests.RESTClient.pas',
   MVCFramework.Tests.AppController in '..\RESTClient\MVCFramework.Tests.AppController.pas',
   BusinessObjectsU in '..\..\..\samples\commons\BusinessObjectsU.pas',
@@ -37,21 +41,24 @@ uses
   JsonDataObjects in '..\..\..\sources\JsonDataObjects.pas',
   Serializers.JsonDataObjectsTestU in 'Serializers.JsonDataObjectsTestU.pas',
   MVCFramework.Tests.Serializer.Entities in '..\..\common\MVCFramework.Tests.Serializer.Entities.pas',
-  MVCFramework.Tests.Serializer.EntitiesModule in '..\..\common\MVCFramework.Tests.Serializer.EntitiesModule.pas' {EntitiesModule: TDataModule},
+  MVCFramework.Tests.Serializer.EntitiesModule
+    in '..\..\common\MVCFramework.Tests.Serializer.EntitiesModule.pas' {EntitiesModule: TDataModule} ,
   MVCFramework.Tests.Serializer.Intf in '..\..\common\MVCFramework.Tests.Serializer.Intf.pas',
-  MVCFramework.Serializer.JsonDataObjects.OptionalCustomTypes in '..\..\..\sources\MVCFramework.Serializer.JsonDataObjects.OptionalCustomTypes.pas',
+  MVCFramework.Serializer.JsonDataObjects.OptionalCustomTypes
+    in '..\..\..\sources\MVCFramework.Serializer.JsonDataObjects.OptionalCustomTypes.pas',
   ActiveRecordTestsU in 'ActiveRecordTestsU.pas',
   TestConstsU in 'TestConstsU.pas';
 
 {$R *.RES}
 {$IFDEF CONSOLE_TESTRUNNER}
 
+
 procedure MainConsole();
 var
   runner: ITestRunner;
   results: IRunResults;
   logger: ITestLogger;
-//  nunitLogger: ITestLogger;
+  // nunitLogger: ITestLogger;
 begin
   try
     // Check command line options, will exit if invalid
@@ -90,14 +97,17 @@ end;
 {$ENDIF}
 {$IFDEF GUI_TESTRUNNER}
 
+
 procedure MainGUI;
 begin
   Application.Initialize;
   Application.CreateForm(TGUIVCLTestRunner, GUIVCLTestRunner);
+  // Application.CreateForm(TGUIXTestRunner, GUIXTestRunner);
   Application.Run;
 end;
 {$ENDIF}
 
+
 begin
   ReportMemoryLeaksOnShutdown := True;
 {$IFDEF CONSOLE_TESTRUNNER}

unittests/general/Several/DMVCFrameworkTests.dproj

@@ -4,7 +4,7 @@
         <ProjectVersion>19.0</ProjectVersion>
         <FrameworkType>VCL</FrameworkType>
         <Base>True</Base>
-        <Config Condition="'$(Config)'==''">GUI</Config>
+        <Config Condition="'$(Config)'==''">CONSOLE</Config>
         <Platform Condition="'$(Platform)'==''">Win32</Platform>
         <TargetedPlatforms>1</TargetedPlatforms>
         <AppType>Console</AppType>

unittests/general/Several/LiveServerTestU.pas

@@ -33,7 +33,6 @@ uses
   System.DateUtils,
   System.Hash;
 
-
 type
 
   TBaseServerTest = class(TObject)
@@ -224,12 +223,17 @@ type
   protected
     FExecutor: IMVCJSONRPCExecutor;
     FExecutor2: IMVCJSONRPCExecutor;
+    FExecutor3: IMVCJSONRPCExecutor;
   public
     [Setup]
     procedure Setup;
     [Test]
     procedure TestRequestWithoutParams;
     [Test]
+    procedure TestNotificationWithoutParams;
+    [Test]
+    procedure TestNotificationWhichRaisesError;
+    [Test]
     procedure TestRequestToNotFoundMethod;
     [Test]
     procedure TestRequestWithParams_I_I_ret_I;
@@ -249,6 +253,26 @@ type
     procedure TestRequestWithParams_I_I_ret_A;
     [Test]
     procedure TestRequestWithParams_DT_T_ret_DT;
+    // hooks tests
+    [Test]
+    procedure TestHooks;
+    [Test]
+    procedure TestHooksWhenMethodRaisesError;
+    [Test]
+    procedure TestHooksWhenOnAfterCallHookRaisesError;
+    [Test]
+    procedure TestHooksNotif;
+    [Test]
+    procedure TestHooksNotifWhenOnBeforeRoutingHookRaisesError;
+    [Test]
+    procedure TestHooksNotifWhenOnBeforeCallHookRaisesError;
+    [Test]
+    procedure TestHooksNotifWhenOnAfterCallHookRaisesError;
+    [Test]
+    procedure TestHooksWhenOnBeforeCallHookRaisesError;
+    [Test]
+    procedure TestHooksWhenOnBeforeRoutingHookRaisesError;
+
   end;
 
 implementation
@@ -278,7 +302,7 @@ uses
 {$ENDIF}
     , TestConstsU;
 
-function GetServer: String;
+function GetServer: string;
 begin
   Result := 'http://' + TEST_SERVER_ADDRESS + ':9999';
 end;
@@ -1876,6 +1900,123 @@ procedure TJSONRPCServerTest.Setup;
 begin
   FExecutor := TMVCJSONRPCExecutor.Create('http://' + TEST_SERVER_ADDRESS + ':9999/jsonrpc', false);
   FExecutor2 := TMVCJSONRPCExecutor.Create('http://' + TEST_SERVER_ADDRESS + ':9999/jsonrpcclass', false);
+  FExecutor3 := TMVCJSONRPCExecutor.Create('http://' + TEST_SERVER_ADDRESS + ':9999/jsonrpcclass1', false);
+end;
+
+procedure TJSONRPCServerTest.TestHooks;
+begin
+  var lRequest1: IJSONRPCRequest := TJSONRPCRequest.Create(1234, 'request1');
+  var lResp := FExecutor3.ExecuteRequest(lRequest1);
+  Assert.areEqual('OnBeforeRoutingHook|OnBeforeCallHook|OnAfterCallHook',
+    FExecutor3.HTTPResponse.HeaderValue['x-history']);
+end;
+
+procedure TJSONRPCServerTest.TestHooksNotif;
+begin
+  var lNotif: IJSONRPCNotification := TJSONRPCNotification.Create('Notif1');
+  var lResp := FExecutor3.ExecuteNotification(lNotif);
+  Assert.areEqual('OnBeforeRoutingHook|OnBeforeCallHook|OnAfterCallHook', FExecutor3.HTTPResponse.HeaderValue['x-history']);
+  Assert.IsFalse(lResp.IsError);
+  Assert.WillRaise(
+    procedure
+    begin
+      lResp.AsJSONString;
+    end, EMVCJSONRPCException);
+end;
+
+procedure TJSONRPCServerTest.TestHooksNotifWhenOnAfterCallHookRaisesError;
+begin
+  var lNotif: IJSONRPCNotification := TJSONRPCNotification.Create('error_OnAfterCallHook');
+  var lResp: IJSONRPCResponse := FExecutor3.ExecuteNotification(lNotif);
+  Assert.areEqual('', FExecutor3.HTTPResponse.HeaderValue['x-history']);
+  Assert.isTrue(lResp.IsError);
+  Assert.WillNotRaise(
+    procedure
+    begin
+      lResp.AsJSONString;
+    end, EMVCJSONRPCException);
+end;
+
+procedure TJSONRPCServerTest.TestHooksNotifWhenOnBeforeCallHookRaisesError;
+begin
+  var lNotif: IJSONRPCNotification := TJSONRPCNotification.Create('error_OnBeforeCallHook');
+  var lResp: IJSONRPCResponse := FExecutor3.ExecuteNotification(lNotif);
+  Assert.areEqual('', FExecutor3.HTTPResponse.HeaderValue['x-history']);
+  Assert.isTrue(lResp.IsError);
+  Assert.WillNotRaise(
+    procedure
+    begin
+      lResp.AsJSONString;
+    end, EMVCJSONRPCException);
+end;
+
+procedure TJSONRPCServerTest.TestHooksNotifWhenOnBeforeRoutingHookRaisesError;
+begin
+  var lNotif: IJSONRPCNotification := TJSONRPCNotification.Create('error_OnBeforeRoutingHook');
+  var lResp: IJSONRPCResponse := FExecutor3.ExecuteNotification(lNotif);
+  Assert.areEqual('', FExecutor3.HTTPResponse.HeaderValue['x-history']);
+  Assert.isTrue(lResp.IsError);
+  Assert.WillNotRaise(
+    procedure
+    begin
+      lResp.AsJSONString;
+    end, EMVCJSONRPCException);
+end;
+
+procedure TJSONRPCServerTest.TestHooksWhenMethodRaisesError;
+begin
+  var lRequest1: IJSONRPCRequest := TJSONRPCRequest.Create(1234, 'RequestWithError');
+  var lResp := FExecutor3.ExecuteRequest(lRequest1);
+  Assert.areEqual('OnBeforeRoutingHook|OnBeforeCallHook|OnAfterCallHook|error',
+    FExecutor3.HTTPResponse.HeaderValue['x-history']);
+  Assert.isTrue(lResp.IsError, 'Method raised error but response is not an error');
+end;
+
+procedure TJSONRPCServerTest.TestHooksWhenOnAfterCallHookRaisesError;
+begin
+  var lRequest1: IJSONRPCRequest := TJSONRPCRequest.Create(1234, 'error_OnAfterCallHook');
+  var lResp := FExecutor3.ExecuteRequest(lRequest1);
+  Assert.isTrue(lResp.IsError, lResp.ToString(true));
+  Assert.areEqual(lResp.Error.ErrMessage, 'error_OnAfterCallHook');
+end;
+
+procedure TJSONRPCServerTest.TestHooksWhenOnBeforeCallHookRaisesError;
+begin
+  var lRequest1: IJSONRPCRequest := TJSONRPCRequest.Create(1234, 'error_OnBeforeCallHook');
+  var lResp := FExecutor3.ExecuteRequest(lRequest1);
+  Assert.isTrue(lResp.IsError, lResp.ToString(true));
+  Assert.areEqual(lResp.Error.ErrMessage, 'error_OnBeforeCallHook');
+
+end;
+
+procedure TJSONRPCServerTest.TestHooksWhenOnBeforeRoutingHookRaisesError;
+begin
+  var lRequest1: IJSONRPCRequest := TJSONRPCRequest.Create(1234, 'error_OnBeforeRoutingHook');
+  var lResp := FExecutor3.ExecuteRequest(lRequest1);
+  Assert.isTrue(lResp.IsError, lResp.ToString(true));
+  Assert.areEqual(lResp.Error.ErrMessage, 'error_OnBeforeRoutingHook');
+end;
+
+procedure TJSONRPCServerTest.TestNotificationWhichRaisesError;
+var
+  lReq: IJSONRPCNotification;
+begin
+  lReq := TJSONRPCNotification.Create;
+  lReq.Method := 'NotifWithError';
+  var lResp := FExecutor3.ExecuteNotification(lReq);
+  Assert.IsTrue(lResp.IsError);
+  Assert.Contains(lResp.Error.ErrMessage, 'BOOM NOTIF');
+end;
+
+procedure TJSONRPCServerTest.TestNotificationWithoutParams;
+var
+  lReq: IJSONRPCNotification;
+begin
+  lReq := TJSONRPCNotification.Create;
+  lReq.Method := 'mynotify';
+  FExecutor.ExecuteNotification(lReq);
+  FExecutor2.ExecuteNotification(lReq);
+  Assert.Pass();
 end;
 
 procedure TJSONRPCServerTest.TestRequestToNotFoundMethod;
@@ -1978,13 +2119,15 @@ end;
 
 procedure TJSONRPCServerTest.TestRequestWithoutParams;
 var
-  lReq: IJSONRPCNotification;
+  lReq: IJSONRPCRequest;
+  lResp: IJSONRPCResponse;
 begin
-  lReq := TJSONRPCNotification.Create;
+  lReq := TJSONRPCRequest.Create;
-  lReq.Method := 'mynotify';
+  lReq.Method := 'MyRequest';
-  FExecutor.ExecuteNotification(lReq);
+  lReq.RequestID := 1234;
-  FExecutor2.ExecuteNotification(lReq);
+  lResp := FExecutor.ExecuteRequest(lReq);
-  Assert.Pass();
+  Assert.isFalse(lResp.IsError);
+  Assert.isTrue(lResp.Result.AsBoolean);
 end;
 
 procedure TJSONRPCServerTest.TestRequestWithParams_I_I_ret_I;

unittests/general/TestServer/TestServerControllerJSONRPCU.pas

@@ -10,6 +10,7 @@ type
   public
     function Subtract(Value1, Value2: Int64): Integer;
     procedure MyNotify;
+    function MyRequest: Boolean;
     function Add(Value1, Value2, Value3: Int64): TJsonObject;
     function GetListFromTo(aFrom, aTo: Int64): TJsonArray;
     function MultiplyString(aString: string; Multiplier: Int64): string;
@@ -25,6 +26,25 @@ type
     function AddTimeToDateTime(aDateTime: TDateTime; aTime: TTime): TDateTime;
   end;
 
+  TTestJSONRPCHookClass = class(TObject)
+  private
+    fJSONReq: TJsonObject;
+    fHistory: string;
+    fJSONRPCKind: TJSONRPCRequestType;
+  public
+    procedure OnBeforeRoutingHook(const Context: TWebContext; const JSON: TJsonObject);
+    procedure OnBeforeCallHook(const Context: TWebContext; const JSON: TJsonObject);
+    procedure OnAfterCallHook(const Context: TWebContext; const JSON: TJsonObject);
+    function error_OnBeforeRoutingHook: Boolean;
+    function error_OnBeforeCallHook: Boolean;
+    function error_OnAfterCallHook: Boolean;
+
+    procedure Notif1;
+    procedure NotifWithError;
+    function Request1: string;
+    function RequestWithError: string;
+  end;
+
 implementation
 
 uses
@@ -65,6 +85,11 @@ begin
   Self.ClassName;
 end;
 
+function TTestJSONRPCController.MyRequest: Boolean;
+begin
+  Result := True;
+end;
+
 function TTestJSONRPCController.Subtract(Value1, Value2: Int64): Integer;
 begin
   Result := Value1 - Value2;
@@ -116,4 +141,100 @@ begin
   Result := Value1 - Value2;
 end;
 
+{ TTestJSONRPCHookClass }
+
+function TTestJSONRPCHookClass.error_OnAfterCallHook: Boolean;
+begin
+  // do nothing
+  Result := True;
+end;
+
+function TTestJSONRPCHookClass.error_OnBeforeCallHook: Boolean;
+begin
+  // do nothing
+  Result := True;
+end;
+
+function TTestJSONRPCHookClass.error_OnBeforeRoutingHook: Boolean;
+begin
+  // do nothing
+  Result := True;
+end;
+
+procedure TTestJSONRPCHookClass.Notif1;
+begin
+  // do nothing
+end;
+
+procedure TTestJSONRPCHookClass.NotifWithError;
+begin
+  raise Exception.Create('BOOM NOTIF');
+end;
+
+procedure TTestJSONRPCHookClass.OnAfterCallHook(const Context: TWebContext; const JSON: TJsonObject);
+begin
+  try
+    if SameText(fJSONReq.S['method'], 'error_OnAfterCallHook') then
+      raise Exception.Create('error_OnAfterCallHook');
+
+    fHistory := fHistory + '|OnAfterCallHook';
+
+    // do nothing
+    if fJSONRPCKind = TJSONRPCRequestType.Request then
+    begin
+      Assert(Assigned(JSON));
+      LogD('TTestJSONRPCHookClass.OnAfterCallHook: ' + JSON.ToJSON());
+    end
+    else
+    begin
+      if Assigned(JSON) then
+        Assert(JSON.Contains('error'), 'ERROR! Notification has a response but is not an error');
+      LogD('TTestJSONRPCHookClass.OnAfterCallHook: Param is nil');
+    end;
+    if Assigned(JSON) then
+      if JSON.Contains('error') then
+        fHistory := fHistory + '|error';
+    Context.Response.CustomHeaders.Values['x-history'] := fHistory;
+  finally
+    FreeAndNil(fJSONReq);
+  end;
+end;
+
+procedure TTestJSONRPCHookClass.OnBeforeCallHook(const Context: TWebContext; const JSON: TJsonObject);
+begin
+  if SameText(JSON.S['method'], 'error_OnBeforeCallHook') then
+    raise Exception.Create('error_OnBeforeCallHook');
+
+  fHistory := fHistory + '|OnBeforeCallHook';
+  Assert(Assigned(JSON), 'JSON not assigned in OnBeforeCallHook');
+  LogD('TTestJSONRPCHookClass.OnBeforeCallHook: ' + JSON.ToJSON());
+end;
+
+procedure TTestJSONRPCHookClass.OnBeforeRoutingHook(const Context: TWebContext; const JSON: TJsonObject);
+begin
+  fJSONReq := JSON.Clone;
+
+  if SameText(JSON.S['method'], 'error_OnBeforeRoutingHook') then
+    raise Exception.Create('error_OnBeforeRoutingHook');
+
+  fHistory := 'OnBeforeRoutingHook';
+  // do nothing
+  Assert(Assigned(JSON), 'JSON not assigned in OnBeforeRoutingHook');
+  LogD('TTestJSONRPCHookClass.OnBeforeRoutingHook: ' + JSON.ToJSON());
+  if JSON.Contains('id') then
+    fJSONRPCKind := TJSONRPCRequestType.Request
+  else
+    fJSONRPCKind := TJSONRPCRequestType.Notification;
+end;
+
+function TTestJSONRPCHookClass.Request1: string;
+begin
+  Result := 'empty';
+end;
+
+function TTestJSONRPCHookClass.RequestWithError: string;
+begin
+  raise Exception.Create('BOOM REQUEST');
+end;
+
 end.

unittests/general/TestServer/WebModuleUnit.pas

@@ -92,6 +92,11 @@ begin
     begin
       Result := TTestJSONRPCClass.Create
     end, '/jsonrpcclass')
+    .PublishObject(
+    function: TObject
+    begin
+      Result := TTestJSONRPCHookClass.Create
+    end, '/jsonrpcclass1')
     .AddController(TTestFaultController) // this will raise an exception
     .AddController(TTestFault2Controller,
     function: TMVCController