unit Sparkle.Http.Engine;

{$I Sparkle.Inc}

interface

uses
  System.SysUtils, System.Classes, System.ZLib,
  Sparkle.Http.Headers,
  Sparkle.Uri;

type
  EHttpEngineException = class(Exception)
  public
    constructor Create(const Msg: string);
    constructor CreateFmt(const Msg: string; const Args: array of const);
  end;

  EHttpEngineNoDefault = class(Exception)
  public
    constructor Create;
  end;

  THttpRequest = class
  private
    FMethod: string;
//    FMinorVersion: integer;
//    FMajorVersion: integer;
    FUri: string;
    FHeaders: THttpHeaders;
    FAsUri: TUri;
    FContentBytes: TBytes;
    FTimeout: integer;
    function GetHeaders: THttpHeaders;
    procedure SetRawMethod(const Value: string);
    procedure SetUri(const Value: string);
    function GetContentLength: integer;
  public
    function ContentBuffer: PByte;
    property AsUri: TUri read FAsUri;
  public
    constructor Create;
    destructor Destroy; override;
    procedure SetContent(const Value: TBytes);
    property Method: string read FMethod write SetRawMethod;
    property Uri: string read FUri write SetUri;
    property Headers: THttpHeaders read GetHeaders;
//    property MajorVersion: integer read FMajorVersion write FMajorVersion;
//    property MinorVersion: integer read FMinorVersion write FMinorVersion;
    property ContentLength: integer read GetContentLength;
    property Timeout: integer read FTimeout write FTimeout;
  end;

  THttpResponse = class abstract
  strict private
    FHeaders: THttpHeaders;
    FContentStream: TStream;
    FWrappedStream: TStream;
    FPrepared: Boolean;
    function GetHeaders: THttpHeaders;
  protected
    function GetContentLength: Int64; virtual; abstract;
    function CreateContentStream: TStream; virtual; abstract;
    function GetContentType: string; virtual; abstract;
    function GetContentEncoding: string; virtual; abstract;
    function GetStatusCode: integer; virtual; abstract;
    function GetStatusReason: string; virtual; abstract;
    procedure UpdateHeaders(AHeaders: THttpHeaders); virtual; abstract;
  protected
    function GetChunked: boolean; virtual;
    procedure PrepareResponse;
  protected
    function GetContentAsBytes: TBytes; virtual;
    function GetContentAsStream: TStream; virtual;
    function GetContentAsString: string; virtual;
  public
    constructor Create;
    destructor Destroy; override;
    property StatusCode: integer read GetStatusCode;
    property StatusReason: string read GetStatusReason;
    property Headers: THttpHeaders read GetHeaders;
    property ContentType: string read GetContentType;
    property ContentEncoding: string read GetContentEncoding;
    property ContentAsStream: TStream read GetContentAsStream;
    property ContentAsBytes: TBytes read GetContentAsBytes;
//    property ContentAsString: string read GetContentAsString;
    property ContentLength: Int64 read GetContentLength;
    property Chunked: boolean read GetChunked;
  end;

  THttpResponseStream = class abstract(TStream)
  strict private
    FContentSize: Cardinal;
  strict protected
    function HttpRead(var Buffer; Count: Longint): Longint; virtual; abstract;
  public
    function Write(const Buffer; Count: Longint): Longint; override;
    function Read(var Buffer; Count: Longint): Longint; override;
    function Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; override;
    constructor Create;
    property ContentSize: Cardinal read FContentSize;
  end;

  THttpEngine = class abstract
  strict protected
    const UserAgent = 'TMS Http/1.0';
  strict protected
    function DoCreateRequest: THttpRequest; virtual; abstract;
    function DoSend(Request: THttpRequest): THttpResponse; virtual; abstract;
  public
    class function CreateDefault: THttpEngine;
    constructor Create; virtual;
    destructor Destroy; override;
    function CreateRequest: THttpRequest;
    function Send(Request: THttpRequest): THttpResponse;
  end;

implementation

