diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,26 @@ +Copyright (c) 2026 Nadeem Bitar + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + +1. Redistributions of source code must retain the above copyright notice, this + list of conditions and the following disclaimer. + +2. Redistributions in binary form must reproduce the above copyright notice, + this list of conditions and the following disclaimer in the documentation + and/or other materials provided with the distribution. + +3. Neither the name of the copyright holder nor the names of its contributors + may be used to endorse or promote products derived from this software + without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND +ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED +WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE +DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE +FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/baikai-kit.cabal b/baikai-kit.cabal new file mode 100644 --- /dev/null +++ b/baikai-kit.cabal @@ -0,0 +1,78 @@ +cabal-version: 3.4 +name: baikai-kit +version: 0.1.0.1 +synopsis: Shared kit installer for AI-agent skills and subagents +description: + Shared implementation of kit listing, installation, update, uninstall, + status, and discovery helpers for command-line tools that install local + AI-agent skills and subagents. + +category: AI +license: BSD-3-Clause +license-file: LICENSE +author: Nadeem Bitar +maintainer: nadeem@gmail.com +copyright: (c) 2026 Nadeem Bitar +build-type: Simple + +common common-options + ghc-options: + -Wall -Wcompat -Widentities -Wincomplete-uni-patterns + -Wincomplete-record-updates -Wredundant-constraints + -fhide-source-paths -Wmissing-export-lists -Wpartial-fields + -Wmissing-deriving-strategies + + default-language: GHC2024 + default-extensions: + DeriveAnyClass + DuplicateRecordFields + OverloadedLabels + OverloadedStrings + +library + import: common-options + hs-source-dirs: src + exposed-modules: + Baikai.Kit + Baikai.Kit.Command + Baikai.Kit.Config + Baikai.Kit.Install + Baikai.Kit.Manifest + Baikai.Kit.Path + Baikai.Kit.Repo + Baikai.Kit.Session + Baikai.Kit.Sidecar + Baikai.Kit.Status + + build-depends: + , aeson + , baikai ^>=0.3.0 + , base >=4.20 && <5 + , binary + , bytestring + , crypton + , directory + , filepath + , optparse-applicative + , process + , text ^>=2.1 + , time + +test-suite baikai-kit-test + import: common-options + type: exitcode-stdio-1.0 + hs-source-dirs: test + main-is: Main.hs + ghc-options: -threaded -with-rtsopts=-N + build-depends: + , aeson + , baikai + , baikai-kit + , base + , bytestring + , directory + , filepath + , tasty + , tasty-hunit + , temporary + , text diff --git a/src/Baikai/Kit.hs b/src/Baikai/Kit.hs new file mode 100644 --- /dev/null +++ b/src/Baikai/Kit.hs @@ -0,0 +1,22 @@ +module Baikai.Kit + ( module Baikai.Kit.Command, + module Baikai.Kit.Config, + module Baikai.Kit.Install, + module Baikai.Kit.Manifest, + module Baikai.Kit.Path, + module Baikai.Kit.Repo, + module Baikai.Kit.Session, + module Baikai.Kit.Sidecar, + module Baikai.Kit.Status, + ) +where + +import Baikai.Kit.Command +import Baikai.Kit.Config +import Baikai.Kit.Install +import Baikai.Kit.Manifest +import Baikai.Kit.Path +import Baikai.Kit.Repo +import Baikai.Kit.Session +import Baikai.Kit.Sidecar +import Baikai.Kit.Status diff --git a/src/Baikai/Kit/Command.hs b/src/Baikai/Kit/Command.hs new file mode 100644 --- /dev/null +++ b/src/Baikai/Kit/Command.hs @@ -0,0 +1,60 @@ +module Baikai.Kit.Command + ( KitCommand (..), + kitCommandParser, + runKit, + ) +where + +import Baikai.Kit.Config (KitConfig, KitScope (..)) +import Baikai.Kit.Install (installItem, listAvailable, uninstallItem, updateKit) +import Baikai.Kit.Status (kitStatus) +import Baikai.Prelude +import Options.Applicative + +data KitCommand + = KitList + | KitInstall !Text !KitScope + | KitUpdate !(Maybe Text) + | KitUninstall !Text !KitScope + | KitStatus + deriving stock (Show) + +kitCommandParser :: Parser KitCommand +kitCommandParser = + hsubparser + ( command "list" (info (pure KitList) (progDesc "List available skills and subagents")) + <> command "install" (info installParser (progDesc "Install a skill or subagent")) + <> command "update" (info updateParser (progDesc "Update installed skills and subagents")) + <> command "uninstall" (info uninstallParser (progDesc "Uninstall a skill or subagent")) + <> command "status" (info (pure KitStatus) (progDesc "Show installed skills and subagents")) + ) + <|> pure KitList + +runKit :: KitConfig -> KitCommand -> IO () +runKit config = \case + KitList -> listAvailable config + KitInstall n scope -> installItem config n scope + KitUpdate n -> updateKit config n + KitUninstall n scope -> uninstallItem config n scope + KitStatus -> kitStatus config + +installParser :: Parser KitCommand +installParser = + KitInstall + <$> strArgument (metavar "NAME" <> help "Name of the skill or subagent to install") + <*> scopeParser "Install to project scope instead of user scope" + +updateParser :: Parser KitCommand +updateParser = + KitUpdate + <$> optional (strArgument (metavar "NAME" <> help "Name of a specific item to update (default: all)")) + +uninstallParser :: Parser KitCommand +uninstallParser = + KitUninstall + <$> strArgument (metavar "NAME" <> help "Name of the skill or subagent to uninstall") + <*> scopeParser "Uninstall from project scope instead of user scope" + +scopeParser :: String -> Parser KitScope +scopeParser helpText = + flag UserScope ProjectScope (long "project" <> help helpText) diff --git a/src/Baikai/Kit/Config.hs b/src/Baikai/Kit/Config.hs new file mode 100644 --- /dev/null +++ b/src/Baikai/Kit/Config.hs @@ -0,0 +1,67 @@ +module Baikai.Kit.Config + ( KitConfig (..), + KitScope (..), + kitCacheDir, + userAgentsDir, + projectAgentsDir, + resolveAgentsBase, + providerAgentsBase, + providerLabel, + sidecarFileName, + scopeLabel, + ) +where + +import Baikai.AgentAssets (AgentAssetProvider) +import Baikai.Interactive (InteractiveProvider (..)) +import Baikai.Prelude +import Data.Text qualified as Text +import System.Directory (getCurrentDirectory, getHomeDirectory) +import System.FilePath (()) + +data KitConfig = KitConfig + { toolName :: !Text, + repoUrl :: !Text, + providers :: ![AgentAssetProvider] + } + deriving stock (Generic, Show) + +data KitScope + = UserScope + | ProjectScope + deriving stock (Eq, Ord, Show) + +kitCacheDir :: KitConfig -> IO FilePath +kitCacheDir config = do + home <- getHomeDirectory + pure (home ".cache" Text.unpack (config ^. #toolName) "kit") + +userAgentsDir :: KitConfig -> IO FilePath +userAgentsDir config = do + home <- getHomeDirectory + pure (home ".config" Text.unpack (config ^. #toolName) "agents") + +projectAgentsDir :: KitConfig -> IO FilePath +projectAgentsDir config = do + cwd <- getCurrentDirectory + pure (cwd "." <> Text.unpack (config ^. #toolName) "agents") + +resolveAgentsBase :: KitConfig -> KitScope -> IO FilePath +resolveAgentsBase config UserScope = userAgentsDir config +resolveAgentsBase config ProjectScope = projectAgentsDir config + +providerAgentsBase :: KitConfig -> AgentAssetProvider -> KitScope -> IO FilePath +providerAgentsBase config InteractiveClaude scope = resolveAgentsBase config scope +providerAgentsBase _config InteractiveCodex UserScope = getHomeDirectory +providerAgentsBase _config InteractiveCodex ProjectScope = getCurrentDirectory + +providerLabel :: AgentAssetProvider -> Text +providerLabel InteractiveClaude = "claude" +providerLabel InteractiveCodex = "codex" + +sidecarFileName :: KitConfig -> Text +sidecarFileName config = "." <> (config ^. #toolName) <> "-kit.json" + +scopeLabel :: KitScope -> Text +scopeLabel UserScope = "user" +scopeLabel ProjectScope = "project" diff --git a/src/Baikai/Kit/Install.hs b/src/Baikai/Kit/Install.hs new file mode 100644 --- /dev/null +++ b/src/Baikai/Kit/Install.hs @@ -0,0 +1,414 @@ +module Baikai.Kit.Install + ( loadManifest, + loadManifestMaybe, + lookupItem, + installItem, + uninstallItem, + uninstallOutcomes, + renderUninstallReport, + RemovalOutcome (..), + updateKit, + listAvailable, + stripYamlFrontmatter, + ) +where + +import Baikai.AgentAssets + ( CodexCustomAgent (..), + agentTargetPath, + codexCustomAgentToml, + skillTargetPath, + ) +import Baikai.Interactive (InteractiveProvider (..), InteractiveScope (InteractiveProjectScope)) +import Baikai.Kit.Config (KitConfig, KitScope (..), kitCacheDir, providerAgentsBase, providerLabel, scopeLabel, sidecarFileName) +import Baikai.Kit.Manifest + ( AgentEntry, + KitItem (..), + KitItemKind (..), + KitManifest (..), + SkillEntry, + itemKind, + kitItemKind, + ) +import Baikai.Kit.Path (safeItemName, safeRelativePath) +import Baikai.Kit.Repo (PullResult (..), ensureKitRepo, pullKitRepo) +import Baikai.Kit.Sidecar (computeKitHash, newSidecarMeta, sidecarPath) +import Baikai.Prelude +import Control.Exception (IOException, catch, throwIO, try) +import Control.Monad (forM, forM_, unless, when) +import Data.Aeson (eitherDecodeFileStrict', encode) +import Data.ByteString.Lazy qualified as LBS +import Data.List (find, nub) +import Data.Text qualified as Text +import Data.Text.Encoding qualified as Text.Encoding +import Data.Text.IO qualified as Text.IO +import System.Directory + ( createDirectoryIfMissing, + doesDirectoryExist, + doesFileExist, + removeDirectoryRecursive, + removeFile, + renameFile, + ) +import System.Exit (exitFailure) +import System.FilePath (takeDirectory, takeFileName, ()) +import System.IO (hPutStrLn, stderr) + +data PlannedWrite = PlannedWrite + { destination :: !FilePath, + content :: !WriteContent + } + +data WriteContent + = CopyFrom !FilePath + | WriteBytes !LBS.ByteString + +data RemovalOutcome = RemovalOutcome + { provider :: !InteractiveProvider, + skillRemoved :: !Bool, + agentRemoved :: !Bool, + sidecarRemoved :: !Bool + } + deriving stock (Eq, Generic, Show) + +loadManifest :: FilePath -> IO KitManifest +loadManifest repoDir = do + let manifestPath = repoDir "kit.json" + exists <- doesFileExist manifestPath + unless exists $ do + hPutStrLn stderr "Error: kit.json not found in kit repository." + exitFailure + result <- eitherDecodeFileStrict' manifestPath + case result of + Left err -> do + hPutStrLn stderr $ "Error: Failed to parse kit.json: " <> err + exitFailure + Right manifest -> pure manifest + +loadManifestMaybe :: FilePath -> IO (Maybe KitManifest) +loadManifestMaybe "" = pure Nothing +loadManifestMaybe cacheDir = do + let manifestPath = cacheDir "kit.json" + exists <- doesFileExist manifestPath + if not exists + then pure Nothing + else do + result <- eitherDecodeFileStrict' manifestPath + case result of + Left err -> do + hPutStrLn stderr $ "Warning: failed to parse kit.json: " <> err + pure Nothing + Right manifest -> pure (Just manifest) + +lookupItem :: Text -> KitManifest -> Maybe KitItem +lookupItem n manifest = + case find (\entry -> entry ^. #name == n) (manifest ^. #skills) of + Just skill -> Just (KitSkillItem skill) + Nothing -> KitAgentItem <$> find (\entry -> entry ^. #name == n) (manifest ^. #agents) + +installItem :: KitConfig -> Text -> KitScope -> IO () +installItem config itemN scope = do + repoDir <- ensureKitRepo config + manifest <- loadManifest repoDir + case lookupItem itemN manifest of + Nothing -> do + hPutStrLn stderr $ "Error: '" <> Text.unpack itemN <> "' not found in kit manifest." + exitFailure + Just item -> do + result <- try @IOException (doInstall config repoDir item scope) + case result of + Right () -> + Text.IO.putStrLn $ + "Installed " <> itemKind item <> " '" <> itemN <> "' to " <> scopeLabel scope <> " scope." + Left e -> do + hPutStrLn stderr $ "Error: install failed, no changes were made: " <> show e + exitFailure + +uninstallItem :: KitConfig -> Text -> KitScope -> IO () +uninstallItem config n scope = do + outcomes <- uninstallOutcomes config n scope + Text.IO.putStrLn (renderUninstallReport n scope outcomes) + +uninstallOutcomes :: KitConfig -> Text -> KitScope -> IO [RemovalOutcome] +uninstallOutcomes config n scope = do + safeName <- requireSafe "item name" (safeItemName n) + forM (config ^. #providers) $ \provider -> do + providerBase <- providerAgentsBase config provider scope + skillRemoved <- removeIfDirectory (skillTarget config provider providerBase safeName) + agentRemoved <- removeIfFile (agentTarget config provider providerBase safeName) + sidecarRemoved <- removeIfFile (agentSidecarTarget config provider providerBase safeName) + pure RemovalOutcome {provider, skillRemoved, agentRemoved, sidecarRemoved} + +renderUninstallReport :: Text -> KitScope -> [RemovalOutcome] -> Text +renderUninstallReport n scope outcomes + | any assetRemoved outcomes = + "Uninstalled " + <> Text.intercalate "+" removedKinds + <> " '" + <> n + <> "' from " + <> scopeLabel scope + <> " scope (" + <> Text.intercalate "," removedProviders + <> ")." + | any (^. #sidecarRemoved) outcomes = + "Removed stale kit metadata for '" <> n <> "' from " <> scopeLabel scope <> " scope." + | otherwise = + "'" <> n <> "' is not installed in " <> scopeLabel scope <> " scope." + where + assetRemoved outcome = outcome ^. #skillRemoved || outcome ^. #agentRemoved + removedKinds = + nub $ + ["skill" | any (^. #skillRemoved) outcomes] + ++ ["agent" | any (^. #agentRemoved) outcomes] + removedProviders = map (providerLabel . view #provider) (filter assetRemoved outcomes) + +updateKit :: KitConfig -> Maybe Text -> IO () +updateKit config mName = do + cacheDir <- kitCacheDir config + exists <- doesDirectoryExist cacheDir + if exists + then do + result <- pullKitRepo config cacheDir + case result of + PullSucceeded -> Text.IO.putStrLn "Kit repository updated." + PullFailed err -> do + hPutStrLn stderr $ "Error: failed to update kit repository: " <> Text.unpack err + hPutStrLn stderr "The cached copy is unchanged; installed items were not reinstalled." + exitFailure + else do + _ <- ensureKitRepo config + Text.IO.putStrLn "Kit repository cloned." + manifest <- loadManifest =<< kitCacheDir config + case mName of + Just n -> do + reinstallIfPresent config n UserScope manifest + reinstallIfPresent config n ProjectScope manifest + Nothing -> reinstallAllPresent config manifest + +listAvailable :: KitConfig -> IO () +listAvailable config = do + repoDir <- ensureKitRepo config + manifest <- loadManifest repoDir + let sk = manifest ^. #skills + ag = manifest ^. #agents + if null sk && null ag + then Text.IO.putStrLn "No items available in the kit." + else do + unless (null sk) $ do + Text.IO.putStrLn "Skills:" + let maxLen = maximum $ map (Text.length . view #name) sk + mapM_ (printEntry maxLen . skillNameDesc) sk + unless (null ag) $ do + unless (null sk) (Text.IO.putStrLn "") + Text.IO.putStrLn "Agents:" + let maxLen = maximum $ map (Text.length . view #name) ag + mapM_ (printEntry maxLen . agentNameDesc) ag + where + printEntry maxLen (n, desc) = + Text.IO.putStrLn $ " " <> Text.justifyLeft (maxLen + 2) ' ' n <> desc + +doInstall :: KitConfig -> FilePath -> KitItem -> KitScope -> IO () +doInstall config repoDir item scope = + planInstall config repoDir item scope >>= executePlan + +planInstall :: KitConfig -> FilePath -> KitItem -> KitScope -> IO [PlannedWrite] +planInstall config repoDir item@(KitSkillItem entry) scope = do + safeName <- requireSafe "skill name" (safeItemName (entry ^. #name)) + safePath <- requireSafe "skill path" (safeRelativePath (entry ^. #path)) + safeFiles <- traverse (requireSafe "skill file" . safeRelativePath) (entry ^. #files) + let sourceDir = repoDir safePath + forM_ safeFiles $ \file -> requireSourceFile (sourceDir file) + hashStr <- computeKitHash sourceDir (map Text.pack safeFiles) + meta <- newSidecarMeta item hashStr + fmap concat $ + forM (config ^. #providers) $ \provider -> do + targetBase <- providerAgentsBase config provider scope + let targetDir = skillTarget config provider targetBase safeName + fileWrites = + [ PlannedWrite + { destination = targetDir file, + content = CopyFrom (sourceDir file) + } + | file <- safeFiles + ] + sidecarWrite = + PlannedWrite + { destination = sidecarPath provider (kitItemKind item) (Text.pack safeName) targetBase (sidecarFileName config), + content = WriteBytes (encode meta) + } + pure (fileWrites ++ [sidecarWrite]) +planInstall config repoDir item@(KitAgentItem entry) scope = do + safeName <- requireSafe "agent name" (safeItemName (entry ^. #name)) + (sourceBase, relFiles, primarySource) <- safeAgentSources repoDir entry + forM_ relFiles $ \file -> requireSourceFile (sourceBase file) + hashStr <- computeKitHash sourceBase (map Text.pack relFiles) + meta <- newSidecarMeta item hashStr + body <- Text.IO.readFile primarySource + fmap concat $ + forM (config ^. #providers) $ \provider -> do + targetBase <- providerAgentsBase config provider scope + let dstFile = agentTarget config provider targetBase safeName + agentWrite = + case provider of + InteractiveClaude -> + PlannedWrite {destination = dstFile, content = CopyFrom primarySource} + InteractiveCodex -> + PlannedWrite + { destination = dstFile, + content = WriteBytes (LBS.fromStrict (Text.Encoding.encodeUtf8 (agentAsCodexToml entry body))) + } + sidecarWrite = + PlannedWrite + { destination = sidecarPath provider (kitItemKind item) (Text.pack safeName) targetBase (sidecarFileName config), + content = WriteBytes (encode meta) + } + pure [agentWrite, sidecarWrite] + +safeAgentSources :: FilePath -> AgentEntry -> IO (FilePath, [FilePath], FilePath) +safeAgentSources repoDir entry = + case entry ^. #files of + Just files -> do + safePath <- requireSafe "agent path" (safeRelativePath (entry ^. #path)) + safeFiles <- traverse (requireSafe "agent file" . safeRelativePath) files + case safeFiles of + [] -> do + hPutStrLn stderr $ "Error: agent '" <> Text.unpack (entry ^. #name) <> "' has no source files." + exitFailure + primaryRel : _ -> do + let sourceBase = repoDir safePath + pure (sourceBase, safeFiles, sourceBase primaryRel) + Nothing -> do + safePath <- requireSafe "agent path" (safeRelativePath (entry ^. #path)) + let fileName = takeFileName safePath + pure (repoDir takeDirectory safePath, [fileName], repoDir safePath) + +requireSourceFile :: FilePath -> IO () +requireSourceFile path = do + exists <- doesFileExist path + unless exists (ioError (userError ("source file does not exist: " <> path))) + +executePlan :: [PlannedWrite] -> IO () +executePlan writes = do + tempPaths <- phaseOne [] writes + forM_ tempPaths $ \(temp, final) -> renameFile temp final + where + phaseOne temps [] = pure (reverse temps) + phaseOne temps (PlannedWrite {destination, content} : rest) = do + let temp = destination <> ".baikai-kit-tmp" + result <- + try @IOException $ do + createDirectoryIfMissing True (takeDirectory destination) + writeTemp content temp + pure (temp, destination) + case result of + Left e -> cleanupTemps temps >> throwIO e + Right tempPair -> + phaseOne (tempPair : temps) rest + `catch` \(e :: IOException) -> cleanupTemps (tempPair : temps) >> throwIO e + + writeTemp (CopyFrom src) temp = LBS.readFile src >>= LBS.writeFile temp + writeTemp (WriteBytes bytes) temp = LBS.writeFile temp bytes + + cleanupTemps temps = + forM_ temps $ \(temp, _) -> do + _ <- try @IOException (removeFile temp) + pure () + +requireSafe :: Text -> Either Text a -> IO a +requireSafe what = \case + Right a -> pure a + Left reason -> do + hPutStrLn stderr $ "Error: unsafe " <> Text.unpack what <> ": " <> Text.unpack reason + exitFailure + +reinstallIfPresent :: KitConfig -> Text -> KitScope -> KitManifest -> IO () +reinstallIfPresent config n scope manifest = do + installed <- isInstalled config n scope + when installed $ + case lookupItem n manifest of + Nothing -> pure () + Just item -> do + repoDir <- kitCacheDir config + doInstall config repoDir item scope + Text.IO.putStrLn $ "Updated '" <> n <> "' (" <> scopeLabel scope <> ")" + +reinstallAllPresent :: KitConfig -> KitManifest -> IO () +reinstallAllPresent config manifest = do + let allNames = + map (view #name) (manifest ^. #skills) + ++ map (view #name) (manifest ^. #agents) + repoDir <- kitCacheDir config + updated <- fmap sum $ forM allNames $ \n -> do + userInstalled <- isInstalled config n UserScope + projectInstalled <- isInstalled config n ProjectScope + let count = (if userInstalled then 1 else 0) + (if projectInstalled then 1 else 0) :: Int + when userInstalled $ + case lookupItem n manifest of + Nothing -> pure () + Just item -> doInstall config repoDir item UserScope + when projectInstalled $ + case lookupItem n manifest of + Nothing -> pure () + Just item -> doInstall config repoDir item ProjectScope + pure count + Text.IO.putStrLn $ "Updated " <> Text.pack (show updated) <> " item(s)." + +isInstalled :: KitConfig -> Text -> KitScope -> IO Bool +isInstalled config n scope = do + safeName <- requireSafe "item name" (safeItemName n) + results <- forM (config ^. #providers) $ \provider -> do + providerBase <- providerAgentsBase config provider scope + skillExists <- doesDirectoryExist (skillTarget config provider providerBase safeName) + agentExists <- doesFileExist (agentTarget config provider providerBase safeName) + pure (skillExists || agentExists) + pure (or results) + +removeIfDirectory :: FilePath -> IO Bool +removeIfDirectory dir = do + exists <- doesDirectoryExist dir + when exists (removeDirectoryRecursive dir) + pure exists + +removeIfFile :: FilePath -> IO Bool +removeIfFile file = do + exists <- doesFileExist file + when exists (removeFile file) + pure exists + +skillTarget :: KitConfig -> InteractiveProvider -> FilePath -> FilePath -> FilePath +skillTarget _config provider targetBase n = + targetBase skillTargetPath provider InteractiveProjectScope n + +agentTarget :: KitConfig -> InteractiveProvider -> FilePath -> FilePath -> FilePath +agentTarget _config provider targetBase n = + targetBase agentTargetPath provider InteractiveProjectScope n + +agentSidecarTarget :: KitConfig -> InteractiveProvider -> FilePath -> FilePath -> FilePath +agentSidecarTarget config provider targetBase n = + sidecarPath provider AgentKind (Text.pack n) targetBase (sidecarFileName config) + +skillNameDesc :: SkillEntry -> (Text, Text) +skillNameDesc entry = (entry ^. #name, entry ^. #description) + +agentNameDesc :: AgentEntry -> (Text, Text) +agentNameDesc entry = (entry ^. #name, entry ^. #description) + +agentAsCodexToml :: AgentEntry -> Text -> Text +agentAsCodexToml entry body = + codexCustomAgentToml + CodexCustomAgent + { name = entry ^. #name, + description = entry ^. #description, + developerInstructions = stripYamlFrontmatter body + } + +stripYamlFrontmatter :: Text -> Text +stripYamlFrontmatter input = + case map dropCr (Text.splitOn "\n" input) of + "---" : rest + | (_, _ : body) <- break (== "---") rest -> + Text.intercalate "\n" body + _ -> input + where + dropCr = Text.dropWhileEnd (== '\r') diff --git a/src/Baikai/Kit/Manifest.hs b/src/Baikai/Kit/Manifest.hs new file mode 100644 --- /dev/null +++ b/src/Baikai/Kit/Manifest.hs @@ -0,0 +1,84 @@ +module Baikai.Kit.Manifest + ( AgentEntry (..), + KitItem (..), + KitItemKind (..), + KitManifest (..), + SkillEntry (..), + agentSources, + itemKind, + itemName, + itemVersion, + kitItemKind, + kindLabel, + ) +where + +import Baikai.Prelude +import Data.Text qualified as Text +import System.FilePath (takeFileName, ()) + +data KitManifest = KitManifest + { version :: !Int, + skills :: ![SkillEntry], + agents :: ![AgentEntry] + } + deriving stock (Generic, Show) + deriving anyclass (FromJSON) + +data SkillEntry = SkillEntry + { name :: !Text, + description :: !Text, + version :: !(Maybe Text), + path :: !Text, + files :: ![Text] + } + deriving stock (Generic, Show) + deriving anyclass (FromJSON) + +data AgentEntry = AgentEntry + { name :: !Text, + description :: !Text, + version :: !(Maybe Text), + path :: !Text, + files :: !(Maybe [Text]) + } + deriving stock (Generic, Show) + deriving anyclass (FromJSON) + +data KitItem + = KitSkillItem !SkillEntry + | KitAgentItem !AgentEntry + deriving stock (Generic, Show) + +data KitItemKind + = SkillKind + | AgentKind + deriving stock (Eq, Ord, Show) + +agentSources :: AgentEntry -> [(FilePath, FilePath)] +agentSources entry = + case entry ^. #files of + Just fs -> [(Text.unpack (entry ^. #path) Text.unpack f, Text.unpack f) | f <- fs] + Nothing -> + let source = Text.unpack (entry ^. #path) + in [(source, takeFileName source)] + +itemName :: KitItem -> Text +itemName (KitSkillItem entry) = entry ^. #name +itemName (KitAgentItem entry) = entry ^. #name + +itemKind :: KitItem -> Text +itemKind KitSkillItem {} = "skill" +itemKind KitAgentItem {} = "agent" + +kitItemKind :: KitItem -> KitItemKind +kitItemKind KitSkillItem {} = SkillKind +kitItemKind KitAgentItem {} = AgentKind + +kindLabel :: KitItemKind -> Text +kindLabel SkillKind = "skill" +kindLabel AgentKind = "agent" + +itemVersion :: KitItem -> Maybe Text +itemVersion (KitSkillItem entry) = entry ^. #version +itemVersion (KitAgentItem entry) = entry ^. #version diff --git a/src/Baikai/Kit/Path.hs b/src/Baikai/Kit/Path.hs new file mode 100644 --- /dev/null +++ b/src/Baikai/Kit/Path.hs @@ -0,0 +1,40 @@ +module Baikai.Kit.Path + ( safeItemName, + safeRelativePath, + safeUnder, + ) +where + +import Baikai.Prelude +import Data.Text qualified as Text +import System.FilePath (isAbsolute, normalise, splitDirectories, ()) + +safeRelativePath :: Text -> Either Text FilePath +safeRelativePath input + | Text.null input = Left "path is empty" + | Text.any (== '\0') input = Left "path contains a NUL byte" + | Text.any (== '\\') input = Left "path contains a backslash" + | isAbsolute raw = Left "path is absolute" + | ".." `elem` components = Left "path contains a parent-directory component" + | otherwise = Right normalised + where + raw = Text.unpack input + normalised = normalise raw + components = splitDirectories normalised + +safeItemName :: Text -> Either Text FilePath +safeItemName input + | Text.any (== '/') input = Left "name must be a single path segment" + | otherwise = do + name <- safeRelativePath input + validateName name + where + validateName name + | name == "." = Left "name cannot be '.'" + | name == ".." = Left "name cannot be '..'" + | "." `Text.isPrefixOf` Text.pack name = Left "name cannot start with '.'" + | length (splitDirectories name) /= 1 = Left "name must be a single path segment" + | otherwise = Right name + +safeUnder :: FilePath -> Text -> Either Text FilePath +safeUnder base rel = (base ) <$> safeRelativePath rel diff --git a/src/Baikai/Kit/Repo.hs b/src/Baikai/Kit/Repo.hs new file mode 100644 --- /dev/null +++ b/src/Baikai/Kit/Repo.hs @@ -0,0 +1,66 @@ +module Baikai.Kit.Repo + ( ensureKitRepo, + PullResult (..), + pullKitRepo, + ) +where + +import Baikai.Kit.Config (KitConfig, kitCacheDir) +import Baikai.Prelude +import Control.Exception (IOException, try) +import Data.Text qualified as Text +import Data.Text.IO qualified as Text.IO +import System.Directory (createDirectoryIfMissing, doesDirectoryExist, doesFileExist) +import System.Exit (ExitCode (..), exitFailure) +import System.FilePath (()) +import System.IO (hPutStrLn, stderr) +import System.Process (readProcessWithExitCode) + +data PullResult + = PullSucceeded + | PullFailed !Text + deriving stock (Eq, Show) + +ensureKitRepo :: KitConfig -> IO FilePath +ensureKitRepo config = do + cacheDir <- kitCacheDir config + exists <- doesDirectoryExist (cacheDir ".git") + if exists + then do + result <- pullKitRepo config cacheDir + case result of + PullSucceeded -> pure () + PullFailed err -> + hPutStrLn stderr $ "Warning: git pull failed, using cached data. " <> Text.unpack err + pure cacheDir + else do + Text.IO.putStrLn $ "Fetching " <> (config ^. #toolName) <> "-kit..." + createDirectoryIfMissing True cacheDir + (exitCode, _, errOut) <- + readProcessWithExitCode + "git" + ["clone", "--depth", "1", Text.unpack (config ^. #repoUrl), cacheDir] + "" + case exitCode of + ExitSuccess -> pure cacheDir + ExitFailure _ -> do + manifestExists <- doesFileExist (cacheDir "kit.json") + if manifestExists + then do + hPutStrLn stderr $ "Warning: git clone failed, using cached data. " <> errOut + pure cacheDir + else do + hPutStrLn stderr $ "Error: Failed to fetch kit repository: " <> errOut + exitFailure + +pullKitRepo :: KitConfig -> FilePath -> IO PullResult +pullKitRepo _config cacheDir = do + result <- + try @IOException $ + readProcessWithExitCode "git" ["-C", cacheDir, "pull", "--ff-only", "--quiet"] "" + case result of + Right (ExitSuccess, _, _) -> pure PullSucceeded + Right (ExitFailure _, _, errOut) -> + pure (PullFailed (Text.pack errOut)) + Left e -> + pure (PullFailed (Text.pack (show e))) diff --git a/src/Baikai/Kit/Session.hs b/src/Baikai/Kit/Session.hs new file mode 100644 --- /dev/null +++ b/src/Baikai/Kit/Session.hs @@ -0,0 +1,14 @@ +module Baikai.Kit.Session + ( agentDirsForSession, + ) +where + +import Baikai.Kit.Config (KitConfig, projectAgentsDir, userAgentsDir) +import Control.Monad (filterM) +import System.Directory (doesDirectoryExist) + +agentDirsForSession :: KitConfig -> IO [FilePath] +agentDirsForSession config = do + userDir <- userAgentsDir config + projectDir <- projectAgentsDir config + filterM doesDirectoryExist [userDir, projectDir] diff --git a/src/Baikai/Kit/Sidecar.hs b/src/Baikai/Kit/Sidecar.hs new file mode 100644 --- /dev/null +++ b/src/Baikai/Kit/Sidecar.hs @@ -0,0 +1,97 @@ +module Baikai.Kit.Sidecar + ( SidecarMeta (..), + computeKitHash, + newSidecarMeta, + sidecarPath, + readSidecar, + writeSidecar, + ) +where + +import Baikai.AgentAssets (AgentAssetProvider, agentTargetPath, skillTargetPath) +import Baikai.Interactive (InteractiveScope (InteractiveProjectScope)) +import Baikai.Kit.Manifest (KitItem, KitItemKind (..), itemKind, itemName, itemVersion, kitItemKind) +import Baikai.Kit.Path (safeRelativePath) +import Baikai.Prelude +import Crypto.Hash (Digest, SHA256) +import Crypto.Hash qualified as Hash +import Data.Aeson (eitherDecodeFileStrict', encode) +import Data.Binary.Put (putWord64be, runPut) +import Data.ByteString qualified as BS +import Data.ByteString.Lazy qualified as LBS +import Data.List (sort) +import Data.Text qualified as Text +import Data.Text.Encoding qualified as Text.Encoding +import Data.Time.Clock (getCurrentTime) +import Data.Time.Format (defaultTimeLocale, formatTime) +import System.Directory (createDirectoryIfMissing, doesFileExist) +import System.FilePath (dropExtension, takeDirectory, ()) +import System.IO (hPutStrLn, stderr) + +data SidecarMeta = SidecarMeta + { name :: !Text, + kind :: !Text, + version :: !(Maybe Text), + hash :: !Text, + installedAt :: !Text + } + deriving stock (Eq, Generic, Show) + deriving anyclass (FromJSON, ToJSON) + +computeKitHash :: FilePath -> [Text] -> IO Text +computeKitHash baseDir relFiles = do + chunks <- mapM (readOne baseDir) (sort relFiles) + let digest = Hash.hash (BS.concat chunks) :: Digest SHA256 + hex = Text.pack (show digest) + pure ("sha256:" <> hex) + where + readOne :: FilePath -> Text -> IO BS.ByteString + readOne dir rel = do + safeRel <- either (ioError . userError . Text.unpack) pure (safeRelativePath rel) + content <- BS.readFile (dir safeRel) + let pathBytes = Text.Encoding.encodeUtf8 (Text.pack safeRel) + lenBytes = LBS.toStrict (runPut (putWord64be (fromIntegral (BS.length content)))) + pure $ BS.concat [pathBytes, BS.singleton 0x00, lenBytes, content, BS.singleton 0x00] + +sidecarPath :: AgentAssetProvider -> KitItemKind -> Text -> FilePath -> Text -> FilePath +sidecarPath provider SkillKind itemName' targetBase sidecarName = + targetBase + skillTargetPath provider InteractiveProjectScope (Text.unpack itemName') + Text.unpack sidecarName +sidecarPath provider AgentKind itemName' targetBase sidecarName = + targetBase + dropExtension (agentTargetPath provider InteractiveProjectScope (Text.unpack itemName')) + <> Text.unpack sidecarName + +readSidecar :: FilePath -> IO (Maybe SidecarMeta) +readSidecar p = do + exists <- doesFileExist p + if not exists + then pure Nothing + else do + result <- eitherDecodeFileStrict' p + case result of + Right meta -> pure (Just meta) + Left err -> do + hPutStrLn stderr $ "Warning: failed to parse sidecar " <> p <> ": " <> err + pure Nothing + +writeSidecar :: AgentAssetProvider -> KitItem -> FilePath -> Text -> Text -> IO () +writeSidecar provider item targetBase sidecarName hashStr = do + meta <- newSidecarMeta item hashStr + let out = sidecarPath provider (kitItemKind item) (itemName item) targetBase sidecarName + createDirectoryIfMissing True (takeDirectory out) + LBS.writeFile out (encode meta) + +newSidecarMeta :: KitItem -> Text -> IO SidecarMeta +newSidecarMeta item hashStr = do + now <- getCurrentTime + let stamp = Text.pack (formatTime defaultTimeLocale "%Y-%m-%dT%H:%M:%SZ" now) + pure + SidecarMeta + { name = itemName item, + kind = itemKind item, + version = itemVersion item, + hash = hashStr, + installedAt = stamp + } diff --git a/src/Baikai/Kit/Status.hs b/src/Baikai/Kit/Status.hs new file mode 100644 --- /dev/null +++ b/src/Baikai/Kit/Status.hs @@ -0,0 +1,225 @@ +module Baikai.Kit.Status + ( KitState (..), + StatusRow (..), + classify, + collectStatus, + kitStatus, + renderState, + ) +where + +import Baikai.AgentAssets (AgentAssetProvider, agentTargetPath, skillTargetPath) +import Baikai.Interactive (InteractiveScope (InteractiveProjectScope)) +import Baikai.Kit.Config (KitConfig, KitScope (..), providerAgentsBase, providerLabel, sidecarFileName) +import Baikai.Kit.Install (loadManifestMaybe, lookupItem) +import Baikai.Kit.Manifest (AgentEntry, KitItem (..), KitItemKind (..), agentSources, itemKind, itemVersion, kindLabel) +import Baikai.Kit.Repo (ensureKitRepo) +import Baikai.Kit.Sidecar (SidecarMeta, computeKitHash, readSidecar, sidecarPath) +import Baikai.Prelude +import Control.Exception (IOException, try) +import Control.Monad (forM) +import Data.List (groupBy, isPrefixOf, isSuffixOf, nub, sort, sortOn) +import Data.Maybe (fromMaybe) +import Data.Text qualified as Text +import Data.Text.IO qualified as Text.IO +import System.Directory (doesDirectoryExist, doesFileExist, listDirectory) +import System.FilePath (takeDirectory, ()) + +data KitState + = KitUpToDate + | KitOutdated + | KitDirty + | KitDirtyOutdated + | KitDelisted + | KitUnknown + deriving stock (Eq, Ord, Show) + +data StatusRow = StatusRow + { name :: !Text, + kind :: !Text, + scope :: !Text, + providers :: !Text, + installedVersion :: !(Maybe Text), + latestVersion :: !(Maybe Text), + state :: !KitState + } + deriving stock (Eq, Generic, Show) + +renderState :: KitState -> Text +renderState = \case + KitUpToDate -> "up-to-date" + KitOutdated -> "outdated" + KitDirty -> "dirty" + KitDirtyOutdated -> "dirty+outdated" + KitDelisted -> "delisted" + KitUnknown -> "unknown" + +classify :: Maybe SidecarMeta -> Maybe KitItem -> Maybe Text -> KitState +classify Nothing _ _ = KitUnknown +classify (Just _) Nothing _ = KitDelisted +classify (Just sm) (Just it) mUpstreamHash = + let outdated = case itemVersion it of + Just latest -> sm ^. #version /= Just latest + Nothing -> False + dirty = case mUpstreamHash of + Just up -> up /= sm ^. #hash + Nothing -> False + in case (outdated, dirty) of + (True, True) -> KitDirtyOutdated + (True, False) -> KitOutdated + (False, True) -> KitDirty + (False, False) -> KitUpToDate + +kitStatus :: KitConfig -> IO () +kitStatus config = do + cacheDir <- resolveCacheOrEmpty config + rows <- collectStatus config cacheDir [(UserScope, "user"), (ProjectScope, "project")] + renderStatusTable rows + +collectStatus :: KitConfig -> FilePath -> [(KitScope, Text)] -> IO [StatusRow] +collectStatus config cacheDir scopes = do + mManifest <- loadManifestMaybe cacheDir + fmap concat . forM scopes $ \(scope, scopeText) -> do + items <- scanInstalled config scope + forM items $ \(provider, baseDir, itemName', scannedKind) -> do + let mItem = lookupItem itemName' =<< mManifest + mSidecar <- readSidecar (sidecarPath provider scannedKind itemName' baseDir (sidecarFileName config)) + mUpstreamHash <- upstreamHash cacheDir mItem + let state' = classify mSidecar mItem mUpstreamHash + pure + StatusRow + { name = itemName', + kind = maybe (kindLabel scannedKind) itemKind mItem, + scope = scopeText, + providers = providerLabel provider, + installedVersion = mSidecar >>= (^. #version), + latestVersion = mItem >>= itemVersion, + state = state' + } + +resolveCacheOrEmpty :: KitConfig -> IO FilePath +resolveCacheOrEmpty config = do + result <- try @IOException (ensureKitRepo config) + case result of + Right dir -> do + manifestExists <- doesFileExist (dir "kit.json") + pure (if manifestExists then dir else "") + Left _ -> pure "" + +upstreamHash :: FilePath -> Maybe KitItem -> IO (Maybe Text) +upstreamHash "" _ = pure Nothing +upstreamHash _ Nothing = pure Nothing +upstreamHash cacheDir (Just (KitSkillItem entry)) = + tryHash (cacheDir Text.unpack (entry ^. #path)) (entry ^. #files) +upstreamHash cacheDir (Just (KitAgentItem entry)) = + tryHash (agentSourceBase cacheDir entry) (map (Text.pack . snd) (agentSources entry)) + +tryHash :: FilePath -> [Text] -> IO (Maybe Text) +tryHash base files = do + result <- try @IOException (computeKitHash base files) + case result of + Right h -> pure (Just h) + Left _ -> pure Nothing + +scanInstalled :: KitConfig -> KitScope -> IO [(AgentAssetProvider, FilePath, Text, KitItemKind)] +scanInstalled config scope = fmap concat $ + forM (config ^. #providers) $ \provider -> do + baseDir <- providerAgentsBase config provider scope + skillItems <- scanSkills provider (takeDirectory (baseDir skillTargetPath provider InteractiveProjectScope "__scan__")) + agentItems <- scanAgents provider (takeDirectory (baseDir agentTargetPath provider InteractiveProjectScope "__scan__")) + pure [(provider', baseDir, itemName', kind) | (provider', itemName', kind) <- skillItems ++ agentItems] + +scanSkills :: AgentAssetProvider -> FilePath -> IO [(AgentAssetProvider, Text, KitItemKind)] +scanSkills provider dir = do + exists <- doesDirectoryExist dir + if exists + then do + entries <- listDirectory dir + pure [(provider, Text.pack e, SkillKind) | e <- entries, visible e] + else pure [] + +scanAgents :: AgentAssetProvider -> FilePath -> IO [(AgentAssetProvider, Text, KitItemKind)] +scanAgents provider dir = do + exists <- doesDirectoryExist dir + if exists + then do + entries <- listDirectory dir + let files = filter (\f -> agentExtension provider `isSuffixOf` f && visible f) entries + pure [(provider, Text.pack (dropAgentExtension provider f), AgentKind) | f <- files] + else pure [] + +renderStatusTable :: [StatusRow] -> IO () +renderStatusTable [] = Text.IO.putStrLn "No kit items installed." +renderStatusTable rows = do + let displayRows = aggregateStatusRows rows + nameW = colWidth displayRows "NAME" (^. #name) + kindW = colWidth displayRows "TYPE" (^. #kind) + scopeW = colWidth displayRows "SCOPE" (^. #scope) + providersW = colWidth displayRows "PROVIDERS" (^. #providers) + instW = colWidth displayRows "INSTALLED" (renderMVer . view #installedVersion) + latW = colWidth displayRows "LATEST" (renderMVer . view #latestVersion) + hdr = + Text.justifyLeft (nameW + 2) ' ' "NAME" + <> Text.justifyLeft (kindW + 2) ' ' "TYPE" + <> Text.justifyLeft (scopeW + 2) ' ' "SCOPE" + <> Text.justifyLeft (providersW + 2) ' ' "PROVIDERS" + <> Text.justifyLeft (instW + 2) ' ' "INSTALLED" + <> Text.justifyLeft (latW + 2) ' ' "LATEST" + <> "STATE" + Text.IO.putStrLn hdr + mapM_ (printRow nameW kindW scopeW providersW instW latW) displayRows + where + colWidth displayRows colTitle f = + maximum (Text.length colTitle : map (Text.length . f) displayRows) + + renderMVer = fromMaybe "-" + + printRow nameW kindW scopeW providersW instW latW row = + Text.IO.putStrLn $ + Text.justifyLeft (nameW + 2) ' ' (row ^. #name) + <> Text.justifyLeft (kindW + 2) ' ' (row ^. #kind) + <> Text.justifyLeft (scopeW + 2) ' ' (row ^. #scope) + <> Text.justifyLeft (providersW + 2) ' ' (row ^. #providers) + <> Text.justifyLeft (instW + 2) ' ' (renderMVer (row ^. #installedVersion)) + <> Text.justifyLeft (latW + 2) ' ' (renderMVer (row ^. #latestVersion)) + <> renderState (row ^. #state) + +aggregateStatusRows :: [StatusRow] -> [StatusRow] +aggregateStatusRows rows = + map summarize grouped + where + grouped = groupBy sameKey $ sortOn rowKey rows + rowKey row = + ( row ^. #name, + row ^. #kind, + row ^. #scope, + row ^. #installedVersion, + row ^. #latestVersion, + row ^. #state + ) + sameKey a b = rowKey a == rowKey b + summarize groupRows@(firstRow : _) = + firstRow & #providers .~ Text.intercalate "," (sort (nub (map (^. #providers) groupRows))) + summarize [] = error "aggregateStatusRows: empty group" + +agentSourceBase :: FilePath -> AgentEntry -> FilePath +agentSourceBase repoDir entry = + case entry ^. #files of + Just _ -> repoDir Text.unpack (entry ^. #path) + Nothing -> repoDir takeDirectory (Text.unpack (entry ^. #path)) + +agentExtension :: AgentAssetProvider -> String +agentExtension provider = + case agentTargetPath provider InteractiveProjectScope "__scan__" of + path + | ".toml" `isSuffixOf` path -> ".toml" + | ".md" `isSuffixOf` path -> ".md" + | otherwise -> "" + +dropAgentExtension :: AgentAssetProvider -> FilePath -> FilePath +dropAgentExtension provider file = + let ext = agentExtension provider + in take (length file - length ext) file + +visible :: FilePath -> Bool +visible = not . ("." `isPrefixOf`) diff --git a/test/Main.hs b/test/Main.hs new file mode 100644 --- /dev/null +++ b/test/Main.hs @@ -0,0 +1,498 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Main (main) where + +import Baikai.Interactive (InteractiveProvider (InteractiveClaude, InteractiveCodex)) +import Baikai.Kit + ( AgentEntry (..), + KitConfig (..), + KitItem (..), + KitItemKind (..), + KitManifest (..), + KitScope (UserScope), + KitState (..), + PullResult (..), + RemovalOutcome (..), + SidecarMeta (..), + SkillEntry (..), + classify, + collectStatus, + computeKitHash, + installItem, + pullKitRepo, + readSidecar, + renderUninstallReport, + safeItemName, + safeRelativePath, + safeUnder, + sidecarFileName, + sidecarPath, + stripYamlFrontmatter, + uninstallItem, + uninstallOutcomes, + 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, + doesDirectoryExist, + doesFileExist, + doesPathExist, + listDirectory, + removeDirectoryRecursive, + ) +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, + frontmatterTests, + classifyTests, + statusFilesystemTests, + installRoundTripTests + ] + +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 <- computeKitHash dir ["a.md", "b.md", "c.md"] + h2 <- 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 <- computeKitHash dir ["a.md"] + BS.writeFile (dir "a.md") "alpha-modified" + after <- 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 "safeUnder rejects an absolute right operand" $ + assertLeft (safeUnder "/base" "/etc/passwd"), + testCase "install refuses a manifest file path that escapes the install root" $ + withPreparedKitHome $ \home cache -> do + BS.writeFile (cache "kit.json") maliciousManifestJson + result <- try @ExitCode (installItem testConfig "evil" UserScope) + result @?= Left (ExitFailure 1) + assertFileMissing (takeDirectory home "escape.txt"), + testCase "uninstall refuses a traversal name" $ + withPreparedKitHome $ \home _cache -> do + let victim = home "victim" + createDirectoryIfMissing True victim + result <- try @ExitCode (uninstallItem testConfig "../victim" UserScope) + result @?= Left (ExitFailure 1) + assertDirectoryExists victim + ] + +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" + ] + +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 + 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 + 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" + 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" + uninstallItem config "demo" UserScope + assertDirectoryMissing claudeSkill + assertDirectoryMissing codexSkill + 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) + 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" + 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 <- try @ExitCode (installItem testConfig "reviewer" UserScope) + result @?= Left (ExitFailure 1) + 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 "uninstallOutcomes reports per-provider removals" $ + withPreparedKitHome $ \home _cache -> do + let codexSkill = home ".agents" "skills" "demo" + installItem testConfig "demo" UserScope + removeDirectoryRecursive codexSkill + outcomes <- uninstallOutcomes 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 and update exits nonzero" $ + withPreparedKitHome $ \_home cache -> do + result <- pullKitRepo testConfig cache + case result of + PullFailed _ -> pure () + PullSucceeded -> assertFailure "expected fake .git cache pull to fail" + updateResult <- try @ExitCode (updateKit testConfig Nothing) + updateResult @?= Left (ExitFailure 1) + ] + +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" + } + +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 + where + restoreHome Nothing = unsetEnv "HOME" + restoreHome (Just value) = setEnv "HOME" value + +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\":[]} " + ] + +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"