RecipeInputsE2ESpec.hs

module Seihou.CLI.RecipeInputsE2ESpec (tests) where

import Control.Monad (forM_)
import Data.Aeson qualified as Aeson
import Data.ByteString.Lazy qualified as LBS
import Data.Generics.Labels ()
import Data.Map.Strict qualified as Map
import Data.Text qualified as T
import Data.Text.IO qualified as TIO
import Seihou.CLI.SeedRunE2ESpec (invoke, prepare, readManifest, success)
import Seihou.Core.Types
import Seihou.Prelude
import System.Directory qualified as D
import System.Exit (ExitCode (..))
import System.IO.Temp (withSystemTempDirectory)
import Test.Hspec
import Test.Tasty
import Test.Tasty.Hspec (testSpec)

prepareRecipe root = do
  (binary, modul) <- prepare root
  let other = root </> ".seihou/modules/other"
      recipe = root </> ".seihou/modules/recipe-input-probe"
      body name = "let S = ../demo/schema/package.dhall in S.Module::{name=\"" <> name <> "\",version=Some \"1.0.0\",vars=[S.VarDecl::{name=\"feature\",type=\"bool\",default=Some \"false\"}],steps=[S.Step::{strategy=\"template\",src=\"value\",dest=\"" <> name <> ".txt\"}]}"
  D.createDirectoryIfMissing True (other </> "files")
  D.createDirectoryIfMissing True recipe
  TIO.writeFile (modul </> "module.dhall") (body "demo")
  TIO.writeFile (other </> "module.dhall") (body "other")
  TIO.writeFile (modul </> "files/value") "{{feature}}"
  TIO.writeFile (other </> "files/value") "{{feature}}"
  TIO.writeFile (recipe </> "recipe.dhall") "let S = ../demo/schema/package.dhall in S.Recipe::{name=\"recipe-input-probe\",version=Some \"1.0.0\",modules=[S.Dependency::{module=\"demo\"},S.Dependency::{module=\"other\"}],vars=[S.VarDecl::{name=\"feature\",type=\"bool\",required=True}],prompts=[S.Prompt::{var=\"feature\",text=\"Enable feature?\"}]}"
  pure binary

-- A harmless command records its rendered destination. Rejected runs must
-- preserve both generated bytes and this command log, including on update.
prepareOwnerPolicy root binding recipePolicy memberPolicy = do
  (binary, modul) <- prepare root
  let recipe = root </> ".seihou/modules/owner-policy"
      constraint enabled = if enabled then ",validation=Some \"^topagentnetwork\\$\"" else ""
      declaration enabled = "S.VarDecl::{name=\"git.githubOwner\",type=\"text\",default=Some \"topagentnetwork\"" <> constraint enabled <> "}"
      writeRecipe bound constrained =
        TIO.writeFile (recipe </> "recipe.dhall") $
          "let S = ../demo/schema/package.dhall in S.Recipe::{name=\"owner-policy\",version=Some \"1.0.0\",modules=[S.Dependency::{module=\"demo\""
            <> (if bound then ",vars=[{name=\"git.githubOwner\",value=\"topagentnetwork\"}]" else "")
            <> "}],vars=["
            <> declaration constrained
            <> "]}"
  D.createDirectoryIfMissing True recipe
  TIO.writeFile (modul </> "module.dhall") $
    "let S = ./schema/package.dhall in S.Module::{name=\"demo\",version=Some \"1.0.0\",vars=[" <> declaration memberPolicy <> "],steps=[S.Step::{strategy=\"template\",src=\"owner\",dest=\"owner.txt\"}],commands=[S.Command::{action=S.Command.Action.Apply \"printf '%s\\n' '{{git.githubOwner}}/probe' >> command-log\"}]}"
  TIO.writeFile (modul </> "files/owner") "{{git.githubOwner}}"
  writeRecipe binding recipePolicy
  pure (binary, writeRecipe)

