Secure ADODB: Unit of Work

Question

I've been meaning to revisit this old code for a long time, and this week finally ended up doing it. The resulting code is on GitHub, and for full context and disclosure I wrote a blog article about this exercise in OOP design.

The idea is to abstract away the pain of making secure ADODB queries. This immediate pane command:

?UnitOfWork.FromConnectionString("connection string").Command.GetSingleValue("SELECT Field1 FROM Table1 WHERE Id=?", 1)

Produces this debug output:

Begin connect...
Connect completed. Status: 1
Begin transaction completed. 
Begin execute...
Execute completed, -1 record(s) affected.
{whatever value was in Field1}
Rollback transaction completed.
Disconnect completed. Status: 1

The 1 is being passed to the command as a proper ADODB.Parameter. I've already identified the need for an IDbParameter abstraction, but does anything else stand out?

Note: this post only covers the "unit of work" bits. See GitHub repository for additional context and the source code for the other types involved.

---

IUnitOfWork

From the calling code's perspective, the top-level API object is the unit of work - the IUnitOfWork class formalizes its interface:

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "IUnitOfWork"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Attribute VB_Description = "Represents an object encapsulating a database transaction."
'@Folder("SecureADODB.UnitOfWork")
'@ModuleDescription("Represents an object encapsulating a database transaction.")
'@Interface
'@Exposed
Option Explicit

'@Description("Commits the transaction.")
Public Sub Commit()
Attribute Commit.VB_Description = "Commits the transaction."
End Sub

'@Description("Rolls back the transaction.")
Public Sub Rollback()
Attribute Rollback.VB_Description = "Rolls back the transaction."
End Sub

'@Description("Creates a new command to execute as part of the transaction.")
'@Ignore ShadowedDeclaration: false positive here, this is an abstract @Interface class
Public Function Command() As IDbCommand
Attribute Command.VB_Description = "Creates a new command to execute as part of the transaction."
End Function

UnitOfWork

The UnitOfWork class implements it - there are two factory methods; Create takes in all dependencies (tests use that), and FromConnectionString wires up convenient defaults for the user code to consume for the most common scenarios:

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "UnitOfWork"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = True
Attribute VB_Description = "An object that encapsulates a database transaction."
'@Folder("SecureADODB.UnitOfWork")
'@ModuleDescription("An object that encapsulates a database transaction.")
'@PredeclaredId
'@Exposed
Option Explicit
Implements IUnitOfWork
Private Type TUnitOfWork
    Committed As Boolean
    RolledBack As Boolean
    Connection As IDbConnection
    CommandFactory As IDbCommandFactory
End Type
Private this As TUnitOfWork

'@Description("Creates a new unit of work using default configurations.")
'@Ignore ProcedureNotUsed
Public Function FromConnectionString(ByVal connString As String) As IUnitOfWork
Attribute FromConnectionString.VB_Description = "Creates a new unit of work using default configurations."

    Dim db As IDbConnection
    Set db = DbConnection.Create(connString)

    Dim provider As IParameterProvider
    Set provider = AdoParameterProvider.Create(AdoTypeMappings.Default)

    Dim baseCommand As IDbCommandBase
    Set baseCommand = DbCommandBase.Create(provider)

    Dim factory As IDbCommandFactory
    Set factory = DefaultDbCommandFactory.Create(baseCommand)

    Set FromConnectionString = UnitOfWork.Create(db, factory)

End Function

'@Inject: just an idea.. see #https://github.com/rubberduck-vba/Rubberduck/issues/5463
Public Function Create(ByVal db As IDbConnection, ByVal factory As IDbCommandFactory) As IUnitOfWork
    Errors.GuardNonDefaultInstance Me, UnitOfWork
    Errors.GuardNullReference factory
    Errors.GuardNullReference db
    Errors.GuardExpression db.State <> adStateOpen, message:="Connection should be open."

    Dim result As UnitOfWork
    Set result = New UnitOfWork
    Set result.CommandFactory = factory
    Set result.Connection = db

    Set Create = result
End Function

