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
parent 1862bb295a
commit 2605c1c977
23 changed files with 1284 additions and 21 deletions
--- a/Web/Controller/AgentProposals.hs
+++ b/Web/Controller/AgentProposals.hs
@@ -0,0 +1,128 @@
+module Web.Controller.AgentProposals where
+
+import Web.Types
+import Web.View.AgentProposals.Index
+import Web.View.AgentProposals.Show
+import Generated.Types
+import IHP.Prelude
+import IHP.ControllerPrelude
+import Data.Aeson (decode)
+import Data.ByteString.Lazy (fromStrict)
+import Data.Text.Encoding (encodeUtf8)
+import Data.HashMap.Strict (HashMap)
+import qualified Data.HashMap.Strict as HashMap
+
+instance Controller AgentProposalsController where
+    beforeAction = ensureIsUser
+
+    action AgentProposalsAction = do
+        mTypeFilter   <- paramOrNothing @Text "proposal_type"
+        mStatusFilter <- paramOrNothing @Text "status"
+        proposals <- case (mTypeFilter, mStatusFilter) of
+            (Nothing, Nothing) ->
+                query @AgentProposal |> orderByDesc #createdAt |> fetch
+            (Just t, Nothing) ->
+                query @AgentProposal
+                    |> filterWhere (#proposalType, t)
+                    |> orderByDesc #createdAt |> fetch
+            (Nothing, Just s) ->
+                query @AgentProposal
+                    |> filterWhere (#status, s)
+                    |> orderByDesc #createdAt |> fetch
+            (Just t, Just s) ->
+                query @AgentProposal
+                    |> filterWhere (#proposalType, t)
+                    |> filterWhere (#status, s)
+                    |> orderByDesc #createdAt |> fetch
+        widgets  <- query @Widget |> fetch
+        render IndexView { proposals, widgets, mTypeFilter, mStatusFilter }
+
+    action ShowAgentProposalAction { agentProposalId } = do
+        proposal    <- fetch agentProposalId
+        mWidget     <- case proposal.sourceWidgetId of
+            Nothing  -> pure Nothing
+            Just wid -> fetchOneOrNothing wid
+        mCandidate  <- case proposal.sourceCandidateId of
+            Nothing  -> pure Nothing
+            Just cid -> fetchOneOrNothing cid
+        mDecision   <- case proposal.sourceDecisionId of
+            Nothing  -> pure Nothing
+            Just did -> fetchOneOrNothing did
+        mReview     <- query @AgentReviewRecord
+            |> filterWhere (#proposalId, agentProposalId)
+            |> fetchOneOrNothing
+        confidences <- query @ConfidenceAnnotation
+            |> filterWhere (#proposalId, agentProposalId)
+            |> orderByAsc #createdAt
+            |> fetch
+        users       <- query @User |> fetch
+        render ShowView
+            { proposal, mWidget, mCandidate, mDecision
+            , mReview, confidences, users }
+
+    action AcceptProposalAction { agentProposalId } = do
+        proposal  <- fetch agentProposalId
+        mExisting <- query @AgentReviewRecord
+            |> filterWhere (#proposalId, agentProposalId)
+            |> fetchOneOrNothing
+        case mExisting of
+            Just _ -> do
+                setSuccessMessage "Already reviewed"
+                redirectTo ShowAgentProposalAction { agentProposalId }
+            Nothing -> do
+                mUser <- currentUserOrNothing
+                let reviewerId = fmap (.id) mUser
+                proposal
+                    |> set #status "accepted"
+                    |> updateRecord
+                notes <- paramOrNothing @Text "notes"
+                newRecord @AgentReviewRecord
+                    |> set #proposalId agentProposalId
+                    |> set #reviewerId (fmap (Id . unId) reviewerId)
+                    |> set #decision "accepted"
+                    |> set #notes notes
+                    |> createRecord
+                -- T04: if requirement_draft, promote to RequirementCandidate
+                when (proposal.proposalType == "requirement_draft") do
+                    let mParsed = decode (fromStrict (encodeUtf8 proposal.content))
+                                    :: Maybe (HashMap Text Text)
+                    case mParsed of
+                        Just m -> do
+                            let title = fromMaybe "AI Draft" (HashMap.lookup "title" m)
+                                desc  = fromMaybe ""         (HashMap.lookup "description" m)
+                            newRecord @RequirementCandidate
+                                |> set #title title
+                                |> set #description desc
+                                |> set #sourceWidgetId proposal.sourceWidgetId
+                                |> set #category "friction"
+                                |> set #status "open"
+                                |> createRecord
+                            setSuccessMessage "Requirement candidate created from AI draft"
+                        Nothing ->
+                            setSuccessMessage "Proposal accepted (could not parse JSON for candidate)"
+                redirectTo ShowAgentProposalAction { agentProposalId }
+
+    action RejectProposalAction { agentProposalId } = do
+        proposal  <- fetch agentProposalId
+        mExisting <- query @AgentReviewRecord
+            |> filterWhere (#proposalId, agentProposalId)
+            |> fetchOneOrNothing
+        case mExisting of
+            Just _ -> do
+                setSuccessMessage "Already reviewed"
+                redirectTo ShowAgentProposalAction { agentProposalId }
+            Nothing -> do
+                mUser <- currentUserOrNothing
+                let reviewerId = fmap (.id) mUser
+                proposal
+                    |> set #status "rejected"
+                    |> updateRecord
+                notes <- paramOrNothing @Text "notes"
+                newRecord @AgentReviewRecord
+                    |> set #proposalId agentProposalId
+                    |> set #reviewerId (fmap (Id . unId) reviewerId)
+                    |> set #decision "rejected"
+                    |> set #notes notes
+                    |> createRecord
+                setSuccessMessage "Proposal rejected"
+                redirectTo ShowAgentProposalAction { agentProposalId }