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

{- | One provider owns metadata retention. Local single-flight shares active requests.
Public metadata and content-addressed responses follow the sharing policy in the web-layer architecture.
-}
module Ecluse.Core.Server.Cache (
    -- * Configuration
    CacheConfig (..),
    StoreBudget (..),

    -- * The cache handle
    MetadataCache,
    newMetadataCache,
    newMetadataCacheWithProvider,

    -- * Cache entries
    Source (..),
    CacheEntry (..),

    -- * Resolution
    resolveMetadata,
    metadataKey,

    -- * Single-version resolution
    resolveVersion,
    prepareVersion,

    -- * Assembled-representation resolution
    resolveAssembled,
) where

import Data.Text.Short qualified as TS

import Ecluse.Core.Package (
    PackageName,
    pkgCanonical,
    pkgEcosystem,
    pkgNamespace,
    renderScope,
 )
import Ecluse.Core.Registry.Metadata (MetadataError, VersionRead)
import Ecluse.Core.Server.Cache.Provider (CacheProvider, localCacheProvider, providerAssembled, providerFull, providerVersion)
import Ecluse.Core.Server.Cache.Store (
    CacheOccupancy (..),
    PreparedStore,
    SingleFlight,
    executePrepared,
    newSingleFlightWithBackend,
    prepareStore,
    resolveSingleFlight,
 )
import Ecluse.Core.Server.Cache.Types
import Ecluse.Core.Telemetry.Metrics qualified as Metric
import Ecluse.Core.Telemetry.Record (MetricsPort (..))
import Ecluse.Core.Version (Version, renderVersion)

-- | The key a full read of one package from one source is shared and retained under.
metadataKey :: Source -> PackageName -> Text
metadataKey :: Source -> PackageName -> Text
metadataKey = Source -> PackageName -> Text
keyText

keyText :: Source -> PackageName -> Text
keyText :: Source -> PackageName -> Text
keyText (Source Text
source) PackageName
name =
    Text
source
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\x1f"
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Ecosystem -> Text
forall b a. (Show a, IsString b) => a -> b
show (PackageName -> Ecosystem
pkgEcosystem PackageName
name)
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\x1f"
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> (Scope -> Text) -> Maybe Scope -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" Scope -> Text
renderScope (PackageName -> Maybe Scope
pkgNamespace PackageName
name)
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\x1f"
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ShortText -> Text
TS.toText (PackageName -> ShortText
pkgCanonical PackageName
name)

versionKey :: Source -> PackageName -> Version -> Text
versionKey :: Source -> PackageName -> Version -> Text
versionKey Source
source PackageName
name Version
version = Source -> PackageName -> Text
keyText Source
source PackageName
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\x1f" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Version -> Text
renderVersion Version
version

-- | One provider supplies every retention capability beside process-local request coalescing.
data MetadataCache = MetadataCache
    { MetadataCache -> SingleFlight MetadataError Text CacheEntry
mcFull :: SingleFlight MetadataError Text CacheEntry
    -- ^ Full fetches partition by source, ecosystem, and package without local retention.
    , MetadataCache -> SingleFlight MetadataError Text VersionRead
mcVersion :: SingleFlight MetadataError Text VersionRead
    , MetadataCache -> SingleFlight Void Text ByteString
mcAssembled :: SingleFlight Void Text ByteString
    }

-- | Select the shipped local provider without an external service dependency.
newMetadataCache :: CacheConfig -> IO MetadataCache
newMetadataCache :: CacheConfig -> IO MetadataCache
newMetadataCache CacheConfig
cfg = CacheConfig -> IO CacheProvider
localCacheProvider CacheConfig
cfg IO CacheProvider
-> (CacheProvider -> IO MetadataCache) -> IO MetadataCache
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CacheProvider -> IO MetadataCache
newMetadataCacheWithProvider

-- | Create only transient flight state. The selected provider owns every retained representation.
newMetadataCacheWithProvider :: CacheProvider -> IO MetadataCache
newMetadataCacheWithProvider :: CacheProvider -> IO MetadataCache
newMetadataCacheWithProvider CacheProvider
provider =
    SingleFlight MetadataError Text CacheEntry
-> SingleFlight MetadataError Text VersionRead
-> SingleFlight Void Text ByteString
-> MetadataCache
MetadataCache
        (SingleFlight MetadataError Text CacheEntry
 -> SingleFlight MetadataError Text VersionRead
 -> SingleFlight Void Text ByteString
 -> MetadataCache)
