Process.hs

{-# LANGUAGE DeriveAnyClass #-}
{-# OPTIONS_GHC -Wno-missing-signatures #-}
-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 6) from process reaction IncidentEscalation; do not edit.
module Generated.IncidentResponse.IncidentEscalation.Process
  ( IncidentEscalationInput (..)
  , incidentEscalationProcessName
  , incidentEscalationCategory
  , incidentEscalationProcessWorkerOptions
  , incidentEscalationReactionVersion
  , incidentEscalationReactionFingerprint
  , incidentEscalationReact
  , incidentEscalationProcessManager
  , incidentEscalationRunProcessWorker
  , EscalationPayload (..)
  , incidentEscalationEscalationTimerRequest
  , incidentEscalationTimerWorkerOptions
  , incidentEscalationFireTimer
  ) where

import Data.Text (Text)
import Data.Aeson (FromJSON, ToJSON)
import Data.Aeson qualified as Aeson
import Data.ByteString qualified as BS
import Data.Text qualified as T
import Data.Text.Encoding (encodeUtf8)
import Data.Time (UTCTime, addUTCTime)
import Data.UUID (UUID)
import Data.UUID.V5 qualified as UUID.V5
import GHC.Generics (Generic)
import Numeric.Natural (Natural)
import Generated.IncidentResponse.IncidentEscalation.Input (IncidentEscalationInput (..))
import IncidentResponse.IncidentEscalation.ProcessHoles (decodeIncidentEscalationInput)
import Generated.IncidentResponse.Escalation.Domain qualified as Saga
import Generated.IncidentResponse.Escalation.EventStream (escalationEventStream, EscalationEventStreamDef)
import Generated.IncidentResponse.Incident.Domain qualified as Target
import Generated.IncidentResponse.Incident.EventStream (incidentCategory, incidentCommandCategory, incidentEventStream)
import Generated.IncidentResponse.Nominals qualified as N
import Keiro.Command (DomainCommandHandler (..), SilentDomainDecision (..))
import Keiro.Command (CommandError (..), RunCommandOptions (..), runCommand)
import Keiro.ProcessManager (PMCommand (..), confirmBenignDuplicate)
import Keiro.ProcessManager.Reaction qualified as Reaction
import Keiro.Stream qualified as Stream
import Keiro.DeterministicId (identitySeedBytes)
import Keiro.Timer (TimerId (..), TimerRequest (..), TimerWorkerOptions (..))
import Kiroku.Store.Types (EventId (..))
import Keiro.ProcessManager (PoisonPolicy (..), RejectedCommandPolicy (..), WorkerOptions (..))
import Shibuya.Core.Ack (RetryDelay (..))

data EscalationPayload = EscalationPayload
  { kind :: !Text
  , incidentId :: !N.IncidentId
  , severity :: !N.Severity
  }
  deriving stock (Generic, Eq, Show)
  deriving anyclass (FromJSON, ToJSON)

incidentEscalationEscalationTimerRequest :: Text -> UTCTime -> N.IncidentId -> N.Severity -> TimerRequest
incidentEscalationEscalationTimerRequest correlationId fireAtTime payloadIncidentId payloadSeverity =
  TimerRequest
    { timerId = TimerId (reactionIdentity "incident-escalation-timer:" correlationId)
    , processManagerName = incidentEscalationProcessName
    , correlationId = correlationId
    , fireAt = fireAtTime
    , payload = Aeson.toJSON (EscalationPayload { kind = "escalation", incidentId = payloadIncidentId, severity = payloadSeverity })
    }

incidentEscalationProcessName :: Text
incidentEscalationProcessName = "incident-escalation"

incidentEscalationCategory :: Stream.StreamCategory EscalationEventStreamDef
incidentEscalationCategory = Stream.categoryUnsafe "escalation"

incidentEscalationProcessWorkerOptions :: WorkerOptions es msg
incidentEscalationProcessWorkerOptions =
  WorkerOptions
    { poisonPolicy = PoisonHalt,
      rejectedCommandPolicy = RejectedHalt,
      transientRetryDelay = RetryDelay 5, -- matches defaultWorkerOptions; runtime tuning
      metrics = Nothing -- runtime configuration; install at call site
    }

incidentEscalationTimerWorkerOptions :: TimerWorkerOptions
incidentEscalationTimerWorkerOptions =
  TimerWorkerOptions
    { maxAttempts = Just 5
    , requeueStuckAfter = Just 300
    }
-- Operator dead-letter guidance: "escalation timer exceeded ceiling"

incidentEscalationReactionVersion :: Natural
incidentEscalationReactionVersion = 1

incidentEscalationReactionFingerprint :: Text
incidentEscalationReactionFingerprint = "74ccfa3e3e78a8d747546629dce80be851ec3dd2babbd7ddea34b0746f19c7c7"

incidentEscalationCorrelate :: IncidentEscalationInput -> Text
incidentEscalationCorrelate input = case input of
  IncidentReported { incidentId } -> (N.incidentIdText incidentId)
  ResponderAcked { incidentId } -> (N.incidentIdText incidentId)
  ResponderIgnored { incidentId } -> (N.incidentIdText incidentId)
  IncidentNoted { incidentId } -> (N.incidentIdText incidentId)

incidentEscalationReact :: IncidentEscalationInput -> Reaction.ReactionPlan Saga.EscalationCommand Target.IncidentCommand
incidentEscalationReact input = case input of
  IncidentReported { incidentId, severity, raisedAt }
    | (severity == N.Sev1) -> Reaction.AdvanceReaction { command = Saga.NoteRaised (Saga.NoteRaisedData { Saga.incidentId = incidentId }), followUps = [Reaction.FollowSchedule Reaction.Rearm (incidentEscalationEscalationTimerRequest (N.incidentIdText incidentId) (addUTCTime 300 raisedAt) incidentId severity)], onAccepted = [] }
    | otherwise -> Reaction.AdvanceReaction { command = Saga.NoteRaised (Saga.NoteRaisedData { Saga.incidentId = incidentId }), followUps = [Reaction.FollowSchedule Reaction.Rearm (incidentEscalationEscalationTimerRequest (N.incidentIdText incidentId) (addUTCTime 3600 raisedAt) incidentId severity)], onAccepted = [] }
  ResponderAcked { incidentId, ackedAt = _ackedAt }
    -> Reaction.AdvanceReaction { command = Saga.NoteAcknowledged (Saga.NoteAcknowledgedData { Saga.incidentId = incidentId }), followUps = [Reaction.FollowCancel (TimerId (reactionIdentity "incident-escalation-timer:" (N.incidentIdText incidentId)))], onAccepted = [Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText incidentId)) (Target.AcknowledgeIncident (Target.AcknowledgeIncidentData { Target.incidentId = incidentId })))] }
  ResponderIgnored { incidentId }
    -> Reaction.AdvanceReaction { command = Saga.NoteIgnored (Saga.NoteIgnoredData { Saga.incidentId = incidentId }), followUps = [Reaction.FollowCancel (TimerId (reactionIdentity "incident-escalation-timer:" (N.incidentIdText incidentId)))], onAccepted = [Reaction.FollowDispatch (PMCommand (Stream.entityStream incidentCommandCategory (N.incidentIdText incidentId)) (Target.AcknowledgeIncident (Target.AcknowledgeIncidentData { Target.incidentId = incidentId })))] }
  IncidentNoted {}
    -> Reaction.NoAdvance []

