never executed always true always false

    1 module PureClaw.Tools.HttpRequest
    2   ( -- * Tool registration
    3     httpRequestTool
    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 
   13 import PureClaw.Core.Types
   14 import PureClaw.Handles.Network
   15 import PureClaw.Providers.Class
   16 import PureClaw.Tools.Registry
   17 
   18 -- | Create an HTTP request tool that sends requests through URL validation.
   19 httpRequestTool :: AllowList Text -> NetworkHandle -> (ToolDefinition, ToolHandler)
   20 httpRequestTool allowList nh = (def, handler)
   21   where
   22     def = ToolDefinition
   23       { _td_name        = "http_request"
   24       , _td_description = "Make an HTTP GET request to a URL. The URL must be in the allowed domain list."
   25       , _td_inputSchema = object
   26           [ "type" .= ("object" :: Text)
   27           , "properties" .= object
   28               [ "url" .= object
   29                   [ "type" .= ("string" :: Text)
   30                   , "description" .= ("The URL to request" :: Text)
   31                   ]
   32               ]
   33           , "required" .= (["url"] :: [Text])
   34           ]
   35       }
   36 
   37     handler = ToolHandler $ \input ->
   38       case parseEither parseInput input of
   39         Left err -> pure (T.pack err, True)
   40         Right url ->
   41           case mkAllowedUrl allowList url of
   42             Left (UrlNotAllowed u) -> pure ("URL domain not allowed: " <> u, True)
   43             Left (UrlMalformed u) -> pure ("Malformed URL: " <> u, True)
   44             Right allowed -> do
   45               result <- try @SomeException (_nh_httpGet nh allowed)
   46               case result of
   47                 Left e -> pure (T.pack (show e), True)
   48                 Right resp ->
   49                   let status = T.pack (show (_hr_statusCode resp))
   50                       body = T.pack (BS8.unpack (_hr_body resp))
   51                   in pure ("HTTP " <> status <> "\n" <> body, False)
   52 
   53     parseInput :: Value -> Parser Text
   54     parseInput = withObject "HttpRequestInput" $ \o -> o .: "url"