diff options
| author | Ben Sima <ben@bensima.com> | 2025-12-14 23:12:47 -0500 |
|---|---|---|
| committer | Ben Sima <ben@bensima.com> | 2025-12-14 23:12:47 -0500 |
| commit | f6bbf86e7e8e76c41b8163ce0b1996ee474fc560 (patch) | |
| tree | 7fb07adcfa75c00ee5e19a6d2bff33606536f5d4 /Omni/Agent | |
| parent | 6b4e8c4963ba286a6aaf3e6f1917290fee7677f3 (diff) | |
Add outreach approval queue for Ava (t-265.3)
- Create Omni/Agent/Tools/Outreach.hs with tools
- Drafts stored in _/var/ava/outreach/{pending,approved,...}
- Add Telegram commands: /review, /approve, /reject, /queue
- Integrate outreach tools into agent's tool list
Amp-Thread-ID: https://ampcode.com/threads/T-019b202c-2156-74db-aa4a-e0a2f4397fbb
Co-authored-by: Amp <amp@ampcode.com>
Diffstat (limited to 'Omni/Agent')
| -rw-r--r-- | Omni/Agent/Telegram.hs | 77 | ||||
| -rw-r--r-- | Omni/Agent/Tools/Outreach.hs | 511 |
2 files changed, 587 insertions, 1 deletions
diff --git a/Omni/Agent/Telegram.hs b/Omni/Agent/Telegram.hs index 34cf0d1..a61c2d0 100644 --- a/Omni/Agent/Telegram.hs +++ b/Omni/Agent/Telegram.hs @@ -92,6 +92,7 @@ import qualified Omni.Agent.Tools.Email as Email import qualified Omni.Agent.Tools.Hledger as Hledger import qualified Omni.Agent.Tools.Http as Http import qualified Omni.Agent.Tools.Notes as Notes +import qualified Omni.Agent.Tools.Outreach as Outreach import qualified Omni.Agent.Tools.Pdf as Pdf import qualified Omni.Agent.Tools.Python as Python import qualified Omni.Agent.Tools.Todos as Todos @@ -566,6 +567,22 @@ handleAuthorizedMessage :: handleAuthorizedMessage tgConfig provider engineCfg msg uid userName chatId = do Reminders.recordUserChat uid chatId + let msgText = Types.tmText msg + threadId = Types.tmThreadId msg + cmdHandled <- handleOutreachCommand tgConfig chatId threadId msgText + when cmdHandled (pure ()) + unless cmdHandled <| handleAuthorizedMessageContinued tgConfig provider engineCfg msg uid userName chatId + +handleAuthorizedMessageContinued :: + Types.TelegramConfig -> + Provider.Provider -> + Engine.EngineConfig -> + Types.TelegramMessage -> + Text -> + Text -> + Int -> + IO () +handleAuthorizedMessageContinued tgConfig provider engineCfg msg uid userName chatId = do pdfContent <- case Types.tmDocument msg of Just doc | Types.isPdf doc -> do putText <| "Processing PDF: " <> fromMaybe "(unnamed)" (Types.tdFileName doc) @@ -963,7 +980,8 @@ processEngagedMessage tgConfig provider engineCfg msg uid userName chatId userMe else [] pythonTools = [Python.pythonExecTool] httpTools = Http.allHttpTools - tools = memoryTools <> searchTools <> webReaderTools <> pdfTools <> notesTools <> calendarTools <> todoTools <> messageTools <> hledgerTools <> emailTools <> pythonTools <> httpTools + outreachTools = Outreach.allOutreachTools + tools = memoryTools <> searchTools <> webReaderTools <> pdfTools <> notesTools <> calendarTools <> todoTools <> messageTools <> hledgerTools <> emailTools <> pythonTools <> httpTools <> outreachTools let agentCfg = Engine.defaultAgentConfig @@ -1261,3 +1279,60 @@ loadAllowedUserIds = do Just idsStr -> do let ids = mapMaybe (readMaybe <. Text.unpack <. Text.strip) (Text.splitOn "," (Text.pack idsStr)) pure ids + +handleOutreachCommand :: Types.TelegramConfig -> Int -> Maybe Int -> Text -> IO Bool +handleOutreachCommand _tgConfig chatId mThreadId cmd + | "/review" `Text.isPrefixOf` cmd = do + pending <- Outreach.listDrafts Outreach.Pending + case pending of + [] -> do + _ <- Messages.enqueueImmediate Nothing chatId mThreadId "no pending outreach drafts" (Just "system") Nothing + pure True + (draft : _) -> do + let msg = formatDraftForReview draft + _ <- Messages.enqueueImmediate Nothing chatId mThreadId msg (Just "system") Nothing + pure True + | "/approve " `Text.isPrefixOf` cmd = do + let draftId = Text.strip (Text.drop 9 cmd) + result <- Outreach.approveDraft draftId + case result of + Left err -> do + _ <- Messages.enqueueImmediate Nothing chatId mThreadId ("error: " <> err) (Just "system") Nothing + pure True + Right draft -> do + _ <- Messages.enqueueImmediate Nothing chatId mThreadId ("approved: " <> Outreach.draftId draft) (Just "system") Nothing + pure True + | "/reject " `Text.isPrefixOf` cmd = do + let rest = Text.strip (Text.drop 8 cmd) + (draftId, reason) = case Text.breakOn " " rest of + (did, r) -> (did, if Text.null r then Nothing else Just (Text.strip r)) + result <- Outreach.rejectDraft draftId reason + case result of + Left err -> do + _ <- Messages.enqueueImmediate Nothing chatId mThreadId ("error: " <> err) (Just "system") Nothing + pure True + Right draft -> do + let reasonMsg = maybe "" (" reason: " <>) (Outreach.draftRejectReason draft) + _ <- Messages.enqueueImmediate Nothing chatId mThreadId ("rejected: " <> Outreach.draftId draft <> reasonMsg) (Just "system") Nothing + pure True + | "/queue" `Text.isPrefixOf` cmd = do + count <- Outreach.getPendingCount + _ <- Messages.enqueueImmediate Nothing chatId mThreadId (tshow count <> " pending outreach drafts") (Just "system") Nothing + pure True + | otherwise = pure False + +formatDraftForReview :: Outreach.OutreachDraft -> Text +formatDraftForReview draft = + Text.unlines + [ "*outreach draft*", + "", + "*id:* `" <> Outreach.draftId draft <> "`", + "*type:* " <> tshow (Outreach.draftType draft), + "*to:* " <> Outreach.draftRecipient draft, + maybe "" (\s -> "*subject:* " <> s <> "\n") (Outreach.draftSubject draft), + "*context:* " <> Outreach.draftContext draft, + "", + Outreach.draftBody draft, + "", + "reply `/approve " <> Outreach.draftId draft <> "` or `/reject " <> Outreach.draftId draft <> " [reason]`" + ] diff --git a/Omni/Agent/Tools/Outreach.hs b/Omni/Agent/Tools/Outreach.hs new file mode 100644 index 0000000..d601b36 --- /dev/null +++ b/Omni/Agent/Tools/Outreach.hs @@ -0,0 +1,511 @@ +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE NoImplicitPrelude #-} + +-- | Outreach approval queue for agent use. +-- +-- Provides tools for creating and tracking outreach drafts that require +-- human approval before sending (emails, messages, etc). +-- +-- Drafts flow: pending -> approved -> sent (or rejected) +-- +-- : out omni-agent-tools-outreach +-- : dep aeson +-- : dep uuid +-- : dep directory +module Omni.Agent.Tools.Outreach + ( -- * Tools + outreachDraftTool, + outreachListTool, + outreachStatusTool, + allOutreachTools, + + -- * Types + OutreachDraft (..), + OutreachType (..), + OutreachStatus (..), + + -- * Direct API + createDraft, + listDrafts, + getDraft, + approveDraft, + rejectDraft, + markSent, + getPendingCount, + + -- * Paths + outreachDir, + pendingDir, + approvedDir, + rejectedDir, + sentDir, + + -- * Testing + main, + test, + ) +where + +import Alpha +import Control.Monad.Fail (MonadFail (fail)) +import Data.Aeson ((.!=), (.:), (.:?), (.=)) +import qualified Data.Aeson as Aeson +import qualified Data.ByteString.Lazy as BL +import qualified Data.Text as Text +import qualified Data.Text.Encoding as TE +import qualified Data.Text.IO as TextIO +import Data.Time (UTCTime, getCurrentTime) +import qualified Data.UUID as UUID +import qualified Data.UUID.V4 as UUID +import qualified Omni.Agent.Engine as Engine +import qualified Omni.Test as Test +import qualified System.Directory as Directory + +main :: IO () +main = Test.run test + +test :: Test.Tree +test = + Test.group + "Omni.Agent.Tools.Outreach" + [ Test.unit "outreachDraftTool has correct name" <| do + Engine.toolName outreachDraftTool Test.@=? "outreach_draft", + Test.unit "outreachListTool has correct name" <| do + Engine.toolName outreachListTool Test.@=? "outreach_list", + Test.unit "outreachStatusTool has correct name" <| do + Engine.toolName outreachStatusTool Test.@=? "outreach_status", + Test.unit "allOutreachTools has 3 tools" <| do + length allOutreachTools Test.@=? 3, + Test.unit "OutreachDraft JSON roundtrip" <| do + now <- getCurrentTime + let draft = + OutreachDraft + { draftId = "test-id-123", + draftType = Email, + draftCreatedAt = now, + draftSubject = Just "Test subject", + draftRecipient = "test@example.com", + draftBody = "Hello, this is a test.", + draftContext = "Testing outreach system", + draftStatus = Pending, + draftRejectReason = Nothing + } + case Aeson.decode (Aeson.encode draft) of + Nothing -> Test.assertFailure "Failed to decode OutreachDraft" + Just decoded -> do + draftId decoded Test.@=? "test-id-123" + draftType decoded Test.@=? Email + draftRecipient decoded Test.@=? "test@example.com", + Test.unit "OutreachType JSON roundtrip" <| do + case Aeson.decode (Aeson.encode Email) of + Just Email -> pure () + _ -> Test.assertFailure "Failed to decode Email" + case Aeson.decode (Aeson.encode Message) of + Just Message -> pure () + _ -> Test.assertFailure "Failed to decode Message", + Test.unit "OutreachStatus JSON roundtrip" <| do + let statuses = [Pending, Approved, Rejected, Sent] + forM_ statuses <| \s -> + case Aeson.decode (Aeson.encode s) of + Nothing -> Test.assertFailure ("Failed to decode " <> show s) + Just decoded -> decoded Test.@=? s + ] + +outreachDir :: FilePath +outreachDir = "_/var/ava/outreach" + +pendingDir :: FilePath +pendingDir = outreachDir <> "/pending" + +approvedDir :: FilePath +approvedDir = outreachDir <> "/approved" + +rejectedDir :: FilePath +rejectedDir = outreachDir <> "/rejected" + +sentDir :: FilePath +sentDir = outreachDir <> "/sent" + +data OutreachType = Email | Message + deriving (Show, Eq, Generic) + +instance Aeson.ToJSON OutreachType where + toJSON Email = Aeson.String "email" + toJSON Message = Aeson.String "message" + +instance Aeson.FromJSON OutreachType where + parseJSON = + Aeson.withText "OutreachType" <| \t -> + case Text.toLower t of + "email" -> pure Email + "message" -> pure Message + _ -> fail "OutreachType must be 'email' or 'message'" + +data OutreachStatus = Pending | Approved | Rejected | Sent + deriving (Show, Eq, Generic) + +instance Aeson.ToJSON OutreachStatus where + toJSON Pending = Aeson.String "pending" + toJSON Approved = Aeson.String "approved" + toJSON Rejected = Aeson.String "rejected" + toJSON Sent = Aeson.String "sent" + +instance Aeson.FromJSON OutreachStatus where + parseJSON = + Aeson.withText "OutreachStatus" <| \t -> + case Text.toLower t of + "pending" -> pure Pending + "approved" -> pure Approved + "rejected" -> pure Rejected + "sent" -> pure Sent + _ -> fail "OutreachStatus must be 'pending', 'approved', 'rejected', or 'sent'" + +data OutreachDraft = OutreachDraft + { draftId :: Text, + draftType :: OutreachType, + draftCreatedAt :: UTCTime, + draftSubject :: Maybe Text, + draftRecipient :: Text, + draftBody :: Text, + draftContext :: Text, + draftStatus :: OutreachStatus, + draftRejectReason :: Maybe Text + } + deriving (Show, Eq, Generic) + +instance Aeson.ToJSON OutreachDraft where + toJSON d = + Aeson.object + [ "id" .= draftId d, + "type" .= draftType d, + "created_at" .= draftCreatedAt d, + "subject" .= draftSubject d, + "recipient" .= draftRecipient d, + "body" .= draftBody d, + "context" .= draftContext d, + "status" .= draftStatus d, + "reject_reason" .= draftRejectReason d + ] + +instance Aeson.FromJSON OutreachDraft where + parseJSON = + Aeson.withObject "OutreachDraft" <| \v -> + (OutreachDraft </ (v .: "id")) + <*> (v .: "type") + <*> (v .: "created_at") + <*> (v .:? "subject") + <*> (v .: "recipient") + <*> (v .: "body") + <*> (v .: "context") + <*> (v .: "status") + <*> (v .:? "reject_reason") + +ensureDirs :: IO () +ensureDirs = do + Directory.createDirectoryIfMissing True pendingDir + Directory.createDirectoryIfMissing True approvedDir + Directory.createDirectoryIfMissing True rejectedDir + Directory.createDirectoryIfMissing True sentDir + +draftPath :: FilePath -> Text -> FilePath +draftPath dir draftId' = dir <> "/" <> Text.unpack draftId' <> ".json" + +saveDraft :: OutreachDraft -> IO () +saveDraft draft = do + ensureDirs + let dir = case draftStatus draft of + Pending -> pendingDir + Approved -> approvedDir + Rejected -> rejectedDir + Sent -> sentDir + path = draftPath dir (draftId draft) + TextIO.writeFile path (TE.decodeUtf8 (BL.toStrict (Aeson.encode draft))) + +createDraft :: OutreachType -> Text -> Maybe Text -> Text -> Text -> IO OutreachDraft +createDraft otype recipient subject body context = do + uuid <- UUID.nextRandom + now <- getCurrentTime + let draft = + OutreachDraft + { draftId = UUID.toText uuid, + draftType = otype, + draftCreatedAt = now, + draftSubject = subject, + draftRecipient = recipient, + draftBody = body, + draftContext = context, + draftStatus = Pending, + draftRejectReason = Nothing + } + saveDraft draft + pure draft + +listDrafts :: OutreachStatus -> IO [OutreachDraft] +listDrafts status = do + ensureDirs + let dir = case status of + Pending -> pendingDir + Approved -> approvedDir + Rejected -> rejectedDir + Sent -> sentDir + files <- Directory.listDirectory dir + let jsonFiles = filter (".json" `isSuffixOf`) files + drafts <- + forM jsonFiles <| \f -> do + content <- TextIO.readFile (dir <> "/" <> f) + pure (Aeson.decode (BL.fromStrict (TE.encodeUtf8 content))) + pure (catMaybes drafts) + +getDraft :: Text -> IO (Maybe OutreachDraft) +getDraft draftId' = do + ensureDirs + let dirs = [pendingDir, approvedDir, rejectedDir, sentDir] + findFirst dirs + where + findFirst [] = pure Nothing + findFirst (dir : rest) = do + let path = draftPath dir draftId' + exists <- Directory.doesFileExist path + if exists + then do + content <- TextIO.readFile path + pure (Aeson.decode (BL.fromStrict (TE.encodeUtf8 content))) + else findFirst rest + +moveDraft :: Text -> OutreachStatus -> OutreachStatus -> Maybe Text -> IO (Either Text OutreachDraft) +moveDraft draftId' fromStatus toStatus reason = do + ensureDirs + let fromDir = case fromStatus of + Pending -> pendingDir + Approved -> approvedDir + Rejected -> rejectedDir + Sent -> sentDir + fromPath = draftPath fromDir draftId' + exists <- Directory.doesFileExist fromPath + if not exists + then pure (Left ("Draft not found in " <> tshow fromStatus <> " queue")) + else do + content <- TextIO.readFile fromPath + case Aeson.decode (BL.fromStrict (TE.encodeUtf8 content)) of + Nothing -> pure (Left "Failed to parse draft") + Just draft -> do + let updated = draft {draftStatus = toStatus, draftRejectReason = reason} + Directory.removeFile fromPath + saveDraft updated + pure (Right updated) + +approveDraft :: Text -> IO (Either Text OutreachDraft) +approveDraft draftId' = moveDraft draftId' Pending Approved Nothing + +rejectDraft :: Text -> Maybe Text -> IO (Either Text OutreachDraft) +rejectDraft draftId' = moveDraft draftId' Pending Rejected + +markSent :: Text -> IO (Either Text OutreachDraft) +markSent draftId' = moveDraft draftId' Approved Sent Nothing + +getPendingCount :: IO Int +getPendingCount = do + ensureDirs + files <- Directory.listDirectory pendingDir + pure (length (filter (".json" `isSuffixOf`) files)) + +allOutreachTools :: [Engine.Tool] +allOutreachTools = + [ outreachDraftTool, + outreachListTool, + outreachStatusTool + ] + +outreachDraftTool :: Engine.Tool +outreachDraftTool = + Engine.Tool + { Engine.toolName = "outreach_draft", + Engine.toolDescription = + "Create a new outreach draft for Ben to review before sending. " + <> "Use this when you want to send an email or message on behalf of the business. " + <> "All outreach requires approval before it goes out.", + Engine.toolJsonSchema = + Aeson.object + [ "type" .= ("object" :: Text), + "properties" + .= Aeson.object + [ "type" + .= Aeson.object + [ "type" .= ("string" :: Text), + "enum" .= (["email", "message"] :: [Text]), + "description" .= ("Type of outreach: 'email' or 'message'" :: Text) + ], + "recipient" + .= Aeson.object + [ "type" .= ("string" :: Text), + "description" .= ("Email address or identifier of the recipient" :: Text) + ], + "subject" + .= Aeson.object + [ "type" .= ("string" :: Text), + "description" .= ("Subject line (required for emails)" :: Text) + ], + "body" + .= Aeson.object + [ "type" .= ("string" :: Text), + "description" .= ("The message content" :: Text) + ], + "context" + .= Aeson.object + [ "type" .= ("string" :: Text), + "description" .= ("Explain why you're sending this - helps Ben review" :: Text) + ] + ], + "required" .= (["type", "recipient", "body", "context"] :: [Text]) + ], + Engine.toolExecute = executeOutreachDraft + } + +executeOutreachDraft :: Aeson.Value -> IO Aeson.Value +executeOutreachDraft v = + case Aeson.fromJSON v of + Aeson.Error e -> pure (Aeson.object ["error" .= Text.pack e]) + Aeson.Success (args :: DraftArgs) -> do + let otype = case daType args of + "email" -> Email + _ -> Message + draft <- createDraft otype (daRecipient args) (daSubject args) (daBody args) (daContext args) + pure + ( Aeson.object + [ "success" .= True, + "draft_id" .= draftId draft, + "message" .= ("Draft created and queued for review. ID: " <> draftId draft) + ] + ) + +data DraftArgs = DraftArgs + { daType :: Text, + daRecipient :: Text, + daSubject :: Maybe Text, + daBody :: Text, + daContext :: Text + } + deriving (Generic) + +instance Aeson.FromJSON DraftArgs where + parseJSON = + Aeson.withObject "DraftArgs" <| \v -> + (DraftArgs </ (v .: "type")) + <*> (v .: "recipient") + <*> (v .:? "subject") + <*> (v .: "body") + <*> (v .: "context") + +outreachListTool :: Engine.Tool +outreachListTool = + Engine.Tool + { Engine.toolName = "outreach_list", + Engine.toolDescription = + "List outreach drafts by status. Use to check what's pending approval, " + <> "what's been approved, or review past outreach.", + Engine.toolJsonSchema = + Aeson.object + [ "type" .= ("object" :: Text), + "properties" + .= Aeson.object + [ "status" + .= Aeson.object + [ "type" .= ("string" :: Text), + "enum" .= (["pending", "approved", "rejected", "sent"] :: [Text]), + "description" .= ("Filter by status (default: pending)" :: Text) + ], + "limit" + .= Aeson.object + [ "type" .= ("integer" :: Text), + "description" .= ("Max drafts to return (default: 20)" :: Text) + ] + ], + "required" .= ([] :: [Text]) + ], + Engine.toolExecute = executeOutreachList + } + +executeOutreachList :: Aeson.Value -> IO Aeson.Value +executeOutreachList v = + case Aeson.fromJSON v of + Aeson.Error e -> pure (Aeson.object ["error" .= Text.pack e]) + Aeson.Success (args :: ListArgs) -> do + let status = case laStatus args of + Just "approved" -> Approved + Just "rejected" -> Rejected + Just "sent" -> Sent + _ -> Pending + limit = min 50 (max 1 (laLimit args)) + drafts <- listDrafts status + let limited = take limit drafts + pure + ( Aeson.object + [ "success" .= True, + "status" .= tshow status, + "count" .= length limited, + "drafts" .= limited + ] + ) + +data ListArgs = ListArgs + { laStatus :: Maybe Text, + laLimit :: Int + } + deriving (Generic) + +instance Aeson.FromJSON ListArgs where + parseJSON = + Aeson.withObject "ListArgs" <| \v -> + (ListArgs </ (v .:? "status")) + <*> (v .:? "limit" .!= 20) + +outreachStatusTool :: Engine.Tool +outreachStatusTool = + Engine.Tool + { Engine.toolName = "outreach_status", + Engine.toolDescription = + "Check the status of a specific outreach draft by ID.", + Engine.toolJsonSchema = + Aeson.object + [ "type" .= ("object" :: Text), + "properties" + .= Aeson.object + [ "draft_id" + .= Aeson.object + [ "type" .= ("string" :: Text), + "description" .= ("The draft ID to check" :: Text) + ] + ], + "required" .= (["draft_id"] :: [Text]) + ], + Engine.toolExecute = executeOutreachStatus + } + +executeOutreachStatus :: Aeson.Value -> IO Aeson.Value +executeOutreachStatus v = + case Aeson.fromJSON v of + Aeson.Error e -> pure (Aeson.object ["error" .= Text.pack e]) + Aeson.Success (args :: StatusArgs) -> do + mDraft <- getDraft (saId args) + case mDraft of + Nothing -> + pure (Aeson.object ["error" .= ("Draft not found" :: Text)]) + Just draft -> + pure + ( Aeson.object + [ "success" .= True, + "draft" .= draft + ] + ) + +newtype StatusArgs = StatusArgs + { saId :: Text + } + deriving (Generic) + +instance Aeson.FromJSON StatusArgs where + parseJSON = + Aeson.withObject "StatusArgs" <| \v -> + StatusArgs </ (v .: "draft_id") |
