Attribute VB_Name = "MursketoriAPI"
'
' Mursketori API - Visual Basic 6 module: Quarry Owner
'
' Full CRUD for quarries and piles.
'
' Setup:
'   1. Project > Add Module > Existing, select this file.
'   2. Project > References: tick "Microsoft WinHTTP Services, version 5.1"
'      (if missing, browse to C:\Windows\System32\winhttp.dll)
'   3. Set API_KEY below to your quarry owner key from siteadmin.
'
' JSON parsing note:
'   VB6 has no built-in JSON parser.  The JsonValue() helper below handles
'   simple "key": value pairs.  For iterating over arrays (e.g. quarry list)
'   use InStr/Mid loops or add a JSON library (VB-JSON, mdJSON).
'

Option Explicit

' =============================================================================
' Configuration
' =============================================================================

Public Const API_BASE As String = "https://mursketori.com/API/v1"
Public Const API_KEY  As String = "mrsk_your_owner_key_here"

' =============================================================================
' Core HTTP helper
' =============================================================================

' method : "GET", "POST", "PUT", "DELETE"
' path   : e.g. "/quarries.php" or "/quarries.php?id=42"
' body   : JSON string for POST/PUT; omit or leave "" for GET/DELETE
'
Public Function ApiRequest(ByVal method As String, _
                           ByVal path   As String, _
                           Optional ByVal body As String = "") As String
    Dim http As Object
    Set http = CreateObject("WinHttp.WinHttpRequest.5.1")
    http.Open method, API_BASE & path, False
    http.SetRequestHeader "Authorization", "Bearer " & API_KEY
    http.SetRequestHeader "Accept", "application/json"
    If Len(body) > 0 Then
        http.SetRequestHeader "Content-Type", "application/json"
        http.Send body
    Else
        http.Send
    End If
    ApiRequest = http.ResponseText
    Set http = Nothing
End Function

' =============================================================================
' JSON helper  (simple key/value extractor -- not a full parser)
' =============================================================================

Public Function JsonValue(ByVal json As String, ByVal key As String) As String
    Dim search As String
    Dim pos    As Long
    Dim rest   As String
    Dim endPos As Long
    Dim endPos2 As Long

    search = Chr(34) & key & Chr(34) & ":"
    pos = InStr(json, search)
    If pos = 0 Then Exit Function

    rest = LTrim(Mid(json, pos + Len(search)))

    If Left(rest, 1) = Chr(34) Then
        rest   = Mid(rest, 2)
        endPos = InStr(rest, Chr(34))
        If endPos > 0 Then JsonValue = Left(rest, endPos - 1)
    Else
        endPos  = InStr(rest, ",")
        endPos2 = InStr(rest, "}")
        If endPos2 > 0 And (endPos2 < endPos Or endPos = 0) Then endPos = endPos2
        If endPos > 0 Then
            JsonValue = Trim(Left(rest, endPos - 1))
        Else
            JsonValue = Trim(rest)
        End If
    End If
End Function

' =============================================================================
' QUARRIES
' =============================================================================

' --- List all quarries -------------------------------------------------------
' Returns raw JSON.  Parse with JsonValue() or a JSON library.
'
Public Function ListQuarries() As String
    ListQuarries = ApiRequest("GET", "/quarries.php")
End Function

' --- Get single quarry -------------------------------------------------------
'
Public Function GetQuarry(ByVal quarryId As Long) As String
    GetQuarry = ApiRequest("GET", "/quarries.php?id=" & quarryId)
End Function

