'@Folder modCloudSync
Option Explicit

' ==========================================================
'  VBAFerry 클라우드 동기화
'
'  Builder 가 만든 리포지토리 폴더를 VBAFerry 서버 작업 공간과 주고받는다.
'  서버의 코드는 AI 에이전트가 MCP 로 읽고 고친다.
'
'  매크로:
'   - CloudSyncSetup : 서버 주소와 동기화 토큰 저장 (통합 문서별)
'   - CloudStatus    : 서버 상태 확인
'   - CloudPush      : 리포지토리 폴더 → 서버 (Builder 로 내보낸 뒤 실행)
'   - CloudPull      : 서버 → 리포지토리 폴더 → (선택) Restorer 로 Excel 에 반영
'
'  필요한 모듈: modUtf8File (Builder 또는 Restorer 폴더의 것)
'  토큰은 Windows 사용자 레지스트리에 저장되고 통합 문서에는 저장되지 않는다.
' ==========================================================

Private Const REG_APP As String = "VBAFerry"
Private Const REG_SECTION As String = "CloudSync"
Private Const DEFAULT_SERVER As String = "https://vbaferry.ilhae.ai"
Private Const BUNDLE_MAGIC As String = "VBAFERRY-BUNDLE 1"
Private Const MAX_FILES_IN_MESSAGE As Long = 20

' 서버와 주고받는 파일 (폴더, 확장자). 이 폴더들 안의 해당 확장자 파일만 다룬다
Private Function SyncFolderSpecs() As Variant
    SyncFolderSpecs = Array( _
        Array("VBA\Modules", "bas"), _
        Array("VBA\Classes", "cls"), _
        Array("VBA\Documents", "cls"), _
        Array("VBA\Forms\Code", "cls"), _
        Array("VBA\Forms\ControlsCsv", "csv"))
End Function

' 함께 올리는 통합 문서 정보.
' WorkbookInfo.txt(로컬 절대 경로 포함)와 Names.csv(셀 값 포함 가능)는 올리지 않는다
Private Function SyncWorkbookFiles() As Variant
    SyncWorkbookFiles = Array("Workbook\Sheets.csv", "Workbook\Tables.csv")
End Function

' ==========================================================
'  설정
' ==========================================================

Public Sub CloudSyncSetup()

    Dim wb As Workbook
    Dim serverUrl As String
    Dim token As String

    Set wb = GetTargetWorkbook()
    If wb Is Nothing Then Exit Sub

    serverUrl = InputBox("VBAFerry 서버 주소", "VBAFerry 설정 - " & wb.Name, _
                         GetSetting(REG_APP, REG_SECTION, SettingKey(wb, "Url"), DEFAULT_SERVER))
    If serverUrl = vbNullString Then Exit Sub
    If Right$(serverUrl, 1) = "/" Then serverUrl = Left$(serverUrl, Len(serverUrl) - 1)

    token = InputBox("동기화 토큰 (vbf_ 로 시작)" & vbCrLf & vbCrLf & _
                     "AI 에이전트에게 create_sync_token 도구로 만들어 달라고 하면 받을 수 있습니다.", _
                     "VBAFerry 설정 - " & wb.Name)
    If token = vbNullString Then Exit Sub
    If Left$(token, 4) <> "vbf_" Then
        MsgBox "토큰 형식이 아닙니다. vbf_ 로 시작해야 합니다.", vbExclamation
        Exit Sub
    End If

    SaveSetting REG_APP, REG_SECTION, SettingKey(wb, "Url"), serverUrl
    SaveSetting REG_APP, REG_SECTION, SettingKey(wb, "Token"), token

    CloudStatus

End Sub

Public Sub CloudStatus()

    Dim wb As Workbook
    Dim responseText As String
    Dim statusCode As Long

    Set wb = GetTargetWorkbook()
    If wb Is Nothing Then Exit Sub
    If Not HasSettings(wb) Then Exit Sub

    responseText = SyncRequest(wb, "GET", "status", vbNullString, statusCode)
    If statusCode <> 200 Then
        ShowServerError statusCode, responseText
        Exit Sub
    End If

    MsgBox "서버 연결 확인" & vbCrLf & vbCrLf & _
           "프로젝트: " & ResponseValue(responseText, "PROJECT") & vbCrLf & _
           "버전: " & ResponseValue(responseText, "VERSION") & vbCrLf & _
           "Excel 에 아직 반영하지 않은 서버 변경: " & ResponseValue(responseText, "CHANGED") & "개", vbInformation

