Merge pull request #14 from timhall/content-length

Content length

.gitattributes

@@ -0,0 +1,22 @@
+# Auto detect text files and perform LF normalization
+* text=auto
+
+# Custom for Visual Studio
+*.cs     diff=csharp
+*.sln    merge=union
+*.csproj merge=union
+*.vbproj merge=union
+*.fsproj merge=union
+*.dbproj merge=union
+
+# Standard to msysgit
+*.doc	 diff=astextplain
+*.DOC	 diff=astextplain
+*.docx diff=astextplain
+*.DOCX diff=astextplain
+*.dot  diff=astextplain
+*.DOT  diff=astextplain
+*.pdf  diff=astextplain
+*.PDF	 diff=astextplain
+*.rtf	 diff=astextplain
+*.RTF	 diff=astextplain

specs/RestClientAsyncSpecs.bas

@@ -86,7 +86,7 @@ Public Function Specs() As SpecSuite
         .Expect(AsyncResponse.StatusDescription).ToEqual "Internal Server Error"
     End With
 
-    With Specs.It("should return 504 and close request on request timeout")
+    With Specs.It("should return 408 and close request on request timeout")
         Set Request = New RestRequest
         Request.Resource = "timeout"
         Request.AddQuerystringParam "ms", 2000
@@ -96,8 +96,8 @@ Public Function Specs() As SpecSuite
         Wait WaitTime
         .Expect(AsyncResponse).ToBeDefined
         If Not AsyncResponse Is Nothing Then
-            .Expect(AsyncResponse.StatusCode).ToEqual 504
-            .Expect(AsyncResponse.StatusDescription).ToEqual "Gateway Timeout"
+            .Expect(AsyncResponse.StatusCode).ToEqual 408
+            .Expect(AsyncResponse.StatusDescription).ToEqual "Request Timeout"
         End If
         .Expect(Request.HttpRequest).ToBeUndefined
     End With

specs/RestClientSpecs.bas

@@ -17,6 +17,7 @@ Public Function Specs() As SpecSuite
     Dim Client As New RestClient
     Dim Request As RestRequest
     Dim Response As RestResponse
+    Dim Body As Object
 
     Client.BaseUrl = "localhost:3000/"
 
@@ -90,7 +91,6 @@ Public Function Specs() As SpecSuite
 
         .Expect(Client.Execute(Request).Data("body")).ToEqual "Howdy!"
 
-        Dim Body As Object
         Set Body = CreateObject("Scripting.Dictionary")
         Body.Add "a", 3.14
 
@@ -116,17 +116,47 @@ Public Function Specs() As SpecSuite
         .Expect(Response.Data("query")("d")).ToEqual "False"
     End With
 
-    With Specs.It("should return 504 on request timeout")
+    With Specs.It("should return 408 on request timeout")
         Set Request = New RestRequest
         Request.Resource = "timeout"
         Request.AddQuerystringParam "ms", 2000
 
         Client.TimeoutMS = 500
         Set Response = Client.Execute(Request)
-        .Expect(Response.StatusCode).ToEqual 504
-        .Expect(Response.StatusDescription).ToEqual "Gateway Timeout"
+        .Expect(Response.StatusCode).ToEqual 408
+        .Expect(Response.StatusDescription).ToEqual "Request Timeout"
         Debug.Print Response.Content
     End With
+
+    With Specs.It("should add content-length header (if enabled)")
+        Set Request = New RestRequest
+        Request.Resource = "text"
+        Request.Method = httpPOST
+        Request.ContentType = "text/plain"
+        Request.AddBodyString "Howdy!"
+
+        Set Response = Client.Execute(Request)
+        .Expect(Request.Headers("Content-Length")).ToEqual "6"
+
+        Request.IncludeContentLength = False
+        Set Response = Client.Execute(Request)
+        .Expect(Request.Headers.Exists("Content-Length")).ToEqual False
+
+        Set Request = New RestRequest
+        Request.Resource = "post"
+        Request.Method = httpPOST
+
+        Set Body = CreateObject("Scripting.Dictionary")
+        Body.Add "a", 3.14
+        Request.AddBody Body
+
+        Set Response = Client.Execute(Request)
+        .Expect(Request.Headers("Content-Length")).ToEqual "10"
+
+        Request.IncludeContentLength = False
+        Set Response = Client.Execute(Request)
+        .Expect(Request.Headers.Exists("Content-Length")).ToEqual False
+    End With
 
     Set Client = Nothing
 

specs/RestRequestSpecs.bas

@@ -13,6 +13,7 @@ Attribute VB_Name = "RestRequestSpecs"
 Public Function Specs() As SpecSuite
     Set Specs = New SpecSuite
     Dim Request As RestRequest
+    Dim Body As Object
 
     Specs.Description = "RestRequest"
 
@@ -132,8 +133,7 @@ Public Function Specs() As SpecSuite
 
     With Specs.It("should only combine body and parameters if not GET Request")
         Set Request = New RestRequest