' --- Create quarry -----------------------------------------------------------
' Returns new quarry ID on success, 0 on failure.
'
Public Function CreateQuarry(ByVal name   As String, _
                              ByVal city   As String, _
                              ByVal lat    As String, _
                              ByVal lng    As String, _
                              Optional ByVal status As String = "active") As Long
    Dim body As String
    body = "{" & _
           """name"":"""   & name   & """," & _
           """city"":"""   & city   & """," & _
           """lat"":"      & lat    & ","   & _
           """lng"":"      & lng    & ","   & _
           """status"":""" & status & """" & _
           "}"
    Dim resp As String
    resp = ApiRequest("POST", "/quarries.php", body)
    Dim newId As String
    newId = JsonValue(resp, "id")
    If Len(newId) > 0 And IsNumeric(newId) Then
        CreateQuarry = CLng(newId)
    Else
        MsgBox "CreateQuarry error: " & JsonValue(resp, "error"), vbCritical
        CreateQuarry = 0
    End If
End Function

' --- Update quarry -----------------------------------------------------------
' Pass only the fields you want to change as a JSON string.
' Example body: "{""name"":""New Name"",""city"":""Oulu""}"
'
Public Function UpdateQuarry(ByVal quarryId As Long, ByVal body As String) As Boolean
    Dim resp As String
    resp = ApiRequest("PUT", "/quarries.php?id=" & quarryId, body)
    If Len(JsonValue(resp, "error")) > 0 Then
        MsgBox "UpdateQuarry error: " & JsonValue(resp, "error"), vbCritical
        UpdateQuarry = False
    Else
        UpdateQuarry = True
    End If
End Function

' --- Delete quarry -----------------------------------------------------------
'
Public Function DeleteQuarry(ByVal quarryId As Long) As Boolean
    Dim resp As String
    resp = ApiRequest("DELETE", "/quarries.php?id=" & quarryId)
    DeleteQuarry = (JsonValue(resp, "deleted") = "true")
End Function

' =============================================================================
' PILES
' =============================================================================

' --- List piles in a quarry --------------------------------------------------
' Returns raw JSON array.
'
Public Function ListPiles(ByVal quarryId As Long) As String
    ListPiles = ApiRequest("GET", "/piles.php?quarry_id=" & quarryId)
End Function

' --- Get single pile ---------------------------------------------------------
'
Public Function GetPile(ByVal pileId As Long) As String
    GetPile = ApiRequest("GET", "/piles.php?id=" & pileId)
End Function

' --- Create pile -------------------------------------------------------------
' Returns new pile ID on success, 0 on failure.
' forSale: pass "true" or "false"
'
Public Function CreatePile(ByVal quarryId As Long, _
                            ByVal name     As String, _
                            ByVal material As String, _
                            ByVal volume   As String, _
                            ByVal price    As String, _
                            Optional ByVal forSale As String = "false") As Long
    Dim body As String
    body = "{" & _
           """quarry_id"":"  & quarryId & ","   & _
           """name"":"""     & name     & """," & _
           """material"":""" & material & """," & _
           """volume"":"     & volume   & ","   & _
           """price"":"      & price    & ","   & _
           """for_sale"":"   & forSale  & _
           "}"
    Dim resp As String
    resp = ApiRequest("POST", "/piles.php", body)
    Dim newId As String
    newId = JsonValue(resp, "id")
    If Len(newId) > 0 And IsNumeric(newId) Then
        CreatePile = CLng(newId)
    Else
        MsgBox "CreatePile error: " & JsonValue(resp, "error"), vbCritical
        CreatePile = 0
    End If
End Function

' --- Update pile -------------------------------------------------------------
' Pass only changed fields as a JSON string.
' Example body: "{""volume"":800,""price"":9.50,""for_sale"":true}"
'
Public Function UpdatePile(ByVal pileId As Long, ByVal body As String) As Boolean
    Dim resp As String
    resp = ApiRequest("PUT", "/piles.php?id=" & pileId, body)
    If Len(JsonValue(resp, "error")) > 0 Then
        MsgBox "UpdatePile error: " & JsonValue(resp, "error"), vbCritical
        UpdatePile = False
    Else
        UpdatePile = True
    End If
End Function

' --- Delete pile -------------------------------------------------------------
'
Public Function DeletePile(ByVal pileId As Long) As Boolean
    Dim resp As String
    resp = ApiRequest("DELETE", "/piles.php?id=" & pileId)
    DeletePile = (JsonValue(resp, "deleted") = "true")
End Function

' =============================================================================
' Demo: call all functions and show results in a MsgBox
' =============================================================================

Public Sub RunDemo()
    Dim msg As String

    ' List quarries
    Dim list As String
    list = ListQuarries()
    msg = "=== Quarries (raw JSON) ===" & vbCrLf & Left(list, 300)
    MsgBox msg, vbInformation, "Mursketori API Demo"

    ' Create a quarry
    Dim qId As Long
    qId = CreateQuarry("VB6 Test Quarry", "Tampere", "61.50", "23.76")
    If qId = 0 Then Exit Sub
    MsgBox "Created quarry ID: " & qId, vbInformation, "Mursketori API Demo"

    ' Update it
    UpdateQuarry qId, "{""name"":""VB6 Test Quarry (updated)"",""city"":""Oulu""}"
    Dim upd As String
    upd = GetQuarry(qId)
    MsgBox "Updated name: " & JsonValue(upd, "name") & vbCrLf & _
           "City: " & JsonValue(upd, "city"), vbInformation, "Mursketori API Demo"

    ' Create a pile in it
    Dim pId As Long
    pId = CreatePile(qId, "VB6 Test Pile", "0-32", "500", "8.50", "true")
    If pId > 0 Then
        MsgBox "Created pile ID: " & pId, vbInformation, "Mursketori API Demo"
        UpdatePile pId, "{""volume"":750,""price"":9.00}"
        DeletePile pId
        MsgBox "Pile " & pId & " updated and deleted.", vbInformation, "Mursketori API Demo"
    End If

    ' Delete the quarry
    DeleteQuarry qId
    MsgBox "Quarry " & qId & " deleted. Demo complete.", vbInformation, "Mursketori API Demo"
End Sub