diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -7,7 +7,7 @@ middleware, JSON Schema validation, plugin manifest parsing, and runtime helpers. - Implementation type: Core. -- Package version: `0.2.0`; supported `SPEC_VERSION`: `0.2.0`. +- Package version: `0.5.0`; supported `SPEC_VERSION`: `0.2.0`. - Local gate: all eleven shared vector groups, native regression tests, and source API/parity checks. - Linux and Windows CI run the full suite. Hackage publication uses @@ -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](https://hackage.haskell.org/package/praxo-core-0.3.0) +- Registry: [Hackage](https://hackage.haskell.org/package/praxo-core-0.4.0) ## Build and Test diff --git a/REGISTRY.md b/REGISTRY.md --- a/REGISTRY.md +++ b/REGISTRY.md @@ -1,7 +1,7 @@ # PRAXO-CORE Haskell Registry Introduction -**Status:** published. Source version `0.4.0`, source -tag `haskell/v0.4.0`. Published registry version: `0.3.0`. Registry +**Status:** published. Source version `0.5.0`, source +tag `haskell/v0.5.0`. Published registry version: `0.4.0`. Registry pages are release snapshots; verify the published version before relying on a feature. @@ -14,15 +14,28 @@ | Field | Value | | --- | --- | | Package | `praxo-core` | -| Registry | [Hackage](https://hackage.haskell.org/package/praxo-core-0.3.0) | -| Source version | `0.4.0` | -| Published registry version | `0.3.0` | +| Registry | [Hackage](https://hackage.haskell.org/package/praxo-core-0.4.0) | +| Source version | `0.5.0` | +| Published registry version | `0.4.0` | | Install (published) | `cabal install praxo-core` | | Install (source/release prepared) | `cabal install praxo-core` | -| Source tag | `haskell/v0.4.0` | +| Source tag | `haskell/v0.5.0` | | Tier | Core | | Contract | `SPEC_VERSION` `0.2.0` | | Documentation | https://axisvela.github.io/praxo-core/languages/haskell/ | + +## Capabilities and Status + +| Adapter | Status | Detail | +| --- | --- | --- | +| OpenAI-compatible model | native (transport seam) | Caller supplies `Transport`; no bundled HTTP client | +| Anthropic model | native (transport seam) | `Praxo.Anthropic`; caller supplies transport | +| Gemini model | native (transport seam) | `Praxo.Gemini`; caller supplies transport | +| MCP client | native (transport seam) | `Praxo.Mcp`; caller supplies `McpTransport` | +| Harmovela sink | native (transport seam) | `Praxo.Harmovela`; caller supplies transport | +| OpenTelemetry sink | native (transport seam) | `Praxo.Otel`; caller supplies `OtelTransport` | +| Subagent delegation | native (synchronous seam) | `Praxo.Delegation.subagentRun`; no asynchronous manager | +| Retriever | native | `Praxo.Retriever.Document` and `Retriever` | ## Coding-agent entry diff --git a/api-snapshot.py b/api-snapshot.py --- a/api-snapshot.py +++ b/api-snapshot.py @@ -21,7 +21,7 @@ exports = header[2].replace("(..)", "").split(",") entries.append("## " + module) for name in sorted(export.strip() for export in exports): - pattern = r"^(?:(?:data|newtype) " + re.escape(name) + r"\b.*|" + re.escape(name) + r" :: .*)$" + pattern = r"^(?:(?:data|newtype|type) " + re.escape(name) + r"\b.*|" + re.escape(name) + r" :: .*)$" declaration = re.search(pattern, text, re.MULTILINE) if not declaration: raise ValueError("missing declaration: " + module + "." + name) diff --git a/api/0.1.0.txt b/api/0.1.0.txt --- a/api/0.1.0.txt +++ b/api/0.1.0.txt @@ -1,4 +1,4 @@ -# PRAXO-CORE Haskell Wire API 0.4.0 +# PRAXO-CORE Haskell Wire API 0.5.0 # SPEC_VERSION 0.2.0 ## Praxo.Agent @@ -17,6 +17,13 @@ generateAnthropic :: AnthropicConfig -> [Message] -> IO (Either AgentError Response) parseAnthropicResponse :: String -> Either AgentError Response +## Praxo.Delegation +data SubagentRequest = SubagentRequest +data SubagentResult = SubagentResult +type SubagentRunner = SubagentRequest -> IO (Either AgentError SubagentResult) +data SubagentTask = SubagentTask +subagentRun :: SubagentRunner -> SubagentRequest -> IO (Either AgentError SubagentTask) + ## Praxo.Gemini data GeminiConfig = GeminiConfig data GeminiTool = GeminiTool @@ -83,12 +90,27 @@ generate :: OpenAIConfig -> [Message] -> IO (Either AgentError Response) parseResponse :: String -> Either AgentError Response +## Praxo.Otel +data OtelRequest = OtelRequest +data OtelResponse = OtelResponse +data OtelSink = OtelSink +newtype OtelTransport = OtelTransport +buildOtelRequest :: OtelSink -> Event -> IO (Either AgentError OtelRequest) +emitOtelEvent :: OtelSink -> Event -> IO (Either AgentError ()) +newOtelSink :: String -> OtelTransport -> IO Integer -> OtelSink + ## Praxo.Pattern matchPattern :: String -> String -> Either String Bool ## Praxo.Plugin parseManifest :: String -> Either String Json validateManifest :: Json -> Either String () + +## Praxo.Retriever +data Document = Document +type Retriever = String -> Int -> IO (Either AgentError [Document]) +newRetriever :: (String -> Int -> IO (Either AgentError [Document])) -> Retriever +retrieveDocuments :: Retriever -> String -> Int -> IO (Either AgentError [Document]) ## Praxo.Runtime data ContextBudget = ContextBudget { budgetMaxTokens :: Int, budgetKeepRecent :: Int } deriving (Eq, Show) diff --git a/llms.md b/llms.md --- a/llms.md +++ b/llms.md @@ -7,15 +7,26 @@ ## Package - package: `praxo-core` -- registry: [Hackage](https://hackage.haskell.org/package/praxo-core-0.3.0) -- source_version: `0.4.0` -- published_version: `0.3.0` +- registry: [Hackage](https://hackage.haskell.org/package/praxo-core-0.4.0) +- source_version: `0.5.0` +- published_version: `0.4.0` - install_published: `cabal install praxo-core` - install_source: `cabal install praxo-core` -- source_tag: `haskell/v0.4.0` +- source_tag: `haskell/v0.5.0` - tier: Core - contract: `SPEC_VERSION` `0.2.0` - documentation: https://axisvela.github.io/praxo-core/languages/haskell/ + +## Capabilities and Status + +- OpenAI-compatible model: native (transport seam) (Caller supplies `Transport`; no bundled HTTP client) +- Anthropic model: native (transport seam) (`Praxo.Anthropic`; caller supplies transport) +- Gemini model: native (transport seam) (`Praxo.Gemini`; caller supplies transport) +- MCP client: native (transport seam) (`Praxo.Mcp`; caller supplies `McpTransport`) +- Harmovela sink: native (transport seam) (`Praxo.Harmovela`; caller supplies transport) +- OpenTelemetry sink: native (transport seam) (`Praxo.Otel`; caller supplies `OtelTransport`) +- Subagent delegation: native (synchronous seam) (`Praxo.Delegation.subagentRun`; no asynchronous manager) +- Retriever: native (`Praxo.Retriever.Document` and `Retriever`) ## Start diff --git a/llms.txt b/llms.txt --- a/llms.txt +++ b/llms.txt @@ -7,15 +7,26 @@ # Package - package: `praxo-core` -- registry: [Hackage](https://hackage.haskell.org/package/praxo-core-0.3.0) -- source_version: `0.4.0` -- published_version: `0.3.0` +- registry: [Hackage](https://hackage.haskell.org/package/praxo-core-0.4.0) +- source_version: `0.5.0` +- published_version: `0.4.0` - install_published: `cabal install praxo-core` - install_source: `cabal install praxo-core` -- source_tag: `haskell/v0.4.0` +- source_tag: `haskell/v0.5.0` - tier: Core - contract: `SPEC_VERSION` `0.2.0` - documentation: https://axisvela.github.io/praxo-core/languages/haskell/ + +# Capabilities and Status + +- OpenAI-compatible model: native (transport seam) (Caller supplies `Transport`; no bundled HTTP client) +- Anthropic model: native (transport seam) (`Praxo.Anthropic`; caller supplies transport) +- Gemini model: native (transport seam) (`Praxo.Gemini`; caller supplies transport) +- MCP client: native (transport seam) (`Praxo.Mcp`; caller supplies `McpTransport`) +- Harmovela sink: native (transport seam) (`Praxo.Harmovela`; caller supplies transport) +- OpenTelemetry sink: native (transport seam) (`Praxo.Otel`; caller supplies `OtelTransport`) +- Subagent delegation: native (synchronous seam) (`Praxo.Delegation.subagentRun`; no asynchronous manager) +- Retriever: native (`Praxo.Retriever.Document` and `Retriever`) # Start diff --git a/praxo-core.cabal b/praxo-core.cabal --- a/praxo-core.cabal +++ b/praxo-core.cabal @@ -1,6 +1,6 @@ cabal-version: 2.4 name: praxo-core -version: 0.4.0 +version: 0.5.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, Praxo.Mcp + 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, Praxo.Otel, Praxo.Retriever, Praxo.Delegation build-depends: base >=4.14 && <5, containers >=0.6 && <0.9 default-language: Haskell2010 ghc-options: -Wall diff --git a/src/Praxo/Delegation.hs b/src/Praxo/Delegation.hs new file mode 100644 --- /dev/null +++ b/src/Praxo/Delegation.hs @@ -0,0 +1,66 @@ +module Praxo.Delegation + ( SubagentRequest(..) + , SubagentResult(..) + , SubagentTask(..) + , SubagentRunner + , subagentRun + ) where + +import Control.Exception (SomeException, try) +import Praxo.Agent (AgentError(..)) + +data SubagentRequest = SubagentRequest + { subagentParentSessionId :: String + , subagentAgentId :: String + , subagentPrompt :: String + , subagentMode :: String + } deriving (Eq, Show) + +data SubagentResult = SubagentResult + { subagentTaskId :: String + , subagentResultAgentId :: String + , subagentOutput :: String + } deriving (Eq, Show) + +data SubagentTask = SubagentTask + { subagentTaskKey :: String + , subagentParentSession :: String + , subagentAgent :: String + , subagentTaskMode :: String + , subagentStatus :: String + , subagentTaskOutput :: String + , subagentTaskError :: String + } deriving (Eq, Show) + +type SubagentRunner = SubagentRequest -> IO (Either AgentError SubagentResult) + +subagentRun :: SubagentRunner -> SubagentRequest -> IO (Either AgentError SubagentTask) +subagentRun runner request + | null (subagentParentSessionId request) || null (subagentAgentId request) = + pure (Left (AgentError "SUBAGENT_INVALID" + "agent: subagent parent session and agent id are required")) + | otherwise = do + outcome <- try (runner request) + :: IO (Either SomeException (Either AgentError SubagentResult)) + pure $ case outcome of + Left error -> Right (failedTask (show error)) + Right (Left err) -> Right (failedTask (errorCode err ++ ": " ++ errorMessage err)) + Right (Right result) -> Right (completedTask result) + where + base = SubagentTask + { subagentTaskKey = "subagent" + , subagentParentSession = subagentParentSessionId request + , subagentAgent = subagentAgentId request + , subagentTaskMode = if subagentMode request == "fork" then "fork" else "isolated" + , subagentStatus = "running" + , subagentTaskOutput = "" + , subagentTaskError = "" + } + completedTask result = base + { subagentStatus = "completed" + , subagentTaskOutput = subagentOutput result + } + failedTask detail = base + { subagentStatus = "failed" + , subagentTaskError = detail + } diff --git a/src/Praxo/Otel.hs b/src/Praxo/Otel.hs new file mode 100644 --- /dev/null +++ b/src/Praxo/Otel.hs @@ -0,0 +1,146 @@ +module Praxo.Otel + ( OtelRequest(..) + , OtelResponse(..) + , OtelTransport(..) + , OtelSink(..) + , newOtelSink + , buildOtelRequest + , emitOtelEvent + ) where + +import Data.Bits (xor) +import Data.Char (ord) +import Data.Word (Word64) +import Numeric (showHex) +import Praxo.Agent (AgentError(..)) +import Praxo.Harmovela (formatHarmovelaTimestamp) +import Praxo.Json +import Praxo.Runtime (Event(..)) + +data OtelRequest = OtelRequest + { otelMethod :: String + , otelURL :: String + , otelHeaders :: [(String, String)] + , otelBody :: String + } deriving (Eq, Show) + +data OtelResponse = OtelResponse + { otelStatus :: Int + , otelResponseBody :: String + } deriving (Eq, Show) + +newtype OtelTransport = OtelTransport + { sendOtel :: OtelRequest -> IO (Either AgentError OtelResponse) + } + +data OtelSink = OtelSink + { otelEndpoint :: String + , otelServiceName :: String + , otelAllowedDataKeys :: [String] + , otelClock :: IO Integer + , otelTransport :: OtelTransport + } + +newOtelSink :: String -> OtelTransport -> IO Integer -> OtelSink +newOtelSink endpoint transport clock = OtelSink + { otelEndpoint = endpoint + , otelServiceName = "praxo-core" + , otelAllowedDataKeys = [] + , otelClock = clock + , otelTransport = transport + } + +buildOtelRequest :: OtelSink -> Event -> IO (Either AgentError OtelRequest) +buildOtelRequest sink event = do + nanos <- otelClock sink + let dataText = either (const "") id (encodeJson (eventData event)) + key = eventSessionId event ++ "|" ++ maybe "" id (eventRunId event) + ++ "|" ++ eventKind event ++ "|" ++ show nanos ++ "|" ++ dataText + traceId = hex64 (fnv key 0xcbf29ce484222325) + ++ hex64 (fnv key 0x84222325cbf29ce4) + spanId = hex64 (fnv (key ++ "|span") 0x100000001b3) + stamp = formatHarmovelaTimestamp nanos + attributes = baseAttributes event stamp + ++ dataAttributes sink event + spanValue = JObject + [ ("traceId", JString traceId) + , ("spanId", JString spanId) + , ("name", JString ("praxo." ++ eventKind event)) + , ("kind", JNumber 1) + , ("startTimeUnixNano", JString (show nanos)) + , ("endTimeUnixNano", JString (show nanos)) + , ("attributes", JArray attributes) + ] + scopeSpan = JObject + [ ("scope", JObject [("name", JString "praxo-core")]) + , ("spans", JArray [spanValue]) + ] + resourceAttributes = + JArray [ attribute "service.name" (otelServiceName sink) ] + resourceSpan = JObject + [ ("resource", JObject [("attributes", resourceAttributes)]) + , ("scopeSpans", JArray [scopeSpan]) + ] + payload = JObject [ ("resourceSpans", JArray [resourceSpan]) ] + pure $ case encodeJson payload of + Left detail -> Left (AgentError "OTEL_JSON" detail) + Right body -> Right OtelRequest + { otelMethod = "POST" + , otelURL = otelEndpoint sink + , otelHeaders = [("content-type", "application/json")] + , otelBody = body + } + +emitOtelEvent :: OtelSink -> Event -> IO (Either AgentError ()) +emitOtelEvent sink event = do + request <- buildOtelRequest sink event + case request of + Left err -> pure (Left err) + Right httpRequest -> do + response <- sendOtel (otelTransport sink) httpRequest + pure $ case response of + Left err -> Left err + Right value + | otelStatus value >= 200 && otelStatus value < 300 -> Right () + | otherwise -> Left (AgentError "OTEL_HTTP" + ("otel: HTTP " ++ show (otelStatus value) ++ ": " + ++ bounded (otelResponseBody value))) + +baseAttributes :: Event -> String -> [Json] +baseAttributes event stamp = + [ attribute "praxo.event.type" (eventKind event) ] + ++ (if null (eventSessionId event) + then [] + else [ attribute "praxo.session.id" (eventSessionId event) ]) + ++ maybe [] (\runId -> [ attribute "praxo.run.id" runId ]) (eventRunId event) + ++ [ attribute "praxo.event.at" stamp ] + +dataAttributes :: OtelSink -> Event -> [Json] +dataAttributes sink event = + [ attribute ("praxo.event.data." ++ name) (textValue value) + | name <- otelAllowedDataKeys sink + , Just value <- [lookup name (asObject (eventData event))] + ] + +attribute :: String -> String -> Json +attribute key value = JObject + [ ("key", JString key) + , ("value", JObject [("stringValue", JString value)]) + ] + +textValue :: Json -> String +textValue (JString value) = value +textValue value = either (const "") id (encodeJson value) + +fnv :: String -> Word64 -> Word64 +fnv text seed = foldl step seed (map (fromIntegral . ord) text) + where + step value byte = (value `xor` byte) * 0x100000001b3 + +hex64 :: Word64 -> String +hex64 value = + let text = showHex value "" + in replicate (16 - length text) '0' ++ text + +bounded :: String -> String +bounded = take 512 diff --git a/src/Praxo/Retriever.hs b/src/Praxo/Retriever.hs new file mode 100644 --- /dev/null +++ b/src/Praxo/Retriever.hs @@ -0,0 +1,25 @@ +module Praxo.Retriever + ( Document(..) + , Retriever + , newRetriever + , retrieveDocuments + ) where + +import Praxo.Agent (AgentError(..)) + +data Document = Document + { documentId :: String + , documentContent :: String + , documentMetadata :: [(String, String)] + , documentScore :: Double + } deriving (Eq, Show) + +type Retriever = String -> Int -> IO (Either AgentError [Document]) + +newRetriever :: (String -> Int -> IO (Either AgentError [Document])) -> Retriever +newRetriever = id + +retrieveDocuments :: Retriever -> String -> Int -> IO (Either AgentError [Document]) +retrieveDocuments retriever query limit + | limit < 0 = pure (Left (AgentError "RETRIEVER_INVALID" "retriever: invalid limit")) + | otherwise = retriever query limit diff --git a/src/Praxo/Wire.hs b/src/Praxo/Wire.hs --- a/src/Praxo/Wire.hs +++ b/src/Praxo/Wire.hs @@ -4,4 +4,4 @@ specVersion = "0.2.0" sdkVersion :: String -sdkVersion = "0.4.0" +sdkVersion = "0.5.0" diff --git a/tests/Main.hs b/tests/Main.hs --- a/tests/Main.hs +++ b/tests/Main.hs @@ -14,6 +14,9 @@ import qualified Praxo.Gemini as G import qualified Praxo.Harmovela as H import qualified Praxo.Mcp as M +import qualified Praxo.Otel as Ot +import qualified Praxo.Retriever as R +import qualified Praxo.Delegation as D import Praxo.Pattern import Praxo.Plugin import Praxo.Runtime @@ -29,7 +32,8 @@ providerTests harmovelaTests mcpTests - assert "contract version" (specVersion == "0.2.0" && sdkVersion == "0.4.0") + seamTests + assert "contract version" (specVersion == "0.2.0" && sdkVersion == "0.5.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")) @@ -452,6 +456,76 @@ assert "mcp tool error" (case called of Left err -> A.errorCode err == "MCP_TOOL_ERROR" Right _ -> False) + +seamTests :: IO () +seamTests = do + calls <- newIORef ([] :: [Ot.OtelRequest]) + let transport = Ot.OtelTransport (\request -> do + modifyIORef' calls (++ [request]) + pure (Right (Ot.OtelResponse 200 ""))) + clock = pure 1794294000000000000 + sink = (Ot.newOtelSink "http://otel.test/v1/traces" transport clock) + { Ot.otelAllowedDataKeys = ["name"] } + event = Event "tool.call" "s1" (Just "run-123") + (JObject [("name", JString "echo"), ("secret", JString "hidden")]) + emitted <- Ot.emitOtelEvent sink event + assert "otel emit" (emitted == Right ()) + requests <- readIORef calls + case requests of + [request] -> do + assert "otel url" (Ot.otelURL request == "http://otel.test/v1/traces") + let payload = either error id (parseJson (Ot.otelBody request)) + resourceSpans = asArray (field "resourceSpans" payload) + case resourceSpans of + [resourceSpan] -> do + let scopeSpan = head (asArray (field "scopeSpans" resourceSpan)) + spanValue = head (asArray (field "spans" scopeSpan)) + assert "otel span name" (asString (field "name" spanValue) == "praxo.tool.call") + assert "otel trace id" (length (asString (field "traceId" spanValue)) == 32) + assert "otel span id" (length (asString (field "spanId" spanValue)) == 16) + let attributes = asArray (field "attributes" spanValue) + attributeValue key = + [ asString (field "stringValue" (field "value" item)) + | item <- attributes + , asString (field "key" item) == key ] + assert "otel allowed data" (attributeValue "praxo.event.data.name" == ["echo"]) + assert "otel data excluded" (null (attributeValue "praxo.event.data.secret")) + _ -> fail "otel resource span count" + _ -> fail "otel request count" + let failing = (Ot.newOtelSink "http://otel.test/v1/traces" + (Ot.OtelTransport (\_ -> pure (Right (Ot.OtelResponse 503 "down")))) + clock) + failed <- Ot.emitOtelEvent failing event + assert "otel error" (case failed of + Left err -> A.errorCode err == "OTEL_HTTP" + Right () -> False) + + let retriever query limit = pure (Right + [R.Document "doc-1" (query ++ ":" ++ show limit) [] 0.5]) + documents <- R.retrieveDocuments retriever "hello" 3 + assert "retriever" (case documents of + Right [document] -> R.documentContent document == "hello:3" + && R.documentScore document == 0.5 + _ -> False) + + let request = D.SubagentRequest "parent" "child" "do" "fork" + runner _ = pure (Right (D.SubagentResult "" "" "done")) + completed <- D.subagentRun runner request + assert "delegation completed" (case completed of + Right task -> D.subagentStatus task == "completed" + && D.subagentTaskOutput task == "done" + && D.subagentTaskMode task == "fork" + Left _ -> False) + let failingRunner _ = pure (Left (A.AgentError "TEST" "boom")) + failedTask <- D.subagentRun failingRunner request + assert "delegation failed" (case failedTask of + Right task -> D.subagentStatus task == "failed" + && "boom" `isInfixOf` D.subagentTaskError task + Left _ -> False) + invalid <- D.subagentRun runner (D.SubagentRequest "" "child" "do" "isolated") + assert "delegation invalid" (case invalid of + Left err -> A.errorCode err == "SUBAGENT_INVALID" + Right _ -> False) assert :: String -> Bool -> IO () assert label condition = unless condition (fail label)