Added timeout support

bumped dspec version

Author: vincentparrett

.gitignore

@@ -37,3 +37,4 @@ __history
 /Tests/Win64
 /Tests/OSX32
 /Tests/__history
+*.delphilsp.json

Source/VSoft.HttpClient.WinHttpClient.pas

@@ -42,6 +42,7 @@   THttpClient = class(THttpClientBase, IHttpClient, IHttpClientInternal)
     FData : Pointer;
     FDataLength : DWORD;
 
+
   protected
     procedure OnHTTPCallback(hInternet: HINTERNET; dwInternetStatus: DWORD; lpvStatusInformation: Pointer; dwStatusInformationLength: DWORD);
     function OnHeadersAvailable(hRequest: HINTERNET; dwInternetStatus: DWORD; lpvStatusInformation: Pointer; dwStatusInformationLength: DWORD) : DWORD;
@@ -78,6 +79,16 @@   THttpClient = class(THttpClientBase, IHttpClient, IHttpClientInternal)
     function GetUseHttp2 : boolean;
     procedure SetUseHttp2(const value : boolean);
 
+    function GetConnectionTimeout : integer;
+    procedure SetConnectionTimeout(const value : integer);
+
+    function GetSendTimeout : integer;
+    procedure SetSendTimeout(const value : integer);
+
+    function GetResponseTimeout : integer;
+    procedure SetResponseTimeout(const value : integer);
+
+
 
     function CreateRequest(const resource : string) : TRequest;overload;
     function CreateRequest(const uri : IUri) : TRequest;overload;
@@ -248,6 +259,11 @@ function THttpClient.GetBaseUri: string;
 end;
 
 
+function THttpClient.GetConnectionTimeout: integer;
+begin
+  result := FConnectionTimeout;
+end;
+
 function THttpClient.GetPassword: string;
 begin
   result := FPassword;
@@ -282,6 +298,16 @@ function THttpClient.GetResourceFromRequest(const request: TRequest): string;
   end;
 end;
 
+function THttpClient.GetResponseTimeout: integer;
+begin
+  result := FResponseTimeout;
+end;
+
+function THttpClient.GetSendTimeout: integer;
+begin
+  result := FSendTimeout;
+end;
+
 function THttpClient.GetUri: IUri;
 begin
   result := FUri;
