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

module Foundation.Type
  ( UniWorX(..)
  , SomeSessionStorage(..)
  , _SessionStorageMemcachedSql, _SessionStorageAcid
  , AppMemcached(..)
  , _memcachedKey, _memcachedConn
  , AppMemcachedLocal(..)
  , _memcachedLocalARC
  , SMTPPool
  , _appSettings', _appStatic, _appConnPool, _appSmtpPool, _appLdapPool, _appWidgetMemcached, _appHttpManager, _appLogger, _appLogSettings, _appCryptoIDKey, _appClusterID, _appInstanceID, _appJobState, _appSessionStore, _appSecretBoxKey, _appJSONWebKeySet, _appHealthReport, _appMemcached, _appUploadCache, _appVerpSecret, _appAuthKey, _appPersonalisedSheetFilesSeedKey, _appVolatileClusterSettingsCache
  , DB, 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 Data.IntervalMap.Strict (IntervalMap)

import qualified Utils.Pool as Custom

import Utils.Metrics (DBConnUseState)

import qualified Data.ByteString.Lazy as Lazy
import Data.Time.Clock.POSIX (POSIXTime)
import GHC.Fingerprint (Fingerprint)
import Handler.Sheet.PersonalisedFiles.Types (PersonalisedSheetFilesSeedKey)


type SMTPPool = Pool SMTPConnection

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

makePrisms ''SomeSessionStorage

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

makeLenses_ ''AppMemcached

data AppMemcachedLocal = AppMemcachedLocal
  { memcachedLocalARC :: ARCHandle (Fingerprint, Lazy.ByteString) Int (NFDynamic, Maybe POSIXTime)
  , memcachedLocalHandleInvalidations :: Async ()
  , memcachedLocalInvalidationQueue :: TVar (Seq (Fingerprint, Lazy.ByteString))
  } deriving (Generic, Typeable)

makeLenses_ ''AppMemcachedLocal

-- | 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
    , appMemcachedLocal    :: Maybe AppMemcachedLocal
    , appUploadCache       :: Maybe MinioConn
    , appVerpSecret        :: VerpSecret
    , appAuthKey           :: Auth.Key
    , appFileSourceARC     :: Maybe (ARCHandle (FileContentChunkReference, (Int, Int)) Int ByteString)
    , appFileSourcePrewarm :: Maybe (LRUHandle (FileContentChunkReference, (Int, Int)) UTCTime Int ByteString)
    , appFileInjectInhibit :: TVar (IntervalMap UTCTime (Set FileContentReference))
    , appPersonalisedSheetFilesSeedKey :: PersonalisedSheetFilesSeedKey
    , appVolatileClusterSettingsCache :: TVar VolatileClusterSettingsCache
    } deriving (Typeable)

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
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)
