unit Common.Middleware.Logging;

interface

uses
  System.Classes, System.SysUtils,

  Sparkle.HttpServer.Module,
  Sparkle.HttpServer.Context,
  Sparkle.Http.Headers,

  Common.Logging;

type
  TLoggingMiddleware = class(THttpServerMiddleware, IHttpServerMiddleware)
  private
    FLogger: ILogger;
    function GetNewHttpRequestLog(Request: THttpServerRequest): ILog;
  protected
    procedure ProcessRequest(Context: THttpServerContext; Next: THttpServerProc); override;
  public
    constructor Create(ALogger: ILogger);
  end;

  THttpRequestLog = class( TInterfacedObject, ILog )
  strict private
    FMethod: string;
    FUriPath: string;
    FUriQuery: string;
    FProtocol: string;
    FRemoteIp: string;
    FHeaders: string;
    FContent: string;
    FContentLength: Int64;
  public
    constructor Create(AMethod: string; AUriPath: string; AUriQuery: string;
      AProtocol: string; ARemoteIp: string; AHeaders: string; AContent: string;
      AContentLength: Int64);
    function GetMessage: string;
  end;

//  THttpResponseLog = class( TInterfacedObject, ILog )
//  strict private
//    FMethod: string;
//    FUriPath: string;
//    FUriQuery: string;
//    FProtocol: string;
//    FRemoteIp: string;
//    FHeaders: string;
//    FContent: string;
//    FContentLength: Int64;
//  public
//    constructor Create(AMethod: string; AUriPath: string; AUriQuery: string;
//      AProtocol: string; ARemoteIp: string; AHeaders: string; AContent: string;
//      AContentLength: Int64);
//    function GetMessage: string;
//  end;

implementation

{ TLoggingMiddleware }

constructor TLoggingMiddleware.Create(ALogger: ILogger);
begin
  FLogger := TLogger.Create(ALogger);
end;

function TLoggingMiddleware.GetNewHttpRequestLog(
  Request: THttpServerRequest): ILog;
var
  Msg: TStrings;
  Header: THttpHeaderInfo;
  StringStream: TStringStream;
  Headers, Content: string;
begin
  Result := nil;
  Msg := TStringList.Create;
  try
    if Length(Request.Headers.AllHeaders.ToArray) = 0 then
      Headers := ''
    else
      begin
        for Header in Request.Headers.AllHeaders do
          Msg.Add(Header.Name + ': ' + Header.Value);
        Headers := Msg.Text;
      end;
  finally
    Msg.Free;
  end;

  StringStream := TStringStream.Create(Request.Content);
  try
    Content := StringStream.DataString
  finally
    StringStream.Free;
  end;

  Result := THttpRequestLog.Create(
    Request.Method,
    Request.Uri.Path,
    Request.Uri.Query,
    Request.Protocol,
    Request.RemoteIp,
    Headers,
    Content,
    Request.ContentLength
  );
end;

procedure TLoggingMiddleware.ProcessRequest(Context: THttpServerContext;
  Next: THttpServerProc);
var
  RequestLogMessage: string;
begin
  Context.Response.OnHeaders(
    procedure(Resp: THttpServerResponse)
    begin
      if (Resp.StatusCode >= 400) and (Resp.StatusCode <= 499) then
        FLogger.Log(5, Format('%d %s on %s', [Resp.StatusCode, Resp.StatusReason, RequestLogMessage]));
    end
  );
  RequestLogMessage := GetNewHttpRequestLog(Context.Request).GetMessage;
  FLogger.Log(5, RequestLogMessage);
  Next(Context);
end;

{ THttpRequestLog }

constructor THttpRequestLog.Create(AMethod, AUriPath, AUriQuery,
  AProtocol, ARemoteIp, AHeaders, AContent: string; AContentLength: Int64);
begin
  FMethod := AMethod;
  FUriPath := AUriPath;
  FUriQuery := AUriQuery;
  FProtocol := AProtocol;
  FRemoteIp := ARemoteIp;
  FHeaders := AHeaders;
  FContent := AContent;
  FContentLength := AContentLength;
end;

function THttpRequestLog.GetMessage: string;
var
  Msg: TStrings;
begin
  Result := '';
  Msg := TStringList.Create;
  try
    Msg.Add(Format('%s %s %s',
       [
          FMethod,
          FUriPath + FUriQuery,
          FProtocol,
          FRemoteIp
       ]));

//    if Not FHeaders.IsEmpty then
//      Msg.Add(FHeaders);
//    if (Not FContent.IsEmpty) then
//      Msg.Add(FContent);
    Result := Trim(Msg.Text);
  finally
    Msg.Free;
  end;
end;

end.