inter-hub-haskell/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, 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 }