-> IO (SingleFlight MetadataError Text CacheEntry)
-> IO
     (SingleFlight MetadataError Text VersionRead
      -> SingleFlight Void Text ByteString -> MetadataCache)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (RetentionBackend Text CacheEntry)
-> IO (SingleFlight MetadataError Text CacheEntry)
forall k v e.
Maybe (RetentionBackend k v) -> IO (SingleFlight e k v)
newSingleFlightWithBackend (CacheProvider -> Maybe (RetentionBackend Text CacheEntry)
providerFull CacheProvider
provider)
        IO
  (SingleFlight MetadataError Text VersionRead
   -> SingleFlight Void Text ByteString -> MetadataCache)
-> IO (SingleFlight MetadataError Text VersionRead)
-> IO (SingleFlight Void Text ByteString -> MetadataCache)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe (RetentionBackend Text VersionRead)
-> IO (SingleFlight MetadataError Text VersionRead)
forall k v e.
Maybe (RetentionBackend k v) -> IO (SingleFlight e k v)
newSingleFlightWithBackend (CacheProvider -> Maybe (RetentionBackend Text VersionRead)
providerVersion CacheProvider
provider)
        IO (SingleFlight Void Text ByteString -> MetadataCache)
-> IO (SingleFlight Void Text ByteString) -> IO MetadataCache
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe (RetentionBackend Text ByteString)
-> IO (SingleFlight Void Text ByteString)
forall k v e.
Maybe (RetentionBackend k v) -> IO (SingleFlight e k v)
newSingleFlightWithBackend (CacheProvider -> Maybe (RetentionBackend Text ByteString)
providerAssembled CacheProvider
provider)

-- | Coalesce public metadata fetches. Failures reach all waiters and retain nothing.
resolveMetadata :: MetricsPort -> MetadataCache -> Source -> PackageName -> IO (Either MetadataError CacheEntry) -> IO (Either MetadataError CacheEntry)
resolveMetadata :: MetricsPort
-> MetadataCache
-> Source
-> PackageName
-> IO (Either MetadataError CacheEntry)
-> IO (Either MetadataError CacheEntry)
resolveMetadata MetricsPort
metrics MetadataCache
cache Source
source PackageName
name =
    (CacheResult -> IO ())
-> (CacheOccupancy -> IO ())
-> IO ()
-> SingleFlight MetadataError Text CacheEntry
-> Text
-> IO (Either MetadataError CacheEntry)
-> IO (Either MetadataError CacheEntry)
forall k e v.
Ord k =>
(CacheResult -> IO ())
-> (CacheOccupancy -> IO ())
-> IO ()
-> SingleFlight e k v
-> k
-> IO (Either e v)
-> IO (Either e v)
resolveSingleFlight
        (MetricsPort -> CacheResult -> IO ()
mpCacheRequest MetricsPort
metrics)
        (MetricsPort -> CacheOccupancy -> IO ()
recordFullOccupancy MetricsPort
metrics)
        (MetricsPort -> CacheStore -> IO ()
mpCacheRefused MetricsPort
metrics CacheStore
Metric.FullStore)
        (MetadataCache -> SingleFlight MetadataError Text CacheEntry
mcFull MetadataCache
cache)
        (Source -> PackageName -> Text
keyText Source
source PackageName
name)

-- | Cache a selectively decoded release or its absence. Oversized releases remain uncached.
resolveVersion :: MetricsPort -> MetadataCache -> Source -> PackageName -> Version -> IO (Either MetadataError VersionRead) -> IO (Either MetadataError VersionRead)
resolveVersion :: MetricsPort
-> MetadataCache
-> Source
-> PackageName
-> Version
-> IO (Either MetadataError VersionRead)
-> IO (Either MetadataError VersionRead)
resolveVersion MetricsPort
metrics MetadataCache
cache Source
source PackageName
name Version
version IO (Either MetadataError VersionRead)
fetch =
    MetricsPort
-> MetadataCache
-> Source
-> PackageName
-> Version
-> IO (Either MetadataError VersionRead)
-> IO (PreparedStore MetadataError VersionRead)
prepareVersion MetricsPort
metrics MetadataCache
cache Source
source PackageName
name Version
version IO (Either MetadataError VersionRead)
fetch IO (PreparedStore MetadataError VersionRead)
-> (PreparedStore MetadataError VersionRead
    -> IO (Either MetadataError VersionRead))
-> IO (Either MetadataError VersionRead)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= PreparedStore MetadataError VersionRead
-> IO (Either MetadataError VersionRead)
forall e v. PreparedStore e v -> IO (Either e v)
executePrepared

