Browse Source

* Different PUT/PATCH. Allow legacy PUT

Michaël Van Canneyt 2 years ago
parent
commit
e84e0a16e1

+ 244 - 137
packages/fcl-web/src/restbridge/sqldbrestbridge.pp

@@ -19,17 +19,20 @@ unit sqldbrestbridge;
 interface
 
 uses
-  Classes, SysUtils, DB, SQLDB, httpdefs, httproute, fpjson, sqldbrestschema, sqldbrestio, sqldbrestdata, sqldbrestauth;
+  Classes, SysUtils, DB, SQLDB, httpdefs, httproute, fpjson, sqldbrestschema, sqldbrestio, sqldbrestdata, sqldbrestauth, sqldbpool;
 
 Type
-  TRestDispatcherOption = (rdoConnectionInURL,     // Route includes connection :Connection/:Resource[/:ID]
-                           rdoExposeMetadata,      // expose metadata resource /metadata[/:Resource]
-                           rdoCustomView,          // Expose custom view /customview
-                           rdoHandleCORS,          // Handle CORS requests
-                           rdoAccessCheckNeedsDB,  // Authenticate after connection to database was made.
-                           rdoConnectionResource,   // Enable connection managament through /_connection[/:Conn] resource
-                           rdoEmptyCORSDomainToOrigin // if CORSAllowedOrigins is empty CORS requests will mirror Origin instead of *
-                           // rdoServerInfo        // Enable querying server info through /_serverinfo  resource
+  TRestDispatcherOption = (rdoConnectionInURL,        // Route includes connection :Connection/:Resource[/:ID]
+                           rdoExposeMetadata,          // expose metadata resource /metadata[/:Resource]
+                           rdoCustomView,              // Expose custom view /customview
+                           rdoHandleCORS,              // Handle CORS requests
+                           rdoAccessCheckNeedsDB,      // Authenticate after connection to database was made.
+                           rdoConnectionResource,      // Enable connection managament through /_connection[/:Conn] resource
+                           rdoEmptyCORSDomainToOrigin, // if CORSAllowedOrigins is empty CORS requests will mirror Origin instead of *
+                           // rdoServerInfo            // Enable querying server info through /_serverinfo  resource
+                           rdoLegacyPut,               // Makes PUT simulate PATCH : Not all values are required, missing values will be gotten from previous record.
+                           rdoAllowNoRecordUpdates,    // Check rows affected, rowsaffected = 0 is OK.
+                           rdoAllowMultiRecordUpdates  // Check rows affected, rowsaffected > 1 is OK.
                            );
 
   TRestDispatcherOptions = set of TRestDispatcherOption;
@@ -53,27 +56,15 @@ Type
 
   { TSQLDBRestConnection }
 
-  TSQLDBRestConnection = Class(TCollectionItem)
+  TSQLDBRestConnection = Class(TSQLDBConnectionDef)
   private
-    FCharSet: UTF8String;
     FConnection: TSQLConnection;
-    FConnectionType: String;
-    FDatabaseName: UTF8String;
     FEnabled: Boolean;
-    FHostName: UTF8String;
-    FName: UTF8String;
-    FParams: TStrings;
-    FPassword: UTF8String;
-    FPort: Word;
-    FRole: UTF8String;
     FSchemaName: UTF8String;
-    FUserName: UTF8String;
     FNotifier : TComponent;
-    function GetName: UTF8String;
     procedure SetConnection(AValue: TSQLConnection);
-    procedure SetParams(AValue: TStrings);
   Protected
-    Function GetDisplayName: string; override;
+    function GetName: UTF8String; override;
     // For use in the REST Connection resource
     Property SchemaName : UTF8String Read FSchemaName Write FSchemaName;
   Public
@@ -84,33 +75,11 @@ Type
   Published
     // Always use this connection instance
     Property SingleConnection : TSQLConnection Read FConnection Write SetConnection;
-    // Allow this connection to be used.
-    Property Enabled : Boolean Read FEnabled Write FEnabled default true;
-    // TSQLConnector type
-    property ConnectionType : String Read FConnectionType Write FConnectionType;
-    // Name for this connection
-    Property Name : UTF8String Read GetName Write FName;
-    // Database user password
-    property Password : UTF8String read FPassword write FPassword;
-    // Database username
-    property UserName : UTF8String read FUserName write FUserName;
-    // Database character set
-    property CharSet : UTF8String read FCharSet write FCharSet;
-    // Database hostname
-    property HostName : UTF8String Read FHostName Write FHostName;
-    // Database role
-    Property Role :  UTF8String read FRole write FRole;
-    // Database database name
-    property DatabaseName : UTF8String Read FDatabaseName Write FDatabaseName;
-    // Other parameters
-    Property Params : TStrings Read FParams Write SetParams;
-    // Port DB is listening on
-    Property Port : Word Read FPort Write FPort;
-  end;
+   end;
 
   { TSQLDBRestConnectionList }
 
-  TSQLDBRestConnectionList = Class(TCollection)
+  TSQLDBRestConnectionList = Class(TSQLDBConnectionDefList)
   private
     function GetConn(aIndex : integer): TSQLDBRestConnection;
     procedure SetConn(aIndex : integer; AValue: TSQLDBRestConnection);
@@ -178,7 +147,7 @@ Type
 
   TResourceAuthorizedEvent = Procedure (Sender : TObject; aRequest : TRequest; Const aResource : UTF8String; var AllowResource : Boolean) of object;
   TGetConnectionNameEvent = Procedure(Sender : TObject; aRequest : TRequest; Const AResource : String; var AConnectionName : UTF8String) of object;
-  TGetConnectionEvent = Procedure(Sender : TObject; aDef : TSQLDBRestConnection; var aConnection : TSQLConnection) of object;
+  TGetConnectionEvent = Procedure(Sender : TObject; aDef : TSQLDBConnectionDef; var aConnection : TSQLConnection) of object;
   TRestExceptionEvent = Procedure(Sender : TObject; aRequest : TRequest; Const AResource : string; E : Exception) of object;
   TRestOperationEvent = Procedure(Sender : TObject; aConn: TSQLConnection; aResource : TSQLDBRestResource) of object;
   TRestGetFormatEvent = Procedure(Sender : TObject; aRest : TRequest; var aFormat : String) of object;
@@ -190,6 +159,7 @@ Type
     Class Var FDBHandlerClass : TSQLDBRestDBHandlerClass;
   private
     FAdminUserIDs: TStrings;
+    FConnectionManager: TSQLDBConnectionManager;
     FCORSAllowCredentials: Boolean;
     FCORSAllowedOrigins: String;
     FCORSMaxAge: Integer;
@@ -234,10 +204,15 @@ Type
     FMetadataItemRoute: THTTPRoute;
     FStatus: TRestStatusConfig;
     FStrings: TRestStringsConfig;
+    FAfterDatabaseRead: TRestDatabaseEvent;
+    FAfterDatabaseUpdate: TRestDatabaseEvent;
+    FBeforeDatabaseRead: TRestDatabaseEvent;
+    FBeforeDatabaseUpdate: TRestDatabaseEvent;
     function GetRoutesRegistered: Boolean;
     procedure SetActive(AValue: Boolean);
     procedure SetAdminUserIDS(AValue: TStrings);
     procedure SetAuthenticator(AValue: TRestAuthenticator);
+    procedure SetConnectionManager(AValue: TSQLDBConnectionManager);
     procedure SetConnections(AValue: TSQLDBRestConnectionList);
     procedure SetDispatchOptions(AValue: TRestDispatcherOptions);
     procedure SetSchemas(AValue: TSQLDBRestSchemaList);
@@ -245,6 +220,7 @@ Type
     procedure SetStrings(AValue: TRestStringsConfig);
   Protected
     // Logging
+    procedure DoConnectionManagerLog(Sender: TObject; const Msg: string); virtual;
     Function MustLog(aLog : TRestDispatcherLogOption) : Boolean; inline;
     procedure DoSQLLog(Sender: TObject; EventType: TDBEventType;  const Msg: String); virtual;
     procedure DoLog(aLog: TRestDispatcherLogOption; IO : TRestIO; const aMessage: UTF8String);  virtual;
@@ -253,8 +229,10 @@ Type
     // Auxiliary methods.
     Procedure Loaded; override;
     Procedure Notification(AComponent: TComponent; Operation: TOperation); override;
-    function FindConnection(IO: TRestIO): TSQLDBRestConnection;
+    function FindConnection(IO: TRestIO): TSQLDBConnectionDef;
+    function GetConnectionManager : TSQLDBConnectionmanager;
     // Factory methods. Override these to customize various helper classes.
+    Function CreateConnectionManager : TSQLDBConnectionmanager;
     function CreateConnection: TSQLConnection; virtual;
     Function CreateConnectionList : TSQLDBRestConnectionList; virtual;
     Function CreateSchemaList : TSQLDBRestSchemaList; virtual;
@@ -267,14 +245,14 @@ Type
     function GetInputFormat(IO: TRestIO): String; virtual;
     function GetOutputFormat(IO: TRestIO): String; virtual;
     function GetConnectionName(IO: TRestIO): UTF8String;
-    function GetSQLConnection(aConnection: TSQLDBRestConnection; Out aTransaction : TSQLTransaction): TSQLConnection; virtual;
-    procedure DoneSQLConnection(aConnection: TSQLDBRestConnection; AConn: TSQLConnection; aTransaction : TSQLTransaction); virtual;
+    function GetSQLConnection(aConnection: TSQLDBConnectionDef; Out aTransaction : TSQLTransaction): TSQLConnection; virtual;
+    procedure DoneSQLConnection(aConnection: TSQLDBConnectionDef; AConn: TSQLConnection; aTransaction : TSQLTransaction); virtual;
     // Connections dataset API
     procedure ConnectionsToDataset(D: TDataset); virtual;
     procedure DoConnectionDelete(DataSet: TDataSet); virtual;
     procedure DoConnectionPost(DataSet: TDataSet);virtual;
     procedure DatasetToConnection(D: TDataset; C: TSQLDBRestConnection); virtual;
-    procedure ConnectionToDataset(C: TSQLDBRestConnection; D: TDataset); virtual;
+    procedure ConnectionToDataset(C: TSQLDBConnectionDef; D: TDataset); virtual;
     procedure DoConnectionResourceAllowed(aSender: TObject; aContext: TBaseRestContext; var allowResource: Boolean);
     // Error handling
     procedure CreateErrorContent(IO: TRestIO; aCode: Integer; AExtraMessage: UTF8String); virtual;
@@ -312,8 +290,8 @@ Type
     procedure DoRegisterRoutes; virtual;
     procedure DoHandleEvent(IsBefore : Boolean;IO: TRestIO); virtual;
     function ResolvedCORSAllowedOrigins(aRequest: TRequest): String; virtual;
-    procedure HandleCORSRequest(aConnection: TSQLDBRestConnection; IO: TRestIO); virtual;
-    procedure HandleResourceRequest(aConnection : TSQLDBRestConnection; IO: TRestIO); virtual;
+    procedure HandleCORSRequest(aConnection: TSQLDBConnectionDef; IO: TRestIO); virtual;
+    procedure HandleResourceRequest(aConnection : TSQLDBConnectionDef; IO: TRestIO); virtual;
     procedure DoHandleRequest(IO: TRestIO); virtual;
   Public
     Class Procedure SetIOClass (aClass: TRestIOClass);
@@ -340,6 +318,8 @@ Type
     Property Schemas : TSQLDBRestSchemaList Read FSchemas Write SetSchemas;
     // Base URL
     property BasePath : UTF8String Read FBaseURL Write FBaseURL;
+    // Connection manager to use
+    property ConnectionManager : TSQLDBConnectionManager Read GetConnectionManager Write SetConnectionManager;
     // Default connection to use if none is detected from request/schema
     // This connection will also be used to authenticate the user for connection API,
     // so it must be set if you use SQL to authenticate the user.
@@ -402,6 +382,12 @@ Type
     Property BeforeDelete : TRestOperationEvent Read FBeforeDelete Write FBeforeDelete;
     // Called After a DELETE request.
     Property AfterDelete : TRestOperationEvent Read FAfterDelete Write FAfterDelete;
+    // Events called when accessing the database during read operations
+    Property BeforeDatabaseRead: TRestDatabaseEvent Read FBeforeDatabaseRead Write FBeforeDatabaseRead;
+    Property AfterDatabaseRead : TRestDatabaseEvent Read FAfterDatabaseRead Write FAfterDatabaseRead;
+    // Events called when accessing the database during update operations
+    Property BeforeDatabaseUpdate : TRestDatabaseEvent Read FBeforeDatabaseUpdate Write FBeforeDatabaseUpdate;
+    Property AfterDatabaseUpdate : TRestDatabaseEvent Read FAfterDatabaseUpdate Write FAfterDatabaseUpdate;
     // Called when logging
     Property OnLog : TRestLogEvent Read FOnLog Write FOnLog;
   end;
@@ -557,6 +543,12 @@ begin
   FActive:=AValue;
 end;
 
+procedure TSQLDBRestDispatcher.DoConnectionManagerLog(Sender: TObject;
+  const Msg: string);
+begin
+  DoLog(rloConnection,Nil,Msg);
+end;
+
 function TSQLDBRestDispatcher.GetRoutesRegistered: Boolean;
 begin
   Result:=FItemRoute<>Nil;
@@ -578,6 +570,25 @@ begin
     FAuthenticator.FreeNotification(Self);
 end;
 
+
+procedure TSQLDBRestDispatcher.SetConnectionManager(AValue: TSQLDBConnectionManager);
+begin
+  if FConnectionManager=AValue then Exit;
+  if Assigned(FCOnnectionManager) then
+    begin
+    if (csSubComponent in FConnectionManager.ComponentStyle)
+       and (FConnectionManager.Owner=Self) then
+      FreeAndNil(FConnectionManager)
+    else
+      FConnectionManager.RemoveFreeNotification(Self) ;
+    end;
+  FConnectionManager:=AValue;
+  if Assigned(FConnectionManager) then
+     FConnectionManager.FreeNotification(Self)
+  else
+     GetConnectionManager;
+end;
+
 procedure TSQLDBRestDispatcher.SetSchemas(AValue: TSQLDBRestSchemaList);
 begin
   if FSchemas=AValue then Exit;
@@ -1122,11 +1133,16 @@ begin
     M:=aRequest.CustomHeaders.Values['Access-Control-Request-Method'];
   Case lowercase(M) of
     'get' : Result:=roGet;
-    'put' : Result:=roPut;
+    'put' :
+      begin
+      Result:=roPut;
+
+      end;
     'post' : Result:=roPost;
     'delete' : Result:=roDelete;
     'options' : Result:=roOptions;
     'head' : Result:=roHead;
+    'patch' : Result:=roPatch;
   end;
 end;
 
@@ -1183,7 +1199,7 @@ begin
 end;
 
 function TSQLDBRestDispatcher.GetSQLConnection(
-  aConnection: TSQLDBRestConnection; out aTransaction: TSQLTransaction
+  aConnection: TSQLDBConnectionDef; out aTransaction: TSQLTransaction
   ): TSQLConnection;
 
 begin
@@ -1191,49 +1207,120 @@ begin
   aTransaction:=Nil;
   if aConnection=Nil then
     exit;
-  Result:=aConnection.SingleConnection;
+  if aConnection is TSQLDBRestConnection then
+  Result:=TSQLDBRestConnection(aConnection).SingleConnection;
   if (Result=Nil) then
     begin
     if Assigned(OnGetConnection) then
       OnGetConnection(Self,aConnection,Result);
     if (Result=Nil) then
-      begin
-      Result:=CreateConnection;
-      aConnection.ConfigConnection(Result);
-      aConnection.SingleConnection:=Result;
-      end;
+      Result:=GetConnectionManager.GetConnection(aConnection);
     end;
   If (Result is TRestSQLConnector) then
     TRestSQLConnector(Result).StartUsing;
-  aTransaction:=TSQLTransaction.Create(Self);
-  aTransaction.Database:=Result;
+  if Result.Transaction=Nil then
+    begin
+    aTransaction:=TSQLTransaction.Create(Result);
+    aTransaction.Database:=Result;
+    end
+  else
+    aTransaction:=Result.Transaction;
 end;
 
 procedure TSQLDBRestDispatcher.DoHandleEvent(IsBefore: Boolean; IO: TRestIO);
 
 Var
   R : TRestOperationEvent;
+  Evt,ResEvt : TRestDatabaseEvent;
+  BP :TSQLDBRestBusinessProcessor;
 
 begin
+  Evt:=Nil;
+  ResEvt:=Nil;
   R:=Nil;
+  BP:=TSQLDBRestBusinessProcessor(IO.Resource.BusinessProcessor);
   if isBefore then
     Case IO.Operation of
-      roGet : R:=FBeforeGet;
-      roPut : R:=FBeforePut;
-      roPost : R:=FBeforePost;
-      roDelete : R:=FBeforeDelete;
+      roGet :
+        begin
+        R:=FBeforeGet;
+        Evt:=BeforeDatabaseRead;
+        if assigned(BP) then
+          ResEvt:=BP.BeforeDatabaseRead;
+        end;
+      roHead :
+        begin
+        Evt:=BeforeDatabaseRead;
+        if assigned(BP) then
+          ResEvt:=BP.BeforeDatabaseRead;
+        end;
+      roPut :
+        begin
+        R:=FBeforePut;
+        Evt:=BeforeDatabaseUpdate;
+        if assigned(BP) then
+          ResEvt:=BP.BeforeDatabaseUpdate;
+        end;
+      roPost :
+        begin
+        R:=FBeforePost;
+        Evt:=BeforeDatabaseUpdate;
+        if assigned(BP) then
+          ResEvt:=BP.BeforeDatabaseUpdate;
+        end;
+      roDelete :
+        begin
+        R:=FBeforeDelete;
+        Evt:=BeforeDatabaseUpdate;
+        if assigned(BP) then
+          ResEvt:=BP.BeforeDatabaseUpdate;
+        end;
     else
       R:=Nil;
     end
   else
     Case IO.Operation of
-      roGet : R:=FAfterGet;
-      roPut : R:=FAfterPut;
-      roPost : R:=FAfterPost;
-      roDelete : R:=FAfterDelete;
+      roGet :
+        begin
+        R:=FAfterGet;
+        Evt:=AfterDatabaseRead;
+        if assigned(BP) then
+          ResEvt:=BP.AfterDatabaseRead;
+        end;
+      roHead :
+        begin
+        Evt:=AfterDatabaseRead;
+        if assigned(BP) then
+          ResEvt:=BP.AfterDatabaseRead;
+        end;
+      roPut :
+        begin
+        R:=FAfterPut;
+        Evt:=AfterDatabaseUpdate;
+        if assigned(BP) then
+          ResEvt:=BP.AfterDatabaseUpdate;
+        end;
+      roPost :
+        begin
+        R:=FAfterPost;
+        Evt:=AfterDatabaseUpdate;
+        if assigned(BP) then
+          ResEvt:=BP.AfterDatabaseUpdate;
+        end;
+      roDelete :
+        begin
+        R:=FAfterDelete;
+        Evt:=AfterDatabaseUpdate;
+        if assigned(BP) then
+          ResEvt:=BP.AfterDatabaseUpdate;
+        end;
     else
       R:=Nil;
     end;
+  If Assigned(Evt) then
+    Evt(Self,IO.OPeration,IO.RestContext,IO.Resource);
+  If Assigned(ResEvt) then
+    ResEvt(Self,IO.Operation,IO.RestContext,IO.Resource);
   If Assigned(R) then
     R(Self,IO.Connection,IO.Resource)
 end;
@@ -1241,39 +1328,48 @@ end;
 
 
 procedure TSQLDBRestDispatcher.DoneSQLConnection(
-  aConnection: TSQLDBRestConnection; AConn: TSQLConnection;
+  aConnection: TSQLDBConnectionDef; AConn: TSQLConnection;
   aTransaction: TSQLTransaction);
 
 Var
-  NeedNil : Boolean;
+  RConn : TSQLDBRestConnection absolute aConnection;
 
 begin
-  FreeAndNil(aTransaction);
-  if (aConn is TRestSQLConnector) then
-    begin
-    NeedNil:= (aConnection.SingleConnection=aConn) ;
-    if TRestSQLConnector(aConn).DoneUsing then
-      FreeAndNil(aConn);
-    If NeedNil then
-      aConnection.SingleConnection:=Nil;
-    end;
+  if aTransaction<>aConn.Transaction then
+    FreeAndNil(aTransaction);
+  if Not ((aConnection is TSQLDBRestConnection) and (RConn.SingleConnection=aConn)) then
+    if not GetConnectionManager.ReleaseConnection(aConn) then
+      aConn.Free;
 end;
 
 
 function TSQLDBRestDispatcher.CreateDBHandler(IO: TRestIO): TSQLDBRestDBHandler;
 
+Var
+  Opts : TSQLDBRestDBHandlerOptions;
+
+
 begin
   Result:=FDBHandlerClass.Create(Self) ;
   Result.Init(IO,FStrings,TSQLQuery);
   Result.EnforceLimit:=Self.EnforceLimit;
+  opts:=[];
+  if rdoLegacyPut in DispatchOptions then
+    Include(opts,rhoLegacyPUT);
+  if ([rdoAllowNoRecordUpdates,rdoAllowMultiRecordUpdates] * DispatchOptions)<>[] then
+    Include(opts,rhoCheckupdateCount);
+  if (rdoAllowMultiRecordUpdates in DispatchOptions) then
+    Include(opts,rhoAllowMultiUpdate);
+  // Options may have been set in handler class, make sure we don't unset any.
+  Result.Options:=Result.Options+Opts;
 end;
 
 
 procedure TSQLDBRestDispatcher.SetDefaultResponsecode(IO : TRestIO);
 
 Const
-  DefaultCodes : Array[TRestOperation] of TRestStatus = (rsError,rsGetOK,rsPOSTOK,rsPUTOK,rsDeleteOK,rsCORSOK,rsGetOK);
-  DefaultTexts : Array[TRestOperation] of string = ('Internal Error','OK','Created','OK','No content','OK','OK');
+  DefaultCodes : Array[TRestOperation] of TRestStatus = (rsError,rsGetOK,rsPOSTOK,rsPUTOK,rsDeleteOK,rsCORSOK,rsGetOK,rsPatchOK);
+  DefaultTexts : Array[TRestOperation] of string = ('Internal Error','OK','Created','OK','No content','OK','OK','OK');
 
 Var
   aCode : TRestStatus;
@@ -1467,7 +1563,10 @@ begin
     C.SchemaName:=D.FieldByName('exposeSchemaName').AsString;
 end;
 
-procedure TSQLDBRestDispatcher.ConnectionToDataset(C : TSQLDBRestConnection;D: TDataset);
+procedure TSQLDBRestDispatcher.ConnectionToDataset(C : TSQLDBConnectionDef;D: TDataset);
+
+Var
+  RestDef : TSQLDBRestConnection absolute C;
 
 begin
   D.FieldByName('key').AsWideString:=UTF8Decode(C.Name);
@@ -1481,8 +1580,17 @@ begin
   D.FieldByName('dbRole').AsString:=C.Role;
   D.FieldByName('dbPort').AsInteger:=C.Port;
   D.FieldByName('enabled').AsBoolean:=C.Enabled;
-  D.FieldByName('expose').AsBoolean:=(C.SchemaName<>'');
-  D.FieldByName('exposeSchemaName').AsString:=C.SchemaName;
+  if C is TSQLDBRestConnection then
+    begin
+    D.FieldByName('expose').AsBoolean:=(RestDef.SchemaName<>'');
+    D.FieldByName('exposeSchemaName').AsString:=RestDef.SchemaName;
+    end
+  else
+    begin
+    D.FieldByName('expose').AsBoolean:=False;
+    D.FieldByName('exposeSchemaName').AsString:='';
+    end;
+
 end;
 
 procedure TSQLDBRestDispatcher.ConnectionsToDataset(D: TDataset);
@@ -1689,7 +1797,7 @@ begin
     Result:='*';
 end;
 
-procedure TSQLDBRestDispatcher.HandleCORSRequest(aConnection : TSQLDBRestConnection; IO : TRestIO);
+procedure TSQLDBRestDispatcher.HandleCORSRequest(aConnection : TSQLDBConnectionDef; IO : TRestIO);
 
 Var
   S : String;
@@ -1720,7 +1828,7 @@ begin
     end;
 end;
 
-procedure TSQLDBRestDispatcher.HandleResourceRequest(aConnection : TSQLDBRestConnection; IO : TRestIO);
+procedure TSQLDBRestDispatcher.HandleResourceRequest(aConnection : TSQLDBConnectionDef; IO : TRestIO);
 
 Var
   Conn : TSQLConnection;
@@ -1804,12 +1912,20 @@ begin
   Result:=N;
 end;
 
-function TSQLDBRestDispatcher.FindConnection(IO: TRestIO): TSQLDBRestConnection;
+function TSQLDBRestDispatcher.FindConnection(IO: TRestIO): TSQLDBConnectionDef;
+
+{
+  - Is a name given ? there a definition with the correct name in our connections:
+    Yes - Use that.
+    No - Check if connectionmanager has a connection with the name
+  - If the previous step didn't result in a connection
+}
 
 Var
   N : UTF8String;
 
 begin
+  Result:=Nil;
   N:=GetConnectionName(IO);
   // If we have a name, look for it
   if (N<>'') then
@@ -1817,16 +1933,40 @@ begin
     Result:=Connections.FindConnection(N);
     if Assigned(Result) and not (Result.Enabled) then
       Result:=Nil;
+    If (Result=Nil) and (GetConnectionManager<>Nil) then
+      Result:=GetConnectionManager.Definitions.Find(N);
     end
-  else if Connections.Count=1 then
-    Result:=Connections[0]
   else
-    Result:=Nil;
+    begin
+    if Connections.Count=1 then
+      begin
+      Result:=Connections[0];
+      If (Result=Nil) and (GetConnectionManager<>Nil) and (GetConnectionManager.Definitions.Count=1) then
+        Result:=GetConnectionManager.Definitions[0];
+      end;
+    end;
+end;
+
+function TSQLDBRestDispatcher.GetConnectionManager: TSQLDBConnectionmanager;
+begin
+  if FConnectionManager=Nil then
+    begin
+    FConnectionManager:=CreateConnectionManager;
+    FConnectionManager.SetSubComponent(True);
+    FConnectionManager.OnLog:=@DoConnectionManagerLog;
+    end;
+  Result:=FConnectionManager;
+end;
+
+function TSQLDBRestDispatcher.CreateConnectionManager: TSQLDBConnectionmanager;
+begin
+  Result:=TSQLDBConnectionmanager.Create(Self);
+  Result.SetSubComponent(True);
 end;
 
 function TSQLDBRestDispatcher.CreateConnectionList: TSQLDBRestConnectionList;
 begin
-  Result:=TSQLDBRestConnectionList.Create(TSQLDBRestConnection);
+  Result:=TSQLDBRestConnectionList.Create(Self,TSQLDBRestConnection);
 
 end;
 
@@ -1868,7 +2008,7 @@ var
   ResourceName : UTF8String;
   Operation : TRestOperation;
   Resource : TSQLDBRestResource;
-  Connection : TSQLDBRestConnection;
+  Connection : TSQLDBConnectionDef;
 
 begin
   Operation:=ExtractRestOperation(IO.Request);
@@ -2028,7 +2168,9 @@ begin
   if Operation=opRemove then
     begin
     if AComponent=FAuthenticator then
-      FAuthenticator:=Nil
+      FAuthenticator:=Nil;
+    if FConnectionManager=aComponent then
+      FConnectionManager:=Nil;
     end;
 end;
 
@@ -2248,9 +2390,7 @@ end;
 function TSQLDBRestConnectionList.IndexOfConnection(const aName: UTF8string
   ): Integer;
 begin
-  Result:=Count-1;
-  While (Result>=0) and not SameText(GetConn(Result).Name,aName) do
-    Dec(Result);
+  Result:=IndexOf(aName);
 end;
 
 function TSQLDBRestConnectionList.FindConnection(const aName: UTF8string): TSQLDBRestConnection;
@@ -2380,16 +2520,6 @@ end;
 
 { TSQLDBRestConnection }
 
-procedure TSQLDBRestConnection.SetParams(AValue: TStrings);
-begin
-  if FParams=AValue then Exit;
-  FParams.Assign(AValue);
-end;
-
-function TSQLDBRestConnection.GetDisplayName: string;
-begin
-  Result:=Name;
-end;
 
 procedure TSQLDBRestConnection.SetConnection(AValue: TSQLConnection);
 begin
@@ -2403,7 +2533,7 @@ end;
 
 function TSQLDBRestConnection.GetName: UTF8String;
 begin
-  Result:=FName;
+  Result:=Inherited GetName;
   if (Result='') and Assigned(SingleConnection) then
     Result:=SingleConnection.Name;
   if (Result='') then
@@ -2413,7 +2543,6 @@ end;
 constructor TSQLDBRestConnection.Create(ACollection: TCollection);
 begin
   inherited Create(ACollection);
-  FParams:=TStringList.Create;
   FNotifier:=TConnectionFreeNotifier.Create(Nil);
   TConnectionFreeNotifier(FNotifier).FRef:=Self;
   FEnabled:=True;
@@ -2423,45 +2552,23 @@ destructor TSQLDBRestConnection.Destroy;
 begin
   TConnectionFreeNotifier(FNotifier).FRef:=Nil;
   FreeAndNil(FNotifier);
-  FreeAndNil(FParams);
   inherited Destroy;
 end;
 
 procedure TSQLDBRestConnection.Assign(Source: TPersistent);
 
 Var
-  C : TSQLDBRestConnection;
+  C : TSQLDBRestConnection absolute source;
 
 begin
   if (Source is TSQLDBRestConnection) then
-    begin
-    C:=Source as TSQLDBRestConnection;
-    Password:=C.Password;
-    UserName:=C.UserName;
-    CharSet :=C.CharSet;
-    HostName:=C.HostName;
-    Role:=C.Role;
-    DatabaseName:=C.DatabaseName;
-    ConnectionType:=C.ConnectionType;
-    Port:=C.Port;
-    Name:=C.Name;
     SchemaName:=C.SchemaName;
-    Params.Assign(C.Params);
-    end
-  else
-    inherited Assign(Source);
+  inherited Assign(Source);
 end;
 
 procedure TSQLDBRestConnection.ConfigConnection(aConn: TSQLConnection);
 begin
-  aConn.CharSet:=Self.CharSet;
-  aConn.HostName:=Self.HostName;
-  aConn.DatabaseName:=Self.DatabaseName;
-  aConn.UserName:=Self.UserName;
-  aConn.Password:=Self.Password;
-  aConn.Params:=Self.Params;
-  if aConn is TSQLConnector then
-    TSQLConnector(aConn).ConnectorType:=Self.ConnectionType;
+  Inherited AssignTo(aConn);
 end;
 
 

+ 3 - 0
packages/fcl-web/src/restbridge/sqldbrestconst.pp

@@ -49,6 +49,9 @@ Resourcestring
   SErrNoSQLStatement = 'Could not find SQL statement for custom view';
   SErrOnlySELECTSQLAllowedInCustomView = 'Only SELECT SQL is allowed for '
     +'custom view';
+  SErrMissingInputFields = 'Missing required fields in input data: %s.';
+  SErrNoRecordsUpdated = 'No records were updated.';
+  SErrTooManyRecordsUpdated = 'Too many records (%d) were updated.';
 
 Const
   DefaultAuthenticationRealm = 'REST API Server';

+ 153 - 40
packages/fcl-web/src/restbridge/sqldbrestdata.pp

@@ -33,6 +33,8 @@ Type
   TRestFilterPairArray = Array of TRestFilterPair;
 
   { TSQLDBRestDBHandler }
+  TSQLDBRestDBHandlerOption = (rhoLegacyPut,rhoCheckupdateCount,rhoAllowMultiUpdate);
+  TSQLDBRestDBHandlerOptions = set of TSQLDBRestDBHandlerOption;
 
   TSQLDBRestDBHandler = Class(TComponent)
   private
@@ -40,23 +42,29 @@ Type
     FEmulateOffsetLimit: Boolean;
     FEnforceLimit: Int64;
     FExternalDataset: TDataset;
+    FOptions: TSQLDBRestDBHandlerOptions;
     FPostParams: TParams;
     FQueryClass: TSQLQueryClass;
     FRestIO: TRestIO;
     FStrings : TRestStringsConfig;
     FResource : TSQLDBRestResource;
     FOwnsResource : Boolean;
+    procedure CheckAllRequiredFieldsPresent;
+    function GetAllowMultiUpdate: Boolean;
+    function GetCheckUpdateCount: Boolean;
+    function GetUseLegacyPUT: Boolean;
     procedure SetExternalDataset(AValue: TDataset);
   Protected
     function StreamRecord(O: TRestOutputStreamer; D: TDataset; FieldList: TRestFieldPairArray): Boolean; virtual;
     function FindExistingRecord(D: TDataset): Boolean;
+    function GetRequestFields: TSQLDBRestFieldArray;
     procedure CreateResourceFromDataset(D: TDataset); virtual;
     procedure DoNotFound; virtual;
     procedure SetPostParams(aParams: TParams; Old : TFields = Nil);virtual;
     procedure SetPostFields(aFields: TFields);virtual;
     procedure SetFieldFromData(DataField: TField; ResField: TSQLDBRestField; D: TJSONData); virtual;
     procedure InsertNewRecord; virtual;
-    procedure UpdateExistingRecord(OldData: TDataset); virtual;
+    procedure UpdateExistingRecord(OldData: TDataset; IsPatch : Boolean); virtual;
     Procedure Notification(AComponent: TComponent; Operation: TOperation); override;
     function SpecialResource: Boolean; virtual;
     function GetGeneratorValue(const aGeneratorName: String): Int64; virtual;
@@ -76,9 +84,14 @@ Type
     procedure DoHandleGet;virtual;
     procedure DoHandleDelete;virtual;
     procedure DoHandlePost;virtual;
+    procedure DoHandlePutPatch(IsPatch : Boolean); virtual;
     procedure DoHandlePut; virtual;
+    procedure DoHandlePatch; virtual;
     // Parameters used when executing update SQLs. Used to get values for return dataset params.
     Property PostParams : TParams Read FPostParams;
+    Property UseLegacyPUT : Boolean Read GetUseLegacyPUT;
+    Property CheckUpdateCount : Boolean Read GetCheckUpdateCount;
+    Property AllowMultiUpdate : Boolean Read GetAllowMultiUpdate;
   Public
     Destructor Destroy; override;
     // Get limi
@@ -96,6 +109,8 @@ Type
     Property ExternalDataset : TDataset Read FExternalDataset Write SetExternalDataset;
     Property EmulateOffsetLimit : Boolean Read FEmulateOffsetLimit Write FEmulateOffsetLimit;
     Property DeriveResourceFromDataset : Boolean Read FDeriveResourceFromDataset Write FDeriveResourceFromDataset;
+    Property Options : TSQLDBRestDBHandlerOptions Read FOptions Write FOptions;
+
   end;
   TSQLDBRestDBHandlerClass = class of TSQLDBRestDBHandler;
 
@@ -665,6 +680,8 @@ begin
   Try
     Q.UsePrimaryKeyAsKey:=False;
     FillParams(roGet,Q.Params,WhereFilterList);
+    if Not SpecialResource then
+      IO.Resource.CheckParams(IO.RestContext,roPost,Q.Params);
     Result:=Q;
   except
     Q.Free;
@@ -837,7 +854,15 @@ begin
       else if IO.GetVariable(P.Name,V,[vsContent,vsQuery])<>vsNone then
         D:=TJSONString.Create(V);
       if (D=Nil) and Assigned(Fold) then
-        P.AssignFromField(Fold) // use old value
+        begin
+{$IFDEF VER3_2_2}
+        // ftLargeInt is missing
+        if Fold.DataType=ftLargeInt then
+          P.AsLargeInt:=FOld.AsLargeInt
+        else
+{$ENDIF}
+          P.AssignFromField(Fold) // use old value
+        end
       else
         SetParamFromData(P,F,D); // Use new value, if any
     finally
@@ -909,12 +934,107 @@ begin
   end;
 end;
 
-procedure TSQLDBRestDBHandler.UpdateExistingRecord(OldData : TDataset);
+procedure TSQLDBRestDBHandler.DoHandlePutPatch(IsPatch: Boolean);
 
 Var
-  S : TSQLStatement;
+  D : TDataset;
+  FieldList : TRestFieldPairArray;
+
+begin
+  // We do this first, so we don't run any unnecessary queries
+  if not IO.RESTInput.SelectObject(0) then
+    Raise ESQLDBRest.Create(IO.RestStatuses.GetStatusCode(rsInvalidParam),SErrNoResourceDataFound);
+  // Get the original record.
+  FieldList:=BuildFieldList(True);
+  D:=GetDatasetForResource(FieldList,True);
+  try
+    if not FindExistingRecord(D) then
+      begin
+      DoNotFound;
+      exit;
+      end;
+    UpdateExistingRecord(D,IsPatch);
+    // Now build response
+    if D<>ExternalDataset then
+      begin;
+      // Now build response. We can imagine not doing a select again, and simply supply back the fields as sent...
+      FreeAndNil(D);
+      D:=GetDatasetForResource(FieldList,True);
+      FieldList:=BuildFieldList(False);
+      D.Open;
+      end;
+    IO.RESTOutput.OutputOptions:=IO.RESTOutput.OutputOptions-[ooMetadata];
+    StreamDataset(IO.RESTOutput,D,FieldList);
+  finally
+    D.Free;
+  end;
+end;
+
+
+function TSQLDBRestDBHandler.GetRequestFields : TSQLDBRestFieldArray;
+
+Var
+  F : TSQLDBRestField;
+  aSize : Integer;
+
+begin
+  Result:=[];
+  SetLength(Result,FResource.Fields.Count);
+  aSize:=0;
+  For F in FResource.Fields do
+    if FRestIO.RESTInput.HaveInputData(F.PublicName) then
+      begin
+      Result[aSize]:=F;
+      Inc(aSize);
+      end;
+  SetLength(Result,aSize);
+end;
+
+
+procedure TSQLDBRestDBHandler.CheckAllRequiredFieldsPresent;
+
+Var
+  F : TSQLDBRestField;
+  Missing : UTF8String;
+
+begin
+  Missing:='';
+  For F in FResource.Fields do
+    if (foRequired in F.Options) and (F.GeneratorName='') then
+      if not IO.RESTInput.HaveInputData(F.PublicName) then
+        begin
+        if Missing<>'' then
+          Missing:=Missing+', ';
+        Missing:=Missing+F.PublicName;
+        end;
+  if Missing<>'' then
+    Raise ESQLDBRest.CreateFmt(500,SErrMissingInputFields,[Missing]);
+end;
+
+function TSQLDBRestDBHandler.GetAllowMultiUpdate: Boolean;
+begin
+  Result:=rhoAllowMultiUpdate in Options;
+end;
+
+function TSQLDBRestDBHandler.GetCheckUpdateCount: Boolean;
+begin
+  Result:=rhoCheckupdateCount in Options;
+end;
+
+function TSQLDBRestDBHandler.GetUseLegacyPUT: Boolean;
+begin
+  Result:=rhoLegacyPut in Options;
+end;
+
+procedure TSQLDBRestDBHandler.UpdateExistingRecord(OldData: TDataset;
+  IsPatch: Boolean);
+
+Var
+  S : TSQLQuery;
+  aRowsAffected: Integer;
   SQl : String;
   WhereFilterList : TRestFilterPairArray;
+  RequestFields : TSQLDBRestFieldArray;
 
 begin
   if (OldData=ExternalDataset) then
@@ -930,25 +1050,41 @@ begin
     end
   else
     begin
-    SQL:=FResource.GetResolvedSQl(skUpdate,GetIDWhere(WhereFilterList) ,'','');
-    S:=TSQLStatement.Create(Self);
+    if isPatch then
+      RequestFields:=GetRequestFields
+    else if not (isPatch or UseLegacyPUT) then
+      begin
+      CheckAllRequiredFieldsPresent;
+      RequestFields:=[];
+      end;
+    S:=TSQLQuery.Create(Self);
     try
+      SQL:=FResource.GetResolvedSQl(skUpdate,GetIDWhere(WhereFilterList) ,'','',RequestFields);
       S.Database:=IO.Connection;
       S.Transaction:=IO.Transaction;
       S.SQL.Text:=SQL;
-      SetPostParams(S.Params,OldData.Fields);
+      if (not isPatch) and UseLegacyPUT then
+        SetPostParams(S.Params,OldData.Fields);
       FillParams(roGet,S.Params,WhereFilterList);
       // Give user a chance to look at it.
       FResource.CheckParams(io.RestContext,roPut,S.Params);
-      S.Execute;
-      S.Transaction.Commit;
+      S.ExecSQL;
+      if CheckUpdateCount then
+        begin
+        aRowsAffected:=S.RowsAffected;
+        if (aRowsAffected<1) then
+          Raise ESQLDBRest.Create(500,SErrNoRecordsUpdated);
+        if (aRowsAffected>1) and not AllowMultiUpdate then
+          Raise ESQLDBRest.CreateFmt(500,SErrTooManyRecordsUpdated,[aRowsAffected]);
+        end;
+      S.SQLTransaction.Commit;
     finally
       S.Free;
     end;
     end;
 end;
 
-Function TSQLDBRestDBHandler.FindExistingRecord(D : TDataset) : Boolean;
+function TSQLDBRestDBHandler.FindExistingRecord(D: TDataset): Boolean;
 
 Var
   KeyFields : String;
@@ -984,38 +1120,15 @@ end;
 
 procedure TSQLDBRestDBHandler.DoHandlePut;
 
-Var
-  D : TDataset;
-  FieldList : TRestFieldPairArray;
+begin
+  DoHandlePutPatch(False);
+end;
+
 
+
+procedure TSQLDBRestDBHandler.DoHandlePatch;
 begin
-  // We do this first, so we don't run any unnecessary queries
-  if not IO.RESTInput.SelectObject(0) then
-    Raise ESQLDBRest.Create(IO.RestStatuses.GetStatusCode(rsInvalidParam),SErrNoResourceDataFound);
-  // Get the original record.
-  FieldList:=BuildFieldList(True);
-  D:=GetDatasetForResource(FieldList,True);
-  try
-    if not FindExistingRecord(D) then
-      begin
-      DoNotFound;
-      exit;
-      end;
-    UpdateExistingRecord(D);
-    // Now build response
-    if D<>ExternalDataset then
-      begin;
-      // Now build response. We can imagine not doing a select again, and simply supply back the fields as sent...
-      FreeAndNil(D);
-      D:=GetDatasetForResource(FieldList,True);
-      FieldList:=BuildFieldList(False);
-      D.Open;
-      end;
-    IO.RESTOutput.OutputOptions:=IO.RESTOutput.OutputOptions-[ooMetadata];
-    StreamDataset(IO.RESTOutput,D,FieldList);
-  finally
-    D.Free;
-  end;
+  DoHandlePutPatch(True);
 end;
 
 destructor TSQLDBRestDBHandler.Destroy;

+ 53 - 2
packages/fcl-web/src/restbridge/sqldbrestio.pp

@@ -151,7 +151,8 @@ Type
                  rsNoResourceSpecified,     // Unable to determine resource (404)
                  rsNoConnectionSpecified,   // Unable to determine connection for (400)
                  rsRecordNotFound,          // Query did not return record for single resource (404)
-                 rsInvalidContent           // Invalid content for POST/PUT operation (400)
+                 rsInvalidContent,          // Invalid content for POST/PUT operation (400)
+                 rsPatchOK                  // PATCH command completed OK (200)
 
                  );
   TRestStatuses = set of TRestStatus;
