Added Compression Protocol Filters

sources/MVCFramework.Filters.Compression.pas

@@ -0,0 +1,137 @@
+// ***************************************************************************
+//
+// Delphi MVC Framework
+//
+// Copyright (c) 2010-2023 Daniele Teti and the DMVCFramework Team
+//
+// https://github.com/danieleteti/delphimvcframework
+//
+// ***************************************************************************
+//
+// Licensed under the Apache License, Version 2.0 (the "License");
+// you may not use this file except in compliance with the License.
+// You may obtain a copy of the License at
+//
+// http://www.apache.org/licenses/LICENSE-2.0
+//
+// Unless required by applicable law or agreed to in writing, software
+// distributed under the License is distributed on an "AS IS" BASIS,
+// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+// See the License for the specific language governing permissions and
+// limitations under the License.
+//
+// *************************************************************************** }
+
+unit MVCFramework.Filters.Compression;
+
+{$I dmvcframework.inc}
+
+interface
+
+uses
+  MVCFramework,
+  MVCFramework.Logger;
+
+type
+  TMVCCompressionProtocolFilter = class(TProtocolFilter)
+  private
+    fCompressionThreshold: Integer;
+  protected
+    procedure DoFilter(Context: TWebContext); override;
+  public
+    constructor Create(aCompressionThreshold: Integer = 1024); virtual;
+  end;
+
+implementation
+
+uses
+  System.SysUtils,
+  System.ZLib,
+  System.Classes,
+  MVCFramework.Commons;
+
+{ TMVCCompressionProtocolFilter }
+
+constructor TMVCCompressionProtocolFilter.Create(aCompressionThreshold: Integer);
+begin
+  inherited Create;
+  fCompressionThreshold := aCompressionThreshold;
+end;
+
+procedure TMVCCompressionProtocolFilter.DoFilter(Context: TWebContext);
+var
+  lMemStream: TMemoryStream;
+  lContentStream: TStream;
+  lAcceptEncoding: string;
+  lEncodings: TArray<string>;
+  lItem: string;
+  lRespCompressionType: TMVCCompressionType;
+  lTmpItem: string;
+  lZStream: TZCompressionStream;
+begin
+  DoNext(Context);
+  if IsLibrary then {disables compression i apache modules and ISAPIs}
+  begin
+    Exit;
+  end;
+
+  lContentStream := Context.Response.RawWebResponse.ContentStream;
+  if (lContentStream = nil) or (lContentStream.Size <= fCompressionThreshold) then
+  begin
+    Exit;
+  end;
+
+  lAcceptEncoding := Context.Request.Headers['Accept-Encoding'];
+  if lAcceptEncoding.IsEmpty then
+  begin
+    Exit;
+  end;
+
+  lAcceptEncoding := lAcceptEncoding.Trim.ToLower;
+  lRespCompressionType := TMVCCompressionType.ctNone;
+  lEncodings := lAcceptEncoding.Split([',']);
+  for lItem in lEncodings do
+  begin
+    lTmpItem := lItem.Trim;
+    if lTmpItem = 'gzip' then
+    begin
+      lRespCompressionType := TMVCCompressionType.ctGZIP;
+      Break;
+    end
+    else if lTmpItem = 'deflate' then
+    begin
+      lRespCompressionType := TMVCCompressionType.ctDeflate;
+      break;
+    end;
+  end;
+
+  if lRespCompressionType = TMVCCompressionType.ctNone then
+  begin
+    Exit;
+  end;
+
+  { When it is a TFileStream copy it to a TMemoryStream, as TFileStream is read only }
+  lMemStream := TMemoryStream.Create;
+  try
+    lZStream := TZCompressionStream.Create(lMemStream, TZCompressionLevel.zcMax,
+      MVC_COMPRESSION_ZLIB_WINDOW_BITS[lRespCompressionType]);
+    try
+      lContentStream.Position := 0;
+      lZStream.CopyFrom(lContentStream, 0);
+    finally
+      lZStream.Free;
+    end;
+  except
+    lMemStream.Free;
+    raise;
+  end;
+  lMemStream.Position := 0;
+  Context.Response.RawWebResponse.ContentStream := lMemStream;
+{$IF Defined(SeattleOrBetter)}
+  Context.Response.RawWebResponse.ContentEncoding := MVC_COMPRESSION_TYPE_AS_STRING[lRespCompressionType];
+{$ELSE}
+  Context.Response.RawWebResponse.ContentEncoding := AnsiString(MVC_COMPRESSION_TYPE_AS_STRING[lRespCompressionType]);
+{$ENDIF}
+end;
+
+end.