uses
  {$IFDEF MSWINDOWS}
  Sparkle.WinHttp.Engine
  {$ENDIF}
  {$IFDEF MACOS}
    {$IFDEF IOS}
    Sparkle.Mac.HttpEngine
    {$ELSE}
    Sparkle.Mac.HttpEngine
    {$ENDIF}
  {$ENDIF}
  {$IFDEF ANDROID}
  Sparkle.Android.HttpEngine
  {$ENDIF}
  {$IFDEF LINUX}
  Sparkle.NativeHttp.Engine
  {$ENDIF}
  ;


{ THttpEngine }

constructor THttpEngine.Create;
begin
end;

class function THttpEngine.CreateDefault: THttpEngine;
begin
  {$IFDEF MSWINDOWS}
  Exit(TWinHttpEngine.Create);
  {$ENDIF}
  {$IFDEF MACOS}
    {$IFDEF IOS}
    Exit(TMacHttpEngine.Create);
    {$ELSE}
    Exit(TMacHttpEngine.Create);
    {$ENDIF}
  {$ENDIF}
  {$IFDEF ANDROID}
  Exit(TAndroidHttpEngine.Create);
  {$ENDIF}
  {$IFDEF LINUX}
  Exit(TNativeHttpEngine.Create);
  {$ENDIF}
  raise EHttpEngineNoDefault.Create;
end;

function THttpEngine.CreateRequest: THttpRequest;
begin
  Result := DoCreateRequest;
end;

destructor THttpEngine.Destroy;
begin
  inherited;
end;

function THttpEngine.Send(Request: THttpRequest): THttpResponse;
begin
  if Request.AsUri = nil then
    raise EHttpEngineException.Create('Uri invalid or not specified');
  Result := DoSend(Request);
end;

{ THttpRequest }

function THttpRequest.ContentBuffer: PByte;
begin
  if Length(FContentBytes) > 0 then
    Result := @FContentBytes[0]
  else
    Result := nil;
end;

constructor THttpRequest.Create;
begin
  FHeaders := THttpHeaders.Create;
//  FMajorVersion := 1;
//  FMinorVersion := 1;
  FTimeout := 60000; // 60 seconds
end;

destructor THttpRequest.Destroy;
begin
  FHeaders.Free;
  FAsUri.Free;
  inherited;
end;

function THttpRequest.GetContentLength: integer;
begin
  Result := Length(FContentBytes);
end;

function THttpRequest.GetHeaders: THttpHeaders;
begin
  Result := FHeaders;
end;

procedure THttpRequest.SetContent(const Value: TBytes);
begin
  FContentBytes := Value;
end;

procedure THttpRequest.SetUri(const Value: string);
var
  OldUri: TUri;
begin
  OldUri := FAsUri;
  FAsUri := TUri.Create(Value);
  FUri := Value;
  OldUri.Free;
end;

procedure THttpRequest.SetRawMethod(const Value: string);
begin
  FMethod := UpperCase(Value);
end;

{ THttpResponse }

constructor THttpResponse.Create;
begin
  FHeaders := THttpHeaders.Create;
end;

destructor THttpResponse.Destroy;
begin
  FHeaders.Free;
  FContentStream.Free;
  FWrappedStream.Free;
  inherited;
end;

function THttpResponse.GetChunked: boolean;
begin
  Result := Pos('chunked', Lowercase(Headers.Get('transfer-encoding'))) > 0;
end;

function THttpResponse.GetContentAsBytes: TBytes;
const
  BufSize = 8192;
var
  BytesRead: Int64;
  TotalRead: Int64;
  Content: TStream;
