-- SPDX-FileCopyrightText: 2026 Alexandra de Wit
--
-- SPDX-License-Identifier: MIT

{- | The circuit-breaker state machine fronting a call that can fail or hang: minting an
outbound credential, or consulting an effectful rule source.

Every transition takes the caller's @now@, so no wall clock is read here. The two policy
knobs, the trip threshold and the cooldown, are the caller's and reach 'recordFailure' per
call, and so are storage and concurrency. These functions only fold one state into the next.
-}
module Ecluse.Core.Breaker (
    Breaker (..),
    initialBreaker,
    admit,
    recordSuccess,
    recordFailure,

    -- * Observing transitions
    BreakerReporter (..),
    noBreakerReporter,
    reportBreakerChange,
    breakerState,
) where

import Data.Time (NominalDiffTime, UTCTime, addUTCTime)

import Ecluse.Core.Telemetry.Metrics qualified as Metric

-- | The breaker's state, gating whether the guarded operation may be attempted.
data Breaker
    = -- | Healthy: the consecutive-failure count so far, up to the trip threshold.
      Closed Int
    | -- | Tripped until the given instant: attempts fast-fail until then.
      Open UTCTime
    | -- | Cooldown elapsed: 'admit' lets one probe attempt through to test recovery.
      HalfOpen
    deriving stock (Breaker -> Breaker -> Bool
(Breaker -> Breaker -> Bool)
-> (Breaker -> Breaker -> Bool) -> Eq Breaker
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Breaker -> Breaker -> Bool
== :: Breaker -> Breaker -> Bool
$c/= :: Breaker -> Breaker -> Bool
/= :: Breaker -> Breaker -> Bool
Eq, Int -> Breaker -> ShowS
[Breaker] -> ShowS
Breaker -> String
(Int -> Breaker -> ShowS)
-> (Breaker -> String) -> ([Breaker] -> ShowS) -> Show Breaker
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Breaker -> ShowS
showsPrec :: Int -> Breaker -> ShowS
$cshow :: Breaker -> String
show :: Breaker -> String
$cshowList :: [Breaker] -> ShowS
showList :: [Breaker] -> ShowS
Show)

-- | A fresh, healthy breaker with no failures recorded.
initialBreaker :: Breaker
initialBreaker :: Breaker
initialBreaker = Int -> Breaker
Closed Int
0

{- | Decide whether the guarded operation may be attempted at @now@. The caller must commit the
returned breaker state, or the move from 'Open' to 'HalfOpen' never takes effect.
-}
admit :: UTCTime -> Breaker -> (Bool, Breaker)
admit :: UTCTime -> Breaker -> (Bool, Breaker)
admit UTCTime
now = \case
    Open UTCTime
until' | UTCTime
now UTCTime -> UTCTime -> Bool
forall a. Ord a => a -> a -> Bool
< UTCTime
until' -> (Bool
False, UTCTime -> Breaker
Open UTCTime
until')
    Open UTCTime
_ -> (Bool
True, Breaker
HalfOpen)
    Breaker
healthy -> (Bool
True, Breaker
healthy)

-- | Fold a successful attempt into the breaker: reset it to healthy from any state.
recordSuccess :: Breaker -> Breaker
recordSuccess :: Breaker -> Breaker
recordSuccess Closed{} = Breaker
initialBreaker
recordSuccess Open{} = Breaker
initialBreaker
recordSuccess Breaker
HalfOpen = Breaker
initialBreaker

{- | Fold a failed attempt into the breaker, given the caller's trip @threshold@ and @cooldown@.
A 'Closed' breaker counts up and trips at the threshold, and any other state opens a fresh cooldown.
-}
recordFailure :: Int -> NominalDiffTime -> UTCTime -> Breaker -> Breaker
recordFailure :: Int -> NominalDiffTime -> UTCTime -> Breaker -> Breaker
recordFailure Int
threshold NominalDiffTime
cooldown UTCTime
now = \case
    Closed Int
n | Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
threshold -> Breaker
tripped
    Closed Int
n -> Int -> Breaker
Closed (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
    Open{} -> Breaker
tripped
    Breaker
HalfOpen -> Breaker
tripped
  where
    tripped :: Breaker
tripped = UTCTime -> Breaker
Open (NominalDiffTime -> UTCTime -> UTCTime
addUTCTime NominalDiffTime
cooldown UTCTime
now)

{- | An observer of breaker state changes. The callback takes the breaker itself, so no
instrument handle reaches here, and the composition root installs the live observer.
-}
newtype BreakerReporter = BreakerReporter (Breaker -> IO ())

-- | The inert reporter: discards the state, recording nothing.
noBreakerReporter :: BreakerReporter
noBreakerReporter :: BreakerReporter
noBreakerReporter = (Breaker -> IO ()) -> BreakerReporter
BreakerReporter (IO () -> Breaker -> IO ()
forall a b. a -> b -> a
const IO ()
forall (f :: * -> *). Applicative f => f ()
pass)

{- | Report a transition through the observer, but only when @old@ and @new@ differ observably.
The failure tally inside 'Closed' is not observable, so advancing it alone fires nothing.
-}
reportBreakerChange :: BreakerReporter -> Breaker -> Breaker -> IO ()
reportBreakerChange :: BreakerReporter -> Breaker -> Breaker -> IO ()
reportBreakerChange (BreakerReporter Breaker -> IO ()
report) Breaker
old Breaker
new
    | Breaker -> BreakerState
breakerState Breaker
old BreakerState -> BreakerState -> Bool
forall a. Eq a => a -> a -> Bool
== Breaker -> BreakerState
breakerState Breaker
new = IO ()
forall (f :: * -> *). Applicative f => f ()
pass
    | Bool
otherwise = Breaker -> IO ()
report Breaker
new

{- | The breaker's coarse observable state, the bounded value the @ecluse.rule.breaker.state@
gauge records. It drops the failure tally, so two 'Closed' breakers project alike.
-}
breakerState :: Breaker -> Metric.BreakerState
breakerState :: Breaker -> BreakerState
breakerState = \case
    Closed{} -> BreakerState
Metric.Closed
    Breaker
HalfOpen -> BreakerState
Metric.HalfOpen
    Open{} -> BreakerState
Metric.Open