'@Inject: this member should only be invoked by Me.Create, where Me is the class' default/predeclared instance.
'@Ignore ProcedureNotUsed: false positive with v2.5.0.5418
Friend Property Set Connection(ByVal value As IDbConnection)
    Errors.GuardDoubleInitialization this.Connection
    Errors.GuardNullReference value
    Set this.Connection = value
    this.Connection.BeginTransaction
End Property

'@Inject: this member should only be invoked by Me.Create, where Me is the class' default/predeclared instance.
'@Ignore ProcedureNotUsed: false positive with v2.5.0.5418
Friend Property Set CommandFactory(ByVal value As IDbCommandFactory)
    Errors.GuardDoubleInitialization this.CommandFactory
    Errors.GuardNullReference value
    Set this.CommandFactory = value
End Property

Private Sub Class_Terminate()
    On Error Resume Next
    If Not this.Committed Then this.Connection.RollbackTransaction
    On Error GoTo 0
End Sub

Private Sub IUnitOfWork_Commit()
    Errors.GuardExpression this.Committed, message:="Transaction is already committed."
    Errors.GuardExpression this.RolledBack, message:="Transaction was rolled back."
    On Error Resume Next ' not all providers support transactions
    this.Connection.CommitTransaction
    this.Committed = True
    On Error GoTo 0
End Sub

Private Function IUnitOfWork_Command() As IDbCommand
    Set IUnitOfWork_Command = this.CommandFactory.Create(this.Connection)
End Function

Private Sub IUnitOfWork_Rollback()
    Errors.GuardExpression this.Committed, message:="Transaction is already committed."
    On Error Resume Next ' not all providers support transactions
    this.Connection.RollbackTransaction
    this.RolledBack = True
    On Error GoTo 0
End Sub

UnitOfWorkTests

These are all the Rubberduck unit tests that have the UnitOfWork class as their SUT:

Attribute VB_Name = "UnitOfWorkTests"
'@TestModule
'@Folder("Tests")
'@IgnoreModule
Option Explicit
Option Private Module

Private Const ExpectedError As Long = SecureADODBCustomError

#Const LateBind = LateBindTests

#If LateBind Then
    Private Assert As Object
#Else
    Private Assert As Rubberduck.PermissiveAssertClass
#End If

'@ModuleInitialize
Private Sub ModuleInitialize()
    #If LateBind Then
        Set Assert = CreateObject("Rubberduck.PermissiveAssertClass")
    #Else
        Set Assert = New Rubberduck.PermissiveAssertClass
    #End If
End Sub

'@ModuleCleanup
Private Sub ModuleCleanup()
    Set Assert = Nothing
End Sub

'@TestMethod("Factory Guard")
Private Sub Create_ThrowsIfNotInvokedFromDefaultInstance()
    On Error GoTo TestFail

    With New UnitOfWork
        On Error GoTo CleanFail
        Dim sut As IUnitOfWork
        Set sut = .Create(New StubDbConnection, New StubDbCommandFactory)
        On Error GoTo 0
    End With

CleanFail:
    If Err.Number = ExpectedError Then Exit Sub
TestFail:
    Assert.Fail "Expected error was not raised."
End Sub

'@TestMethod("Factory Guard")
Private Sub Create_ThrowsGivenNullConnection()

    On Error GoTo CleanFail
    Dim sut As IUnitOfWork
    Set sut = UnitOfWork.Create(Nothing, New StubDbCommandFactory)
    On Error GoTo 0

CleanFail:
    If Err.Number = ExpectedError Then Exit Sub
TestFail:
    Assert.Fail "Expected error was not raised."
End Sub

'@TestMethod("Factory Guard")
Private Sub Create_ThrowsGivenConnectionStateNotOpen()
    On Error GoTo TestFail
    Dim db As StubDbConnection
    Set db = New StubDbConnection
    db.State = adStateClosed

    On Error GoTo CleanFail
    Dim sut As IUnitOfWork
    Set sut = UnitOfWork.Create(db, New StubDbCommandFactory)
    On Error GoTo 0

CleanFail:
    If Err.Number = ExpectedError Then Exit Sub
TestFail:
    Assert.Fail "Expected error was not raised."
End Sub

