module Web.Controller.HubRoutingRules where import Web.Types import Web.View.HubRoutingRules.Index import Web.View.HubRoutingRules.Show import Web.View.HubRoutingRules.New import Web.View.HubRoutingRules.Edit import Web.View.HubRoutingRules.RoutedCandidates import Generated.Types import IHP.Prelude import IHP.ControllerPrelude import Application.Helper.RoutingEngine (applyRoutingRules) import Application.Helper.TypeRegistry (validateWidgetType, validateAnnotationCategory) instance Controller HubRoutingRulesController where beforeAction = ensureIsUser action HubRoutingRulesAction = autoRefresh do rules <- query @HubRoutingRule |> orderByDesc #priority |> fetch hubs <- query @Hub |> fetch render IndexView { rules, hubs } action ShowHubRoutingRuleAction { hubRoutingRuleId } = do rule <- fetch hubRoutingRuleId sourceHub <- fetch rule.sourceHubId targetHub <- fetch rule.targetHubId render ShowView { rule, sourceHub, targetHub } action NewHubRoutingRuleAction = do let rule = newRecord @HubRoutingRule hubs <- query @Hub |> orderByAsc #name |> fetch render NewView { rule, hubs } action CreateHubRoutingRuleAction = do let rule = newRecord @HubRoutingRule hubs <- query @Hub |> orderByAsc #name |> fetch mMatchWidgetType <- paramOrNothing @Text "matchWidgetType" mMatchCategory <- paramOrNothing @Text "matchCategory" wtResult <- case mMatchWidgetType of { Nothing -> pure (Right ()); Just "" -> pure (Right ()); Just t -> liftIO (validateWidgetType t) } catResult <- case mMatchCategory of { Nothing -> pure (Right ()); Just "" -> pure (Right ()); Just c -> liftIO (validateAnnotationCategory c) } rule |> fill @'["sourceHubId","targetHubId","matchCategory","matchWidgetType","priority","notes"] |> validateField #sourceHubId nonEmpty |> validateField #targetHubId nonEmpty |> (case wtResult of { Left msg -> attachFailure #matchWidgetType msg; Right () -> id }) |> (case catResult of { Left msg -> attachFailure #matchCategory msg; Right () -> id }) |> ifValid \case Left r -> render NewView { rule = r, hubs } Right r -> do r <- createRecord r setSuccessMessage "Routing rule created" redirectTo ShowHubRoutingRuleAction { hubRoutingRuleId = r.id } action EditHubRoutingRuleAction { hubRoutingRuleId } = do rule <- fetch hubRoutingRuleId hubs <- query @Hub |> orderByAsc #name |> fetch render EditView { rule, hubs } action UpdateHubRoutingRuleAction { hubRoutingRuleId } = do rule <- fetch hubRoutingRuleId hubs <- query @Hub |> orderByAsc #name |> fetch mMatchWidgetType <- paramOrNothing @Text "matchWidgetType" mMatchCategory <- paramOrNothing @Text "matchCategory" wtResult <- case mMatchWidgetType of { Nothing -> pure (Right ()); Just "" -> pure (Right ()); Just t -> liftIO (validateWidgetType t) } catResult <- case mMatchCategory of { Nothing -> pure (Right ()); Just "" -> pure (Right ()); Just c -> liftIO (validateAnnotationCategory c) } rule |> fill @'["matchCategory","matchWidgetType","priority","notes"] |> (case wtResult of { Left msg -> attachFailure #matchWidgetType msg; Right () -> id }) |> (case catResult of { Left msg -> attachFailure #matchCategory msg; Right () -> id }) |> ifValid \case Left r -> render EditView { rule = r, hubs } Right r -> do updateRecord r setSuccessMessage "Routing rule updated" redirectTo ShowHubRoutingRuleAction { hubRoutingRuleId = r.id } action ActivateRoutingRuleAction { hubRoutingRuleId } = do rule <- fetch hubRoutingRuleId rule |> set #status "active" |> updateRecord setSuccessMessage "Rule activated" redirectTo HubRoutingRulesAction action DeactivateRoutingRuleAction { hubRoutingRuleId } = do rule <- fetch hubRoutingRuleId rule |> set #status "inactive" |> updateRecord setSuccessMessage "Rule deactivated" redirectTo HubRoutingRulesAction action RoutedCandidatesAction { hubId } = autoRefresh do hub <- fetch hubId candidates <- query @RequirementCandidate |> filterWhere (#routedToHubId, Just hubId) |> orderByDesc #createdAt |> fetch render RoutedCandidatesView { hub, candidates } action RouteNowAction { requirementCandidateId } = do candidate <- fetch requirementCandidateId widgets <- query @Widget |> fetch _ <- applyRoutingRules candidate widgets setSuccessMessage "Routing re-evaluated" redirectTo ShowRequirementCandidateAction { requirementCandidateId }