coauth2 class for VBA http://ramblings.mcpher.com/Home/excelquirks/googleoauth2

cOauth2.cls

'gistThat@mcpher.com :do not modify this line - see ramblings.mcpher.com for details: updated on 8/9/2014 3:09:54 PM : from manifest:5055578 gist https://gist.github.com/brucemcpherson/6937450/raw/cOauth2.cls
Option Explicit
'" based on Kyle Beachill Oauth2
'" for credits and details see
'" http://ramblings.mcpher.com/Home/excelquirks/guests/oauth2
' for details on this implementation see http://ramblings.mcpher.com/Home/excelquirks/googleoauth2
' v1.5

Private pPackage As cJobject
Private pCb As cBrowser
Private pDialog  As cJobject
Private pSalt As String
Private pMessage As String

Public Function googleAuth(scopeEntry As String, _
        Optional replacementConsole As cJobject = Nothing, _
        Optional clientID As String = vbNullString, _
        Optional clientSecret As String = vbNullString, _
        Optional complain As Boolean = True, _
        Optional cloneFromScopeEntry As String = vbNullString) As cOauth2
    
    ' this will do an oauth2 against google - the generated token() is usuable for subsequent requests against the given scope
    ' a auth interactive dialog wont be necessary if there is a refresh token, or an unexpired auth token
    ' available in the registry for this user.
    ' All data in registry is encrypted, and package from the last access is stored there
    ' this mimics the behavior of sites that authorized against google credentials
    
    ' setting up for the fist time.
    ' the first time this is used, there is nothing in the registry, so this needs to be called with either
    ' a cJobject which is simply the JSONPARSE of the string you can download from google when you register an app
    ' or, the clientID and client secret
    ' or you can clone all this from another scope
    ' once this has ever been called, the registry is used for the source of all this.
    
    ' refreshing the registry
    ' if for any reason the registry is stale, just repeat as if setting up for the first time
    Dim authFlavor As String, aKey As String, sKey As String, clonePackage As cJobject
    authFlavor = "google"
    aKey = "type_" & authFlavor
    sKey = "scope_" & scopeEntry
    
    Set googleAuth = Me
    
    ' first see if we are cloning from another scope
    If (cloneFromScopeEntry <> vbNullString) Then
        Set clonePackage = getRegistryPackage(aKey, "scope_" & cloneFromScopeEntry)
    End If
    
    If (clientID <> vbNullString Or clientSecret <> vbNullString Or Not replacementConsole Is Nothing _
        Or Not clonePackage Is Nothing) Then
        ' need a refresh
        If (clonePackage Is Nothing) Then
            Set pPackage = googlePackage(replacementConsole)
        Else
            ' use the cloned credentials, but revoke it to force a new authentication
            Set pPackage = clonePackage
            revoke
        End If
        ' use replacement package and add any passwords passed over (they may already be in the package)
        With pPackage.child("parameters")
            If clientSecret <> vbNullString Then .add "client_secret", clientSecret
            If clientID <> vbNullString Then .add "client_id", clientID
            .add "authFlavor", aKey
            .add "scopeEntry", sKey
        End With
        
    Else
        ' get existing ppackage from registry if there is one
        Set pPackage = getRegistryPackage(aKey, sKey)
        If (pPackage Is Nothing) Then
            pMessage = "need to supply new credentials - nothing in registry"
            Exit Function
        End If
    
    End If
    ' this looks up the URL for the given scope entry
    addGoogleScope (scopeEntry)
    
    ' do the auth
    If (Not hasRefreshToken) Then
'        " first step is to either get user consent and get a new token
        getUserConsent
'        " now get an access token
        Set googleAuth = getToken
    
    ElseIf (isExpired) Then
'        " or to refresh an old one
        Set googleAuth = getToken("refresh_token")
        
    Else
    
'        " or we are already good
        Set googleAuth = Me
    End If
    
'    " update registry package
    setRegistryPackage
    

End Function
'" do we have a token
Public Property Get hasToken() As Boolean
    hasToken = token <> ""
End Property
' the auth header
Public Property Get authHeader() As String
    If hasToken Then authHeader = tokenType & " " & token