-- | Pin a selected local value, including absence, before any remote work.
prepareVersion :: MetricsPort -> MetadataCache -> Source -> PackageName -> Version -> IO (Either MetadataError VersionRead) -> IO (PreparedStore MetadataError VersionRead)
prepareVersion :: MetricsPort
-> MetadataCache
-> Source
-> PackageName
-> Version
-> IO (Either MetadataError VersionRead)
-> IO (PreparedStore MetadataError VersionRead)
prepareVersion MetricsPort
metrics MetadataCache
cache Source
source PackageName
name Version
version =
    (CacheResult -> IO ())
-> (CacheOccupancy -> IO ())
-> IO ()
-> SingleFlight MetadataError Text VersionRead
-> Text
-> IO (Either MetadataError VersionRead)
-> IO (PreparedStore MetadataError VersionRead)
forall k e v.
Ord k =>
(CacheResult -> IO ())
-> (CacheOccupancy -> IO ())
-> IO ()
-> SingleFlight e k v
-> k
-> IO (Either e v)
-> IO (PreparedStore e v)
prepareStore
        (MetricsPort -> CacheResult -> IO ()
mpVersionCacheRequest MetricsPort
metrics)
        (MetricsPort -> Int -> IO ()
mpVersionCacheResidentBytes MetricsPort
metrics (Int -> IO ())
-> (CacheOccupancy -> Int) -> CacheOccupancy -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CacheOccupancy -> Int
occBytes)
        (MetricsPort -> CacheStore -> IO ()
mpCacheRefused MetricsPort
metrics CacheStore
Metric.VersionStore)
        (MetadataCache -> SingleFlight MetadataError Text VersionRead
mcVersion MetadataCache
cache)
        (Source -> PackageName -> Version -> Text
versionKey Source
source PackageName
name Version
version)

-- | Memoise a response under the content digest of this request's authorised inputs.
resolveAssembled :: MetricsPort -> MetadataCache -> Text -> IO ByteString -> IO ByteString
resolveAssembled :: MetricsPort
-> MetadataCache -> Text -> IO ByteString -> IO ByteString
resolveAssembled MetricsPort
metrics MetadataCache
cache Text
key IO ByteString
render =
    (Void -> ByteString)
-> (ByteString -> ByteString)
-> Either Void ByteString
-> ByteString
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either Void -> ByteString
forall a. Void -> a
absurd ByteString -> ByteString
forall a. a -> a
id
        (Either Void ByteString -> ByteString)
-> IO (Either Void ByteString) -> IO ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (CacheResult -> IO ())
-> (CacheOccupancy -> IO ())
-> IO ()
-> SingleFlight Void Text ByteString
-> Text
-> IO (Either Void ByteString)
-> IO (Either Void ByteString)
forall k e v.
Ord k =>
(CacheResult -> IO ())
-> (CacheOccupancy -> IO ())
-> IO ()
-> SingleFlight e k v
-> k
-> IO (Either e v)
-> IO (Either e v)
resolveSingleFlight
            (MetricsPort -> CacheResult -> IO ()
mpAssembledCacheRequest MetricsPort
metrics)
            (MetricsPort -> Int -> IO ()
mpAssembledCacheResidentBytes MetricsPort
metrics (Int -> IO ())
-> (CacheOccupancy -> Int) -> CacheOccupancy -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CacheOccupancy -> Int
occBytes)
            (MetricsPort -> CacheStore -> IO ()
mpCacheRefused MetricsPort
metrics CacheStore
Metric.AssembledStore)
            (MetadataCache -> SingleFlight Void Text ByteString
mcAssembled MetadataCache
cache)
            Text
key
            (ByteString -> Either Void ByteString
forall a b. b -> Either a b
Right (ByteString -> Either Void ByteString)
-> IO ByteString -> IO (Either Void ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO ByteString
render)

recordFullOccupancy :: MetricsPort -> CacheOccupancy -> IO ()
recordFullOccupancy :: MetricsPort -> CacheOccupancy -> IO ()
recordFullOccupancy MetricsPort
metrics CacheOccupancy
occ = do
    MetricsPort -> Int -> IO ()
mpCacheEntries MetricsPort
metrics (CacheOccupancy -> Int
occEntries CacheOccupancy
occ)
    MetricsPort -> Int -> IO ()
mpCacheResidentBytes MetricsPort
metrics (CacheOccupancy -> Int
occBytes CacheOccupancy
occ)