-- 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 shared shutdown-drain flag the front door observes during a graceful
rollover, as a small handle (a reader plus a one-way raise) rather than a bare
'TVar' -- so the same field can hold either a live, flip-once signal ('newDrainSignal')
or the inert 'neverDraining' constant the socket-free tests assemble against, and
nothing downstream can lower it back. It is raised once, on a shutdown signal, and
read on every request by the readiness probe and the going-away middleware.
-}
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, lowered shutdown-drain signal backed by a 'TVar'. @runWarp@
allocates one per launch, hands it to the @application@ builder through the
'ServerConfig' it passes, and flips it from the signal handler, so the readiness
probe and the going-away middleware read the very same signal the instant the handler
raises it.
-}
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, raising it is a no-op. The
@mkServerConfig@ default, so an @application@ assembled for a socket-free test (and
one driven without ever entering shutdown) reports ready and adds no going-away
header. A real launch overrides it with 'newDrainSignal' in @runWarp@.
-}
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: how many seconds the server waits for
in-flight requests and in-progress artifact streams to finish after it stops
accepting new connections, before the process exits regardless. A @newtype@ so a
raw seconds count is not mistaken for some other 'Int', and so a non-positive value
cannot be passed where a positive timeout is meant (see @runWarp@).
-}
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. Long enough for an in-flight
metadata fetch or a moderate artifact stream to complete during a rolling deploy,
short enough that a stuck request cannot pin the old instance indefinitely.
-}
defaultShutdownDrainTimeout :: ShutdownDrainTimeout
defaultShutdownDrainTimeout :: ShutdownDrainTimeout
defaultShutdownDrainTimeout = Int -> ShutdownDrainTimeout
ShutdownDrainTimeout Int
30