MassMailer/tools/init-db.vbs

' Create the first local Access database. Refuses to overwrite an existing file.
Option Explicit

Dim fs, source, settings, dbPath, folder, catalog, db, sql, configPath
Set fs = CreateObject("Scripting.FileSystemObject")
source = fs.BuildPath(fs.GetParentFolderName(WScript.ScriptFullName), "common.vbs")
ExecuteGlobal fs.OpenTextFile(source, 1).ReadAll
If WScript.Arguments.Count > 1 Then StopWithError "Usage: init-db.vbs [config path]"
configPath = ConfigFilePath()
If WScript.Arguments.Count = 1 Then configPath = WScript.Arguments(0)

On Error Resume Next
Set settings = LoadConfig(configPath)
If Err.Number <> 0 Then StopWithError "Configuration: " & Err.Description
dbPath = ResolveDbPath(settings)
If Err.Number <> 0 Then StopWithError "Database path: " & Err.Description
On Error GoTo 0

If fs.FileExists(dbPath) Then StopWithError "Database already exists: " & dbPath
folder = fs.GetParentFolderName(dbPath)
If Not fs.FolderExists(folder) Then CreateFolders folder

On Error Resume Next
Set catalog = CreateObject("ADOX.Catalog")
catalog.Create "Provider=" & settings("DB_PROVIDER") & ";Data Source=" & dbPath & _
    ";Jet OLEDB:Engine Type=5;"
If Err.Number <> 0 Then StopWithError "Cannot create MDB with " & settings("DB_PROVIDER") & _
    " in this script host: " & Err.Description
Set catalog = Nothing
Set db = CreateObject("ADODB.Connection")
db.Open "Provider=" & settings("DB_PROVIDER") & ";Data Source=" & dbPath & ";"
If Err.Number <> 0 Then StopWithError "Cannot open new MDB: " & Err.Description
On Error GoTo 0

RunSql "CREATE TABLE [AppMeta] ([SchemaVersion] INTEGER NOT NULL, [CreatedAtUtc] DATETIME)"
RunSql "CREATE TABLE [Contact] ([Id] COUNTER CONSTRAINT [pkContact] PRIMARY KEY, " & _
    "[EmailOriginal] TEXT(254) NOT NULL, [EmailKey] TEXT(254) NOT NULL, " & _
    "[BusinessName] TEXT(200), [SourceReference] MEMO, [AcquiredAtUtc] DATETIME, " & _
    "[Country] TEXT(2), [EligibilityBasis] TEXT(100), [CreatedAtUtc] DATETIME)"
RunSql "CREATE TABLE [Suppression] ([EmailKey] TEXT(254) NOT NULL, [Reason] TEXT(40) NOT NULL, " & _
    "[RecordedAtUtc] DATETIME, [EvidenceReference] MEMO)"
RunSql "CREATE TABLE [TemplateVersion] ([Id] COUNTER CONSTRAINT [pkTemplateVersion] PRIMARY KEY, " & _
    "[TemplateName] TEXT(200) NOT NULL, [VersionNumber] INTEGER NOT NULL, " & _
    "[HtmlContent] MEMO NOT NULL, [ContentHash] TEXT(64), [ImportedAtUtc] DATETIME, " & _
    "[ValidationStatus] TEXT(30))"
RunSql "CREATE TABLE [TemplateImage] ([Id] COUNTER CONSTRAINT [pkTemplateImage] PRIMARY KEY, " & _
    "[TemplateVersionId] INTEGER NOT NULL, [OriginalRelativePath] TEXT(255) NOT NULL, " & _
    "[ContentType] TEXT(40) NOT NULL, [ContentHash] TEXT(64), " & _
    "[SnapshotBytes] LONGBINARY, [ContentId] TEXT(200))"
RunSql "CREATE TABLE [Campaign] ([Id] COUNTER CONSTRAINT [pkCampaign] PRIMARY KEY, " & _
    "[Name] TEXT(200) NOT NULL, [SenderKey] TEXT(254) NOT NULL, " & _
    "[FromSnapshot] TEXT(254), [ReplyToSnapshot] TEXT(254), " & _
    "[PostalAddressSnapshot] MEMO, [Subject] TEXT(255), [TemplateVersionId] INTEGER, " & _
    "[Status] TEXT(30) NOT NULL, [StartAtUtc] DATETIME, [ApprovedAtUtc] DATETIME)"
