Logging Response Body

BIZ TMS XData
1

I have an Entity storing some informations of a third party API.
I would like to store the fully recieved Response Body into a TBlob field into this Entity.
Each record represents an API-Call.

What are best practices to do so before XData generates instances out of the normaly recieved JSON?

2

Here is a sample middleware that logs request and response:

unit Server.Middleware.InternalError;

interface

uses
  System.SysUtils,
  System.Classes,
  System.Diagnostics,
  Sparkle.Http.Headers,
  Sparkle.HttpServer.Context,
  Sparkle.HttpServer.Module,
  Sparkle.HttpServer.Response;

type
  TServerErrorInfo = class;

  TInternalServerErrorMiddleware = class(THttpServerMiddleware)
  strict private
    procedure SaveServerError(Context: THttpServerContext; RequestContent: TBytes;
      ServerErrorInfo: TServerErrorInfo);
  public
    procedure ProcessRequest(Context: THttpServerContext; Next: THttpServerProc); override;
  end;

  TServerErrorInfo = class
  strict private
    FResponseStream: TBytesStream;
    FStopWatch: TStopWatch;
  public
    constructor Create(AResponseStream: TBytesStream);
    procedure StartWatch;
    procedure StopWatch;
    function ElapsedMilliseconds: Int64;
    function ResponseContent: TBytes;
    function InternalServerError: string;
  end;

  THttpRawResponseLoggingStream = class;

  THttpRawResponseBodyLoggingWriter = class(TInterfacedObject, IHttpResponseBodyWriter)
  strict private
    FStream: THttpRawResponseLoggingStream;
  public
    constructor Create(AResponse: THttpServerResponse; AStream: TBytesStream);
    destructor Destroy; override;
    function Stream: TStream;
    procedure Flush;
  end;

  THttpRawResponseLoggingStream = class(THttpRawResponseStream)
  strict private
    FStream: TBytesStream;
  public
    constructor Create(AResponse: THttpServerResponse; AStream: TBytesStream);
    function Write(const Buffer; Count: Longint): Longint; override;
    function Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; override;
  end;

implementation

uses
  Bcl.Json,
  Bcl.Json.Classes;

{ THttpRawResponseLoggingStream }

constructor THttpRawResponseLoggingStream.Create(AResponse: THttpServerResponse;
  AStream: TBytesStream);
begin
  inherited Create(AResponse);
  FStream := AStream;
end;

function THttpRawResponseLoggingStream.Seek(const Offset: Int64;
  Origin: TSeekOrigin): Int64;
begin
  FStream.Seek(Offset, Origin);
  inherited;
end;

function THttpRawResponseLoggingStream.Write(const Buffer;
  Count: Longint): Longint;
begin
  FStream.Write(Buffer, Count);
  inherited;
end;

{ THttpRawResponseBodyLoggingWriter }

constructor THttpRawResponseBodyLoggingWriter.Create(
  AResponse: THttpServerResponse; AStream: TBytesStream);
begin
  inherited Create;
  FStream := THttpRawResponseLoggingStream.Create(AResponse, AStream);
end;

destructor THttpRawResponseBodyLoggingWriter.Destroy;
begin
  FStream.Free;
  inherited;
end;

procedure THttpRawResponseBodyLoggingWriter.Flush;
begin
  FStream.Flush;
end;

function THttpRawResponseBodyLoggingWriter.Stream: TStream;
begin
  Result := FStream;
end;

{ TInternalServerErrorMiddleware }

procedure TInternalServerErrorMiddleware.ProcessRequest(
  Context: THttpServerContext; Next: THttpServerProc);
var
  RequestContent: TBytes;
  ResponseStream: TBytesStream;
  ServerErrorInfo: TServerErrorInfo;
  LogRequest: Boolean;
begin
  LogRequest := False;
  SetLength(RequestContent, 0);
  ResponseStream := TBytesStream.Create;
  ServerErrorInfo := TServerErrorInfo.Create(ResponseStream);
  try
    Context.Response.OnHeaders(
      procedure(Resp: THttpServerResponse)
      var
        Writer: IHttpResponseBodyWriter;
      begin
        LogRequest := Resp.StatusCode >= 500;
        if not LogRequest then
          Exit;
        RequestContent := Context.Request.Content;
        Writer := THttpRawResponseBodyLoggingWriter.Create(Resp, ResponseStream);
        Context.Response.RawWriter := Writer;
      end
    );
    ServerErrorInfo.StartWatch;
    Next(Context);
    ServerErrorInfo.StopWatch;
    if LogRequest then
      SaveServerError(Context, RequestContent, ServerErrorInfo);
  finally
    ServerErrorInfo.Free;
    ResponseStream.Free;
  end;
end;

procedure TInternalServerErrorMiddleware.SaveServerError(
  Context: THttpServerContext; RequestContent: TBytes;
  ServerErrorInfo: TServerErrorInfo);
begin
end;

{ TServerErrorInfo }

constructor TServerErrorInfo.Create(AResponseStream: TBytesStream);
begin
  FResponseStream := AResponseStream;
end;

function TServerErrorInfo.ElapsedMilliseconds: Int64;
begin
  Result := FStopWatch.ElapsedMilliseconds;
end;

function TServerErrorInfo.InternalServerError: string;
begin
  Result := '';
  try
    FResponseStream.Position := 0;
    var Json := TJson.Deserialize<TJObject>(FResponseStream);
    try
      if not Json.Contains('error') then
        Exit;
      if not Json['error'].IsObject then
        Exit;
      if not Json['error'].AsObject.Contains('message') then
        Exit;
      if not Json['error'].AsObject['message'].IsString then
        Exit;
      Result := Json['error'].AsObject['message'].AsString;
      Result := Result.Replace('Internal server error: ', '', [rfReplaceAll]);
    finally
      Json.Free;
    end;
  except
    Result := '';
  end;
end;

function TServerErrorInfo.ResponseContent: TBytes;
begin
  Result := FResponseStream.Bytes;
  SetLength(Result, FResponseStream.Size);
end;

procedure TServerErrorInfo.StartWatch;
begin
  FStopWatch := TStopwatch.StartNew;
end;

procedure TServerErrorInfo.StopWatch;
begin
  FStopWatch.Stop;
end;

end.
3

your given Example looks like it could not be used within XData-Client.

Or maybe I don’t see how a Middleware could be used on client-side.

4

For client-side you can use this approach:

5

This topic was automatically closed 24 hours after the last reply. New replies are no longer allowed.