unit XData.Web.Response;

interface

uses
  XData.Web.Headers,
  Web;

type
  IHttpResponse = interface
  ['{4F5FBBEB-2D03-446F-AD75-FFF8DB09B0B0}']
    function GetStatusCode: Integer;
    function GetStatusReason: string;
    function GetHeaders: THttpHeaders;
    function GetContentAsText: string;
    property StatusCode: Integer read GetStatusCode;
    property StatusReason: string read GetStatusReason;
    property Headers: THttpHeaders read GetHeaders;
    property ContentAsText: string read GetContentAsText;
  end;

  THttpResponse = class(TInterfacedObject, IHttpResponse)
  strict private
    FPrepared: Boolean;
    function GetHeaders: THttpHeaders;
  strict protected
    FHeaders: THttpHeaders;
    procedure PrepareResponse;
  strict protected
    function GetStatusCode: Integer; virtual; abstract;
    function GetStatusReason: string; virtual; abstract;
    procedure UpdateHeaders(AHeaders: THttpHeaders); virtual; abstract;
    function GetContentAsText: string; virtual; abstract;
  public
    constructor Create; reintroduce;
    destructor Destroy; override;
    property StatusCode: integer read GetStatusCode;
    property StatusReason: string read GetStatusReason;
    property Headers: THttpHeaders read GetHeaders;
    property ContentAsText: string read GetContentAsText;
  end;

  // Move this class to another unit later
  TXhrHttpResponse = class(THttpResponse, IHttpResponse)
  strict private
    FXhr: TJSXmlHttpRequest;
  strict protected
    function GetStatusCode: Integer; override;
    function GetStatusReason: string; override;
    procedure UpdateHeaders(AHeaders: THttpHeaders); override;
    function GetContentAsText: string; override;
  public
    constructor Create(AXhr: TJSXmlHttpRequest); reintroduce;
  end;

  // Move this class to another unit later
  TDummyHttpResponse = class(THttpResponse, IHttpResponse)
  strict protected
    function GetStatusCode: Integer; override;
    function GetStatusReason: string; override;
    procedure UpdateHeaders(AHeaders: THttpHeaders); override;
    function GetContentAsText: string; override;
  end;

implementation

uses
  Types, SysUtils, JS;

{ THttpResponse }

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

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

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

procedure THttpResponse.PrepareResponse;
begin
  if FPrepared then
    Exit;
  FPrepared := True;
  UpdateHeaders(FHeaders);
end;

{ TXhrHttpResponse }

constructor TXhrHttpResponse.Create(AXhr: TJSXmlHttpRequest);
begin
  inherited Create;
  FXhr := AXhr;
end;

function TXhrHttpResponse.GetContentAsText: string;
begin
  Result := FXhr.responseText;
end;

function TXhrHttpResponse.GetStatusCode: Integer;
begin
  Result := FXhr.status;
end;

function TXhrHttpResponse.GetStatusReason: string;
begin
  Result := FXhr.statusText;
end;

{$HINTS OFF}
// Pas2Js is raising a hint about "HeaderPair never used"
// Let's disable the hint for now and remove it when compiler is fixed
procedure TXhrHttpResponse.UpdateHeaders(AHeaders: THttpHeaders);
var
  I: Integer;
  SplitHeaders: TStringDynArray;
  HeaderPair: TStringDynArray;
begin
  SplitHeaders := TJSString(Trim(FXhr.getAllResponseHeaders)).split(#13#10);
  FHeaders.Clear;
  for I := 0 to Length(SplitHeaders) - 1 do
  begin
    HeaderPair := TJSString(SplitHeaders[I]).split(':');
    FHeaders.SetValue(Trim(HeaderPair[0]), Trim(HeaderPair[1]));
  end;
end;
{$HINTS ON}

{ TDummyHttpResponse }

function TDummyHttpResponse.GetContentAsText: string;
begin
  Result := '';
end;

function TDummyHttpResponse.GetStatusCode: Integer;
begin
  Result := 0;
end;

function TDummyHttpResponse.GetStatusReason: string;
begin
  Result := '';
end;

procedure TDummyHttpResponse.UpdateHeaders(AHeaders: THttpHeaders);
begin
end;

end.
