{********************************************************************}
{                                                                    }
{ written by TMS Software                                            }
{            copyright (c) 2018                                      }
{            Email : info@tmssoftware.com                            }
{            Web : http://www.tmssoftware.com                        }
{                                                                    }
{ Thanks to Michael Van Canneyt for his contribution on              }
{ Indy and TMS Sparkle integration                                   }
{                                                                    }
{ The source code is given as is. The author is not responsible      }
{ for any possible damage done due to the use of this code.          }
{ The complete source code remains property of the author and may    }
{ not be distributed, published, given or sold in any form as such.  }
{ No parts of the source code can be included in any other component }
{ or application without written authorization of the author.        }
{********************************************************************}

unit Sparkle.Indy.Server;

interface

uses
  System.Classes,
  Sparkle.HttpServer.Context,
  Sparkle.HttpServer.Module,
  Sparkle.HttpServer.Dispatcher,
  Sparkle.WebBroker.Context,
  Sparkle.Logger,
  Sparkle.Indy.Context,
  idContext,
  idCustomHTTPServer;

type
  TIndySparkleHTTPServer = class(TIdCustomHTTPServer)
  private
    FDispatcher: THttpDispatcher;
    FLogger: TLogger;
    function GetLogEngine: ILogEngine;
    procedure SetLogEngine(const Value: ILogEngine);
  protected
    procedure ParseAuthenticationHandler(AContext: TIdContext;
      const AAuthType, AAuthData: String; var VUsername, VPassword: String;
      var VHandled: Boolean);
    procedure DoCommandGet(AThread: TIdContext;
      ARequestInfo: TIdHTTPRequestInfo;
      AResponseInfo: TIdHTTPResponseInfo); override;
    procedure DoCommandOther(AThread: TIdContext;
      ARequestInfo: TIdHTTPRequestInfo;
      AResponseInfo: TIdHTTPResponseInfo); override;
    procedure DoneWithPostStream(ASender: TIdContext;
      ARequestInfo: TIdHTTPRequestInfo); override;
    procedure InitComponent; override;
    property Logger: TLogger read FLogger;
  public
    procedure AfterConstruction; override;
    destructor Destroy; override;
    property LogEngine: ILogEngine read GetLogEngine write SetLogEngine;
    property Dispatcher: THttpDispatcher read FDispatcher;
  end;

implementation

{ TIndySparkleHTTPServer }

procedure TIndySparkleHTTPServer.InitComponent;
begin
  Inherited;
  FLogger := TLogger.Create;
  FDispatcher := THttpDispatcher.Create;
end;

procedure TIndySparkleHTTPServer.ParseAuthenticationHandler
  (AContext: TIdContext; const AAuthType, AAuthData: String;
  var VUsername, VPassword: String; var VHandled: Boolean);
begin
  VHandled := True;
end;

procedure TIndySparkleHTTPServer.AfterConstruction;
begin
  inherited;
  OnParseAuthentication := ParseAuthenticationHandler;
end;

destructor TIndySparkleHTTPServer.Destroy;
begin
  FLogger.Free;
  FDispatcher.Free;
  inherited;
end;

procedure TIndySparkleHTTPServer.DoCommandGet(AThread: TIdContext;
  ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);
var
  Context: THttpServerContext;
begin
  Context := TIndyContext.Create(AThread, ARequestInfo, AResponseInfo);
  try
    FDispatcher.DispatchRequest(Context);
  finally
    Context.Free;
  end;
end;

procedure TIndySparkleHTTPServer.DoCommandOther(AThread: TIdContext;
  ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);
var
  Context: THttpServerContext;
begin
  Context := TIndyContext.Create(AThread, ARequestInfo, AResponseInfo);
  try
    FDispatcher.DispatchRequest(Context);
  finally
    Context.Free;
  end;
end;

procedure TIndySparkleHTTPServer.DoneWithPostStream(ASender: TIdContext;
  ARequestInfo: TIdHTTPRequestInfo);
begin
  // Do not destroy PostStream, since Sparkle needs it all the time
  // Indy destroys/cleans it in advance in some situations, like when
  // request content-type is application/x-www-form-urlencoded, for example.
  // We should also set the position back to 0 as Indy has read the content
  // to parse the content, but Sparkle will do its own processing.
  ARequestInfo.PostStream.Position := 0;
end;

function TIndySparkleHTTPServer.GetLogEngine: ILogEngine;
begin
  Result := Logger.LogEngine;
end;

procedure TIndySparkleHTTPServer.SetLogEngine(const Value: ILogEngine);
begin
  Logger.LogEngine := Value;
  FDispatcher.LogEngine := Value;
end;

end.
