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

{- | Conservative accounting for selectively decoded releases.
The cache charges backing allocations and repeated structures without deduplicating sharing.
A retained raw version object is charged on the shared wire-to-resident model, without encoding it.
-}
module Ecluse.Core.Server.Cache.VersionWeight (weighVersion, weighEntryKey) where

import Data.Text.Short qualified as TS
import Data.Text.Unsafe (lengthWord8)
import Data.Time (UTCTime (..), diffTimeToPicoseconds, toModifiedJulianDay)

import Ecluse.Core.Package
import Ecluse.Core.Package.Entry (EntryKey (..))
import Ecluse.Core.Registry.CachedDocument (CachedDoc, weighCachedDoc)
import Ecluse.Core.Registry.Metadata (VersionDoc (vdDetails, vdRaw), VersionRead (vrUpstreamLatest, vrVersion))
import Ecluse.Core.Server.MemoryModel (expandWireBytes)
import Ecluse.Core.Text (textStorageBytes)
import Ecluse.Core.Version (renderVersion)

-- | Estimate retained release bytes. 'maxBound' marks an uncacheable saturated estimate.
weighVersion :: VersionRead -> Int
weighVersion :: VersionRead -> Int
weighVersion VersionRead
versionRead =
    Integer -> Int
forall a. Num a => Integer -> a
fromInteger (Integer -> Integer -> Integer
forall a. Ord a => a -> a -> a
min (Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Int
forall a. Bounded a => a
maxBound :: Int)) (Integer
versionPart Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
latestPart))
  where
    versionPart :: Integer
versionPart = Integer -> (VersionDoc -> Integer) -> Maybe VersionDoc -> Integer
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Integer
1024 VersionDoc -> Integer
pairWeight (VersionRead -> Maybe VersionDoc
vrVersion VersionRead
versionRead)
    latestPart :: Integer
latestPart = Integer -> (Version -> Integer) -> Maybe Version -> Integer
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Integer
0 (Text -> Integer
textWeight (Text -> Integer) -> (Version -> Text) -> Version -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Version -> Text
renderVersion) (VersionRead -> Maybe Version
vrUpstreamLatest VersionRead
versionRead)

pairWeight :: VersionDoc -> Integer
pairWeight :: VersionDoc -> Integer
pairWeight VersionDoc
doc = PackageDetails -> Integer
detailsWeight (VersionDoc -> PackageDetails
vdDetails VersionDoc
doc) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer -> (CachedDoc -> Integer) -> Maybe CachedDoc -> Integer
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Integer
0 CachedDoc -> Integer
rawWeight (VersionDoc -> Maybe CachedDoc
vdRaw VersionDoc
doc)

{- The raw object on the full store's measure, its compact-encoded size scaled by the shared
expansion, estimated by one walk of the tree so the serve path never encodes it. -}
rawWeight :: CachedDoc -> Integer
rawWeight :: CachedDoc -> Integer
rawWeight = Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Int -> Integer) -> (CachedDoc -> Int) -> CachedDoc -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int
expandWireBytes (Int -> Int) -> (CachedDoc -> Int) -> CachedDoc -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Int) -> (CachedDoc -> Int64) -> CachedDoc -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CachedDoc -> Int64
weighCachedDoc

detailsWeight :: PackageDetails -> Integer
detailsWeight :: PackageDetails -> Integer
detailsWeight PackageDetails
details =
    -- The base covers the entry, package record, scalar tags, and wrappers.
    -- Artifact node allowances include the size as well as record fields.
    Integer
16 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
1024
        Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ PackageName -> Integer
nameWeight (PackageDetails -> PackageName
pkgName PackageDetails
details)
        Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Text -> Integer
textWeight Text
rawVersion
        Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
256 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Int -> Integer
forall a. Integral a => a -> Integer
toInteger Int
rawLength
        Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer -> (UTCTime -> Integer) -> Maybe UTCTime -> Integer
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Integer
0 UTCTime -> Integer
timeWeight (PackageDetails -> Maybe UTCTime
pkgPublishedAt PackageDetails
details)
        Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ CodeExecSignal -> Integer
installWeight (PackageDetails -> CodeExecSignal
pkgInstallCode PackageDetails
details)
        Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Availability -> Integer
availabilityWeight (PackageDetails -> Availability
pkgAvailability PackageDetails
details)
        Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ (Artifact -> Integer) -> NonEmpty Artifact -> Integer
forall (f :: * -> *) a.
Foldable f =>
(a -> Integer) -> f a -> Integer
itemsWeight Artifact -> Integer
artifactWeight (PackageDetails -> NonEmpty Artifact
pkgArtifacts PackageDetails
details)
  where
    -- The opaque parsed version has flat token lists and bounded numeric components.
    -- The per-byte allowance also covers RubyGems hyphen expansion and copied parser text.
    rawVersion :: Text
