unit XData.Web.Connection;

interface

uses
  System.Classes, System.SysUtils,
  XData.Web.Request,
  XData.Web.Response,
  XData.Model.Classes;

const
{$IF COMPILERVERSION > 28}
  pidWeb = $10000;
{$ELSE}
  pidWeb = $1000;
{$IFEND}
  TMSWebPlatform = pidWin32 + pidWin64 + pidWeb;

type
  TXDataWebConnection = class;
  TXDataWebConnectionDesignData = class;
  THttpResponseProc = reference to procedure(Response: IHttpResponse);
  THttpErrorProc = reference to procedure;

  TXDataWebConnectionRequest = class
  strict private
    FRequest: IHttpRequest;
  public
    property Request: IHttpRequest read FRequest;
  end;

  TXDataWebConnectionResponse = class
  strict private
    FRequest: IHttpRequest;
    FResponse: IHttpResponse;
  public
    property Request: IHttpRequest read FRequest;
    property Response: IHttpResponse read FResponse;
  end;

  TXDataWebConnectionError = class
  strict private
    FResponse: IHttpResponse;
    FErrorMessage: string;
    FRequestUrl: string;
  public
    property Response: IHttpResponse read FResponse;
    property ErrorMessage: string read FErrorMessage;
    property RequestUrl: string read FRequestUrl;
  end;

  TXDataWebConnectionRequestEvent = procedure(Args: TXDataWebConnectionRequest) of object;
  TXDataWebConnectionResponseEvent = procedure(Args: TXDataWebConnectionResponse) of object;
  TXDataWebConnectionErrorEvent = procedure(Error: TXDataWebConnectionError) of object;
  TXDataWebConnectionErrorProc = reference to procedure(Error: TXDataWebConnectionError);
  TXDataWebConnectionConnectProc = reference to procedure;

  [ComponentPlatforms(TMSWebPlatform)]
  TXDataWebConnection = class(TComponent)
  private
    FURL: string;
    FModel: TXDataModel;
    FOnConnect: TNotifyEvent;
    FStreamedConnected: Boolean;
    FOnRequest: TXDataWebConnectionRequestEvent;
    FOnResponse: TXDataWebConnectionResponseEvent;
    FOnError: TXDataWebConnectionErrorEvent;
    FDesignData: TXDataWebConnectionDesignData;
    function GetConnected: Boolean;
    procedure SetConnected(const Value: Boolean);
    function IsDesignDataStored: Boolean;
    procedure SetDesignData(const Value: TXDataWebConnectionDesignData);
    procedure CheckUrl;
    procedure SetURL(const Value: string);
  protected
    procedure DoConnect; virtual;
    procedure DoDisconnect; virtual;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure LoadModel; deprecated;
    function RetrieveModel: TXDataModel;
    property Model: TXDataModel read FModel;
  public
    procedure SendRequest(Request: IHttpRequest; SuccessProc: THttpResponseProc; ErrorProc: THttpErrorProc = nil);
    procedure Open(ConnectProc: TXDataWebConnectionConnectProc = nil; ErrorProc: TXDataWebConnectionErrorProc = nil);
    procedure Close;
    procedure Loaded; override;
  published
    property URL: string read FURL write SetURL;
    property DesignData: TXDataWebConnectionDesignData read FDesignData write SetDesignData stored IsDesignDataStored;
    property Connected: Boolean read GetConnected write SetConnected default False;
    property OnConnect: TNotifyEvent read FOnConnect write FOnConnect;
    property OnError: TXDataWebConnectionErrorEvent read FOnError write FOnError;
    property OnRequest: TXDataWebConnectionRequestEvent read FOnRequest write FOnRequest;
    property OnResponse: TXDataWebConnectionResponseEvent read FOnResponse write FOnResponse;
  end;

  TXDataWebConnectionDesignData = class(TPersistent)
  private
    FHeaders: TStrings;
    FPersist: Boolean;
    function IsStored: Boolean;
    procedure SetHeaders(const Value: TStrings);
  public
    constructor Create;
    destructor Destroy; override;
    procedure Assign(Source: TPersistent); override;
  published
    property Headers: TStrings read FHeaders write SetHeaders stored IsStored;
    property Persist: Boolean read FPersist write FPersist stored IsStored;
  end;

implementation

uses
  Bcl.Utils,
  Sparkle.Http.Client,
  {$IFDEF MSWINDOWS}
  Sparkle.WinHttp.Engine,
  {$ENDIF}
  XData.Model.Deserializer;

{ TXDataWebConnection }

procedure TXDataWebConnection.CheckUrl;
begin
  if Trim(Self.URL) = '' then
    raise Exception.Create('URL property not specified');
end;

