converge/test/RelaySpec.hs

module RelaySpec (spec) where

import Converge
    ( PushEvent (..),
      RepoConfig (..),
      extractLines,
      foldLines,
      handleSSEEvent,
      parseEvent,
    )
import qualified Data.ByteString.Char8 as BSC
import qualified Data.Text as T
import System.FilePath ((</>))
import TestHelper (commitCount, runGitIn, testLogger, withTempGitRepoWithRemote)
import Test.Hspec

spec :: Spec
spec = do
    extractLinesSpec
    foldLinesSpec
    parseEventSpec
    handleSSEEventSpec

----------------------------------------------------------------------
-- extractLines
----------------------------------------------------------------------

extractLinesSpec :: Spec
extractLinesSpec = describe "extractLines" $ do
    it "splits a single line" $ do
        let (lines', leftover) = extractLines (bsc "\n")
        lines' `shouldBe` [bsc ""]
        leftover `shouldBe` bsc ""

    it "splits multiple lines" $ do
        let (lines', leftover) = extractLines (bsc "hello\nworld\n")
        lines' `shouldBe` [bsc "hello", bsc "world"]
        leftover `shouldBe` bsc ""

    it "handles CRLF line endings" $ do
        let (lines', leftover) = extractLines (bsc "hello\r\nworld\r\n")
        lines' `shouldBe` [bsc "hello", bsc "world"]
        leftover `shouldBe` bsc ""

    it "returns partial line as leftover" $ do
        let (lines', leftover) = extractLines (bsc "hello\nwor")
        lines' `shouldBe` [bsc "hello"]
        leftover `shouldBe` bsc "wor"

    it "returns empty for empty input" $ do
        let (lines', leftover) = extractLines (bsc "")
        lines' `shouldBe` []
        leftover `shouldBe` bsc ""

    it "handles line with only CR" $ do
        let (lines', leftover) = extractLines (bsc "\r\n")
        lines' `shouldBe` [bsc ""]
        leftover `shouldBe` bsc ""

----------------------------------------------------------------------
-- foldLines
----------------------------------------------------------------------

foldLinesSpec :: Spec
foldLinesSpec = describe "foldLines" $ do
    it "parses a single push event" $ do
        let lines' =
                [ bsc "event: push",
                  bsc "data: {\"full_name\":\"myorg/myrepo\",\"branch\":\"main\",\"ref\":\"refs/heads/main\"}",
                  bsc ""
                ]
            (finalEvtType, finalDLines, events) = foldLines Nothing [] lines'
        events `shouldBe`
            [ PushEvent
                { peFullName = "myorg/myrepo",
                  peBranch = "main",
                  peRef = "refs/heads/main"
                }
            ]
        finalEvtType `shouldBe` Nothing
        finalDLines `shouldBe` []

    it "parses two push events" $ do
        let lines' =
                [ bsc "event: push",
                  bsc "data: {\"full_name\":\"a/b\",\"branch\":\"main\",\"ref\":\"refs/heads/main\"}",
                  bsc "",
                  bsc "event: push",
                  bsc "data: {\"full_name\":\"c/d\",\"branch\":\"dev\",\"ref\":\"refs/heads/dev\"}",
                  bsc ""
                ]
            (_, _, events) = foldLines Nothing [] lines'
        length events `shouldBe` 2
        peFullName (events !! 0) `shouldBe` "a/b"
        peFullName (events !! 1) `shouldBe` "c/d"

    it "ignores non-push events" $ do
        let lines' =
                [ bsc "event: ping",
                  bsc "data: hello",
                  bsc ""
                ]
            (_, _, events) = foldLines Nothing [] lines'
        events `shouldBe` []

    it "ignores comment lines (starting with colon)" $ do
        let lines' =
                [ bsc ": this is a comment",
                  bsc "event: push",
                  bsc "data: {\"full_name\":\"a/b\",\"branch\":\"main\",\"ref\":\"refs/heads/main\"}",
                  bsc ""
                ]
            (_, _, events) = foldLines Nothing [] lines'
        length events `shouldBe` 1

    it "handles event: without space after colon" $ do
        let lines' =
                [ bsc "event:push",
                  bsc "data:{\"full_name\":\"a/b\",\"branch\":\"main\",\"ref\":\"refs/heads/main\"}",
                  bsc ""
                ]
            (_, _, events) = foldLines Nothing [] lines'
        length events `shouldBe` 1

    it "carries partial state across calls" $ do
        -- First batch: incomplete event (missing blank line)
        let batch1 = [bsc "event: push", bsc "data: {\"full_name\":\"a/b\",\"branch\":\"main\",\"ref\":\"refs/heads/main\"}"]
            (evtType1, dLines1, events1) = foldLines Nothing [] batch1
        events1 `shouldBe` []
        evtType1 `shouldBe` Just "push"
        dLines1 `shouldBe` [bsc "{\"full_name\":\"a/b\",\"branch\":\"main\",\"ref\":\"refs/heads/main\"}"]

        -- Second batch: completes the event
        let batch2 = [bsc ""]
            (_, _, events2) = foldLines evtType1 dLines1 batch2
        length events2 `shouldBe` 1

----------------------------------------------------------------------
-- parseEvent
----------------------------------------------------------------------

parseEventSpec :: Spec
parseEventSpec = describe "parseEvent" $ do
    it "parses a valid push event" $ do
        let evt = parseEvent (Just "push") [bsc "{\"full_name\":\"org/repo\",\"branch\":\"main\",\"ref\":\"refs/heads/main\"}"]
        evt `shouldBe` Just
            PushEvent
                { peFullName = "org/repo",
                  peBranch = "main",
                  peRef = "refs/heads/main"
                }

    it "returns Nothing for non-push event type" $ do
        let evt = parseEvent (Just "ping") [bsc "{}"]
        evt `shouldBe` Nothing

    it "returns Nothing for malformed JSON" $ do
        let evt = parseEvent (Just "push") [bsc "not json"]
        evt `shouldBe` Nothing

    it "handles multiple data lines joined" $ do
        let evt = parseEvent (Just "push")
                [ bsc "{\"full_name\":\"x\"",
                  bsc ",\"branch\":\"y\"",
                  bsc ",\"ref\":\"z\"}"
                ]
        evt `shouldBe` Just
            PushEvent
                { peFullName = "x",
                  peBranch = "y",
                  peRef = "z"
                }

----------------------------------------------------------------------
-- handleSSEEvent (integration — uses real git repos)
----------------------------------------------------------------------

handleSSEEventSpec :: Spec
handleSSEEventSpec = describe "handleSSEEvent" $ do
    it "pulls on a matching repo when a push event arrives" $
        withTempGitRepoWithRemote $ \localRepo -> do
            logger <- testLogger
            -- Simulate someone else pushing: commit locally, push, then reset local behind
            writeFile (localRepo </> "remote-change.txt") "pushed from elsewhere"
            _ <- runGitIn localRepo ["add", "remote-change.txt"]
            _ <- runGitIn localRepo ["commit", "-m", "simulated remote push"]
            _ <- runGitIn localRepo ["push", "origin", "main"]

            -- Verify remote has the commit
            (_, remoteLog, _) <- runGitIn localRepo ["log", "--oneline", "origin/main"]
            let remoteCount = length (filter (not . T.null) (T.lines remoteLog))

            -- Reset local repo to one commit behind
            _ <- runGitIn localRepo ["reset", "--hard", "HEAD~1"]

            -- Verify local is behind
            localBefore <- commitCount localRepo
            localBefore `shouldBe` (remoteCount - 1)

            -- Create a repo config with matching gitea_repo
            let repoCfg =
                    (defaultRepoCfg localRepo)
                        { rcGiteaRepo = Just "test-org/test-repo"
                        }

            -- Send a matching push event
            let evt =
                    PushEvent
                        { peFullName = "test-org/test-repo",
                          peBranch = "main",
                          peRef = "refs/heads/main"
                        }
            handleSSEEvent logger [repoCfg] evt

            -- Local should now have the remote's commit
            localAfter <- commitCount localRepo
            localAfter `shouldBe` remoteCount

    it "ignores events for repos with non-matching gitea_repo" $
        withTempGitRepoWithRemote $ \localRepo -> do
            logger <- testLogger
            let repoCfg =
                    (defaultRepoCfg localRepo)
                        { rcGiteaRepo = Just "test-org/test-repo"
                        }
            let evt =
                    PushEvent
                        { peFullName = "other-org/other-repo",
                          peBranch = "main",
                          peRef = "refs/heads/main"
                        }
            -- This should not crash or pull — it just ignores
            handleSSEEvent logger [repoCfg] evt
            -- Test passes if no exception is thrown

    it "ignores events for repos with non-matching branch" $
        withTempGitRepoWithRemote $ \localRepo -> do
            logger <- testLogger
            let repoCfg =
                    (defaultRepoCfg localRepo)
                        { rcGiteaRepo = Just "test-org/test-repo",
                          rcBranch = "main"
                        }
            let evt =
                    PushEvent
                        { peFullName = "test-org/test-repo",
                          peBranch = "dev",
                          peRef = "refs/heads/dev"
                        }
            commitsBefore <- commitCount localRepo
            handleSSEEvent logger [repoCfg] evt
            commitsAfter <- commitCount localRepo
            commitsAfter `shouldBe` commitsBefore  -- no pull should have happened

    it "skips pull when an operation is in progress" $
        withTempGitRepoWithRemote $ \localRepo -> do
            logger <- testLogger
            -- Create a MERGE_HEAD sentinel to simulate a merge in progress
            (_, gitDirOut, _) <- runGitIn localRepo ["rev-parse", "--git-dir"]
            let sentinelFile = localRepo </> T.unpack (T.strip gitDirOut) </> "MERGE_HEAD"
            writeFile sentinelFile "fake merge head"

            -- Push a new commit to remote
            writeFile (localRepo </> "during-merge.txt") "change during merge"
            _ <- runGitIn localRepo ["add", "during-merge.txt"]
            _ <- runGitIn localRepo ["commit", "-m", "commit during merge"]
            _ <- runGitIn localRepo ["push", "origin", "main"]
            _ <- runGitIn localRepo ["reset", "--hard", "HEAD~1"]

            commitsBefore <- commitCount localRepo

            let repoCfg =
                    (defaultRepoCfg localRepo)
                        { rcGiteaRepo = Just "test-org/test-repo"
                        }
            let evt =
                    PushEvent
                        { peFullName = "test-org/test-repo",
                          peBranch = "main",
                          peRef = "refs/heads/main"
                        }
            handleSSEEvent logger [repoCfg] evt

            commitsAfter <- commitCount localRepo
            commitsAfter `shouldBe` commitsBefore  -- pull should be skipped

----------------------------------------------------------------------
-- Helpers
----------------------------------------------------------------------

-- | Shortcut for ByteString from ASCII.
bsc :: String -> BSC.ByteString
bsc = BSC.pack

-- | Create a default RepoConfig for a given path (for testing).
defaultRepoCfg :: FilePath -> RepoConfig
defaultRepoCfg path =
    RepoConfig
        { rcPath = path,
          rcRemote = "origin",
          rcBranch = "main",
          rcNotifyOnPull = False,
          rcGiteaRepo = Nothing
        }