baikai-kit-0.2.0.0: test/Main.hs
{-# LANGUAGE OverloadedStrings #-}
module Main (main) where
import Baikai.Interactive (InteractiveProvider (InteractiveClaude, InteractiveCodex))
import Baikai.Kit
( AgentEntry (..),
KitCommand (..),
KitConfig (..),
KitError (..),
KitItem (..),
KitItemKind (..),
KitManifest (..),
KitScope (UserScope),
KitState (..),
OverwritePolicy (..),
PlannedWrite (..),
PullResult (..),
RemovalOutcome (..),
SidecarMeta (..),
SkillEntry (..),
UpstreamAvailability (..),
WriteContent (..),
classify,
collectStatus,
computeKitHash,
executePlanWith,
installItem,
kitStatus,
loadManifest,
pullKitRepo,
readSidecar,
reinstallPresent,
renderState,
renderUninstallReport,
runKit,
safeItemName,
safeRelativePath,
safeSourcePath,
sidecarFileName,
sidecarPath,
stripYamlFrontmatter,
uninstallItem,
updateKit,
)
import Baikai.Prelude
import Control.Exception (finally, try)
import Data.Aeson qualified as Aeson
import Data.ByteString qualified as BS
import Data.List (find, isSuffixOf)
import Data.Text qualified as Text
import Data.Text.Encoding qualified as Text.Encoding
import System.Directory
( createDirectoryIfMissing,
createDirectoryLink,
doesDirectoryExist,
doesFileExist,
doesPathExist,
listDirectory,
removeDirectoryRecursive,
removeFile,
renameFile,
)
import System.Environment (lookupEnv, setEnv, unsetEnv)
import System.Exit (ExitCode (..))
import System.FilePath (takeDirectory, (</>))
import System.IO.Temp (withSystemTempDirectory)
import Test.Tasty (TestTree, defaultMain, localOption, testGroup)
import Test.Tasty.HUnit (assertBool, assertFailure, testCase, (@?=))
import Test.Tasty.Runners (NumThreads (NumThreads))
main :: IO ()
main =
defaultMain $
localOption (NumThreads 1) $
testGroup
"baikai-kit"
[ manifestTests,
hashTests,
pathSafetyTests,
symlinkSafetyTests,
frontmatterTests,
classifyTests,
statusFilesystemTests,
installRoundTripTests,
typedErrorTests,
installFidelityTests
]
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 => dirty+outdated" $
classify
(Just (mkSidecar (Just "1.0") "h1"))
(Just (mkSkillItem "foo" (Just "2.0")))
(Just "h2")
@?= KitDirtyOutdated,
testCase "hash mismatch => dirty" $
classify
(Just (mkSidecar (Just "1.0") "h1"))
(Just (mkSkillItem "foo" (Just "1.0")))
(Just "h2")
@?= KitDirty,
testCase "version and hash match => up-to-date" $
classify
(Just (mkSidecar (Just "1.0") "h"))
(Just (mkSkillItem "foo" (Just "1.0")))
(Just "h")
@?= KitUpToDate,
testCase "no upstream hash on matching version => up-to-date" $
classify
(Just (mkSidecar (Just "1.0") "h"))
(Just (mkAgentItem "foo" (Just "1.0")))
Nothing
@?= KitUpToDate
]
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
assertKitError "KitUnsafePath" isUnsafePath result
assertFileMissing (takeDirectory home </> "escape.txt")
exitResult <- try @ExitCode (runKit testConfig (KitInstall "evil" UserScope))
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
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
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 ^. #state @?= KitUpstreamRefused) demoRows,
testCase "renderState names the refused state" $
renderState 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
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 ^. #state @?= KitDelisted) demoRows
mapM_ (\row -> row ^. #installedVersion @?= Just "0.1.0") demoRows,
testCase "version and cached hash drift reports dirty+outdated" $
withPreparedKitHome $ \_home cache -> do
_ <- assertRight =<< installItem testConfig "demo" UserScope
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 ^. #state @?= KitDirtyOutdated) demoRows
]
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
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
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
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
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
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
assertKitError "KitItemNotFound" (== KitItemNotFound "nope") result,
testCase "kit status offline on a fresh HOME exits 0" $
withSystemTempDirectory "baikai-kit-offline" $ \tmp -> do
oldHome <- lookupEnv "HOME"
let home = tmp </> "home"
config = testConfig & #repoUrl .~ "file:///nonexistent-kit"
createDirectoryIfMissing True home
setEnv "HOME" home
flip finally (restoreHome oldHome) $ do
exitResult <- try @ExitCode (runKit config KitStatus)
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
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
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
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
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
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
}
mkSkillItem :: Text -> Maybe Text -> KitItem
mkSkillItem n mVersion =
KitSkillItem
SkillEntry
{ name = n,
description = "x",
version = mVersion,
path = "skills/foo",
files = ["SKILL.md"]
}
mkAgentItem :: Text -> Maybe Text -> KitItem
mkAgentItem n mVersion =
KitAgentItem
AgentEntry
{ name = n,
description = "x",
version = mVersion,
path = "agents/foo.md",
files = Nothing
}
testConfig :: KitConfig
testConfig =
KitConfig
{ toolName = "testkit",
repoUrl = "file:///not-used",
providers = [InteractiveClaude, InteractiveCodex]
}
withPreparedKitHome :: (FilePath -> FilePath -> IO a) -> IO a
withPreparedKitHome action =
withSystemTempDirectory "baikai-kit-home" $ \tmp -> do
oldHome <- lookupEnv "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
action home cache `finally` restoreHome oldHome
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"