Cache.fs

namespace Sharpino

open System.Collections.Concurrent
open Microsoft.Extensions.Logging
open Microsoft.Extensions.Caching.Memory
open ZiggyCreatures.Caching.Fusion
open Microsoft.Extensions.Configuration
open Microsoft.Extensions.Hosting
open Sharpino
open Sharpino.Core
open Sharpino.Definitions
open System.Runtime.CompilerServices
open Microsoft.Extensions.Logging.Abstractions
open System.Collections
open FSharp.Core
open System
open System.Threading
open System.Threading.Tasks
open Microsoft.Extensions.Caching.Distributed
open ZiggyCreatures.Caching.Fusion.Backplane
open ZiggyCreatures.Caching.Fusion.Serialization

open Microsoft.Extensions.Caching.SqlServer
open Community.Microsoft.Extensions.Caching.PostgreSql
open Microsoft.Extensions.Caching.StackExchangeRedis
open Microsoft.Extensions.Options
open Microsoft.Extensions.DependencyInjection
open ZiggyCreatures.Caching.Fusion.Serialization.SystemTextJson
open System.Text.Json
open System.Text.Json.Serialization
open FsToolkit.ErrorHandling
open MQTTnet
open ZiggyCreatures.Caching.Fusion.Backplane.StackExchangeRedis