'@TestMethod("Factory Guard")
Private Sub Create_ThrowsGivenNullCommandFactory()

    On Error GoTo CleanFail
    Dim sut As IUnitOfWork
    Set sut = UnitOfWork.Create(New StubDbConnection, Nothing)
    On Error GoTo 0

CleanFail:
    If Err.Number = ExpectedError Then Exit Sub
TestFail:
    Assert.Fail "Expected error was not raised."
End Sub

'@TestMethod("Guard Clauses")
Private Sub CommandFactory_ThrowsIfAlreadySet()
    On Error GoTo TestFail

    Dim sut As UnitOfWork
    Set sut = UnitOfWork.Create(New StubDbConnection, New StubDbCommandFactory)

    On Error GoTo CleanFail
    Set sut.CommandFactory = New StubDbCommandFactory
    On Error GoTo 0

CleanFail:
    If Err.Number = ExpectedError Then Exit Sub
TestFail:
    Assert.Fail "Expected error was not raised."
End Sub

'@TestMethod("Guard Clauses")
Private Sub Connection_ThrowsIfAlreadySet()
    On Error GoTo TestFail

    Dim sut As UnitOfWork
    Set sut = UnitOfWork.Create(New StubDbConnection, New StubDbCommandFactory)

    On Error GoTo CleanFail
    Set sut.Connection = New StubDbConnection
    On Error GoTo 0

CleanFail:
    If Err.Number = ExpectedError Then Exit Sub
TestFail:
    Assert.Fail "Expected error was not raised."
End Sub

'@TestMethod("UnitOfWork")
Private Sub Command_CreatesDbCommandWithFactory()

    Dim stubCommandFactory As StubDbCommandFactory
    Set stubCommandFactory = New StubDbCommandFactory

    Dim sut As IUnitOfWork
    Set sut = UnitOfWork.Create(New StubDbConnection, stubCommandFactory)

    Dim result As IDbCommand
    Set result = sut.Command

    Assert.AreEqual 1, stubCommandFactory.CreateCommandInvokes
End Sub

'@TestMethod("UnitOfWork")
Private Sub Create_StartsTransaction()

    Dim stubConnection As StubDbConnection
    Set stubConnection = New StubDbConnection

    Dim sut As IUnitOfWork
    Set sut = UnitOfWork.Create(stubConnection, New StubDbCommandFactory)

    Assert.IsTrue stubConnection.DidBeginTransaction
End Sub

'@TestMethod("UnitOfWork")
Private Sub Commit_CommitsTransaction()

    Dim stubConnection As StubDbConnection
    Set stubConnection = New StubDbConnection

    Dim sut As IUnitOfWork
    Set sut = UnitOfWork.Create(stubConnection, New StubDbCommandFactory)

    sut.Commit

    Assert.IsTrue stubConnection.DidCommitTransaction
End Sub

'@TestMethod("UnitOfWork")
Private Sub Commit_ThrowsIfAlreadyCommitted()
    On Error GoTo TestFail

    Dim stubConnection As StubDbConnection
    Set stubConnection = New StubDbConnection

    Dim sut As IUnitOfWork
    Set sut = UnitOfWork.Create(stubConnection, New StubDbCommandFactory)

    sut.Commit
    On Error GoTo CleanFail
    sut.Commit
    On Error GoTo 0

CleanFail:
    If Err.Number = ExpectedError Then Exit Sub
TestFail:
    Assert.Fail "Expected error was not raised."
End Sub

'@TestMethod("UnitOfWork")
Private Sub Commit_ThrowsIfAlreadyRolledBack()
    On Error GoTo TestFail

    Dim stubConnection As StubDbConnection
    Set stubConnection = New StubDbConnection

    Dim sut As IUnitOfWork
    Set sut = UnitOfWork.Create(stubConnection, New StubDbCommandFactory)

    sut.Rollback
    On Error GoTo CleanFail
    sut.Commit
    On Error GoTo 0

CleanFail:
    If Err.Number = ExpectedError Then Exit Sub
TestFail:
    Assert.Fail "Expected error was not raised."
End Sub

