Inbox.hs

{-# LANGUAGE OverloadedStrings #-}
-- @generated by keiro-dsl 0.8.0.0 (language keiro-dsl 4) from intake thingInbox; do not edit.
module SkelIntake.Generated.MyService.ThingInbox.Inbox
  ( InboxFailure (..)
  , ThingInboxOutcome (..)
  , ThingInboxDisposition (..)
  , 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 = PersistFullEnvelope

-- 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 ThingInboxOutcome
  = ThingInboxProcessed
  | ThingInboxDuplicate
  | ThingInboxInProgress
  | ThingInboxPreviouslyFailed
  | ThingInboxDecodeFailed
  | ThingInboxDedupeFailed
  | ThingInboxStoreFailed
  deriving stock (Eq, Show)

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

-- The complete disposition table (hole-kind 2).
inboxDispositionFor :: ThingInboxOutcome -> ThingInboxDisposition
inboxDispositionFor outcome = case outcome of
  ThingInboxProcessed -> InboxAccept
  ThingInboxDuplicate -> InboxAccept
  ThingInboxInProgress -> InboxRetryAfter (RetryDelay 5) Nothing
  ThingInboxPreviouslyFailed -> InboxDeadLetter (Just "previous inbox failure") Nothing
  ThingInboxDecodeFailed -> InboxDeadLetter Nothing Nothing
  ThingInboxDedupeFailed -> InboxDeadLetter Nothing Nothing
  ThingInboxStoreFailed -> InboxRetryAfter (RetryDelay 5) Nothing

-- Lower the LIVE Keiro.Inbox.Types.InboxResult without an open fallback.
inboxDisposition :: InboxResult a -> ThingInboxDisposition
inboxDisposition r = case r of
  InboxProcessed _ -> inboxDispositionFor ThingInboxProcessed
  InboxDuplicate -> inboxDispositionFor ThingInboxDuplicate
  InboxInProgress -> inboxDispositionFor ThingInboxInProgress
  InboxPreviouslyFailed failureReason ->
    maybe (inboxDispositionFor ThingInboxPreviouslyFailed)
      (\reason -> attachFailure (InboxFailure reason Nothing) (inboxDispositionFor ThingInboxPreviouslyFailed))
      failureReason
  InboxHandlerFailed reason attempts ->
    attachFailure (InboxFailure reason (Just attempts)) (inboxDispositionFor ThingInboxStoreFailed)

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