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) 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: " <> err.errorMessage) 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 }