Attribute VB_Name = "TestSc14n"
Option Explicit
Option Base 0

' Some tests using the VBA/VB6 interface to SC14N

' $Id: TestSc14n.bas $
'    Last updated:
'    $Date: 2019-12-12 22:13:00 $
'    $Version: 2.1.0 $
'
' ------------------------------ LICENSE -------------------------------------
' Copyright (C) 2018-19 David Ireland, DI Management Services Pty Limited.
' All rights reserved. <www.di-mgt.com.au> <www.cryptosys.net>
' The code in this module is licensed under the terms of the MIT license.
' For a copy, see <http://opensource.org/licenses/MIT>
' ----------------------------------------------------------------------------
'
' Requires `SC14N` to be installed on your system: available from <https://cryptosys.net/sc14n/>.
' Include the modules `basSc14n.bas` and `basUtf8FromString` in your project.
'
' Test files are in `sc14n-testfiles.zip`. These must be in the current working directory.
'

Public Sub DoAllTests()
    Call Test_General
    Call Test_sc14nFile2File
    Call Test_sc14nFile2Bytes
    Call Test_sc14nError
    Call Test_sc14nFile2Digest
    Call Test_sc14nBytes2Digest
    Call Test_sc14nBytes2Bytes
    Call Test_Empty
    Call Test_Exclusive_c14n
    Call Test_Flatten
End Sub

Public Sub Test_General()
    Dim n As Long
    Dim ch As String

    Debug.Print ("INTERROGATE THE CORE DISC14N DLL:")
    n = SC14N_Gen_Version()
    Debug.Print "Version=" & n
    If n < 10000 Then
        MsgBox "Require Sc14n v1.0 or higher", vbCritical
        Exit Sub
    End If
    ch = Chr(SC14N_Gen_LicenceType())
    Debug.Print "LicenceType=" & ch
    Debug.Print "ModuleName=" & sc14nGenModuleName()
    Debug.Print "CompileTime=" & sc14nGenCompileTime()
    Debug.Print "Platform=" & sc14nGenPlatform()

End Sub

Public Sub Test_sc14nFile2File()
    Dim strFileName As String
    Dim strFileOUT As String
    Dim nRet As Long
    
    strFileName = "olamundo.xml"
    strFileOUT = "olamundo-c14n.xml"
    nRet = sc14nFile2File(strFileOUT, strFileName, "Signature", "", SC14N_TRAN_EXCLUDEBYTAG)
    Debug.Print "C14N_File2File returns " & nRet & " (expecting 0)"

End Sub


Public Sub Test_sc14nFile2Bytes()
    Dim abBuffer() As Byte
    Dim strFileName As String
    
    strFileName = "olamundo.xml"
    abBuffer = sc14nFile2Bytes(strFileName, "Body", "", SC14N_TRAN_SUBSETBYTAG)
    Call ShowBytesInArray(abBuffer)
    Debug.Print Utf8BytesToString(abBuffer)
    
End Sub

Public Sub Test_sc14nError()
    Dim abBuffer() As Byte
    Dim nBytes As Long
    Dim strFileName As String
    Dim nRet As Long
    
    Debug.Print "Expecting errors..."
    ' Input file that does not exist
    strFileName = "missing.xml"
    abBuffer = sc14nFile2Bytes(strFileName, "Body", "", SC14N_TRAN_SUBSETBYTAG)
    ' Result is an empty buffer
    nBytes = UBound(abBuffer) + 1
    Debug.Print "nBytes=" & nBytes
    Debug.Print "Result='" & Utf8BytesToString(abBuffer) & "'"
    ' Get last error set
    Debug.Print "LastError='" & sc14nErrLastError() & "'"
    
    ' Function that returns an error code
    nRet = sc14nFile2File("whatever.xml", strFileName, "", "", 0)
    Debug.Print "sc14nFile2File() returns " & nRet
    Debug.Print "sc14nErrErrorLookup(" & nRet & ") => " & sc14nErrErrorLookup(nRet)
    Debug.Print "LastError='" & sc14nErrLastError() & "'"
    
    ' Try again with input file that is not a valid XML file
    strFileName = "AliceRSASignByCarl.cer"
    nRet = sc14nFile2File("whatever.xml", strFileName, "", "", 0)
    Debug.Print "sc14nFile2File() returns " & nRet
    Debug.Print "sc14nErrErrorLookup(" & nRet & ") => " & sc14nErrErrorLookup(nRet)
    Debug.Print "LastError='" & sc14nErrLastError() & "'"
    
