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

{- | Everything a registry data plane needs to reach one origin: where it is, what to dial it
through, what to present, and what response bound to hold it to. The composition root and the
serve pipeline are the only builders, and nothing here is derived or cached.
-}
module Ecluse.Core.Registry.Origin (
    OriginClient (..),
    originClient,
    originBaseUrl,

    -- * Credential posture, carried in the type
    OriginFor,
    Public,
    Private,
    anonymousOrigin,
    perCallerOrigin,
    originClientOf,
    chargingFullReads,
) where

import Network.HTTP.Client (Manager)

import Ecluse.Core.Credential (ClientCredential)
import Ecluse.Core.Security (Limits)
import Ecluse.Core.Security.Egress (RegistryUrl, registryUrlText)

-- | One origin's coordinates, credential posture, and response bound.
data OriginClient = OriginClient
    { OriginClient -> RegistryUrl
ocBaseUrl :: RegistryUrl
    -- ^ The https-only egress witness the proxy appends a package path to.
    , OriginClient -> Manager
ocManager :: Manager
    -- ^ The shared @http-client@ 'Manager' to issue requests through.
    , OriginClient -> Maybe ClientCredential
ocToken :: Maybe ClientCredential
    -- ^ 'Nothing' for an anonymous origin. A passthrough read carries the caller's own verbatim.
    , OriginClient -> Limits
ocLimits :: Limits
    -- ^ The bound every read through this origin is held to, fail-closed past the maximum.
    , OriginClient -> Int -> IO ()
ocChargeFullRead :: Int -> IO ()
    -- ^ Pays for each decompressed chunk of a full metadata read before the parser sees it.
    }

{- | One origin from the four things that name it. The bound comes first because a caller
usually holds one and reaches several origins under it.
-}
originClient :: Limits -> Manager -> RegistryUrl -> Maybe ClientCredential -> OriginClient
originClient :: Limits
-> Manager -> RegistryUrl -> Maybe ClientCredential -> OriginClient
originClient Limits
limits Manager
manager RegistryUrl
baseUrl Maybe ClientCredential
token =
    OriginClient{ocBaseUrl :: RegistryUrl
ocBaseUrl = RegistryUrl
baseUrl, ocManager :: Manager
ocManager = Manager
manager, ocToken :: Maybe ClientCredential
ocToken = Maybe ClientCredential
token, ocLimits :: Limits
ocLimits = Limits
limits, ocChargeFullRead :: Int -> IO ()
ocChargeFullRead = IO () -> Int -> IO ()
forall a b. a -> b -> a
const IO ()
forall (f :: * -> *). Applicative f => f ()
pass}

-- | The origin's base URL as text, which is how every request builder takes it.
originBaseUrl :: OriginClient -> Text
originBaseUrl :: OriginClient -> Text
originBaseUrl = RegistryUrl -> Text
registryUrlText (RegistryUrl -> Text)
-> (OriginClient -> RegistryUrl) -> OriginClient -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OriginClient -> RegistryUrl
ocBaseUrl

{- | An 'OriginClient' whose credential posture its builder fixed. The constructor stays here and
the role annotation below stops 'coerce' retagging one.
-}
newtype OriginFor (posture :: Type) = OriginFor OriginClient

-- RoleAnnotations is not in GHC2021. Without this line the parameter takes GHC's phantom role,
-- and coerce changes it from any module, constructor in scope or not.
type role OriginFor nominal

-- The two postures. Neither type is inhabited: each names a posture in a type, never a value.
data Public
data Private

-- | An origin dialled with no credential, so no caller's authorisation scopes what it reads.
anonymousOrigin :: Limits -> Manager -> RegistryUrl -> OriginFor Public
anonymousOrigin :: Limits -> Manager -> RegistryUrl -> OriginFor Public
anonymousOrigin Limits
limits Manager
manager RegistryUrl
baseUrl = OriginClient -> OriginFor Public
forall posture. OriginClient -> OriginFor posture
OriginFor (Limits
-> Manager -> RegistryUrl -> Maybe ClientCredential -> OriginClient
originClient Limits
limits Manager
manager RegistryUrl
baseUrl Maybe ClientCredential
forall a. Maybe a
Nothing)

-- | An origin presenting one caller's credential, so what it reads is scoped to that caller.
perCallerOrigin :: Limits -> Manager -> RegistryUrl -> Maybe ClientCredential -> OriginFor Private
perCallerOrigin :: Limits
-> Manager
-> RegistryUrl
-> Maybe ClientCredential
-> OriginFor Private
perCallerOrigin Limits
limits Manager
manager RegistryUrl
baseUrl Maybe ClientCredential
token = OriginClient -> OriginFor Private
forall posture. OriginClient -> OriginFor posture
OriginFor (Limits
-> Manager -> RegistryUrl -> Maybe ClientCredential -> OriginClient
originClient Limits
limits Manager
manager RegistryUrl
baseUrl Maybe ClientCredential
token)

-- | The plain record behind a tagged origin, for the operations that take any origin.
originClientOf :: OriginFor posture -> OriginClient
originClientOf :: forall posture. OriginFor posture -> OriginClient
originClientOf (OriginFor OriginClient
client) = OriginClient
client

-- | The same origin, paying for what its full metadata reads hand on.
chargingFullReads :: (Int -> IO ()) -> OriginFor posture -> OriginFor posture
chargingFullReads :: forall posture.
(Int -> IO ()) -> OriginFor posture -> OriginFor posture
chargingFullReads Int -> IO ()
charge (OriginFor OriginClient
client) = OriginClient -> OriginFor posture
forall posture. OriginClient -> OriginFor posture
OriginFor OriginClient
client{ocChargeFullRead = charge}