baikai-kit-0.4.0.0: test/Main.hs
{-# LANGUAGE OverloadedStrings #-}
module Main (main) where
import Baikai.Interactive (InteractiveProvider (InteractiveClaude, InteractiveCodex))
import Baikai.Kit
( AgentEntry (..),
InstallOptions (..),
KitCommand (..),
KitCondition (..),
KitConfig (..),
KitError (..),
KitItem (..),
KitItemKind (..),
KitManifest (..),
KitScope (..),
KitVisibility (..),
OutputFormat (..),
OverwritePolicy (..),
PlannedWrite (..),
PullResult (..),
RemovalOutcome (..),
RepoRefresh (..),
SidecarMeta (..),
SkillEntry (..),
UpstreamAvailability (..),
WriteContent (..),
addDisabledSkill,
agentDirsForSession,
checkVisibility,
classify,
codexSessionArgs,
collectStatus,
computeKitHash,
conditionLabel,
defaultInstallOptions,
enableSkillsArgs,
executePlanWith,
findProjectRoot,
installItem,
installedCopies,
kitCommandParser,
kitConfig,
kitJsonFormatVersion,
kitStatus,
listDocument,
loadManifest,
projectRootByMarkers,
pullKitRepo,
readSidecar,
readSkillEntries,
reinstallPresent,
relativeLinkTarget,
removeDisabledSkill,
renderConditions,
renderStatusTable,
renderUninstallReport,
runKit,
runKitCommand,
safeItemName,
safeRelativePath,
safeSourcePath,
sidecarFileName,
sidecarPath,
statusDocument,
stripYamlFrontmatter,
uninstallItem,
updateDocument,
updateKit,
)
import Baikai.Prelude
import Control.Concurrent (threadDelay)
import Control.Exception (finally, try)
import Control.Monad (forM_, void)
import Data.Aeson (Value (..))
import Data.Aeson qualified as Aeson
import Data.Aeson.KeyMap qualified as KeyMap
import Data.Bits ((.&.))
import Data.ByteString qualified as BS
import Data.ByteString.Lazy qualified as LBS
import Data.Foldable (toList)
import Data.IORef (newIORef, readIORef, writeIORef)
import Data.List (find, isInfixOf, isSuffixOf, nub, sort)
import Data.Text qualified as Text
import Data.Text.Encoding qualified as Text.Encoding
import GHC.IO.Handle (hDuplicate, hDuplicateTo)
import Options.Applicative
( ParserResult (..),
defaultPrefs,
execParserPure,
getParseResult,
helper,
info,
renderFailure,
(<**>),
)
import System.Directory
( canonicalizePath,
createDirectoryIfMissing,
createDirectoryLink,
createFileLink,
doesDirectoryExist,
doesFileExist,
doesPathExist,
getCurrentDirectory,
getSymbolicLinkTarget,
listDirectory,
pathIsSymbolicLink,
removeDirectoryRecursive,
removeFile,
renameFile,
withCurrentDirectory,
)
import System.Environment (lookupEnv, setEnv, unsetEnv)
import System.Exit (ExitCode (..))
import System.FilePath (takeDirectory, (</>))
import System.IO (hClose, hFlush, stdout)
import System.IO.Temp (withSystemTempDirectory, withSystemTempFile)
import System.Posix.Files qualified as Posix
import System.Process (readProcessWithExitCode)
import Test.Tasty (TestTree, defaultMain, localOption, testGroup)
import Test.Tasty.HUnit (Assertion, assertBool, assertFailure, testCase, (@?=))
import Test.Tasty.Runners (NumThreads (NumThreads))
import Toml qualified
main :: IO ()
main =
defaultMain $
localOption (NumThreads 1) $
testGroup
"baikai-kit"
[ manifestTests,
hashTests,
pathSafetyTests,
symlinkSafetyTests,
frontmatterTests,
classifyTests,
statusFilesystemTests,
installRoundTripTests,
typedErrorTests,
installFidelityTests,
projectRootTests,
commandTests,
jsonTests,
visibilityTests,
codexVisibilityTests,
visibilityStatusTests,
visibilityRecoveryTests
]
manifestTests :: TestTree
manifestTests =
testGroup
"Manifest backward compatibility"
[ fixtureCase "mori-kit.json" 2 4 0,
fixtureCase "rei-kit.json" 1 9 1,
fixtureCase "seihou-kit.json" 1 2 0
]
fixtureCase :: FilePath -> Int -> Int -> Int -> TestTree
fixtureCase file expectedVersion expectedSkills expectedAgents =
testCase (file <> " decodes") $ do
manifest <- decodeFixture file
(manifest ^. #version) @?= expectedVersion
length (manifest ^. #skills) @?= expectedSkills
length (manifest ^. #agents) @?= expectedAgents
hashTests :: TestTree
hashTests =
testGroup
"Hash"
[ testCase "computeKitHash is deterministic regardless of input order" $
withSystemTempDirectory "baikai-kit-hash" $ \dir -> do
BS.writeFile (dir </> "a.md") "alpha"
BS.writeFile (dir </> "b.md") "beta"
BS.writeFile (dir </> "c.md") "gamma"
h1 <- assertRight =<< computeKitHash dir "." ["a.md", "b.md", "c.md"]
h2 <- assertRight =<< computeKitHash dir "." ["c.md", "a.md", "b.md"]
h1 @?= h2
assertBool "hash should carry sha256 prefix" ("sha256:" `Text.isPrefixOf` h1),
testCase "computeKitHash changes when file content changes" $
withSystemTempDirectory "baikai-kit-hash-mut" $ \dir -> do
BS.writeFile (dir </> "a.md") "alpha"
before <- assertRight =<< computeKitHash dir "." ["a.md"]
BS.writeFile (dir </> "a.md") "alpha-modified"
after <- assertRight =<< computeKitHash dir "." ["a.md"]
assertBool "hashes must differ after content change" (before /= after)
]
classifyTests :: TestTree
classifyTests =
testGroup
"Status.classify"
[ testCase "no sidecar => unknown" $
classify Nothing (Just (mkSkillItem "foo" (Just "1.0"))) (Just "h") @?= [KitUnknown],
testCase "no upstream entry with a sidecar => delisted" $
classify (Just (mkSidecar (Just "1.0") "h")) Nothing (Just "h") @?= [KitDelisted],
testCase "version mismatch => outdated" $
classify
(Just (mkSidecar (Just "1.0") "h"))
(Just (mkSkillItem "foo" (Just "2.0")))
(Just "h")
@?= [KitOutdated],
testCase "version and hash mismatch => outdated+changed-upstream" $
classify
(Just (mkSidecar (Just "1.0") "h1"))
(Just (mkSkillItem "foo" (Just "2.0")))
(Just "h2")
@?= [KitOutdated, KitChangedUpstream],
testCase "hash mismatch => changed-upstream" $
classify
(Just (mkSidecar (Just "1.0") "h1"))
(Just (mkSkillItem "foo" (Just "1.0")))
(Just "h2")
@?= [KitChangedUpstream],
testCase "version and hash match => up-to-date" $
classify
(Just (mkSidecar (Just "1.0") "h"))
(Just (mkSkillItem "foo" (Just "1.0")))
(Just "h")
@?= [],
testCase "no upstream hash on matching version => up-to-date" $
classify
(Just (mkSidecar (Just "1.0") "h"))
(Just (mkAgentItem "foo" (Just "1.0")))
Nothing
@?= [],
testCase "renderConditions joins labels in order" $ do
renderConditions [] @?= "up-to-date"
renderConditions [KitOutdated, KitChangedUpstream, KitLocallyModified] @?= "outdated+changed-upstream+modified"
]
pathSafetyTests :: TestTree
pathSafetyTests =
testGroup
"Path safety"
[ testCase "safeRelativePath accepts and normalises harmless paths" $ do
safeRelativePath "SKILL.md" @?= Right "SKILL.md"
safeRelativePath "skills/review" @?= Right "skills/review"
safeRelativePath "a/./b" @?= Right ("a" </> "b"),
testCase "safeRelativePath rejects zip-slip, absolute paths, backslashes, and NUL" $ do
mapM_
(assertLeft . safeRelativePath)
["", "/etc/passwd", "../x", "a/../../x", "..", "a/..", "a\\..\\b", "a\0b"],
testCase "safeItemName rejects multi-component and hidden names" $ do
safeItemName "reviewer" @?= Right "reviewer"
mapM_ (assertLeft . safeItemName) ["a/b", ".", ".hidden"],
testCase "install refuses a manifest file path that escapes the install root" $
withPreparedKitHome $ \home cache -> do
BS.writeFile (cache </> "kit.json") maliciousManifestJson
result <- installItem testConfig "evil" UserScope defaultInstallOptions
assertKitError "KitUnsafePath" isUnsafePath result
assertFileMissing (takeDirectory home </> "escape.txt")
exitResult <- try @ExitCode (runKit testConfig (KitInstall (Just "evil") UserScope defaultInstallOptions))
exitResult @?= Left (ExitFailure 1),
testCase "uninstall refuses a traversal name" $
withPreparedKitHome $ \home _cache -> do
let victim = home </> "victim"
createDirectoryIfMissing True victim
result <- uninstallItem testConfig "../victim" UserScope
assertKitError "KitUnsafeName" isUnsafeName result
assertDirectoryExists victim
exitResult <- try @ExitCode (runKit testConfig (KitUninstall "../victim" UserScope))
exitResult @?= Left (ExitFailure 1)
assertDirectoryExists victim
]
symlinkSafetyTests :: TestTree
symlinkSafetyTests =
testGroup
"Symlink safety"
[ testCase "safeSourcePath refuses a symlinked component" $
withPreparedKitHome $ \home cache -> do
plantSymlinkedSource home cache
refused <- safeSourcePath cache ("skills" </> "demo" </> "sub" </> "secret.txt")
refused @?= Left (KitSourceSymlink (cache </> "skills" </> "demo" </> "sub"))
absolute <- safeSourcePath cache "/etc/passwd"
case absolute of
Left (KitUnsafePath _ _) -> pure ()
other -> assertFailure ("expected KitUnsafePath, got " <> show other)
plain <- safeSourcePath cache ("skills" </> "demo" </> "SKILL.md")
plain @?= Right (cache </> "skills" </> "demo" </> "SKILL.md"),
testCase "computeKitHash refuses a symlinked source" $
withPreparedKitHome $ \home cache -> do
plantSymlinkedSource home cache
hashed <- computeKitHash cache ("skills" </> "demo") ["SKILL.md", "sub" </> "secret.txt"]
hashed @?= Left (KitSourceSymlink (cache </> "skills" </> "demo" </> "sub")),
testCase "install refuses a symlinked source and writes nothing" $
withPreparedKitHome $ \home cache -> do
plantSymlinkedSource home cache
let claudeSkill = home </> ".config" </> "testkit" </> "agents" </> ".claude" </> "skills" </> "demo"
result <- installItem testConfig "demo" UserScope defaultInstallOptions
assertKitError "KitSourceSymlink" isSourceSymlink result
assertFileMissing (claudeSkill </> "sub" </> "secret.txt")
assertFileMissing (claudeSkill </> "SKILL.md"),
testCase "status reports refused when upstream lists a symlinked source" $
withPreparedKitHome $ \home cache -> do
_ <- assertRight =<< installItem testConfig "demo" UserScope defaultInstallOptions
plantSymlinkedSource home cache
rows <- collectStatus testConfig cache [(UserScope, "user")]
let demoRows = filter ((== "demo") . view #name) rows
assertBool "expected demo status rows" (not (null demoRows))
mapM_ (\row -> row ^. #conditions @?= [KitUpstreamRefused]) demoRows,
testCase "conditionLabel names the refused condition" $
conditionLabel KitUpstreamRefused @?= "refused"
]
frontmatterTests :: TestTree
frontmatterTests =
testGroup
"Frontmatter"
[ testCase "stripYamlFrontmatter handles LF, CRLF, and final delimiter without newline" $ do
stripYamlFrontmatter "---\nname: x\n---\nBody.\n" @?= "Body.\n"
stripYamlFrontmatter "---\r\nname: x\r\n---\r\nBody.\r\n" @?= "Body.\n"
stripYamlFrontmatter "---\nname: x\n---" @?= "",
testCase "stripYamlFrontmatter leaves non-frontmatter and unterminated blocks unchanged" $ do
stripYamlFrontmatter "Body.\n" @?= "Body.\n"
stripYamlFrontmatter "---\nname: x\nBody.\n" @?= "---\nname: x\nBody.\n",
testCase "stripYamlFrontmatter normalises line endings on every branch" $ do
stripYamlFrontmatter "Body.\r\n" @?= "Body.\n"
stripYamlFrontmatter "---\r\nname: x\r\nBody.\r\n" @?= "---\nname: x\nBody.\n"
]
statusFilesystemTests :: TestTree
statusFilesystemTests =
testGroup
"Status filesystem"
[ testCase "sidecarPath drops any agent target extension" $
withPreparedKitHome $ \home _cache -> do
let claudeBase = home </> ".config" </> "testkit" </> "agents"
codexBase = home
sidecar = sidecarFileName testConfig
sidecarPath InteractiveClaude AgentKind "reviewer" claudeBase sidecar
@?= claudeBase </> ".claude" </> "agents" </> "reviewer.testkit-kit.json"
sidecarPath InteractiveCodex AgentKind "reviewer" codexBase sidecar
@?= codexBase </> ".codex" </> "agents" </> "reviewer.testkit-kit.json",
testCase "delisted installed item keeps sidecar version in status" $
withPreparedKitHome $ \_home cache -> do
_ <- assertRight =<< installItem testConfig "demo" UserScope defaultInstallOptions
BS.writeFile (cache </> "kit.json") manifestWithoutDemoJson
rows <- collectStatus testConfig cache [(UserScope, "user")]
let demoRows = filter ((== "demo") . view #name) rows
assertBool "expected demo status rows" (not (null demoRows))
mapM_ (\row -> row ^. #conditions @?= [KitDelisted]) demoRows
mapM_ (\row -> row ^. #installedVersion @?= Just "0.1.0") demoRows,
testCase "version and cached hash drift reports outdated+changed-upstream" $
withPreparedKitHome $ \_home cache -> do
_ <- assertRight =<< installItem testConfig "demo" UserScope defaultInstallOptions
BS.writeFile (cache </> "skills" </> "demo" </> "SKILL.md") "changed instructions\n"
BS.writeFile (cache </> "kit.json") manifestWithDemoVersionJson
rows <- collectStatus testConfig cache [(UserScope, "user")]
let demoRows = filter ((== "demo") . view #name) rows
assertBool "expected demo status rows" (not (null demoRows))
mapM_ (\row -> row ^. #conditions @?= [KitOutdated, KitChangedUpstream]) demoRows,
testCase "an installed item reports no conditions before an edit" $
withPreparedKitHome $ \_home cache -> do
_ <- assertRight =<< installItem testConfig "demo" UserScope defaultInstallOptions
rows <- collectStatus testConfig cache [(UserScope, "user")]
let demoRows = filter ((== "demo") . view #name) rows
assertBool "expected demo status rows" (not (null demoRows))
mapM_ (\row -> row ^. #conditions @?= []) demoRows,
testCase "editing an installed file reports modified" $
withPreparedKitHome $ \home cache -> do
_ <- assertRight =<< installItem testConfig "demo" UserScope defaultInstallOptions
BS.writeFile (userClaudeSkill home </> "SKILL.md") "my edits"
rows <- collectStatus testConfig cache [(UserScope, "user")]
demoConditions rows "claude" >>= (@?= [KitLocallyModified])
demoConditions rows "codex" >>= (@?= []),
testCase "a legacy sidecar reports edits-unknown" $
withPreparedKitHome $ \home cache -> do
_ <- assertRight =<< installItem testConfig "demo" UserScope defaultInstallOptions
BS.writeFile (userClaudeSkill home </> ".testkit-kit.json") legacySidecarJson
rows <- collectStatus testConfig cache [(UserScope, "user")]
conditions <- demoConditions rows "claude"
assertBool ("expected edits-unknown in " <> show conditions) (KitLocalEditsUnknown `elem` conditions)
assertBool ("expected no modified in " <> show conditions) (KitLocallyModified `notElem` conditions),
testCase "modified composes with outdated and changed-upstream" $
withPreparedKitHome $ \home cache -> do
_ <- assertRight =<< installItem testConfig "demo" UserScope defaultInstallOptions
BS.writeFile (userClaudeSkill home </> "SKILL.md") "my edits"
BS.writeFile (cache </> "skills" </> "demo" </> "SKILL.md") "changed instructions\n"
BS.writeFile (cache </> "kit.json") manifestWithDemoVersionJson
rows <- collectStatus testConfig cache [(UserScope, "user")]
demoConditions rows "claude" >>= (@?= [KitOutdated, KitChangedUpstream, KitLocallyModified]),
testCase "status reports modified for exactly what update would skip" $
withPreparedKitHome $ \home cache -> do
-- Keep project scope inside the temporary HOME so the update's
-- project-scope scan never looks at the working directory.
let config = testConfig & #projectRoot .~ pure (home </> "project")
_ <- assertRight =<< installItem config "demo" UserScope defaultInstallOptions
_ <- assertRight =<< installItem config "reviewer" UserScope (InstallOptions Nothing True)
BS.writeFile (userClaudeSkill home </> "SKILL.md") "my edits"
rows <- collectStatus config cache [(UserScope, "user"), (ProjectScope, "project")]
let toScope scopeText = if scopeText == "project" then ProjectScope else UserScope
modifiedByStatus =
nub
[ (row ^. #name, toScope (row ^. #scope))
| row <- rows,
KitLocallyModified `elem` row ^. #conditions
]
manifest <- assertRight =<< loadManifest cache
report <- assertRight =<< reinstallPresent config cache manifest Nothing KeepLocalEdits
sort (report ^. #skipped) @?= sort modifiedByStatus
modifiedByStatus @?= [("demo", UserScope)]
]
where
userClaudeSkill home = home </> ".config" </> "testkit" </> "agents" </> ".claude" </> "skills" </> "demo"
demoConditions rows providerText =
case filter (\row -> row ^. #name == "demo" && row ^. #providers == providerText) rows of
[row] -> pure (row ^. #conditions)
other -> assertFailure ("expected one " <> Text.unpack providerText <> " demo row, got " <> show other)
installRoundTripTests :: TestTree
installRoundTripTests =
testGroup
"Install"
[ testCase "skill and agent round-trip through Claude and Codex layouts with sidecars" $
withPreparedKitHome $ \home _cache -> do
let config = testConfig
claudeBase = home </> ".config" </> "testkit" </> "agents"
codexBase = home
claudeSkill = claudeBase </> ".claude" </> "skills" </> "demo"
codexSkill = codexBase </> ".agents" </> "skills" </> "demo"
claudeAgent = claudeBase </> ".claude" </> "agents" </> "reviewer.md"
codexAgent = codexBase </> ".codex" </> "agents" </> "reviewer.toml"
claudeAgentSidecar = claudeBase </> ".claude" </> "agents" </> "reviewer.testkit-kit.json"
codexAgentSidecar = codexBase </> ".codex" </> "agents" </> "reviewer.testkit-kit.json"
_ <- assertRight =<< installItem config "demo" UserScope defaultInstallOptions
assertFileExists (claudeSkill </> "SKILL.md")
assertFileExists (codexSkill </> "SKILL.md")
assertFileExists (claudeSkill </> ".testkit-kit.json")
meta <- readSidecar (claudeSkill </> ".testkit-kit.json")
case meta of
Just sidecar -> do
(sidecar ^. #name) @?= ("demo" :: Text)
(sidecar ^. #kind) @?= ("skill" :: Text)
Nothing -> assertFailure "expected a skill sidecar"
_ <- assertRight =<< uninstallItem config "demo" UserScope
assertDirectoryMissing claudeSkill
assertDirectoryMissing codexSkill
_ <- assertRight =<< installItem config "reviewer" UserScope (InstallOptions Nothing True)
assertFileExists claudeAgent
assertFileExists codexAgent
assertFileExists claudeAgentSidecar
assertFileExists codexAgentSidecar
toml <- Text.Encoding.decodeUtf8 <$> BS.readFile codexAgent
assertBool "Codex agent TOML should contain developer instructions" ("developer_instructions" `Text.isInfixOf` toml)
_ <- assertRight =<< uninstallItem config "reviewer" UserScope
assertFileMissing claudeAgent
assertFileMissing codexAgent
assertFileMissing claudeAgentSidecar
assertFileMissing codexAgentSidecar,
testCase "Codex TOML strips CRLF YAML frontmatter" $
withPreparedKitHome $ \home cache -> do
let codexAgent = home </> ".codex" </> "agents" </> "reviewer.toml"
BS.writeFile (cache </> "agents" </> "reviewer.md") "---\r\nname: reviewer\r\n---\r\nReview carefully.\r\n"
_ <- assertRight =<< installItem testConfig "reviewer" UserScope (InstallOptions Nothing True)
toml <- Text.Encoding.decodeUtf8 <$> BS.readFile codexAgent
assertBool "frontmatter name should be stripped" (not ("name: reviewer" `Text.isInfixOf` toml))
assertBool "CR characters should be stripped" (not ("\r" `Text.isInfixOf` toml)),
testCase "failed provider write rolls back all staged writes" $
withPreparedKitHome $ \home _cache -> do
let claudeBase = home </> ".config" </> "testkit" </> "agents"
claudeAgent = claudeBase </> ".claude" </> "agents" </> "reviewer.md"
claudeAgentSidecar = claudeBase </> ".claude" </> "agents" </> "reviewer.testkit-kit.json"
BS.writeFile (home </> ".codex") ""
result <- installItem testConfig "reviewer" UserScope (InstallOptions Nothing True)
assertKitError "KitWriteFailed" isWriteFailed result
assertFileMissing claudeAgent
assertFileMissing claudeAgentSidecar
tmpFiles <- findFilesWithSuffix home ".baikai-kit-tmp"
tmpFiles @?= [],
testCase "renderUninstallReport names actual assets and stale metadata" $ do
renderUninstallReport "demo" UserScope [RemovalOutcome InteractiveClaude True False False [] []]
@?= "Uninstalled skill 'demo' from user scope (claude)."
renderUninstallReport "demo" UserScope [RemovalOutcome InteractiveClaude True False False [] [], RemovalOutcome InteractiveCodex True False False [] []]
@?= "Uninstalled skill 'demo' from user scope (claude,codex)."
renderUninstallReport "reviewer" UserScope [RemovalOutcome InteractiveClaude False False True [] []]
@?= "Removed stale kit metadata for 'reviewer' from user scope."
renderUninstallReport "demo" UserScope [RemovalOutcome InteractiveClaude False False False [] []]
@?= "'demo' is not installed in user scope.",
testCase "uninstallItem reports per-provider removals" $
withPreparedKitHome $ \home _cache -> do
let codexSkill = home </> ".agents" </> "skills" </> "demo"
_ <- assertRight =<< installItem testConfig "demo" UserScope defaultInstallOptions
removeDirectoryRecursive codexSkill
outcomes <- assertRight =<< uninstallItem testConfig "demo" UserScope
let claudeOutcome = findOutcome InteractiveClaude outcomes
codexOutcome = findOutcome InteractiveCodex outcomes
view #skillRemoved claudeOutcome @?= True
view #skillRemoved codexOutcome @?= False
view #agentRemoved codexOutcome @?= False
view #sidecarRemoved codexOutcome @?= False,
testCase "pull failure is returned as a typed error" $
withPreparedKitHome $ \_home cache -> do
result <- pullKitRepo testConfig cache
case result of
PullFailed _ -> pure ()
PullSucceeded -> assertFailure "expected fake .git cache pull to fail"
updateResult <- updateKit testConfig Nothing KeepLocalEdits
assertKitError "KitPullFailed" isPullFailed updateResult
]
typedErrorTests :: TestTree
typedErrorTests =
testGroup
"Typed errors"
[ testCase "loadManifest returns typed errors" $
withSystemTempDirectory "baikai-kit-manifest" $ \dir -> do
missing <- loadManifest dir
assertKitError "KitManifestMissing" isManifestMissing missing
BS.writeFile (dir </> "kit.json") "{"
invalid <- loadManifest dir
assertKitError "KitManifestInvalid" isManifestInvalid invalid,
testCase "installItem returns KitItemNotFound" $
withPreparedKitHome $ \_home _cache -> do
result <- installItem testConfig "nope" UserScope defaultInstallOptions
assertKitError "KitItemNotFound" (== KitItemNotFound "nope") result,
testCase "kit status offline on a fresh HOME exits 0" $
withSystemTempDirectory "baikai-kit-offline" $ \tmp -> do
oldHome <- lookupEnv "HOME"
oldCodexHome <- lookupEnv "CODEX_HOME"
let home = tmp </> "home"
config = testConfig & #repoUrl .~ "file:///nonexistent-kit"
createDirectoryIfMissing True home
setEnv "HOME" home
setEnv "CODEX_HOME" (home </> ".codex")
flip finally (restoreHome oldHome >> restoreCodexHome oldCodexHome) $ do
exitResult <- try @ExitCode (runKit config (KitStatus HumanOutput))
exitResult @?= Right ()
report <- kitStatus config
(report ^. #rows) @?= []
case report ^. #upstream of
UpstreamUnavailable (KitCloneFailed _ _) -> pure ()
other -> assertFailure ("expected an unavailable upstream, got " <> show other)
]
installFidelityTests :: TestTree
installFidelityTests =
testGroup
"Install fidelity"
[ testCase "multi-file agent installs every listed file" $
withPreparedKitHome $ \home cache -> do
plantMultiFileAgent cache
let claudeBase = home </> ".config" </> "testkit" </> "agents"
claudeAgents = claudeBase </> ".claude" </> "agents"
codexAgents = home </> ".codex" </> "agents"
_ <- assertRight =<< installItem testConfig "reviewer" UserScope (InstallOptions Nothing True)
assertFileExists (claudeAgents </> "reviewer.md")
assertFileExists (claudeAgents </> "reviewer" </> "guide.md")
assertFileExists (codexAgents </> "reviewer.toml")
assertFileExists (codexAgents </> "reviewer" </> "guide.md")
meta <- readSidecar (claudeAgents </> "reviewer.testkit-kit.json")
case meta of
Just sidecar -> (sidecar ^. #installedFiles) @?= Just ["reviewer.md", "reviewer" <> "/" <> "guide.md"]
Nothing -> assertFailure "expected an agent sidecar"
_ <- assertRight =<< uninstallItem testConfig "reviewer" UserScope
assertDirectoryMissing (claudeAgents </> "reviewer")
assertDirectoryMissing (codexAgents </> "reviewer"),
testCase "phase-two failure restores the previous files" $
withSystemTempDirectory "baikai-kit-journal" $ \dir -> do
BS.writeFile (dir </> "a.txt") "old"
let writes =
[ PlannedWrite {destination = dir </> "a.txt", content = WriteBytes "new"},
PlannedWrite {destination = dir </> "b.txt", content = WriteBytes "new"}
]
failingRename temp dest
| "b.txt" `isSuffixOf` dest = do
takeDirectory temp @?= dir
assertBool "temporary should keep the tmp suffix" (".baikai-kit-tmp" `isSuffixOf` temp)
assertBool "temporary name should be unique" (temp /= dest <> ".baikai-kit-tmp")
ioError (userError "boom")
| otherwise = renameFile temp dest
result <- executePlanWith failingRename writes
case result of
Left (KitWriteFailed _ restored broken) -> do
restored @?= [dir </> "a.txt"]
broken @?= []
other -> assertFailure ("expected KitWriteFailed, got " <> show other)
kept <- BS.readFile (dir </> "a.txt")
kept @?= "old"
assertFileMissing (dir </> "b.txt")
tmpFiles <- findFilesWithSuffix dir ".baikai-kit-tmp"
tmpFiles @?= []
bakFiles <- findFilesWithSuffix dir ".baikai-kit-bak"
bakFiles @?= [],
testCase "destination directory is refused before any write" $
withPreparedKitHome $ \home _cache -> do
let claudeAgents = home </> ".config" </> "testkit" </> "agents" </> ".claude" </> "agents"
createDirectoryIfMissing True (claudeAgents </> "reviewer.md")
result <- installItem testConfig "reviewer" UserScope (InstallOptions Nothing True)
assertKitError "KitWriteFailed" isWriteFailed result
assertFileMissing (home </> ".codex" </> "agents" </> "reviewer.toml"),
testCase "unsupported manifest version is refused" $
withPreparedKitHome $ \_home cache -> do
BS.writeFile (cache </> "kit.json") manifestWithUnsupportedVersionJson
loaded <- loadManifest cache
case loaded of
Left (KitManifestVersionUnsupported _ 99) -> pure ()
other -> assertFailure ("expected KitManifestVersionUnsupported 99, got " <> show other)
installed <- installItem testConfig "demo" UserScope defaultInstallOptions
assertKitError "KitManifestVersionUnsupported" isVersionUnsupported installed,
testCase "a sidecar written before the installed-file fields still decodes" $
case Aeson.eitherDecodeStrict' legacySidecarJson :: Either String SidecarMeta of
Right meta -> do
(meta ^. #name) @?= ("demo" :: Text)
(meta ^. #installedFiles) @?= Nothing
(meta ^. #installedHash) @?= Nothing
Left err -> assertFailure ("expected a legacy sidecar to decode: " <> err),
testCase "update skips locally modified items unless forced" $
withPreparedKitHome $ \home cache -> do
let claudeSkill = home </> ".config" </> "testkit" </> "agents" </> ".claude" </> "skills" </> "demo"
upstream = cache </> "skills" </> "demo" </> "SKILL.md"
_ <- assertRight =<< installItem testConfig "demo" UserScope defaultInstallOptions
BS.writeFile (claudeSkill </> "SKILL.md") "my edits"
BS.writeFile upstream "new upstream"
manifest <- assertRight =<< loadManifest cache
kept <- assertRight =<< reinstallPresent testConfig cache manifest (Just "demo") KeepLocalEdits
(kept ^. #skipped) @?= [("demo", UserScope)]
(kept ^. #updated) @?= []
mine <- BS.readFile (claudeSkill </> "SKILL.md")
mine @?= "my edits"
forced <- assertRight =<< reinstallPresent testConfig cache manifest (Just "demo") OverwriteLocalEdits
(forced ^. #updated) @?= [("demo", UserScope)]
(forced ^. #skipped) @?= []
fresh <- BS.readFile (claudeSkill </> "SKILL.md")
fresh @?= "new upstream"
-- A sidecar from before this release records no installed hash,
-- so the item is reinstalled without the check.
BS.writeFile (claudeSkill </> ".testkit-kit.json") legacySidecarJson
BS.writeFile (claudeSkill </> "SKILL.md") "my edits again"
legacy <- assertRight =<< reinstallPresent testConfig cache manifest (Just "demo") KeepLocalEdits
(legacy ^. #updated) @?= [("demo", UserScope)]
(legacy ^. #skipped) @?= [],
testCase "a write failure during update is returned, not thrown" $
withPreparedKitHome $ \home _cache -> do
let claudeAgents = home </> ".config" </> "testkit" </> "agents" </> ".claude" </> "agents"
cache = home </> ".cache" </> "testkit" </> "kit"
_ <- assertRight =<< installItem testConfig "reviewer" UserScope (InstallOptions Nothing True)
removeFile (claudeAgents </> "reviewer.md")
createDirectoryIfMissing True (claudeAgents </> "reviewer.md")
manifest <- assertRight =<< loadManifest cache
result <- reinstallPresent testConfig cache manifest (Just "reviewer") OverwriteLocalEdits
assertKitError "KitWriteFailed" isWriteFailed result
]
decodeFixture :: FilePath -> IO KitManifest
decodeFixture file = do
bytes <- BS.readFile ("test/fixtures" </> file)
case Aeson.eitherDecodeStrict' bytes of
Right manifest -> pure manifest
Left err -> assertFailure ("failed to decode " <> file <> ": " <> err)
mkSidecar :: Maybe Text -> Text -> SidecarMeta
mkSidecar mVersion h =
SidecarMeta
{ name = "foo",
kind = "skill",
version = mVersion,
hash = h,
installedAt = "2026-05-13T00:00:00Z",
installedFiles = Nothing,
installedHash = Nothing,
visibility = Nothing,
visibilitySource = Nothing,
sharedLinks = Nothing,
codexDisabledSkills = Nothing
}
mkSkillItem :: Text -> Maybe Text -> KitItem
mkSkillItem n mVersion =
KitSkillItem
SkillEntry
{ name = n,
description = "x",
version = mVersion,
path = "skills/foo",
files = ["SKILL.md"],
visibility = Nothing
}
mkAgentItem :: Text -> Maybe Text -> KitItem
mkAgentItem n mVersion =
KitAgentItem
AgentEntry
{ name = n,
description = "x",
version = mVersion,
path = "agents/foo.md",
files = Nothing,
visibility = Nothing
}
jsonTests :: TestTree
jsonTests =
testGroup
"JSON"
[ testCase "kit-status document matches the golden" $
withStatusFixture $ \home proj config -> do
document <- statusDocument <$> kitStatus config
golden "status.json" (normalise home proj document),
testCase "kit-list document matches the golden" $
withStatusFixture $ \home proj config -> do
manifest <- assertRight =<< loadManifest (fixtureCache home)
copies <- installedCopies config
golden "list.json" (normalise home proj (listDocument (UpstreamStale "x") manifest copies)),
testCase "kit-update document matches the golden" $
withPreparedKitHome $ \home cache -> do
let config = testConfig & #projectRoot .~ pure (home </> "project")
_ <- assertRight =<< installItem config "demo" UserScope defaultInstallOptions
_ <- assertRight =<< installItem config "reviewer" UserScope (InstallOptions Nothing True)
BS.writeFile (home </> ".config" </> "testkit" </> "agents" </> ".claude" </> "skills" </> "demo" </> "SKILL.md") "my edits"
manifest <- assertRight =<< loadManifest cache
report <- assertRight =<< reinstallPresent config cache manifest Nothing KeepLocalEdits
golden "update.json" (updateDocument report)
jsonKey "refresh" (updateDocument (report & #refresh .~ Just RepoPulled)) @?= Just (String "pulled"),
testCase "every document names its format version" $
withStatusFixture $ \home _proj config -> do
manifest <- assertRight =<< loadManifest (fixtureCache home)
copies <- installedCopies config
statusDoc <- statusDocument <$> kitStatus config
report <- assertRight =<< reinstallPresent config (fixtureCache home) manifest (Just "no-such-item") KeepLocalEdits
let documents =
[ ("kit-list", listDocument UpstreamReady manifest copies),
("kit-status", statusDoc),
("kit-update", updateDocument report)
]
forM_ documents $ \(name, document) -> do
jsonKey "formatVersion" document @?= Just (Aeson.toJSON kitJsonFormatVersion)
jsonKey "document" document @?= Just (String name),
testCase "status --json parses as one document when the cache is stale" $
withPreparedKitHome $ \_home _cache -> do
_ <- assertRight =<< installItem testConfig "demo" UserScope defaultInstallOptions
(result, out) <- captureStdout (runKitCommand testConfig (KitStatus JsonOutput))
result @?= Right ()
document <- decodeDocument out
(jsonKey "upstream" document >>= jsonKey "state") @?= Just (String "stale"),
testCase "status --json parses as one document when the repository is unreachable" $
withFreshHome $ \_home -> do
let config = testConfig & #repoUrl .~ "file:///nonexistent-kit"
(result, out) <- captureStdout (runKitCommand config (KitStatus JsonOutput))
result @?= Right ()
document <- decodeDocument out
(jsonKey "upstream" document >>= jsonKey "state") @?= Just (String "unavailable")
jsonKey "items" document @?= Just (Array mempty),
testCase "list --json writes nothing to stdout when the repository is unreachable" $
withFreshHome $ \_home -> do
let config = testConfig & #repoUrl .~ "file:///nonexistent-kit"
(result, out) <- captureStdout (runKitCommand config (KitList JsonOutput))
assertKitError "KitCloneFailed" isCloneFailed result
out @?= "",
testCase "list --json keeps the first-clone notice off stdout" $
withFreshHome $ \home -> do
let repoDir = takeDirectory home </> "kit-repo"
createDirectoryIfMissing True (repoDir </> "skills" </> "demo")
createDirectoryIfMissing True (repoDir </> "agents")
BS.writeFile (repoDir </> "skills" </> "demo" </> "SKILL.md") "skill instructions\n"
BS.writeFile (repoDir </> "agents" </> "reviewer.md") "---\nname: reviewer\n---\nReview carefully.\n"
BS.writeFile (repoDir </> "kit.json") manifestJson
git repoDir ["init", "--quiet"]
git repoDir ["add", "."]
git repoDir ["-c", "user.name=test", "-c", "user.email=test@example.com", "commit", "--quiet", "-m", "kit"]
let config = testConfig & #repoUrl .~ ("file://" <> Text.pack repoDir)
(result, out) <- captureStdout (runKitCommand config (KitList JsonOutput))
result @?= Right ()
document <- decodeDocument out
(jsonKey "upstream" document >>= jsonKey "state") @?= Just (String "ready")
case jsonKey "items" document of
Just (Array items) -> map (jsonKey "name") (toList items) @?= [Just (String "demo"), Just (String "reviewer")]
other -> assertFailure ("expected an items array, got " <> show other),
testCase "update --json writes nothing to stdout when the pull fails" $
withPreparedKitHome $ \_home _cache -> do
(result, out) <- captureStdout (runKitCommand testConfig (KitUpdate Nothing KeepLocalEdits JsonOutput))
assertKitError "KitPullFailed" isPullFailed result
out @?= "",
testCase "the command and the encoder agree" $
withStatusFixture $ \home proj config -> do
(result, out) <- captureStdout (runKitCommand config (KitStatus JsonOutput))
result @?= Right ()
document <- decodeDocument out
golden "status.json" (normalise home proj document),
testCase "--json parses on list, status, and update only" $ do
let parse = getParseResult . execParserPure defaultPrefs (info (kitCommandParser testConfig) mempty)
parse ["list", "--json"] @?= Just (KitList JsonOutput)
parse ["status", "--json"] @?= Just (KitStatus JsonOutput)
parse ["update", "--json"] @?= Just (KitUpdate Nothing KeepLocalEdits JsonOutput)
parse ["install", "demo", "--json"] @?= Nothing
]
where
isCloneFailed = \case
KitCloneFailed _ _ -> True
_ -> False
git dir args = do
(code, _out, err) <- readProcessWithExitCode "git" ("-C" : dir : args) ""
assertBool ("git " <> unwords args <> " failed: " <> err) (code == ExitSuccess)
decodeDocument out = case Aeson.eitherDecodeStrict' out of
Right document -> pure document
Left err -> assertFailure ("stdout is not one JSON document (" <> err <> "): " <> show out)
-- | A temporary, empty @HOME@ for the duration of the action.
withFreshHome :: (FilePath -> IO a) -> IO a
withFreshHome action =
withSystemTempDirectory "baikai-kit-fresh" $ \tmp -> do
oldHome <- lookupEnv "HOME"
oldCodexHome <- lookupEnv "CODEX_HOME"
let home = tmp </> "home"
createDirectoryIfMissing True home
setEnv "HOME" home
setEnv "CODEX_HOME" (home </> ".codex")
action home `finally` (restoreHome oldHome >> restoreCodexHome oldCodexHome)
fixtureCache :: FilePath -> FilePath
fixtureCache home = home </> ".cache" </> "testkit" </> "kit"
-- | Seven items covering every status condition, both kinds, both scopes,
-- and both providers. The action gets @HOME@, the project root, and a
-- config whose project scope is that root.
withStatusFixture :: (FilePath -> FilePath -> KitConfig -> IO a) -> IO a
withStatusFixture action =
withPreparedKitHome $ \home cache -> do
let proj = takeDirectory home </> "project"
config = testConfig & #projectRoot .~ pure proj
skills = ["alpha", "beta", "gamma", "delta", "epsilon"]
agents = ["reviewer", "planner"]
claudeBase = home </> ".config" </> "testkit" </> "agents" </> ".claude"
createDirectoryIfMissing True proj
forM_ skills $ \n -> do
createDirectoryIfMissing True (cache </> "skills" </> n)
BS.writeFile (cache </> "skills" </> n </> "SKILL.md") ("the " <> Text.Encoding.encodeUtf8 (Text.pack n) <> " skill\n")
forM_ agents $ \n ->
BS.writeFile (cache </> "agents" </> (n <> ".md")) ("---\nname: " <> Text.Encoding.encodeUtf8 (Text.pack n) <> "\n---\nBe helpful.\n")
BS.writeFile (cache </> "kit.json") (fixtureManifest [] [])
forM_ ["alpha", "gamma", "epsilon", "reviewer"] $ \n ->
void (assertRight =<< installItem config n UserScope (InstallOptions Nothing True))
forM_ ["beta", "delta", "planner"] $ \n ->
void (assertRight =<< installItem config n ProjectScope (InstallOptions Nothing True))
-- alpha: the Codex copy loses its sidecar => unknown.
removeFile (home </> ".agents" </> "skills" </> "alpha" </> ".testkit-kit.json")
-- gamma: its Claude shared link is lost; the Codex copy predates visibility.
removeFile (home </> ".claude/skills/gamma")
let gammaSidecar = home </> ".agents/skills/gamma/.testkit-kit.json"
gammaMeta <- requireSidecar gammaSidecar
LBS.writeFile gammaSidecar (Aeson.encode (gammaMeta & #visibility .~ Nothing & #visibilitySource .~ Nothing))
-- gamma: upstream sources change without a version bump => changed-upstream.
BS.writeFile (cache </> "skills" </> "gamma" </> "SKILL.md") "the gamma skill, revised\n"
-- epsilon: upstream now lists a file through a symbolic link => refused.
let outsideDir = takeDirectory home </> "outside"
createDirectoryIfMissing True outsideDir
BS.writeFile (outsideDir </> "secret.txt") "top secret\n"
createDirectoryLink outsideDir (cache </> "skills" </> "epsilon" </> "sub")
-- reviewer: the Claude copy is edited => modified.
BS.writeFile (claudeBase </> "agents" </> "reviewer.md") "my own reviewer\n"
-- planner: the Claude sidecar predates the installed-file hash => edits-unknown.
let plannerSidecar = proj </> ".testkit" </> "agents" </> ".claude" </> "agents" </> "planner.testkit-kit.json"
sidecar <- maybe (assertFailure "expected the planner sidecar") pure =<< readSidecar plannerSidecar
LBS.writeFile plannerSidecar (Aeson.encode (sidecar & #installedFiles .~ Nothing & #installedHash .~ Nothing))
-- beta: version bump => outdated; delta: removed => delisted.
BS.writeFile (cache </> "kit.json") (fixtureManifest ["beta"] ["delta"])
action home proj config
-- | The fixture manifest: every item at 0.1.0 except those in @bumped@
-- (0.2.0), without those in @removed@; once anything is bumped, epsilon
-- also lists a file below its symlinked @sub@ directory.
fixtureManifest :: [Text] -> [Text] -> BS.ByteString
fixtureManifest bumped removed =
Text.Encoding.encodeUtf8 $
"{\"version\":2,\"skills\":["
<> Text.intercalate "," [skill n | n <- ["alpha", "beta", "gamma", "delta", "epsilon"], n `notElem` removed]
<> "],\"agents\":["
<> Text.intercalate "," [agent n | n <- ["reviewer", "planner"], n `notElem` removed]
<> "]}"
where
final = not (null bumped)
version n = if n `elem` bumped then "0.2.0" else "0.1.0"
files n
| n == "epsilon" && final = "[\"SKILL.md\",\"sub/secret.txt\"]"
| otherwise = "[\"SKILL.md\"]"
skill n =
"{\"name\":\""
<> n
<> "\",\"description\":\"The "
<> n
<> " skill\",\"version\":\""
<> version n
<> "\",\"path\":\"skills/"
<> n
<> "\",\"files\":"
<> files n
<> (if n `elem` ["alpha", "gamma"] then ",\"visibility\":\"shared\"" else "")
<> "}"
agent n =
"{\"name\":\""
<> n
<> "\",\"description\":\"The "
<> n
<> " agent\",\"version\":\""
<> version n
<> "\",\"path\":\"agents/"
<> n
<> ".md\"}"
-- | Run an action with stdout sent to a file, and return what it wrote.
-- The pause first lets tasty's reporter finish writing the test name,
-- which it does on stdout from another thread as the test starts.
captureStdout :: IO a -> IO (a, BS.ByteString)
captureStdout action =
withSystemTempFile "baikai-kit-stdout" $ \file fileHandle -> do
threadDelay 200000
hFlush stdout
saved <- hDuplicate stdout
hDuplicateTo fileHandle stdout
result <-
action `finally` do
hFlush stdout
hDuplicateTo saved stdout
hClose saved
hClose fileHandle
out <- BS.readFile file
pure (result, out)
-- | Replace the temporary directories in every string with @$HOME@ and
-- @$PROJECT@, and any upstream detail (git's message, which names paths
-- and varies by git version) with @<detail>@.
normalise :: FilePath -> FilePath -> Value -> Value
normalise home proj = go
where
go = \case
String t -> String (Text.replace (Text.pack proj) "$PROJECT" (Text.replace (Text.pack home) "$HOME" t))
Array values -> Array (fmap go values)
Object o -> Object (KeyMap.mapWithKey (\key value -> if key == "upstream" then upstream value else go value) o)
other -> other
upstream = \case
Object o -> Object (KeyMap.mapWithKey (\key value -> if key == "detail" && value /= Null then String "<detail>" else value) o)
other -> other
-- | Compare with @test/golden/<file>@, or write it when
-- @BAIKAI_KIT_ACCEPT_GOLDEN@ is set. Values are compared decoded, so key
-- order and whitespace are not part of the contract.
golden :: FilePath -> Value -> Assertion
golden file value = do
let path = "test" </> "golden" </> file
accept <- lookupEnv "BAIKAI_KIT_ACCEPT_GOLDEN"
case accept of
Just _ -> do
createDirectoryIfMissing True ("test" </> "golden")
LBS.writeFile path (Aeson.encode value <> "\n")
Nothing -> do
expected <- Aeson.eitherDecodeFileStrict' path
case expected of
Left err -> assertFailure ("cannot read golden " <> path <> ": " <> err)
Right expectedValue ->
assertBool
("golden " <> path <> " differs.\nexpected: " <> show (Aeson.encode expectedValue) <> "\nactual: " <> show (Aeson.encode value))
(expectedValue == (value :: Value))
jsonKey :: Aeson.Key -> Value -> Maybe Value
jsonKey key = \case
Object o -> KeyMap.lookup key o
_ -> Nothing
commandTests :: TestTree
commandTests =
testGroup
"Command"
[ testCase "install parses with and without a name" $ do
parse ["install"] @?= Just (KitInstall Nothing UserScope defaultInstallOptions)
parse ["install", "demo", "--project"] @?= Just (KitInstall (Just "demo") ProjectScope defaultInstallOptions)
parse [] @?= Just (KitList HumanOutput),
testCase "install help names the tool's project directory" $
case execParserPure defaultPrefs (info (kitCommandParser testConfig <**> helper) mempty) ["install", "--help"] of
Failure failure -> do
let rendered = fst (renderFailure failure "kit")
assertBool ("expected .testkit/agents in help:\n" <> rendered) (".testkit/agents" `isInfixOf` rendered)
_ -> assertFailure "expected --help to produce help text",
testCase "install with no name and no chooser is a KitItemNameRequired error" $ do
result <- runKitCommand testConfig (KitInstall Nothing UserScope defaultInstallOptions)
result @?= Left KitItemNameRequired
exitResult <- try @ExitCode (runKit testConfig (KitInstall Nothing UserScope defaultInstallOptions))
exitResult @?= Left (ExitFailure 1),
testCase "install with no name installs what the chooser returns" $
withPreparedKitHome $ \home _cache -> do
seen <- newIORef []
let chooser manifest = do
writeIORef seen (map (view #name) (manifest ^. #skills) ++ map (view #name) (manifest ^. #agents))
pure (Just "demo")
config = testConfig & #chooseItem .~ Just chooser
result <- runKitCommand config (KitInstall Nothing UserScope defaultInstallOptions)
result @?= Right ()
assertFileExists (userClaudeDemo home </> "SKILL.md")
readIORef seen >>= (@?= ["demo", "reviewer"]),
testCase "a cancelled choice installs nothing and succeeds" $
withPreparedKitHome $ \home _cache -> do
let config = testConfig & #chooseItem .~ Just (\_ -> pure Nothing)
result <- runKitCommand config (KitInstall Nothing UserScope defaultInstallOptions)
result @?= Right ()
assertDirectoryMissing (userClaudeDemo home)
exitResult <- try @ExitCode (runKit config (KitInstall Nothing UserScope defaultInstallOptions))
exitResult @?= Right ()
assertDirectoryMissing (userClaudeDemo home),
testCase "a chosen name the manifest lacks is KitItemNotFound" $
withPreparedKitHome $ \_home _cache -> do
let config = testConfig & #chooseItem .~ Just (\_ -> pure (Just "nope"))
result <- runKitCommand config (KitInstall Nothing UserScope defaultInstallOptions)
result @?= Left (KitItemNotFound "nope")
]
where
parse = getParseResult . execParserPure defaultPrefs (info (kitCommandParser testConfig) mempty)
userClaudeDemo home = home </> ".config" </> "testkit" </> "agents" </> ".claude" </> "skills" </> "demo"
projectRootTests :: TestTree
projectRootTests =
testGroup
"Project root"
[ testCase "findProjectRoot walks up from a nested directory" $
withMarkedTree $ \root -> do
found <- findProjectRoot [rootMarker] (root </> "a" </> "b")
found @?= Just root,
testCase "findProjectRoot accepts a start directory that is itself the root" $
withMarkedTree $ \root -> do
found <- findProjectRoot [rootMarker] root
found @?= Just root,
testCase "findProjectRoot returns Nothing when no marker exists" $
withMarkedTree $ \root -> do
found <- findProjectRoot [".testkit-no-such-marker"] (root </> "a")
found @?= Nothing
withCurrentDirectory (root </> "a") $ do
resolved <- projectRootByMarkers [".testkit-no-such-marker"]
cwd <- getCurrentDirectory
resolved @?= cwd,
testCase "a configured root puts project scope in one place" $
withPreparedKitHome $ \_home _cache ->
withProjectTree $ \proj -> do
let config = testConfig & #projectRoot .~ pure proj
claudeSkill = proj </> ".testkit" </> "agents" </> ".claude" </> "skills" </> "demo"
withCurrentDirectory (proj </> "src" </> "deep") $
void (assertRight =<< installItem config "demo" ProjectScope defaultInstallOptions)
assertFileExists (claudeSkill </> "SKILL.md")
assertFileExists (proj </> ".agents" </> "skills" </> "demo" </> "SKILL.md")
assertDirectoryMissing (proj </> "src" </> "deep" </> ".testkit")
withCurrentDirectory (proj </> "docs") $ do
assertProjectRow config
dirs <- agentDirsForSession config
assertBool
("expected the project agents dir in " <> show dirs)
((proj </> ".testkit" </> "agents") `elem` dirs)
outcomes <- assertRight =<< uninstallItem config "demo" ProjectScope
let rendered = renderUninstallReport "demo" ProjectScope outcomes
assertBool
("unexpected uninstall report: " <> Text.unpack rendered)
("Uninstalled skill 'demo' from project scope" `Text.isPrefixOf` rendered)
assertDirectoryMissing claudeSkill
let markerConfig = testConfig & #projectRoot .~ projectRootByMarkers [rootMarker]
withCurrentDirectory (proj </> "src" </> "deep") $
void (assertRight =<< installItem markerConfig "demo" ProjectScope defaultInstallOptions)
assertFileExists (claudeSkill </> "SKILL.md")
withCurrentDirectory (proj </> "docs") $ assertProjectRow markerConfig,
testCase "without a resolver, project scope is the current directory" $
withPreparedKitHome $ \_home _cache ->
withProjectTree $ \proj ->
withCurrentDirectory (proj </> "src" </> "deep") $ do
_ <- assertRight =<< installItem testConfig "demo" ProjectScope defaultInstallOptions
cwd <- getCurrentDirectory
assertFileExists (cwd </> ".testkit" </> "agents" </> ".claude" </> "skills" </> "demo" </> "SKILL.md")
assertDirectoryMissing (proj </> ".testkit")
]
where
assertProjectRow config = do
report <- kitStatus config
let projectRows = filter (\row -> row ^. #name == "demo" && row ^. #scope == "project") (report ^. #rows)
assertBool "expected a project-scope status row for demo" (not (null projectRows))
-- | A marker no real directory above the system temporary directory can
-- hold, so a walk to the filesystem root cannot find someone's @.git@.
rootMarker :: FilePath
rootMarker = ".testkit-root-marker"
-- | @root/.testkit-root-marker@ and @root/a/b@, with @root@ canonical so
-- it compares equal to paths the resolver builds.
withMarkedTree :: (FilePath -> IO a) -> IO a
withMarkedTree action =
withSystemTempDirectory "baikai-kit-root" $ \tmp -> do
root <- (</> "root") <$> canonicalizePath tmp
createDirectoryIfMissing True (root </> "a" </> "b")
BS.writeFile (root </> rootMarker) ""
action root
-- | A project with a root marker, @src/deep@, and @docs@.
withProjectTree :: (FilePath -> IO a) -> IO a
withProjectTree action =
withSystemTempDirectory "baikai-kit-project" $ \tmp -> do
proj <- (</> "proj") <$> canonicalizePath tmp
createDirectoryIfMissing True (proj </> "src" </> "deep")
createDirectoryIfMissing True (proj </> "docs")
BS.writeFile (proj </> rootMarker) ""
action proj
testConfig :: KitConfig
testConfig = kitConfig "testkit" "file:///not-used" [InteractiveClaude, InteractiveCodex]
withPreparedKitHome :: (FilePath -> FilePath -> IO a) -> IO a
withPreparedKitHome action =
withSystemTempDirectory "baikai-kit-home" $ \tmp -> do
oldHome <- lookupEnv "HOME"
oldCodexHome <- lookupEnv "CODEX_HOME"
let home = tmp </> "home"
cache = home </> ".cache" </> "testkit" </> "kit"
createDirectoryIfMissing True (cache </> ".git")
createDirectoryIfMissing True (cache </> "skills" </> "demo")
createDirectoryIfMissing True (cache </> "agents")
BS.writeFile (cache </> "skills" </> "demo" </> "SKILL.md") "skill instructions\n"
BS.writeFile (cache </> "agents" </> "reviewer.md") "---\nname: reviewer\n---\nReview carefully.\n"
BS.writeFile (cache </> "kit.json") manifestJson
setEnv "HOME" home
setEnv "CODEX_HOME" (home </> ".codex")
action home cache `finally` (restoreHome oldHome >> restoreCodexHome oldCodexHome)
restoreCodexHome :: Maybe String -> IO ()
restoreCodexHome Nothing = unsetEnv "CODEX_HOME"
restoreCodexHome (Just value) = setEnv "CODEX_HOME" value
restoreHome :: Maybe String -> IO ()
restoreHome Nothing = unsetEnv "HOME"
restoreHome (Just value) = setEnv "HOME" value
-- | Plant a committed-symlink kit: a directory link out of the checkout
-- and a manifest that lists a file below it.
plantSymlinkedSource :: FilePath -> FilePath -> IO ()
plantSymlinkedSource home cache = do
let outsideDir = takeDirectory home </> "outside"
createDirectoryIfMissing True outsideDir
BS.writeFile (outsideDir </> "secret.txt") "top secret\n"
createDirectoryLink outsideDir (cache </> "skills" </> "demo" </> "sub")
BS.writeFile (cache </> "kit.json") manifestWithSymlinkedFileJson
manifestWithSymlinkedFileJson :: BS.ByteString
manifestWithSymlinkedFileJson =
Text.Encoding.encodeUtf8 $
Text.concat
[ "{\"version\":2,",
"\"skills\":[{",
"\"name\":\"demo\",",
"\"description\":\"Demo skill\",",
"\"version\":\"0.1.0\",",
"\"path\":\"skills/demo\",",
"\"files\":[\"SKILL.md\",\"sub/secret.txt\"]",
"}],",
"\"agents\":[]} "
]
-- | Rewrite the fixture kit so its agent lists two files below a
-- directory of its own.
plantMultiFileAgent :: FilePath -> IO ()
plantMultiFileAgent cache = do
createDirectoryIfMissing True (cache </> "agents" </> "reviewer")
BS.writeFile (cache </> "agents" </> "reviewer" </> "reviewer.md") "---\nname: reviewer\n---\nReview carefully.\n"
BS.writeFile (cache </> "agents" </> "reviewer" </> "guide.md") "How to review.\n"
BS.writeFile (cache </> "kit.json") manifestWithMultiFileAgentJson
manifestWithMultiFileAgentJson :: BS.ByteString
manifestWithMultiFileAgentJson =
Text.Encoding.encodeUtf8 $
Text.concat
[ "{\"version\":2,",
"\"skills\":[],",
"\"agents\":[{",
"\"name\":\"reviewer\",",
"\"description\":\"Review agent\",",
"\"version\":\"0.1.0\",",
"\"path\":\"agents/reviewer\",",
"\"files\":[\"reviewer.md\",\"guide.md\"]",
"}]} "
]
manifestWithUnsupportedVersionJson :: BS.ByteString
manifestWithUnsupportedVersionJson =
Text.Encoding.encodeUtf8 $
Text.concat
[ "{\"version\":99,",
"\"skills\":[{",
"\"name\":\"demo\",",
"\"description\":\"Demo skill\",",
"\"version\":\"0.1.0\",",
"\"path\":\"skills/demo\",",
"\"files\":[\"SKILL.md\"]",
"}],",
"\"agents\":[]} "
]
legacySidecarJson :: BS.ByteString
legacySidecarJson =
"{\"name\":\"demo\",\"kind\":\"skill\",\"version\":\"0.1.0\",\"hash\":\"sha256:x\",\"installedAt\":\"t\"}"
manifestJson :: BS.ByteString
manifestJson =
Text.Encoding.encodeUtf8 $
Text.concat
[ "{\"version\":2,",
"\"skills\":[{",
"\"name\":\"demo\",",
"\"description\":\"Demo skill\",",
"\"version\":\"0.1.0\",",
"\"path\":\"skills/demo\",",
"\"files\":[\"SKILL.md\"]",
"}],",
"\"agents\":[{",
"\"name\":\"reviewer\",",
"\"description\":\"Review agent\",",
"\"version\":\"0.1.0\",",
"\"path\":\"agents/reviewer.md\"",
"}]} "
]
manifestWithoutDemoJson :: BS.ByteString
manifestWithoutDemoJson =
Text.Encoding.encodeUtf8 $
Text.concat
[ "{\"version\":2,",
"\"skills\":[],",
"\"agents\":[{",
"\"name\":\"reviewer\",",
"\"description\":\"Review agent\",",
"\"version\":\"0.1.0\",",
"\"path\":\"agents/reviewer.md\"",
"}]} "
]
manifestWithDemoVersionJson :: BS.ByteString
manifestWithDemoVersionJson =
Text.Encoding.encodeUtf8 $
Text.concat
[ "{\"version\":2,",
"\"skills\":[{",
"\"name\":\"demo\",",
"\"description\":\"Demo skill\",",
"\"version\":\"0.2.0\",",
"\"path\":\"skills/demo\",",
"\"files\":[\"SKILL.md\"]",
"}],",
"\"agents\":[{",
"\"name\":\"reviewer\",",
"\"description\":\"Review agent\",",
"\"version\":\"0.1.0\",",
"\"path\":\"agents/reviewer.md\"",
"}]} "
]
maliciousManifestJson :: BS.ByteString
maliciousManifestJson =
Text.Encoding.encodeUtf8 $
Text.concat
[ "{\"version\":2,",
"\"skills\":[{",
"\"name\":\"evil\",",
"\"description\":\"Evil skill\",",
"\"version\":\"0.1.0\",",
"\"path\":\"skills/demo\",",
"\"files\":[\"../../../../escape.txt\"]",
"}],",
"\"agents\":[]} "
]
isUnsafePath :: KitError -> Bool
isUnsafePath = \case KitUnsafePath _ _ -> True; _ -> False
isUnsafeName :: KitError -> Bool
isUnsafeName = \case KitUnsafeName _ _ -> True; _ -> False
isSourceSymlink :: KitError -> Bool
isSourceSymlink = \case KitSourceSymlink _ -> True; _ -> False
isWriteFailed :: KitError -> Bool
isWriteFailed = \case KitWriteFailed {} -> True; _ -> False
isPullFailed :: KitError -> Bool
isPullFailed = \case KitPullFailed _ -> True; _ -> False
isManifestMissing :: KitError -> Bool
isManifestMissing = \case KitManifestMissing _ -> True; _ -> False
isVersionUnsupported :: KitError -> Bool
isVersionUnsupported = \case KitManifestVersionUnsupported _ _ -> True; _ -> False
isManifestInvalid :: KitError -> Bool
isManifestInvalid = \case KitManifestInvalid _ _ -> True; _ -> False
assertKitError :: (Show a) => String -> (KitError -> Bool) -> Either KitError a -> IO ()
assertKitError label matches result =
case result of
Left err | matches err -> pure ()
other -> assertFailure ("expected " <> label <> ", got " <> show other)
assertRight :: (Show e) => Either e a -> IO a
assertRight = \case
Right value -> pure value
Left err -> assertFailure ("expected Right, got Left " <> show err)
assertLeft :: (Show b) => Either a b -> IO ()
assertLeft result =
case result of
Left _ -> pure ()
Right value -> assertFailure ("expected Left, got Right " <> show value)
assertFileExists :: FilePath -> IO ()
assertFileExists path = do
exists <- doesFileExist path
assertBool ("expected file to exist: " <> path) exists
assertFileMissing :: FilePath -> IO ()
assertFileMissing path = do
exists <- doesFileExist path
assertBool ("expected file to be missing: " <> path) (not exists)
assertDirectoryMissing :: FilePath -> IO ()
assertDirectoryMissing path = do
exists <- doesDirectoryExist path
assertBool ("expected directory to be missing: " <> path) (not exists)
assertDirectoryExists :: FilePath -> IO ()
assertDirectoryExists path = do
exists <- doesDirectoryExist path
assertBool ("expected directory to exist: " <> path) exists
findFilesWithSuffix :: FilePath -> String -> IO [FilePath]
findFilesWithSuffix root suffix = do
exists <- doesPathExist root
if not exists
then pure []
else do
isDir <- doesDirectoryExist root
if not isDir
then pure [root | suffix `isSuffixOf` root]
else do
names <- listDirectory root
fmap concat $ mapM (\name -> findFilesWithSuffix (root </> name) suffix) names
findOutcome :: InteractiveProvider -> [RemovalOutcome] -> RemovalOutcome
findOutcome expected outcomes =
case find ((== expected) . view #provider) outcomes of
Just outcome -> outcome
Nothing -> error "expected provider outcome"
visibilityTests :: TestTree
visibilityTests =
testGroup
"visibility"
[ testCase "a manifest item without visibility installs tool-only" $
withPreparedKitHome $ \home _ -> do
_ <- assertRight =<< installItem testConfig "demo" UserScope defaultInstallOptions
assertFileExists (ownedDemo home </> "SKILL.md")
assertDirectoryMissing (sharedDemo home)
meta <- demoSidecar home
meta ^. #visibility @?= Just "tool-only"
meta ^. #visibilitySource @?= Just "manifest",
testCase "a shared item links into ~/.claude/skills" $
withPreparedKitHome $ \home cache -> do
declareShared cache
_ <- assertRight =<< installItem testConfig "demo" UserScope defaultInstallOptions
getSymbolicLinkTarget (sharedDemo home) >>= (@?= ownedDemo home)
BS.readFile (sharedDemo home </> "SKILL.md") >>= (@?= "skill instructions\n")
meta <- demoSidecar home
meta ^. #sharedLinks @?= Just [Text.pack (sharedDemo home)],
testCase "a project-scope shared item uses a relative link" $
withPreparedKitHome $ \home _ -> do
let root = takeDirectory home </> "project"
config = testConfig & #projectRoot .~ pure root
_ <- assertRight =<< installItem config "demo" ProjectScope sharedOptions
getSymbolicLinkTarget (root </> ".claude/skills/demo") >>= (@?= "../../.testkit/agents/.claude/skills/demo"),
testCase "relativeLinkTarget handles siblings and descendants" $ do
relativeLinkTarget "/a/.claude/skills" "/a/.tool/agents/.claude/skills/demo" @?= "../../.tool/agents/.claude/skills/demo"
relativeLinkTarget "/a" "/a/b/c" @?= "b/c",
testCase "kit install --shared overrides the manifest and update keeps it" $
withPreparedKitHome $ \home cache -> do
_ <- assertRight =<< installItem testConfig "demo" UserScope sharedOptions
updateDemo cache
assertBool "shared link survives" =<< pathIsSymbolicLink (sharedDemo home)
meta <- demoSidecar home
meta ^. #visibilitySource @?= Just "install-flag",
testCase "update follows a changed manifest default" $
withPreparedKitHome $ \home cache -> do
_ <- assertRight =<< installItem testConfig "demo" UserScope defaultInstallOptions
declareShared cache
updateDemo cache
assertBool "new manifest creates link" =<< pathIsSymbolicLink (sharedDemo home),
testCase "update changes linked content without touching the link" $
withPreparedKitHome $ \home cache -> do
_ <- assertRight =<< installItem testConfig "demo" UserScope sharedOptions
before <- getSymbolicLinkTarget (sharedDemo home)
inodeBefore <- Posix.getSymbolicLinkStatus (sharedDemo home)
BS.writeFile (cache </> "skills/demo/SKILL.md") "new content\n"
updateDemo cache
getSymbolicLinkTarget (sharedDemo home) >>= (@?= before)
inodeAfter <- Posix.getSymbolicLinkStatus (sharedDemo home)
Posix.fileID inodeAfter @?= Posix.fileID inodeBefore
Posix.modificationTimeHiRes inodeAfter @?= Posix.modificationTimeHiRes inodeBefore
BS.readFile (sharedDemo home </> "SKILL.md") >>= (@?= "new content\n"),
testCase "update recreates a deleted link including when local edits skip content" $
withPreparedKitHome $ \home cache -> do
_ <- assertRight =<< installItem testConfig "demo" UserScope sharedOptions
removeFile (sharedDemo home)
updateDemo cache
assertBool "link repaired" =<< pathIsSymbolicLink (sharedDemo home)
BS.writeFile (ownedDemo home </> "SKILL.md") "local edits\n"
removeFile (sharedDemo home)
manifest <- assertRight =<< loadManifest cache
report <- assertRight =<< reinstallPresent testConfig cache manifest (Just "demo") KeepLocalEdits
report ^. #skipped @?= [("demo", UserScope)]
BS.readFile (sharedDemo home </> "SKILL.md") >>= (@?= "local edits\n"),
testCase "uninstall removes the link and nothing else" $
withPreparedKitHome $ \home _ -> do
_ <- assertRight =<< installItem testConfig "demo" UserScope sharedOptions
createDirectoryIfMissing True (home </> ".claude/skills/other")
outcomes <- assertRight =<< uninstallItem testConfig "demo" UserScope
concatMap (view #linksRemoved) outcomes @?= [sharedDemo home]
assertDirectoryExists (home </> ".claude/skills/other")
assertDirectoryMissing (sharedDemo home),
testCase "a shared install refuses a foreign skill directory before any write" $
withPreparedKitHome $ \home _ -> do
createDirectoryIfMissing True (sharedDemo home)
BS.writeFile (sharedDemo home </> "SKILL.md") "foreign\n"
result <- installItem testConfig "demo" UserScope sharedOptions
assertKitError "shared name taken" isNameTaken result
BS.readFile (sharedDemo home </> "SKILL.md") >>= (@?= "foreign\n")
assertDirectoryMissing (ownedDemo home)
assertDirectoryMissing (home </> ".agents/skills/demo"),
testCase "a shared install names the owning tool even for a dangling link" $
withPreparedKitHome $ \home _ -> do
createDirectoryIfMissing True (home </> ".claude/skills")
createDirectoryLink (home </> ".config/rei/agents/.claude/skills/demo") (sharedDemo home)
result <- installItem testConfig "demo" UserScope sharedOptions
case result of
Left (KitSharedNameTaken _ owner) -> owner @?= Just "rei"
other -> assertFailure (show other),
testCase "a Codex install refuses a skill directory without this tool's sidecar" $
withPreparedKitHome $ \home _ -> do
let path = home </> ".agents/skills/demo"
createDirectoryIfMissing True path
BS.writeFile (path </> "SKILL.md") "foreign\n"
result <- installItem testConfig "demo" UserScope defaultInstallOptions
assertKitError "shared name taken" isNameTaken result
BS.readFile (path </> "SKILL.md") >>= (@?= "foreign\n")
assertDirectoryMissing (ownedDemo home),
testCase "the parser accepts --shared, --tool-only and --accept-shared-codex" $ do
let parse = getParseResult . execParserPure defaultPrefs (info (kitCommandParser testConfig) mempty)
parse ["install", "demo"] @?= Just (KitInstall (Just "demo") UserScope defaultInstallOptions)
parse ["install", "demo", "--shared"] @?= Just (KitInstall (Just "demo") UserScope sharedOptions)
parse ["install", "demo", "--tool-only"] @?= Just (KitInstall (Just "demo") UserScope (InstallOptions (Just ToolOnlyVisibility) False))
parse ["install", "demo", "--accept-shared-codex"] @?= Just (KitInstall (Just "demo") UserScope (InstallOptions Nothing True))
parse ["install", "demo", "--shared", "--tool-only"] @?= Nothing,
testCase "an unknown visibility value is an invalid manifest" $
withPreparedKitHome $ \_ cache -> do
BS.writeFile (cache </> "kit.json") (Text.Encoding.encodeUtf8 (Text.replace "\"name\":\"demo\"" "\"visibility\":\"public\",\"name\":\"demo\"" (Text.Encoding.decodeUtf8 manifestJson)))
assertKitError "invalid manifest" isInvalid =<< loadManifest cache,
testCase "legacy visibility survives update until explicit reinstall" $
withPreparedKitHome $ \home cache -> do
_ <- assertRight =<< installItem testConfig "demo" UserScope defaultInstallOptions
_ <- assertRight =<< removeDisabledSkill (codexConfig home) (codexDemo home)
forM_ [ownedDemo home, home </> ".agents/skills/demo"] $ \dir -> do
meta <- requireSidecar (dir </> ".testkit-kit.json")
LBS.writeFile (dir </> ".testkit-kit.json") (Aeson.encode (meta & #visibility .~ Nothing & #visibilitySource .~ Nothing & #sharedLinks .~ Nothing & #codexDisabledSkills .~ Nothing))
declareShared cache
updateDemo cache
assertDirectoryMissing (sharedDemo home)
meta <- demoSidecar home
meta ^. #visibility @?= Nothing
legacy <- assertRight =<< checkVisibility testConfig InteractiveCodex UserScope SkillKind "demo"
legacy ^. #effective @?= SharedVisibility
_ <- assertRight =<< installItem testConfig "demo" UserScope (InstallOptions (Just ToolOnlyVisibility) False)
modern <- assertRight =<< checkVisibility testConfig InteractiveCodex UserScope SkillKind "demo"
modern ^. #requested @?= Just ToolOnlyVisibility
modern ^. #effective @?= ToolOnlyVisibility,
testCase "shared multi-file agents link the body and resources" $
withPreparedKitHome $ \home cache -> do
plantMultiFileAgent cache
_ <- assertRight =<< installItem testConfig "reviewer" UserScope sharedOptions
BS.readFile (home </> ".claude/agents/reviewer/guide.md") >>= (@?= "How to review.\n")
assertBool "agent link" =<< pathIsSymbolicLink (home </> ".claude/agents/reviewer.md")
outcomes <- assertRight =<< uninstallItem testConfig "reviewer" UserScope
length (concatMap (view #linksRemoved) outcomes) @?= 2
]
where
isNameTaken KitSharedNameTaken {} = True
isNameTaken _ = False
isInvalid KitManifestInvalid {} = True
isInvalid _ = False
sharedOptions :: InstallOptions
sharedOptions = InstallOptions (Just SharedVisibility) False
ownedDemo :: FilePath -> FilePath
ownedDemo home = home </> ".config/testkit/agents/.claude/skills/demo"
sharedDemo :: FilePath -> FilePath
sharedDemo home = home </> ".claude/skills/demo"
requireSidecar :: FilePath -> IO SidecarMeta
requireSidecar path = maybe (assertFailure ("missing sidecar: " <> path)) pure =<< readSidecar path
demoSidecar :: FilePath -> IO SidecarMeta
demoSidecar home = requireSidecar (ownedDemo home </> ".testkit-kit.json")
declareShared :: FilePath -> IO ()
declareShared cache = do
bytes <- BS.readFile (cache </> "kit.json")
BS.writeFile (cache </> "kit.json") (Text.Encoding.encodeUtf8 (Text.replace "\"name\":\"demo\"" "\"visibility\":\"shared\",\"name\":\"demo\"" (Text.Encoding.decodeUtf8 bytes)))
updateDemo :: FilePath -> IO ()
updateDemo cache = do
manifest <- assertRight =<< loadManifest cache
void (assertRight =<< reinstallPresent testConfig cache manifest (Just "demo") KeepLocalEdits)
codexVisibilityTests :: TestTree
codexVisibilityTests =
testGroup
"visibility"
[ testCase "a tool-only Codex skill adds one disabled config entry" $
withCodexHome $ \home _ -> do
_ <- assertRight =<< installItem testConfig "demo" UserScope defaultInstallOptions
expected <- canonicalizePath (codexDemo home)
entries <- assertRight =<< readSkillEntries (codexConfig home)
entries @?= [(expected, False)]
meta <- requireSidecar (takeDirectory (codexDemo home) </> ".testkit-kit.json")
meta ^. #codexDisabledSkills @?= Just [Text.pack expected]
_ <- assertRight =<< installItem testConfig "demo" UserScope defaultInstallOptions
entries2 <- assertRight =<< readSkillEntries (codexConfig home)
entries2 @?= entries,
testCase "the config edit preserves the user's text and permissions" $
withCodexHome $ \home _ -> do
forM_ ["", "# no final newline", "# my config\n[projects.\"/x\"]\ntrust_level = \"trusted\"\n\n[[skills.config]]\npath = \"/user/other/SKILL.md\"\nenabled = false\n"] $ \seed -> do
createDirectoryIfMissing True (home </> ".codex")
BS.writeFile (codexConfig home) seed
Posix.setFileMode (codexConfig home) 0o600
_ <- assertRight =<< installItem testConfig "demo" UserScope defaultInstallOptions
infoBefore <- Posix.getFileStatus (codexConfig home)
Posix.fileMode infoBefore .&. 0o777 @?= 0o600
outcomes <- assertRight =<< uninstallItem testConfig "demo" UserScope
expected <- canonicalizePath (codexDemo home)
concatMap (view #configEntriesRemoved) outcomes @?= [expected]
BS.readFile (codexConfig home) >>= (@?= seed),
testCase "a shared Codex skill writes no entry and switching to shared removes ours" $
withCodexHome $ \home _ -> do
_ <- assertRight =<< installItem testConfig "demo" UserScope sharedOptions
assertFileMissing (codexConfig home)
_ <- assertRight =<< installItem testConfig "demo" UserScope defaultInstallOptions
_ <- assertRight =<< installItem testConfig "demo" UserScope sharedOptions
entries <- assertRight =<< readSkillEntries (codexConfig home)
entries @?= [],
testCase "codexSessionArgs re-enables exactly this tool's hidden skills" $
withCodexHome $ \home _ -> do
let root = takeDirectory home </> "project"
config = testConfig & #projectRoot .~ pure root
_ <- assertRight =<< installItem config "demo" UserScope defaultInstallOptions
_ <- assertRight =<< installItem config "demo" ProjectScope defaultInstallOptions
_ <- assertRight =<< addDisabledSkill (codexConfig home) (home </> "other/SKILL.md")
user <- canonicalizePath (codexDemo home)
project <- canonicalizePath (root </> ".agents/skills/demo/SKILL.md")
args <- codexSessionArgs config
parseArgs args @?= parseArgs (enableSkillsArgs [user, project])
codexSessionArgs (config & #providers .~ [InteractiveClaude]) >>= (@?= []),
testCase "a symlinked Codex config is refused untouched before writes" $
withCodexHome $ \home _ -> do
createDirectoryIfMissing True (home </> ".codex")
BS.writeFile (home </> "generated.toml") "# generated\n"
createFileLink (home </> "generated.toml") (codexConfig home)
result <- installItem testConfig "demo" UserScope defaultInstallOptions
case result of
Left (KitCodexConfigUnusable _ message) -> assertBool "manual block is in error" ("[[skills.config]]" `Text.isInfixOf` message)
other -> assertFailure (show other)
assertDirectoryMissing (ownedDemo home)
assertFileMissing (codexDemo home)
getSymbolicLinkTarget (codexConfig home) >>= (@?= home </> "generated.toml")
BS.readFile (home </> "generated.toml") >>= (@?= "# generated\n"),
testCase "inline arrays, malformed TOML, and enabled=true are refused" $
withCodexHome $ \home _ -> do
createDirectoryIfMissing True (home </> ".codex")
path <- canonicalizePath (codexDemo home)
forM_ ["[skills]\nconfig = []\n", "invalid = [", "[[skills.config]]\npath = \"" <> Text.Encoding.encodeUtf8 (Text.pack path) <> "\"\nenabled = true\n"] $ \seed -> do
BS.writeFile (codexConfig home) seed
result <- installItem testConfig "demo" UserScope defaultInstallOptions
assertKitError "unusable config" isConfigError result
BS.readFile (codexConfig home) >>= (@?= seed)
assertDirectoryMissing (ownedDemo home),
testCase "an existing disabled entry is reused and survives uninstall" $
withCodexHome $ \home _ -> do
_ <- assertRight =<< addDisabledSkill (codexConfig home) (codexDemo home)
seed <- BS.readFile (codexConfig home)
_ <- assertRight =<< installItem testConfig "demo" UserScope defaultInstallOptions
meta <- requireSidecar (takeDirectory (codexDemo home) </> ".testkit-kit.json")
meta ^. #codexDisabledSkills @?= Just []
args <- codexSessionArgs (testConfig & #projectRoot .~ pure (takeDirectory home </> "project"))
path <- canonicalizePath (codexDemo home)
parseArgs args @?= parseArgs (enableSkillsArgs [path])
_ <- assertRight =<< uninstallItem testConfig "demo" UserScope
BS.readFile (codexConfig home) >>= (@?= seed),
testCase "update re-adds a deleted config entry including for local edits" $
withCodexHome $ \home cache -> do
_ <- assertRight =<< installItem testConfig "demo" UserScope defaultInstallOptions
_ <- assertRight =<< removeDisabledSkill (codexConfig home) (codexDemo home)
updateDemo cache
entries <- assertRight =<< readSkillEntries (codexConfig home)
assertBool "entry repaired" (length entries == 1)
_ <- assertRight =<< removeDisabledSkill (codexConfig home) (codexDemo home)
BS.writeFile (ownedDemo home </> "SKILL.md") "local edits\n"
updateDemo cache
entries2 <- assertRight =<< readSkillEntries (codexConfig home)
entries2 @?= entries
BS.readFile (ownedDemo home </> "SKILL.md") >>= (@?= "local edits\n"),
testCase "a tool-only agent with Codex is refused without acceptance" $
withCodexHome $ \home _ -> do
result <- installItem testConfig "reviewer" UserScope defaultInstallOptions
assertKitError "cannot isolate agent" (== KitCodexCannotIsolate "reviewer") result
assertFileMissing (home </> ".config/testkit/agents/.claude/agents/reviewer.md")
assertFileMissing (home </> ".codex/agents/reviewer.toml"),
testCase "agent acceptance flag and callbacks work and update never asks" $
withCodexHome $ \home cache -> do
let refusing = testConfig & #confirmSharedCodex .~ Just (\_ -> pure False)
accepting = testConfig & #confirmSharedCodex .~ Just (\_ -> pure True)
result <- installItem refusing "reviewer" UserScope defaultInstallOptions
assertKitError "callback refused" (== KitCodexCannotIsolate "reviewer") result
_ <- assertRight =<< installItem accepting "reviewer" UserScope defaultInstallOptions
manifest <- assertRight =<< loadManifest cache
_ <- assertRight =<< reinstallPresent refusing cache manifest (Just "reviewer") KeepLocalEdits
_ <- assertRight =<< uninstallItem testConfig "reviewer" UserScope
_ <- assertRight =<< installItem refusing "reviewer" UserScope (InstallOptions Nothing True)
assertFileExists (home </> ".codex/agents/reviewer.toml")
_ <- assertRight =<< uninstallItem testConfig "reviewer" UserScope
_ <- assertRight =<< installItem (refusing & #providers .~ [InteractiveClaude]) "reviewer" UserScope defaultInstallOptions
assertFileMissing (home </> ".codex/agents/reviewer.toml"),
testCase "the TOML escaper round-trips quotes, backslashes and controls" $
withCodexHome $ \home _ -> do
let path = home </> "quote\"slash\\tab\t/SKILL.md"
_ <- assertRight =<< addDisabledSkill (codexConfig home) path
expected <- canonicalizePath path
entries <- assertRight =<< readSkillEntries (codexConfig home)
entries @?= [(expected, False)]
assertBool "launch override parses" (has _Right (parseArgs (enableSkillsArgs [expected]))),
testCase "a tool-only Codex skill must list SKILL.md" $
withCodexHome $ \home cache -> do
BS.writeFile (cache </> "skills/demo/OTHER.md") "other"
BS.writeFile (cache </> "kit.json") (Text.Encoding.encodeUtf8 (Text.replace "SKILL.md" "OTHER.md" (Text.Encoding.decodeUtf8 manifestJson)))
assertKitError "no SKILL.md" isConfigError =<< installItem testConfig "demo" UserScope defaultInstallOptions
assertDirectoryMissing (ownedDemo home)
]
where
isConfigError KitCodexConfigUnusable {} = True
isConfigError _ = False
-- Every visibility test uses both isolated roots, as do the older fixtures.
withCodexHome :: (FilePath -> FilePath -> IO a) -> IO a
withCodexHome = withPreparedKitHome
codexConfig :: FilePath -> FilePath
codexConfig home = home </> ".codex/config.toml"
codexDemo :: FilePath -> FilePath
codexDemo home = home </> ".agents/skills/demo/SKILL.md"
parseArgs :: [Text] -> Either String Toml.Table
parseArgs ["-c", override] = Toml.forgetTableAnns <$> Toml.parse override
parseArgs other = Left ("unexpected arguments: " <> show other)
visibilityStatusTests :: TestTree
visibilityStatusTests =
testGroup
"visibility"
[ testCase "status reports requested and effective visibility" $
withStatusFixture $ \home _ config -> do
rows <- collectStatus config (fixtureCache home) [(UserScope, "user")]
let one n p = case filter (\r -> r ^. #name == n && r ^. #providers == p) rows of
[r] -> pure r
other -> assertFailure (show other)
shared <- one "alpha" "claude"
shared ^. #requestedVisibility @?= Just SharedVisibility
shared ^. #effectiveVisibility @?= SharedVisibility
hidden <- one "epsilon" "codex"
hidden ^. #requestedVisibility @?= Just ToolOnlyVisibility
hidden ^. #effectiveVisibility @?= ToolOnlyVisibility
legacy <- one "gamma" "codex"
legacy ^. #requestedVisibility @?= Nothing
legacy ^. #effectiveVisibility @?= SharedVisibility
broken <- one "gamma" "claude"
broken ^. #requestedVisibility @?= Just SharedVisibility
broken ^. #effectiveVisibility @?= ToolOnlyVisibility
assertBool "broken condition" (KitVisibilityBroken `elem` (broken ^. #conditions))
assertBool "table carries requested mismatch" ("tool-only (requested shared)" `Text.isInfixOf` renderStatusTable rows)
assertBool "agent mismatch" ("shared (requested tool-only)" `Text.isInfixOf` renderStatusTable rows),
testCase "a deleted link reports visibility-broken and update clears it" $
withCodexHome $ \home cache -> do
_ <- assertRight =<< installItem testConfig "demo" UserScope sharedOptions
removeFile (sharedDemo home)
before <- assertRight =<< checkVisibility testConfig InteractiveClaude UserScope SkillKind "demo"
before ^. #broken @?= [sharedDemo home]
rows <- collectStatus testConfig cache [(UserScope, "user")]
assertBool "status detects missing link" (any (elem KitVisibilityBroken . view #conditions) rows)
updateDemo cache
after <- assertRight =<< checkVisibility testConfig InteractiveClaude UserScope SkillKind "demo"
after ^. #broken @?= [],
testCase "a deleted disabled entry reports visibility-broken and update clears it" $
withCodexHome $ \home cache -> do
_ <- assertRight =<< installItem testConfig "demo" UserScope defaultInstallOptions
_ <- assertRight =<< removeDisabledSkill (codexConfig home) (codexDemo home)
rows <- collectStatus testConfig cache [(UserScope, "user")]
assertBool "Codex is now shared and broken" (any (\r -> r ^. #providers == "codex" && r ^. #effectiveVisibility == SharedVisibility && KitVisibilityBroken `elem` (r ^. #conditions)) rows)
updateDemo cache
after <- assertRight =<< checkVisibility testConfig InteractiveCodex UserScope SkillKind "demo"
after ^. #effective @?= ToolOnlyVisibility
after ^. #broken @?= [],
testCase "status table prints the legacy note only for a shared legacy Codex skill" $
withStatusFixture $ \home _ config -> do
rows <- collectStatus config (fixtureCache home) [(UserScope, "user")]
assertBool "legacy note" ("installed before baikai-kit 0.4.0.0" `Text.isInfixOf` renderStatusTable rows)
let modern = filter (\r -> has _Just (r ^. #requestedVisibility)) rows
assertBool "no legacy note for modern copies" (not ("installed before baikai-kit 0.4.0.0" `Text.isInfixOf` renderStatusTable modern)),
testCase "uninstall preserves foreign Codex assets and a replaced Claude link" $
withCodexHome $ \home _ -> do
_ <- assertRight =<< installItem (testConfig & #providers .~ [InteractiveClaude]) "demo" UserScope sharedOptions
removeFile (sharedDemo home)
createDirectoryIfMissing True (home </> "foreign")
createDirectoryLink (home </> "foreign") (sharedDemo home)
createDirectoryIfMissing True (takeDirectory (codexDemo home))
BS.writeFile (codexDemo home) "foreign skill\n"
outcomes <- assertRight =<< uninstallItem testConfig "demo" UserScope
concatMap (view #linksRemoved) outcomes @?= []
BS.readFile (codexDemo home) >>= (@?= "foreign skill\n")
getSymbolicLinkTarget (sharedDemo home) >>= (@?= home </> "foreign")
]
visibilityRecoveryTests :: TestTree
visibilityRecoveryTests =
testGroup
"visibility"
[ testCase "shared visibility refuses a user-owned disabled entry before writing assets" $
withCodexHome $ \home _ -> do
_ <- assertRight =<< addDisabledSkill (codexConfig home) (codexDemo home)
seed <- BS.readFile (codexConfig home)
result <- installItem testConfig "demo" UserScope sharedOptions
case result of
Left KitCodexConfigUnusable {} -> pure ()
other -> assertFailure (show other)
BS.readFile (codexConfig home) >>= (@?= seed)
assertDirectoryMissing (ownedDemo home)
assertFileMissing (codexDemo home),
testCase "uninstall reports an owned dangling link after its copy and sidecar are lost" $
withCodexHome $ \home _ -> do
let config = testConfig & #providers .~ [InteractiveClaude]
_ <- assertRight =<< installItem config "demo" UserScope sharedOptions
removeDirectoryRecursive (ownedDemo home)
outcomes <- assertRight =<< uninstallItem config "demo" UserScope
concatMap (view #linksRemoved) outcomes @?= [sharedDemo home]
assertBool "report names removed link" ("1 shared link" `Text.isInfixOf` renderUninstallReport "demo" UserScope outcomes),
testCase "update does not introduce an unaccepted Codex agent copy" $
withCodexHome $ \home cache -> do
_ <- assertRight =<< installItem (testConfig & #providers .~ [InteractiveClaude]) "reviewer" UserScope defaultInstallOptions
manifest <- assertRight =<< loadManifest cache
_ <- assertRight =<< reinstallPresent testConfig cache manifest (Just "reviewer") KeepLocalEdits
assertFileMissing (home </> ".codex/agents/reviewer.toml"),
testCase "multiple config entries preserve each other when one is removed" $
withCodexHome $ \home _ -> do
_ <- assertRight =<< addDisabledSkill (codexConfig home) (codexDemo home)
_ <- assertRight =<< addDisabledSkill (codexConfig home) (home </> "other/SKILL.md")
_ <- assertRight =<< removeDisabledSkill (codexConfig home) (codexDemo home)
expected <- canonicalizePath (home </> "other/SKILL.md")
entries <- assertRight =<< readSkillEntries (codexConfig home)
entries @?= [(expected, False)],
testCase "update finishes pending visibility removals from sidecar ownership" $
withCodexHome $ \home cache -> do
_ <- assertRight =<< installItem testConfig "demo" UserScope sharedOptions
meta <- demoSidecar home
LBS.writeFile (ownedDemo home </> ".testkit-kit.json") (Aeson.encode (meta & #visibility .~ Just "tool-only"))
before <- assertRight =<< checkVisibility testConfig InteractiveClaude UserScope SkillKind "demo"
before ^. #broken @?= [sharedDemo home]
updateDemo cache
assertDirectoryMissing (sharedDemo home)
_ <- assertRight =<< installItem testConfig "demo" UserScope defaultInstallOptions
let sidecar = takeDirectory (codexDemo home) </> ".testkit-kit.json"
codexMeta <- requireSidecar sidecar
LBS.writeFile sidecar (Aeson.encode (codexMeta & #visibility .~ Just "shared" & #visibilitySource .~ Just "install-flag"))
pending <- assertRight =<< checkVisibility testConfig InteractiveCodex UserScope SkillKind "demo"
assertBool "pending config cleanup" (not (null (pending ^. #broken)))
updateDemo cache
entries <- assertRight =<< readSkillEntries (codexConfig home)
entries @?= []
final <- requireSidecar sidecar
final ^. #codexDisabledSkills @?= Just [],
testCase "removal tolerates deleted delimiter comments and keeps other TOML" $
withCodexHome $ \home _ -> do
path <- canonicalizePath (codexDemo home)
createDirectoryIfMissing True (home </> ".codex")
let suffix = "[projects.\"/x\"]\ntrust_level = \"trusted\"\n"
seed = "# user comment\n[[skills.config]]\npath = \"" <> Text.Encoding.encodeUtf8 (Text.pack path) <> "\"\nenabled = false\n" <> suffix
BS.writeFile (codexConfig home) seed
removed <- assertRight =<< removeDisabledSkill (codexConfig home) path
removed @?= True
BS.readFile (codexConfig home) >>= (@?= "# user comment\n" <> suffix),
testCase "a read-only Codex config is refused before writing assets" $
withCodexHome $ \home _ -> do
createDirectoryIfMissing True (home </> ".codex")
BS.writeFile (codexConfig home) "# read only\n"
Posix.setFileMode (codexConfig home) 0o400
result <- installItem testConfig "demo" UserScope defaultInstallOptions
case result of
Left KitCodexConfigUnusable {} -> pure ()
other -> assertFailure (show other)
assertDirectoryMissing (ownedDemo home)
BS.readFile (codexConfig home) >>= (@?= "# read only\n"),
testCase "a read-only Codex config parent is refused before writing assets" $
withCodexHome $ \home _ -> do
let parent = home </> ".codex"
createDirectoryIfMissing True parent
Posix.setFileMode parent 0o500
flip finally (Posix.setFileMode parent 0o700) $ do
result <- installItem testConfig "demo" UserScope defaultInstallOptions
case result of
Left KitCodexConfigUnusable {} -> pure ()
other -> assertFailure (show other)
assertDirectoryMissing (ownedDemo home)
assertFileMissing (codexConfig home),
testCase "foreign Codex agent resources are protected without a body file" $
withCodexHome $ \home _ -> do
let resource = home </> ".codex/agents/reviewer/data.txt"
createDirectoryIfMissing True (takeDirectory resource)
BS.writeFile resource "foreign resource"
result <- installItem testConfig "reviewer" UserScope sharedOptions
case result of
Left KitSharedNameTaken {} -> pure ()
other -> assertFailure (show other)
BS.readFile resource >>= (@?= "foreign resource")
assertFileMissing (home </> ".codex/agents/reviewer.toml")
assertDirectoryMissing (ownedDemo home),
testCase "project shared names and foreign Codex agents are protected" $
withCodexHome $ \home _ -> do
let root = takeDirectory home </> "project"
config = testConfig & #projectRoot .~ pure root
createDirectoryIfMissing True (root </> ".claude/skills/demo")
result <- installItem config "demo" ProjectScope sharedOptions
case result of
Left KitSharedNameTaken {} -> pure ()
other -> assertFailure (show other)
assertDirectoryMissing (root </> ".testkit")
createDirectoryIfMissing True (home </> ".codex/agents")
BS.writeFile (home </> ".codex/agents/reviewer.toml") "foreign"
result2 <- installItem testConfig "reviewer" UserScope sharedOptions
case result2 of
Left KitSharedNameTaken {} -> pure ()
other -> assertFailure (show other)
BS.readFile (home </> ".codex/agents/reviewer.toml") >>= (@?= "foreign"),
testCase "post-content visibility failure remains tracked and update repairs it" $
withCodexHome $ \home cache -> do
let config = testConfig & #providers .~ [InteractiveClaude]
createDirectoryIfMissing True (home </> ".claude")
BS.writeFile (home </> ".claude/skills") "blocking parent"
result <- installItem config "demo" UserScope sharedOptions
case result of
Left KitVisibilityNotApplied {} -> pure ()
other -> assertFailure (show other)
meta <- demoSidecar home
meta ^. #sharedLinks @?= Just [Text.pack (sharedDemo home)]
assertFileExists (ownedDemo home </> "SKILL.md")
removeFile (home </> ".claude/skills")
manifest <- assertRight =<< loadManifest cache
_ <- assertRight =<< reinstallPresent config cache manifest (Just "demo") KeepLocalEdits
assertBool "repair after blocker clears" =<< pathIsSymbolicLink (sharedDemo home)
]