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

{- | Resolve metadata origins with their credential posture and typed outcomes.
Private reads forward the caller's credential without caching. Public reads are anonymous.
Explicit access refusals remain distinct for the packument pipeline, and an origin that
answered 404 stays distinct from one that could not be read.
-}
module Ecluse.Core.Server.Pipeline.Origin (
    -- * A resolved contribution
    Contribution (..),
    fingerprintPiece,

    -- * The per-origin outcome
    OriginResult (..),
    OriginMiss (..),
    originManifest,
    originMiss,

    -- * Fetching the two origins
    fetchPrivateOrigin,
    fetchPublicOrigin,
    preparePublicMetadata,
    withPrivateMetadataClient,

    -- * One origin's coordinates
    mountOrigin,
) where

import Data.Map.Strict qualified as Map
import Katip (Severity (DebugS), logFM, ls)
import Network.HTTP.Client (Manager)
import UnliftIO (withRunInIO)
import UnliftIO.Exception (tryAny)

import Ecluse.Core.Credential (ClientCredential)
import Ecluse.Core.Package (Artifact (artEntryKey), PackageDetails (pkgArtifacts), PackageInfo (infoVersions), PackageName, renderPackageName)
import Ecluse.Core.Package.Entry (EntryKey)
import Ecluse.Core.Package.Merge (Provenance)
import Ecluse.Core.Registry.Adapter.Capability (AdapterMetadata (metadataChargeFactors, metadataNewReads))
import Ecluse.Core.Registry.CachedDocument (CachedDoc)
import Ecluse.Core.Registry.Metadata (
    ContentDigest,
    Manifest,
    MetadataClient (fetchFullManifest),
    MetadataError (
        MetadataAbsent,
        MetadataAuthorisationFailure,
        MetadataBoundExceeded,
        MetadataFetch,
        MetadataHttpFailure,
        MetadataNameMismatch,
        MetadataUndecodable
    ),
    VersionRead,
 )
import Ecluse.Core.Registry.Origin (OriginClient, OriginFor, Private, Public, anonymousOrigin, chargingFullReads, originBaseUrl, originClient, originClientOf, perCallerOrigin)
import Ecluse.Core.Security (Limits (progressFloor))
import Ecluse.Core.Security.Egress (RegistryUrl, registryUrlText)
import Ecluse.Core.Server.Admission.Budget (scaleCharge)
import Ecluse.Core.Server.Admission.Meter (MemoryTicket, awaitingFlight, charge, servingFlight)
import Ecluse.Core.Server.Admission.Types (ChargeFactors (cfFullReadPermille), FlightKey (FlightKey))
import Ecluse.Core.Server.Cache (Source (Source), metadataKey)
import Ecluse.Core.Server.Cache.Store (PreparedStore)
import Ecluse.Core.Server.Context (
    Handler,
    PackumentDeps (..),
    ServeRuntime (..),
    pdPrivateBaseUrl,
    pdPublicBaseUrl,
 )
import Ecluse.Core.Server.Metadata (MetadataReads, preparePublicVersion, privateMetadataClient, publicMetadataClient, withinRequestCap)
import Ecluse.Core.Server.Pipeline.Diagnostics (logInvalidEntries, logMetadataFailure)
import Ecluse.Core.Version (Version)

-- | A parsed contribution with opaque source bytes and a digest for the derived validator.
data Contribution = Contribution
    { Contribution -> Provenance
srcProvenance :: Provenance
    , Contribution -> PackageInfo
srcInfo :: PackageInfo
    , Contribution -> CachedDoc
srcValue :: CachedDoc
    , Contribution -> ContentDigest
srcDigest :: ContentDigest
    , Contribution -> Int
srcBodyBytes :: Int
    -- ^ The decompressed source size, from which the listing's output charge takes its basis.
    }

-- | Scope surviving versions and exact artifact coordinates to their source digest and provenance.
fingerprintPiece :: Contribution -> (Provenance, ContentDigest, [(Text, [EntryKey])])
fingerprintPiece :: Contribution -> (Provenance, ContentDigest, [(Text, [EntryKey])])
fingerprintPiece Contribution
s =
    ( Contribution -> Provenance
srcProvenance Contribution
s
    , Contribution -> ContentDigest
srcDigest Contribution
s
    , [(Text
version, (Artifact -> EntryKey) -> [Artifact] -> [EntryKey]
forall a b. (a -> b) -> [a] -> [b]
map Artifact -> EntryKey
artEntryKey (NonEmpty Artifact -> [Artifact]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (PackageDetails -> NonEmpty Artifact
pkgArtifacts PackageDetails
details))) | (Text
version, PackageDetails
details) <- Map Text PackageDetails -> [(Text, PackageDetails)]
forall k a. Map k a -> [(k, a)]
Map.toList (PackageInfo -> Map Text PackageDetails
infoVersions (Contribution -> PackageInfo
srcInfo Contribution
s))]
    )

