diff --git a/Application/Helper/Controller.hs b/Application/Helper/Controller.hs index dd6cfca..062dd65 100644 --- a/Application/Helper/Controller.hs +++ b/Application/Helper/Controller.hs @@ -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 - ] \ No newline at end of file + ] + +-- | 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") diff --git a/Application/Migration/1743379200-ihf-phase5-agent-distillation.sql b/Application/Migration/1743379200-ihf-phase5-agent-distillation.sql new file mode 100644 index 0000000..9537ff7 --- /dev/null +++ b/Application/Migration/1743379200-ihf-phase5-agent-distillation.sql @@ -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); diff --git a/Application/Schema.sql b/Application/Schema.sql index eb5f286..a388b61 100644 --- a/Application/Schema.sql +++ b/Application/Schema.sql @@ -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); diff --git a/SCOPE.md b/SCOPE.md index d4b6d9a..2fddbdc 100644 --- a/SCOPE.md +++ b/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 --- diff --git a/Test/Integration.hs b/Test/Integration.hs index b21b81c..113b2d5 100644 --- a/Test/Integration.hs +++ b/Test/Integration.hs @@ -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 diff --git a/Web/Controller/AgentProposals.hs b/Web/Controller/AgentProposals.hs new file mode 100644 index 0000000..024e94e --- /dev/null +++ b/Web/Controller/AgentProposals.hs @@ -0,0 +1,128 @@ +module Web.Controller.AgentProposals where + +import Web.Types +import Web.View.AgentProposals.Index +import Web.View.AgentProposals.Show +import Generated.Types +import IHP.Prelude +import IHP.ControllerPrelude +import Data.Aeson (decode) +import Data.ByteString.Lazy (fromStrict) +import Data.Text.Encoding (encodeUtf8) +import Data.HashMap.Strict (HashMap) +import qualified Data.HashMap.Strict as HashMap + +instance Controller AgentProposalsController where + beforeAction = ensureIsUser + + action AgentProposalsAction = do + mTypeFilter <- paramOrNothing @Text "proposal_type" + mStatusFilter <- paramOrNothing @Text "status" + proposals <- case (mTypeFilter, mStatusFilter) of + (Nothing, Nothing) -> + query @AgentProposal |> orderByDesc #createdAt |> fetch + (Just t, Nothing) -> + query @AgentProposal + |> filterWhere (#proposalType, t) + |> orderByDesc #createdAt |> fetch + (Nothing, Just s) -> + query @AgentProposal + |> filterWhere (#status, s) + |> orderByDesc #createdAt |> fetch + (Just t, Just s) -> + query @AgentProposal + |> filterWhere (#proposalType, t) + |> filterWhere (#status, s) + |> orderByDesc #createdAt |> fetch + widgets <- query @Widget |> fetch + render IndexView { proposals, widgets, mTypeFilter, mStatusFilter } + + action ShowAgentProposalAction { agentProposalId } = do + proposal <- fetch agentProposalId + mWidget <- case proposal.sourceWidgetId of + Nothing -> pure Nothing + Just wid -> fetchOneOrNothing wid + mCandidate <- case proposal.sourceCandidateId of + Nothing -> pure Nothing + Just cid -> fetchOneOrNothing cid + mDecision <- case proposal.sourceDecisionId of + Nothing -> pure Nothing + Just did -> fetchOneOrNothing did + mReview <- query @AgentReviewRecord + |> filterWhere (#proposalId, agentProposalId) + |> fetchOneOrNothing + confidences <- query @ConfidenceAnnotation + |> filterWhere (#proposalId, agentProposalId) + |> orderByAsc #createdAt + |> fetch + users <- query @User |> fetch + render ShowView + { proposal, mWidget, mCandidate, mDecision + , mReview, confidences, users } + + action AcceptProposalAction { agentProposalId } = do + proposal <- fetch agentProposalId + mExisting <- query @AgentReviewRecord + |> filterWhere (#proposalId, agentProposalId) + |> fetchOneOrNothing + case mExisting of + Just _ -> do + setSuccessMessage "Already reviewed" + redirectTo ShowAgentProposalAction { agentProposalId } + Nothing -> do + mUser <- currentUserOrNothing + let reviewerId = fmap (.id) mUser + proposal + |> set #status "accepted" + |> updateRecord + notes <- paramOrNothing @Text "notes" + newRecord @AgentReviewRecord + |> set #proposalId agentProposalId + |> set #reviewerId (fmap (Id . unId) reviewerId) + |> set #decision "accepted" + |> set #notes notes + |> createRecord + -- T04: if requirement_draft, promote to RequirementCandidate + when (proposal.proposalType == "requirement_draft") do + let mParsed = decode (fromStrict (encodeUtf8 proposal.content)) + :: Maybe (HashMap Text Text) + case mParsed of + Just m -> do + let title = fromMaybe "AI Draft" (HashMap.lookup "title" m) + desc = fromMaybe "" (HashMap.lookup "description" m) + newRecord @RequirementCandidate + |> set #title title + |> set #description desc + |> set #sourceWidgetId proposal.sourceWidgetId + |> set #category "friction" + |> set #status "open" + |> createRecord + setSuccessMessage "Requirement candidate created from AI draft" + Nothing -> + setSuccessMessage "Proposal accepted (could not parse JSON for candidate)" + redirectTo ShowAgentProposalAction { agentProposalId } + + action RejectProposalAction { agentProposalId } = do + proposal <- fetch agentProposalId + mExisting <- query @AgentReviewRecord + |> filterWhere (#proposalId, agentProposalId) + |> fetchOneOrNothing + case mExisting of + Just _ -> do + setSuccessMessage "Already reviewed" + redirectTo ShowAgentProposalAction { agentProposalId } + Nothing -> do + mUser <- currentUserOrNothing + let reviewerId = fmap (.id) mUser + proposal + |> set #status "rejected" + |> updateRecord + notes <- paramOrNothing @Text "notes" + newRecord @AgentReviewRecord + |> set #proposalId agentProposalId + |> set #reviewerId (fmap (Id . unId) reviewerId) + |> set #decision "rejected" + |> set #notes notes + |> createRecord + setSuccessMessage "Proposal rejected" + redirectTo ShowAgentProposalAction { agentProposalId } diff --git a/Web/Controller/DecisionRecords.hs b/Web/Controller/DecisionRecords.hs index 911ea11..a38d703 100644 --- a/Web/Controller/DecisionRecords.hs +++ b/Web/Controller/DecisionRecords.hs @@ -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 } diff --git a/Web/Controller/Hubs.hs b/Web/Controller/Hubs.hs index 15ad0ba..fc1670a 100644 --- a/Web/Controller/Hubs.hs +++ b/Web/Controller/Hubs.hs @@ -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 } diff --git a/Web/Controller/RequirementCandidates.hs b/Web/Controller/RequirementCandidates.hs index a634a3c..3d58d35 100644 --- a/Web/Controller/RequirementCandidates.hs +++ b/Web/Controller/RequirementCandidates.hs @@ -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 diff --git a/Web/Controller/Widgets.hs b/Web/Controller/Widgets.hs index 6eafa54..f5db4fd 100644 --- a/Web/Controller/Widgets.hs +++ b/Web/Controller/Widgets.hs @@ -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 } diff --git a/Web/FrontController.hs b/Web/FrontController.hs index 3cb1709..5c2855e 100644 --- a/Web/FrontController.hs +++ b/Web/FrontController.hs @@ -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| Requirements Decisions Deployments + Agent
Sign out
diff --git a/Web/Routes.hs b/Web/Routes.hs index 2b40237..a0ecf5d 100644 --- a/Web/Routes.hs +++ b/Web/Routes.hs @@ -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 diff --git a/Web/Types.hs b/Web/Types.hs index 0d3ec1c..1ee7d90 100644 --- a/Web/Types.hs +++ b/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 diff --git a/Web/View/AgentProposals/Index.hs b/Web/View/AgentProposals/Index.hs new file mode 100644 index 0000000..125cdb7 --- /dev/null +++ b/Web/View/AgentProposals/Index.hs @@ -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| +
+

