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) import IHP.ModelSupport (sqlQuery) import qualified Data.Aeson as A 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 (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 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) 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 let mUser = currentUserOrNothing 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 } -- T05 / Phase 12: Distil decision into institutional knowledge entry action DistilDecisionAction { decisionRecordId } = do record <- fetch decisionRecordId outcomes <- sqlQuery "SELECT os.signal_type, os.value FROM outcome_signals os \ \ JOIN deployment_records dep ON dep.id = os.deployment_id \ \ WHERE dep.decision_id = ?" [decisionRecordId] :: IO [(Text, Maybe Double)] let signalText = intercalate ", " $ map (\(st, mv) -> st <> maybe "" (\v -> "=" <> show v) mv) outcomes prompt = "Distil this decision into a 2-3 sentence institutional knowledge entry. " <> "Include the outcome data.\n\nDecision: " <> record.title <> "\nRationale: " <> record.rationale <> "\nOutcome: " <> record.outcome <> "\nSignals: " <> signalText -- Resolve hub from requirement chain mHubId <- case record.requirementId of Nothing -> pure Nothing Just rid -> do mReq <- fetchOneOrNothing rid pure $ case mReq >>= (.sourceWidgetId) of Nothing -> Nothing Just _ -> Nothing -- hub resolution via widget lookup below mHubIdResolved <- case record.requirementId of Nothing -> pure Nothing Just rid -> do mReq <- fetchOneOrNothing rid case mReq >>= (.sourceWidgetId) of Nothing -> pure Nothing Just wid -> fmap (.hubId) <$> fetchOneOrNothing @Widget wid case mHubIdResolved of Nothing -> do setErrorMessage "Cannot resolve hub — ensure decision has a linked requirement with a source widget" redirectTo ShowDecisionRecordAction { decisionRecordId } Just hubId -> do mAgent <- resolveAgent hubId "synthesis" case mAgent of Nothing -> do setErrorMessage "No routing policy for 'synthesis' task type" redirectTo ShowDecisionRecordAction { decisionRecordId } Just agent -> do result <- liftIO $ callAgent agent prompt case result of Left err -> do setErrorMessage ("Distillation failed: " <> bridgeErrorMessage err) redirectTo ShowDecisionRecordAction { decisionRecordId } Right resp -> do newRecord @InstitutionalKnowledgeEntry |> set #hubId hubId |> set #decisionRecordId (Just decisionRecordId) |> set #summary resp.content |> set #tags (A.toJSON ["decision" :: Text]) |> createRecord setSuccessMessage "Knowledge entry created" redirectTo ShowDecisionRecordAction { decisionRecordId }