@@ -694,6 +720,13 @@ function THttpClient.Send(const request: TRequest; const cancellationToken: ICan
       FClientError := GetLastError;
       raise EHttpClientException.Create(ClientErrorToString(FClientError), FClientError);
     end;
+
+    if WinHttpSetTimeouts(hRequest, request.ConnectionTimeout, request.ConnectionTimeout, request.SendTimeout, request.ResponseTimeout) = False then
+      raise EHttpClientException.Create(SysErrorMessage(GetLastError), GetLastError);
+
+
+    //set timeouts on the request.
+
     try
       pCallback := WinHttpSetStatusCallback(hRequest, _HTTPCallback, WINHTTP_CALLBACK_FLAG_ALL_COMPLETIONS + WINHTTP_CALLBACK_FLAG_REDIRECT, 0);
 
@@ -799,11 +832,26 @@ procedure THttpClient.SetBaseUri(const value: string);
   FUri.BaseUriString := value;
 end;
 
+procedure THttpClient.SetConnectionTimeout(const value: integer);
+begin
+  FConnectionTimeout := value;
+end;
+
 procedure THttpClient.SetPassword(const value: string);
 begin
   FPassword := value;
 end;
 
+procedure THttpClient.SetResponseTimeout(const value: integer);
+begin
+  FResponseTimeout := value;
+end;
+
+procedure THttpClient.SetSendTimeout(const value: integer);
+begin
+  FSendTimeout := value;
+end;
+
 procedure THttpClient.SetUseHttp2(const value: boolean);
 begin
   FUseHttp2 := value;

Source/VSoft.HttpClient.pas

@@ -73,8 +73,15 @@   TRequest = class;
   end;
 
   THttpClientBase = class(TInterfacedObject)
+  protected
+    FConnectionTimeout: Integer;
+    FSendTimeout: Integer;
+    FResponseTimeout: Integer;
   public
     procedure ReleaseRequest(const request : TRequest);virtual;abstract;
+    property ConnectionTimeout: Integer read FConnectionTimeout write FConnectionTimeout;
+    property SendTimeout: Integer read FSendTimeout write FSendTimeout;
+    property ResponseTimeout: Integer read FResponseTimeout write FResponseTimeout;
   end;
 
 
@@ -97,6 +104,10 @@   TRequest = class
     FProxyUserName : string;
     FProxyPassword : string;
 
+    FConnectionTimeout: Integer;
+    FSendTimeout: Integer;
+    FResponseTimeout: Integer;
+
     FURI : IUri;
   protected
     function GetHeaders : TStrings;
@@ -203,6 +214,11 @@   TRequest = class
     property Passsword : string read FPassword write FPassword;
     property ProxyUserName : string read FProxyUserName write FProxyUserName;
     property ProxyPassword : string read FProxyPassword write FProxyPassword;
+
+    property ConnectionTimeout: Integer read FConnectionTimeout write FConnectionTimeout;
+    property SendTimeout: Integer read FSendTimeout write FSendTimeout;
+    property ResponseTimeout: Integer read FResponseTimeout write FResponseTimeout;
+
   end;
 
 
@@ -233,6 +249,15 @@   TRequest = class
     function GetPassword : string;
     procedure SetPassword(const value : string);
 
+    function GetConnectionTimeout : integer;
+    procedure SetConnectionTimeout(const value : integer);
+
+    function GetSendTimeout : integer;
+    procedure SetSendTimeout(const value : integer);
+
+    function GetResponseTimeout : integer;
+    procedure SetResponseTimeout(const value : integer);
+
     function CreateRequest(const resource : string) : TRequest;overload;
     function CreateRequest(const uri : IUri) : TRequest;overload;
 
@@ -246,13 +271,31 @@   TRequest = class
     property UserName   : string read GetUserName write SetUserName;
     property Password   : string read GetPassword write SetPassword;
 
+    property ConnectionTimeout: Integer read GetConnectionTimeout write SetConnectionTimeout;
+    property SendTimeout: Integer read GetSendTimeout write SetSendTimeout;
+    property ResponseTimeout: Integer read GetResponseTimeout write SetResponseTimeout;
+
+
     property UseHttp2   : boolean read GetUseHttp2 write SetUseHttp2;
+
+
   end;
 
   THttpClientFactory = class
-   class function CreateClient(const uri: string): IHttpClient;overload;
-   class function CreateClient(const uri: IUri): IHttpClient;overload;
+  private
+   class
+    var
+      FDefaultConnectionTimeout: Integer;
+      FDefaultSendTimeout: Integer;
+      FDefaultResponseTimeout: Integer;
+    class constructor Create;
+  public
+    class function CreateClient(const uri: string): IHttpClient;overload;
+    class function CreateClient(const uri: IUri): IHttpClient;overload;
 
+    class property DefaultConnectionTimeout: Integer read FDefaultConnectionTimeout write FDefaultConnectionTimeout;
+    class property DefaultSendTimeout: Integer read FDefaultSendTimeout write FDefaultSendTimeout;
+    class property DefaultResponseTimeout: Integer read FDefaultResponseTimeout write FDefaultResponseTimeout;
   end;
 
   EHttpClientException = class(Exception)
@@ -402,6 +445,9 @@ constructor TRequest.Create(const client: THttpClientBase; const uri: IUri);
     for queryParam in uri.QueryParams do
       WithParameter(queryParam.Name, queryParam.Value);
   end;
+  FConnectionTimeout := client.ConnectionTimeout;
+  FSendTimeout := client.SendTimeout;
+  FResponseTimeout := client.ResponseTimeout;
 end;
 
 function CombineUriParts(const a, b : string) : string;
@@ -596,6 +642,7 @@ function TRequest.GetCharSet: string;
     result := '';
 end;
 
+
 function TRequest.GetContentLength: Int64;
 var
   stream : TStream;
@@ -627,6 +674,7 @@ function TRequest.GetResource: string;
   result := FURI.AbsolutePath;
 end;
 
+
 function TRequest.GetUrlSegments: TStrings;
 begin
   result := FUrlSegments;
@@ -776,6 +824,7 @@ procedure TRequest.SetAcceptLanguage(const value: string);
   FHeaders.Values[cAcceptLanguageHeader] := value;
 end;
 
+
 procedure TRequest.SetContentType(const value: string);
 begin
   FHeaders.Values[cContentTypeHeader] := value;
@@ -787,6 +836,7 @@ procedure TRequest.SetResource(const value: string);
 end;
 
 
+
 function TRequest.WillFollowRedirects: TRequest;
 begin
   FFollowRedirects := true;
@@ -907,13 +957,23 @@ class function THttpClientFactory.CreateClient(const uri : string): IHttpClient;
 begin
   if not TUriFactory.TryParseWithError(uri, true, theUri, error)  then
     raise EArgumentOutOfRangeException.Create('Invalid Uri : ' + error );
+  result := THttpClientFactory.CreateClient(theUri);
+end;
 
-  result := THttpClient.Create(theUri);
+class constructor THttpClientFactory.Create;
+begin
+  //1min defaults
+  FDefaultConnectionTimeout := 60000;
+  FDefaultSendTimeout := 60000;
+  FDefaultResponseTimeout := 60000;
 end;
 
 class function THttpClientFactory.CreateClient(const uri: IUri): IHttpClient;
 begin
   result := THttpClient.Create(uri);
+  result.ConnectionTimeout := FDefaultConnectionTimeout;
+  result.SendTimeout := FDefaultSendTimeout;
+  result.ResponseTimeout := FDefaultResponseTimeout;
 end;
 
 { EHttpClientException }