unit Sparkle.NativeHttp.Engine;

{$I Sparkle.Inc}

interface

{$IFDEF DELPHITOKYO_LVL}

uses
  Generics.Collections, SysUtils, Classes,
  System.Net.HttpClient,
  System.Net.URLClient,
  Sparkle.Http.Engine,
  Sparkle.Http.Headers,
  Sparkle.Uri;

type
  THttpProxyMode = (Default, Auto, Custom);

  TNativeHttpResponse = class;

  TNativeHttpResponseStream = class(THttpResponseStream)
  strict private
    FNativeResponse: System.Net.HttpClient.IHTTPResponse;
  strict protected
    function HttpRead(var Buffer; Count: Longint): Longint; override;
  public
    constructor Create(ANativeResponse: System.Net.HttpClient.IHTTPResponse);
  end;

  TNativeHttpResponse = class(THttpResponse)
  strict private
    FNativeResponse: System.Net.HttpClient.IHTTPResponse;
    FContentLength: Int64;
    FContentLengthLoaded: boolean;
  protected
    function GetContentLength: Int64; override;
    function CreateContentStream: TStream; override;
    function GetContentType: string; override;
    function GetContentEncoding: string; override;
    function GetStatusCode: integer; override;
    function GetStatusReason: string; override;
    procedure UpdateHeaders(AHeaders: THttpHeaders); override;
  public
    constructor Create(ANativeResponse: System.Net.HttpClient.IHTTPResponse);
    destructor Destroy; override;
    property NativeResponse: System.Net.HttpClient.IHTTPResponse read FNativeResponse;
  end;

  TNativeHttpEngine = class(THttpEngine)
  strict private
    FClient: System.Net.HttpClient.THTTPClient;
    FTunnelUnsupportedMethods: boolean;
  strict protected
    function DoCreateRequest: THttpRequest; override;
    function DoSend(Request: THttpRequest): THttpResponse; override;
  public
    constructor Create; override;
    destructor Destroy; override;
    property TunnelUnsupportedMethods: boolean read FTunnelUnsupportedMethods write FTunnelUnsupportedMethods;
  end;

{$ENDIF}

implementation

{$IFDEF DELPHITOKYO_LVL}

{ TNativeHttpEngine }

constructor TNativeHttpEngine.Create;
begin
  inherited;
  FClient := System.Net.HttpClient.THTTPClient.Create;
  FTunnelUnsupportedMethods := True;
end;

function TNativeHttpEngine.DoCreateRequest: THttpRequest;
begin
  Result := THttpRequest.Create;
end;

destructor TNativeHttpEngine.Destroy;
begin
  FClient.Free;
  inherited;
end;

function TNativeHttpEngine.DoSend(Request: THttpRequest): THttpResponse;
var
  NativeRequest: System.Net.HttpClient .IHTTPRequest;
  NativeResponse: System.Net.HttpClient.IHTTPResponse;
  HeaderInfo: THttpHeaderInfo;
  SourceStream: TStream;
  ContentLen: Int64;
  CreateSourceStream: Boolean;
  UpperMethod: string;
