{-# 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.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 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 = Paths.outreachDir 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