diff --git a/Application/Helper/BottleneckDetector.hs b/Application/Helper/BottleneckDetector.hs index f1df231..66d3f15 100644 --- a/Application/Helper/BottleneckDetector.hs +++ b/Application/Helper/BottleneckDetector.hs @@ -8,6 +8,7 @@ import Generated.Types import Web.Routes () import Data.Time.Clock (addUTCTime, getCurrentTime, NominalDiffTime) import Database.PostgreSQL.Simple (Only(..)) +import Data.Coerce (coerce) -- | Severity based on how much older than the threshold the record is. staleSeverity :: NominalDiffTime -> NominalDiffTime -> Text diff --git a/Application/Helper/CrossHubPropagation.hs b/Application/Helper/CrossHubPropagation.hs index a94a526..7f4edc4 100644 --- a/Application/Helper/CrossHubPropagation.hs +++ b/Application/Helper/CrossHubPropagation.hs @@ -9,6 +9,7 @@ import Web.Routes () import Data.Time.Clock (addUTCTime, getCurrentTime) import Data.Aeson (toJSON) import qualified Data.List as List +import Control.Monad (guard) -- | Detect cross-hub propagation patterns and insert CrossHubPropagation rows. -- Idempotent: skips patterns for which an open/acknowledged record already exists. diff --git a/Application/Helper/HubHealth.hs b/Application/Helper/HubHealth.hs index 8b9325d..0d0c957 100644 --- a/Application/Helper/HubHealth.hs +++ b/Application/Helper/HubHealth.hs @@ -51,7 +51,7 @@ computeHubHealth hubId widgets candidates decisions deployments signals annotati score = max 0 (100 - deductions) newRecord @HubHealthSnapshot - |> set #hubId (toUUID hubId) + |> set #hubId hubId |> set #healthScore score |> set #openCandidates openCount |> set #regressedWidgets regCount diff --git a/Application/Helper/ModelRouter.hs b/Application/Helper/ModelRouter.hs index c9d6403..00e8be8 100644 --- a/Application/Helper/ModelRouter.hs +++ b/Application/Helper/ModelRouter.hs @@ -24,7 +24,7 @@ resolveAgent hubId taskType = do \ LIMIT 1" (hubId, taskType) case rows of - [Only agentId] -> fetchOneOrNothing agentId + [Only (agentId :: Id AgentRegistration)] -> fetchOneOrNothing agentId _ -> pure Nothing -- | Return all active AgentRegistrations for a hub + task_type ordered by @@ -39,4 +39,4 @@ resolveAllAgents hubId taskType = do \ WHERE mrp.hub_id = ? AND mrp.task_type = ? AND mrp.is_active = TRUE \ \ ORDER BY mrp.priority DESC" (hubId, taskType) - mapM (fetch . (\(Only i) -> i)) rows + mapM (\(Only (i :: Id AgentRegistration)) -> fetch i) rows diff --git a/Application/Schema.sql b/Application/Schema.sql index cf7e48d..e5dafd0 100644 --- a/Application/Schema.sql +++ b/Application/Schema.sql @@ -1053,3 +1053,93 @@ ALTER TABLE agent_review_records ADD FOREIGN KEY (proposal_id) REFERENCES agent_ 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); + +-- Additional FK constraints for IHP type generation (Id vs UUID) +-- Phase 6 — widget_adapter_specs +ALTER TABLE widget_adapter_specs ADD FOREIGN KEY (envelope_contract_id) REFERENCES envelope_emission_contracts(id); +ALTER TABLE widget_adapter_specs ADD FOREIGN KEY (reporting_contract_id) REFERENCES interaction_reporting_contracts(id); +ALTER TABLE widgets ADD FOREIGN KEY (adapter_spec_id) REFERENCES widget_adapter_specs(id); + +-- Phase 7 — friction_scores, bottleneck_records, hub_health_snapshots +ALTER TABLE friction_scores ADD FOREIGN KEY (widget_id) REFERENCES widgets(id); +ALTER TABLE bottleneck_records ADD FOREIGN KEY (hub_id) REFERENCES hubs(id); +ALTER TABLE hub_health_snapshots ADD FOREIGN KEY (hub_id) REFERENCES hubs(id); +ALTER TABLE cross_hub_propagations ADD FOREIGN KEY (source_hub_id) REFERENCES hubs(id); + +-- Phase 8 — widget_ownerships, hub_routing_rules, stewardship_roles +ALTER TABLE widget_ownerships ADD FOREIGN KEY (widget_id) REFERENCES widgets(id); +ALTER TABLE widget_ownerships ADD FOREIGN KEY (owner_hub_id) REFERENCES hubs(id); +ALTER TABLE widget_ownerships ADD FOREIGN KEY (steward_hub_id) REFERENCES hubs(id); +ALTER TABLE hub_routing_rules ADD FOREIGN KEY (source_hub_id) REFERENCES hubs(id); +ALTER TABLE hub_routing_rules ADD FOREIGN KEY (target_hub_id) REFERENCES hubs(id); +ALTER TABLE stewardship_roles ADD FOREIGN KEY (hub_id) REFERENCES hubs(id); +ALTER TABLE requirement_candidates ADD FOREIGN KEY (routed_to_hub_id) REFERENCES hubs(id); + +-- User actor references (nullable) +ALTER TABLE annotation_threads ADD FOREIGN KEY (created_by) REFERENCES users(id); +ALTER TABLE requirement_candidates ADD FOREIGN KEY (created_by) REFERENCES users(id); +ALTER TABLE triage_states ADD FOREIGN KEY (changed_by) REFERENCES users(id); +ALTER TABLE requirements ADD FOREIGN KEY (created_by) REFERENCES users(id); +ALTER TABLE decision_records ADD FOREIGN KEY (decided_by) REFERENCES users(id); +ALTER TABLE policy_references ADD FOREIGN KEY (created_by) REFERENCES users(id); +ALTER TABLE implementation_change_references ADD FOREIGN KEY (linked_by) REFERENCES users(id); +ALTER TABLE deployment_records ADD FOREIGN KEY (deployed_by) REFERENCES users(id); +ALTER TABLE agent_review_records ADD FOREIGN KEY (reviewer_id) REFERENCES users(id); + +-- change_evaluations +ALTER TABLE change_evaluations ADD FOREIGN KEY (deployment_id) REFERENCES deployment_records(id); +ALTER TABLE change_evaluations ADD FOREIGN KEY (decision_id) REFERENCES decision_records(id); +ALTER TABLE change_evaluations ADD FOREIGN KEY (evaluated_by) REFERENCES users(id); + +-- agent_proposals source refs +ALTER TABLE agent_proposals ADD FOREIGN KEY (source_widget_id) REFERENCES widgets(id); +ALTER TABLE agent_proposals ADD FOREIGN KEY (source_candidate_id) REFERENCES requirement_candidates(id); +ALTER TABLE agent_proposals ADD FOREIGN KEY (source_thread_id) REFERENCES annotation_threads(id); +ALTER TABLE agent_proposals ADD FOREIGN KEY (source_decision_id) REFERENCES decision_records(id); +ALTER TABLE agent_proposals ADD FOREIGN KEY (agent_registration_id) REFERENCES agent_registrations(id); + +-- GAAF type registry owner refs (nullable) +ALTER TABLE widget_type_registry ADD FOREIGN KEY (owner_hub_id) REFERENCES hubs(id); +ALTER TABLE event_type_registry ADD FOREIGN KEY (owner_hub_id) REFERENCES hubs(id); +ALTER TABLE annotation_category_registry ADD FOREIGN KEY (owner_hub_id) REFERENCES hubs(id); +ALTER TABLE policy_scope_registry ADD FOREIGN KEY (owner_hub_id) REFERENCES hubs(id); + +-- hub_capability_manifests +ALTER TABLE hub_capability_manifests ADD FOREIGN KEY (hub_id) REFERENCES hubs(id); + +-- Phase 9 — api_consumers, webhook_deliveries, api_request_log +ALTER TABLE api_consumers ADD FOREIGN KEY (hub_capability_manifest_id) REFERENCES hub_capability_manifests(id); +ALTER TABLE webhook_deliveries ADD FOREIGN KEY (webhook_subscription_id) REFERENCES webhook_subscriptions(id); +ALTER TABLE api_request_log ADD FOREIGN KEY (api_consumer_id) REFERENCES api_consumers(id); + +-- Phase 10 — widget_patterns, pattern_adoptions, governance_templates +ALTER TABLE widget_patterns ADD FOREIGN KEY (hub_id) REFERENCES hubs(id); +ALTER TABLE widget_pattern_versions ADD FOREIGN KEY (widget_pattern_id) REFERENCES widget_patterns(id); +ALTER TABLE pattern_adoptions ADD FOREIGN KEY (adopting_hub_id) REFERENCES hubs(id); +ALTER TABLE pattern_adoptions ADD FOREIGN KEY (pinned_version_id) REFERENCES widget_pattern_versions(id); +ALTER TABLE governance_templates ADD FOREIGN KEY (hub_id) REFERENCES hubs(id); +ALTER TABLE governance_template_clones ADD FOREIGN KEY (governance_template_id) REFERENCES governance_templates(id); +ALTER TABLE governance_template_clones ADD FOREIGN KEY (cloning_hub_id) REFERENCES hubs(id); + +-- Phase 11 — agent_registrations, model_routing_policies, agent_delegations, collective_proposals +ALTER TABLE agent_registrations ADD FOREIGN KEY (hub_id) REFERENCES hubs(id); +ALTER TABLE model_routing_policies ADD FOREIGN KEY (hub_id) REFERENCES hubs(id); +ALTER TABLE model_routing_policies ADD FOREIGN KEY (agent_registration_id) REFERENCES agent_registrations(id); +ALTER TABLE agent_delegations ADD FOREIGN KEY (delegating_agent_id) REFERENCES agent_registrations(id); +ALTER TABLE agent_delegations ADD FOREIGN KEY (receiving_agent_id) REFERENCES agent_registrations(id); +ALTER TABLE agent_delegations ADD FOREIGN KEY (parent_proposal_id) REFERENCES agent_proposals(id); +ALTER TABLE collective_proposals ADD FOREIGN KEY (source_widget_id) REFERENCES widgets(id); +ALTER TABLE collective_proposals ADD FOREIGN KEY (source_candidate_id) REFERENCES requirement_candidates(id); +ALTER TABLE collective_proposal_contributions ADD FOREIGN KEY (collective_proposal_id) REFERENCES collective_proposals(id); +ALTER TABLE collective_proposal_contributions ADD FOREIGN KEY (agent_registration_id) REFERENCES agent_registrations(id); +ALTER TABLE ai_governance_policies ADD FOREIGN KEY (hub_id) REFERENCES hubs(id); +ALTER TABLE ai_governance_policies ADD FOREIGN KEY (agent_registration_id) REFERENCES agent_registrations(id); +ALTER TABLE agent_performance_records ADD FOREIGN KEY (agent_registration_id) REFERENCES agent_registrations(id); +ALTER TABLE agent_performance_records ADD FOREIGN KEY (hub_id) REFERENCES hubs(id); + +-- Phase 12 — outcome_correlations, pattern_performance_records, adaptive_threshold_configs, learning_insights +ALTER TABLE outcome_correlations ADD FOREIGN KEY (hub_id) REFERENCES hubs(id); +ALTER TABLE pattern_performance_records ADD FOREIGN KEY (widget_pattern_id) REFERENCES widget_patterns(id); +ALTER TABLE pattern_performance_records ADD FOREIGN KEY (hub_id) REFERENCES hubs(id); +ALTER TABLE adaptive_threshold_configs ADD FOREIGN KEY (hub_id) REFERENCES hubs(id); +ALTER TABLE learning_insights ADD FOREIGN KEY (hub_id) REFERENCES hubs(id); diff --git a/Web/Controller/ApiInteractionEvents.hs b/Web/Controller/ApiInteractionEvents.hs index 472b187..e717eee 100644 --- a/Web/Controller/ApiInteractionEvents.hs +++ b/Web/Controller/ApiInteractionEvents.hs @@ -80,7 +80,7 @@ createEventForHub hub = do Nothing -> do renderJsonWithStatusCode status422 (object ["error" .= ("Widget not found" :: Text)]) Just widget -> do - when (widget.hubId /= toUUID hub.id) do + when (widget.hubId /= hub.id) do renderJsonWithStatusCode status403 (object ["error" .= ("Widget does not belong to this hub" :: Text)]) event <- newRecord @InteractionEvent diff --git a/Web/Controller/ApiKeys.hs b/Web/Controller/ApiKeys.hs index 001bd14..429bba4 100644 --- a/Web/Controller/ApiKeys.hs +++ b/Web/Controller/ApiKeys.hs @@ -7,7 +7,7 @@ import Generated.Types import IHP.Prelude import IHP.ControllerPrelude import qualified Data.Text.Encoding as TE -import qualified Crypto.Hash.SHA256 as SHA256 +import qualified "cryptohash-sha256" Crypto.Hash.SHA256 as SHA256 import qualified Data.ByteString.Base16 as Base16 import qualified Data.ByteString.Random as Random diff --git a/Web/Job/WebhookDeliveryJob.hs b/Web/Job/WebhookDeliveryJob.hs index 1e37a70..9e120c7 100644 --- a/Web/Job/WebhookDeliveryJob.hs +++ b/Web/Job/WebhookDeliveryJob.hs @@ -52,7 +52,7 @@ attempt sub payload attemptNo = do $ HTTP.setRequestHeader "Content-Type" ["application/json"] $ HTTP.setRequestHeader "X-IHF-Signature" [TE.encodeUtf8 sig] $ HTTP.setRequestHeader "X-IHF-Event" [TE.encodeUtf8 sub.eventType] - $ HTTP.setRequestBodyBS payloadBytes req + $ HTTP.setRequestBodyLBS (LBS.fromStrict payloadBytes) req HTTP.httpLBS req' endTime <- getCurrentTime let latencyMs = round (realToFrac (diffUTCTime endTime startTime) * 1000 :: Double) :: Int @@ -104,5 +104,3 @@ hmacSha256Hex secret payload = digest = SHA256.hash combined in TE.decodeUtf8 (Base16.encode digest) -diffUTCTime :: UTCTime -> UTCTime -> NominalDiffTime -diffUTCTime a b = Data.Time.diffUTCTime a b diff --git a/Web/View/AgentProposals/Index.hs b/Web/View/AgentProposals/Index.hs index 2c96355..eb88624 100644 --- a/Web/View/AgentProposals/Index.hs +++ b/Web/View/AgentProposals/Index.hs @@ -97,7 +97,7 @@ renderRow widgets p = [hsx|
Full traceability chain for this widget.