dcovington
/
wsc-mvc


			
				
					
						
						
							
							Option Explicit

Dim fso, logDir, viewsDir, testViewsDir, pass
Dim dbConnStringPath, dbConnString, dbSectionAvailable
pass = True

Set fso = CreateObject("Scripting.FileSystemObject")
logDir = fso.GetParentFolderName(WScript.ScriptFullName) & "\test-logs"
If fso.FolderExists(logDir) Then
    fso.DeleteFolder logDir, True
End If

' Real Views/ used for the /hello integration path (proves the end-to-end
' rendering pipeline, not just the ViewRenderer component in isolation).
viewsDir = fso.GetParentFolderName(WScript.ScriptFullName) & "\..\Views"

' The connection string (with live credentials) lives only in the untracked
' db.connectionstring file (see .gitignore, docs/DECISIONS.md) - never
' hardcoded here. Read up front so every RunApplication call (including the
' non-DB ones above the Database contract section below) sees a consistent
' value. If the file isn't present on this machine, dbSectionAvailable gates
' the Database contract tests as NOT RUN rather than FAIL further down.
dbConnStringPath = fso.GetParentFolderName(WScript.ScriptFullName) & "\..\db.connectionstring"
dbSectionAvailable = fso.FileExists(dbConnStringPath)
dbConnString = ""
If dbSectionAvailable Then
    Dim dbConnStringStreamEarly
    Set dbConnStringStreamEarly = fso.OpenTextFile(dbConnStringPath, 1)
    dbConnString = Trim(dbConnStringStreamEarly.ReadAll)
    dbConnStringStreamEarly.Close
    Set dbConnStringStreamEarly = Nothing
End If

' Disposable fixture directory for direct ViewRenderer contract tests below.
testViewsDir = fso.GetParentFolderName(WScript.ScriptFullName) & "\test-views"
If fso.FolderExists(testViewsDir) Then
    fso.DeleteFolder testViewsDir, True
End If
fso.CreateFolder testViewsDir

Function NewContext(path, httpMethod)
    Dim ctx
    Set ctx = CreateObject("WscMvc.RequestContext")
    ctx.Initialize path, httpMethod, logDir
    Set NewContext = ctx
End Function

Sub RunApplication(app, path, httpMethod, applicationName, statusLine, contentType, body, allowHeader)
    Dim ctx
    Set ctx = NewContext(path, httpMethod)
    statusLine = "" : contentType = "" : body = "" : allowHeader = ""
    app.Run ctx, applicationName, viewsDir, dbConnString, statusLine, contentType, body, allowHeader
    Set ctx = Nothing
End Sub

