inter-hub-haskell/Web/Controller/AgentDelegations.hs

module Web.Controller.AgentDelegations where

-- IHF Phase 11 — Advanced AI Federation (IHUB-WP-0012 T06)
-- Updated: delegation token budget enforced natively by llm-connect BudgetTracker (FR-4).

import Web.Controller.Prelude
import Web.View.AgentDelegations.Index
import Web.View.AgentDelegations.Show
import qualified Data.Aeson as A
import Application.Helper.AgentBridge
    ( callAgentWithBudget
    , BridgeError(..)
    , BridgeResponse(..)
    , bridgeErrorMessage
    )

instance Controller AgentDelegationsController where

    action AgentDelegationsAction = do
        delegations <- query @AgentDelegation
            |> orderByDesc #createdAt
            |> fetch
        render IndexView { .. }

    action ShowAgentDelegationAction { agentDelegationId } = do
        delegation <- fetch agentDelegationId
        delegatingAgent <- fetch delegation.delegatingAgentId
        receivingAgent  <- fetch delegation.receivingAgentId
        mParentProposal <- case delegation.parentProposalId of
            Nothing  -> pure Nothing
            Just pid -> fetchOneOrNothing pid
        render ShowView { .. }

    action DelegateSubtaskAction { agentProposalId } = do
        proposal <- fetch agentProposalId
        let receivingAgentId = param @(Id AgentRegistration) "receivingAgentId"
            scope            = param @Text "scope"
            tokenBudget      = paramOrDefault @Int 1000 "tokenBudget"
        delegatingAgentId <- case (proposal.agentRegistrationId :: Maybe (Id AgentRegistration)) of
            Just aid -> pure aid
            Nothing  -> renderNotFound >> error "unreachable"

        receivingAgent <- fetch receivingAgentId

        delegation <- newRecord @AgentDelegation
            |> set #delegatingAgentId delegatingAgentId
            |> set #receivingAgentId receivingAgentId
            |> set #parentProposalId (Just agentProposalId)
            |> set #scope scope
            |> set #tokenBudget tokenBudget
            |> set #status "pending"
            |> createRecord

        -- FR-4: token budget passed to bridge → llm-connect BudgetTracker enforces it
        -- natively, raising LLMBudgetExceededError if the call would exceed the cap.
        result <- liftIO $ callAgentWithBudget receivingAgent scope tokenBudget 0

        now <- getCurrentTime
        case result of
            Left BudgetExceededError { errorMessage, budgetTotal, budgetConsumed, budgetRequested } -> do
                delegation
                    |> set #status "failed"
                    |> set #result (Just . A.toJSON $ A.object
                        [ "error"            A..= errorMessage
                        , "budgetTotal"      A..= budgetTotal
                        , "budgetConsumed"   A..= budgetConsumed
                        , "budgetRequested"  A..= budgetRequested
                        ])
                    |> set #completedAt (Just now)
                    |> updateRecord
                setErrorMessage ("Budget exceeded: requested " <> show budgetRequested
                    <> " tokens but only " <> show (budgetTotal - budgetConsumed) <> " remain")
            Left err -> do
                delegation
                    |> set #status "failed"
                    |> set #result (Just . A.toJSON $ A.object ["error" A..= bridgeErrorMessage err])
                    |> set #completedAt (Just now)
                    |> updateRecord
                setErrorMessage ("Delegation failed: " <> bridgeErrorMessage err)
            Right resp -> do
                delegation
                    |> set #status "completed"
                    |> set #tokensUsed (Just resp.tokensOut)
                    |> set #result (Just . A.toJSON $ A.object ["content" A..= resp.content])
                    |> set #completedAt (Just now)
                    |> updateRecord
                setSuccessMessage "Subtask delegated successfully"

        redirectTo ShowAgentDelegationAction { agentDelegationId = delegation.id }