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

module Foundation.Type
  ( UniWorX(..)
  , SomeSessionStorage(..)
  , _SessionStorageMemcachedSql, _SessionStorageAcid
  , SMTPPool
  , _appSettings', _appStatic, _appConnPool, _appSmtpPool, _appLdapPool, _appWidgetMemcached, _appHttpManager, _appLogger, _appLogSettings, _appCryptoIDKey, _appClusterID, _appInstanceID, _appJobState, _appSessionStore, _appSecretBoxKey, _appJSONWebKeySet, _appHealthReport
  , DB, Form, MsgRenderer, MailM
  ) where

import Import.NoFoundation
import Database.Persist.Sql (ConnectionPool)

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 Jose.Jwk as Jose

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


type SMTPPool = Pool SMTPConnection

data SomeSessionStorage
  = SessionStorageMemcachedSql { sessionStorageMemcachedSql :: MemcachedSqlStorage SessionMap }
  | SessionStorageAcid { sessionStorageAcid :: AcidStorage SessionMap }

makePrisms ''SomeSessionStorage

-- | 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         :: ConnectionPool -- ^ 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 (AEAD.Key, Memcached.Connection)
    , appUploadCache      :: Maybe MinioConn
    }

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