Agent Proposals

+
+ + +
+
+ Type: + All + {forEach allProposalTypes (\t -> [hsx| + {t} + |])} +
+
+ Status: + All + {forEach allStatuses (\s -> [hsx| + {s} + |])} +
+
+ + {if null proposals + then [hsx|

No proposals found.

|] + 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| +
+ + + + + + + + + + + + {forEach proposals (renderRow widgets)} + +
TypeSource WidgetConfidenceStatusCreated
+
+|] + +renderRow :: [Widget] -> AgentProposal -> Html +renderRow widgets p = [hsx| + + + " text-xs px-2 py-0.5 rounded font-medium"}> + {p.proposalType} + + + {widgetName widgets p.sourceWidgetId} + {renderConfidenceBar p.confidence} + + " text-xs px-2 py-0.5 rounded font-medium"}> + {p.status} + + + {show p.createdAt} + +|] + +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|—|] +renderConfidenceBar (Just c) = + let pct = show (round (c * 100) :: Int) <> "%" + barWidth = "width: " <> pct + in [hsx| +
+
+
+
+ {pct} +
+ |] + +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" diff --git a/Web/View/AgentProposals/Show.hs b/Web/View/AgentProposals/Show.hs new file mode 100644 index 0000000..1c1c38b --- /dev/null +++ b/Web/View/AgentProposals/Show.hs @@ -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| +
+ ← Agent Proposals +
+ +
+
+ " text-sm px-2 py-1 rounded font-medium"}> + {proposal.proposalType} + + " text-sm px-2 py-1 rounded font-medium"}> + {proposal.status} + +
+
+ + +
+

