unit Sparkle.InProc.Context;

interface

uses
  System.Classes,
  Sparkle.Http.Client,
  Sparkle.Http.Headers,
  Sparkle.HttpServer.Context,
  Sparkle.HttpServer.Request,
  Sparkle.HttpServer.Response;

type
  TInProcHttpContext = class;

  TInProcHttpServerResponse = class(THttpServerResponse)
  strict private
    {$IFDEF AUTOREFCOUNT}[Weak]{$ENDIF}
    FContext: TInProcHttpContext;
    FCachedContent: TBytesStream;
  strict protected
    procedure EndResponse; override;
    procedure SendResponse; override;
    function SendBody(const PBuf: Pointer; const BufferSize: Integer): Integer; override;
  public
    property CachedContent: TBytesStream read FCachedContent;
  public
    constructor Create(AContext: TInProcHttpContext);
    destructor Destroy; override;
  end;

  TInProcHttpServerRequestStream = class(THttpRequestStream)
  strict private
    FClientRequest: THttpRequest;
    FSourceBuffer: PByte;
    FTotalRead: Longint;
  protected
    function GetContentLength: Int64; override;
    function ReadBuffer(Buffer: Pointer; Count: Longint): Longint; override;
  public
    constructor Create(AClientRequest: THttpRequest);
  end;

  TInProcHttpContext = class(THttpServerContext)
  strict private
    FClientRequest: THttpRequest;
    FRequest: THttpServerRequest;
    FResponse: TInProcHttpServerResponse;
  strict
  private
    function GetResponseContent: TStream; protected
    function GetRequest: THttpServerRequest; override;
    function GetResponse: THttpServerResponse; override;
  public
    constructor Create(AClientRequest: THttpRequest);
    destructor Destroy; override;
    property ResponseContent: TStream read GetResponseContent;
  end;

implementation

{ TInProcHttpContext }

constructor TInProcHttpContext.Create(AClientRequest: THttpRequest);
var
  Header: THttpHeaderInfo;
begin
  inherited Create;
  FClientRequest := AClientRequest;

  FRequest := THttpServerRequest.Create;
  FRequest.Method := FClientRequest.Method;
  if FRequest.Method = '' then
    FRequest.Method := 'GET';
  FRequest.RawUri := FClientRequest.Uri;
  for Header in FClientRequest.Headers.AllHeaders do
    FRequest.Headers.SetValue(Header.Name, Header.Value);
  FRequest.ContentStream := TInProcHttpServerRequestStream.Create(FClientRequest);

  FResponse := TInProcHttpServerResponse.Create(Self);
end;

destructor TInProcHttpContext.Destroy;
begin
  FRequest.Free;
  FResponse.Free;
  inherited;
end;

function TInProcHttpContext.GetRequest: THttpServerRequest;
begin
  Result := FRequest;
end;

function TInProcHttpContext.GetResponse: THttpServerResponse;
begin
  Result := FResponse;
end;

function TInProcHttpContext.GetResponseContent: TStream;
begin
  Result := FResponse.CachedContent;
end;

{ TInProcHttpServerRequestStream }

constructor TInProcHttpServerRequestStream.Create(AClientRequest: THttpRequest);
begin
  inherited Create;
  FClientRequest := AClientRequest;
  FSourceBuffer := FClientRequest.ContentBuffer;
  FTotalRead := 0;
end;

function TInProcHttpServerRequestStream.GetContentLength: Int64;
begin
  Result := FClientRequest.ContentLength;
end;

function TInProcHttpServerRequestStream.ReadBuffer(Buffer: Pointer;
  Count: Longint): Longint;
begin
  Result := FClientRequest.ContentLength - FTotalRead;
  if Result > Count then
    Result := Count;
  if Result > 0 then
  begin
    System.Move(FSourceBuffer^, Buffer^, Result);
    Inc(FSourceBuffer, Result);
    Inc(FTotalRead, Result);
  end;
end;

{ TInProcHttpServerResponse }

constructor TInProcHttpServerResponse.Create(AContext: TInProcHttpContext);
begin
  inherited Create;
  FContext := AContext;
  FCachedContent := TBytesStream.Create;
end;

destructor TInProcHttpServerResponse.Destroy;
begin
  FCachedContent.Free;
  inherited;
end;

procedure TInProcHttpServerResponse.EndResponse;
begin
  // No need to do anything because the response will be read
  // directly from the properties of this object. So this object
  // is already "the response".
end;

function TInProcHttpServerResponse.SendBody(const PBuf: Pointer;
  const BufferSize: Integer): Integer;
begin
  Result := FCachedContent.Write(PBuf^, BufferSize);
end;

procedure TInProcHttpServerResponse.SendResponse;
begin
  // No need to do anything because the response will be read
  // directly from the properties of this object. So this object
  // is already "the response".
end;

end.
