commit 68449c74936897a9213c089b04f1138f9a4408e6
Author: Ben Sima <ben@bensima.com>
Date: Tue Dec 30 17:59:27 2025
Omni/Agent/Telegram: Add type-safe Action system for callbacks
Refactor Telegram callbacks to use a type-enforced Action system that
guarantees all button actions log to conversation history.
- Add Actions.hs with Action, ActionInput, ActionResult types
- Migrate subagent_approve/reject to new system
- All actions now automatically saved to Memory
Task-Id: t-280.2.8
diff --git a/Omni/Agent/Telegram.hs b/Omni/Agent/Telegram.hs
index a4d084fc..f83fa48a 100644
--- a/Omni/Agent/Telegram.hs
+++ b/Omni/Agent/Telegram.hs
@@ -93,6 +93,7 @@ import qualified Omni.Agent.Provider as Provider
import qualified Omni.Agent.Skills as Skills
import qualified Omni.Agent.Subagent as Subagent
import qualified Omni.Agent.Subagent.Jobs as Jobs
+import qualified Omni.Agent.Telegram.Actions as Actions
import qualified Omni.Agent.Telegram.IncomingQueue as IncomingQueue
import qualified Omni.Agent.Telegram.Media as Media
import qualified Omni.Agent.Telegram.Messages as Messages
@@ -686,31 +687,21 @@ handleCallbackQueryInner tgConfig cq chatId userId callbackData = do
then do
answerCallbackQuery tgConfig (Types.cqId cq) (Just "Not authorized")
putText <| "Unauthorized callback from user " <> tshow userId
- else case Text.splitOn ":" callbackData of
- ["subagent_approve", pendingId] -> do
- putText <| "Approving subagent spawn: " <> pendingId
- answerCallbackQuery tgConfig (Types.cqId cq) (Just "Spawning subagent...")
- -- Results are now delivered via scheduled_messages from the worker
- spawnResult <- Subagent.approveAndSpawnSubagentWithCallback pendingId Nothing
- putText <| "Spawn result: " <> tshow spawnResult
- case spawnResult of
- Left err -> do
- putText <| "Spawn failed: " <> err
- sendMessage tgConfig chatId ("Failed to spawn subagent: " <> err)
- Right subagentId -> do
- putText <| "Spawn succeeded, subagent ID: " <> subagentId
- sendMessage tgConfig chatId ("Subagent " <> subagentId <> " queued! You'll be notified when it completes.")
- ["subagent_reject", pendingId] -> do
- putText <| "Rejecting subagent spawn: " <> pendingId
- rejected <- Subagent.rejectPendingSpawn pendingId
- if rejected
- then do
- answerCallbackQuery tgConfig (Types.cqId cq) (Just "Spawn cancelled")
- sendMessage tgConfig chatId "Subagent spawn cancelled."
- else answerCallbackQuery tgConfig (Types.cqId cq) (Just "Already expired")
- _ -> do
- answerCallbackQuery tgConfig (Types.cqId cq) (Just "Unknown action")
- putText <| "Unknown callback data: " <> callbackData
+ else do
+ let (actionId, payload) = Actions.parseCallbackData callbackData
+ input = Actions.ActionInput userId chatId payload
+ result <- Actions.executeAction actionId input
+ case result of
+ Nothing -> do
+ answerCallbackQuery tgConfig (Types.cqId cq) (Just "Unknown action")
+ putText <| "Unknown callback: " <> callbackData
+ Just ar -> do
+ -- Log to conversation history
+ _ <- Memory.saveMessage (tshow userId) chatId Memory.UserRole Nothing (Actions.arUserMessage ar)
+ _ <- Memory.saveMessage (tshow userId) chatId Memory.AssistantRole Nothing (Actions.arAssistantMessage ar)
+ -- Send response
+ sendMessage tgConfig chatId (Actions.arAssistantMessage ar)
+ answerCallbackQuery tgConfig (Types.cqId cq) (Just "Done")
handleMessageBatch ::
Types.TelegramConfig ->
diff --git a/Omni/Agent/Telegram/Actions.hs b/Omni/Agent/Telegram/Actions.hs
new file mode 100644
index 00000000..8ed482da
--- /dev/null
+++ b/Omni/Agent/Telegram/Actions.hs
@@ -0,0 +1,180 @@
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+
+-- | Type-safe action system for Telegram inline keyboard callbacks.
+--
+-- All callback actions must be registered here. This provides:
+-- - Type-safe action definitions (no stringly-typed callback data)
+-- - Automatic conversation logging for all actions
+-- - Consistent error handling
+--
+-- : out omni-agent-telegram-actions
+-- : dep aeson
+-- : dep containers
+module Omni.Agent.Telegram.Actions
+ ( -- * Core Types
+ Action (..),
+ ActionInput (..),
+ ActionResult (..),
+ ActionOutcome (..),
+
+ -- * Registry
+ actionRegistry,
+ lookupAction,
+
+ -- * Execution
+ executeAction,
+
+ -- * Parsing
+ parseCallbackData,
+
+ -- * Testing
+ main,
+ test,
+ )
+where
+
+import Alpha
+import qualified Data.Map.Strict as Map
+import qualified Data.Text as Text
+import qualified Omni.Agent.Subagent as Subagent
+import qualified Omni.Test as Test
+
+main :: IO ()
+main = Test.run test
+
+test :: Test.Tree
+test =
+ Test.group
+ "Omni.Agent.Telegram.Actions"
+ [ Test.unit "parseCallbackData splits on colon" <| do
+ parseCallbackData "subagent_approve:abc123" Test.@=? ("subagent_approve", "abc123"),
+ Test.unit "parseCallbackData handles no payload" <| do
+ parseCallbackData "simple_action" Test.@=? ("simple_action", ""),
+ Test.unit "parseCallbackData handles multiple colons" <| do
+ parseCallbackData "action:payload:with:colons" Test.@=? ("action", "payload:with:colons"),
+ Test.unit "lookupAction finds registered action" <| do
+ let found = lookupAction "subagent_approve"
+ isJust found Test.@=? True,
+ Test.unit "lookupAction returns Nothing for unknown" <| do
+ let found = lookupAction "nonexistent_action"
+ isJust found Test.@=? False,
+ Test.unit "actionRegistry has expected actions" <| do
+ let keys = Map.keys actionRegistry
+ ("subagent_approve" `elem` keys) Test.@=? True
+ ("subagent_reject" `elem` keys) Test.@=? True
+ ]
+
+-- | Input provided to an action execution
+data ActionInput = ActionInput
+ { aiUserId :: Int,
+ aiChatId :: Int,
+ aiPayload :: Text
+ }
+ deriving (Show, Eq, Generic)
+
+-- | Outcome of an action
+data ActionOutcome
+ = -- | Action completed successfully
+ ActionSuccess
+ | -- | Action failed with error
+ ActionFailed Text
+ | -- | Action started but pending completion (e.g., async job)
+ ActionPending Text
+ deriving (Show, Eq, Generic)
+
+-- | Result of executing an action
+data ActionResult = ActionResult
+ { -- | Message to log as user action (e.g., "[Approved subagent: abc123]")
+ arUserMessage :: Text,
+ -- | Message to send back to chat and log as assistant
+ arAssistantMessage :: Text,
+ -- | Outcome of the action
+ arOutcome :: ActionOutcome
+ }
+ deriving (Show, Eq, Generic)
+
+-- | An action that can be triggered by inline keyboard callback
+data Action = Action
+ { actionId :: Text,
+ actionExecute :: ActionInput -> IO ActionResult
+ }
+
+-- | Parse callback data into (actionId, payload)
+-- Format: "actionId:payload" or just "actionId" if no payload
+parseCallbackData :: Text -> (Text, Text)
+parseCallbackData callbackData =
+ case Text.breakOn ":" callbackData of
+ (actionId, rest)
+ | Text.null rest -> (actionId, "")
+ | otherwise -> (actionId, Text.drop 1 rest)
+
+-- | Registry of all available actions
+actionRegistry :: Map.Map Text Action
+actionRegistry =
+ Map.fromList
+ [ ("subagent_approve", approveSubagentAction),
+ ("subagent_reject", rejectSubagentAction)
+ ]
+
+-- | Look up an action by its ID
+lookupAction :: Text -> Maybe Action
+lookupAction actionId = Map.lookup actionId actionRegistry
+
+-- | Execute an action by ID with given input
+executeAction :: Text -> ActionInput -> IO (Maybe ActionResult)
+executeAction actionId input =
+ case lookupAction actionId of
+ Nothing -> pure Nothing
+ Just action -> Just </ actionExecute action input
+
+-- | Action to approve a pending subagent spawn
+approveSubagentAction :: Action
+approveSubagentAction =
+ Action
+ { actionId = "subagent_approve",
+ actionExecute = \input -> do
+ let pendingId = aiPayload input
+ result <- Subagent.approveAndSpawnSubagentWithCallback pendingId Nothing
+ case result of
+ Left err ->
+ pure
+ ActionResult
+ { arUserMessage = "[Approved subagent: " <> pendingId <> "]",
+ arAssistantMessage = "failed to spawn subagent: " <> err,
+ arOutcome = ActionFailed err
+ }
+ Right subagentId ->
+ pure
+ ActionResult
+ { arUserMessage = "[Approved subagent: " <> pendingId <> "]",
+ arAssistantMessage = "subagent " <> subagentId <> " queued! i'll notify you when it completes.",
+ arOutcome = ActionPending subagentId
+ }
+ }
+
+-- | Action to reject a pending subagent spawn
+rejectSubagentAction :: Action
+rejectSubagentAction =
+ Action
+ { actionId = "subagent_reject",
+ actionExecute = \input -> do
+ let pendingId = aiPayload input
+ rejected <- Subagent.rejectPendingSpawn pendingId
+ if rejected
+ then
+ pure
+ ActionResult
+ { arUserMessage = "[Rejected subagent: " <> pendingId <> "]",
+ arAssistantMessage = "subagent spawn cancelled.",
+ arOutcome = ActionSuccess
+ }
+ else
+ pure
+ ActionResult
+ { arUserMessage = "[Rejected subagent: " <> pendingId <> " (expired)]",
+ arAssistantMessage = "spawn request had already expired.",
+ arOutcome = ActionFailed "already expired"
+ }
+ }