{*******************************************************}
{                                                       }
{            Delphi Visual Component Library            }
{                                                       }
{ Copyright(c) 1995-2010 Embarcadero Technologies, Inc. }
{                                                       }
{*******************************************************}

unit DSClientRest;

interface

uses Classes, SysUtils, DBXCommon, Generics.Collections, DBXJSON, DBXJSONReflect,
  DSHTTP, Contnrs, DB, DSCommonProxy;

type
  TDSRestParameterMetaData = record
    Name: string;
    Direction: Integer;
    DBXType: Integer;
    TypeName: string;
  end;

  TDSRestLoginProperties = class(TPersistent)
  protected
    procedure AssignTo(Dest: TPersistent); override;
  public
    UserName: string;
    Password: string;
    LoginPrompt: Boolean;
  end;

  TDSRestCommand = class;
  TDSRestLoginEvent = procedure(Sender: TObject; LoginProperties: TDSRestLoginProperties; var Cancel: Boolean) of object;

  TDSTestConnectionOption = (toNoLoginPrompt);
  TDSTestConnectionOptions = set of TDSTestConnectionOption;

  TDSCustomRestConnection = class(TComponent)
  strict private
    FProtocol: string;
    FHost: string;
    FPort: Integer;
    FUrlPath: string;
    FUserName: string;
    FPassword: string;
    FUniqueID: string;
    FContext: string;
    FLoginProperties: TDSRestLoginProperties;
    FHTTP: TDSHTTP;
    FSessionID: string;
  private
    FLoginPrompt: Boolean;
    FOnLogin: TDSRestLoginEvent;
    FOnValidateCertificate: TValidateCertificate;
    FBeforeExecute: TNotifyEvent;
    FAfterExecute: TNotifyEvent;
    FPreserveSessionID: Boolean;
    procedure ReadUniqueId(Reader: TReader);
    procedure WriteUniqueId(Writer: TWriter);
    function GetPassword: string;
    function GetUserName: string;
    procedure SetPassword(const Value: string);
    procedure SetUserName(const Value: string);
    procedure SetLoginPrompt(const Value: Boolean);
    function GetLoginPrompt: Boolean;
    procedure LoginDialogTestConnection;
    procedure SetContext(const Value: string);
    function GetHTTP: TDSHTTP;
    function GetOnValidatePeerCertificate: TValidateCertificate;
    procedure SetOnValidatePeerCertificate(const Value: TValidateCertificate);
    procedure SetProtocol(const Value: string);
  protected
    function Login: Boolean; virtual;
    procedure BeforeExecute; virtual;
    procedure AfterExecute; virtual;
    procedure DefineProperties(Filer: TFiler); override;
    procedure AssignTo(Dest: TPersistent); override;
    procedure SessionExpired; virtual;
    procedure SetConnection(const KeepAlive: String); virtual;
    function GetConnection: String; virtual;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure TestConnection(AOptions: TDSTestConnectionOptions = []);
    function CreateCommand: TDSRestCommand;
    function DefaultProtocol: string;
    procedure Reset;
    property Protocol: string read FProtocol write SetProtocol;
    property Host: string read FHost write FHost;
    property Port: Integer read FPort write FPort;
    property UrlPath: string read FUrlPath write FUrlPath;
    property Context: string read FContext write SetContext;
    property UserName: string read GetUserName write SetUserName;
    property Password: string read GetPassword write SetPassword;
    property UniqueID: string read FUniqueID write FUniqueID;
    property LoginPrompt: Boolean read GetLoginPrompt write SetLoginPrompt default True;
    property OnLogin: TDSRestLoginEvent read FOnLogin write FOnLogin;
    property SessionID: string read FSessionID write FSessionID;
    property LoginProperties: TDSRestLoginProperties read FLoginProperties;
    property PreserveSessionID: Boolean read FPreserveSessionID write FPreserveSessionID default True;
    property OnValidatePeerCertificate: TValidateCertificate read GetOnValidatePeerCertificate write SetOnValidatePeerCertificate;
    property OnBeforeExecute: TNotifyEvent read FBeforeExecute write FBeforeExecute;
    property OnAfterExecute: TNotifyEvent read FAfterExecute write FAfterExecute;
    property HTTP: TDSHTTP read GetHTTP;
    property Connection: String read GetConnection write SetConnection;
  end;

  TDSRestConnection = class(TDSCustomRestConnection)
  published
    property Protocol;
    property Host;
    property Port;
    property UrlPath;
    property Context;
    property UserName;
    property Password;
    property LoginPrompt;
    property PreserveSessionID;
    property Connection;
    property OnLogin;
    property OnValidatePeerCertificate;
    property OnBeforeExecute;
    property OnAfterExecute;
  end;

  TDSRestParameterMetaDataArray = array of TDSRestParameterMetaData;

  TDSRestCommand = class
  strict private
    FDBXContext: TDBXContext;
    FConnection: TDSCustomRestConnection;
    FText: string;
    FParameters: TDBXParameterList;
    FRequestType: string;
    FFreeOnExecuteList: TObjectList;
    function CreateParameters(AMetaData: array of TDSRestParameterMetaData): TDBXParameterList;
  private
    procedure AfterExecute;
    procedure BeforeExecute;
    function BuildParameterMetaDataArray: TArray<TDSRestParameterMetaData>; overload;
    function BuildParameterMetaDataArray(AProxyMetaData: TDSProxyMetadata): TArray<TDSRestParameterMetaData>; overload;
    function DetermineRequestType(
      AMetaData: array of TDSRestParameterMetaData): string;
  public
    constructor Create(AConnection: TDSCustomRestConnection);
    destructor Destroy; override;
    procedure Prepare(AMetaData: array of TDSRestParameterMetaData); overload;
    procedure Prepare(AProxyMetaData: TDSProxyMetadata); overload;
    procedure Prepare; overload;
    procedure Execute(const ARequestFilter: string = '');
    procedure ExecuteCache(const ARequestFilter: string = '');
    property Text: string read FText write FText;
    property Parameters: TDBXParameterList read FParameters;
    property RequestType: string read FRequestType write FRequestType;
    property Connection: TDSCustomRestConnection read FConnection;
    function GetJSONMarshaler: TJSONMarshal;
    function GetJSONUnMarshaler: TJSONUnMarshal;
    procedure FreeOnExecute(Value: TObject);
  end;

  TDSRestResponseStreamProc = reference to procedure(AStream: TStream; const AResponseCharSet: string; var AOwnsStream: Boolean);
  TDSRestCacheCommand = class
  strict private
    FParameterPath: string;
    FConnection: TDSCustomRestConnection;
    procedure Execute(const ARequestType, ACachePath: string; AResponseStreamProc: TDSRestResponseStreamProc; const ARequestFilter: string = '');
    function GetCommandPath: string;
  public
    constructor Create(AConnection: TDSCustomRestConnection);
    destructor Destroy; override;
    procedure GetParameter(AResponseStreamProc: TDSRestResponseStreamProc; const ARequestFilter: string = ''); overload;
    procedure GetParameter(out AJSONValue: TJSONValue; const ARequestFilter: string = ''); overload;
    procedure GetParameter(out AStream: TStream;  AOwnsObject: Boolean; const ARequestFilter: string = ''); overload;
    procedure GetCommand(AResponseStreamProc: TDSRestResponseStreamProc);
    procedure DeleteCommand;
    property Connection: TDSCustomRestConnection read FConnection;
    property ParameterPath: string read FParameterPath write FParameterPath;
    property CommandPath: string read GetCommandPath;
  end;

  IDSRestCachedCommand = interface
  ['{16B2E1F2-436B-45D8-A17D-5B1617F65BD6}']
    function GetCommand(AConnection: TDSRestConnection; AOwnsObject: Boolean = True): TJSONObject;
    procedure DeleteCommand(AConnection: TDSRestConnection);
  end;

  IDSRestCachedItem = interface
    ['{CCCDC036-04F0-4CF6-A74F-D2759F1E635A}']
    function GetItemPath: string;
    property ItemPath: string read GetItemPath;
  end;

  IDSRestCachedJSONObject = interface(IDSRestCachedItem)
    ['{3C45664B-BAAB-42AA-8FD9-9D3AB0198455}']
    function GetValue(AConnection: TDSRestConnection; AOwnsObject: Boolean = True; const ARequestFilter: string = ''): TJSONObject;
  end;

  IDSRestCachedJSONArray = interface(IDSRestCachedItem)
    ['{38E0EFCC-A1B6-4E11-BD9D-F640B7822D44}']
    function GetValue(AConnection: TDSRestConnection; AOwnsObject: Boolean = True; const ARequestFilter: string = ''): TJSONArray;
  end;

  IDSRestCachedJSONValue = interface(IDSRestCachedItem)
    ['{12458118-91A1-4A67-87AB-947CB8970D7B}']
    function GetValue(AConnection: TDSRestConnection; AOwnsObject: Boolean = True; const ARequestFilter: string = ''): TJSONValue;
  end;

  IDSRestCachedDBXReader = interface(IDSRestCachedItem)
    ['{567DBA1E-2CAE-4C15-824B-0B678FBBD5B1}']
    function GetValue(AConnection: TDSRestConnection; AOwnsObject: Boolean = True; const ARequestFilter: string = ''): TDBXReader;
  end;

  IDSRestCachedDataSet = interface(IDSRestCachedItem)
    ['{54D0BA3F-9159-4DD5-802A-0097BA842D91}']
    function GetValue(AConnection: TDSRestConnection; AOwnsObject: Boolean = True; const ARequestFilter: string = ''): TDataSet;
  end;

  IDSRestCachedParams = interface(IDSRestCachedItem)
    ['{FD14E67B-D225-4FED-8B45-451B6627962C}']
    function GetValue(AConnection: TDSRestConnection; AOwnsObject: Boolean = True; const ARequestFilter: string = ''): TParams;
  end;

  IDSRestCachedStream = interface(IDSRestCachedItem)
    ['{0E09C8A7-11A5-4CD5-B175-A35C9B0BEDF5}']
    function GetValue(AConnection: TDSRestConnection; AOwnsObject: Boolean = True; const ARequestFilter: string = ''): TStream;
  end;

  IDSRestCachedObject<T: class> = interface
    function GetValue(AConnection: TDSRestConnection; AOwnsObject: Boolean = True; const ARequestFilter: string = ''): T;
  end;

  TGetJSONValueCallback = reference to function(AValue: TJSONValue): Boolean;

  TDSRestCachedItem = class(TInterfacedObject, IDSRestCachedItem, IDSRestCachedCommand)
  strict private
    FItemPath: string;
    FOwnedObjects: TList;
  protected
    function GetItemPath: string;
    function GetJSONValue(AConnection: TDSRestConnection;
      AOwnsObject: Boolean; const ARequestFilter: string): TJSONValue;
    function GetJSONValueCallback(AConnection: TDSRestConnection; ACallBack: TGetJSONValueCallback; AOwnsObject: Boolean = True; const ARequestFilter: string = ''): TJSONValue;
    function UnmarshalValue<T: class>(AConnection: TDSRestConnection;
     AOwnsObject: Boolean; const ARequestFilter: string): T;
    property OwnedObjects: TList read FOwnedObjects;
  public
    constructor Create(const AItemPath: string);
    destructor Destroy; override;
    procedure DeleteCommand(AConnection: TDSRestConnection);
    function GetCommand(AConnection: TDSRestConnection; AOwnsObject: Boolean = True): TJSONObject;
    property ItemPath: string read GetItemPath;
  end;

  TDSRestCachedJSONObject = class(TDSRestCachedItem, IDSRestCachedJSONObject, IDSRestCachedCommand)
  public
    function GetValue(AConnection: TDSRestConnection; AOwnsObject: Boolean = True; const ARequestFilter: string = ''): TJSONObject;
  end;

  TDSRestCachedJSONArray = class(TDSRestCachedItem, IDSRestCachedJSONArray, IDSRestCachedCommand)
  public
    function GetValue(AConnection: TDSRestConnection; AOwnsObject: Boolean = True; const ARequestFilter: string = ''): TJSONArray;
  end;

  TDSRestCachedJSONValue = class(TDSRestCachedItem, IDSRestCachedJSONValue, IDSRestCachedCommand)
  public
    function GetValue(AConnection: TDSRestConnection; AOwnsObject: Boolean = True; const ARequestFilter: string = ''): TJSONValue;
  end;

  TDSRestCachedStream = class(TDSRestCachedItem, IDSRestCachedStream, IDSRestCachedCommand)
  public
    function GetValue(AConnection: TDSRestConnection; AOwnsObject: Boolean = True; const ARequestFilter: string = ''): TStream;
  end;

  TDSRestCachedDataSet = class(TDSRestCachedItem, IDSRestCachedDataSet, IDSRestCachedCommand)
  public
    function GetValue(AConnection: TDSRestConnection; AOwnsObject: Boolean = True; const ARequestFilter: string = ''): TDataSet;
  end;

  TDSRestCachedParams = class(TDSRestCachedItem, IDSRestCachedParams, IDSRestCachedCommand)
  public
    function GetValue(AConnection: TDSRestConnection; AOwnsObject: Boolean = True; const ARequestFilter: string = ''): TParams;
  end;

  TDSRestCachedDBXReader = class(TDSRestCachedItem, IDSRestCachedDBXReader, IDSRestCachedCommand)
  public
    function GetValue(AConnection: TDSRestConnection; AOwnsObject: Boolean = True; const ARequestFilter: string = ''): TDBXReader;
  end;

  TDSRestCachedObject<T: class> = class(TDSRestCachedItem)
  public
    function GetValue(AConnection: TDSRestConnection; AOwnsObject: Boolean = True; const ARequestFilter: string = ''): T;
  end;

  TDSRestClientCallback = class;
  TDSRestClientChannel = class;
  TDSRestCallbackLoop = class;

  TDSRestClientChannel = class
  private
    FConnection: TDSCustomRestConnection;
    FCallbackLoop: TDSRestCallbackLoop;
    FOnDisconnect: TNotifyEvent;
    procedure EnumerateCallbacks(AMethod: TFunc<TDSRestClientCallback, Boolean>); overload;
    procedure EnumerateCallbacks(AMethod: TProc<TDSRestClientCallback>); overload;
    procedure UnregisterAllCallbacks;
  strict private
    FChannelId: string;
    FServerChannelName: string;
    FCallbacks: TList<TDSRestClientCallback>;
    function GetConnected: Boolean;
  public
    constructor Create(const AChannelId, AServerChannelName: string; AConnection: TDSCustomRestConnection);
    destructor Destroy; override;
    procedure RegisterCallback(AClientCallback: TDSRestClientCallback);
    procedure Connect(AFirstCallback: TDSRestClientCallback);
    procedure UnRegisterCallback(AClientCallback: TDSRestClientCallback);
    function Broadcast(AMessage: TJSONValue): Boolean;
    procedure DisConnect;
    function Notify(const AClientId, ACallbackId: string;
      AMessage: TJSONValue): Boolean;
    property Connected: Boolean read GetConnected;
    property OnDisconnect: TNotifyEvent read FOnDisconnect write FOnDisconnect;
    property ServerChannelName: string read FServerChannelName;
    property ChannelId: string read FChannelId;
  end;

  TDSRestCallbackLoop = class
  strict private
    FClientChannel: TDSRestClientChannel;
    FConnection: TDSCustomRestConnection;
    FThread: TThread;
    procedure OnThreadTerminate(ASender: TObject);
    function GetStopped: Boolean;
  public
    constructor Create(AClientChannel: TDSRestClientChannel; AConnection: TDSCustomRestConnection);
    destructor Destroy; override;
    procedure Callback(responseValue: TJSONValue; var AStatus: Boolean; var AStop: Boolean);
    procedure Start(AFirstCallback: TDSRestClientCallback);
    procedure Stop;
    property Stopped: Boolean read GetStopped;
    property ClientChannel: TDSRestClientChannel read FClientChannel;
  end;

  TDSRestClientCallbackFunction = TFunc<TJSONValue, string, Boolean>;

  TDSRestClientCallback = class
  strict private
    FCallbackId: string;
    FClientCallbackFunction: TDSRestClientCallbackFunction;
    FClientChannel: TDSRestClientChannel;
  public
    constructor Create(AClientChannel: TDSRestClientChannel; const ACallbackId: string;
      AClientCallbackFunction: TDSRestClientCallbackFunction);
    property CallbackId: string read FCallbackId;
    property ClientCallbackFunction: TDSRestClientCallbackFunction read FClientCallbackFunction;
  end;

  TTestConnectionMethod = procedure of object;

  TDSRestException = class(Exception);

  TDSRestProtocolException = class(TDSRestException)
  private
    FStatus: Integer;
    FResponseText: string;
  public
    constructor Create(AStatus: Integer; const AMessage, AResponseText: string);
    property Status: Integer read FStatus;
    property ResponseText: string read FResponseText;
  end;

