Merge Ava deployment changes

1 files changed, 108 insertions, 0 deletions

diff --git a/Omni/Agent/Telegram/Reminders.hs b/Omni/Agent/Telegram/Reminders.hs
new file mode 100644
index 0000000..88aab0a
--- /dev/null
+++ b/Omni/Agent/Telegram/Reminders.hs
@@ -0,0 +1,108 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+
+-- | Telegram Reminders - Background reminder loop and user chat persistence.
+--
+-- : out omni-agent-telegram-reminders
+-- : dep sqlite-simple
+module Omni.Agent.Telegram.Reminders
+  ( -- * User Chat Persistence
+    initUserChatsTable,
+    recordUserChat,
+    lookupChatId,
+
+    -- * Reminder Loop
+    reminderLoop,
+    checkAndSendReminders,
+
+    -- * Testing
+    main,
+    test,
+  )
+where
+
+import Alpha
+import Data.Time (getCurrentTime)
+import qualified Database.SQLite.Simple as SQL
+import qualified Omni.Agent.Memory as Memory
+import qualified Omni.Agent.Telegram.Messages as Messages
+import qualified Omni.Agent.Tools.Todos as Todos
+import qualified Omni.Test as Test
+
+main :: IO ()
+main = Test.run test
+
+test :: Test.Tree
+test =
+  Test.group
+    "Omni.Agent.Telegram.Reminders"
+    [ Test.unit "initUserChatsTable is idempotent" <| do
+        Memory.withMemoryDb <| \conn -> do
+          initUserChatsTable conn
+          initUserChatsTable conn
+          pure ()
+    ]
+
+initUserChatsTable :: SQL.Connection -> IO ()
+initUserChatsTable conn =
+  SQL.execute_
+    conn
+    "CREATE TABLE IF NOT EXISTS user_chats (\
+    \  user_id TEXT PRIMARY KEY,\
+    \  chat_id INTEGER NOT NULL,\
+    \  last_seen_at TIMESTAMP DEFAULT CURRENT_TIMESTAMP\
+    \)"
+
+recordUserChat :: Text -> Int -> IO ()
+recordUserChat uid chatId = do
+  now <- getCurrentTime
+  Memory.withMemoryDb <| \conn -> do
+    initUserChatsTable conn
+    SQL.execute
+      conn
+      "INSERT INTO user_chats (user_id, chat_id, last_seen_at) \
+      \VALUES (?, ?, ?) \
+      \ON CONFLICT(user_id) DO UPDATE SET \
+      \  chat_id = excluded.chat_id, \
+      \  last_seen_at = excluded.last_seen_at"
+      (uid, chatId, now)
+
+lookupChatId :: Text -> IO (Maybe Int)
+lookupChatId uid =
+  Memory.withMemoryDb <| \conn -> do
+    initUserChatsTable conn
+    rows <-
+      SQL.query
+        conn
+        "SELECT chat_id FROM user_chats WHERE user_id = ?"
+        (SQL.Only uid)
+    pure (listToMaybe (map SQL.fromOnly rows))
+
+reminderLoop :: IO ()
+reminderLoop =
+  forever <| do
+    threadDelay (5 * 60 * 1000000)
+    checkAndSendReminders
+
+checkAndSendReminders :: IO ()
+checkAndSendReminders = do
+  todos <- Todos.listTodosDueForReminder
+  forM_ todos <| \td -> do
+    mChatId <- lookupChatId (Todos.todoUserId td)
+    case mChatId of
+      Nothing -> pure ()
+      Just chatId -> do
+        let title = Todos.todoTitle td
+            uid = Todos.todoUserId td
+            dueStr = case Todos.todoDueDate td of
+              Just d -> " (due: " <> tshow d <> ")"
+              Nothing -> ""
+            msg =
+              "⏰ reminder: \""
+                <> title
+                <> "\""
+                <> dueStr
+                <> "\nreply when you finish and i'll mark it complete."
+        _ <- Messages.enqueueImmediate (Just uid) chatId Nothing msg (Just "reminder") Nothing
+        Todos.markReminderSent (Todos.todoId td)
+        putText <| "Queued reminder for todo " <> tshow (Todos.todoId td) <> " to chat " <> tshow chatId