begin
  // tunnel unsupported http methods if needed
  NativeRequest := nil;
  if Request.Method <> '' then
  begin
    UpperMethod := Uppercase(Request.Method);
    if TunnelUnsupportedMethods and
      (UpperMethod <> '') and
      (UpperMethod <> 'GET') and
      (UpperMethod <> 'POST') and
      (UpperMethod <> 'PUT') and
      (UpperMethod <> 'DELETE') and
      (UpperMethod <> 'HEAD') and
      (UpperMethod <> 'OPTIONS') and
      (UpperMethod <> 'TRACE') then
    begin
      NativeRequest := FClient.GetRequest('POST', Request.Uri);
      NativeRequest.HeaderValue['x-http-method-override'] := Request.Method;
    end;
  end;
  if NativeRequest = nil then
    NativeRequest := FClient.GetRequest(Request.Method, Request.Uri);

  for HeaderInfo in Request.Headers.AllHeaders do
    NativeRequest.HeaderValue[HeaderInfo.Name] := HeaderInfo.Value;

  // make client consistent with other platforms:
  // if content-type is not set in the request, client shuold send it blank
  // if we don't do this, the default value will be x-www-form-urlencoded
  if not Request.Headers.Exists('content-type') then
    NativeRequest.HeaderValue['content-type'] := '';

  FClient.ConnectionTimeout := Request.Timeout;
  FClient.ResponseTimeout := Request.Timeout;

  // Optimize this. Should create a custom stream to provide data on the fly
  // avoiding copying the whole content at once. Leave it for later, though
  SourceStream := nil;
  try
  // Timeout: Request.Timeout
  // Disable redirects

    ContentLen := Request.ContentLength;

    // Workaround a bug (behavior?) in Linux rest client: if method is POST (and maybe others)
    // we HAVE to provide a source stream, even if content length is zero. This is not necessary
    // on Windows, so it's an inconsistency.
    CreateSourceStream := ContentLen > 0;
    {$IFDEF LINUX}
    CreateSourceStream := CreateSourceStream or
      ((Request.Method <> 'GET') and (Request.Method <> 'DELETE')
      and (Request.Method <> 'OPTIONS') and (Request.Method <> 'HEAD'));
    {$ENDIF}
    if CreateSourceStream then
    begin
      SourceStream := TMemoryStream.Create;
      SourceStream.Write(Request.ContentBuffer^, ContentLen);
      SourceStream.Position := 0;
      NativeRequest.SourceStream := SourceStream;
    end;

    NativeResponse := FClient.Execute(NativeRequest);
    Result := TNativeHttpResponse.Create(NativeResponse);
  finally
    SourceStream.Free;
  end;
end;

{ TNativeHttpResponse }

constructor TNativeHttpResponse.Create(ANativeResponse: System.Net.HttpClient.IHTTPResponse);
begin
  inherited Create;
  FNativeResponse := ANativeResponse;
end;

destructor TNativeHttpResponse.Destroy;
begin
  inherited;
end;

function TNativeHttpResponse.CreateContentStream: TStream;
begin
  Result := TNativeHttpResponseStream.Create(FNativeResponse);
end;

function TNativeHttpResponse.GetContentEncoding: string;
begin
  Result := Headers.Get('content-encoding');
end;

function TNativeHttpResponse.GetContentLength: Int64;
begin
  if not FContentLengthLoaded then
  begin
    if Chunked then
      FContentLength := -1
    else
      FContentLength := FNativeResponse.ContentLength;
    FContentLengthLoaded := true;
  end;
  Result := FContentLength;
end;

function TNativeHttpResponse.GetContentType: string;
begin
  Result := Headers.Get('content-type');
end;

function TNativeHttpResponse.GetStatusCode: integer;
begin
  Result := FNativeResponse.StatusCode;
end;

function TNativeHttpResponse.GetStatusReason: string;
begin
  Result := FNativeResponse.StatusText;
end;

procedure TNativeHttpResponse.UpdateHeaders(AHeaders: THttpHeaders);
var
  Header: TNameValuePair;
begin
  AHeaders.Clear;
  for Header in FNativeResponse.GetHeaders do
    AHeaders.AddValue(Header.Name, Header.Value);
end;

{ TNativeHttpResponseStream }

constructor TNativeHttpResponseStream.Create(ANativeResponse: System.Net.HttpClient.IHTTPResponse);
begin
  inherited Create;
  FNativeResponse := ANativeResponse;
end;

function TNativeHttpResponseStream.HttpRead(var Buffer; Count: Longint): Longint;
var
  Stream: TStream;
begin
  Stream := FNativeResponse.ContentStream;
  Assert(Stream <> nil, 'nil?');
  Result := Stream.Read(Buffer, Count);
end;

{$ENDIF}

end.
