Skip to content

Commit 1073924

Browse files
committed
Merge pull request #29 from timhall/client-changes
Add GetJSON and PostJSON Client helpers
2 parents b3aeb3d + 14974a7 commit 1073924

7 files changed

+213
-11
lines changed

specs/Excel-REST - Specs.xlsm

48.1 KB
Binary file not shown.

specs/RestClientSpecs.bas

+26
Original file line numberDiff line numberDiff line change
@@ -20,6 +20,7 @@ Public Function Specs() As SpecSuite
2020
Dim Body As Dictionary
2121
Dim BodyToString As String
2222
Dim i As Integer
23+
Dim Options As Dictionary
2324

2425
Client.BaseUrl = "localhost:3000/"
2526

@@ -118,6 +119,31 @@ Public Function Specs() As SpecSuite
118119
.Expect(Response.Data("query")("d")).ToEqual "False"
119120
End With
120121

122+
With Specs.It("should GET json")
123+
Set Response = Client.GetJSON("/get")
124+
125+
.Expect(Response.StatusCode).ToEqual 200
126+
.Expect(Response.Data).ToBeDefined
127+
End With
128+
129+
With Specs.It("should POST json")
130+
Set Body = New Dictionary
131+
Body.Add "a", 3.14
132+
Set Response = Client.PostJSON("/post", Body)
133+
134+
.Expect(Response.StatusCode).ToEqual 200
135+
.Expect(Response.Data("body")("a")).ToEqual 3.14
136+
End With
137+
138+
With Specs.It("should include options with GET and POST json")
139+
Set Options = New Dictionary
140+
Options.Add "Headers", New Dictionary
141+
Options("Headers").Add "custom", "value"
142+
Set Response = Client.GetJSON("/get", Options)
143+
144+
.Expect(Response.Data("headers")("custom")).ToEqual "value"
145+
End With
146+
121147
With Specs.It("should return 408 on request timeout")
122148
Set Request = New RestRequest
123149
Request.Resource = "timeout"

specs/RestHelpersSpecs.bas

+54
Original file line numberDiff line numberDiff line change
@@ -27,6 +27,8 @@ Public Function Specs() As SpecSuite
2727
Dim ResponseHeaders As String
2828
Dim Headers As Collection
2929
Dim Cookies As Dictionary
30+
Dim Options As Dictionary
31+
Dim Request As RestRequest
3032

3133
With Specs.It("should parse json")
3234
json = "{""a"":1,""b"":3.14,""c"":""Howdy!"",""d"":true,""e"":[1,2]}"
@@ -125,6 +127,11 @@ Public Function Specs() As SpecSuite
125127
.Expect(RestHelpers.JoinUrl("a/", "/b")).ToEqual "a/b"
126128
End With
127129

130+
With Specs.It("should not join blank urls with /")
131+
.Expect(RestHelpers.JoinUrl("", "b")).ToEqual "b"
132+
.Expect(RestHelpers.JoinUrl("a", "")).ToEqual "a"
133+
End With
134+
128135
With Specs.It("should combine objects, with overwrite option")
129136
Set A = New Dictionary
130137
Set B = New Dictionary
@@ -183,6 +190,24 @@ Public Function Specs() As SpecSuite
183190
.Expect(Parsed("d & e")).ToEqual "A + B"
184191
End With
185192

193+
With Specs.It("should identify valid protocols")
194+
.Expect(RestHelpers.IncludesProtocol("http://testing.com")).ToEqual "http://"
195+
.Expect(RestHelpers.IncludesProtocol("https://testing.com")).ToEqual "https://"
196+
.Expect(RestHelpers.IncludesProtocol("ftp://testing.com")).ToEqual "ftp://"
197+
.Expect(RestHelpers.IncludesProtocol("htp://testing.com")).ToEqual ""
198+
.Expect(RestHelpers.IncludesProtocol("testing.com/http://")).ToEqual ""
199+
.Expect(RestHelpers.IncludesProtocol("http://https://testing.com")).ToEqual "http://"
200+
End With
201+
202+
With Specs.It("should remove valid protocols")
203+
.Expect(RestHelpers.RemoveProtocol("http://testing.com")).ToEqual "testing.com"
204+
.Expect(RestHelpers.RemoveProtocol("https://testing.com")).ToEqual "testing.com"
205+
.Expect(RestHelpers.RemoveProtocol("ftp://testing.com")).ToEqual "testing.com"
206+
.Expect(RestHelpers.RemoveProtocol("htp://testing.com")).ToEqual "htp://testing.com"
207+
.Expect(RestHelpers.RemoveProtocol("testing.com/http://")).ToEqual "testing.com/http://"
208+
.Expect(RestHelpers.RemoveProtocol("http://https://testing.com")).ToEqual "https://testing.com"
209+
End With
210+
186211
With Specs.It("should extract headers from response headers")
187212
ResponseHeaders = "Connection: keep -alive" & vbCrLf & _
188213
"Date: Tue, 18 Feb 2014 15:00:26 GMT" & vbCrLf & _
@@ -208,6 +233,35 @@ Public Function Specs() As SpecSuite
208233
.Expect(Cookies("duplicate-cookie")).ToEqual "B"
209234
End With
210235

