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

{- | The graceful-shutdown drain vocabulary: the one-way 'DrainSignal' the front
door observes on every request, and the bound on how long a drain may run.
"Ecluse.Runtime.Server"'s 'runWarp' raises the signal from the OS shutdown handler.
The readiness probe and the going-away middleware
("Ecluse.Runtime.Server.Middleware") read it.
-}
module Ecluse.Runtime.Server.Drain (
    DrainSignal,
    newDrainSignal,
    neverDraining,
    beginDrain,
    isDraining,
    ShutdownDrainTimeout (..),
    defaultShutdownDrainTimeout,
) where

{- | The shutdown-drain flag the front door observes during a graceful rollover. Nothing
lowers it again. The readiness probe and the going-away middleware read it per request.
-}
data DrainSignal = DrainSignal
    { DrainSignal -> STM Bool
drainState :: STM Bool
    -- ^ Whether the instance is draining: 'False' while serving, 'True' once raised.
    , DrainSignal -> STM ()
drainRaise :: STM ()
    -- ^ Raise the flag. Idempotent: a second raise is a no-op.
    }

{- | Allocate a live drain signal, lowered. @runWarp@ allocates one per launch and raises
it from the shutdown signal handler.
-}
newDrainSignal :: IO DrainSignal
newDrainSignal :: IO DrainSignal
newDrainSignal = do
    tvar <- Bool -> IO (TVar Bool)
forall (m :: * -> *) a. MonadIO m => a -> m (TVar a)
newTVarIO Bool
False
    pure
        DrainSignal
            { drainState = readTVar tvar
            , drainRaise = writeTVar tvar True
            }

{- | The inert drain signal: permanently lowered, and raising it does nothing. It is the
@mkServerConfig@ default, so a socket-free test reports ready and stamps no going-away header.
-}
neverDraining :: DrainSignal
neverDraining :: DrainSignal
neverDraining =
    DrainSignal
        { drainState :: STM Bool
drainState = Bool -> STM Bool
forall a. a -> STM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
        , drainRaise :: STM ()
drainRaise = () -> STM ()
forall a. a -> STM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
        }

-- | Raise a drain signal: the one-way transition into draining. Idempotent.
beginDrain :: DrainSignal -> IO ()
beginDrain :: DrainSignal -> IO ()
beginDrain = STM () -> IO ()
forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically (STM () -> IO ())
-> (DrainSignal -> STM ()) -> DrainSignal -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DrainSignal -> STM ()
drainRaise

-- | Read whether a drain signal is raised.
isDraining :: DrainSignal -> IO Bool
isDraining :: DrainSignal -> IO Bool
isDraining = STM Bool -> IO Bool
forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically (STM Bool -> IO Bool)
-> (DrainSignal -> STM Bool) -> DrainSignal -> IO Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DrainSignal -> STM Bool
drainState

{- | The bound on the graceful drain, in seconds. The server stops accepting connections,
waits this long for in-flight requests and artifact streams, then exits regardless.
-}
newtype ShutdownDrainTimeout = ShutdownDrainTimeout Int
    deriving stock (ShutdownDrainTimeout -> ShutdownDrainTimeout -> Bool
(ShutdownDrainTimeout -> ShutdownDrainTimeout -> Bool)
-> (ShutdownDrainTimeout -> ShutdownDrainTimeout -> Bool)
-> Eq ShutdownDrainTimeout
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ShutdownDrainTimeout -> ShutdownDrainTimeout -> Bool
== :: ShutdownDrainTimeout -> ShutdownDrainTimeout -> Bool
$c/= :: ShutdownDrainTimeout -> ShutdownDrainTimeout -> Bool
/= :: ShutdownDrainTimeout -> ShutdownDrainTimeout -> Bool
Eq, Int -> ShutdownDrainTimeout -> ShowS
[ShutdownDrainTimeout] -> ShowS
ShutdownDrainTimeout -> String
(Int -> ShutdownDrainTimeout -> ShowS)
-> (ShutdownDrainTimeout -> String)
-> ([ShutdownDrainTimeout] -> ShowS)
-> Show ShutdownDrainTimeout
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ShutdownDrainTimeout -> ShowS
showsPrec :: Int -> ShutdownDrainTimeout -> ShowS
$cshow :: ShutdownDrainTimeout -> String
show :: ShutdownDrainTimeout -> String
$cshowList :: [ShutdownDrainTimeout] -> ShowS
showList :: [ShutdownDrainTimeout] -> ShowS
Show)

{- | The default graceful-drain bound: 30 seconds. It covers an in-flight metadata fetch or
a moderate artifact stream, and stops a stuck request pinning the old instance.
-}
defaultShutdownDrainTimeout :: ShutdownDrainTimeout
defaultShutdownDrainTimeout :: ShutdownDrainTimeout
defaultShutdownDrainTimeout = Int -> ShutdownDrainTimeout
ShutdownDrainTimeout Int
30