@@ -225,6 +226,8 @@ Type
   end;
   TRestStreamerClass = Class of TRestStreamer;
 
+  { TRestInputStreamer }
+
   TRestInputStreamer = Class(TRestStreamer)
   Public
     // Select input object aIndex. Must return False if no such object in input
@@ -232,6 +235,8 @@ Type
     Function SelectObject(aIndex : Integer) : Boolean; virtual; abstract;
     // Return Nil if none found. If result is non-nil, caller will free.
     Function GetContentField(aName : UTF8string) : TJSONData; virtual; abstract;
+    Function HaveInputData(aName : UTF8string) : Boolean; virtual;
+
     Class Procedure RegisterStreamer(Const aName : String);
     Class Procedure UnRegisterStreamer(Const aName : String);
   end;
@@ -271,6 +276,9 @@ Type
   Private
     FIO : TRestIO;
   Protected
+    function GetConnection: TSQLConnection; override;
+    function GetTransaction: TSQLTransaction; override;
+    Function DoGetInputData(aName : UTF8string) : TJSONData; override;
     property IO : TRestIO Read FIO;
   Public
     Function GetVariable(Const aName : UTF8String; aSources : TVariableSources; Out aValue : UTF8String) : Boolean; override;
@@ -458,7 +466,8 @@ Const
     404, { rsNoResourceSpecified }
     400, { rsNoConnectionSpecified }
     404, { rsRecordNotFound }