AI Output

+ 
{proposal.content}
+
+ + + {if null confidences then mempty else renderConfidences confidences} + + +
+

Source Context

+
+
Widget
+
{maybe "—" (.name) mWidget}
+
Candidate
+
{maybe "—" (.title) mCandidate}
+
Decision
+
{maybe "—" (.title) mDecision}
+
+
+ + + {case mReview of + Just review -> renderExistingReview review users + Nothing -> renderReviewForm proposal.id proposal.status} + + +
+ Model: {proposal.modelRef} + · Created: {show proposal.createdAt} +
+ |] + +renderConfidences :: [ConfidenceAnnotation] -> Html +renderConfidences cs = [hsx| +
+

Confidence Breakdown

+
+ {forEach cs renderConfidenceRow} +
+
+|] + +renderConfidenceRow :: ConfidenceAnnotation -> Html +renderConfidenceRow c = + let pct = show (round (c.score * 100) :: Int) <> "%" + barWidth = "width: " <> pct + in [hsx| +
+
+ {c.dimension} + {pct} +
+
+
+
+ {maybe mempty (\e -> [hsx|

{e}

|]) c.explanation} +
+ |] + +renderExistingReview :: AgentReviewRecord -> [User] -> Html +renderExistingReview review users = [hsx| +
+

Review Decision

+
+ " text-sm px-2 py-1 rounded font-medium"}> + {review.decision} + + by {reviewerName users review.reviewerId} at {show review.reviewedAt} +
+ {maybe mempty (\n -> [hsx|

{n}

|]) review.notes} +
+|] + +renderReviewForm :: Id AgentProposal -> Text -> Html +renderReviewForm pid status + | status /= "pending" = mempty + | otherwise = [hsx| +
+

Review This Proposal

+
+ + +
+
+
+ + +
+
+ + +
+
+
+ |] + +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" diff --git a/Web/View/DecisionRecords/Show.hs b/Web/View/DecisionRecords/Show.hs index 1a05042..51cb5fa 100644 --- a/Web/View/DecisionRecords/Show.hs +++ b/Web/View/DecisionRecords/Show.hs @@ -114,7 +114,14 @@ instance View ShowView where
-

Implementation References

+
+

Implementation References

+
+ +
+
{forEach implRefs renderImplRef}
diff --git a/Web/View/Hubs/AgentAuditDashboard.hs b/Web/View/Hubs/AgentAuditDashboard.hs new file mode 100644 index 0000000..e673816 --- /dev/null +++ b/Web/View/Hubs/AgentAuditDashboard.hs @@ -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| +
+
+

