feat(P5): IHF Phase 5 complete — agent-assisted distillation
Some checks failed
Test / test (push) Has been cancelled

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>
This commit is contained in:
2026-03-29 15:54:33 +00:00
parent 1862bb295a
commit 2605c1c977
23 changed files with 1284 additions and 21 deletions

View File

@@ -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 }

View File

@@ -8,6 +8,8 @@ import Web.View.DecisionRecords.Edit
import Generated.Types
import IHP.Prelude
import IHP.ControllerPrelude
import Application.Helper.Controller (callClaudeApi)
import Data.List (intercalate)
validOutcomes :: [Text]
validOutcomes = ["accepted", "rejected", "deferred", "split", "merged", "reframed"]
@@ -175,3 +177,38 @@ instance Controller DecisionRecordsController where
deleteRecord ref
setSuccessMessage "Implementation reference removed"
redirectTo ShowDecisionRecordAction { decisionRecordId }
-- T07: Propose implementation paths via Claude API
action ProposeImplementationAction { decisionRecordId } = do
record <- fetch decisionRecordId
implRefs <- query @ImplementationChangeReference
|> filterWhere (#decisionId, decisionRecordId)
|> fetch
mRequirement <- case record.requirementId of
Nothing -> pure Nothing
Just rid -> fetchOneOrNothing rid
let implLines = map (\r -> r.system <> ": " <> r.workItemRef) implRefs
reqDesc = maybe "" (.description) mRequirement
userMsg = "Decision: " <> record.title
<> "\nRationale: " <> record.rationale
<> "\nOutcome: " <> record.outcome
<> "\nRequirement: " <> reqDesc
<> "\nExisting impl refs: " <> intercalate ", " implLines
result <- liftIO $ callClaudeApi
"You are a traceability-aware implementation analyst. Propose 1\x20133 concrete implementation paths for this decision. Each path should include a work_item_ref (e.g. PROJ-123), a system (github|linear|jira), and a rationale. Respond with JSON: {\"proposals\": [{\"work_item_ref\": \"...\", \"system\": \"...\", \"rationale\": \"...\"}]}."
userMsg
600
case result of
Left err -> do
setErrorMessage ("Implementation proposal failed: " <> err)
redirectTo ShowDecisionRecordAction { decisionRecordId }
Right content -> do
newRecord @AgentProposal
|> set #proposalType "impl_proposal"
|> set #sourceDecisionId (Just decisionRecordId)
|> set #content content
|> set #modelRef "claude-sonnet-4-6"
|> set #status "pending"
|> createRecord
setSuccessMessage "Implementation proposal created"
redirectTo ShowDecisionRecordAction { decisionRecordId }

View File

@@ -8,6 +8,7 @@ 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
@@ -219,3 +220,11 @@ instance Controller HubsController where
, 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 }

View File

