inter-hub-haskell/Web/Controller/FederatedPolicyOverlays.hs

module Web.Controller.FederatedPolicyOverlays where

import Web.Types
import Web.View.FederatedPolicyOverlays.Index
import Web.View.FederatedPolicyOverlays.Show
import Web.View.FederatedPolicyOverlays.New
import Web.View.FederatedPolicyOverlays.Edit
import Web.View.FederatedPolicyOverlays.PolicyComplianceDashboard
import Generated.Types
import IHP.Prelude
import IHP.ControllerPrelude

instance Controller FederatedPolicyOverlaysController where
    beforeAction = ensureIsUser

    action FederatedPolicyOverlaysAction = autoRefresh do
        overlays <- query @FederatedPolicyOverlay |> orderByDesc #createdAt |> fetch
        hubs     <- query @Hub |> fetch
        render IndexView { overlays, hubs }

    action ShowFederatedPolicyOverlayAction { federatedPolicyOverlayId } = do
        overlay <- fetch federatedPolicyOverlayId
        hubs    <- query @Hub |> fetch
        render ShowView { overlay, hubs }

    action NewFederatedPolicyOverlayAction = do
        let overlay = newRecord @FederatedPolicyOverlay
        hubs <- query @Hub |> orderByAsc #name |> fetch
        render NewView { overlay, hubs }

    action CreateFederatedPolicyOverlayAction = do
        let overlay = newRecord @FederatedPolicyOverlay
        hubs <- query @Hub |> orderByAsc #name |> fetch
        overlay
            |> fill @'["title","policyText","appliesToHubs","notes"]
            |> validateField #title nonEmpty
            |> validateField #policyText nonEmpty
            |> ifValid \case
                Left o  -> render NewView { overlay = o, hubs }
                Right o -> do
                    o <- createRecord o
                    setSuccessMessage "Policy overlay created"
                    redirectTo ShowFederatedPolicyOverlayAction { federatedPolicyOverlayId = o.id }

    action EditFederatedPolicyOverlayAction { federatedPolicyOverlayId } = do
        overlay <- fetch federatedPolicyOverlayId
        when (overlay.status /= "draft") do
            setErrorMessage "Activated overlays cannot be edited"
            redirectTo ShowFederatedPolicyOverlayAction { federatedPolicyOverlayId }
        hubs <- query @Hub |> orderByAsc #name |> fetch
        render EditView { overlay, hubs }

    action UpdateFederatedPolicyOverlayAction { federatedPolicyOverlayId } = do
        overlay <- fetch federatedPolicyOverlayId
        hubs <- query @Hub |> orderByAsc #name |> fetch
        when (overlay.status /= "draft") do
            setErrorMessage "Activated overlays cannot be edited"
            redirectTo ShowFederatedPolicyOverlayAction { federatedPolicyOverlayId }
        overlay
            |> fill @'["title","policyText","appliesToHubs","notes"]
            |> validateField #title nonEmpty
            |> validateField #policyText nonEmpty
            |> ifValid \case
                Left o  -> render EditView { overlay = o, hubs }
                Right o -> do
                    updateRecord o
                    setSuccessMessage "Policy overlay updated"
                    redirectTo ShowFederatedPolicyOverlayAction { federatedPolicyOverlayId = o.id }

    action ActivateFederatedPolicyAction { federatedPolicyOverlayId } = do
        overlay <- fetch federatedPolicyOverlayId
        now <- getCurrentTime
        overlay
            |> set #status "active"
            |> set #enforcedFrom (Just now)
            |> updateRecord
        setSuccessMessage "Policy overlay activated"
        redirectTo ShowFederatedPolicyOverlayAction { federatedPolicyOverlayId }

    action RetireFederatedPolicyAction { federatedPolicyOverlayId } = do
        overlay <- fetch federatedPolicyOverlayId
        overlay |> set #status "retired" |> updateRecord
        setSuccessMessage "Policy overlay retired"
        redirectTo FederatedPolicyOverlaysAction

    action PolicyComplianceDashboardAction = autoRefresh do
        overlays   <- query @FederatedPolicyOverlay |> filterWhere (#status, "active") |> fetch
        hubs       <- query @Hub |> fetch
        decisions  <- query @DecisionRecord |> fetch
        policies   <- query @PolicyReference |> fetch
        render PolicyComplianceDashboardView { overlays, hubs, decisions, policies }