-- | One origin's contribution, access refusal, identity mismatch, or absence.
data OriginResult
    = -- | A packument that decoded and whose self-reported name matched the request.
      OriginResolved Manifest
    | -- | An explicit upstream access refusal, retaining its 401 or 403.
      OriginAuthorisationFailure Int
    | -- | An invalid package identity, contributing a 502 when no valid origin remains.
      OriginNameMismatch
    | -- | The origin answered 404, so it holds no such package. It degrades to no contribution.
      OriginNotFound
    | -- | The origin was not read: unreachable, faulting, or undecodable. It degrades to no contribution.
      OriginUnresolved
    | -- | An unconfigured origin contributes neither metadata nor an availability failure.
      OriginAbsent

-- | Distinguish a settled absence from an unread origin that a retry may resolve.
data OriginMiss
    = -- | The origin holds no such package, or the mount configures no such origin.
      MissAbsent
    | -- | The origin was not read, so nothing yet says whether it holds the package.
      MissUnresolved
    deriving stock (OriginMiss -> OriginMiss -> Bool
(OriginMiss -> OriginMiss -> Bool)
-> (OriginMiss -> OriginMiss -> Bool) -> Eq OriginMiss
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: OriginMiss -> OriginMiss -> Bool
== :: OriginMiss -> OriginMiss -> Bool
$c/= :: OriginMiss -> OriginMiss -> Bool
/= :: OriginMiss -> OriginMiss -> Bool
Eq, Int -> OriginMiss -> ShowS
[OriginMiss] -> ShowS
OriginMiss -> String
(Int -> OriginMiss -> ShowS)
-> (OriginMiss -> String)
-> ([OriginMiss] -> ShowS)
-> Show OriginMiss
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> OriginMiss -> ShowS
showsPrec :: Int -> OriginMiss -> ShowS
$cshow :: OriginMiss -> String
show :: OriginMiss -> String
$cshowList :: [OriginMiss] -> ShowS
showList :: [OriginMiss] -> ShowS
Show)

-- | The resolved manifest an origin contributed, if any.
originManifest :: OriginResult -> Maybe Manifest
originManifest :: OriginResult -> Maybe Manifest
originManifest = \case
    OriginAuthorisationFailure Int
_ -> Maybe Manifest
forall a. Maybe a
Nothing
    OriginResolved Manifest
manifest -> Manifest -> Maybe Manifest
forall a. a -> Maybe a
Just Manifest
manifest
    OriginResult
OriginNameMismatch -> Maybe Manifest
forall a. Maybe a
Nothing
    OriginResult
OriginNotFound -> Maybe Manifest
forall a. Maybe a
Nothing
    OriginResult
OriginUnresolved -> Maybe Manifest
forall a. Maybe a
Nothing
    OriginResult
OriginAbsent -> Maybe Manifest
forall a. Maybe a
Nothing

-- | The miss an origin yielded, or 'Nothing' when it contributed a document or an explicit refusal.
originMiss :: OriginResult -> Maybe OriginMiss
originMiss :: OriginResult -> Maybe OriginMiss
originMiss = \case
    OriginAuthorisationFailure Int
_ -> Maybe OriginMiss
forall a. Maybe a
Nothing
    OriginResolved{} -> Maybe OriginMiss
forall a. Maybe a
Nothing
    OriginResult
OriginNameMismatch -> Maybe OriginMiss
forall a. Maybe a
Nothing
    OriginResult
OriginNotFound -> OriginMiss -> Maybe OriginMiss
forall a. a -> Maybe a
Just OriginMiss
MissAbsent
    OriginResult
OriginUnresolved -> OriginMiss -> Maybe OriginMiss
forall a. a -> Maybe a
Just OriginMiss
MissUnresolved
    OriginResult
OriginAbsent -> OriginMiss -> Maybe OriginMiss
forall a. a -> Maybe a
Just OriginMiss
MissAbsent