End Sub

Public Sub Test_sc14nFile2Digest()
    Dim strDigest As String
    Dim strFileName As String
    Dim strOK As String
    
    strFileName = "olamundo.xml"
    strOK = "dwWOTcgHoCxU+d3Xyi8GLWnzRPs="
    strDigest = sc14nFile2Digest(strFileName, "", "", 0)
    Debug.Print "DIGEST=" & strDigest
    Debug.Print "OK    =" & strOK
    Debug.Assert (strDigest = strOK)
    
End Sub

Public Sub Test_sc14nBytes2Digest()
    Dim strDigest As String
    Dim abBuffer() As Byte
    Dim nBytes As Long
    Dim strFileName As String
    Dim strOK As String
    
    strFileName = "olamundo.xml"
    ' Read in entire XML document (C14N transformed, but could just be read in directly from file)
    abBuffer = sc14nFile2Bytes(strFileName, "", "", 0)
    nBytes = UBound(abBuffer) + 1
    
    ' Now perform memory->digest C14N transformation of doc excluding Signature element
    ' = DigestValue for <Reference URI="">
    strOK = "UWuYTYug10J1k5hKfonxthgrAR8="
    strDigest = sc14nBytes2Digest(abBuffer, nBytes, "Signature", "", SC14N_TRAN_EXCLUDEBYTAG)
    Debug.Print "DIGEST=" & strDigest
    Debug.Print "OK    =" & strOK
    Debug.Assert (strDigest = strOK)
   
    ' Again but using SHA-256 instead of SHA-1
    strOK = "XmEzFTF6w33nhHfeQqIZKwITz3H2mbBvShxWn+ML/7s="
    strDigest = sc14nBytes2Digest(abBuffer, nBytes, "Signature", "", SC14N_TRAN_EXCLUDEBYTAG Or SC14N_DIG_SHA256)
    Debug.Print "DIGEST(SHA-256)=" & strDigest
    Debug.Print "OK             =" & strOK
    Debug.Assert (strDigest = strOK)
End Sub

Public Sub Test_sc14nBytes2Bytes()
    Dim abBuffer() As Byte
    Dim nBytes As Long
    Dim strFileName As String
    Dim abOut() As Byte
    Dim nOut As Long
    
    strFileName = "olamundo.xml"
    ' Read in entire XML document (C14N transformed, but could just be read in directly from file)
    abBuffer = sc14nFile2Bytes(strFileName, "", "", 0)
    nBytes = UBound(abBuffer) + 1
    
    ' Now perform memory->memory C14N transformation
    abOut = sc14nBytes2Bytes(abBuffer, nBytes, "Body", "", SC14N_TRAN_SUBSETBYTAG)
    nOut = UBound(abOut) + 1
    Debug.Print "nOut=" & nOut
    ' Display in "ANSI" string form
    Debug.Print "Result='" & Utf8BytesToString(abOut) & "'"
End Sub

Public Sub Test_Empty()
    Dim s As String
    Dim b() As Byte
    Dim abEmpty() As Byte
    
    Debug.Print "Test empty input..."
    b = Utf8BytesFromString(vbNullString)
    Call ShowBytesInArray(b)
    
    ' Undefined array
    s = Utf8BytesToString(abEmpty)
    Debug.Print "[" & s & "]"
    Call ShowStringBytes(s)
  
End Sub

