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 Web.View.Hubs.AdapterCompatibilityDashboard import Web.View.Hubs.FrictionHeatmap import Web.View.Hubs.BottleneckDashboard import Web.View.Hubs.HubHealthHistory import Web.View.Hubs.OperationalReviewBoard import Generated.Types import IHP.Prelude import IHP.ControllerPrelude import Application.Helper.Controller (regressedWidgetIds, widgetCycleCounts) import Application.Helper.FrictionScore (computeFrictionScore) import Application.Helper.BottleneckDetector (detectBottlenecks) import Application.Helper.HubHealth (computeHubHealth) 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)) mManifest <- query @HubCapabilityManifest |> filterWhere (#hubId, hubId) |> fetchOneOrNothing render ShowView { hub, widgets, recentEvents, recentAnnotations, mManifest } action CreateHubAction = do let hub = newRecord @Hub hub |> fill @'["slug", "name", "domain", "hubKind"] |> validateField #slug nonEmpty |> validateField #name nonEmpty |> validateField #domain nonEmpty |> validateField #hubKind (`elem` ["domain", "shared"]) -- 'framework' cannot be set via the UI |> 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", "hubKind"] |> validateField #slug nonEmpty |> validateField #name nonEmpty |> validateField #domain nonEmpty |> validateField #hubKind (`elem` ["framework", "domain", "shared"]) |> 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 } action AdapterCompatibilityDashboardAction { hubId } = autoRefresh do hub <- fetch hubId specs <- query @WidgetAdapterSpec |> orderByAsc #name |> fetch widgets <- query @Widget |> filterWhere (#hubId, hubId) |> fetch envelopes <- query @EnvelopeEmissionContract |> filterWhere (#status, "active") |> fetch reportings <- query @InteractionReportingContract |> filterWhere (#status, "active") |> fetch render AdapterCompatibilityDashboardView { hub, specs, widgets, envelopes, reportings } action FrictionHeatmapAction { hubId } = autoRefresh do hub <- fetch hubId widgets <- query @Widget |> filterWhere (#hubId, hubId) |> fetch let widgetIds = map (.id) widgets frictionScores <- query @FrictionScore |> filterWhereIn (#widgetId, widgetIds) |> fetch render FrictionHeatmapView { hub, widgets, frictionScores } action RecomputeFrictionAction { hubId } = do hub <- fetch hubId widgets <- query @Widget |> filterWhere (#hubId, hubId) |> fetch let widgetIds = map (.id) widgets annotations <- query @Annotation |> filterWhereIn (#widgetId, widgetIds) |> fetch events <- sqlQuery "SELECT * FROM interaction_events WHERE widget_id = ANY(?)" (Only (PGArray widgetIds)) signals <- query @OutcomeSignal |> filterWhereIn (#widgetId, widgetIds) |> fetch candidates <- query @RequirementCandidate |> filterWhereIn (#sourceWidgetId, widgetIds) |> fetch let regressionWids = regressedWidgetIds signals annotations mapM_ (\w -> let wAnnotations = filter (\a -> a.widgetId == w.id) annotations wEvents = filter (\e -> e.widgetId == w.id) events wCandidates = filter (\c -> c.sourceWidgetId == w.id) candidates isRegressed = w.id `elem` regressionWids in computeFrictionScore w.id wAnnotations wEvents isRegressed wCandidates ) widgets setSuccessMessage "Friction scores recomputed" redirectTo FrictionHeatmapAction { hubId } action BottleneckDashboardAction { hubId } = autoRefresh do hub <- fetch hubId widgets <- query @Widget |> filterWhere (#hubId, hubId) |> fetch bottlenecks <- query @BottleneckRecord |> filterWhere (#hubId, hubId) |> orderByAsc #stalledSince |> fetch render BottleneckDashboardView { hub, widgets, bottlenecks } action DetectBottlenecksAction { hubId } = do hub <- fetch hubId widgets <- query @Widget |> filterWhere (#hubId, hubId) |> fetch let widgetIds = map (.id) widgets candidates <- query @RequirementCandidate |> filterWhereIn (#sourceWidgetId, widgetIds) |> fetch let candidateIds = map (.id) candidates acceptedIds = map (.id) (filter (\c -> c.status == "accepted") candidates) requirements <- query @Requirement |> filterWhereIn (#sourceCandidateId, acceptedIds) |> fetch let reqIds = map (.id) requirements decisions <- query @DecisionRecord |> filterWhereIn (#requirementId, map Just reqIds) |> fetch let decisionIds = map (.id) decisions deployments <- query @DeploymentRecord |> filterWhereIn (#decisionId, decisionIds) |> fetch _ <- detectBottlenecks hubId widgets candidates requirements decisions deployments setSuccessMessage "Bottleneck detection complete" redirectTo BottleneckDashboardAction { hubId } action ResolveBottleneckAction { bottleneckRecordId } = do bottleneck <- fetch bottleneckRecordId now <- getCurrentTime bottleneck |> set #resolvedAt (Just now) |> updateRecord setSuccessMessage "Bottleneck resolved" redirectTo BottleneckDashboardAction { hubId = bottleneck.hubId } action SnapshotHubHealthAction { hubId } = do hub <- fetch hubId widgets <- query @Widget |> filterWhere (#hubId, hubId) |> fetch let widgetIds = map (.id) widgets candidates <- query @RequirementCandidate |> filterWhereIn (#sourceWidgetId, widgetIds) |> fetch let acceptedIds = map (.id) (filter (\c -> c.status == "accepted") candidates) requirements <- query @Requirement |> filterWhereIn (#sourceCandidateId, acceptedIds) |> fetch let reqIds = map (.id) requirements decisions <- query @DecisionRecord |> filterWhereIn (#requirementId, map Just reqIds) |> fetch let decisionIds = map (.id) decisions deployments <- query @DeploymentRecord |> filterWhereIn (#decisionId, decisionIds) |> fetch signals <- query @OutcomeSignal |> filterWhereIn (#widgetId, widgetIds) |> fetch annotations <- query @Annotation |> filterWhereIn (#widgetId, widgetIds) |> fetch bottlenecks <- query @BottleneckRecord |> filterWhere (#hubId, hubId) |> filterWhereSql (#resolvedAt, "IS NULL") |> fetch _ <- computeHubHealth hubId widgets candidates decisions deployments signals annotations bottlenecks setSuccessMessage "Hub health snapshot taken" redirectTo HubHealthHistoryAction { hubId } action HubHealthHistoryAction { hubId } = autoRefresh do hub <- fetch hubId snapshots <- query @HubHealthSnapshot |> filterWhere (#hubId, hubId) |> orderByDesc #computedAt |> fetch render HubHealthHistoryView { hub, snapshots } action OperationalReviewBoardAction = autoRefresh do hubs <- query @Hub |> orderByAsc #name |> fetch allSnapshots <- query @HubHealthSnapshot |> orderByDesc #computedAt |> fetch topFrictionScores <- query @FrictionScore |> orderByDesc #score |> limit 10 |> fetch topWidgets <- mapM (\fs -> fetch fs.widgetId) topFrictionScores bottlenecks <- query @BottleneckRecord |> filterWhereSql (#resolvedAt, "IS NULL") |> orderByAsc #stage |> fetch propagations <- query @CrossHubPropagation |> orderByDesc #detectedAt |> fetch let openPropagations = filter (\p -> p.status `elem` ["open","acknowledged"]) propagations render OperationalReviewBoardView { hubs , allSnapshots , topFrictionScores , topWidgets , bottlenecks , openPropagations }