-    400  { rsInvalidContent }
+    400, { rsInvalidContent }
+    200  { rsPatchOK }
   );
 
 { TRestStatusConfig }
@@ -512,10 +521,41 @@ end;
 { TRestContext }
 
 function TRestContext.GetVariable(const aName: UTF8String; aSources : TVariableSources; out aValue: UTF8String): Boolean;
+
+Var
+  D : TJSONData;
+
 begin
   Result:=FIO.GetVariable(aName,aValue,aSources)<>vsNone;
+  if Not Result and (vsData in aSources) then
+    begin
+    // Will be freed.
+    D:=GetInputData(aName);
+    Result:=Assigned(D);
+    if Result then
+      if D.JSONType in StructuredJSONTypes then
+        aValue:=D.AsJSON
+      else
+        aValue:=D.AsString;
+    end;
+end;
+
+function TRestContext.GetConnection: TSQLConnection;
+begin
+  Result:=IO.Connection;
 end;
 
+function TRestContext.GetTransaction: TSQLTransaction;
+begin
+  Result:=IO.Transaction;
+end;
+
+function TRestContext.DoGetInputData(aName: UTF8string): TJSONData;
+begin
+  Result:=IO.RESTInput.GetContentField(aName);
+end;
+
+
 { TStreamerDefList }
 
 function TStreamerDefList.GetD(aIndex : integer): TStreamerDef;
