never executed always true always false

    1 module PureClaw.Tools.FileWrite
    2   ( -- * Tool registration
    3     fileWriteTool
    4   ) where
    5 
    6 import Control.Exception
    7 import Data.Aeson
    8 import Data.Aeson.Types
    9 import Data.ByteString qualified as BS
   10 import Data.Text (Text)
   11 import Data.Text qualified as T
   12 import Data.Text.Encoding qualified as TE
   13 
   14 import PureClaw.Core.Types
   15 import PureClaw.Handles.File
   16 import PureClaw.Providers.Class
   17 import PureClaw.Security.Path
   18 import PureClaw.Tools.Registry
   19 
   20 -- | Create a file write tool that writes files through SafePath validation.
   21 fileWriteTool :: WorkspaceRoot -> FileHandle -> (ToolDefinition, ToolHandler)
   22 fileWriteTool root fh = (def, handler)
   23   where
   24     def = ToolDefinition
   25       { _td_name        = "file_write"
   26       , _td_description = "Write content to a file within the workspace. Creates the file if it does not exist, or overwrites if it does."
   27       , _td_inputSchema = object
   28           [ "type" .= ("object" :: Text)
   29           , "properties" .= object
   30               [ "path" .= object
   31                   [ "type" .= ("string" :: Text)
   32                   , "description" .= ("The file path relative to the workspace root" :: Text)
   33                   ]
   34               , "content" .= object
   35                   [ "type" .= ("string" :: Text)
   36                   , "description" .= ("The content to write" :: Text)
   37                   ]
   38               ]
   39           , "required" .= (["path", "content"] :: [Text])
   40           ]
   41       }
   42 
   43     handler = ToolHandler $ \input ->
   44       case parseEither parseInput input of
   45         Left err -> pure (T.pack err, True)
   46         Right (path, content) -> do
   47           pathResult <- mkSafePath root (T.unpack path)
   48           case pathResult of
   49             Left (PathDoesNotExist _) -> do
   50               -- For writes, we allow creating new files. Use the raw path
   51               -- but still validate it doesn't escape workspace.
   52               writeNew root path content
   53             Left pe -> pure (T.pack (show pe), True)
   54             Right sp -> do
   55               result <- try @SomeException (_fh_writeFile fh sp (TE.encodeUtf8 content))
   56               case result of
   57                 Left e -> pure (T.pack (show e), True)
   58                 Right () -> pure ("Written to " <> path, False)
   59 
   60     writeNew :: WorkspaceRoot -> Text -> Text -> IO (Text, Bool)
   61     writeNew (WorkspaceRoot wr) path content = do
   62       -- Create the file first so mkSafePath can validate it exists
   63       let fullPath = wr <> "/" <> T.unpack path
   64       result <- try @SomeException (TE.encodeUtf8 content `seq` pure ())
   65       case result of
   66         Left e -> pure (T.pack (show e), True)
   67         Right () -> do
   68           writeResult <- try @SomeException $ do
   69             BS.writeFile fullPath (TE.encodeUtf8 content)
   70           case writeResult of
   71             Left e -> pure (T.pack (show e), True)
   72             Right () -> do
   73               -- Validate the written file is safe
   74               validated <- mkSafePath (WorkspaceRoot wr) fullPath
   75               case validated of
   76                 Left pe -> pure (T.pack (show pe), True)
   77                 Right _ -> pure ("Written to " <> path, False)
   78 
   79     parseInput :: Value -> Parser (Text, Text)
   80     parseInput = withObject "FileWriteInput" $ \o ->
   81       (,) <$> o .: "path" <*> o .: "content"