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

{- | Derive the mirror-queue backend from the queue URL's own shape.

The queue URL is the single source of truth for which backend carries the mirror
jobs, the same derivation the mirror-write credential follows
("Ecluse.Config.MirrorCredential"): a real SQS queue URL
(@https:\/\/sqs.{region}.amazonaws.com\/{account}\/{queue}@) names the SQS backend
and carries its region in its host, and a Pub\/Sub topic resource
(@projects\/{project}\/topics\/{topic}@) names the GCP backend and carries its
project. Because the mechanism is parsed from the very destination it will serve, a
backend\/URL disagreement is unrepresentable rather than merely guarded, and no
separate backend selector exists to disagree with the URL.
-}
module Ecluse.Config.QueueTarget (
    QueueTarget (..),
    parseQueueTarget,
) where

import Data.Text qualified as T

import Ecluse.Config.MirrorCredential (isAccountId)
import Ecluse.Core.Text (nonBlank)

-- | A recognised mirror-queue destination, parsed from the queue URL's shape.
data QueueTarget
    = -- | An SQS queue URL; carries the region parsed from its host.
      SqsTarget Text
    | -- | A Pub\/Sub topic resource; carries its project and topic.
      PubSubTarget Text Text
    deriving stock (QueueTarget -> QueueTarget -> Bool
(QueueTarget -> QueueTarget -> Bool)
-> (QueueTarget -> QueueTarget -> Bool) -> Eq QueueTarget
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: QueueTarget -> QueueTarget -> Bool
== :: QueueTarget -> QueueTarget -> Bool
$c/= :: QueueTarget -> QueueTarget -> Bool
/= :: QueueTarget -> QueueTarget -> Bool
Eq, Int -> QueueTarget -> ShowS
[QueueTarget] -> ShowS
QueueTarget -> String
(Int -> QueueTarget -> ShowS)
-> (QueueTarget -> String)
-> ([QueueTarget] -> ShowS)
-> Show QueueTarget
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> QueueTarget -> ShowS
showsPrec :: Int -> QueueTarget -> ShowS
$cshow :: QueueTarget -> String
show :: QueueTarget -> String
$cshowList :: [QueueTarget] -> ShowS
showList :: [QueueTarget] -> ShowS
Show)

{- | Parse a queue URL into the backend it names, or 'Nothing' for a shape that
names neither -- which the caller refuses loudly rather than guessing a backend.
The SQS shape is validated in full, never classified on the host alone: exactly
@https:\/\/sqs.{region}.amazonaws.com\/{account}\/{queue}@ with a single-label
region, a 12-digit account, one non-empty queue segment, and no query or
fragment. The canonical form carries no port, so an explicit port -- @:443@
included -- is refused: a value that is nearly-but-not an SQS queue URL is a
transcription error to surface, never to repair. The Pub\/Sub shape is the whole
value as a topic resource.
-}
parseQueueTarget :: Text -> Maybe QueueTarget
parseQueueTarget :: Text -> Maybe QueueTarget
parseQueueTarget Text
raw = Text -> Maybe QueueTarget
sqsTargetOf Text
raw Maybe QueueTarget -> Maybe QueueTarget -> Maybe QueueTarget
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> Maybe QueueTarget
pubSubTargetOf Text
raw

-- The region slot must be a single host label: a dotted "region" means the host is
-- some other AWS endpoint shape, never an SQS queue's, so it is not mis-parsed here.
sqsTargetOf :: Text -> Maybe QueueTarget
sqsTargetOf :: Text -> Maybe QueueTarget
sqsTargetOf Text
url = do
    rest <- Text -> Text -> Maybe Text
T.stripPrefix Text
"https://" (Text -> Text
T.strip Text
url)
    guard (T.all (\Char
c -> Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'?' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'#') rest)
    let (authority, slashPath) = T.breakOn "/" rest
    guard (T.all (/= ':') authority)
    region <- nonBlank =<< T.stripSuffix ".amazonaws.com" =<< T.stripPrefix "sqs." (T.toLower authority)
    guard (T.all (/= '.') region)
    case T.splitOn "/" (T.drop 1 slashPath) of
        [Text
account, Text
queueName]
            | Text -> Bool
isAccountId Text
account Bool -> Bool -> Bool
&& Maybe Text -> Bool
forall a. Maybe a -> Bool
isJust (Text -> Maybe Text
nonBlank Text
queueName) ->
                QueueTarget -> Maybe QueueTarget
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> QueueTarget
SqsTarget Text
region)
        [Text]
_ -> Maybe QueueTarget
forall a. Maybe a
Nothing

pubSubTargetOf :: Text -> Maybe QueueTarget
pubSubTargetOf :: Text -> Maybe QueueTarget
pubSubTargetOf Text
raw = case HasCallStack => Text -> Text -> [Text]
Text -> Text -> [Text]
T.splitOn Text
"/" Text
raw of
    [Text
"projects", Text
project, Text
"topics", Text
topic] ->
        Text -> Text -> QueueTarget
PubSubTarget (Text -> Text -> QueueTarget)
-> Maybe Text -> Maybe (Text -> QueueTarget)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Maybe Text
nonBlank Text
project Maybe (Text -> QueueTarget) -> Maybe Text -> Maybe QueueTarget
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> Maybe Text
nonBlank Text
topic
    [Text]
_ -> Maybe QueueTarget
forall a. Maybe a
Nothing