path: root/Omni/Agent/Tools/Outreach.hs

{-# 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")