var
  DSRestLoginDialogProc: function (ASender: TObject; var LoginProperties: TDSRestLoginProperties;
    ATestConnectionMethod: TTestConnectionMethod): Boolean;

implementation

uses DBXMemoryRow, StrUtils, DBXJSONCommon, DBXPlatform,
  IdGlobal,
  IdHTTP,
  IdAuthentication, IdGlobalProtocols, DSClientResStrs, DSProxyRest,
  IdURI, DBXCommonTable, IdMessageClient, DBXDbReaders,
  SqlExpr;

const
  sDSSessionEquals = 'dssession=';
type
  TDSRestRequestResponse = class
  strict private
    FFreeStreamValue: Boolean;
    FStringValue: string;
    FStreamValue: TStream;
    FHaveString: Boolean;
    FSessionID: string;
    FSessionExpired: Boolean;
    FResponseCharSet: string;
  private
    function GetStringValue: string;
  public
    function GetStream(AObjectOwner: Boolean = True): TStream;
    property StringValue: string read GetStringValue;
    property SessionExpired: Boolean read FSessionExpired;
    property SessionID: string read FSessionID;
    constructor Create(const AStream: TStream; const AResponseCharSet, ASessionID: string;
    ASessionExpired: Boolean);
    destructor Destroy; override;
    property ResponseCharSet: string read FResponseCharSet;
  end;

  TDSRestRequest = class
  strict private
    FHeaders: TDictionary<string, string>;
    FResponseStream: TStream;
    FResponseCharSet: string;
    FResponseSessionID: string;
    FResponseSessionExpired: Boolean;
    FStatus: Integer;
    FRequestType: string;
    FUrl: string;
    FPassword: string;
    FUsername: string;
    FHTTP: TDSHTTP;
    FRequestPragma: string;
    FFreeResponseStream: Boolean;
    procedure SendDeleteRequest(var response: string;
      out responseCode: Integer; out errorMessage: string);
    procedure SendGetRequest(var response: string; out responseCode: Integer; out errorMessage: string);
    procedure SendPostRequest(datastream: TStream; var response: string;
      out responseCode: Integer; out errorMessage: string);
    procedure SendPutRequest(datastream: TStream; var response: string;
      out responseCode: Integer; out errorMessage: string);
    function GetResponseStream(AOwnsObject: Boolean): TStream;
  private
    FAccept: string;
    function GetHTTP: TDSHTTP;
    procedure DoRequest(var response: string; out responseCode: Integer; out errorMessage: string;
      ACallback: TProc<TDSHTTP>);
  public
    constructor Create(AHTTP: TDSHTTP);
    destructor Destroy; override;
    procedure open(const requestType, url, userName, password: string);
    procedure setRequestHeader(const AName, AValue: string);
    procedure setRequestPragma(const AValue: string);
    function send(const paramToSend: string): TDSRestRequestResponse; overload;
    property Status: Integer read FStatus;
    property SessionExpired: Boolean read FResponseSessionExpired;
    property Accept: string read FAccept write FAccept;
  end;

constructor TDSRestCommand.Create(AConnection: TDSCustomRestConnection);
begin
  FConnection := AConnection;
end;

destructor TDSRestCommand.Destroy;
begin
  FParameters.Free;
  FDBXContext.Free;
  FFreeOnExecuteList.Free;
  inherited;
end;

// Use "GET" unless parameters types require "POST".  Use "POST" because request content,
// rather than URL, must be used to pass complex input parameters.
function TDSRestCommand.DetermineRequestType(AMetaData: array of TDSRestParameterMetaData): string;
  function IsKnownJSONTypeName(const Name: UnicodeString): Boolean;
  begin
    if not StringIsNil(Name) then
    begin
      if CompareText(Copy(Name,0+1,5-(0)), 'TJSON') = 0 then
        Exit(True);
    end;
    Result := False;
  end;
var
  Item: TDSRestParameterMetaData;
  LRequiresRequestContent: Boolean;
  LTypeName: string;
begin
  LRequiresRequestContent := False;
  for Item in AMetaData do
  begin
    case Item.Direction of
      TDBXParameterDirections.InParameter,
      TDBXParameterDirections.InOutParameter:
      begin
        case Item.DBXType of
          TDBXDataTypes.TableType, TDBXDataTypes.BinaryBlobType:
            LRequiresRequestContent := True;
          TDBXDataTypes.JsonValueType:
          begin
            LTypeName := Item.TypeName;
            if not IsKnownJSONTypeName(LTypeName) then
              LRequiresRequestContent := True
            else if SameText(LTypeName, 'TJSONValue') or SameText(LTypeName, 'TJSONObject') or SameText(LTypeName, 'TJSONArray') then  // Do not localize
              LRequiresRequestContent := True;
          end;
        end;
        if LRequiresRequestContent then
          break;
      end;
    end;
  end;
  if LRequiresRequestContent then
    Result := 'POST' // Do not localize
  else
    Result := 'GET';  // Do not localize
end;

procedure TDSRestCommand.Prepare(AMetaData: array of TDSRestParameterMetaData);
var
  Item: TDSRestParameterMetaData;
begin
  FreeAndNil(FParameters);
  FParameters := CreateParameters(AMetaData);
  // Set HTTP verb if not specified
  if Self.FRequestType = '' then
    Self.FRequestType := DetermineRequestType(AMetaData);
 end;

procedure TDSRestCommand.Prepare(AProxyMetaData: TDSProxyMetadata);
var
  DSRestParameterMetaDataArray: TArray<TDSRestParameterMetaData>;
begin
  DSRestParameterMetaDataArray := BuildParameterMetaDataArray(AProxyMetaData);
  Self.Prepare(DSRestParameterMetaDataArray);
end;

procedure TDSRestCommand.Prepare;
var
  DSRestParameterMetaDataArray: TArray<TDSRestParameterMetaData>;
begin
  DSRestParameterMetaDataArray := BuildParameterMetaDataArray;
  Self.Prepare(DSRestParameterMetaDataArray);
end;

function TDSRestCommand.BuildParameterMetaDataArray(AProxyMetaData: TDSProxyMetadata): TArray<TDSRestParameterMetaData>;
var
  MethodStr: string;
  Index: Integer;
  DSRestParameterMetaDataArray: TArray<TDSRestParameterMetaData>;
  ParamCount: Integer;
  DSProxyClass: TDSProxyClass;
  DSProxyMethod: TDSProxyMethod;
  DSProxyParameter: TDSProxyParameter;
  LClassName: string;
  LMethodName: string;
begin
  MethodStr := ReplaceStr(Self.Text, '"', '');
  Index := Pos('.', MethodStr);
  if Index < 0 then
    raise TDSRestException.CreateFmt(sInvalidServerMethodName, [Self.Text]);

  LClassName := AnsiLeftStr(MethodStr, Index-1);
  LMethodName := AnsiRightStr(MethodStr, Length(MethodStr)-Index);
  if MethodStr = Self.Text then // Not quoted
  begin
    //adjust method name for REST request storage methods
    if Self.RequestType = 'PUT' then            // Do not localize
      LMethodName := 'Accept' + LMethodName     // Do not localize
    else if Self.RequestType = 'POST' then      // Do not localize
      LMethodName := 'Update' + LMethodName     // Do not localize
    else if Self.RequestType = 'DELETE' then    // Do not localize
      LMethodName := 'Cancel' + LMethodName;    // Do not localize
  end;

  DSProxyClass := AProxyMetaData.Classes;
  while DSProxyClass <> nil do
  begin
    if SameText(DSProxyClass.ProxyClassName, LClassName) then
    begin
      DSProxyMethod := DSProxyClass.FirstMethod;
      while DSProxyMethod <> nil do
      begin
        if SameText(DSProxyMethod.ProxyMethodName, LMethodName) then
        begin
          DSProxyParameter := DSProxyMethod.Parameters;
          ParamCount := 0;
          while DSProxyParameter <> nil do
          begin
            Inc(ParamCount);
            SetLength(DSRestParameterMetaDataArray, ParamCount);
            DSRestParameterMetaDataArray[ParamCount-1].Name := DSProxyParameter.ParameterName;
            DSRestParameterMetaDataArray[ParamCount-1].Direction := DSProxyParameter.ParameterDirection;
            DSRestParameterMetaDataArray[ParamCount-1].DBXType := DSProxyParameter.DataType;
            DSRestParameterMetaDataArray[ParamCount-1].TypeName := DSProxyParameter.TypeName;
            DSProxyParameter := DSProxyParameter.Next;
          end;
          Exit(DSRestParameterMetaDataArray);
        end;
        DSProxyMethod := DSProxyMethod.Next;
      end;
    end;
    DSProxyClass := DSProxyClass.Next;
  end;
end;

function TDSRestCommand.BuildParameterMetaDataArray: TArray<TDSRestParameterMetaData>;
var
  SessionID: string;
  DSProxyMetaDataLoaderIntf: IDSProxyMetaDataLoader;
  DSProxyMetadata: TDSProxyMetadata;
