Files
inter-hub/Web/Controller/AgentRegistrations.hs
tegwick 2106000cc7
Some checks failed
Test / test (push) Has been cancelled
fix: resolve all GHC 9.10.3 / IHP 1.5 compile errors (all 616 modules load)
Fix 13 modules that blocked compilation on Alpine:

- FrontController: remove annotationLauncherScript helper (IHP Html is a
  constrained type synonym); add (?context, ?request) constraint to
  defaultLayout matching what setLayout expects
- HubCapabilityManifests: switch JSONB fill to paramList+toJSON; fix dynamic
  SQL Text→Query via fromString/cs; void sqlExec; add Control.Monad.void
- Hubs: replace raw Array sqlQuery with filterWhereIn query builder;
  fix isInList validators
- DecisionRecords: remove unregistered DistilDecisionAction; fix hub
  resolution chain via candidateId→sourceWidgetId; BridgeResponse(..)
- RequirementCandidates: BridgeResponse(..); remove @Widget type apps from
  fetchOneOrNothing; void ConfidenceAnnotation createRecord
- AdaptiveThresholds: fix sqlQuery tuple param (Only hubId)
- AgentDelegations, AgentRegistrations, Widgets: BridgeResponse(..)
- Annotations, DeploymentRecords, GovernanceTemplates: minor type fixes
- DecisionRecords/Edit view: extract formAction before HSX block

Co-Authored-By: Claude Sonnet 4.6 <noreply@anthropic.com>
2026-04-29 10:46:50 +02:00

129 lines
5.7 KiB
Haskell

module Web.Controller.AgentRegistrations where
-- IHF Phase 11 — Advanced AI Federation (IHUB-WP-0012 T03)
import Web.Types
import Generated.Types
import IHP.Prelude
import IHP.ControllerPrelude
import IHP.ModelSupport (sqlQuery)
import qualified Data.Aeson as A
import Web.View.AgentRegistrations.Index
import Web.View.AgentRegistrations.Show
import Web.View.AgentRegistrations.New
import Web.View.AgentRegistrations.Edit
import Web.View.AgentRegistrations.Performance
instance Controller AgentRegistrationsController where
action AgentRegistrationsAction = do
agents <- query @AgentRegistration
|> orderByAsc #name
|> fetch
hubs <- query @Hub |> orderByAsc #name |> fetch
render IndexView { .. }
action ShowAgentRegistrationAction { agentRegistrationId } = do
agent <- fetch agentRegistrationId
policies <- query @ModelRoutingPolicy
|> filterWhere (#agentRegistrationId, agentRegistrationId)
|> orderByAsc #taskType
|> fetch
recentProposals <- query @AgentProposal
|> filterWhere (#agentRegistrationId, Just agentRegistrationId)
|> orderByDesc #createdAt
|> limit 10
|> fetch
mPerformance <- query @AgentPerformanceRecord
|> filterWhere (#agentRegistrationId, agentRegistrationId)
|> orderByDesc #computedAt
|> limit 1
|> fetchOneOrNothing
render ShowView { .. }
action NewAgentRegistrationAction = do
let agent = newRecord @AgentRegistration
hubs <- query @Hub |> orderByAsc #name |> fetch
render NewView { .. }
action CreateAgentRegistrationAction = do
let agent = newRecord @AgentRegistration
agent
|> fill @'["hubId","name","slug","description","provider","modelName","trustLevel","systemPrompt"]
|> set #capabilities (A.Array mempty)
|> validateField #name nonEmpty
|> validateField #slug nonEmpty
|> validateField #provider (isInList ["openrouter","gemini","openai","claude-code"])
|> validateField #modelName nonEmpty
|> validateField #trustLevel (isInList ["advisory","elevated","autonomous"])
|> ifValid \case
Left agent -> do
hubs <- query @Hub |> orderByAsc #name |> fetch
render NewView { .. }
Right agent -> do
agent <- createRecord agent
setSuccessMessage "Agent registered"
redirectTo AgentRegistrationsAction
action EditAgentRegistrationAction { agentRegistrationId } = do
agent <- fetch agentRegistrationId
hubs <- query @Hub |> orderByAsc #name |> fetch
render EditView { .. }
action UpdateAgentRegistrationAction { agentRegistrationId } = do
agent <- fetch agentRegistrationId
agent
|> fill @'["name","description","provider","modelName","trustLevel","systemPrompt"]
|> validateField #name nonEmpty
|> validateField #provider (isInList ["openrouter","gemini","openai","claude-code"])
|> validateField #modelName nonEmpty
|> validateField #trustLevel (isInList ["advisory","elevated","autonomous"])
|> ifValid \case
Left agent -> do
hubs <- query @Hub |> orderByAsc #name |> fetch
render EditView { .. }
Right agent -> do
updateRecord agent
setSuccessMessage "Agent updated"
redirectTo (ShowAgentRegistrationAction agentRegistrationId)
action DeactivateAgentAction { agentRegistrationId } = do
agent <- fetch agentRegistrationId
agent |> set #isActive False |> updateRecord
setSuccessMessage "Agent deactivated"
redirectTo (ShowAgentRegistrationAction agentRegistrationId)
action ComputeAgentPerformanceAction { agentRegistrationId } = do
agent <- fetch agentRegistrationId
rows <- sqlQuery
"SELECT \
\ COUNT(*) FILTER (WHERE ap.status = 'accepted')::int AS accepted, \
\ COUNT(*) FILTER (WHERE ap.status = 'rejected')::int AS rejected, \
\ COUNT(*) FILTER (WHERE ap.status NOT IN ('accepted','rejected'))::int AS other, \
\ COUNT(*)::int AS total, \
\ AVG(ca.score) AS mean_confidence \
\ FROM agent_proposals ap \
\ LEFT JOIN confidence_annotations ca ON ca.proposal_id = ap.id \
\ WHERE ap.agent_registration_id = ? \
\ AND ap.created_at >= NOW() - INTERVAL '30 days'"
(Only agentRegistrationId)
:: IO [(Int, Int, Int, Int, Maybe Double)]
case rows of
[(accepted, rejected, _other, total, mConf)] -> do
now <- getCurrentTime
let periodStart = addUTCTime (negate $ 30 * 86400) now
newRecord @AgentPerformanceRecord
|> set #agentRegistrationId agentRegistrationId
|> set #hubId agent.hubId
|> set #periodStart periodStart
|> set #periodEnd now
|> set #proposalsGenerated total
|> set #proposalsAccepted accepted
|> set #proposalsRejected rejected
|> set #proposalsRevised 0
|> set #meanConfidence mConf
|> createRecord
setSuccessMessage "Performance snapshot computed"
_ -> setErrorMessage "Could not compute performance metrics"
redirectTo (ShowAgentRegistrationAction agentRegistrationId)