Inbox.hs

{-# LANGUAGE OverloadedStrings #-}
-- @generated by keiro-dsl 0.8.0.0 (language keiro-dsl 4) from intake incidentInbox; do not edit.
module Generated.HospitalCapacity.IncidentInbox.Inbox
  ( InboxFailure (..)
  , IncidentInboxOutcome (..)
  , IncidentInboxDisposition (..)
  , inboxDedupePolicy
  , inboxPersistence
  , inboxDispositionFor
  , inboxDisposition
  ) where

import Data.Text (Text)
import Keiro.Inbox.Types (InboxDedupePolicy (..), InboxPersistence (..), InboxResult (..), RetryDelay (..))

-- The dedupe policy (hole-kind 4), lowered to the live InboxDedupePolicy.
inboxDedupePolicy :: InboxDedupePolicy
inboxDedupePolicy = PreferIntegrationMessageId

-- | Success-path envelope retention passed to runInboxTransactionWith.
-- Failures always retain their full operator-facing dead-letter envelope.
-- Dedupe-only success rows decode with an empty payload.
inboxPersistence :: InboxPersistence
inboxPersistence = PersistDedupeOnly

-- Runtime failure detail retained when the inbox wrapper reports a failed handler attempt.
data InboxFailure = InboxFailure
  { inboxFailureReason :: !Text
  , inboxFailureAttempt :: !(Maybe Int)
  }
  deriving stock (Eq, Show)

-- Every classification named by the spec. Keeping this closed makes the
-- generated table exhaustive and gives handler holes typed inputs.
data IncidentInboxOutcome
  = IncidentInboxProcessed
  | IncidentInboxDuplicate
  | IncidentInboxInProgress
  | IncidentInboxPreviouslyFailed
  | IncidentInboxDecodeFailed
  | IncidentInboxDedupeFailed
  | IncidentInboxStoreFailed
  deriving stock (Eq, Show)

-- The service's declared acknowledgement decision, including its details.
data IncidentInboxDisposition
  = InboxAccept
  | InboxRetryAfter !RetryDelay !(Maybe InboxFailure)
  | InboxDeadLetter !(Maybe Text) !(Maybe InboxFailure)
  deriving stock (Eq, Show)

-- The complete disposition table (hole-kind 2).
inboxDispositionFor :: IncidentInboxOutcome -> IncidentInboxDisposition
inboxDispositionFor outcome = case outcome of
  IncidentInboxProcessed -> InboxAccept
  IncidentInboxDuplicate -> InboxAccept
  IncidentInboxInProgress -> InboxRetryAfter (RetryDelay 5) Nothing
  IncidentInboxPreviouslyFailed -> InboxDeadLetter (Just "previous inbox failure") Nothing
  IncidentInboxDecodeFailed -> InboxDeadLetter Nothing Nothing
  IncidentInboxDedupeFailed -> InboxDeadLetter Nothing Nothing
  IncidentInboxStoreFailed -> InboxRetryAfter (RetryDelay 5) Nothing

-- Lower the LIVE Keiro.Inbox.Types.InboxResult without an open fallback.
inboxDisposition :: InboxResult a -> IncidentInboxDisposition
inboxDisposition r = case r of
  InboxProcessed _ -> inboxDispositionFor IncidentInboxProcessed
  InboxDuplicate -> inboxDispositionFor IncidentInboxDuplicate
  InboxInProgress -> inboxDispositionFor IncidentInboxInProgress
  InboxPreviouslyFailed failureReason ->
    maybe (inboxDispositionFor IncidentInboxPreviouslyFailed)
      (\reason -> attachFailure (InboxFailure reason Nothing) (inboxDispositionFor IncidentInboxPreviouslyFailed))
      failureReason
  InboxHandlerFailed reason attempts ->
    attachFailure (InboxFailure reason (Just attempts)) (inboxDispositionFor IncidentInboxStoreFailed)

attachFailure :: InboxFailure -> IncidentInboxDisposition -> IncidentInboxDisposition
attachFailure failure disposition = case disposition of
  InboxRetryAfter delay _ -> InboxRetryAfter delay (Just failure)
  InboxDeadLetter reason _ -> InboxDeadLetter reason (Just failure)
  InboxAccept -> InboxAccept