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

{- | The composition root's mirror-queue backend selection: the pure decision of
which queue this binary builds and the boot warnings the choice warrants.

'planMirrorQueue' is the single place that knows which backends this binary can
build; the composition root pattern-matches its 'MirrorQueuePlan' to make the one
constructor call, and 'mirrorQueuePlanWarning' tells it whether a boot warning is
due. Failures aggregate as 'Ecluse.Composition.BootError.BootError's, so one run
reports every missing input. The SQS endpoint override is parsed by the shared
'Ecluse.Config.Ambient.parseEndpointUrl'.
-}
module Ecluse.Composition.MirrorQueue (
    MirrorRuntimePlan (..),
    planMirrorRuntime,
    MirrorQueuePlan (..),
    planMirrorQueue,
    mirrorQueuePlanWarning,
    memoryQueueBootWarning,
    memoryQueueDropWarning,
) where

import Data.Text qualified as T

import Ecluse.Composition.BootError (BootError (..))
import Ecluse.Config (
    AppConfig (..),
    Config (..),
    Mount (mountRegistries),
    QueueSettings (qsUrl),
    regMirrorTarget,
    unUrl,
 )
import Ecluse.Config.Ambient (AmbientAws (..), parseEndpointUrl)
import Ecluse.Config.QueueTarget (QueueTarget (..), parseQueueTarget)
import Ecluse.Core.Text (nonBlank)
import Ecluse.Runtime.Queue.Sqs (SqsConfig (sqsEndpoint), SqsEndpoint (..), defaultSqsConfig)

{- | Whether this deployment runs a mirror runtime at all: with zero mirroring
mounts there is no queue to build and no worker to start ('NoMirroring'), and the
queue configuration is not even consulted, so a serve-only deployment boots with no
queue variables under the shipped @sqs@ default. With at least one mirroring mount,
exactly today's queue selection applies ('MirrorWith').
-}
data MirrorRuntimePlan
    = -- | No mount mirrors: no queue, no enqueue buffer, no worker.
      NoMirroring
    | -- | At least one mount mirrors: build the planned queue backend.
      MirrorWith MirrorQueuePlan
    deriving stock (MirrorRuntimePlan -> MirrorRuntimePlan -> Bool
(MirrorRuntimePlan -> MirrorRuntimePlan -> Bool)
-> (MirrorRuntimePlan -> MirrorRuntimePlan -> Bool)
-> Eq MirrorRuntimePlan
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MirrorRuntimePlan -> MirrorRuntimePlan -> Bool
== :: MirrorRuntimePlan -> MirrorRuntimePlan -> Bool
$c/= :: MirrorRuntimePlan -> MirrorRuntimePlan -> Bool
/= :: MirrorRuntimePlan -> MirrorRuntimePlan -> Bool
Eq, Int -> MirrorRuntimePlan -> ShowS
[MirrorRuntimePlan] -> ShowS
MirrorRuntimePlan -> String
(Int -> MirrorRuntimePlan -> ShowS)
-> (MirrorRuntimePlan -> String)
-> ([MirrorRuntimePlan] -> ShowS)
-> Show MirrorRuntimePlan
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MirrorRuntimePlan -> ShowS
showsPrec :: Int -> MirrorRuntimePlan -> ShowS
$cshow :: MirrorRuntimePlan -> String
show :: MirrorRuntimePlan -> String
$cshowList :: [MirrorRuntimePlan] -> ShowS
showList :: [MirrorRuntimePlan] -> ShowS
Show)

{- | The one decision the composition root branches the mirror runtime on: derive
whether anything mirrors from the resolved mounts, and only then consult the queue
configuration ('planMirrorQueue'), so a serve-only deployment can never fail boot
over queue variables it does not need.
-}
planMirrorRuntime :: AmbientAws -> Config -> Either [BootError] MirrorRuntimePlan
planMirrorRuntime :: AmbientAws -> Config -> Either [BootError] MirrorRuntimePlan
planMirrorRuntime AmbientAws
ambient Config
config
    | Bool
noneMirror = MirrorRuntimePlan -> Either [BootError] MirrorRuntimePlan
forall a b. b -> Either a b
Right MirrorRuntimePlan
NoMirroring
    | Bool
