Attribute VB_Name = "ZeroVaRApi"
' ZeroVaR Excel UDF pack (Windows Excel) — Tier A parity with sheets-demo.gs
'
' Setup:
'   1. Alt+F11 → File → Import File → ZeroVaRApi.bas
'   2. Run ZV_SetToken once (stores zvrd_… in HKCU via SaveSetting; not in a cell)
'   3. In a sheet: =ZV_WHOAMI() then =ZV_SPOT("USD","SEK")
'
' Optional: ZV_SetBaseUrl to override https://staging.api.zerovar.com
' Supported: Windows Excel (WinHttp). Mac Excel VBA is not a v1 target.

Option Explicit

Private Const REG_APP As String = "ZeroVaR"
Private Const REG_SECTION As String = "Api"
Private Const REG_TOKEN As String = "Token"
Private Const REG_BASE As String = "BaseUrl"
Private Const DEFAULT_BASE As String = "https://staging.api.zerovar.com"

' ---- Token / base URL -------------------------------------------------------

Public Sub ZV_SetToken()
    Dim t As String
    t = Trim$(InputBox( _
        "Paste your zvrd_… API key." & vbCrLf & _
        "Stored in Windows settings for this user (not in a sheet cell).", _
        "ZeroVaR — set API key"))
    If Len(t) = 0 Then Exit Sub
    SaveSetting REG_APP, REG_SECTION, REG_TOKEN, t
    MsgBox "API key saved. Try =ZV_WHOAMI() in a cell.", vbInformation, "ZeroVaR"
End Sub

Public Sub ZV_ClearToken()
    On Error Resume Next
    DeleteSetting REG_APP, REG_SECTION, REG_TOKEN
    On Error GoTo 0
    MsgBox "API key cleared.", vbInformation, "ZeroVaR"
End Sub

Public Sub ZV_SetBaseUrl()
    Dim u As String
    u = Trim$(InputBox( _
        "API base URL (no trailing slash).", _
        "ZeroVaR — set base URL", _
        ZV_BaseUrl()))
    If Len(u) = 0 Then Exit Sub
    If Right$(u, 1) = "/" Then u = Left$(u, Len(u) - 1)
    SaveSetting REG_APP, REG_SECTION, REG_BASE, u
    MsgBox "Base URL saved: " & u, vbInformation, "ZeroVaR"
End Sub

Public Function ZV_BaseUrl() As String
    Dim u As String
    u = Trim$(GetSetting(REG_APP, REG_SECTION, REG_BASE, DEFAULT_BASE))
    If Len(u) = 0 Then u = DEFAULT_BASE
    If Right$(u, 1) = "/" Then u = Left$(u, Len(u) - 1)
    ZV_BaseUrl = u
End Function

Private Function ZV_Token() As String
    Dim t As String
    t = Trim$(GetSetting(REG_APP, REG_SECTION, REG_TOKEN, ""))
    If Len(t) = 0 Then
        Err.Raise vbObjectError + 1001, "ZeroVaRApi", _
            "Run ZV_SetToken (Alt+F11 → Run) to store your zvrd_ key"
    End If
    ZV_Token = t
End Function

' ---- HTTP -------------------------------------------------------------------

Private Function HttpGet(ByVal path As String) As String
    HttpGet = HttpRequest("GET", path, "")
End Function

Private Function HttpPostJson(ByVal path As String, ByVal body As String) As String
    HttpPostJson = HttpRequest("POST", path, body)
End Function

Private Function HttpRequest(ByVal method As String, ByVal path As String, ByVal body As String) As String
    Dim http As Object
    Dim url As String
    Dim code As Long
    Dim text As String

    If Left$(path, 1) <> "/" Then path = "/" & path
    url = ZV_BaseUrl() & path

    Set http = CreateObject("WinHttp.WinHttpRequest.5.1")
    http.Open method, url, False
    http.SetRequestHeader "Authorization", "Bearer " & ZV_Token()
    http.SetRequestHeader "Accept", "application/json"
    If Len(body) > 0 Then
        http.SetRequestHeader "Content-Type", "application/json"
        http.Send body
    Else
        http.Send
    End If

    code = CLng(http.Status)
    text = CStr(http.ResponseText)
    If code < 200 Or code >= 300 Then
        Err.Raise vbObjectError + 1002, "ZeroVaRApi", "API " & code & ": " & Left$(text, 240)
    End If
    HttpRequest = text
End Function