@@ -811,6 +851,17 @@ begin
   Result:='text/html';
 end;
 
+function TRestInputStreamer.HaveInputData(aName: UTF8string): Boolean;
+
+Var
+  D : TJSONData;
+
+begin
+  D:=GetContentField(aName);
+  Result:=D<>Nil;
+  D.Free;
+end;
+
 class procedure TRestInputStreamer.RegisterStreamer(const aName: String);
 begin
   TStreamerFactory.Instance.RegisterStreamer(rstInput,aName,Self)

+ 6 - 0
packages/fcl-web/src/restbridge/sqldbrestjson.pp

@@ -33,6 +33,7 @@ Type
     Destructor Destroy; override;
     Function SelectObject(aIndex : Integer) : Boolean; override;
     function GetContentField(aName: UTF8string): TJSONData; override;
+    Function HaveInputData(aName: UTF8string): Boolean; override;
     procedure InitStreaming; override;
   end;
 
@@ -115,6 +116,11 @@ begin
     Result:=nil;
 end;
 
+function TJSONInputStreamer.HaveInputData(aName: UTF8string): Boolean;
+begin
+  Result:=(FJSON as TJSONObject).Find(aName)<>Nil;
+end;
+
 { TJSONOutputStreamer }
 
 

+ 125 - 20
packages/fcl-web/src/restbridge/sqldbrestschema.pp