@@ -8,6 +8,17 @@ import Web.View.RequirementCandidates.Edit
import Generated.Types
import IHP.Prelude
import IHP.ControllerPrelude
import Application.Helper.Controller (callClaudeApi)
import Data.List (intercalate)
import Data.Aeson (decode, Value(..), Array)
import Data.Aeson.Lens (key, _String)
import Control.Lens ((^?))
import Data.ByteString.Lazy (fromStrict)
import Data.Text.Encoding (encodeUtf8)
import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as HashMap
import qualified Data.Vector as Vector
import Control.Monad (forM_)
validStatuses :: [Text]
validStatuses = ["open", "in_review", "accepted", "rejected", "deferred"]
@@ -233,3 +244,86 @@ instance Controller RequirementCandidatesController where
|> createRecord
setSuccessMessage "Decision record created"
redirectTo ShowDecisionRecordAction { decisionRecordId = dr.id }
-- T05: Detect duplicate candidates via Claude API
action DetectDuplicatesAction { requirementCandidateId } = do
target <- fetch requirementCandidateId
others <- query @RequirementCandidate
|> fetch
let otherLines = map (\c -> show c.id <> " | " <> c.title <> ": " <> c.description)
(filter (\c -> c.id /= requirementCandidateId) others)
targetLine = "TARGET: " <> target.title <> ": " <> target.description
userMsg = targetLine <> "\n\nEXISTING:\n" <> intercalate "\n" otherLines
result <- liftIO $ callClaudeApi
"You are a deduplication assistant. Given a target candidate and a list of existing candidates, identify likely duplicates. Respond with JSON: {\"duplicates\": [{\"id\": \"uuid\", \"reason\": \"...\"}]}."
userMsg
500
case result of
Left err -> do
setErrorMessage ("Duplicate detection failed: " <> err)
redirectTo ShowRequirementCandidateAction { requirementCandidateId }
Right content -> do
newRecord @AgentProposal
|> set #proposalType "duplicate_flag"
|> set #sourceCandidateId (Just requirementCandidateId)
|> set #content content
|> set #modelRef "claude-sonnet-4-6"
|> set #status "pending"
|> createRecord
setSuccessMessage "Duplicate detection proposal created"
redirectTo ShowRequirementCandidateAction { requirementCandidateId }
-- T06: Detect policy sensitivity via Claude API
action DetectPolicySensitivityAction { requirementCandidateId } = do
candidate <- fetch requirementCandidateId
mWidget <- case candidate.sourceWidgetId of
Nothing -> pure Nothing
Just wid -> fetchOneOrNothing wid
let policyCtx = maybe "unknown" (.policyScope) mWidget
userMsg = "Title: " <> candidate.title
<> "\nDescription: " <> candidate.description
<> "\nPolicy scope context: " <> policyCtx
result <- liftIO $ callClaudeApi
"You are a policy compliance assistant. Analyse this requirement candidate for potential policy concerns. Valid scopes: internal, external, regulatory, contractual, architectural. Respond with JSON: {\"concerns\": [{\"scope\": \"...\", \"note\": \"...\"}], \"severity\": \"low|medium|high\"}."
userMsg
500
case result of
Left err -> do
setErrorMessage ("Policy check failed: " <> err)
redirectTo ShowRequirementCandidateAction { requirementCandidateId }
Right content -> do
let confidenceScore = extractSeverityScore content
proposal <- newRecord @AgentProposal
|> set #proposalType "policy_flag"
|> set #sourceCandidateId (Just requirementCandidateId)
|> set #content content
|> set #modelRef "claude-sonnet-4-6"
|> set #confidence (Just confidenceScore)
|> set #status "pending"
|> createRecord
-- Create one ConfidenceAnnotation per concern scope
let mParsed = decode (fromStrict (encodeUtf8 content))
:: Maybe (HashMap Text Value)
case mParsed >>= HashMap.lookup "concerns" of
Just (Array concerns) ->
forM_ (Vector.toList concerns) \concern ->
case (concern ^? key "scope" . _String
,concern ^? key "note" . _String) of
(Just scope, noteM) ->
newRecord @ConfidenceAnnotation
|> set #proposalId proposal.id
|> set #dimension scope
|> set #score confidenceScore
|> set #explanation noteM
|> createRecord
_ -> pure ()
_ -> pure ()
setSuccessMessage "Policy check proposal created"
redirectTo ShowRequirementCandidateAction { requirementCandidateId }
-- Map severity string to numeric confidence
extractSeverityScore :: Text -> Double
extractSeverityScore content
| "\"high\"" `isInfixOf` content = 0.9
| "\"medium\"" `isInfixOf` content = 0.6
| otherwise = 0.3

View File