originResultOf :: Either SomeException (Either MetadataError Manifest) -> OriginResult
originResultOf :: Either SomeException (Either MetadataError Manifest)
-> OriginResult
originResultOf = \case
    Left SomeException
_ -> OriginResult
OriginUnresolved
    Right (Left (MetadataAuthorisationFailure Int
code)) -> Int -> OriginResult
OriginAuthorisationFailure Int
code
    Right (Left (MetadataNameMismatch Text
_)) -> OriginResult
OriginNameMismatch
    Right (Left MetadataError
MetadataAbsent) -> OriginResult
OriginNotFound
    Right (Left (MetadataHttpFailure Int
_)) -> OriginResult
OriginUnresolved
    Right (Left MetadataError
MetadataUndecodable) -> OriginResult
OriginUnresolved
    Right (Left (MetadataBoundExceeded LimitError
_)) -> OriginResult
OriginUnresolved
    Right (Left (MetadataFetch FetchFault
_)) -> OriginResult
OriginUnresolved
    Right (Right Manifest
manifest) -> Manifest -> OriginResult
OriginResolved Manifest
manifest

-- | Resolve the private origin uncached with the caller's credential, retaining explicit access refusals.
fetchPrivateOrigin :: PackumentDeps -> ServeRuntime -> MemoryTicket -> Maybe ClientCredential -> PackageName -> Handler OriginResult
fetchPrivateOrigin :: PackumentDeps
-> ServeRuntime
-> MemoryTicket
-> Maybe ClientCredential
-> PackageName
-> Handler OriginResult
fetchPrivateOrigin PackumentDeps
deps ServeRuntime
rt MemoryTicket
ticket Maybe ClientCredential
token PackageName
name = case PackumentDeps -> Maybe RegistryUrl
pdPrivateBaseUrl PackumentDeps
deps of
    Maybe RegistryUrl
Nothing -> OriginResult -> Handler OriginResult
forall a. a -> Handler a
forall (f :: * -> *) a. Applicative f => a -> f a
pure OriginResult
OriginAbsent
    Just RegistryUrl
privateBase -> do
        Severity -> LogStr -> Handler ()
forall (m :: * -> *).
(Applicative m, KatipContext m) =>
Severity -> LogStr -> m ()
logFM Severity
DebugS (Text -> LogStr
forall a. StringConv a Text => a -> LogStr
ls (Text
"fetching private origin for " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> PackageName -> Text
renderPackageName PackageName
name))
        let origin :: OriginFor Private
origin = (Int -> IO ()) -> OriginFor Private -> OriginFor Private
forall posture.
(Int -> IO ()) -> OriginFor posture -> OriginFor posture
chargingFullReads (PackumentDeps -> MemoryTicket -> Int -> IO ()
fullReadCharge PackumentDeps
deps MemoryTicket
ticket) (ServeRuntime
-> PackumentDeps
-> RegistryUrl
-> Maybe ClientCredential
-> OriginFor Private
privateOrigin ServeRuntime
rt PackumentDeps
deps RegistryUrl
privateBase Maybe ClientCredential
token)
        Either SomeException (Either MetadataError Manifest)
-> OriginResult
originResultOf (Either SomeException (Either MetadataError Manifest)
 -> OriginResult)
-> Handler (Either SomeException (Either MetadataError Manifest))
-> Handler OriginResult
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Handler (Either MetadataError Manifest)
-> Handler (Either SomeException (Either MetadataError Manifest))
forall (m :: * -> *) a.
MonadUnliftIO m =>
m a -> m (Either SomeException a)
tryAny (ServeRuntime
-> PackumentDeps
-> (MetadataReads Private -> MetadataClient)
-> OriginFor Private
-> (MetadataClient -> IO (Either MetadataError Manifest))
-> Handler (Either MetadataError Manifest)
forall posture client a.
ServeRuntime
-> PackumentDeps
-> (MetadataReads posture -> client)
-> OriginFor posture
-> (client -> IO a)
-> Handler a
withMetadataClient ServeRuntime
rt PackumentDeps
deps MetadataReads Private -> MetadataClient
privateMetadataClient OriginFor Private
origin (MetadataClient -> PackageName -> IO (Either MetadataError Manifest)
`fetchFullManifest` PackageName
name))