End Property
'" the token
Public Property Get token() As String
    token = getItemValue("parameters.access_token")
End Property
'" the denied error
Public Property Get denied() As String
    denied = getItemValue("parameters.deniedCode") & pMessage
End Property
Private Function revoke() As cOauth2
    With pPackage.child("parameters")
        .add "access_token", vbNullString
        .add "refresh_token", vbNullString
        .add "code", vbNullString
    End With
    Set revoke = Me
End Function
'" the first phase - get user consent to proceed
Private Function getUserConsent() As cOauth2

    If pCb Is Nothing Then
        Set pCb = New cBrowser
    End If
    Dim phase As String
    phase = "userConsent"
    
    With pCb
        .init().Navigate _
            createUrl(phase) & "?" & generatePhaseParameters(phase), True
'        " store results
        With pPackage.child("parameters")
            .add "code", pCb.successCode
            .add "deniedCode", pCb.deniedCode
        End With
    End With
    
    Set getUserConsent = Me
End Function

'" if we got user consent, then we can go ahead and get an access token
Private Function getToken(Optional phase As String = "authorization_code") As cOauth2

    Dim job As cJobject, joc As cJobject

    If isAuthenticated Then
        If pCb Is Nothing Then
            Set pCb = New cBrowser
        End If
        
        pPackage.child("parameters").add "grant_type", phase
        pCb.httpPost createUrl(phase), generatePhaseParameters(phase)
        With pPackage.child("parameters")
            If (pCb.status <> 200) Then
                revoke
                .add "deniedCode", pCb.status

            Else
                Set job = JSONParse(pCb.Text)

                For Each joc In job.children
                    .add joc.key, joc.value
                Next joc
                If hasRefreshToken Then
                    .add "expires", addSeconds(Now(), expiresIn)
                End If

            End If
        End With
    End If
    Set getToken = Me
    
End Function
Private Function addSeconds(d As Date, n As Long) As Date
    addSeconds = DateAdd("s", n, d)
End Function
'" - none of these need to be exposed --
'" do we have user consent
Private Property Get isAuthenticated() As Boolean
    isAuthenticated = code <> ""
End Property

Private Property Get tokenType() As String
    tokenType = getItemValue("parameters.token_type")
End Property
Private Property Get expiresIn() As Long
    expiresIn = getItemValue("parameters.expires_in")
End Property
Private Property Get expires() As Date
    expires = getItemValue("parameters.expires")
End Property
'" the user consent
Private Property Get code() As String
    code = getItemValue("parameters.code")
End Property
Private Property Get hasRefreshToken() As Boolean
    hasRefreshToken = refreshToken <> vbNullString
End Property
Private Property Get isExpired() As Boolean
    isExpired = addSeconds(Now(), 660) > expires
    
End Property

'" the refresh token
Private Property Get refreshToken() As String
    refreshToken = getItemValue("parameters.refresh_token")
End Property
Private Function getItemValue(key As String) As String
    On Error GoTo crapped
        If Not pPackage Is Nothing Then
            getItemValue = pPackage.child(key).toString
        Else
            getItemValue = vbNullString
        End If
        Exit Function
crapped:
    getItemValue = vbNullString
End Function
Private Function createUrl(parameterType As String) As String
    createUrl = getItemValue("parameters." & pDialog.child(parameterType).toString("url"))
End Function

Private Function generatePhaseParameters(whichPhase As String) As String
    Dim joc As cJobject, s As cStringChunker
'    " this will construct a parameterstring for everything needed for an authentication phase
    Set s = New cStringChunker
    With pDialog.child(whichPhase).child("parameters")
       For Each joc In .children
           With pPackage.child("parameters").child(joc.value)
               If (.toString <> vbNullString) Then
                   s.add(.key).add("=").add(.toString).add ("&")
               End If
           End With
       Next joc
    End With
    generatePhaseParameters = s.chopIf("&").content
    Set s = Nothing
End Function

'" release up memory - should be called when done
Public Function teardown() As cOauth2
    If (Not pPackage Is Nothing) Then
        pPackage.teardown
        Set pPackage = Nothing
    End If
    If (Not pDialog Is Nothing) Then
        pDialog.teardown
        Set pDialog = Nothing
    End If
    If (Not pCb Is Nothing) Then
        pCb.teardown
        Set pCb = Nothing
    End If
    Set teardown = Me