@@ -14,12 +14,15 @@
  **********************************************************************}
 unit sqldbrestschema;
 
-{$mode objfpc}{$H+}
+{$mode objfpc}
+{$H+}
+{$modeswitch typehelpers}
+{$modeswitch advancedrecords}
 
 interface
 
 uses
-  Classes, SysUtils, db, sqldb, fpjson;
+  Classes, SysUtils, contnrs, db, sqldb, fpjson;
 
 Type
   TRestFieldType = (rftUnknown,rftInteger,rftLargeInt,rftFloat,rftDate,rftTime,rftDateTime,rftString,rftBoolean,rftBlob);
@@ -34,13 +37,13 @@ Type
   TSQLKind = (skSelect,skInsert,skUpdate,skDelete); // Must follow Index used below.
   TSQLKinds = set of TSQLKind;
 
-  TRestOperation = (roUnknown,roGet,roPost,roPut,roDelete,roOptions,roHead); // add roPatch, roMerge ?
+  TRestOperation = (roUnknown,roGet,roPost,roPut,roDelete,roOptions,roHead,roPatch);
   TRestOperations = Set of TRestOperation;
 
   TFieldListKind = (flSelect,flInsert,flInsertParams,flUpdate,flWhereKey,flFilter,flOrderby);
   TFieldListKinds = set of TFieldListKind;
 