-
-        Dim Body As Object
+
         Set Body = CreateObject("Scripting.Dictionary")
         Body.Add "A", 123
 
@@ -243,5 +243,23 @@ Public Function Specs() As SpecSuite
         .Expect(Request.FormattedResource).ToEqual "?A=20&B=3.14&C=True"
     End With
 
+    With Specs.It("should allow body or body string for GET requests")
+        Set Request = New RestRequest
+        Request.Method = httpGET
+
+        Set Body = CreateObject("Scripting.Dictionary")
+        Body.Add "A", 123
+
+        Request.AddBody Body
+        .Expect(Request.Body).ToEqual "{""A"":123}"
+
+        Set Request = New RestRequest
+        Request.Method = httpGET
+
+        Request.AddBodyString "Howdy!"
+        .Expect(Request.Body).ToEqual "Howdy!"
+    End With
+
     InlineRunner.RunSuite Specs
 End Function
+

src/RestClient.cls

@@ -19,7 +19,6 @@ Attribute VB_Exposed = True
 ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ '
 Option Explicit
 
-Private Const UserAgent As String = "Excel Client v2.0.1 (https://github.com/timhall/Excel-REST)"
 Private Const DefaultTimeoutMS As Integer = 5000
 
 
@@ -48,7 +47,7 @@ Public Function Execute(Request As RestRequest) As RestResponse
     Dim HeaderKey As Variant
 
     On Error GoTo ErrorHandling
-    Set Http = CreateObject("MSXML2.ServerXMLHTTP")
+    Set Http = CreateObject("MSXML2.ServerXMLHTTP.6.0")
     HttpSetup Http, Request, False
 
     ' Send the request
@@ -63,8 +62,8 @@ ErrorHandling:
 
     If Err.Number <> 0 Then
         If InStr(Err.Description, "The operation timed out") > 0 Then
-            ' Return 504
-            Set Response = Request.CreateResponse(StatusCodes.GatewayTimeout, "Gateway Timeout")
+            ' Return 408
+            Set Response = Request.CreateResponse(StatusCodes.RequestTimeout, "Request Timeout")
             Err.Clear
         Else
             ' Rethrow error