'@TestMethod("UnitOfWork")
Private Sub Rollback_ThrowsIfAlreadyCommitted()
    On Error GoTo TestFail

    Dim stubConnection As StubDbConnection
    Set stubConnection = New StubDbConnection

    Dim sut As IUnitOfWork
    Set sut = UnitOfWork.Create(stubConnection, New StubDbCommandFactory)

    sut.Commit
    On Error GoTo CleanFail
    sut.Rollback
    On Error GoTo 0

CleanFail:
    If Err.Number = ExpectedError Then Exit Sub
TestFail:
    Assert.Fail "Expected error was not raised."
End Sub

Errors

The custom errors are raised in a standard module named Errors:

Attribute VB_Name = "Errors"
Attribute VB_Description = "Global procedures for throwing common errors."
'@Folder("SecureADODB")
'@ModuleDescription("Global procedures for throwing common errors.")
Option Explicit
Option Private Module

Public Const SecureADODBCustomError As Long = vbObjectError Or 32

'@Description("Re-raises the current error, if there is one.")
Public Sub RethrowOnError()
Attribute RethrowOnError.VB_Description = "Re-raises the current error, if there is one."
    With VBA.Information.Err
        If .Number <> 0 Then
            Debug.Print "Error " & .Number, .Description
            .Raise .Number
        End If
    End With
End Sub

'@Description("Raises a run-time error if the specified Boolean expression is True.")
Public Sub GuardExpression(ByVal throw As Boolean, _
Optional ByVal Source As String = "SecureADODB.Errors", _
Optional ByVal message As String = "Invalid procedure call or argument.")
Attribute GuardExpression.VB_Description = "Raises a run-time error if the specified Boolean expression is True."
    If throw Then VBA.Information.Err.Raise SecureADODBCustomError, Source, message
End Sub

'@Description("Raises a run-time error if the specified instance isn't the default instance.")
Public Sub GuardNonDefaultInstance(ByVal instance As Object, ByVal defaultInstance As Object, _
Optional ByVal Source As String = "SecureADODB.Errors", _
Optional ByVal message As String = "Method should be invoked from the default/predeclared instance of this class.")
Attribute GuardNonDefaultInstance.VB_Description = "Raises a run-time error if the specified instance isn't the default instance."
    Debug.Assert TypeName(instance) = TypeName(defaultInstance)
    GuardExpression Not instance Is defaultInstance, Source, message
End Sub

'@Description("Raises a run-time error if the specified object reference is already set.")
Public Sub GuardDoubleInitialization(ByVal instance As Object, _
Optional ByVal Source As String = "SecureADODB.Errors", _
Optional ByVal message As String = "Object is already initialized.")
Attribute GuardDoubleInitialization.VB_Description = "Raises a run-time error if the specified object reference is already set."
    GuardExpression Not instance Is Nothing, Source, message
End Sub

'@Description("Raises a run-time error if the specified object reference is Nothing.")
Public Sub GuardNullReference(ByVal instance As Object, _
Optional ByVal Source As String = "SecureADODB.Errors", _
Optional ByVal message As String = "Object reference cannot be Nothing.")
Attribute GuardNullReference.VB_Description = "Raises a run-time error if the specified object reference is Nothing."
    GuardExpression instance Is Nothing, Source, message
End Sub

'@Description("Raises a run-time error if the specified string is empty.")
Public Sub GuardEmptyString(ByVal value As String, _
Optional ByVal Source As String = "SecureADODB.Errors", _
Optional ByVal message As String = "String cannot be empty.")
Attribute GuardEmptyString.VB_Description = "Raises a run-time error if the specified string is empty."
    GuardExpression value = vbNullString, Source, message
End Sub

Can anything be improved? Did I forget any tests? I write in README.md that the abstraction is leaky on purpose in order to retain the full flexibility of the ADODB library, ...but I have to admit it looks pretty airtight at that level.

At the IDbConnection level though...

...Wrinkles appear. It's almost as if I needed another interface to separate the internal API from the public API!

IDbConnection

