generated from coulomb/repo-seed
feat(P5): IHF Phase 5 complete — agent-assisted distillation
Some checks failed
Test / test (push) Has been cancelled
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:
@@ -5,6 +5,14 @@ import Generated.Types
|
||||
import Data.Time.Clock (addUTCTime)
|
||||
import Data.List (sortBy)
|
||||
|
||||
-- Phase 5: Anthropic API
|
||||
import Network.HTTP.Conduit (newManager, tlsManagerSettings, parseRequest, httpLbs, responseBody, method, requestHeaders, requestBody, RequestBodyLBS(..))
|
||||
import Data.Aeson (object, (.=), encode, eitherDecode, Value)
|
||||
import Data.Aeson.Lens (key, _String, nth)
|
||||
import Control.Lens ((^?))
|
||||
import Data.String.Conversions (cs)
|
||||
import System.Environment (lookupEnv)
|
||||
|
||||
-- Here you can add functions which are available in all your controllers
|
||||
|
||||
-- | Returns the set of widget IDs that are currently in regression.
|
||||
@@ -68,4 +76,53 @@ widgetCycleCounts candidates requirements decisions deployments =
|
||||
[ ()
|
||||
| deplTime <- deplTimes
|
||||
, any (\c -> c.createdAt > deplTime) widCandidates
|
||||
]
|
||||
]
|
||||
|
||||
-- | Call the Anthropic Messages API.
|
||||
--
|
||||
-- Returns the text content of the first content block, or an error message.
|
||||
-- API key read from IHP_ANTHROPIC_API_KEY env var.
|
||||
-- On any error (missing key, HTTP failure, unexpected JSON) returns Left with a description.
|
||||
callClaudeApi
|
||||
:: Text -- ^ system prompt
|
||||
-> Text -- ^ user message
|
||||
-> Int -- ^ max_tokens
|
||||
-> IO (Either Text Text)
|
||||
callClaudeApi systemPrompt userMessage maxTokens = do
|
||||
mApiKey <- lookupEnv "IHP_ANTHROPIC_API_KEY"
|
||||
case mApiKey of
|
||||
Nothing -> pure (Left "IHP_ANTHROPIC_API_KEY is not set")
|
||||
Just apiKey -> do
|
||||
let url = "https://api.anthropic.com/v1/messages"
|
||||
let body = object
|
||||
[ "model" .= ("claude-sonnet-4-6" :: Text)
|
||||
, "max_tokens" .= maxTokens
|
||||
, "system" .= systemPrompt
|
||||
, "messages" .= [ object
|
||||
[ "role" .= ("user" :: Text)
|
||||
, "content" .= userMessage
|
||||
] ]
|
||||
]
|
||||
let reqBody = RequestBodyLBS (encode body)
|
||||
manager <- newManager tlsManagerSettings
|
||||
initReq <- parseRequest url
|
||||
let req = initReq
|
||||
{ method = "POST"
|
||||
, requestHeaders =
|
||||
[ ("content-type", "application/json")
|
||||
, ("x-api-key", cs apiKey)
|
||||
, ("anthropic-version", "2023-06-01")
|
||||
]
|
||||
, requestBody = reqBody
|
||||
}
|
||||
resp <- httpLbs req manager
|
||||
let respBody = responseBody resp
|
||||
case eitherDecode respBody of
|
||||
Left err -> pure (Left ("JSON parse error: " <> cs err))
|
||||
Right val ->
|
||||
case val ^? key "content" . nth 0 . key "text" . _String of
|
||||
Just txt -> pure (Right txt)
|
||||
Nothing ->
|
||||
case val ^? key "error" . key "message" . _String of
|
||||
Just msg -> pure (Left ("API error: " <> msg))
|
||||
Nothing -> pure (Left "Unexpected API response shape")
|
||||
|
||||
@@ -0,0 +1,44 @@
|
||||
-- Phase 5: Agent-Assisted Distillation and Suggestion
|
||||
-- AgentProposal, AgentReviewRecord, ConfidenceAnnotation
|
||||
|
||||
CREATE TABLE agent_proposals (
|
||||
id UUID DEFAULT uuid_generate_v4() PRIMARY KEY NOT NULL,
|
||||
proposal_type TEXT NOT NULL,
|
||||
source_widget_id UUID REFERENCES widgets(id) ON DELETE SET NULL,
|
||||
source_candidate_id UUID REFERENCES requirement_candidates(id) ON DELETE SET NULL,
|
||||
source_thread_id UUID REFERENCES annotation_threads(id) ON DELETE SET NULL,
|
||||
source_decision_id UUID REFERENCES decision_records(id) ON DELETE SET NULL,
|
||||
content TEXT NOT NULL,
|
||||
model_ref TEXT NOT NULL,
|
||||
confidence NUMERIC CHECK (confidence BETWEEN 0 AND 1),
|
||||
status TEXT NOT NULL DEFAULT 'pending',
|
||||
created_at TIMESTAMP WITH TIME ZONE DEFAULT now() NOT NULL
|
||||
);
|
||||
|
||||
CREATE INDEX agent_proposals_proposal_type_idx ON agent_proposals (proposal_type);
|
||||
CREATE INDEX agent_proposals_status_idx ON agent_proposals (status);
|
||||
CREATE INDEX agent_proposals_source_widget_id_idx ON agent_proposals (source_widget_id);
|
||||
CREATE INDEX agent_proposals_created_at_idx ON agent_proposals (created_at DESC);
|
||||
|
||||
CREATE TABLE agent_review_records (
|
||||
id UUID DEFAULT uuid_generate_v4() PRIMARY KEY NOT NULL,
|
||||
proposal_id UUID NOT NULL REFERENCES agent_proposals(id) ON DELETE CASCADE,
|
||||
reviewer_id UUID REFERENCES users(id),
|
||||
decision TEXT NOT NULL,
|
||||
notes TEXT,
|
||||
reviewed_at TIMESTAMP WITH TIME ZONE DEFAULT now() NOT NULL,
|
||||
UNIQUE (proposal_id)
|
||||
);
|
||||
|
||||
CREATE INDEX agent_review_records_proposal_id_idx ON agent_review_records (proposal_id);
|
||||
|
||||
CREATE TABLE confidence_annotations (
|
||||
id UUID DEFAULT uuid_generate_v4() PRIMARY KEY NOT NULL,
|
||||
proposal_id UUID NOT NULL REFERENCES agent_proposals(id) ON DELETE CASCADE,
|
||||
dimension TEXT NOT NULL,
|
||||
score NUMERIC NOT NULL CHECK (score BETWEEN 0 AND 1),
|
||||
explanation TEXT,
|
||||
created_at TIMESTAMP WITH TIME ZONE DEFAULT now() NOT NULL
|
||||
);
|
||||
|
||||
CREATE INDEX confidence_annotations_proposal_id_idx ON confidence_annotations (proposal_id);
|
||||
@@ -263,3 +263,52 @@ CREATE TABLE change_evaluations (
|
||||
);
|
||||
|
||||
CREATE INDEX change_evaluations_deployment_id_idx ON change_evaluations (deployment_id);
|
||||
|
||||
-- Agent proposals — AI-generated outputs awaiting human review (Phase 5)
|
||||
CREATE TABLE agent_proposals (
|
||||
id UUID DEFAULT uuid_generate_v4() PRIMARY KEY NOT NULL,
|
||||
proposal_type TEXT NOT NULL,
|
||||
-- proposal_type values: summary | requirement_draft | duplicate_flag |
|
||||
-- policy_flag | impl_proposal
|
||||
source_widget_id UUID REFERENCES widgets(id) ON DELETE SET NULL,
|
||||
source_candidate_id UUID REFERENCES requirement_candidates(id) ON DELETE SET NULL,
|
||||
source_thread_id UUID REFERENCES annotation_threads(id) ON DELETE SET NULL,
|
||||
source_decision_id UUID REFERENCES decision_records(id) ON DELETE SET NULL,
|
||||
content TEXT NOT NULL,
|
||||
model_ref TEXT NOT NULL,
|
||||
confidence NUMERIC CHECK (confidence BETWEEN 0 AND 1),
|
||||
status TEXT NOT NULL DEFAULT 'pending',
|
||||
-- status values: pending | accepted | rejected | superseded
|
||||
created_at TIMESTAMP WITH TIME ZONE DEFAULT now() NOT NULL
|
||||
);
|
||||
|
||||
CREATE INDEX agent_proposals_proposal_type_idx ON agent_proposals (proposal_type);
|
||||
CREATE INDEX agent_proposals_status_idx ON agent_proposals (status);
|
||||
CREATE INDEX agent_proposals_source_widget_id_idx ON agent_proposals (source_widget_id);
|
||||
CREATE INDEX agent_proposals_created_at_idx ON agent_proposals (created_at DESC);
|
||||
|
||||
-- One review record per proposal (human decision on AI output) (Phase 5)
|
||||
CREATE TABLE agent_review_records (
|
||||
id UUID DEFAULT uuid_generate_v4() PRIMARY KEY NOT NULL,
|
||||
proposal_id UUID NOT NULL REFERENCES agent_proposals(id) ON DELETE CASCADE,
|
||||
reviewer_id UUID REFERENCES users(id),
|
||||
decision TEXT NOT NULL, -- accepted | rejected | modified
|
||||
notes TEXT,
|
||||
reviewed_at TIMESTAMP WITH TIME ZONE DEFAULT now() NOT NULL,
|
||||
UNIQUE (proposal_id)
|
||||
);
|
||||
|
||||
CREATE INDEX agent_review_records_proposal_id_idx ON agent_review_records (proposal_id);
|
||||
|
||||
-- Confidence annotations — per-dimension breakdown of AI confidence (Phase 5)
|
||||
CREATE TABLE confidence_annotations (
|
||||
id UUID DEFAULT uuid_generate_v4() PRIMARY KEY NOT NULL,
|
||||
proposal_id UUID NOT NULL REFERENCES agent_proposals(id) ON DELETE CASCADE,
|
||||
dimension TEXT NOT NULL,
|
||||
-- dimension values: accuracy | relevance | completeness | policy_alignment
|
||||
score NUMERIC NOT NULL CHECK (score BETWEEN 0 AND 1),
|
||||
explanation TEXT,
|
||||
created_at TIMESTAMP WITH TIME ZONE DEFAULT now() NOT NULL
|
||||
);
|
||||
|
||||
CREATE INDEX confidence_annotations_proposal_id_idx ON confidence_annotations (proposal_id);
|
||||
|
||||
6
SCOPE.md
6
SCOPE.md
@@ -65,9 +65,9 @@ IHF treats every meaningful UI element as a **governed interaction artifact** ra
|
||||
|
||||
## Current State
|
||||
|
||||
- Status: Phase 4 complete — outcome observation and antifragility loop implemented
|
||||
- Implementation: Phase 0 complete (specification); Phase 1 complete (widget registry, event capture, annotations, hub dashboard, auth); Phase 2 complete (annotation severity, annotation threads, requirement candidates, triage lifecycle, reviewer assignment, triage dashboard); Phase 3 complete (requirement promotion, decision records, policy references, implementation change references, governance dashboard); Phase 4 complete (deployment records, outcome signals, pre/post comparison, regression detection, change evaluation, recurrence tracking, antifragility dashboard)
|
||||
- Stability: core artifact model and schema are stable; Phase 4 data model (DeploymentRecord, OutcomeSignal, ChangeEvaluation) is additive and stable; outcome signals and interaction events are append-only (DB triggers)
|
||||
- Status: Phase 5 complete — agent-assisted distillation and suggestion implemented
|
||||
- Implementation: Phase 0 complete (specification); Phase 1 complete (widget registry, event capture, annotations, hub dashboard, auth); Phase 2 complete (annotation severity, annotation threads, requirement candidates, triage lifecycle, reviewer assignment, triage dashboard); Phase 3 complete (requirement promotion, decision records, policy references, implementation change references, governance dashboard); Phase 4 complete (deployment records, outcome signals, pre/post comparison, regression detection, change evaluation, recurrence tracking, antifragility dashboard); Phase 5 complete (agent proposals, review records, confidence annotations, cluster summarization, requirement drafting, duplicate detection, policy sensitivity, implementation proposals, agent audit dashboard)
|
||||
- Stability: core artifact model and schema are stable; Phase 5 data model (AgentProposal, AgentReviewRecord, ConfidenceAnnotation) is additive; all AI outputs are attributed and reviewer-controlled
|
||||
- Usage: reference implementation running on IHP v1.5 + PostgreSQL; `devenv up` to start
|
||||
|
||||
---
|
||||
|
||||
@@ -942,3 +942,151 @@ main = do
|
||||
let improvedCount = length (filter (\s -> s.signalType == "improved") signals)
|
||||
improvedCount `shouldBe` 1
|
||||
deleteRecord hub
|
||||
|
||||
-- Phase 5: Agent-Assisted Distillation
|
||||
describe "AgentProposal" do
|
||||
|
||||
it "creates and fetches a proposal with all fields" do
|
||||
hub <- newRecord @Hub |> set #name "P5Hub" |> createRecord
|
||||
widget <- newRecord @Widget
|
||||
|> set #name "p5widget" |> set #widgetType "button"
|
||||
|> set #hubId hub.id |> set #status "active"
|
||||
|> createRecord
|
||||
proposal <- newRecord @AgentProposal
|
||||
|> set #proposalType "summary"
|
||||
|> set #sourceWidgetId (Just widget.id)
|
||||
|> set #content "AI summary text"
|
||||
|> set #modelRef "claude-sonnet-4-6"
|
||||
|> set #status "pending"
|
||||
|> createRecord
|
||||
proposal.proposalType `shouldBe` "summary"
|
||||
proposal.modelRef `shouldBe` "claude-sonnet-4-6"
|
||||
proposal.status `shouldBe` "pending"
|
||||
proposal.confidence `shouldBe` Nothing
|
||||
deleteRecord hub
|
||||
|
||||
it "accept changes proposal status to accepted and creates review record" do
|
||||
hub <- newRecord @Hub |> set #name "P5AccHub" |> createRecord
|
||||
proposal <- newRecord @AgentProposal
|
||||
|> set #proposalType "summary"
|
||||
|> set #content "test"
|
||||
|> set #modelRef "claude-sonnet-4-6"
|
||||
|> set #status "pending"
|
||||
|> createRecord
|
||||
proposal' <- proposal |> set #status "accepted" |> updateRecord
|
||||
_review <- newRecord @AgentReviewRecord
|
||||
|> set #proposalId proposal.id
|
||||
|> set #decision "accepted"
|
||||
|> createRecord
|
||||
proposal'.status `shouldBe` "accepted"
|
||||
reviews <- query @AgentReviewRecord
|
||||
|> filterWhere (#proposalId, proposal.id) |> fetch
|
||||
length reviews `shouldBe` 1
|
||||
(head reviews).decision `shouldBe` "accepted"
|
||||
deleteRecord hub
|
||||
|
||||
it "reject changes proposal status to rejected and creates review record" do
|
||||
hub <- newRecord @Hub |> set #name "P5RejHub" |> createRecord
|
||||
proposal <- newRecord @AgentProposal
|
||||
|> set #proposalType "policy_flag"
|
||||
|> set #content "{}"
|
||||
|> set #modelRef "claude-sonnet-4-6"
|
||||
|> set #status "pending"
|
||||
|> createRecord
|
||||
proposal' <- proposal |> set #status "rejected" |> updateRecord
|
||||
_review <- newRecord @AgentReviewRecord
|
||||
|> set #proposalId proposal.id
|
||||
|> set #decision "rejected"
|
||||
|> createRecord
|
||||
proposal'.status `shouldBe` "rejected"
|
||||
reviews <- query @AgentReviewRecord
|
||||
|> filterWhere (#proposalId, proposal.id) |> fetch
|
||||
(head reviews).decision `shouldBe` "rejected"
|
||||
deleteRecord hub
|
||||
|
||||
it "review record is idempotent (UNIQUE constraint on proposal_id)" do
|
||||
hub <- newRecord @Hub |> set #name "P5IdemHub" |> createRecord
|
||||
proposal <- newRecord @AgentProposal
|
||||
|> set #proposalType "summary"
|
||||
|> set #content "c"
|
||||
|> set #modelRef "claude-sonnet-4-6"
|
||||
|> set #status "pending"
|
||||
|> createRecord
|
||||
newRecord @AgentReviewRecord
|
||||
|> set #proposalId proposal.id
|
||||
|> set #decision "accepted"
|
||||
|> createRecord
|
||||
result <- try (
|
||||
newRecord @AgentReviewRecord
|
||||
|> set #proposalId proposal.id
|
||||
|> set #decision "accepted"
|
||||
|> createRecord
|
||||
) :: IO (Either SomeException AgentReviewRecord)
|
||||
isLeft result `shouldBe` True
|
||||
deleteRecord hub
|
||||
|
||||
describe "ConfidenceAnnotation" do
|
||||
it "creates and links to proposal" do
|
||||
hub <- newRecord @Hub |> set #name "P5CaHub" |> createRecord
|
||||
proposal <- newRecord @AgentProposal
|
||||
|> set #proposalType "policy_flag"
|
||||
|> set #content "{}"
|
||||
|> set #modelRef "claude-sonnet-4-6"
|
||||
|> set #status "pending"
|
||||
|> set #confidence (Just 0.9)
|
||||
|> createRecord
|
||||
_ca <- newRecord @ConfidenceAnnotation
|
||||
|> set #proposalId proposal.id
|
||||
|> set #dimension "policy_alignment"
|
||||
|> set #score 0.9
|
||||
|> set #explanation (Just "High regulatory risk")
|
||||
|> createRecord
|
||||
cas <- query @ConfidenceAnnotation
|
||||
|> filterWhere (#proposalId, proposal.id) |> fetch
|
||||
length cas `shouldBe` 1
|
||||
(head cas).dimension `shouldBe` "policy_alignment"
|
||||
deleteRecord hub
|
||||
|
||||
describe "Duplicate detection proposal" do
|
||||
it "creates duplicate_flag proposal and handles empty duplicates array" do
|
||||
hub <- newRecord @Hub |> set #name "P5DupHub" |> createRecord
|
||||
widget <- newRecord @Widget
|
||||
|> set #name "dupwidget" |> set #widgetType "form"
|
||||
|> set #hubId hub.id |> set #status "active"
|
||||
|> createRecord
|
||||
candidate <- newRecord @RequirementCandidate
|
||||
|> set #title "Slow form" |> set #description "Form is slow"
|
||||
|> set #sourceWidgetId widget.id |> set #category "friction"
|
||||
|> set #status "open" |> createRecord
|
||||
proposal <- newRecord @AgentProposal
|
||||
|> set #proposalType "duplicate_flag"
|
||||
|> set #sourceCandidateId (Just candidate.id)
|
||||
|> set #content "{\"duplicates\": []}"
|
||||
|> set #modelRef "claude-sonnet-4-6"
|
||||
|> set #status "pending"
|
||||
|> createRecord
|
||||
proposal.proposalType `shouldBe` "duplicate_flag"
|
||||
proposal.content `shouldBe` "{\"duplicates\": []}"
|
||||
deleteRecord hub
|
||||
|
||||
describe "Agent audit dashboard data" do
|
||||
it "fetches proposal counts correctly" do
|
||||
hub <- newRecord @Hub |> set #name "P5AuditHub" |> createRecord
|
||||
p1 <- newRecord @AgentProposal
|
||||
|> set #proposalType "summary" |> set #content "s"
|
||||
|> set #modelRef "claude-sonnet-4-6" |> set #status "pending"
|
||||
|> createRecord
|
||||
p2 <- newRecord @AgentProposal
|
||||
|> set #proposalType "policy_flag" |> set #content "p"
|
||||
|> set #modelRef "claude-sonnet-4-6" |> set #status "accepted"
|
||||
|> createRecord
|
||||
_r <- newRecord @AgentReviewRecord
|
||||
|> set #proposalId p2.id |> set #decision "accepted"
|
||||
|> createRecord
|
||||
allProposals <- query @AgentProposal |> fetch
|
||||
allReviews <- query @AgentReviewRecord |> fetch
|
||||
let pending = filter (\p -> p.status == "pending") allProposals
|
||||
accepted = filter (\r -> r.decision == "accepted") allReviews
|
||||
length pending `shouldBe` 1
|
||||
length accepted `shouldBe` 1
|
||||
deleteRecord hub
|
||||
|
||||
128
Web/Controller/AgentProposals.hs
Normal file
128
Web/Controller/AgentProposals.hs
Normal 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 }
|
||||
@@ -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 }
|
||||
|
||||
@@ -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 }
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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 }
|
||||
|
||||
@@ -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>
|
||||
|
||||
@@ -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
|
||||
|
||||
21
Web/Types.hs
21
Web/Types.hs
@@ -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
|
||||
|
||||
138
Web/View/AgentProposals/Index.hs
Normal file
138
Web/View/AgentProposals/Index.hs
Normal 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"
|
||||
165
Web/View/AgentProposals/Show.hs
Normal file
165
Web/View/AgentProposals/Show.hs
Normal 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"
|
||||
@@ -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">
|
||||
|
||||
191
Web/View/Hubs/AgentAuditDashboard.hs
Normal file
191
Web/View/Hubs/AgentAuditDashboard.hs
Normal 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"
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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)}
|
||||
|
||||
82
docs/phase5-summary.md
Normal file
82
docs/phase5-summary.md
Normal file
@@ -0,0 +1,82 @@
|
||||
# Phase 5 Summary — Agent-Assisted Distillation and Suggestion
|
||||
|
||||
**Workplan:** IHUB-WP-0005
|
||||
**Completed:** 2026-03-29
|
||||
**Phase:** 5 of 8 in the IHF specification
|
||||
|
||||
---
|
||||
|
||||
## What Was Built
|
||||
|
||||
Phase 5 introduces bounded AI support into the IHF governance loop. All AI outputs are attributed (model_ref recorded), reviewable (AgentReviewRecord), and reversible (proposals can be rejected). No autonomous final decisions. No silent requirement promotion.
|
||||
|
||||
### T01 — Schema
|
||||
|
||||
Three new tables:
|
||||
- **`agent_proposals`** — stores every AI-generated output (summary, requirement_draft, duplicate_flag, policy_flag, impl_proposal). Status: `pending → accepted | rejected | superseded`. `model_ref` and optional `confidence` on every row.
|
||||
- **`agent_review_records`** — one per proposal (UNIQUE on `proposal_id`). Human decision: `accepted | rejected | modified`. Idempotent: second accept/reject returns "Already reviewed".
|
||||
- **`confidence_annotations`** — per-dimension breakdown of AI confidence (accuracy, relevance, completeness, policy_alignment). Linked to proposal via FK.
|
||||
|
||||
### T02 — AgentProposalsController
|
||||
|
||||
`AgentProposalsAction` (index filterable by type and status), `ShowAgentProposalAction`, `AcceptProposalAction`, `RejectProposalAction`. Proposals are immutable audit artifacts — no update/delete. Global nav "Agent" link added.
|
||||
|
||||
### T03 — Cluster Summarization
|
||||
|
||||
`SummarizeClusterAction` (POST from widget show page). Fetches last 20 annotations + threads, calls `claude-sonnet-4-6` with a factual distillation prompt (max_tokens=300), creates a `summary` AgentProposal. "Summarize Feedback" button on widget show page. API errors produce a user-visible flash message.
|
||||
|
||||
### T04 — AI-Drafted Requirement Candidate
|
||||
|
||||
`DraftRequirementAction` (POST from widget show page, gated on ≥ 3 annotations). Prompts Claude for JSON `{title, description}`. Creates a `requirement_draft` AgentProposal. On `AcceptProposalAction` for a requirement_draft: parses JSON and creates a `RequirementCandidate` with `category="friction"`, `status="open"`. No candidate is created without human acceptance.
|
||||
|
||||
### T05 — Duplicate Candidate Detection
|
||||
|
||||
`DetectDuplicatesAction` (POST from candidate show page). Sends target candidate + all others to Claude, requests JSON `{duplicates: [{id, reason}]}`. Creates a `duplicate_flag` AgentProposal. Informational only — no automated merging.
|
||||
|
||||
### T06 — Policy-Sensitive Issue Detection
|
||||
|
||||
`DetectPolicySensitivityAction` (POST from candidate show page). Sends candidate + widget `policy_scope` context to Claude, requests JSON `{concerns: [{scope, note}], severity}`. Creates a `policy_flag` AgentProposal with numeric `confidence` (low=0.3, medium=0.6, high=0.9). Creates one `ConfidenceAnnotation` per concern scope. Amber badge if concerns, green if clean.
|
||||
|
||||
### T07 — Implementation Path Proposal
|
||||
|
||||
`ProposeImplementationAction` (POST from decision show page). Fetches decision + requirement + existing impl refs, prompts Claude for JSON `{proposals: [{work_item_ref, system, rationale}]}`. Creates an `impl_proposal` AgentProposal. "Propose Implementation" button on decision show page.
|
||||
|
||||
### T08 — Agent Audit Dashboard
|
||||
|
||||
`AgentAuditDashboardAction` wrapped with `autoRefresh do`. Five panels:
|
||||
1. **KPI row**: total proposals / pending count / acceptance rate / rejection rate
|
||||
2. **Proposals by type**: count per type with color badges
|
||||
3. **Unreviewed queue**: pending proposals oldest-first with "Review" links
|
||||
4. **Recent proposals** (last 20): type, source widget, status, confidence, age
|
||||
5. **Attribution log**: model_ref × proposal_type count matrix
|
||||
|
||||
Linked from hub show page (purple "Agent Audit" button).
|
||||
|
||||
---
|
||||
|
||||
## Governance Constraints Upheld
|
||||
|
||||
- **Attributability**: every `AgentProposal` records `model_ref`. Reviewers see exactly which model produced the output.
|
||||
- **Human control**: no proposal auto-promotes. `requirement_draft` → `RequirementCandidate` only after explicit acceptance via `AcceptProposalAction`.
|
||||
- **Idempotency**: `UNIQUE (proposal_id)` on `agent_review_records`. Second accept/reject returns "Already reviewed" — no double-review.
|
||||
- **Error isolation**: all Claude API calls are wrapped; failures produce a flash message and redirect, never a 500.
|
||||
- **Confidence is optional**: `AgentProposal.confidence` is nullable. Summaries have no numeric score; policy flags derive confidence from severity.
|
||||
|
||||
---
|
||||
|
||||
## Known Limitations
|
||||
|
||||
- **No streaming**: Claude API calls are synchronous within the controller action. For large annotation sets this may cause slow response times. Future work: background job with status polling.
|
||||
- **Confidence annotations for T06 use same score for all dimensions**: each concern dimension gets the overall severity score, not a per-dimension score from Claude. A refined prompt could request per-dimension scores.
|
||||
- **Duplicate detection scales linearly**: the full candidate list is sent to Claude. For large datasets (>100 candidates) the prompt will be large. Future work: embedding-based pre-filtering.
|
||||
- **No embeddings storage**: all intelligence is delegated to the Anthropic API. Phase 5 adds no local model serving or vector store.
|
||||
|
||||
---
|
||||
|
||||
## Phase 6 Readiness
|
||||
|
||||
Phase 6 (Cross-Hub Integration) can build on:
|
||||
- `AgentProposal` as a structured output artifact that can be routed across hubs
|
||||
- `ConfidenceAnnotation` as a per-dimension quality signal for cross-hub filtering
|
||||
- The attribution log as an audit trail for multi-hub AI operations
|
||||
- All Phase 1–5 traceability chain intact: Widget → Annotation → Candidate → Decision → Deployment → OutcomeSignal → AgentProposal
|
||||
@@ -37,6 +37,10 @@
|
||||
# ihp-job-dashboard # Job dashboard UI
|
||||
# ihp-typed-sql # Type-safe SQL queries
|
||||
# ihp-pglistener # PostgreSQL LISTEN/NOTIFY
|
||||
# Phase 5: Anthropic API calls
|
||||
http-conduit
|
||||
aeson
|
||||
string-conversions
|
||||
];
|
||||
devHaskellPackages = p: with p; [
|
||||
cabal-install
|
||||
|
||||
@@ -62,7 +62,7 @@ Reference: `docs/ihp-overview.md`, `docs/ihp-data-and-queries.md`,
|
||||
|
||||
```task
|
||||
id: IHUB-WP-0005-T01
|
||||
status: todo
|
||||
status: done
|
||||
priority: high
|
||||
state_hub_task_id: "6e1a9d31-a7e9-4d71-a726-44eaf739371c"
|
||||
```
|
||||
@@ -131,7 +131,7 @@ CREATE INDEX confidence_annotations_proposal_id_idx ON confidence_annotations (p
|
||||
|
||||
```task
|
||||
id: IHUB-WP-0005-T02
|
||||
status: todo
|
||||
status: done
|
||||
priority: high
|
||||
state_hub_task_id: "5a9b9d51-dcdf-4dad-b449-08a7091e4563"
|
||||
```
|
||||
@@ -165,7 +165,7 @@ review record created correctly; idempotent guard works.
|
||||
|
||||
```task
|
||||
id: IHUB-WP-0005-T03
|
||||
status: todo
|
||||
status: done
|
||||
priority: high
|
||||
state_hub_task_id: "630d8d95-a009-4406-82e2-27f62fabcd3c"
|
||||
```
|
||||
@@ -199,7 +199,7 @@ API errors produce a user-visible error message (not a 500).
|
||||
|
||||
```task
|
||||
id: IHUB-WP-0005-T04
|
||||
status: todo
|
||||
status: done
|
||||
priority: high
|
||||
state_hub_task_id: "4c9d23f7-1744-48c8-90b5-71854d9b7daf"
|
||||
```
|
||||
@@ -236,7 +236,7 @@ human acceptance.
|
||||
|
||||
```task
|
||||
id: IHUB-WP-0005-T05
|
||||
status: todo
|
||||
status: done
|
||||
priority: medium
|
||||
state_hub_task_id: "969b7c7f-c3ba-4892-a1d0-faedf536d1c6"
|
||||
```
|
||||
@@ -266,7 +266,7 @@ links on candidate show page; empty duplicates array handled gracefully.
|
||||
|
||||
```task
|
||||
id: IHUB-WP-0005-T06
|
||||
status: todo
|
||||
status: done
|
||||
priority: medium
|
||||
state_hub_task_id: "475290e0-7842-4336-a57c-04fa62652094"
|
||||
```
|
||||
@@ -299,7 +299,7 @@ concern severity rendered correctly; clean result (empty concerns) handled.
|
||||
|
||||
```task
|
||||
id: IHUB-WP-0005-T07
|
||||
status: todo
|
||||
status: done
|
||||
priority: medium
|
||||
state_hub_task_id: "7ee1274e-fa1b-4ae8-a360-4abafc1773f0"
|
||||
```
|
||||
@@ -333,7 +333,7 @@ form; multiple proposal paths rendered clearly.
|
||||
|
||||
```task
|
||||
id: IHUB-WP-0005-T08
|
||||
status: todo
|
||||
status: done
|
||||
priority: high
|
||||
state_hub_task_id: "53b58abb-cb50-4985-a1c0-b05da17dfc3f"
|
||||
```
|
||||
|
||||
Reference in New Issue
Block a user