Files
inter-hub/Web/Controller/AgentRegistrations.hs
Bernd Worsch 3737845e02 fix(WP-0017/E4): Layer 3 error fixes — round 2 (18 files)
Fixes 46 compile errors across 18 controllers and views:
- BridgeResponse missing from explicit import lists (Widgets, RequirementCandidates,
  DecisionRecords, AgentDelegations) — dot-notation HasField resolution fails without
  the type in scope under DuplicateRecordFields
- unId not in IHP v1.5 — replaced all fmap (Id . unId) with fmap coerce
- respondWith not in IHP — replaced with plain redirectTo in 5 controllers
- [hubId] list param to sqlQuery — replaced with (Only hubId) tuple
- deleteWhere not in IHP — replaced with query/filterWhere/fetch/deleteRecords
- fill @'["label"] mismatch — field is label_ in generated types, not label
- PersistUUID/toUUID (persistent-style) — replaced with (Only id)
- intercalate + jsonArrayTexts ambiguity in GovernanceTemplates — hid Index import,
  removed local duplicates, added Data.Text (intercalate)
- Int16 not in scope in AntifragilityDashboard — changed to Int (score :: Int)
- typeArraySection type mismatch in HubCapabilityManifests/Edit — unified to [Text]
- renderForm arity mismatch — added action param to DecisionRecords/New.renderForm
- Missing qualified Data.Aeson import in AdaptiveThresholds
- Missing ?request::Request constraint in Api/V2/WidgetPatterns.renderJsonWithStatus

Co-Authored-By: Claude Sonnet 4.6 <noreply@anthropic.com>
2026-04-12 12:17:45 +00:00

128 lines
5.6 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)
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)