End Function

'"---- encryption ----
Public Property Let salt(p As String)
'    " you can change the encrypt salt if necessary
    pSalt = p
End Property
Private Function encrypt(s As String) As String
'    " uses capicom
    encrypt = encryptMessage(s, pSalt)
End Function
Private Function decrypt(s As String) As String
'    " uses capicom
    decrypt = decryptMessage(s, pSalt)
End Function
'" ---- registry -----
'" in registry entries, the values are encrypted useing the salt
'" the structure is
'" xLiberation/googleAuth/scope - json pPackage values
Private Function getRegistryPackage(authFlavor As String, scopeEntry As String) As cJobject
    Dim s As String
    s = GetSetting("xLiberation", _
            authFlavor, _
            scopeEntry)
    
    If (s <> vbNullString) Then Set getRegistryPackage = JSONParse(decrypt(s))
End Function
Private Function setRegistryPackage() As cJobject
    Dim s As String
    s = JSONStringify(pPackage)
    SaveSetting "xLiberation", _
            getItemValue("parameters.authFlavor"), _
            getItemValue("parameters.scopeEntry"), _
            encrypt(s)
            
End Function
Private Function describeDialog() As cJobject
    Set describeDialog = JSONParse( _
    "{'userConsent':" & _
        "{'url':'url','parameters':" & _
            "['response_type','token_uri','redirect_uri','client_id','scope']}," & _
    "'authorization_code':{'url':'token_uri','parameters':['code','client_id'," & _
    "'client_secret','redirect_uri','grant_type']}," & _
    "'refresh_token':{'url':'refresh_uri','parameters'" & _
    ":['refresh_token','client_id','client_secret','grant_type']}}")
     
End Function
'" this is the package describing google oauth2
Private Function googlePackage(Optional consolePackage As cJobject = Nothing) As cJobject
    Dim job As cJobject, package As cJobject, p As cJobject, c As cJobject

    ' use data provided or create an empty one
    If consolePackage Is Nothing Then
        Set job = makeBasicGoogleConsole()
    Else
        Set job = consolePackage
    End If
    
    Set package = skeletonPackage
    Set c = job.child("installed")
    Set p = package.child("parameters")
    
    addFromOther c, p, "url", "auth_uri"
    addFromOther c, p, "token_uri"
    p.add "response_type", "code"
    p.add "redirect_uri", c.child("redirect_uris.1").value
    addFromOther c, p, "client_id"
    addFromOther c, p, "client_secret"
    addFromOther c, p, "refresh_uri", "token_uri"
    p.add "grant_type", "authorization_code"

    
    Set googlePackage = package
    If (consolePackage Is Nothing) Then job.teardown
    
End Function
Private Sub addFromOther(c As cJobject, p As cJobject, k As String, Optional ok As String = vbNullString)
    If ok = vbNullString Then ok = k
    With p
        If Not c.childExists(ok) Is Nothing Then
            .add k, c.child(ok).value
        Else
            .add k
        End If
    End With
End Sub
Public Function addGoogleScope(s As String) As cOauth2
    

    With pPackage.child("parameters")
        Select Case s
            Case "analytics"
                .add "scope", URLEncode("https://www.googleapis.com/auth/analytics.readonly")
            
            Case "drive"
                .add "scope", URLEncode("https://www.googleapis.com/auth/drive")
                
            Case "feeds"
                .add "scope", URLEncode("https://spreadsheets.google.com/feeds")
                
            Case "viz"
                .add "scope", URLEncode("https://spreadsheets.google.com/feeds") + "+" & _
                     URLEncode("https://www.googleapis.com/auth/drive")
            
            Case "urlshortener"
                .add "scope", URLEncode("https://www.googleapis.com/auth/urlshortener")
                
                
            Case default
                Debug.Assert False
        End Select
    End With
    Set addGoogleScope = Me
End Function

Private Function makeBasicGoogleConsole() As cJobject
    Dim consoleJSON As String
'    " when you register your app with google, you can download the Json
    
    consoleJSON = _