sources/MVCFramework.Filters.Router.pas

@@ -108,6 +108,7 @@ var
   lRouter: IMVCRouter;
   lParamsTable: TMVCRequestParamsTable;
 begin
+  {TODO -odanielet -cGeneral : ParamsTable in an objectpool?}
   lParamsTable := TMVCRequestParamsTable.Create;
   try
     lRouter := TMVCRouter.Create(FConfig, fEngine.gMVCGlobalActionParamsCache);

unittests/general/TestServer/SpeedProtocolFilterU.pas

@@ -0,0 +1,145 @@
+// ***************************************************************************
+//
+// Delphi MVC Framework
+//
+// Copyright (c) 2010-2023 Daniele Teti and the DMVCFramework Team
+//
+// https://github.com/danieleteti/delphimvcframework
+//
+// ***************************************************************************
+//
+// Licensed under the Apache License, Version 2.0 (the "License");
+// you may not use this file except in compliance with the License.
+// You may obtain a copy of the License at
+//
+// http://www.apache.org/licenses/LICENSE-2.0
+//
+// Unless required by applicable law or agreed to in writing, software
+// distributed under the License is distributed on an "AS IS" BASIS,
+// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+// See the License for the specific language governing permissions and
+// limitations under the License.
+//
+// *************************************************************************** }
+
+unit SpeedProtocolFilterU;
+
+interface
+
+uses
+  MVCFramework;
+
+type
+  TSpeedProtocolFilter = class(TProtocolFilter)
+  protected
+    procedure DoFilter(Context: TWebContext); override;
+  end;
+
+  TMVCSpeedMiddleware = class(TInterfacedObject, IMVCMiddleware)
+  public
+    procedure OnBeforeRouting(Context: TWebContext; var Handled: Boolean);
+    procedure OnAfterControllerAction(Context: TWebContext; const AControllerQualifiedClassName: string;
+      const AActionNAme: string; const Handled: Boolean);
+    procedure OnBeforeControllerAction(Context: TWebContext; const AControllerQualifiedClassName: string;
+      const AActionNAme: string; var Handled: Boolean);
+    procedure OnAfterRouting(AContext: TWebContext; const AHandled: Boolean);
+  end;
+
+implementation
+
+uses
+  MVCFramework.Serializer.Commons, System.SysUtils, DateUtils;
+
+type
+  ISpeedData = interface
+    ['{72B0C1CA-00D1-431F-B093-C91A90147F90}']
+    procedure SetData(value: TDateTime);
+    function GetData: TDateTime;
+  end;
+
+  TSpeedData = class(TInterfacedObject, ISpeedData)
+  private
+    fData: TDateTime;
+  protected
+    procedure SetData(value: TDateTime);
+    function GetData: TDateTime;
+  public
+    destructor Destroy; override;
+  end;
+
+  { TMVCSpeedMiddleware }
+
+procedure TMVCSpeedMiddleware.OnAfterControllerAction(Context: TWebContext; const AControllerQualifiedClassName: string;
+  const AActionNAme: string; const Handled: Boolean);
+begin
+  // Context.Response.CustomHeaders.Values['request_gen_time'] :=
+  // MilliSecondsBetween(Now, ISOTimeStampToDateTime(Context.Data[classname + 'startup'])).ToString
+  Context.Response.CustomHeaders.Values['request_gen_time'] :=
+    MilliSecondsBetween(Now, ISOTimeStampToDateTime(Context.Data['start_req_timestamp'])).ToString;
+end;
+
+procedure TMVCSpeedMiddleware.OnAfterRouting(AContext: TWebContext; const AHandled: Boolean);
+begin
+
+end;
+
+procedure TMVCSpeedMiddleware.OnBeforeControllerAction(Context: TWebContext;
+  const AControllerQualifiedClassName, AActionNAme: string; var Handled: Boolean);
+begin
+
+end;
+
+procedure TMVCSpeedMiddleware.OnBeforeRouting(Context: TWebContext; var Handled: Boolean);
+begin
+  if Context.Request.PathInfo = '/handledbymiddleware' then
+  begin
+    Handled := True;
+    Context.Response.RawWebResponse.Content := 'This is a middleware response';
+    Context.Response.StatusCode := 200;
+  end
+  else
+  begin
+    Context.Data['start_req_timestamp'] := DateTimeToISOTimeStamp(Now);
+  end;
+end;
+
+{ TSpeedData }
+
+destructor TSpeedData.Destroy;
+begin
+
+  inherited;
+end;
+
+function TSpeedData.GetData: TDateTime;
+begin
+  Result := fData;
+end;
+
+procedure TSpeedData.SetData(value: TDateTime);
+begin
+  fData := value;
+end;
+
+{ TSpeedProtocolFilter }
+
+procedure TSpeedProtocolFilter.DoFilter(Context: TWebContext);
+begin
+  if Context.Request.PathInfo = '/handledbymiddleware' then
+  begin
+    Context.Response.RawWebResponse.Content := 'This is a middleware response';
+    Context.Response.StatusCode := 200;
+  end
+  else
+  begin
+    Context.Data['start_req_timestamp'] := DateTimeToISOTimeStamp(now);
+    try
+      DoNext(Context);
+    finally
+      Context.Response.CustomHeaders.Values['request_gen_time'] :=
+        MilliSecondsBetween(Now, ISOTimeStampToDateTime(Context.Data['start_req_timestamp'])).ToString;
+    end;
+  end;
+end;
+
+end.