@@ -92,7 +91,7 @@ Public Function ExecuteAsync(Request As RestRequest, Callback As String, Optiona
     On Error GoTo ErrorHandling
 
     ' Setup the request
-    Set Http = CreateObject("MSXML2.ServerXMLHTTP")
+    Set Http = CreateObject("MSXML2.ServerXMLHTTP.6.0")
     HttpSetup Http, Request, True
     Request.Callback = Callback
     Request.CallbackArgs = CallbackArgs
@@ -122,18 +121,7 @@ End Function
 ' ============================================= '
 
 Private Sub HttpSetup(ByRef Http As Object, ByRef Request As RestRequest, Optional UseAsync As Boolean = False)
-    ' Set timeouts
-    Http.setTimeouts Me.TimeoutMS, Me.TimeoutMS, Me.TimeoutMS, Me.TimeoutMS
-
-    ' Add general headers to request
-    Request.AddHeader "User-Agent", UserAgent
-    Request.AddHeader "Content-Type", Request.ContentType()
-
-    ' Pass http to request and setup onreadystatechange
-    If UseAsync Then
-        Set Request.HttpRequest = Http
-        Http.onreadystatechange = Request
-    End If
+    RestHelpers.PrepareHttpRequest Http, Request, Me.TimeoutMS, UseAsync
 
     ' Before execute and http open hooks for authenticator
     If Not Me.Authenticator Is Nothing Then
@@ -144,11 +132,7 @@ Private Sub HttpSetup(ByRef Http As Object, ByRef Request As RestRequest, Option
         Http.Open Request.MethodName(), Request.FullUrl(Me.BaseUrl), UseAsync
     End If
 
-    ' Set request headers
-    Dim HeaderKey As Variant
-    For Each HeaderKey In Request.Headers.keys()
-        Http.setRequestHeader HeaderKey, Request.Headers(HeaderKey)
-    Next HeaderKey
+    RestHelpers.SetHeaders Http, Request
 End Sub
 
 Private Sub Class_Initialize()

src/RestClientBase.bas

@@ -15,7 +15,6 @@ Attribute VB_Name = "RestClientBase"
 ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ '
 Option Explicit
 
-Private Const UserAgent As String = "Excel Client v2.0.1 (https://github.com/timhall/Excel-REST)"
 Private Const TimeoutMS As Integer = 5000
 Private Initialized As Boolean
 
@@ -69,7 +68,7 @@ Public Function Execute(Request As RestRequest) As RestResponse
     Dim HeaderKey As Variant
 
     On Error GoTo ErrorHandling
-    Set Http = CreateObject("MSXML2.ServerXMLHTTP")
+    Set Http = CreateObject("MSXML2.ServerXMLHTTP.6.0")
     HttpSetup Http, Request, False
 
     ' Send the request
@@ -84,8 +83,8 @@ ErrorHandling:
 
     If Err.Number <> 0 Then
         If InStr(Err.Description, "The operation timed out") > 0 Then
-            ' Return 504
-            Set Response = Request.CreateResponse(StatusCodes.GatewayTimeout, "Gateway Timeout")
+            ' Return 408
+            Set Response = Request.CreateResponse(StatusCodes.RequestTimeout, "Request Timeout")
             Err.Clear
         Else
             ' Rethrow error
@@ -112,7 +111,7 @@ Public Function ExecuteAsync(Request As RestRequest, Callback As String, Optiona
     On Error GoTo ErrorHandling
 
     ' Setup the request
-    Set Http = CreateObject("MSXML2.ServerXMLHTTP")
+    Set Http = CreateObject("MSXML2.ServerXMLHTTP.6.0")
     HttpSetup Http, Request, True
     Request.Callback = Callback
     Request.CallbackArgs = CallbackArgs
@@ -138,28 +137,13 @@ End Function
 
 Private Sub HttpSetup(ByRef Http As Object, ByRef Request As RestRequest, Optional UseAsync As Boolean = False)
     If Not Initialized Then: Initialize
-
-    ' Set timeouts
-    Http.setTimeouts TimeoutMS, TimeoutMS, TimeoutMS, TimeoutMS
-
-    ' Add general headers to request
-    Request.AddHeader "User-Agent", UserAgent
-    Request.AddHeader "Content-Type", Request.ContentType()
 
-    ' Pass http to request and setup onreadystatechange
-    If UseAsync Then
-        Set Request.HttpRequest = Http
-        Http.onreadystatechange = Request
-    End If
+    RestHelpers.PrepareHttpRequest Http, Request, TimeoutMS, UseAsync
 
-    ' Before execute and http open hooks for authenticator
+    ' Before execute and http open hooks for authentication
     BeforeExecute Request
     HttpOpen Http, Request, BaseUrl, UseAsync
 
-    ' Set request headers
-    Dim HeaderKey As Variant
-    For Each HeaderKey In Request.Headers.keys()
-        Http.setRequestHeader HeaderKey, Request.Headers(HeaderKey)
-    Next HeaderKey
+    RestHelpers.SetHeaders Http, Request
 End Sub
 

src/RestHelpers.bas

@@ -39,6 +39,8 @@ Attribute VB_Name = "RestHelpers"
 
 #End If
 
+Private Const UserAgent As String = "Excel Client v2.0.1 (https://github.com/timhall/Excel-REST)"
+
 ' Moved to top from JSONLib
 Private Const INVALID_JSON      As Long = 1
 Private Const INVALID_OBJECT    As Long = 2
@@ -56,6 +58,7 @@ Public Enum StatusCodes
     Unauthorized = 401
     Forbidden = 403
     NotFound = 404
+    RequestTimeout = 408
     UnsupportedMediaType = 415
     InternalServerError = 500
     BadGateway = 502
@@ -226,6 +229,51 @@ Public Function FilterObject(ByVal Original As Object, Whitelist As Variant) As
     Set FilterObject = Filtered
 End Function
 
+''
+' Prepare http request for execution
+'
+' @param {Object} Http request
+' @param {RestRequest} Request
+' @param {Integer} TimeoutMS
+' @param {Boolean} [UseAsync=False]
+' --------------------------------------------- '
+
+Public Sub PrepareHttpRequest(ByRef Http As Object, Request As RestRequest, TimeoutMS As Integer, Optional UseAsync As Boolean = False)
+    ' Set timeouts
+    Http.setTimeouts TimeoutMS, TimeoutMS, TimeoutMS, TimeoutMS
+
+    ' Add general headers to request
+    Request.AddHeader "User-Agent", UserAgent
+    Request.AddHeader "Content-Type", Request.ContentType
+
+    If Request.IncludeContentLength Then
+        Request.AddHeader "Content-Length", Request.ContentLength
+    Else
+        If Request.Headers.Exists("Content-Length") Then
+            Request.Headers.Remove "Content-Length"
+        End If
+    End If
+
+    ' Pass http to request and setup onreadystatechange
+    If UseAsync Then
+        Set Request.HttpRequest = Http
+        Http.onreadystatechange = Request
+    End If
+End Sub
+
+''
+' Set headers to http object for given request
+'
+' @param {Object} Http request
+' @param {RestRequest} Request
+' --------------------------------------------- '
+
+Public Sub SetHeaders(ByRef Http As Object, Request As RestRequest)
+    Dim HeaderKey As Variant
+    For Each HeaderKey In Request.Headers.keys()
+        Http.setRequestHeader HeaderKey, Request.Headers(HeaderKey)
+    Next HeaderKey
+End Sub
 
 
 ' ======================================================================================== '