' ---- JSON helpers (minimal, response-shaped) --------------------------------

Private Function JsonGetString(ByVal json As String, ByVal key As String) As String
    Dim pat As String
    Dim p As Long
    Dim i As Long
    Dim j As Long
    Dim ch As String
    Dim acc As String
    Dim esc As Boolean

    pat = """" & key & """"
    p = InStr(1, json, pat, vbTextCompare)
    If p = 0 Then Exit Function
    p = InStr(p + Len(pat), json, ":")
    If p = 0 Then Exit Function
    i = p + 1
    Do While i <= Len(json) And (Mid$(json, i, 1) = " " Or Mid$(json, i, 1) = vbTab)
        i = i + 1
    Loop
    If i > Len(json) Then Exit Function
    If Mid$(json, i, 1) = """" Then
        i = i + 1
        esc = False
        acc = ""
        For j = i To Len(json)
            ch = Mid$(json, j, 1)
            If esc Then
                acc = acc & ch
                esc = False
            ElseIf ch = "\" Then
                esc = True
            ElseIf ch = """" Then
                JsonGetString = acc
                Exit Function
            Else
                acc = acc & ch
            End If
        Next j
    ElseIf Mid$(json, i, 4) = "null" Then
        JsonGetString = ""
    Else
        ' bare number / bool / ident — take until delimiter
        j = i
        Do While j <= Len(json)
            ch = Mid$(json, j, 1)
            If ch = "," Or ch = "}" Or ch = "]" Or ch = " " Or ch = vbCr Or ch = vbLf Then Exit Do
            j = j + 1
        Loop
        JsonGetString = Mid$(json, i, j - i)
    End If
End Function

Private Function JsonGetNumber(ByVal json As String, ByVal key As String) As Double
    Dim s As String
    s = JsonGetString(json, key)
    If Len(s) = 0 Or s = "null" Then
        Err.Raise vbObjectError + 1003, "ZeroVaRApi", "Missing numeric field: " & key
    End If
    JsonGetNumber = CDbl(Val(s))
End Function

Private Function JsonGetNumberOpt(ByVal json As String, ByVal key As String, ByRef found As Boolean) As Double
    Dim s As String
    s = JsonGetString(json, key)
    If Len(s) = 0 Or s = "null" Then
        found = False
        Exit Function
    End If
    found = True
    JsonGetNumberOpt = CDbl(Val(s))
End Function

Private Function UrlEncode(ByVal s As String) As String
    Dim i As Long
    Dim ch As String
    Dim n As Integer
    Dim out As String
    out = ""
    For i = 1 To Len(s)
        ch = Mid$(s, i, 1)
        n = Asc(ch)
        If (n >= 48 And n <= 57) Or (n >= 65 And n <= 90) Or (n >= 97 And n <= 122) _
            Or ch = "-" Or ch = "_" Or ch = "." Or ch = "~" Then
            out = out & ch
        ElseIf ch = " " Then
            out = out & "%20"
        Else
            out = out & "%" & Right$("0" & Hex$(n), 2)
        End If
    Next i
    UrlEncode = out
End Function

Private Function Ccy(ByVal x As Variant) As String
    Ccy = UCase$(Trim$(CStr(x)))
End Function

Private Function DateStr(ByVal d As Variant) As String
    If IsDate(d) Then
        DateStr = Format$(CDate(d), "yyyy-mm-dd")
    Else
        DateStr = Left$(Trim$(CStr(d)), 10)
    End If
End Function

Private Function UdfErr(ByVal ex As ErrObject) As Variant
    UdfErr = "#" & ex.Description
End Function

' ---- Tier A UDFs ------------------------------------------------------------

Public Function ZV_WHOAMI() As Variant
    On Error GoTo Fail
    Dim json As String
    Dim kind As String
    Dim level As String
    Dim subj As String
    json = HttpGet("/api/v1/me")
    kind = JsonGetString(json, "kind")
    level = JsonGetString(json, "level_name")
    If Len(level) = 0 Then level = JsonGetString(json, "level")
    subj = JsonGetString(json, "subject")
    If Len(subj) > 8 Then subj = Left$(subj, 8) & "..."
    If Len(subj) > 0 Then
        ZV_WHOAMI = kind & " | " & level & " | " & subj
    Else
        ZV_WHOAMI = kind & " | " & level
    End If
    Exit Function
Fail:
    ZV_WHOAMI = UdfErr(Err)
End Function

