fix: resolve all GHC 9.10.3 / IHP 1.5 compile errors (all 616 modules load)
Some checks failed
Test / test (push) Has been cancelled

Fix 13 modules that blocked compilation on Alpine:

- FrontController: remove annotationLauncherScript helper (IHP Html is a
  constrained type synonym); add (?context, ?request) constraint to
  defaultLayout matching what setLayout expects
- HubCapabilityManifests: switch JSONB fill to paramList+toJSON; fix dynamic
  SQL Text→Query via fromString/cs; void sqlExec; add Control.Monad.void
- Hubs: replace raw Array sqlQuery with filterWhereIn query builder;
  fix isInList validators
- DecisionRecords: remove unregistered DistilDecisionAction; fix hub
  resolution chain via candidateId→sourceWidgetId; BridgeResponse(..)
- RequirementCandidates: BridgeResponse(..); remove @Widget type apps from
  fetchOneOrNothing; void ConfidenceAnnotation createRecord
- AdaptiveThresholds: fix sqlQuery tuple param (Only hubId)
- AgentDelegations, AgentRegistrations, Widgets: BridgeResponse(..)
- Annotations, DeploymentRecords, GovernanceTemplates: minor type fixes
- DecisionRecords/Edit view: extract formAction before HSX block

Co-Authored-By: Claude Sonnet 4.6 <noreply@anthropic.com>
This commit is contained in:
2026-04-29 10:46:50 +02:00
parent 209c77dd31
commit 2106000cc7
13 changed files with 71 additions and 130 deletions

View File

@@ -8,7 +8,7 @@ import Web.View.RequirementCandidates.Edit
import Generated.Types
import IHP.Prelude
import IHP.ControllerPrelude
import Application.Helper.AgentBridge (callAgent, checkGovernancePolicy, bridgeErrorMessage, BridgeResponse)
import Application.Helper.AgentBridge (callAgent, checkGovernancePolicy, bridgeErrorMessage, BridgeResponse(..))
import Application.Helper.ModelRouter (resolveAgent)
import Data.Aeson (decode, Value(..), Array)
import Data.Aeson.Lens (key, _String)
@@ -18,6 +18,7 @@ import Web.Job.WebhookDeliveryJob (dispatchWebhooks)
import Control.Concurrent (forkIO)
import Control.Monad (void)
import Data.Coerce (coerce)
import Data.Scientific (Scientific)
import Data.Aeson ((.=), object)
import Data.Text.Encoding (encodeUtf8)
import Data.HashMap.Strict (HashMap)
@@ -95,7 +96,7 @@ instance Controller RequirementCandidatesController where
|> set #createdBy (fmap coerce createdBy)
|> validateField #title nonEmpty
|> validateField #description nonEmpty
|> validateField #category (`elem` validCategories)
|> validateField #category (isInList validCategories)
|> ifValid \case
Left candidate -> render NewView { candidate, widgets, threads }
Right candidate -> do
@@ -127,7 +128,7 @@ instance Controller RequirementCandidatesController where
|> fill @'["title", "description", "sourceWidgetId", "sourceThreadId", "category"]
|> validateField #title nonEmpty
|> validateField #description nonEmpty
|> validateField #category (`elem` validCategories)
|> validateField #category (isInList validCategories)
|> ifValid \case
Left candidate -> render EditView { candidate, widgets, threads }
Right candidate -> do
@@ -260,10 +261,8 @@ instance Controller RequirementCandidatesController where
action DetectDuplicatesAction { requirementCandidateId } = do
target <- fetch requirementCandidateId
others <- query @RequirementCandidate |> fetch
-- Resolve hub from the source widget
mHubId <- case target.sourceWidgetId of
Nothing -> pure Nothing
Just wid -> fmap (.hubId) <$> fetchOneOrNothing @Widget wid
-- Resolve hub from the source widget (sourceWidgetId is non-nullable)
mHubId <- fmap (.hubId) <$> fetchOneOrNothing target.sourceWidgetId
let otherLines = map (\c -> show c.id <> " | " <> c.title <> ": " <> c.description)
(filter (\c -> c.id /= requirementCandidateId) others)
targetLine = "TARGET: " <> target.title <> ": " <> target.description
@@ -315,13 +314,9 @@ instance Controller RequirementCandidatesController where
-- T06: Detect policy sensitivity via routed agent
action DetectPolicySensitivityAction { requirementCandidateId } = do
candidate <- fetch requirementCandidateId
mWidget <- case candidate.sourceWidgetId of
Nothing -> pure Nothing
Just wid -> fetchOneOrNothing wid
-- Resolve hub for routing
mHubId <- case candidate.sourceWidgetId of
Nothing -> pure Nothing
Just wid -> fmap (.hubId) <$> fetchOneOrNothing @Widget wid
-- sourceWidgetId is non-nullable; fetchOneOrNothing handles missing widget
mWidget <- fetchOneOrNothing candidate.sourceWidgetId
mHubId <- fmap (.hubId) <$> fetchOneOrNothing candidate.sourceWidgetId
let policyCtx = maybe "unknown" (.policyScope) mWidget
userMsg = "Title: " <> candidate.title
<> "\nDescription: " <> candidate.description
@@ -358,7 +353,7 @@ instance Controller RequirementCandidatesController where
setErrorMessage ("Policy check failed: " <> bridgeErrorMessage err)
redirectTo ShowRequirementCandidateAction { requirementCandidateId }
Right resp -> do
let confidenceScore = extractSeverityScore resp.content
let confidenceScore = realToFrac (extractSeverityScore resp.content) :: Scientific
proposal <- newRecord @AgentProposal
|> set #proposalType "policy_flag"
|> set #sourceCandidateId (Just requirementCandidateId)
@@ -379,10 +374,10 @@ instance Controller RequirementCandidatesController where
case (concern ^? key "scope" . _String
,concern ^? key "note" . _String) of
(Just scope, noteM) ->
newRecord @ConfidenceAnnotation
void $ newRecord @ConfidenceAnnotation
|> set #proposalId proposal.id
|> set #dimension scope
|> set #score confidenceScore
|> set #score (confidenceScore :: Scientific)
|> set #explanation noteM
|> createRecord
_ -> pure ()