Files
inter-hub/Web/Controller/Hubs.hs
Bernd Worsch 2605c1c977
Some checks failed
Test / test (push) Has been cancelled
feat(P5): IHF Phase 5 complete — agent-assisted distillation
Adds bounded AI support to the IHF governance loop. All AI outputs are
attributed (model_ref), reviewable (AgentReviewRecord), and reversible.
No autonomous decisions; no silent requirement promotion.

- T01: Schema — agent_proposals, agent_review_records,
  confidence_annotations (migration 1743379200)
- T02: AgentProposalsController (index/show/accept/reject, idempotent
  review guard), global nav "Agent" link
- T03: SummarizeClusterAction — Claude API cluster summary on widget show
- T04: DraftRequirementAction — AI requirement draft; acceptance creates
  RequirementCandidate (human-gated)
- T05: DetectDuplicatesAction — duplicate_flag proposal on candidate show
- T06: DetectPolicySensitivityAction — policy_flag with
  ConfidenceAnnotations per concern scope
- T07: ProposeImplementationAction — impl_proposal from decision show
- T08: AgentAuditDashboardAction — autoRefresh; KPI row, unreviewed queue,
  recent proposals, attribution log matrix
- T09: integration tests, SCOPE.md updated, phase5-summary.md, flake.nix
  adds http-conduit/aeson/string-conversions

Co-Authored-By: Claude Sonnet 4.6 <noreply@anthropic.com>
2026-03-29 15:54:33 +00:00

231 lines
8.2 KiB
Haskell

