{-# LANGUAGE TemplateHaskell #-}

module Tendermint.SDK.BaseApp.Effects.CoreEffs
  ( CoreEffs
  , Context(..)
  , contextLogConfig
  , contextPrometheusEnv
  , contextVersions
  , contextGrpcClient
  , makeContext
  , runCoreEffs
  ) where

import           Control.Lens                              (makeLenses)
import           Data.Text                                 (Text)
import qualified Katip                                     as K
import           Polysemy                                  (Embed, Sem, runM)
import           Polysemy.Reader                           (Reader, runReader)
import qualified Tendermint.SDK.BaseApp.Logger.Katip       as KL
import qualified Tendermint.SDK.BaseApp.Metrics.Prometheus as P
import qualified Tendermint.SDK.BaseApp.Store.IAVLStore    as IAVL

-- | CoreEffs is one level below BaseAppEffs, and provides one possible
-- | interpretation for its effects to IO.
type CoreEffs =
  '[ Reader KL.LogConfig
   , Reader (Maybe P.PrometheusEnv)
   , Reader IAVL.IAVLVersions
   , Reader IAVL.GrpcClient
   , Embed IO
   ]

-- | 'Context' is the environment required to run 'CoreEffs' to 'IO'
data Context = Context
  { Context -> LogConfig
_contextLogConfig     :: KL.LogConfig
  , Context -> Maybe PrometheusEnv
_contextPrometheusEnv :: Maybe P.PrometheusEnv
  , Context -> GrpcClient
_contextGrpcClient    :: IAVL.GrpcClient
  , Context -> IAVLVersions
_contextVersions      :: IAVL.IAVLVersions
  }

makeLenses ''Context

makeContext
  :: KL.InitialLogNamespace
  -> Maybe P.MetricsScrapingConfig
  -> IAVL.IAVLVersions
  -> IAVL.GrpcConfig
  -> IO Context
makeContext :: InitialLogNamespace
-> Maybe MetricsScrapingConfig
-> IAVLVersions
-> GrpcConfig
-> IO Context
makeContext KL.InitialLogNamespace{..} scrapingCfg :: Maybe MetricsScrapingConfig
scrapingCfg versions :: IAVLVersions
versions rpcConf :: GrpcConfig
rpcConf = do
  Maybe PrometheusEnv
metCfg <- case Maybe MetricsScrapingConfig
scrapingCfg of
        Nothing -> Maybe PrometheusEnv -> IO (Maybe PrometheusEnv)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe PrometheusEnv
forall a. Maybe a
Nothing
        Just scfg :: MetricsScrapingConfig
scfg -> IO MetricsState
P.emptyState IO MetricsState
-> (MetricsState -> IO (Maybe PrometheusEnv))
-> IO (Maybe PrometheusEnv)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \es :: MetricsState
es ->
          Maybe PrometheusEnv -> IO (Maybe PrometheusEnv)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe PrometheusEnv -> IO (Maybe PrometheusEnv))
-> (PrometheusEnv -> Maybe PrometheusEnv)
-> PrometheusEnv
-> IO (Maybe PrometheusEnv)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrometheusEnv -> Maybe PrometheusEnv
forall a. a -> Maybe a
Just (PrometheusEnv -> IO (Maybe PrometheusEnv))
-> PrometheusEnv -> IO (Maybe PrometheusEnv)
forall a b. (a -> b) -> a -> b
$ MetricsState -> MetricsScrapingConfig -> PrometheusEnv
P.PrometheusEnv MetricsState
es MetricsScrapingConfig
scfg
  LogConfig
logCfg <- Text -> Text -> IO LogConfig
mkLogConfig Text
_initialLogEnvironment Text
_initialLogProcessName
  GrpcClient
grpc <- GrpcConfig -> IO GrpcClient
IAVL.initGrpcClient GrpcConfig
rpcConf
  Context -> IO Context
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Context -> IO Context) -> Context -> IO Context
forall a b. (a -> b) -> a -> b
$ Context :: LogConfig
-> Maybe PrometheusEnv -> GrpcClient -> IAVLVersions -> Context
Context
    { _contextLogConfig :: LogConfig
_contextLogConfig = LogConfig
logCfg
    , _contextPrometheusEnv :: Maybe PrometheusEnv
_contextPrometheusEnv = Maybe PrometheusEnv
metCfg
    , _contextVersions :: IAVLVersions
_contextVersions = IAVLVersions
versions
    , _contextGrpcClient :: GrpcClient
_contextGrpcClient = GrpcClient
grpc
    }
    where
      mkLogConfig :: Text -> Text -> IO KL.LogConfig
      mkLogConfig :: Text -> Text -> IO LogConfig