Here I'm wrapping an ADODB.Connection - I need to expose the ADODB.Connection object somehow, in order to be able to create commands off that connection.

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "IDbConnection"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Attribute VB_Description = "Represents an object that wraps an active ADODB connection."
'@Folder("SecureADODB.DbConnection.Abstract")
'@ModuleDescription("Represents an object that wraps an active ADODB connection.")
'@Exposed
'@Interface
Option Explicit

'@Description("Gets the wrapped ADODB connection.")
Public Property Get AdoConnection() As ADODB.Connection
Attribute AdoConnection.VB_Description = "Gets the wrapped ADODB connection."
End Property

'@Description("Gets the state of the wrapped ADODB connection.")
Public Property Get State() As ADODB.ObjectStateEnum
Attribute State.VB_Description = "Gets the state of the wrapped ADODB connection."
End Property

'@Description("Creates an ADODB.Command that uses the wrapped connection")
Public Function CreateCommand(ByVal commandType As ADODB.CommandTypeEnum, ByVal sql As String) As ADODB.Command
Attribute CreateCommand.VB_Description = "Creates an ADODB.Command that uses the wrapped connection"
End Function

'@Description("Returns the object itself. Useful to retrieve the With object variable in a With block.")
Public Property Get Self() As IDbConnection
Attribute Self.VB_Description = "Returns the object itself. Useful to retrieve the With object variable in a With block."
End Property

Public Sub BeginTransaction()
End Sub

Public Sub CommitTransaction()
End Sub

Public Sub RollbackTransaction()
End Sub

---

Best Practices

I've given a bit of thought about the various ways the API could be used & misused (probably something to do with the leaky abstractions!), and came up with these "best practices" usage guidelines:

• DO hold the object reference in a With block. (e.g. With New UnitOfWork.FromConnectionString(...))
• DO have an active On Error statement to graciously handle any errors.
• DO commit or rollback the transaction explicitly in the scope that owns the IUnitOfWork object.
• CONSIDER passing IDbCommand as an argument to other scopes.
• AVOID passing IUnitOfWork as a parameter to another object or procedure.
• AVOID accidentally re-entering a With block from an error-handling subroutine (i.e. avoid Resume, Resume [label], and Resume Next in these subroutines). If there was an error, execution jumped out of the With block that held the references, and the transaction was rolled back and the connection is already closed: there's nothing left to clean up.

I think that's pretty consistent with the implementation, but did I miss anything important?

Answer 1

