module Web.Controller.DecisionRecords where import Web.Types import Web.View.DecisionRecords.Index import Web.View.DecisionRecords.Show import Web.View.DecisionRecords.New import Web.View.DecisionRecords.Edit import Generated.Types import IHP.Prelude import IHP.ControllerPrelude import Application.Helper.AgentBridge (callAgent, checkGovernancePolicy, bridgeErrorMessage, BridgeResponse(..)) import Application.Helper.ModelRouter (resolveAgent) import IHP.ModelSupport (sqlQuery) import qualified Data.Aeson as A import Data.Coerce (coerce) validOutcomes :: [Text] validOutcomes = ["accepted", "rejected", "deferred", "split", "merged", "reframed"] validPolicyScopes :: [Text] validPolicyScopes = ["internal", "external", "regulatory", "contractual", "architectural"] validSystems :: [Text] validSystems = ["github", "linear", "jira", "other"] instance Controller DecisionRecordsController where beforeAction = ensureIsUser action DecisionRecordsAction = do let mOutcomeFilter = paramOrNothing @Text "outcome" records <- case mOutcomeFilter of Nothing -> query @DecisionRecord |> orderByDesc #decidedAt |> fetch Just o -> query @DecisionRecord |> filterWhere (#outcome, o) |> orderByDesc #decidedAt |> fetch requirements <- query @Requirement |> fetch users <- query @User |> fetch render IndexView { records, requirements, users, mOutcomeFilter } action ShowDecisionRecordAction { decisionRecordId } = do record <- fetch decisionRecordId policyRefs <- query @PolicyReference |> filterWhere (#decisionId, decisionRecordId) |> orderByAsc #createdAt |> fetch implRefs <- query @ImplementationChangeReference |> filterWhere (#decisionId, decisionRecordId) |> orderByAsc #linkedAt |> fetch deploymentRecords <- query @DeploymentRecord |> filterWhere (#decisionId, decisionRecordId) |> orderByDesc #deployedAt |> fetch let deploymentIds = map (.id) deploymentRecords evaluations <- query @ChangeEvaluation |> filterWhereIn (#deploymentId, deploymentIds) |> fetch mRequirement <- case record.requirementId of Nothing -> pure Nothing Just rid -> fetchOneOrNothing rid mCandidate <- case record.candidateId of Nothing -> pure Nothing Just cid -> fetchOneOrNothing cid users <- query @User |> fetch render ShowView { record , policyRefs , implRefs , deploymentRecords , evaluations , mRequirement , mCandidate , users } action NewDecisionRecordAction = do requirements <- query @Requirement |> fetch candidates <- query @RequirementCandidate |> fetch users <- query @User |> fetch let record = newRecord @DecisionRecord render NewView { record, requirements, candidates, users } action CreateDecisionRecordAction = do requirements <- query @Requirement |> fetch candidates <- query @RequirementCandidate |> fetch users <- query @User |> fetch let mUser = currentUserOrNothing decidedBy = fmap (.id) mUser let record = newRecord @DecisionRecord record |> fill @'["title", "rationale", "outcome", "requirementId", "candidateId", "notes"] |> set #decidedBy (fmap coerce decidedBy) |> validateField #title nonEmpty |> validateField #rationale nonEmpty |> validateField #outcome (isInList validOutcomes) |> ifValid \case Left record -> render NewView { record, requirements, candidates, users } Right record -> do created <- createRecord record setSuccessMessage "Decision record created" redirectTo ShowDecisionRecordAction { decisionRecordId = created.id } action EditDecisionRecordAction { decisionRecordId } = do record <- fetch decisionRecordId requirements <- query @Requirement |> fetch candidates <- query @RequirementCandidate |> fetch users <- query @User |> fetch render EditView { record, requirements, candidates, users } action UpdateDecisionRecordAction { decisionRecordId } = do record <- fetch decisionRecordId requirements <- query @Requirement |> fetch candidates <- query @RequirementCandidate |> fetch users <- query @User |> fetch -- Outcome is immutable: only update non-outcome fields record |> fill @'["title", "rationale", "requirementId", "candidateId", "notes"] |> validateField #title nonEmpty |> validateField #rationale nonEmpty |> ifValid \case Left record -> render EditView { record, requirements, candidates, users } Right record -> do updateRecord record setSuccessMessage "Decision record updated" redirectTo ShowDecisionRecordAction { decisionRecordId } action AddPolicyReferenceAction { decisionRecordId } = do let mUser = currentUserOrNothing createdBy = fmap (.id) mUser policyScope = param @Text "policyScope" constraintNote = paramOrNothing @Text "constraintNote" unless (policyScope `elem` validPolicyScopes) do setErrorMessage ("Invalid policy scope: " <> policyScope) redirectTo ShowDecisionRecordAction { decisionRecordId } newRecord @PolicyReference |> set #decisionId decisionRecordId |> set #policyScope policyScope |> set #constraintNote constraintNote |> set #createdBy (fmap coerce createdBy) |> createRecord setSuccessMessage "Policy reference added" redirectTo ShowDecisionRecordAction { decisionRecordId } action DeletePolicyReferenceAction { policyReferenceId } = do ref <- fetch policyReferenceId let decisionRecordId = ref.decisionId deleteRecord ref setSuccessMessage "Policy reference removed" redirectTo ShowDecisionRecordAction { decisionRecordId } action AddImplementationRefAction { decisionRecordId } = do let mUser = currentUserOrNothing linkedBy = fmap (.id) mUser workItemRef = param @Text "workItemRef" system = param @Text "system" unless (system `elem` validSystems) do setErrorMessage ("Invalid system: " <> system) redirectTo ShowDecisionRecordAction { decisionRecordId } when (workItemRef == "") do setErrorMessage "Work item reference cannot be empty" redirectTo ShowDecisionRecordAction { decisionRecordId } newRecord @ImplementationChangeReference |> set #decisionId decisionRecordId |> set #workItemRef workItemRef |> set #system system |> set #linkedBy (fmap coerce linkedBy) |> createRecord setSuccessMessage "Implementation reference added" redirectTo ShowDecisionRecordAction { decisionRecordId } action DeleteImplementationRefAction { implementationChangeReferenceId } = do ref <- fetch implementationChangeReferenceId let decisionRecordId = ref.decisionId deleteRecord ref setSuccessMessage "Implementation reference removed" redirectTo ShowDecisionRecordAction { decisionRecordId } -- T07 / Phase 11: Propose implementation paths via routed agent action ProposeImplementationAction { decisionRecordId } = do record <- fetch decisionRecordId implRefs <- query @ImplementationChangeReference |> filterWhere (#decisionId, decisionRecordId) |> fetch mRequirement <- case record.requirementId of Nothing -> pure Nothing Just rid -> fetchOneOrNothing rid -- Resolve hub via the decision's linked candidate → source widget mHubId <- case record.candidateId of Nothing -> pure Nothing Just cid -> do mCand <- fetchOneOrNothing cid case mCand of Nothing -> pure Nothing Just cand -> fmap (.hubId) <$> fetchOneOrNothing cand.sourceWidgetId let implLines = map (\r -> r.system <> ": " <> r.workItemRef) implRefs reqDesc = maybe "" (.description) mRequirement userMsg = "Decision: " <> record.title <> "\nRationale: " <> record.rationale <> "\nOutcome: " <> record.outcome <> "\nRequirement: " <> reqDesc <> "\nExisting impl refs: " <> intercalate ", " implLines case mHubId of Nothing -> do setErrorMessage "Cannot determine hub for routing — ensure the decision has a linked requirement with a source widget" redirectTo ShowDecisionRecordAction { decisionRecordId } Just hubId -> do mAgent <- resolveAgent hubId "implementation" case mAgent of Nothing -> do setErrorMessage "No routing policy for 'implementation' task type" redirectTo ShowDecisionRecordAction { decisionRecordId } Just agent -> do allowed <- checkGovernancePolicy hubId agent.id "decision_record" if not allowed then do newRecord @AgentProposal |> set #proposalType "impl_proposal" |> set #sourceDecisionId (Just decisionRecordId) |> set #content "Blocked by AI governance policy" |> set #modelRef agent.modelName |> set #status "blocked_by_policy" |> set #agentRegistrationId (Just agent.id) |> createRecord setErrorMessage "Blocked by AI governance policy" redirectTo ShowDecisionRecordAction { decisionRecordId } else do result <- liftIO $ callAgent agent userMsg case result of Left err -> do setErrorMessage ("Implementation proposal failed: " <> bridgeErrorMessage err) redirectTo ShowDecisionRecordAction { decisionRecordId } Right resp -> do newRecord @AgentProposal |> set #proposalType "impl_proposal" |> set #sourceDecisionId (Just decisionRecordId) |> set #content resp.content |> set #modelRef resp.modelUsed |> set #status "pending" |> set #agentRegistrationId (Just agent.id) |> set #tokensIn (Just resp.tokensIn) |> set #tokensOut (Just resp.tokensOut) |> createRecord setSuccessMessage "Implementation proposal created" redirectTo ShowDecisionRecordAction { decisionRecordId }