"{'installed':{'auth_uri':'https://accounts.google.com/o/oauth2/auth'," & _
  "'token_uri':'https://accounts.google.com/o/oauth2/token'," & _
  "'redirect_uris':['urn:ietf:wg:oauth:2.0:oob','oob']," & _
  "'auth_provider_x509_cert_url':'https://www.googleapis.com/oauth2/v1/certs'}}"

'  " then parse it
  Set makeBasicGoogleConsole = JSONParse(consoleJSON)
End Function
Public Function skeletonPackage() As cJobject
    Dim package As cJobject
    Set package = New cJobject
    With package.init(Nothing)
        With .add("parameters")
            .add "url"
            .add "token_uri"
            .add "response_type"
            .add "redirect_uri"
            .add "client_id"
            .add "code"
            .add "client_secret"
            .add "refresh_uri"
            .add "grant_type"
            .add "scope"
            .add "authFlavor"
            .add "scopeEntry"
            .add "deniedCode"
        End With
    End With
    Set skeletonPackage = package
End Function


Private Sub Class_Initialize()
    Set pDialog = describeDialog
    pSalt = "xLiberation"
End Sub

oAuthExamples.vba

'gistThat@mcpher.com :do not modify this line - see ramblings.mcpher.com for details: updated on 8/9/2014 3:09:55 PM : from manifest:5055578 gist https://gist.github.com/brucemcpherson/6937174/raw/oauthExamples.vba
Option Explicit
' oauth examples
' v1.2
' convienience function for auth..
Public Function getGoogled(scope As String, _
                                Optional replacementpackage As cJobject = Nothing, _
                                Optional clientID As String = vbNullString, _
                                Optional clientSecret As String = vbNullString, _
                                Optional complain As Boolean = True, _
                                Optional cloneFromeScope As String = vbNullString) As cOauth2
    Dim o2 As cOauth2
    Set o2 = New cOauth2
    With o2.googleAuth(scope, replacementpackage, clientID, clientSecret, complain, cloneFromeScope)
        If Not .hasToken And complain Then
            MsgBox ("Failed to authorize to google for scope " & scope & ":denied code " & o2.denied)
        End If
    End With
    
    Set getGoogled = o2
End Function
Private Sub testOauth2()
    Dim myConsole As cJobject
    ' if you are calling for the first time ever you can either provide your
    ' clientid/clientsecret - or pass the the jsonparse retrieved from the google app console
    ' normally all this stuff comes from encrpted registry store
    
    ' first ever
    'Set myConsole = makeMyGoogleConsole
    'With getGoogled("analytics", myConsole)
    '    Debug.Print .authHeader
   '     .tearDown
   ' End With

    'or you can do first ever like this
    'With getGoogled("viz", , "xxxxx.apps.googleusercontent.com", "xxxxx")
    '    Debug.Print .authHeader
    '    .tearDown
    'End With
    
    ' all other times this is what is needed
    With getGoogled("drive")
        Debug.Print .authHeader

        .teardown
    End With
    ' lets auth and have a look at the contents
    'Debug.Print objectStringify(getGoogled("drive"))
    
    ' all other times this is what is needed
    With getGoogled("analytics")
        Debug.Print .authHeader
        .teardown
    End With
    
    ' here's an example of cloning credentials from a different scope for 1st time in
    With getGoogled("urlshortener", , , , , "drive")
        Debug.Print .authHeader
        .teardown
    End With
    
    With getGoogled("urlshortener")
        Debug.Print .authHeader
        .teardown
    End With
    
    ' if you made one, clean it up
    If Not myConsole Is Nothing Then
        myConsole.teardown
    End If
End Sub

Private Function makeMyGoogleConsole() As cJobject
    Dim consoleJSON As String
 
     consoleJSON = _
    "{'installed':{'auth_uri':'https://accounts.google.com/o/oauth2/auth'," & _
      "'client_secret':'xxxxxxxx'," & _
      "'token_uri':'https://accounts.google.com/o/oauth2/token'," & _
      "'client_email':'','redirect_uris':['urn:ietf:wg:oauth:2.0:oob','oob']," & _
      "'client_x509_cert_url':'','client_id':'xxxxxxx.apps.googleusercontent.com'," & _
      "'auth_provider_x509_cert_url':'https://www.googleapis.com/oauth2/v1/certs'}}"
      
      Set makeMyGoogleConsole = JSONParse(consoleJSON)