-  TVariableSource = (vsNone,vsQuery,vsContent,vsRoute,vsHeader);
+  TVariableSource = (vsNone,vsQuery,vsContent,vsRoute,vsHeader,vsData);
   TVariableSources = Set of TVariableSource;
 
 Const
@@ -59,14 +62,28 @@ Type
   private
     FData: TObject;
     FUserID: UTF8String;
+    FFreeList : TFPObjectList;
+  Protected
+    Procedure AddToFreeList(aData : TJSONData);
+    // The result of this function will be freed.
+    function DoGetInputData(aName: UTF8string): TJSONData; virtual; abstract;
+    Function GetConnection : TSQLConnection; virtual; abstract;
+    Function GetTransaction : TSQLTransaction; virtual; abstract;
   Public
+    Destructor Destroy; override;
     // Call this to get a HTTP Query variable, header,...
     Function GetVariable(Const aName : UTF8String; aSources : TVariableSources; Out aValue : UTF8String) : Boolean; virtual; abstract;
+    // Get data from input data. Do not free the result !
+    Function GetInputData(aName : UTF8string) : TJSONData;
     // This will be set when calling.
     Property UserID : UTF8String Read FUserID Write FUserID;
     // You can attach data to this if you want to. It will be kept for the duration of the request.
     // You are responsible for freeing this data, though.
     Property Data : TObject Read FData Write FData;