End Sub

' ==========================================================
'  올리기: 리포지토리 폴더 → 서버
' ==========================================================

Public Sub CloudPush()

    Dim wb As Workbook
    Dim baseFolder As String
    Dim paths As Collection
    Dim bundle As String
    Dim responseText As String
    Dim statusCode As Long
    Dim changed As Long
    Dim i As Long

    Set wb = GetTargetWorkbook()
    If wb Is Nothing Then Exit Sub
    If Not HasSettings(wb) Then Exit Sub

    baseFolder = RepositoryFolder(wb)
    If Dir$(baseFolder, vbDirectory) = vbNullString Then
        MsgBox "리포지토리 폴더가 없습니다. 먼저 Builder 의 ExportRepositoryForActiveWorkbook 을 실행해 주세요." & vbCrLf & baseFolder, vbExclamation
        Exit Sub
    End If

    ' 서버에 Excel 로 아직 받지 않은 변경이 있으면 덮어쓰게 되므로 먼저 확인한다
    responseText = SyncRequest(wb, "GET", "status", vbNullString, statusCode)
    If statusCode <> 200 Then
        ShowServerError statusCode, responseText
        Exit Sub
    End If
    changed = CLng(Val(ResponseValue(responseText, "CHANGED")))

    If changed > 0 Then
        If MsgBox("서버에 Excel 로 아직 받지 않은 변경이 " & changed & "개 있습니다." & vbCrLf & _
                  "(AI 에이전트가 고친 내용일 수 있습니다)" & vbCrLf & vbCrLf & _
                  "올리면 서버의 그 변경은 이 리포지토리 폴더 내용으로 덮어써집니다." & vbCrLf & _
                  "서버 이력에는 남아서 나중에 되돌릴 수 있습니다." & vbCrLf & vbCrLf & _
                  "그래도 올릴까요? (받아 오려면 [아니요] 후 CloudPull)", _
                  vbYesNo + vbExclamation + vbDefaultButton2) <> vbYes Then Exit Sub
    End If

    Set paths = CollectSyncFiles(baseFolder)
    bundle = BUNDLE_MAGIC & vbLf
    For i = 1 To paths.Count
        bundle = bundle & BundleEntry(paths(i), ReadUtf8Text(baseFolder & "\" & paths(i)))
    Next i
    bundle = bundle & "END" & vbLf

    responseText = SyncRequest(wb, "POST", "push", bundle, statusCode)
    If statusCode <> 200 Then
        ShowServerError statusCode, responseText
        Exit Sub
    End If

    MsgBox "올리기 완료: 파일 " & paths.Count & "개 (서버 버전 " & ResponseValue(responseText, "VERSION") & ")" & vbCrLf & _
           "이제 AI 에이전트가 MCP 로 코드를 읽고 고칠 수 있습니다.", vbInformation

End Sub

' ==========================================================
'  받기: 서버 → 리포지토리 폴더 → Excel
' ==========================================================

Public Sub CloudPull()

    Dim wb As Workbook
    Dim baseFolder As String
    Dim responseText As String
    Dim statusCode As Long
    Dim version As Long
    Dim paths() As String
    Dim contents() As String
    Dim fileCount As Long
    Dim staleFiles As Collection
    Dim message As String
    Dim i As Long
    Dim imported As Boolean

    Set wb = GetTargetWorkbook()
    If wb Is Nothing Then Exit Sub
    If Not HasSettings(wb) Then Exit Sub

    baseFolder = RepositoryFolder(wb)

    responseText = SyncRequest(wb, "GET", "pull", vbNullString, statusCode)
    If statusCode <> 200 Then
        ShowServerError statusCode, responseText
        Exit Sub
    End If

    On Error GoTo Parse_Error
    fileCount = ParseBundle(responseText, version, paths, contents)
    On Error GoTo 0

    ' 서버에 없는 로컬 파일 (AI 가 지운 파일 등)
    Set staleFiles = FindStaleLocalFiles(baseFolder, paths, fileCount)

    message = "서버에서 파일 " & fileCount & "개를 받아 리포지토리 폴더에 씁니다 (서버 버전 " & version & ")." & vbCrLf & baseFolder & vbCrLf
    If staleFiles.Count > 0 Then
        message = message & vbCrLf & "서버에 없는 로컬 파일 " & staleFiles.Count & "개는 삭제합니다:" & vbCrLf
        For i = 1 To staleFiles.Count
            If i > MAX_FILES_IN_MESSAGE Then
                message = message & "… 외 " & (staleFiles.Count - MAX_FILES_IN_MESSAGE) & "개" & vbCrLf
                Exit For
            End If
            message = message & "- " & staleFiles(i) & vbCrLf
        Next i
        message = message & "(Excel 안의 해당 모듈은 자동으로 지워지지 않습니다)" & vbCrLf
    End If
    message = message & vbCrLf & "계속할까요?"

    If MsgBox(message, vbYesNo + vbQuestion) <> vbYes Then Exit Sub

    For i = 0 To fileCount - 1
        CreateFolderTree baseFolder & "\" & ParentFolder(paths(i))
        Call SaveUtf8NoBom(baseFolder & "\" & paths(i), contents(i))
    Next i
    For i = 1 To staleFiles.Count
        Kill baseFolder & "\" & staleFiles(i)
    Next i

    If MsgBox("리포지토리 폴더에 받았습니다." & vbCrLf & vbCrLf & _
              "지금 Restorer(ImportRepositoryForActiveWorkbook)로 Excel 에 반영할까요?" & vbCrLf & _
              "반영하기 전에 통합 문서를 백업했는지 확인하세요.", vbYesNo + vbQuestion) = vbYes Then
        imported = RunRestorer()
    End If

    If imported Then
        ' Excel 에 반영한 경우에만 서버에 알린다.
        ' 알리지 않으면 서버는 "Excel 에 아직 반영 안 된 변경"으로 계속 표시하고, CloudPush 때 경고한다.
        responseText = SyncRequest(wb, "POST", "ack?version=" & version, vbNullString, statusCode)
        If statusCode = 409 Then
            MsgBox "받아 온 뒤에 서버 내용이 또 바뀌었습니다. CloudPull 을 한 번 더 실행해 주세요.", vbExclamation
        ElseIf statusCode <> 200 Then
            ShowServerError statusCode, responseText
        End If
    Else
        MsgBox "Excel 에는 아직 반영하지 않았습니다." & vbCrLf & _
               "Restorer 로 가져온 뒤 CloudPull 을 다시 실행하면 서버에도 반영 완료로 기록됩니다." & vbCrLf & _
               "그 전에 Builder 로 내보내고 CloudPush 하면 받은 변경을 덮어쓰게 되니 주의하세요.", vbInformation
    End If
    Exit Sub

Parse_Error:
    MsgBox "서버 응답을 해석하지 못했습니다: " & Err.Description, vbCritical

End Sub

' Restorer 가 열려 있는 통합 문서에 있으면 실행한다
Private Function RunRestorer() As Boolean

    On Error GoTo Not_Found
    Application.Run "ImportRepositoryForActiveWorkbook"
    ' Restorer 는 일부 항목이 실패해도 끝까지 돌고 결과 창으로 알려 주므로, 사용자에게 확인한다
    RunRestorer = (MsgBox("Restorer 결과 창에 문제(오류·건너뜀)가 없었나요?" & vbCrLf & vbCrLf & _
                          "[예] 를 누르면 서버에 'Excel 반영 완료'로 기록합니다." & vbCrLf & _
                          "문제가 있었다면 [아니요] 를 누르고 확인 후 다시 CloudPull 하세요.", _
                          vbYesNo + vbQuestion) = vbYes)
    Exit Function

Not_Found:
    MsgBox "Restorer 매크로를 실행하지 못했습니다: " & Err.Description & vbCrLf & _
           "Restorer 통합 문서를 연 뒤, 대상 통합 문서를 활성화하고 ImportRepositoryForActiveWorkbook 을 직접 실행해 주세요.", vbExclamation
    RunRestorer = False

End Function

' ==========================================================
'  묶음 형식 (server/src/sync/bundle.ts 와 같은 규칙)
'
'   VBAFERRY-BUNDLE 1
'   VERSION <n>              (서버 → Excel)
'   FILE <길이>[Tab]<경로>
'   <내용>
'   END
'  길이는 Len() 값 (UTF-16 단위). 줄바꿈은 LF.
' ==========================================================

Private Function BundleEntry(ByVal path As String, ByVal content As String) As String

    BundleEntry = "FILE " & CStr(Len(content)) & vbTab & path & vbLf & content & vbLf

End Function

Private Function ParseBundle(ByVal text As String, ByRef version As Long, _
                             ByRef paths() As String, ByRef contents() As String) As Long

    Dim pos As Long
    Dim oneLine As String
    Dim tabPos As Long
    Dim contentLength As Long
    Dim path As String
    Dim n As Long

    pos = 1
    If ReadBundleLine(text, pos) <> BUNDLE_MAGIC Then Err.Raise vbObjectError + 513, , "묶음 머리글이 없습니다"

    ReDim paths(0)
    ReDim contents(0)

    Do
        oneLine = ReadBundleLine(text, pos)

        If oneLine = "END" Then Exit Do

        If Left$(oneLine, 8) = "VERSION " Then
            version = CLng(Mid$(oneLine, 9))
        ElseIf Left$(oneLine, 5) = "FILE " Then
            tabPos = InStr(oneLine, vbTab)
            If tabPos = 0 Then Err.Raise vbObjectError + 514, , "FILE 줄 형식 오류"
            contentLength = CLng(Mid$(oneLine, 6, tabPos - 6))
            path = Mid$(oneLine, tabPos + 1)
            If Not IsSafeRelativePath(path) Then Err.Raise vbObjectError + 515, , "허용하지 않는 경로: " & path

            If pos + contentLength > Len(text) Then Err.Raise vbObjectError + 516, , path & ": 내용이 잘렸습니다"
            If n > 0 Then
                ReDim Preserve paths(n)
                ReDim Preserve contents(n)
            End If
            paths(n) = Replace(path, "/", "\")
            contents(n) = Mid$(text, pos, contentLength)
            pos = pos + contentLength
            If Mid$(text, pos, 1) <> vbLf Then Err.Raise vbObjectError + 517, , path & ": 길이가 맞지 않습니다"
            pos = pos + 1
            n = n + 1
        Else
            Err.Raise vbObjectError + 518, , "알 수 없는 줄: " & Left$(oneLine, 80)
        End If
    Loop

    ParseBundle = n

End Function

Private Function ReadBundleLine(ByVal text As String, ByRef pos As Long) As String

    Dim lf As Long

    lf = InStr(pos, text, vbLf)
    If lf = 0 Then Err.Raise vbObjectError + 519, , "묶음이 중간에 끝났습니다"

    ReadBundleLine = Mid$(text, pos, lf - pos)
    If Right$(ReadBundleLine, 1) = vbCr Then ReadBundleLine = Left$(ReadBundleLine, Len(ReadBundleLine) - 1)
    pos = lf + 1

End Function

' 서버가 이미 검사하지만, 로컬 파일을 쓰기 전에 한 번 더 확인한다
Private Function IsSafeRelativePath(ByVal path As String) As Boolean

    IsSafeRelativePath = Not (path = vbNullString _
        Or InStr(path, "..") > 0 _
        Or InStr(path, ":") > 0 _
        Or InStr(path, "\") > 0 _
        Or Left$(path, 1) = "/" _
        Or (Left$(path, 4) <> "VBA/" And Left$(path, 9) <> "Workbook/"))

End Function

' ==========================================================
'  파일 목록
' ==========================================================

' 올릴 파일의 상대 경로 목록 ("/" 구분)
Private Function CollectSyncFiles(ByVal baseFolder As String) As Collection

    Dim fso As Object
    Dim file As Object
    Dim spec As Variant
    Dim relative As Variant
    Dim result As Collection

    Set fso = CreateObject("Scripting.FileSystemObject")
    Set result = New Collection

    For Each spec In SyncFolderSpecs()
        If fso.FolderExists(baseFolder & "\" & spec(0)) Then
            For Each file In fso.GetFolder(baseFolder & "\" & spec(0)).Files
                If LCase$(fso.GetExtensionName(file.Name)) = spec(1) Then
                    result.Add Replace(spec(0), "\", "/") & "/" & file.Name
                End If
            Next file
        End If
    Next spec

    For Each relative In SyncWorkbookFiles()
        If fso.FileExists(baseFolder & "\" & relative) Then
            result.Add Replace(relative, "\", "/")
        End If
    Next relative

    Set CollectSyncFiles = result

End Function

' 서버 묶음에 없는 로컬 파일 (동기화 폴더 안의 해당 확장자만)
Private Function FindStaleLocalFiles(ByVal baseFolder As String, ByRef paths() As String, ByVal fileCount As Long) As Collection

    Dim fso As Object
    Dim file As Object
    Dim spec As Variant
    Dim relative As String
    Dim known As Object
    Dim i As Long
    Dim result As Collection

    Set fso = CreateObject("Scripting.FileSystemObject")
    Set known = CreateObject("Scripting.Dictionary")
    Set result = New Collection

    For i = 0 To fileCount - 1
        known(LCase$(paths(i))) = True
    Next i

    For Each spec In SyncFolderSpecs()
        If fso.FolderExists(baseFolder & "\" & spec(0)) Then
            For Each file In fso.GetFolder(baseFolder & "\" & spec(0)).Files
                If LCase$(fso.GetExtensionName(file.Name)) = spec(1) Then
                    relative = spec(0) & "\" & file.Name
                    If Not known.Exists(LCase$(relative)) Then result.Add relative
                End If
            Next file
        End If
    Next spec

    Set FindStaleLocalFiles = result

End Function

' ==========================================================
'  HTTP
' ==========================================================

Private Function SyncRequest(ByVal wb As Workbook, ByVal method As String, ByVal action As String, _
                             ByVal bodyText As String, ByRef statusCode As Long) As String

    Dim http As Object

    On Error GoTo Network_Error

    Set http = CreateObject("WinHttp.WinHttpRequest.5.1")
    http.SetTimeouts 10000, 10000, 30000, 120000
    http.Open method, GetSetting(REG_APP, REG_SECTION, SettingKey(wb, "Url"), DEFAULT_SERVER) & "/api/sync/" & action, False
    http.SetRequestHeader "Authorization", "Bearer " & GetSetting(REG_APP, REG_SECTION, SettingKey(wb, "Token"), vbNullString)
    http.SetRequestHeader "Content-Type", "text/plain; charset=utf-8"

    If Len(bodyText) > 0 Then
        http.Send Utf8Bytes(bodyText)
    Else
        http.Send
    End If

    statusCode = http.Status
    SyncRequest = BytesToUtf8(http.ResponseBody)
    Exit Function

Network_Error:
    statusCode = 0
    SyncRequest = Err.Description

End Function

Private Function Utf8Bytes(ByVal text As String) As Byte()

    Dim stm As Object
    Dim bytes() As Byte

    Set stm = CreateObject("ADODB.Stream")
    With stm
        .Type = 2
        .Charset = "utf-8"
        .Open
        .WriteText text
        .Position = 0          ' Type 은 Position 이 0 일 때만 바꿀 수 있다
        .Type = 1
        .Position = 3          ' BOM(EF BB BF) 건너뛰기
        bytes = .Read
        .Close
    End With

    Utf8Bytes = bytes

End Function

Private Function BytesToUtf8(ByVal body As Variant) As String

    Dim stm As Object

    If IsEmpty(body) Then Exit Function
    If (VarType(body) And vbArray) = 0 Then Exit Function
    If UBound(body) < LBound(body) Then Exit Function

    Set stm = CreateObject("ADODB.Stream")
    With stm
        .Type = 1
        .Open
        .Write body
        .Position = 0
        .Type = 2
        .Charset = "utf-8"
        BytesToUtf8 = .ReadText
        .Close
    End With

End Function

Private Sub ShowServerError(ByVal statusCode As Long, ByVal responseText As String)

    Select Case statusCode
        Case 0
            MsgBox "서버에 연결하지 못했습니다: " & responseText & vbCrLf & "인터넷 연결과 서버 주소를 확인해 주세요 (CloudSyncSetup).", vbCritical
        Case 401
            MsgBox "토큰이 유효하지 않습니다: " & responseText & vbCrLf & "AI 에이전트에게 create_sync_token 으로 새 토큰을 받아 CloudSyncSetup 에 넣어 주세요.", vbExclamation
        Case Else
            MsgBox "서버 오류 (" & statusCode & "): " & responseText, vbExclamation
    End Select

End Sub

' "KEY 값" 형식의 응답 줄에서 값 꺼내기
Private Function ResponseValue(ByVal responseText As String, ByVal key As String) As String

    Dim lines() As String
    Dim i As Long

    lines = Split(Replace(responseText, vbCr, vbNullString), vbLf)
    For i = LBound(lines) To UBound(lines)
        If Left$(lines(i), Len(key) + 1) = key & " " Then
            ResponseValue = Mid$(lines(i), Len(key) + 2)
            Exit Function
        End If
    Next i

End Function

' ==========================================================
'  헬퍼
' ==========================================================

Private Function GetTargetWorkbook() As Workbook

    Set GetTargetWorkbook = ActiveWorkbook

    If GetTargetWorkbook Is Nothing Then
        MsgBox "활성화된 통합 문서가 없습니다.", vbExclamation
    ElseIf GetTargetWorkbook.Path = vbNullString Then
        MsgBox "통합 문서가 아직 저장되지 않았습니다. 먼저 저장해 주세요.", vbExclamation
        Set GetTargetWorkbook = Nothing
    End If

End Function

Private Function HasSettings(ByVal wb As Workbook) As Boolean

    HasSettings = GetSetting(REG_APP, REG_SECTION, SettingKey(wb, "Token"), vbNullString) <> vbNullString
    If Not HasSettings Then
        MsgBox "이 통합 문서(" & wb.Name & ")의 동기화 설정이 없습니다. CloudSyncSetup 을 먼저 실행해 주세요.", vbExclamation
    End If

End Function

' 통합 문서마다 다른 토큰을 쓰므로 전체 경로로 구분한다
Private Function SettingKey(ByVal wb As Workbook, ByVal name As String) As String

    SettingKey = name & "|" & LCase$(wb.FullName)

End Function

Private Function RepositoryFolder(ByVal wb As Workbook) As String

    RepositoryFolder = wb.Path & "\ExcelRepository\" & GetNameWithoutExtension(wb.Name) & "_repository"

End Function

Private Function GetNameWithoutExtension(ByVal fileName As String) As String

    Dim pos As Long

    pos = InStrRev(fileName, ".")

    If pos > 0 Then
        GetNameWithoutExtension = Left$(fileName, pos - 1)
    Else
        GetNameWithoutExtension = fileName
    End If

End Function

Private Function ParentFolder(ByVal relativePath As String) As String

    Dim pos As Long

    pos = InStrRev(relativePath, "\")
    If pos > 0 Then ParentFolder = Left$(relativePath, pos - 1)

End Function

Private Sub CreateFolderTree(ByVal folderPath As String)

    Dim fso As Object

    Set fso = CreateObject("Scripting.FileSystemObject")
    If Right$(folderPath, 1) = "\" Then folderPath = Left$(folderPath, Len(folderPath) - 1)
    If folderPath = vbNullString Or fso.FolderExists(folderPath) Then Exit Sub

    CreateFolderTree fso.GetParentFolderName(folderPath)
    fso.CreateFolder folderPath

End Sub