End Function
   
Private Sub showLinkedinConsole()
    Dim url As String, cb As cBrowser
    Set cb = New cBrowser
    
    ' see http://excelramblings.blogspot.co.uk/2012/10/somewhere-to-keep-those-api-keys-google.html
    ' for how to store credentials in a google lockbox
    url = "https://script.google.com/a/macros/mcpher.com/s/" & _
    "AKfycbza96-Mpa47jlqXoPosk64bUfR8T7zO5POZMYyN45InrvX8gm28/exec" & _
    "?action=show&entry=linkedinauth"
    
    With getGoogled("drive")
        If .hasToken Then
            Debug.Print cb.httpGET(url, , , , , .authHeader)
        Else
            MsgBox ("failed to authenticate: " & .denied)
        End If
        .teardown
    End With

    cb.teardown
    
End Sub
' db abstraction tests
Private Function every(a As Variant) As Boolean
    Dim i As Long, good As Boolean
    If (IsArray(a)) Then
        For i = LBound(a) To UBound(a)
            If (Not a(i)) Then
                good = False
                Exit For
            End If
            good = True
        Next i
    Else
        good = a
    End If
    every = good
End Function
Private Function assert(what As Variant, message As cJobject, n As String) As Boolean

    Dim fatal As Boolean, m As String, good As Boolean
    fatal = True
    good = every(what)
    m = "assertion:" & n
    If (Not good) Then
        m = m & ":failed:" & message.stringify
        If fatal Then
            Debug.Print m
            Debug.Assert good
        End If
    End If
    assert = good
    Debug.Print m
End Function
Private Function setUpTest(dbtype As String, siloid As String, dbid As String) As cDbAb
    ' get authorized - using drive scope
    Dim oauth2 As cOauth2, handler As cDbAb
    Dim ds As cDataSet, testData As cJobject
        
    Set oauth2 = getGoogled("drive")
    
    ' set up handler & set end point
    Set oauth2 = getGoogled("drive")
    Set handler = New cDbAb
    With handler.setOauth2(oauth2)
        .setEndPoint ("https://script.google.com/macros/s/AKfycbyfapkJpd4UOhiqLOJOGBb11nG4BTru_Bw8bZQ49eQSTfL2vbU/exec")
        .setDbId ("13ccFPXI0L8-ZViHlv8qoVspotUcnX8v0ZFeY4nUP574")
        .setNoCache (1)
        .setDbId (dbid)
        .setSiloId (siloid)
        .setDbName dbtype
        
    End With
    Set setUpTest = handler

End Function
Public Function testDbAb()

    ' get authorized - using drive scope
    Dim handler As cDbAb
    Dim ds As cDataSet, testData As cJobject, result As cDbAbResult, testSheet As String

    'get testdata from a google sheet & write it to an excel sheet
    testSheet = "dbab"
    Set handler = setUpTest("sheet", "customers", "13ccFPXI0L8-ZViHlv8qoVspotUcnX8v0ZFeY4nUP574")
    Set result = handler.query()
    assert result.handleCode >= 0, result.response, "getting testData from google sheet"
    Set ds = makeSheetFromJob(result.data, testSheet)
    Set testData = ds.jObject(, , , , "data")

    ' set up handler & set end point
    Set handler = setUpTest("datastore", ds.name, "xliberationdatastore")
    lotsoftests handler, testData
    handler.teardown
    
    Set handler = setUpTest("mongolab", ds.name, "xliberation")
    lotsoftests handler, testData
    handler.teardown
    
    Set handler = setUpTest("parse", ds.name, "xliberation")
    lotsoftests handler, testData
    handler.teardown
    
    Set handler = setUpTest("drive", ds.name, "/datahandler/driverdrive")
    lotsoftests handler, testData
    handler.teardown
    
    Set handler = setUpTest("sheet", ds.name, "13ccFPXI0L8-ZViHlv8qoVspotUcnX8v0ZFeY4nUP574")
    lotsoftests handler, testData
    handler.teardown
    

    ds.teardown