rawVersion = Version -> Text
renderVersion (PackageDetails -> Version
pkgVersion PackageDetails
details)
    rawLength :: Int
rawLength = Text -> Int
lengthWord8 Text
rawVersion

nameWeight :: PackageName -> Integer
nameWeight :: PackageName -> Integer
nameWeight PackageName
name =
    [Integer] -> Integer
forall a (f :: * -> *). (Foldable f, Num a) => f a -> a
sum ((ShortText -> Integer) -> [ShortText] -> [Integer]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> Integer
textWeight (Text -> Integer) -> (ShortText -> Text) -> ShortText -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShortText -> Text
TS.toText) [PackageName -> ShortText
pkgCanonical PackageName
name, PackageName -> ShortText
pkgBaseName PackageName
name])
        Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Text -> Integer
textWeight (PackageName -> Text
renderPackageName PackageName
name)
        Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer -> (Scope -> Integer) -> Maybe Scope -> Integer
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Integer
0 (Text -> Integer
textWeight (Text -> Integer) -> (Scope -> Text) -> Scope -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Scope -> Text
renderScope) (PackageName -> Maybe Scope
pkgNamespace PackageName
name)

-- Decimal digits overestimate Integer payload bytes without depending on its heap layout.
timeWeight :: UTCTime -> Integer
timeWeight :: UTCTime -> Integer
timeWeight (UTCTime Day
day DiffTime
time) =
    Text -> Integer
textWeight (Integer -> Text
forall b a. (Show a, IsString b) => a -> b
show (Day -> Integer
toModifiedJulianDay Day
day)) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Text -> Integer
textWeight (Integer -> Text
forall b a. (Show a, IsString b) => a -> b
show (DiffTime -> Integer
diffTimeToPicoseconds DiffTime
time))

-- Text slices can retain an entire input allocation. Count that allocation each time.
textWeight :: Text -> Integer
textWeight :: Text -> Integer
textWeight Text
text = Integer
128 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Text -> Int
textStorageBytes Text
text)

-- The allowance covers a list cell, its element record, wrappers, and alignment.
itemsWeight :: (Foldable f) => (a -> Integer) -> f a -> Integer
itemsWeight :: forall (f :: * -> *) a.
Foldable f =>
(a -> Integer) -> f a -> Integer
itemsWeight a -> Integer
weigh = (Integer -> a -> Integer) -> Integer -> f a -> Integer
forall b a. (b -> a -> b) -> b -> f a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\Integer
total a
value -> Integer
total Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
256 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ a -> Integer
weigh a
value) Integer
0

installWeight :: CodeExecSignal -> Integer
installWeight :: CodeExecSignal -> Integer
installWeight = \case
    CodeExecSignal
NoCodeOnInstall -> Integer
0
    RunsCodeOnInstall Text
reason -> Text -> Integer
textWeight Text
reason
    CodeExecSignal
CodeExecUnknown -> Integer
0

availabilityWeight :: Availability -> Integer
availabilityWeight :: Availability -> Integer
availabilityWeight = \case
    Availability
Available -> Integer
0
    Deprecated Text
reason -> Text -> Integer
textWeight Text
reason
    Yanked Maybe Text
reason -> Integer -> (Text -> Integer) -> Maybe Text -> Integer
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Integer
0 Text -> Integer
textWeight Maybe Text
reason

artifactWeight :: Artifact -> Integer
artifactWeight :: Artifact -> Integer
artifactWeight Artifact
artifact =
    EntryKey -> Integer
weighEntryKey (Artifact -> EntryKey
artEntryKey Artifact
artifact)
        Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Text -> Integer
textWeight (Artifact -> Text
artFilename Artifact
artifact)
        Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Text -> Integer
textWeight (Artifact -> Text
artUrl Artifact
artifact)
        Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ (Hash -> Integer) -> [Hash] -> Integer
forall (f :: * -> *) a.
Foldable f =>
(a -> Integer) -> f a -> Integer
itemsWeight (Text -> Integer
textWeight (Text -> Integer) -> (Hash -> Text) -> Hash -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hash -> Text
hashValue) (Artifact -> [Hash]
artHashes Artifact
artifact)

-- | Charge an entry coordinate, including any retained text backing allocation.
weighEntryKey :: EntryKey -> Integer
weighEntryKey :: EntryKey -> Integer
weighEntryKey = \case
    ArrayEntry Int
_ -> Integer
64
    ObjectEntry Text
key -> Integer
64 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Text -> Integer
textWeight Text
key
    EntryKey
SingletonEntry -> Integer
16