* Add request ID handling and callback-based result

packages/fcl-web/src/base/fphttpwebclient.pp

@@ -37,12 +37,14 @@ Type
     FHTTP : TFPHTTPClient;
   Public
     function GetHeaders: TStrings;override;
-    Constructor Create(AHTTP : TFPHTTPClient);
+    Constructor Create(AHTTP : TFPHTTPClient; aAsync: Boolean; const aRequestID : String=''); reintroduce;
     Destructor Destroy; override;
   end;
 
   { TFPHTTPRequest }
 
+  { TFPHTTPResponse }
+
   TFPHTTPResponse = Class(TWebClientResponse)
   Private
     FHTTP : TFPHTTPClient;
@@ -51,14 +53,14 @@ Type
     Function GetStatusCode : Integer; override;
     Function GetStatusText : String; override;
   Public
-    Constructor Create(AHTTP : TFPHTTPRequest);
+    Constructor Create(ARequest : TFPHTTPRequest); reintroduce;
   end;
 
   { TFPHTTPWebClient }
 
   TFPHTTPWebClient = Class(TAbstractWebClient)
   Protected
-    Function DoCreateRequest: TWebClientRequest; override;
+    Function DoCreateRequest(aIsAsync : Boolean; const aRequestID : String): TWebClientRequest; override;
     Function DoHTTPMethod(Const AMethod,AURL : String; ARequest : TWebClientRequest) : TWebClientResponse; override;
   end;
 
@@ -77,8 +79,9 @@ begin
   Result:=FHTTP.RequestHeaders;
 end;
 
-constructor TFPHTTPRequest.Create(AHTTP: TFPHTTPClient);
+constructor TFPHTTPRequest.Create(AHTTP: TFPHTTPClient; aAsync: Boolean; const aRequestID : String = '');
 begin
+  Inherited Create(aAsync,aRequestID);
   FHTTP:=AHTTP;
 end;
 
@@ -114,16 +117,16 @@ begin
     Result:='';
 end;
 
-Constructor TFPHTTPResponse.Create(AHTTP: TFPHTTPRequest);
+constructor TFPHTTPResponse.Create(ARequest: TFPHTTPRequest);
 begin
-  Inherited Create(AHTTP);
-  FHTTP:=AHTTP.FHTTP;
+  Inherited Create(ARequest);
+  FHTTP:=ARequest.FHTTP;
 end;
 
 
 { TFPHTTPWebClient }
 
-Function TFPHTTPWebClient.DoCreateRequest: TWebClientRequest;
+function TFPHTTPWebClient.DoCreateRequest(aIsAsync: Boolean; const aRequestID: String): TWebClientRequest;
 
 Var
   C : TFPHTTPClient;
@@ -133,7 +136,7 @@ begin
   C.RequestHeaders.NameValueSeparator:=':';
   C.ResponseHeaders.NameValueSeparator:=':';
 //  C.HTTPversion:='1.0';