begin
  //preserve original session
  SessionID := Connection.SessionID;
  try
    DSProxyMetaDataLoaderIntf := TDSRestProxyMetaDataLoader.Create(Connection);
    if DSProxyMetaDataLoaderIntf = nil then
      raise TDSRestException.Create(SUnableToRetrieveServerMethodParameters);
    DSProxyMetaData := TDSProxyMetaData.Create;
    try
      DSProxyMetaDataLoaderIntf.Load(DSProxyMetaData);
      Result := BuildParameterMetaDataArray(DSProxyMetaData);
    finally
      DSProxyMetaData.Free;
    end;
  finally
    //restore session
    Self.Connection.SessionID := SessionID;
  end;
end;


function TDSRestCommand.CreateParameters(AMetaData: array of TDSRestParameterMetaData): TDBXParameterList;
var
  LParameter: TDBXParameter;
  LValueTypes: TDBXValueTypeArray;
  LMemoryRow: TDBXRow;
  LValueType: TDBXValueType;
  LMetaData: TDSRestParameterMetaData;
  I: Integer;
  LParameterList: TDBXParameterList;
begin
  if FDBXContext = nil then
    FDBXContext := TDBXContext.Create;
  SetLength(LValueTypes, Length(AMetaData));
  for I := 0 to Length(AMetaData) - 1 do
  begin
    LMetaData := AMetaData[I];
    LParameter := TDBXParameter.Create(FDBXContext);
    LParameter.DataType := LMetaData.DBXType;
    LParameter.ParameterDirection :=  LMetaData.Direction;
    LParameter.Name :=  LMetaData.Name;
    LParameter.Ordinal := I;
    LParameter.ConnectionHandler := Self;
    LParameter.TypeName := LMetaData.TypeName;
    LValueTypes[I] := LParameter;
  end;

  LMemoryRow := TDBXMemoryRow.Create(FDBXContext, LValueTypes);
  LParameterList := TDBXParameterList.Create(nil, LMemoryRow);
  for LValueType in LValueTypes do
    LParameterList.AddParameter(TDBXParameter(LValueType));
  Result := LParameterList;
end;

procedure ExecuteCommand(ACommand: TDSRestCommand; const ARequestFilter: string; const AAccept: string = ''); forward;
procedure ExecuteCacheCommand(ACommand: TDSRestCacheCommand; const ARequestType: string; const ACachePath: string; AResponseStreamProc: TDSRestResponseStreamProc; const ARequestFilter: string ); forward;

procedure TDSRestCommand.Execute(const ARequestFilter: string);
begin
  BeforeExecute;
  try
    if Connection.LoginProperties.LoginPrompt then
      if not Connection.Login then
        SysUtils.Abort;
    ExecuteCommand(Self, ARequestFilter);
  finally
    AfterExecute;
  end;
end;

procedure TDSRestCommand.BeforeExecute;
begin
  FreeAndNil(FFreeOnExecuteList);
  Connection.BeforeExecute;
end;

procedure TDSRestCommand.AfterExecute;
begin
  Connection.AfterExecute;
end;

procedure TDSRestCommand.ExecuteCache(const ARequestFilter: string);
begin
  Connection.BeforeExecute;
  try
    if Connection.LoginProperties.LoginPrompt then
      if not Connection.Login then
        SysUtils.Abort;
    ExecuteCommand(Self, ARequestFilter, 'application/rest');
  finally
    Connection.AfterExecute;
  end;
end;

function TDSRestCommand.GetJSONMarshaler: TJSONMarshal;
begin
  Result := TJSONConverters.GetJSONMarshaler;
end;

function TDSRestCommand.GetJSONUnMarshaler: TJSONUnMarshal;
begin
  Result := TJSONConverters.GetJSONUnmarshaler;
end;

procedure TDSRestCommand.FreeOnExecute(Value: TObject);
begin
  if FFreeOnExecuteList = nil then
  begin
    FFreeOnExecuteList := TObjectList.Create;
    FFreeOnExecuteList.OwnsObjects := true;
  end;
  FFreeOnExecuteList.Add(Value);
end;

{ TDSRestCacheCommand }

constructor TDSRestCacheCommand.Create(AConnection: TDSCustomRestConnection);
begin
  FConnection := AConnection;
end;

procedure TDSRestCacheCommand.DeleteCommand;
begin
  if CommandPath = '' then
    raise Exception.Create(sMissingCommandPath);
  Execute('DELETE', CommandPath, nil);
end;

destructor TDSRestCacheCommand.Destroy;
begin

  inherited;
end;

procedure TDSRestCacheCommand.Execute(const ARequestType, ACachePath: string; AResponseStreamProc: TDSRestResponseStreamProc; const ARequestFilter: string );
begin
  ExecuteCacheCommand(Self, ARequestType, ACachePath, AResponseStreamProc, ARequestFilter);
end;

procedure TDSRestCacheCommand.GetCommand(AResponseStreamProc: TDSRestResponseStreamProc);
begin
  if CommandPath = '' then
    raise Exception.Create(sMissingCommandPath);
  Execute('GET', CommandPath, AResponseStreamProc);
end;

function TDSRestCacheCommand.GetCommandPath: string;
var
  LLast: Integer;
begin
  LLast := SysUtils.LastDelimiter('/', FParameterPath);
  if LLast > 0 then
    Result := Copy(FParameterPath, 1, LLast-1)
  else
    Result := '';
end;

procedure TDSRestCacheCommand.GetParameter(out AJSONValue: TJSONValue;
  const ARequestFilter: string);
var
  LJSONValue: TJSONValue;
  LResult: TJSONValue;
  LPair: TJSONPair;
begin
  LResult := nil;
  GetParameter(
    procedure(AStream: TStream; const AResponseCharSet: string; var AOwnsStream: Boolean)
    var
      LString: string;
    begin
      if AStream <> nil then
      begin
        AStream.Position := 0;
        LString := ReadStringAsCharset(AStream, AResponseCharSet);
        AOwnsStream := True; // Don't keep stream
        LJSONValue := TJSONObject.ParseJSONValue(BytesOf(LString), 0);
        try
          if LJSONValue is TJSONObject then
          begin
            LPair := TJSONObject(LJSONValue).Get('result');
            if (LPair <> nil) then //and (LPair.JSONValue is TJSONArray) then
            begin
              LResult := LPair.JSONValue; // TJSONArray(LPair.JSONValue);
              if LResult <> nil then
                LResult.Owned := False;
            end
          end;
        finally
          LJSONValue.Free;
        end;
      end;
    end, ARequestFilter);
  AJSONValue := LResult;
end;

procedure TDSRestCacheCommand.GetParameter(out AStream: TStream; AOwnsObject: Boolean; const ARequestFilter: string = '');
var
  LJSONValue: TJSONValue;
  LResult: TStream;
  LPair: TJSONPair;
  LString: string;
  LJSONArray: TJSONArray;
begin
  LResult := nil;
  GetParameter(
    procedure(AStream: TStream; const AResponseCharSet: string; var AOwnsStream: Boolean)
    begin
      AStream.Position := 0;
      // ResponseCharSet should identify as binary stream
      LString := ReadStringAsCharset(AStream, AResponseCharSet);
      LJSONValue := TJSONObject.ParseJSONValue(BytesOf(LString), 0);
      try
        if LJSONValue is TJSONObject then
        begin
          LPair := TJSONObject(LJSONValue).Get('result');
          if (LPair <> nil) and(LPair.JSONValue is TJSONArray) then
          begin
            LJSONArray := TJSONArray(LPair.JSONValue);
            LResult := TDBXJSONTools.JSONToStream(LJSONArray);
          end
        end
        else if LJSONValue = nil then
        begin
          // Assume binary
          AStream.Position := 0;
          LResult := AStream;
          if AOwnsObject then
            AOwnsStream := AOwnsObject;
        end;
      finally
        LJSONValue.Free;
      end;
    end,
    ARequestFilter);
  AStream := LResult;
end;

procedure TDSRestCacheCommand.GetParameter(AResponseStreamProc: TDSRestResponseStreamProc;
  const ARequestFilter: string);
begin
  if FParameterPath = '' then
    raise Exception.Create(sMissingParameterPath);
  Execute('GET', FParameterPath, AResponseStreamProc, ARequestFilter);
end;

function EncodeCharSet(const AStr: string; ACharSet: TSysCharSet): string;
var
  Sp, Rp: PChar;
begin
  SetLength(Result, Length(AStr) * 3);
  Sp := PChar(AStr);
  Rp := PChar(Result);
  while Sp^ <> #0 do
  begin
    if not SysUtils.CharInSet(Sp^, ACharSet) then
      Rp^ := Sp^
    else
    begin
      FormatBuf(Rp, 3, '%%%.2x', 6, [Ord(Sp^)]);
      Inc(Rp,2);
    end;
    Inc(Rp);
    Inc(Sp);
  end;
  SetLength(Result, (Rp - PChar(Result)));
end;