module Cache =
    let builder = Host.CreateApplicationBuilder()
    let env = Environment.GetEnvironmentVariable("ASPNETCORE_ENVIRONMENT")
    
    builder.Configuration
        .SetBasePath(AppDomain.CurrentDomain.BaseDirectory)
        .AddJsonFile("appSettings.json", optional=false, reloadOnChange=true) |> ignore
    
    if not (String.IsNullOrWhiteSpace env) then
        builder.Configuration.AddJsonFile($"appSettings.{env}.json", optional=true) |> ignore
        
    builder.Configuration.AddEnvironmentVariables() |> ignore
    let config = builder.Configuration
        
    let numProcs = Environment.ProcessorCount
    let concurrencyLevel = numProcs * 2

    let loggerFactory = LoggerFactory.Create(fun b ->
        if config.GetValue<bool>("Logging:Console", true) then
            b.AddConsole() |> ignore
        )
    let logger = loggerFactory.CreateLogger("Sharpino.Cache")

    let jsonOptions = JsonFSharpOptions.Default().ToJsonSerializerOptions()
    let serializer = new FusionCacheSystemTextJsonSerializer(jsonOptions)
    
    let setLogger (newLogger: Microsoft.Extensions.Logging.ILogger) =
        logger.LogError ("setting logger is not supported")
   
    type Refreshable<'A> =
        abstract member Refresh: unit -> Result<'A, string>

    type RefreshableAsync<'A> =
        abstract member RefreshAsync: Option<CancellationToken> -> TaskResult<'A, string>

    let mkRefreshableAsync (refresher: Option<CancellationToken> -> TaskResult<'A, string>) =
        { new RefreshableAsync<'A> with
            member this.RefreshAsync ct = refresher ct }

    let mkRefreshableAsyncFromSync (refresher: unit -> Result<'A, string>) =
        { new RefreshableAsync<'A> with
            member this.RefreshAsync _ = refresher () |> Task.FromResult }
   
    type DetailsCacheKey =
        | DetailsCacheKey of string * Guid  // string = type name (not System.Type, for JSON-serializability)
        with
            member this.Value =
                match this with
                | DetailsCacheKey (typeName, id) -> sprintf "%s:%A" typeName id
            static member OfType (t: Type) (id: Guid) =
                DetailsCacheKey (t.Name, id)
    
    type DetailsCache private () =
        let ignoreIncomingBackplane = config.GetValue<bool>("Cache:IgnoreIncomingBackplaneNotifications", false)
        let detailsOptions = FusionCacheOptions(
            CacheName = "statesDetails",
            CacheKeyPrefix = "statesDetails:",
            IgnoreIncomingBackplaneNotifications = ignoreIncomingBackplane
        )
        let statesDetails = new FusionCache(detailsOptions)
            
        let detailsCacheExpirationConfigInSeconds = config.GetValue<float>("DetailsCacheExpiration", 300)
        let detailsCacheDependenciesExpirationConfigInSeconds = config.GetValue<float>("DetailsCacheDependenciesExpiration", 301)
        let l2CacheExpirationConfigInSeconds = config.GetValue<float>("Cache:L2CacheExpirationSeconds", 120)
        
        let detailsEntryOptions =
            FusionCacheEntryOptions().
                SetDuration(TimeSpan.FromSeconds(detailsCacheExpirationConfigInSeconds))
        
        let detailsDependenciesEntryOptions =
            // L2 TTL is set separately and shorter than L1 to avoid stale entries polluting L1 on restarts
            let opts = FusionCacheEntryOptions().
                           SetDuration(TimeSpan.FromSeconds(detailsCacheDependenciesExpirationConfigInSeconds))
            opts.DistributedCacheDuration <- System.Nullable(TimeSpan.FromSeconds(l2CacheExpirationConfigInSeconds))
            opts

        let assocOptions = FusionCacheOptions(
            CacheName = "objectDetails",
            CacheKeyPrefix = "objectDetails:",
            IgnoreIncomingBackplaneNotifications = ignoreIncomingBackplane
        )
        let objectDetailsAssociationsCache = new FusionCache(assocOptions)
        
        let mutable _backplane: IFusionCacheBackplane option = None
        let detailsRefreshed = new Microsoft.FSharp.Control.Event<string * Guid>()
        
        static let instance = DetailsCache ()
        static member Instance = instance

        [<CLIEvent>]
        member this.OnDetailsRefreshed = detailsRefreshed.Publish
        
        member this.SetupL2AndBackplane(dc: IDistributedCache option, ser: IFusionCacheSerializer option, bp: IFusionCacheBackplane option) =
            if dc.IsSome && ser.IsSome then
                // NOTE: statesDetails intentionally does NOT use L2/SQL cache.
                // It stores Refreshable<'T> wrappers which contain live closures and
                // are fundamentally non-serializable (they carry System.Type references).
                // If we wire statesDetails to L2, System.Text.Json will throw
                // "Serialization of System.Type is not supported" on the first write.
                // Only objectDetailsAssociationsCache (which stores plain List<DetailsCacheKey>)
                // is safe to persist in L2.
                (objectDetailsAssociationsCache :> IFusionCache).SetupDistributedCache(dc.Value, ser.Value) |> ignore
            if bp.IsSome then
                let backplane = bp.Value
                _backplane <- Some backplane
                (statesDetails :> IFusionCache).SetupBackplane(backplane) |> ignore
                (objectDetailsAssociationsCache :> IFusionCache).SetupBackplane(backplane) |> ignore
                
                // FusionCache only auto-subscribes when managed by DI/IHostedService.
                // Since we instantiate it directly, we manually trigger the internal Subscribe() using reflection.
                let activateBackplane (fc: IFusionCache) =
                    let bpaProp = fc.GetType().GetProperty("BackplaneAccessor", System.Reflection.BindingFlags.Instance ||| System.Reflection.BindingFlags.NonPublic)
                    if not (isNull bpaProp) then
                        let bpa = bpaProp.GetValue(fc)
                        if not (isNull bpa) then
                            let subMethod = bpa.GetType().GetMethod("Subscribe", System.Reflection.BindingFlags.Instance ||| System.Reflection.BindingFlags.Public ||| System.Reflection.BindingFlags.NonPublic)
                            if not (isNull subMethod) then
                                subMethod.Invoke(bpa, [||]) |> ignore
                
                activateBackplane (statesDetails :> IFusionCache)
                activateBackplane (objectDetailsAssociationsCache :> IFusionCache)
                
                // Manually invalidate L1 cache when receiving backplane messages
                let receiverOptions = ZiggyCreatures.Caching.Fusion.FusionCacheEntryOptions().SetSkipBackplaneNotifications(true)
                
                statesDetails.Events.Backplane.add_MessageReceived(System.EventHandler<ZiggyCreatures.Caching.Fusion.Events.FusionCacheBackplaneMessageEventArgs>(fun sender e ->
                    if e.Message.SourceId <> statesDetails.InstanceId then
                        if e.Message.Action = ZiggyCreatures.Caching.Fusion.Backplane.BackplaneMessageAction.EntryRemove || e.Message.Action = ZiggyCreatures.Caching.Fusion.Backplane.BackplaneMessageAction.EntrySet then
                            let prefix = "statesDetails:"
                            if e.Message.CacheKey.StartsWith(prefix) then
                                let key = e.Message.CacheKey.Substring(prefix.Length)
                                statesDetails.Remove(key, receiverOptions)
                                logger.LogDebug (sprintf "[Cache Event] DetailsCache manually removed L1 entry for %s" key)
                ))
                
                objectDetailsAssociationsCache.Events.Backplane.add_MessageReceived(System.EventHandler<ZiggyCreatures.Caching.Fusion.Events.FusionCacheBackplaneMessageEventArgs>(fun sender e ->
                    if e.Message.SourceId <> objectDetailsAssociationsCache.InstanceId then
                        if e.Message.Action = ZiggyCreatures.Caching.Fusion.Backplane.BackplaneMessageAction.EntryRemove || e.Message.Action = ZiggyCreatures.Caching.Fusion.Backplane.BackplaneMessageAction.EntrySet then
                            let prefix = "objectDetails:"
                            if e.Message.CacheKey.StartsWith(prefix) then
                                let key = e.Message.CacheKey.Substring(prefix.Length)
                                objectDetailsAssociationsCache.Remove(key, receiverOptions)
                                logger.LogDebug (sprintf "[Cache Event] DetailsCache(Associations) manually removed L1 entry for %s" key)
                ))
            ()
            
        member this.UpdateMultipleAggregateIdAssociation (aggregateIds: AggregateId[]) (key: DetailsCacheKey) =
            for aggregateId in aggregateIds do
                let existingKeys = objectDetailsAssociationsCache.GetOrDefault<List<DetailsCacheKey>>(aggregateId.ToString(), Unchecked.defaultof<List<DetailsCacheKey>>)
                let updatedKeys = 
                    if isNull (box existingKeys) then
                        [key]
                    elif not (List.contains key existingKeys) then
                        key :: existingKeys
                    else
                        existingKeys
                objectDetailsAssociationsCache.Set(aggregateId.ToString(), updatedKeys, detailsDependenciesEntryOptions)
            ()
        
        member this.RefreshAsync (key: DetailsCacheKey, ct: Option<CancellationToken>) =
            task {
                let v = statesDetails.GetOrDefault<obj>(key.Value, null)
                if (obj.ReferenceEquals(v, null)) then
                    return Error "not found"
                else 
                    let interfaces = v.GetType().GetInterfaces()
                    let refreshableInterface = interfaces |> Array.tryFind (fun i -> i.IsGenericType && i.GetGenericTypeDefinition() = typedefof<RefreshableAsync<_>>)
                    
                    match refreshableInterface with
                    | Some ri ->
                        let refreshMethod = v.GetType().GetMethod("RefreshAsync")
                        let refreshedTask = refreshMethod.Invoke(v, [| ct |]) :?> Task
                        
                        do! refreshedTask.ContinueWith(ignore) |> Async.AwaitTask
                        
                        let refreshed = refreshedTask.GetType().GetProperty("Result").GetValue(refreshedTask)
                        let resultType = ri.GetGenericArguments().[0]
                        let result = 
                            try
                                // Create a Result<obj, string> from the refreshed object
                                let resultFullType = typedefof<Result<_, _>>.MakeGenericType([| resultType; typeof<string> |])
                                let okValue = resultFullType.GetProperty("IsOk").GetValue(refreshed)
                                if unbox<bool> okValue then
                                    let value = resultFullType.GetProperty("ResultValue").GetValue(refreshed)
                                    Ok value
                                else
                                    // I assume that if an element is not refreshable anymore it means that it should be evicted
                                    this.Evict key
                                    let error = resultFullType.GetProperty("ErrorValue").GetValue(refreshed) :?> string
                                    Error error
                            with ex ->
                                Error (sprintf "Error processing refresh result: %s" ex.Message)
                        
                        match result with
                        | Ok resultObj ->
                            // Update the cache directly without going through TryCache
                            try
                                let keyStr = key.Value
                                statesDetails.Set<obj>(keyStr, resultObj, detailsEntryOptions)
                                if _backplane.IsSome then
                                    let fullKey = "statesDetails:" + keyStr
                                    let msg = ZiggyCreatures.Caching.Fusion.Backplane.BackplaneMessage.CreateForEntrySet(
                                        statesDetails.InstanceId, 
                                        fullKey, 
                                        System.DateTimeOffset.UtcNow.ToUnixTimeMilliseconds()
                                    )
                                    _backplane.Value.PublishAsync(msg, detailsEntryOptions, System.Threading.CancellationToken.None).AsTask() |> ignore
                                match key with
                                | DetailsCacheKey (typeName, id) -> detailsRefreshed.Trigger(typeName, id)
                                return Ok resultObj
                            with e ->
                                logger.LogError (sprintf "error: cache update failed. %A\n" e)
                                statesDetails.Clear()
                                return Error "Failed to update cache"
                        | Error e -> return Error e
                    | _ -> return Error "Object does not implement RefreshableAsync interface"
            }
        
        member this.Evict (key: DetailsCacheKey)  =
            let keyStr = key.Value
            statesDetails.Remove keyStr
            if _backplane.IsSome then
                let fullKey = "statesDetails:" + keyStr
                let msg = ZiggyCreatures.Caching.Fusion.Backplane.BackplaneMessage.CreateForEntryRemove(
                    statesDetails.InstanceId, 
                    fullKey, 
                    System.DateTimeOffset.UtcNow.ToUnixTimeMilliseconds()
                )
                _backplane.Value.PublishAsync(msg, detailsEntryOptions, System.Threading.CancellationToken.None).AsTask() |> ignore

        member this.RefreshDependentDetails (aggregateId: AggregateId) =
            let keys = objectDetailsAssociationsCache.GetOrDefault<List<DetailsCacheKey>>(aggregateId.ToString(), Unchecked.defaultof<List<DetailsCacheKey>>)
            if not (obj.ReferenceEquals(keys, null)) then
                for key in keys do
                    let! _ = this.RefreshAsync (key, None)
                    ()

        member this.RefreshDependentDetailsAsync (aggregateId: AggregateId, ct: Option<CancellationToken>) =
            task {
                let keys = objectDetailsAssociationsCache.GetOrDefault<List<DetailsCacheKey>>(aggregateId.ToString(), Unchecked.defaultof<List<DetailsCacheKey>>)
                if not (obj.ReferenceEquals(keys, null)) then
                    for key in keys do
                        let! _ = this.RefreshAsync (key, ct)
                        ()
            }

        member this.RefreshDependentDetailsSafeFireAndForget (aggregateIds: seq<AggregateId>) =
            Task.Run(fun () ->
                task {
                    try
                        let tasks = 
                            aggregateIds 
                            |> Seq.map (fun id -> this.RefreshDependentDetailsAsync(id, Some CancellationToken.None))
                            |> Seq.toArray
                        if tasks.Length > 0 then
                            do! Task.WhenAll tasks :> Task
                    with ex ->
                        logger.LogError(sprintf "Error in RefreshDependentDetailsSafeFireAndForget: %s" ex.Message)
                } :> Task
            ) |> ignore
        
        member this.evictDependentDetails (aggregateId: AggregateId) =
            let keys = objectDetailsAssociationsCache.GetOrDefault<List<DetailsCacheKey>>(aggregateId.ToString(), Unchecked.defaultof<List<DetailsCacheKey>>)
            if not (obj.ReferenceEquals(keys, null)) then
                for key in keys do
                    this.Evict key
                ()
        
        member private this.TryCacheAsync (key: string, value: RefreshableAsync<_>) =
            try
                statesDetails.Set<obj>(key, value, detailsEntryOptions)
                if _backplane.IsSome then
                    let fullKey = "statesDetails:" + key
                    let msg = ZiggyCreatures.Caching.Fusion.Backplane.BackplaneMessage.CreateForEntrySet(
                        statesDetails.InstanceId, 
                        fullKey, 
                        System.DateTimeOffset.UtcNow.ToUnixTimeMilliseconds()
                    )
                    _backplane.Value.PublishAsync(msg, detailsEntryOptions, System.Threading.CancellationToken.None).AsTask() |> ignore
            with e ->
                logger.LogError (sprintf "error: cache is doing something wrong. Resetting. %A\n" e)
                statesDetails.Clear()
                ()
                    
        member this.Memoize (f: unit -> Result<RefreshableAsync<_>*List<AggregateId>, string>) (key: DetailsCacheKey) =
            let v = statesDetails.GetOrDefault<obj>(key.Value, null)
            if not (obj.ReferenceEquals(v, null)) then
                v |> unbox |> Ok
            else
                let res = f()
                match res with
                | Ok (result, dependendIds) ->
                    this.TryCacheAsync (key.Value, result)
                    this.UpdateMultipleAggregateIdAssociation (dependendIds |> List.toArray) key 
                    Ok result
                | Error e ->
                    Error e

        member this.MemoizeAsync (f: Option<CancellationToken> -> Task<Result<RefreshableAsync<_>*List<AggregateId>, string>>) (key: DetailsCacheKey) (ct: Option<CancellationToken>) =
            task {
                let v = statesDetails.GetOrDefault<obj>(key.Value, null)
                if not (obj.ReferenceEquals(v, null)) then
                    return v |> unbox |> Ok
                else
                    let! res = f ct
                    match res with
                    | Ok (result, dependendIds) ->
                        this.TryCacheAsync (key.Value, result)
                        this.UpdateMultipleAggregateIdAssociation (dependendIds |> List.toArray) key 
                        return Ok result
                    | Error e ->
                        return Error e
            }
        
        member this.Clear () =
            statesDetails.Clear()
            objectDetailsAssociationsCache.Clear()

        member this.ClearL1 () =
            statesDetails.Clear(true)
            objectDetailsAssociationsCache.Clear(true)

        member this.ClearL2 () =
            statesDetails.Clear(false)
            objectDetailsAssociationsCache.Clear(false)

    [<CLIMutable>]
    type CachedAggregateEntry = {
        EventId: EventId
        TypeName: string
        StateJson: string
        [<System.Text.Json.Serialization.JsonIgnore>]
        mutable BoxedState: obj option
    }

    type AggregateCache3 private () =
        let ignoreIncomingBackplane = config.GetValue<bool>("Cache:IgnoreIncomingBackplaneNotifications", false)
        let aggregateOptions = FusionCacheOptions(
            CacheName = "statePerAggregate",
            CacheKeyPrefix = "statePerAggregate:",
            IgnoreIncomingBackplaneNotifications = ignoreIncomingBackplane
        )
        let statePerAggregate = new FusionCache(aggregateOptions)
        let cacheExpirationConfigInSeconds = config.GetValue<float>("AggregateCacheExpiration", 600)
        let l2CacheExpirationConfigInSeconds = config.GetValue<float>("Cache:L2CacheExpirationSeconds", 120)
        let entryOptions =
            // L2 TTL is shorter than L1 to prevent stale aggregate states from polluting L1 on node restarts
            let opts = FusionCacheEntryOptions().
                           SetDuration(TimeSpan.FromSeconds(cacheExpirationConfigInSeconds))
            opts.DistributedCacheDuration <- System.Nullable(TimeSpan.FromSeconds(l2CacheExpirationConfigInSeconds))
            opts
        
        let mutable _backplane: IFusionCacheBackplane option = None

        let maxCacheSize = config.GetValue<int>("Cache:AggregateCacheMaxSize", 1000)
        let maxMemoryBytes = int64 (config.GetValue<int>("Cache:AggregateCacheMaxMemoryMegabytes", 0)) * 1024L * 1024L
        let memoryLoadThreshold = config.GetValue<double>("Cache:AggregateCacheMemoryLoadThreshold", 0.85)
        let minEvictBatchSize = config.GetValue<int>("Cache:AggregateCacheMinEvictBatchSize", 10)

        let lruList = System.Collections.Generic.LinkedList<string>()
        let lruDict = System.Collections.Generic.Dictionary<string, System.Collections.Generic.LinkedListNode<string>>()
        let lruLock = obj()

        let checkMemoryLimits () =
            let mutable shouldEvict = false
            
            // Check total system memory load
            if memoryLoadThreshold > 0.0 then
                let gcInfo = GC.GetGCMemoryInfo()
                if gcInfo.TotalAvailableMemoryBytes > 0L then
                    let loadRatio = (double gcInfo.MemoryLoadBytes) / (double gcInfo.TotalAvailableMemoryBytes)
                    if loadRatio > memoryLoadThreshold then
                        shouldEvict <- true

            // Check process memory limit
            if not shouldEvict && maxMemoryBytes > 0L then
                use proc = System.Diagnostics.Process.GetCurrentProcess()
                if proc.WorkingSet64 > maxMemoryBytes then
                    shouldEvict <- true
                    
            shouldEvict

        let recordAccess (key: string) =
            lock lruLock (fun () ->
                // 1. Update LRU access order
                match lruDict.TryGetValue(key) with
                | true, node ->
                    lruList.Remove(node)
                    lruList.AddLast(node)
                | false, _ ->
                    let newNode = lruList.AddLast(key)
                    lruDict.[key] <- newNode

                // 2. Enforce item count limit
                if maxCacheSize > 0 then
                    while lruList.Count > maxCacheSize && lruList.Count > 0 do
                        let oldestKey = lruList.First.Value
                        lruList.RemoveFirst()
                        lruDict.Remove(oldestKey) |> ignore
                        statePerAggregate.Remove(oldestKey) |> ignore

                // 3. Enforce memory limits
                if checkMemoryLimits() then
                    let mutable evictedCount = 0
                    while lruList.Count > 0 && (checkMemoryLimits() || (evictedCount < minEvictBatchSize)) do
                        let oldestKey = lruList.First.Value
                        lruList.RemoveFirst()
                        lruDict.Remove(oldestKey) |> ignore
                        statePerAggregate.Remove(oldestKey) |> ignore
                        evictedCount <- evictedCount + 1
            )

        static let instance = AggregateCache3()
        static member Instance = instance
        
        member this.SetupL2AndBackplane(dc: IDistributedCache option, ser: IFusionCacheSerializer option, bp: IFusionCacheBackplane option) =
            if dc.IsSome && ser.IsSome then
                (statePerAggregate :> IFusionCache).SetupDistributedCache(dc.Value, ser.Value) |> ignore
            if bp.IsSome then
                let backplane = bp.Value
                _backplane <- Some backplane
                (statePerAggregate :> IFusionCache).SetupBackplane(backplane) |> ignore
                
                // Activate backplane manually via reflection
                let bpaProp = statePerAggregate.GetType().GetProperty("BackplaneAccessor", System.Reflection.BindingFlags.Instance ||| System.Reflection.BindingFlags.NonPublic)
                if not (isNull bpaProp) then
                    let bpa = bpaProp.GetValue(statePerAggregate)
                    if not (isNull bpa) then
                        let subMethod = bpa.GetType().GetMethod("Subscribe", System.Reflection.BindingFlags.Instance ||| System.Reflection.BindingFlags.Public ||| System.Reflection.BindingFlags.NonPublic)
                        if not (isNull subMethod) then
                            subMethod.Invoke(bpa, [||]) |> ignore
                            logger.LogInformation (sprintf "[Cache] AggregateCache3: HasBackplane = %A" statePerAggregate.HasBackplane)
                            
                            let usableMethod = bpa.GetType().GetMethod("IsCurrentlyUsable", System.Reflection.BindingFlags.Instance ||| System.Reflection.BindingFlags.Public ||| System.Reflection.BindingFlags.NonPublic)
                            if not (isNull usableMethod) then
                                logger.LogInformation (sprintf "[Cache] AggregateCache3: IsCurrentlyUsable = %A" (usableMethod.Invoke(bpa, [| null; null |])))
                            logger.LogInformation (sprintf "[Cache] AggregateCache3: SkipBackplane = %A" entryOptions.SkipBackplaneNotifications)
                
                // Add event listeners (evicts only L1 upon EntrySet so L2 remains intact)
                let receiverOptions =
                    let opt = ZiggyCreatures.Caching.Fusion.FusionCacheEntryOptions()
                    opt.SkipBackplaneNotifications <- true
                    opt.SkipDistributedCacheRead <- true
                    opt.SkipDistributedCacheWrite <- true
                    opt
                statePerAggregate.Events.Backplane.add_MessagePublished(System.EventHandler<ZiggyCreatures.Caching.Fusion.Events.FusionCacheBackplaneMessageEventArgs>(fun sender e ->
                    logger.LogDebug (sprintf "[Cache Event] MessagePublished: Action=%A, Key=%s, SourceId=%s" e.Message.Action e.Message.CacheKey e.Message.SourceId)
                ))
                statePerAggregate.Events.Backplane.add_MessageReceived(System.EventHandler<ZiggyCreatures.Caching.Fusion.Events.FusionCacheBackplaneMessageEventArgs>(fun sender e ->
                    logger.LogDebug (sprintf "[Cache Event] MessageReceived: Action=%A, Key=%s, SourceId=%s" e.Message.Action e.Message.CacheKey e.Message.SourceId)
                    // Manually invalidate L1 cache
                    if e.Message.SourceId <> statePerAggregate.InstanceId then
                        if e.Message.Action = ZiggyCreatures.Caching.Fusion.Backplane.BackplaneMessageAction.EntryRemove || e.Message.Action = ZiggyCreatures.Caching.Fusion.Backplane.BackplaneMessageAction.EntrySet then
                            let prefix = "statePerAggregate:"
                            if e.Message.CacheKey.StartsWith(prefix) then
                                let key = e.Message.CacheKey.Substring(prefix.Length)
                                statePerAggregate.Remove(key, receiverOptions)

                                lock lruLock (fun () ->
                                    match lruDict.TryGetValue(key) with
                                    | true, node ->
                                        lruList.Remove(node)
                                        lruDict.Remove(key) |> ignore
                                    | false, _ -> ()
                                )

                                let (isGuid, guidKey) = Guid.TryParse(key)
                                if isGuid then
                                    DetailsCache.Instance.RefreshDependentDetailsAsync(guidKey, Some CancellationToken.None) |> ignore
                                else
                                    logger.LogWarning (sprintf "[Cache Event] AggregateCache3: Could not parse Guid from key %s" key)
                                logger.LogDebug (sprintf "[Cache Event] AggregateCache3 manually removed L1 entry for %s" key)
                ))
            ()

        member this.Memoize2 (eventId: EventId, x:'A) (aggregateId: AggregateId) =
            let key = aggregateId.ToString()
            this.Clean aggregateId
            let boxed: obj = box x
            let typeName = boxed.GetType().AssemblyQualifiedName
            let json: string = System.Text.Json.JsonSerializer.Serialize(boxed, boxed.GetType(), jsonOptions)
            let entry = {
                EventId = eventId
                TypeName = typeName
                StateJson = json
                BoxedState = Some boxed
            }
            try
                statePerAggregate.Set<CachedAggregateEntry>(key, entry, entryOptions)
                recordAccess key
                
                if _backplane.IsSome then
                    let fullKey = "statePerAggregate:" + key
                    let msg = ZiggyCreatures.Caching.Fusion.Backplane.BackplaneMessage.CreateForEntrySet(
                        statePerAggregate.InstanceId, 
                        fullKey, 
                        System.DateTimeOffset.UtcNow.ToUnixTimeMilliseconds()
                    )
                    _backplane.Value.PublishAsync(msg, entryOptions, System.Threading.CancellationToken.None).AsTask() |> ignore
            with e -> 
                logger.LogError (sprintf "error: cache is doing something wrong. Resetting. %A\n" e)
                statePerAggregate.Clear()
                DetailsCache.Instance.Clear()
                () 
    
        member this.Clean (aggregateId: AggregateId) =
            let key = aggregateId.ToString()
            lock lruLock (fun () ->
                match lruDict.TryGetValue(key) with
                | true, node ->
                    lruList.Remove(node)
                    lruDict.Remove(key) |> ignore
                | false, _ -> ()
            )
            statePerAggregate.Remove(key)
            if _backplane.IsSome then
                let fullKey = "statePerAggregate:" + key
                let msg = ZiggyCreatures.Caching.Fusion.Backplane.BackplaneMessage.CreateForEntryRemove(
                    statePerAggregate.InstanceId, 
                    fullKey, 
                    System.DateTimeOffset.UtcNow.ToUnixTimeMilliseconds()
                )
                _backplane.Value.PublishAsync(msg, entryOptions, System.Threading.CancellationToken.None).AsTask() |> ignore
        
        member this.Clear () =
            lock lruLock (fun () ->
                lruList.Clear()
                lruDict.Clear()
            )
            statePerAggregate.Clear()

        member this.ClearL1 () =
            lock lruLock (fun () ->
                lruList.Clear()
                lruDict.Clear()
            )
            let mcaProp = statePerAggregate.GetType().GetProperty("MemoryCacheAccessor", System.Reflection.BindingFlags.Instance ||| System.Reflection.BindingFlags.NonPublic)
            if not (isNull mcaProp) then
                let mca = mcaProp.GetValue(statePerAggregate)
                if not (isNull mca) then
                    let tryClearMethod = mca.GetType().GetMethod("TryClear", System.Reflection.BindingFlags.Instance ||| System.Reflection.BindingFlags.Public ||| System.Reflection.BindingFlags.NonPublic)
                    if not (isNull tryClearMethod) then
                        tryClearMethod.Invoke(mca, [||]) |> ignore

        member this.ClearL2 () =
            let opt = ZiggyCreatures.Caching.Fusion.FusionCacheEntryOptions()
            opt.SkipMemoryCacheRead <- true
            opt.SkipMemoryCacheWrite <- true
            opt.SkipBackplaneNotifications <- true
            statePerAggregate.Clear(false, opt)
        
        member this.GetEntry (aggregateId: AggregateId) : CachedAggregateEntry option =
            let key = aggregateId.ToString()
            let entry = statePerAggregate.GetOrDefault<CachedAggregateEntry>(key, null)
            if not (obj.ReferenceEquals(entry, null)) then
                recordAccess key
                Some entry
            else
                None

        member this.GetEntryAsync (aggregateId: AggregateId, ?ct: CancellationToken) : Task<CachedAggregateEntry option> =
            task {
                let key = aggregateId.ToString()
                let token = defaultArg ct CancellationToken.None
                let! entry = statePerAggregate.GetOrDefaultAsync<CachedAggregateEntry>(key, null, token = token)
                if not (obj.ReferenceEquals(entry, null)) then
                    recordAccess key
                    return Some entry
                else
                    return None
            }

        member this.LastEventId (aggregateId: AggregateId) =
            let key = aggregateId.ToString()
            let entry = statePerAggregate.GetOrDefault<CachedAggregateEntry>(key, null)
            if not (obj.ReferenceEquals(entry, null)) then 
                recordAccess key
                Some entry.EventId
            else None
        
        member this.GetState (aggregateId: AggregateId) : Result<obj, string> =
            let key = aggregateId.ToString()
            let entry = statePerAggregate.GetOrDefault<CachedAggregateEntry>(key, null)
            if not (obj.ReferenceEquals(entry, null)) then 
                recordAccess key
                match entry.BoxedState with
                | Some state -> Ok state
                | None ->
                    try
                        let t = Type.GetType(entry.TypeName)
                        if not (isNull t) then
                            let state = System.Text.Json.JsonSerializer.Deserialize(entry.StateJson, t, jsonOptions)
                            entry.BoxedState <- Some state
                            Ok state
                        else
                            Error (sprintf "Could not resolve type %s" entry.TypeName)
                    with ex ->
                        Error ex.Message
            else Error "aggregate not found"        

        member this.GetStateAsync (aggregateId: AggregateId) (ct: Option<CancellationToken>) =
            let key = aggregateId.ToString()
            let token = ct |> Option.defaultValue CancellationToken.None
            task {
                let! entry = statePerAggregate.GetOrDefaultAsync<CachedAggregateEntry>(key, null, token = token)
                if not (obj.ReferenceEquals(entry, null)) then 
                    recordAccess key
                    match entry.BoxedState with
                    | Some state -> return Ok state
                    | None ->
                        try
                            let t = Type.GetType(entry.TypeName)
                            if not (isNull t) then
                                let state = System.Text.Json.JsonSerializer.Deserialize(entry.StateJson, t, jsonOptions)
                                entry.BoxedState <- Some state
                                return Ok state
                            else
                                return Error (sprintf "Could not resolve type %s" entry.TypeName)
                        with ex ->
                            return Error ex.Message
                else
                    return Error "aggregate not found"
            }

        member this.Memoize (f: unit -> Result<EventId * obj, string>) (aggregateId: AggregateId): Result<EventId * obj, string> =
            let key = aggregateId.ToString()
            let entry = statePerAggregate.GetOrDefault<CachedAggregateEntry>(key, null)
            if not (obj.ReferenceEquals(entry, null)) then
                recordAccess key
                match entry.BoxedState with
                | Some state -> Ok (entry.EventId, state)
                | None ->
                    try
                        let t = Type.GetType(entry.TypeName)
                        if not (isNull t) then
                            let state = System.Text.Json.JsonSerializer.Deserialize(entry.StateJson, t, jsonOptions)
                            entry.BoxedState <- Some state
                            Ok (entry.EventId, state)
                        else
                            let res = f()
                            match res with
                            | Ok (eventId, state) ->
                                this.Memoize2 (eventId, state) aggregateId
                                Ok (eventId, state)
                            | Error e -> Error e
                    with ex ->
                        logger.LogError (sprintf "Error deserializing cached entry for %s: %A" key ex)
                        let res = f()
                        match res with
                        | Ok (eventId, state) ->
                            this.Memoize2 (eventId, state) aggregateId
                            Ok (eventId, state)
                        | Error e -> Error e
            else
                let res = f()
                match res with
                | Ok (eventId, state) ->
                    this.Memoize2 (eventId, state) aggregateId
                    Ok (eventId, state)
                | Error e ->
                    Error e

        member this.MemoizeAsync (f: Option<CancellationToken> -> Task<Result<EventId * obj, string>>) (aggregateId: AggregateId) (ct: Option<CancellationToken>): Task<Result<EventId * obj, string>> =
            let key = aggregateId.ToString()
            let token = ct |> Option.defaultValue CancellationToken.None
            task {
                let! entry = statePerAggregate.GetOrDefaultAsync<CachedAggregateEntry>(key, null, token = token)
                if not (obj.ReferenceEquals(entry, null)) then
                    recordAccess key
                    match entry.BoxedState with
                    | Some state -> return Ok (entry.EventId, state)
                    | None ->
                        try
                            let t = Type.GetType(entry.TypeName)
                            if not (isNull t) then
                                let state = System.Text.Json.JsonSerializer.Deserialize(entry.StateJson, t, jsonOptions)
                                entry.BoxedState <- Some state
                                return Ok (entry.EventId, state)
                            else
                                let! res = f ct
                                match res with
                                | Ok (eventId, state) ->
                                    this.Memoize2 (eventId, state) aggregateId
                                    return Ok (eventId, state)
                                | Error e -> return Error e
                        with ex ->
                            logger.LogError (sprintf "Error deserializing cached entry for %s: %A" key ex)
                            let! res = f ct
                            match res with
                            | Ok (eventId, state) ->
                                this.Memoize2 (eventId, state) aggregateId
                                return Ok (eventId, state)
                            | Error e -> return Error e
                else
                    let! res = f ct
                    match res with
                    | Ok (eventId, state) ->
                        this.Memoize2 (eventId, state) aggregateId
                        return Ok (eventId, state)
                    | Error e ->
                        return Error e
            }

    type StateCache2<'A> private () =
        let mutable cachedValue: 'A option = None
        let mutable eventId: EventId = 0
        static let instance = StateCache2<'A>()
        static member Instance = instance
           
        [<MethodImpl(MethodImplOptions.Synchronized)>]
        member this.TryCache (res: 'A, evId: EventId) =
            cachedValue <- Some res
            eventId <- evId
            ()
               
        member this.GetState() =
            match cachedValue with
            | Some res -> Ok res
            | None -> Error "context state not found"
   
        member this.Memoize (f: unit -> Result<'A, string>)  (eventId: EventId)=
            match cachedValue with
            | Some res -> Ok res
            | _ ->
                let res = f()
                match res with
                | Ok result ->
                    let _  = this.TryCache (result, eventId)
                    Ok result
                | Error e ->
                    Error (e.ToString())
        member this.GetEventIdAndState () =
            match cachedValue with
            | Some res -> Some (eventId, res)
            | None -> None
            
        member this.Memoize2 (x: 'A) (eventId: EventId) =
            this.TryCache (x, eventId)
       
        member this.LastEventId() =
            eventId

        [<MethodImpl(MethodImplOptions.Synchronized)>]      
        member this.Invalidate() =
            cachedValue <- None         
            eventId <- 0
            ()

    let setupSecondLevelCacheAndBackplane 
        (distributedCache: IDistributedCache option) 
        (serializer: IFusionCacheSerializer option) 
        (backplane: IFusionCacheBackplane option) =
        DetailsCache.Instance.SetupL2AndBackplane(distributedCache, serializer, backplane)
        AggregateCache3.Instance.SetupL2AndBackplane(distributedCache, serializer, backplane)

    let setupAzureSqlCache (connectionString: string) (schemaName: string) (tableName: string) =
        let options = SqlServerCacheOptions(
            ConnectionString = connectionString,
            SchemaName = schemaName,
            TableName = tableName
        )
        let opts = Options.Create(options)
        let sqlCache = new SqlServerCache(opts)
        
        setupSecondLevelCacheAndBackplane (Some (sqlCache :> IDistributedCache)) (Some (serializer :> IFusionCacheSerializer)) None

    let setupPostgresCache (connectionString: string) (schemaName: string) (tableName: string) =
        let services = new ServiceCollection()
        services.AddLogging() |> ignore
        services.AddDistributedPostgreSqlCache(fun opts ->
            opts.ConnectionString <- connectionString
            opts.SchemaName <- schemaName
            opts.TableName <- tableName
            opts.CreateInfrastructure <- true
        ) |> ignore
        let provider = services.BuildServiceProvider()
        let pgCache = provider.GetRequiredService<IDistributedCache>()
        
        setupSecondLevelCacheAndBackplane (Some pgCache) (Some (serializer :> IFusionCacheSerializer)) None

    let setupRedisCache (connectionString: string) =
        let services = new ServiceCollection()
        services.AddLogging() |> ignore
        services.AddStackExchangeRedisCache(fun opts ->
            opts.Configuration <- connectionString
            opts.InstanceName <- "sharpino:"
        ) |> ignore
        let provider = services.BuildServiceProvider()
        let redisCache = provider.GetRequiredService<IDistributedCache>()
        
        setupSecondLevelCacheAndBackplane (Some redisCache) (Some (serializer :> IFusionCacheSerializer)) None

    let setupRedisBackplane (connectionString: string) =
        let options = RedisBackplaneOptions(Configuration = connectionString)
        let bp = new RedisBackplane(options)
        bp :> IFusionCacheBackplane

    do // initialize L2 cache
        let l2SqlCacheEnabled = config.GetValue<bool>("Cache:L2SqlCacheEnabled", false)
        logger.LogInformation (sprintf "[Cache] Config: L2SqlCacheEnabled = %b" l2SqlCacheEnabled)
        if l2SqlCacheEnabled then
            let provider = config.GetValue<string>("Cache:L2CacheProvider", "SqlServer")
            if provider.Equals("Postgres", StringComparison.OrdinalIgnoreCase) then
                let connectionString = config.GetValue<string>("Cache:L2CacheConnectionString", String.Empty)
                let connectionString = if String.IsNullOrEmpty connectionString then config.GetValue<string>("Cache:L2CacheSqlUrl", String.Empty) else connectionString
                let tableName = config.GetValue<string>("Cache:L2CacheTableName", String.Empty)
                let tableName = if String.IsNullOrEmpty tableName then config.GetValue<string>("Cache:L2CacheSqlTableName", String.Empty) else tableName
                let schemaName = config.GetValue<string>("Cache:L2CacheSchemaName", "public")
                match connectionString, tableName with
                | "", _ -> logger.LogCritical ("[Cache] Error: L2 Postgres connection string (L2CacheConnectionString or L2CacheSqlUrl) is empty")
                | _, "" -> logger.LogCritical ("[Cache] Error: L2 Postgres table name (L2CacheTableName or L2CacheSqlTableName) is empty")
                | _ ->
                    logger.LogInformation (sprintf "[Cache] Initializing L2 Postgres Cache with table: %s.%s" schemaName tableName)
                    setupPostgresCache connectionString schemaName tableName |> ignore
                    logger.LogInformation (sprintf "[Cache] L2 Postgres Cache initialized.")
            elif provider.Equals("Redis", StringComparison.OrdinalIgnoreCase) then
                let connectionString = config.GetValue<string>("Cache:L2CacheConnectionString", String.Empty)
                match connectionString with
                | "" -> logger.LogCritical ("[Cache] Error: L2 Redis connection string (L2CacheConnectionString) is empty")
                | _ ->
                    logger.LogInformation (sprintf "[Cache] Initializing L2 Redis Cache with connection: %s" connectionString)
                    setupRedisCache connectionString |> ignore
                    logger.LogInformation (sprintf "[Cache] L2 Redis Cache initialized.")
            else
                let l2CacheSqlUrl = config.GetValue<string>("Cache:L2CacheSqlUrl", String.Empty)
                let l2CacheSqlTableName = config.GetValue<string>("Cache:L2CacheSqlTableName", String.Empty)
                match l2CacheSqlUrl, l2CacheSqlTableName with
                | "", _ -> logger.LogCritical ("[Cache] Error: L2CacheSqlUrl is empty")
                | _, "" -> logger.LogCritical ("[Cache] Error: L2CacheSqlTableName is empty")
                | _ ->
                    logger.LogInformation (sprintf "[Cache] Initializing L2 SQL Cache with table: %s" l2CacheSqlTableName)
                    setupAzureSqlCache l2CacheSqlUrl "dbo" l2CacheSqlTableName |> ignore
                    logger.LogInformation (sprintf "[Cache] L2 SQL Cache initialized.")
        else 
            ()

    let setupEventGridMqttOptions (hostname: string) (port: int) (clientId: string) (username: string) (password: string) =
        MqttClientOptionsBuilder()
            .WithTcpServer(hostname, port)
            .WithCredentials(username, password)
            .WithClientId(clientId)
            .WithTlsOptions(fun o -> o.UseTls() |> ignore)
            .Build()

    let setupAzureServiceBusBackplane (connectionString: string) (topicName: string) (subscriptionName: string) (managementConnectionString: string option) =
        let bp =
            match managementConnectionString with
            | Some mcs -> new AzureServiceBusBackplane(connectionString, topicName, subscriptionName, mcs)
            | None     -> new AzureServiceBusBackplane(connectionString, topicName, subscriptionName)
        bp :> IFusionCacheBackplane

    do // initialize backplane in Service Bus
        let backplaneEnabled = config.GetValue<bool>("Cache:L2ServiceBusEnabled", false)
        if backplaneEnabled then
            printfn "[Cache] Initializing Service Bus Backplane..."
            let serviceBusConnectionString = config.GetValue<string>("Cache:ServiceBusConnectionString", String.Empty)
            let serviceBusTopicName = config.GetValue<string>("Cache:ServiceBusTopicName", String.Empty)
            let serviceBusSubscriptionName = config.GetValue<string>("Cache:ServiceBusSubscriptionName", String.Empty)
            match serviceBusConnectionString, serviceBusTopicName, serviceBusSubscriptionName with
            | "", _, _ -> logger.LogCritical "[Cache] Error: ServiceBusConnectionString is empty"
            | _, "", _ -> logger.LogCritical "[Cache] Error: ServiceBusTopicName is empty"
            | _, _, "" -> logger.LogCritical "[Cache] Error: ServiceBusSubscriptionName is empty"
            | _ ->
                let mgmtUrl = config.GetValue<string>("Cache:ServiceBusManagementConnectionString", String.Empty)
                let mgmtOpt = if String.IsNullOrWhiteSpace mgmtUrl then None else Some mgmtUrl
                let bp = setupAzureServiceBusBackplane serviceBusConnectionString serviceBusTopicName serviceBusSubscriptionName mgmtOpt
                setupSecondLevelCacheAndBackplane None None (Some bp)
                logger.LogCritical (sprintf "[Cache] Service Bus Backplane initialized (Subscription: %s)" serviceBusSubscriptionName)
        else
            logger.LogInformation "[Cache] Service Bus Backplane is disabled."

    let setupMqttBackplane (options: MqttClientOptions) (topicPrefix: string) =
        let bp = new MqttBackplane(options, topicPrefix)
        bp :> IFusionCacheBackplane

    let setupPgNotifyBackplane (connectionString: string) (channelName: string) =
        let bp = new PgNotifyBackplane(connectionString, channelName)
        bp :> IFusionCacheBackplane

    do // initialize backplane in Postgres LISTEN/NOTIFY
        let pgNotifyEnabled = config.GetValue<bool>("Cache:L2PgNotifyBackplaneEnabled", false)
        if pgNotifyEnabled then
            printfn "[Cache] Initializing Postgres LISTEN/NOTIFY Backplane..."
            let connStr = config.GetValue<string>("Cache:L2PgNotifyConnectionString", String.Empty)
            let connStr =
                if String.IsNullOrEmpty connStr then
                    let l2Conn = config.GetValue<string>("Cache:L2CacheConnectionString", String.Empty)
                    if String.IsNullOrEmpty l2Conn then
                        Environment.GetEnvironmentVariable("DATABASE_L2_CACHE")
                    else
                        l2Conn
                else
                    connStr
            let channelName = config.GetValue<string>("Cache:L2PgNotifyChannelName", "sharpino_cache_eviction")
            if String.IsNullOrEmpty connStr then
                logger.LogCritical "[Cache] Error: L2PgNotifyConnectionString is empty and no fallback found"
            else
                let bp = setupPgNotifyBackplane connStr channelName
                setupSecondLevelCacheAndBackplane None None (Some bp)
                logger.LogCritical (sprintf "[Cache] Postgres LISTEN/NOTIFY Backplane initialized (Channel: %s)" channelName)
        else
            logger.LogInformation "[Cache] Postgres LISTEN/NOTIFY Backplane is disabled."

    do // initialize Redis backplane (pub/sub invalidation via StackExchange.Redis)
        let redisBackplaneEnabled = config.GetValue<bool>("Cache:L2RedisBackplaneEnabled", false)
        if redisBackplaneEnabled then
            printfn "[Cache] Initializing Redis Backplane..."
            let connStr = config.GetValue<string>("Cache:L2CacheConnectionString", String.Empty)
            let channelName = config.GetValue<string>("Cache:L2RedisBackplaneChannel", "sharpino_cache_eviction")
            match connStr with
            | "" -> logger.LogCritical "[Cache] Error: L2CacheConnectionString is empty — cannot initialize Redis Backplane"
            | _ ->
                // Note: FusionCache derives the Redis channel name from the CacheName (FusionCacheOptions.BackplaneChannelPrefix).
                // The L2RedisBackplaneChannel config value is logged here for documentation purposes.
                let bp = setupRedisBackplane connStr
                setupSecondLevelCacheAndBackplane None None (Some bp)
                logger.LogInformation (sprintf "[Cache] Redis Backplane initialized (configured channel prefix hint: %s)" channelName)
        else
            logger.LogInformation "[Cache] Redis Backplane is disabled."