-  Result:=TFPHTTPRequest.Create(C);
+  Result:=TFPHTTPRequest.Create(C,aIsAsync,aRequestID);
 end;
 
 Function TFPHTTPWebClient.DoHTTPMethod(Const AMethod, AURL: String;

packages/fcl-web/src/base/fpwebclient.pp

@@ -16,6 +16,8 @@ unit fpwebclient;
 {$ENDIF FPC_DOTTEDUNITS}
 
 {$mode objfpc}{$H+}
+{$modeswitch functionreferences}
+{$modeswitch advancedrecords}
 
 interface
 
@@ -43,13 +45,19 @@ Type
     FStream : TStream;
     FOwnsStream : Boolean;
     FSSLVersion : TSSLVersion;
+    FRequestID : String;
+    FIsAsync : Boolean;
   Protected
     function GetHeaders: TStrings;virtual;
     function GetStream: TStream;virtual;
+    property IsAsync : Boolean read FIsAsync;
   Public
+    constructor create(aASync : Boolean; const aRequestID : String = '');
     Destructor Destroy; override;
     Procedure SetContentFromString(Const S : String) ;
     Function GetContentAsString : String;
+    // Unique request ID
+    Property RequestID : String Read FRequestID;
     // Request headers or response headers
     Property Headers : TStrings Read GetHeaders;
     // Request content or response content
@@ -81,11 +89,15 @@ Type
   { TWebClientResponse }
 
   TWebClientResponse = Class(TRequestResponse)
+  private
+    FOwnsRequest: Boolean;
+    FRequest: TWebClientRequest;
   Protected
     Function GetStatusCode : Integer; virtual;
     Function GetStatusText : String; virtual;
   Public
-    Constructor Create(ARequest : TWebClientRequest); virtual;
+    Constructor Create(ARequest : TWebClientRequest); virtual; reintroduce;
+    Destructor Destroy; override;
     // Status code of request
     Property StatusCode : Integer Read GetStatusCode;
     // Status text of request
@@ -112,7 +124,16 @@ Type
 
   { TAbstractWebClient }
 
+  { TWebClientResponseResult }
 
+  TWebClientResponseResult = record
+    Response : TWebClientResponse;
+    Error : Exception;
+    function Success : Boolean;
+  end;
+
+  TAsyncResponseCallback = reference to procedure (aResponse : TWebClientResponseResult);
+   
   TAbstractWebClient = Class(TComponent)
   private
     FExaminer: TAbstractResponseExaminer;
@@ -121,12 +142,14 @@ Type
     FLogStream : TStream;
     FMinSSLVersion: TSSLVersion;
     FMaxSSLVersion: TSSLVersion;
+    FRequestID : Integer;
     Procedure LogRequest(AMethod, AURL: String; ARequest: TWebClientRequest);
     Procedure LogResponse(AResponse: TWebClientResponse);
     procedure SetLogFile(const AValue: String);
     procedure SetSSLVersion(AValue : TSSLVersion);
     Function GetSSLVersion : TSSLVersion;
   protected
+    function GetNextRequestID : String; virtual;
     // Determine min/max version to try
     procedure GetVersionLimits(out PMin, PMax: TSSLVersion);
     // Write a string to the log file
@@ -134,17 +157,18 @@ Type
     // Must execute the requested method using request/response. Must take ResponseContent stream into account
     Function DoHTTPMethod(Const AMethod,AURL : String; ARequest : TWebClientRequest) : TWebClientResponse; virtual; abstract;
     // Must create a request.
-    Function DoCreateRequest : TWebClientRequest; virtual; abstract;
+    Function DoCreateRequest(aIsAsync :Boolean; const aRequestID : String) : TWebClientRequest; virtual; abstract;
   Public
     Destructor Destroy; override;
 
     // Executes the HTTP method AMethod on AURL. Raises an exception on error.
     // On success, TWebClientResponse is returned. It must be freed by the caller.
     Function ExecuteRequest(Const AMethod,AURL : String; ARequest : TWebClientRequest) : TWebClientResponse;
+    Function ExecuteRequest(Const AMethod,AURL : String; ARequest : TWebClientRequest; aCallback : TAsyncResponseCallback) : String;
     // Same as HTTPMethod, but signs the request first using signer.
     Function ExecuteSignedRequest(Const AMethod,AURL : String; ARequest : TWebClientRequest) : TWebClientResponse;
     // Create a new request. The caller is responsible for freeing the request.
-    Function CreateRequest : TWebClientRequest;
+    Function CreateRequest(aForAsync : Boolean = False; const aRequestID : String = '') : TWebClientRequest;
     // These can be set to sign/examine the request/response.
     Property RequestSigner : TAbstractRequestSigner Read FSigner Write FSigner;
     Property ResponseExaminer : TAbstractResponseExaminer Read FExaminer Write FExaminer;
@@ -186,6 +210,13 @@ begin
   DoExamineResponse(AResponse);
 end;
 
+{ TWebClientResponseResult }
+
+function TWebClientResponseResult.Success: Boolean;
+begin
+  Result:=(Error=Nil)
+end;
+
 { TWebClientRequest }
 
 function TWebClientRequest.GetExtraParams: TStrings;
@@ -195,7 +226,6 @@ begin
   Result:=FExtraParams;
 end;
 
-
 destructor TWebClientRequest.Destroy;
 begin
   FreeAndNil(FExtraParams);
@@ -233,10 +263,20 @@ begin
 end;
 
 constructor TWebClientResponse.Create(ARequest: TWebClientRequest);
+
 begin
+  Inherited Create(aRequest.IsAsync,aRequest.RequestID);
+  FRequest:=aRequest;
   FStream:=ARequest.ResponseContent;
 end;
 
+destructor TWebClientResponse.Destroy;
+begin
+  if IsAsync then
+    FreeAndNil(FRequest);
+  inherited Destroy;
+end;
+
 { TAbstractWebClient }
 
 procedure TAbstractWebClient.SetSSLVersion(AValue : TSSLVersion);
@@ -324,6 +364,15 @@ begin
   StringToStream('');
 end;
 
+function TAbstractWebClient.GetNextRequestID : String;
+
+var
+  lNextID : Integer;
+
+begin
+  LNextID:=InterlockedIncrement(FRequestID);
+end;
+ 
 procedure TAbstractWebClient.GetVersionLimits(out PMin, PMax: TSSLVersion);
 
 begin
@@ -383,6 +432,34 @@ begin
     StringToStream('Request generated no response');
 end;
 
+function TAbstractWebClient.ExecuteRequest(const AMethod, AURL: String; ARequest: TWebClientRequest;
+  aCallback: TAsyncResponseCallback): String;
+
+var
+  lResponse : TWebClientResponse;
+  lResult : TWebClientResponseResult;
+
+begin
+  lResponse:=nil;
+  try
+    lResult:=Default(TWebClientResponseResult);
+    Result:=aRequest.RequestID;
+    try
+      lResponse:=ExecuteRequest(aMethod,aURL,aRequest);
+      lResult.Response:=lResponse;
+      aCallBack(lResult);
+    except
+      on E : Exception do
+        begin
+        lResult.Error:=E;
+        aCallback(lResult);
+        end;
+    end;
+  finally
+    lResponse.Free;
+  end;
+end;
+
 function TAbstractWebClient.ExecuteSignedRequest(const AMethod, AURL: String;
   ARequest: TWebClientRequest): TWebClientResponse;
 begin
@@ -391,9 +468,18 @@ begin
   Result:=ExecuteRequest(AMethod,AURl,ARequest);
 end;
 
-function TAbstractWebClient.CreateRequest: TWebClientRequest;
+function TAbstractWebClient.CreateRequest(aForAsync: Boolean; const aRequestID: String): TWebClientRequest;
+
+var
+  lID : String;
+
 begin
-  Result:=DoCreateRequest;
+  lID:=aRequestID;
+  if lID='' then
+    lID:=GetNextRequestID;
+  Result:=DoCreateRequest(aForAsync,lID);
+  if (Result.FRequestID='') then
+    Result.FRequestID:=lID;
 end;
 
 { TRequestResponse }
@@ -418,6 +504,14 @@ begin
   Result:=FStream;
 end;
 
+constructor TRequestResponse.Create(aAsync: Boolean; const aRequestID : String);
+
+begin
+  FRequestID:=aRequestID;
+  FIsAsync:=aAsync;
+end;
+
+
 Destructor TRequestResponse.Destroy;
 begin
   FreeAndNil(FHeaders);