SeedTransactionSpec.hs

module Seihou.Engine.SeedTransactionSpec (tests) where

import Control.Exception (IOException)
import Data.Either (isLeft)
import Data.Generics.Labels ()
import Data.Map.Strict qualified as Map
import Data.Set qualified as Set
import Data.Text.IO qualified as TIO
import Data.Time (UTCTime (..), fromGregorian)
import Seihou.Core.Migration qualified as Migration
import Seihou.Core.Types hiding (KeepCurrent)
import Seihou.Effect.BaselineStorePure (runBaselineStorePure)
import Seihou.Effect.Filesystem (PathEntry (..))
import Seihou.Effect.FilesystemInterp (runFilesystem)
import Seihou.Engine.Migrate (validateSeedMigration)
import Seihou.Engine.Reconcile
import Seihou.Engine.Seed (SeedDecision (..))
import Seihou.Engine.UpdateTransaction
import Seihou.Manifest.Hash (baselineRefForContent, hashContent)
import Seihou.Manifest.Types (emptyManifest)
import Seihou.Prelude
import System.Directory qualified as D
import System.IO.Temp (withSystemTempDirectory)
import Test.Hspec
import Test.Tasty
import Test.Tasty.Hspec (testSpec)

tests :: IO TestTree
tests = testSpec "seed update transactions" $ do
  let now = UTCTime (fromGregorian 2026 10 26) 0
      appId = ApplicationId "app"
      app = AppliedComposition appId (AppliedModuleTarget "seeder") (LocalOrigin "seeder") Nothing [] Nothing Nothing [AppliedInstanceState "seeder" emptyParentVars (LocalOrigin "seeder") Nothing Map.empty] Map.empty [] now
      manifest = emptyManifest now & #applications .~ [app]
      claims = Map.singleton appId (Set.singleton "seeder")
      createAction = SeedAction "seed.txt" "seeder" claims SeedWrite (Just "seed bytes\n")
      createPlan = ReconciliationPlan (Set.singleton appId) (Map.singleton "seed.txt" (FileSeedCreate createAction EntryMissing)) Set.empty
      begin root = beginSeedUpdateTransaction root (reconciliationMutationPaths createPlan) (Set.singleton "seed.txt")
      receipt = SeedRecord "seeder" (KnownSeedOwners claims) SeedCreated now
      priorSeed = manifest & #seeds .~ Map.singleton "seed.txt" receipt
      managedOwners = Map.singleton "seed.txt" (DesiredFileOwner "seeder" (Set.singleton appId))
      plan root prior ops owners seedClaims =
        fmap fst $
          runEff $
            runFilesystem $
              runBaselineStorePure Map.empty $
                planSeedReconciliation root root prior (Set.singleton appId) ops owners seedClaims
  it "requires explicit adoption of equal seed bytes and records keep-current against the generated baseline" $
    withSystemTempDirectory "seed-adoption" $ \root -> do
      TIO.writeFile (root </> "seed.txt") "project bytes\n"
      Right pending <- plan root priorSeed [WriteFileOp "seed.txt" "candidate bytes\n" Copy] managedOwners Map.empty
      unresolvedPaths pending `shouldBe` Set.singleton "seed.txt"
      Right kept <- pure (resolveFileConflict "seed.txt" KeepCurrent pending)
      Right transaction <- beginSeedUpdateTransaction root (reconciliationMutationPaths kept) Set.empty
      Right final <- applyReconciliation transaction kept priorSeed
      final ^. #seeds `shouldBe` Map.empty
      fmap (^. #hash) (Map.lookup "seed.txt" (final ^. #files)) `shouldBe` Just (hashContent "project bytes\n")
      fmap (^. #baseline) (Map.lookup "seed.txt" (final ^. #files)) `shouldBe` Just (Just (baselineRefForContent "candidate bytes\n"))
      TIO.readFile (root </> "seed.txt") `shouldReturn` "project bytes\n"
      completeUpdateTransaction transaction `shouldReturn` Right ()
  it "offers only explicit recreation for a missing seed and accepts generated bytes" $
    withSystemTempDirectory "seed-adopt-missing" $ \root -> do
      Right pending <- plan root priorSeed [WriteFileOp "seed.txt" "candidate bytes\n" Copy] managedOwners Map.empty
      resolveFileConflict "seed.txt" KeepCurrent pending `shouldSatisfy` isLeft
      resolveFileConflict "seed.txt" WriteConflictMarkers pending `shouldSatisfy` isLeft
      Right accepted <- pure (resolveFileConflict "seed.txt" AcceptGenerated pending)
      Right transaction <- beginSeedUpdateTransaction root (reconciliationMutationPaths accepted) Set.empty
      Right final <- applyReconciliation transaction accepted priorSeed
      final ^. #seeds `shouldBe` Map.empty
      TIO.readFile (root </> "seed.txt") `shouldReturn` "candidate bytes\n"
      completeUpdateTransaction transaction `shouldReturn` Right ()
  it "preserves unselected seed claims when the selected application retires its claim" $
    withSystemTempDirectory "seed-partial-retirement" $ \root -> do
      let other = app & #applicationId .~ ApplicationId "other"
          sharedClaims = Map.insert (ApplicationId "other") (Set.singleton "seeder") claims
          prior = priorSeed & #applications %~ (<> [other]) & #seeds .~ Map.singleton "seed.txt" (receipt & #ownership .~ KnownSeedOwners sharedClaims)
      D.createDirectory (root </> "seed.txt")
      Right pending <- plan root prior [] Map.empty Map.empty
      reconciliationMutationPaths pending `shouldBe` Set.empty
      Right transaction <- beginSeedUpdateTransaction root Set.empty Set.empty
      Right final <- applyReconciliation transaction pending prior
      fmap (^. #ownership) (Map.lookup "seed.txt" (final ^. #seeds)) `shouldBe` Just (KnownSeedOwners (Map.delete appId sharedClaims))
      D.doesDirectoryExist (root </> "seed.txt") `shouldReturn` True
      completeUpdateTransaction transaction `shouldReturn` Right ()
  it "does not grant release over an unselected managed owner, even with additive certification" $
    withSystemTempDirectory "seed-release-owner" $ \root -> do
      let record = FileRecord (hashContent "generated") "seeder" Copy now Nothing (Set.fromList [appId, ApplicationId "other"]) SharedWriteAdditiveOnly
      result <- plan root (manifest & #files .~ Map.singleton "seed.txt" record) [SeedFileOp "seed.txt" "seed" Copy "seeder"] Map.empty (Map.singleton "seed.txt" claims)
      result `shouldBe` Left (SeedReleaseBlockedByOwners "seed.txt" (Set.singleton (ApplicationId "other")))
  it "guards every declarative migration source, destination, ancestor and portable alias" $ do
    let protected = Set.singleton "nested/seed.txt"
        ops = [Migration.MoveFile "nested/seed.txt" "elsewhere", Migration.MoveFile "elsewhere" "nested/seed.txt", Migration.MoveDir "nested" "other", Migration.MoveDir "other" "nested", Migration.DeleteFile "nested/seed.txt", Migration.DeleteDir "nested", Migration.DeleteFile "NESTED/seed.txt"]
    mapM_ (\op -> validateSeedMigration protected [op] `shouldSatisfy` isLeft) ops
    validateSeedMigration protected [Migration.DeleteFile "unrelated"] `shouldBe` Right ()
  it "releases edited managed files without reading or restoring project bytes" $
    withSystemTempDirectory "seed-release-transaction" $ \root -> do
      let record = FileRecord (hashContent "generated") "seeder" Copy now Nothing (Set.singleton appId) SharedWriteRequiresOwnershipClosure
          prior = manifest & #files .~ Map.singleton "seed.txt" record
          action = SeedAction "seed.txt" "seeder" claims SeedReleaseManaged Nothing
          plan = ReconciliationPlan (Set.singleton appId) (Map.singleton "seed.txt" (FileSeedRelease action record)) Set.empty
      -- A directory cannot be read as text or journaled as an ordinary file;
      -- metadata release still preserves this project-owned replacement.
      D.createDirectory (root </> "seed.txt")
      Right transaction <- beginSeedUpdateTransaction root (reconciliationMutationPaths plan) Set.empty
      Right candidate <- applyReconciliation transaction plan prior
      candidate ^. #files `shouldBe` Map.empty
      fmap (^. #outcome) (Map.lookup "seed.txt" (candidate ^. #seeds)) `shouldBe` Just SeedReleasedFromManaged
      rollbackUpdateTransaction transaction `shouldReturn` Right ()
      D.doesDirectoryExist (root </> "seed.txt") `shouldReturn` True
  it "does not resurrect a missing managed path on release" $
    withSystemTempDirectory "seed-release-missing" $ \root -> do
      let record = FileRecord (hashContent "generated") "seeder" Copy now Nothing (Set.singleton appId) SharedWriteRequiresOwnershipClosure
          action = SeedAction "seed.txt" "seeder" claims SeedReleaseManaged Nothing
          plan = ReconciliationPlan (Set.singleton appId) (Map.singleton "seed.txt" (FileSeedRelease action record)) Set.empty
      Right transaction <- beginSeedUpdateTransaction root Set.empty Set.empty
      Right _ <- applyReconciliation transaction plan (manifest & #files .~ Map.singleton "seed.txt" record)
      D.doesPathExist (root </> "seed.txt") `shouldReturn` False
      rollbackUpdateTransaction transaction `shouldReturn` Right ()
  it "aborts a creation that became occupied without restoring over the new object" $
    withSystemTempDirectory "seed-stale" $ \root -> do
      Right transaction <- begin root
      TIO.writeFile (root </> "seed.txt") "concurrent project file\n"
      result <- applyReconciliation transaction createPlan manifest
      result `shouldSatisfy` isLeft
      TIO.readFile (root </> "seed.txt") `shouldReturn` "concurrent project file\n"
      recoverIncompleteTransactions root >>= (`shouldSatisfy` all (== Right ()))
  it "rolls back only an unchanged seed actually created by the transaction" $
    withSystemTempDirectory "seed-rollback" $ \root -> do
      Right transaction <- begin root
      result <- applyReconciliationWithHook (\_ -> ioError (userError "injected failure")) transaction createPlan manifest
      result `shouldSatisfy` isLeft
      D.doesPathExist (root </> "seed.txt") `shouldReturn` False
  it "recovers completed creation evidence after restart" $
    withSystemTempDirectory "seed-restart" $ \root -> do
      Right transaction <- begin root
      Right _ <- applyReconciliation transaction createPlan manifest
      TIO.readFile (root </> "seed.txt") `shouldReturn` "seed bytes\n"
      recoverIncompleteTransactions root >>= (`shouldSatisfy` all (== Right ()))
      D.doesPathExist (root </> "seed.txt") `shouldReturn` False
  it "preserves later edits and identical replacement objects during failed rollback" $
    mapM_
      ( \replace -> withSystemTempDirectory "seed-rollback-project-edit" $ \root -> do
          Right transaction <- begin root
          let change _ = do
                if replace then D.removeFile (root </> "seed.txt") else pure ()
                TIO.writeFile (root </> "seed.txt") (if replace then "seed bytes\n" else "project edit\n")
                ioError (userError "injected failure")
          result <- applyReconciliationWithHook change transaction createPlan manifest
          result `shouldSatisfy` isLeft
          D.doesFileExist (root </> "seed.txt") `shouldReturn` True
          TIO.readFile (root </> "seed.txt") `shouldReturn` (if replace then "seed bytes\n" else "project edit\n")
      )
      [False, True]