diff --git a/specs/Excel-REST - Specs.xlsm b/specs/Excel-REST - Specs.xlsm index 9bfa0ce4..630a235c 100644 Binary files a/specs/Excel-REST - Specs.xlsm and b/specs/Excel-REST - Specs.xlsm differ diff --git a/specs/RestClientSpecs.bas b/specs/RestClientSpecs.bas index fade8659..2e09c5e8 100644 --- a/specs/RestClientSpecs.bas +++ b/specs/RestClientSpecs.bas @@ -20,6 +20,7 @@ Public Function Specs() As SpecSuite Dim Body As Dictionary Dim BodyToString As String Dim i As Integer + Dim Options As Dictionary Client.BaseUrl = "localhost:3000/" @@ -118,6 +119,31 @@ Public Function Specs() As SpecSuite .Expect(Response.Data("query")("d")).ToEqual "False" End With + With Specs.It("should GET json") + Set Response = Client.GetJSON("/get") + + .Expect(Response.StatusCode).ToEqual 200 + .Expect(Response.Data).ToBeDefined + End With + + With Specs.It("should POST json") + Set Body = New Dictionary + Body.Add "a", 3.14 + Set Response = Client.PostJSON("/post", Body) + + .Expect(Response.StatusCode).ToEqual 200 + .Expect(Response.Data("body")("a")).ToEqual 3.14 + End With + + With Specs.It("should include options with GET and POST json") + Set Options = New Dictionary + Options.Add "Headers", New Dictionary + Options("Headers").Add "custom", "value" + Set Response = Client.GetJSON("/get", Options) + + .Expect(Response.Data("headers")("custom")).ToEqual "value" + End With + With Specs.It("should return 408 on request timeout") Set Request = New RestRequest Request.Resource = "timeout" diff --git a/specs/RestHelpersSpecs.bas b/specs/RestHelpersSpecs.bas index 208be111..2ccd51d0 100644 --- a/specs/RestHelpersSpecs.bas +++ b/specs/RestHelpersSpecs.bas @@ -27,6 +27,8 @@ Public Function Specs() As SpecSuite Dim ResponseHeaders As String Dim Headers As Collection Dim Cookies As Dictionary + Dim Options As Dictionary + Dim Request As RestRequest With Specs.It("should parse json") json = "{""a"":1,""b"":3.14,""c"":""Howdy!"",""d"":true,""e"":[1,2]}" @@ -125,6 +127,11 @@ Public Function Specs() As SpecSuite .Expect(RestHelpers.JoinUrl("a/", "/b")).ToEqual "a/b" End With + With Specs.It("should not join blank urls with /") + .Expect(RestHelpers.JoinUrl("", "b")).ToEqual "b" + .Expect(RestHelpers.JoinUrl("a", "")).ToEqual "a" + End With + With Specs.It("should combine objects, with overwrite option") Set A = New Dictionary Set B = New Dictionary @@ -183,6 +190,24 @@ Public Function Specs() As SpecSuite .Expect(Parsed("d & e")).ToEqual "A + B" End With + With Specs.It("should identify valid protocols") + .Expect(RestHelpers.IncludesProtocol("http://testing.com")).ToEqual "http://" + .Expect(RestHelpers.IncludesProtocol("https://testing.com")).ToEqual "https://" + .Expect(RestHelpers.IncludesProtocol("ftp://testing.com")).ToEqual "ftp://" + .Expect(RestHelpers.IncludesProtocol("htp://testing.com")).ToEqual "" + .Expect(RestHelpers.IncludesProtocol("testing.com/http://")).ToEqual "" + .Expect(RestHelpers.IncludesProtocol("http://https://testing.com")).ToEqual "http://" + End With + + With Specs.It("should remove valid protocols") + .Expect(RestHelpers.RemoveProtocol("http://testing.com")).ToEqual "testing.com" + .Expect(RestHelpers.RemoveProtocol("https://testing.com")).ToEqual "testing.com" + .Expect(RestHelpers.RemoveProtocol("ftp://testing.com")).ToEqual "testing.com" + .Expect(RestHelpers.RemoveProtocol("htp://testing.com")).ToEqual "htp://testing.com" + .Expect(RestHelpers.RemoveProtocol("testing.com/http://")).ToEqual "testing.com/http://" + .Expect(RestHelpers.RemoveProtocol("http://https://testing.com")).ToEqual "https://testing.com" + End With + With Specs.It("should extract headers from response headers") ResponseHeaders = "Connection: keep -alive" & vbCrLf & _ "Date: Tue, 18 Feb 2014 15:00:26 GMT" & vbCrLf & _ @@ -208,6 +233,35 @@ Public Function Specs() As SpecSuite .Expect(Cookies("duplicate-cookie")).ToEqual "B" End With + With Specs.It("should create request from options") + Set Request = RestHelpers.CreateRequestFromOptions(Nothing) + .Expect(Request.Headers.count).ToEqual 0 + + Set Options = New Dictionary + Set Request = RestHelpers.CreateRequestFromOptions(Options) + .Expect(Request.Headers.count).ToEqual 0 + + Options.Add "Headers", New Dictionary + Options("Headers").Add "HeaderKey", "HeaderValue" + Set Request = RestHelpers.CreateRequestFromOptions(Options) + .Expect(Request.Headers("HeaderKey")).ToEqual "HeaderValue" + + Options.Add "Cookies", New Dictionary + Options("Cookies").Add "CookieKey", "CookieValue" + Set Request = RestHelpers.CreateRequestFromOptions(Options) + .Expect(Request.Cookies("CookieKey")).ToEqual "CookieValue" + + Options.Add "QuerystringParams", New Dictionary + Options("QuerystringParams").Add "QuerystringKey", "QuerystringValue" + Set Request = RestHelpers.CreateRequestFromOptions(Options) + .Expect(Request.QuerystringParams("QuerystringKey")).ToEqual "QuerystringValue" + + Options.Add "UrlSegments", New Dictionary + Options("UrlSegments").Add "SegmentKey", "SegmentValue" + Set Request = RestHelpers.CreateRequestFromOptions(Options) + .Expect(Request.UrlSegments("SegmentKey")).ToEqual "SegmentValue" + End With + With Specs.It("should encode string to base64") .Expect(RestHelpers.EncodeStringToBase64("Howdy!")).ToEqual "SG93ZHkh" End With diff --git a/specs/RestRequestSpecs.bas b/specs/RestRequestSpecs.bas index fa460306..bdbadf5c 100644 --- a/specs/RestRequestSpecs.bas +++ b/specs/RestRequestSpecs.bas @@ -89,6 +89,17 @@ Public Function Specs() As SpecSuite .Expect(Request.FormattedResource).ToEqual "?A=123&B=456" End With + + With Specs.It("should not include http/https if included in resource") + Set Request = New RestRequest + Request.IncludeCacheBreaker = False + + Request.Resource = "http://localhost:3000/get" + .Expect(Request.FullUrl("")).ToEqual "http://localhost:3000/get" + + Request.Resource = "https://localhost:3000/get" + .Expect(Request.FullUrl("")).ToEqual "https://localhost:3000/get" + End With With Specs.It("should URL encode querystring") Set Request = New RestRequest diff --git a/src/RestClient.cls b/src/RestClient.cls index aa6380ad..e993903a 100644 --- a/src/RestClient.cls +++ b/src/RestClient.cls @@ -87,6 +87,27 @@ ErrorHandling: Err.Raise Err.Number, Description:=Err.Description End Function +Public Function GetJSON(Url As String, Optional Options As Dictionary) As RestResponse + Dim Request As RestRequest + Set Request = RestHelpers.CreateRequestFromOptions(Options) + Request.Resource = Url + Request.Format = json + Request.Method = httpGET + + Set GetJSON = Me.Execute(Request) +End Function + +Public Function PostJSON(Url As String, Body As Dictionary, Optional Options As Dictionary) As RestResponse + Dim Request As RestRequest + Set Request = RestHelpers.CreateRequestFromOptions(Options) + Request.Resource = Url + Request.Format = json + Request.Method = httpPOST + Request.AddBody Body + + Set PostJSON = Me.Execute(Request) +End Function + '' ' Set proxy for all requests ' diff --git a/src/RestHelpers.bas b/src/RestHelpers.bas index cd244ad5..9ec5443c 100644 --- a/src/RestHelpers.bas +++ b/src/RestHelpers.bas @@ -65,6 +65,9 @@ Public Enum StatusCodes GatewayTimeout = 504 End Enum +Public Property Get ValidProtocols() As Variant + ValidProtocols = Array("http", "https", "ftp") +End Property ' ============================================= ' ' Shared Helpers @@ -194,7 +197,11 @@ Public Function JoinUrl(LeftSide As String, RightSide As String) As String LeftSide = Left(LeftSide, Len(LeftSide) - 1) End If - JoinUrl = LeftSide & "/" & RightSide + If LeftSide <> "" And RightSide <> "" Then + JoinUrl = LeftSide & "/" & RightSide + Else + JoinUrl = LeftSide & RightSide + End If End Function '' @@ -322,6 +329,49 @@ Public Function ParseUrlEncoded(Encoded As String) As Dictionary Set ParseUrlEncoded = Parsed End Function +'' +' Check if protocol is included with url +' +' @param {String} Url +' @return {String} Found protocol +' --------------------------------------------- ' + +Public Function IncludesProtocol(Url As String) As String + Dim Protocol As String + Dim i As Integer + + For i = LBound(ValidProtocols) To UBound(ValidProtocols) + Protocol = ValidProtocols(i) + "://" + If Left(Url, Len(Protocol)) = Protocol Then + IncludesProtocol = Protocol + Exit Function + End If + Next i +End Function + +'' +' Remove protocol from url (if present) +' +' @param {String} Url +' @return {String} Url without protocol +' --------------------------------------------- ' + +Public Function RemoveProtocol(Url As String) As String + Dim Protocol As String + + RemoveProtocol = Url + Protocol = IncludesProtocol(RemoveProtocol) + If Protocol <> "" Then + RemoveProtocol = Replace(RemoveProtocol, Protocol, "") + End If +End Function + +' ======================================================================================== ' +' +' Request Preparation / Handling +' +' ======================================================================================== ' + '' ' Prepare http request for execution ' @@ -567,6 +617,37 @@ Public Function ExtractHeadersFromResponseHeaders(ResponseHeaders As String) As Set ExtractHeadersFromResponseHeaders = Headers End Function +'' +' Create request from options +' +' @param {Dictionary} Options +' - Headers +' - Cookies +' - QuerystringParams +' - UrlSegments +' --------------------------------------------- ' + +Public Function CreateRequestFromOptions(Options As Dictionary) As RestRequest + Dim Request As New RestRequest + + If Not IsEmpty(Options) And Not Options Is Nothing Then + If Options.Exists("Headers") Then + Set Request.Headers = Options("Headers") + End If + If Options.Exists("Cookies") Then + Set Request.Cookies = Options("Cookies") + End If + If Options.Exists("QuerystringParams") Then + Set Request.QuerystringParams = Options("QuerystringParams") + End If + If Options.Exists("UrlSegments") Then + Set Request.UrlSegments = Options("UrlSegments") + End If + End If + + Set CreateRequestFromOptions = Request +End Function + ' ======================================================================================== ' ' ' Timeout Timing diff --git a/src/RestRequest.cls b/src/RestRequest.cls index d90deeaa..0ef70e90 100644 --- a/src/RestRequest.cls +++ b/src/RestRequest.cls @@ -71,7 +71,7 @@ Public Property Get Headers() As Dictionary If pHeaders Is Nothing Then: Set pHeaders = New Dictionary Set Headers = pHeaders End Property -Public Property Let Headers(Value As Dictionary) +Public Property Set Headers(Value As Dictionary) Set pHeaders = Value End Property @@ -79,7 +79,7 @@ Public Property Get Parameters() As Dictionary If pParameters Is Nothing Then: Set pParameters = New Dictionary Set Parameters = pParameters End Property -Public Property Let Parameters(Value As Dictionary) +Public Property Set Parameters(Value As Dictionary) Set pParameters = Value End Property @@ -87,7 +87,7 @@ Public Property Get QuerystringParams() As Dictionary If pQuerystringParams Is Nothing Then: Set pQuerystringParams = New Dictionary Set QuerystringParams = pQuerystringParams End Property -Public Property Let QuerystringParams(Value As Dictionary) +Public Property Set QuerystringParams(Value As Dictionary) Set pQuerystringParams = Value End Property @@ -95,7 +95,7 @@ Public Property Get UrlSegments() As Dictionary If pUrlSegments Is Nothing Then: Set pUrlSegments = New Dictionary Set UrlSegments = pUrlSegments End Property -Public Property Let UrlSegments(Value As Dictionary) +Public Property Set UrlSegments(Value As Dictionary) Set pUrlSegments = Value End Property @@ -103,7 +103,7 @@ Public Property Get Cookies() As Dictionary If pCookies Is Nothing Then: Set pCookies = New Dictionary Set Cookies = pCookies End Property -Public Property Let Cookies(Value As Dictionary) +Public Property Set Cookies(Value As Dictionary) Set pCookies = Value End Property @@ -176,10 +176,12 @@ Public Property Get Body() As String End Property Public Property Get FullUrl(Optional ClientBaseUrl As String = "") As String + Dim Formatted As String + Formatted = Me.FormattedResource If Me.BaseUrl = "" Then Me.BaseUrl = ClientBaseUrl - ' If protocol is missing from base url, add it based on RequireHTTPS property - If Left(Me.BaseUrl, 7) <> "http://" And Left(Me.BaseUrl, 8) <> "https://" Then + ' If protocol is missing, add it based on RequireHTTPS property + If RestHelpers.IncludesProtocol(Me.BaseUrl) = "" And RestHelpers.IncludesProtocol(Formatted) = "" Then If Me.RequireHTTPS Then Me.BaseUrl = "https://" & Me.BaseUrl Else @@ -187,7 +189,16 @@ Public Property Get FullUrl(Optional ClientBaseUrl As String = "") As String End If End If - FullUrl = JoinUrl(Me.BaseUrl, Me.FormattedResource) + ' If protocol is included on base and resource, use base + ' If protocol is included on resource and base is not blank, move to base + If RestHelpers.IncludesProtocol(Me.BaseUrl) <> "" And RestHelpers.IncludesProtocol(Formatted) <> "" Then + Formatted = RestHelpers.RemoveProtocol(Formatted) + ElseIf RestHelpers.IncludesProtocol(Formatted) <> "" And Me.BaseUrl <> "" Then + Me.BaseUrl = RestHelpers.IncludesProtocol(Formatted) & Me.BaseUrl + Formatted = RestHelpers.RemoveProtocol(Formatted) + End If + + FullUrl = JoinUrl(Me.BaseUrl, Formatted) End Property Public Property Get MethodName() As String @@ -375,8 +386,6 @@ Attribute ReadyStateChangeHandler.VB_UserMemId = 0 ' Request is finished, clean up Set Me.HttpRequest = Nothing End If - - ' TODO: Check for timeout and cleanup End Sub ''