@@ -9,7 +9,8 @@ import Generated.Types
import IHP.Prelude
import IHP.ControllerPrelude
import Data.Aeson (toJSON, object, (.=))
import Application.Helper.Controller (isInRegression, widgetCycleCounts)
import Application.Helper.Controller (isInRegression, widgetCycleCounts, callClaudeApi)
import Data.List (intercalate)
instance Controller WidgetsController where
beforeAction = ensureIsUser
@@ -121,3 +122,65 @@ instance Controller WidgetsController where
|> createRecord
setSuccessMessage "Widget updated"
redirectTo ShowWidgetAction { widgetId = widget.id }
-- T03: Summarize feedback cluster via Claude API
action SummarizeClusterAction { widgetId } = do
annotations <- query @Annotation
|> filterWhere (#widgetId, widgetId)
|> orderByDesc #createdAt
|> limit 20
|> fetch
threads <- query @AnnotationThread
|> filterWhere (#widgetId, widgetId)
|> orderByDesc #createdAt
|> limit 20
|> fetch
let annLines = map (\a -> "[" <> a.category <> "/" <> a.severity <> "] " <> a.body) annotations
threadLines = map (\t -> "[thread] " <> t.title <> ": " <> fromMaybe "" t.description) threads
userMsg = intercalate "\n" (annLines <> threadLines)
result <- liftIO $ callClaudeApi
"You are a distillation assistant for a governed interaction hub. Summarize the following user feedback cluster into a concise, actionable summary (2\x20134 sentences). Be factual and neutral."
userMsg
300
case result of
Left err -> do
setErrorMessage ("AI summarization failed: " <> err)
redirectTo ShowWidgetAction { widgetId }
Right content -> do
newRecord @AgentProposal
|> set #proposalType "summary"
|> set #sourceWidgetId (Just widgetId)
|> set #content content
|> set #modelRef "claude-sonnet-4-6"
|> set #status "pending"
|> createRecord
setSuccessMessage "Summary proposal created"
redirectTo ShowWidgetAction { widgetId }
-- T04: Draft a requirement candidate via Claude API
action DraftRequirementAction { widgetId } = do
annotations <- query @Annotation
|> filterWhere (#widgetId, widgetId)
|> orderByDesc #createdAt
|> limit 20
|> fetch
let annLines = map (\a -> "[" <> a.category <> "/" <> a.severity <> "] " <> a.body) annotations
userMsg = intercalate "\n" annLines
result <- liftIO $ callClaudeApi
"You are a requirements analyst. Given these friction annotations, draft a single structured requirement candidate. Respond with JSON: {\"title\": \"...\", \"description\": \"...\"}."
userMsg
400
case result of
Left err -> do
setErrorMessage ("AI draft failed: " <> err)
redirectTo ShowWidgetAction { widgetId }
Right content -> do
newRecord @AgentProposal
|> set #proposalType "requirement_draft"
|> set #sourceWidgetId (Just widgetId)
|> set #content content
|> set #modelRef "claude-sonnet-4-6"
|> set #status "pending"
|> createRecord
setSuccessMessage "Requirement draft proposal created"
redirectTo ShowWidgetAction { widgetId }

View File

@@ -16,6 +16,7 @@ import Web.Controller.RequirementCandidates ()
import Web.Controller.Requirements ()
import Web.Controller.DecisionRecords ()
import Web.Controller.DeploymentRecords ()
import Web.Controller.AgentProposals ()
import Web.Controller.Sessions ()
instance FrontController WebApplication where
@@ -30,6 +31,7 @@ instance FrontController WebApplication where
, parseRoute @RequirementsController
, parseRoute @DecisionRecordsController
, parseRoute @DeploymentRecordsController
, parseRoute @AgentProposalsController
]
instance InitControllerContext WebApplication where
@@ -59,6 +61,7 @@ defaultLayout inner = [hsx|
<a href={RequirementsAction} class="text-sm text-gray-600 hover:text-gray-900">Requirements</a>
<a href={DecisionRecordsAction} class="text-sm text-gray-600 hover:text-gray-900">Decisions</a>
<a href={DeploymentRecordsAction} class="text-sm text-gray-600 hover:text-gray-900">Deployments</a>
<a href={AgentProposalsAction} class="text-sm text-gray-600 hover:text-gray-900">Agent</a>
<div class="ml-auto">
<a href={DeleteSessionAction} class="text-sm text-gray-500 hover:text-gray-700">Sign out</a>
</div>

View File

@@ -31,5 +31,8 @@ instance AutoRoute DecisionRecordsController
-- Deployment Records (Phase 4)
instance AutoRoute DeploymentRecordsController
-- Agent Proposals (Phase 5)
instance AutoRoute AgentProposalsController
-- Sessions
instance AutoRoute SessionsController

View File

@@ -26,6 +26,7 @@ data HubsController
| TriageDashboardAction { hubId :: !(Id Hub) }
| GovernanceDashboardAction { hubId :: !(Id Hub) }
| AntifragilityDashboardAction { hubId :: !(Id Hub) }
| AgentAuditDashboardAction { hubId :: !(Id Hub) }
deriving (Eq, Show, Data)
data WidgetsController
@@ -33,8 +34,10 @@ data WidgetsController
| NewWidgetAction
| ShowWidgetAction { widgetId :: !(Id Widget) }
| CreateWidgetAction
| EditWidgetAction { widgetId :: !(Id Widget) }
| UpdateWidgetAction { widgetId :: !(Id Widget) }
| EditWidgetAction { widgetId :: !(Id Widget) }
| UpdateWidgetAction { widgetId :: !(Id Widget) }
| SummarizeClusterAction { widgetId :: !(Id Widget) }
| DraftRequirementAction { widgetId :: !(Id Widget) }
deriving (Eq, Show, Data)
data InteractionEventsController
@@ -67,8 +70,10 @@ data RequirementCandidatesController
| UpdateTriageStatusAction { requirementCandidateId :: !(Id RequirementCandidate) }
| AssignReviewerAction { requirementCandidateId :: !(Id RequirementCandidate) }
| MyQueueAction
| PromoteToRequirementAction { requirementCandidateId :: !(Id RequirementCandidate) }
| LinkToDecisionAction { requirementCandidateId :: !(Id RequirementCandidate) }
| PromoteToRequirementAction { requirementCandidateId :: !(Id RequirementCandidate) }
| LinkToDecisionAction { requirementCandidateId :: !(Id RequirementCandidate) }
| DetectDuplicatesAction { requirementCandidateId :: !(Id RequirementCandidate) }
| DetectPolicySensitivityAction { requirementCandidateId :: !(Id RequirementCandidate) }
deriving (Eq, Show, Data)
data RequirementsController
@@ -87,6 +92,7 @@ data DecisionRecordsController
| DeletePolicyReferenceAction { policyReferenceId :: !(Id PolicyReference) }
| AddImplementationRefAction { decisionRecordId :: !(Id DecisionRecord) }
| DeleteImplementationRefAction { implementationChangeReferenceId :: !(Id ImplementationChangeReference) }
| ProposeImplementationAction { decisionRecordId :: !(Id DecisionRecord) }
deriving (Eq, Show, Data)
data DeploymentRecordsController
@@ -98,6 +104,13 @@ data DeploymentRecordsController
| EvaluateChangeAction { deploymentRecordId :: !(Id DeploymentRecord) }
deriving (Eq, Show, Data)
data AgentProposalsController
= AgentProposalsAction
| ShowAgentProposalAction { agentProposalId :: !(Id AgentProposal) }
| AcceptProposalAction { agentProposalId :: !(Id AgentProposal) }
| RejectProposalAction { agentProposalId :: !(Id AgentProposal) }
deriving (Eq, Show, Data)
data SessionsController
= NewSessionAction
| CreateSessionAction

View File

@@ -0,0 +1,138 @@
module Web.View.AgentProposals.Index where
import Web.Types
import Generated.Types
import IHP.Prelude
import IHP.ViewPrelude
data IndexView = IndexView
{ proposals :: ![AgentProposal]
, widgets :: ![Widget]
, mTypeFilter :: !(Maybe Text)
, mStatusFilter :: !(Maybe Text)
}
allProposalTypes :: [Text]
allProposalTypes = ["summary", "requirement_draft", "duplicate_flag", "policy_flag", "impl_proposal"]
allStatuses :: [Text]
allStatuses = ["pending", "accepted", "rejected", "superseded"]
instance View IndexView where
html IndexView { .. } = [hsx|
<div class="flex items-center justify-between mb-6">
<h1 class="text-2xl font-semibold">Agent Proposals</h1>
</div>
<!-- Filters -->
<div class="flex gap-4 mb-5 flex-wrap">
<div class="flex gap-1 text-sm flex-wrap">
<span class="text-gray-400 text-xs self-center mr-1">Type:</span>
<a href={agentProposalsUrl Nothing mStatusFilter}
class={typeTabClass Nothing mTypeFilter}>All</a>
{forEach allProposalTypes (\t -> [hsx|
<a href={agentProposalsUrl (Just t) mStatusFilter}
class={typeTabClass (Just t) mTypeFilter}>{t}</a>
|])}
</div>
<div class="flex gap-1 text-sm flex-wrap">
<span class="text-gray-400 text-xs self-center mr-1">Status:</span>
<a href={agentProposalsUrl mTypeFilter Nothing}
class={typeTabClass Nothing mStatusFilter}>All</a>
{forEach allStatuses (\s -> [hsx|
<a href={agentProposalsUrl mTypeFilter (Just s)}
class={typeTabClass (Just s) mStatusFilter}>{s}</a>
|])}
</div>
</div>
{if null proposals
then [hsx|<p class="text-sm text-gray-400">No proposals found.</p>|]
else renderTable proposals widgets}
|]
agentProposalsUrl :: Maybe Text -> Maybe Text -> Text
agentProposalsUrl mt ms =
let parts = catMaybes
[ fmap ("proposal_type=" <>) mt
, fmap ("status=" <>) ms
]
in "/AgentProposals" <> if null parts then "" else "?" <> intercalate "&" parts
renderTable :: [AgentProposal] -> [Widget] -> Html
renderTable proposals widgets = [hsx|
<div class="bg-white rounded-lg border border-gray-200 overflow-hidden">
<table class="w-full text-sm">
<thead class="bg-gray-50 border-b border-gray-200">
<tr>
<th class="text-left px-4 py-3 font-medium text-gray-600">Type</th>
<th class="text-left px-4 py-3 font-medium text-gray-600">Source Widget</th>
<th class="text-left px-4 py-3 font-medium text-gray-600">Confidence</th>
<th class="text-left px-4 py-3 font-medium text-gray-600">Status</th>
<th class="text-left px-4 py-3 font-medium text-gray-600">Created</th>
</tr>
</thead>
<tbody class="divide-y divide-gray-100">
{forEach proposals (renderRow widgets)}
</tbody>
</table>
</div>
|]
renderRow :: [Widget] -> AgentProposal -> Html
renderRow widgets p = [hsx|
<tr class="hover:bg-gray-50">
<td class="px-4 py-3">
<a href={ShowAgentProposalAction { agentProposalId = p.id }}
class={proposalTypeBadge p.proposalType <> " text-xs px-2 py-0.5 rounded font-medium"}>
{p.proposalType}
</a>
</td>
<td class="px-4 py-3 text-gray-600">{widgetName widgets p.sourceWidgetId}</td>
<td class="px-4 py-3">{renderConfidenceBar p.confidence}</td>
<td class="px-4 py-3">
<span class={statusBadge p.status <> " text-xs px-2 py-0.5 rounded font-medium"}>
{p.status}
</span>
</td>
<td class="px-4 py-3 text-gray-400 text-xs">{show p.createdAt}</td>
</tr>
|]
widgetName :: [Widget] -> Maybe (Id Widget) -> Text
widgetName _ Nothing = ""
widgetName widgets (Just wid) = maybe "(unknown)" (.name) (find (\w -> w.id == wid) widgets)
renderConfidenceBar :: Maybe Double -> Html
renderConfidenceBar Nothing = [hsx|<span class="text-gray-300 text-xs"></span>|]
renderConfidenceBar (Just c) =
let pct = show (round (c * 100) :: Int) <> "%"
barWidth = "width: " <> pct
in [hsx|
<div class="flex items-center gap-2">
<div class="w-16 bg-gray-100 rounded h-1.5">
<div class="bg-indigo-400 rounded h-1.5" style={barWidth}></div>
</div>
<span class="text-xs text-gray-500">{pct}</span>
</div>
|]
proposalTypeBadge :: Text -> Text
proposalTypeBadge "summary" = "bg-blue-100 text-blue-800"
proposalTypeBadge "requirement_draft" = "bg-indigo-100 text-indigo-800"
proposalTypeBadge "duplicate_flag" = "bg-orange-100 text-orange-800"
proposalTypeBadge "policy_flag" = "bg-red-100 text-red-800"
proposalTypeBadge "impl_proposal" = "bg-green-100 text-green-800"
proposalTypeBadge _ = "bg-gray-100 text-gray-600"
statusBadge :: Text -> Text
statusBadge "pending" = "bg-yellow-100 text-yellow-800"
statusBadge "accepted" = "bg-green-100 text-green-800"
statusBadge "rejected" = "bg-red-100 text-red-800"
statusBadge "superseded" = "bg-gray-100 text-gray-500"
statusBadge _ = "bg-gray-100 text-gray-600"
typeTabClass :: Maybe Text -> Maybe Text -> Text
typeTabClass a b
| a == b = "px-3 py-1 rounded bg-indigo-100 text-indigo-700 font-medium text-xs"
| otherwise = "px-3 py-1 rounded text-gray-600 hover:bg-gray-100 text-xs"

View File

@@ -0,0 +1,165 @@
module Web.View.AgentProposals.Show where
import Web.Types
import Generated.Types
import IHP.Prelude
import IHP.ViewPrelude
data ShowView = ShowView
{ proposal :: !AgentProposal
, mWidget :: !(Maybe Widget)
, mCandidate :: !(Maybe RequirementCandidate)
, mDecision :: !(Maybe DecisionRecord)
, mReview :: !(Maybe AgentReviewRecord)
, confidences :: ![ConfidenceAnnotation]
, users :: ![User]
}
instance View ShowView where
html ShowView { .. } = [hsx|
<div class="mb-4">
<a href={AgentProposalsAction} class="text-sm text-indigo-600 hover:underline"> Agent Proposals</a>
</div>
<div class="flex items-start justify-between mb-6">
<div class="flex items-center gap-3">
<span class={proposalTypeBadge proposal.proposalType <> " text-sm px-2 py-1 rounded font-medium"}>
{proposal.proposalType}
</span>
<span class={statusBadge proposal.status <> " text-sm px-2 py-1 rounded font-medium"}>
{proposal.status}
</span>
</div>
</div>
<!-- Content panel -->
<div class="bg-white rounded-lg border border-gray-200 p-5 mb-5">
<h2 class="text-sm font-semibold text-gray-700 mb-2">AI Output</h2>
<pre class="text-sm text-gray-800 whitespace-pre-wrap font-mono bg-gray-50 rounded p-4">{proposal.content}</pre>
</div>
<!-- Confidence breakdown -->
{if null confidences then mempty else renderConfidences confidences}
<!-- Source context -->
<div class="bg-white rounded-lg border border-gray-200 p-5 mb-5">
<h2 class="text-sm font-semibold text-gray-700 mb-3">Source Context</h2>
<dl class="grid grid-cols-2 gap-3 text-sm">
<dt class="text-gray-500">Widget</dt>
<dd>{maybe "" (.name) mWidget}</dd>
<dt class="text-gray-500">Candidate</dt>
<dd>{maybe "" (.title) mCandidate}</dd>
<dt class="text-gray-500">Decision</dt>
<dd>{maybe "" (.title) mDecision}</dd>
</dl>
</div>
<!-- Review section -->
{case mReview of
Just review -> renderExistingReview review users
Nothing -> renderReviewForm proposal.id proposal.status}
<!-- Attribution footer -->
<div class="text-xs text-gray-400 mt-4 border-t pt-3">
Model: <span class="font-mono">{proposal.modelRef}</span>
· Created: {show proposal.createdAt}
</div>
|]
renderConfidences :: [ConfidenceAnnotation] -> Html
renderConfidences cs = [hsx|
<div class="bg-white rounded-lg border border-gray-200 p-5 mb-5">
<h2 class="text-sm font-semibold text-gray-700 mb-3">Confidence Breakdown</h2>
<div class="space-y-3">
{forEach cs renderConfidenceRow}
</div>
</div>
|]
renderConfidenceRow :: ConfidenceAnnotation -> Html
renderConfidenceRow c =
let pct = show (round (c.score * 100) :: Int) <> "%"
barWidth = "width: " <> pct
in [hsx|
<div>
<div class="flex justify-between text-xs mb-1">
<span class="text-gray-600">{c.dimension}</span>
<span class="text-gray-500">{pct}</span>
</div>
<div class="w-full bg-gray-100 rounded h-2">
<div class="bg-indigo-400 rounded h-2" style={barWidth}></div>
</div>
{maybe mempty (\e -> [hsx|<p class="text-xs text-gray-400 mt-0.5">{e}</p>|]) c.explanation}
</div>
|]
renderExistingReview :: AgentReviewRecord -> [User] -> Html
renderExistingReview review users = [hsx|
<div class="bg-gray-50 rounded-lg border border-gray-200 p-5 mb-5">
<h2 class="text-sm font-semibold text-gray-700 mb-2">Review Decision</h2>
<div class="flex items-center gap-3 mb-2">
<span class={decisionBadge review.decision <> " text-sm px-2 py-1 rounded font-medium"}>
{review.decision}
</span>
<span class="text-xs text-gray-400">by {reviewerName users review.reviewerId} at {show review.reviewedAt}</span>
</div>
{maybe mempty (\n -> [hsx|<p class="text-sm text-gray-600">{n}</p>|]) review.notes}
</div>
|]
renderReviewForm :: Id AgentProposal -> Text -> Html
renderReviewForm pid status
| status /= "pending" = mempty
| otherwise = [hsx|
<div class="bg-white rounded-lg border border-gray-200 p-5 mb-5">
<h2 class="text-sm font-semibold text-gray-700 mb-3">Review This Proposal</h2>
<div class="mb-3">
<label class="block text-xs text-gray-500 mb-1">Notes (optional)</label>
<textarea id="review-notes" name="notes" rows="2"
class="w-full border border-gray-300 rounded px-3 py-2 text-sm"></textarea>
</div>
<div class="flex gap-3">
<form method="POST" action={AcceptProposalAction { agentProposalId = pid }}
onsubmit="document.getElementById('accept-notes').value = document.getElementById('review-notes').value">
<input type="hidden" name="notes" id="accept-notes" />
<button type="submit"
class="bg-green-600 text-white text-sm px-4 py-2 rounded hover:bg-green-700">
Accept
</button>
</form>
<form method="POST" action={RejectProposalAction { agentProposalId = pid }}
onsubmit="document.getElementById('reject-notes').value = document.getElementById('review-notes').value">
<input type="hidden" name="notes" id="reject-notes" />
<button type="submit"
class="bg-red-600 text-white text-sm px-4 py-2 rounded hover:bg-red-700">
Reject
</button>
</form>
</div>
</div>
|]
reviewerName :: [User] -> Maybe (Id User) -> Text
reviewerName _ Nothing = "unknown"
reviewerName users (Just uid) = maybe "(unknown)" (.name) (find (\u -> u.id == uid) users)
proposalTypeBadge :: Text -> Text
proposalTypeBadge "summary" = "bg-blue-100 text-blue-800"
proposalTypeBadge "requirement_draft" = "bg-indigo-100 text-indigo-800"
proposalTypeBadge "duplicate_flag" = "bg-orange-100 text-orange-800"
proposalTypeBadge "policy_flag" = "bg-red-100 text-red-800"
proposalTypeBadge "impl_proposal" = "bg-green-100 text-green-800"
proposalTypeBadge _ = "bg-gray-100 text-gray-600"
statusBadge :: Text -> Text
statusBadge "pending" = "bg-yellow-100 text-yellow-800"
statusBadge "accepted" = "bg-green-100 text-green-800"
statusBadge "rejected" = "bg-red-100 text-red-800"
statusBadge "superseded" = "bg-gray-100 text-gray-500"
statusBadge _ = "bg-gray-100 text-gray-600"
decisionBadge :: Text -> Text
decisionBadge "accepted" = "bg-green-100 text-green-800"
decisionBadge "rejected" = "bg-red-100 text-red-800"
decisionBadge "modified" = "bg-blue-100 text-blue-800"
decisionBadge _ = "bg-gray-100 text-gray-600"

View File

@@ -114,7 +114,14 @@ instance View ShowView where
<!-- Implementation references -->
<div class="bg-white rounded-lg border border-gray-200 px-6 py-4">
<h2 class="text-sm font-semibold text-gray-700 mb-3">Implementation References</h2>
<div class="flex items-center justify-between mb-3">
<h2 class="text-sm font-semibold text-gray-700">Implementation References</h2>
<form method="POST" action={ProposeImplementationAction { decisionRecordId = record.id }} class="inline">
<button type="submit" class="text-xs border border-green-300 text-green-700 px-2 py-1 rounded hover:bg-green-50">
Propose Implementation
</button>
</form>
</div>
{forEach implRefs renderImplRef}
<form method="POST" action={AddImplementationRefAction { decisionRecordId = record.id }}
class="mt-3 flex items-end gap-2">

View File

@@ -0,0 +1,191 @@
module Web.View.Hubs.AgentAuditDashboard where
import Web.Types
import Generated.Types
import IHP.Prelude
import IHP.ViewPrelude
data AgentAuditDashboardView = AgentAuditDashboardView
{ hub :: !Hub
, proposals :: ![AgentProposal]
, reviews :: ![AgentReviewRecord]
, widgets :: ![Widget]
}
instance View AgentAuditDashboardView where
html AgentAuditDashboardView { .. } = [hsx|
<div class="flex items-center justify-between mb-6">
<div>
<h1 class="text-2xl font-semibold">Agent Audit Dashboard</h1>
<p class="text-sm text-gray-500">{hub.name}</p>
</div>
<a href={ShowHubAction { hubId = hub.id }}
class="text-sm text-indigo-600 hover:underline"> Hub</a>
</div>
<!-- KPI row -->
<div class="grid grid-cols-4 gap-4 mb-6">
{kpiCard "Total Proposals" (show totalProposals) "text-gray-800"}
{kpiCard "Pending" (show pendingCount) "text-yellow-700"}
{kpiCard "Acceptance Rate" (showPct acceptanceRate) "text-green-700"}
{kpiCard "Rejection Rate" (showPct rejectionRate) "text-red-700"}
</div>
<!-- Proposals by type -->
<div class="bg-white rounded-lg border border-gray-200 p-5 mb-5">
<h2 class="text-sm font-semibold text-gray-700 mb-3">Proposals by Type</h2>
<div class="flex gap-4 flex-wrap">
{forEach allTypes (\t ->
let cnt = length (filter (\p -> p.proposalType == t) proposals)
in [hsx|
<div class="flex items-center gap-2">
<span class={typeBadge t <> " text-xs px-2 py-0.5 rounded font-medium"}>{t}</span>
<span class="text-sm font-semibold text-gray-700">{show cnt}</span>
</div>
|])}
</div>
</div>
<!-- Unreviewed queue -->
<div class="bg-white rounded-lg border border-gray-200 overflow-hidden mb-5">
<div class="px-5 py-3 border-b border-gray-100 bg-yellow-50">
<h2 class="text-sm font-semibold text-yellow-800">Unreviewed Queue ({show pendingCount})</h2>
</div>
{if null pending
then [hsx|<p class="text-sm text-gray-400 px-5 py-4">No pending proposals.</p>|]
else [hsx|
<table class="w-full text-sm">
<tbody class="divide-y divide-gray-100">
{forEach (sortByCreatedAt pending) renderQueueRow}
</tbody>
</table>
|]}
</div>
<!-- Recent proposals (last 20) -->
<div class="bg-white rounded-lg border border-gray-200 overflow-hidden mb-5">
<div class="px-5 py-3 border-b border-gray-100">
<h2 class="text-sm font-semibold text-gray-700">Recent Proposals (last 20)</h2>
</div>
<table class="w-full text-sm">
<thead class="bg-gray-50 border-b border-gray-200">
<tr>
<th class="text-left px-4 py-2 font-medium text-gray-600 text-xs">Type</th>
<th class="text-left px-4 py-2 font-medium text-gray-600 text-xs">Source Widget</th>
<th class="text-left px-4 py-2 font-medium text-gray-600 text-xs">Status</th>
<th class="text-left px-4 py-2 font-medium text-gray-600 text-xs">Confidence</th>
<th class="text-left px-4 py-2 font-medium text-gray-600 text-xs">Age</th>
</tr>
</thead>
<tbody class="divide-y divide-gray-100">
{forEach recent (renderRecentRow widgets)}
</tbody>
</table>
</div>
<!-- Attribution log: model_ref x proposal_type matrix -->
<div class="bg-white rounded-lg border border-gray-200 p-5">
<h2 class="text-sm font-semibold text-gray-700 mb-3">Attribution Log (model × type)</h2>
<table class="text-xs">
<thead>
<tr>
<th class="text-left px-3 py-1 text-gray-500">Model</th>
{forEach allTypes (\t -> [hsx|
<th class="px-3 py-1 text-gray-500">{t}</th>
|])}
</tr>
</thead>
<tbody>
{forEach allModels (\m -> [hsx|
<tr class="border-t border-gray-100">
<td class="px-3 py-1 font-mono text-gray-600">{m}</td>
{forEach allTypes (\t ->
let cnt = length (filter (\p -> p.modelRef == m && p.proposalType == t) proposals)
in [hsx|<td class="px-3 py-1 text-center text-gray-700">{if cnt == 0 then "" else show cnt}</td>|])}
</tr>
|])}
</tbody>
</table>
</div>
|]
where
totalProposals = length proposals
pending = filter (\p -> p.status == "pending") proposals
pendingCount = length pending
accepted = filter (\r -> r.decision == "accepted") reviews
rejected = filter (\r -> r.decision == "rejected") reviews
reviewed = length accepted + length rejected
acceptanceRate = if reviewed == 0 then 0 else fromIntegral (length accepted) / fromIntegral reviewed :: Double
rejectionRate = if reviewed == 0 then 0 else fromIntegral (length rejected) / fromIntegral reviewed :: Double
recent = take 20 proposals
allTypes = ["summary", "requirement_draft", "duplicate_flag", "policy_flag", "impl_proposal"]
allModels = nub (map (.modelRef) proposals)
kpiCard :: Text -> Text -> Text -> Html
kpiCard label value colorClass = [hsx|
<div class="bg-white rounded-lg border border-gray-200 p-4">
<p class="text-xs text-gray-500 mb-1">{label}</p>
<p class={"text-2xl font-bold " <> colorClass}>{value}</p>
</div>
|]
renderQueueRow :: AgentProposal -> Html
renderQueueRow p = [hsx|
<tr class="hover:bg-gray-50">
<td class="px-4 py-2">
<span class={typeBadge p.proposalType <> " text-xs px-2 py-0.5 rounded font-medium"}>
{p.proposalType}
</span>
</td>
<td class="px-4 py-2 text-gray-400 text-xs">{show p.createdAt}</td>
<td class="px-4 py-2">
<a href={ShowAgentProposalAction { agentProposalId = p.id }}
class="text-xs text-indigo-600 hover:underline">Review </a>
</td>
</tr>
|]
renderRecentRow :: [Widget] -> AgentProposal -> Html
renderRecentRow widgets p = [hsx|
<tr class="hover:bg-gray-50">
<td class="px-4 py-2">
<a href={ShowAgentProposalAction { agentProposalId = p.id }}
class={typeBadge p.proposalType <> " text-xs px-2 py-0.5 rounded font-medium"}>
{p.proposalType}
</a>
</td>
<td class="px-4 py-2 text-gray-600 text-xs">{widgetName widgets p.sourceWidgetId}</td>
<td class="px-4 py-2">
<span class={statusBadge p.status <> " text-xs px-2 py-0.5 rounded"}>
{p.status}
</span>
</td>
<td class="px-4 py-2 text-gray-500 text-xs">{maybe "" (\c -> show (round (c * 100) :: Int) <> "%") p.confidence}</td>
<td class="px-4 py-2 text-gray-400 text-xs">{show p.createdAt}</td>
</tr>
|]
widgetName :: [Widget] -> Maybe (Id Widget) -> Text
widgetName _ Nothing = ""
widgetName widgets (Just wid) = maybe "" (.name) (find (\w -> w.id == wid) widgets)
sortByCreatedAt :: [AgentProposal] -> [AgentProposal]
sortByCreatedAt = sortBy (\a b -> compare a.createdAt b.createdAt)
showPct :: Double -> Text
showPct d = show (round (d * 100) :: Int) <> "%"
typeBadge :: Text -> Text
typeBadge "summary" = "bg-blue-100 text-blue-800"
typeBadge "requirement_draft" = "bg-indigo-100 text-indigo-800"
typeBadge "duplicate_flag" = "bg-orange-100 text-orange-800"
typeBadge "policy_flag" = "bg-red-100 text-red-800"
typeBadge "impl_proposal" = "bg-green-100 text-green-800"
typeBadge _ = "bg-gray-100 text-gray-600"
statusBadge :: Text -> Text
statusBadge "pending" = "bg-yellow-100 text-yellow-800"
statusBadge "accepted" = "bg-green-100 text-green-800"
statusBadge "rejected" = "bg-red-100 text-red-800"
statusBadge "superseded" = "bg-gray-100 text-gray-500"
statusBadge _ = "bg-gray-100 text-gray-600"

View File

@@ -41,6 +41,10 @@ instance View ShowView where
class="text-sm border border-green-300 text-green-700 px-3 py-1.5 rounded hover:bg-green-50">
Antifragility
</a>
<a href={AgentAuditDashboardAction { hubId = hub.id }}
class="text-sm border border-purple-300 text-purple-700 px-3 py-1.5 rounded hover:bg-purple-50">
Agent Audit
</a>
<a href={EditHubAction { hubId = hub.id }}
class="text-sm border border-gray-300 px-3 py-1.5 rounded hover:bg-gray-50">
Edit

View File

@@ -28,7 +28,17 @@ instance View ShowView where
<div class="bg-white rounded-lg border border-gray-200 px-6 py-5">
<div class="flex items-start justify-between mb-3">
<h1 class="text-2xl font-semibold">{candidate.title}</h1>
<div class="flex gap-2 ml-4">
<div class="flex gap-2 ml-4 flex-wrap">
<form method="POST" action={DetectDuplicatesAction { requirementCandidateId = candidate.id }} class="inline">
<button type="submit" class="text-sm border border-orange-300 text-orange-700 px-3 py-1.5 rounded hover:bg-orange-50">
Check Duplicates
</button>
</form>
<form method="POST" action={DetectPolicySensitivityAction { requirementCandidateId = candidate.id }} class="inline">
<button type="submit" class="text-sm border border-red-300 text-red-700 px-3 py-1.5 rounded hover:bg-red-50">
Policy Check
</button>
</form>
<a href={EditRequirementCandidateAction { requirementCandidateId = candidate.id }}
class="text-sm border border-gray-300 px-3 py-1.5 rounded hover:bg-gray-50">
Edit

View File

@@ -82,8 +82,22 @@ instance View ShowView where
<section>
<div class="flex items-center justify-between mb-3">
<h2 class="text-lg font-medium">Annotations</h2>
<a href={NewAnnotationAction { widgetId = widget.id }}
class="text-sm text-indigo-600 hover:text-indigo-800">+ Add</a>
<div class="flex items-center gap-2">
{if length annotations >= 3 then [hsx|
<form method="POST" action={DraftRequirementAction { widgetId = widget.id }} class="inline">
<button type="submit" class="text-xs border border-indigo-300 text-indigo-700 px-2 py-1 rounded hover:bg-indigo-50">
Draft Requirement
</button>
</form>
|] else mempty}
<form method="POST" action={SummarizeClusterAction { widgetId = widget.id }} class="inline">
<button type="submit" class="text-xs border border-blue-300 text-blue-700 px-2 py-1 rounded hover:bg-blue-50">
Summarize Feedback
</button>
</form>
<a href={NewAnnotationAction { widgetId = widget.id }}
class="text-sm text-indigo-600 hover:text-indigo-800">+ Add</a>
</div>
</div>
<div class="space-y-2">
{forEach rootAnnotations (renderAnnotation childrenOf)}