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