summaryrefslogtreecommitdiff
path: root/Omni/Agent/Tools/Http.hs
diff options
context:
space:
mode:
Diffstat (limited to 'Omni/Agent/Tools/Http.hs')
-rw-r--r--Omni/Agent/Tools/Http.hs338
1 files changed, 338 insertions, 0 deletions
diff --git a/Omni/Agent/Tools/Http.hs b/Omni/Agent/Tools/Http.hs
new file mode 100644
index 0000000..d996ff5
--- /dev/null
+++ b/Omni/Agent/Tools/Http.hs
@@ -0,0 +1,338 @@
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+
+-- | HTTP request tools for agent API interactions.
+--
+-- Provides http_get and http_post tools for making HTTP requests.
+-- Supports headers, query params, and JSON body.
+--
+-- : out omni-agent-tools-http
+-- : dep aeson
+-- : dep http-conduit
+module Omni.Agent.Tools.Http
+ ( -- * Tools
+ httpGetTool,
+ httpPostTool,
+ allHttpTools,
+
+ -- * Types
+ HttpGetArgs (..),
+ HttpPostArgs (..),
+ HttpResult (..),
+
+ -- * Testing
+ main,
+ test,
+ )
+where
+
+import Alpha
+import Data.Aeson ((.:), (.:?), (.=))
+import qualified Data.Aeson as Aeson
+import qualified Data.Aeson.Key as Key
+import qualified Data.Aeson.KeyMap as KeyMap
+import qualified Data.ByteString.Lazy as BL
+import qualified Data.CaseInsensitive as CI
+import qualified Data.Text as Text
+import qualified Data.Text.Encoding as TE
+import qualified Network.HTTP.Client as HTTPClient
+import qualified Network.HTTP.Simple as HTTP
+import qualified Omni.Agent.Engine as Engine
+import qualified Omni.Test as Test
+import System.Timeout (timeout)
+
+main :: IO ()
+main = Test.run test
+
+test :: Test.Tree
+test =
+ Test.group
+ "Omni.Agent.Tools.Http"
+ [ Test.unit "httpGetTool has correct name" <| do
+ Engine.toolName httpGetTool Test.@=? "http_get",
+ Test.unit "httpPostTool has correct name" <| do
+ Engine.toolName httpPostTool Test.@=? "http_post",
+ Test.unit "allHttpTools has 2 tools" <| do
+ length allHttpTools Test.@=? 2,
+ Test.unit "HttpGetArgs parses correctly" <| do
+ let json = Aeson.object ["url" .= ("https://example.com" :: Text)]
+ case Aeson.fromJSON json of
+ Aeson.Success (args :: HttpGetArgs) -> httpGetUrl args Test.@=? "https://example.com"
+ Aeson.Error e -> Test.assertFailure e,
+ Test.unit "HttpGetArgs parses with headers" <| do
+ let json =
+ Aeson.object
+ [ "url" .= ("https://api.example.com" :: Text),
+ "headers" .= Aeson.object ["Authorization" .= ("Bearer token" :: Text)]
+ ]
+ case Aeson.fromJSON json of
+ Aeson.Success (args :: HttpGetArgs) -> do
+ httpGetUrl args Test.@=? "https://api.example.com"
+ isJust (httpGetHeaders args) Test.@=? True
+ Aeson.Error e -> Test.assertFailure e,
+ Test.unit "HttpPostArgs parses correctly" <| do
+ let json =
+ Aeson.object
+ [ "url" .= ("https://api.example.com" :: Text),
+ "body" .= Aeson.object ["key" .= ("value" :: Text)]
+ ]
+ case Aeson.fromJSON json of
+ Aeson.Success (args :: HttpPostArgs) -> do
+ httpPostUrl args Test.@=? "https://api.example.com"
+ isJust (httpPostBody args) Test.@=? True
+ Aeson.Error e -> Test.assertFailure e,
+ Test.unit "HttpResult JSON roundtrip" <| do
+ let result =
+ HttpResult
+ { httpResultStatus = 200,
+ httpResultHeaders = Aeson.object ["Content-Type" .= ("application/json" :: Text)],
+ httpResultBody = "{\"ok\": true}"
+ }
+ case Aeson.decode (Aeson.encode result) of
+ Nothing -> Test.assertFailure "Failed to decode HttpResult"
+ Just decoded -> httpResultStatus decoded Test.@=? 200,
+ Test.unit "http_get fetches real URL" <| do
+ let args = Aeson.object ["url" .= ("https://httpbin.org/get" :: Text)]
+ result <- Engine.toolExecute httpGetTool args
+ case Aeson.fromJSON result of
+ Aeson.Success (r :: HttpResult) -> do
+ httpResultStatus r Test.@=? 200
+ ("httpbin.org" `Text.isInfixOf` httpResultBody r) Test.@=? True
+ Aeson.Error e -> Test.assertFailure e,
+ Test.unit "http_post with JSON body" <| do
+ let args =
+ Aeson.object
+ [ "url" .= ("https://httpbin.org/post" :: Text),
+ "body" .= Aeson.object ["test" .= ("value" :: Text)]
+ ]
+ result <- Engine.toolExecute httpPostTool args
+ case Aeson.fromJSON result of
+ Aeson.Success (r :: HttpResult) -> do
+ httpResultStatus r Test.@=? 200
+ ("test" `Text.isInfixOf` httpResultBody r) Test.@=? True
+ Aeson.Error e -> Test.assertFailure e
+ ]
+
+data HttpGetArgs = HttpGetArgs
+ { httpGetUrl :: Text,
+ httpGetHeaders :: Maybe Aeson.Object,
+ httpGetParams :: Maybe Aeson.Object
+ }
+ deriving (Show, Eq, Generic)
+
+instance Aeson.FromJSON HttpGetArgs where
+ parseJSON =
+ Aeson.withObject "HttpGetArgs" <| \v ->
+ (HttpGetArgs </ (v .: "url"))
+ <*> (v .:? "headers")
+ <*> (v .:? "params")
+
+data HttpPostArgs = HttpPostArgs
+ { httpPostUrl :: Text,
+ httpPostHeaders :: Maybe Aeson.Object,
+ httpPostBody :: Maybe Aeson.Value,
+ httpPostContentType :: Maybe Text
+ }
+ deriving (Show, Eq, Generic)
+
+instance Aeson.FromJSON HttpPostArgs where
+ parseJSON =
+ Aeson.withObject "HttpPostArgs" <| \v ->
+ (HttpPostArgs </ (v .: "url"))
+ <*> (v .:? "headers")
+ <*> (v .:? "body")
+ <*> (v .:? "content_type")
+
+data HttpResult = HttpResult
+ { httpResultStatus :: Int,
+ httpResultHeaders :: Aeson.Value,
+ httpResultBody :: Text
+ }
+ deriving (Show, Eq, Generic)
+
+instance Aeson.ToJSON HttpResult where
+ toJSON r =
+ Aeson.object
+ [ "status" .= httpResultStatus r,
+ "headers" .= httpResultHeaders r,
+ "body" .= httpResultBody r
+ ]
+
+instance Aeson.FromJSON HttpResult where
+ parseJSON =
+ Aeson.withObject "HttpResult" <| \v ->
+ (HttpResult </ (v .: "status"))
+ <*> (v .: "headers")
+ <*> (v .: "body")
+
+allHttpTools :: [Engine.Tool]
+allHttpTools = [httpGetTool, httpPostTool]
+
+httpGetTool :: Engine.Tool
+httpGetTool =
+ Engine.Tool
+ { Engine.toolName = "http_get",
+ Engine.toolDescription =
+ "Make an HTTP GET request. Returns status code, headers, and response body. "
+ <> "Use for fetching data from APIs or web pages.",
+ Engine.toolJsonSchema =
+ Aeson.object
+ [ "type" .= ("object" :: Text),
+ "properties"
+ .= Aeson.object
+ [ "url"
+ .= Aeson.object
+ [ "type" .= ("string" :: Text),
+ "description" .= ("The URL to request" :: Text)
+ ],
+ "headers"
+ .= Aeson.object
+ [ "type" .= ("object" :: Text),
+ "description" .= ("Optional headers as key-value pairs" :: Text)
+ ],
+ "params"
+ .= Aeson.object
+ [ "type" .= ("object" :: Text),
+ "description" .= ("Optional query parameters as key-value pairs" :: Text)
+ ]
+ ],
+ "required" .= (["url"] :: [Text])
+ ],
+ Engine.toolExecute = executeHttpGet
+ }
+
+executeHttpGet :: Aeson.Value -> IO Aeson.Value
+executeHttpGet v =
+ case Aeson.fromJSON v of
+ Aeson.Error e -> pure <| mkError ("Invalid arguments: " <> Text.pack e)
+ Aeson.Success args -> do
+ let urlWithParams = case httpGetParams args of
+ Nothing -> httpGetUrl args
+ Just params ->
+ let paramList = [(k, v') | (k, v') <- KeyMap.toList params]
+ paramStr = Text.intercalate "&" [Key.toText k <> "=" <> valueToText v' | (k, v') <- paramList]
+ in if Text.null paramStr
+ then httpGetUrl args
+ else httpGetUrl args <> "?" <> paramStr
+ doHttpRequest "GET" urlWithParams (httpGetHeaders args) Nothing
+
+httpPostTool :: Engine.Tool
+httpPostTool =
+ Engine.Tool
+ { Engine.toolName = "http_post",
+ Engine.toolDescription =
+ "Make an HTTP POST request. Returns status code, headers, and response body. "
+ <> "Use for submitting data to APIs or forms.",
+ Engine.toolJsonSchema =
+ Aeson.object
+ [ "type" .= ("object" :: Text),
+ "properties"
+ .= Aeson.object
+ [ "url"
+ .= Aeson.object
+ [ "type" .= ("string" :: Text),
+ "description" .= ("The URL to request" :: Text)
+ ],
+ "headers"
+ .= Aeson.object
+ [ "type" .= ("object" :: Text),
+ "description" .= ("Optional headers as key-value pairs" :: Text)
+ ],
+ "body"
+ .= Aeson.object
+ [ "type" .= ("object" :: Text),
+ "description" .= ("Optional JSON body (object or string)" :: Text)
+ ],
+ "content_type"
+ .= Aeson.object
+ [ "type" .= ("string" :: Text),
+ "description" .= ("Content type (default: application/json)" :: Text)
+ ]
+ ],
+ "required" .= (["url"] :: [Text])
+ ],
+ Engine.toolExecute = executeHttpPost
+ }
+
+executeHttpPost :: Aeson.Value -> IO Aeson.Value
+executeHttpPost v =
+ case Aeson.fromJSON v of
+ Aeson.Error e -> pure <| mkError ("Invalid arguments: " <> Text.pack e)
+ Aeson.Success args -> do
+ let contentType = fromMaybe "application/json" (httpPostContentType args)
+ body = case httpPostBody args of
+ Nothing -> Nothing
+ Just b -> Just (contentType, BL.toStrict (Aeson.encode b))
+ doHttpRequest "POST" (httpPostUrl args) (httpPostHeaders args) body
+
+doHttpRequest ::
+ ByteString ->
+ Text ->
+ Maybe Aeson.Object ->
+ Maybe (Text, ByteString) ->
+ IO Aeson.Value
+doHttpRequest method url mHeaders mBody = do
+ let timeoutMicros = 30 * 1000000
+ result <-
+ try <| do
+ req0 <- HTTP.parseRequest (Text.unpack url)
+ let req1 =
+ HTTP.setRequestMethod method
+ <| HTTP.setRequestHeader "User-Agent" ["OmniAgent/1.0"]
+ <| HTTP.setRequestResponseTimeout (HTTPClient.responseTimeoutMicro timeoutMicros)
+ <| req0
+ req2 = case mHeaders of
+ Nothing -> req1
+ Just hdrs -> foldr addHeader req1 (KeyMap.toList hdrs)
+ req3 = case mBody of
+ Nothing -> req2
+ Just (ct, bodyBytes) ->
+ HTTP.setRequestHeader "Content-Type" [TE.encodeUtf8 ct]
+ <| HTTP.setRequestBodyLBS (BL.fromStrict bodyBytes)
+ <| req2
+ mResp <- timeout timeoutMicros (HTTP.httpLBS req3)
+ case mResp of
+ Nothing -> pure (Left "Request timed out after 30 seconds")
+ Just resp -> pure (Right resp)
+ case result of
+ Left (e :: SomeException) -> pure <| mkError ("Request failed: " <> tshow e)
+ Right (Left err) -> pure <| mkError err
+ Right (Right response) -> do
+ let status = HTTP.getResponseStatusCode response
+ respHeaders = HTTP.getResponseHeaders response
+ headerObj =
+ Aeson.object
+ [ Key.fromText (TE.decodeUtf8 (CI.original k)) .= TE.decodeUtf8 v
+ | (k, v) <- respHeaders
+ ]
+ body = TE.decodeUtf8With (\_ _ -> Just '?') (BL.toStrict (HTTP.getResponseBody response))
+ pure
+ <| Aeson.toJSON
+ <| HttpResult
+ { httpResultStatus = status,
+ httpResultHeaders = headerObj,
+ httpResultBody = body
+ }
+ where
+ addHeader :: (Aeson.Key, Aeson.Value) -> HTTP.Request -> HTTP.Request
+ addHeader (k, v) req =
+ let headerName = CI.mk (TE.encodeUtf8 (Key.toText k))
+ headerValue = TE.encodeUtf8 (valueToText v)
+ in HTTP.addRequestHeader headerName headerValue req
+
+valueToText :: Aeson.Value -> Text
+valueToText (Aeson.String s) = s
+valueToText (Aeson.Number n) = tshow n
+valueToText (Aeson.Bool b) = if b then "true" else "false"
+valueToText Aeson.Null = ""
+valueToText other = TE.decodeUtf8 (BL.toStrict (Aeson.encode other))
+
+mkError :: Text -> Aeson.Value
+mkError err =
+ Aeson.object
+ [ "status" .= (-1 :: Int),
+ "headers" .= Aeson.object [],
+ "body" .= err
+ ]
generated by cgit v1.2.3 (git 2.25.1) at 2025-12-18 22:27:06 +0000