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

-- | Optional retention with bounded external operations and backend-owned codecs.
module Ecluse.Core.Server.Cache.Backend (
    RetentionBackend,
    RetentionOperations (..),
    BackendStorage (..),
    Recency (..),
    CacheOccupancy (..),
    retentionBackend,
    supportsFullRetention,
) where

import UnliftIO.Exception (tryAny)
import UnliftIO.Timeout (timeout)

import Ecluse.Core.Server.Cache.Backend.Internal

{- | Build storage independently of request coalescing. External deadlines cap at one second.
Adapters own TTL, bounded decoding, identity validation, and storage representation.
-}
retentionBackend ::
    BackendStorage ->
    RetentionOperations k v ->
    RetentionBackend k v
retentionBackend :: forall k v.
BackendStorage -> RetentionOperations k v -> RetentionBackend k v
retentionBackend BackendStorage
storage RetentionOperations k v
operations =
    RetentionBackend
        { rbStorage :: BackendStorage
rbStorage = BackendStorage
storage
        , rbLookup :: (CacheOccupancy -> IO ()) -> IO () -> Recency -> k -> IO (Maybe v)
rbLookup = \CacheOccupancy -> IO ()
record IO ()
failed Recency
recency k
key -> BackendStorage -> IO () -> Maybe v -> IO (Maybe v) -> IO (Maybe v)
forall a. BackendStorage -> IO () -> a -> IO a -> IO a
runBackend BackendStorage
storage IO ()
failed Maybe v
forall a. Maybe a
Nothing (RetentionOperations k v
-> (CacheOccupancy -> IO ()) -> Recency -> k -> IO (Maybe v)
forall k v.
RetentionOperations k v
-> (CacheOccupancy -> IO ()) -> Recency -> k -> IO (Maybe v)
roLookup RetentionOperations k v
operations CacheOccupancy -> IO ()
record Recency
recency k
key)
        , rbInsert :: (CacheOccupancy -> IO ()) -> IO () -> IO () -> k -> v -> IO ()
rbInsert = \CacheOccupancy -> IO ()
record IO ()
refused IO ()
failed k
key v
value -> BackendStorage -> IO () -> () -> IO () -> IO ()
forall a. BackendStorage -> IO () -> a -> IO a -> IO a
runBackend BackendStorage
storage IO ()
failed () (RetentionOperations k v
-> (CacheOccupancy -> IO ()) -> IO () -> k -> v -> IO ()
forall k v.
RetentionOperations k v
-> (CacheOccupancy -> IO ()) -> IO () -> k -> v -> IO ()
roInsert RetentionOperations k v
operations CacheOccupancy -> IO ()
record IO ()
refused k
key v
value)
        }

runBackend :: BackendStorage -> IO () -> a -> IO a -> IO a
runBackend :: forall a. BackendStorage -> IO () -> a -> IO a -> IO a
runBackend BackendStorage
storage IO ()
failed a
fallback IO a
action = case BackendStorage
storage of
    BackendStorage
LocalStorage -> IO a
action
    ExternalStorage Int
micros -> do
        result <- IO (Maybe a) -> IO (Either SomeException (Maybe a))
forall (m :: * -> *) a.
MonadUnliftIO m =>
m a -> m (Either SomeException a)
tryAny (Int -> IO a -> IO (Maybe a)
forall (m :: * -> *) a.
MonadUnliftIO m =>
Int -> m a -> m (Maybe a)
timeout (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
1 (Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
1_000_000 Int
micros)) IO a
action)
        case result of
            Right (Just a
value) -> a -> IO a
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
value
            Either SomeException (Maybe a)
_ -> IO ()
failed IO () -> a -> IO a
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> a
fallback

-- | Only external storage is eligible to retain full metadata.
supportsFullRetention :: BackendStorage -> Bool
supportsFullRetention :: BackendStorage -> Bool
supportsFullRetention = \case
    BackendStorage
LocalStorage -> Bool
False
    ExternalStorage Int
_ -> Bool
True