38 lines
1.4 KiB
Haskell
38 lines
1.4 KiB
Haskell
|
|
module Web.Controller.CrossHubPropagations where
|
||
|
|
|
||
|
|
import Web.Types
|
||
|
|
import Web.View.CrossHubPropagations.Index
|
||
|
|
import Generated.Types
|
||
|
|
import IHP.Prelude
|
||
|
|
import IHP.ControllerPrelude
|
||
|
|
import Application.Helper.CrossHubPropagation (detectPropagations)
|
||
|
|
|
||
|
|
instance Controller CrossHubPropagationsController where
|
||
|
|
beforeAction = ensureIsUser
|
||
|
|
|
||
|
|
action CrossHubPropagationsAction = autoRefresh do
|
||
|
|
propagations <- query @CrossHubPropagation
|
||
|
|
|> orderByDesc #detectedAt
|
||
|
|
|> fetch
|
||
|
|
hubs <- query @Hub |> fetch
|
||
|
|
render IndexView { propagations, hubs }
|
||
|
|
|
||
|
|
action DetectPropagationsAction = do
|
||
|
|
hubs <- query @Hub |> fetch
|
||
|
|
widgets <- query @Widget |> fetch
|
||
|
|
annotations <- query @Annotation |> fetch
|
||
|
|
frictionScores <- query @FrictionScore |> fetch
|
||
|
|
_ <- detectPropagations hubs annotations widgets frictionScores
|
||
|
|
setSuccessMessage "Propagation detection complete"
|
||
|
|
redirectTo CrossHubPropagationsAction
|
||
|
|
|
||
|
|
action AcknowledgePropagationAction { crossHubPropagationId } = do
|
||
|
|
p <- fetch crossHubPropagationId
|
||
|
|
p |> set #status "acknowledged" |> updateRecord
|
||
|
|
redirectTo CrossHubPropagationsAction
|
||
|
|
|
||
|
|
action ResolvePropagationAction { crossHubPropagationId } = do
|
||
|
|
p <- fetch crossHubPropagationId
|
||
|
|
p |> set #status "resolved" |> updateRecord
|
||
|
|
redirectTo CrossHubPropagationsAction
|