-- | Resolve the public (gated, anonymous) upstream origin through the metadata cache, keyed by the origin's base URL as its 'Source'.
fetchPublicOrigin :: PackumentDeps -> ServeRuntime -> MemoryTicket -> PackageName -> Handler OriginResult
fetchPublicOrigin :: PackumentDeps
-> ServeRuntime
-> MemoryTicket
-> PackageName
-> Handler OriginResult
fetchPublicOrigin PackumentDeps
deps ServeRuntime
rt MemoryTicket
ticket PackageName
name = do
    Severity -> LogStr -> Handler ()
forall (m :: * -> *).
(Applicative m, KatipContext m) =>
Severity -> LogStr -> m ()
logFM Severity
DebugS (Text -> LogStr
forall a. StringConv a Text => a -> LogStr
ls (Text
"fetching public origin for " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> PackageName -> Text
renderPackageName PackageName
name))
    -- Every request that shares this read waits on it, so whichever request leads it pays with their priority.
    let flight :: FlightKey
flight = Text -> FlightKey
FlightKey (Source -> PackageName -> Text
metadataKey (PackumentDeps -> Source
publicSource PackumentDeps
deps) PackageName
name)
        origin :: OriginFor Public
origin = (Int -> IO ()) -> OriginFor Public -> OriginFor Public
forall posture.
(Int -> IO ()) -> OriginFor posture -> OriginFor posture
chargingFullReads (PackumentDeps -> MemoryTicket -> Int -> IO ()
fullReadCharge PackumentDeps
deps (FlightKey -> MemoryTicket -> MemoryTicket
servingFlight FlightKey
flight MemoryTicket
ticket)) (ServeRuntime -> PackumentDeps -> OriginFor Public
publicOrigin ServeRuntime
rt PackumentDeps
deps)
    Either SomeException (Either MetadataError Manifest)
-> OriginResult
originResultOf (Either SomeException (Either MetadataError Manifest)
 -> OriginResult)
-> Handler (Either SomeException (Either MetadataError Manifest))
-> Handler OriginResult
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Handler (Either MetadataError Manifest)
-> Handler (Either SomeException (Either MetadataError Manifest))
forall (m :: * -> *) a.
MonadUnliftIO m =>
m a -> m (Either SomeException a)
tryAny (MemoryTicket
-> FlightKey
-> Handler (Either MetadataError Manifest)
-> Handler (Either MetadataError Manifest)
forall (m :: * -> *) a.
MonadUnliftIO m =>
MemoryTicket -> FlightKey -> m a -> m a
awaitingFlight MemoryTicket
ticket FlightKey
flight (ServeRuntime
-> PackumentDeps
-> (MetadataReads Public -> MetadataClient)
-> OriginFor Public
-> (MetadataClient -> IO (Either MetadataError Manifest))
-> Handler (Either MetadataError Manifest)
forall posture client a.
ServeRuntime
-> PackumentDeps
-> (MetadataReads posture -> client)
-> OriginFor posture
-> (client -> IO a)
-> Handler a
withMetadataClient ServeRuntime
rt PackumentDeps
deps (MetadataCache -> Source -> MetadataReads Public -> MetadataClient
publicMetadataClient (ServeRuntime -> MetadataCache
srMetadataCache ServeRuntime
rt) (PackumentDeps -> Source
publicSource PackumentDeps
deps)) OriginFor Public
origin (MetadataClient -> PackageName -> IO (Either MetadataError Manifest)
`fetchFullManifest` PackageName
name)))