incidentEscalationProcessManager =
  Reaction.ReactiveProcessManager
    { name = incidentEscalationProcessName
    , correlate = incidentEscalationCorrelate
    , sagaHandler = DomainCommandHandler { eventStream = escalationEventStream, classifySilent = \_ -> SilentNoOp () }
    , streamFor = Stream.entityStream incidentEscalationCategory
    , targetEventStream = incidentEventStream
    , targetProjections = const []
    , react = incidentEscalationReact
    }

incidentEscalationRunProcessWorker options adapter =
  Reaction.runReactiveProcessManagerWorkerWith
    incidentEscalationProcessWorkerOptions
    options
    incidentEscalationProcessManager
    adapter
    (\event -> case decodeIncidentEscalationInput event of Nothing -> Nothing; Just input -> Just (event, input))

incidentEscalationFireTimer options timer
  | timer.timerId == TimerId (reactionIdentity "incident-escalation-timer:" timer.correlationId) = incidentEscalationEscalationFire options timer
  | otherwise = pure Nothing

incidentEscalationEscalationFire options timer
  | timer.processManagerName /= incidentEscalationProcessName = pure Nothing
  | otherwise =
      case (Aeson.fromJSON timer.payload :: Aeson.Result EscalationPayload) of
        Aeson.Error _ -> pure Nothing
        Aeson.Success decoded -> do
          let firedId = EventId (reactionIdentity "incident-escalation-fired:" timer.correlationId)
              target = Stream.entityStream incidentCategory timer.correlationId
          result <-
            runCommand
              (options { eventIds = [firedId] })
              incidentEventStream
              target
              (Target.EscalateIncident (Target.EscalateIncidentData { Target.incidentId = decoded.incidentId }))
          case result of
            Right {} -> pure (Just firedId)
            Left err -> do
              benign <- confirmBenignDuplicate (Stream.streamName target) firedId err
              pure $ if benign then Just firedId else case err of
                CommandRejected -> Just firedId
                CommandAmbiguous _ -> Nothing
                _ -> Nothing

reactionIdentity :: Text -> Text -> UUID
reactionIdentity prefix correlation =
  UUID.V5.generateNamed UUID.V5.namespaceURL (identitySeedBytes (T.concat (map field [prefix, correlation])))
  where
    field value = T.pack (show (BS.length (encodeUtf8 value))) <> ":" <> value