Public Sub Test_Exclusive_c14n()
    Dim strDigest As String
    Dim abBuffer() As Byte
    Dim strFileName As String
    Dim strOK As String
    Dim strPrefixList As String
    
    ' Example files from RFC 3741 "Exclusive XML Canonicalization, Version 1.0", s2.2
    ' Transform element <n1:elem2>
    strOK = "qYwgpdgV1/b3PQ3aSpMx9wKGtqY="
    strFileName = "example1.xml"
    Debug.Print
    Debug.Print "FILE: " & strFileName
    abBuffer = sc14nFile2Bytes(strFileName, "n1:elem2", "", SC14N_TRAN_SUBSETBYTAG Or SC14N_METHOD_EXCLUSIVE)
    Debug.Print "excl-c14n:"
    Debug.Print Utf8BytesToString(abBuffer)
    ' Compute digest
    strDigest = sc14nFile2Digest(strFileName, "n1:elem2", "", SC14N_TRAN_SUBSETBYTAG Or SC14N_METHOD_EXCLUSIVE)
    Debug.Print "DIGEST=" & strDigest
    Debug.Print "OK    =" & strOK
    Debug.Assert (strDigest = strOK)

    strFileName = "example2.xml"
    Debug.Print
    Debug.Print "FILE: " & strFileName
    abBuffer = sc14nFile2Bytes(strFileName, "n1:elem2", "", SC14N_TRAN_SUBSETBYTAG Or SC14N_METHOD_EXCLUSIVE)
    Debug.Print "excl-c14n:"
    Debug.Print Utf8BytesToString(abBuffer)
    ' Compute digest
    strDigest = sc14nFile2Digest(strFileName, "n1:elem2", "", SC14N_TRAN_SUBSETBYTAG Or SC14N_METHOD_EXCLUSIVE)
    Debug.Print "DIGEST=" & strDigest
    Debug.Print "OK    =" & strOK
    Debug.Assert (strDigest = strOK)
    
    ' Transform using exclusive c14n with PrefixList
    ' <ds:Reference URI="#TS-3">
    ' <ec:InclusiveNamespaces PrefixList="wsse SOAP-ENV"
    strFileName = "soap-ts3-signed-by-alice.xml"
    strPrefixList = "wsse SOAP-ENV"
    Debug.Print
    Debug.Print "FILE: " & strFileName
    Debug.Print "PrefixList='" & strPrefixList & "'"
    abBuffer = sc14nFile2Bytes(strFileName, "wsu:Id=TS-3", strPrefixList, SC14N_TRAN_SUBSETBYID Or SC14N_METHOD_EXCLUSIVE)
    Debug.Print Utf8BytesToString(abBuffer)
    ' Compute SHA-256 digest
    ' <ds:DigestMethod Algorithm="http://www.w3.org/2001/04/xmlenc#sha256" />
    strOK = "a4cojI7ZDOI1lKvGD7OHNus7qy1DQgpqNdGZ/YEDJQo="
    strDigest = sc14nFile2Digest(strFileName, "wsu:Id=TS-3", strPrefixList, SC14N_TRAN_SUBSETBYID Or SC14N_METHOD_EXCLUSIVE Or SC14N_DIG_SHA256)
    Debug.Print "DIGEST=" & strDigest
    Debug.Print "OK    =" & strOK
    Debug.Assert (strDigest = strOK)
    
End Sub

Public Sub Test_Flatten()
    Dim strFileName As String
    Dim abBuffer() As Byte
    Dim strDigest As String
    Dim strOK As String
    
    strFileName = "ignorable_ws.xml"
    Debug.Print
    Debug.Print "FILE: " & strFileName
    
    ' Default c14n...
    strOK = "JNluoz+Z+MbLrTX8W//wEEgeFpo="
    abBuffer = sc14nFile2Bytes(strFileName, "", "", 0)
    Debug.Print "no-flatten:"
    Debug.Print Utf8BytesToString(abBuffer)
    strDigest = sc14nFile2Digest(strFileName, "", "", 0)
    Debug.Print "DIGEST=" & strDigest
    Debug.Print "OK    =" & strOK
    Debug.Assert (strDigest = strOK)
        
    ' Flatten the XML - remove ignorable whitespace
    strOK = "4ZKWJnP7dUperStlOKrq7athzxw="
    abBuffer = sc14nFile2Bytes(strFileName, "", "", SC14N_OPT_FLATTEN)
    Debug.Print "FLATTEN:"
    Debug.Print Utf8BytesToString(abBuffer)
    strDigest = sc14nFile2Digest(strFileName, "", "", SC14N_OPT_FLATTEN)
    Debug.Print "DIGEST=" & strDigest
    Debug.Print "OK    =" & strOK
    Debug.Assert (strDigest = strOK)

End Sub


' For debugging
Public Sub ShowBytesInArray(vnt As Variant)
    Dim i As Long
    Dim b() As Byte
    b = vnt
    For i = 0 To UBound(b)
        Dim ch As Byte
        ch = b(i)
        If (ch < 15) Then Debug.Print "0";
        Debug.Print Hex(b(i));
    Next
    Debug.Print
End Sub

' For debugging
Public Sub ShowStringBytes(str As String)
    Dim i As Long
    Dim x() As Byte
    x = str
    For i = 0 To UBound(x)
       Debug.Print x(i);
    Next
    Debug.Print
End Sub