otherwise = MirrorQueuePlan -> MirrorRuntimePlan
MirrorWith (MirrorQueuePlan -> MirrorRuntimePlan)
-> Either [BootError] MirrorQueuePlan
-> Either [BootError] MirrorRuntimePlan
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AmbientAws -> AppConfig -> Either [BootError] MirrorQueuePlan
planMirrorQueue AmbientAws
ambient (Config -> AppConfig
configApp Config
config)
  where
    noneMirror :: Bool
noneMirror = (Mount -> Bool) -> Map Ecosystem Mount -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Maybe MirrorTarget -> Bool
forall a. Maybe a -> Bool
isNothing (Maybe MirrorTarget -> Bool)
-> (Mount -> Maybe MirrorTarget) -> Mount -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MountRegistries -> Maybe MirrorTarget
regMirrorTarget (MountRegistries -> Maybe MirrorTarget)
-> (Mount -> MountRegistries) -> Mount -> Maybe MirrorTarget
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Mount -> MountRegistries
mountRegistries) (Config -> Map Ecosystem Mount
configMounts Config
config)

{- | Which mirror-queue backend the composition root will build, resolved from
config: the durable AWS @sqs@ backend (with its 'SqsConfig'), or the bounded
best-effort in-memory backend. The pure decision 'planMirrorQueue' yields; the
composition root pattern-matches it to make the one constructor call, and
'mirrorQueuePlanWarning' tells it whether a boot warning is due. Selection needs
no sizes: the in-memory backend's depth cap is a memory-plan tenant allocated
__after__ this choice (only the memory backend spends heap on queued jobs), so it
parametrises the build ('Ecluse.Boot.buildMirrorQueue'), never the plan.
-}
data MirrorQueuePlan
    = -- | The durable AWS SQS backend, built by @Ecluse.Runtime.Queue.Sqs.newSqsQueue@.
      SqsBackend SqsConfig
    | {- | The bounded in-memory backend, built by
      'Ecluse.Core.Queue.newBoundedInMemoryQueue'. Non-durable and best-effort -- boot warns.
      -}
      MemoryBackend
    deriving stock (MirrorQueuePlan -> MirrorQueuePlan -> Bool
(MirrorQueuePlan -> MirrorQueuePlan -> Bool)
-> (MirrorQueuePlan -> MirrorQueuePlan -> Bool)
-> Eq MirrorQueuePlan
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MirrorQueuePlan -> MirrorQueuePlan -> Bool
== :: MirrorQueuePlan -> MirrorQueuePlan -> Bool
$c/= :: MirrorQueuePlan -> MirrorQueuePlan -> Bool
/= :: MirrorQueuePlan -> MirrorQueuePlan -> Bool
Eq, Int -> MirrorQueuePlan -> ShowS
[MirrorQueuePlan] -> ShowS
MirrorQueuePlan -> String
(Int -> MirrorQueuePlan -> ShowS)
-> (MirrorQueuePlan -> String)
-> ([MirrorQueuePlan] -> ShowS)
-> Show MirrorQueuePlan
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MirrorQueuePlan -> ShowS
showsPrec :: Int -> MirrorQueuePlan -> ShowS
$cshow :: MirrorQueuePlan -> String
show :: MirrorQueuePlan -> String
$cshowList :: [MirrorQueuePlan] -> ShowS
showList :: [MirrorQueuePlan] -> ShowS
Show)

