never executed always true always false

    1 module PureClaw.Tools.Git
    2   ( -- * Tool registration
    3     gitTool
    4   ) where
    5 
    6 import Control.Exception
    7 import Data.Aeson
    8 import Data.Aeson.Types
    9 import Data.ByteString.Char8 qualified as BS8
   10 import Data.Text (Text)
   11 import Data.Text qualified as T
   12 import System.Exit
   13 
   14 import PureClaw.Handles.Shell
   15 import PureClaw.Providers.Class
   16 import PureClaw.Security.Command
   17 import PureClaw.Security.Policy
   18 import PureClaw.Tools.Registry
   19 
   20 -- | Create a git tool that executes git subcommands through the security policy.
   21 gitTool :: SecurityPolicy -> ShellHandle -> (ToolDefinition, ToolHandler)
   22 gitTool policy sh = (def, handler)
   23   where
   24     def = ToolDefinition
   25       { _td_name        = "git"
   26       , _td_description = "Execute git operations. Supports: status, diff, log, add, commit, branch, checkout, stash."
   27       , _td_inputSchema = object
   28           [ "type" .= ("object" :: Text)
   29           , "properties" .= object
   30               [ "subcommand" .= object
   31                   [ "type" .= ("string" :: Text)
   32                   , "description" .= ("The git subcommand and arguments, e.g. \"status\" or \"diff --cached\"" :: Text)
   33                   ]
   34               ]
   35           , "required" .= (["subcommand"] :: [Text])
   36           ]
   37       }
   38 
   39     handler = ToolHandler $ \input ->
   40       case parseEither parseInput input of
   41         Left err -> pure (T.pack err, True)
   42         Right subcmd -> do
   43           let args = T.words subcmd
   44           case authorize policy "git" args of
   45             Left (CommandNotAllowed _) -> pure ("git is not in the allowed commands list", True)
   46             Left CommandInAutonomyDeny -> pure ("All commands denied by security policy", True)
   47             Right authorized -> do
   48               result <- try @SomeException (_sh_execute sh authorized)
   49               case result of
   50                 Left e -> pure (T.pack (show e), True)
   51                 Right pr -> do
   52                   let out = T.pack (BS8.unpack (_pr_stdout pr))
   53                       err = T.pack (BS8.unpack (_pr_stderr pr))
   54                       exitInfo = case _pr_exitCode pr of
   55                         ExitSuccess -> ""
   56                         ExitFailure n -> "\nExit code: " <> T.pack (show n)
   57                       combined = T.strip (out <> err <> exitInfo)
   58                   pure (if T.null combined then "(no output)" else combined, False)
   59 
   60     parseInput :: Value -> Parser Text
   61     parseInput = withObject "GitInput" $ \o -> o .: "subcommand"