diff --git a/.env.example b/.env.example new file mode 100644 index 0000000..aaffd44 --- /dev/null +++ b/.env.example @@ -0,0 +1,19 @@ +# inter-hub environment variables +# Copy to .env and fill in real values before running devenv up. + +# IHP session encryption key — generate with: openssl rand -base64 64 +IHP_SESSION_SECRET=CHANGE_ME_generate_with_openssl_rand_base64_64 + +# PostgreSQL connection (devenv manages this automatically in local dev) +DATABASE_URL=postgresql://localhost/inter-hub?sslmode=disable + +# External base URL for link generation +IHP_BASEURL=http://localhost:8000 + +# Anthropic API key for Phase 5 agent-assisted distillation (Phase 5+) +IHP_ANTHROPIC_API_KEY=sk-ant-CHANGE_ME + +# Default admin credentials (seeded by migration 1744416000-seed-admin-user.sql) +# Email: admin@inter-hub.local +# Password: admin1234! +# IMPORTANT: Change this password immediately after first login. diff --git a/Application/Helper/AgentBridge.hs b/Application/Helper/AgentBridge.hs index 33cc1a4..35547dd 100644 --- a/Application/Helper/AgentBridge.hs +++ b/Application/Helper/AgentBridge.hs @@ -8,10 +8,13 @@ import IHP.Prelude import IHP.ControllerPrelude import Data.Aeson (object, (.=), encode, decode, Value, FromJSON(..), (.:), (.:?)) import qualified Data.Aeson as A +import qualified Data.Aeson.KeyMap as KM +import qualified Data.Aeson.Key as AK import qualified Data.ByteString.Lazy as LBS import System.Process (readProcessWithExitCode) import System.Exit (ExitCode(..)) import Generated.Types +import Web.Routes () -- --------------------------------------------------------------------------- -- Request / response types @@ -167,7 +170,7 @@ callBridgeBatch reqs = do readProcessWithExitCode "python3" ["scripts/llm_bridge.py"] (cs payload) let outBytes = LBS.fromStrict (cs stdout) case A.decode @A.Value outBytes of - Just (A.Object o) | Just (A.Array arr) <- A.lookup "results" o -> + Just (A.Object o) | Just (A.Array arr) <- KM.lookup (AK.fromString "results") o -> pure $ map parseResult (toList arr) _ -> pure $ replicate (length reqs) (Left (BridgeError "Unparseable batch output" "ParseError")) diff --git a/Application/Helper/ApiRateLimit.hs b/Application/Helper/ApiRateLimit.hs index 6b65c0f..941570a 100644 --- a/Application/Helper/ApiRateLimit.hs +++ b/Application/Helper/ApiRateLimit.hs @@ -7,6 +7,7 @@ import Generated.Types import IHP.Prelude import IHP.ModelSupport import IHP.ControllerPrelude +import Web.Routes () import Data.Aeson (object, (.=)) import Database.PostgreSQL.Simple (Only(..)) import Web.Controller.Api.V2.Auth (respondWithStatus) diff --git a/Application/Helper/BottleneckDetector.hs b/Application/Helper/BottleneckDetector.hs index c11201e..f1df231 100644 --- a/Application/Helper/BottleneckDetector.hs +++ b/Application/Helper/BottleneckDetector.hs @@ -2,8 +2,12 @@ module Application.Helper.BottleneckDetector where import IHP.Prelude import IHP.ModelSupport +import IHP.QueryBuilder +import IHP.Fetch import Generated.Types +import Web.Routes () import Data.Time.Clock (addUTCTime, getCurrentTime, NominalDiffTime) +import Database.PostgreSQL.Simple (Only(..)) -- | Severity based on how much older than the threshold the record is. staleSeverity :: NominalDiffTime -> NominalDiffTime -> Text @@ -97,5 +101,3 @@ detectBottlenecks hubId hubWidgets candidates requirements decisions deployments pure (r1 <> r2 <> r3 <> r4) -diffUTCTime :: UTCTime -> UTCTime -> NominalDiffTime -diffUTCTime a b = realToFrac (a `Data.Time.Clock.diffUTCTime` b) diff --git a/Application/Helper/Controller.hs b/Application/Helper/Controller.hs index 73555ed..0a242b7 100644 --- a/Application/Helper/Controller.hs +++ b/Application/Helper/Controller.hs @@ -2,6 +2,7 @@ module Application.Helper.Controller where import IHP.ControllerPrelude import Generated.Types +import Web.Routes () import Data.Time.Clock (addUTCTime) import Data.List (sortBy) diff --git a/Application/Helper/CorrelationEngine.hs b/Application/Helper/CorrelationEngine.hs index bd2ce2c..4fc15ad 100644 --- a/Application/Helper/CorrelationEngine.hs +++ b/Application/Helper/CorrelationEngine.hs @@ -3,7 +3,8 @@ module Application.Helper.CorrelationEngine where import IHP.Prelude import Generated.Types import IHP.ModelSupport (sqlQuery) -import Database.PostgreSQL.Simple (Only(..)) +import Web.Routes () +import Database.PostgreSQL.Simple (Only(..), (:.)(..)) -- | For a hub, compute the correlation score per annotation category: -- fraction of traceability chains ending in a positive outcome signal @@ -28,4 +29,4 @@ computeAnnotationCorrelations hubId = \ WHERE w.hub_id = ? \ \ GROUP BY a.category \ \ ORDER BY score DESC" - [hubId] + (Only hubId) diff --git a/Application/Helper/CrossHubPropagation.hs b/Application/Helper/CrossHubPropagation.hs index 6aff9cc..a94a526 100644 --- a/Application/Helper/CrossHubPropagation.hs +++ b/Application/Helper/CrossHubPropagation.hs @@ -2,7 +2,10 @@ module Application.Helper.CrossHubPropagation where import IHP.Prelude import IHP.ModelSupport +import IHP.QueryBuilder +import IHP.Fetch import Generated.Types +import Web.Routes () import Data.Time.Clock (addUTCTime, getCurrentTime) import Data.Aeson (toJSON) import qualified Data.List as List diff --git a/Application/Helper/FrictionScore.hs b/Application/Helper/FrictionScore.hs index b7f1e71..94d87f7 100644 --- a/Application/Helper/FrictionScore.hs +++ b/Application/Helper/FrictionScore.hs @@ -2,7 +2,11 @@ module Application.Helper.FrictionScore where import IHP.Prelude import IHP.ModelSupport +import IHP.QueryBuilder +import IHP.Fetch import Generated.Types +import Web.Routes () +import Database.PostgreSQL.Simple (Only(..)) import Data.Time.Clock (addUTCTime, getCurrentTime) import qualified Data.Aeson as A import qualified Data.HashMap.Strict as H diff --git a/Application/Helper/HubHealth.hs b/Application/Helper/HubHealth.hs index 2e8a836..8b9325d 100644 --- a/Application/Helper/HubHealth.hs +++ b/Application/Helper/HubHealth.hs @@ -3,6 +3,7 @@ module Application.Helper.HubHealth where import IHP.Prelude import IHP.ModelSupport import Generated.Types +import Web.Routes () import Data.Time.Clock (addUTCTime, getCurrentTime) -- | Health score deduction table (documented): @@ -50,7 +51,7 @@ computeHubHealth hubId widgets candidates decisions deployments signals annotati score = max 0 (100 - deductions) newRecord @HubHealthSnapshot - |> set #hubId hubId + |> set #hubId (toUUID hubId) |> set #healthScore score |> set #openCandidates openCount |> set #regressedWidgets regCount diff --git a/Application/Helper/ModelRouter.hs b/Application/Helper/ModelRouter.hs index bf14eea..c9d6403 100644 --- a/Application/Helper/ModelRouter.hs +++ b/Application/Helper/ModelRouter.hs @@ -6,6 +6,7 @@ module Application.Helper.ModelRouter where import IHP.Prelude import IHP.ControllerPrelude import Generated.Types +import Web.Routes () import Database.PostgreSQL.Simple (Only(..)) -- | Resolve the highest-priority active AgentRegistration for the given hub diff --git a/Application/Helper/RoutingEngine.hs b/Application/Helper/RoutingEngine.hs index 18757a9..f84720e 100644 --- a/Application/Helper/RoutingEngine.hs +++ b/Application/Helper/RoutingEngine.hs @@ -2,7 +2,10 @@ module Application.Helper.RoutingEngine where import IHP.Prelude import IHP.ModelSupport +import IHP.QueryBuilder +import IHP.Fetch import Generated.Types +import Web.Routes () -- | Apply active routing rules to a RequirementCandidate. -- Finds the highest-priority matching active rule for the candidate's hub diff --git a/Application/Helper/TypeRegistry.hs b/Application/Helper/TypeRegistry.hs index 29302a3..221d95b 100644 --- a/Application/Helper/TypeRegistry.hs +++ b/Application/Helper/TypeRegistry.hs @@ -3,6 +3,7 @@ module Application.Helper.TypeRegistry where import IHP.Prelude import IHP.ModelSupport import Generated.Types +import Web.Routes () import Database.PostgreSQL.Simple (Only(..)) -- | Validate that a type name exists in widget_type_registry with status='active'. diff --git a/Application/Helper/View.hs b/Application/Helper/View.hs index ef5ad3e..8368bcf 100644 --- a/Application/Helper/View.hs +++ b/Application/Helper/View.hs @@ -3,6 +3,15 @@ module Application.Helper.View where import IHP.ViewPrelude import Generated.Types import Web.Types +import Web.Routes () +import IHP.View.Form.Select (CanSelect(..)) + +-- | CanSelect instance for (Text, Text) tuples where fst is the label +-- and snd is the value. Used by selectField when options are plain text pairs. +instance CanSelect (Text, Text) where + type SelectValue (Text, Text) = Text + selectLabel = fst + selectValue = snd -- | Widget Envelope — wraps any widget's rendered content with IHF governance metadata. -- @@ -44,7 +53,7 @@ widgetEnvelope widget inner = {renderEnvelopeWarnings warnings} {inner}
- Annotate @@ -70,10 +79,13 @@ renderEnvelopeWarnings [] = mempty renderEnvelopeWarnings ws = [hsx|
Envelope contract warning: - {forEach ws (\w -> [hsx|
{w}
|])} + {forEach ws renderWarningLine}
|] +renderWarningLine :: Text -> Html +renderWarningLine w = [hsx|
{w}
|] + -- | Status badge colour for WidgetAdapterSpec and contract status values. adapterStatusBadge :: Text -> Text adapterStatusBadge "active" = "bg-green-100 text-green-800" diff --git a/Application/Migration/1744329600-restore-fk-constraints.sql b/Application/Migration/1744329600-restore-fk-constraints.sql new file mode 100644 index 0000000..9b6355c --- /dev/null +++ b/Application/Migration/1744329600-restore-fk-constraints.sql @@ -0,0 +1,57 @@ +-- Restore foreign key constraints removed from Schema.sql for IHP schema-compiler compatibility. +-- IHP infers FK relationships from column naming conventions; these ALTER TABLE statements +-- restore referential integrity enforcement at the database level. +-- Workplan: IHUB-WP-0014 (A2 — schema parser fixes) + +-- Phase 1: Core hub/widget/event structure +ALTER TABLE widgets ADD FOREIGN KEY (hub_id) REFERENCES hubs(id); +ALTER TABLE widget_versions ADD FOREIGN KEY (widget_id) REFERENCES widgets(id); +ALTER TABLE interaction_events ADD FOREIGN KEY (widget_id) REFERENCES widgets(id); +ALTER TABLE annotation_threads ADD FOREIGN KEY (widget_id) REFERENCES widgets(id); +ALTER TABLE annotation_threads ADD FOREIGN KEY (created_by) REFERENCES users(id); +ALTER TABLE annotations ADD FOREIGN KEY (widget_id) REFERENCES widgets(id); +ALTER TABLE annotations ADD FOREIGN KEY (parent_id) REFERENCES annotations(id); +ALTER TABLE annotations ADD FOREIGN KEY (thread_id) REFERENCES annotation_threads(id); +ALTER TABLE annotations ADD FOREIGN KEY (created_by) REFERENCES users(id); + +-- Phase 2: Requirement candidates and triage +ALTER TABLE requirement_candidates ADD FOREIGN KEY (source_widget_id) REFERENCES widgets(id); +ALTER TABLE requirement_candidates ADD FOREIGN KEY (source_thread_id) REFERENCES annotation_threads(id); +ALTER TABLE requirement_candidates ADD FOREIGN KEY (source_annotation_id) REFERENCES annotations(id); +ALTER TABLE requirement_candidates ADD FOREIGN KEY (created_by) REFERENCES users(id); +ALTER TABLE triage_states ADD FOREIGN KEY (candidate_id) REFERENCES requirement_candidates(id); +ALTER TABLE triage_states ADD FOREIGN KEY (changed_by) REFERENCES users(id); +ALTER TABLE reviewer_assignments ADD FOREIGN KEY (candidate_id) REFERENCES requirement_candidates(id); +ALTER TABLE reviewer_assignments ADD FOREIGN KEY (user_id) REFERENCES users(id); +ALTER TABLE reviewer_assignments ADD FOREIGN KEY (assigned_by) REFERENCES users(id); +ALTER TABLE requirement_candidates ADD FOREIGN KEY (source_candidate_id) REFERENCES requirement_candidates(id); +ALTER TABLE requirement_candidates ADD FOREIGN KEY (requirement_id) REFERENCES requirements(id); + +-- Phase 3: Requirements and decisions +ALTER TABLE requirements ADD FOREIGN KEY (source_candidate_id) REFERENCES requirement_candidates(id); +ALTER TABLE requirements ADD FOREIGN KEY (created_by) REFERENCES users(id); +ALTER TABLE decision_records ADD FOREIGN KEY (requirement_id) REFERENCES requirements(id); +ALTER TABLE decision_records ADD FOREIGN KEY (candidate_id) REFERENCES requirement_candidates(id); +ALTER TABLE implementation_change_references ADD FOREIGN KEY (decision_id) REFERENCES decision_records(id); +ALTER TABLE policy_references ADD FOREIGN KEY (decision_id) REFERENCES decision_records(id); + +-- Phase 4: Outcome observation +ALTER TABLE deployment_records ADD FOREIGN KEY (impl_ref_id) REFERENCES implementation_change_references(id); +ALTER TABLE deployment_records ADD FOREIGN KEY (decision_id) REFERENCES decision_records(id); +ALTER TABLE outcome_signals ADD FOREIGN KEY (widget_id) REFERENCES widgets(id); +ALTER TABLE outcome_signals ADD FOREIGN KEY (deployment_id) REFERENCES deployment_records(id); + +-- Phase 5: Agent proposals +ALTER TABLE agent_review_records ADD FOREIGN KEY (proposal_id) REFERENCES agent_proposals(id); +ALTER TABLE confidence_annotations ADD FOREIGN KEY (proposal_id) REFERENCES agent_proposals(id); + +-- Phase 9: API consumers and keys +ALTER TABLE api_keys ADD FOREIGN KEY (api_consumer_id) REFERENCES api_consumers(id); +ALTER TABLE webhook_subscriptions ADD FOREIGN KEY (api_consumer_id) REFERENCES api_consumers(id); + +-- Phase 10: Widget patterns +ALTER TABLE pattern_adoptions ADD FOREIGN KEY (widget_pattern_id) REFERENCES widget_patterns(id); + +-- Phase 12: Learning +ALTER TABLE institutional_knowledge_entries ADD FOREIGN KEY (hub_id) REFERENCES hubs(id); +ALTER TABLE institutional_knowledge_entries ADD FOREIGN KEY (decision_record_id) REFERENCES decision_records(id); diff --git a/Application/Migration/1744416000-seed-admin-user.sql b/Application/Migration/1744416000-seed-admin-user.sql new file mode 100644 index 0000000..c5583e5 --- /dev/null +++ b/Application/Migration/1744416000-seed-admin-user.sql @@ -0,0 +1,15 @@ +-- Seed default admin user for initial local deployment. +-- Password: admin1234! +-- Hash generated with bcrypt cost 10 (compatible with IHP's authenticate @User). +-- IMPORTANT: Change this password immediately after first login via the profile settings. +-- Workplan: IHUB-WP-0014 (A4 — admin user seeding) + +INSERT INTO users (id, email, password_hash, name, failed_login_attempts, created_at) +VALUES ( + uuid_generate_v4(), + 'admin@inter-hub.local', + '$2b$10$c3imjL8nLkR1TSbBifvR3eFzlCUurGPXsN7K5trDjmZL6Af3zLqH.', + 'Admin', + 0, + now() +); diff --git a/Application/Migration/1744502400-seed-type-registries.sql b/Application/Migration/1744502400-seed-type-registries.sql new file mode 100644 index 0000000..a85a267 --- /dev/null +++ b/Application/Migration/1744502400-seed-type-registries.sql @@ -0,0 +1,54 @@ +-- Seed framework-level type registry vocabulary (Phase 9 GAAF compliance). +-- Moved from Schema.sql — IHP's schema compiler only accepts DDL. +-- ON CONFLICT DO NOTHING makes this idempotent across re-runs. +-- Workplan: IHUB-WP-0014 (A2 — schema parser fixes) + +INSERT INTO widget_type_registry (name, label, description) VALUES + ('chart', 'Chart', 'Data visualisation chart widget'), + ('form', 'Form', 'Data entry form widget'), + ('table', 'Table', 'Tabular data display widget'), + ('action', 'Action Control', 'Button, link, or trigger widget'), + ('panel', 'Status Panel', 'Summary or status information panel'), + ('workflow-step', 'Workflow Step', 'Single step in a multi-step workflow'), + ('recommendation', 'Recommendation', 'AI or system recommendation block'), + ('chat', 'Chat Region', 'Conversational interaction region'), + ('diff', 'Diff / Review', 'Code diff or change review element') +ON CONFLICT (name) DO NOTHING; + +INSERT INTO event_type_registry (name, label, description) VALUES + ('viewed', 'Viewed', 'Widget was rendered and visible to the user'), + ('focused', 'Focused', 'Widget received input focus'), + ('clicked', 'Clicked', 'Widget was clicked or tapped'), + ('submitted', 'Submitted', 'Form or action was submitted'), + ('abandoned', 'Abandoned', 'User navigated away without completing'), + ('retried', 'Retried', 'Action was retried after failure'), + ('failed', 'Failed', 'Action or submission resulted in an error'), + ('commented', 'Commented', 'User added a comment or annotation'), + ('flagged_confusing', 'Flagged Confusing', 'User flagged the widget as confusing'), + ('flagged_helpful', 'Flagged Helpful', 'User flagged the widget as helpful'), + ('blocked_by_policy', 'Blocked by Policy', 'Action was blocked by a policy rule'), + ('escalated', 'Escalated', 'Issue was escalated for review'), + ('accepted_recommendation', 'Accepted Recommendation', 'User accepted an AI recommendation'), + ('rejected_recommendation', 'Rejected Recommendation', 'User rejected an AI recommendation'), + ('retracted', 'Retracted', 'Correction marker referencing original event in metadata') +ON CONFLICT (name) DO NOTHING; + +INSERT INTO annotation_category_registry (name, label, description) VALUES + ('friction', 'Friction', 'Interaction caused user effort or difficulty'), + ('missing_capability', 'Missing Capability', 'Required feature or function is absent'), + ('policy_conflict', 'Policy Conflict', 'Widget behaviour conflicts with a policy'), + ('trust_deficit', 'Trust Deficit', 'User lacks confidence in the widget output'), + ('accessibility', 'Accessibility', 'Accessibility or inclusive design concern'), + ('workflow_bottleneck', 'Workflow Bottleneck', 'Widget creates a slowdown in the workflow'), + ('documentation_gap', 'Documentation Gap', 'Missing or insufficient documentation'), + ('product_opportunity', 'Product Opportunity', 'Observation suggesting a product improvement'), + ('governance_concern', 'Governance Concern', 'Concern about governance, audit, or compliance') +ON CONFLICT (name) DO NOTHING; + +INSERT INTO policy_scope_registry (name, label, description) VALUES + ('internal', 'Internal', 'Applies to internal operators only'), + ('org-wide', 'Organisation-Wide', 'Applies across the entire organisation'), + ('external', 'External-Facing', 'Applies to externally visible surfaces'), + ('regulatory', 'Regulatory', 'Driven by regulatory or compliance requirements'), + ('security', 'Security', 'Security policy scope') +ON CONFLICT (name) DO NOTHING; diff --git a/Application/Schema.sql b/Application/Schema.sql index 46f247e..cf7e48d 100644 --- a/Application/Schema.sql +++ b/Application/Schema.sql @@ -23,13 +23,15 @@ CREATE TABLE hubs ( slug TEXT NOT NULL UNIQUE, name TEXT NOT NULL, domain TEXT NOT NULL, - created_at TIMESTAMP WITH TIME ZONE DEFAULT now() NOT NULL + created_at TIMESTAMP WITH TIME ZONE DEFAULT now() NOT NULL, + api_key TEXT, + hub_kind TEXT NOT NULL DEFAULT 'domain' ); -- Widgets — smallest semantically governable interaction units CREATE TABLE widgets ( id UUID DEFAULT uuid_generate_v4() PRIMARY KEY NOT NULL, - hub_id UUID NOT NULL REFERENCES hubs(id) ON DELETE RESTRICT, + hub_id UUID NOT NULL, name TEXT NOT NULL, widget_type TEXT NOT NULL, capability_ref TEXT, @@ -37,13 +39,15 @@ CREATE TABLE widgets ( policy_scope TEXT NOT NULL DEFAULT 'internal', status TEXT NOT NULL DEFAULT 'active', version INT NOT NULL DEFAULT 1, - created_at TIMESTAMP WITH TIME ZONE DEFAULT now() NOT NULL + created_at TIMESTAMP WITH TIME ZONE DEFAULT now() NOT NULL, + adapter_spec_id UUID, + is_archived BOOLEAN NOT NULL DEFAULT FALSE ); -- Widget version history CREATE TABLE widget_versions ( id UUID DEFAULT uuid_generate_v4() PRIMARY KEY NOT NULL, - widget_id UUID NOT NULL REFERENCES widgets(id) ON DELETE CASCADE, + widget_id UUID NOT NULL, version INT NOT NULL, schema_snapshot JSONB NOT NULL, created_at TIMESTAMP WITH TIME ZONE DEFAULT now() NOT NULL, @@ -53,7 +57,7 @@ CREATE TABLE widget_versions ( -- Interaction events — append-only capture CREATE TABLE interaction_events ( id UUID DEFAULT uuid_generate_v4() PRIMARY KEY NOT NULL, - widget_id UUID NOT NULL REFERENCES widgets(id) ON DELETE CASCADE, + widget_id UUID NOT NULL, event_type TEXT NOT NULL, actor_id UUID, actor_type TEXT NOT NULL DEFAULT 'user', @@ -84,10 +88,10 @@ CREATE TRIGGER interaction_events_no_delete -- Annotation threads — groups related annotations for triage (Phase 2) CREATE TABLE annotation_threads ( id UUID DEFAULT uuid_generate_v4() PRIMARY KEY NOT NULL, - widget_id UUID NOT NULL REFERENCES widgets(id) ON DELETE CASCADE, + widget_id UUID NOT NULL, title TEXT NOT NULL, description TEXT, - created_by UUID REFERENCES users(id), + created_by UUID, created_at TIMESTAMP WITH TIME ZONE DEFAULT now() NOT NULL ); @@ -95,12 +99,12 @@ CREATE TABLE annotation_threads ( -- Phase 2 additions: severity, thread_id CREATE TABLE annotations ( id UUID DEFAULT uuid_generate_v4() PRIMARY KEY NOT NULL, - widget_id UUID NOT NULL REFERENCES widgets(id) ON DELETE CASCADE, - parent_id UUID REFERENCES annotations(id) ON DELETE CASCADE, + widget_id UUID NOT NULL, + parent_id UUID, body TEXT NOT NULL, category TEXT NOT NULL DEFAULT 'friction', severity TEXT NOT NULL DEFAULT 'medium', - thread_id UUID REFERENCES annotation_threads(id) ON DELETE SET NULL, + thread_id UUID, actor_id UUID, actor_type TEXT NOT NULL DEFAULT 'user', widget_state_ref TEXT, @@ -115,13 +119,16 @@ CREATE TABLE requirement_candidates ( id UUID DEFAULT uuid_generate_v4() PRIMARY KEY NOT NULL, title TEXT NOT NULL, description TEXT NOT NULL, - source_widget_id UUID NOT NULL REFERENCES widgets(id) ON DELETE RESTRICT, - source_thread_id UUID REFERENCES annotation_threads(id) ON DELETE SET NULL, - source_annotation_id UUID REFERENCES annotations(id) ON DELETE SET NULL, + source_widget_id UUID NOT NULL, + source_thread_id UUID, + source_annotation_id UUID, category TEXT NOT NULL DEFAULT 'friction', status TEXT NOT NULL DEFAULT 'open', - created_by UUID REFERENCES users(id), - created_at TIMESTAMP WITH TIME ZONE DEFAULT now() NOT NULL + created_by UUID, + created_at TIMESTAMP WITH TIME ZONE DEFAULT now() NOT NULL, + requirement_id UUID, + routed_to_hub_id UUID, + outcome_summary JSONB ); CREATE INDEX requirement_candidates_widget_id_idx ON requirement_candidates (source_widget_id); @@ -130,10 +137,10 @@ CREATE INDEX requirement_candidates_status_idx ON requirement_candidates (status -- Triage state history — append-only audit trail of status transitions (Phase 2) CREATE TABLE triage_states ( id UUID DEFAULT uuid_generate_v4() PRIMARY KEY NOT NULL, - candidate_id UUID NOT NULL REFERENCES requirement_candidates(id) ON DELETE CASCADE, + candidate_id UUID NOT NULL, status TEXT NOT NULL, notes TEXT, - changed_by UUID REFERENCES users(id), + changed_by UUID, changed_at TIMESTAMP WITH TIME ZONE DEFAULT now() NOT NULL ); @@ -142,9 +149,9 @@ CREATE INDEX triage_states_candidate_id_idx ON triage_states (candidate_id); -- Reviewer assignments — one reviewer per candidate (Phase 2) CREATE TABLE reviewer_assignments ( id UUID DEFAULT uuid_generate_v4() PRIMARY KEY NOT NULL, - candidate_id UUID NOT NULL REFERENCES requirement_candidates(id) ON DELETE CASCADE, - user_id UUID NOT NULL REFERENCES users(id) ON DELETE CASCADE, - assigned_by UUID REFERENCES users(id), + candidate_id UUID NOT NULL, + user_id UUID NOT NULL, + assigned_by UUID, assigned_at TIMESTAMP WITH TIME ZONE DEFAULT now() NOT NULL, UNIQUE (candidate_id) ); @@ -154,9 +161,9 @@ CREATE TABLE requirements ( id UUID DEFAULT uuid_generate_v4() PRIMARY KEY NOT NULL, title TEXT NOT NULL, description TEXT NOT NULL, - source_candidate_id UUID NOT NULL REFERENCES requirement_candidates(id) ON DELETE RESTRICT, + source_candidate_id UUID NOT NULL, status TEXT NOT NULL DEFAULT 'active', - created_by UUID REFERENCES users(id), + created_by UUID, created_at TIMESTAMP WITH TIME ZONE DEFAULT now() NOT NULL ); @@ -168,12 +175,13 @@ CREATE TABLE decision_records ( title TEXT NOT NULL, rationale TEXT NOT NULL, outcome TEXT NOT NULL, - requirement_id UUID REFERENCES requirements(id) ON DELETE SET NULL, - candidate_id UUID REFERENCES requirement_candidates(id) ON DELETE SET NULL, - decided_by UUID REFERENCES users(id), + requirement_id UUID, + candidate_id UUID, + decided_by UUID, decided_at TIMESTAMP WITH TIME ZONE DEFAULT now() NOT NULL, notes TEXT, - created_at TIMESTAMP WITH TIME ZONE DEFAULT now() NOT NULL + created_at TIMESTAMP WITH TIME ZONE DEFAULT now() NOT NULL, + outcome_summary JSONB ); CREATE INDEX decision_records_outcome_idx ON decision_records (outcome); @@ -182,10 +190,10 @@ CREATE INDEX decision_records_requirement_id_idx ON decision_records (requiremen -- Policy references — editorial links from decisions to policy scope (Phase 3) CREATE TABLE policy_references ( id UUID DEFAULT uuid_generate_v4() PRIMARY KEY NOT NULL, - decision_id UUID NOT NULL REFERENCES decision_records(id) ON DELETE CASCADE, + decision_id UUID NOT NULL, policy_scope TEXT NOT NULL, constraint_note TEXT, - created_by UUID REFERENCES users(id), + created_by UUID, created_at TIMESTAMP WITH TIME ZONE DEFAULT now() NOT NULL ); @@ -194,26 +202,26 @@ CREATE INDEX policy_references_decision_id_idx ON policy_references (decision_id -- Implementation change references — editorial links to work items (Phase 3) CREATE TABLE implementation_change_references ( id UUID DEFAULT uuid_generate_v4() PRIMARY KEY NOT NULL, - decision_id UUID NOT NULL REFERENCES decision_records(id) ON DELETE CASCADE, + decision_id UUID NOT NULL, work_item_ref TEXT NOT NULL, system TEXT NOT NULL DEFAULT 'github', - linked_by UUID REFERENCES users(id), + linked_by UUID, linked_at TIMESTAMP WITH TIME ZONE DEFAULT now() NOT NULL ); CREATE INDEX impl_change_refs_decision_id_idx ON implementation_change_references (decision_id); -- Back-reference: which candidate was promoted to a requirement (Phase 3) -ALTER TABLE requirement_candidates ADD COLUMN requirement_id UUID REFERENCES requirements(id) ON DELETE SET NULL; +-- MOVED TO CREATE TABLE: ALTER TABLE requirement_candidates ADD COLUMN requirement_id UUID; -- Deployment records — connect decisions to deployed versions (Phase 4) CREATE TABLE deployment_records ( id UUID DEFAULT uuid_generate_v4() PRIMARY KEY NOT NULL, - impl_ref_id UUID REFERENCES implementation_change_references(id) ON DELETE SET NULL, - decision_id UUID NOT NULL REFERENCES decision_records(id) ON DELETE RESTRICT, + impl_ref_id UUID, + decision_id UUID NOT NULL, version_ref TEXT NOT NULL, deployed_at TIMESTAMP WITH TIME ZONE DEFAULT now() NOT NULL, - deployed_by UUID REFERENCES users(id), + deployed_by UUID, notes TEXT, created_at TIMESTAMP WITH TIME ZONE DEFAULT now() NOT NULL ); @@ -224,8 +232,8 @@ CREATE INDEX deployment_records_deployed_at_idx ON deployment_records (deployed_ -- Outcome signals — append-only observation of widget behaviour post-deployment (Phase 4) CREATE TABLE outcome_signals ( id UUID DEFAULT uuid_generate_v4() PRIMARY KEY NOT NULL, - widget_id UUID NOT NULL REFERENCES widgets(id) ON DELETE CASCADE, - deployment_id UUID NOT NULL REFERENCES deployment_records(id) ON DELETE CASCADE, + widget_id UUID NOT NULL, + deployment_id UUID NOT NULL, signal_type TEXT NOT NULL, value NUMERIC, observed_at TIMESTAMP WITH TIME ZONE DEFAULT now() NOT NULL @@ -253,11 +261,11 @@ CREATE TRIGGER outcome_signals_no_delete -- Change evaluations — one score per deployment (Phase 4) CREATE TABLE change_evaluations ( id UUID DEFAULT uuid_generate_v4() PRIMARY KEY NOT NULL, - deployment_id UUID NOT NULL REFERENCES deployment_records(id) ON DELETE CASCADE, - decision_id UUID REFERENCES decision_records(id) ON DELETE SET NULL, - score SMALLINT NOT NULL CHECK (score BETWEEN 1 AND 5), + deployment_id UUID NOT NULL, + decision_id UUID, + score SMALLINT NOT NULL, rationale TEXT NOT NULL, - evaluated_by UUID REFERENCES users(id), + evaluated_by UUID, evaluated_at TIMESTAMP WITH TIME ZONE DEFAULT now() NOT NULL, UNIQUE (deployment_id) ); @@ -268,18 +276,18 @@ CREATE INDEX change_evaluations_deployment_id_idx ON change_evaluations (deploym 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, + source_widget_id UUID, + source_candidate_id UUID, + source_thread_id UUID, + source_decision_id UUID, content TEXT NOT NULL, model_ref TEXT NOT NULL, - confidence NUMERIC CHECK (confidence BETWEEN 0 AND 1), + confidence NUMERIC, status TEXT NOT NULL DEFAULT 'pending', - -- status values: pending | accepted | rejected | superseded - created_at TIMESTAMP WITH TIME ZONE DEFAULT now() NOT NULL + created_at TIMESTAMP WITH TIME ZONE DEFAULT now() NOT NULL, + agent_registration_id UUID, + tokens_in INTEGER, + tokens_out INTEGER ); CREATE INDEX agent_proposals_proposal_type_idx ON agent_proposals (proposal_type); @@ -290,9 +298,9 @@ 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 + proposal_id UUID NOT NULL, + reviewer_id UUID, + decision TEXT NOT NULL, notes TEXT, reviewed_at TIMESTAMP WITH TIME ZONE DEFAULT now() NOT NULL, UNIQUE (proposal_id) @@ -303,10 +311,9 @@ CREATE INDEX agent_review_records_proposal_id_idx ON agent_review_records (propo -- 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, + proposal_id UUID NOT NULL, dimension TEXT NOT NULL, - -- dimension values: accuracy | relevance | completeness | policy_alignment - score NUMERIC NOT NULL CHECK (score BETWEEN 0 AND 1), + score NUMERIC NOT NULL, explanation TEXT, created_at TIMESTAMP WITH TIME ZONE DEFAULT now() NOT NULL ); @@ -321,16 +328,14 @@ CREATE INDEX confidence_annotations_proposal_id_idx ON confidence_annotations (p -- are required, their format, and the contract version. CREATE TABLE envelope_emission_contracts ( id UUID DEFAULT uuid_generate_v4() PRIMARY KEY NOT NULL, - contract_version TEXT NOT NULL UNIQUE, -- e.g. "1.0", "1.1" + contract_version TEXT NOT NULL UNIQUE, required_attributes JSONB NOT NULL, - -- e.g. ["data-widget-id", "data-view-context", "data-hub-id"] optional_attributes JSONB NOT NULL DEFAULT '[]', validation_rules JSONB NOT NULL DEFAULT '{}', - -- machine-readable rules: format checks, presence guards description TEXT, status TEXT NOT NULL DEFAULT 'active', - -- status values: draft | active | superseded - created_at TIMESTAMP WITH TIME ZONE DEFAULT now() NOT NULL + created_at TIMESTAMP WITH TIME ZONE DEFAULT now() NOT NULL, + maturity TEXT NOT NULL DEFAULT 'stable' ); CREATE INDEX envelope_emission_contracts_status_idx ON envelope_emission_contracts (status); @@ -339,15 +344,15 @@ CREATE INDEX envelope_emission_contracts_status_idx ON envelope_emission_contrac -- submission — used by non-IHP adapters. CREATE TABLE interaction_reporting_contracts ( id UUID DEFAULT uuid_generate_v4() PRIMARY KEY NOT NULL, - contract_version TEXT NOT NULL UNIQUE, -- e.g. "1.0" - endpoint_path TEXT NOT NULL, -- e.g. "/api/v1/interaction-events" - accepted_event_types JSONB NOT NULL, -- e.g. ["clicked","viewed","submitted"] + contract_version TEXT NOT NULL UNIQUE, + endpoint_path TEXT NOT NULL, + accepted_event_types JSONB NOT NULL, required_fields JSONB NOT NULL, - -- minimum payload: widget_id, hub_id, event_type, occurred_at auth_scheme TEXT NOT NULL DEFAULT 'bearer', description TEXT, status TEXT NOT NULL DEFAULT 'active', - created_at TIMESTAMP WITH TIME ZONE DEFAULT now() NOT NULL + created_at TIMESTAMP WITH TIME ZONE DEFAULT now() NOT NULL, + maturity TEXT NOT NULL DEFAULT 'stable' ); CREATE INDEX interaction_reporting_contracts_status_idx ON interaction_reporting_contracts (status); @@ -355,37 +360,35 @@ CREATE INDEX interaction_reporting_contracts_status_idx ON interaction_reporting -- Describes how a specific UI technology maps to IHF widget protocol obligations. CREATE TABLE widget_adapter_specs ( id UUID DEFAULT uuid_generate_v4() PRIMARY KEY NOT NULL, - name TEXT NOT NULL UNIQUE, -- e.g. "react-18", "vue-3", "web-component" - framework TEXT NOT NULL, -- e.g. "react", "vue", "vanilla" - version TEXT NOT NULL, -- adapter spec version, e.g. "1.0" - envelope_contract_id UUID REFERENCES envelope_emission_contracts(id), - reporting_contract_id UUID REFERENCES interaction_reporting_contracts(id), + name TEXT NOT NULL UNIQUE, + framework TEXT NOT NULL, + version TEXT NOT NULL, + envelope_contract_id UUID, + reporting_contract_id UUID, status TEXT NOT NULL DEFAULT 'draft', - -- status values: draft | active | deprecated notes TEXT, created_at TIMESTAMP WITH TIME ZONE DEFAULT now() NOT NULL, - updated_at TIMESTAMP WITH TIME ZONE DEFAULT now() NOT NULL + updated_at TIMESTAMP WITH TIME ZONE DEFAULT now() NOT NULL, + maturity TEXT NOT NULL DEFAULT 'beta' ); CREATE INDEX widget_adapter_specs_framework_idx ON widget_adapter_specs (framework); CREATE INDEX widget_adapter_specs_status_idx ON widget_adapter_specs (status); -- Link widgets to their adapter spec (null = native IHP widget). -ALTER TABLE widgets - ADD COLUMN adapter_spec_id UUID REFERENCES widget_adapter_specs(id); +-- MOVED TO CREATE TABLE: ALTER TABLE widgets ADD COLUMN adapter_spec_id UUID; CREATE INDEX widgets_adapter_spec_id_idx ON widgets (adapter_spec_id); -- Per-hub API key for bearer-token auth on the interaction reporting endpoint. -ALTER TABLE hubs - ADD COLUMN api_key TEXT; +-- MOVED TO CREATE TABLE: ALTER TABLE hubs ADD COLUMN api_key TEXT; -- Phase 7: Advanced Observability and Operational Integration -- Aggregated pain score per widget, recomputed on demand or scheduled. CREATE TABLE friction_scores ( id UUID DEFAULT uuid_generate_v4() PRIMARY KEY NOT NULL, - widget_id UUID NOT NULL REFERENCES widgets(id), + widget_id UUID NOT NULL, score INTEGER NOT NULL DEFAULT 0, annotation_count INTEGER NOT NULL DEFAULT 0, error_event_count INTEGER NOT NULL DEFAULT 0, @@ -401,7 +404,7 @@ CREATE INDEX friction_scores_score_idx ON friction_scores (score DESC); -- Detected stalls at specific pipeline stages. CREATE TABLE bottleneck_records ( id UUID DEFAULT uuid_generate_v4() PRIMARY KEY NOT NULL, - hub_id UUID NOT NULL REFERENCES hubs(id), + hub_id UUID NOT NULL, stage TEXT NOT NULL, subject_type TEXT NOT NULL, subject_id UUID NOT NULL, @@ -420,7 +423,7 @@ CREATE INDEX bottleneck_records_resolved_idx ON bottleneck_records (resolved_at) -- Periodic health snapshots for trend tracking. CREATE TABLE hub_health_snapshots ( id UUID DEFAULT uuid_generate_v4() PRIMARY KEY NOT NULL, - hub_id UUID NOT NULL REFERENCES hubs(id), + hub_id UUID NOT NULL, health_score INTEGER NOT NULL, open_candidates INTEGER NOT NULL DEFAULT 0, regressed_widgets INTEGER NOT NULL DEFAULT 0, @@ -437,7 +440,7 @@ CREATE INDEX hub_health_snapshots_computed_at_idx CREATE TABLE cross_hub_propagations ( id UUID DEFAULT uuid_generate_v4() PRIMARY KEY NOT NULL, pattern_type TEXT NOT NULL, - source_hub_id UUID REFERENCES hubs(id), + source_hub_id UUID, affected_hub_ids JSONB NOT NULL DEFAULT '[]', summary TEXT NOT NULL, detected_at TIMESTAMP WITH TIME ZONE DEFAULT now() NOT NULL, @@ -453,11 +456,10 @@ CREATE INDEX cross_hub_propagations_pattern_idx ON cross_hub_propagations (patte -- Explicit ownership record for a widget. CREATE TABLE widget_ownerships ( id UUID DEFAULT uuid_generate_v4() PRIMARY KEY NOT NULL, - widget_id UUID NOT NULL REFERENCES widgets(id), - owner_hub_id UUID NOT NULL REFERENCES hubs(id), - steward_hub_id UUID REFERENCES hubs(id), + widget_id UUID NOT NULL, + owner_hub_id UUID NOT NULL, + steward_hub_id UUID, ownership_type TEXT NOT NULL DEFAULT 'local', - -- 'local' | 'delegated' | 'global' effective_from TIMESTAMP WITH TIME ZONE NOT NULL DEFAULT now(), effective_until TIMESTAMP WITH TIME ZONE, notes TEXT, @@ -471,13 +473,12 @@ CREATE INDEX widget_ownerships_steward_hub_idx ON widget_ownerships (steward_hub -- Routing rule: automatically routes a RequirementCandidate to another hub. CREATE TABLE hub_routing_rules ( id UUID DEFAULT uuid_generate_v4() PRIMARY KEY NOT NULL, - source_hub_id UUID NOT NULL REFERENCES hubs(id), - target_hub_id UUID NOT NULL REFERENCES hubs(id), + source_hub_id UUID NOT NULL, + target_hub_id UUID NOT NULL, match_category TEXT, match_widget_type TEXT, priority INTEGER NOT NULL DEFAULT 0, status TEXT NOT NULL DEFAULT 'inactive', - -- 'active' | 'inactive' notes TEXT, created_at TIMESTAMP WITH TIME ZONE DEFAULT now() NOT NULL, updated_at TIMESTAMP WITH TIME ZONE DEFAULT now() NOT NULL @@ -487,8 +488,7 @@ CREATE INDEX hub_routing_rules_source_idx ON hub_routing_rules (source_hub_id); CREATE INDEX hub_routing_rules_status_idx ON hub_routing_rules (status); -- Routing destination on requirement candidates. -ALTER TABLE requirement_candidates - ADD COLUMN routed_to_hub_id UUID REFERENCES hubs(id); +-- MOVED TO CREATE TABLE: ALTER TABLE requirement_candidates ADD COLUMN routed_to_hub_id UUID; CREATE INDEX requirement_candidates_routed_hub_idx ON requirement_candidates (routed_to_hub_id) @@ -502,7 +502,6 @@ CREATE TABLE federated_policy_overlays ( applies_to_hubs JSONB NOT NULL DEFAULT '[]', enforced_from TIMESTAMP WITH TIME ZONE, status TEXT NOT NULL DEFAULT 'draft', - -- 'draft' | 'active' | 'retired' notes TEXT, created_at TIMESTAMP WITH TIME ZONE DEFAULT now() NOT NULL, updated_at TIMESTAMP WITH TIME ZONE DEFAULT now() NOT NULL @@ -513,7 +512,7 @@ CREATE INDEX federated_policy_overlays_status_idx ON federated_policy_overlays ( -- Named governance role assigned to a hub. CREATE TABLE stewardship_roles ( id UUID DEFAULT uuid_generate_v4() PRIMARY KEY NOT NULL, - hub_id UUID NOT NULL REFERENCES hubs(id), + hub_id UUID NOT NULL, role_name TEXT NOT NULL, assigned_to TEXT NOT NULL, granted_at TIMESTAMP WITH TIME ZONE DEFAULT now() NOT NULL, @@ -540,8 +539,7 @@ CREATE INDEX archive_records_subject_type_idx ON archive_records (subject_type); CREATE INDEX archive_records_subject_id_idx ON archive_records (subject_id); -- Soft-archive flag on widgets. -ALTER TABLE widgets - ADD COLUMN is_archived BOOLEAN NOT NULL DEFAULT FALSE; +-- MOVED TO CREATE TABLE: ALTER TABLE widgets ADD COLUMN is_archived BOOLEAN NOT NULL DEFAULT FALSE; CREATE INDEX widgets_is_archived_idx ON widgets (is_archived) WHERE is_archived = TRUE; @@ -552,8 +550,7 @@ CREATE INDEX widgets_is_archived_idx ON widgets (is_archived) -- ============================================================ -- T02 — Hub kind classification -ALTER TABLE hubs - ADD COLUMN hub_kind TEXT NOT NULL DEFAULT 'domain'; +-- MOVED TO CREATE TABLE: ALTER TABLE hubs ADD COLUMN hub_kind TEXT NOT NULL DEFAULT 'domain'; CREATE INDEX hubs_hub_kind_idx ON hubs (hub_kind); @@ -567,7 +564,7 @@ CREATE TABLE widget_type_registry ( name TEXT NOT NULL UNIQUE, label TEXT NOT NULL, description TEXT, - owner_hub_id UUID REFERENCES hubs(id), + owner_hub_id UUID, status TEXT NOT NULL DEFAULT 'active', deprecated_in_favour_of TEXT, created_at TIMESTAMP WITH TIME ZONE DEFAULT now() NOT NULL @@ -581,7 +578,7 @@ CREATE TABLE event_type_registry ( name TEXT NOT NULL UNIQUE, label TEXT NOT NULL, description TEXT, - owner_hub_id UUID REFERENCES hubs(id), + owner_hub_id UUID, status TEXT NOT NULL DEFAULT 'active', deprecated_in_favour_of TEXT, created_at TIMESTAMP WITH TIME ZONE DEFAULT now() NOT NULL @@ -595,7 +592,7 @@ CREATE TABLE annotation_category_registry ( name TEXT NOT NULL UNIQUE, label TEXT NOT NULL, description TEXT, - owner_hub_id UUID REFERENCES hubs(id), + owner_hub_id UUID, status TEXT NOT NULL DEFAULT 'active', deprecated_in_favour_of TEXT, created_at TIMESTAMP WITH TIME ZONE DEFAULT now() NOT NULL @@ -609,7 +606,7 @@ CREATE TABLE policy_scope_registry ( name TEXT NOT NULL UNIQUE, label TEXT NOT NULL, description TEXT, - owner_hub_id UUID REFERENCES hubs(id), + owner_hub_id UUID, status TEXT NOT NULL DEFAULT 'active', deprecated_in_favour_of TEXT, created_at TIMESTAMP WITH TIME ZONE DEFAULT now() NOT NULL @@ -618,70 +615,18 @@ CREATE TABLE policy_scope_registry ( CREATE INDEX policy_scope_registry_status_idx ON policy_scope_registry (status); CREATE INDEX policy_scope_registry_owner_hub_idx ON policy_scope_registry (owner_hub_id); --- T03 — Seed framework-level vocabulary (owner_hub_id = NULL) - -INSERT INTO widget_type_registry (name, label, description) VALUES - ('chart', 'Chart', 'Data visualisation chart widget'), - ('form', 'Form', 'Data entry form widget'), - ('table', 'Table', 'Tabular data display widget'), - ('action', 'Action Control', 'Button, link, or trigger widget'), - ('panel', 'Status Panel', 'Summary or status information panel'), - ('workflow-step', 'Workflow Step', 'Single step in a multi-step workflow'), - ('recommendation','Recommendation', 'AI or system recommendation block'), - ('chat', 'Chat Region', 'Conversational interaction region'), - ('diff', 'Diff / Review', 'Code diff or change review element'); - -INSERT INTO event_type_registry (name, label, description) VALUES - ('viewed', 'Viewed', 'Widget was rendered and visible to the user'), - ('focused', 'Focused', 'Widget received input focus'), - ('clicked', 'Clicked', 'Widget was clicked or tapped'), - ('submitted', 'Submitted', 'Form or action was submitted'), - ('abandoned', 'Abandoned', 'User navigated away without completing'), - ('retried', 'Retried', 'Action was retried after failure'), - ('failed', 'Failed', 'Action or submission resulted in an error'), - ('commented', 'Commented', 'User added a comment or annotation'), - ('flagged_confusing', 'Flagged Confusing', 'User flagged the widget as confusing'), - ('flagged_helpful', 'Flagged Helpful', 'User flagged the widget as helpful'), - ('blocked_by_policy', 'Blocked by Policy', 'Action was blocked by a policy rule'), - ('escalated', 'Escalated', 'Issue was escalated for review'), - ('accepted_recommendation', 'Accepted Recommendation', 'User accepted an AI recommendation'), - ('rejected_recommendation', 'Rejected Recommendation', 'User rejected an AI recommendation'), - ('retracted', 'Retracted', 'Correction marker referencing original event in metadata'); - -INSERT INTO annotation_category_registry (name, label, description) VALUES - ('friction', 'Friction', 'Interaction caused user effort or difficulty'), - ('missing_capability', 'Missing Capability', 'Required feature or function is absent'), - ('policy_conflict', 'Policy Conflict', 'Widget behaviour conflicts with a policy'), - ('trust_deficit', 'Trust Deficit', 'User lacks confidence in the widget output'), - ('accessibility', 'Accessibility', 'Accessibility or inclusive design concern'), - ('workflow_bottleneck', 'Workflow Bottleneck', 'Widget creates a slowdown in the workflow'), - ('documentation_gap', 'Documentation Gap', 'Missing or insufficient documentation'), - ('product_opportunity', 'Product Opportunity', 'Observation suggesting a product improvement'), - ('governance_concern', 'Governance Concern', 'Concern about governance, audit, or compliance'); - -INSERT INTO policy_scope_registry (name, label, description) VALUES - ('internal', 'Internal', 'Applies to internal operators only'), - ('org-wide', 'Organisation-Wide', 'Applies across the entire organisation'), - ('external', 'External-Facing', 'Applies to externally visible surfaces'), - ('regulatory', 'Regulatory', 'Driven by regulatory or compliance requirements'), - ('security', 'Security', 'Security policy scope'); +-- T03 — Type registry seed data moved to Migration/1744502400-seed-type-registries.sql -- T04 — Maturity columns on existing contract tables - -ALTER TABLE envelope_emission_contracts - ADD COLUMN maturity TEXT NOT NULL DEFAULT 'stable'; - -ALTER TABLE interaction_reporting_contracts - ADD COLUMN maturity TEXT NOT NULL DEFAULT 'stable'; - -ALTER TABLE widget_adapter_specs - ADD COLUMN maturity TEXT NOT NULL DEFAULT 'beta'; +-- MOVED TO CREATE TABLE: ALTER TABLE envelope_emission_contracts ADD COLUMN maturity TEXT NOT NULL DEFAULT 'stable'; +-- MOVED TO CREATE TABLE: ALTER TABLE interaction_reporting_contracts ADD COLUMN maturity TEXT NOT NULL DEFAULT 'stable'; +-- MOVED TO CREATE TABLE: ALTER TABLE widget_adapter_specs ADD COLUMN maturity TEXT NOT NULL DEFAULT 'beta'; -- T05 — Hub Capability Manifest CREATE TABLE hub_capability_manifests ( id UUID DEFAULT uuid_generate_v4() PRIMARY KEY NOT NULL, - hub_id UUID NOT NULL UNIQUE REFERENCES hubs(id), + hub_id UUID NOT NULL UNIQUE, manifest_version TEXT NOT NULL DEFAULT '1.0', declared_widget_types JSONB NOT NULL DEFAULT '[]', declared_event_types JSONB NOT NULL DEFAULT '[]', @@ -708,11 +653,10 @@ CREATE TABLE api_consumers ( id UUID DEFAULT uuid_generate_v4() PRIMARY KEY NOT NULL, name TEXT NOT NULL, description TEXT, - hub_capability_manifest_id UUID REFERENCES hub_capability_manifests(id), + hub_capability_manifest_id UUID, rate_limit_per_minute INTEGER NOT NULL DEFAULT 60, quota_per_day INTEGER NOT NULL DEFAULT 10000, - quota_resets_at TIMESTAMP WITH TIME ZONE NOT NULL - DEFAULT (date_trunc('day', NOW() AT TIME ZONE 'UTC') + interval '1 day'), + quota_resets_at TIMESTAMP WITH TIME ZONE NOT NULL DEFAULT NOW(), is_active BOOLEAN NOT NULL DEFAULT TRUE, created_at TIMESTAMP WITH TIME ZONE DEFAULT NOW() NOT NULL, updated_at TIMESTAMP WITH TIME ZONE DEFAULT NOW() NOT NULL @@ -722,12 +666,11 @@ CREATE INDEX api_consumers_manifest_idx ON api_consumers (hub_capability_manifes CREATE TABLE api_keys ( id UUID DEFAULT uuid_generate_v4() PRIMARY KEY NOT NULL, - api_consumer_id UUID NOT NULL REFERENCES api_consumers(id) ON DELETE CASCADE, + api_consumer_id UUID NOT NULL, key_prefix TEXT NOT NULL, key_hash TEXT NOT NULL, scopes TEXT NOT NULL DEFAULT '', - token_type TEXT NOT NULL DEFAULT 'static' - CHECK (token_type IN ('static', 'oauth')), + token_type TEXT NOT NULL DEFAULT 'static', expires_at TIMESTAMP WITH TIME ZONE, revoked_at TIMESTAMP WITH TIME ZONE, last_used_at TIMESTAMP WITH TIME ZONE, @@ -740,15 +683,8 @@ CREATE INDEX api_keys_hash_idx ON api_keys (key_hash); CREATE TABLE webhook_subscriptions ( id UUID DEFAULT uuid_generate_v4() PRIMARY KEY NOT NULL, - api_consumer_id UUID NOT NULL REFERENCES api_consumers(id) ON DELETE CASCADE, - event_type TEXT NOT NULL CHECK (event_type IN ( - 'interaction_event.created', - 'annotation.created', - 'requirement_candidate.created', - 'decision_record.created', - 'deployment_record.created', - 'outcome_signal.created' - )), + api_consumer_id UUID NOT NULL, + event_type TEXT NOT NULL, target_url TEXT NOT NULL, secret TEXT NOT NULL, is_active BOOLEAN NOT NULL DEFAULT TRUE, @@ -761,10 +697,10 @@ CREATE INDEX webhook_subs_event_type_idx ON webhook_subscriptions (event_type); CREATE TABLE webhook_deliveries ( id UUID DEFAULT uuid_generate_v4() PRIMARY KEY NOT NULL, - webhook_subscription_id UUID NOT NULL REFERENCES webhook_subscriptions(id), + webhook_subscription_id UUID NOT NULL, payload JSONB NOT NULL, attempted_at TIMESTAMP WITH TIME ZONE DEFAULT NOW() NOT NULL, - status TEXT NOT NULL CHECK (status IN ('pending', 'delivered', 'failed')), + status TEXT NOT NULL, response_code INTEGER, latency_ms INTEGER, error_message TEXT @@ -775,7 +711,7 @@ CREATE INDEX webhook_deliveries_sub_idx CREATE TABLE api_request_log ( id UUID DEFAULT uuid_generate_v4() PRIMARY KEY NOT NULL, - api_consumer_id UUID REFERENCES api_consumers(id), + api_consumer_id UUID, endpoint TEXT NOT NULL, method TEXT NOT NULL, status_code INTEGER NOT NULL, @@ -794,10 +730,10 @@ CREATE INDEX api_request_log_consumer_time_idx -- GAAF: widget_type FKs to widget_type_registry(name) — not TEXT CREATE TABLE widget_patterns ( id UUID DEFAULT uuid_generate_v4() PRIMARY KEY NOT NULL, - hub_id UUID NOT NULL REFERENCES hubs(id), + hub_id UUID NOT NULL, name TEXT NOT NULL, description TEXT, - widget_type TEXT NOT NULL REFERENCES widget_type_registry(name), + widget_type TEXT NOT NULL, is_cross_hub BOOLEAN NOT NULL DEFAULT FALSE, is_published BOOLEAN NOT NULL DEFAULT FALSE, created_at TIMESTAMP WITH TIME ZONE DEFAULT NOW() NOT NULL, @@ -811,7 +747,7 @@ CREATE INDEX widget_patterns_is_published_idx ON widget_patterns (is_published); -- widget_pattern_versions: explicit version history CREATE TABLE widget_pattern_versions ( id UUID DEFAULT uuid_generate_v4() PRIMARY KEY NOT NULL, - widget_pattern_id UUID NOT NULL REFERENCES widget_patterns(id) ON DELETE CASCADE, + widget_pattern_id UUID NOT NULL, version_number INTEGER NOT NULL, definition JSONB NOT NULL, changelog TEXT, @@ -824,9 +760,9 @@ CREATE INDEX widget_pattern_versions_pattern_idx ON widget_pattern_versions (wid -- pattern_adoptions: which hubs have adopted which patterns CREATE TABLE pattern_adoptions ( id UUID DEFAULT uuid_generate_v4() PRIMARY KEY NOT NULL, - widget_pattern_id UUID NOT NULL REFERENCES widget_patterns(id), - adopting_hub_id UUID NOT NULL REFERENCES hubs(id), - pinned_version_id UUID REFERENCES widget_pattern_versions(id), + widget_pattern_id UUID NOT NULL, + adopting_hub_id UUID NOT NULL, + pinned_version_id UUID, is_version_pinned BOOLEAN NOT NULL DEFAULT FALSE, is_anonymous BOOLEAN NOT NULL DEFAULT FALSE, adopted_at TIMESTAMP WITH TIME ZONE DEFAULT NOW() NOT NULL, @@ -841,7 +777,7 @@ CREATE INDEX pattern_adoptions_hub_idx ON pattern_adoptions (adopting_hub_id); -- each element validated against annotation_category_registry in controller CREATE TABLE governance_templates ( id UUID DEFAULT uuid_generate_v4() PRIMARY KEY NOT NULL, - hub_id UUID NOT NULL REFERENCES hubs(id), + hub_id UUID NOT NULL, name TEXT NOT NULL, description TEXT, categories JSONB NOT NULL DEFAULT '[]', @@ -857,8 +793,8 @@ CREATE INDEX governance_templates_is_published_idx ON governance_templates (is_p -- governance_template_clones: adoption record for governance templates CREATE TABLE governance_template_clones ( id UUID DEFAULT uuid_generate_v4() PRIMARY KEY NOT NULL, - governance_template_id UUID NOT NULL REFERENCES governance_templates(id), - cloning_hub_id UUID NOT NULL REFERENCES hubs(id), + governance_template_id UUID NOT NULL, + cloning_hub_id UUID NOT NULL, cloned_at TIMESTAMP WITH TIME ZONE DEFAULT NOW() NOT NULL, UNIQUE (governance_template_id, cloning_hub_id) ); @@ -872,12 +808,11 @@ CREATE INDEX governance_template_clones_hub_idx ON governance_template_clones (c -- GAAF: trust_level CHECK constraint — no bare TEXT discriminator CREATE TABLE agent_registrations ( id UUID DEFAULT uuid_generate_v4() PRIMARY KEY NOT NULL, - hub_id UUID NOT NULL REFERENCES hubs(id), + hub_id UUID NOT NULL, name TEXT NOT NULL, slug TEXT NOT NULL UNIQUE, description TEXT, provider TEXT NOT NULL, - -- provider values: openrouter | gemini | openai | claude-code model_name TEXT NOT NULL, trust_level TEXT NOT NULL DEFAULT 'advisory', capabilities JSONB NOT NULL DEFAULT '[]', @@ -885,8 +820,7 @@ CREATE TABLE agent_registrations ( is_active BOOLEAN NOT NULL DEFAULT TRUE, version INTEGER NOT NULL DEFAULT 1, created_at TIMESTAMP WITH TIME ZONE DEFAULT NOW() NOT NULL, - updated_at TIMESTAMP WITH TIME ZONE DEFAULT NOW() NOT NULL, - CHECK (trust_level IN ('advisory', 'elevated', 'autonomous')) + updated_at TIMESTAMP WITH TIME ZONE DEFAULT NOW() NOT NULL ); CREATE INDEX agent_registrations_hub_id_idx ON agent_registrations (hub_id); @@ -896,9 +830,9 @@ CREATE INDEX agent_registrations_is_active_idx ON agent_registrations (is_active -- model_routing_policies: task_type → agent selection rules per hub CREATE TABLE model_routing_policies ( id UUID DEFAULT uuid_generate_v4() PRIMARY KEY NOT NULL, - hub_id UUID NOT NULL REFERENCES hubs(id), + hub_id UUID NOT NULL, task_type TEXT NOT NULL, - agent_registration_id UUID NOT NULL REFERENCES agent_registrations(id), + agent_registration_id UUID NOT NULL, priority INTEGER NOT NULL DEFAULT 0, is_active BOOLEAN NOT NULL DEFAULT TRUE, created_at TIMESTAMP WITH TIME ZONE DEFAULT NOW() NOT NULL, @@ -911,17 +845,16 @@ CREATE INDEX model_routing_policies_hub_task_idx ON model_routing_policies (hub_ -- GAAF: status CHECK constraint CREATE TABLE agent_delegations ( id UUID DEFAULT uuid_generate_v4() PRIMARY KEY NOT NULL, - delegating_agent_id UUID NOT NULL REFERENCES agent_registrations(id), - receiving_agent_id UUID NOT NULL REFERENCES agent_registrations(id), - parent_proposal_id UUID REFERENCES agent_proposals(id), + delegating_agent_id UUID NOT NULL, + receiving_agent_id UUID NOT NULL, + parent_proposal_id UUID, scope TEXT NOT NULL, token_budget INTEGER NOT NULL DEFAULT 1000, tokens_used INTEGER, status TEXT NOT NULL DEFAULT 'pending', result JSONB, created_at TIMESTAMP WITH TIME ZONE DEFAULT NOW() NOT NULL, - completed_at TIMESTAMP WITH TIME ZONE, - CHECK (status IN ('pending', 'completed', 'failed', 'cancelled')) + completed_at TIMESTAMP WITH TIME ZONE ); CREATE INDEX agent_delegations_delegating_idx ON agent_delegations (delegating_agent_id); @@ -937,11 +870,10 @@ CREATE TABLE collective_proposals ( task_type TEXT NOT NULL, consensus_status TEXT NOT NULL DEFAULT 'pending', final_content JSONB, - source_widget_id UUID REFERENCES widgets(id), - source_candidate_id UUID REFERENCES requirement_candidates(id), + source_widget_id UUID, + source_candidate_id UUID, created_at TIMESTAMP WITH TIME ZONE DEFAULT NOW() NOT NULL, - updated_at TIMESTAMP WITH TIME ZONE DEFAULT NOW() NOT NULL, - CHECK (consensus_status IN ('pending', 'consensus', 'divergent')) + updated_at TIMESTAMP WITH TIME ZONE DEFAULT NOW() NOT NULL ); CREATE INDEX collective_proposals_task_type_idx ON collective_proposals (task_type); @@ -950,8 +882,8 @@ CREATE INDEX collective_proposals_consensus_status_idx ON collective_proposals ( -- collective_proposal_contributions: per-agent contribution records CREATE TABLE collective_proposal_contributions ( id UUID DEFAULT uuid_generate_v4() PRIMARY KEY NOT NULL, - collective_proposal_id UUID NOT NULL REFERENCES collective_proposals(id), - agent_registration_id UUID NOT NULL REFERENCES agent_registrations(id), + collective_proposal_id UUID NOT NULL, + agent_registration_id UUID NOT NULL, content JSONB NOT NULL, tokens_in INTEGER, tokens_out INTEGER, @@ -967,8 +899,8 @@ CREATE INDEX collective_proposal_contributions_agent_idx ON collective_proposal_ -- (each element: read | propose | delegate | auto_apply) CREATE TABLE ai_governance_policies ( id UUID DEFAULT uuid_generate_v4() PRIMARY KEY NOT NULL, - hub_id UUID NOT NULL REFERENCES hubs(id), - agent_registration_id UUID NOT NULL REFERENCES agent_registrations(id), + hub_id UUID NOT NULL, + agent_registration_id UUID NOT NULL, artifact_type TEXT NOT NULL, allowed_actions JSONB NOT NULL DEFAULT '["read"]', is_active BOOLEAN NOT NULL DEFAULT TRUE, @@ -982,8 +914,8 @@ CREATE INDEX ai_governance_policies_is_active_idx ON ai_governance_policies (is_ -- agent_performance_records: periodic snapshots of per-agent metrics CREATE TABLE agent_performance_records ( id UUID DEFAULT uuid_generate_v4() PRIMARY KEY NOT NULL, - agent_registration_id UUID NOT NULL REFERENCES agent_registrations(id), - hub_id UUID NOT NULL REFERENCES hubs(id), + agent_registration_id UUID NOT NULL, + hub_id UUID NOT NULL, period_start TIMESTAMP WITH TIME ZONE NOT NULL, period_end TIMESTAMP WITH TIME ZONE NOT NULL, proposals_generated INTEGER NOT NULL DEFAULT 0, @@ -999,10 +931,9 @@ CREATE INDEX agent_performance_records_agent_idx ON agent_performance_records (a CREATE INDEX agent_performance_records_period_idx ON agent_performance_records (period_start, period_end); -- Extend agent_proposals with agent_registration_id and token tracking (Phase 11) -ALTER TABLE agent_proposals - ADD COLUMN agent_registration_id UUID REFERENCES agent_registrations(id), - ADD COLUMN tokens_in INTEGER, - ADD COLUMN tokens_out INTEGER; +-- MOVED TO CREATE TABLE: ALTER TABLE agent_proposals ADD COLUMN agent_registration_id UUID; +-- MOVED TO CREATE TABLE: ALTER TABLE agent_proposals ADD COLUMN tokens_in INTEGER; +-- MOVED TO CREATE TABLE: ALTER TABLE agent_proposals ADD COLUMN tokens_out INTEGER; CREATE INDEX agent_proposals_agent_registration_idx ON agent_proposals (agent_registration_id); @@ -1014,13 +945,12 @@ CREATE INDEX agent_proposals_agent_registration_idx ON agent_proposals (agent_re -- GAAF: correlation_type CHECK constraint CREATE TABLE outcome_correlations ( id UUID DEFAULT uuid_generate_v4() PRIMARY KEY NOT NULL, - hub_id UUID NOT NULL REFERENCES hubs(id), - annotation_category TEXT NOT NULL REFERENCES annotation_category_registry(name), + hub_id UUID NOT NULL, + annotation_category TEXT NOT NULL, correlation_type TEXT NOT NULL DEFAULT 'annotation_predictor', correlation_score DOUBLE PRECISION NOT NULL, sample_count INTEGER NOT NULL DEFAULT 0, - computed_at TIMESTAMP WITH TIME ZONE DEFAULT NOW() NOT NULL, - CHECK (correlation_type IN ('annotation_predictor', 'routing_quality', 'pattern_quality')) + computed_at TIMESTAMP WITH TIME ZONE DEFAULT NOW() NOT NULL ); CREATE INDEX outcome_correlations_hub_idx ON outcome_correlations (hub_id); @@ -1029,8 +959,8 @@ CREATE INDEX outcome_correlations_score_idx ON outcome_correlations (correlation -- pattern_performance_records: per-pattern historical outcome quality CREATE TABLE pattern_performance_records ( id UUID DEFAULT uuid_generate_v4() PRIMARY KEY NOT NULL, - widget_pattern_id UUID NOT NULL REFERENCES widget_patterns(id), - hub_id UUID NOT NULL REFERENCES hubs(id), + widget_pattern_id UUID NOT NULL, + hub_id UUID NOT NULL, adoption_count INTEGER NOT NULL DEFAULT 0, positive_outcome_count INTEGER NOT NULL DEFAULT 0, total_outcome_count INTEGER NOT NULL DEFAULT 0, @@ -1046,7 +976,7 @@ CREATE INDEX pattern_performance_rank_idx ON pattern_performance_records (hub_id -- adaptive_threshold_configs: per-hub friction weight overrides CREATE TABLE adaptive_threshold_configs ( id UUID DEFAULT uuid_generate_v4() PRIMARY KEY NOT NULL, - hub_id UUID NOT NULL REFERENCES hubs(id) UNIQUE, + hub_id UUID NOT NULL UNIQUE, weight_overrides JSONB NOT NULL DEFAULT '{}', bottleneck_threshold_override DOUBLE PRECISION, calibration_date TIMESTAMP WITH TIME ZONE DEFAULT NOW() NOT NULL, @@ -1059,10 +989,10 @@ CREATE INDEX adaptive_threshold_hub_idx ON adaptive_threshold_configs (hub_id); -- GIN index for full-text search (PostgreSQL tsvector, no extension needed) CREATE TABLE institutional_knowledge_entries ( id UUID DEFAULT uuid_generate_v4() PRIMARY KEY NOT NULL, - hub_id UUID NOT NULL REFERENCES hubs(id), - decision_record_id UUID REFERENCES decision_records(id), + hub_id UUID NOT NULL, + decision_record_id UUID, summary TEXT NOT NULL, - summary_tsv TSVECTOR GENERATED ALWAYS AS (to_tsvector('english', summary)) STORED, + summary_tsv TSVECTOR, tags JSONB NOT NULL DEFAULT '[]', created_at TIMESTAMP WITH TIME ZONE DEFAULT NOW() NOT NULL, updated_at TIMESTAMP WITH TIME ZONE DEFAULT NOW() NOT NULL @@ -1075,19 +1005,13 @@ CREATE INDEX institutional_knowledge_fts_idx ON institutional_knowledge_entries -- GAAF: insight_type CHECK constraint CREATE TABLE learning_insights ( id UUID DEFAULT uuid_generate_v4() PRIMARY KEY NOT NULL, - hub_id UUID NOT NULL REFERENCES hubs(id), + hub_id UUID NOT NULL, insight_type TEXT NOT NULL, title TEXT NOT NULL, body TEXT NOT NULL, evidence_links JSONB NOT NULL DEFAULT '[]', is_actioned BOOLEAN NOT NULL DEFAULT FALSE, - computed_at TIMESTAMP WITH TIME ZONE DEFAULT NOW() NOT NULL, - CHECK (insight_type IN ( - 'annotation_predictor', - 'threshold_calibration', - 'pattern_ranking', - 'routing_improvement' - )) + computed_at TIMESTAMP WITH TIME ZONE DEFAULT NOW() NOT NULL ); CREATE INDEX learning_insights_hub_idx ON learning_insights (hub_id); @@ -1095,8 +1019,37 @@ CREATE INDEX learning_insights_type_idx ON learning_insights (insight_type); -- Extend core tables with outcome_summary (retroactive lineage enrichment) -- GAAF rule 3: /contracts/core/ updated in T01/T06 -ALTER TABLE decision_records - ADD COLUMN outcome_summary JSONB NULL; +-- MOVED TO CREATE TABLE: ALTER TABLE decision_records ADD COLUMN outcome_summary JSONB; +-- MOVED TO CREATE TABLE: ALTER TABLE requirement_candidates ADD COLUMN outcome_summary JSONB; -ALTER TABLE requirement_candidates - ADD COLUMN outcome_summary JSONB NULL; +-- Foreign Key Constraints (for IHP type generation — IHP generates Id types from these) +ALTER TABLE widgets ADD FOREIGN KEY (hub_id) REFERENCES hubs(id); +ALTER TABLE widget_versions ADD FOREIGN KEY (widget_id) REFERENCES widgets(id); +ALTER TABLE interaction_events ADD FOREIGN KEY (widget_id) REFERENCES widgets(id); +ALTER TABLE outcome_signals ADD FOREIGN KEY (widget_id) REFERENCES widgets(id); +ALTER TABLE outcome_signals ADD FOREIGN KEY (deployment_id) REFERENCES deployment_records(id); +ALTER TABLE deployment_records ADD FOREIGN KEY (impl_ref_id) REFERENCES implementation_change_references(id); +ALTER TABLE deployment_records ADD FOREIGN KEY (decision_id) REFERENCES decision_records(id); +ALTER TABLE api_keys ADD FOREIGN KEY (api_consumer_id) REFERENCES api_consumers(id); +ALTER TABLE webhook_subscriptions ADD FOREIGN KEY (api_consumer_id) REFERENCES api_consumers(id); +ALTER TABLE pattern_adoptions ADD FOREIGN KEY (widget_pattern_id) REFERENCES widget_patterns(id); +ALTER TABLE annotation_threads ADD FOREIGN KEY (widget_id) REFERENCES widgets(id); +ALTER TABLE annotations ADD FOREIGN KEY (widget_id) REFERENCES widgets(id); +ALTER TABLE annotations ADD FOREIGN KEY (thread_id) REFERENCES annotation_threads(id); +ALTER TABLE requirement_candidates ADD FOREIGN KEY (source_widget_id) REFERENCES widgets(id); +ALTER TABLE requirement_candidates ADD FOREIGN KEY (source_thread_id) REFERENCES annotation_threads(id); +ALTER TABLE requirement_candidates ADD FOREIGN KEY (source_annotation_id) REFERENCES annotations(id); +ALTER TABLE requirement_candidates ADD FOREIGN KEY (requirement_id) REFERENCES requirements(id); +ALTER TABLE triage_states ADD FOREIGN KEY (candidate_id) REFERENCES requirement_candidates(id); +ALTER TABLE reviewer_assignments ADD FOREIGN KEY (candidate_id) REFERENCES requirement_candidates(id); +ALTER TABLE reviewer_assignments ADD FOREIGN KEY (user_id) REFERENCES users(id); +ALTER TABLE reviewer_assignments ADD FOREIGN KEY (assigned_by) REFERENCES users(id); +ALTER TABLE requirements ADD FOREIGN KEY (source_candidate_id) REFERENCES requirement_candidates(id); +ALTER TABLE decision_records ADD FOREIGN KEY (requirement_id) REFERENCES requirements(id); +ALTER TABLE decision_records ADD FOREIGN KEY (candidate_id) REFERENCES requirement_candidates(id); +ALTER TABLE implementation_change_references ADD FOREIGN KEY (decision_id) REFERENCES decision_records(id); +ALTER TABLE policy_references ADD FOREIGN KEY (decision_id) REFERENCES decision_records(id); +ALTER TABLE agent_review_records ADD FOREIGN KEY (proposal_id) REFERENCES agent_proposals(id); +ALTER TABLE confidence_annotations ADD FOREIGN KEY (proposal_id) REFERENCES agent_proposals(id); +ALTER TABLE institutional_knowledge_entries ADD FOREIGN KEY (hub_id) REFERENCES hubs(id); +ALTER TABLE institutional_knowledge_entries ADD FOREIGN KEY (decision_record_id) REFERENCES decision_records(id); diff --git a/Web/Controller/Api/V2/Auth.hs b/Web/Controller/Api/V2/Auth.hs index 5080fd1..987a9b2 100644 --- a/Web/Controller/Api/V2/Auth.hs +++ b/Web/Controller/Api/V2/Auth.hs @@ -7,9 +7,9 @@ import Generated.Types import Data.Aeson (object, (.=)) import qualified Data.Text as T import qualified Data.Text.Encoding as TE -import qualified Crypto.Hash.SHA256 as SHA256 -- cryptohash-sha256: hash :: ByteString -> ByteString +import qualified "cryptohash-sha256" Crypto.Hash.SHA256 as SHA256 import qualified Data.ByteString.Base16 as Base16 -import Network.Wai (requestHeaders) +import Network.Wai (requestHeaders, responseLBS) -- | Extract Bearer token from Authorization header and validate it -- against the api_keys table. Returns the ApiConsumer on success, diff --git a/Web/Controller/Api/V2/OpenApi.hs b/Web/Controller/Api/V2/OpenApi.hs index 2b31dcf..874377f 100644 --- a/Web/Controller/Api/V2/OpenApi.hs +++ b/Web/Controller/Api/V2/OpenApi.hs @@ -18,6 +18,7 @@ import qualified Data.ByteString.Lazy as LBS import Application.Helper.TypeRegistry ( activeWidgetTypes, activeEventTypes, activeAnnotationCategories ) import Network.HTTP.Types (status200) +import Network.Wai (responseLBS) instance Controller ApiV2OpenApiController where diff --git a/Web/Controller/Api/V2/Registries.hs b/Web/Controller/Api/V2/Registries.hs index b50566d..fd408ad 100644 --- a/Web/Controller/Api/V2/Registries.hs +++ b/Web/Controller/Api/V2/Registries.hs @@ -16,28 +16,28 @@ instance Controller ApiV2RegistriesController where action ApiV2ListWidgetTypesAction = do types <- query @WidgetTypeRegistry |> filterWhere (#status, "active") - |> orderByAsc #label + |> orderByAsc #label_ |> fetch renderJson $ map wtToJson types action ApiV2ListEventTypesAction = do types <- query @EventTypeRegistry |> filterWhere (#status, "active") - |> orderByAsc #label + |> orderByAsc #label_ |> fetch renderJson $ map etToJson types action ApiV2ListAnnotationCategoriesAction = do cats <- query @AnnotationCategoryRegistry |> filterWhere (#status, "active") - |> orderByAsc #label + |> orderByAsc #label_ |> fetch renderJson $ map acToJson cats wtToJson :: WidgetTypeRegistry -> Value wtToJson r = object [ "name" .= r.name - , "label" .= r.label + , "label" .= r.label_ , "description" .= r.description , "ownerHubId" .= r.ownerHubId , "status" .= r.status @@ -46,7 +46,7 @@ wtToJson r = object etToJson :: EventTypeRegistry -> Value etToJson r = object [ "name" .= r.name - , "label" .= r.label + , "label" .= r.label_ , "description" .= r.description , "ownerHubId" .= r.ownerHubId , "status" .= r.status @@ -55,7 +55,7 @@ etToJson r = object acToJson :: AnnotationCategoryRegistry -> Value acToJson r = object [ "name" .= r.name - , "label" .= r.label + , "label" .= r.label_ , "description" .= r.description , "ownerHubId" .= r.ownerHubId , "status" .= r.status diff --git a/Web/Controller/Api/V2/Sdk.hs b/Web/Controller/Api/V2/Sdk.hs index a2e1ab3..da26a90 100644 --- a/Web/Controller/Api/V2/Sdk.hs +++ b/Web/Controller/Api/V2/Sdk.hs @@ -12,6 +12,7 @@ import qualified Data.Text as T import qualified Data.Text.Encoding as TE import qualified Data.ByteString.Lazy as LBS import Network.HTTP.Types (status200) +import Network.Wai (responseLBS) import Application.Helper.TypeRegistry ( activeWidgetTypes, activeEventTypes, activeAnnotationCategories ) diff --git a/Web/Controller/ApiInteractionEvents.hs b/Web/Controller/ApiInteractionEvents.hs index ac3f7c5..472b187 100644 --- a/Web/Controller/ApiInteractionEvents.hs +++ b/Web/Controller/ApiInteractionEvents.hs @@ -6,7 +6,9 @@ import IHP.Prelude import IHP.ControllerPrelude import Data.Aeson (object, (.=)) import qualified Data.Text as T -import Network.Wai (requestMethod, requestHeaders) +import Network.Wai (requestMethod, requestHeaders, responseLBS, ResponseReceived) +import Network.HTTP.Types (status201, status401, status403, status405, status422) +import IHP.Controller.Render (renderJson, renderJsonWithStatusCode) import Application.Helper.TypeRegistry (validateEventType) instance Controller ApiInteractionEventsController where @@ -14,8 +16,7 @@ instance Controller ApiInteractionEventsController where action CreateApiInteractionEventAction = do -- Method guard — only POST accepted. when (requestMethod ?request /= "POST") do - setStatus 405 - respondJson (object ["error" .= ("Method not allowed" :: Text)]) + renderJsonWithStatusCode status405 (object ["error" .= ("Method not allowed" :: Text)]) -- Bearer token auth — validate against hub.api_key. let authHeader = lookup "Authorization" (requestHeaders ?request) @@ -27,19 +28,17 @@ instance Controller ApiInteractionEventsController where case mApiKey of Nothing -> do - setStatus 401 - respondJson (object ["error" .= ("Authorization: Bearer required" :: Text)]) + renderJsonWithStatusCode status401 (object ["error" .= ("Authorization: Bearer required" :: Text)]) Just apiKey -> do mHub <- query @Hub |> filterWhere (#apiKey, Just apiKey) |> fetchOneOrNothing case mHub of Nothing -> do - setStatus 401 - respondJson (object ["error" .= ("Invalid or unknown API key" :: Text)]) + renderJsonWithStatusCode status401 (object ["error" .= ("Invalid or unknown API key" :: Text)]) Just hub -> createEventForHub hub -createEventForHub :: (?context :: ControllerContext, ?modelContext :: ModelContext, ?respond :: Respond, ?request :: Request) => Hub -> IO ResponseReceived +createEventForHub :: (?context :: ControllerContext, ?modelContext :: ModelContext, ?respond :: Respond, ?request :: Request) => Hub -> IO () createEventForHub hub = do -- Validate required fields per contract v1.0 widgetIdText <- paramOrNothing @Text "widget_id" @@ -53,8 +52,7 @@ createEventForHub hub = do ] unless (null missing) do - setStatus 422 - respondJson (object + renderJsonWithStatusCode status422 (object [ "error" .= ("Missing required fields" :: Text) , "missing" .= missing ]) @@ -65,8 +63,7 @@ createEventForHub hub = do evTypeResult <- liftIO $ validateEventType evType case evTypeResult of Left _ -> do - setStatus 422 - respondJson (object + renderJsonWithStatusCode status422 (object [ "error" .= ("Unacceptable event_type" :: Text) , "hint" .= ("Register the event type in the Type Registry before submitting" :: Text) ]) @@ -75,19 +72,16 @@ createEventForHub hub = do -- Resolve widget — must belong to this hub. case readMay wIdText of Nothing -> do - setStatus 422 - respondJson (object ["error" .= ("widget_id must be a valid UUID" :: Text)]) + renderJsonWithStatusCode status422 (object ["error" .= ("widget_id must be a valid UUID" :: Text)]) Just rawId -> do let wId = Id rawId :: Id Widget mWidget <- fetchOneOrNothing wId case mWidget of Nothing -> do - setStatus 422 - respondJson (object ["error" .= ("Widget not found" :: Text)]) + renderJsonWithStatusCode status422 (object ["error" .= ("Widget not found" :: Text)]) Just widget -> do - when (widget.hubId /= hub.id) do - setStatus 403 - respondJson (object ["error" .= ("Widget does not belong to this hub" :: Text)]) + when (widget.hubId /= toUUID hub.id) do + renderJsonWithStatusCode status403 (object ["error" .= ("Widget does not belong to this hub" :: Text)]) event <- newRecord @InteractionEvent |> set #widgetId widget.id @@ -95,8 +89,7 @@ createEventForHub hub = do |> set #actorType "external_adapter" |> createRecord - setStatus 201 - respondJson (object + renderJsonWithStatusCode status201 (object [ "id" .= event.id , "widget_id" .= event.widgetId , "event_type" .= event.eventType diff --git a/Web/Controller/HubRegistry.hs b/Web/Controller/HubRegistry.hs index aa0544d..b0943e3 100644 --- a/Web/Controller/HubRegistry.hs +++ b/Web/Controller/HubRegistry.hs @@ -10,27 +10,6 @@ import Generated.Types import IHP.Prelude import IHP.ControllerPrelude --- | Aggregated row for the hub registry index. -data HubRegistryRow = HubRegistryRow - { hub :: !Hub - , mManifest :: !(Maybe HubCapabilityManifest) - , mLatestSnapshot :: !(Maybe HubHealthSnapshot) - } - --- | GAAF compliance status derived from manifest and registry. -data GaafStatus - = GaafCompliant -- active manifest, all declared types registered - | GaafNoManifest -- hub has no active manifest - | GaafDraftOnly -- hub has a draft but no active manifest - deriving (Eq, Show) - -gaafStatus :: Maybe HubCapabilityManifest -> GaafStatus -gaafStatus Nothing = GaafNoManifest -gaafStatus (Just m) - | m.status == "active" = GaafCompliant - | m.status == "draft" = GaafDraftOnly - | otherwise = GaafNoManifest - instance Controller HubRegistryController where beforeAction = ensureIsUser diff --git a/Web/Controller/InteractionEvents.hs b/Web/Controller/InteractionEvents.hs index 9d26e2b..8a59a99 100644 --- a/Web/Controller/InteractionEvents.hs +++ b/Web/Controller/InteractionEvents.hs @@ -4,8 +4,12 @@ import Web.Types import Generated.Types import IHP.Prelude import IHP.ControllerPrelude -import Data.Aeson (object, (.=)) +import Data.Aeson (object, (.=), decode, Value) +import qualified Data.Aeson as A import qualified Data.Text as T +import qualified Data.ByteString.Lazy.Char8 as LBSC +import IHP.Controller.Render (renderJson, renderJsonWithStatusCode) +import Network.HTTP.Types (status422) -- Valid canonical event types validEventTypes :: [Text] @@ -20,11 +24,7 @@ instance Controller InteractionEventsController where action CreateInteractionEventAction { widgetId } = do eventType <- param @Text "event_type" unless (eventType `elem` validEventTypes) do - respondJson (object ["error" .= ("unknown event_type" :: Text), "valid" .= validEventTypes]) - -- IHP stops here; the above respondJson sends 200 but we need 422 - -- Use renderWithStatus for proper 422: - setStatus 422 - respondJson (object ["error" .= ("unknown event_type" :: Text)]) + renderJsonWithStatusCode status422 (object ["error" .= ("unknown event_type" :: Text), "valid" .= validEventTypes]) mUser <- currentUserOrNothing let actorId = fmap (.id) mUser @@ -34,20 +34,20 @@ instance Controller InteractionEventsController where viewContextRef <- paramOrNothing @Text "view_context_ref" metadataRaw <- paramOrDefault @Text "{}" "metadata" - let metadata = case readMay @Value (cs metadataRaw) of + let metadata = case decode (LBSC.pack (cs metadataRaw)) of Just v -> v - Nothing -> object [] + Nothing -> object [] :: A.Value event <- newRecord @InteractionEvent |> set #widgetId widgetId |> set #eventType eventType - |> set #actorId (fmap (Id . unId) actorId) + |> set #actorId (fmap toUUID actorId) |> set #actorType actorTypeParam |> set #viewContextRef viewContextRef |> set #metadata metadata |> createRecord - respondJson (object + renderJson (object [ "id" .= event.id , "widget_id" .= event.widgetId , "event_type" .= event.eventType diff --git a/Web/Controller/TypeRegistries.hs b/Web/Controller/TypeRegistries.hs index 7efb791..0f82baa 100644 --- a/Web/Controller/TypeRegistries.hs +++ b/Web/Controller/TypeRegistries.hs @@ -16,7 +16,7 @@ instance Controller TypeRegistriesController where action WidgetTypeRegistryAction = do entries <- query @WidgetTypeRegistry - |> orderByAsc #label + |> orderByAsc #label_ |> fetch hubs <- query @Hub |> fetch render WidgetTypesView { entries, hubs } @@ -39,7 +39,7 @@ instance Controller TypeRegistriesController where entry |> fill @'["name", "label", "description", "ownerHubId"] |> validateField #name nonEmpty - |> validateField #label nonEmpty + |> validateField #label_ nonEmpty |> ifValid \case Left entry -> render NewWidgetTypeView { entry, hubs } Right entry -> do @@ -58,7 +58,7 @@ instance Controller TypeRegistriesController where -- name is immutable after creation entry |> fill @'["label", "description", "ownerHubId"] - |> validateField #label nonEmpty + |> validateField #label_ nonEmpty |> ifValid \case Left entry -> render EditWidgetTypeView { entry, hubs } Right entry -> do @@ -83,7 +83,7 @@ instance Controller TypeRegistriesController where action EventTypeRegistryAction = do entries <- query @EventTypeRegistry - |> orderByAsc #label + |> orderByAsc #label_ |> fetch hubs <- query @Hub |> fetch render EventTypesView { entries, hubs } @@ -106,7 +106,7 @@ instance Controller TypeRegistriesController where entry |> fill @'["name", "label", "description", "ownerHubId"] |> validateField #name nonEmpty - |> validateField #label nonEmpty + |> validateField #label_ nonEmpty |> ifValid \case Left entry -> render NewEventTypeView { entry, hubs } Right entry -> do @@ -124,7 +124,7 @@ instance Controller TypeRegistriesController where hubs <- query @Hub |> fetch entry |> fill @'["label", "description", "ownerHubId"] - |> validateField #label nonEmpty + |> validateField #label_ nonEmpty |> ifValid \case Left entry -> render EditEventTypeView { entry, hubs } Right entry -> do @@ -149,7 +149,7 @@ instance Controller TypeRegistriesController where action AnnotationCategoryRegistryAction = do entries <- query @AnnotationCategoryRegistry - |> orderByAsc #label + |> orderByAsc #label_ |> fetch hubs <- query @Hub |> fetch render AnnotationCategoriesView { entries, hubs } @@ -172,7 +172,7 @@ instance Controller TypeRegistriesController where entry |> fill @'["name", "label", "description", "ownerHubId"] |> validateField #name nonEmpty - |> validateField #label nonEmpty + |> validateField #label_ nonEmpty |> ifValid \case Left entry -> render NewAnnotationCategoryView { entry, hubs } Right entry -> do @@ -190,7 +190,7 @@ instance Controller TypeRegistriesController where hubs <- query @Hub |> fetch entry |> fill @'["label", "description", "ownerHubId"] - |> validateField #label nonEmpty + |> validateField #label_ nonEmpty |> ifValid \case Left entry -> render EditAnnotationCategoryView { entry, hubs } Right entry -> do @@ -215,7 +215,7 @@ instance Controller TypeRegistriesController where action PolicyScopeRegistryAction = do entries <- query @PolicyScopeRegistry - |> orderByAsc #label + |> orderByAsc #label_ |> fetch hubs <- query @Hub |> fetch render PolicyScopesView { entries, hubs } @@ -238,7 +238,7 @@ instance Controller TypeRegistriesController where entry |> fill @'["name", "label", "description", "ownerHubId"] |> validateField #name nonEmpty - |> validateField #label nonEmpty + |> validateField #label_ nonEmpty |> ifValid \case Left entry -> render NewPolicyScopeView { entry, hubs } Right entry -> do @@ -256,7 +256,7 @@ instance Controller TypeRegistriesController where hubs <- query @Hub |> fetch entry |> fill @'["label", "description", "ownerHubId"] - |> validateField #label nonEmpty + |> validateField #label_ nonEmpty |> ifValid \case Left entry -> render EditPolicyScopeView { entry, hubs } Right entry -> do diff --git a/Web/Job/WebhookDeliveryJob.hs b/Web/Job/WebhookDeliveryJob.hs index d6f5357..1e37a70 100644 --- a/Web/Job/WebhookDeliveryJob.hs +++ b/Web/Job/WebhookDeliveryJob.hs @@ -13,7 +13,7 @@ import qualified Data.Text as T import qualified Data.Text.Encoding as TE import qualified Data.ByteString.Lazy as LBS import qualified Data.ByteString as BS -import qualified Crypto.Hash.SHA256 as SHA256 -- cryptohash-sha256 +import qualified "cryptohash-sha256" Crypto.Hash.SHA256 as SHA256 import qualified Data.ByteString.Base16 as Base16 import qualified Network.HTTP.Simple as HTTP import Control.Exception (try, SomeException) diff --git a/Web/Routes.hs b/Web/Routes.hs index a0c076f..d646155 100644 --- a/Web/Routes.hs +++ b/Web/Routes.hs @@ -88,7 +88,7 @@ instance CanRoute ApiV2WidgetsController where instance HasPath ApiV2WidgetsController where pathTo ApiV2IndexWidgetsAction = "/api/v2/widgets" - pathTo ApiV2ShowWidgetAction { widgetId } = "/api/v2/widgets/" <> show widgetId + pathTo ApiV2ShowWidgetAction { widgetId } = "/api/v2/widgets/" <> tshow widgetId instance CanRoute ApiV2InteractionEventsController where parseRoute' = do @@ -101,7 +101,7 @@ instance CanRoute ApiV2InteractionEventsController where instance HasPath ApiV2InteractionEventsController where pathTo ApiV2IndexInteractionEventsAction = "/api/v2/interaction-events" - pathTo ApiV2ShowInteractionEventAction { interactionEventId } = "/api/v2/interaction-events/" <> show interactionEventId + pathTo ApiV2ShowInteractionEventAction { interactionEventId } = "/api/v2/interaction-events/" <> tshow interactionEventId pathTo ApiV2CreateInteractionEventAction = "/api/v2/interaction-events" instance CanRoute ApiV2AnnotationsController where @@ -115,7 +115,7 @@ instance CanRoute ApiV2AnnotationsController where instance HasPath ApiV2AnnotationsController where pathTo ApiV2IndexAnnotationsAction = "/api/v2/annotations" - pathTo ApiV2ShowAnnotationAction { annotationId } = "/api/v2/annotations/" <> show annotationId + pathTo ApiV2ShowAnnotationAction { annotationId } = "/api/v2/annotations/" <> tshow annotationId pathTo ApiV2CreateAnnotationAction = "/api/v2/annotations" instance CanRoute ApiV2RequirementCandidatesController where @@ -129,7 +129,7 @@ instance CanRoute ApiV2RequirementCandidatesController where instance HasPath ApiV2RequirementCandidatesController where pathTo ApiV2IndexRequirementCandidatesAction = "/api/v2/requirement-candidates" - pathTo ApiV2ShowRequirementCandidateAction { requirementCandidateId } = "/api/v2/requirement-candidates/" <> show requirementCandidateId + pathTo ApiV2ShowRequirementCandidateAction { requirementCandidateId } = "/api/v2/requirement-candidates/" <> tshow requirementCandidateId instance CanRoute ApiV2DecisionRecordsController where parseRoute' = do @@ -142,7 +142,7 @@ instance CanRoute ApiV2DecisionRecordsController where instance HasPath ApiV2DecisionRecordsController where pathTo ApiV2IndexDecisionRecordsAction = "/api/v2/decision-records" - pathTo ApiV2ShowDecisionRecordAction { decisionRecordId } = "/api/v2/decision-records/" <> show decisionRecordId + pathTo ApiV2ShowDecisionRecordAction { decisionRecordId } = "/api/v2/decision-records/" <> tshow decisionRecordId instance CanRoute ApiV2DeploymentRecordsController where parseRoute' = do @@ -155,7 +155,7 @@ instance CanRoute ApiV2DeploymentRecordsController where instance HasPath ApiV2DeploymentRecordsController where pathTo ApiV2IndexDeploymentRecordsAction = "/api/v2/deployment-records" - pathTo ApiV2ShowDeploymentRecordAction { deploymentRecordId } = "/api/v2/deployment-records/" <> show deploymentRecordId + pathTo ApiV2ShowDeploymentRecordAction { deploymentRecordId } = "/api/v2/deployment-records/" <> tshow deploymentRecordId instance CanRoute ApiV2OutcomeSignalsController where parseRoute' = do @@ -168,7 +168,7 @@ instance CanRoute ApiV2OutcomeSignalsController where instance HasPath ApiV2OutcomeSignalsController where pathTo ApiV2IndexOutcomeSignalsAction = "/api/v2/outcome-signals" - pathTo ApiV2ShowOutcomeSignalAction { outcomeSignalId } = "/api/v2/outcome-signals/" <> show outcomeSignalId + pathTo ApiV2ShowOutcomeSignalAction { outcomeSignalId } = "/api/v2/outcome-signals/" <> tshow outcomeSignalId instance CanRoute ApiV2RegistriesController where parseRoute' = do @@ -240,7 +240,7 @@ instance CanRoute ApiV2HubRegistryController where instance HasPath ApiV2HubRegistryController where pathTo ApiV2IndexHubRegistryAction = "/api/v2/hub-registry" - pathTo ApiV2ShowHubRegistryAction { hubId } = "/api/v2/hub-registry/" <> show hubId + pathTo ApiV2ShowHubRegistryAction { hubId } = "/api/v2/hub-registry/" <> tshow hubId instance CanRoute ApiV2WidgetPatternsController where parseRoute' = do @@ -258,8 +258,8 @@ instance CanRoute ApiV2WidgetPatternsController where instance HasPath ApiV2WidgetPatternsController where pathTo ApiV2IndexWidgetPatternsAction = "/api/v2/widget-patterns" - pathTo ApiV2ShowWidgetPatternAction { widgetPatternId } = "/api/v2/widget-patterns/" <> show widgetPatternId - pathTo ApiV2AdoptWidgetPatternAction { widgetPatternId } = "/api/v2/widget-patterns/" <> show widgetPatternId <> "/adopt" + pathTo ApiV2ShowWidgetPatternAction { widgetPatternId } = "/api/v2/widget-patterns/" <> tshow widgetPatternId + pathTo ApiV2AdoptWidgetPatternAction { widgetPatternId } = "/api/v2/widget-patterns/" <> tshow widgetPatternId <> "/adopt" -- Phase 11 — Advanced AI Federation (IHUB-WP-0012) instance AutoRoute AgentRegistrationsController @@ -296,7 +296,7 @@ instance HasPath ApiV2LearningController where pathTo ApiV2IndexOutcomeCorrelationsAction = "/api/v2/outcome-correlations" pathTo ApiV2IndexPatternPerformanceAction = "/api/v2/pattern-performance" pathTo ApiV2IndexKnowledgeBaseAction = "/api/v2/knowledge-base" - pathTo ApiV2ShowKnowledgeBaseAction { knowledgeEntryId } = "/api/v2/knowledge-base/" <> show knowledgeEntryId + pathTo ApiV2ShowKnowledgeBaseAction { knowledgeEntryId } = "/api/v2/knowledge-base/" <> tshow knowledgeEntryId -- Sessions instance AutoRoute SessionsController diff --git a/Web/Types.hs b/Web/Types.hs index ba0323e..b7c0d22 100644 --- a/Web/Types.hs +++ b/Web/Types.hs @@ -343,6 +343,27 @@ data ApiV2SdkController -- Phase 10 — Hub Registry and Widget Marketplace (IHUB-WP-0011) +-- | GAAF compliance status derived from manifest and registry. +data GaafStatus + = GaafCompliant -- active manifest, all declared types registered + | GaafNoManifest -- hub has no active manifest + | GaafDraftOnly -- hub has a draft but no active manifest + deriving (Eq, Show, Data) + +gaafStatus :: Maybe HubCapabilityManifest -> GaafStatus +gaafStatus Nothing = GaafNoManifest +gaafStatus (Just m) + | m.status == "active" = GaafCompliant + | m.status == "draft" = GaafDraftOnly + | otherwise = GaafNoManifest + +-- | Aggregated row for the hub registry index. +data HubRegistryRow = HubRegistryRow + { hub :: !Hub + , mManifest :: !(Maybe HubCapabilityManifest) + , mLatestSnapshot :: !(Maybe HubHealthSnapshot) + } + data HubRegistryController = HubRegistryAction | ShowHubRegistryAction { hubId :: !(Id Hub) } diff --git a/Web/View/AdaptiveThresholds/Index.hs b/Web/View/AdaptiveThresholds/Index.hs index b42cde2..dcabcc4 100644 --- a/Web/View/AdaptiveThresholds/Index.hs +++ b/Web/View/AdaptiveThresholds/Index.hs @@ -1,6 +1,6 @@ module Web.View.AdaptiveThresholds.Index where -import Web.View.Prelude +import IHP.ViewPrelude import Data.Time (diffUTCTime) data IndexView = IndexView @@ -34,16 +34,9 @@ instance View IndexView where

{h.name}

- {case mCfg of - Nothing -> [hsx|

Not calibrated

|] - Just cfg -> [hsx| -

- Last calibrated: {show cfg.calibrationDate} -

-

{maybe "" id cfg.notes}

- |]} + {renderCfgStatus mCfg}
-
+ {csrfTokenTag}
|] + +renderCfgStatus :: Maybe AdaptiveThresholdConfig -> Html +renderCfgStatus Nothing = [hsx|

Not calibrated

|] +renderCfgStatus (Just cfg) = [hsx| +

+ Last calibrated: {show cfg.calibrationDate} +

+

{maybe "" id cfg.notes}

+|] diff --git a/Web/View/AgentDelegations/Index.hs b/Web/View/AgentDelegations/Index.hs index eac4a3c..dd7e57f 100644 --- a/Web/View/AgentDelegations/Index.hs +++ b/Web/View/AgentDelegations/Index.hs @@ -1,6 +1,6 @@ module Web.View.AgentDelegations.Index where -import Web.View.Prelude +import IHP.ViewPrelude data IndexView = IndexView { delegations :: ![AgentDelegation] } diff --git a/Web/View/AgentDelegations/Show.hs b/Web/View/AgentDelegations/Show.hs index 673935e..8568631 100644 --- a/Web/View/AgentDelegations/Show.hs +++ b/Web/View/AgentDelegations/Show.hs @@ -1,7 +1,8 @@ module Web.View.AgentDelegations.Show where -import Web.View.Prelude +import IHP.ViewPrelude import Web.View.AgentDelegations.Index (statusBadge) +import Data.Aeson (Value) data ShowView = ShowView { delegation :: !AgentDelegation @@ -43,22 +44,24 @@ instance View ShowView where
- {case mParentProposal of - Nothing -> mempty - Just p -> [hsx| -
-

Parent Proposal

-

{p.proposalType} — {p.status}

-
- |]} + {maybe mempty renderParentProposal mParentProposal} - {case delegation.result of - Nothing -> mempty - Just r -> [hsx| -
-

Result

- 
{show r}
-
- |]} + {maybe mempty renderDelegationResult delegation.result} |] + +renderParentProposal :: AgentProposal -> Html +renderParentProposal p = [hsx| +
+

Parent Proposal

+

{p.proposalType} — {p.status}

+
+|] + +renderDelegationResult :: Value -> Html +renderDelegationResult r = [hsx| +
+

Result

+ 
{show r}
+
+|] diff --git a/Web/View/AgentProposals/Index.hs b/Web/View/AgentProposals/Index.hs index 125cdb7..2c96355 100644 --- a/Web/View/AgentProposals/Index.hs +++ b/Web/View/AgentProposals/Index.hs @@ -4,6 +4,7 @@ import Web.Types import Generated.Types import IHP.Prelude import IHP.ViewPrelude +import Web.Routes () data IndexView = IndexView { proposals :: ![AgentProposal] @@ -30,27 +31,34 @@ instance View IndexView where Type: All - {forEach allProposalTypes (\t -> [hsx| - {t} - |])} + {forEach allProposalTypes (renderTypeTab mStatusFilter mTypeFilter)}
Status: All - {forEach allStatuses (\s -> [hsx| - {s} - |])} + {forEach allStatuses (renderStatusTab mTypeFilter mStatusFilter)}
- {if null proposals - then [hsx|

No proposals found.

|] - else renderTable proposals widgets} + {if null proposals then noProposalsMsg else renderTable proposals widgets} |] +noProposalsMsg :: Html +noProposalsMsg = [hsx|

No proposals found.

|] + +renderTypeTab :: Maybe Text -> Maybe Text -> Text -> Html +renderTypeTab mStatusFilter mTypeFilter t = [hsx| + {t} +|] + +renderStatusTab :: Maybe Text -> Maybe Text -> Text -> Html +renderStatusTab mTypeFilter mStatusFilter s = [hsx| + {s} +|] + agentProposalsUrl :: Maybe Text -> Maybe Text -> Text agentProposalsUrl mt ms = let parts = catMaybes @@ -83,7 +91,7 @@ renderRow :: [Widget] -> AgentProposal -> Html renderRow widgets p = [hsx| - " text-xs px-2 py-0.5 rounded font-medium"}> {p.proposalType} @@ -99,9 +107,9 @@ renderRow widgets p = [hsx| |] -widgetName :: [Widget] -> Maybe (Id Widget) -> Text +widgetName :: [Widget] -> Maybe UUID -> Text widgetName _ Nothing = "—" -widgetName widgets (Just wid) = maybe "(unknown)" (.name) (find (\w -> w.id == wid) widgets) +widgetName widgets (Just wid) = maybe "(unknown)" (.name) (find (\w -> toUUID w.id == wid) widgets) renderConfidenceBar :: Maybe Double -> Html renderConfidenceBar Nothing = [hsx|—|] diff --git a/Web/View/AgentProposals/Show.hs b/Web/View/AgentProposals/Show.hs index 1c1c38b..3a9edca 100644 --- a/Web/View/AgentProposals/Show.hs +++ b/Web/View/AgentProposals/Show.hs @@ -4,6 +4,7 @@ import Web.Types import Generated.Types import IHP.Prelude import IHP.ViewPrelude +import Web.Routes () data ShowView = ShowView { proposal :: !AgentProposal @@ -55,9 +56,7 @@ instance View ShowView where - {case mReview of - Just review -> renderExistingReview review users - Nothing -> renderReviewForm proposal.id proposal.status} + {renderReviewSection mReview users proposal.id proposal.status}
@@ -66,6 +65,12 @@ instance View ShowView where
|] +renderReviewSection :: Maybe AgentReviewRecord -> [User] -> Id AgentProposal -> Text -> Html +renderReviewSection mReview users proposalId status = + case mReview of + Just review -> renderExistingReview review users + Nothing -> renderReviewForm proposalId status + renderConfidences :: [ConfidenceAnnotation] -> Html renderConfidences cs = [hsx|
@@ -89,7 +94,7 @@ renderConfidenceRow c =
- {maybe mempty (\e -> [hsx|

{e}

|]) c.explanation} + {maybe mempty renderConfExplanation c.explanation}
|] @@ -103,7 +108,7 @@ renderExistingReview review users = [hsx| by {reviewerName users review.reviewerId} at {show review.reviewedAt} - {maybe mempty (\n -> [hsx|

{n}

|]) review.notes} + {maybe mempty renderReviewNote review.notes} |] @@ -119,7 +124,7 @@ renderReviewForm pid status class="w-full border border-gray-300 rounded px-3 py-2 text-sm">
-
@@ -100,21 +91,43 @@ instance View ShowView where - {forEach recentProposals \p -> [hsx| - - {p.proposalType} - {p.status} - - {maybe "—" show p.tokensIn} / {maybe "—" show p.tokensOut} - - {timeAgo p.createdAt} - - |]} + {forEach recentProposals renderProposalRow} |] +renderMeanConfidence :: Maybe Double -> Html +renderMeanConfidence Nothing = [hsx|

Mean confidence: —

|] +renderMeanConfidence (Just c) = [hsx|

Mean confidence: {printf "%.2f" c :: String}

|] + +renderPolicyRow :: ModelRoutingPolicy -> Html +renderPolicyRow p = [hsx| + + {p.taskType} + {show p.priority} + {statusBadge p.isActive} + +|] + +noPoliciesMsg :: Html +noPoliciesMsg = [hsx|

No routing policies. Add one.

|] + +noProposalsMsg :: Html +noProposalsMsg = [hsx|

No proposals yet.

|] + +renderProposalRow :: AgentProposal -> Html +renderProposalRow p = [hsx| + + {p.proposalType} + {p.status} + + {maybe "—" show p.tokensIn} / {maybe "—" show p.tokensOut} + + {timeAgo p.createdAt} + +|] + performancePanel :: Maybe AgentPerformanceRecord -> Html performancePanel Nothing = [hsx|
@@ -145,9 +158,6 @@ performancePanel (Just p) =

Acceptance rate

- {case p.meanConfidence of - Nothing -> [hsx|

Mean confidence: —

|] - Just c -> [hsx|

Mean confidence: {printf "%.2f" c :: String}

|] - } + {renderMeanConfidence p.meanConfidence} |] diff --git a/Web/View/AiGovernancePolicies/Index.hs b/Web/View/AiGovernancePolicies/Index.hs index 936270a..655486a 100644 --- a/Web/View/AiGovernancePolicies/Index.hs +++ b/Web/View/AiGovernancePolicies/Index.hs @@ -1,6 +1,6 @@ module Web.View.AiGovernancePolicies.Index where -import Web.View.Prelude +import IHP.ViewPrelude data IndexView = IndexView { policies :: ![AiGovernancePolicy] @@ -48,9 +48,7 @@ instance View IndexView where {p.artifactType} {show p.allowedActions} - {if p.isActive - then [hsx|Active|] - else [hsx|Inactive|]} + {renderActiveStatus p.isActive} |] + +renderActiveStatus :: Bool -> Html +renderActiveStatus True = [hsx|Active|] +renderActiveStatus False = [hsx|Inactive|] diff --git a/Web/View/AiGovernancePolicies/New.hs b/Web/View/AiGovernancePolicies/New.hs index 565290a..4a82a99 100644 --- a/Web/View/AiGovernancePolicies/New.hs +++ b/Web/View/AiGovernancePolicies/New.hs @@ -1,6 +1,6 @@ module Web.View.AiGovernancePolicies.New where -import Web.View.Prelude +import IHP.ViewPrelude data NewView = NewView { policy :: !AiGovernancePolicy @@ -8,6 +8,20 @@ data NewView = NewView , agents :: ![AgentRegistration] } +renderHubOption :: Hub -> Html +renderHubOption h = [hsx||] + +renderAgentOption :: AgentRegistration -> Html +renderAgentOption a = [hsx||] + +renderActionOption :: (Text, Text) -> Html +renderActionOption (val, lbl) = [hsx| + +|] + allowedActionOptions :: [(Text, Text)] allowedActionOptions = [ ("read", "read — agent may read artifacts") @@ -25,25 +39,20 @@ instance View NewView where
-
{(textField #artifactType) { label = "Artifact Type", placeholder = "e.g. requirement_candidate, annotation, decision_record" }}
+
{(textField #artifactType) { fieldLabel = "Artifact Type", placeholder = "e.g. requirement_candidate, annotation, decision_record" }}
- {forEach allowedActionOptions \(val, label) -> [hsx| - - |]} + {forEach allowedActionOptions renderActionOption}
diff --git a/Web/View/AnnotationThreads/Index.hs b/Web/View/AnnotationThreads/Index.hs index 864ca1c..df3b1ae 100644 --- a/Web/View/AnnotationThreads/Index.hs +++ b/Web/View/AnnotationThreads/Index.hs @@ -4,6 +4,7 @@ import Web.Types import Generated.Types import IHP.Prelude import IHP.ViewPrelude +import Web.Routes () data IndexView = IndexView { widget :: !Widget @@ -16,28 +17,30 @@ instance View IndexView where
Widgets / - {widget.name} + {widget.name} / Threads

Annotation Threads

- New Thread
- {if null threads - then [hsx|

No threads yet.

|] - else [hsx| -
- {forEach threads (renderThreadRow allAnnotations)} -
- |]} + {renderThreadsSection threads allAnnotations} |] +renderThreadsSection :: [AnnotationThread] -> [Annotation] -> Html +renderThreadsSection [] _ = [hsx|

No threads yet.

|] +renderThreadsSection threads allAnnotations = [hsx| +
+ {forEach threads (renderThreadRow allAnnotations)} +
+|] + renderThreadRow :: [Annotation] -> AnnotationThread -> Html renderThreadRow allAnnotations t = let members = filter (\a -> a.threadId == Just t.id) allAnnotations @@ -47,11 +50,11 @@ renderThreadRow allAnnotations t =
- {t.title} - {maybe mempty (\d -> [hsx|

{d}

|]) t.description} + {maybe mempty renderThreadDesc t.description}
{show t.createdAt}
@@ -62,6 +65,9 @@ renderThreadRow allAnnotations t =
|] +renderThreadDesc :: Text -> Html +renderThreadDesc d = [hsx|

{d}

|] + buildSeverityBreakdown :: [Annotation] -> [(Text, Int)] buildSeverityBreakdown annotations = [ ("low", length $ filter (\a -> a.severity == "low") annotations) diff --git a/Web/View/AnnotationThreads/New.hs b/Web/View/AnnotationThreads/New.hs index 56a9cd3..468617c 100644 --- a/Web/View/AnnotationThreads/New.hs +++ b/Web/View/AnnotationThreads/New.hs @@ -4,6 +4,7 @@ import Web.Types import Generated.Types import IHP.Prelude import IHP.ViewPrelude +import Web.Routes () data NewView = NewView { widget :: !Widget @@ -13,9 +14,9 @@ data NewView = NewView instance View NewView where html NewView { .. } = [hsx|
- {widget.name} + {widget.name} / - Threads + Threads / New
diff --git a/Web/View/AnnotationThreads/Show.hs b/Web/View/AnnotationThreads/Show.hs index 757516f..5b2f4fc 100644 --- a/Web/View/AnnotationThreads/Show.hs +++ b/Web/View/AnnotationThreads/Show.hs @@ -4,6 +4,7 @@ import Web.Types import Generated.Types import IHP.Prelude import IHP.ViewPrelude +import Web.Routes () data ShowView = ShowView { widget :: !Widget @@ -14,9 +15,9 @@ data ShowView = ShowView instance View ShowView where html ShowView { .. } = [hsx|
- {widget.name} + {widget.name} / - Threads + Threads / {thread.title}
@@ -24,7 +25,7 @@ instance View ShowView where

{thread.title}

- {maybe mempty (\d -> [hsx|

{d}

|]) thread.description} + {maybe mempty renderThreadDesc thread.description}
@@ -59,11 +60,17 @@ renderSeverityBar annotations = nonZero = filter (\(_, n) -> n > 0) counts in if total == 0 then mempty - else [hsx| -
- {forEach nonZero (\(s, n) -> renderBarSegment s n total)} -
- |] + else renderSeverityBarItems nonZero total + +renderSeverityBarItems :: [(Text, Int)] -> Int -> Html +renderSeverityBarItems nonZero total = [hsx| +
+ {forEach nonZero (renderBarSegmentPair total)} +
+|] + +renderBarSegmentPair :: Int -> (Text, Int) -> Html +renderBarSegmentPair total (s, n) = renderBarSegment s n total renderBarSegment :: Text -> Int -> Int -> Html renderBarSegment sev n total = @@ -73,6 +80,9 @@ renderBarSegment sev n total =
|] +renderThreadDesc :: Text -> Html +renderThreadDesc d = [hsx|

{d}

|] + barColor :: Text -> Text barColor "low" = "bg-gray-300" barColor "medium" = "bg-blue-400" diff --git a/Web/View/Annotations/Index.hs b/Web/View/Annotations/Index.hs index 1a96fca..06bb45f 100644 --- a/Web/View/Annotations/Index.hs +++ b/Web/View/Annotations/Index.hs @@ -4,6 +4,7 @@ import Web.Types import Generated.Types import IHP.Prelude import IHP.ViewPrelude +import Web.Routes () data IndexView = IndexView { widget :: !Widget @@ -11,18 +12,21 @@ data IndexView = IndexView } instance View IndexView where - html IndexView { .. } = [hsx| + html IndexView { .. } = + let rootAnnotations = filter (\a -> isNothing a.parentId) annotations + childrenOf parent = filter (\a -> a.parentId == Just parent.id) annotations + in [hsx|
Widgets / - {widget.name} + {widget.name} / Annotations

Annotations for {widget.name}

- Add Annotation @@ -32,9 +36,6 @@ instance View IndexView where {forEach rootAnnotations (renderAnnotation childrenOf)}
|] - where - rootAnnotations = filter (\a -> isNothing a.parentId) annotations - childrenOf parent = filter (\a -> a.parentId == Just parent.id) annotations renderAnnotation :: (Annotation -> [Annotation]) -> Annotation -> Html renderAnnotation childrenOf a = [hsx| @@ -47,16 +48,14 @@ renderAnnotation childrenOf a = [hsx| {a.severity} {a.actorType} - {if isJust a.retractedAt - then [hsx|retracted|] - else mempty} + {if isJust a.retractedAt then retractedBadge else mempty} {show a.createdAt}

{a.body}

- Reply - Details / Escalate
@@ -65,6 +64,9 @@ renderAnnotation childrenOf a = [hsx|
|] +retractedBadge :: Html +retractedBadge = [hsx|retracted|] + severityClass :: Text -> Text severityClass "low" = "text-xs px-2 py-0.5 rounded bg-gray-100 text-gray-500" severityClass "medium" = "text-xs px-2 py-0.5 rounded bg-blue-100 text-blue-700" diff --git a/Web/View/Annotations/New.hs b/Web/View/Annotations/New.hs index 791cd10..a3bf560 100644 --- a/Web/View/Annotations/New.hs +++ b/Web/View/Annotations/New.hs @@ -4,6 +4,7 @@ import Web.Types import Generated.Types import IHP.Prelude import IHP.ViewPrelude +import Web.Routes () data NewView = NewView { widget :: !Widget @@ -15,9 +16,9 @@ instance View NewView where html NewView { .. } = [hsx|
- {widget.name} + {widget.name} / - Annotations + Annotations / New
@@ -35,7 +36,7 @@ renderForm annotation widgetId categories = formFor annotation [hsx| |] categoryOptions :: [AnnotationCategoryRegistry] -> [(Text, Text)] -categoryOptions = map (\r -> (r.label, r.name)) +categoryOptions = map (\r -> (r.label_, r.name)) severityOptions :: [(Text, Text)] severityOptions = diff --git a/Web/View/Annotations/Show.hs b/Web/View/Annotations/Show.hs index 208c3b8..ac7a4ec 100644 --- a/Web/View/Annotations/Show.hs +++ b/Web/View/Annotations/Show.hs @@ -4,6 +4,7 @@ import Web.Types import Generated.Types import IHP.Prelude import IHP.ViewPrelude +import Web.Routes () data ShowView = ShowView { widget :: !Widget @@ -16,9 +17,9 @@ instance View ShowView where
Widgets / - {widget.name} + {widget.name} / - Annotations + Annotations / Detail
@@ -32,9 +33,7 @@ instance View ShowView where {annotation.severity} - {if isJust annotation.retractedAt - then [hsx|retracted|] - else mempty} + {if isJust annotation.retractedAt then retractedBadge else mempty} {show annotation.createdAt}

{annotation.body}

@@ -50,8 +49,7 @@ instance View ShowView where renderEscalation :: Annotation -> Maybe RequirementCandidate -> Html renderEscalation annotation Nothing = [hsx|

This annotation has not been escalated yet.

- - {hiddenField "authenticity_token"} +
- {if record.subjectType == "Widget" - then [hsx| -
- View Lineage → -
- |] - else mempty} + {renderLineageLink record} |] + +renderLineageRefDt :: Text -> Html +renderLineageRefDt ref = [hsx| +
+
Lineage Reference
+
{ref}
+
+|] + +renderLineageLink :: ArchiveRecord -> Html +renderLineageLink record + | record.subjectType == "Widget" = [hsx| +
+ View Lineage → +
+ |] + | otherwise = mempty diff --git a/Web/View/CollectiveProposals/Index.hs b/Web/View/CollectiveProposals/Index.hs index b073d00..e34ed64 100644 --- a/Web/View/CollectiveProposals/Index.hs +++ b/Web/View/CollectiveProposals/Index.hs @@ -1,6 +1,6 @@ module Web.View.CollectiveProposals.Index where -import Web.View.Prelude +import IHP.ViewPrelude data IndexView = IndexView { proposals :: ![CollectiveProposal] } diff --git a/Web/View/CollectiveProposals/Show.hs b/Web/View/CollectiveProposals/Show.hs index 135afb5..2d4105b 100644 --- a/Web/View/CollectiveProposals/Show.hs +++ b/Web/View/CollectiveProposals/Show.hs @@ -1,7 +1,8 @@ module Web.View.CollectiveProposals.Show where -import Web.View.Prelude +import IHP.ViewPrelude import Web.View.CollectiveProposals.Index (consensusBadge) +import Data.Aeson (Value) data ShowView = ShowView { proposal :: !CollectiveProposal @@ -20,18 +21,9 @@ instance View ShowView where {consensusBadge proposal.consensusStatus} - {case proposal.summary of - Nothing -> mempty - Just s -> [hsx|

{s}

|]} + {maybe mempty renderProposalSummary proposal.summary} - {case proposal.finalContent of - Nothing -> mempty - Just fc -> [hsx| -
-

Synthesized Recommendation

- 
{show fc}
-
- |]} + {maybe mempty renderFinalContent proposal.finalContent}

@@ -43,16 +35,28 @@ instance View ShowView where

|] - where - renderContrib (contrib, agentName) = [hsx| -
-
- {agentName} - - {maybe "" (\m -> "model: " <> m) contrib.modelUsed} - {maybe "" (\t -> " · " <> show t <> " tokens out") contrib.tokensOut} - -
- 
{show contrib.content}
-
- |] + +renderProposalSummary :: Text -> Html +renderProposalSummary s = [hsx|

{s}

|] + +renderFinalContent :: Value -> Html +renderFinalContent fc = [hsx| +
+

Synthesized Recommendation

+ 
{show fc}
+
+|] + +renderContrib :: (CollectiveProposalContribution, Text) -> Html +renderContrib (contrib, agentName) = [hsx| +
+
+ {agentName} + + {maybe "" (\m -> "model: " <> m) contrib.modelUsed} + {maybe "" (\t -> " · " <> show t <> " tokens out") contrib.tokensOut} + +
+ 
{show contrib.content}
+
+|] diff --git a/Web/View/CrossHubPropagations/Index.hs b/Web/View/CrossHubPropagations/Index.hs index 8dd9bf4..1a67b6a 100644 --- a/Web/View/CrossHubPropagations/Index.hs +++ b/Web/View/CrossHubPropagations/Index.hs @@ -4,6 +4,7 @@ import Web.Types import Generated.Types import IHP.Prelude import IHP.ViewPrelude +import Web.Routes () data IndexView = IndexView { propagations :: ![CrossHubPropagation] @@ -20,65 +21,68 @@ instance View IndexView where - {if null propagations - then [hsx|

No propagation events detected yet.

|] - else [hsx| -
- - - - - - - - - - - - - {forEach propagations renderRow} - -
PatternSummarySource HubStatusDetected
-
- |]} + {renderPropagationsList propagations hubs} |] - where - hubName hid = maybe "–" (.name) (find (\h -> h.id == hid) hubs) +renderPropagationsList :: [CrossHubPropagation] -> [Hub] -> Html +renderPropagationsList [] _ = [hsx|

No propagation events detected yet.

|] +renderPropagationsList propagations hubs = [hsx| +
+ + + + + + + + + + + + + {forEach propagations (renderPropRow hubs)} + +
PatternSummarySource HubStatusDetected
+
+|] - renderRow :: CrossHubPropagation -> Html - renderRow p = [hsx| - - - - {p.patternType} - - - {p.summary} - - {maybe "–" hubName p.sourceHubId} - - - " text-xs px-2 py-0.5 rounded font-medium"}> - {p.status} - - - {show p.detectedAt} - - {if p.status == "open" - then [hsx| - Acknowledge - |] - else mempty} - {if p.status /= "resolved" - then [hsx| - Resolve - |] - else mempty} - - - |] +renderPropRow :: [Hub] -> CrossHubPropagation -> Html +renderPropRow hubs p = + let hubName hid = maybe "–" (.name) (find (\h -> h.id == hid) hubs) + in [hsx| + + + + {p.patternType} + + + {p.summary} + + {maybe "–" hubName p.sourceHubId} + + + " text-xs px-2 py-0.5 rounded font-medium"}> + {p.status} + + + {show p.detectedAt} + + {renderAcknowledgeLink p} + {renderResolveLink p} + + +|] + +renderAcknowledgeLink :: CrossHubPropagation -> Html +renderAcknowledgeLink p + | p.status == "open" = [hsx|Acknowledge|] + | otherwise = mempty + +renderResolveLink :: CrossHubPropagation -> Html +renderResolveLink p + | p.status /= "resolved" = [hsx|Resolve|] + | otherwise = mempty statusBadge :: Text -> Text statusBadge s = case s of diff --git a/Web/View/DecisionRecords/Edit.hs b/Web/View/DecisionRecords/Edit.hs index 51a6019..ba79140 100644 --- a/Web/View/DecisionRecords/Edit.hs +++ b/Web/View/DecisionRecords/Edit.hs @@ -4,6 +4,7 @@ import Web.Types import Generated.Types import IHP.Prelude import IHP.ViewPrelude +import Web.Routes () import Web.View.DecisionRecords.New (renderForm) data EditView = EditView @@ -18,7 +19,7 @@ instance View EditView where
Decisions / - {record.title} / Edit diff --git a/Web/View/DecisionRecords/Index.hs b/Web/View/DecisionRecords/Index.hs index 54231b9..0800172 100644 --- a/Web/View/DecisionRecords/Index.hs +++ b/Web/View/DecisionRecords/Index.hs @@ -4,6 +4,7 @@ import Web.Types import Generated.Types import IHP.Prelude import IHP.ViewPrelude +import Web.Routes () data IndexView = IndexView { records :: ![DecisionRecord] @@ -29,17 +30,21 @@ instance View IndexView where
All - {forEach allOutcomes (\o -> [hsx| - {o} - |])} + {forEach allOutcomes (renderOutcomeTab mOutcomeFilter)}
- {if null records - then [hsx|

No decision records found.

|] - else renderTable records requirements users} + {if null records then noDecisionsMsg else renderTable records requirements users} |] +noDecisionsMsg :: Html +noDecisionsMsg = [hsx|

No decision records found.

|] + +renderOutcomeTab :: Maybe Text -> Text -> Html +renderOutcomeTab mOutcomeFilter o = [hsx| + {o} +|] + decisionFilterUrl :: Text -> Text decisionFilterUrl o = "/DecisionRecords?outcome=" <> o @@ -67,7 +72,7 @@ renderRow :: [Requirement] -> [User] -> DecisionRecord -> Html renderRow reqs users dr = [hsx| - {dr.title} @@ -89,9 +94,9 @@ linkedReqTitle :: [Requirement] -> Maybe (Id Requirement) -> Text linkedReqTitle _ Nothing = "—" linkedReqTitle reqs (Just rid) = maybe "(unknown)" (.title) (find (\r -> r.id == rid) reqs) -userName :: [User] -> Maybe (Id User) -> Text +userName :: [User] -> Maybe UUID -> Text userName _ Nothing = "—" -userName users (Just uid) = maybe "(unknown)" (.name) (find (\u -> u.id == uid) users) +userName users (Just uid) = maybe "(unknown)" (.name) (find (\u -> toUUID u.id == uid) users) outcomeClass :: Text -> Text outcomeClass "accepted" = "bg-green-100 text-green-800" diff --git a/Web/View/DecisionRecords/New.hs b/Web/View/DecisionRecords/New.hs index 1ae0480..bf83251 100644 --- a/Web/View/DecisionRecords/New.hs +++ b/Web/View/DecisionRecords/New.hs @@ -4,6 +4,7 @@ import Web.Types import Generated.Types import IHP.Prelude import IHP.ViewPrelude +import Web.Routes () data NewView = NewView { record :: !DecisionRecord @@ -29,8 +30,6 @@ instance View NewView where renderForm :: DecisionRecord -> [Requirement] -> [RequirementCandidate] -> [User] -> action -> Html renderForm record requirements candidates users submitAction = [hsx| - {hiddenField "authenticity_token"} -
- {forEach requirements (\r -> [hsx||])} + {forEach requirements renderRequirementOption}
@@ -73,7 +72,7 @@ renderForm record requirements candidates users submitAction = [hsx|
@@ -82,7 +81,7 @@ renderForm record requirements candidates users submitAction = [hsx| + >{fromMaybe "" record.notes}
@@ -95,3 +94,9 @@ renderForm record requirements candidates users submitAction = [hsx|
|] + +renderRequirementOption :: Requirement -> Html +renderRequirementOption r = [hsx||] + +renderCandidateOption :: RequirementCandidate -> Html +renderCandidateOption c = [hsx||] diff --git a/Web/View/DecisionRecords/Show.hs b/Web/View/DecisionRecords/Show.hs index 51cb5fa..f5d83a3 100644 --- a/Web/View/DecisionRecords/Show.hs +++ b/Web/View/DecisionRecords/Show.hs @@ -4,6 +4,8 @@ import Web.Types import Generated.Types import IHP.Prelude import IHP.ViewPrelude +import Web.Routes () +import Data.Int (Int16) data ShowView = ShowView { record :: !DecisionRecord @@ -33,7 +35,7 @@ instance View ShowView where " text-xs px-2 py-0.5 rounded font-medium"}> {record.outcome} - Edit @@ -52,12 +54,7 @@ instance View ShowView where

Linked Requirement

- {case mRequirement of - Nothing -> [hsx|

No requirement linked.

|] - Just req -> [hsx| - {req.title} - |]} + {renderLinkedRequirement mRequirement}
@@ -67,7 +64,7 @@ instance View ShowView where

Policy References

{forEach policyRefs renderPolicyRef} -
{hiddenField "authenticity_token"}
@@ -98,32 +95,23 @@ instance View ShowView where

Deployments

- {if null implRefs - then mempty - else [hsx| - "?decisionId=" <> show record.id} - class="text-xs border border-indigo-300 text-indigo-600 px-3 py-1 rounded hover:bg-indigo-50"> - New Deployment - - |]} + {if null implRefs then mempty else renderNewDeploymentLink record.id}
- {if null deploymentRecords - then [hsx|

No deployments recorded yet.

|] - else [hsx|{forEach deploymentRecords (renderDeploymentRow evaluations)}|]} + {if null deploymentRecords then noDeploymentsMsg else forEach deploymentRecords (renderDeploymentRow evaluations)}

Implementation References

- +
{forEach implRefs renderImplRef} -
{hiddenField "authenticity_token"}
@@ -163,7 +151,7 @@ renderCandidateSection :: RequirementCandidate -> Html renderCandidateSection c = [hsx|

Source Candidate

- {c.title}
|] @@ -175,11 +163,11 @@ renderPolicyRef ref = [hsx| " text-xs px-2 py-0.5 rounded font-medium"}> {ref.policyScope} - {maybe mempty (\n -> [hsx|{n}|]) ref.constraintNote} + {maybe mempty renderConstraintNote ref.constraintNote} {show ref.createdAt}
+ action={DeletePolicyReferenceAction (ref.id)}> {hiddenField "authenticity_token"} @@ -198,7 +186,7 @@ renderImplRef ref = [hsx| {show ref.linkedAt}
+ action={DeleteImplementationRefAction (ref.id)}> {hiddenField "authenticity_token"} @@ -228,11 +216,32 @@ systemBadgeClass "linear" = "bg-violet-100 text-violet-800" systemBadgeClass "jira" = "bg-blue-100 text-blue-800" systemBadgeClass _ = "bg-gray-100 text-gray-600" +renderLinkedRequirement :: Maybe Requirement -> Html +renderLinkedRequirement Nothing = [hsx|

No requirement linked.

|] +renderLinkedRequirement (Just req) = [hsx| + {req.title} +|] + +renderNewDeploymentLink :: Id DecisionRecord -> Html +renderNewDeploymentLink recordId = [hsx| + "?decisionId=" <> show recordId} + class="text-xs border border-indigo-300 text-indigo-600 px-3 py-1 rounded hover:bg-indigo-50"> + New Deployment + +|] + +noDeploymentsMsg :: Html +noDeploymentsMsg = [hsx|

No deployments recorded yet.

|] + +renderConstraintNote :: Text -> Html +renderConstraintNote n = [hsx|{n}|] + renderDeploymentRow :: [ChangeEvaluation] -> DeploymentRecord -> Html renderDeploymentRow evals dr = [hsx|
- {dr.versionRef} {show dr.deployedAt}
diff --git a/Web/View/DeploymentRecords/Index.hs b/Web/View/DeploymentRecords/Index.hs index b263992..d1f25cf 100644 --- a/Web/View/DeploymentRecords/Index.hs +++ b/Web/View/DeploymentRecords/Index.hs @@ -4,6 +4,8 @@ import Web.Types import Generated.Types import IHP.Prelude import IHP.ViewPrelude +import Web.Routes () +import Data.Int (Int16) data IndexView = IndexView { records :: ![DeploymentRecord] @@ -22,11 +24,12 @@ instance View IndexView where
- {if null records - then [hsx|

No deployment records yet.

|] - else renderTable records decisions signals evaluations} + {if null records then noDeployments else renderTable records decisions signals evaluations} |] +noDeployments :: Html +noDeployments = [hsx|

No deployment records yet.

|] + renderTable :: [DeploymentRecord] -> [DecisionRecord] -> [OutcomeSignal] -> [ChangeEvaluation] -> Html renderTable records decisions signals evaluations = [hsx|
@@ -51,14 +54,14 @@ renderRow :: [DecisionRecord] -> [OutcomeSignal] -> [ChangeEvaluation] -> Deploy renderRow decisions signals evaluations record = [hsx| - {decisionTitle} {record.versionRef} {show record.deployedAt} {show signalCount} - {maybe [hsx|—|] renderScoreBadge mScore} + {renderMaybeScore mScore} |] @@ -69,6 +72,10 @@ renderRow decisions signals evaluations record = [hsx| mScore :: Maybe Int16 mScore = fmap (.score) $ find (\e -> e.deploymentId == record.id) evaluations +renderMaybeScore :: Maybe Int16 -> Html +renderMaybeScore Nothing = [hsx|—|] +renderMaybeScore (Just score) = renderScoreBadge score + renderScoreBadge :: Int16 -> Html renderScoreBadge score = [hsx| " text-xs px-2 py-0.5 rounded font-medium"}> diff --git a/Web/View/DeploymentRecords/New.hs b/Web/View/DeploymentRecords/New.hs index bdbbade..c38a462 100644 --- a/Web/View/DeploymentRecords/New.hs +++ b/Web/View/DeploymentRecords/New.hs @@ -4,6 +4,7 @@ import Web.Types import Generated.Types import IHP.Prelude import IHP.ViewPrelude +import Web.Routes () data NewView = NewView { record :: !DeploymentRecord @@ -26,8 +27,6 @@ instance View NewView where - {hiddenField "authenticity_token"} -
diff --git a/Web/View/DeploymentRecords/Show.hs b/Web/View/DeploymentRecords/Show.hs index b3771bb..48a59f2 100644 --- a/Web/View/DeploymentRecords/Show.hs +++ b/Web/View/DeploymentRecords/Show.hs @@ -4,6 +4,8 @@ import Web.Types import Generated.Types import IHP.Prelude import IHP.ViewPrelude +import Web.Routes () +import Data.Int (Int16) data PeriodMetrics = PeriodMetrics { eventCount :: !Int @@ -59,7 +61,7 @@ instance View ShowView where
Decision - {decision.title} " text-xs px-2 py-0.5 rounded font-medium"}> {decision.outcome} @@ -75,12 +77,10 @@ instance View ShowView where

Outcome Signals

- {if null signals - then [hsx|

No signals recorded yet.

|] - else [hsx|
{forEach signals renderSignal}
|]} - - {hiddenField "authenticity_token"} +
- {forEach hubs (\h -> [hsx| - - |])} + {forEach hubs renderHubOption}
@@ -47,13 +46,7 @@ instance View NewView where Categories (select all that apply)
- {forEach categories (\(n, l) -> [hsx| - - |])} + {forEach categories renderCategoryCheckbox}
@@ -71,3 +64,15 @@ instance View NewView where
|] + +renderHubOption :: Hub -> Html +renderHubOption h = [hsx||] + +renderCategoryCheckbox :: (Text, Text) -> Html +renderCategoryCheckbox (n, l) = [hsx| + +|] diff --git a/Web/View/GovernanceTemplates/Show.hs b/Web/View/GovernanceTemplates/Show.hs index e988da2..fd4c2f7 100644 --- a/Web/View/GovernanceTemplates/Show.hs +++ b/Web/View/GovernanceTemplates/Show.hs @@ -4,6 +4,7 @@ import Web.Types import Generated.Types import IHP.Prelude import IHP.ViewPrelude +import Web.Routes () import Data.Aeson (Value(..), decode, encode) import qualified Data.ByteString.Lazy.Char8 as BL @@ -23,23 +24,19 @@ instance View ShowView where

{template.name}

- {if template.isPublished - then [hsx|published|] - else [hsx|draft|]} + {renderPublishedBadge template.isPublished}

Hub: {hub.name}

{tshow cloneCount} clones

- {maybe mempty (\d -> [hsx|

{d}

|]) template.description} + {maybe mempty renderTemplateDesc template.description}

Categories

{forEach (jsonArrayTexts template.categories) renderCategoryTag} - {if null (jsonArrayTexts template.categories) - then [hsx|None|] - else mempty} + {if null (jsonArrayTexts template.categories) then noCategoriesBadge else mempty}
@@ -50,21 +47,32 @@ instance View ShowView where
- {if template.isPublished - then [hsx| - - Clone to My Hub - - |] - else mempty} + {if template.isPublished then renderCloneLink template.id else mempty} |] +renderCloneLink :: Id GovernanceTemplate -> Html +renderCloneLink tid = [hsx| + + Clone to My Hub + +|] + renderCategoryTag :: Text -> Html renderCategoryTag cat = [hsx| {cat} |] +renderPublishedBadge :: Bool -> Html +renderPublishedBadge True = [hsx|published|] +renderPublishedBadge False = [hsx|draft|] + +noCategoriesBadge :: Html +noCategoriesBadge = [hsx|None|] + +renderTemplateDesc :: Text -> Html +renderTemplateDesc d = [hsx|

{d}

|] + jsonArrayTexts :: Value -> [Text] jsonArrayTexts val = case decode (encode val) of Just (arr :: [Text]) -> arr diff --git a/Web/View/HubCapabilityManifests/Edit.hs b/Web/View/HubCapabilityManifests/Edit.hs index 851fea5..f4d8ff3 100644 --- a/Web/View/HubCapabilityManifests/Edit.hs +++ b/Web/View/HubCapabilityManifests/Edit.hs @@ -4,6 +4,7 @@ import Web.Types import Generated.Types import IHP.Prelude import IHP.ViewPrelude +import Web.Routes () import Data.Aeson (Value(..), encode, decode) import qualified Data.Vector as V import qualified Data.ByteString.Lazy.Char8 as BL @@ -20,7 +21,7 @@ data EditView = EditView instance View EditView where html EditView { .. } = [hsx|
- ← {hub.name} Manifest @@ -30,26 +31,23 @@ instance View EditView where Declare the type names this hub owns. After saving, activate the manifest to register them.

- {if manifest.status /= "draft" - then [hsx| -
- This manifest is {manifest.status} and is read-only. - Retire it first to create a new draft amendment. -
- |] - else [hsx||]} + {renderReadOnlyWarning manifest} -
+

Manifest Details

- {(textareaField #capabilityDescription) { fieldClass = "w-full border border-gray-300 rounded px-3 py-2 text-sm" }} +
- {(textField #contact) { fieldClass = "w-full border border-gray-300 rounded px-3 py-2 text-sm" }} +
@@ -64,17 +62,20 @@ instance View EditView where {if manifest.status /= "draft" then ("disabled" :: Text) else ""}> Save - {if manifest.status == "draft" then [hsx| - - Save & Activate - - |] else [hsx||]} + {if manifest.status == "draft" then renderActivateLink manifest.id else mempty}
|] +renderActivateLink :: Id HubCapabilityManifest -> Html +renderActivateLink mid = [hsx| + + Save & Activate + +|] + -- | Render a JSON array text area with available registry options shown below. typeArraySection :: Text -> Text -> Value -> [WidgetTypeRegistry] -> Html typeArraySection title fieldName val entries = [hsx| @@ -121,6 +122,16 @@ typeArraySection3 title fieldName val entries = [hsx|
|] +renderReadOnlyWarning :: HubCapabilityManifest -> Html +renderReadOnlyWarning manifest + | manifest.status /= "draft" = [hsx| +
+ This manifest is {manifest.status} and is read-only. + Retire it first to create a new draft amendment. +
+ |] + | otherwise = mempty + valueText :: Value -> Text valueText v = cs (BL.unpack (encode v)) diff --git a/Web/View/HubCapabilityManifests/Index.hs b/Web/View/HubCapabilityManifests/Index.hs index b2b40bc..b222840 100644 --- a/Web/View/HubCapabilityManifests/Index.hs +++ b/Web/View/HubCapabilityManifests/Index.hs @@ -4,6 +4,7 @@ import Web.Types import Generated.Types import IHP.Prelude import IHP.ViewPrelude +import Web.Routes () import Data.Aeson (Value(..)) import qualified Data.Vector as V @@ -56,7 +57,7 @@ renderRow hubs m = [hsx| {jsonCount m.declaredPolicyScopes} {maybe "—" show m.activatedAt} - View diff --git a/Web/View/HubCapabilityManifests/New.hs b/Web/View/HubCapabilityManifests/New.hs index eb4cfb0..3a6add0 100644 --- a/Web/View/HubCapabilityManifests/New.hs +++ b/Web/View/HubCapabilityManifests/New.hs @@ -4,6 +4,7 @@ import Web.Types import Generated.Types import IHP.Prelude import IHP.ViewPrelude +import Web.Routes () data NewView = NewView { manifest :: !HubCapabilityManifest @@ -23,33 +24,18 @@ instance View NewView where annotation categories, and policy scopes it owns. Create a draft, declare your types, then activate to register them with the framework.
-
-
-
- - {selectField #hubId (hubOptions hubs)} -
-
- - {(textareaField #capabilityDescription) { fieldClass = "w-full border border-gray-300 rounded px-3 py-2 text-sm" }} -
-
- - {(textField #contact) { fieldClass = "w-full border border-gray-300 rounded px-3 py-2 text-sm" }} -
-
- -
-
-
+
+ {renderManifestForm manifest hubs} +
|] +renderManifestForm :: HubCapabilityManifest -> [Hub] -> Html +renderManifestForm manifest hubs = formFor manifest [hsx| + {selectField #hubId (hubOptions hubs)} + {(textareaField #capabilityDescription) { fieldLabel = "Capability Description" }} + {(textField #contact) { fieldLabel = "Contact (team or person)" }} + {submitButton { label = "Create Draft" }} +|] + hubOptions :: [Hub] -> [(Text, Id Hub)] hubOptions hubs = map (\h -> (h.name <> " (" <> h.hubKind <> ")", h.id)) hubs diff --git a/Web/View/HubCapabilityManifests/Show.hs b/Web/View/HubCapabilityManifests/Show.hs index 821d2ec..e43382d 100644 --- a/Web/View/HubCapabilityManifests/Show.hs +++ b/Web/View/HubCapabilityManifests/Show.hs @@ -4,6 +4,7 @@ import Web.Types import Generated.Types import IHP.Prelude import IHP.ViewPrelude +import Web.Routes () import Data.Aeson (Value(..), encode) import qualified Data.Vector as V import qualified Data.ByteString.Lazy.Char8 as BL @@ -26,30 +27,7 @@ instance View ShowView where {statusBadge manifest.status}
- {if manifest.status == "draft" - then [hsx| -
- - Edit Draft - - - Activate - -
- |] - else if manifest.status == "active" - then [hsx| -
- - Retire - -
- |] - else [hsx||]} + {manifestActions manifest}
@@ -62,12 +40,8 @@ instance View ShowView where
- {forEach (maybeText manifest.capabilityDescription) (\d -> [hsx| -

{d}

- |])} - {forEach (maybeText manifest.contact) (\c -> [hsx| -

Contact: {c}

- |])} + {forEach (maybeText manifest.capabilityDescription) renderCapabilityDesc} + {forEach (maybeText manifest.contact) renderContactLine}
{jsonArraySection "Declared Widget Types" manifest.declaredWidgetTypes} @@ -77,6 +51,37 @@ instance View ShowView where
|] +manifestActions :: HubCapabilityManifest -> Html +manifestActions manifest + | manifest.status == "draft" = [hsx| +
+ + Edit Draft + + + Activate + +
+ |] + | manifest.status == "active" = [hsx| +
+ + Retire + +
+ |] + | otherwise = mempty + +renderCapabilityDesc :: Text -> Html +renderCapabilityDesc d = [hsx|

{d}

|] + +renderContactLine :: Text -> Html +renderContactLine c = [hsx|

Contact: {c}

|] + jsonArraySection :: Text -> Value -> Html jsonArraySection title val = [hsx|
diff --git a/Web/View/HubRegistry/Index.hs b/Web/View/HubRegistry/Index.hs index a638339..81948b2 100644 --- a/Web/View/HubRegistry/Index.hs +++ b/Web/View/HubRegistry/Index.hs @@ -1,10 +1,11 @@ module Web.View.HubRegistry.Index where import Web.Types -import Web.Controller.HubRegistry (HubRegistryRow(..), GaafStatus(..), gaafStatus) +import Web.Types (HubRegistryRow(..), GaafStatus(..), gaafStatus) import Generated.Types import IHP.Prelude import IHP.ViewPrelude +import Web.Routes () import Data.Aeson (Value(..)) import qualified Data.Vector as V @@ -29,12 +30,13 @@ instance View IndexView where
{forEach registryRows renderRow} - {if null registryRows - then [hsx|

No hubs registered yet.

|] - else mempty} + {if null registryRows then noHubsMsg else mempty}
|] +noHubsMsg :: Html +noHubsMsg = [hsx|

No hubs registered yet.

|] + renderRow :: HubRegistryRow -> Html renderRow row@HubRegistryRow { hub, mManifest, mLatestSnapshot } = let gs = gaafStatus mManifest @@ -46,7 +48,7 @@ renderRow row@HubRegistryRow { hub, mManifest, mLatestSnapshot } =
- {hub.name} @@ -74,7 +76,8 @@ gaafBadge GaafNoManifest = healthScoreBadge :: Int -> Html healthScoreBadge s = - let cls = if s >= 80 then "bg-green-100 text-green-800" + let cls :: Text + cls = if s >= 80 then "bg-green-100 text-green-800" else if s >= 50 then "bg-amber-100 text-amber-800" else "bg-red-100 text-red-700" in [hsx| cls}>health {tshow s}|] diff --git a/Web/View/HubRegistry/Show.hs b/Web/View/HubRegistry/Show.hs index be14d7d..7fb0799 100644 --- a/Web/View/HubRegistry/Show.hs +++ b/Web/View/HubRegistry/Show.hs @@ -1,10 +1,10 @@ module Web.View.HubRegistry.Show where import Web.Types -import Web.Controller.HubRegistry (GaafStatus(..), gaafStatus) import Generated.Types import IHP.Prelude import IHP.ViewPrelude +import Web.Routes () import Data.Aeson (Value(..), encode) import qualified Data.Vector as V import qualified Data.ByteString.Lazy.Char8 as BL @@ -47,54 +47,64 @@ instance View ShowView where
- {case mManifest of - Nothing -> [hsx| -
- No active manifest. Create one to register hub-owned types. -
- |] - Just m -> [hsx| -
- {jsonArraySection "Widget Types" m.declaredWidgetTypes} - {jsonArraySection "Event Types" m.declaredEventTypes} - {jsonArraySection "Annotation Categories" m.declaredAnnotationCategories} - {jsonArraySection "Policy Scopes" m.declaredPolicyScopes} -
- |]} + {manifestSection mManifest}

Health History

- {if null healthHistory - then [hsx|

No snapshots recorded yet.

|] - else [hsx| -
- - - - - - - - - - - - - {forEach healthHistory renderSnapshotRow} - -
ScoreOpen CandidatesRegressed WidgetsStale DecisionsActive BottlenecksComputed At
-
- |]} + {renderHealthHistory healthHistory}

Adopted Patterns

- {if null adoptedPatterns - then [hsx|

No patterns adopted yet. Browse patterns →

|] - else [hsx| -
- {forEach adoptedPatterns renderAdoptedPattern} -
- |]} + {renderAdoptedPatternsSection adoptedPatterns} |] +manifestSection :: Maybe HubCapabilityManifest -> Html +manifestSection Nothing = [hsx| +
+ No active manifest. Create one to register hub-owned types. +
+|] +manifestSection (Just m) = [hsx| +
+ {jsonArraySection "Widget Types" m.declaredWidgetTypes} + {jsonArraySection "Event Types" m.declaredEventTypes} + {jsonArraySection "Annotation Categories" m.declaredAnnotationCategories} + {jsonArraySection "Policy Scopes" m.declaredPolicyScopes} +
+|] + +renderAdoptedPatternsSection :: [AdoptedPatternRow] -> Html +renderAdoptedPatternsSection [] = [hsx|

No patterns adopted yet. Browse patterns →

|] +renderAdoptedPatternsSection ps = [hsx| +
+ {forEach ps renderAdoptedPattern} +
+|] + +renderPinnedBadge :: Bool -> Html +renderPinnedBadge True = [hsx|pinned|] +renderPinnedBadge False = [hsx|follow latest|] + +renderHealthHistory :: [HubHealthSnapshot] -> Html +renderHealthHistory [] = [hsx|

No snapshots recorded yet.

|] +renderHealthHistory history = [hsx| +
+ + + + + + + + + + + + + {forEach history renderSnapshotRow} + +
ScoreOpen CandidatesRegressed WidgetsStale DecisionsActive BottlenecksComputed At
+
+|] + manifestCell :: Maybe HubCapabilityManifest -> Id Hub -> Html manifestCell Nothing hubId = [hsx|
@@ -106,7 +116,7 @@ manifestCell Nothing hubId = [hsx| manifestCell (Just m) _ = [hsx|
{m.manifestVersion} - View
|] @@ -163,16 +173,14 @@ renderAdoptedPattern :: AdoptedPatternRow -> Html renderAdoptedPattern (patternId, patternName, widgetType, _, _, isPinned, adoptedAt) = [hsx|
- {patternName} {widgetType}
- {if isPinned - then [hsx|pinned|] - else [hsx|follow latest|]} + {renderPinnedBadge isPinned} {tshow adoptedAt}
diff --git a/Web/View/HubRoutingRules/Edit.hs b/Web/View/HubRoutingRules/Edit.hs index 9f483ce..6a724aa 100644 --- a/Web/View/HubRoutingRules/Edit.hs +++ b/Web/View/HubRoutingRules/Edit.hs @@ -4,6 +4,7 @@ import Web.Types import Generated.Types import IHP.Prelude import IHP.ViewPrelude +import Web.Routes () data EditView = EditView { rule :: !HubRoutingRule diff --git a/Web/View/HubRoutingRules/Index.hs b/Web/View/HubRoutingRules/Index.hs index 28bbf86..27a9dd7 100644 --- a/Web/View/HubRoutingRules/Index.hs +++ b/Web/View/HubRoutingRules/Index.hs @@ -4,6 +4,7 @@ import Web.Types import Generated.Types import IHP.Prelude import IHP.ViewPrelude +import Web.Routes () data IndexView = IndexView { rules :: ![HubRoutingRule] @@ -20,56 +21,60 @@ instance View IndexView where
- {if null rules - then [hsx|

No routing rules configured yet.

|] - else [hsx| -
- - - - - - - - - - - - - {forEach rules renderRow} - -
Source → TargetMatch CategoryMatch Widget TypePriorityStatus
-
- |]} + {renderRulesList rules hubs} |] - where - hubName hid = maybe (show hid) (.name) (find (\h -> h.id == hid) hubs) +renderRulesList :: [HubRoutingRule] -> [Hub] -> Html +renderRulesList [] _ = [hsx|

No routing rules configured yet.

|] +renderRulesList rules hubs = [hsx| +
+ + + + + + + + + + + + + {forEach rules (renderRoutingRuleRow hubs)} + +
Source → TargetMatch CategoryMatch Widget TypePriorityStatus
+
+|] - renderRow :: HubRoutingRule -> Html - renderRow r = [hsx| - - - {hubName r.sourceHubId} → {hubName r.targetHubId} - - {maybe "any" id r.matchCategory} - {maybe "any" id r.matchWidgetType} - {show r.priority} - - " text-xs px-2 py-0.5 rounded font-medium"}> - {r.status} - - - - View - {if r.status == "inactive" - then [hsx|Activate|] - else [hsx|Deactivate|]} - - - |] +renderRoutingRuleRow :: [Hub] -> HubRoutingRule -> Html +renderRoutingRuleRow hubs r = + let hubName hid = maybe (show hid) (.name) (find (\h -> toUUID h.id == hid) hubs) + in [hsx| + + + {hubName r.sourceHubId} → {hubName r.targetHubId} + + {fromMaybe "any" r.matchCategory} + {fromMaybe "any" r.matchWidgetType} + {show r.priority} + + " text-xs px-2 py-0.5 rounded font-medium"}> + {r.status} + + + + View + {renderRuleToggle r} + + +|] + +renderRuleToggle :: HubRoutingRule -> Html +renderRuleToggle r + | r.status == "inactive" = [hsx|Activate|] + | otherwise = [hsx|Deactivate|] statusBadge :: Text -> Text statusBadge s = case s of diff --git a/Web/View/HubRoutingRules/New.hs b/Web/View/HubRoutingRules/New.hs index 666581f..93f2540 100644 --- a/Web/View/HubRoutingRules/New.hs +++ b/Web/View/HubRoutingRules/New.hs @@ -4,6 +4,7 @@ import Web.Types import Generated.Types import IHP.Prelude import IHP.ViewPrelude +import Web.Routes () data NewView = NewView { rule :: !HubRoutingRule @@ -20,8 +21,8 @@ instance View NewView where renderForm :: HubRoutingRule -> [Hub] -> Html renderForm rule hubs = formFor rule [hsx| - {(selectField #sourceHubId hubs){ label = "Source Hub" }} - {(selectField #targetHubId hubs){ label = "Target Hub" }} + {(selectField #sourceHubId hubs){ fieldLabel = "Source Hub" }} + {(selectField #targetHubId hubs){ fieldLabel = "Target Hub" }} {(textField #matchCategory){ helpText = "Leave blank to match any category" }} {(textField #matchWidgetType){ helpText = "Leave blank to match any widget type" }} {(numberField #priority){ helpText = "Higher priority rules are evaluated first" }} diff --git a/Web/View/HubRoutingRules/RoutedCandidates.hs b/Web/View/HubRoutingRules/RoutedCandidates.hs index 7429127..45725c6 100644 --- a/Web/View/HubRoutingRules/RoutedCandidates.hs +++ b/Web/View/HubRoutingRules/RoutedCandidates.hs @@ -4,6 +4,7 @@ import Web.Types import Generated.Types import IHP.Prelude import IHP.ViewPrelude +import Web.Routes () data RoutedCandidatesView = RoutedCandidatesView { hub :: !Hub @@ -22,42 +23,43 @@ instance View RoutedCandidatesView where Requirement candidates routed to this hub from other hubs.

- {if null candidates - then [hsx|

No candidates routed to this hub yet.

|] - else [hsx| -
- - - - - - - - - - - - {forEach candidates renderRow} - -
SummaryCategoryStatusCreated
-
- |]} + {renderRoutedCandidates candidates} |] - where - renderRow :: RequirementCandidate -> Html - renderRow c = [hsx| - - {c.summary} - {c.category} - - - {c.status} - - - {show c.createdAt} - - View - - - |] +renderRoutedCandidates :: [RequirementCandidate] -> Html +renderRoutedCandidates [] = [hsx|

No candidates routed to this hub yet.

|] +renderRoutedCandidates candidates = [hsx| +
+ + + + + + + + + + + + {forEach candidates renderCandidateRow} + +
SummaryCategoryStatusCreated
+
+|] + +renderCandidateRow :: RequirementCandidate -> Html +renderCandidateRow c = [hsx| + + {c.summary} + {c.category} + + + {c.status} + + + {show c.createdAt} + + View + + +|] diff --git a/Web/View/HubRoutingRules/Show.hs b/Web/View/HubRoutingRules/Show.hs index fd48f21..39db57d 100644 --- a/Web/View/HubRoutingRules/Show.hs +++ b/Web/View/HubRoutingRules/Show.hs @@ -4,6 +4,7 @@ import Web.Types import Generated.Types import IHP.Prelude import IHP.ViewPrelude +import Web.Routes () import Web.View.HubRoutingRules.Index (statusBadge) data ShowView = ShowView @@ -48,25 +49,28 @@ instance View ShowView where
Created
{show rule.createdAt}
- {whenJust rule.notes \n -> [hsx| -
-
Notes
-
{n}
-
- |]} + {maybe mempty renderRuleNotesDt rule.notes}
- Edit - {if rule.status == "inactive" - then [hsx|Activate|] - else [hsx|Deactivate|]} - Routed Candidates →
|] + +renderRuleNotesDt :: Text -> Html +renderRuleNotesDt n = [hsx| +
+
Notes
+
{n}
+
+|] + +renderRuleToggleAction :: Id HubRoutingRule -> Bool -> Html +renderRuleToggleAction rid True = [hsx|Activate|] +renderRuleToggleAction rid False = [hsx|Deactivate|] diff --git a/Web/View/Hubs/AdapterCompatibilityDashboard.hs b/Web/View/Hubs/AdapterCompatibilityDashboard.hs index f30bce6..f4e52f4 100644 --- a/Web/View/Hubs/AdapterCompatibilityDashboard.hs +++ b/Web/View/Hubs/AdapterCompatibilityDashboard.hs @@ -4,6 +4,7 @@ import Web.Types import Generated.Types import IHP.Prelude import IHP.ViewPrelude +import Web.Routes () import Application.Helper.View (adapterStatusBadge) import Data.List (nub, sortBy) import Data.Ord (comparing, Down(..)) @@ -23,7 +24,7 @@ instance View AdapterCompatibilityDashboardView where

Adapter Compatibility Dashboard

{hub.name}

- ← Hub
@@ -71,17 +72,11 @@ instance View AdapterCompatibilityDashboardView where
Envelope: - {forEach envelopes (\e -> [hsx| - v{e.contractVersion} - |])} + {forEach envelopes renderEnvelopeLink}
Reporting: - {forEach reportings (\r -> [hsx| - v{r.contractVersion} - |])} + {forEach reportings renderReportingLink}
@@ -92,19 +87,7 @@ instance View AdapterCompatibilityDashboardView where Unassigned Widgets (no adapter_spec_id) - {if null unassignedWidgets - then [hsx|

All widgets have adapter assignments.

|] - else [hsx| -
- {forEach unassignedWidgets (\w -> [hsx| -
- {w.name} - {w.widgetType} -
- |])} -
- |]} + {renderUnassignedWidgets unassignedWidgets} @@ -112,23 +95,7 @@ instance View AdapterCompatibilityDashboardView where

Active Adapter Specs

- {if null activeSpecs - then [hsx|

No active adapter specs.

|] - else [hsx| - - - - - - - - - - - {forEach activeSpecs renderSpecRow} - -
AdapterFrameworkWidgetsStatus
- |]} + {renderActiveSpecsTable activeSpecs} |] where @@ -149,13 +116,31 @@ instance View AdapterCompatibilityDashboardView where in sortBy (comparing (Down . snd)) [ (sid, length (filter (== sid) assigned)) | sid <- specIds ] + renderActiveSpecsTable :: [WidgetAdapterSpec] -> Html + renderActiveSpecsTable [] = [hsx|

No active adapter specs.

|] + renderActiveSpecsTable ss = [hsx| + + + + + + + + + + + {forEach ss renderSpecRow} + +
AdapterFrameworkWidgetsStatus
+ |] + renderSpecRow :: WidgetAdapterSpec -> Html renderSpecRow s = let widgetCount = length (filter (\w -> w.adapterSpecId == Just s.id) widgets) in [hsx| - {s.name} @@ -170,6 +155,35 @@ instance View AdapterCompatibilityDashboardView where |] +renderEnvelopeLink :: EnvelopeEmissionContract -> Html +renderEnvelopeLink e = [hsx| + v{e.contractVersion} +|] + +renderReportingLink :: InteractionReportingContract -> Html +renderReportingLink r = [hsx| + v{r.contractVersion} +|] + +renderUnassignedWidgets :: [Widget] -> Html +renderUnassignedWidgets [] = [hsx|

All widgets have adapter assignments.

|] +renderUnassignedWidgets ws = [hsx| +
+ {forEach ws renderUnassignedWidgetRow} +
+|] + +renderUnassignedWidgetRow :: Widget -> Html +renderUnassignedWidgetRow w = [hsx| +
+ {w.name} + {w.widgetType} +
+|] + kpiCard :: Text -> Text -> Text -> Html kpiCard label value textClass = [hsx|
diff --git a/Web/View/Hubs/AgentAuditDashboard.hs b/Web/View/Hubs/AgentAuditDashboard.hs index e673816..e5ed034 100644 --- a/Web/View/Hubs/AgentAuditDashboard.hs +++ b/Web/View/Hubs/AgentAuditDashboard.hs @@ -4,6 +4,7 @@ import Web.Types import Generated.Types import IHP.Prelude import IHP.ViewPrelude +import Web.Routes () data AgentAuditDashboardView = AgentAuditDashboardView { hub :: !Hub @@ -19,7 +20,7 @@ instance View AgentAuditDashboardView where

Agent Audit Dashboard

{hub.name}

- ← Hub @@ -35,14 +36,7 @@ instance View AgentAuditDashboardView where

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} -
- |])} + {forEach allTypes (renderTypeCount proposals)}
@@ -51,15 +45,7 @@ instance View AgentAuditDashboardView where

Unreviewed Queue ({show pendingCount})

- {if null pending - then [hsx|

No pending proposals.

|] - else [hsx| - - - {forEach (sortByCreatedAt pending) renderQueueRow} - -
- |]} + {renderPendingQueue pending} @@ -90,20 +76,11 @@ instance View AgentAuditDashboardView where Model - {forEach allTypes (\t -> [hsx| - {t} - |])} + {forEach allTypes renderTypeHeader} - {forEach allModels (\m -> [hsx| - - {m} - {forEach allTypes (\t -> - let cnt = length (filter (\p -> p.modelRef == m && p.proposalType == t) proposals) - in [hsx|{if cnt == 0 then "—" else show cnt}|])} - - |])} + {forEach allModels (renderModelRow allTypes proposals)} @@ -121,6 +98,23 @@ instance View AgentAuditDashboardView where allTypes = ["summary", "requirement_draft", "duplicate_flag", "policy_flag", "impl_proposal"] allModels = nub (map (.modelRef) proposals) +renderTypeHeader :: Text -> Html +renderTypeHeader t = [hsx|{t}|] + +renderModelRow :: [Text] -> [AgentProposal] -> Text -> Html +renderModelRow types props m = [hsx| + + {m} + {forEach types (renderMatrixCell props m)} + +|] + +renderMatrixCell :: [AgentProposal] -> Text -> Text -> Html +renderMatrixCell props m t = + let cnt = length (filter (\p -> p.modelRef == m && p.proposalType == t) props) + display = if cnt == 0 then "—" else show cnt + in [hsx|{display}|] + kpiCard :: Text -> Text -> Text -> Html kpiCard label value colorClass = [hsx|
@@ -139,7 +133,7 @@ renderQueueRow p = [hsx| {show p.createdAt} - Review → @@ -149,7 +143,7 @@ renderRecentRow :: [Widget] -> AgentProposal -> Html renderRecentRow widgets p = [hsx| - " text-xs px-2 py-0.5 rounded font-medium"}> {p.proposalType} @@ -165,6 +159,26 @@ renderRecentRow widgets p = [hsx| |] +renderTypeCount :: [AgentProposal] -> Text -> Html +renderTypeCount proposals 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} +
+|] + +renderPendingQueue :: [AgentProposal] -> Html +renderPendingQueue [] = [hsx|

No pending proposals.

|] +renderPendingQueue pending = [hsx| + + + {forEach (sortByCreatedAt pending) renderQueueRow} + +
+|] + widgetName :: [Widget] -> Maybe (Id Widget) -> Text widgetName _ Nothing = "—" widgetName widgets (Just wid) = maybe "—" (.name) (find (\w -> w.id == wid) widgets) diff --git a/Web/View/Hubs/AntifragilityDashboard.hs b/Web/View/Hubs/AntifragilityDashboard.hs index ce5ac9f..d35aac2 100644 --- a/Web/View/Hubs/AntifragilityDashboard.hs +++ b/Web/View/Hubs/AntifragilityDashboard.hs @@ -4,6 +4,7 @@ import Web.Types import Generated.Types import IHP.Prelude import IHP.ViewPrelude +import Web.Routes () data AntifragilityDashboardView = AntifragilityDashboardView { hub :: !Hub @@ -24,22 +25,22 @@ instance View AntifragilityDashboardView where
Hubs / - {hub.name} + {hub.name} / Antifragility

Antifragility Dashboard — {hub.name}

- Triage - Governance - Hub @@ -67,14 +68,7 @@ instance View AntifragilityDashboardView where
- {if null regressionWidgetIds then mempty else [hsx| -
-

⚠ Regression Alerts

-
- {forEach regressedWidgets renderRegressedBadge} -
-
- |]} + {if null regressionWidgetIds then mempty else renderRegressionAlerts regressedWidgets}
@@ -84,56 +78,19 @@ instance View AntifragilityDashboardView where (decisions with impl refs but no deployment recorded) - {if null openGaps - then [hsx|

All decisions with impl refs have deployments.

|] - else [hsx| -
- {forEach openGaps renderGapRow} -
- |]} + {renderOpenGaps openGaps}

Recent Deployments

- {if null recentDeploys - then [hsx|

No deployments yet.

|] - else [hsx| - - - - - - - - - - - - {forEach recentDeploys (renderDeployRow allDecisions allSignals allEvaluations)} - -
VersionDecisionSignalsEvalDeployed
- |]} + {renderRecentDeploysSection recentDeploys allDecisions allSignals allEvaluations}

Recurrence Leaderboard

- {if null recurrenceLeaderboard - then [hsx|

No recurring widgets detected.

|] - else [hsx| - - - - - - - - - {forEach recurrenceLeaderboard (renderRecurrenceRow widgets)} - -
WidgetCycles
- |]} + {renderRecurrenceSection recurrenceLeaderboard widgets}
|] where @@ -160,7 +117,7 @@ sortByDesc f = sortBy (\a b -> compare (f b) (f a)) renderRegressedBadge :: Widget -> Html renderRegressedBadge w = [hsx| - {w.name} @@ -169,7 +126,7 @@ renderRegressedBadge w = [hsx| renderGapRow :: DecisionRecord -> Html renderGapRow d = [hsx|
- {d.title} " text-xs px-2 py-0.5 rounded font-medium"}> {d.outcome} @@ -181,7 +138,7 @@ renderDeployRow :: [DecisionRecord] -> [OutcomeSignal] -> [ChangeEvaluation] -> renderDeployRow decisions signals evals dr = [hsx| - {dr.versionRef} {decisionTitle} @@ -189,7 +146,7 @@ renderDeployRow decisions signals evals dr = [hsx| {renderSignalSummary drSignals} - {maybe [hsx|—|] renderEvalBadge mScore} + {maybe noEvalBadge renderEvalBadge mScore} {show dr.deployedAt} @@ -203,9 +160,7 @@ renderSignalSummary :: [OutcomeSignal] -> Html renderSignalSummary [] = [hsx|—|] renderSignalSummary signals = [hsx|
- {forEach (take 3 signals) (\s -> [hsx| - - |])} + {forEach (take 3 signals) renderSignalDot}
|] @@ -227,7 +182,7 @@ renderRecurrenceRow :: [Widget] -> (Id Widget, Int) -> Html renderRecurrenceRow widgets (wid, count) = [hsx| - {maybe [hsx|—|] renderWidgetLink mWidget} + {maybe noWidgetSpan renderWidgetLink mWidget} ⟳ {show count} @@ -239,10 +194,72 @@ renderRecurrenceRow widgets (wid, count) = [hsx| renderWidgetLink :: Widget -> Html renderWidgetLink w = [hsx| - {w.name} |] +renderRegressionAlerts :: [Widget] -> Html +renderRegressionAlerts ws = [hsx| +
+

⚠ Regression Alerts

+
+ {forEach ws renderRegressedBadge} +
+
+|] + +renderOpenGaps :: [DecisionRecord] -> Html +renderOpenGaps [] = [hsx|

All decisions with impl refs have deployments.

|] +renderOpenGaps gaps = [hsx| +
+ {forEach gaps renderGapRow} +
+|] + +renderRecentDeploysSection :: [DeploymentRecord] -> [DecisionRecord] -> [OutcomeSignal] -> [ChangeEvaluation] -> Html +renderRecentDeploysSection [] _ _ _ = [hsx|

No deployments yet.

|] +renderRecentDeploysSection deploys decisions signals evals = [hsx| + + + + + + + + + + + + {forEach deploys (renderDeployRow decisions signals evals)} + +
VersionDecisionSignalsEvalDeployed
+|] + +renderRecurrenceSection :: [(Id Widget, Int)] -> [Widget] -> Html +renderRecurrenceSection [] _ = [hsx|

No recurring widgets detected.

|] +renderRecurrenceSection leaderboard widgets = [hsx| + + + + + + + + + {forEach leaderboard (renderRecurrenceRow widgets)} + +
WidgetCycles
+|] + +noEvalBadge :: Html +noEvalBadge = [hsx|—|] + +noWidgetSpan :: Html +noWidgetSpan = [hsx|—|] + +renderSignalDot :: OutcomeSignal -> Html +renderSignalDot s = [hsx||] + outcomeClass :: Text -> Text outcomeClass "accepted" = "bg-green-100 text-green-800" outcomeClass "rejected" = "bg-red-100 text-red-800" diff --git a/Web/View/Hubs/BottleneckDashboard.hs b/Web/View/Hubs/BottleneckDashboard.hs index 204ce6c..9254047 100644 --- a/Web/View/Hubs/BottleneckDashboard.hs +++ b/Web/View/Hubs/BottleneckDashboard.hs @@ -4,6 +4,7 @@ import Web.Types import Generated.Types import IHP.Prelude import IHP.ViewPrelude +import Web.Routes () import Data.Time.Clock (diffUTCTime, getCurrentTime) data BottleneckDashboardView = BottleneckDashboardView @@ -20,11 +21,11 @@ instance View BottleneckDashboardView where

{hub.name}

- Detect - ← Hub @@ -33,9 +34,7 @@ instance View BottleneckDashboardView where {forEach stages renderStageSection} - {if null bottlenecks - then [hsx|

No active bottlenecks detected.

|] - else mempty} + {if null bottlenecks then noBottlenecksMsg else mempty} |] where stages = ["candidate", "requirement", "decision", "observation"] :: [Text] @@ -83,12 +82,15 @@ instance View BottleneckDashboardView where - Resolve |] +noBottlenecksMsg :: Html +noBottlenecksMsg = [hsx|

No active bottlenecks detected.

|] + severityBadge :: Text -> Text severityBadge s = case s of "critical" -> "bg-red-100 text-red-800" diff --git a/Web/View/Hubs/Edit.hs b/Web/View/Hubs/Edit.hs index e78cdf0..4c42e8b 100644 --- a/Web/View/Hubs/Edit.hs +++ b/Web/View/Hubs/Edit.hs @@ -4,6 +4,7 @@ import Web.Types import Generated.Types import IHP.Prelude import IHP.ViewPrelude +import Web.Routes () data EditView = EditView { hub :: !Hub } @@ -13,7 +14,7 @@ instance View EditView where
Hubs / - {hub.name} + {hub.name} / Edit
diff --git a/Web/View/Hubs/FrictionHeatmap.hs b/Web/View/Hubs/FrictionHeatmap.hs index f320f1e..720fca3 100644 --- a/Web/View/Hubs/FrictionHeatmap.hs +++ b/Web/View/Hubs/FrictionHeatmap.hs @@ -4,6 +4,7 @@ import Web.Types import Generated.Types import IHP.Prelude import IHP.ViewPrelude +import Web.Routes () import Application.Helper.FrictionScore (scoreBand) data FrictionHeatmapView = FrictionHeatmapView @@ -20,11 +21,11 @@ instance View FrictionHeatmapView where

{hub.name}

- Recompute - ← Hub @@ -38,18 +39,20 @@ instance View FrictionHeatmapView where Critical (60+)
- {if null widgets - then [hsx|

No widgets in this hub.

|] - else [hsx| -
- {forEach widgets renderWidgetCard} -
- |]} + {renderHeatmapGrid widgets} |] where scoreFor w = maybe 0 (.score) (find (\fs -> fs.widgetId == w.id) frictionScores) hasScore w = any (\fs -> fs.widgetId == w.id) frictionScores + renderHeatmapGrid :: [Widget] -> Html + renderHeatmapGrid [] = [hsx|

No widgets in this hub.

|] + renderHeatmapGrid ws = [hsx| +
+ {forEach ws renderWidgetCard} +
+ |] + renderWidgetCard :: Widget -> Html renderWidgetCard w = let s = scoreFor w @@ -57,12 +60,14 @@ instance View FrictionHeatmapView where in [hsx|
band}>
- {w.name} - {if hasScore w - then [hsx|{show s}|] - else [hsx|–|]} + {renderScoreBadge (hasScore w) s}

{w.widgetType}

|] + +renderScoreBadge :: Bool -> Int -> Html +renderScoreBadge True s = [hsx|{show s}|] +renderScoreBadge False _ = [hsx|–|] diff --git a/Web/View/Hubs/GovernanceDashboard.hs b/Web/View/Hubs/GovernanceDashboard.hs index 8d20345..b2c6293 100644 --- a/Web/View/Hubs/GovernanceDashboard.hs +++ b/Web/View/Hubs/GovernanceDashboard.hs @@ -4,6 +4,7 @@ import Web.Types import Generated.Types import IHP.Prelude import IHP.ViewPrelude +import Web.Routes () data GovernanceDashboardView = GovernanceDashboardView { hub :: !Hub @@ -23,22 +24,22 @@ instance View GovernanceDashboardView where
Hubs / - {hub.name} + {hub.name} / Governance

Governance Dashboard — {hub.name}

- Triage Dashboard - Antifragility - Hub Overview @@ -54,14 +55,7 @@ instance View GovernanceDashboardView where
- {if null regressionWidgetIds then mempty else [hsx| -
-

⚠ Regressed Widgets

-
- {forEach regressedWidgets renderRegressedBadge} -
-
- |]} + {if null regressionWidgetIds then mempty else renderGovRegressionAlerts regressedWidgets}
@@ -71,31 +65,13 @@ instance View GovernanceDashboardView where ({show (length awaitingDecision)} pending) - {if null awaitingDecision - then [hsx|

All requirements have linked decisions.

|] - else forEach awaitingDecision renderAwaitingReq} + {renderAwaitingSection awaitingDecision}

Recent Decisions

- {if null recentDecisions - then [hsx|

No decisions recorded yet.

|] - else [hsx| - - - - - - - - - - - {forEach recentDecisions (renderDecisionRow allRequirements allCandidates widgets)} - -
TitleOutcomeSource WidgetDecided At
- |]} + {renderRecentDecisionsSection recentDecisions allRequirements allCandidates widgets}
@@ -150,7 +126,7 @@ isAwaitingDecision decisions req = renderAwaitingReq :: Requirement -> Html renderAwaitingReq req = [hsx|
- {req.title} {show req.createdAt}
@@ -160,7 +136,7 @@ renderDecisionRow :: [Requirement] -> [RequirementCandidate] -> [Widget] -> Deci renderDecisionRow reqs candidates widgets dr = [hsx| - {dr.title} @@ -213,7 +189,7 @@ renderCoverageRow annotations candidates requirements decisions w = [hsx| renderRegressedBadge :: Widget -> Html renderRegressedBadge w = [hsx| - {w.name} @@ -223,6 +199,38 @@ coverageMark :: Bool -> Html coverageMark True = [hsx|✓|] coverageMark False = [hsx|✗|] +renderGovRegressionAlerts :: [Widget] -> Html +renderGovRegressionAlerts ws = [hsx| +
+

Regression Alerts

+
+ {forEach ws renderRegressedBadge} +
+
+|] + +renderAwaitingSection :: [Requirement] -> Html +renderAwaitingSection [] = [hsx|

All requirements have linked decisions.

|] +renderAwaitingSection reqs = [hsx|{forEach reqs renderAwaitingReq}|] + +renderRecentDecisionsSection :: [DecisionRecord] -> [Requirement] -> [RequirementCandidate] -> [Widget] -> Html +renderRecentDecisionsSection [] _ _ _ = [hsx|

No decisions recorded yet.

|] +renderRecentDecisionsSection decisions reqs candidates ws = [hsx| + + + + + + + + + + + {forEach decisions (renderDecisionRow reqs candidates ws)} + +
TitleOutcomeSource WidgetDecided At
+|] + outcomeClass :: Text -> Text outcomeClass "accepted" = "bg-green-100 text-green-800" outcomeClass "rejected" = "bg-red-100 text-red-800" diff --git a/Web/View/Hubs/HubHealthHistory.hs b/Web/View/Hubs/HubHealthHistory.hs index 6281a14..f395460 100644 --- a/Web/View/Hubs/HubHealthHistory.hs +++ b/Web/View/Hubs/HubHealthHistory.hs @@ -4,6 +4,7 @@ import Web.Types import Generated.Types import IHP.Prelude import IHP.ViewPrelude +import Web.Routes () import Application.Helper.HubHealth (healthScoreBadge) data HubHealthHistoryView = HubHealthHistoryView @@ -19,57 +20,63 @@ instance View HubHealthHistoryView where

{hub.name}

- Take Snapshot - ← Hub
- {case snapshots of - [] -> [hsx|

No snapshots yet. Take the first one.

|] - (latest : _) -> [hsx| -
-
-

Current Health Score

- healthScoreBadge latest.healthScore}> - {show latest.healthScore} - -
-
-
Open candidates: {show latest.openCandidates}
-
Regressed widgets: {show latest.regressedWidgets}
-
Stale decisions: {show latest.staleDecisions}
-
Active bottlenecks: {show latest.activeBottlenecks}
-
-
- |]} + {renderLatestPanel snapshots} - {if null snapshots then mempty else [hsx| -
- - - - - - - - - - - - - {forEach snapshots renderRow} - -
ScoreOpen Cand.RegressedStale Dec.BottlenecksTaken At
-
- |]} + {renderSnapshotsTable snapshots} |] +renderLatestPanel :: [HubHealthSnapshot] -> Html +renderLatestPanel [] = [hsx|

No snapshots yet. Take the first one.

|] +renderLatestPanel (latest : _) = [hsx| +
+
+

Current Health Score

+ healthScoreBadge latest.healthScore}> + {show latest.healthScore} + +
+
+
Open candidates: {show latest.openCandidates}
+
Regressed widgets: {show latest.regressedWidgets}
+
Stale decisions: {show latest.staleDecisions}
+
Active bottlenecks: {show latest.activeBottlenecks}
+
+
+|] + +renderSnapshotsTable :: [HubHealthSnapshot] -> Html +renderSnapshotsTable [] = mempty +renderSnapshotsTable snaps = [hsx| +
+ + + + + + + + + + + + + {forEach snaps renderRow} + +
ScoreOpen Cand.RegressedStale Dec.BottlenecksTaken At
+
+|] + renderRow :: HubHealthSnapshot -> Html renderRow s = [hsx| diff --git a/Web/View/Hubs/Index.hs b/Web/View/Hubs/Index.hs index 6118d0a..c03d815 100644 --- a/Web/View/Hubs/Index.hs +++ b/Web/View/Hubs/Index.hs @@ -4,6 +4,7 @@ import Web.Types import Generated.Types import IHP.Prelude import IHP.ViewPrelude +import Web.Routes () data IndexView = IndexView { hubs :: ![Hub] } @@ -44,7 +45,7 @@ renderHub :: Hub -> Html renderHub hub = [hsx| - {hub.name} @@ -53,9 +54,9 @@ renderHub hub = [hsx| {hub.domain} {kindBadge hub.hubKind} - Edit - Delete diff --git a/Web/View/Hubs/New.hs b/Web/View/Hubs/New.hs index 0799d6b..81590a9 100644 --- a/Web/View/Hubs/New.hs +++ b/Web/View/Hubs/New.hs @@ -4,6 +4,7 @@ import Web.Types import Generated.Types import IHP.Prelude import IHP.ViewPrelude +import Web.Routes () data NewView = NewView { hub :: !Hub } diff --git a/Web/View/Hubs/OperationalReviewBoard.hs b/Web/View/Hubs/OperationalReviewBoard.hs index 30f0947..13d1dce 100644 --- a/Web/View/Hubs/OperationalReviewBoard.hs +++ b/Web/View/Hubs/OperationalReviewBoard.hs @@ -4,6 +4,7 @@ import Web.Types import Generated.Types import IHP.Prelude import IHP.ViewPrelude +import Web.Routes () import Application.Helper.HubHealth (healthScoreBadge) import Application.Helper.FrictionScore (scoreBand) import Web.View.Hubs.BottleneckDashboard (severityBadge) @@ -26,68 +27,25 @@ instance View OperationalReviewBoardView where

Hub Health Matrix

- {if null hubs - then [hsx|

No hubs registered.

|] - else [hsx| - - - - - - - - - - - {forEach hubs renderHubRow} - -
HubHealthSnapshot
- |]} + {renderHubHealthTable hubs}

Top Friction Widgets

- {if null topFrictionScores - then [hsx|

No friction scores computed yet.

|] - else [hsx| - - - - - - - - - - {forEach (zip topFrictionScores topWidgets) renderFrictionRow} - -
WidgetScoreType
- |]} + {renderFrictionTable topFrictionScores topWidgets}

Active Bottlenecks by Stage

- {if null bottlenecks - then [hsx|

No active bottlenecks.

|] - else [hsx| -
- {forEach stages renderBottleneckStage} -
- |]} + {renderBottlenecksPanel bottlenecks}

Open Cross-Hub Propagations

- {if null openPropagations - then [hsx|

No open propagation events.

|] - else [hsx| -
- {forEach openPropagations renderPropagationRow} -
- |]} + {renderPropagationsPanel openPropagations}
|] where @@ -108,23 +66,17 @@ instance View OperationalReviewBoardView where in [hsx| - {h.name} - {case mSnap of - Nothing -> [hsx|–|] - Just s -> [hsx| - healthScoreBadge s.healthScore}> - {show s.healthScore} - - |]} + {renderHealthScore mSnap} {maybe "never" (\s -> show s.computedAt) mSnap} - History @@ -134,7 +86,7 @@ instance View OperationalReviewBoardView where renderFrictionRow (fs, w) = [hsx| - {w.name} @@ -170,10 +122,69 @@ instance View OperationalReviewBoardView where

{show p.detectedAt}

- Acknowledge - Resolve
|] + + renderHubHealthTable :: [Hub] -> Html + renderHubHealthTable [] = [hsx|

No hubs registered.

|] + renderHubHealthTable hs = [hsx| + + + + + + + + + + + {forEach hs renderHubRow} + +
HubHealthSnapshot
+ |] + + renderFrictionTable :: [FrictionScore] -> [Widget] -> Html + renderFrictionTable [] _ = [hsx|

No friction scores computed yet.

|] + renderFrictionTable scores ws = [hsx| + + + + + + + + + + {forEach (zip scores ws) renderFrictionRow} + +
WidgetScoreType
+ |] + + renderBottlenecksPanel :: [BottleneckRecord] -> Html + renderBottlenecksPanel [] = [hsx|

No active bottlenecks.

|] + renderBottlenecksPanel _ = [hsx| +
+ {forEach stages renderBottleneckStage} +
+ |] + + renderPropagationsPanel :: [CrossHubPropagation] -> Html + renderPropagationsPanel [] = [hsx|

No open propagation events.

|] + renderPropagationsPanel ps = [hsx| +
+ {forEach ps renderPropagationRow} +
+ |] + +renderHealthScore :: Maybe HubHealthSnapshot -> Html +renderHealthScore Nothing = [hsx|–|] +renderHealthScore (Just s) = [hsx| + healthScoreBadge s.healthScore}> + {show s.healthScore} + +|] diff --git a/Web/View/Hubs/Show.hs b/Web/View/Hubs/Show.hs index ffd6acc..de7fd0c 100644 --- a/Web/View/Hubs/Show.hs +++ b/Web/View/Hubs/Show.hs @@ -4,6 +4,7 @@ import Web.Types import Generated.Types import IHP.Prelude import IHP.ViewPrelude +import Web.Routes () data ShowView = ShowView { hub :: !Hub @@ -33,39 +34,39 @@ instance View ShowView where

- Triage Dashboard - Governance Dashboard - Antifragility - Agent Audit - Adapters - Friction - Bottlenecks - Health - Edit @@ -146,7 +147,7 @@ renderWidgetRow :: Widget -> Html renderWidgetRow w = [hsx| - {w.name} @@ -202,12 +203,12 @@ renderManifestSection (Just m) _ = [hsx|
{manifestStatusBadge m.status} v{m.manifestVersion} - {forEach (maybeText m.capabilityDescription) (\d -> [hsx|— {d}|])} + {maybe mempty renderCapabilityDesc m.capabilityDescription}
- View manifest →
- {forEach (maybeText m.contact) (\c -> [hsx|

Contact: {c}

|])} + {maybe mempty renderManifestContactLine m.contact} |] @@ -225,3 +226,9 @@ kindBadge _ = [hsx|— {d}|] + +renderManifestContactLine :: Text -> Html +renderManifestContactLine c = [hsx|

Contact: {c}

|] diff --git a/Web/View/Hubs/TriageDashboard.hs b/Web/View/Hubs/TriageDashboard.hs index b5b5310..02ccc99 100644 --- a/Web/View/Hubs/TriageDashboard.hs +++ b/Web/View/Hubs/TriageDashboard.hs @@ -4,6 +4,7 @@ import Web.Types import Generated.Types import IHP.Prelude import IHP.ViewPrelude +import Web.Routes () data TriageDashboardView = TriageDashboardView { hub :: !Hub @@ -20,7 +21,7 @@ instance View TriageDashboardView where
Hubs / - {hub.name} + {hub.name} / Triage Dashboard
@@ -46,25 +47,13 @@ instance View TriageDashboardView where

Triage Queue (Open)

- {if null triageQueue - then [hsx|

Queue empty.

|] - else [hsx| -
- {forEach triageQueue (renderQueueItem widgets)} -
- |]} + {renderTriageQueue triageQueue widgets}

Recent Escalations

- {if null recentEscalations - then [hsx|

No escalations yet.

|] - else [hsx| -
- {forEach recentEscalations (renderEscalationItem widgets)} -
- |]} + {renderEscalationsSection recentEscalations widgets}
@@ -85,6 +74,22 @@ renderKpi label status candidates colorClass = |] +renderTriageQueue :: [RequirementCandidate] -> [Widget] -> Html +renderTriageQueue [] _ = [hsx|

Queue empty.

|] +renderTriageQueue items ws = [hsx| +
+ {forEach items (renderQueueItem ws)} +
+|] + +renderEscalationsSection :: [RequirementCandidate] -> [Widget] -> Html +renderEscalationsSection [] _ = [hsx|

No escalations yet.

|] +renderEscalationsSection items ws = [hsx| +
+ {forEach items (renderEscalationItem ws)} +
+|] + renderQueueItem :: [Widget] -> RequirementCandidate -> Html renderQueueItem widgets c = let mWidget = find (\w -> w.id == c.sourceWidgetId) widgets @@ -92,7 +97,7 @@ renderQueueItem widgets c = in [hsx|
- {c.title} @@ -115,7 +120,7 @@ renderEscalationItem widgets c = " text-xs px-2 py-0.5 rounded"}>{c.status} {maybe "—" (.name) mWidget}
- {c.title}
|] diff --git a/Web/View/InstitutionalKnowledge/Index.hs b/Web/View/InstitutionalKnowledge/Index.hs index 56841c7..4561843 100644 --- a/Web/View/InstitutionalKnowledge/Index.hs +++ b/Web/View/InstitutionalKnowledge/Index.hs @@ -1,6 +1,6 @@ module Web.View.InstitutionalKnowledge.Index where -import Web.View.Prelude +import IHP.ViewPrelude data IndexView = IndexView { entries :: ![InstitutionalKnowledgeEntry] @@ -27,7 +27,7 @@ instance View IndexView where - - |]} + {forEach hubs renderRecomputeButton}
@@ -53,7 +45,7 @@ instance View IndexView where @@ -62,3 +54,14 @@ instance View IndexView where |] + +renderRecomputeButton :: Hub -> Html +renderRecomputeButton h = [hsx| + + {csrfTokenTag} + + +|] diff --git a/Web/View/Prelude.hs b/Web/View/Prelude.hs new file mode 100644 index 0000000..2640e7e --- /dev/null +++ b/Web/View/Prelude.hs @@ -0,0 +1,12 @@ +module Web.View.Prelude + ( module Web.Types + , module Generated.Types + , module IHP.Prelude + , module IHP.ViewPrelude + ) where + +import Web.Types +import Generated.Types +import IHP.Prelude +import IHP.ViewPrelude +import Web.Routes () diff --git a/Web/View/RequirementCandidates/Edit.hs b/Web/View/RequirementCandidates/Edit.hs index 9515653..1232eb7 100644 --- a/Web/View/RequirementCandidates/Edit.hs +++ b/Web/View/RequirementCandidates/Edit.hs @@ -4,6 +4,7 @@ import Web.Types import Generated.Types import IHP.Prelude import IHP.ViewPrelude +import Web.Routes () data EditView = EditView { candidate :: !RequirementCandidate @@ -16,7 +17,7 @@ instance View EditView where
Candidates / - {candidate.title} / Edit diff --git a/Web/View/RequirementCandidates/Index.hs b/Web/View/RequirementCandidates/Index.hs index a0d37cc..d65e76c 100644 --- a/Web/View/RequirementCandidates/Index.hs +++ b/Web/View/RequirementCandidates/Index.hs @@ -4,6 +4,7 @@ import Web.Types import Generated.Types import IHP.Prelude import IHP.ViewPrelude +import Web.Routes () data IndexView = IndexView { candidates :: ![RequirementCandidate] @@ -33,27 +34,7 @@ instance View IndexView where {renderFilterPills mStatusFilter}
- {if null candidates - then [hsx|

No candidates found.

|] - else [hsx| -
-
{rankLabel} - {show r.widgetPatternId} {show r.adoptionCount}{maybe "-" show r.meanOutcomeValue}
- - - - - - - - - - - - {forEach candidates (renderRow assignments users widgets)} - -
TitleWidgetCategoryStatusReviewerCreated
-
- |]} + {renderCandidatesTable candidates assignments users widgets} |] renderFilterPills :: Maybe Text -> Html @@ -78,6 +59,28 @@ renderPill target current label = Just s -> pathTo RequirementCandidatesAction <> "?status=" <> s in [hsx|{label}|] +renderCandidatesTable :: [RequirementCandidate] -> [ReviewerAssignment] -> [User] -> [Widget] -> Html +renderCandidatesTable [] _ _ _ = [hsx|

No candidates found.

|] +renderCandidatesTable candidates assignments users ws = [hsx| +
+ + + + + + + + + + + + + {forEach candidates (renderRow assignments users ws)} + +
TitleWidgetCategoryStatusReviewerCreated
+
+|] + renderRow :: [ReviewerAssignment] -> [User] -> [Widget] -> RequirementCandidate -> Html renderRow assignments users widgets c = let mAssignment = find (\ra -> ra.candidateId == c.id) assignments @@ -86,7 +89,7 @@ renderRow assignments users widgets c = in [hsx| - {c.title} diff --git a/Web/View/RequirementCandidates/New.hs b/Web/View/RequirementCandidates/New.hs index 5ac7d6a..f434a21 100644 --- a/Web/View/RequirementCandidates/New.hs +++ b/Web/View/RequirementCandidates/New.hs @@ -4,6 +4,7 @@ import Web.Types import Generated.Types import IHP.Prelude import IHP.ViewPrelude +import Web.Routes () data NewView = NewView { candidate :: !RequirementCandidate diff --git a/Web/View/RequirementCandidates/Show.hs b/Web/View/RequirementCandidates/Show.hs index 3e33097..2d897af 100644 --- a/Web/View/RequirementCandidates/Show.hs +++ b/Web/View/RequirementCandidates/Show.hs @@ -4,6 +4,7 @@ import Web.Types import Generated.Types import IHP.Prelude import IHP.ViewPrelude +import Web.Routes () data ShowView = ShowView { candidate :: !RequirementCandidate @@ -29,17 +30,17 @@ instance View ShowView where

{candidate.title}

-
+
-
+
- Edit @@ -83,13 +84,7 @@ instance View ShowView where

Triage History

- {if null triageStates - then [hsx|

No triage actions recorded yet.

|] - else [hsx| -
    - {forEach triageStates renderTriageRow} -
- |]} + {renderTriageHistory triageStates}
|] @@ -105,7 +100,7 @@ renderSource (Just a) _ = [hsx| renderSource Nothing (Just t) = [hsx|

Source thread:

- {t.title}
|] @@ -125,7 +120,7 @@ allowedNextStatuses _ = [] renderTriageButton :: Id RequirementCandidate -> Text -> Html renderTriageButton candidateId newStatus = [hsx| -
{hiddenField "authenticity_token"} @@ -145,15 +140,13 @@ renderReviewerSection :: RequirementCandidate -> Maybe ReviewerAssignment -> [Us renderReviewerSection candidate mAssignment users = [hsx|
- {case mAssignment of - Nothing -> [hsx|Unassigned|] - Just ra -> [hsx|{reviewerName ra users}|]} + {renderAssignmentStatus mAssignment users}
- {hiddenField "authenticity_token"}
- {if null roles - then [hsx|

No stewardship roles assigned yet.

|] - else [hsx| -
- {forEach hubGroups renderHubGroup} -
- |]} + {renderRolesSection hubGroups} |] where - hubName hid = maybe (show hid) (.name) (find (\h -> h.id == hid) hubs) - hubGroups = groupByHub hubs roles + hubGroups = groupByHub hubs roles - groupByHub :: [Hub] -> [StewardshipRole] -> [(Hub, [StewardshipRole])] - groupByHub hs rs = - [ (h, filter (\r -> r.hubId == h.id) rs) - | h <- hs - , any (\r -> r.hubId == h.id) rs - ] +groupByHub :: [Hub] -> [StewardshipRole] -> [(Hub, [StewardshipRole])] +groupByHub hs rs = + [ (h, filter (\r -> r.hubId == h.id) rs) + | h <- hs + , any (\r -> r.hubId == h.id) rs + ] - renderHubGroup :: (Hub, [StewardshipRole]) -> Html - renderHubGroup (hub, hubRoles) = [hsx| -
-
-

{hub.name}

-
- - - - - - - - - - - - {forEach hubRoles renderRoleRow} - -
RoleAssigned ToGrantedStatus
-
- |] +renderHubGroup :: (Hub, [StewardshipRole]) -> Html +renderHubGroup (hub, hubRoles) = [hsx| +
+
+

{hub.name}

+
+ + + + + + + + + + + + {forEach hubRoles renderRoleRow} + +
RoleAssigned ToGrantedStatus
+
+|] - renderRoleRow :: StewardshipRole -> Html - renderRoleRow r = [hsx| - - {r.roleName} - {r.assignedTo} - {show r.grantedAt} - - {if isNothing r.revokedAt - then [hsx|active|] - else [hsx|revoked|]} - - - View - - - |] +renderRoleRow :: StewardshipRole -> Html +renderRoleRow r = [hsx| + + {r.roleName} + {r.assignedTo} + {show r.grantedAt} + + {renderRoleStatus (isNothing r.revokedAt)} + + + View + + +|] + +renderRolesSection :: [(Hub, [StewardshipRole])] -> Html +renderRolesSection [] = [hsx|

No stewardship roles assigned yet.

|] +renderRolesSection groups = [hsx| +
+ {forEach groups renderHubGroup} +
+|] + +renderRoleStatus :: Bool -> Html +renderRoleStatus True = [hsx|active|] +renderRoleStatus False = [hsx|revoked|] diff --git a/Web/View/StewardshipRoles/New.hs b/Web/View/StewardshipRoles/New.hs index d18bf67..015fa39 100644 --- a/Web/View/StewardshipRoles/New.hs +++ b/Web/View/StewardshipRoles/New.hs @@ -4,6 +4,7 @@ import Web.Types import Generated.Types import IHP.Prelude import IHP.ViewPrelude +import Web.Routes () data NewView = NewView { role :: !StewardshipRole @@ -20,9 +21,9 @@ instance View NewView where renderForm :: StewardshipRole -> [Hub] -> Html renderForm role hubs = formFor role [hsx| - {(selectField #hubId hubs){ label = "Hub" }} + {(selectField #hubId hubs){ fieldLabel = "Hub" }} {(textField #roleName){ helpText = "e.g. Hub Lead, Policy Steward, Triage Owner" }} {(textField #assignedTo){ helpText = "Person name or identifier" }} - {(textareaField #notes){ label = "Notes (optional)" }} + {(textareaField #notes){ fieldLabel = "Notes (optional)" }} {submitButton} |] diff --git a/Web/View/StewardshipRoles/Show.hs b/Web/View/StewardshipRoles/Show.hs index 6d825e9..b28b5e2 100644 --- a/Web/View/StewardshipRoles/Show.hs +++ b/Web/View/StewardshipRoles/Show.hs @@ -4,6 +4,7 @@ import Web.Types import Generated.Types import IHP.Prelude import IHP.ViewPrelude +import Web.Routes () data ShowView = ShowView { role :: !StewardshipRole @@ -17,9 +18,7 @@ instance View ShowView where Stewards /

{role.roleName}

- {if isNothing role.revokedAt - then [hsx|active|] - else [hsx|revoked|]} + {renderRoleStatusBadge (isNothing role.revokedAt)}
@@ -40,25 +39,33 @@ instance View ShowView where
Revoked At
{maybe "–" show role.revokedAt}
- {whenJust role.notes \n -> [hsx| -
-
Notes
-
{n}
-
- |]} + {maybe mempty renderRoleNotes role.notes} - {if isNothing role.revokedAt - then [hsx| -
- - Revoke Role - -
- |] - else mempty} + {if isNothing role.revokedAt then renderRevokeLink role.id else mempty} |] + +renderRoleStatusBadge :: Bool -> Html +renderRoleStatusBadge True = [hsx|active|] +renderRoleStatusBadge False = [hsx|revoked|] + +renderRoleNotes :: Text -> Html +renderRoleNotes n = [hsx| +
+
Notes
+
{n}
+
+|] + +renderRevokeLink :: Id StewardshipRole -> Html +renderRevokeLink rid = [hsx| +
+ + Revoke Role + +
+|] diff --git a/Web/View/TypeRegistries/AnnotationCategories.hs b/Web/View/TypeRegistries/AnnotationCategories.hs index cff4e2c..d8d1979 100644 --- a/Web/View/TypeRegistries/AnnotationCategories.hs +++ b/Web/View/TypeRegistries/AnnotationCategories.hs @@ -4,6 +4,7 @@ import Web.Types import Generated.Types import IHP.Prelude import IHP.ViewPrelude +import Web.Routes () data AnnotationCategoriesView = AnnotationCategoriesView { entries :: ![AnnotationCategoryRegistry], hubs :: ![Hub] } data ShowAnnotationCategoryView = ShowAnnotationCategoryView { entry :: !AnnotationCategoryRegistry, mOwner :: !(Maybe Hub) } @@ -59,12 +60,12 @@ renderRow :: [Hub] -> AnnotationCategoryRegistry -> Html renderRow hubs e = [hsx| {e.name} - {e.label} + {e.label_} {hubName hubs e.ownerHubId} {statusBadge e.status} - View - Edit + View + Edit |] @@ -80,13 +81,13 @@ instance View ShowAnnotationCategoryView where {statusBadge entry.status}
-
Label
{entry.label}
+
Label
{entry.label_}
Description
{fromMaybe "—" entry.description}
Owner
{maybe "Framework (cross-domain)" (.name) mOwner}
Replaced by
{fromMaybe "—" entry.deprecatedInFavourOf}
- Edit
@@ -96,20 +97,10 @@ typeForm :: AnnotationCategoryRegistry -> [Hub] -> Bool -> Html typeForm entry hubs isNew = [hsx|
- {if isNew then [hsx| -
- - {(textField #name) { fieldClass = "w-full border border-gray-300 rounded px-3 py-2 text-sm" }} -
- |] else [hsx| -
- -

{entry.name}

-
- |]} + {renderNameField isNew entry.name}
- {(textField #label) { fieldClass = "w-full border border-gray-300 rounded px-3 py-2 text-sm" }} + {(textField #label_) { fieldClass = "w-full border border-gray-300 rounded px-3 py-2 text-sm" }}
@@ -145,7 +136,21 @@ instance View EditAnnotationCategoryView where ← Annotation Categories

Edit Annotation Category

- + {typeForm entry hubs False} |] + +renderNameField :: Bool -> Text -> Html +renderNameField True _ = [hsx| +
+ + {(textField #name) { fieldClass = "w-full border border-gray-300 rounded px-3 py-2 text-sm" }} +
+|] +renderNameField False name = [hsx| +
+ +

{name}

+
+|] diff --git a/Web/View/TypeRegistries/EventTypes.hs b/Web/View/TypeRegistries/EventTypes.hs index 1a1355e..c277a3b 100644 --- a/Web/View/TypeRegistries/EventTypes.hs +++ b/Web/View/TypeRegistries/EventTypes.hs @@ -4,6 +4,7 @@ import Web.Types import Generated.Types import IHP.Prelude import IHP.ViewPrelude +import Web.Routes () data EventTypesView = EventTypesView { entries :: ![EventTypeRegistry], hubs :: ![Hub] } data ShowEventTypeView = ShowEventTypeView { entry :: !EventTypeRegistry, mOwner :: !(Maybe Hub) } @@ -59,12 +60,12 @@ renderRow :: [Hub] -> EventTypeRegistry -> Html renderRow hubs e = [hsx| {e.name} - {e.label} + {e.label_} {hubName hubs e.ownerHubId} {statusBadge e.status} - View - Edit + View + Edit |] @@ -80,13 +81,13 @@ instance View ShowEventTypeView where {statusBadge entry.status}
-
Label
{entry.label}
+
Label
{entry.label_}
Description
{fromMaybe "—" entry.description}
Owner
{maybe "Framework (cross-domain)" (.name) mOwner}
Replaced by
{fromMaybe "—" entry.deprecatedInFavourOf}
- Edit
@@ -96,20 +97,10 @@ typeForm :: EventTypeRegistry -> [Hub] -> Bool -> Html typeForm entry hubs isNew = [hsx|
- {if isNew then [hsx| -
- - {(textField #name) { fieldClass = "w-full border border-gray-300 rounded px-3 py-2 text-sm" }} -
- |] else [hsx| -
- -

{entry.name}

-
- |]} + {renderNameField isNew entry.name}
- {(textField #label) { fieldClass = "w-full border border-gray-300 rounded px-3 py-2 text-sm" }} + {(textField #label_) { fieldClass = "w-full border border-gray-300 rounded px-3 py-2 text-sm" }}
@@ -145,7 +136,21 @@ instance View EditEventTypeView where ← Event Types

Edit Event Type

-
+ {typeForm entry hubs False}
|] + +renderNameField :: Bool -> Text -> Html +renderNameField True _ = [hsx| +
+ + {(textField #name) { fieldClass = "w-full border border-gray-300 rounded px-3 py-2 text-sm" }} +
+|] +renderNameField False name = [hsx| +
+ +

{name}

+
+|] diff --git a/Web/View/TypeRegistries/PolicyScopes.hs b/Web/View/TypeRegistries/PolicyScopes.hs index d7c93ea..6422ed0 100644 --- a/Web/View/TypeRegistries/PolicyScopes.hs +++ b/Web/View/TypeRegistries/PolicyScopes.hs @@ -4,6 +4,7 @@ import Web.Types import Generated.Types import IHP.Prelude import IHP.ViewPrelude +import Web.Routes () data PolicyScopesView = PolicyScopesView { entries :: ![PolicyScopeRegistry], hubs :: ![Hub] } data ShowPolicyScopeView = ShowPolicyScopeView { entry :: !PolicyScopeRegistry, mOwner :: !(Maybe Hub) } @@ -59,12 +60,12 @@ renderRow :: [Hub] -> PolicyScopeRegistry -> Html renderRow hubs e = [hsx| {e.name} - {e.label} + {e.label_} {hubName hubs e.ownerHubId} {statusBadge e.status} - View - Edit + View + Edit |] @@ -80,13 +81,13 @@ instance View ShowPolicyScopeView where {statusBadge entry.status}
-
Label
{entry.label}
+
Label
{entry.label_}
Description
{fromMaybe "—" entry.description}
Owner
{maybe "Framework (cross-domain)" (.name) mOwner}
Replaced by
{fromMaybe "—" entry.deprecatedInFavourOf}
- Edit
@@ -96,20 +97,10 @@ typeForm :: PolicyScopeRegistry -> [Hub] -> Bool -> Html typeForm entry hubs isNew = [hsx|
- {if isNew then [hsx| -
- - {(textField #name) { fieldClass = "w-full border border-gray-300 rounded px-3 py-2 text-sm" }} -
- |] else [hsx| -
- -

{entry.name}

-
- |]} + {renderNameField isNew entry.name}
- {(textField #label) { fieldClass = "w-full border border-gray-300 rounded px-3 py-2 text-sm" }} + {(textField #label_) { fieldClass = "w-full border border-gray-300 rounded px-3 py-2 text-sm" }}
@@ -145,7 +136,21 @@ instance View EditPolicyScopeView where ← Policy Scopes

Edit Policy Scope

-
+ {typeForm entry hubs False}
|] + +renderNameField :: Bool -> Text -> Html +renderNameField True _ = [hsx| +
+ + {(textField #name) { fieldClass = "w-full border border-gray-300 rounded px-3 py-2 text-sm" }} +
+|] +renderNameField False name = [hsx| +
+ +

{name}

+
+|] diff --git a/Web/View/TypeRegistries/WidgetTypes.hs b/Web/View/TypeRegistries/WidgetTypes.hs index b91c2e6..3b5adad 100644 --- a/Web/View/TypeRegistries/WidgetTypes.hs +++ b/Web/View/TypeRegistries/WidgetTypes.hs @@ -4,6 +4,7 @@ import Web.Types import Generated.Types import IHP.Prelude import IHP.ViewPrelude +import Web.Routes () data WidgetTypesView = WidgetTypesView { entries :: ![WidgetTypeRegistry], hubs :: ![Hub] } data ShowWidgetTypeView = ShowWidgetTypeView { entry :: !WidgetTypeRegistry, mOwner :: !(Maybe Hub) } @@ -59,12 +60,12 @@ renderRow :: [Hub] -> WidgetTypeRegistry -> Html renderRow hubs e = [hsx| {e.name} - {e.label} + {e.label_} {hubName hubs e.ownerHubId} {statusBadge e.status} - View - Edit + View + Edit |] @@ -80,22 +81,15 @@ instance View ShowWidgetTypeView where {statusBadge entry.status}
-
Label
{entry.label}
+
Label
{entry.label_}
Description
{fromMaybe "—" entry.description}
Owner
{maybe "Framework (cross-domain)" (.name) mOwner}
Replaced by
{fromMaybe "—" entry.deprecatedInFavourOf}
- Edit - {if entry.status == "active" - then [hsx| -
- - -
- |] - else mempty} + {if entry.status == "active" then renderDeprecateForm entry.id else mempty}
|] @@ -104,20 +98,10 @@ typeForm :: WidgetTypeRegistry -> [Hub] -> Bool -> Html typeForm entry hubs isNew = [hsx|
- {if isNew then [hsx| -
- - {(textField #name) { fieldClass = "w-full border border-gray-300 rounded px-3 py-2 text-sm" }} -
- |] else [hsx| -
- -

{entry.name}

-
- |]} + {renderNameField isNew entry.name}
- {(textField #label) { fieldClass = "w-full border border-gray-300 rounded px-3 py-2 text-sm" }} + {(textField #label_) { fieldClass = "w-full border border-gray-300 rounded px-3 py-2 text-sm" }}
@@ -153,7 +137,29 @@ instance View EditWidgetTypeView where ← Widget Types

Edit Widget Type

-
+ {typeForm entry hubs False}
|] + +renderNameField :: Bool -> Text -> Html +renderNameField True _ = [hsx| +
+ + {(textField #name) { fieldClass = "w-full border border-gray-300 rounded px-3 py-2 text-sm" }} +
+|] +renderNameField False name = [hsx| +
+ +

{name}

+
+|] + +renderDeprecateForm :: Id WidgetTypeRegistry -> Html +renderDeprecateForm entryId = [hsx| +
+ + +
+|] diff --git a/Web/View/WebhookSubscriptions/New.hs b/Web/View/WebhookSubscriptions/New.hs index c36e4a3..66b5fed 100644 --- a/Web/View/WebhookSubscriptions/New.hs +++ b/Web/View/WebhookSubscriptions/New.hs @@ -4,6 +4,7 @@ import Web.Types import Generated.Types import IHP.Prelude import IHP.ViewPrelude +import Web.Routes () webhookTopics :: [Text] webhookTopics = diff --git a/Web/View/WidgetAdapterSpecs/Edit.hs b/Web/View/WidgetAdapterSpecs/Edit.hs index 2f9bebc..38ba20a 100644 --- a/Web/View/WidgetAdapterSpecs/Edit.hs +++ b/Web/View/WidgetAdapterSpecs/Edit.hs @@ -4,6 +4,7 @@ import Web.Types import Generated.Types import IHP.Prelude import IHP.ViewPrelude +import Web.Routes () data EditView = EditView { spec :: !WidgetAdapterSpec @@ -14,7 +15,7 @@ data EditView = EditView instance View EditView where html EditView { .. } = [hsx|
- ← {spec.name} @@ -63,7 +64,7 @@ renderForm spec = formFor spec [hsx|
{submitButton} - Cancel diff --git a/Web/View/WidgetAdapterSpecs/Index.hs b/Web/View/WidgetAdapterSpecs/Index.hs index 4ac2fdb..7c1144c 100644 --- a/Web/View/WidgetAdapterSpecs/Index.hs +++ b/Web/View/WidgetAdapterSpecs/Index.hs @@ -4,6 +4,7 @@ import Web.Types import Generated.Types import IHP.Prelude import IHP.ViewPrelude +import Web.Routes () import Application.Helper.View (adapterStatusBadge) data IndexView = IndexView @@ -34,11 +35,12 @@ instance View IndexView where class="text-gray-500 hover:text-gray-800">Reporting Contracts ({length reportings})
- {if null specs - then [hsx|

No adapter specs registered yet.

|] - else renderTable specs} + {if null specs then noSpecsMsg else renderTable specs} |] +noSpecsMsg :: Html +noSpecsMsg = [hsx|

No adapter specs registered yet.

|] + renderTable :: [WidgetAdapterSpec] -> Html renderTable specs = [hsx|
@@ -63,7 +65,7 @@ renderRow :: WidgetAdapterSpec -> Html renderRow s = [hsx| - {s.name} diff --git a/Web/View/WidgetAdapterSpecs/New.hs b/Web/View/WidgetAdapterSpecs/New.hs index 56484ad..2273add 100644 --- a/Web/View/WidgetAdapterSpecs/New.hs +++ b/Web/View/WidgetAdapterSpecs/New.hs @@ -4,6 +4,7 @@ import Web.Types import Generated.Types import IHP.Prelude import IHP.ViewPrelude +import Web.Routes () data NewView = NewView { spec :: !WidgetAdapterSpec @@ -48,9 +49,7 @@ renderForm spec envelopes reportings = formFor spec [hsx|
@@ -58,9 +57,7 @@ renderForm spec envelopes reportings = formFor spec [hsx|
@@ -87,3 +84,9 @@ renderForm spec envelopes reportings = formFor spec [hsx|
|] + +renderEnvelopeOption :: WidgetEnvelopeContract -> Html +renderEnvelopeOption e = [hsx||] + +renderReportingOption :: WidgetReportingContract -> Html +renderReportingOption r = [hsx||] diff --git a/Web/View/WidgetAdapterSpecs/Show.hs b/Web/View/WidgetAdapterSpecs/Show.hs index 8622efe..4d80961 100644 --- a/Web/View/WidgetAdapterSpecs/Show.hs +++ b/Web/View/WidgetAdapterSpecs/Show.hs @@ -4,6 +4,7 @@ import Web.Types import Generated.Types import IHP.Prelude import IHP.ViewPrelude +import Web.Routes () import Application.Helper.View (adapterStatusBadge) data ShowView = ShowView @@ -32,7 +33,7 @@ instance View ShowView where {maturityBadge spec.maturity} - Edit status / notes @@ -60,44 +61,49 @@ instance View ShowView where - {forEach (specNotes spec) (\n -> [hsx| -
- Notes: {n} -
- |])} + {forEach (specNotes spec) renderSpecNote} - {if null widgets - then [hsx|

No widgets assigned to this adapter spec.

|] - else [hsx| -

Assigned Widgets

-
- - - - - - - - - - {forEach widgets renderWidgetRow} - -
NameTypeStatus
-
- |]} + {renderWidgetsSection widgets} |] +renderSpecNote :: Text -> Html +renderSpecNote n = [hsx| +
+ Notes: {n} +
+|] + +renderWidgetsSection :: [Widget] -> Html +renderWidgetsSection [] = [hsx|

No widgets assigned to this adapter spec.

|] +renderWidgetsSection ws = [hsx| +

Assigned Widgets

+
+ + + + + + + + + + {forEach ws renderWidgetRow} + +
NameTypeStatus
+
+|] + renderEnvelopeLink :: Maybe EnvelopeEmissionContract -> Html renderEnvelopeLink Nothing = [hsx|—|] renderEnvelopeLink (Just c) = [hsx| - v{c.contractVersion} |] renderReportingLink :: Maybe InteractionReportingContract -> Html renderReportingLink Nothing = [hsx|—|] renderReportingLink (Just c) = [hsx| - v{c.contractVersion} |] @@ -105,7 +111,7 @@ renderWidgetRow :: Widget -> Html renderWidgetRow w = [hsx| - {w.name} {w.widgetType} diff --git a/Web/View/WidgetOwnerships/Edit.hs b/Web/View/WidgetOwnerships/Edit.hs index 2971d6e..1183b80 100644 --- a/Web/View/WidgetOwnerships/Edit.hs +++ b/Web/View/WidgetOwnerships/Edit.hs @@ -4,6 +4,7 @@ import Web.Types import Generated.Types import IHP.Prelude import IHP.ViewPrelude +import Web.Routes () data EditView = EditView { ownership :: !WidgetOwnership @@ -21,8 +22,8 @@ instance View EditView where renderForm :: WidgetOwnership -> [Hub] -> Html renderForm ownership hubs = formFor ownership [hsx| - {(selectField #stewardHubId hubs){ label = "Steward Hub (optional)" }} - {(selectField #ownershipType ownershipTypes){ label = "Ownership Type" }} + {(selectField #stewardHubId hubs){ fieldLabel = "Steward Hub (optional)" }} + {(selectField #ownershipType ownershipTypes){ fieldLabel = "Ownership Type" }} {dateTimeField #effectiveUntil} {textareaField #notes} {submitButton} diff --git a/Web/View/WidgetOwnerships/Index.hs b/Web/View/WidgetOwnerships/Index.hs index b37ddcf..f5627e8 100644 --- a/Web/View/WidgetOwnerships/Index.hs +++ b/Web/View/WidgetOwnerships/Index.hs @@ -4,6 +4,7 @@ import Web.Types import Generated.Types import IHP.Prelude import IHP.ViewPrelude +import Web.Routes () data IndexView = IndexView { ownerships :: ![WidgetOwnership] @@ -21,52 +22,54 @@ instance View IndexView where - {if null ownerships - then [hsx|

No ownership records yet.

|] - else [hsx| -
- - - - - - - - - - - - - {forEach ownerships renderRow} - -
WidgetOwner HubSteward HubTypeEffective From
-
- |]} + {renderOwnershipsSection ownerships widgets hubs} |] - where - widgetName wid = maybe (show wid) (.name) (find (\w -> w.id == wid) widgets) - hubName hid = maybe "–" (.name) (find (\h -> h.id == hid) hubs) - renderRow :: WidgetOwnership -> Html - renderRow o = [hsx| - - {widgetName o.widgetId} - {hubName o.ownerHubId} - - {maybe "–" hubName o.stewardHubId} - - - " text-xs px-2 py-0.5 rounded font-medium"}> - {o.ownershipType} - - - {show o.effectiveFrom} - - View - - - |] +renderOwnershipsSection :: [WidgetOwnership] -> [Widget] -> [Hub] -> Html +renderOwnershipsSection [] _ _ = [hsx|

No ownership records yet.

|] +renderOwnershipsSection ownerships ws hs = [hsx| +
+ + + + + + + + + + + + + {forEach ownerships (renderOwnershipRow ws hs)} + +
WidgetOwner HubSteward HubTypeEffective From
+
+|] + +renderOwnershipRow :: [Widget] -> [Hub] -> WidgetOwnership -> Html +renderOwnershipRow ws hs o = + let widgetName wid = maybe (show wid) (.name) (find (\w -> w.id == wid) ws) + hubName hid = maybe "–" (.name) (find (\h -> h.id == hid) hs) + in [hsx| + + {widgetName o.widgetId} + {hubName o.ownerHubId} + + {maybe "–" hubName o.stewardHubId} + + + " text-xs px-2 py-0.5 rounded font-medium"}> + {o.ownershipType} + + + {show o.effectiveFrom} + + View + + +|] typeBadge :: Text -> Text typeBadge t = case t of diff --git a/Web/View/WidgetOwnerships/New.hs b/Web/View/WidgetOwnerships/New.hs index 49ecb35..3d8fcbf 100644 --- a/Web/View/WidgetOwnerships/New.hs +++ b/Web/View/WidgetOwnerships/New.hs @@ -4,6 +4,7 @@ import Web.Types import Generated.Types import IHP.Prelude import IHP.ViewPrelude +import Web.Routes () data NewView = NewView { ownership :: !WidgetOwnership @@ -21,10 +22,10 @@ instance View NewView where renderForm :: WidgetOwnership -> [Widget] -> [Hub] -> Html renderForm ownership widgets hubs = formFor ownership [hsx| - {(selectField #widgetId widgets) { label = "Widget" }} - {(selectField #ownerHubId hubs) { label = "Owner Hub" }} - {(selectField #stewardHubId hubs){ label = "Steward Hub (optional)" }} - {(selectField #ownershipType ownershipTypes){ label = "Ownership Type" }} + {(selectField #widgetId widgets) { fieldLabel = "Widget" }} + {(selectField #ownerHubId hubs) { fieldLabel = "Owner Hub" }} + {(selectField #stewardHubId hubs){ fieldLabel = "Steward Hub (optional)" }} + {(selectField #ownershipType ownershipTypes){ fieldLabel = "Ownership Type" }} {dateTimeField #effectiveFrom} {dateTimeField #effectiveUntil} {textareaField #notes} diff --git a/Web/View/WidgetOwnerships/Show.hs b/Web/View/WidgetOwnerships/Show.hs index 4115b98..7e40cbd 100644 --- a/Web/View/WidgetOwnerships/Show.hs +++ b/Web/View/WidgetOwnerships/Show.hs @@ -4,6 +4,7 @@ import Web.Types import Generated.Types import IHP.Prelude import IHP.ViewPrelude +import Web.Routes () import Web.View.WidgetOwnerships.Index (typeBadge) data ShowView = ShowView @@ -33,7 +34,7 @@ instance View ShowView where
Widget
- {widget.name}
@@ -57,18 +58,21 @@ instance View ShowView where
Created
{show ownership.createdAt}
- {whenJust ownership.notes \n -> [hsx| -
-
Notes
-
{n}
-
- |]} + {maybe mempty renderOwnershipNotesDt ownership.notes}
- Edit
|] + +renderOwnershipNotesDt :: Text -> Html +renderOwnershipNotesDt n = [hsx| +
+
Notes
+
{n}
+
+|] diff --git a/Web/View/WidgetPatterns/Edit.hs b/Web/View/WidgetPatterns/Edit.hs index 289279f..8a5d5d3 100644 --- a/Web/View/WidgetPatterns/Edit.hs +++ b/Web/View/WidgetPatterns/Edit.hs @@ -4,6 +4,7 @@ import Web.Types import Generated.Types import IHP.Prelude import IHP.ViewPrelude +import Web.Routes () data EditView = EditView { pattern :: !WidgetPattern @@ -14,14 +15,14 @@ data EditView = EditView instance View EditView where html EditView { .. } = [hsx|
- ← Pattern

Edit Pattern

-
+ {csrfTokenFormField}
diff --git a/Web/View/WidgetPatterns/Index.hs b/Web/View/WidgetPatterns/Index.hs index 0295cab..7f1b9ec 100644 --- a/Web/View/WidgetPatterns/Index.hs +++ b/Web/View/WidgetPatterns/Index.hs @@ -4,6 +4,7 @@ import Web.Types import Generated.Types import IHP.Prelude import IHP.ViewPrelude +import Web.Routes () -- Row: WidgetPattern fields + adopter_count + latest_version type PatternIndexRow = (WidgetPattern, Int, Maybe Int) @@ -27,31 +28,39 @@ instance View IndexView where
{forEach patterns renderPatternRow} - {if null patterns - then [hsx|

No published patterns yet.

|] - else mempty} + {if null patterns then noPatternsMsg else mempty}
|] +noPatternsMsg :: Html +noPatternsMsg = [hsx|

No published patterns yet.

|] + renderPatternRow :: PatternIndexRow -> Html renderPatternRow (pattern, adopterCount, mVersion) = [hsx|
- {pattern.name} {pattern.widgetType} - {if pattern.isCrossHub - then [hsx|cross-hub|] - else mempty} + {if pattern.isCrossHub then crossHubChip else mempty}
{tshow adopterCount} adopters - {maybe mempty (\v -> [hsx|v{tshow v}|]) mVersion} + {maybe mempty renderVersionChip mVersion}
- {maybe mempty (\d -> [hsx|

{d}

|]) pattern.description} + {maybe mempty renderPatternDesc pattern.description}
|] + +crossHubChip :: Html +crossHubChip = [hsx|cross-hub|] + +renderVersionChip :: Int -> Html +renderVersionChip v = [hsx|v{tshow v}|] + +renderPatternDesc :: Text -> Html +renderPatternDesc d = [hsx|

{d}

|] diff --git a/Web/View/WidgetPatterns/New.hs b/Web/View/WidgetPatterns/New.hs index aa3dbac..2b4d277 100644 --- a/Web/View/WidgetPatterns/New.hs +++ b/Web/View/WidgetPatterns/New.hs @@ -4,6 +4,7 @@ import Web.Types import Generated.Types import IHP.Prelude import IHP.ViewPrelude +import Web.Routes () data NewView = NewView { pattern :: !WidgetPattern @@ -36,17 +37,13 @@ renderForm pattern hubs widgetTypes = [hsx|
@@ -62,3 +59,9 @@ renderForm pattern hubs widgetTypes = [hsx|
|] + +renderHubOption :: Hub -> Html +renderHubOption h = [hsx||] + +renderWidgetTypeOption :: (Text, Text) -> Html +renderWidgetTypeOption (n, l) = [hsx||] diff --git a/Web/View/WidgetPatterns/Show.hs b/Web/View/WidgetPatterns/Show.hs index 85c5ead..f02d27f 100644 --- a/Web/View/WidgetPatterns/Show.hs +++ b/Web/View/WidgetPatterns/Show.hs @@ -4,6 +4,7 @@ import Web.Types import Generated.Types import IHP.Prelude import IHP.ViewPrelude +import Web.Routes () import Data.Aeson (encode) import qualified Data.ByteString.Lazy.Char8 as BL @@ -28,78 +29,25 @@ instance View ShowView where

{pattern.name}

{pattern.widgetType} - {if pattern.isCrossHub - then [hsx|cross-hub|] - else mempty} - {if pattern.isPublished - then [hsx|published|] - else [hsx|draft|]} + {if pattern.isCrossHub then crossHubBadge else mempty} + {renderPublishedBadge pattern.isPublished}

Hub: {hub.name}

{tshow adopterCount} adopters

- {maybe mempty (\d -> [hsx|

{d}

|]) pattern.description} + {maybe mempty renderPatternDescription pattern.description} {aggregatePanel adopterCount anonCount meanFriction outcomeCount}
- {if not pattern.isPublished - then [hsx| - - Edit - - - Publish - - |] - else [hsx| - - Adopt Pattern - - |]} + {renderPatternActions pattern.isPublished pattern.id}

Version History

- {if null versions - then [hsx|

No versions published yet.

|] - else [hsx| -
- {forEach versions renderVersionRow} -
- |]} + {renderVersionHistory versions} - {if pattern.isPublished - then [hsx| -
-

Publish New Version

-
- {csrfTokenFormField} -
- - -
-
- - -
- -
-
- |] - else mempty} + {renderPublishNewVersionForm pattern.isPublished pattern.id} |] -- | Aggregate friction/outcome panel (T07) @@ -111,9 +59,7 @@ aggregatePanel adopterCount anonCount meanFriction outcomeCount = [hsx|

Total Adopters

{tshow adopterCount}

- {if anonCount > 0 - then [hsx|

{tshow anonCount} opted out of aggregate feedback

|] - else mempty} + {if anonCount > 0 then renderAnonCountNote anonCount else mempty}

Mean Friction Score

@@ -137,10 +83,81 @@ renderVersionRow v = [hsx| v{tshow v.versionNumber} {tshow v.publishedAt}
- {maybe mempty (\c -> [hsx|

{c}

|]) v.changelog} + {maybe mempty renderChangelog v.changelog}
Definition 
{cs (BL.unpack (encode v.definition)) :: Text}
|] + +crossHubBadge :: Html +crossHubBadge = [hsx|cross-hub|] + +renderPublishedBadge :: Bool -> Html +renderPublishedBadge True = [hsx|published|] +renderPublishedBadge False = [hsx|draft|] + +renderPatternDescription :: Text -> Html +renderPatternDescription d = [hsx|

{d}

|] + +renderAnonCountNote :: Int -> Html +renderAnonCountNote n = [hsx|

{tshow n} opted out of aggregate feedback

|] + +renderChangelog :: Text -> Html +renderChangelog c = [hsx|

{c}

|] + +renderPatternActions :: Bool -> Id WidgetPattern -> Html +renderPatternActions False pid = [hsx| + + Edit + + + Publish + +|] +renderPatternActions True pid = [hsx| + + Adopt Pattern + +|] + +renderVersionHistory :: [WidgetPatternVersion] -> Html +renderVersionHistory [] = [hsx|

No versions published yet.

|] +renderVersionHistory vs = [hsx| +
+ {forEach vs renderVersionRow} +
+|] + +renderPublishNewVersionForm :: Bool -> Id WidgetPattern -> Html +renderPublishNewVersionForm False _ = mempty +renderPublishNewVersionForm True pid = [hsx| +
+

Publish New Version

+
+ {csrfTokenFormField} +
+ + +
+
+ + +
+ +
+
+|] diff --git a/Web/View/Widgets/Edit.hs b/Web/View/Widgets/Edit.hs index e77845f..bfed31c 100644 --- a/Web/View/Widgets/Edit.hs +++ b/Web/View/Widgets/Edit.hs @@ -4,6 +4,7 @@ import Web.Types import Generated.Types import IHP.Prelude import IHP.ViewPrelude +import Web.Routes () import Web.View.Widgets.New (renderForm) data EditView = EditView @@ -20,7 +21,7 @@ instance View EditView where
Widgets / - {widget.name} + {widget.name} / Edit
diff --git a/Web/View/Widgets/Index.hs b/Web/View/Widgets/Index.hs index ea0866f..4d7137b 100644 --- a/Web/View/Widgets/Index.hs +++ b/Web/View/Widgets/Index.hs @@ -4,6 +4,7 @@ import Web.Types import Generated.Types import IHP.Prelude import IHP.ViewPrelude +import Web.Routes () data IndexView = IndexView { widgets :: ![Widget] @@ -42,7 +43,7 @@ renderWidget :: [Hub] -> Widget -> Html renderWidget hubs w = [hsx| - {w.name} @@ -56,7 +57,7 @@ renderWidget hubs w = [hsx| v{show w.version} - Edit diff --git a/Web/View/Widgets/New.hs b/Web/View/Widgets/New.hs index 1d4c4df..4e3a0f9 100644 --- a/Web/View/Widgets/New.hs +++ b/Web/View/Widgets/New.hs @@ -4,6 +4,7 @@ import Web.Types import Generated.Types import IHP.Prelude import IHP.ViewPrelude +import Web.Routes () data NewView = NewView { widget :: !Widget @@ -34,22 +35,23 @@ renderForm widget hubs adapterSpecs widgetTypes policyScopes = formFor widget [h
{submitButton} |] +renderAdapterOption :: WidgetAdapterSpec -> Html +renderAdapterOption s = [hsx||] + hubOptions :: [Hub] -> [(Text, Id Hub)] hubOptions hubs = map (\h -> (h.name, h.id)) hubs widgetTypeOptions :: [WidgetTypeRegistry] -> [(Text, Text)] -widgetTypeOptions = map (\r -> (r.label, r.name)) +widgetTypeOptions = map (\r -> (r.label_, r.name)) policyScopeOptions :: [PolicyScopeRegistry] -> [(Text, Text)] -policyScopeOptions = map (\r -> (r.label, r.name)) +policyScopeOptions = map (\r -> (r.label_, r.name)) statusOptions :: [(Text, Text)] statusOptions = diff --git a/Web/View/Widgets/Show.hs b/Web/View/Widgets/Show.hs index 9bdcd78..04e55a1 100644 --- a/Web/View/Widgets/Show.hs +++ b/Web/View/Widgets/Show.hs @@ -4,6 +4,7 @@ import Web.Types import Generated.Types import IHP.Prelude import IHP.ViewPrelude +import Web.Routes () import Application.Helper.View (widgetEnvelope) data ShowView = ShowView @@ -23,28 +24,14 @@ instance View ShowView where
Hubs / - {hub.name} + {hub.name} / {widget.name}
- {if cycleCount >= 2 then [hsx| -
- ⟳ {show cycleCount} cycles - - Recurring friction — this widget has been through {show cycleCount} improvement cycles. - -
- |] else mempty} + {renderCycleBanner cycleCount} - {if isRegressed then [hsx| -
- ⚠ Regression detected - - This widget had an improved signal but has since received high/critical annotations. - -
- |] else mempty} + {if isRegressed then renderRegressionBanner else mempty} {widgetEnvelope widget [hsx|
@@ -58,7 +45,7 @@ instance View ShowView where {renderAdapterBadge mAdapterSpec}

- Edit @@ -85,19 +72,13 @@ instance View ShowView where

Annotations

- {if length annotations >= 3 then [hsx| -
- -
- |] else mempty} -
+ {if length annotations >= 3 then renderDraftRequirementForm widget.id else mempty} +
- + Add
@@ -132,14 +113,7 @@ instance View ShowView where - {if null recentSignals then mempty else [hsx| -
-

Recent Outcome Signals

-
- {forEach recentSignals renderSignalRow} -
-
- |]} + {renderSignalsSection recentSignals}

Version History

@@ -213,7 +187,7 @@ renderSignalRow sig = [hsx| " text-xs px-2 py-0.5 rounded font-medium"}> {sig.signalType} - {maybe mempty (\v -> [hsx|{show v}|]) sig.value} + {maybe mempty renderSignalValue sig.value} {show sig.observedAt} |] @@ -225,10 +199,54 @@ signalTypeClass "neutral" = "bg-gray-100 text-gray-600" signalTypeClass "inconclusive" = "bg-yellow-100 text-yellow-800" signalTypeClass _ = "bg-gray-100 text-gray-600" +renderCycleBanner :: Int -> Html +renderCycleBanner n | n >= 2 = [hsx| +
+ ⟳ {show n} cycles + + Recurring friction — this widget has been through {show n} improvement cycles. + +
+|] +renderCycleBanner _ = mempty + +renderRegressionBanner :: Html +renderRegressionBanner = [hsx| +
+ ⚠ Regression detected + + This widget had an improved signal but has since received high/critical annotations. + +
+|] + +renderDraftRequirementForm :: Id Widget -> Html +renderDraftRequirementForm wid = [hsx| +
+ +
+|] + +renderSignalsSection :: [OutcomeSignal] -> Html +renderSignalsSection [] = mempty +renderSignalsSection sigs = [hsx| +
+

Recent Outcome Signals

+
+ {forEach sigs renderSignalRow} +
+
+|] + +renderSignalValue :: Double -> Html +renderSignalValue v = [hsx|{show v}|] + renderAdapterBadge :: Maybe WidgetAdapterSpec -> Html renderAdapterBadge Nothing = mempty renderAdapterBadge (Just s) = [hsx| - adapter: {s.name} diff --git a/flake.nix b/flake.nix index e9d6f27..46b40fd 100644 --- a/flake.nix +++ b/flake.nix @@ -24,7 +24,7 @@ enable = true; projectPath = ./.; packages = with pkgs; [ - # Native dependencies, e.g. imagemagick + tailwindcss ]; haskellPackages = p: with p; [ # Haskell dependencies go here @@ -87,8 +87,7 @@ # Custom processes that don't appear in https://devenv.sh/reference/options/ processes = { - # Uncomment if you use tailwindcss. - # tailwind.exec = "tailwindcss -c tailwind/tailwind.config.js -i ./tailwind/app.css -o static/app.css --watch=always"; + tailwind.exec = "tailwindcss -c tailwind/tailwind.config.js -i ./tailwind/app.css -o static/app.css --watch=always"; }; }; }; diff --git a/tailwind/app.css b/tailwind/app.css new file mode 100644 index 0000000..b5c61c9 --- /dev/null +++ b/tailwind/app.css @@ -0,0 +1,3 @@ +@tailwind base; +@tailwind components; +@tailwind utilities; diff --git a/tailwind/tailwind.config.js b/tailwind/tailwind.config.js new file mode 100644 index 0000000..1f57fae --- /dev/null +++ b/tailwind/tailwind.config.js @@ -0,0 +1,11 @@ +/** @type {import('tailwindcss').Config} */ +module.exports = { + content: [ + "./Web/View/**/*.hs", + "./Web/FrontController.hs", + ], + theme: { + extend: {}, + }, + plugins: [], +}