236+
With Specs.It("should create request from options")
237+
Set Request = RestHelpers.CreateRequestFromOptions(Nothing)
238+
.Expect(Request.Headers.count).ToEqual 0
239+
240+
Set Options = New Dictionary
241+
Set Request = RestHelpers.CreateRequestFromOptions(Options)
242+
.Expect(Request.Headers.count).ToEqual 0
243+
244+
Options.Add "Headers", New Dictionary
245+
Options("Headers").Add "HeaderKey", "HeaderValue"
246+
Set Request = RestHelpers.CreateRequestFromOptions(Options)
247+
.Expect(Request.Headers("HeaderKey")).ToEqual "HeaderValue"
248+
249+
Options.Add "Cookies", New Dictionary
250+
Options("Cookies").Add "CookieKey", "CookieValue"
251+
Set Request = RestHelpers.CreateRequestFromOptions(Options)
252+
.Expect(Request.Cookies("CookieKey")).ToEqual "CookieValue"
253+
254+
Options.Add "QuerystringParams", New Dictionary
255+
Options("QuerystringParams").Add "QuerystringKey", "QuerystringValue"
256+
Set Request = RestHelpers.CreateRequestFromOptions(Options)
257+
.Expect(Request.QuerystringParams("QuerystringKey")).ToEqual "QuerystringValue"
258+
259+
Options.Add "UrlSegments", New Dictionary
260+
Options("UrlSegments").Add "SegmentKey", "SegmentValue"
261+
Set Request = RestHelpers.CreateRequestFromOptions(Options)
262+
.Expect(Request.UrlSegments("SegmentKey")).ToEqual "SegmentValue"
263+
End With
264+
211265
With Specs.It("should encode string to base64")
212266
.Expect(RestHelpers.EncodeStringToBase64("Howdy!")).ToEqual "SG93ZHkh"
213267
End With

specs/RestRequestSpecs.bas

+11
Original file line numberDiff line numberDiff line change
@@ -89,6 +89,17 @@ Public Function Specs() As SpecSuite
8989

9090
.Expect(Request.FormattedResource).ToEqual "?A=123&B=456"
9191
End With
92+
93+
With Specs.It("should not include http/https if included in resource")
94+
Set Request = New RestRequest
95+
Request.IncludeCacheBreaker = False
96+
97+
Request.Resource = "http://localhost:3000/get"
98+
.Expect(Request.FullUrl("")).ToEqual "http://localhost:3000/get"
99+
100+
Request.Resource = "https://localhost:3000/get"
101+
.Expect(Request.FullUrl("")).ToEqual "https://localhost:3000/get"
102+
End With
92103

93104
With Specs.It("should URL encode querystring")
94105
Set Request = New RestRequest

src/RestClient.cls

+21
Original file line numberDiff line numberDiff line change
@@ -87,6 +87,27 @@ ErrorHandling:
8787
Err.Raise Err.Number, Description:=Err.Description
8888
End Function
8989

90+
Public Function GetJSON(Url As String, Optional Options As Dictionary) As RestResponse
91+
Dim Request As RestRequest
92+
Set Request = RestHelpers.CreateRequestFromOptions(Options)
93+
Request.Resource = Url
94+
Request.Format = json
95+
Request.Method = httpGET
96+
97+
Set GetJSON = Me.Execute(Request)
98+
End Function
99+
100+
Public Function PostJSON(Url As String, Body As Dictionary, Optional Options As Dictionary) As RestResponse
101+
Dim Request As RestRequest
102+
Set Request = RestHelpers.CreateRequestFromOptions(Options)
103+
Request.Resource = Url
104+
Request.Format = json
105+
Request.Method = httpPOST
106+
Request.AddBody Body
107+
108+
Set PostJSON = Me.Execute(Request)
109+
End Function
110+
90111
''
91112
' Set proxy for all requests
92113
'

