never executed always true always false

    1 module PureClaw.Tools.Shell
    2   ( -- * Tool registration
    3     shellTool
    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 shell tool that executes commands through the security policy.
   21 shellTool :: SecurityPolicy -> ShellHandle -> (ToolDefinition, ToolHandler)
   22 shellTool policy sh = (def, handler)
   23   where
   24     def = ToolDefinition
   25       { _td_name        = "shell"
   26       , _td_description = "Execute a shell command. The command is validated against the security policy before execution."
   27       , _td_inputSchema = object
   28           [ "type" .= ("object" :: Text)
   29           , "properties" .= object
   30               [ "command" .= object
   31                   [ "type" .= ("string" :: Text)
   32                   , "description" .= ("The shell command to execute" :: Text)
   33                   ]
   34               ]
   35           , "required" .= (["command"] :: [Text])
   36           ]
   37       }
   38 
   39     handler = ToolHandler $ \input -> do
   40       case parseEither parseInput input of
   41         Left err -> pure (T.pack err, True)
   42         Right cmd -> do
   43           let parts = T.words cmd
   44           case parts of
   45             [] -> pure ("Empty command", True)
   46             (prog:args) ->
   47               case authorize policy (T.unpack prog) args of
   48                 Left (CommandNotAllowed c) ->
   49                   pure ("Command not allowed: " <> c, True)
   50                 Left CommandInAutonomyDeny ->
   51                   pure ("All commands denied by security policy", True)
   52                 Right authorized -> do
   53                   result <- try @SomeException (_sh_execute sh authorized)
   54                   case result of
   55                     Left e -> pure (T.pack (show e), True)
   56                     Right pr -> do
   57                       let out = T.pack (BS8.unpack (_pr_stdout pr))
   58                           err = T.pack (BS8.unpack (_pr_stderr pr))
   59                           exitInfo = case _pr_exitCode pr of
   60                             ExitSuccess -> ""
   61                             ExitFailure n -> "\nExit code: " <> T.pack (show n)
   62                           combined = T.strip (out <> err <> exitInfo)
   63                       pure (if T.null combined then "(no output)" else combined, False)
   64 
   65     parseInput :: Value -> Parser Text
   66     parseInput = withObject "ShellInput" $ \o -> o .: "command"