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

module Utils.VolatileClusterSettings
  ( getVolatileClusterSetting
  , VolatileClusterSettingException(..)
  , whenVolatile, volatileBool, guardVolatile
  ) where

import Import.NoModel
import Model
import Foundation.Type
import Foundation.DB

import System.Clock

import qualified Data.Aeson.Types as Aeson


data VolatileClusterSettingException = VolatileClusterSettingExceptionNoParse
  deriving (Eq, Ord, Read, Show, Generic)
  deriving anyclass (Exception)

  
getVolatileClusterSetting :: forall key m p.
                             ( VolatileClusterSetting key
                             , MonadHandler m, HandlerSite m ~ UniWorX
                             )
                          => p key
                          -> m (VolatileClusterSettingValue key)
getVolatileClusterSetting p = exceptT return return $ do
  cacheTVar <- getsYesod appVolatileClusterSettingsCache
  now <- liftIO $ getTime Monotonic
  oldVal <- flip (lookupVolatileClusterSettingsCache p) now <$> readTVarIO cacheTVar
  traverse_ throwE oldVal
  dbVal <- liftHandler . runDBInternal $ do
    dbVal <- fmap (fmap volatileClusterConfigValue) . get . VolatileClusterConfigKey $ knownVolatileClusterSetting p
    case dbVal of
      Just v -> maybe (throwM VolatileClusterSettingExceptionNoParse) return $ Aeson.parseMaybe parseJSON v
      Nothing -> do
        newVal <- initVolatileClusterSetting p
        insert_ $ VolatileClusterConfig (knownVolatileClusterSetting p) (toJSON newVal)
        return newVal
  atomically . modifyTVar' cacheTVar $ \c -> insertVolatileClusterSettingsCache p (Just dbVal) c now
  return dbVal

volatileBool :: forall key m a p.
                ( VolatileClusterSetting key, VolatileClusterSettingValue key ~ Bool
                , MonadHandler m, HandlerSite m ~ UniWorX
                )
             => p key
             -> m a
             -> m a
             -> m a
volatileBool p ifFalse ifTrue = do
  r <- getVolatileClusterSetting p
  bool ifFalse ifTrue r

whenVolatile :: forall key m p.
                ( VolatileClusterSetting key, VolatileClusterSettingValue key ~ Bool
                , MonadHandler m, HandlerSite m ~ UniWorX
                )
             => p key
             -> m ()
             -> m ()
whenVolatile p = volatileBool p (return ())

guardVolatile :: forall key m p.
                 ( VolatileClusterSetting key, VolatileClusterSettingValue key ~ Bool
                 , MonadHandler m, HandlerSite m ~ UniWorX
                 , MonadPlus m
                 )
              => p key
              -> m ()
guardVolatile p = volatileBool p mzero (return ())