+    // Get connection in use
+    Property Connection : TSQLConnection Read GetConnection;
+    // Get transaction in use
+    Property Transaction : TSQLTransaction Read GetTransaction;
   end;
 
   { ESQLDBRest }
@@ -121,6 +138,13 @@ Type
   TSQLDBRestFieldClass = Class of TSQLDBRestField;
   TSQLDBRestFieldArray = Array of TSQLDBRestField;
 
+  { TSQLDBRestFieldArrayHelper }
+
+  TSQLDBRestFieldArrayHelper = type helper for TSQLDBRestFieldArray
+    Function IndexOf(aField : TSQLDBRestField) : Integer;
+    Function Has(aField : TSQLDBRestField) : Boolean;
+  end;
+
   TRestFieldPair = Record
     DBField : TField;
     RestField :TSQLDBRestField;
@@ -135,11 +159,20 @@ Type
 
   { TSQLDBRestFieldList }
 
+  { TSQLDBRestFieldListEnumerator }
+
+  TSQLDBRestFieldListEnumerator = Class(TCollectionEnumerator)
+  Public
+    function GetCurrent: TSQLDBRestField; reintroduce;
+    property Current: TSQLDBRestField read GetCurrent;
+  end;
+
   TSQLDBRestFieldList = class(TCollection)
   private
     function GetFields(aIndex : Integer): TSQLDBRestField;
     procedure SetFields(aIndex : Integer; AValue: TSQLDBRestField);
   Public
+    Function GetEnumerator: TSQLDBRestFieldListEnumerator;
     Function AddField(Const aFieldName : UTF8String; aFieldType : TRestFieldType; aOptions : TRestFieldOptions) : TSQLDBRestField;
     function indexOfFieldName(const aFieldName: UTF8String): Integer;
     Function FindByFieldName(const aFieldName: UTF8String):TSQLDBRestField;
@@ -193,15 +226,15 @@ Type
     Procedure CheckParams(aContext : TBaseRestContext; aOperation : TRestoperation; P : TParams);
     Function GetDataset(aContext : TBaseRestContext; aFieldList : TRestFieldPairArray; aOrderBy : TRestFieldOrderPairArray; aLimit, aOffset : Int64) : TDataset;
     Function GetSchema : TSQLDBRestSchema;
-    function GenerateDefaultSQL(aKind: TSQLKind): UTF8String; virtual;
+    function GenerateDefaultSQL(aKind: TSQLKind; OnlyFields: TSQLDBRestFieldArray = nil): UTF8String; virtual;
     Procedure Assign(Source: TPersistent); override;
     Function AllowRecord(aContext : TBaseRestContext; aDataset : TDataset) : Boolean;
     Function AllowResource(aContext : TBaseRestContext) : Boolean;
     Function GetAllowedOperations(aContext : TBaseRestContext) : TRestOperations;
     Function GetHTTPAllow : String; virtual;
-    function GetFieldList(aListKind: TFieldListKind; ASep : String = ''): UTF8String;
+    function GetFieldList(aListKind: TFieldListKind; ASep : String = ''; OnlyFields : TSQLDBRestFieldArray = Nil): UTF8String;
     function GetFieldArray(aListKind: TFieldListKind): TSQLDBRestFieldArray;
-    Function GetResolvedSQl(aKind : TSQLKind; Const AWhere : UTF8String; Const aOrderBy : UTF8String = ''; aLimit : UTF8String = '') : UTF8String;
+    Function GetResolvedSQl(aKind : TSQLKind; Const AWhere : UTF8String; Const aOrderBy : UTF8String = ''; aLimit : UTF8String = ''; OnlyFields : TSQLDBRestFieldArray = nil) : UTF8String;
     Function ProcessSQl(aSQL : String; Const AWhere : UTF8String; Const aOrderBy : UTF8String = ''; aLimit : UTF8String = '') : UTF8String;
     Procedure PopulateFieldsFromFieldDefs(Defs : TFieldDefs; aIndexFields : TStringArray; aProcessIdentifier : TProcessIdentifier; aMinFieldOpts : TRestFieldOptions);
     Property SQL [aKind : TSQLKind] : TStrings Read GetSQLTyped;
@@ -306,6 +339,7 @@ Type
 
   { TSQLDBRestBusinessProcessor }
   TOnGetHTTPAllow = Procedure(Sender : TObject; Var aHTTPAllow) of object;
+  TRestDatabaseEvent = Procedure(Sender : TObject; aOperation : TRestOperation; aContext: TBaseRestContext; aResource : TSQLDBRestResource) of object;
 
   TSQLDBRestBusinessProcessor = class(TSQLDBRestCustomBusinessProcessor)
   private
@@ -315,6 +349,10 @@ Type
     FOnGetDataset: TSQLDBRestGetDatasetEvent;
     FOnResourceAllowed: TSQLDBRestAllowResourceEvent;
     FSchema: TSQLDBRestSchema;
+    FAfterDatabaseRead: TRestDatabaseEvent;
+    FAfterDatabaseUpdate: TRestDatabaseEvent;
+    FBeforeDatabaseRead: TRestDatabaseEvent;
+    FBeforeDatabaseUpdate: TRestDatabaseEvent;
     procedure SetSchema(AValue: TSQLDBRestSchema);
   Protected
     Function GetSchema : TSQLDBRestSchema; override;
@@ -331,16 +369,66 @@ Type
     Property OnAllowResource : TSQLDBRestAllowResourceEvent Read FOnResourceAllowed Write FOnResourceAllowed;
     Property OnAllowedOperations : TSQLDBRestAllowedOperationsEvent Read FOnAllowedOperations Write FOnAllowedOperations;
     Property OnAllowRecord : TSQLDBRestAllowRecordEvent Read FOnAllowRecord Write FOnAllowRecord;