Public Function ZV_SPOT(ByVal base As String, ByVal foreign As String, Optional ByVal side As String = "MID") As Variant
    On Error GoTo Fail
    Dim b As String, f As String, s As String, json As String
    b = Ccy(base)
    f = Ccy(foreign)
    s = UCase$(Trim$(side))
    If Len(s) = 0 Then s = "MID"
    json = HttpGet("/api/v1/excel/spot?base=" & UrlEncode(b) & _
        "&foreign=" & UrlEncode(f) & "&side=" & UrlEncode(s))
    ZV_SPOT = JsonGetNumber(json, "rate")
    Exit Function
Fail:
    ZV_SPOT = UdfErr(Err)
End Function

Public Function ZV_FORWARD(ByVal base As String, ByVal foreign As String, ByVal weeks As Double, Optional ByVal on As Variant) As Variant
    On Error GoTo Fail
    Dim b As String, f As String, path As String, json As String
    Dim mid As Double, rate As Double, found As Boolean
    b = Ccy(base)
    f = Ccy(foreign)
    path = "/api/v1/market/forward?base=" & UrlEncode(b) & _
        "&foreign=" & UrlEncode(f) & "&horizon_weeks=" & UrlEncode(CStr(CLng(weeks)))
    If Not IsMissing(on) Then
        If Len(Trim$(CStr(on))) > 0 Then path = path & "&on=" & UrlEncode(DateStr(on))
    End If
    json = HttpGet(path)
    mid = JsonGetNumberOpt(json, "mid", found)
    If found Then
        ZV_FORWARD = mid
    Else
        ZV_FORWARD = JsonGetNumber(json, "rate")
    End If
    Exit Function
Fail:
    ZV_FORWARD = UdfErr(Err)
End Function

Public Function ZV_VOL(ByVal base As String, ByVal foreign As String, Optional ByVal on As Variant) As Variant
    On Error GoTo Fail
    Dim b As String, f As String, path As String, json As String
    b = Ccy(base)
    f = Ccy(foreign)
    path = "/api/v1/market/volatility?base=" & UrlEncode(b) & "&foreign=" & UrlEncode(f)
    If Not IsMissing(on) Then
        If Len(Trim$(CStr(on))) > 0 Then path = path & "&on=" & UrlEncode(DateStr(on))
    End If
    json = HttpGet(path)
    ZV_VOL = JsonGetNumber(json, "annualised_vol")
    Exit Function
Fail:
    ZV_VOL = UdfErr(Err)
End Function

Public Function ZV_CARRY(ByVal spot As Double, ByVal forward As Double, ByVal tenor_weeks As Double) As Variant
    On Error GoTo Fail
    Dim body As String, json As String
    body = "{""spot"":" & JsonNum(spot) & ",""forward"":" & JsonNum(forward) & _
        ",""tenor_weeks"":" & CLng(tenor_weeks) & "}"
    json = HttpPostJson("/api/v1/analytics/carry", body)
    ZV_CARRY = JsonGetNumber(json, "carry_bps")
    Exit Function
Fail:
    ZV_CARRY = UdfErr(Err)
End Function

Private Function JsonNum(ByVal x As Double) As String
    JsonNum = Replace(CStr(x), ",", ".")
End Function

' Daily spot history as a 2-column spill: date | rate (Excel 365 / 2021 dynamic arrays).
Public Function ZV_SPOT_HISTORY(ByVal base As String, ByVal foreign As String, ByVal startDate As Variant, ByVal endDate As Variant) As Variant
    On Error GoTo Fail
    Dim b As String, f As String, json As String
    Dim points As String
    Dim rows() As Variant
    Dim n As Long, i As Long
    Dim p As Long, objEnd As Long
    Dim obj As String
    Dim d As String, r As String

    b = Ccy(base)
    f = Ccy(foreign)
    json = HttpGet("/api/v1/market/spot/history?base=" & UrlEncode(b) & _
        "&foreign=" & UrlEncode(f) & _
        "&start=" & UrlEncode(DateStr(startDate)) & _
        "&end=" & UrlEncode(DateStr(endDate)))

    points = ExtractJsonArray(json, "points")
    If Len(points) = 0 Then
        Dim emptyArr(1 To 1, 1 To 2) As Variant
        emptyArr(1, 1) = "(no points)"
        emptyArr(1, 2) = ""
        ZV_SPOT_HISTORY = emptyArr
        Exit Function
    End If

    ' Count objects
    n = 0
    p = 1
    Do
        p = InStr(p, points, "{")
        If p = 0 Then Exit Do
        n = n + 1
        p = p + 1
    Loop
    If n = 0 Then
        Dim empty2(1 To 1, 1 To 2) As Variant
        empty2(1, 1) = "(no points)"
        empty2(1, 2) = ""
        ZV_SPOT_HISTORY = empty2
        Exit Function
    End If

    ReDim rows(1 To n, 1 To 2)
    i = 0
    p = 1
    Do
        p = InStr(p, points, "{")
        If p = 0 Then Exit Do
        objEnd = InStr(p, points, "}")
        If objEnd = 0 Then Exit Do
        obj = Mid$(points, p, objEnd - p + 1)
        i = i + 1
        d = JsonGetString(obj, "date")
        r = JsonGetString(obj, "rate")
        rows(i, 1) = d
        If Len(r) > 0 Then rows(i, 2) = CDbl(Val(r)) Else rows(i, 2) = ""
        p = objEnd + 1
        If i >= n Then Exit Do
    Loop
    ZV_SPOT_HISTORY = rows
    Exit Function
