Add GetJSON and PostJSON Client helpers

Author: timhall

specs/Excel-REST - Specs.xlsm

@@ -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"

specs/RestClientSpecs.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

specs/RestHelpersSpecs.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

specs/RestRequestSpecs.bas

@@ -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
 '

src/RestClient.cls

@@ -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

src/RestHelpers.bas

@@ -71,39 +71,39 @@ 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
 
 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
 
 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
 
 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
 
 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,18 +176,29 @@ 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
             Me.BaseUrl = "http://" & Me.BaseUrl
         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
 
 ''