End Function

Private Sub lotsoftests(handler As cDbAb, testData As cJobject)
   ' remove from last time
    Dim result As cDbAbResult, r2 As cDbAbResult
    Dim x As Long, job As cJobject
    Set result = handler.remove()
    
    Debug.Print "Starting " & handler.getDbName
    assert result.handleCode >= 0, result.response, "removing initial"
    
    ' save the new data
    Set result = handler.save(testData)
    assert result.handleCode >= 0, result.response, "saving initial"
    
    ' query and make sure it matches what was saved
    Set result = handler.query()
    assert Array(result.handleCode >= 0, result.count = testData.children.count), _
            result.response, "querying initial"
    
    '--------query everything with limit
    Set result = handler.query(, "{'limit':2}")
    assert Array(result.handleCode >= 0, result.count = 2), _
            result.response, "limit test(" & result.count & ")"
            
    '------Sort Reverse
    Set result = handler.query(, "{'sort':'-name'}")
    assert Array(result.handleCode >= 0, result.count = testData.children.count), _
            result.response, "querysort(" & result.count & ")"
 
    '------Sort Reverse/skip
    Set result = handler.query(, "{'sort':'-name','skip':3}")
    assert Array(result.handleCode >= 0, result.count = testData.children.count - 3), _
            result.response, "querysort+skip(" & result.count & ")"
            
    '------query simple nosql
    Set result = handler.query("{'name':'ethel'}")
    x = 0
    For Each job In testData.children
        x = x + -1 * CLng(job.child("name").value = "ethel")
    Next job
    assert Array(result.handleCode >= 0, result.count = x), _
            result.response, "filterdot0(" & result.count & ")"

    '------query multi level
    Set result = handler.query("{'stuff':{'sex':'female'}}")
    x = 0
    For Each job In testData.children
        x = x + -1 * CLng(job.child("stuff.sex").value = "female")
    Next job
    assert Array(result.handleCode >= 0, result.count = x), _
            result.response, "filter(" & result.count & ")"
            
     '------queries in
    Set result = handler.query("{'name':" & _
        handler.constraints("[['IN',['ethel','fred']]]") & "}", , True)
    x = 0
    For Each job In testData.children
        x = x + -1 * (job.toString("name") = "ethel" Or job.toString("name") = "fred")
    Next job
    assert Array(result.handleCode >= 0, result.count = x), _
            result.response, "filterdotc4 (" & result.count & ")"
                  
            
    '------first complex constraints
    Set result = handler.query("{'stuff.age':" & _
        handler.constraints("[['GT',25],['LTE',60]]") & "}")
    ' checking results kind of long winded in vba
    x = 0
    For Each job In testData.children
        x = x + -1 * CLng(job.child("stuff.age").value > 25 And job.child("stuff.age").value <= 60)
    Next job
    assert Array(result.handleCode >= 0, result.count = x), _
            result.response, "querying initial complex(" & result.count & ")"


    '------query single constraint
    Set result = handler.query("{'stuff':{'age':" & _
        handler.constraints("[['GT',25]]") & "}}")
    x = 0
    For Each job In testData.children
        x = x + -1 * CDbl(job.child("stuff.age").value > 25)
    Next job
    assert Array(result.handleCode >= 0, result.count = x), _
           result.response, "filterdotc1 (" & result.count & ")"

  '------2 queries same constraint
    Set result = handler.query("{'stuff':{'age':" & _
        handler.constraints("[['GT',25],['LT',60]]") & "}}")
    x = 0
    For Each job In testData.children
        x = x + -1 * CDbl(job.child("stuff.age").value > 25 And job.child("stuff.age").value < 60)
    Next job
    assert Array(result.handleCode >= 0, result.count = x), _
            result.response, "filterdotc2 (" & result.count & ")"

  '------2 queries same constraint
    Set result = handler.query("{'stuff':{'sex':'male', 'age':" & _
        handler.constraints("[['GTE',25],['LT',60]]") & "}}", , True)
    x = 0
    For Each job In testData.children
        x = x + -1 * (job.child("stuff.age").value >= 25 And job.child("stuff.age").value < 60 _
            And job.child("stuff.sex").value = "male")
    Next job
    assert Array(result.handleCode >= 0, result.count = x), _
            result.response, "filterdotc3 (" & result.count & ")"

  '------queries in +
    Set result = handler.query( _
        "{'name':" & handler.constraints("[['IN',['john','mary']]]") & _
        ",'stuff.sex':'male','stuff.age':" & handler.constraints("[['GT',25]]") & "}")
    x = 0
    For Each job In testData.children
        x = x + -1 * (job.child("stuff.sex").value = "male" And job.child("stuff.age").value > 25 And _
            (job.toString("name") = "john" Or job.toString("name") = "mary"))
    Next job
    assert Array(result.handleCode >= 0, result.count = x), _
            result.response, "filterdotc5 (" & result.count & "/" & x & ")"
            
    '------query single constraint, get keys
    Set result = handler.query( _
        "{'stuff.age':" & handler.constraints("[['GT',25]]") & "}", _
        "{'limit':1}", , True)
    x = 1
    assert Array(result.handleCode >= 0, result.handleKeys.children.count = 1), _
            result.response, "limitkeycheck1 (" & result.count & ")"

    '-------testing Get -- known as getobjects because get is reserved in vba
    Set r2 = handler.getObjects(result.handleKeys)
    x = 0
    For Each job In r2.data.children
        x = x + -1 * CDbl(job.child("stuff.age").value > 25)
    Next job
    assert Array(r2.handleCode >= 0, r2.count = 1, x = r2.count), _
            result.response, "get1 (" & r2.count & ")"
            
    '------retest constraint
    Set result = handler.query("{'stuff':{'age':" & _
        handler.constraints("[['GT',60]]") & "}}")
    x = 0
    For Each job In testData.children
        x = x + -1 * CDbl(job.child("stuff.age").value > 60)
    Next job
    assert Array(result.handleCode >= 0, result.count = x), _
           result.response, "repeat test easy (" & result.count & ")"
           
    '------get ready for update test
    Set result = handler.query("{'stuff.sex':'male'}", , 1, 1)
    x = 0
    For Each job In testData.children
        x = x + -1 * CDbl(job.child("stuff.sex").value = "male")
    Next job
    assert Array(result.handleCode >= 0, result.handleKeys.children.count = x), _
           result.response, "does male work(" & result.count & ")"
   
    '----- do the update
    'first update the data with a new field
    For Each job In result.data.children
        job.add "stuff.man", job.child("stuff.sex").value = "male"
    Next job
    ' now update it
    Set r2 = handler.update(result.handleKeys, result.data)
    assert Array(r2.handleCode = 0), _
           r2.response, "update 2 (" & r2.count & ")"
           
  '------check previous query still works
    Set result = handler.query( _
        "{'name':" & handler.constraints("[['IN',['john','mary']]]") & _
        ",'stuff.sex':'male','stuff.age':" & handler.constraints("[['GT',25]]") & "}")
    x = 0
    For Each job In testData.children
        x = x + -1 * (job.child("stuff.sex").value = "male" And job.child("stuff.age").value > 25 And _
            (job.toString("name") = "john" Or job.toString("name") = "mary"))
    Next job
    assert Array(result.handleCode >= 0, result.count = x), _
            result.response, "repeat test after update (" & result.count & "/" & x & ")"
            
    ' query again and make sure it matches what was saved
    Set result = handler.query()
    assert Array(result.handleCode >= 0, result.count = testData.children.count), _
            result.response, "repeat querying initial"
         
    ' try counting
    Set result = handler.count()
    assert Array(result.handleCode >= 0, result.count = testData.children.count), _
            result.response, "count 1"
            
    ' try complicated counting
    Set result = handler.count( _
        "{'name':" & handler.constraints("[['IN',['john','mary']]]") & _
        ",'stuff.sex':'male','stuff.age':" & handler.constraints("[['GT',25]]") & "}")
    x = 0
    For Each job In testData.children
        x = x + -1 * (job.child("stuff.sex").value = "male" And job.child("stuff.age").value > 25 And _
            (job.toString("name") = "john" Or job.toString("name") = "mary"))
    Next job
    assert Array(result.handleCode >= 0, result.count = x), _
            result.response, "complex counting (" & result.count & "/" & x & ")"
   
    
    '--------------some more
    Set result = handler.query( _
        "{ 'stuff.sex':'male','stuff.age':" & handler.constraints("[['GT',59]]") & "}")
    x = 0
    For Each job In testData.children
        x = x + -1 * (job.child("stuff.sex").value = "male" And job.child("stuff.age").value >= 60)
    Next job
    assert Array(result.handleCode >= 0, result.count = x), _
            result.response, "normal 0 (" & result.count & "/" & x & ")"
            
 
    
    '--------------make sure we're getting the right id with complex constaints
    Set result = handler.query( _
        "{'stuff.age':" & handler.constraints("[['GT',25],['LTE',60]]") & "}")
    x = 0
    For Each job In testData.children
        x = x + -1 * (job.child("stuff.age").value > 25 And job.child("stuff.age").value <= 60)
    Next job
    assert Array(result.handleCode >= 0, result.count = x), _
            result.response, "repeat test constraint (" & result.count & "/" & x & ")"
            
    '--------------try OR
    Set result = handler.query( _
        "[{'stuff.age':" & handler.constraints("[['LT',26]]") & ",'stuff.sex':'male'}," & _
         "{'stuff.age':" & handler.constraints("[['GTE',60]]") & ",'stuff.sex':'male'}]")
    x = 0
    For Each job In testData.children
        x = x + -1 * (job.child("stuff.sex").value = "male" And (job.child("stuff.age").value < 26 Or job.child("stuff.age").value >= 60))
    Next job
    assert Array(result.handleCode >= 0, result.count = x), _
            result.response, "OR 1 (" & result.count & "/" & x & ")"
            
            
    '------------show all the males
    Set r2 = handler.query("{'stuff.sex':'male'}", , 1, 1)
    x = 0
    For Each job In testData.children
        x = x + -1 * CDbl(job.child("stuff.sex").value = "male")
    Next job
    assert Array(r2.handleCode >= 0, r2.handleKeys.children.count = x), _
           r2.response, "show the males(" & r2.count & ")"

  '------------remove all the males
    Set result = handler.remove("{'stuff.sex':'male'}")
    assert Array(result.handleCode >= 0), _
           result.response, "remove the males(" & result.count & ")"
           
   '-----------make sure they are gone
    Set result = handler.query()
    x = 0
    For Each job In testData.children
        x = x + -1 * CDbl(job.child("stuff.sex").value <> "male")
    Next job
    assert Array(result.handleCode >= 0, result.handleKeys.children.count = x), _
           result.response, "check after delete males(" & result.count & ")"

   '-----------add them back in
    Set result = handler.save(r2.data)
    assert Array(result.handleCode >= 0), _
           result.response, "add them back(" & result.count & ")"
           
    '--------check they got added
    Set result = handler.query("{'stuff.man':true}")
    x = 0
    For Each job In testData.children
        x = x + -1 * CDbl(job.child("stuff.sex").value = "male")
    Next job
    assert Array(result.handleCode >= 0, result.handleKeys.children.count = x), _
           result.response, "check after adding them back(" & result.count & ")"
    
    '-------sort and save
    Set result = handler.query(, "{'sort':'-serial'}")
    assert Array(result.handleCode >= 0, result.count = testData.children.count), _
            result.response, "sorting serial"
           
    '----- mark as good and save
    For Each job In result.data.children
        job.add "good", True
    Next job
    Set r2 = handler.save(result.data)
    assert Array(r2.handleCode >= 0), _
            r2.response, "adding goods"

    '-------check we have twice th records
    Set result = handler.count()
    assert Array(result.handleCode >= 0, result.count = testData.children.count * 2), _
            result.response, "doubled data"
            
    '------delete the ones we added
    Set result = handler.remove("{'good':true}")
    assert Array(result.handleCode >= 0), _
            result.response, "doubled data"

    '------check original length
    Set result = handler.count()
    assert Array(result.handleCode >= 0, result.count = testData.children.count), _
            result.response, "check final count"
            
    Debug.Print "Finished " & handler.getDbName
End Sub