Fail:
    ZV_SPOT_HISTORY = UdfErr(Err)
End Function

Private Function ExtractJsonArray(ByVal json As String, ByVal key As String) As String
    Dim pat As String
    Dim p As Long, i As Long, depth As Long
    Dim ch As String
    Dim inStrq As Boolean
    Dim esc As Boolean

    pat = """" & key & """"
    p = InStr(1, json, pat, vbTextCompare)
    If p = 0 Then Exit Function
    p = InStr(p + Len(pat), json, "[")
    If p = 0 Then Exit Function
    depth = 0
    inStrq = False
    esc = False
    For i = p To Len(json)
        ch = Mid$(json, i, 1)
        If inStrq Then
            If esc Then
                esc = False
            ElseIf ch = "\" Then
                esc = True
            ElseIf ch = """" Then
                inStrq = False
            End If
        Else
            If ch = """" Then
                inStrq = True
            ElseIf ch = "[" Then
                depth = depth + 1
            ElseIf ch = "]" Then
                depth = depth - 1
                If depth = 0 Then
                    ExtractJsonArray = Mid$(json, p, i - p + 1)
                    Exit Function
                End If
            End If
        End If
    Next i
End Function

' USD PnL on USD notional for USDSEK-style rates (foreign per 1 USD).
' side: "SELL_USD" (buy SEK) or "BUY_USD" (sell SEK).
Public Function ZV_TCA_PNL(ByVal usd_notional As Double, ByVal side As String, ByVal exec_rate As Double, ByVal arrival_mid As Double) As Variant
    On Error GoTo Fail
    Dim n As Double, rExec As Double, rMid As Double, s As String
    n = usd_notional
    rExec = exec_rate
    rMid = arrival_mid
    If Not (n > 0 And rExec > 0 And rMid > 0) Then
        Err.Raise vbObjectError + 1004, "ZeroVaRApi", "usd_notional, exec_rate, arrival_mid must be positive"
    End If
    s = UCase$(Replace(Trim$(side), " ", "_"))
    If s = "SELL_USD" Or s = "BUY_SEK" Or s = "SELLUSD" Then
        ZV_TCA_PNL = (n * (rMid - rExec)) / rMid
        Exit Function
    End If
    If s = "BUY_USD" Or s = "SELL_SEK" Or s = "BUYUSD" Then
        ZV_TCA_PNL = (n * (rExec - rMid)) / rMid
        Exit Function
    End If
    Err.Raise vbObjectError + 1005, "ZeroVaRApi", "side must be SELL_USD or BUY_USD"
    Exit Function
Fail:
    ZV_TCA_PNL = UdfErr(Err)
End Function

' ---- Smoke ------------------------------------------------------------------

Public Sub ZV_SmokeSpot()
    On Error GoTo Fail
    Dim json As String
    Dim rate As Double
    Dim asOf As String
    json = HttpGet("/api/v1/excel/spot?base=USD&foreign=SEK&side=MID")
    rate = JsonGetNumber(json, "rate")
    asOf = JsonGetString(json, "as_of")
    ActiveSheet.Range("A1").Value = rate
    ActiveSheet.Range("B1").Value = asOf
    MsgBox "USD/SEK mid = " & rate & vbCrLf & asOf, vbInformation, "ZeroVaR"
    Exit Sub
Fail:
    MsgBox Err.Description, vbExclamation, "ZeroVaR"
End Sub