src/RestHelpers.bas

+82-1
Original file line numberDiff line numberDiff line change
@@ -65,6 +65,9 @@ Public Enum StatusCodes
6565
GatewayTimeout = 504
6666
End Enum
6767

68+
Public Property Get ValidProtocols() As Variant
69+
ValidProtocols = Array("http", "https", "ftp")
70+
End Property
6871

6972
' ============================================= '
7073
' Shared Helpers
@@ -194,7 +197,11 @@ Public Function JoinUrl(LeftSide As String, RightSide As String) As String
194197
LeftSide = Left(LeftSide, Len(LeftSide) - 1)
195198
End If
196199

197-
JoinUrl = LeftSide & "/" & RightSide
200+
If LeftSide <> "" And RightSide <> "" Then
201+
JoinUrl = LeftSide & "/" & RightSide
202+
Else
203+
JoinUrl = LeftSide & RightSide
204+
End If
198205
End Function
199206

200207
''
@@ -322,6 +329,49 @@ Public Function ParseUrlEncoded(Encoded As String) As Dictionary
322329
Set ParseUrlEncoded = Parsed
323330
End Function
324331

332+
''
333+
' Check if protocol is included with url
334+
'
335+
' @param {String} Url
336+
' @return {String} Found protocol
337+
' --------------------------------------------- '
338+
339+
Public Function IncludesProtocol(Url As String) As String
340+
Dim Protocol As String
341+
Dim i As Integer
342+
343+
For i = LBound(ValidProtocols) To UBound(ValidProtocols)
344+
Protocol = ValidProtocols(i) + "://"
345+
If Left(Url, Len(Protocol)) = Protocol Then
346+
IncludesProtocol = Protocol
347+
Exit Function
348+
End If
349+
Next i
350+
End Function
351+
352+
''
353+
' Remove protocol from url (if present)
354+
'
355+
' @param {String} Url
356+
' @return {String} Url without protocol
357+
' --------------------------------------------- '
358+
359+
Public Function RemoveProtocol(Url As String) As String
360+
Dim Protocol As String
361+
362+
RemoveProtocol = Url
363+
Protocol = IncludesProtocol(RemoveProtocol)
364+
If Protocol <> "" Then
365+
RemoveProtocol = Replace(RemoveProtocol, Protocol, "")
366+
End If
367+
End Function
368+
369+
' ======================================================================================== '
370+
'
371+
' Request Preparation / Handling
372+
'
373+
' ======================================================================================== '
374+
325375
''
326376
' Prepare http request for execution
327377
'
@@ -567,6 +617,37 @@ Public Function ExtractHeadersFromResponseHeaders(ResponseHeaders As String) As
567617
Set ExtractHeadersFromResponseHeaders = Headers
568618
End Function
569619

620+
''
621+
' Create request from options
622+
'
623+
' @param {Dictionary} Options
624+
' - Headers
625+
' - Cookies
626+
' - QuerystringParams
627+
' - UrlSegments
628+
' --------------------------------------------- '
629+
630+
Public Function CreateRequestFromOptions(Options As Dictionary) As RestRequest
631+
Dim Request As New RestRequest
632+
633+
If Not IsEmpty(Options) And Not Options Is Nothing Then
634+
If Options.Exists("Headers") Then
635+
Set Request.Headers = Options("Headers")
636+
End If
637+
If Options.Exists("Cookies") Then
638+
Set Request.Cookies = Options("Cookies")
639+
End If
640+
If Options.Exists("QuerystringParams") Then
641+
Set Request.QuerystringParams = Options("QuerystringParams")
642+
End If
643+
If Options.Exists("UrlSegments") Then
644+
Set Request.UrlSegments = Options("UrlSegments")
645+
End If
646+
End If
647+
648+
Set CreateRequestFromOptions = Request
649+
End Function
650+
570651
' ======================================================================================== '
571652
'
572653
' Timeout Timing

src/RestRequest.cls

