-- SPDX-FileCopyrightText: 2022 Gregor Kleen <gregor.kleen@ifi.lmu.de>,Sarah Vaupel <sarah.vaupel@ifi.lmu.de>
--
-- SPDX-License-Identifier: AGPL-3.0-or-later

module Settings.Cluster.Volatile
  ( VolatileClusterSettingsKey(..)
  , clusterVolatileQuickActionsEnabled
  , VolatileClusterSetting(..)
  , VolatileClusterSettingsCache
  , mkVolatileClusterSettingsCache
  , alterVolatileClusterSettingsCacheF, insertVolatileClusterSettingsCache, lookupVolatileClusterSettingsCache
  ) where

import ClassyPrelude.Yesod hiding (Proxy)

import Data.HashPSQ (HashPSQ)
import qualified Data.HashPSQ as HashPSQ

import Data.Universe
import Utils.PathPiece
import Model.Types.TH.PathPiece
  
import Data.Kind (Type)
import Data.Dynamic

import System.Clock (TimeSpec)

import Data.Functor.Const

import Data.Proxy

-- import Control.Lens


data VolatileClusterSettingsKey
  = ClusterVolatileQuickActionsEnabled
  deriving (Eq, Ord, Enum, Bounded, Show, Read, Generic)
  deriving anyclass (Hashable, Universe, Finite, NFData)

nullaryPathPiece ''VolatileClusterSettingsKey $ camelToPathPiece' 2
pathPieceJSON ''VolatileClusterSettingsKey
pathPieceJSONKey ''VolatileClusterSettingsKey
pathPieceHttpApiData ''VolatileClusterSettingsKey
derivePersistFieldPathPiece ''VolatileClusterSettingsKey

clusterVolatileQuickActionsEnabled :: Proxy 'ClusterVolatileQuickActionsEnabled
clusterVolatileQuickActionsEnabled = Proxy


class ( ToJSON (VolatileClusterSettingValue key)
      , FromJSON (VolatileClusterSettingValue key)
      , Typeable (VolatileClusterSettingValue key)
      , NFData (VolatileClusterSettingValue key)
      ) => VolatileClusterSetting (key :: VolatileClusterSettingsKey) where
  type VolatileClusterSettingValue key :: Type
  initVolatileClusterSetting :: forall m p. MonadIO m => p key -> m (VolatileClusterSettingValue key)
  knownVolatileClusterSetting :: forall p. p key -> VolatileClusterSettingsKey

instance VolatileClusterSetting 'ClusterVolatileQuickActionsEnabled where
  type VolatileClusterSettingValue 'ClusterVolatileQuickActionsEnabled = Bool
  initVolatileClusterSetting _ = return True
  knownVolatileClusterSetting _ = ClusterVolatileQuickActionsEnabled


data SomeVolatileClusterSettingsKey = forall key p. VolatileClusterSetting key => SomeVolatileClusterSettingsKey (p key)

instance Eq SomeVolatileClusterSettingsKey where
  (SomeVolatileClusterSettingsKey p1) == (SomeVolatileClusterSettingsKey p2) = knownVolatileClusterSetting p1 == knownVolatileClusterSetting p2
instance Ord SomeVolatileClusterSettingsKey where
  (SomeVolatileClusterSettingsKey p1) `compare` (SomeVolatileClusterSettingsKey p2) = knownVolatileClusterSetting p1 `compare` knownVolatileClusterSetting p2
instance Hashable SomeVolatileClusterSettingsKey where
  hashWithSalt s (SomeVolatileClusterSettingsKey p) = s `hashWithSalt` knownVolatileClusterSetting p

data VolatileClusterSettingsCache = VolatileClusterSettingsCache
  { volatileClusterSettingsCacheExpiry :: TimeSpec
  , volatileClusterSettingsCacheCache :: HashPSQ SomeVolatileClusterSettingsKey TimeSpec Dynamic
  }

-- makePrisms ''VolatileClusterSettingsCache

mkVolatileClusterSettingsCache :: TimeSpec -> VolatileClusterSettingsCache
mkVolatileClusterSettingsCache volatileClusterSettingsCacheExpiry = VolatileClusterSettingsCache{..}
  where volatileClusterSettingsCacheCache = HashPSQ.empty


alterVolatileClusterSettingsCacheF :: forall key f p.
                                      ( VolatileClusterSetting key
                                      , Functor f
                                      )
                                   => p key
                                   -> (Maybe (VolatileClusterSettingValue key) -> f (Maybe (VolatileClusterSettingValue key)))
                                   -> VolatileClusterSettingsCache
                                   -> TimeSpec -- ^ @now@
                                   -> f VolatileClusterSettingsCache
alterVolatileClusterSettingsCacheF p f c now
    = f current <&> \new -> c { volatileClusterSettingsCacheCache = maybe (HashPSQ.delete k current') (\new' -> HashPSQ.insert k now (toDyn $!! new') current') new }
  where
    k = SomeVolatileClusterSettingsKey p
    
    cutoff = now - volatileClusterSettingsCacheExpiry c
    
    current' = volatileClusterSettingsCacheCache c
    current = HashPSQ.lookup k current' >>= \(t, v) -> if
      | t > cutoff -> fromDynamic v
      | otherwise  -> Nothing

insertVolatileClusterSettingsCache :: forall key p.
                                      VolatileClusterSetting key
                                   => p key
                                   -> Maybe (VolatileClusterSettingValue key)
                                   -> VolatileClusterSettingsCache
                                   -> TimeSpec
                                   -> VolatileClusterSettingsCache
insertVolatileClusterSettingsCache k newVal = (runIdentity .) . alterVolatileClusterSettingsCacheF k (const $ pure newVal)

lookupVolatileClusterSettingsCache :: forall key p.
                                      VolatileClusterSetting key
                                   => p key
                                   -> VolatileClusterSettingsCache
                                   -> TimeSpec
                                   -> Maybe (VolatileClusterSettingValue key)
lookupVolatileClusterSettingsCache k = (getConst .) . alterVolatileClusterSettingsCacheF k Const