packages feed

shibuya-core-0.10.0.0: src/Shibuya/Policy.hs

-- | OrderingPolicy and concurrency policies.
-- Runner policy that maps ordering guarantees to concurrency constraints.
module Shibuya.Policy
  ( -- * OrderingPolicy
    OrderingPolicy (..),

    -- * Concurrency
    Concurrency (..),

    -- * Validation
    validatePolicy,
  )
where

import Shibuya.Core.Error (PolicyError (..))
import Shibuya.Prelude

-- | Message ordering guarantees.
data OrderingPolicy
  = -- | Event-sourced subscriptions - must be Serial
    StrictInOrder
  | -- | Kafka-style ordering: messages with the same partition key are
    -- processed and acknowledged in arrival order, while distinct partitions
    -- may run concurrently. Messages without a partition key are unconstrained.
    PartitionedInOrder
  | -- | No ordering guarantees
    Unordered
  deriving stock (Eq, Show, Generic)

-- | Concurrency mode.
data Concurrency
  = -- | One message at a time
    Serial
  | -- | Process up to N messages concurrently. Stream results are yielded
    -- downstream in input order, but handler execution and acknowledgement run
    -- concurrently and may complete in any order. Since Shibuya discards the
    -- per-message result, this ordered yielding is not observable as ordered
    -- side effects or ordered acks.
    Ahead !Int
  | -- | Process N concurrently
    Async !Int
  deriving stock (Eq, Show, Generic)

-- | Validate policy combinations.
-- Invariant: StrictInOrder => Serial
validatePolicy :: OrderingPolicy -> Concurrency -> Either PolicyError ()
validatePolicy ordering concurrency = do
  validateConcurrency concurrency
  validateCombination ordering concurrency
  where
    validateConcurrency Serial = Right ()
    validateConcurrency (Ahead n) = validateBound n
    validateConcurrency (Async n) = validateBound n

    validateBound n
      | n < 1 = Left $ InvalidConcurrency n
      | n > maxBound `div` 2 = Left $ ConcurrencyCapacityOverflow n
      | otherwise = Right ()

    validateCombination StrictInOrder (Ahead _) =
      Left $ InvalidPolicyCombo "StrictInOrder requires Serial concurrency"
    validateCombination StrictInOrder (Async _) =
      Left $ InvalidPolicyCombo "StrictInOrder requires Serial concurrency"
    validateCombination _ _ = Right ()