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) import Application.Helper.ModelRouter (resolveAgent) import Data.List (intercalate) 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 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 mUser <- currentUserOrNothing let decidedBy = fmap (.id) mUser let record = newRecord @DecisionRecord record |> fill @'["title", "rationale", "outcome", "requirementId", "candidateId", "notes"] |> set #decidedBy (fmap (Id . unId) decidedBy) |> validateField #title nonEmpty |> validateField #rationale nonEmpty |> validateField #outcome (`elem` 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 mUser <- currentUserOrNothing let createdBy = fmap (.id) mUser policyScope <- param @Text "policyScope" constraintNote <- paramOrNothing @Text "constraintNote" unless (policyScope `elem` validPolicyScopes) do setErrorMessage ("Invalid policy scope: " <> policyScope) respondWith 422 do redirectTo ShowDecisionRecordAction { decisionRecordId } newRecord @PolicyReference |> set #decisionId decisionRecordId |> set #policyScope policyScope |> set #constraintNote constraintNote |> set #createdBy (fmap (Id . unId) 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 mUser <- currentUserOrNothing let linkedBy = fmap (.id) mUser workItemRef <- param @Text "workItemRef" system <- param @Text "system" unless (system `elem` validSystems) do setErrorMessage ("Invalid system: " <> system) respondWith 422 do redirectTo ShowDecisionRecordAction { decisionRecordId } when (workItemRef == "") do setErrorMessage "Work item reference cannot be empty" respondWith 422 do redirectTo ShowDecisionRecordAction { decisionRecordId } newRecord @ImplementationChangeReference |> set #decisionId decisionRecordId |> set #workItemRef workItemRef |> set #system system |> set #linkedBy (fmap (Id . unId) 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 from the source widget via requirement candidate mHubId <- case mRequirement >>= (.sourceWidgetId) of Nothing -> pure Nothing Just wid -> fmap (.hubId) <$> fetchOneOrNothing @Widget wid 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 }