procedure TXDataWebConnection.Close;
begin
  SetConnected(False);
end;

constructor TXDataWebConnection.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FDesignData := TXDataWebConnectionDesignData.Create;
end;

destructor TXDataWebConnection.Destroy;
begin
  Close;
  FDesignData.Free;
  inherited;
end;

procedure TXDataWebConnection.DoConnect;
begin
  // DoDisconnect
  FreeAndNil(FModel);

  FModel := RetrieveModel;
end;

procedure TXDataWebConnection.DoDisconnect;
begin
  FreeAndNil(FModel);
end;

function TXDataWebConnection.GetConnected: Boolean;
begin
  Result := Assigned(FModel);
end;

function TXDataWebConnection.IsDesignDataStored: Boolean;
begin
  Result := FDesignData.Persist;
end;

procedure TXDataWebConnection.Loaded;
begin
  inherited Loaded;
  try
    if FStreamedConnected then SetConnected(True);
  except
    if csDesigning in ComponentState then
      if Assigned(System.Classes.ApplicationHandleException) then
        System.Classes.ApplicationHandleException(ExceptObject)
      else
        ShowException(ExceptObject, ExceptAddr)
    else
      raise;
  end;
end;

procedure TXDataWebConnection.LoadModel;
begin
  DoConnect;
end;

procedure TXDataWebConnection.Open;
begin
  SetConnected(True);
end;

function TXDataWebConnection.RetrieveModel: TXDataModel;
var
  Client: THttpClient;
  Req: THttpRequest;
  Resp: THttpResponse;
  ModelUrl: string;
  LocalModel: TXDataModel;
  I: Integer;
begin
  CheckUrl;
  LocalModel := TXDataModel.Create;
  try
    ModelUrl := TBclUtils.CombineUrlFast(Self.URL, '$model');
    Resp := nil;
    Req := nil;
    Client := THttpClient.Create;
    try
      {$IFDEF MSWINDOWS}
      if csDesigning in Self.ComponentState then
        TWinHttpEngine(Client.Engine).ProxyMode := THttpProxyMode.Auto;
      {$ENDIF}

      Req := Client.CreateRequest;
      Req.Uri := ModelUrl;
      for I := 0 to DesignData.Headers.Count - 1 do
        if DesignData.Headers.Names[I] <> '' then
          Req.Headers.SetValue(DesignData.Headers.Names[I], DesignData.Headers.ValueFromIndex[I]);

      Resp := Client.Send(Req);
      if Resp.StatusCode = 200 then
      begin
        TXDataModelDeserializer.Deserialize(LocalModel, TEncoding.UTF8.GetString(Resp.ContentAsBytes));
        if Assigned(FOnConnect) then
          FOnConnect(Self);
      end
      else
        raise Exception.CreateFmt('Error %d. Could not connect retrieve XData model from %s',
          [Resp.StatusCode, ModelUrl]);
    finally
      Resp.Free;
      Req.Free;
      Client.Free;
    end;
  except
    LocalModel.Free;
    raise;
  end;
  Result := LocalModel;
end;

procedure TXDataWebConnection.SendRequest(Request: XData.Web.Request.IHttpRequest;
  SuccessProc: THttpResponseProc; ErrorProc: THttpErrorProc);
begin
end;

procedure TXDataWebConnection.SetConnected(const Value: Boolean);
begin
  if (csReading in ComponentState) and Value then
    FStreamedConnected := True else
  begin
    if Value = GetConnected then Exit;
    if Value then
    begin
      DoConnect;
    end else
    begin
      DoDisconnect;
    end;
  end;
end;

procedure TXDataWebConnection.SetDesignData(
  const Value: TXDataWebConnectionDesignData);
begin
  FDesignData.Assign(Value);
end;

procedure TXDataWebConnection.SetURL(const Value: string);
begin
  if FURL <> Value then
  begin
    FUrl := Value;
    DoDisconnect;
  end;
end;

{ TXDataWebConnectionDesignData }

procedure TXDataWebConnectionDesignData.Assign(Source: TPersistent);
begin
  if Source is TXDataWebConnectionDesignData then
  begin
    Persist := TXDataWebConnectionDesignData(Source).Persist;
    Headers := TXDataWebConnectionDesignData(Source).Headers;
  end
  else
    inherited Assign(Source);
end;

constructor TXDataWebConnectionDesignData.Create;
begin
  inherited Create;
  FHeaders := TStringList.Create;
end;

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

function TXDataWebConnectionDesignData.IsStored: Boolean;
begin
  Result := FPersist;
end;

procedure TXDataWebConnectionDesignData.SetHeaders(const Value: TStrings);
begin
  FHeaders.Assign(Value);
end;

end.
