From f6bbf86e7e8e76c41b8163ce0b1996ee474fc560 Mon Sep 17 00:00:00 2001 From: Ben Sima Date: Sun, 14 Dec 2025 23:12:47 -0500 Subject: 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 --- Omni/Agent/Tools/Outreach.hs | 511 +++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 511 insertions(+) create mode 100644 Omni/Agent/Tools/Outreach.hs (limited to 'Omni/Agent/Tools/Outreach.hs') 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 .: "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 .: "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 .:? "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 Date: Wed, 17 Dec 2025 13:29:24 -0500 Subject: Add Ava systemd deployment with dedicated user and workspace - Add Omni.Agent.Paths module for configurable AVA_DATA_ROOT - Create ava Linux user in Users.nix with SSH key - Add systemd service in Beryllium/Ava.nix with graceful shutdown - Update Skills.hs and Outreach.hs to use configurable paths - Add startup logging of resolved paths in Telegram.hs - Create migration script for moving data from _/var/ava to /home/ava - Add deployment documentation in Beryllium/AVA.md In dev: AVA_DATA_ROOT unset uses _/var/ava/ In prod: AVA_DATA_ROOT=/home/ava via systemd Amp-Thread-ID: https://ampcode.com/threads/T-019b2d7e-bd88-7355-8133-275c65157aaf Co-authored-by: Amp --- Omni/Agent/Tools/Outreach.hs | 16 +++++++++------- 1 file changed, 9 insertions(+), 7 deletions(-) (limited to 'Omni/Agent/Tools/Outreach.hs') diff --git a/Omni/Agent/Tools/Outreach.hs b/Omni/Agent/Tools/Outreach.hs index d601b36..e576cbd 100644 --- a/Omni/Agent/Tools/Outreach.hs +++ b/Omni/Agent/Tools/Outreach.hs @@ -60,8 +60,10 @@ 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.Agent.Paths as Paths import qualified Omni.Test as Test import qualified System.Directory as Directory +import System.FilePath (()) main :: IO () main = Test.run test @@ -114,19 +116,19 @@ test = ] outreachDir :: FilePath -outreachDir = "_/var/ava/outreach" +outreachDir = Paths.outreachDir pendingDir :: FilePath -pendingDir = outreachDir <> "/pending" +pendingDir = outreachDir "pending" approvedDir :: FilePath -approvedDir = outreachDir <> "/approved" +approvedDir = outreachDir "approved" rejectedDir :: FilePath -rejectedDir = outreachDir <> "/rejected" +rejectedDir = outreachDir "rejected" sentDir :: FilePath -sentDir = outreachDir <> "/sent" +sentDir = outreachDir "sent" data OutreachType = Email | Message deriving (Show, Eq, Generic) @@ -210,7 +212,7 @@ ensureDirs = do Directory.createDirectoryIfMissing True sentDir draftPath :: FilePath -> Text -> FilePath -draftPath dir draftId' = dir <> "/" <> Text.unpack draftId' <> ".json" +draftPath dir draftId' = dir (Text.unpack draftId' <> ".json") saveDraft :: OutreachDraft -> IO () saveDraft draft = do @@ -254,7 +256,7 @@ listDrafts status = do let jsonFiles = filter (".json" `isSuffixOf`) files drafts <- forM jsonFiles <| \f -> do - content <- TextIO.readFile (dir <> "/" <> f) + content <- TextIO.readFile (dir f) pure (Aeson.decode (BL.fromStrict (TE.encodeUtf8 content))) pure (catMaybes drafts) -- cgit v1.2.3