RunSql "CREATE TABLE [Delivery] ([Id] COUNTER CONSTRAINT [pkDelivery] PRIMARY KEY, " & _
    "[CampaignId] INTEGER NOT NULL, [ContactId] INTEGER NOT NULL, " & _
    "[EmailKey] TEXT(254) NOT NULL, [Status] TEXT(30) NOT NULL, " & _
    "[AttemptCount] INTEGER NOT NULL, [LastAttemptAtUtc] DATETIME, " & _
    "[ProviderMessageId] TEXT(200), [LastErrorCode] TEXT(100))"
RunSql "CREATE TABLE [Attempt] ([Id] COUNTER CONSTRAINT [pkAttempt] PRIMARY KEY, " & _
    "[DeliveryId] INTEGER NOT NULL, [StartedAtUtc] DATETIME, [EndedAtUtc] DATETIME, " & _
    "[Outcome] TEXT(30) NOT NULL, [ProviderRequestId] TEXT(200), [SanitizedError] MEMO)"
RunSql "CREATE TABLE [DispatchState] ([SenderKey] TEXT(254) NOT NULL, " & _
    "[LastAttemptAtUtc] DATETIME, [NextAllowedAttemptUtc] DATETIME)"
RunSql "CREATE TABLE [OperationalState] ([Id] INTEGER NOT NULL, [GlobalPause] BIT NOT NULL, " & _
    "[LastOptOutReviewAtUtc] DATETIME, [LastConfigHash] TEXT(64))"
RunSql "CREATE TABLE [ProtectedSecret] ([Id] TEXT(100) NOT NULL, [Purpose] TEXT(50) NOT NULL, " & _
    "[DpapiCiphertext] LONGBINARY, [CreatedAtUtc] DATETIME, [RotatedAtUtc] DATETIME)"
RunSql "CREATE TABLE [AuditEvent] ([Id] COUNTER CONSTRAINT [pkAuditEvent] PRIMARY KEY, " & _
    "[Actor] TEXT(100), [Action] TEXT(100) NOT NULL, [EntityId] TEXT(100), " & _
    "[TimestampUtc] DATETIME, [Detail] MEMO)"

RunSql "CREATE UNIQUE INDEX [uxContactEmail] ON [Contact] ([EmailKey])"
RunSql "CREATE UNIQUE INDEX [uxSuppressionEmail] ON [Suppression] ([EmailKey])"
RunSql "CREATE UNIQUE INDEX [uxDeliveryCampaignEmail] ON [Delivery] ([CampaignId], [EmailKey])"
RunSql "CREATE UNIQUE INDEX [uxDispatchSender] ON [DispatchState] ([SenderKey])"
RunSql "CREATE UNIQUE INDEX [uxProtectedSecretId] ON [ProtectedSecret] ([Id])"
RunSql "CREATE INDEX [ixDeliveryStatus] ON [Delivery] ([Status], [CampaignId])"
RunSql "CREATE INDEX [ixAttemptDelivery] ON [Attempt] ([DeliveryId])"
RunSql "CREATE INDEX [ixTemplateImageVersion] ON [TemplateImage] ([TemplateVersionId])"

RunSql "INSERT INTO [AppMeta] ([SchemaVersion]) VALUES (1)"
RunSql "INSERT INTO [OperationalState] ([Id], [GlobalPause]) VALUES (1, TRUE)"
db.Close
WScript.Echo "Created MDB schema version 1: " & dbPath
WScript.Quit 0

Sub RunSql(statement)
    On Error Resume Next
    db.Execute statement
    If Err.Number <> 0 Then StopWithError "Schema initialization failed: " & Err.Description & _
        vbCrLf & "Statement: " & statement
    On Error GoTo 0
End Sub

Sub CreateFolders(path)
    Dim parent
    parent = fs.GetParentFolderName(path)
    If Not fs.FolderExists(parent) Then CreateFolders parent
    fs.CreateFolder path
End Sub

Sub StopWithError(message)
    WScript.Echo "ERROR: " & message
    WScript.Quit 1
End Sub