-- SPDX-FileCopyrightText: 2022-26 Gregor Kleen <gregor.kleen@ifi.lmu.de>,Sarah Vaupel <sarah.vaupel@ifi.lmu.de>,Steffen Jost <jost@tcs.ifi.lmu.de>,Steffen Jost <s.jost@fraport.de>
--
-- SPDX-License-Identifier: AGPL-3.0-or-later

{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE UndecidableInstances #-}

module Foundation.Type
  ( UniWorX(..)
  , SomeSessionStorage(..)
  , _SessionStorageMemcachedSql, _SessionStorageAcid
  , AppMemcached(..)
  , _memcachedKey, _memcachedConn
  , SMTPPool
  , _appSettings', _appStatic, _appConnPool, _appSmtpPool, _appLdapPool, _appWidgetMemcached, _appHttpManager, _appLogger, _appLogSettings, _appCryptoIDKey, _appClusterID, _appInstanceID, _appJobState, _appSessionStore, _appSecretBoxKey, _appJSONWebKeySet, _appHealthReport, _appMemcached, _appUploadCache, _appVerpSecret, _appAuthKey, _appPersonalisedSheetFilesSeedKey, _appVolatileClusterSettingsCache, _appAvsQuery
  , DB
  , DBRead, DBRead', DBReadUq, DBReadUq'
  , Form, MsgRenderer, MailM, DBFile
  ) where

import Import.NoFoundation

import Jobs.Types

import Yesod.Core.Types (Logger)

import qualified Crypto.Saltine.Core.SecretBox as SecretBox
import qualified Crypto.Saltine.Core.AEAD as AEAD
import qualified Crypto.Saltine.Core.Auth as Auth
import qualified Jose.Jwk as Jose

import qualified Database.Memcached.Binary.IO as Memcached
import Network.Minio (MinioConn)

import qualified Utils.Pool as Custom

import Utils.Metrics (DBConnUseState)

import Handler.Sheet.PersonalisedFiles.Types (PersonalisedSheetFilesSeedKey)

import Utils.Avs (AvsQuery())


type SMTPPool = Pool SMTPConnection

data SomeSessionStorage
  = SessionStorageMemcachedSql { sessionStorageMemcachedSql :: MemcachedSqlStorage SessionMap }
  | SessionStorageAcid { sessionStorageAcid :: AcidStorage SessionMap }
  deriving (Generic)

makePrisms ''SomeSessionStorage

data AppMemcached = AppMemcached
  { memcachedKey :: AEAD.Key
  , memcachedConn :: Memcached.Connection
  } deriving (Generic)

makeLenses_ ''AppMemcached


-- | The foundation datatype for your application. This can be a good place to
-- keep settings and values requiring initialization before your application
-- starts running, such as database connections. Every handler will have
-- access to the data present here.
data UniWorX = UniWorX
    { appSettings'         :: AppSettings
    , appStatic            :: EmbeddedStatic -- ^ Settings for static file serving.
    , appConnPool          :: forall m. MonadIO m => Custom.Pool' m DBConnLabel DBConnUseState SqlBackend -- ^ Database connection pool.
    , appSmtpPool          :: Maybe SMTPPool
    , appLdapPool          :: Maybe (Failover (LdapConf, LdapPool))
    , appWidgetMemcached   :: Maybe Memcached.Connection -- ^ Actually a proper pool
    , appHttpManager       :: Manager
    , appLogger            :: (ReleaseKey, TVar Logger)
    , appLogSettings       :: TVar LogSettings
    , appCryptoIDKey       :: CryptoIDKey
    , appClusterID         :: ClusterId
    , appInstanceID        :: InstanceId
    , appJobState          :: TMVar JobState
    , appSessionStore      :: SomeSessionStorage
    , appSecretBoxKey      :: SecretBox.Key
    , appJSONWebKeySet     :: Jose.JwkSet
    , appHealthReport      :: TVar (Set (UTCTime, HealthReport))
    , appMemcached         :: Maybe AppMemcached
    , appUploadCache       :: Maybe MinioConn
    , appVerpSecret        :: VerpSecret
    , appAuthKey           :: Auth.Key
    , appPersonalisedSheetFilesSeedKey :: PersonalisedSheetFilesSeedKey
    , appVolatileClusterSettingsCache :: TVar VolatileClusterSettingsCache
    , appStartTime         :: UTCTime -- for Status Page
    , appAvsQuery          :: Maybe AvsQuery
    }

makeLenses_ ''UniWorX
instance HasInstanceID UniWorX InstanceId where
  instanceID = _appInstanceID
instance HasClusterID UniWorX ClusterId where
  clusterID = _appClusterID
instance HasJSONWebKeySet UniWorX Jose.JwkSet where
  jsonWebKeySet = _appJSONWebKeySet
instance HasHttpManager UniWorX Manager where
  httpManager = _appHttpManager
instance HasAppSettings UniWorX where
  appSettings = _appSettings'
instance HasCookieSettings RegisteredCookie UniWorX where
  getCookieSettings = appCookieSettings . appSettings'

instance (MonadHandler m, HandlerSite m ~ UniWorX) => ReadLogSettings m where
  readLogSettings = liftIO . readTVarIO =<< getsYesod (view _appLogSettings)

type DB = YesodDB UniWorX
  --    ~     ReaderT SqlBackend     (HandlerFor UniWorX)
-- type DBRead = ReaderT SqlReadBackend (HandlerFor UniWorX) -- old, was too unflexible. Try DBRead first, then add suffixes ' or Uq until it types ;)
type DBRead     a = forall backend . (PersistQueryRead backend, BackendCompatible SqlBackend backend)
                  => ReaderT backend (HandlerFor UniWorX) a
type DBRead'    a = forall backend . (PersistQueryRead backend, BackendCompatible SqlBackend backend, BaseBackend backend ~ SqlBackend) -- ought to  be redundant, but somehow isn´t. Using this everywhere give redundant constraint warnings, also undesirable
                  => ReaderT backend (HandlerFor UniWorX) a
type DBReadUq   a = forall backend . (PersistQueryRead backend, BackendCompatible SqlBackend backend,                                   PersistUniqueRead backend) -- adding this to DBRead would yield some unnecessary constraint warnings
                  => ReaderT backend (HandlerFor UniWorX) a
type DBReadUq'  a = forall backend . (PersistQueryRead backend, BackendCompatible SqlBackend backend, BaseBackend backend ~ SqlBackend, PersistUniqueRead backend)
                  => ReaderT backend (HandlerFor UniWorX) a
type Form x = Html -> MForm (HandlerFor UniWorX) (FormResult x, WidgetFor UniWorX ())
type MsgRenderer = MsgRendererS UniWorX -- see Utils
type MailM a = MailT (HandlerFor UniWorX) a
type DBFile = File (YesodDB UniWorX)
