From b96cad2c4698dd12bb138c1cabf5741fe513cd6e Mon Sep 17 00:00:00 2001 From: Ben Sima Date: Fri, 12 Dec 2025 16:44:21 -0500 Subject: Telegram bot: conversation history and summaries - Add sendTypingAction to show typing indicator when processing - Add conversation_messages and conversation_summaries tables - Implement conversation history with token counting - Auto-summarize when context exceeds threshold (3000 tokens) - Save user/assistant messages for multi-turn context - Add ConversationMessage, ConversationSummary, MessageRole types Tasks created: t-252 (web search), t-253 (calendar), t-254 (PDF), t-255 (knowledge graph), t-256 (notes) --- Omni/Agent/Memory.hs | 251 +++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 251 insertions(+) (limited to 'Omni/Agent/Memory.hs') diff --git a/Omni/Agent/Memory.hs b/Omni/Agent/Memory.hs index 863528c..461f7ac 100644 --- a/Omni/Agent/Memory.hs +++ b/Omni/Agent/Memory.hs @@ -1,4 +1,5 @@ {-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE NoImplicitPrelude #-} @@ -25,6 +26,9 @@ module Omni.Agent.Memory User (..), Memory (..), MemorySource (..), + ConversationMessage (..), + ConversationSummary (..), + MessageRole (..), -- * User Management createUser, @@ -39,6 +43,13 @@ module Omni.Agent.Memory getAllMemoriesForUser, updateMemoryAccess, + -- * Conversation History + saveMessage, + getRecentMessages, + getConversationContext, + summarizeAndArchive, + estimateTokens, + -- * Embeddings embedText, @@ -332,6 +343,93 @@ instance SQL.FromRow Memory where memoryTags = tags } +-- | Role in a conversation message. +data MessageRole = UserRole | AssistantRole + deriving (Show, Eq, Generic) + +instance Aeson.ToJSON MessageRole where + toJSON UserRole = Aeson.String "user" + toJSON AssistantRole = Aeson.String "assistant" + +instance Aeson.FromJSON MessageRole where + parseJSON = + Aeson.withText "MessageRole" <| \case + "user" -> pure UserRole + "assistant" -> pure AssistantRole + _ -> empty + +-- | A message in a conversation. +data ConversationMessage = ConversationMessage + { cmId :: Maybe Int, + cmUserId :: Text, + cmChatId :: Int, + cmRole :: MessageRole, + cmContent :: Text, + cmTokensEstimate :: Int, + cmCreatedAt :: UTCTime + } + deriving (Show, Eq, Generic) + +instance Aeson.ToJSON ConversationMessage where + toJSON m = + Aeson.object + [ "id" .= cmId m, + "user_id" .= cmUserId m, + "chat_id" .= cmChatId m, + "role" .= cmRole m, + "content" .= cmContent m, + "tokens_estimate" .= cmTokensEstimate m, + "created_at" .= cmCreatedAt m + ] + +instance SQL.FromRow ConversationMessage where + fromRow = + (ConversationMessage SQL.field + <*> SQL.field + <*> (parseRole SQL.field + <*> (fromMaybe 0 SQL.field + where + parseRole :: Text -> MessageRole + parseRole "user" = UserRole + parseRole _ = AssistantRole + +-- | A summary of older conversation messages. +data ConversationSummary = ConversationSummary + { csId :: Maybe Int, + csUserId :: Text, + csChatId :: Int, + csSummary :: Text, + csMessagesSummarized :: Int, + csTokensSaved :: Maybe Int, + csCreatedAt :: UTCTime + } + deriving (Show, Eq, Generic) + +instance Aeson.ToJSON ConversationSummary where + toJSON s = + Aeson.object + [ "id" .= csId s, + "user_id" .= csUserId s, + "chat_id" .= csChatId s, + "summary" .= csSummary s, + "messages_summarized" .= csMessagesSummarized s, + "tokens_saved" .= csTokensSaved s, + "created_at" .= csCreatedAt s + ] + +instance SQL.FromRow ConversationSummary where + fromRow = + (ConversationSummary SQL.field + <*> SQL.field + <*> SQL.field + <*> SQL.field + <*> SQL.field + <*> SQL.field + -- | Get the path to memory.db getMemoryDbPath :: IO FilePath getMemoryDbPath = do @@ -387,6 +485,34 @@ initMemoryDb conn = do SQL.execute_ conn "CREATE INDEX IF NOT EXISTS idx_memories_agent ON memories(source_agent)" + SQL.execute_ + conn + "CREATE TABLE IF NOT EXISTS conversation_messages (\ + \ id INTEGER PRIMARY KEY AUTOINCREMENT,\ + \ user_id TEXT NOT NULL REFERENCES users(id),\ + \ chat_id INTEGER NOT NULL,\ + \ role TEXT NOT NULL,\ + \ content TEXT NOT NULL,\ + \ tokens_estimate INTEGER,\ + \ created_at TIMESTAMP DEFAULT CURRENT_TIMESTAMP\ + \)" + SQL.execute_ + conn + "CREATE INDEX IF NOT EXISTS idx_conv_user_chat ON conversation_messages(user_id, chat_id)" + SQL.execute_ + conn + "CREATE TABLE IF NOT EXISTS conversation_summaries (\ + \ id INTEGER PRIMARY KEY AUTOINCREMENT,\ + \ user_id TEXT NOT NULL REFERENCES users(id),\ + \ chat_id INTEGER NOT NULL,\ + \ summary TEXT NOT NULL,\ + \ messages_summarized INTEGER NOT NULL,\ + \ tokens_saved INTEGER,\ + \ created_at TIMESTAMP DEFAULT CURRENT_TIMESTAMP\ + \)" + SQL.execute_ + conn + "CREATE INDEX IF NOT EXISTS idx_summary_user_chat ON conversation_summaries(user_id, chat_id)" -- | Create a new user. createUser :: Text -> Maybe Int -> IO User @@ -749,3 +875,128 @@ instance Aeson.FromJSON RecallArgs where Aeson.withObject "RecallArgs" <| \v -> (RecallArgs (v .:? "limit" .!= 5) + +-- | Estimate token count for text (rough: ~4 chars per token). +estimateTokens :: Text -> Int +estimateTokens t = max 1 (Text.length t `div` 4) + +-- | Save a message to conversation history. +saveMessage :: Text -> Int -> MessageRole -> Text -> IO ConversationMessage +saveMessage uid chatId role content = do + now <- getCurrentTime + let tokens = estimateTokens content + withMemoryDb <| \conn -> do + SQL.execute + conn + "INSERT INTO conversation_messages (user_id, chat_id, role, content, tokens_estimate, created_at) VALUES (?, ?, ?, ?, ?, ?)" + (uid, chatId, roleToText role, content, tokens, now) + rowId <- SQL.lastInsertRowId conn + pure + ConversationMessage + { cmId = Just (fromIntegral rowId), + cmUserId = uid, + cmChatId = chatId, + cmRole = role, + cmContent = content, + cmTokensEstimate = tokens, + cmCreatedAt = now + } + where + roleToText UserRole = "user" :: Text + roleToText AssistantRole = "assistant" + +-- | Get recent messages for a user/chat, newest first. +getRecentMessages :: Text -> Int -> Int -> IO [ConversationMessage] +getRecentMessages uid chatId limit = + withMemoryDb <| \conn -> + SQL.query + conn + "SELECT id, user_id, chat_id, role, content, tokens_estimate, created_at \ + \FROM conversation_messages \ + \WHERE user_id = ? AND chat_id = ? \ + \ORDER BY created_at DESC LIMIT ?" + (uid, chatId, limit) + +-- | Get the most recent summary for a chat. +getLatestSummary :: Text -> Int -> IO (Maybe ConversationSummary) +getLatestSummary uid chatId = + withMemoryDb <| \conn -> do + rows <- + SQL.query + conn + "SELECT id, user_id, chat_id, summary, messages_summarized, tokens_saved, created_at \ + \FROM conversation_summaries \ + \WHERE user_id = ? AND chat_id = ? \ + \ORDER BY created_at DESC LIMIT 1" + (uid, chatId) + pure (listToMaybe rows) + +-- | Build conversation context for the LLM. +-- Returns (context text, total token estimate). +getConversationContext :: Text -> Int -> Int -> IO (Text, Int) +getConversationContext uid chatId maxTokens = do + maybeSummary <- getLatestSummary uid chatId + recentMsgs <- getRecentMessages uid chatId 50 + + let summaryText = maybe "" (\s -> "## Previous conversation summary\n" <> csSummary s <> "\n\n") maybeSummary + summaryTokens = maybe 0 (estimateTokens <. csSummary) maybeSummary + + msgsOldestFirst = reverse recentMsgs + availableTokens = maxTokens - summaryTokens - 100 + + (selectedMsgs, usedTokens) = selectMessages msgsOldestFirst availableTokens + + formattedMsgs = + if null selectedMsgs + then "" + else + "## Recent conversation\n" + <> Text.unlines (map formatMsg selectedMsgs) + + pure (summaryText <> formattedMsgs, summaryTokens + usedTokens) + where + selectMessages :: [ConversationMessage] -> Int -> ([ConversationMessage], Int) + selectMessages msgs budget = go (reverse msgs) budget [] + where + go [] _ acc = (acc, sum (map cmTokensEstimate acc)) + go (m : ms) remaining acc + | cmTokensEstimate m <= remaining = + go ms (remaining - cmTokensEstimate m) (m : acc) + | otherwise = (acc, sum (map cmTokensEstimate acc)) + + formatMsg m = + let prefix = case cmRole m of + UserRole -> "User: " + AssistantRole -> "Assistant: " + in prefix <> cmContent m + +-- | Summarize old messages and archive them. +-- Returns the new summary text. +summarizeAndArchive :: Text -> Int -> Text -> IO Text +summarizeAndArchive uid chatId summaryText = do + now <- getCurrentTime + + (oldMsgCount, tokensSaved) <- + withMemoryDb <| \conn -> do + rows <- + SQL.query + conn + "SELECT COUNT(*), COALESCE(SUM(tokens_estimate), 0) FROM conversation_messages WHERE user_id = ? AND chat_id = ?" + (uid, chatId) :: + IO [(Int, Int)] + let (count, tokens) = fromMaybe (0, 0) (listToMaybe rows) + + SQL.execute + conn + "INSERT INTO conversation_summaries (user_id, chat_id, summary, messages_summarized, tokens_saved, created_at) VALUES (?, ?, ?, ?, ?, ?)" + (uid, chatId, summaryText, count, tokens, now) + + SQL.execute + conn + "DELETE FROM conversation_messages WHERE user_id = ? AND chat_id = ?" + (uid, chatId) + + pure (count, tokens) + + putText <| "Archived " <> tshow oldMsgCount <> " messages (" <> tshow tokensSaved <> " tokens) for chat " <> tshow chatId + pure summaryText -- cgit v1.2.3