inter-hub/Web/Controller/DecisionRecords.hs

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 }