I have been silently waiting for you to post this for a while. I was working on something nearly identical to this, and almost posted my stuff a couple of weeks ago, but I wasn't sure of how to hook the events on the connection object without housing all of the event procedures inside the UnitOfWork. That just didn't seem right to me, so I decided I would wait just a little longer in hopes that you would randomly revisit your old code, and boy am I glad I did. The object model of this API is exactly what it needs to be (much like .NET's System.Data' / 'System.Data.Common).

Saying that, there is one thing that I would to address, so, lets get into it.

The idea of a unit of work, is to encapsulate a transaction(s), i.e. track the objects affected by actions performed on the database and then commit or rollback the changes made by those actions. This means that without transactions, the UnitOfWork is virtually useless.

In both of IUnitOfWork_Commit and IUnitOfWork_Rollback, you are ignoring any errors associated with provider transaction support. This makes UnitOfWork a bit misleading, because the client code may not account for the fact that a particular provider does not support the use of transactions. If this is so, then it may full well be assumed that transaction usage is permitted, because nothing in the API indicates otherwise. Say that several updates/deletes/inserts are performed, but then, it is determined that those actions need to be rolled back...except...they can't be...and what's done is done.

I think it might be better to block, the usage of UnitOfWork by raising an error if the connection's provider does not support transactions. This would prevent client code from assuming anything, and force them to use an IDbConnection directly instead. You could implement one of your Error.GuardXxxxx methods in the UoW's contructors, FromConnectionString and Create like so:

'@Description("Raises a run-time error if the specified connection does not support usage of transactions.")
Public Sub GuardNoTransactionSupport(ByVal connection As IDbConnection, _
Optional ByVal Source As String = "SecureADODB.Errors", _
Optional ByVal message As String = "Provider does not support transactions.")
    GuardExpression Not SupportsTransactions(connection.AdoConnection), Source, message
End Sub

'Returns false If the TRANSACTION_PROPERTY_NAME does not exist in the connection's properties collection
Public Function SupportsTransactions(ByVal connection As ADODB.Connection) As Boolean

    Const TRANSACTION_PROPERTY_NAME As String = "Transaction DDL"

    On Error Resume Next 
    SupportsTransactions = connection.Properties(TRANSACTION_PROPERTY_NAME)
    On Error GoTo 0

End Function

Then FromConnectionString and Create Become:

Public Function FromConnectionString(ByVal connString As String) As IUnitOfWork

    Dim db As IDbConnection
    Set db = DbConnection.Create(connString)
    Errors.GuardNoTransactionSupport db 

    Dim provider As IParameterProvider
    Set provider = AdoParameterProvider.Create(AdoTypeMappings.Default)

    Dim baseCommand As IDbCommandBase
    Set baseCommand = DbCommandBase.Create(provider)

    Dim factory As IDbCommandFactory
    Set factory = DefaultDbCommandFactory.Create(baseCommand)

    Set FromConnectionString = UnitOfWork.Create(db, factory)

End Function

Public Function Create(ByVal db As IDbConnection, ByVal factory As IDbCommandFactory) As IUnitOfWork
    Errors.GuardNonDefaultInstance Me, UnitOfWork
    Errors.GuardNullReference factory
    Errors.GuardNullReference db
    Errors.GuardExpression db.State <> adStateOpen, message:="Connection should be open."
    Errors.GuardNoTransactionSupport db  

    Dim result As UnitOfWork
    Set result = New UnitOfWork
    Set result.CommandFactory = factory
    Set result.Connection = db

    Set Create = result
End Function

Answer 2

Comment on Transaction DDL. While Microsoft does state that its presence indicates that the backend supports transactions, there is another reference (possibly outdated) discussing DBPROP_SUPPORTEDTXNDDL enum, where DBPROPVAL_TC_NONE value of Transaction DDL indicates that transactions are not supported.

In fact, I have made a few test snippets for SecureADODB to be executed against a CSV and SQLite files via ADODB. For SQLite, Transaction DDL property is set to 8, whereas in case of CSV, which does not support transactions and throws an error if BeginTrans is attempted, Transaction DDL property is still present and is set to 0.

The proposed Guard code should still work, as SupportsTransactions would be set to 0 and still evaluate to false.

Answer 3

I have noticed this interface IDbConnection_CreateCommand, which appears to be an unnecessary coupling between DbCommandBase and DbConnection. DbCommandBase is injected with a DbConnection object:

Private Function IDbCommandBase_CreateCommand(ByVal db As IDbConnection, ByVal commandType As ADODB.CommandTypeEnum, ByVal sql As String, ByRef args() As Variant) As ADODB.Command
    Set IDbCommandBase_CreateCommand = CreateCommand(db, commandType, sql, args)
End Function

ADODB.Connection object, which is what DbCommandBase needs to complete setup of the underlying ADODB.Command object, is exposed via the IDbConnection_AdoConnection interface. So rather than using/keeping IDbConnection_CreateCommand interface called from DbCommandBase:

Private  Function  CreateCommand(ByVal db As  IDbConnection, ByVal commandType As  ADODB.CommandTypeEnum, ByVal sql As  String, ByRef args() As  Variant) As  ADODB.Command
    Errors.GuardNullReference db
    Errors.GuardEmptyString sql
    Errors.GuardExpression db.State <> adStateOpen, message:="Connection is not open."
    Errors.GuardExpression  Not  ValidateOrdinalArguments(sql, args), message:="Arguments supplied are inconsistent with the provided command string parameters."

    Dim cmd As  ADODB.Command
    Set cmd = db.CreateCommand(commandType, sql)

I would replace the last two lines with

Dim cmd As  ADODB.Command
Set cmd = New  ADODB.Command
Set cmd.ActiveConnection = db.AdoConnection
cmd.commandType = commandType
cmd.CommandText = sql

and removed IDbConnection_CreateCommand interface. Am I missing something?