diff --git a/authenticators/EmptyAuthenticator.cls b/authenticators/EmptyAuthenticator.cls index 63fea59d..0c612d8a 100644 --- a/authenticators/EmptyAuthenticator.cls +++ b/authenticators/EmptyAuthenticator.cls @@ -7,25 +7,69 @@ Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = False Attribute VB_Exposed = False +'' +' Base for setting up authenticator +' +' @author: +' @license: +' @implements: IAuthenticator +' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ' Implements IAuthenticator +Option Explicit + +' ============================================= ' +' Public Methods +' ============================================= ' + +'' +' Setup authenticator +' --------------------------------------------- ' Public Sub Setup() ' Define any user-specific variables needed for authentication End Sub -Private Sub IAuthenticator_BeforeExecute(Request As RestRequest) -' (Used to add any required fields to the `Request` before it is executed) +' ============================================= ' +' Private Methods +' ============================================= ' + +'' +' Hook for taking action before a request is executed +' +' @param {RestClient} Client The client that is about to execute the request +' @param {RestRequest} Request The request about to be executed +' --------------------------------------------- ' + +Private Sub IAuthenticator_BeforeExecute(ByVal Client As RestClient, ByRef Request As RestRequest) + ' Add headers, cookies, etc to `Request` before it is executed + ' (Leave blank to pass Request through unmodified) +End Sub + +'' +' Hook for taking action after request has been executed +' +' @param {RestClient} Client The client that executed request +' @param {RestRequest} Request The request that was just executed +' @param {RestResponse} Response to request +' --------------------------------------------- ' + +Private Sub IAuthenticator_AfterExecute(ByVal Client As RestClient, ByVal Request As RestRequest, ByRef Response As RestResponse) - ' Leave blank to pass Request through unmodified End Sub -Private Sub IAuthenticator_HttpOpen( _ - Http As Object, _ - Request As RestRequest, _ - BaseUrl As String, _ - Optional UseAsync As Boolean = False) -' (Used to open the given http request, making any necessary modifications) +'' +' Hook for overriding standard http open (used for HTTP Basic) +' +' @param {MSXML2.IXMLHTTPRequest} http +' @parma {RestClient} Client The client that is about to open request +' @param {RestRequest} Request The request about to be opened +' @param {String} BaseUrl +' @param {Boolean} [useAsync=False] +' --------------------------------------------- ' + +Private Sub IAuthenticator_HttpOpen(ByRef Http As Object, ByVal Client As RestClient, ByRef Request As RestRequest, BaseUrl As String, Optional UseAsync As Boolean = False) + ' Use modified http open (if necessary) ' Perform standard http open - ' Call http.Open(Request.MethodName(), Request.FullUrl(BaseUrl), useAsync) + Call Http.Open(Request.MethodName(), Request.FullUrl(BaseUrl), UseAsync) End Sub diff --git a/authenticators/GoogleAuthenticator.cls b/authenticators/GoogleAuthenticator.cls index 29c19a87..a1c9f276 100644 --- a/authenticators/GoogleAuthenticator.cls +++ b/authenticators/GoogleAuthenticator.cls @@ -7,9 +7,8 @@ Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = False Attribute VB_Exposed = True -Implements IAuthenticator '' -' Google Authenticator v1.0.0 +' Google Authenticator v2.0.0 ' (c) Tim Hall - https://github.com/timhall/Excel-REST ' ' Custom IAuthenticator for "installed application" authentication for Google APIs @@ -17,11 +16,13 @@ Implements IAuthenticator ' - https://developers.google.com/accounts/docs/OAuth2#installed ' - https://developers.google.com/accounts/docs/OAuth2InstalledApp ' -' @dependencies +' @implements IAuthenticator ' @author: tim.hall.engr@gmail.com ' @license: MIT (http://www.opensource.org/licenses/mit-license.php) ' ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ' +Implements IAuthenticator +Option Explicit Private Const AuthorizationUrl As String = "https://accounts.google.com/o/oauth2/auth" Private Const RedirectUri As String = "urn:ietf:wg:oauth:2.0:oob" @@ -111,6 +112,10 @@ End Property ' Public Methods ' ============================================= ' +'' +' Setup authenticator +' --------------------------------------------- ' + Public Sub Setup(ClientId As String, ClientSecret As String) Me.ClientId = ClientId Me.ClientSecret = ClientSecret @@ -148,7 +153,14 @@ Public Sub Logout() Me.Token = "" End Sub -Private Sub IAuthenticator_BeforeExecute(Request As RestRequest) +'' +' Hook for taking action before a request is executed +' +' @param {RestClient} Client The client that is about to execute the request +' @param {RestRequest} Request The request about to be executed +' --------------------------------------------- ' + +Private Sub IAuthenticator_BeforeExecute(ByVal Client As RestClient, ByRef Request As RestRequest) If Me.ApiKey <> "" Then Request.AddQuerystringParam "key", Me.ApiKey Else @@ -156,13 +168,31 @@ Private Sub IAuthenticator_BeforeExecute(Request As RestRequest) End If End Sub -Private Sub IAuthenticator_HttpOpen( _ - Http As Object, _ - Request As RestRequest, _ - BaseUrl As String, _ - Optional UseAsync As Boolean = False) +'' +' Hook for taking action after request has been executed +' +' @param {RestClient} Client The client that executed request +' @param {RestRequest} Request The request that was just executed +' @param {RestResponse} Response to request +' --------------------------------------------- ' + +Private Sub IAuthenticator_AfterExecute(ByVal Client As RestClient, ByVal Request As RestRequest, ByRef Response As RestResponse) + +End Sub + +'' +' Hook for overriding standard http open (used for HTTP Basic) +' +' @param {MSXML2.IXMLHTTPRequest} http +' @parma {RestClient} Client The client that is about to open request +' @param {RestRequest} Request The request about to be opened +' @param {String} BaseUrl +' @param {Boolean} [useAsync=False] +' --------------------------------------------- ' + +Private Sub IAuthenticator_HttpOpen(ByRef Http As Object, ByVal Client As RestClient, ByRef Request As RestRequest, BaseUrl As String, Optional UseAsync As Boolean = False) - ' Perform standard http open + ' Perform standard http open Http.Open Request.MethodName(), Request.FullUrl(BaseUrl), UseAsync End Sub diff --git a/authenticators/HttpBasicAuthenticator.cls b/authenticators/HttpBasicAuthenticator.cls index 277eb965..4879adb1 100644 --- a/authenticators/HttpBasicAuthenticator.cls +++ b/authenticators/HttpBasicAuthenticator.cls @@ -9,12 +9,12 @@ Attribute VB_PredeclaredId = False Attribute VB_Exposed = True Implements IAuthenticator '' -' HttpBasicAuthenticator v1.0.0 +' HttpBasicAuthenticator v2.0.0 ' (c) Tim Hall - https://github.com/timhall/Excel-REST ' ' Utilize http basic authentication ' -' @author: tim.hall.engr@gmail.com +' @author tim.hall.engr@gmail.com ' @license: MIT (http://www.opensource.org/licenses/mit-license.php) ' ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ' @@ -48,11 +48,40 @@ End Sub ' Private Methods ' ============================================= ' -Private Sub IAuthenticator_BeforeExecute(Request As RestRequest) +'' +' Hook for taking action before a request is executed +' +' @param {RestClient} Client The client that is about to execute the request +' @param {RestRequest} Request The request about to be executed +' --------------------------------------------- ' + +Private Sub IAuthenticator_BeforeExecute(ByVal Client As RestClient, ByRef Request As RestRequest) Request.AddHeader "Authorization", CreateHeader() End Sub -Private Sub IAuthenticator_HttpOpen(Http As Object, Request As RestRequest, BaseUrl As String, Optional UseAsync As Boolean = False) +'' +' Hook for taking action after request has been executed +' +' @param {RestClient} Client The client that executed request +' @param {RestRequest} Request The request that was just executed +' @param {RestResponse} Response to request +' --------------------------------------------- ' + +Private Sub IAuthenticator_AfterExecute(ByVal Client As RestClient, ByVal Request As RestRequest, ByRef Response As RestResponse) + +End Sub + +'' +' Hook for overriding standard http open (used for HTTP Basic) +' +' @param {MSXML2.IXMLHTTPRequest} http +' @parma {RestClient} Client The client that is about to open request +' @param {RestRequest} Request The request about to be opened +' @param {String} BaseUrl +' @param {Boolean} [useAsync=False] +' --------------------------------------------- ' + +Private Sub IAuthenticator_HttpOpen(ByRef Http As Object, ByVal Client As RestClient, ByRef Request As RestRequest, BaseUrl As String, Optional UseAsync As Boolean = False) ' Use http open with username and password values set ' (This is used in addition to setting request header, as some services required this) Http.Open Request.MethodName(), Request.FullUrl(BaseUrl), UseAsync, Me.Username, Me.Password diff --git a/authenticators/OAuth1Authenticator.cls b/authenticators/OAuth1Authenticator.cls index 871ccc41..e271fb3b 100644 --- a/authenticators/OAuth1Authenticator.cls +++ b/authenticators/OAuth1Authenticator.cls @@ -9,14 +9,14 @@ Attribute VB_PredeclaredId = False Attribute VB_Exposed = True Implements IAuthenticator '' -' OAuth1 Authenticator v1.0.0 +' OAuth1 Authenticator v2.0.0 ' (c) Tim Hall - https://github.com/timhall/Excel-REST ' ' Utilize OAuth1 authentication ' ' @dependencies ' Microsoft XML, v3+ -' @author: tim.hall.engr@gmail.com +' @author tim.hall.engr@gmail.com ' @license: MIT (http://www.opensource.org/licenses/mit-license.php) ' ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ' @@ -98,14 +98,43 @@ End Sub ' Private Methods ' ============================================= ' -Private Sub IAuthenticator_BeforeExecute(Request As RestRequest) +'' +' Hook for taking action before a request is executed +' +' @param {RestClient} Client The client that is about to execute the request +' @param {RestRequest} Request The request about to be executed +' --------------------------------------------- ' + +Private Sub IAuthenticator_BeforeExecute(ByVal Client As RestClient, ByRef Request As RestRequest) ' Add authorization header to request Request.AddHeader "Authorization", CreateHeader(Request) End Sub -Private Sub IAuthenticator_HttpOpen(Http As Object, Request As RestRequest, BaseUrl As String, Optional UseAsync As Boolean = False) - ' Standard http open - Http.Open Request.MethodName(), Request.FullUrl(BaseUrl), UseAsync +'' +' Hook for taking action after request has been executed +' +' @param {RestClient} Client The client that executed request +' @param {RestRequest} Request The request that was just executed +' @param {RestResponse} Response to request +' --------------------------------------------- ' + +Private Sub IAuthenticator_AfterExecute(ByVal Client As RestClient, ByVal Request As RestRequest, ByRef Response As RestResponse) + +End Sub + +'' +' Hook for overriding standard http open (used for HTTP Basic) +' +' @param {MSXML2.IXMLHTTPRequest} http +' @parma {RestClient} Client The client that is about to open request +' @param {RestRequest} Request The request about to be opened +' @param {String} BaseUrl +' @param {Boolean} [useAsync=False] +' --------------------------------------------- ' + +Private Sub IAuthenticator_HttpOpen(ByRef Http As Object, ByVal Client As RestClient, ByRef Request As RestRequest, BaseUrl As String, Optional UseAsync As Boolean = False) + ' Perform standard http open + Call Http.Open(Request.MethodName(), Request.FullUrl(BaseUrl), UseAsync) End Sub Private Function CreateHeader(Request As RestRequest) As String diff --git a/authenticators/OAuth2Authenticator.cls b/authenticators/OAuth2Authenticator.cls index bff1f3a6..0e295345 100644 --- a/authenticators/OAuth2Authenticator.cls +++ b/authenticators/OAuth2Authenticator.cls @@ -9,7 +9,7 @@ Attribute VB_PredeclaredId = False Attribute VB_Exposed = True Implements IAuthenticator '' -' OAuth2 Authenticator v1.0.0 +' OAuth2 Authenticator v2.0.0 ' (c) Tim Hall - https://github.com/timhall/Excel-REST ' ' Utilize OAuth2 authentication @@ -17,7 +17,7 @@ Implements IAuthenticator ' ' @dependencies ' Microsoft XML, v3+ -' @author: tim.hall.engr@gmail.com +' @author tim.hall.engr@gmail.com ' @license: MIT (http://www.opensource.org/licenses/mit-license.php) ' ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ' @@ -68,7 +68,14 @@ Public Sub SetupTokenUrl(TokenUrl As String, Optional TokenKey As String = "acce Me.TokenKey = TokenKey End Sub -Private Sub IAuthenticator_BeforeExecute(Request As RestRequest) +'' +' Hook for taking action before a request is executed +' +' @param {RestClient} Client The client that is about to execute the request +' @param {RestRequest} Request The request about to be executed +' --------------------------------------------- ' + +Private Sub IAuthenticator_BeforeExecute(ByVal Client As RestClient, ByRef Request As RestRequest) On Error GoTo ErrorHandling If (Me.Token = "" Or Not Me.CacheToken) And (Me.TokenUrl <> "" And Me.TokenKey <> "") Then ' Get new token @@ -76,7 +83,7 @@ Private Sub IAuthenticator_BeforeExecute(Request As RestRequest) Set Http = CreateObject("MSXML2.ServerXMLHTTP") Http.Open "POST", CreateTokenRequest, False - Http.send + Http.Send If Http.Status <> 200 Then ' Error getting OAuth2 token @@ -113,9 +120,31 @@ ErrorHandling: End If End Sub -Private Sub IAuthenticator_HttpOpen(Http As Object, Request As RestRequest, BaseUrl As String, Optional UseAsync As Boolean = False) +'' +' Hook for taking action after request has been executed +' +' @param {RestClient} Client The client that executed request +' @param {RestRequest} Request The request that was just executed +' @param {RestResponse} Response to request +' --------------------------------------------- ' + +Private Sub IAuthenticator_AfterExecute(ByVal Client As RestClient, ByVal Request As RestRequest, ByRef Response As RestResponse) + +End Sub + +'' +' Hook for overriding standard http open (used for HTTP Basic) +' +' @param {MSXML2.IXMLHTTPRequest} http +' @parma {RestClient} Client The client that is about to open request +' @param {RestRequest} Request The request about to be opened +' @param {String} BaseUrl +' @param {Boolean} [useAsync=False] +' --------------------------------------------- ' + +Private Sub IAuthenticator_HttpOpen(ByRef Http As Object, ByVal Client As RestClient, ByRef Request As RestRequest, BaseUrl As String, Optional UseAsync As Boolean = False) ' Perform standard http open - Http.Open Request.MethodName(), Request.FullUrl(BaseUrl), UseAsync + Call Http.Open(Request.MethodName(), Request.FullUrl(BaseUrl), UseAsync) End Sub ' ============================================= ' diff --git a/authenticators/TwitterAuthenticator.cls b/authenticators/TwitterAuthenticator.cls index e3793726..7a8fdad8 100644 --- a/authenticators/TwitterAuthenticator.cls +++ b/authenticators/TwitterAuthenticator.cls @@ -9,7 +9,7 @@ Attribute VB_PredeclaredId = False Attribute VB_Exposed = False Implements IAuthenticator '' -' Twitter Authenticator v1.0.0 +' Twitter Authenticator v2.0.0 ' (c) Tim Hall - https://github.com/timhall/Excel-REST ' ' Custom IAuthenticator for application-only authentication in Twitter's V1.1 REST API @@ -18,7 +18,7 @@ Implements IAuthenticator ' - https://github.com/timhall/Excel-REST/wiki/Implementing-your-own-IAuthenticator ' ' @dependencies -' @author: tim.hall.engr@gmail.com +' @author tim.hall.engr@gmail.com ' @license: MIT (http://www.opensource.org/licenses/mit-license.php) ' ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ' @@ -78,23 +78,49 @@ Public Sub Setup(ConsumerKey As String, ConsumerSecret As String) Me.ConsumerSecret = ConsumerSecret End Sub -Private Sub IAuthenticator_BeforeExecute(Request As RestRequest) +' ============================================= ' +' Private Methods +' ============================================= ' + +'' +' Hook for taking action before a request is executed +' +' @param {RestClient} Client The client that is about to execute the request +' @param {RestRequest} Request The request about to be executed +' --------------------------------------------- ' + +Private Sub IAuthenticator_BeforeExecute(ByVal Client As RestClient, ByRef Request As RestRequest) Request.AddHeader "Authorization", "Bearer " & Me.Token End Sub -Private Sub IAuthenticator_HttpOpen( _ - Http As Object, _ - Request As RestRequest, _ - BaseUrl As String, _ - Optional UseAsync As Boolean = False) +'' +' Hook for taking action after request has been executed +' +' @param {RestClient} Client The client that executed request +' @param {RestRequest} Request The request that was just executed +' @param {RestResponse} Response to request +' --------------------------------------------- ' + +Private Sub IAuthenticator_AfterExecute(ByVal Client As RestClient, ByVal Request As RestRequest, ByRef Response As RestResponse) - ' Perform standard http open - Http.Open Request.MethodName(), Request.FullUrl(BaseUrl), UseAsync End Sub -' ============================================= ' -' Private Methods -' ============================================= ' +'' +' Hook for overriding standard http open (used for HTTP Basic) +' +' @param {MSXML2.IXMLHTTPRequest} http +' @parma {RestClient} Client The client that is about to open request +' @param {RestRequest} Request The request about to be opened +' @param {String} BaseUrl +' @param {Boolean} [useAsync=False] +' --------------------------------------------- ' + +Private Sub IAuthenticator_HttpOpen(ByRef Http As Object, ByVal Client As RestClient, ByRef Request As RestRequest, BaseUrl As String, Optional UseAsync As Boolean = False) + ' Use modified http open (if necessary) + + ' Perform standard http open + Call Http.Open(Request.MethodName(), Request.FullUrl(BaseUrl), UseAsync) +End Sub Private Function TokenRequest() As RestRequest Set TokenRequest = New RestRequest diff --git a/build/export-auth.vbs b/build/export-auth.vbs index c0093c3c..beceefcc 100644 --- a/build/export-auth.vbs +++ b/build/export-auth.vbs @@ -18,6 +18,9 @@ Set Args = Wscript.Arguments If Args.Length > 0 Then WBPath = Args(0) OutputPath = Args(1) +Else + WBPath = "examples\Excel-REST - Example.xlsm" + OutputPath = "authenticators\" End If ' Setup modules to export diff --git a/examples/Excel-REST - Example.xlsm b/examples/Excel-REST - Example.xlsm index 02ef5be2..8595e2aa 100644 Binary files a/examples/Excel-REST - Example.xlsm and b/examples/Excel-REST - Example.xlsm differ diff --git a/src/IAuthenticator.cls b/src/IAuthenticator.cls index 2090940c..234456ac 100644 --- a/src/IAuthenticator.cls +++ b/src/IAuthenticator.cls @@ -26,25 +26,36 @@ Option Explicit '' ' Hook for taking action before a request is executed ' -' @param {RestRequest} request The request about to be executed +' @param {RestClient} Client The client that is about to execute the request +' @param {RestRequest} Request The request about to be executed ' --------------------------------------------- ' -Public Sub BeforeExecute(ByRef Request As RestRequest) - ' ... - ' Add header - ' etc. +Public Sub BeforeExecute(ByVal Client As RestClient, ByRef Request As RestRequest) + ' Add headers, cookies, etc +End Sub + +'' +' Hook for taking action after request has been executed +' +' @param {RestClient} Client The client that executed request +' @param {RestRequest} Request The request that was just executed +' @param {RestResponse} Response to request +' --------------------------------------------- ' + +Public Sub AfterExecute(ByVal Client As RestClient, ByVal Request As RestRequest, ByRef Response As RestResponse) + ' Handle 304 Unauthorized or other issues End Sub '' ' Hook for overriding standard http open (used for HTTP Basic) ' ' @param {MSXML2.IXMLHTTPRequest} http -' @param {RestRequest} request The request about to be opened +' @parma {RestClient} Client The client that is about to open request +' @param {RestRequest} Request The request about to be opened ' @param {String} BaseUrl ' @param {Boolean} [useAsync=False] ' --------------------------------------------- ' -Public Sub HttpOpen(ByRef Http As Object, ByRef Request As RestRequest, BaseUrl As String, Optional UseAsync As Boolean = False) - ' Use standard http open by default - Http.Open Request.MethodName(), Request.FullUrl(BaseUrl), UseAsync +Public Sub HttpOpen(ByRef Http As Object, ByVal Client As RestClient, ByRef Request As RestRequest, BaseUrl As String, Optional UseAsync As Boolean = False) + ' Modify http open behavior End Sub diff --git a/src/RestClient.cls b/src/RestClient.cls index e993903a..0ec97820 100644 --- a/src/RestClient.cls +++ b/src/RestClient.cls @@ -52,6 +52,10 @@ Public Function Execute(Request As RestRequest) As RestResponse Set Http = HttpSetup(Request, False) Set Execute = RestHelpers.ExecuteRequest(Http, Request) + If Not Me.Authenticator Is Nothing Then + Me.Authenticator.AfterExecute Me, Request, Execute + End If + ErrorHandling: If Not Http Is Nothing Then Set Http = Nothing @@ -87,6 +91,18 @@ ErrorHandling: Err.Raise Err.Number, Description:=Err.Description End Function +'' +' GET JSON from Url using options +' +' @param {String} Url (relative to BaseUrl, if set) +' @param {Dictionary} [Options] +' - Headers +' - Cookies +' - QuerystringParams +' - UrlSegments +' @return {RestResponse} Response +' --------------------------------------------- ' + Public Function GetJSON(Url As String, Optional Options As Dictionary) As RestResponse Dim Request As RestRequest Set Request = RestHelpers.CreateRequestFromOptions(Options) @@ -97,6 +113,19 @@ Public Function GetJSON(Url As String, Optional Options As Dictionary) As RestRe Set GetJSON = Me.Execute(Request) End Function +'' +' POST JSON to Url using body and options +' +' @param {String} Url (relative to BaseUrl, if set) +' @param {Dictionary} Body +' @param {Dictionary} [Options] +' - Headers +' - Cookies +' - QuerystringParams +' - UrlSegments +' @return {RestResponse} Response +' --------------------------------------------- ' + Public Function PostJSON(Url As String, Body As Dictionary, Optional Options As Dictionary) As RestResponse Dim Request As RestRequest Set Request = RestHelpers.CreateRequestFromOptions(Options) @@ -139,8 +168,10 @@ Private Function HttpSetup(ByRef Request As RestRequest, Optional UseAsync As Bo ' Before execute and http open hooks for authenticator If Not Me.Authenticator Is Nothing Then - Me.Authenticator.BeforeExecute Request - Me.Authenticator.HttpOpen HttpSetup, Request, Me.BaseUrl, UseAsync + Me.Authenticator.BeforeExecute Me, Request + Me.Authenticator.HttpOpen HttpSetup, Me, Request, Me.BaseUrl, UseAsync + Set Request.Authenticator = Me.Authenticator + Set Request.Client = Me Else ' Nothing hooked in so open http object HttpSetup.Open Request.MethodName(), Request.FullUrl(Me.BaseUrl), UseAsync diff --git a/src/RestRequest.cls b/src/RestRequest.cls index 0ef70e90..f860b6b5 100644 --- a/src/RestRequest.cls +++ b/src/RestRequest.cls @@ -66,6 +66,8 @@ Public RequireHTTPS As Boolean Public CallbackArgs As Variant Public IncludeCacheBreaker As Boolean Public IncludeContentLength As Boolean +Public Authenticator As IAuthenticator +Public Client As RestClient Public Property Get Headers() As Dictionary If pHeaders Is Nothing Then: Set pHeaders = New Dictionary @@ -345,8 +347,8 @@ End Sub ' @param {Dictionary} bodyVal Object to add to body (will be converted to string) ' --------------------------------------------- ' -Public Function AddBody(bodyVal As Dictionary) - Set pBody = bodyVal +Public Function AddBody(BodyVal As Dictionary) + Set pBody = BodyVal End Function '' @@ -355,8 +357,8 @@ End Function ' @param {String} bodyVal ' --------------------------------------------- ' -Public Function AddBodyString(bodyVal As String) - pBodyString = bodyVal +Public Function AddBodyString(BodyVal As String) + pBodyString = BodyVal End Function '' @@ -437,7 +439,18 @@ Private Sub RunCallback(Response As RestResponse) ' Debug.Print args(i) & " was passed into async execute" ' Next i ' End Function - ' + + If Not Me.Authenticator Is Nothing Then + ' Don't pass Authenticator and Client with Request to AfterExecute + Dim Auth As IAuthenticator + Dim Client As RestClient + Set Auth = Me.Authenticator + Set Client = Me.Client + Set Me.Authenticator = Nothing + Set Me.Client = Nothing + + Auth.AfterExecute Me.Client, Me, Response + End If If Me.Callback <> "" Then If Not IsMissing(Me.CallbackArgs) Then Application.Run Me.Callback, Response, Me.CallbackArgs @@ -456,4 +469,6 @@ End Sub Private Sub Class_Terminate() ' Clean up If Not Me.HttpRequest Is Nothing Then: Set Me.HttpRequest = Nothing + If Not Me.Authenticator Is Nothing Then: Set Me.Authenticator = Nothing + If Not Me.Client Is Nothing Then: Set Me.Client = Nothing End Sub