{- Run an action over a per-request read handle for one origin. 'withRunInIO' captures the request's
@katip@ context into the failure logs, and each read holds to the mount's 'Limits' and the serve cap. -}
withMetadataClient ::
    ServeRuntime ->
    PackumentDeps ->
    (MetadataReads posture -> client) ->
    OriginFor posture ->
    (client -> IO a) ->
    Handler a
withMetadataClient :: forall posture client a.
ServeRuntime
-> PackumentDeps
-> (MetadataReads posture -> client)
-> OriginFor posture
-> (client -> IO a)
-> Handler a
withMetadataClient ServeRuntime
rt PackumentDeps
deps MetadataReads posture -> client
settle OriginFor posture
origin client -> IO a
k =
    ((forall a. Handler a -> IO a) -> IO a) -> Handler a
forall b. ((forall a. Handler a -> IO a) -> IO b) -> Handler b
forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO (((forall a. Handler a -> IO a) -> IO a) -> Handler a)
-> ((forall a. Handler a -> IO a) -> IO a) -> Handler a
forall a b. (a -> b) -> a -> b
$ \forall a. Handler a -> IO a
runInIO ->
        client -> IO a
k (client -> IO a)
-> (MetadataReads posture -> client)
-> MetadataReads posture
-> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MetadataReads posture -> client
settle (MetadataReads posture -> client)
-> (MetadataReads posture -> MetadataReads posture)
-> MetadataReads posture
-> client
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProgressFloor -> MetadataReads posture -> MetadataReads posture
forall posture.
ProgressFloor -> MetadataReads posture -> MetadataReads posture
withinRequestCap (Limits -> ProgressFloor
progressFloor (PackumentDeps -> Limits
pdLimits PackumentDeps
deps)) (MetadataReads posture -> IO a) -> MetadataReads posture -> IO a
forall a b. (a -> b) -> a -> b
$
            AdapterMetadata
-> forall posture.
   TracingPort
   -> MetricsPort
   -> (PackageName -> MetadataError -> IO ())
   -> (PackageName -> [InvalidEntry] -> IO ())
   -> (PackageName -> IO ())
   -> OriginFor posture
   -> MetadataReads posture
metadataNewReads
                (PackumentDeps -> AdapterMetadata
pdMetadata PackumentDeps
deps)
                (ServeRuntime -> TracingPort
srTracing ServeRuntime
rt)
                (ServeRuntime -> MetricsPort
srMetrics ServeRuntime
rt)
                (\PackageName
nm MetadataError
err -> Handler () -> IO ()
forall a. Handler a -> IO a
runInIO (PackageName -> Text -> MetadataError -> Handler ()
forall (m :: * -> *).
KatipContext m =>
PackageName -> Text -> MetadataError -> m ()
logMetadataFailure PackageName
nm Text
baseUrl MetadataError
err))
                (\PackageName
nm [InvalidEntry]
entries -> Handler () -> IO ()
forall a. Handler a -> IO a
runInIO (PackageName -> Text -> [InvalidEntry] -> Handler ()
forall (m :: * -> *).
KatipContext m =>
PackageName -> Text -> [InvalidEntry] -> m ()
logInvalidEntries PackageName
nm Text
baseUrl [InvalidEntry]
entries))
                (\PackageName
nm -> Handler () -> IO ()
forall a. Handler a -> IO a
runInIO (Severity -> LogStr -> Handler ()
forall (m :: * -> *).
(Applicative m, KatipContext m) =>
Severity -> LogStr -> m ()
logFM Severity
DebugS (Text -> LogStr
forall a. StringConv a Text => a -> LogStr
ls (Text
"fetching packument from origin for " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> PackageName -> Text
renderPackageName PackageName
nm))))
                OriginFor posture
origin
  where
    baseUrl :: Text
baseUrl = OriginClient -> Text
originBaseUrl (OriginFor posture -> OriginClient
forall posture. OriginFor posture -> OriginClient
originClientOf OriginFor posture
origin)

-- The ticket pays for each full-read chunk at the ecosystem's factor.
fullReadCharge :: PackumentDeps -> MemoryTicket -> Int -> IO ()
fullReadCharge :: PackumentDeps -> MemoryTicket -> Int -> IO ()
fullReadCharge PackumentDeps
deps MemoryTicket
ticket = MemoryTicket -> Int -> IO ()
charge MemoryTicket
ticket (Int -> IO ()) -> (Int -> Int) -> Int -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int -> Int
scaleCharge (ChargeFactors -> Int
cfFullReadPermille (AdapterMetadata -> ChargeFactors
metadataChargeFactors (PackumentDeps -> AdapterMetadata
pdMetadata PackumentDeps
deps)))

-- | Bypass shared caching so the private upstream authorises each caller's credential.
withPrivateMetadataClient :: ServeRuntime -> PackumentDeps -> RegistryUrl -> Maybe ClientCredential -> (MetadataClient -> IO a) -> Handler a
withPrivateMetadataClient :: forall a.
ServeRuntime
-> PackumentDeps
-> RegistryUrl
-> Maybe ClientCredential
-> (MetadataClient -> IO a)
-> Handler a
withPrivateMetadataClient ServeRuntime
rt PackumentDeps
deps RegistryUrl
baseUrl Maybe ClientCredential
token =
    ServeRuntime
-> PackumentDeps
-> (MetadataReads Private -> MetadataClient)
-> OriginFor Private
-> (MetadataClient -> IO a)
-> Handler a
forall posture client a.
ServeRuntime
-> PackumentDeps
-> (MetadataReads posture -> client)
-> OriginFor posture
-> (client -> IO a)
-> Handler a
withMetadataClient ServeRuntime
rt PackumentDeps
deps MetadataReads Private -> MetadataClient
privateMetadataClient (ServeRuntime
-> PackumentDeps
-> RegistryUrl
-> Maybe ClientCredential
-> OriginFor Private
privateOrigin ServeRuntime
rt PackumentDeps
deps RegistryUrl
baseUrl Maybe ClientCredential
token)

-- | Pin a public local value without starting remote work.
preparePublicMetadata :: ServeRuntime -> PackumentDeps -> PackageName -> Version -> Handler (PreparedStore MetadataError VersionRead)
preparePublicMetadata :: ServeRuntime
-> PackumentDeps
-> PackageName
-> Version
-> Handler (PreparedStore MetadataError VersionRead)
preparePublicMetadata ServeRuntime
rt PackumentDeps
deps PackageName
name Version
version =
    ServeRuntime
-> PackumentDeps
-> (MetadataReads Public
    -> PackageName
    -> Version
    -> IO (PreparedStore MetadataError VersionRead))
-> OriginFor Public
-> ((PackageName
     -> Version -> IO (PreparedStore MetadataError VersionRead))
    -> IO (PreparedStore MetadataError VersionRead))
-> Handler (PreparedStore MetadataError VersionRead)
forall posture client a.
ServeRuntime
-> PackumentDeps
-> (MetadataReads posture -> client)
-> OriginFor posture
-> (client -> IO a)
-> Handler a
withMetadataClient ServeRuntime
rt PackumentDeps
deps (MetadataCache
-> Source
-> MetadataReads Public
-> PackageName
-> Version
-> IO (PreparedStore MetadataError VersionRead)
preparePublicVersion (ServeRuntime -> MetadataCache
srMetadataCache ServeRuntime
rt) (PackumentDeps -> Source
publicSource PackumentDeps
deps)) (ServeRuntime -> PackumentDeps -> OriginFor Public
publicOrigin ServeRuntime
rt PackumentDeps
deps) (\PackageName
-> Version -> IO (PreparedStore MetadataError VersionRead)
prepare -> PackageName
-> Version -> IO (PreparedStore MetadataError VersionRead)
prepare PackageName
name Version
version)

privateOrigin :: ServeRuntime -> PackumentDeps -> RegistryUrl -> Maybe ClientCredential -> OriginFor Private
privateOrigin :: ServeRuntime
-> PackumentDeps
-> RegistryUrl
-> Maybe ClientCredential
-> OriginFor Private
privateOrigin ServeRuntime
rt PackumentDeps
deps = Limits
-> Manager
-> RegistryUrl
-> Maybe ClientCredential
-> OriginFor Private
perCallerOrigin (PackumentDeps -> Limits
pdLimits PackumentDeps
deps) (ServeRuntime -> Manager
srPrivateManager ServeRuntime
rt)

publicOrigin :: ServeRuntime -> PackumentDeps -> OriginFor Public
publicOrigin :: ServeRuntime -> PackumentDeps -> OriginFor Public
publicOrigin ServeRuntime
rt PackumentDeps
deps = Limits -> Manager -> RegistryUrl -> OriginFor Public
anonymousOrigin (PackumentDeps -> Limits
pdLimits PackumentDeps
deps) (ServeRuntime -> Manager
srPublicManager ServeRuntime
rt) (PackumentDeps -> RegistryUrl
pdPublicBaseUrl PackumentDeps
deps)

-- The public origin's key in the shared metadata cache.
publicSource :: PackumentDeps -> Source
publicSource :: PackumentDeps -> Source
publicSource PackumentDeps
deps = Text -> Source
Source (RegistryUrl -> Text
registryUrlText (PackumentDeps -> RegistryUrl
pdPublicBaseUrl PackumentDeps
deps))

-- | Build an origin with the mount's response bound and the caller-selected manager and credential.
mountOrigin :: PackumentDeps -> Manager -> RegistryUrl -> Maybe ClientCredential -> OriginClient
mountOrigin :: PackumentDeps
-> Manager -> RegistryUrl -> Maybe ClientCredential -> OriginClient
mountOrigin PackumentDeps
deps = Limits
-> Manager -> RegistryUrl -> Maybe ClientCredential -> OriginClient
originClient (PackumentDeps -> Limits
pdLimits PackumentDeps
deps)