begin
  PrepareResponse;
  Content := GetContentAsStream;
  if Headers.Exists('content-length') and not Chunked then
  begin
    SetLength(Result, ContentLength);
    if ContentLength > 0 then
    begin
      BytesRead := Content.Read(Result[0], ContentLength);
      if BytesRead <> ContentLength then
        raise EHttpEngineException.CreateFmt(
          'Could not read complete entity body. Content-length: %d; Bytes read: %d',
          [ContentLength, BytesRead]);
    end;
  end else
  begin
    SetLength(Result, 0);
    TotalRead := 0;
    repeat
      SetLength(Result, Length(Result) + BufSize);
      BytesRead := Content.Read(Result[TotalRead], BufSize);
      TotalRead := TotalRead + BytesRead;
    until BytesRead <> BufSize;
    SetLength(Result, TotalRead);
  end;
end;

function THttpResponse.GetContentAsStream: TStream;
begin
  PrepareResponse;
  Result := FContentStream;
end;

function THttpResponse.GetContentAsString: string;
begin
  PrepareResponse;
  Result := StringOf(GetContentAsBytes);
end;

function THttpResponse.GetHeaders: THttpHeaders;
begin
  PrepareResponse;
  Result := FHeaders;
end;

procedure THttpResponse.PrepareResponse;
begin
  if FPrepared then
    Exit;
  FPrepared := True;
  UpdateHeaders(FHeaders);
  FContentStream := CreateContentStream;
  if SameText(ContentEncoding, 'deflate') then
  begin
    FHeaders.Remove('content-encoding');
    {$IFNDEF MACOS}
    FWrappedStream := FContentStream;
    FContentStream := nil;
    FContentStream := TZDecompressionStream.Create(FWrappedStream, 15);
    {$ENDIF}
  end
  else
  if SameText(ContentEncoding, 'gzip') then
  begin
    FHeaders.Remove('content-encoding');
    {$IFNDEF MACOS}
    FWrappedStream := FContentStream;
    FContentStream := nil;
    FContentStream := TZDecompressionStream.Create(FWrappedStream, 31);
    {$ENDIF}
  end;
end;

{ THttpResponseStream }

constructor THttpResponseStream.Create;
begin
  FContentSize := 0;
end;

function THttpResponseStream.Read(var Buffer; Count: Longint): Longint;
var
  BytesRead: Cardinal;
  BytesToRetrieve: Cardinal;
  TotalRead: Cardinal;
  PBuf: PByte;
begin
  if Count <= 0 then Exit(0);

  // Receive content in pieces, not all at once
  // It's done this way because WinHttpReadData has an internal buffer that might be
  // smaller than the total body size.
  PBuf := @Buffer;
  TotalRead := 0;
  repeat
    BytesToRetrieve := Cardinal(Count) - TotalRead;
    BytesRead := 0;
    if BytesToRetrieve > 0 then
    begin
      if BytesToRetrieve > 8192 then
        BytesToRetrieve := 8192; // do not read everything at once, it might cause error 9 - out of memory
      BytesRead := HttpRead(PBuf^, BytesToRetrieve);
      Inc(PBuf, BytesRead);
      TotalRead := TotalRead + BytesRead;
      FContentSize := FContentSize + BytesRead;
    end;
  until (BytesRead = 0) or (TotalRead = Cardinal(Count));
  Result := TotalRead;
end;

function THttpResponseStream.Seek(const Offset: Int64;
  Origin: TSeekOrigin): Int64;
begin
  if Offset = 0 then
    case Origin of
      soBeginning:
        if FContentSize = 0 then Exit(0);
      soCurrent, soEnd:
        Exit(FContentSize);
    end;
  raise EStreamError.Create('Http response stream cannot change position.');
end;

function THttpResponseStream.Write(const Buffer; Count: Longint): Longint;
begin
  Result := 0;
end;

{ EHttpEngineException }

constructor EHttpEngineException.Create(const Msg: string);
begin
  inherited Create('HttpEngine Error.' + sLineBreak + Msg);
end;

constructor EHttpEngineException.CreateFmt(const Msg: string;
  const Args: array of const);
begin
  inherited CreateFmt('HttpEngine Error.' + sLineBreak + Msg, Args);
end;

{ EHttpEngineNoDefault }

constructor EHttpEngineNoDefault.Create;
begin
  inherited Create('Default THttpEngine class not available for current platform.');
end;

end.
