-- SPDX-FileCopyrightText: 2026 Alexandra de Wit
--
-- SPDX-License-Identifier: MIT
{-# LANGUAGE OverloadedStrings #-}

{- |
Hierarchical configuration resolution (Viper-style).
Unifies defaults, configuration files, and environment variables into a single
resolution tree with strict precedence: Defaults < File < Env.
-}
module Ecluse.Config.Resolve (
    deepMerge,
    buildEnvAst,
    secretLeafKeys,
    secretEnvSpellings,
    envSpellingOf,
    mountEnvKey,
) where

import Data.Aeson (Value (..), eitherDecodeStrict)
import Data.Aeson.Key qualified as Key
import Data.Aeson.KeyMap qualified as KeyMap
import Data.Char (isUpper)

import Data.Text qualified as T

{- | Right-biased deep merge of two Aeson Values.
Objects are merged recursively. Other types (Arrays, Strings, etc.) are
overwritten by the right side (the higher precedence value).
-}
deepMerge :: Value -> Value -> Value
deepMerge :: Value -> Value -> Value
deepMerge (Object Object
l) (Object Object
r) = Object -> Value
Object (Object -> Value) -> Object -> Value
forall a b. (a -> b) -> a -> b
$ (Value -> Value -> Value) -> Object -> Object -> Object
forall v. (v -> v -> v) -> KeyMap v -> KeyMap v -> KeyMap v
KeyMap.unionWith Value -> Value -> Value
deepMerge Object
l Object
r
deepMerge Value
_ Value
r = Value
r

{- | Convert a list of environment variables into a nested JSON Object.
Filters for keys starting with @ECLUSE_@ and strips the prefix.
Double underscores (@__@) represent nested object paths.
Single underscores (@_@) are converted to camelCase for Aeson key matching.
For example, @ECLUSE_MOUNTS__NPM__PRIVATE_UPSTREAM@ becomes
@{"mounts": {"npm": {"privateUpstream": ...}}}@.
Values that parse as valid JSON (like numbers or booleans) are decoded;
otherwise they remain as Strings.

Two kinds of variable never enter the AST: anything outside the @ECLUSE_@
prefix (the ambient SDK environment, @AWS_*@ included, is read directly at the
composition root; see "Ecluse.Config.Ambient"), and the reserved process-level
@ECLUSE_CONFIG@ (the config-document path override, consumed by
"Ecluse.Boot" before the document is even read, so it must not double as a
document key).
-}
buildEnvAst :: [(String, String)] -> Value
buildEnvAst :: [(String, String)] -> Value
buildEnvAst [(String, String)]
env =
    (Value -> Value -> Value) -> Value -> [Value] -> Value
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Value -> Value -> Value
deepMerge (Object -> Value
Object Object
forall v. KeyMap v
KeyMap.empty) (((Text, String) -> Value) -> [(Text, String)] -> [Value]
forall a b. (a -> b) -> [a] -> [b]
map (Text, String) -> Value
envVarValue [(Text, String)]
configVars)
  where
    configVars :: [(Text, String)]
configVars = [(Text
key, String
v) | (String
name, String
v) <- [(String, String)]
env, Just Text
key <- [Text -> Maybe Text
configEnvKey (String -> Text
T.pack String
name)]]

configEnvKey :: Text -> Maybe Text
configEnvKey :: Text -> Maybe Text
configEnvKey Text
name
    | Text
name Text -> [Text] -> Bool
forall (f :: * -> *) a.
(Foldable f, DisallowElem f, Eq a) =>
a -> f a -> Bool
`elem` [Text]
reservedProcessKeys = Maybe Text
forall a. Maybe a
Nothing
    | Bool
otherwise = Text -> Text -> Maybe Text
T.stripPrefix Text
"ECLUSE_" Text
name

{- | @ECLUSE_@-prefixed variables that address the boot process, not the config
document; they are consumed before resolution and never become document keys.
-}
reservedProcessKeys :: [Text]
reservedProcessKeys :: [Text]
reservedProcessKeys = [Text
"ECLUSE_CONFIG"]

{- | The secret-typed leaf keys of the config schema, in their document spelling.
The one source for every site that treats a secret specially: the environment
layer ('buildEnvAst' takes their values verbatim), the provenance dump (these
leaves render redacted; "Ecluse.Config"), and the @*_FILE@ indirection (their env
spellings are the only file-shaped side door; "Ecluse.Boot").
-}
secretLeafKeys :: [Text]
secretLeafKeys :: [Text]
secretLeafKeys = [Text
"authToken", Text
"mirrorTargetToken", Text
"publicationTargetToken"]

-- | 'secretLeafKeys' in their environment spelling (@authToken@ -> @AUTH_TOKEN@).
secretEnvSpellings :: [Text]
secretEnvSpellings :: [Text]
secretEnvSpellings = (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Text
envSpellingOf [Text]
secretLeafKeys

{- | The environment spelling of a camelCase document key (@authToken@ ->
@AUTH_TOKEN@): the inverse of the camelCase reconstruction 'buildEnvAst' applies, so
the key a boot error tells an operator to set is exactly the key the resolver reads.
-}
envSpellingOf :: Text -> Text
envSpellingOf :: Text -> Text
envSpellingOf = Text -> Text
T.toUpper (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Text) -> Text -> Text
T.concatMap Char -> Text
underscoreUpper
  where
    underscoreUpper :: Char -> Text
underscoreUpper Char
c
        | Char -> Bool
isUpper Char
c = Text
"_" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Char -> Text
T.singleton Char
c
        | Bool
otherwise = Char -> Text
T.singleton Char
c

{- | The full environment key of a mount-scoped setting
(@ECLUSE_MOUNTS__{ECOSYSTEM}__{KEY}@), assembled from the mount's ecosystem name and
the setting's already env-spelled suffix. The one home shared by the config-load
errors ("Ecluse.Config.Types") and the boot-error renderings
("Ecluse.Composition.BootError").
-}
mountEnvKey :: Text -> Text -> Text
mountEnvKey :: Text -> Text -> Text
mountEnvKey Text
ecosystem Text
key = Text
"ECLUSE_MOUNTS__" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
T.toUpper Text
ecosystem Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"__" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
key

envVarValue :: (Text, String) -> Value
envVarValue :: (Text, String) -> Value
envVarValue (Text
key, String
value) =
    [Key] -> Value -> Value
nest [Key]
segments (Text -> Value
leafValue (String -> Text
T.pack String
value))
  where
    segments :: [Key]
segments = (Text -> Key) -> [Text] -> [Key]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Key
toCamelCase (HasCallStack => Text -> Text -> [Text]
Text -> Text -> [Text]
T.splitOn Text
"__" Text
key)
    -- A secret is taken verbatim: JSON-parsing it would coerce a value like
    -- 12345 or true into a non-string the secret parser rightly refuses.
    leafValue :: Text -> Value
leafValue
        | Bool -> (Key -> Bool) -> Maybe Key -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False ((Text -> [Text] -> Bool
forall (f :: * -> *) a.
(Foldable f, DisallowElem f, Eq a) =>
a -> f a -> Bool
`elem` [Text]
secretLeafKeys) (Text -> Bool) -> (Key -> Text) -> Key -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key -> Text
Key.toText) ([Key] -> Maybe Key
forall a. [a] -> Maybe a
listToMaybe ([Key] -> [Key]
forall a. [a] -> [a]
reverse [Key]
segments)) = Text -> Value
String
        | Bool
otherwise = Text -> Value
parseEnvValue

toCamelCase :: Text -> Key.Key
toCamelCase :: Text -> Key
toCamelCase Text
t =
    let words' :: [Text]
words' = (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Text -> Bool) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Bool
T.null) (HasCallStack => Text -> Text -> [Text]
Text -> Text -> [Text]
T.splitOn Text
"_" Text
t)
     in Text -> Key
Key.fromText (Text -> Key) -> Text -> Key
forall a b. (a -> b) -> a -> b
$ case [Text]
words' of
            [] -> Text
""
            (Text
w : [Text]
ws) -> Text -> Text
T.toLower Text
w Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Text] -> Text
T.concat ((Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Text
T.toTitle [Text]
ws)

nest :: [Key.Key] -> Value -> Value
nest :: [Key] -> Value -> Value
nest [] Value
v = Value
v
nest (Key
p : [Key]
ps) Value
v = Object -> Value
Object (Object -> Value) -> Object -> Value
forall a b. (a -> b) -> a -> b
$ Key -> Value -> Object
forall v. Key -> v -> KeyMap v
KeyMap.singleton Key
p ([Key] -> Value -> Value
nest [Key]
ps Value
v)

parseEnvValue :: Text -> Value
parseEnvValue :: Text -> Value
parseEnvValue Text
txt = case ByteString -> Either String Value
forall a. FromJSON a => ByteString -> Either String a
eitherDecodeStrict (Text -> ByteString
forall a b. ConvertUtf8 a b => a -> b
encodeUtf8 Text
txt) of
    Right Value
v -> Value
v
    Left String
_ -> Text -> Value
String Text
txt