function EncodeURIComponent(const AStr: string): string; overload;
const
  // Excludes ~!*()'
  EncodeURIComponentCharSet =
                 [(*'~', '!',*) ' ', '@', '#',
                 '$', '%', '^', '&',
                 (*'*', '(', ')',*) '{',
                 '}', '[', ']', '=',
                 ':', '/', ',', ';',
                 '?', '+', (*'''',*) '"',
                 '\'];
    begin
  Result := EncodeCharSet(AStr, EncodeURIComponentCharSet);
end;

function encodeURIComponent(const AValue: TDBXParameter): string; overload;
begin
  Result := encodeURIComponent(AValue.Value.AsString);
end;

function IsUrlParameter(const AValue: TDBXParameter): Boolean;
var
  LTypeName: string;
begin
  LTypeName := AValue.TypeName;
  if AValue.DataType = TDBXDataTypes.TableType then
    Exit(False);
  if AValue.DataType = TDBXDataTypes.BinaryBlobType then
    Exit(False);
  if AValue.DataType = TDBXDataTypes.JSONValueType then
    if not SameText(Copy(LTypeName,0+1,5-(0)), 'TJSON') then
      Exit(False)
    else if SameText(LTypeName, 'TJSONValue') or SameText(LTypeName, 'TJSONObject') or SameText(LTypeName, 'TJSONArray') then
      Exit(False);
  Result := True;
end;

procedure ExecuteRequest(AHTTP: TDSHTTP; const AURL, LRequestType, LUserName, LPassword: string; LParameters: TDBXParameterList; const ARequestFilter, AAccept: string;
   var ASessionID: string; LSessionExpired: TProc; LSetSessionID: TProc<string>); forward;


procedure ExecuteCommand(ACommand: TDSRestCommand; const ARequestFilter, AAccept: string); overload;
var
  LPathPrefix: string;
  LPort: Integer;
  LHost: string;
  LPortString: string;
  LUrl: string;
  LMethodName: string;
  LContext: string;
  LProtocol: string;
  LSessionID: string;
begin
  LPathPrefix := ACommand.Connection.UrlPath;
  LPort := ACommand.Connection.Port;
  LHost := ACommand.Connection.Host;
  LMethodName := ACommand.Text;
  LProtocol := ACommand.Connection.HTTP.Protocol;
  if LProtocol = '' then
    LProtocol := 'http';

  if LHost = '' then
    LHost := 'localhost';
  if LPathPrefix <> '' then
    LPathPrefix := '/' + LPathPrefix;
  if LPort > 0 then
    LPortString := ':' + IntToStr(LPort);
  LMethodName := StringReplace(LMethodName, '.', '/', []);
  LMethodName := StringReplace(LMethodName, '"', '%22', [rfReplaceAll]); // Encode quotes
  LContext := ACommand.Connection.Context;
  if LContext = '' then
    LContext := 'datasnap/';
  LUrl := LProtocol + '://' +
    encodeURIComponent(LHost) + LPortString + LpathPrefix + '/' + LContext + 'rest/' + LMethodName  + '/';
  LSessionID := ACommand.Connection.SessionID;
  ExecuteRequest(ACommand.Connection.HTTP, LURL, ACommand.RequestType, ACommand.Connection.LoginProperties.UserName, ACommand.Connection.LoginProperties.Password, ACommand.Parameters, ARequestFilter, AAccept,
    LSessionID,
    procedure
    begin
      ACommand.Connection.SessionExpired;
    end,
    procedure(ASessionID: string)
    begin
      if ASessionID <> '' then
        ACommand.Connection.SessionID := ASessionID;
    end);
end;

procedure ExecuteRequest(AHTTP: TDSHTTP; const AURL, LRequestType, LUserName, LPassword: string; LParameters: TDBXParameterList;
  const ARequestFilter, AAccept: string; var ASessionID: string;
  LSessionExpired: TProc; LSetSessionID: TProc<string>); overload;

  function ParameterToJSon(AParameter: TDBXParameter; out ACanFree: Boolean): TJSONValue;
  begin
    ACanFree := True;
    if AParameter.Value = nil then
      Result := nil
    else if AParameter.Value.IsNull then
      Result := TJSONNull.Create
    else
      case AParameter.DataType of
        TDBXDataTypes.JsonValueType:
        begin
          Result := AParameter.Value.GetJSONValue;
          ACanFree := False;
        end;
        TDBXDataTypes.TableType:
          Result := TDBXJSONTools.TableToJSON(AParameter.Value.GetDBXReader, High(Integer), False);
        TDBXDataTypes.BlobType,
        TDBXDataTypes.BinaryBlobType:
          Result := TDBXJSONTools.StreamToJSON(AParameter.Value.GetStream, 0, High(Integer));
      else
        Result := TDBXJSONTools.DBXToJSON(AParameter.Value,
                               AParameter.DataType, True (* Local connection *));
      end;
  end;

var
  LUrl: string;
  LParametersToSend: TList<TDBXParameter>;
  LParametersToSendInContent: TList<TDBXParameter>;
  LParameter: TDBXParameter;
  LWritingUrl: Boolean;
  LOrdinal: Integer;
  LRequest: TDSRestRequest;
  LStringToSend: string;
  LJSONToSend: TJSONValue;
  LResponseText: TDSRestRequestResponse;
  LResponseJSON: TJSONValue;
  LJSONParameterValuePair: TJSONPair;
  LJSONParameterValue: TJSONValue;
  LJSONResultArray: TJSONArray;
  LJSONResultArrayIndex: Integer;
  LJSONArray: TJSONArray;
  LJSONObject: TJSONObject;
  LCanFree: Boolean;
  LValueToFree: TJSONValue;
begin
  LURL := AURL;
  LParametersToSend := TList<TDBXParameter>.Create;
  LParametersToSendInContent := nil;
  try
  if LParameters <> nil then
    for LOrdinal := 0 to  LParameters.Count - 1 do
    begin
      LParameter := LParameters[LOrdinal];
      if (LParameter.ParameterDirection = TDBXParameterDirections.InParameter) or
         (LParameter.ParameterDirection = TDBXParameterDirections.InOutParameter) then
        LParametersToSend.Add(LParameter);
    end;
  if (LRequestType = 'GET') or (LRequestType = '') or (LRequestType = 'DELETE') then
  begin
    for LParameter in LParametersToSend do
      LUrl := LUrl + encodeURIComponent(LParameter) + '/';
  end
  else
  begin
    LParametersToSendInContent := TList<TDBXParameter>.Create;
    LWritingUrl := True;
    for LParameter in LParametersToSend do
    begin
      if LWritingUrl then
        if IsUrlParameter(LParameter) then
          LUrl := LUrl + encodeURIComponent(LParameter) + '/'
        else
        begin
          LParametersToSendInContent.Add(LParameter);
          LWritingUrl := False
        end
      else
        LParametersToSendInContent.Add(LParameter);
    end;
  end;
  if ARequestFilter <> '' then
  begin
    if not StrUtils.EndsText('/', LUrl) then
      LUrl := LUrl + '/';
    if ARequestFilter[1] = '?' then
      LUrl := LUrl + ARequestFilter
    else
      LUrl := LUrl + '?' + ARequestFilter;
  end;

  LRequest := TDSRestRequest.Create(AHTTP);
  try

  LRequest.open(LRequestType, LUrl, LUserName, LPassword);

  if (LParametersToSendInContent <> nil) and (LParametersToSendInContent.Count > 0) then
    begin
      LValueToFree := nil;
      try
        if LParametersToSendInContent.Count = 1 then
        begin
          LJSONToSend := ParameterToJSon(LParametersToSendInContent[0], LCanFree);
          if LCanFree then
            LValueToFree := LJSONToSend;
        end
        else
        begin
          LJSONArray := TJSONArray.Create;
          for LParameter in  LParametersToSendInContent do
          begin
            LJSONToSend := ParameterToJSon(LParameter, LCanFree);
            LJSONArray.AddElement(LJSONToSend);
            if not LCanFree then
              LJSONToSend.Owned := False;
          end;
          LJSONObject := TJSONObject.Create;
          LJSONObject.AddPair('_parameters', LJSONArray);
          LJSONToSend := LJSONObject;
          LValueToFree := LJSONObject;
        end;
        LStringToSend := LJSONToSend.ToString;
      finally
        LValueToFree.Free;
      end;
    end;
  if AAccept <> '' then
    Lrequest.Accept := AAccept
  else
    Lrequest.Accept := 'application/JSON'; // Do not localize
  Lrequest.SetRequestHeader('Content-Type', 'text/plain;charset=UTF-8');  // Do not localize
  Lrequest.SetRequestHeader('If-Modified-Since', 'Mon, 1 Oct 1990 05:00:00 GMT');  // Do not localize
  if ASessionId <> '' then
    Lrequest.SetRequestPragma(sDSSessionEquals + ASessionId);

  LResponseText := LRequest.send(LStringToSend);
  try
  if LResponseText.SessionExpired then
    LSessionExpired
  else
    LSetSessionID(LResponseText.SessionID);

  LResponseJSON := TJSONObject.ParseJSONValue(BytesOf(LResponseText.StringValue), 0);
  try
    if LResponseJSON <> nil then
    begin
      LJSONParameterValuePair := TJSONObject(LResponseJSON).Get('result');
      if LJSONParameterValuePair.JSONValue is TJSONArray then
        LJSONResultArray := TJSONArray(LJSONParameterValuePair.JSONValue)
      else
        LJSONResultArray := nil;
      if LJSONResultArray <> nil then
      begin
        LJSONResultArrayIndex := 0;
        if LParameters <> nil then
          for LOrdinal := 0 to  LParameters.Count - 1 do
          begin
            LParameter := LParameters[LOrdinal];
            LJSONParameterValue := nil;
            if (LParameter.ParameterDirection = TDBXParameterDirections.ReturnParameter) or
               (LParameter.ParameterDirection = TDBXParameterDirections.InOutParameter) or
               (LParameter.ParameterDirection = TDBXParameterDirections.OutParameter) then
              if LJSONResultArray.Size = 1 then
                LJSONParameterValue := LJSONResultArray.Get(0)
              else
              begin
                LJSONParameterValue := LJSONResultArray.Get(LJSONResultArrayIndex);
                Inc(LJSONResultArrayIndex);
              end;
            if LJSONParameterValue <> nil then
            begin
               // Must clone some types
               case LParameter.DataType of
                 TDBXDataTypes.TableType:
                 begin
                   TDBXJSONTools.JSONToDBX(TJSONValue(LJSONParameterValue.Clone), LParameter.Value,
                                    LParameter.DataType, True (* Local connection *), True (* Owns Clone *));

                 end;
                 TDBXDataTypes.JSONValueType:
                 begin
                   TDBXJSONTools.JSONToDBX(TJSONValue(LJSONParameterValue.Clone), LParameter.Value,
                                    LParameter.DataType, True (* Local connection *), True (* Owns Clone *));

                 end
               else
                 TDBXJSONTools.JSONToDBX(LJSONParameterValue, LParameter.Value,
                                    LParameter.DataType, True (* Local connection *));
               end;
            end;
          end;
      end;
    end
    else
    begin
      // Stream result
      if LParameters <> nil then
        for LOrdinal := 0 to  LParameters.Count - 1 do
        begin
          LParameter := LParameters[LOrdinal];
          if (LParameter.ParameterDirection = TDBXParameterDirections.ReturnParameter) or
             (LParameter.ParameterDirection = TDBXParameterDirections.InOutParameter) or
             (LParameter.ParameterDirection = TDBXParameterDirections.OutParameter) then
             if LParameter.DataType = TDBXDataTypes.BinaryBlobType then
             begin
               LParameter.Value.SetStream(LResponseText.GetStream(False), True);
               break;
             end;
        end;
    end;
  finally
    LResponseJSON.Free;
  end;
  finally
    LResponseText.Free;
  end;
  finally
    LRequest.Free;
  end;
  finally
    LParametersToSend.Free;
    LParametersToSendInContent.Free;
  end;
end;

procedure ExecuteCacheRequest(AHTTP: TDSHTTP; const LRequestType: string; const AURL, LUserName, LPassword: string;
  const ARequestFilter: string; const ACachePath: string; var ASessionID: string;
  LSessionExpired: TProc; LSetSessionID: TProc<string>; AResponseStreamProc: TDSRestResponseStreamProc ); forward;

procedure ExecuteCacheCommand(ACommand: TDSRestCacheCommand; const ARequestType: string; const ACachePath: string; AResponseStreamProc: TDSRestResponseStreamProc; const ARequestFilter: string );
var
  LPathPrefix: string;
  LPort: Integer;
  LHost: string;
  LPortString: string;
  LUrl: string;
//  LMethodName: string;
  LContext: string;
  LProtocol: string;
  LSessionID: string;
  //LParameterPath: string;
begin
  LPathPrefix := ACommand.Connection.UrlPath;
  LPort := ACommand.Connection.Port;
  LHost := ACommand.Connection.Host;
//  LMethodName := ACommand.Text;
  LProtocol := ACommand.Connection.HTTP.Protocol;
//  LParameterPath := ACommand.ParameterPath;
  if LProtocol = '' then
    LProtocol := 'http';

  if LHost = '' then
    LHost := 'localhost';
  if LPathPrefix <> '' then
    LPathPrefix := '/' + LPathPrefix;
  if LPort > 0 then
    LPortString := ':' + IntToStr(LPort);
//  LMethodName := StringReplace(LMethodName, '.', '/', []);
  LContext := ACommand.Connection.Context;
  if LContext = '' then
    LContext := 'datasnap/';
  LUrl := LProtocol + '://' +
    encodeURIComponent(LHost) + LPortString + LpathPrefix + '/' + LContext + 'cache'  + '/';
  LSessionID := ACommand.Connection.SessionID;
  ExecuteCacheRequest(ACommand.Connection.HTTP, ARequestType, LURL, ACommand.Connection.LoginProperties.UserName, ACommand.Connection.LoginProperties.Password, ARequestFilter, ACachePath,
    LSessionID,
    procedure
    begin
      ACommand.Connection.SessionExpired;
    end,
    procedure(ASessionID: string)
    begin
      if ASessionID <> '' then
        ACommand.Connection.SessionID := ASessionID;
    end,
    AResponseStreamProc);
end;

procedure ExecuteCacheRequest(AHTTP: TDSHTTP; const LRequestType: string;  const AURL, LUserName, LPassword: string;
  const ARequestFilter: string; const ACachePath: string; var ASessionID: string;
  LSessionExpired: TProc; LSetSessionID: TProc<string>; AResponseStreamProc: TDSRestResponseStreamProc );
var
  LUrl: string;
  LRequest: TDSRestRequest;
  LResponseText: TDSRestRequestResponse;
  LObjectOwner: Boolean;
begin
  LURL := AURL;
  LURL := LURL + ACachePath;
  if ARequestFilter <> '' then
  begin
    if not StrUtils.EndsText('/', LUrl) then
      LUrl := LUrl + '/';
    if ARequestFilter[1] = '?' then
      LUrl := LUrl + ARequestFilter
    else
      LUrl := LUrl + '?' + ARequestFilter;
  end;

  LRequest := TDSRestRequest.Create(AHTTP);
  try
    LRequest.open(LRequestType, LUrl, LUserName, LPassword);

    Lrequest.Accept := 'application/JSON'; // Do not localize
    Lrequest.SetRequestHeader('Content-Type', 'text/plain;charset=UTF-8');  // Do not localize
    Lrequest.SetRequestHeader('If-Modified-Since', 'Mon, 1 Oct 1990 05:00:00 GMT');  // Do not localize
    if ASessionId <> '' then
      Lrequest.SetRequestPragma(sDSSessionEquals + ASessionId);

    LResponseText := LRequest.send('');
    try
    if LResponseText.SessionExpired then
      LSessionExpired
    else
      LSetSessionID(LResponseText.SessionID);

    if Assigned(AResponseStreamProc) then
    begin
      LObjectOwner := False;
      AResponseStreamProc(LResponseText.GetStream, LResponseText.ResponseCharSet, LObjectOwner);
      if not LObjectOwner then
        LResponseText.GetStream(False);
    end;
    finally
      LResponseText.Free;
    end;
  finally
    LRequest.Free;
  end;
end;


{ TDSCustomRestConnection }

procedure TDSCustomRestConnection.AfterExecute;
begin
  if Assigned(OnAfterExecute) then
    OnAfterExecute(Self);
end;

procedure TDSCustomRestConnection.AssignTo(Dest: TPersistent);
begin
  if Dest is TDSCustomRestConnection then
  begin
    TDSCustomRestConnection(Dest).Host := Host;
    TDSCustomRestConnection(Dest).Port := Port;
    TDSCustomRestConnection(Dest).UrlPath := UrlPath;
    TDSCustomRestConnection(Dest).UserName := UserName;
    TDSCustomRestConnection(Dest).Password := Password;
    TDSCustomRestConnection(Dest).Context := Context;
    TDSCustomRestConnection(Dest).SessionID := SessionID;
    TDSCustomRestConnection(Dest).PreserveSessionID := PreserveSessionID;
    TDSCustomRestConnection(Dest).OnLogin := OnLogin;
    TDSCustomRestConnection(Dest).OnValidatePeerCertificate := OnValidatePeerCertificate;
  end
  else
    inherited;
end;

procedure TDSCustomRestConnection.BeforeExecute;
begin
  if not PreserveSessionID then
    SessionID := '';
  if Assigned(OnBeforeExecute) then
    OnBeforeExecute(Self);
end;

constructor TDSCustomRestConnection.Create(AOwner: TComponent);
begin
  inherited;
  FLoginProperties := TDSRestLoginProperties.Create;
  FPreserveSessionID := True;
  LoginPrompt := True;
end;

function TDSCustomRestConnection.CreateCommand: TDSRestCommand;
begin
  Result := TDSRestCommand.Create(Self);
end;

procedure TDSCustomRestConnection.DefineProperties(Filer: TFiler);

  function DesignerDataStored: Boolean;
  begin
    if Filer.Ancestor <> nil then
      Result := TDSCustomRestConnection(Filer.Ancestor).UniqueId <> UniqueId else
      Result := UniqueId <> '';
  end;

begin
  inherited;
  Filer.DefineProperty('UniqueId', ReadUniqueId, WriteUniqueId,
    DesignerDataStored);
end;

destructor TDSCustomRestConnection.Destroy;
begin
  FLoginProperties.Free;
  FHTTP.Free;
  inherited;
end;

function TDSCustomRestConnection.GetConnection: String;
begin
  Result := HTTP.Request.Connection;
end;

function TDSCustomRestConnection.GetHTTP: TDSHTTP;
var
  LProtocol: string;
begin
  if FHTTP = nil then
  begin
    LProtocol := DefaultProtocol;
    FHTTP := TDSHTTP.ProtocolClass(LProtocol).Create(nil); // call virtual constructor
    FHTTP.OnValidatePeerCertificate := FOnValidateCertificate;
    FHTTP.Request.Connection := 'Keep-Alive';
    FHTTP.HTTPOptions := [hoKeepOrigProtocol];
  end;
  Result := FHTTP;
end;

function TDSCustomRestConnection.GetLoginPrompt: Boolean;
begin
  if not (csDesigning in ComponentState) then
    Result := FLoginProperties.LoginPrompt
  else
    Result := FLoginPrompt;
end;

function TDSCustomRestConnection.GetPassword: string;
begin
  if not (csDesigning in ComponentState) then
    Result := FLoginProperties.Password
  else
    Result := FPassword;
end;

function TDSCustomRestConnection.DefaultProtocol: string;
begin
  if FProtocol = '' then
    Result := 'http'
  else
    Result := FProtocol;
end;

function TDSCustomRestConnection.GetUserName: string;
begin
  if not (csDesigning in ComponentState) then
    Result := FLoginProperties.Username
  else
    Result := FUserName;
end;

function TDSCustomRestConnection.GetOnValidatePeerCertificate: TValidateCertificate;
begin
  if FHTTP <> nil then
    Result := FHTTP.OnValidatePeerCertificate
  else
    Result := FOnValidateCertificate;
end;

procedure TDSCustomRestConnection.ReadUniqueId(Reader: TReader);
begin
  FUniqueID := Reader.ReadString;
end;

procedure TDSCustomRestConnection.SessionExpired;
begin
  FSessionID := '';
end;

procedure TDSCustomRestConnection.SetConnection(const KeepAlive: String);
begin
  HTTP.Request.Connection := KeepAlive;
end;

procedure TDSCustomRestConnection.SetContext(const Value: string);
begin
  if (Value <> EmptyStr) and
     (Value[Length(Value)] <> '/') then
      FContext := FContext + '/'
  else
    FContext := Value;
end;

procedure TDSCustomRestConnection.SetLoginPrompt(const Value: Boolean);
begin
  FLoginPrompt := Value;
  FLoginProperties.LoginPrompt := Value;
end;

procedure TDSCustomRestConnection.SetPassword(const Value: string);
begin
  FPassword := Value;
  FLoginProperties.Password := Value;
end;

procedure TDSCustomRestConnection.SetProtocol(const Value: string);
begin
  if FProtocol <> Value then
    Reset;
  FProtocol := Value;
end;

procedure TDSCustomRestConnection.Reset;
begin
  FreeAndNil(FHTTP);
end;

procedure TDSCustomRestConnection.SetUserName(const Value: string);
begin
  if FUserName <> Value then
  begin
    SessionID := '';
    FUserName := Value;
    FLoginProperties.UserName := Value;
  end;
end;

procedure TDSCustomRestConnection.SetOnValidatePeerCertificate(
  const Value: TValidateCertificate);
begin
  FOnValidateCertificate := Value;
  if FHTTP <> nil then
    FHTTP.OnValidatePeerCertificate := Value;
end;

procedure TDSCustomRestConnection.TestConnection(
  AOptions: TDSTestConnectionOptions);
var
  LSaveLoginPrompt: Boolean;
  LClient: TDSAdminRestClient;
  LPlatformName: string;
begin
  LSaveLoginPrompt := LoginProperties.LoginPrompt;
  if toNoLoginPrompt in AOptions then
    LoginProperties.LoginPrompt := False;
  try
    LClient := TDSAdminRestClient.Create(Self);
    try
      LPlatformName := LClient.GetPlatformName;
      if LPlatformName = '' then
        raise TDSRestException.Create(sUnexpectedResult);
    finally
      LClient.Free;
    end;
  finally
    if toNoLoginPrompt in AOptions then
      LoginProperties.LoginPrompt := LSaveLoginPrompt;
    try
      Self.HTTP.Disconnect;
    except
    end;
  end;
end;

procedure TDSCustomRestConnection.WriteUniqueId(Writer: TWriter);
begin
  Writer.WriteString(FUniqueID);
end;

function TDSCustomRestConnection.Login: Boolean;
var
  LCancel: Boolean;

  function Login: Boolean;
  begin
    Result := (not (csDesigning in ComponentState)) and Assigned(FOnLogin);
    if Result then FOnLogin(Self, FLoginProperties, LCancel);
  end;

begin
  LCancel := False;
  if not Login then
  begin
    if Assigned(DSRestLoginDialogProc) then
    begin
      if not DSRestLoginDialogProc(Self, FLoginProperties, LoginDialogTestConnection) then
        LCancel := True;
    end;
  end;
  Result := not LCancel;
end;


procedure TDSCustomRestConnection.LoginDialogTestConnection;
begin
  TestConnection([toNoLoginPrompt]);
end;

{ TDSRestRequest }

procedure TDSRestRequest.open(const requestType, url, userName, password: string);
begin
  FHeaders := TDictionary<string, string>.Create;
  FRequestType := UpperCase(requestType);
  FUrl := url;
  FUserName := userName;
  FPassword := password;
end;

destructor TDSRestRequest.Destroy;
begin
  inherited;
  FHeaders.Free;
  if FFreeResponseStream then
    FResponseStream.Free;
end;

function TDSRestRequest.send(const paramToSend: string): TDSRestRequestResponse;
var
  LStream: TStream;
  LResponseText: string;
  LJSONValue: TJSONValue;
  LErrorMessage: string;
begin
  Result := nil;
  LStream := nil;
  try
    if FResponseStream = nil then
      FResponseStream := TMemoryStream.Create;
    if (FRequestType = 'GET') or (FRequestType = '') then
      SendGetRequest(LResponseText, FStatus, LErrorMessage)
    else if FRequestType = 'PUT' then
    begin
      LStream := TStringStream.Create(paramToSend, TEncoding.UTF8);
      SendPutRequest(LStream, LResponseText, FStatus, LErrorMessage);
    end
    else if FRequestType = 'POST' then
    begin
      LStream := TStringStream.Create(paramToSend, TEncoding.UTF8);
      SendPostRequest(LStream, LResponseText, FStatus, LErrorMessage);
    end
    else if FRequestType = 'DELETE' then
      SendDeleteRequest(LResponseText, FStatus, LErrorMessage)
    else
      raise TDSRestException.CreateFmt(SUnexpectedRequestType, [FRequestType]);
    //handle session timeouts (status = 403) and other session and authorization related errors
    if FStatus = 403 then
    begin
      Result := TDSRestRequestResponse.Create(GetResponseStream(False), FResponseCharSet, '', False);
      try
        LJSONValue := TJSONObject.ParseJSONValue(BytesOf(Result.StringValue), 0);
        if (LJSONValue <> nil) and (LJSONValue is TJSONObject) and
          (TJSONObject(LJSONValue).Get('SessionExpired') <> nil) then
          FResponseSessionExpired := True;
      finally
        FreeAndNil(Result);
      end;
    end;
    if (FStatus <> 200) and (FStatus <> 201) and (FStatus <> 202) then
      raise TDSRestProtocolException.Create(FStatus, LResponseText, LErrorMessage);
    Result := TDSRestRequestResponse.Create(GetResponseStream(False), FResponseCharSet, FResponseSessionID,
      FResponseSessionExpired);
  finally
    LStream.Free;
  end;
end;

procedure TDSRestRequest.setRequestHeader(const AName, AValue: string);
begin
  if not FHeaders.ContainsKey(AName) then
    FHeaders.Add(AName, AValue)
  else
    FHeaders[AName] := AValue;
end;

procedure TDSRestRequest.setRequestPragma(const AValue: string);
begin
  FRequestPragma := AValue;
end;

constructor TDSRestRequest.Create(AHTTP: TDSHTTP);
begin
  FFreeResponseStream := True;
  FHTTP := AHTTP;
end;

function TDSRestRequest.GetHTTP: TDSHTTP;
var
  P: TPair<string, string>;
begin
  Result := FHTTP;
  Result.Request.Accept := Accept;
  if Result.Request.Authentication <> nil then
  begin
    Result.Request.Authentication.Username := FUserName;
    Result.Request.Authentication.Password := FPassword;
  end
  else
    Result.SetBasicAuthentication(FUserName, FPassword);
  FResponseStream.Size := 0;
  Result.Request.CustomHeaders.Clear;
  for P in FHeaders do
    Result.Request.CustomHeaders.AddValue(P.Key, P.Value);
  Result.Request.Pragma := FRequestPragma;
end;

function TDSRestRequest.GetResponseStream(AOwnsObject: Boolean): TStream;
begin
  Result := FResponseStream;
  if (Result <> nil) and (not AOwnsObject) then
    FFreeResponseStream := False;
end;

procedure TDSRestRequest.DoRequest(var response: string; out responseCode: Integer; out errorMessage: string;
  ACallback: TProc<TDSHTTP>);
var
  Http: TDSHTTP;
  LPragma: string;
  LPos: Integer;
begin
  errorMessage := '';
  Http := GetHTTP;
  try
    ACallback(Http);
    FResponseCharSet := Http.Response.Charset;
    responseCode := http.ResponseCode;
    //FResponseSessionID := Http.Response.CustomHeaders.Values['dssession'];
    LPragma := Http.Response.Pragma;
    LPos := Pos(sDSSessionEquals, LPragma);
    if LPos > 0 then
    begin
      LPragma := Copy(LPragma, LPos+Length(sDSSessionEquals), MaxInt);
      LPos := Pos(',', LPragma);
      if LPos > 0 then
        Delete(LPragma, LPos, MaxInt);
      FResponseSessionID := LPragma;
    end
    else
      FResponseSessionID := '';
  except
    on PE: EIdHTTPProtocolException do
    begin
      responseCode := PE.ErrorCode;
      errorMessage := PE.ErrorMessage;
      response := PE.Message;
    end;
    on E: Exception do
      raise;
  end;
end;

procedure TDSRestRequest.SendGetRequest(var response: string; out responseCode: Integer; out errorMessage: string);
begin
  DoRequest(response, responseCode, errorMessage,
    procedure(Http: TDSHTTP)
    begin
      Http.Get(FURL, FResponseStream);
    end
    );
end;

procedure TDSRestRequest.SendPutRequest(datastream: TStream; var response: string; out responseCode: Integer; out errorMessage: string);
begin
  DoRequest(response, responseCode, errorMessage,
    procedure(Http: TDSHTTP)
    begin
      Http.Put(FURL, dataStream, FResponseStream);
    end
    );
end;

procedure TDSRestRequest.SendPostRequest(datastream: TStream; var response: string; out responseCode: Integer; out errorMessage: string);
begin
  DoRequest(response, responseCode, errorMessage,
    procedure(Http: TDSHTTP)
    begin
      http.Post(FURL, dataStream, FResponseStream);
    end
    );
end;

procedure TDSRestRequest.SendDeleteRequest(var response: string; out responseCode: Integer; out errorMessage: string);
begin
  DoRequest(response, responseCode, errorMessage,
    procedure(Http: TDSHTTP)
    begin
      http.Delete(FURL, FResponseStream);
    end
    );
end;

{ TDSRestRequestResponse }

constructor TDSRestRequestResponse.Create(const AStream: TStream;
  const AResponseCharSet, ASessionID: string; ASessionExpired: Boolean);
begin
  FFreeStreamValue := True;
  AStream.Position := 0;
  FStreamValue := AStream;
  FResponseCharSet := AResponseCharSet;
  FSessionID := ASessionID;
  FSessionExpired := ASessionExpired;
end;

function TDSRestRequestResponse.GetStringValue: string;
begin
  if not FHaveString then
  begin
    FHaveString := True;
    FStreamValue.Position := 0;
    FStringValue := ReadStringAsCharset(FStreamValue, FResponseCharset);
  end;
  Result := FStringValue;
end;

destructor TDSRestRequestResponse.Destroy;
begin
  if FFreeStreamValue then
    FreeAndNil(FStreamValue);
  inherited;
end;

function TDSRestRequestResponse.GetStream(AObjectOwner: Boolean): TStream;
begin
  Result := FStreamValue;
  if not AObjectOwner then
    FFreeStreamValue := False;
end;

{ TDSRestLoginProperties }

procedure TDSRestLoginProperties.AssignTo(Dest: TPersistent);
begin
  if Dest is TDSRestLoginProperties then
  begin
    TDSRestLoginProperties(Dest).UserName := UserName;
    TDSRestLoginProperties(Dest).Password := Password;
    TDSRestLoginProperties(Dest).LoginPrompt := LoginPrompt;
  end
  else
    inherited;
end;

(*
 * Class for registering a callback which will update callbacks on the client when invoked from
 * the server. A channel on the server is a manager for a specific object on the source which can
 * send out notifications. Registering a client callback hooks that callback in to be notified
 * of changes by the server.
 * @param AChannelId the unique identifier for this client channel (callback)
 * @param AServerChannelName the unique name of the server channel
 * @param AConnection TDSRestConnection
 *)
constructor TDSRestClientChannel.Create(const AChannelId, AServerChannelName: string; AConnection: TDSCustomRestConnection);
begin
  FConnection := AConnection;
  FCallbacks := TObjectList<TDSRestClientCallback>.Create(True (* Owns *));
  FServerChannelName := AServerChannelName;
  FCallbackLoop := nil;
  FChannelId := AChannelId;
end;

(*
 * Registers a client callback with the server.
 * @param AClientCallback an instance of TClientCallback
 *)
procedure TDSRestClientChannel.RegisterCallback(AClientCallback: TDSRestClientCallback);
var
  LClient: TDSAdminRestClient;
begin
  TMonitor.Enter(FCallbacks);
  try
    if (FCallbackLoop <> nil) and (FCallbackLoop.Stopped) then
    begin
      FCallbacks.Add(AClientCallback);
      LClient :=  TDSAdminRestClient.Create(FConnection, False);
      try
        LClient.RegisterClientCallbackServer(FserverChannelName, FchannelId,
        AClientCallback.callbackId);
      finally
       LClient.Free;
      end;
    end;
  finally
    TMonitor.Exit(FCallbacks);
  end;
end;

(*
 * Unregisters a client callback from the server.
 * @param AClientCallback the callback to unregister
 *)
procedure TDSRestClientChannel.UnRegisterCallback(AClientCallback: TDSRestClientCallback);
var
  LClient: TDSAdminRestClient;
  LCallbackId: string;
begin
  TMonitor.Enter(FCallbacks);
  try
    LCallbackId := AClientCallback.CallbackId;
    // Frees AClientCallback
    FCallbacks.Remove(AClientCallback);
    LClient :=  TDSAdminRestClient.Create(FConnection, False);
    try
      LClient.UnregisterClientCallback(FserverChannelName, FchannelId, LCallbackId);
    finally
      LClient.Free;
    end;
  finally
    TMonitor.Exit(FCallbacks);
  end;
end;

(*
 * Connects the client channel, registering a callback, as the channel can only
 * be open if at least one callback is registered.
 * @param AFirstCallback an instance of TClientCallback
 *)
procedure TDSRestClientChannel.Connect(AFirstCallback: TDSRestClientCallback);
begin
  TMonitor.Enter(FCallbacks);
  try
    if (FCallbackLoop <> nil) then
      FCallbackLoop.Stop;
    FCallbacks.Clear;
    FCallbacks.Add(AFirstCallback);
    FCallbackLoop := TDSRestCallbackLoop.Create(Self, FConnection);
    FCallbackLoop.Start(AFirstCallback);
  finally
    TMonitor.Exit(FCallbacks);
  end;
end;

(*
 * Unregisters all callbacks and disconnect the channel.
 *)
procedure TDSRestClientChannel.DisConnect;
begin
  UnregisterAllCallbacks;
  if FCallbackLoop <> nil then
  begin
    FCallbackLoop.Stop;
  end;
end;

procedure TDSRestClientChannel.UnregisterAllCallbacks;
begin
  TMonitor.Enter(FCallbacks);
  try
   while FCallbacks.Count > 0 do
     UnRegisterCallback(FCallbacks[0]);
  finally
    TMonitor.Exit(FCallbacks);
  end;
end;

procedure TDSRestClientChannel.EnumerateCallbacks(AMethod: TFunc<TDSRestClientCallback, Boolean>);
var
  LCallback: TDSRestClientCallback;
begin
  TMonitor.Enter(FCallbacks);
  try
   for LCallback in FCallbacks do
     if not AMethod(LCallback) then
       break;
  finally
    TMonitor.Exit(FCallbacks);
  end;
end;

procedure TDSRestClientChannel.EnumerateCallbacks(AMethod: TProc<TDSRestClientCallback>);
var
  LCallback: TDSRestClientCallback;
begin
  TMonitor.Enter(FCallbacks);
  try
   for LCallback in FCallbacks do
     AMethod(LCallback);
  finally
    TMonitor.Exit(FCallbacks);
  end;
end;

function TDSRestClientChannel.GetConnected: Boolean;
begin
  Result := (FCallbackLoop <> nil) and (not FCallbackLoop.Stopped)
end;

destructor TDSRestClientChannel.Destroy;
begin
  if (FCallbackLoop <> nil) and (not FCallbackLoop.Stopped) then
    Disconnect; // Blocks until thread is terminated
  FreeAndNil(FCallbacks);
  FreeAndNil(FCallbackLoop);
  inherited;
end;

(*
 * Broadcasts a message to all registered callbacks of the server channel
 * this ClientChannel is registered with.
 * @param AMessage the message to broadcast
 * @return true if the message was sent successfully to the server (but not neccessarally all callbacks,)
 *         false otherwise
 *)
function TDSRestClientChannel.Broadcast(AMessage: TJSONValue): Boolean;
var
  LClient: TDSAdminRestClient;
begin
  if AMessage <> nil then
  begin
    LClient := TDSAdminRestClient.Create(FConnection, False);
    try
      Result := LClient.BroadcastToChannel(FServerChannelName, AMessage)
    finally
      LClient.Free;
    end;
  end
  else
    Result := False;
end;

(*
 * Sends a notification message to a single callback of a specific ClientChannel.
 * Note that if you try to notify a callback of this ClientChannel no trip to the
 * server will be made to perform this.
 * @param AClientId the unique ID of ClientChannel the callback to notify is in
 * @param ACallbackId the unique ID of the callback to notify
 * @param AMessage the message to notify the callback with
 * @return true if notification was successful,
 *         false otherwise
 *)
function TDSRestClientChannel.Notify(const AClientId, ACallbackId: string; AMessage: TJSONValue): Boolean;
var
  LResponse: TJSONValue;
  LClient: TDSAdminRestClient;
  LCurCallback: TDSRestClientCallback;
begin
  if (AClientId = '') or (ACallbackId = '') or (AMessage = nil) then
    Exit(false);

  if AClientId = FChannelId then
  begin
    TMonitor.Enter(FCallbacks);
    try
      for LCurCallback in FCallbacks do
      begin
        if LCurCallback.CallbackId = ACallbackId then
        begin
          Exit(LCurCallback.ClientCallbackFunction(AMessage, ''));
        end;
      end;
    finally
      TMonitor.Exit(FCallbacks);
    end;
    Exit(False);
  end;
  LClient := TDSAdminRestClient.Create(FConnection, False);
  try
    Result := LClient.NotifyCallback(FServerChannelName, AClientId, ACallbackId, AMessage, LResponse);
  finally
    LClient.Free;
  end;
end;

constructor TDSRestCallbackLoop.Create(AClientChannel: TDSRestClientChannel; AConnection: TDSCustomRestConnection);
begin
  // Clone connection to use on a separate thread
  FConnection := TDSCustomRestConnection(TComponentClass(AConnection.ClassType).Create(nil));
  FConnection.Assign(AConnection);
  FClientChannel := AClientChannel;
end;

destructor TDSRestCallbackLoop.Destroy;
begin
  FreeAndNil(FThread);
  FreeAndNil(FConnection);
  inherited;
end;

function TDSRestCallbackLoop.GetStopped: Boolean;
begin
  Result := (FThread = nil) or (FThread.Finished);
end;

(*
 * The callback which will handle a value passed in from the server
 *)
procedure TDSRestCallbackLoop.Callback(responseValue: TJSONValue; var AStatus: Boolean; var AStop: Boolean);
var
  LParamArray: TJSONArray;
  LParamValue: TJSONValue;
  LDataType: string;
  LResponseObject: TJSONObject;
  LCallbackKey: string;
  LStatus: PBoolean;
begin
  AStop := False;
  AStatus := True;
  if (not Self.Stopped) and (responseValue <> nil) then
  begin
    //code which resolves the true response object
    if (responseValue is TJSONObject) and (TJSONObject(responseValue).Get('result') <> nil) then
       responseValue := TJSONObject(responseValue).Get('result').JSONValue;
    if responseValue is TJSONArray then
      responseValue := TJSONArray(responseValue).Get(0);
    LResponseObject := TJSONObject(responseValue);
    //session expired, so notify local callbacks and then stop the loop
    if LResponseObject.Get('SessionExpired') <> nil then
    begin
      clientChannel.EnumerateCallbacks(
        procedure(ACallback: TDSRestClientCallback)
        begin
          ACallback.ClientCallbackFunction(LResponseObject,'');
        end);
      AStop := True;
    end
    //broadcast to all of the callbacks
    else if LResponseObject.Get('broadcast') <> nil then
    begin
      LParamArray := TJSONArray(LResponseObject.Get('broadcast').JSONValue);
      LParamValue := TJSONArray(LParamArray.Get(0));

      //used to determine if the paramValue is (on the server) a JSONValue or a TObject
      LDataType := LParamArray.Get(1).Value;

      clientChannel.EnumerateCallbacks(
        procedure(ACallback: TDSRestClientCallback)
        begin
          ACallback.ClientCallbackFunction(LParamValue, LDataType);
        end);
      AStatus := True;
    end
    //Invoke the specified callback
    else if LResponseObject.Get('invoke') <> nil then
    begin
      LParamArray := TJSONArray(LResponseObject.Get('invoke').JSONValue);
      LCallbackKey := LParamArray.Get(0).Value;
      LParamValue := TJSONArray(LParamArray.Get(1));

      //used to determine if the paramValue is (on the server) a JSONValue or a TObject
      LDataType := LParamArray.Get(2).Value;

      LStatus := @AStatus;
      clientChannel.EnumerateCallbacks(
        function(ACallback: TDSRestClientCallback): Boolean
        begin
          if ACallback.callbackId = LCallbackKey then
          begin
            LStatus^ := ACallback.ClientCallbackFunction(LParamValue, LDataType);
            Result := False; // Stop enumeration
          end
          else
            Result := True; // continue enumeration
        end);
    end
    //if an error has occured notify the callbacks and stop the loop
    else if LResponseObject.Get('error') <> nil then
    begin
      clientChannel.EnumerateCallbacks(
        procedure(ACallback: TDSRestClientCallback)
        begin
          ACallback.ClientCallbackFunction(LResponseObject, 'error');
        end);
       AStop := True;
    end
    //If the result key is 'close' or 'closeChannel' then no response should be sent, which means
    //the recursion of this loop will end. Otherwise, send a response to the server with
    //a value of false so the loop will continue and the server will know the invocation failed
    else if (LResponseObject.Get('closeChannel') = nil) and (LResponseObject.Get('close') = nil) then
    begin
      AStatus := False;
    end
    else
    begin
      AStop := True;
    end
  end
  else
  begin
    AStop := True;
  end;
end;


type
  TCallbackLoopWorker = procedure(AResponseValue: TJSONValue; var AStatus: Boolean; var AStop: Boolean) of object;
  TCallbackLoopThread = class(TThread)
  private
    FConnection: TDSCustomRestConnection;
    FChannelName: string;
    FClientManagerId: string;
    FCallbackId: string;
    FWorker: TCallbackLoopWorker;
    constructor Create(AWorker: TCallbackLoopWorker;
      AConnection: TDSCustomRestConnection; AChannelName, AClientManagerId, ACallbackId: string);
  protected
    procedure Execute; override;
  end;

constructor TCallbackLoopThread.Create(AWorker: TCallbackLoopWorker;
  AConnection: TDSCustomRestConnection; AChannelName, AClientManagerId, ACallbackId: string);
begin
  FWorker := AWorker;
  FConnection := AConnection;
  FChannelName := AChannelName;
  FClientManagerId := AClientManagerId;
  FCallbackId := ACallbackId;
  inherited Create(True);
end;

procedure TCallbackLoopThread.Execute;
var
  LClient: TDSAdminRestClient;
  LJSONValue: TJSONValue;
  LStatus: Boolean;
  LStopped: Boolean;
  LStatusValue: TJSONValue;
  LTrue: TJSONTrue;
  LFalse: TJSONFalse;
begin
  LTrue := TJSONTrue.Create;
  LFalse := TJSONFalse.Create;
  LClient :=  TDSAdminRestClient.Create(FConnection, False);
  try
    // Block until the server responds
    LJSONValue := LClient.ConsumeClientChannel(FChannelName, FClientManagerId, FCallbackId, nil);
    try
      FWorker(LJSONValue, LStatus, LStopped);
    finally
      LJSONValue.Free;
    end;
    while not LStopped do
    begin
      if LStatus then
        LStatusValue := TJSONTrue.Create
      else
        LStatusValue := TJSONFalse.Create;
      try
        // Must pass '' when using an existing channel
        // Block until the server responds
        LJSONValue := LClient.ConsumeClientChannel(FChannelName, FClientManagerId, '', LStatusValue);
        try
          FWorker(LJSONValue, LStatus, LStopped);
        finally
          LJSONValue.Free;
        end;
      finally
        LStatusValue.Free;
      end;
    end;
  finally
    LClient.Free;
    LTrue.Free;
    LFalse.Free;
  end;
end;

(*
 * Starts the loop, registering the client callback on the server and the initial client callback specified
 * @param firstCallback the first callback to register, as you can't register a client with the server without specifying the first callback
 *)
procedure TDSRestCallbackLoop.Start(AFirstCallback: TDSRestClientCallback);
begin
  if Stopped and (FClientChannel <> nil) then
  begin
    FreeAndNil(FThread);
    FThread := TCallbackLoopThread.Create(Self.Callback,
      FConnection, FClientChannel.ServerChannelName, FClientChannel.ChannelId, AFirstCallback.CallbackId);
    FThread.OnTerminate := OnThreadTerminate;
    FThread.FreeOnTerminate := False;
    FThread.Start;
  end;
end;

procedure TDSRestCallbackLoop.OnThreadTerminate(ASender: TObject);
begin
  // Unregister callbacks in case of unexpected termination
  FClientChannel.UnregisterAllCallbacks;
  if Assigned(FClientChannel.FOnDisconnect) then
    FClientChannel.FOnDisconnect(FClientChannel);
end;

(*
 * Tells the thread to terminate. The thread will still be hung waiting for a response from the server, but
 * once it gets that it will disregard the server command and not send another http request. This also
 * sends a command to the server, telling it that the client wishes to be unregistered.
 *)
procedure TDSRestCallbackLoop.Stop;
{
var
  LClient: TDSAdminRestClient;
begin
  if (not Stopped) and (FClientChannel <> nil) then
  begin
    LClient :=  TDSAdminRestClient.Create(FConnection, False);
    try
      LClient.CloseClientChannel(FClientChannel.ServerChannelName, FClientChannel.ChannelId);
    finally
      LClient.Free;
    end;
  end;
  try
    // Block until thread is terminated
    if FThread <> nil then
      FThread.WaitFor;
  except
  end;
}
var
  LClient: TDSAdminRestClient;
  LConnection: TDSCustomRestConnection;
begin
  if (not Stopped) and (FClientChannel <> nil) then
  begin
    // Must use another connection because FConnection is currently
    // waiting for a response
    LConnection := TDSCustomRestConnection(TComponentClass(FConnection.ClassType).Create(nil));
    try
      LConnection.Assign(FConnection);
      LConnection.SessionId := '';
      LClient :=  TDSAdminRestClient.Create(LConnection, False);
      try
        LClient.CloseClientChannel(FClientChannel.ServerChannelName, FClientChannel.ChannelId);
      finally
        LClient.Free;
      end;
    finally
      LConnection.Free;
    end;
  end;
  try
    // Block until thread is terminated
    if FThread <> nil then
      FThread.WaitFor;
  except
  end;
end;


(*
 * AClientChannel is an instance of the ClientChannel class which is intended to contain the callback. It isn't
 * guaranteed this containment will actually exist. To do so, you will need to call either the
 * "connect" or "registerCallback" function of the ClientChannel instance with this callback
 * as a parameter to create the containment relationship.
 * ACallbackId is the unique ID of this callback. This only needs to be unique on this particular client,
 * in this instance of ClientChannel and not across all instances of ClientChannel or all clients.
 * AClientCallbackFunction is the function to call for updating the callback and returning a JSON Value response back to the server.
 * @param value a JSON Value instance containing the formatted JSON properties required for updating the callback
 * @return a JSON value response to deliver to the server. This response will reflect the current
 *         state of the callback after the update.
 *)

constructor TDSRestClientCallback.Create(AClientChannel: TDSRestClientChannel; const ACallbackId: string;
      AClientCallbackFunction: TDSRestClientCallbackFunction);
begin
  FClientChannel := AClientChannel;
  FCallbackId := ACallbackId;
  FClientCallbackFunction := AClientCallbackFunction
end;

// The above code is based on the following javascript.  CallbackFramework.js
//
///*
// * Class for registering a callback which will update callbacks on the client when invoked from
// * the server. A channel on the server is a manager for a specific object on the source which can
// * send out notifications. Registering a client callback hooks that callback in to be notified
// * of changes by the server.
// * @param channelId the unique identifier for this client channel (callback)
// * @param serverChannelName the unique name of the server channel
// * @param connectionInfo map (JSON Object) containing connection info. See ServerFunctionExecutor for more info
// */
//function ClientChannel(channelId, serverChannelName, connectionInfo)
//{
//  /*
//   * This holds all of the registered callbacks for this client channel
//   */
//  this.callbacks = new Array();
//  this.serverChannelName = serverChannelName;
//  this.connectionInfo = connectionInfo;
//  this.admin = new DSAdmin(connectionInfo);
//
//  /*
//   * The name of the channel on the server this callback will 'listen to' for updates.
//   */
//  this.serverChannelName = serverChannelName;
//
//  /*
//   * The wrapper of a continually issued XMLHTTPRequest which is used as the client callback on the server.
//   */
//  this.callbackLoop = null;
//
//  /*
//   * Unique ID of the client channel (callback.) Not to be confused with the server's Channel Name, which
//   * uniquely identifies the channel type on the server.
//   */
//  this.channelId = channelId;
//
//  /*
//   * Registers a client callback with the server.
//   * @param clientCallback an instance of ClientCallback
//   */
//  this.registerCallback = function(clientCallback) {
//    if (this.callbackLoop != null && !this.callbackLoop.stopped)
//    {
//      this.callbacks[this.callbacks.length] = clientCallback;
//      this.callbackLoop.registerCallback(clientCallback);
//    }
//  }
//
//  /*
//   * Unregisters a client callback from the server.
//   * @param clientCallback the callback to unregister
//   */
//  this.unregisterCallback = function(clientCallback) {
//    if (this.callbackLoop != null)
//    {
//      this.callbacks.removeItem(clientCallback);
//      if (!this.callbackLoop.stopped)
//      {
//        this.callbackLoop.unregisterCallback(clientCallback);
//      }
//      if (this.callbacks.length == 0)
//      {
//        this.callbackLoop = null;
//      }
//    }
//  }
//
//  /*
//   * Connects the client channel, registering a callback, as the channel can only
//   * be open if at least one callback is registered.
//   * @param firstCallback an instance of ClientCallback
//   */
//  this.connect = function(firstCallback) {
//    if (this.callbackLoop != null)
//    {
//      this.callbackLoop.stop();
//    }
//    this.callbacks.length = 0; //clear the array
//    this.callbacks[this.callbacks.length] = firstCallback;
//    this.callbackLoop = new CallbackLoop(this, this.connectionInfo);
//    this.callbackLoop.start(firstCallback);
//  }
//
//  /*
//   * Unregisters all callbacks and disconnect the channel.
//   */
//  this.disconnect = function() {
//    this.callbacks.length = 0;
//    if (this.callbackLoop != null)
//    {
//      this.callbackLoop.stop(); //this will unregister all callbacks
//      this.callbackLoop = null;
//    }
//  }
//
//  /*
//   * Broadcasts a message to all registered callbacks of the server channel
//   * this ClientChannel is registered with.
//   * @param message the message to broadcast
//   * @return true if the message was sent successfully to the server (but not neccessarally all callbacks,)
//   *         false otherwise (or a JSON value/object in special cases, such as errors or session timeouts)
//   */
//  this.broadcast = function(message) {
//    var response = null;
//    if (message != null)
//    {
//       response = this.admin.BroadcastToChannel(this.serverChannelName, message);
//    }
//
//    //if the response isn't a formatted result then it is probably an error, so pass it back
//    if (response != null && response.result == null)
//    {
//      return response;
//    }
//
//    return response != null && response.result != null && response.result;
//  }
//
//  /*
//   * Sends a notification message to a single callback of a specific ClientChannel.
//   * Note that if you try to notify a callback of this ClientChannel no trip to the
//   * server will be made to perform this.
//   * @param clientId the unique ID of ClientChannel the callback to notify is in
//   * @param callbackId the unique ID of the callback to notify
//   * @param message the message to notify the callback with
//   * @return true (or possibly a response message) if notification was successful,
//   *         false otherwise  (or a JSON value/object in special cases, such as errors or session timeouts)
//   */
//  this.notify = function(clientId, callbackId, message) {
//    if (clientId == null || callbackId == null || message == null)
//    {
//      return false;
//    }
//
//    //optimization to prevent unrequired trip to the server.
//    //Also done because of open connection limits in browsers which can be as low as 2 or 3
//    if (clientId == this.channelId)
//    {
//      for(var i = 0; i < this.callbacks.length; i++)
//      {
//        var currCallback = this.callbacks[i];
//        if (currCallback.callbackId == callbackId)
//        {
//          var cbResult = currCallback.notifyCallback(message);
//          return cbResult != null ? cbResult : false;
//        }
//      }
//
//      //callback with given ID doesn't exist
//      return false;
//    }
//
//    //the callback isn't in this ClientChannel, so request for the server to notify it
//    return this.admin.NotifyCallback(this.serverChannelName, clientId, callbackId, message);
//  }
//}

///*
// * Class representing a client callback with a single function which will be invoked from
// * the server to update the callback, and then return a result which will be passed back to the server.
// * @param clientChannel an instance of ClientChannel, which will contain this callback
// * @param callbackId a unique id for this callback
// * @param clientFunction a function to call which will do the update of the physical callback and return a result.
// *                  This function takes a JSON Value as a parameter and returns a JSON Value as a result.
// */
//function ClientCallback(clientChannel, callbackId, clientFunction)
//{
//  /*
//   * An instance of the ClientChannel class which is intended to contain the callback. It isn't
//   * guaranteed this containment will actually exist. To do so, you will need to call either the
//   * "connect" or "registerCallback" function of the ClientChannel instance with this callback
//   * as a parameter to create the containment relationship.
//   */
//  this.clientChannel = clientChannel;
//
//  /*
//   * The unique ID of this callback. This only needs to be unique on this particular client,
//   * in this instance of ClientChannel and not across all instances of ClientChannel or all clients.
//   */
//  this.callbackId = callbackId;
//
//  /**
//   * The function to call for updating the callback and returning a JSON Value response back to the server.
//   * @param value a JSON Value instance containing the formatted JSON properties required for updating the callback
//   * @return a JSON value response to deliver to the server. This response will reflect the current
//   *         state of the callback after the update.
//   */
//  this.notifyCallback = clientFunction;
//}

///*
// * Class which wraps an XMLHTTPRequest. When the request returns, the appropriate callback(s) are notified
// * and then this callback loop returns the result of the invocation back to the server.
// *
// * This long-term callback is achieved by issuing an HTTP request which will not return anything until
// * a server channel this client is interested in is updated. When the response is returned,
// * it is handled and another request (the client's response) is sent.
// *
// * @param clientChannel the client channel to have registered on the server
// * @param connectionInfo map (JSON Object) containing connection info. See ServerFunctionExecutor for more info
// */
//function CallbackLoop(clientChannel, connectionInfo)
//{
//  this.executor = new ServerFunctionExecutor("DSAdmin", connectionInfo, this);
//  this.clientChannel = clientChannel;
//  this.stopped = true;
//
//  /*
//   * The callback which will handle a value passed in from the server and then pass
//   * back a response to the server as long as the channel is active.
//   */
//  this.callback = function(responseObject, requestStatus, callbackLoop) {
//    if (callbackLoop != null && !callbackLoop.stopped && responseObject != null)
//    {
//      //code which resolves the true response object
//      responseObject = (responseObject.result != null) ? responseObject.result : responseObject;
//      responseObject = isArray(responseObject) ? responseObject[0] : responseObject;
//
//      //if the session this callback was created on has sense expired then stop the callback loop,
//      //preventing any calls to callbackLoop.sendResponse from executing
//      if ($$SessionID$$ == null)
//      {
//        callbackLoop.stopped = true;
//      }
//
//      //session expired, so notify local callbacks and then stop the loop
//      if (responseObject.SessionExpired != null)
//      {
//        for(var i = 0; i < clientChannel.callbacks.length; i++)
//        {
//          clientChannel.callbacks[i].notifyCallback(responseObject);
//        }
//        callbackLoop.stopped = true;
//      }
//      //broadcast to all of the callbacks
//      else if (responseObject.broadcast != null)
//      {
//        var paramArray = responseObject.broadcast;
//        var paramValue = paramArray[0];
//
//        //used to determine if the paramValue is (on the server) a JSONValue or a TObject
//        var dataType = paramArray[1];
//
//        for(var i = 0; i < clientChannel.callbacks.length; i++)
//        {
//          clientChannel.callbacks[i].notifyCallback(paramValue, dataType);
//        }
//        callbackLoop.sendResponse(true, callbackLoop);
//      }
//      //Invoke the specified callback
//      else if (responseObject.invoke != null)
//      {
//        var paramArray = responseObject.invoke;
//        var callbackKey = paramArray[0];
//        var paramValue = paramArray[1];
//
//        //used to determine if the paramValue is (on the server) a JSONValue or a TObject
//        var dataType = paramArray[2];
//
//        var currCallback;
//        for(var i = 0; i < clientChannel.callbacks.length; i++)
//        {
//          currCallback = clientChannel.callbacks[i];
//
//          if (currCallback.callbackId == callbackKey)
//          {
//            callbackLoop.sendResponse(currCallback.notifyCallback(paramValue, dataType), callbackLoop);
//            break;
//          }
//        }
//      }
//      //if an error has occured notify the callbacks and stop the loop
//      else if (responseObject.error != null)
//      {
//        for(var i = 0; i < clientChannel.callbacks.length; i++)
//        {
//          clientChannel.callbacks[i].notifyCallback(responseObject, "error");
//        }
//        callbackLoop.stopped = true;
//      }
//      //If the result key is 'close' or 'closeChannel' then no response should be sent, which means
//      //the recursion of this loop will end. Otherwise, send a response to the server with
//      //a value of false so the loop will continue and the server will know the invocation failed
//      else if (responseObject.closeChannel == null && responseObject.close == null)
//      {
//        callbackLoop.sendResponse(false, callbackLoop);
//      }
//      else
//      {
//        callbackLoop.stopped = true;
//      }
//    }
//    else
//    {
//      callbackLoop.stopped = true;
//    }
//  };
//
//  /*
//   * Starts the loop, registering the client callback on the server and the initial client callback specified
//   * @param firstCallback the first callback to register, as you can't register a client with the server without specifying the first callback
//   */
//  this.start = function(firstCallback) {
//    if (this.stopped && this.clientChannel != null)
//    {
//      this.stopped = false;
//
//      //passes empty string for the ConsumeClientChannel last parameter, since this is initiating the channel, and has no value
//      //passes true after the callback to say a response from the server is expected
//      this.executor.executeMethod("ConsumeClientChannel", "GET",
//                             [this.clientChannel.serverChannelName, this.clientChannel.channelId, firstCallback.callbackId, ""],
//                             this.callback, true);
//    }
//  };
//
//  /*
//   * Tells the loop to terminate. The loop will still be hung waiting for a response from the server, but
//   * once it gets that it will disregard the server command and not send another http request. This also
//   * sends a command to the server, telling it that the client wishes to be unregistered.
//   */
//  this.stop = function() {
//    if(!this.stopped && this.clientChannel != null)
//    {
//      this.stopped = true;
//      this.executor.executeMethod("CloseClientChannel", "GET",
//                         [this.clientChannel.serverChannelName, this.clientChannel.channelId], null);
//    }
//  }
//
//  /*
//   * Function which should only be called internally from the callback inside this CallbackLoop instance.
//   * This function is used to return a given response to the server, reinitializing the callback HTTP request in the process.
//   */
//  this.sendResponse = function(responseObject,callbackLoop) {
//    if (!this.stopped)
//    {
//      if (callbackLoop == null)
//      {
//        callbackLoop = this;
//      }
//      //passes empty string for the CallbackId parameter of ConsumeClientChannel to say this is a response to a client invocation
//      //passes the response JSON Value as the last parameter of the ConsumeclientChannel call
//      this.executor.executeMethod("ConsumeClientChannel", "POST",
//                             [callbackLoop.clientChannel.serverChannelName, callbackLoop.clientChannel.channelId, "", responseObject],
//                             callbackLoop.callback, true);
//    }
//  };
//
//  /*
//   * This function registers the given callback. This should only be called after the
//   * start function has been called and the loop is active. The call is not issued through
//   * the loop; it instead uses a separate http request to do this.
//   */
//  this.registerCallback = function(clientCallback) {
//    if(!this.stopped && this.clientChannel != null && clientCallback != null)
//    {
//      this.executor.executeMethod("RegisterClientCallbackServer", "GET",
//                             [this.clientChannel.serverChannelName, this.clientChannel.channelId, clientCallback.callbackId], null);
//    }
//  };
//
//  /*
//   * This function unregisters the given callback
//   */
//  this.unregisterCallback = function(clientCallback) {
//    if(!this.stopped && this.clientChannel != null && clientCallback != null)
//    {
//      this.executor.executeMethod("UnregisterClientCallback", "GET",
//                             [this.clientChannel.serverChannelName, this.clientChannel.channelId, clientCallback.callbackId], null);
//    }
//  };
//}



{ TDSRestCachedItem }

constructor TDSRestCachedItem.Create(const AItemPath: string);
begin
  FItemPath := AItemPath;
  FOwnedObjects := TObjectList.Create(True);
end;

procedure TDSRestCachedItem.DeleteCommand(AConnection: TDSRestConnection);
begin
  Assert(False);
end;

destructor TDSRestCachedItem.Destroy;
begin
  FOwnedObjects.Free;
  inherited;
end;

function TDSRestCachedItem.GetCommand(AConnection: TDSRestConnection; AOwnsObject: Boolean = True): TJSONObject;
begin
  Assert(False);
  Result := nil;
end;

function TDSRestCachedItem.GetItemPath: string;
begin
  Result := FItempath;
end;

function TDSRestCachedItem.GetJSONValueCallback(AConnection: TDSRestConnection; ACallback: TGetJSONValueCallback; AOwnsObject: Boolean; const ARequestFilter: string): TJSONValue;
var
  LCommand: TDSRestCacheCommand;
  LAccept: Boolean;
begin
  LAccept := False;
  Result := nil;
  LCommand := TDSRestCacheCommand.Create(AConnection);
  try
    LCommand.ParameterPath := ItemPath;
    LCommand.GetParameter(Result, ARequestFilter);
    try
      if Assigned(ACallback) then
        LAccept := ACallback(Result)
      else
        LAccept := True;
      if LAccept and AOwnsObject then
        OwnedObjects.Add(Result);
    finally
      if not LAccept then
        FreeAndNil(Result);
    end;
  finally
    LCommand.Free;
  end;
end;

function TDSRestCachedItem.UnmarshalValue<T>(AConnection: TDSRestConnection;
  AOwnsObject: Boolean; const ARequestFilter: string): T;
var
  AJSONValue: TJSONValue;
  AUnmarshal: TJSONUnMarshal;
begin
  Result := nil;
  AJSONValue := GetJSONValue(AConnection, True, ARequestFilter);
  if AJSONValue <> nil then
  begin
    AUnmarshal := TJSONConverters.GetJSONUnmarshaler;
    try
      Result := T(AUnmarshal.UnMarshal(AJSONValue));
      if (Result <> nil) and AOwnsObject then
        OwnedObjects.Add(TObject(Result));
    finally
      FreeAndNil(AUnmarshal)
    end
  end
end;

function TDSRestCachedItem.GetJSONValue(AConnection: TDSRestConnection;
  AOwnsObject: Boolean; const ARequestFilter: string): TJSONValue;
begin
  Result :=
   (GetJSONValueCallback(AConnection,
    nil (* Callback *), AOwnsObject, ARequestFilter));
end;

{ TDSRestCachedJSONObject }

function TDSRestCachedJSONObject.GetValue(AConnection: TDSRestConnection;
  AOwnsObject: Boolean; const ARequestFilter: string): TJSONObject;
begin
  Result := TJSONObject
   (GetJSONValueCallback(AConnection,
    function(AValue: TJSONValue): Boolean
    begin
      Result := AValue is TJSONObject;
    end, AOwnsObject, ARequestFilter));
end;

{ TDSRestCachedJSONArray }

function TDSRestCachedJSONArray.GetValue(AConnection: TDSRestConnection;
  AOwnsObject: Boolean; const ARequestFilter: string): TJSONArray;
begin
  Result := TJSONArray
   (GetJSONValueCallback(AConnection,
    function(AValue: TJSONValue): Boolean
    begin
      Result := AValue is TJSONArray;
    end, AOwnsObject, ARequestFilter));
end;

{ TDSRestCachedJSONValue }

function TDSRestCachedJSONValue.GetValue(AConnection: TDSRestConnection;
  AOwnsObject: Boolean; const ARequestFilter: string): TJSONValue;
begin
  Result :=
   (GetJSONValueCallback(AConnection,
    function(AValue: TJSONValue): Boolean
    begin
      Result := AValue is TJSONValue;
    end, AOwnsObject, ARequestFilter));
end;

{ TDSRestCachedStream }

function TDSRestCachedStream.GetValue(AConnection: TDSRestConnection;
  AOwnsObject: Boolean; const ARequestFilter: string): TStream;
var
  LCommand: TDSRestCacheCommand;
begin
  Result := nil;
  LCommand := TDSRestCacheCommand.Create(AConnection);
  try
    LCommand.ParameterPath := ItemPath;
    LCommand.GetParameter(Result, False (* We own stream now *), ARequestFilter);
    if AOwnsObject and (Result <> nil) then
      OwnedObjects.Add(Result);
  finally
    LCommand.Free;
  end;
end;

{ TDSRestCachedDataSet }

function TDSRestCachedDataSet.GetValue(AConnection: TDSRestConnection;
  AOwnsObject: Boolean; const ARequestFilter: string): TDataSet;
var
  LReader: TDBXReader;
  LJSONTable: TJSONObject;
begin
  Result := nil;
  LJSONTable := TJSONObject
   (GetJSONValueCallback(AConnection,
    function(AValue: TJSONValue): Boolean
    begin
      Result := AValue is TJSONObject;
    end, False, ARequestFilter));
  try
    if LJSONTable <> nil then
    begin
      LReader := TDBXJSONTableReader.Create(nil, LJSONTable, True);
      LJSONTable := nil;
      try
        if LReader <> nil then
        begin
          Result := TCustomSQLDataSet.Create(nil, LReader, True);
          LReader := nil;
          Result.Open;
          if AOwnsObject then
            OwnedObjects.Add(Result);
        end;
      finally
        LReader.Free;
      end;
    end;
  finally
    LJSONTable.Free;
  end;
end;

{ TDSRestCachedParams }

function TDSRestCachedParams.GetValue(AConnection: TDSRestConnection;
  AOwnsObject: Boolean; const ARequestFilter: string): TParams;
var
  LReader: TDBXReader;
  LJSONTable: TJSONObject;
begin
  Result := nil;
  LJSONTable := TJSONObject
   (GetJSONValueCallback(AConnection,
    function(AValue: TJSONValue): Boolean
    begin
      Result := AValue is TJSONObject;
    end, False (* Take ownership of JSONObject *), ARequestFilter));
  try
    if LJSONTable <> nil then
    begin
      LReader := TDBXJSONTableReader.Create(nil, LJSONTable, True);
      LJSONTable := nil;
      try
        Result := TDBXParamsReader.ToParams(nil, LReader, True);
        LReader := nil;
        if AOwnsObject then
          OwnedObjects.Add(Result);
      finally
        LReader.Free;
      end;
    end;
  finally
    LJSONTable.Free;
  end;
end;

{ TDSRestCachedDBXReader }

function TDSRestCachedDBXReader.GetValue(AConnection: TDSRestConnection;
  AOwnsObject: Boolean; const ARequestFilter: string): TDBXReader;
var
  LJSONTable: TJSONObject;
begin
  LJSONTable := TJSONObject
   (GetJSONValueCallback(AConnection,
    function(AValue: TJSONValue): Boolean
    begin
      Result := AValue is TJSONObject;
    end, False, ARequestFilter));
  if LJSONTable <> nil then
  begin
    Result := TDBXJSONTableReader.Create(nil, LJSONTable, True);
    if (Result <> nil) and AOwnsObject then
      OwnedObjects.Add(Result);
  end
  else
    Result := nil;
end;

{ TDSRestCachedObject<T> }

function TDSRestCachedObject<T>.GetValue(AConnection: TDSRestConnection;
  AOwnsObject: Boolean; const ARequestFilter: string): T;
begin
  Result := UnmarshalValue<T>(AConnection, AOwnsObject, ARequestFilter);
end;

{ TDSRestProtocolException }

constructor TDSRestProtocolException.Create(AStatus: Integer; const AMessage,
  AResponseText: string);
begin
  inherited Create(AMessage);
  FStatus := AStatus;
  FResponseText := AResponseText;
end;

end.