{- | Select the mirror-queue backend from the queue URL's shape and the ambient SDK
environment, yielding the 'MirrorQueuePlan' the composition root builds the queue
from, or the aggregated boot errors that block it.

This is the pure half of the queue's backend choice -- the single place that knows
which backends this binary can build. There is no backend selector: the operator
points @ECLUSE_QUEUE__URL@ at a destination and the backend is derived from its
shape ("Ecluse.Config.QueueTarget", the queue's counterpart of the mirror-credential
derivation), so a backend\/URL disagreement is unrepresentable. A real SQS queue
URL resolves to a 'SqsBackend' carrying its 'SqsConfig', with the region parsed
from the URL's own host (@AWS_REGION@ is not consulted for it); the composition
root passes that to @Ecluse.Runtime.Queue.Sqs.newSqsQueue@. A Pub\/Sub topic
resource names the GCP backend, which is recognised but not built, so it is a
fail-loud 'QueueProviderUnavailable' rather than a silent fall-through, and any
other shape is a fail-loud 'QueueUrlUnrecognised' naming the accepted forms. An
__absent__ @ECLUSE_QUEUE__URL@ rolls over to the bounded in-memory 'MemoryBackend'
(its depth cap is allocated by the memory plan after this selection, and
parametrises only the build): mirroring is demand-driven and self-healing (a job lost to
a restart re-enqueues on the next demand), so the rollover degrades durability,
never safety, and the composition root emits the 'memoryQueueBootWarning' so it is
never a silent surprise.

When an endpoint override is set (@AWS_ENDPOINT_URL_SQS@, the AWS-SDK-standard
service-specific variable), it __forces__ the SQS interpretation of the queue URL
regardless of shape -- an emulator (@ministack@) or VPC endpoint URL matches no
public shape by design -- and the ambient @AWS_REGION@ must scope it (a missing one
is the 'QueueRegionMissing' boot error, this override being the only path that
still raises it). The override is parsed into the backend's 'SqsEndpoint'; a
malformed one is a fail-loud 'QueueEndpointMalformed', aggregated with the region
failure so one boot reports both. The generic @AWS_ENDPOINT_URL@ is deliberately
__not__ consulted here: it is the S3 advisory client's override, and honouring it
for the queue would let an S3-only override silently redirect the queue's traffic.
With no override, the SQS backend uses AWS's default endpoint and credential
resolution.
-}
planMirrorQueue :: AmbientAws -> AppConfig -> Either [BootError] MirrorQueuePlan
planMirrorQueue :: AmbientAws -> AppConfig -> Either [BootError] MirrorQueuePlan
planMirrorQueue AmbientAws
ambient AppConfig
env = case QueueSettings -> Maybe Url
qsUrl (AppConfig -> QueueSettings
cfgQueue AppConfig
env) of
    -- No queue URL: the bounded in-memory queue, a graceful rollover (loudly
    -- warned), never a boot failure -- there is nothing to misconfigure. Its
    -- depth cap is the memory plan's to allocate, after this selection.
    Maybe Url
Nothing -> MirrorQueuePlan -> Either [BootError] MirrorQueuePlan
forall a b. b -> Either a b
Right MirrorQueuePlan
MemoryBackend
    Just Url
queueUrl ->
        let url :: Text
url = Url -> Text
unUrl Url
queueUrl
         in case Text -> Maybe Text
nonBlank (Text -> Maybe Text) -> Maybe Text -> Maybe Text
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< AmbientAws -> Maybe Text
ambientAwsEndpointUrlSqs AmbientAws
ambient of
                Just Text
override -> case (Either BootError Text
regionE, Text -> Either BootError SqsEndpoint
endpointE Text
override) of
                    (Right Text
region, Right SqsEndpoint
endpoint) ->
                        MirrorQueuePlan -> Either [BootError] MirrorQueuePlan
forall a b. b -> Either a b
Right (SqsConfig -> MirrorQueuePlan
SqsBackend (Text -> Text -> SqsConfig
defaultSqsConfig Text
url Text
region){sqsEndpoint = Just endpoint})
                    (Either BootError Text
r, Either BootError SqsEndpoint
e) -> [BootError] -> Either [BootError] MirrorQueuePlan
forall a b. a -> Either a b
Left ([Either BootError ()] -> [BootError]
forall a b. [Either a b] -> [a]
lefts [Either BootError Text -> Either BootError ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void Either BootError Text
r, Either BootError SqsEndpoint -> Either BootError ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void Either BootError SqsEndpoint
e])
                Maybe Text
Nothing -> case Text -> Maybe QueueTarget
parseQueueTarget Text
url of
                    Just (SqsTarget Text
region) -> MirrorQueuePlan -> Either [BootError] MirrorQueuePlan
forall a b. b -> Either a b
Right (SqsConfig -> MirrorQueuePlan
SqsBackend (Text -> Text -> SqsConfig
defaultSqsConfig Text
url Text
region))
                    Just (PubSubTarget Text
_project Text
_topic) -> [BootError] -> Either [BootError] MirrorQueuePlan
forall a b. a -> Either a b
Left [Text -> BootError
QueueProviderUnavailable Text
"pubsub"]
                    Maybe QueueTarget