+19-10
Original file line numberDiff line numberDiff line change
@@ -71,39 +71,39 @@ Public Property Get Headers() As Dictionary
7171
If pHeaders Is Nothing Then: Set pHeaders = New Dictionary
7272
Set Headers = pHeaders
7373
End Property
74-
Public Property Let Headers(Value As Dictionary)
74+
Public Property Set Headers(Value As Dictionary)
7575
Set pHeaders = Value
7676
End Property
7777

7878
Public Property Get Parameters() As Dictionary
7979
If pParameters Is Nothing Then: Set pParameters = New Dictionary
8080
Set Parameters = pParameters
8181
End Property
82-
Public Property Let Parameters(Value As Dictionary)
82+
Public Property Set Parameters(Value As Dictionary)
8383
Set pParameters = Value
8484
End Property
8585

8686
Public Property Get QuerystringParams() As Dictionary
8787
If pQuerystringParams Is Nothing Then: Set pQuerystringParams = New Dictionary
8888
Set QuerystringParams = pQuerystringParams
8989
End Property
90-
Public Property Let QuerystringParams(Value As Dictionary)
90+
Public Property Set QuerystringParams(Value As Dictionary)
9191
Set pQuerystringParams = Value
9292
End Property
9393

9494
Public Property Get UrlSegments() As Dictionary
9595
If pUrlSegments Is Nothing Then: Set pUrlSegments = New Dictionary
9696
Set UrlSegments = pUrlSegments
9797
End Property
98-
Public Property Let UrlSegments(Value As Dictionary)
98+
Public Property Set UrlSegments(Value As Dictionary)
9999
Set pUrlSegments = Value
100100
End Property
101101

102102
Public Property Get Cookies() As Dictionary
103103
If pCookies Is Nothing Then: Set pCookies = New Dictionary
104104
Set Cookies = pCookies
105105
End Property
106-
Public Property Let Cookies(Value As Dictionary)
106+
Public Property Set Cookies(Value As Dictionary)
107107
Set pCookies = Value
108108
End Property
109109

@@ -176,18 +176,29 @@ Public Property Get Body() As String
176176
End Property
177177

178178
Public Property Get FullUrl(Optional ClientBaseUrl As String = "") As String
179+
Dim Formatted As String
180+
Formatted = Me.FormattedResource
179181
If Me.BaseUrl = "" Then Me.BaseUrl = ClientBaseUrl
180182

181-
' If protocol is missing from base url, add it based on RequireHTTPS property
182-
If Left(Me.BaseUrl, 7) <> "http://" And Left(Me.BaseUrl, 8) <> "https://" Then
183+
' If protocol is missing, add it based on RequireHTTPS property
184+
If RestHelpers.IncludesProtocol(Me.BaseUrl) = "" And RestHelpers.IncludesProtocol(Formatted) = "" Then
183185
If Me.RequireHTTPS Then
184186
Me.BaseUrl = "https://" & Me.BaseUrl
185187
Else
186188
Me.BaseUrl = "http://" & Me.BaseUrl
187189
End If
188190
End If
189191

190-
FullUrl = JoinUrl(Me.BaseUrl, Me.FormattedResource)
192+
' If protocol is included on base and resource, use base
193+
' If protocol is included on resource and base is not blank, move to base
194+
If RestHelpers.IncludesProtocol(Me.BaseUrl) <> "" And RestHelpers.IncludesProtocol(Formatted) <> "" Then
195+
Formatted = RestHelpers.RemoveProtocol(Formatted)
196+
ElseIf RestHelpers.IncludesProtocol(Formatted) <> "" And Me.BaseUrl <> "" Then
197+
Me.BaseUrl = RestHelpers.IncludesProtocol(Formatted) & Me.BaseUrl
198+
Formatted = RestHelpers.RemoveProtocol(Formatted)
199+
End If
200+
201+
FullUrl = JoinUrl(Me.BaseUrl, Formatted)
191202
End Property
192203

193204
Public Property Get MethodName() As String
@@ -375,8 +386,6 @@ Attribute ReadyStateChangeHandler.VB_UserMemId = 0
375386
' Request is finished, clean up
376387
Set Me.HttpRequest = Nothing
377388
End If
378-
379-
' TODO: Check for timeout and cleanup
380389
End Sub
381390

382391
''

0 commit comments

Comments
 (0)