Agent Audit Dashboard

+

{hub.name}

+
+ ← Hub +
+ + +
+ {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"} +
+ + +
+

Proposals by Type

+
+ {forEach allTypes (\t -> + let cnt = length (filter (\p -> p.proposalType == t) proposals) + in [hsx| +
+ " text-xs px-2 py-0.5 rounded font-medium"}>{t} + {show cnt} +
+ |])} +
+
+ + +
+
+

Unreviewed Queue ({show pendingCount})

+
+ {if null pending + then [hsx|

No pending proposals.

|] + else [hsx| + + + {forEach (sortByCreatedAt pending) renderQueueRow} + +
+ |]} +
+ + +
+
+

Recent Proposals (last 20)

+
+ + + + + + + + + + + + {forEach recent (renderRecentRow widgets)} + +
TypeSource WidgetStatusConfidenceAge
+
+ + +
+

Attribution Log (model × type)

+ + + + + {forEach allTypes (\t -> [hsx| + + |])} + + + + {forEach allModels (\m -> [hsx| + + + {forEach allTypes (\t -> + let cnt = length (filter (\p -> p.modelRef == m && p.proposalType == t) proposals) + in [hsx||])} + + |])} + +
Model{t}
{m}{if cnt == 0 then "—" else show cnt}
+
+ |] + 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| +
+

{label}

+

colorClass}>{value}

+
+|] + +renderQueueRow :: AgentProposal -> Html +renderQueueRow p = [hsx| + + + " text-xs px-2 py-0.5 rounded font-medium"}> + {p.proposalType} + + + {show p.createdAt} + + Review → + + +|] + +renderRecentRow :: [Widget] -> AgentProposal -> Html +renderRecentRow widgets p = [hsx| + + + " text-xs px-2 py-0.5 rounded font-medium"}> + {p.proposalType} + + + {widgetName widgets p.sourceWidgetId} + + " text-xs px-2 py-0.5 rounded"}> + {p.status} + + + {maybe "—" (\c -> show (round (c * 100) :: Int) <> "%") p.confidence} + {show p.createdAt} + +|] + +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" diff --git a/Web/View/Hubs/Show.hs b/Web/View/Hubs/Show.hs index a939ffe..31ae647 100644 --- a/Web/View/Hubs/Show.hs +++ b/Web/View/Hubs/Show.hs @@ -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 + + Agent Audit + Edit diff --git a/Web/View/RequirementCandidates/Show.hs b/Web/View/RequirementCandidates/Show.hs index 08c1248..3e33097 100644 --- a/Web/View/RequirementCandidates/Show.hs +++ b/Web/View/RequirementCandidates/Show.hs @@ -28,7 +28,17 @@ instance View ShowView where

{candidate.title}

-
+
+ + + +
+ +
Edit diff --git a/Web/View/Widgets/Show.hs b/Web/View/Widgets/Show.hs index 0d42e9c..ecabb52 100644 --- a/Web/View/Widgets/Show.hs +++ b/Web/View/Widgets/Show.hs @@ -82,8 +82,22 @@ instance View ShowView where

Annotations

- + Add +
+ {if length annotations >= 3 then [hsx| +
+ +
+ |] else mempty} +
+ +
+ + Add +
{forEach rootAnnotations (renderAnnotation childrenOf)} diff --git a/docs/phase5-summary.md b/docs/phase5-summary.md new file mode 100644 index 0000000..632b90c --- /dev/null +++ b/docs/phase5-summary.md @@ -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 diff --git a/flake.nix b/flake.nix index 1a2e12c..40652c5 100644 --- a/flake.nix +++ b/flake.nix @@ -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 diff --git a/workplans/IHUB-WP-0005-ihf-phase5-agent-assisted-distillation.md b/workplans/IHUB-WP-0005-ihf-phase5-agent-assisted-distillation.md index c76c573..b9e6361 100644 --- a/workplans/IHUB-WP-0005-ihf-phase5-agent-assisted-distillation.md +++ b/workplans/IHUB-WP-0005-ihf-phase5-agent-assisted-distillation.md @@ -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" ```