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 }