unittests/general/TestServer/TestServer.dpr

@@ -26,7 +26,9 @@ uses
   Entities in '..\Several\Entities.pas',
   EntitiesProcessors in '..\Several\EntitiesProcessors.pas',
   MVCFramework.Filters.Action in '..\..\..\sources\MVCFramework.Filters.Action.pas',
-  MVCFramework.Filters.Router in '..\..\..\sources\MVCFramework.Filters.Router.pas';
+  MVCFramework.Filters.Router in '..\..\..\sources\MVCFramework.Filters.Router.pas',
+  SpeedProtocolFilterU in 'SpeedProtocolFilterU.pas',
+  MVCFramework.Filters.Compression in '..\..\..\sources\MVCFramework.Filters.Compression.pas';
 
 {$R *.res}
 

unittests/general/TestServer/TestServer.dproj

@@ -143,6 +143,8 @@
         <DCCReference Include="..\Several\EntitiesProcessors.pas"/>
         <DCCReference Include="..\..\..\sources\MVCFramework.Filters.Action.pas"/>
         <DCCReference Include="..\..\..\sources\MVCFramework.Filters.Router.pas"/>
+        <DCCReference Include="SpeedProtocolFilterU.pas"/>
+        <DCCReference Include="..\..\..\sources\MVCFramework.Filters.Compression.pas"/>
         <BuildConfiguration Include="Base">
             <Key>Base</Key>
         </BuildConfiguration>

unittests/general/TestServer/WebModuleUnit.pas

@@ -69,7 +69,8 @@ uses
   {$ENDIF}
   MVCFramework.Middleware.Compression,
   MVCFramework.Middleware.StaticFiles, FireDAC.Comp.Client,
-  MVCFramework.ActiveRecord, FDConnectionConfigU;
+  MVCFramework.ActiveRecord, FDConnectionConfigU, SpeedProtocolFilterU,
+  MVCFramework.Filters.Compression;
 
 procedure TMainWebModule.WebModuleCreate(Sender: TObject);
 begin
@@ -128,12 +129,14 @@ begin
     begin
       Result := TTestFault2Controller.Create; // this will raise an exception
     end)
-    .AddMiddleware(TMVCSpeedMiddleware.Create)
+    .AddFilter(TSpeedProtocolFilter.Create)
+    //.AddMiddleware(TMVCSpeedMiddleware.Create)
     .AddMiddleware(TMVCCustomAuthenticationMiddleware.Create(TCustomAuthHandler.Create, '/system/users/logged'))
     .AddMiddleware(TMVCStaticFilesMiddleware.Create('/static', 'www', 'index.html', False))
     .AddMiddleware(TMVCStaticFilesMiddleware.Create('/spa', 'www', 'index.html', True))
     .AddMiddleware(TMVCBasicAuthenticationMiddleware.Create(TBasicAuthHandler.Create))
-    .AddMiddleware(TMVCCompressionMiddleware.Create);
+    //.AddMiddleware(TMVCCompressionMiddleware.Create);
+    .AddFilter(TMVCCompressionProtocolFilter.Create);
 {$IFDEF MSWINDOWS}
   MVCEngine.SetViewEngine(TMVCMustacheViewEngine);
   RegisterOptionalCustomTypesSerializers(MVCEngine.Serializers[TMVCMediaType.APPLICATION_JSON]);