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

{- | The egress posture for registry traffic: https-only by construction.

Every outbound registry URL is a 'RegistryUrl', so a plain-HTTP target cannot be represented
and a non-https configured upstream fails closed at boot.

== Endpoint authentication

TLS certificate validation, not a resolved-IP pin, is the boundary: an attacker who steers a
name to an internal address cannot make it present a CA-trusted certificate for that host. The
host allowlist ('Ecluse.Core.Security.isAllowedUpstreamHost'), the literal internal-range block,
and the @redirectCount = 0@ every request carries are complementary controls owned elsewhere.
-}
module Ecluse.Core.Security.Egress (
    -- * The https-only egress URL
    RegistryUrl,
    mkRegistryUrl,
    mkConfiguredRegistryUrl,
    registryUrlText,

    -- * Packument @dist.tarball@ normalisation
    resolveTarballUrl,
) where

import Data.Text qualified as T

import Ecluse.Core.Security (authorityLabel, hostAddress)
import Ecluse.Core.Security.Egress.Internal (RegistryUrl, mkConfiguredRegistryUrl, mkRegistryUrl, registryUrlText)
import Ecluse.Core.Text (httpPrefix, httpsPrefix, isPrefixOfLowered, lowerPrefixChars)

{- | Resolve a packument's @dist.tarball@ under the https-only posture: plaintext upgrades
to https only on its own host. A refusal names the authority, since the URL can carry a credential.
-}
resolveTarballUrl :: Text -> Text -> Either Text RegistryUrl
resolveTarballUrl :: Text -> Text -> Either Text RegistryUrl
resolveTarballUrl Text
upstreamHost Text
url
    | LowerPrefix -> Text -> Bool
isPrefixOfLowered LowerPrefix
httpsPrefix Text
url = Text -> Either Text RegistryUrl
mkRegistryUrl Text
url
    | LowerPrefix -> Text -> Bool
isPrefixOfLowered LowerPrefix
httpPrefix Text
url =
        if Text -> Text
hostAddress Text
url Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
upstreamHost
            then Text -> Either Text RegistryUrl
mkRegistryUrl (Text
"https://" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text -> Text
T.drop (LowerPrefix -> Int
lowerPrefixChars LowerPrefix
httpPrefix) Text
url)
            else Text -> Either Text RegistryUrl
forall a b. a -> Either a b
Left (Text
"dist.tarball is http on a host other than the upstream registry: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
authorityLabel Text
url)
    | Bool
otherwise = Text -> Either Text RegistryUrl
forall a b. a -> Either a b
Left (Text
"dist.tarball is not an https URL: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
authorityLabel Text
url)