Nothing -> [BootError] -> Either [BootError] MirrorQueuePlan
forall a b. a -> Either a b
Left [Text -> BootError
QueueUrlUnrecognised Text
url]
  where
    -- AWS_REGION, required only under the endpoint override (a real SQS URL carries
    -- its region in its host); a blank value is treated as absent.
    regionE :: Either BootError Text
    regionE :: Either BootError Text
regionE = case Text -> Text
T.strip (Text -> Text) -> Maybe Text -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AmbientAws -> Maybe Text
ambientAwsRegion AmbientAws
ambient of
        Just Text
region | Bool -> Bool
not (Text -> Bool
T.null Text
region) -> Text -> Either BootError Text
forall a b. b -> Either a b
Right Text
region
        Maybe Text
_ -> BootError -> Either BootError Text
forall a b. a -> Either a b
Left BootError
QueueRegionMissing

    endpointE :: Text -> Either BootError SqsEndpoint
    endpointE :: Text -> Either BootError SqsEndpoint
endpointE Text
override = case Text -> Maybe (Bool, Text, Int)
parseEndpointUrl Text
override of
        Maybe (Bool, Text, Int)
Nothing -> BootError -> Either BootError SqsEndpoint
forall a b. a -> Either a b
Left (Text -> BootError
QueueEndpointMalformed Text
override)
        Just (Bool
secure, Text
host, Int
port) ->
            SqsEndpoint -> Either BootError SqsEndpoint
forall a b. b -> Either a b
Right SqsEndpoint{endpointSecure :: Bool
endpointSecure = Bool
secure, endpointHost :: Text
endpointHost = Text
host, endpointPort :: Int
endpointPort = Int
port}

{- | The loud boot warning a 'MirrorQueuePlan' warrants before its queue is built, or
'Nothing' for a durable backend that needs none. The composition root logs the
'Just' at @WarningS@ on selection, so an operator who chose the in-memory backend is
told plainly that the mirror is non-durable -- never a silent surprise.
-}
mirrorQueuePlanWarning :: MirrorQueuePlan -> Maybe Text
mirrorQueuePlanWarning :: MirrorQueuePlan -> Maybe Text
mirrorQueuePlanWarning = \case
    SqsBackend SqsConfig
_ -> Maybe Text
forall a. Maybe a
Nothing
    MirrorQueuePlan
MemoryBackend -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
memoryQueueBootWarning

{- | The boot warning emitted when mirroring rolls over to the in-memory queue (no
@ECLUSE_QUEUE__URL@): it states plainly that the mirror is in-memory, non-durable,
and best-effort, and that a lost job is re-mirrored on the next demand (so there is
no data loss, only deferred mirroring), so the rollover is never mistaken for a
durable cloud backend.
-}
memoryQueueBootWarning :: Text
memoryQueueBootWarning :: Text
memoryQueueBootWarning =
    Text
"no ECLUSE_QUEUE__URL is set, so the mirror queue is IN-MEMORY, NON-DURABLE, and BEST-EFFORT. "
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"Jobs are dropped on cap overflow and lost on restart or redeploy; each is re-mirrored on the next "
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"demand (no data loss, only deferred mirroring). Point ECLUSE_QUEUE__URL at a durable queue (SQS) "
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"for a production mirror that must not shed under load."

{- | The cap-overflow drop warning for the in-memory backend, carrying the running
total of dropped jobs (this report is rate-limited at the queue, so it does not fire
per dropped job). A note on a one-line follow-up: a drop __metric__
(@ecluse.mirror.*@, S26 PR2) hooks in alongside this log once that catalogue lands.
-}
memoryQueueDropWarning :: Int -> Text
memoryQueueDropWarning :: Int -> Text
memoryQueueDropWarning Int
dropped =
    Text
"mirror queue at capacity: dropped a mirror job (drop-newest); "
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall b a. (Show a, IsString b) => a -> b
show Int
dropped
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" job(s) dropped so far. Each is re-mirrored on the next demand; raise "
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"ECLUSE_QUEUE__MEMORY_MAX_DEPTH to shed fewer under load."