inter-hub-haskell/Web/Controller/LineageEnrichment.hs

module Web.Controller.LineageEnrichment where

-- IHF Phase 12 — Platform Memory (IHUB-WP-0013 T06)
-- The AFTER INSERT trigger trg_enrich_lineage handles real-time enrichment.
-- This controller provides on-demand batch backfill for existing records.

import Web.Controller.Prelude
import Web.View.LineageEnrichment.Index
import IHP.ModelSupport (sqlQuery)
import Database.PostgreSQL.Simple (Only(..))

instance Controller LineageEnrichmentController where
    beforeAction = ensureIsUser

    action LineageEnrichmentAction = do
        hubs <- query @Hub |> orderByAsc #name |> fetch
        -- Count unenriched decisions per hub
        counts <- sqlQuery
            "SELECT dr.hub_id, COUNT(*) FILTER (WHERE dr.outcome_summary IS NULL)::int AS unenriched \
            \ FROM decision_records dr \
            \ GROUP BY dr.hub_id"
            ()
            :: IO [(Id Hub, Int)]
        render IndexView { hubs, counts }

    action EnrichLineageAction { hubIdForLineage } = do
        let hubId = hubIdForLineage
        -- Batch-call the trigger logic via a PL/pgSQL function for all
        -- outcome_signals in this hub that haven't yet enriched their chain.
        [Only enriched] <- sqlQuery
            "SELECT COUNT(*) FROM ( \
            \    SELECT enrich_lineage_on_outcome_batch(os.id) \
            \    FROM outcome_signals os \
            \    JOIN deployment_records dep ON dep.id = os.deployment_id \
            \    JOIN decision_records dr ON dr.id = dep.decision_id \
            \    WHERE dr.hub_id = ? \
            \      AND dr.outcome_summary IS NULL \
            \ ) sub"
            (Only hubId)
            :: IO [Only Int]
        setSuccessMessage ("Lineage enriched for " <> show enriched <> " signals")
        redirectTo LineageEnrichmentAction