module Web.Controller.Hubs where
import Web.Types
import Web.View.Hubs.Index
import Web.View.Hubs.Show
import Web.View.Hubs.New
import Web.View.Hubs.Edit
import Web.View.Hubs.TriageDashboard
import Web.View.Hubs.GovernanceDashboard
import Web.View.Hubs.AntifragilityDashboard
import Web.View.Hubs.AgentAuditDashboard
import Generated.Types
import IHP.Prelude
import IHP.ControllerPrelude
import Application.Helper.Controller (regressedWidgetIds, widgetCycleCounts)
instance Controller HubsController where
beforeAction = ensureIsUser
action HubsAction = do
hubs <- query @Hub |> orderByAsc #createdAt |> fetch
render IndexView { hubs }
action NewHubAction = do
let hub = newRecord @Hub
render NewView { hub }
action ShowHubAction { hubId } = autoRefresh do
hub <- fetch hubId
widgets <- query @Widget
|> filterWhere (#hubId, hubId)
|> orderByAsc #name
|> fetch
widgetIds <- pure (map (.id) widgets)
recentEvents <- sqlQuery
"SELECT * FROM interaction_events WHERE widget_id = ANY(?) ORDER BY occurred_at DESC LIMIT 50"
(Only (PGArray widgetIds))
recentAnnotations <- sqlQuery
"SELECT * FROM annotations WHERE widget_id = ANY(?) ORDER BY created_at DESC LIMIT 20"
(Only (PGArray widgetIds))
render ShowView { hub, widgets, recentEvents, recentAnnotations }
action CreateHubAction = do
let hub = newRecord @Hub
hub
|> fill @'["slug", "name", "domain"]
|> validateField #slug nonEmpty
|> validateField #name nonEmpty
|> validateField #domain nonEmpty
|> ifValid \case
Left hub -> render NewView { hub }
Right hub -> do
hub <- createRecord hub
setSuccessMessage "Hub created"
redirectTo ShowHubAction { hubId = hub.id }
action EditHubAction { hubId } = do
hub <- fetch hubId
render EditView { hub }
action UpdateHubAction { hubId } = do
hub <- fetch hubId
hub
|> fill @'["slug", "name", "domain"]
|> validateField #slug nonEmpty
|> validateField #name nonEmpty
|> validateField #domain nonEmpty
|> ifValid \case
Left hub -> render EditView { hub }
Right hub -> do
updateRecord hub
setSuccessMessage "Hub updated"
redirectTo ShowHubAction { hubId = hub.id }
action DeleteHubAction { hubId } = do
hub <- fetch hubId
deleteRecord hub
setSuccessMessage "Hub deleted"
redirectTo HubsAction
action TriageDashboardAction { hubId } = autoRefresh do
hub <- fetch hubId
widgets <- query @Widget
|> filterWhere (#hubId, hubId)
|> fetch
let widgetIds = map (.id) widgets
-- All candidates for this hub's widgets
allCandidates <- query @RequirementCandidate
|> filterWhereIn (#sourceWidgetId, widgetIds)
|> orderByAsc #createdAt
|> fetch
-- Triage queue: open candidates, oldest first
let triageQueue = filter (\c -> c.status == "open") allCandidates
-- Recent escalations: last 20
recentEscalations <- query @RequirementCandidate
|> filterWhereIn (#sourceWidgetId, widgetIds)
|> orderByDesc #createdAt
|> limit 20
|> fetch
-- All annotations for category breakdown
allAnnotations <- query @Annotation
|> filterWhereIn (#widgetId, widgetIds)
|> fetch
render TriageDashboardView
{ hub
, widgets
, allCandidates
, triageQueue
, recentEscalations
, allAnnotations
}
action GovernanceDashboardAction { hubId } = autoRefresh do
hub <- fetch hubId
widgets <- query @Widget
|> filterWhere (#hubId, hubId)
|> fetch
let widgetIds = map (.id) widgets
-- All requirements whose source candidate is in this hub's widgets
allCandidates <- query @RequirementCandidate
|> filterWhereIn (#sourceWidgetId, widgetIds)
|> fetch
let acceptedCandidateIds = map (.id) (filter (\c -> c.status == "accepted") allCandidates)
allRequirements <- query @Requirement
|> filterWhereIn (#sourceCandidateId, acceptedCandidateIds)
|> fetch
-- Recent decisions (last 20) — scoped to this hub's requirements
let requirementIds = map (.id) allRequirements
recentDecisions <- query @DecisionRecord
|> filterWhereIn (#requirementId, map Just requirementIds)
|> orderByDesc #decidedAt
|> limit 20
|> fetch
-- All hub decisions (for outcome counts)
allDecisions <- query @DecisionRecord
|> filterWhereIn (#requirementId, map Just requirementIds)
|> fetch
-- All annotations for traceability coverage
allAnnotations <- query @Annotation
|> filterWhereIn (#widgetId, widgetIds)
|> fetch
-- Outcome signals for regression detection
allSignals <- query @OutcomeSignal
|> filterWhereIn (#widgetId, widgetIds)
|> fetch
let regressionWidgetIds = regressedWidgetIds allSignals allAnnotations
render GovernanceDashboardView
{ hub
, widgets
, allCandidates
, allRequirements
, recentDecisions
, allDecisions
, allAnnotations
, regressionWidgetIds
}
action AntifragilityDashboardAction { hubId } = autoRefresh do
hub <- fetch hubId
widgets <- query @Widget
|> filterWhere (#hubId, hubId)
|> fetch
let widgetIds = map (.id) widgets
-- Deployments for this hub's decisions
allCandidates <- query @RequirementCandidate
|> filterWhereIn (#sourceWidgetId, widgetIds)
|> fetch
let acceptedCandidateIds = map (.id) (filter (\c -> c.status == "accepted") allCandidates)
allRequirements <- query @Requirement
|> filterWhereIn (#sourceCandidateId, acceptedCandidateIds)
|> fetch
let requirementIds = map (.id) allRequirements
allDecisions <- query @DecisionRecord
|> filterWhereIn (#requirementId, map Just requirementIds)
|> fetch
let decisionIds = map (.id) allDecisions
allDeployments <- query @DeploymentRecord
|> filterWhereIn (#decisionId, decisionIds)
|> orderByDesc #deployedAt
|> fetch
let deploymentIds = map (.id) allDeployments
allSignals <- query @OutcomeSignal
|> filterWhereIn (#widgetId, widgetIds)
|> fetch
allEvaluations <- query @ChangeEvaluation
|> filterWhereIn (#deploymentId, deploymentIds)
|> fetch
allImplRefs <- query @ImplementationChangeReference
|> filterWhereIn (#decisionId, decisionIds)
|> fetch
allAnnotations <- query @Annotation
|> filterWhereIn (#widgetId, widgetIds)
|> fetch
let regressionWidgetIds = regressedWidgetIds allSignals allAnnotations
recurrenceLeaderboard = take 10 (widgetCycleCounts allCandidates allRequirements allDecisions allDeployments)
render AntifragilityDashboardView
{ hub
, widgets
, allDeployments
, allDecisions
, allSignals
, allEvaluations
, allImplRefs
, regressionWidgetIds
, recurrenceLeaderboard
}
action AgentAuditDashboardAction { hubId } = autoRefresh do
hub <- fetch hubId
proposals <- query @AgentProposal
|> orderByDesc #createdAt
|> fetch
reviews <- query @AgentReviewRecord |> fetch
widgets <- query @Widget |> fetch
render AgentAuditDashboardView { hub, proposals, reviews, widgets }