generated from coulomb/repo-seed
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
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:
@@ -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 ()
|
||||
|
||||
Reference in New Issue
Block a user