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)
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 }