tests :: IO TestTree
tests = testSpec "Recipe inputs" $ do
  it "uses a camelCase owner binding above global config and rejects CLI violations before effects" $
    withSystemTempDirectory "owner-policy" $ \root -> do
      (binary, _) <- prepareOwnerPolicy root True True False
      _ <- success binary root ["config", "set", "git.githubOwner", "someone-else", "--global"]
      _ <- success binary root ["validate-recipe", root </> ".seihou/modules/owner-policy"]
      _ <- success binary root ["run", "owner-policy", "--dry-run"]
      D.doesPathExist (root </> "owner.txt") `shouldReturn` False
      D.doesPathExist (root </> "command-log") `shouldReturn` False
      (code, out, err) <- invoke binary root ["run", "owner-policy", "--var", "git.githubOwner=someone-else"]
      code `shouldBe` ExitFailure 1
      let message = T.pack (out <> err)
      mapM_ (\needle -> message `shouldSatisfy` T.isInfixOf needle) ["git.githubOwner", "--var", "^topagentnetwork$", "--var git.githubOwner=topagentnetwork"]
      D.doesPathExist (root </> "owner.txt") `shouldReturn` False
      D.doesPathExist (root </> "command-log") `shouldReturn` False
      D.doesPathExist (root </> ".seihou/manifest.json") `shouldReturn` False
      D.doesPathExist (root </> ".seihou/config.dhall") `shouldReturn` False
      _ <- success binary root ["run", "owner-policy"]
      TIO.readFile (root </> "owner.txt") `shouldReturn` "topagentnetwork"
      TIO.readFile (root </> "command-log") `shouldReturn` "topagentnetwork/probe\n"
      before <- LBS.readFile (root </> ".seihou/manifest.json")
      forM_ [[], ["--reconfigure"], ["--json"], ["--reconfigure", "--json"]] $ \extra -> do
        (refused, stdout, stderr) <- invoke binary root (["update", "owner-policy", "--var", "git.githubOwner=someone-else"] <> extra)
        refused `shouldBe` ExitFailure 1
        let output = T.pack (stdout <> stderr)
        output `shouldSatisfy` T.isInfixOf "git.githubOwner"
        if "--json" `elem` extra then output `shouldSatisfy` T.isInfixOf "\"code\":\"variable_errors\"" else pure ()
        LBS.readFile (root </> ".seihou/manifest.json") `shouldReturn` before
        TIO.readFile (root </> "owner.txt") `shouldReturn` "topagentnetwork"
        TIO.readFile (root </> "command-log") `shouldReturn` "topagentnetwork/probe\n"
  forM_ [True, False] $ \recipePolicy ->
    it ("revalidates historical personal owner independently; recipe policy=" <> show recipePolicy) $
      withSystemTempDirectory "owner-history" $ \root -> do
        (binary, writeRecipe) <- prepareOwnerPolicy root False False False
        _ <- success binary root ["run", "owner-policy", "--var", "git.githubOwner=someone-else"]
        if recipePolicy
          then writeRecipe False True
          else do
            let modul = root </> ".seihou/modules/demo/module.dhall"
            body <- TIO.readFile modul
            TIO.writeFile modul (T.replace "default=Some \"topagentnetwork\"" "default=Some \"topagentnetwork\",validation=Some \"^topagentnetwork\\$\"" body)
        before <- LBS.readFile (root </> ".seihou/manifest.json")
        (code, out, err) <- invoke binary root ["update", "owner-policy"]
        code `shouldBe` ExitFailure 1
        T.pack (out <> err) `shouldSatisfy` T.isInfixOf "application"
        TIO.readFile (root </> "owner.txt") `shouldReturn` "someone-else"
        TIO.readFile (root </> "command-log") `shouldReturn` "someone-else/probe\n"
        LBS.readFile (root </> ".seihou/manifest.json") `shouldReturn` before
        -- Adoption owns replacing old accepted input when the producer adds a binding.
        writeRecipe True True
        output <- success binary root ["update", "owner-policy", "--json"]
        value <- TIO.readFile (root </> "owner.txt")
        if value == "topagentnetwork" then pure () else expectationFailure (T.unpack output)
  it "validates global config against a consuming module with the original source" $
    withSystemTempDirectory "owner-consumer" $ \root -> do
      (binary, _) <- prepareOwnerPolicy root False False True
      _ <- success binary root ["config", "set", "git.githubOwner", "someone-else", "--global"]
      (code, out, err) <- invoke binary root ["run", "owner-policy"]
      code `shouldBe` ExitFailure 1
      T.pack (out <> err) `shouldSatisfy` T.isInfixOf "global config"
      D.doesPathExist (root </> "owner.txt") `shouldReturn` False
      D.doesPathExist (root </> "command-log") `shouldReturn` False

  it "refuses missing recipe decisions before writing files or manifest" $
    withSystemTempDirectory "recipe-missing" $ \root -> do
      binary <- prepareRecipe root
      (code, out, err) <- invoke binary root ["run", "recipe-input-probe"]
      code `shouldBe` ExitFailure 1
      T.pack (out <> err) `shouldSatisfy` T.isInfixOf "feature"
      D.doesPathExist (root </> "demo.txt") `shouldReturn` False
      D.doesPathExist (root </> ".seihou/manifest.json") `shouldReturn` False
  forM_ ["true", "false"] $ \choice ->
    it ("broadcasts and records " <> T.unpack choice) $
      withSystemTempDirectory "recipe-choice" $ \root -> do
        binary <- prepareRecipe root
        _ <- success binary root ["run", "recipe-input-probe", "--var", "feature=" <> T.unpack choice]
        TIO.readFile (root </> "demo.txt") `shouldReturn` choice
        TIO.readFile (root </> "other.txt") `shouldReturn` choice
        manifest <- readManifest root
        map (^. #recipeInputs) (manifest ^. #applications) `shouldBe` [Just (Map.singleton "feature" choice)]

  it "adopts an older application through ordinary preview and atomic apply" $
    withSystemTempDirectory "recipe-adoption" $ \root -> do
      binary <- prepareRecipe root
      _ <- success binary root ["run", "recipe-input-probe", "--var", "feature=false"]
      accepted <- readManifest root
      -- Construct a supported historical input, as emitted before schema 12.
      let older = accepted & #version .~ ManifestSchemaVersion 11 & #applications %~ map (\app -> app & #recipeInputs .~ Nothing)
          path = root </> ".seihou/manifest.json"
      LBS.writeFile path (Aeson.encode older)
      before <- LBS.readFile path
      _ <- success binary root ["update", "recipe-input-probe", "--dry-run", "--json"]
      LBS.readFile path `shouldReturn` before
      _ <- success binary root ["update", "recipe-input-probe", "--json"]
      adopted <- readManifest root
      map (^. #recipeInputs) (adopted ^. #applications) `shouldBe` [Just (Map.singleton "feature" "false")]
      unchanged <- success binary root ["update", "recipe-input-probe", "--json"]
      unchanged `shouldSatisfy` T.isInfixOf "\"alreadyUpToDate\":true"
  it "replays a recipe-only input after declining config saving" $
    withSystemTempDirectory "recipe-only" $ \root -> do
      binary <- prepareRecipe root
      let recipe = root </> ".seihou/modules/recipe-input-probe/recipe.dhall"
      definition <- TIO.readFile recipe
      TIO.writeFile recipe (T.replace "vars=[S.VarDecl" "vars=[S.VarDecl::{name=\"recipe.only\",type=\"bool\",required=True},S.VarDecl" definition)
      _ <- success binary root ["run", "recipe-input-probe", "--var", "feature=false", "--var", "recipe.only=true", "--no-save-prompted"]
      output <- success binary root ["update", "recipe-input-probe", "--dry-run", "--json"]
      output `shouldSatisfy` T.isInfixOf "\"alreadyUpToDate\":true"
      manifest <- readManifest root
      map (^. #recipeInputs) (manifest ^. #applications) `shouldBe` [Just (Map.fromList [("feature", "false"), ("recipe.only", "true")])]