praxo-core 0.3.0 → 0.4.0

raw patch · 9 files changed

+197/−20 lines, 9 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• README.md +1/−1
• REGISTRY.md +6/−6
• api/0.1.0.txt +9/−1
• llms.md +4/−4
• llms.txt +4/−4
• praxo-core.cabal +2/−2
• src/Praxo/Mcp.hs +104/−0
• src/Praxo/Wire.hs +1/−1
• tests/Main.hs +66/−1

@@ -19,7 +19,7 @@ - Registry introduction: [REGISTRY.md](https://github.com/axisvela/praxo-core/blob/main/language/haskell/REGISTRY.md) - Machine-readable entry: [llms.txt](https://github.com/axisvela/praxo-core/blob/main/language/haskell/llms.txt) and [llms.md](https://github.com/axisvela/praxo-core/blob/main/language/haskell/llms.md) - Coding-agent contract: [docs/getting-started/coding-agents.md](https://github.com/axisvela/praxo-core/blob/main/docs/getting-started/coding-agents.md)-- Registry: [Hackage (pending)](https://github.com/axisvela/praxo-core/releases/tag/haskell%2Fv0.2.0)+- Registry: [Hackage](https://hackage.haskell.org/package/praxo-core-0.3.0)  ## Build and Test 

@@ -1,7 +1,7 @@ # PRAXO-CORE Haskell Registry Introduction -**Status:** source release; Hackage upload pending. Source version `0.3.0`, source-tag `haskell/v0.3.0`. Published registry version: `0.2.0`. Registry+**Status:** published. Source version `0.4.0`, source+tag `haskell/v0.4.0`. Published registry version: `0.3.0`. Registry pages are release snapshots; verify the published version before relying on a feature. @@ -14,12 +14,12 @@ | Field | Value | | --- | --- | | Package | `praxo-core` |-| Registry | [Hackage (pending)](https://github.com/axisvela/praxo-core/releases/tag/haskell%2Fv0.2.0) |-| Source version | `0.3.0` |-| Published registry version | `0.2.0` |+| Registry | [Hackage](https://hackage.haskell.org/package/praxo-core-0.3.0) |+| Source version | `0.4.0` |+| Published registry version | `0.3.0` | | Install (published) | `cabal install praxo-core` | | Install (source/release prepared) | `cabal install praxo-core` |-| Source tag | `haskell/v0.3.0` |+| Source tag | `haskell/v0.4.0` | | Tier | Core | | Contract | `SPEC_VERSION` `0.2.0` | | Documentation | https://axisvela.github.io/praxo-core/languages/haskell/ |

@@ -1,4 +1,4 @@-# PRAXO-CORE Haskell Wire API 0.3.0+# PRAXO-CORE Haskell Wire API 0.4.0 # SPEC_VERSION 0.2.0  ## Praxo.Agent@@ -47,6 +47,14 @@ ## Praxo.JsonSchema data ValidationError = ValidationError { errorPath :: String, errorMessage :: String } deriving (Eq, Show) validateSchema :: Json -> Json -> Either String [ValidationError]++## Praxo.Mcp+data McpClient = McpClient+newtype McpTransport = McpTransport (String -> Json -> IO (Either AgentError Json))+mcpCallTool :: McpClient -> String -> Json -> IO (Either AgentError Json)+mcpClient :: McpTransport -> String -> String -> IO (Either AgentError McpClient)+mcpClose :: McpClient -> IO ()+mcpListTools :: McpClient -> IO (Either AgentError [Json])  ## Praxo.Middleware data CallLimit = CallLimit

@@ -7,12 +7,12 @@ ## Package  - package: `praxo-core`-- registry: [Hackage (pending)](https://github.com/axisvela/praxo-core/releases/tag/haskell%2Fv0.2.0)-- source_version: `0.3.0`-- published_version: `0.2.0`+- registry: [Hackage](https://hackage.haskell.org/package/praxo-core-0.3.0)+- source_version: `0.4.0`+- published_version: `0.3.0` - install_published: `cabal install praxo-core` - install_source: `cabal install praxo-core`-- source_tag: `haskell/v0.3.0`+- source_tag: `haskell/v0.4.0` - tier: Core - contract: `SPEC_VERSION` `0.2.0` - documentation: https://axisvela.github.io/praxo-core/languages/haskell/

@@ -7,12 +7,12 @@ # Package  - package: `praxo-core`-- registry: [Hackage (pending)](https://github.com/axisvela/praxo-core/releases/tag/haskell%2Fv0.2.0)-- source_version: `0.3.0`-- published_version: `0.2.0`+- registry: [Hackage](https://hackage.haskell.org/package/praxo-core-0.3.0)+- source_version: `0.4.0`+- published_version: `0.3.0` - install_published: `cabal install praxo-core` - install_source: `cabal install praxo-core`-- source_tag: `haskell/v0.3.0`+- source_tag: `haskell/v0.4.0` - tier: Core - contract: `SPEC_VERSION` `0.2.0` - documentation: https://axisvela.github.io/praxo-core/languages/haskell/

@@ -1,6 +1,6 @@ cabal-version: 2.4 name: praxo-core-version: 0.3.0+version: 0.4.0 synopsis: Embeddable MIT-licensed agent framework for Haskell description: Native agent loop with tools, policy hooks, typed events, memory,              checkpoints, context budgets, middleware, JSON Schema validation,@@ -22,7 +22,7 @@  library   hs-source-dirs: src-  exposed-modules: Praxo.Agent, Praxo.Json, Praxo.ToolCall, Praxo.JsonSchema, Praxo.Pattern, Praxo.Plugin, Praxo.Runtime, Praxo.Middleware, Praxo.Wire, Praxo.OpenAICompatible, Praxo.Anthropic, Praxo.Gemini, Praxo.Harmovela+  exposed-modules: Praxo.Agent, Praxo.Json, Praxo.ToolCall, Praxo.JsonSchema, Praxo.Pattern, Praxo.Plugin, Praxo.Runtime, Praxo.Middleware, Praxo.Wire, Praxo.OpenAICompatible, Praxo.Anthropic, Praxo.Gemini, Praxo.Harmovela, Praxo.Mcp   build-depends: base >=4.14 && <5, containers >=0.6 && <0.9   default-language: Haskell2010   ghc-options: -Wall

@@ -0,0 +1,104 @@+module Praxo.Mcp (McpTransport(..), McpClient(..), mcpClient, mcpListTools, mcpCallTool, mcpClose) where++import Data.IORef+import Praxo.Agent (AgentError(..))+import Praxo.Json++newtype McpTransport = McpTransport (String -> Json -> IO (Either AgentError Json))++data McpClient = McpClient+    { mcpTransport :: McpTransport+    , mcpClientVersion :: String+    , mcpProtocolVersion :: String+    , mcpServerInfo :: Json+    , mcpClosed :: IORef Bool+    }++mcpClient :: McpTransport -> String -> String -> IO (Either AgentError McpClient)+mcpClient transport clientVersion protocolVersion = do+    let version = if null clientVersion then "0.4.0" else clientVersion+        protocol = if null protocolVersion then "2024-11-05" else protocolVersion+        params = JObject+            [ ("protocolVersion", JString protocol)+            , ("capabilities", JObject [])+            , ("clientInfo", JObject+                [ ("name", JString "praxo-core")+                , ("version", JString version)+                ])+            ]+    result <- invoke transport "initialize" params+    case result of+        Left err -> pure (Left err)+        Right value -> case value of+            JObject _ ->+                let negotiated = asString (field "protocolVersion" value)+                in if null negotiated+                    then pure (Left (AgentError "MCP_HANDSHAKE" "mcp: initialize returned no protocol version"))+                    else do+                        closed <- newIORef False+                        let info = case field "serverInfo" value of+                                JObject _ -> field "serverInfo" value+                                _ -> JObject []+                        pure (Right (McpClient transport version negotiated info closed))+            _ -> pure (Left (AgentError "MCP_PROTOCOL" "mcp: initialize result must be an object"))++mcpListTools :: McpClient -> IO (Either AgentError [Json])+mcpListTools client = loop "" [] [] []+  where+    loop cursor tools names cursors = do+        let params = if null cursor then JObject [] else JObject [("cursor", JString cursor)]+        result <- invoke (mcpTransport client) "tools/list" params+        case result of+            Left err -> pure (Left err)+            Right value -> case field "tools" value of+                JArray items -> case collect items tools names of+                    Left err -> pure (Left err)+                    Right (updatedTools, updatedNames) ->+                        case field "nextCursor" value of+                            JNull -> pure (Right updatedTools)+                            JString next+                                | null next -> pure (Right updatedTools)+                                | next `elem` cursors -> pure (Left (AgentError "MCP_PAGINATION" "mcp: repeated tool pagination cursor"))+                                | otherwise -> loop next updatedTools updatedNames (next : cursors)+                            _ -> pure (Left (AgentError "MCP_PROTOCOL" "mcp: nextCursor must be a string"))+                _ -> pure (Left (AgentError "MCP_PROTOCOL" "mcp: tools/list tools must be an array"))+    collect [] tools names = Right (tools, names)+    collect (item:rest) tools names = case item of+        JObject _ ->+            let name = asString (field "name" item)+            in if null name+                then Left (AgentError "MCP_PROTOCOL" "mcp: tool name is required")+                else if name `elem` names+                    then Left (AgentError "MCP_DUPLICATE_TOOL" ("mcp: duplicate tool " ++ name))+                    else collect rest (tools ++ [item]) (name : names)+        _ -> Left (AgentError "MCP_PROTOCOL" "mcp: tool definition must be an object")++mcpCallTool :: McpClient -> String -> Json -> IO (Either AgentError Json)+mcpCallTool client name arguments+    | null name = pure (Left (AgentError "MCP_PROTOCOL" "mcp: tool name is required"))+    | otherwise = do+        result <- invoke (mcpTransport client) "tools/call"+            (JObject [("name", JString name), ("arguments", arguments)])+        case result of+            Left err -> pure (Left err)+            Right value -> case value of+                JObject _ ->+                    if field "isError" value == JBool True+                        then pure (Left (AgentError "MCP_TOOL_ERROR" ("mcp: tool " ++ name ++ " failed")))+                        else case lookup "structuredContent" (asObject value) of+                            Just structured -> pure (Right structured)+                            Nothing -> pure (Right (textContent (field "content" value)))+                _ -> pure (Left (AgentError "MCP_PROTOCOL" "mcp: tools/call result must be an object"))+  where+    textContent (JArray items) =+        case [asString (field "text" item) | item <- items, asString (field "type" item) == "text"] of+            [] -> JNull+            [text] -> JString text+            texts -> JArray (map JString texts)+    textContent _ = JNull++mcpClose :: McpClient -> IO ()+mcpClose client = writeIORef (mcpClosed client) True++invoke :: McpTransport -> String -> Json -> IO (Either AgentError Json)+invoke (McpTransport send) = send

@@ -4,4 +4,4 @@ specVersion = "0.2.0"  sdkVersion :: String-sdkVersion = "0.3.0"+sdkVersion = "0.4.0"

@@ -13,6 +13,7 @@ import qualified Praxo.Anthropic as An import qualified Praxo.Gemini as G import qualified Praxo.Harmovela as H+import qualified Praxo.Mcp as M import Praxo.Pattern import Praxo.Plugin import Praxo.Runtime@@ -27,7 +28,8 @@     adapterTests     providerTests     harmovelaTests-    assert "contract version" (specVersion == "0.2.0" && sdkVersion == "0.3.0")+    mcpTests+    assert "contract version" (specVersion == "0.2.0" && sdkVersion == "0.4.0")     forM_ ["", "01", "1.", "+1", "NaN", "1e", "[1,]", "{\"a\":1,}", "{}{}", "\"\\q\"", "\"\\ud800\"", "\"\\udc00\"", "\"\\ud800\\u0041\"", "\"line\nbreak\"", "true garbage"] $ \raw ->         assert ("invalid JSON " ++ show raw) (isLeft (parseJson raw))     assert "unicode escape" (parseJson "\"\\u00e9\\ud83d\\ude00\"" == Right (JString "\x00e9\x1f600"))@@ -387,6 +389,69 @@     let missing = H.newHarmovelaSink "" (H.HarmovelaTransport (\_ -> fail "harmovela transport called for missing base URL")) (pure 1)     missingResult <- H.emitHarmovelaEvent missing event     assert "harmovela missing base url" (case missingResult of Left err -> A.errorCode err == "HARMOVELA_URL"; _ -> False)++mcpTests :: IO ()+mcpTests = do+    let transport = M.McpTransport (\method params -> case method of+            "initialize" -> pure (Right (json "{\"protocolVersion\":\"2024-11-05\",\"serverInfo\":{\"name\":\"fake\"}}"))+            "tools/list" -> case field "cursor" params of+                JString "c1" -> pure (Right (json "{\"tools\":[{\"name\":\"two\"}]}"))+                _ -> pure (Right (json "{\"tools\":[{\"name\":\"echo\",\"inputSchema\":{\"type\":\"object\"}}],\"nextCursor\":\"c1\"}"))+            "tools/call" -> pure (Right (json "{\"content\":[{\"type\":\"text\",\"text\":\"ok\"}]}"))+            _ -> pure (Right (JObject [])))+    clientResult <- M.mcpClient transport "" ""+    case clientResult of+        Left err -> fail (A.errorMessage err)+        Right client -> do+            assert "mcp default client version" (M.mcpClientVersion client == "0.4.0")+            assert "mcp negotiated protocol" (M.mcpProtocolVersion client == "2024-11-05")+            tools <- M.mcpListTools client+            case tools of+                Left err -> fail (A.errorMessage err)+                Right items -> do+                    assert "mcp pagination count" (length items == 2)+                    assert "mcp tool order" (map (asString . field "name") items == ["echo", "two"])+            value <- M.mcpCallTool client "echo" (JObject [])+            assert "mcp text call" (value == Right (JString "ok"))+            M.mcpClose client+            closed <- readIORef (M.mcpClosed client)+            assert "mcp closed" closed+    let duplicateTransport = M.McpTransport (\method _ -> case method of+            "initialize" -> pure (Right (json "{\"protocolVersion\":\"2024-11-05\"}"))+            "tools/list" -> pure (Right (json "{\"tools\":[{\"name\":\"echo\"},{\"name\":\"echo\"}]}"))+            _ -> pure (Right (JObject [])))+    duplicateResult <- M.mcpClient duplicateTransport "" ""+    case duplicateResult of+        Left err -> fail (A.errorMessage err)+        Right duplicateClient -> do+            duplicateTools <- M.mcpListTools duplicateClient+            assert "mcp duplicate tool error" (case duplicateTools of+                Left err -> A.errorCode err == "MCP_DUPLICATE_TOOL"+                Right _ -> False)+    let cursorTransport = M.McpTransport (\method _ -> case method of+            "initialize" -> pure (Right (json "{\"protocolVersion\":\"2024-11-05\"}"))+            "tools/list" -> pure (Right (json "{\"tools\":[],\"nextCursor\":\"c1\"}"))+            _ -> pure (Right (JObject [])))+    cursorResult <- M.mcpClient cursorTransport "" ""+    case cursorResult of+        Left err -> fail (A.errorMessage err)+        Right cursorClient -> do+            paginated <- M.mcpListTools cursorClient+            assert "mcp repeated cursor error" (case paginated of+                Left err -> A.errorCode err == "MCP_PAGINATION"+                Right _ -> False)+    let failingTransport = M.McpTransport (\method _ -> case method of+            "initialize" -> pure (Right (json "{\"protocolVersion\":\"2024-11-05\"}"))+            "tools/call" -> pure (Right (json "{\"isError\":true}"))+            _ -> pure (Right (JObject [])))+    failingResult <- M.mcpClient failingTransport "" ""+    case failingResult of+        Left err -> fail (A.errorMessage err)+        Right failingClient -> do+            called <- M.mcpCallTool failingClient "echo" (JObject [])+            assert "mcp tool error" (case called of+                Left err -> A.errorCode err == "MCP_TOOL_ERROR"+                Right _ -> False)  assert :: String -> Bool -> IO () assert label condition = unless condition (fail label)