mkLogConfig env :: Text
env pName :: Text
pName = do
        let mkLogEnv :: IO LogEnv
mkLogEnv = Namespace -> Environment -> IO LogEnv
K.initLogEnv ([Text] -> Namespace
K.Namespace [Text
pName]) (Text -> Environment
K.Environment Text
env)
        LogEnv
le <- IO LogEnv
mkLogEnv
        LogConfig -> IO LogConfig
forall (m :: * -> *) a. Monad m => a -> m a
return (LogConfig -> IO LogConfig) -> LogConfig -> IO LogConfig
forall a b. (a -> b) -> a -> b
$ LogConfig :: Namespace -> LogContexts -> LogEnv -> LogConfig
KL.LogConfig
          { _logNamespace :: Namespace
_logNamespace = Namespace
forall a. Monoid a => a
mempty
          , _logContext :: LogContexts
_logContext = LogContexts
forall a. Monoid a => a
mempty
          , _logEnv :: LogEnv
_logEnv = LogEnv
le
          }

-- | The standard interpeter for 'CoreEffs'.
runCoreEffs
  :: Context
  -> forall a. Sem CoreEffs a -> IO a
runCoreEffs :: Context -> forall a. Sem CoreEffs a -> IO a
runCoreEffs Context{..} =
  Sem '[Embed IO] a -> IO a
forall (m :: * -> *) a. Monad m => Sem '[Embed m] a -> m a
runM (Sem '[Embed IO] a -> IO a)
-> (Sem CoreEffs a -> Sem '[Embed IO] a) -> Sem CoreEffs a -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    GrpcClient
-> Sem '[Reader GrpcClient, Embed IO] a -> Sem '[Embed IO] a
forall i (r :: [(* -> *) -> * -> *]) a.
i -> Sem (Reader i : r) a -> Sem r a
runReader GrpcClient
_contextGrpcClient (Sem '[Reader GrpcClient, Embed IO] a -> Sem '[Embed IO] a)
-> (Sem CoreEffs a -> Sem '[Reader GrpcClient, Embed IO] a)
-> Sem CoreEffs a
-> Sem '[Embed IO] a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    IAVLVersions
-> Sem '[Reader IAVLVersions, Reader GrpcClient, Embed IO] a
-> Sem '[Reader GrpcClient, Embed IO] a
forall i (r :: [(* -> *) -> * -> *]) a.
i -> Sem (Reader i : r) a -> Sem r a
runReader IAVLVersions
_contextVersions (Sem '[Reader IAVLVersions, Reader GrpcClient, Embed IO] a
 -> Sem '[Reader GrpcClient, Embed IO] a)
-> (Sem CoreEffs a
    -> Sem '[Reader IAVLVersions, Reader GrpcClient, Embed IO] a)
-> Sem CoreEffs a
-> Sem '[Reader GrpcClient, Embed IO] a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    Maybe PrometheusEnv
-> Sem
     '[Reader (Maybe PrometheusEnv), Reader IAVLVersions,
       Reader GrpcClient, Embed IO]
     a
-> Sem '[Reader IAVLVersions, Reader GrpcClient, Embed IO] a
forall i (r :: [(* -> *) -> * -> *]) a.
i -> Sem (Reader i : r) a -> Sem r a
runReader Maybe PrometheusEnv
_contextPrometheusEnv (Sem
   '[Reader (Maybe PrometheusEnv), Reader IAVLVersions,
     Reader GrpcClient, Embed IO]
   a
 -> Sem '[Reader IAVLVersions, Reader GrpcClient, Embed IO] a)
-> (Sem CoreEffs a
    -> Sem
         '[Reader (Maybe PrometheusEnv), Reader IAVLVersions,
           Reader GrpcClient, Embed IO]
         a)
-> Sem CoreEffs a
-> Sem '[Reader IAVLVersions, Reader GrpcClient, Embed IO] a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    LogConfig
-> Sem CoreEffs a
-> Sem
     '[Reader (Maybe PrometheusEnv), Reader IAVLVersions,
       Reader GrpcClient, Embed IO]
     a
forall i (r :: [(* -> *) -> * -> *]) a.
i -> Sem (Reader i : r) a -> Sem r a
runReader LogConfig
_contextLogConfig