generated from coulomb/repo-seed
feat(P2+P3): IHF Phase 2 complete; register Phase 3 workplan
Phase 2 — Structured Feedback and Triage (IHUB-WP-0002): - Schema: annotation_threads, requirement_candidates, triage_states, reviewer_assignments; annotations extended with severity + thread_id - AnnotationThreadsController: create threads, assign annotations - RequirementCandidatesController: CRUD, escalation, triage lifecycle, reviewer assignment, my-queue - Annotation severity (low/medium/high/critical) with Tailwind color cues - TriageDashboardAction on HubsController with autoRefresh - Integration tests (T01–T09), SCOPE.md updated, docs/phase2-summary.md Phase 3 — Governance and Decision Linkage (IHUB-WP-0003): - Workplan registered: 9 tasks, State Hub workstream 5f201ee3 Co-Authored-By: Claude Sonnet 4.6 <noreply@anthropic.com>
This commit is contained in:
@@ -160,3 +160,292 @@ main = do
|
||||
|> validateField #body nonEmpty
|
||||
isValid ann `shouldBe` False
|
||||
deleteRecord hub
|
||||
|
||||
-- ----------------------------------------------------------------
|
||||
-- Phase 2: Annotation severity
|
||||
-- ----------------------------------------------------------------
|
||||
describe "Annotation severity" do
|
||||
it "defaults to medium severity" do
|
||||
hub <- newRecord @Hub
|
||||
|> set #slug "sev-hub" |> set #name "Sev Hub" |> set #domain "d"
|
||||
|> createRecord
|
||||
widget <- newRecord @Widget
|
||||
|> set #hubId hub.id |> set #name "Sev Widget" |> set #widgetType "form"
|
||||
|> createRecord
|
||||
ann <- newRecord @Annotation
|
||||
|> set #widgetId widget.id
|
||||
|> set #body "Default severity test"
|
||||
|> set #category "friction"
|
||||
|> set #actorType "user"
|
||||
|> createRecord
|
||||
ann.severity `shouldBe` "medium"
|
||||
deleteRecord hub
|
||||
|
||||
it "stores explicit severity" do
|
||||
hub <- newRecord @Hub
|
||||
|> set #slug "sev2-hub" |> set #name "Sev2 Hub" |> set #domain "d"
|
||||
|> createRecord
|
||||
widget <- newRecord @Widget
|
||||
|> set #hubId hub.id |> set #name "Sev2 Widget" |> set #widgetType "form"
|
||||
|> createRecord
|
||||
ann <- newRecord @Annotation
|
||||
|> set #widgetId widget.id
|
||||
|> set #body "Critical issue"
|
||||
|> set #category "defect"
|
||||
|> set #severity "critical"
|
||||
|> set #actorType "user"
|
||||
|> createRecord
|
||||
ann.severity `shouldBe` "critical"
|
||||
deleteRecord hub
|
||||
|
||||
-- ----------------------------------------------------------------
|
||||
-- Phase 2: AnnotationThread create + assign annotation
|
||||
-- ----------------------------------------------------------------
|
||||
describe "AnnotationThread" do
|
||||
it "creates thread and assigns annotation" do
|
||||
hub <- newRecord @Hub
|
||||
|> set #slug "th-hub" |> set #name "Th Hub" |> set #domain "d"
|
||||
|> createRecord
|
||||
widget <- newRecord @Widget
|
||||
|> set #hubId hub.id |> set #name "Th Widget" |> set #widgetType "panel"
|
||||
|> createRecord
|
||||
thread <- newRecord @AnnotationThread
|
||||
|> set #widgetId widget.id
|
||||
|> set #title "Login flow friction cluster"
|
||||
|> set #description (Just "All friction annotations about login")
|
||||
|> createRecord
|
||||
ann <- newRecord @Annotation
|
||||
|> set #widgetId widget.id
|
||||
|> set #body "Login button is confusing"
|
||||
|> set #category "friction"
|
||||
|> set #actorType "user"
|
||||
|> createRecord
|
||||
-- Assign annotation to thread
|
||||
ann |> set #threadId (Just thread.id) |> updateRecord
|
||||
fetched <- fetch ann.id
|
||||
fetched.threadId `shouldBe` Just thread.id
|
||||
deleteRecord hub
|
||||
|
||||
-- ----------------------------------------------------------------
|
||||
-- Phase 2: Escalation annotation → RequirementCandidate
|
||||
-- ----------------------------------------------------------------
|
||||
describe "Escalation: annotation → RequirementCandidate" do
|
||||
it "creates candidate from annotation" do
|
||||
hub <- newRecord @Hub
|
||||
|> set #slug "esc-hub" |> set #name "Esc Hub" |> set #domain "d"
|
||||
|> createRecord
|
||||
widget <- newRecord @Widget
|
||||
|> set #hubId hub.id |> set #name "Esc Widget" |> set #widgetType "form"
|
||||
|> createRecord
|
||||
ann <- newRecord @Annotation
|
||||
|> set #widgetId widget.id
|
||||
|> set #body "The submit button is invisible"
|
||||
|> set #category "defect"
|
||||
|> set #actorType "user"
|
||||
|> createRecord
|
||||
candidate <- newRecord @RequirementCandidate
|
||||
|> set #title "The submit button is invisible"
|
||||
|> set #description ann.body
|
||||
|> set #sourceWidgetId widget.id
|
||||
|> set #sourceAnnotationId (Just ann.id)
|
||||
|> set #category ann.category
|
||||
|> set #status "open"
|
||||
|> createRecord
|
||||
candidate.status `shouldBe` "open"
|
||||
candidate.sourceAnnotationId `shouldBe` Just ann.id
|
||||
deleteRecord hub
|
||||
|
||||
it "duplicate escalation: candidate already linked to annotation" do
|
||||
hub <- newRecord @Hub
|
||||
|> set #slug "dup-hub" |> set #name "Dup Hub" |> set #domain "d"
|
||||
|> createRecord
|
||||
widget <- newRecord @Widget
|
||||
|> set #hubId hub.id |> set #name "Dup Widget" |> set #widgetType "form"
|
||||
|> createRecord
|
||||
ann <- newRecord @Annotation
|
||||
|> set #widgetId widget.id
|
||||
|> set #body "Duplicate escalation test"
|
||||
|> set #category "friction"
|
||||
|> set #actorType "user"
|
||||
|> createRecord
|
||||
_c1 <- newRecord @RequirementCandidate
|
||||
|> set #title "First escalation"
|
||||
|> set #description ann.body
|
||||
|> set #sourceWidgetId widget.id
|
||||
|> set #sourceAnnotationId (Just ann.id)
|
||||
|> set #category ann.category
|
||||
|> set #status "open"
|
||||
|> createRecord
|
||||
-- Second escalation attempt: query returns existing
|
||||
existing <- query @RequirementCandidate
|
||||
|> filterWhere (#sourceAnnotationId, Just ann.id)
|
||||
|> fetchOneOrNothing
|
||||
isJust existing `shouldBe` True
|
||||
deleteRecord hub
|
||||
|
||||
-- ----------------------------------------------------------------
|
||||
-- Phase 2: Triage lifecycle
|
||||
-- ----------------------------------------------------------------
|
||||
describe "Triage lifecycle" do
|
||||
it "valid path: open → in_review → accepted" do
|
||||
hub <- newRecord @Hub
|
||||
|> set #slug "tri-hub" |> set #name "Tri Hub" |> set #domain "d"
|
||||
|> createRecord
|
||||
widget <- newRecord @Widget
|
||||
|> set #hubId hub.id |> set #name "Tri Widget" |> set #widgetType "form"
|
||||
|> createRecord
|
||||
candidate <- newRecord @RequirementCandidate
|
||||
|> set #title "Triage test candidate"
|
||||
|> set #description "Testing triage lifecycle"
|
||||
|> set #sourceWidgetId widget.id
|
||||
|> set #category "friction"
|
||||
|> set #status "open"
|
||||
|> createRecord
|
||||
|
||||
-- Transition: open → in_review
|
||||
newRecord @TriageState
|
||||
|> set #candidateId candidate.id
|
||||
|> set #status "in_review"
|
||||
|> createRecord
|
||||
candidate |> set #status "in_review" |> updateRecord
|
||||
|
||||
inReview <- fetch candidate.id
|
||||
inReview.status `shouldBe` "in_review"
|
||||
|
||||
-- Transition: in_review → accepted
|
||||
newRecord @TriageState
|
||||
|> set #candidateId inReview.id
|
||||
|> set #status "accepted"
|
||||
|> createRecord
|
||||
inReview |> set #status "accepted" |> updateRecord
|
||||
|
||||
accepted <- fetch candidate.id
|
||||
accepted.status `shouldBe` "accepted"
|
||||
|
||||
-- Audit trail: 2 triage state rows
|
||||
rows <- query @TriageState |> filterWhere (#candidateId, candidate.id) |> fetch
|
||||
length rows `shouldBe` 2
|
||||
deleteRecord hub
|
||||
|
||||
it "invalid transition is not allowed by controller logic" do
|
||||
let allowedTransition from to = case (from, to) of
|
||||
("open", "in_review") -> True
|
||||
("in_review", "accepted") -> True
|
||||
("in_review", "rejected") -> True
|
||||
("in_review", "deferred") -> True
|
||||
("deferred", "in_review") -> True
|
||||
_ -> False
|
||||
allowedTransition "open" "accepted" `shouldBe` False
|
||||
allowedTransition "open" "rejected" `shouldBe` False
|
||||
allowedTransition "accepted" "open" `shouldBe` False
|
||||
|
||||
-- ----------------------------------------------------------------
|
||||
-- Phase 2: ReviewerAssignment
|
||||
-- ----------------------------------------------------------------
|
||||
describe "ReviewerAssignment" do
|
||||
it "assigns and reassigns reviewer" do
|
||||
hub <- newRecord @Hub
|
||||
|> set #slug "rev-hub" |> set #name "Rev Hub" |> set #domain "d"
|
||||
|> createRecord
|
||||
widget <- newRecord @Widget
|
||||
|> set #hubId hub.id |> set #name "Rev Widget" |> set #widgetType "form"
|
||||
|> createRecord
|
||||
candidate <- newRecord @RequirementCandidate
|
||||
|> set #title "Reviewer test"
|
||||
|> set #description "Testing reviewer assignment"
|
||||
|> set #sourceWidgetId widget.id
|
||||
|> set #category "friction"
|
||||
|> set #status "open"
|
||||
|> createRecord
|
||||
user1 <- newRecord @User
|
||||
|> set #email "reviewer1@example.com"
|
||||
|> set #name "Reviewer One"
|
||||
|> set #passwordHash "hash1"
|
||||
|> createRecord
|
||||
user2 <- newRecord @User
|
||||
|> set #email "reviewer2@example.com"
|
||||
|> set #name "Reviewer Two"
|
||||
|> set #passwordHash "hash2"
|
||||
|> createRecord
|
||||
|
||||
-- First assignment
|
||||
ra <- newRecord @ReviewerAssignment
|
||||
|> set #candidateId candidate.id
|
||||
|> set #userId user1.id
|
||||
|> createRecord
|
||||
ra.userId `shouldBe` user1.id
|
||||
|
||||
-- Reassign (upsert: delete old, insert new)
|
||||
deleteRecord ra
|
||||
ra2 <- newRecord @ReviewerAssignment
|
||||
|> set #candidateId candidate.id
|
||||
|> set #userId user2.id
|
||||
|> createRecord
|
||||
ra2.userId `shouldBe` user2.id
|
||||
|
||||
-- Only one assignment remains
|
||||
assignments <- query @ReviewerAssignment
|
||||
|> filterWhere (#candidateId, candidate.id)
|
||||
|> fetch
|
||||
length assignments `shouldBe` 1
|
||||
|
||||
deleteRecord hub
|
||||
deleteRecord user1
|
||||
deleteRecord user2
|
||||
|
||||
it "my-queue filter: only returns assigned open/in_review candidates" do
|
||||
hub <- newRecord @Hub
|
||||
|> set #slug "q-hub" |> set #name "Q Hub" |> set #domain "d"
|
||||
|> createRecord
|
||||
widget <- newRecord @Widget
|
||||
|> set #hubId hub.id |> set #name "Q Widget" |> set #widgetType "form"
|
||||
|> createRecord
|
||||
user <- newRecord @User
|
||||
|> set #email "queue@example.com"
|
||||
|> set #name "Queue User"
|
||||
|> set #passwordHash "hash"
|
||||
|> createRecord
|
||||
c1 <- newRecord @RequirementCandidate
|
||||
|> set #title "Assigned open" |> set #description "d"
|
||||
|> set #sourceWidgetId widget.id |> set #category "friction"
|
||||
|> set #status "open" |> createRecord
|
||||
c2 <- newRecord @RequirementCandidate
|
||||
|> set #title "Unassigned" |> set #description "d"
|
||||
|> set #sourceWidgetId widget.id |> set #category "friction"
|
||||
|> set #status "open" |> createRecord
|
||||
newRecord @ReviewerAssignment
|
||||
|> set #candidateId c1.id
|
||||
|> set #userId user.id
|
||||
|> createRecord
|
||||
assignments <- query @ReviewerAssignment |> filterWhere (#userId, user.id) |> fetch
|
||||
let assignedIds = map (.candidateId) assignments
|
||||
assignedIds `shouldContain` [c1.id]
|
||||
assignedIds `shouldNotContain` [c2.id]
|
||||
deleteRecord hub
|
||||
deleteRecord user
|
||||
|
||||
-- ----------------------------------------------------------------
|
||||
-- Phase 2: Triage dashboard autoRefresh wrapper check
|
||||
-- ----------------------------------------------------------------
|
||||
describe "Triage dashboard" do
|
||||
it "autoRefresh wrapper: TriageDashboardAction fetches hub + widgets + candidates" do
|
||||
-- Structural test: verify the data fetching logic compiles and is accessible
|
||||
-- (runtime autoRefresh test requires WebSocket — verified manually)
|
||||
hub <- newRecord @Hub
|
||||
|> set #slug "dash-hub" |> set #name "Dash Hub" |> set #domain "d"
|
||||
|> createRecord
|
||||
widget <- newRecord @Widget
|
||||
|> set #hubId hub.id |> set #name "Dash Widget" |> set #widgetType "panel"
|
||||
|> createRecord
|
||||
candidate <- newRecord @RequirementCandidate
|
||||
|> set #title "Dashboard candidate" |> set #description "d"
|
||||
|> set #sourceWidgetId widget.id |> set #category "friction"
|
||||
|> set #status "open" |> createRecord
|
||||
-- Verify fetch path used by dashboard action
|
||||
widgets <- query @Widget |> filterWhere (#hubId, hub.id) |> fetch
|
||||
candidates <- query @RequirementCandidate
|
||||
|> filterWhereIn (#sourceWidgetId, map (.id) widgets)
|
||||
|> fetch
|
||||
length widgets `shouldBe` 1
|
||||
length candidates `shouldBe` 1
|
||||
deleteRecord hub
|
||||
|
||||
Reference in New Issue
Block a user