+  Published
+    Property BeforeDatabaseUpdate : TRestDatabaseEvent Read FBeforeDatabaseUpdate Write FBeforeDatabaseUpdate;
+    Property AfterDatabaseUpdate : TRestDatabaseEvent Read FAfterDatabaseUpdate Write FAfterDatabaseUpdate;
+    Property BeforeDatabaseRead: TRestDatabaseEvent Read FBeforeDatabaseRead Write FBeforeDatabaseRead;
+    Property AfterDatabaseRead : TRestDatabaseEvent Read FAfterDatabaseRead Write FAfterDatabaseRead;
   end;
 
 Const
   TypeNames : Array[TRestFieldType] of string = ('?','int','bigint','float','date','time','datetime','string','bool','blob');
-  RestMethods : Array[TRestOperation] of string = ('','GET','POST','PUT','DELETE','OPTIONS','HEAD');
+  RestMethods : Array[TRestOperation] of string = ('','GET','POST','PUT','DELETE','OPTIONS','HEAD','PATCH');
 
 implementation
 
 uses strutils, fpjsonrtti,dbconst, sqldbrestconst;
 
+{ TSQLDBRestFieldListEnumerator }
+
+function TSQLDBRestFieldListEnumerator.GetCurrent: TSQLDBRestField;
+begin
+  Result:=TSQLDBRestField(Inherited GetCurrent);
+end;
+
+{ TSQLDBRestFieldArrayHelper }
+
+function TSQLDBRestFieldArrayHelper.IndexOf(aField: TSQLDBRestField): Integer;
+begin
+  Result:=Length(Self)-1;
+  While (Result>=0) and (Self[Result]<>aField) do
+    Dec(Result);
+end;
+
+function TSQLDBRestFieldArrayHelper.Has(aField: TSQLDBRestField): Boolean;
+begin
+  Result:=IndexOf(aField)<>-1;
+end;
+
+{ TBaseRestContext }
+
+destructor TBaseRestContext.Destroy;
+begin
+  FreeAndNil(FFreeList);
+  inherited Destroy;
+end;
+
+procedure TBaseRestContext.AddToFreeList(aData: TJSONData);
+begin
+  If Not Assigned(FFreeList) then
+    FFreeList:=TFPObjectList.Create(True);
+  FFreeList.Add(aData)
+end;
+
+function TBaseRestContext.GetInputData(aName: UTF8string): TJSONData;
+
+begin
+  Result:=DoGetInputData(aName);
+  // Don't burden the user with freeing this.
+  if Assigned(Result) then
+    AddToFreeList(Result);
+end;
+
 { TSQLDBRestCustomBusinessProcessor }
 
 procedure TSQLDBRestCustomBusinessProcessor.SetResourceName(AValue: UTF8String);
@@ -1080,7 +1168,8 @@ begin
       AddR(RestMethods[O]);
 end;
 
-function TSQLDBRestResource.GetFieldList(aListKind : TFieldListKind; ASep : String = '') : UTF8String;
+function TSQLDBRestResource.GetFieldList(aListKind: TFieldListKind;
+  ASep: String; OnlyFields: TSQLDBRestFieldArray): UTF8String;
 
 Const
   SepComma = ', ';
@@ -1095,11 +1184,20 @@ Const
   Colons = Wheres + [flInsertParams,flUpdate];
   UseEqual = Wheres+[flUpdate];
 
+  Function AllowField (F :TSQLDBRestField) : Boolean; inline;
+
+  begin
+    Result:=F.UseInFieldList(aListKind) and ((Length(OnlyFields)=0) or (OnlyFields.Has(F)));
+  end;
+
+
+
 Var
   Sep,Term,Res,Prefix : UTF8String;
   I : Integer;
   F : TSQLDBRestField;
 
+
 begin
   Prefix:='';
   Sep:=aSep;
@@ -1114,7 +1212,7 @@ begin
     begin
     Term:='';
     F:=Fields[i];
-    if F.UseInFieldList(aListKind) then
+    if allowfield(F) then
       begin
       Term:=Prefix+F.FieldName;
       if (aSep='') and (aListKind in UseEqual) then
@@ -1155,16 +1253,16 @@ begin
   SetLength(Result,aCount);
 end;
 
-function TSQLDBRestResource.GenerateDefaultSQL(aKind: TSQLKind) : UTF8String;
+function TSQLDBRestResource.GenerateDefaultSQL(aKind: TSQLKind; OnlyFields : TSQLDBRestFieldArray = nil) : UTF8String;
 
 begin
   Case aKind of
     skSelect :
-      Result:='SELECT '+GetFieldList(flSelect)+' FROM '+TableName+' %FULLWHERE% %FULLORDERBY% %LIMIT%';
+      Result:='SELECT '+GetFieldList(flSelect,'',OnlyFields)+' FROM '+TableName+' %FULLWHERE% %FULLORDERBY% %LIMIT%';
     skInsert :
-      Result:='INSERT INTO '+TableName+' ('+GetFieldList(flInsert)+') VALUES ('+GetFieldList(flInsertParams)+')';
+      Result:='INSERT INTO '+TableName+' ('+GetFieldList(flInsert,'',OnlyFields)+') VALUES ('+GetFieldList(flInsertParams)+')';
     skUpdate :
-      Result:='UPDATE '+TableName+' SET '+GetFieldList(flUpdate)+' %FULLWHERE%';
+      Result:='UPDATE '+TableName+' SET '+GetFieldList(flUpdate,'',OnlyFields)+' %FULLWHERE%';
     skDelete :
       Result:='DELETE FROM '+TableName+' %FULLWHERE%';
   else
@@ -1173,13 +1271,13 @@ begin
 end;
 
 function TSQLDBRestResource.GetResolvedSQl(aKind: TSQLKind;
-  const AWhere: UTF8String; const aOrderBy: UTF8String; aLimit: UTF8String
-  ): UTF8String;
+  const AWhere: UTF8String; const aOrderBy: UTF8String; aLimit: UTF8String;
+  OnlyFields: TSQLDBRestFieldArray): UTF8String;
 
 begin
   Result:=SQL[aKind].Text;
   if (Result='') then
-    Result:=GenerateDefaultSQL(aKind);
+    Result:=GenerateDefaultSQL(aKind,OnlyFields);
   Result:=ProcessSQL(Result,aWhere,aOrderBy,aLimit);
 end;
 
@@ -1239,9 +1337,11 @@ Const
      rftUnknown, rftUnknown, rftUnknown, rftUnknown, rftString,               // ftParadoxOle, ftDBaseOle, ftTypedBinary, ftCursor, ftFixedChar,
      rftString, rftLargeInt, rftUnknown, rftUnknown, rftUnknown,              // ftWideString, ftLargeint, ftADT, ftArray, ftReference,
      rftUnknown, rftBlob, rftBlob, rftUnknown, rftUnknown,                    // ftDataSet, ftOraBlob, ftOraClob, ftVariant, ftInterface,
-     rftUnknown, rftString, rftDateTime, rftFloat, rftString, rftString,      // ftIDispatch, ftGuid, ftTimeStamp, ftFMTBcd, ftFixedWideChar, ftWideMemo
-     rftDateTime, rftDateTime, rftInteger, rftInteger, rftInteger, rftFloat,  // ftOraTimeStamp, ftOraInterval, ftLongWord, ftShortint, ftByte, ftExtended
-     rftFloat                                                                 // Single
+     rftUnknown, rftString, rftDateTime, rftFloat, rftString, rftString       // ftIDispatch, ftGuid, ftTimeStamp, ftFMTBcd, ftFixedWideChar, ftWideMemo
+{$IFNDEF VER3_2_2}
+     ,rftDateTime, rftDateTime, rftInteger, rftInteger, rftInteger, rftFloat,  // ftOraTimeStamp, ftOraInterval, ftLongWord, ftShortint, ftByte, ftExtended
+     rftFloat // Single
+{$ENDIF}
      );
 
 begin
@@ -1305,6 +1405,11 @@ begin
   Items[aIndex]:=aValue;
 end;
 
+function TSQLDBRestFieldList.GetEnumerator: TSQLDBRestFieldListEnumerator;
+begin
+  Result:=TSQLDBRestFieldListEnumerator.Create(Self);
+end;
+
 function TSQLDBRestFieldList.AddField(const aFieldName: UTF8String; aFieldType: TRestFieldType; aOptions: TRestFieldOptions
   ): TSQLDBRestField;
 begin