wsc-mvc/tests/Test-Components.vbs

Option Explicit

Dim fso, logDir, viewsDir, testViewsDir, pass
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"

' 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, 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

' --- 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