Sub WriteFixture(fileName, content)
    Dim stream
    Set stream = fso.CreateTextFile(testViewsDir & "\" & fileName, True)
    stream.Write content
    stream.Close
    Set stream = Nothing
End Sub

Sub CheckEqual(actual, expected, label)
    If actual = expected Then
        WScript.Echo "PASS: " & label
    Else
        WScript.Echo "FAIL: " & label & " -> expected [" & expected & "] got [" & actual & "]"
        pass = False
    End If
End Sub

' --- RequestContext contract ---
Dim ctx1
On Error Resume Next
Set ctx1 = NewContext("/hello", "GET")
If Err.Number <> 0 Then
    WScript.Echo "FAIL: could not create/initialize WscMvc.RequestContext - " & Err.Description
    pass = False
    Err.Clear
End If
On Error Goto 0

If pass Then
    CheckEqual ctx1.Path, "/hello", "RequestContext.Path"
    CheckEqual ctx1.HttpMethod, "GET", "RequestContext.HttpMethod"
    If Len(ctx1.CorrelationId) > 0 Then
        WScript.Echo "PASS: RequestContext.CorrelationId non-empty (" & ctx1.CorrelationId & ")"
    Else
        WScript.Echo "FAIL: RequestContext.CorrelationId empty"
        pass = False
    End If
    If ctx1.ElapsedMs() >= 0 Then
        WScript.Echo "PASS: RequestContext.ElapsedMs non-negative (" & ctx1.ElapsedMs() & ")"
    Else
        WScript.Echo "FAIL: RequestContext.ElapsedMs negative"
        pass = False
    End If
End If

' --- Two independent contexts must not share correlation IDs or state ---
Dim ctx2
If pass Then
    Set ctx2 = NewContext("/does-not-exist", "GET")
    If ctx1.CorrelationId <> ctx2.CorrelationId Then
        WScript.Echo "PASS: two RequestContext instances have distinct CorrelationIds"
    Else
        WScript.Echo "FAIL: two RequestContext instances produced the same CorrelationId - " & ctx1.CorrelationId
        pass = False
    End If
End If

' --- Application.Run happy path via ctx ---
Dim app, statusLine, contentType, body, allowHeader
If pass Then
    On Error Resume Next
    Set app = CreateObject("WscMvc.Application")
    If Err.Number <> 0 Then
        WScript.Echo "FAIL: could not create WscMvc.Application - " & Err.Description
        pass = False
        Err.Clear
    End If
    On Error Goto 0
End If

If pass Then
    On Error Resume Next
    RunApplication app, "/hello", "GET", "production", statusLine, contentType, body, allowHeader
    If Err.Number <> 0 Then
        WScript.Echo "FAIL: Application.Run raised error on /hello - " & Err.Description
        pass = False
        Err.Clear
    End If
    On Error Goto 0
End If

If pass Then
    CheckEqual statusLine, "200 OK", "Application.Run(/hello) statusLine"
    CheckEqual contentType, "text/html; charset=utf-8", "Application.Run(/hello) contentType"
    CheckEqual body, "Hello from WSC-MVC!", "Application.Run(/hello) body"
    CheckEqual allowHeader, "", "Application.Run(/hello) Allow header"
End If

' --- Application.Run unknown route via ctx (expected 404, not an error) ---
If pass Then
    On Error Resume Next
    RunApplication app, "/does-not-exist", "GET", "production", statusLine, contentType, body, allowHeader
    If Err.Number <> 0 Then
        WScript.Echo "FAIL: Application.Run raised error on unknown route - " & Err.Description
        pass = False
        Err.Clear
    End If
    On Error Goto 0
End If

If pass Then
    CheckEqual statusLine, "404 Not Found", "Application.Run(unknown route) statusLine"
    CheckEqual allowHeader, "", "Application.Run(unknown route) Allow header"
End If

' --- Router method contract: existing route with unsupported method is 405 + Allow ---
If pass Then
    On Error Resume Next
    RunApplication app, "/hello", "POST", "production", statusLine, contentType, body, allowHeader
    If Err.Number <> 0 Then
        WScript.Echo "FAIL: Application.Run raised error on method mismatch - " & Err.Description
        pass = False
        Err.Clear
    End If
    On Error Goto 0
End If

If pass Then
    CheckEqual statusLine, "405 Method Not Allowed", "Application.Run(POST /hello) statusLine"
    CheckEqual contentType, "text/plain; charset=utf-8", "Application.Run(POST /hello) contentType"
    CheckEqual body, "Method Not Allowed", "Application.Run(POST /hello) body"
    CheckEqual allowHeader, "GET", "Application.Run(POST /hello) Allow header"
End If

' --- Router app isolation and POST support for test app route ---
If pass Then
    On Error Resume Next
    RunApplication app, "/self-test", "POST", "tests", statusLine, contentType, body, allowHeader
    If Err.Number <> 0 Then
        WScript.Echo "FAIL: Application.Run raised error on POST /self-test - " & Err.Description
        pass = False
        Err.Clear
    End If
    On Error Goto 0
End If

If pass Then
    CheckEqual statusLine, "200 OK", "Application.Run(POST /self-test tests) statusLine"
    CheckEqual contentType, "application/json; charset=utf-8", "Application.Run(POST /self-test tests) contentType"
    CheckEqual allowHeader, "", "Application.Run(POST /self-test tests) Allow header"
End If

' --- Router malformed path contract ---
If pass Then
    On Error Resume Next
    RunApplication app, "/hello/../secret", "GET", "production", statusLine, contentType, body, allowHeader
    If Err.Number <> 0 Then
        WScript.Echo "FAIL: Application.Run raised error on malformed path - " & Err.Description
        pass = False
        Err.Clear
    End If
    On Error Goto 0
End If

If pass Then
    CheckEqual statusLine, "400 Bad Request", "Application.Run(malformed path) statusLine"
    CheckEqual contentType, "text/plain; charset=utf-8", "Application.Run(malformed path) contentType"
    CheckEqual body, "Bad Request", "Application.Run(malformed path) body"
    CheckEqual allowHeader, "", "Application.Run(malformed path) Allow header"
End If

' --- ViewRenderer contract: substitution + HTML-encoding ---
Dim renderer
On Error Resume Next
Set renderer = CreateObject("WscMvc.ViewRenderer")
If Err.Number <> 0 Then
    WScript.Echo "FAIL: could not create WscMvc.ViewRenderer - " & Err.Description
    pass = False
    Err.Clear
End If
On Error Goto 0

If pass Then
    WriteFixture "Sample.html", "<p>{{Name}}</p>"
    Dim dataSample, outSample
    Set dataSample = CreateObject("Scripting.Dictionary")
    dataSample.Add "Name", "<script>alert(1)</script>"
    outSample = ""
    On Error Resume Next
    renderer.Render testViewsDir, "Sample", dataSample, outSample
    If Err.Number <> 0 Then
        WScript.Echo "FAIL: ViewRenderer.Render raised error on Sample - " & Err.Description
        pass = False
        Err.Clear
    End If
    On Error Goto 0
    If pass Then
        CheckEqual outSample, "<p>&lt;script&gt;alert(1)&lt;/script&gt;</p>", "ViewRenderer HTML-encodes placeholder value"
    End If
    Set dataSample = Nothing
End If

' --- ViewRenderer contract: template with no placeholders passes through unchanged, data = Nothing ---
If pass Then
    WriteFixture "Plain.html", "Plain text, no placeholders."
    Dim outPlain
    outPlain = ""
    On Error Resume Next
    renderer.Render testViewsDir, "Plain", Nothing, outPlain
    If Err.Number <> 0 Then
        WScript.Echo "FAIL: ViewRenderer.Render raised error on Plain (data=Nothing) - " & Err.Description
        pass = False
        Err.Clear
    End If
    On Error Goto 0
    If pass Then
        CheckEqual outPlain, "Plain text, no placeholders.", "ViewRenderer passes through template with no placeholders (data=Nothing)"
    End If
End If

' --- ViewRenderer contract: missing template file is a safe, path-free error ---
If pass Then
    Dim outMissing, missingOk, missingDetail
    missingOk = False
    outMissing = ""
    On Error Resume Next
    renderer.Render testViewsDir, "DoesNotExist", Nothing, outMissing
    If Err.Number <> 0 Then
        missingDetail = Err.Description
        If InStr(1, missingDetail, testViewsDir, 1) = 0 Then
            missingOk = True
        End If
        Err.Clear
    End If
    On Error Goto 0
    If missingOk Then
        WScript.Echo "PASS: ViewRenderer.Render on missing template raises a path-free error"
    Else
        WScript.Echo "FAIL: ViewRenderer.Render on missing template -> Err.Number after call, detail=[" & missingDetail & "]"
        pass = False
    End If
End If

' --- ViewRenderer contract: unresolved placeholder (no matching dictionary key) is a safe error ---
If pass Then
    WriteFixture "Missing.html", "{{Unknown}}"
    Dim dataEmpty, outMissingKey, unresolvedOk
    Set dataEmpty = CreateObject("Scripting.Dictionary")
    unresolvedOk = False
    outMissingKey = ""
    On Error Resume Next
    renderer.Render testViewsDir, "Missing", dataEmpty, outMissingKey
    If Err.Number <> 0 Then
        unresolvedOk = True
        Err.Clear
    End If
    On Error Goto 0
    If unresolvedOk Then
        WScript.Echo "PASS: ViewRenderer.Render raises on unresolved placeholder"
    Else
        WScript.Echo "FAIL: ViewRenderer.Render did not raise on unresolved placeholder -> got [" & outMissingKey & "]"
        pass = False
    End If
    Set dataEmpty = Nothing
End If

' --- ViewRenderer contract: invalid view name (path traversal attempt) is rejected ---
If pass Then
    Dim outTraversal, traversalOk
    traversalOk = False
    outTraversal = ""
    On Error Resume Next
    renderer.Render testViewsDir, "../secret", Nothing, outTraversal
    If Err.Number <> 0 Then
        traversalOk = True
        Err.Clear
    End If
    On Error Goto 0
    If traversalOk Then
        WScript.Echo "PASS: ViewRenderer.Render rejects an invalid view name"
    Else
        WScript.Echo "FAIL: ViewRenderer.Render did not reject invalid view name -> got [" & outTraversal & "]"
        pass = False
    End If
End If

Set renderer = Nothing

' --- Database contract (M5) ---
' Targets the dedicated integration test database created by
' tools/Setup-TestDatabase.ps1 (never auto-created by application code -
' SPEC SS10: no broad filesystem/DB write privileges from a web request).
' dbConnString/dbSectionAvailable were already read at the top of this file
' (before the first RunApplication call). If db.connectionstring isn't
' present on this machine, the DB section is skipped (NOT RUN) rather than
' failed, since the real issue is an unprovisioned environment, not a
' framework defect.
Dim db
If Not dbSectionAvailable Then
    WScript.Echo "NOT RUN: Database contract tests skipped - db.connectionstring not found at " & dbConnStringPath
End If

If pass And dbSectionAvailable Then
    On Error Resume Next
    Set db = CreateObject("WscMvc.Database")
    If Err.Number <> 0 Then
        WScript.Echo "FAIL: could not create WscMvc.Database - " & Err.Description
        pass = False
        Err.Clear
    End If
    On Error Goto 0
End If

If pass And dbSectionAvailable Then
    On Error Resume Next
    db.Open dbConnString
    If Err.Number <> 0 Then
        WScript.Echo "FAIL: Database.Open raised error - " & Err.Description
        pass = False
        Err.Clear
    End If
    On Error Goto 0
End If

' Clean slate so this test is deterministic across repeated runs.
If pass And dbSectionAvailable Then
    Dim rowsCleared
    On Error Resume Next
    db.ExecuteNonQuery "DELETE FROM dbo.Widgets", "", Nothing, rowsCleared
    If Err.Number <> 0 Then
        WScript.Echo "FAIL: Database.ExecuteNonQuery(DELETE) raised error - " & Err.Description
        pass = False
        Err.Clear
    End If
    On Error Goto 0
End If

' --- Parameterized INSERT with a value containing a single quote: proves no
' string-concatenation SQL injection (a naive concatenation would break the
' SQL syntax or need manual quote-escaping; the parameterized call needs
' neither). ---
If pass And dbSectionAvailable Then
    Dim insertParams, rowsInserted
    Set insertParams = CreateObject("Scripting.Dictionary")
    insertParams.Add "Name", "O'Brien"
    On Error Resume Next
    db.ExecuteNonQuery "INSERT INTO dbo.Widgets (Name) VALUES (?)", "Name", insertParams, rowsInserted
    If Err.Number <> 0 Then
        WScript.Echo "FAIL: Database.ExecuteNonQuery(INSERT) raised error - " & Err.Description
        pass = False
        Err.Clear
    End If
    On Error Goto 0
    If pass Then
        CheckEqual rowsInserted, 1, "Database.ExecuteNonQuery(INSERT) rowsAffected"
    End If
    Set insertParams = Nothing
End If

' --- Parameterized SELECT round-trips the quote-containing value intact ---
If pass And dbSectionAvailable Then
    Dim selectParams, foundName
    Set selectParams = CreateObject("Scripting.Dictionary")
    selectParams.Add "Name", "O'Brien"
    On Error Resume Next
    db.ExecuteScalar "SELECT Name FROM dbo.Widgets WHERE Name = ?", "Name", selectParams, foundName
    If Err.Number <> 0 Then
        WScript.Echo "FAIL: Database.ExecuteScalar(SELECT) raised error - " & Err.Description
        pass = False
        Err.Clear
    End If
    On Error Goto 0
    If pass Then
        CheckEqual foundName, "O'Brien", "Database.ExecuteScalar round-trips quote-containing value"
    End If
    Set selectParams = Nothing
End If

' --- Null parameter contract: a Null value must pass through as a real SQL
' NULL, not the string "Null" or an empty string. ---
If pass And dbSectionAvailable Then
    Dim nullParams, nullResult
    Set nullParams = CreateObject("Scripting.Dictionary")
    nullParams.Add "v", Null
    On Error Resume Next
    db.ExecuteScalar "SELECT ? AS v", "v", nullParams, nullResult
    If Err.Number <> 0 Then
        WScript.Echo "FAIL: Database.ExecuteScalar(Null param) raised error - " & Err.Description
        pass = False
        Err.Clear
    End If
    On Error Goto 0
    If pass Then
        If IsNull(nullResult) Then
            WScript.Echo "PASS: Database.ExecuteScalar Null parameter round-trips as SQL NULL"
        Else
            WScript.Echo "FAIL: Database.ExecuteScalar Null parameter -> expected Null, got [" & nullResult & "]"
            pass = False
        End If
    End If
    Set nullParams = Nothing
End If

' --- Transaction contract: rollback leaves no trace ---
If pass And dbSectionAvailable Then
    Dim rollbackParams, rowsRolledBack, countAfterRollback
    On Error Resume Next
    db.BeginTransaction
    Set rollbackParams = CreateObject("Scripting.Dictionary")
    rollbackParams.Add "Name", "RolledBack"
    db.ExecuteNonQuery "INSERT INTO dbo.Widgets (Name) VALUES (?)", "Name", rollbackParams, rowsRolledBack
    db.RollbackTransaction
    If Err.Number <> 0 Then
        WScript.Echo "FAIL: Database rollback sequence raised error - " & Err.Description
        pass = False
        Err.Clear
    End If
    On Error Goto 0

    If pass Then
        Dim countParams
        Set countParams = CreateObject("Scripting.Dictionary")
        countParams.Add "Name", "RolledBack"
        On Error Resume Next
        db.ExecuteScalar "SELECT COUNT(*) FROM dbo.Widgets WHERE Name = ?", "Name", countParams, countAfterRollback
        On Error Goto 0
        CheckEqual countAfterRollback, 0, "Database.RollbackTransaction leaves no row"
        Set countParams = Nothing
    End If
    Set rollbackParams = Nothing
End If

' --- Transaction contract: commit persists the change ---
If pass And dbSectionAvailable Then
    Dim commitParams, rowsCommitted, countAfterCommit
    On Error Resume Next
    db.BeginTransaction
    Set commitParams = CreateObject("Scripting.Dictionary")
    commitParams.Add "Name", "Committed"
    db.ExecuteNonQuery "INSERT INTO dbo.Widgets (Name) VALUES (?)", "Name", commitParams, rowsCommitted
    db.CommitTransaction
    If Err.Number <> 0 Then
        WScript.Echo "FAIL: Database commit sequence raised error - " & Err.Description
        pass = False
        Err.Clear
    End If
    On Error Goto 0

    If pass Then
        On Error Resume Next
        db.ExecuteScalar "SELECT COUNT(*) FROM dbo.Widgets WHERE Name = ?", "Name", commitParams, countAfterCommit
        On Error Goto 0
        CheckEqual countAfterCommit, 1, "Database.CommitTransaction persists the row"
    End If
    Set commitParams = Nothing
End If

' --- Failure path: operating on a closed/never-opened connection is a safe error ---
If pass And dbSectionAvailable Then
    Dim db2, closedOk, closedDetail, dummyResult
    closedOk = False
    Set db2 = CreateObject("WscMvc.Database")
    On Error Resume Next
    db2.ExecuteScalar "SELECT 1", "", Nothing, dummyResult
    If Err.Number <> 0 Then
        closedOk = True
        Err.Clear
    End If
    On Error Goto 0
    If closedOk Then
        WScript.Echo "PASS: Database.ExecuteScalar on an unopened connection raises a safe error"
    Else
        WScript.Echo "FAIL: Database.ExecuteScalar on an unopened connection did not raise -> got [" & dummyResult & "]"
        pass = False
    End If
    Set db2 = Nothing
End If

' --- Close is idempotent ---
If pass And dbSectionAvailable Then
    Dim closeOk
    closeOk = True
    On Error Resume Next
    db.Close
    db.Close
    If Err.Number <> 0 Then
        closeOk = False
        Err.Clear
    End If
    On Error Goto 0
    If closeOk Then
        WScript.Echo "PASS: Database.Close is idempotent"
    Else
        WScript.Echo "FAIL: calling Database.Close twice raised an error"
        pass = False
    End If
End If

Set db = Nothing

' --- Logging: best-effort log file was written with both outcomes ---
If pass Then
    Dim logPath, logContent
    logPath = logDir & "\app.log"
    If fso.FileExists(logPath) Then
        Dim logStream
        Set logStream = fso.OpenTextFile(logPath, 1)
        logContent = logStream.ReadAll
        logStream.Close
        If InStr(logContent, "200 OK") > 0 And InStr(logContent, "404 Not Found") > 0 Then
            WScript.Echo "PASS: app.log contains both 200 OK and 404 Not Found outcomes"
        Else
            WScript.Echo "FAIL: app.log missing expected outcomes -> " & logContent
            pass = False
        End If
    Else
        WScript.Echo "FAIL: app.log was not created at " & logPath
        pass = False
    End If
End If

Set app = Nothing
Set ctx1 = Nothing
Set ctx2 = Nothing

If fso.FolderExists(logDir) Then
    fso.DeleteFolder logDir, True
End If
If fso.FolderExists(testViewsDir) Then
    fso.DeleteFolder testViewsDir, True
End If
Set fso = Nothing

If pass Then
    WScript.Echo "RESULT: ALL PASS"
    WScript.Quit 0
Else
    WScript.Echo "RESULT: FAILURE"
    WScript.Quit 1
End If