Attribute VB_Name = "JWS_Signature_RFC7515"
' $Id: JWS_Signature_RFC7515.bas $
' $Date: 2020-01-20 11:53 $

' Example using CryptoSys PKI to create and validate a JSON Web Signature (JWS)
' using test data from Appendix A.2 of RFC 7515

' ******************************* LICENSE ***********************************
' Copyright (C) 2020 David Ireland, DI Management Services Pty Limited.
' All rights reserved. <https://di-mgt.com.au> <https://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 CryptoSys PKI Pro v12.2 or later to be installed on your system
' (download from https://cryptosys.net/pki/)
' and module `basCrPKI.bas` to be in the same project
' (look for this in C:\Program Files (x86)\CryptoSysPKI\VB6)

Option Explicit

Public Sub JWS_RFC7515_Example()

' Ref: RFC 7515 JSON Web Signature (JWS), Appendix A.2
' https://tools.ietf.org/html/rfc7515#appendix-A.2

    Dim strJwsPriKey As String
    Dim strPrivateKey As String
    Dim strPublicKey As String
    Dim strJwsSigningInput As String
    Dim strJwsSignature As String
    Dim abData() As Byte
    Dim nDataLen As Long
    Dim nChars As Long
    Dim nRet As Long
    Dim strAlgName As String
    Dim strHeader As String
    Dim strHeaderURL As String
    Dim strPayload As String
    Dim strPayloadURL As String
    Dim strJwsPubKey As String
    Dim strJwsSigOK As String
    
    Debug.Print "Creating JSON Web Signature..."
    
    strAlgName = "sha256WithRSAEncryption"  ' "alg":"RS256"
    
    ' Read in JWS RSA private key
    strJwsPriKey = "{""kty"":""RSA""," & vbCrLf & _
        """n"":""ofgWCuLjybRlzo0tZWJjNiuSfb4p4fAkd_wWJcyQoTbji9k0l8W26mPddxHmfHQp-Vaw-4qPCJrcS2mJPMEzP1Pt0Bm4d4QlL-yRT-SFd2lZS-pCgNMsD1W_YpRPEwOWvG6b32690r2jZ47soMZo9wGzjb_7OMg0LOL-bSf63kpaSHSXndS5z5rexMdbBYUsLA9e-KXBdQOS-UTo7WTBEMa2R2CapHg665xsmtdVMTBQY4uDZlxvb3qCo5ZwKh9kG4LT6_I5IhlJH7aGhyxXFvUK-DWNmoudF8NAco9_h9iaGNj8q2ethFkMLs91kzk2PAcDTW9gb54h4FRWyuXpoQ""," & vbCrLf & _
        """e"":""AQAB""," & vbCrLf & _
        """d"":""Eq5xpGnNCivDflJsRQBXHx1hdR1k6Ulwe2JZD50LpXyWPEAeP88vLNO97IjlA7_GQ5sLKMgvfTeXZx9SE-7YwVol2NXOoAJe46sui395IW_GO-pWJ1O0BkTGoVEn2bKVRUCgu-GjBVaYLU6f3l9kJfFNS3E0QbVdxzubSu3Mkqzjkn439X0M_V51gfpRLI9JYanrC4D4qAdGcopV_0ZHHzQlBjudU2QvXt4ehNYTCBr6XCLQUShb1juUO1ZdiYoFaFQT5Tw8bGUl_x_jTj3ccPDVZFD9pIuhLhBOneufuBiB4cS98l2SR_RQyGWSeWjnczT0QU91p1DhOVRuOopznQ""," & vbCrLf & _
        """p"":""4BzEEOtIpmVdVEZNCqS7baC4crd0pqnRH_5IB3jw3bcxGn6QLvnEtfdUdiYrqBdss1l58BQ3KhooKeQTa9AB0Hw_Py5PJdTJNPY8cQn7ouZ2KKDcmnPGBY5t7yLc1QlQ5xHdwW1VhvKn-nXqhJTBgIPgtldC-KDV5z-y2XDwGUc""," & vbCrLf & _
        """q"":""uQPEfgmVtjL0Uyyx88GZFF1fOunH3-7cepKmtH4pxhtCoHqpWmT8YAmZxaewHgHAjLYsp1ZSe7zFYHj7C6ul7TjeLQeZD_YwD66t62wDmpe_HlB-TnBA-njbglfIsRLtXlnDzQkv5dTltRJ11BKBBypeeF6689rjcJIDEz9RWdc""," & vbCrLf & _
        """dp"":""BwKfV3Akq5_MFZDFZCnW-wzl-CCo83WoZvnLQwCTeDv8uzluRSnm71I3QCLdhrqE2e9YkxvuxdBfpT_PI7Yz-FOKnu1R6HsJeDCjn12Sk3vmAktV2zb34MCdy7cpdTh_YVr7tss2u6vneTwrA86rZtu5Mbr1C1XsmvkxHQAdYo0""," & vbCrLf & _
        """dq"":""h_96-mK1R_7glhsum81dZxjTnYynPbZpHziZjeeHcXYsXaaMwkOlODsWa7I9xXDoRwbKgB719rrmI2oKr6N3Do9U0ajaHF-NKJnwgjMd2w9cjz3_-kyNlxAr2v4IKhGNpmM5iIgOS1VZnOZ68m6_pbLBSp3nssTdlqvd0tIiTHU""," & vbCrLf & _
        """qi"":""IYd7DHOhrWvxkwPQsRM2tOgrjbcrfvtQJipd-DlcxyVuuM9sQLdgjVk2oy26F0EmpScGLq2MowX7fhd_QJQ3ydy5cY7YIBi87w93IKLEdfnbJtoOPLUW0ITrJReOgo1cq9SbsxYawBgfp_gh6A5603k2-ZQwVK0JKSHuLFkuQ3U""" & vbCrLf & _
        "}"
    
    ' Read JWS key string into ephemeral RSA private key string and display key characteristics
    ' (we don't need to do this to make a signature, it's just a check all is OK)
    strPrivateKey = rsaReadPrivateKey(strJwsPriKey, "")
    Debug.Print "Key length=" & RSA_KeyBits(strPrivateKey) & " bits"
    Debug.Print "Key hash=0x" & Hex(RSA_KeyHashCode(strPrivateKey))
    
    ' Compose JWS Protected Header
    strHeader = "{""alg"":""RS256""}"
    Debug.Print "JWS Protected Header=" & strHeader
    strHeaderURL = cnvBase64urlFromString(strHeader)
    Debug.Print "BASE64URL(UTF8(JWS Protected Header))=" & strHeaderURL

    ' Compose JWS Payload (note CR-LF line endings and single space indents)
    strPayload = "{""iss"":""joe""," & vbCrLf & _
        " ""exp"":1300819380," & vbCrLf & _
        " ""http://example.com/is_root"":true}"
    Debug.Print "JWS Payload=" & strPayload
    strPayloadURL = cnvBase64urlFromString(strPayload)
    Debug.Print "BASE64URL(UTF8(JWS Payload))=" & strPayloadURL
    
    ' Compose JWS Signing Input
    ' BASE64URL(UTF8(JWS Protected Header) || '.' || BASE64URL(JWS Payload)
    strJwsSigningInput = strHeaderURL & "." & strPayloadURL
    Debug.Print "JWS Signing Input=" & strJwsSigningInput
    
    ' Encode signing input as a byte array
    abData = StrConv(strJwsSigningInput, vbFromUnicode)
    nDataLen = UBound(abData) + 1
    
    ' Compute JWS Signature value BASE64URL(JWS Signature)
    ' -- Note we can use the JSW key string directly here. There is no password.
    ' -- Find out how many characters in the signature output
    nChars = SIG_SignData("", 0, abData(0), nDataLen, strJwsPriKey, "", strAlgName, PKI_ENCODE_BASE64URL)
    Debug.Print "SIG chars length=" & nChars
    Debug.Assert nChars > 0
    ' -- Allocate memory for output
    strJwsSignature = String(nChars, " ")
    ' -- Compute signature value encoded directly in base64url
    nChars = SIG_SignData(strJwsSignature, Len(strJwsSignature), abData(0), nDataLen, strJwsPriKey, "", strAlgName, PKI_ENCODE_BASE64URL)
    Debug.Print "BASE64URL(JWS Signature)=" & strJwsSignature
    
    ' The correct signature value from RFC 7515
    strJwsSigOK = "cC4hiUPoj9Eetdgtv3hF80EGrhuB__dzERat0XF9g2VtQgr9PJbu3XOiZj5RZmh7AAuHIm4Bh-0Qc_lF5YKt_O8W2Fp5jujGbds9uJdbF9CUAr7t1dnZcAcQjbKBYNX4BAynRFdiuB--f_nZLgrnbyTyWzO75vRK5h6xBArLIARNPvkSjtQBMHlb1L07Qe7K0GarZRmB_eSN9383LcOLn6_dO--xi12jzDwusC-eOkHWEsqtFZESc6BfI7noOPqvhJ1phCnvWh6IeYI2w9QOYEUipUTI8np6LbgGY9Fs98rqVt5AXLIhWkWywlVmtVrBp0igcN_IoypGlUPQGe77Rw"
    Debug.Print "Correct value           =" & strJwsSignature
    Debug.Assert strJwsSigOK = strJwsSignature
    
    ' Output full JWS Compact Serialization
    ' Header.Payload.Signature with period ('.') characters between the parts, all parts base64url encoded.
    Debug.Print "JWS Compact Serialization="
    Debug.Print strHeaderURL & "." & strPayloadURL & "." & strJwsSignature
    
    '-------------------
    ' VALIDATE SIGNATURE
    '-------------------
    Debug.Print
    Debug.Print "Validating signature..."
    ' INPUT: JwsSignature, JwsSigningInput, Public key, SigningAlgorithm
    ' OUTPUT: Signature valid (returns 0) or invalid.
      
    ' Given JWS public key
    Debug.Print "Public key details given directly in a string..."
    strJwsPubKey = "{""kty"":""RSA""," & _
        """n"":""ofgWCuLjybRlzo0tZWJjNiuSfb4p4fAkd_wWJcyQoTbji9k0l8W26mPddxHmfHQp-Vaw-4qPCJrcS2mJPMEzP1Pt0Bm4d4QlL-yRT-SFd2lZS-pCgNMsD1W_YpRPEwOWvG6b32690r2jZ47soMZo9wGzjb_7OMg0LOL-bSf63kpaSHSXndS5z5rexMdbBYUsLA9e-KXBdQOS-UTo7WTBEMa2R2CapHg665xsmtdVMTBQY4uDZlxvb3qCo5ZwKh9kG4LT6_I5IhlJH7aGhyxXFvUK-DWNmoudF8NAco9_h9iaGNj8q2ethFkMLs91kzk2PAcDTW9gb54h4FRWyuXpoQ""," & _
        """e"":""AQAB""" & _
        "}"
    Debug.Print strJwsPubKey
    nChars = RSA_ReadAnyPublicKey(0, 0, strJwsPubKey, 0)
    Debug.Assert nChars > 0
    ' Read in public key to internal ephemeral key string to check details (extra check, not necessary)
    strPublicKey = String(nChars, " ")
    nChars = RSA_ReadAnyPublicKey(strPublicKey, Len(strPublicKey), strJwsPubKey, 0)
    Debug.Print "Display public key characteristics (should be the same as private key above)..."
    Debug.Print "Key length=" & RSA_KeyBits(strPublicKey) & " bits"
    Debug.Print "Key hash=0x" & Hex(RSA_KeyHashCode(strPublicKey))
    nRet = RSA_KeyMatch(strPrivateKey, strPublicKey)
    Debug.Print "RSA_KeyMatch() returns " & nRet & " (expected 0 => keys match OK)"
    
    ' Verify the signature value against original signing input using the JSON RSA public key
    nRet = SIG_VerifyData(strJwsSignature, abData(0), nDataLen, strJwsPubKey, strAlgName, 0)
    Debug.Print "SIG_VerifyData() returns " & nRet & " (expecting 0 => signature is valid)"
    Debug.Assert nRet = 0
   
End Sub

' *******************
' BASE64URL UTILITIES
' *******************

''' Encode string value in base64url encoding
Private Function cnvBase64urlFromString(strInput As String) As String
    strInput = cnvB64StrFromString(strInput)
    strInput = Replace(strInput, "+", "-")
    strInput = Replace(strInput, "/", "_")
    strInput = Replace(strInput, "=", "")
    cnvBase64urlFromString = strInput
End Function

''' Decode base64url-encoded string to Unicode string
Private Function cnvBase64urlToString(strInput As String) As String
    strInput = Replace(strInput, "-", "+")
    strInput = Replace(strInput, "_", "/")
    strInput = cnvStringFromHexStr((cnvHexStrFromB64Str(strInput)))
    cnvBase64urlToString = strInput
End Function

''' Decode base64url-encoded string to Byte array
Private Function cnvBase64urlToBytes(strInput As String) As Byte()
    strInput = Replace(strInput, "-", "+")
    strInput = Replace(strInput, "_", "/")
    cnvBase64urlToBytes = cnvBytesFromB64Str(strInput)
End Function