{-# LANGUAGE DataKinds        #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE MonoLocalBinds   #-}
{-# LANGUAGE NamedFieldPuns   #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeOperators    #-}
module Plutus.ChainIndex(
    runChainIndexEffects
    , handleChainIndexEffects
    , RunRequirements(..)
    , module Export
    ) where

import Control.Monad.Freer.Extras.Pagination as Export
import Plutus.ChainIndex.ChainIndexError as Export
import Plutus.ChainIndex.ChainIndexLog as Export
import Plutus.ChainIndex.Effects as Export
import Plutus.ChainIndex.Handlers as Export
import Plutus.ChainIndex.Tx as Export
import Plutus.ChainIndex.TxIdState as Export hiding (fromBlock, fromTx, rollback)
import Plutus.ChainIndex.TxOutBalance as Export hiding (fromBlock, fromTx, isSpentOutput, isUnspentOutput, rollback)
import Plutus.ChainIndex.Types as Export
import Plutus.ChainIndex.UtxoState as Export

import Cardano.BM.Trace (Trace)
import Control.Concurrent.STM (TVar, atomically, readTVarIO, writeTVar)
import Control.Monad.Freer (Eff, LastMember, Member, interpret)
import Control.Monad.Freer.Error (handleError, runError, throwError)
import Control.Monad.Freer.Extras.Beam.Effects (BeamEffect, handleBeam)
import Control.Monad.Freer.Extras.Beam.Sqlite (runBeam)
import Control.Monad.Freer.Extras.Log (LogMsg)
import Control.Monad.Freer.Extras.Modify (raiseEnd, raiseMUnderN)
import Control.Monad.Freer.Reader (runReader)
import Control.Monad.Freer.State (runState)
import Control.Monad.IO.Class (liftIO)
import Data.Pool (Pool)
import Database.Beam.Sqlite (Sqlite)
import Database.SQLite.Simple qualified as Sqlite
import Plutus.Monitoring.Util (PrettyObject (PrettyObject), convertLog, runLogEffects)

-- | The required arguments to run the chain index effects.
data RunRequirements = RunRequirements
    { RunRequirements -> Trace IO (PrettyObject ChainIndexLog)
trace         :: Trace IO (PrettyObject ChainIndexLog)
    , RunRequirements -> TVar ChainIndexState
stateTVar     :: TVar ChainIndexState
    , RunRequirements -> Pool Connection
pool          :: Pool Sqlite.Connection
    , RunRequirements -> Int
securityParam :: Int
    }

-- | Run the chain index effects.
runChainIndexEffects
    :: RunRequirements
    -> Eff '[ChainIndexQueryEffect, ChainIndexControlEffect, BeamEffect Sqlite] a
    -> IO (Either ChainIndexError a)
runChainIndexEffects :: RunRequirements
-> Eff
     '[ChainIndexQueryEffect, ChainIndexControlEffect,
       BeamEffect Sqlite]
     a
-> IO (Either ChainIndexError a)
runChainIndexEffects RunRequirements
runReq Eff
  '[ChainIndexQueryEffect, ChainIndexControlEffect,
    BeamEffect Sqlite]
  a
action =
    Trace IO ChainIndexLog -> Eff '[LogMsg ChainIndexLog, IO] ~> IO
forall (m :: * -> *) l.
MonadIO m =>
Trace m l -> Eff '[LogMsg l, m] ~> m
runLogEffects ((ChainIndexLog -> PrettyObject ChainIndexLog)
-> Trace IO (PrettyObject ChainIndexLog) -> Trace IO ChainIndexLog
forall a b (m :: * -> *). (a -> b) -> Trace m b -> Trace m a
convertLog ChainIndexLog -> PrettyObject ChainIndexLog
forall t. t -> PrettyObject t
PrettyObject (Trace IO (PrettyObject ChainIndexLog) -> Trace IO ChainIndexLog)
-> Trace IO (PrettyObject ChainIndexLog) -> Trace IO ChainIndexLog
forall a b. (a -> b) -> a -> b
$ RunRequirements -> Trace IO (PrettyObject ChainIndexLog)
trace RunRequirements
runReq)
        (Eff '[LogMsg ChainIndexLog, IO] (Either ChainIndexError a)
 -> IO (Either ChainIndexError a))
-> Eff '[LogMsg ChainIndexLog, IO] (Either ChainIndexError a)
-> IO (Either ChainIndexError a)
forall a b. (a -> b) -> a -> b
$ RunRequirements
-> Eff
     '[ChainIndexQueryEffect, ChainIndexControlEffect,
       BeamEffect Sqlite, LogMsg ChainIndexLog, IO]
     a
-> Eff '[LogMsg ChainIndexLog, IO] (Either ChainIndexError a)
forall (effs :: [* -> *]) a.
(LastMember IO effs, Member (LogMsg ChainIndexLog) effs) =>
RunRequirements
-> Eff
     (ChainIndexQueryEffect
        : ChainIndexControlEffect : BeamEffect Sqlite : effs)
     a
-> Eff effs (Either ChainIndexError a)
handleChainIndexEffects RunRequirements
runReq
        (Eff
   '[ChainIndexQueryEffect, ChainIndexControlEffect,
     BeamEffect Sqlite, LogMsg ChainIndexLog, IO]
   a
 -> Eff '[LogMsg ChainIndexLog, IO] (Either ChainIndexError a))
-> Eff
     '[ChainIndexQueryEffect, ChainIndexControlEffect,
       BeamEffect Sqlite, LogMsg ChainIndexLog, IO]
     a
-> Eff '[LogMsg ChainIndexLog, IO] (Either ChainIndexError a)
forall a b. (a -> b) -> a -> b
$ Eff
  '[ChainIndexQueryEffect, ChainIndexControlEffect,
    BeamEffect Sqlite]
  a
-> Eff
     '[ChainIndexQueryEffect, ChainIndexControlEffect,
       BeamEffect Sqlite, LogMsg ChainIndexLog, IO]
     a
forall (effs :: [* -> *]) (as :: [* -> *]).
CanWeakenEnd as effs =>
Eff as ~> Eff effs
raiseEnd Eff
  '[ChainIndexQueryEffect, ChainIndexControlEffect,
    BeamEffect Sqlite]
  a
action

-- | Handle the chain index effects from the set of all effects.
handleChainIndexEffects
    :: (LastMember IO effs, Member (LogMsg ChainIndexLog) effs)
    => RunRequirements
    -> Eff (ChainIndexQueryEffect ': ChainIndexControlEffect ': BeamEffect Sqlite ': effs) a
    -> Eff effs (Either ChainIndexError a)
handleChainIndexEffects :: RunRequirements
-> Eff
     (ChainIndexQueryEffect
        : ChainIndexControlEffect : BeamEffect Sqlite : effs)
     a
-> Eff effs (Either ChainIndexError a)
handleChainIndexEffects RunRequirements{Trace IO (PrettyObject ChainIndexLog)
trace :: Trace IO (PrettyObject ChainIndexLog)
trace :: RunRequirements -> Trace IO (PrettyObject ChainIndexLog)
trace, TVar ChainIndexState
stateTVar :: TVar ChainIndexState
stateTVar :: RunRequirements -> TVar ChainIndexState
stateTVar, Pool Connection
pool :: Pool Connection
pool :: RunRequirements -> Pool Connection
pool, Int
securityParam :: Int
securityParam :: RunRequirements -> Int
securityParam} Eff
  (ChainIndexQueryEffect
     : ChainIndexControlEffect : BeamEffect Sqlite : effs)
  a
action = do
    ChainIndexState
state <- IO ChainIndexState -> Eff effs ChainIndexState
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ChainIndexState -> Eff effs ChainIndexState)
-> IO ChainIndexState -> Eff effs ChainIndexState
forall a b. (a -> b) -> a -> b
$ TVar ChainIndexState -> IO ChainIndexState
forall a. TVar a -> IO a
readTVarIO TVar ChainIndexState
stateTVar
    (Either ChainIndexError a
result, ChainIndexState
newState) <-
        ChainIndexState
-> Eff (State ChainIndexState : effs) (Either ChainIndexError a)
-> Eff effs (Either ChainIndexError a, ChainIndexState)
forall s (effs :: [* -> *]) a.
s -> Eff (State s : effs) a -> Eff effs (a, s)
runState ChainIndexState
state
        (Eff (State ChainIndexState : effs) (Either ChainIndexError a)
 -> Eff effs (Either ChainIndexError a, ChainIndexState))
-> Eff (State ChainIndexState : effs) (Either ChainIndexError a)
-> Eff effs (Either ChainIndexError a, ChainIndexState)
forall a b. (a -> b) -> a -> b
$ Pool Connection
-> Eff
     (Reader (Pool Connection) : State ChainIndexState : effs)
     (Either ChainIndexError a)
-> Eff (State ChainIndexState : effs) (Either ChainIndexError a)
forall r (effs :: [* -> *]) a.
r -> Eff (Reader r : effs) a -> Eff effs a
runReader Pool Connection
pool
        (Eff
   (Reader (Pool Connection) : State ChainIndexState : effs)
   (Either ChainIndexError a)
 -> Eff (State ChainIndexState : effs) (Either ChainIndexError a))
-> Eff
     (Reader (Pool Connection) : State ChainIndexState : effs)
     (Either ChainIndexError a)
-> Eff (State ChainIndexState : effs) (Either ChainIndexError a)
forall a b. (a -> b) -> a -> b
$ Depth
-> Eff
     (Reader Depth
        : Reader (Pool Connection) : State ChainIndexState : effs)
     (Either ChainIndexError a)
-> Eff
     (Reader (Pool Connection) : State ChainIndexState : effs)
     (Either ChainIndexError a)
forall r (effs :: [* -> *]) a.
r -> Eff (Reader r : effs) a -> Eff effs a
runReader (Int -> Depth
Depth Int
securityParam)
        (Eff
   (Reader Depth
      : Reader (Pool Connection) : State ChainIndexState : effs)
   (Either ChainIndexError a)
 -> Eff
      (Reader (Pool Connection) : State ChainIndexState : effs)
      (Either ChainIndexError a))
-> Eff
     (Reader Depth
        : Reader (Pool Connection) : State ChainIndexState : effs)
     (Either ChainIndexError a)
-> Eff
     (Reader (Pool Connection) : State ChainIndexState : effs)
     (Either ChainIndexError a)
forall a b. (a -> b) -> a -> b
$ forall (effs :: [* -> *]) a.
Eff (Error ChainIndexError : effs) a
-> Eff effs (Either ChainIndexError a)
forall e (effs :: [* -> *]) a.
Eff (Error e : effs) a -> Eff effs (Either e a)
runError @ChainIndexError
        (Eff
   (Error ChainIndexError
      : Reader Depth : Reader (Pool Connection) : State ChainIndexState
      : effs)
   a
 -> Eff
      (Reader Depth
         : Reader (Pool Connection) : State ChainIndexState : effs)
      (Either ChainIndexError a))
-> Eff
     (Error ChainIndexError
        : Reader Depth : Reader (Pool Connection) : State ChainIndexState
        : effs)
     a
-> Eff
     (Reader Depth
        : Reader (Pool Connection) : State ChainIndexState : effs)
     (Either ChainIndexError a)
forall a b. (a -> b) -> a -> b
$ (Eff
   (Error BeamError
      : Error ChainIndexError : Reader Depth : Reader (Pool Connection)
      : State ChainIndexState : effs)
   a
 -> (BeamError
     -> Eff
          (Error ChainIndexError
             : Reader Depth : Reader (Pool Connection) : State ChainIndexState
             : effs)
          a)
 -> Eff
      (Error ChainIndexError
         : Reader Depth : Reader (Pool Connection) : State ChainIndexState
         : effs)
      a)
-> (BeamError
    -> Eff
         (Error ChainIndexError
            : Reader Depth : Reader (Pool Connection) : State ChainIndexState
            : effs)
         a)
-> Eff
     (Error BeamError
        : Error ChainIndexError : Reader Depth : Reader (Pool Connection)
        : State ChainIndexState : effs)
     a
-> Eff
     (Error ChainIndexError
        : Reader Depth : Reader (Pool Connection) : State ChainIndexState
        : effs)
     a
forall a b c. (a -> b -> c) -> b -> a -> c
flip Eff
  (Error BeamError
     : Error ChainIndexError : Reader Depth : Reader (Pool Connection)
     : State ChainIndexState : effs)
  a
-> (BeamError
    -> Eff
         (Error ChainIndexError
            : Reader Depth : Reader (Pool Connection) : State ChainIndexState
            : effs)
         a)
-> Eff
     (Error ChainIndexError
        : Reader Depth : Reader (Pool Connection) : State ChainIndexState
        : effs)
     a
forall e (effs :: [* -> *]) a.
Eff (Error e : effs) a -> (e -> Eff effs a) -> Eff effs a
handleError (ChainIndexError
-> Eff
     (Error ChainIndexError
        : Reader Depth : Reader (Pool Connection) : State ChainIndexState
        : effs)
     a
forall e (effs :: [* -> *]) a.
Member (Error e) effs =>
e -> Eff effs a
throwError (ChainIndexError
 -> Eff
      (Error ChainIndexError
         : Reader Depth : Reader (Pool Connection) : State ChainIndexState
         : effs)
      a)
-> (BeamError -> ChainIndexError)
-> BeamError
-> Eff
     (Error ChainIndexError
        : Reader Depth : Reader (Pool Connection) : State ChainIndexState
        : effs)
     a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BeamError -> ChainIndexError
BeamEffectError)
        (Eff
   (Error BeamError
      : Error ChainIndexError : Reader Depth : Reader (Pool Connection)
      : State ChainIndexState : effs)
   a
 -> Eff
      (Error ChainIndexError
         : Reader Depth : Reader (Pool Connection) : State ChainIndexState
         : effs)
      a)
-> Eff
     (Error BeamError
        : Error ChainIndexError : Reader Depth : Reader (Pool Connection)
        : State ChainIndexState : effs)
     a
-> Eff
     (Error ChainIndexError
        : Reader Depth : Reader (Pool Connection) : State ChainIndexState
        : effs)
     a
forall a b. (a -> b) -> a -> b
$ (BeamEffect Sqlite
 ~> Eff
      (Error BeamError
         : Error ChainIndexError : Reader Depth : Reader (Pool Connection)
         : State ChainIndexState : effs))
-> Eff
     (BeamEffect Sqlite
        : Error BeamError : Error ChainIndexError : Reader Depth
        : Reader (Pool Connection) : State ChainIndexState : effs)
   ~> Eff
        (Error BeamError
           : Error ChainIndexError : Reader Depth : Reader (Pool Connection)
           : State ChainIndexState : effs)
forall (eff :: * -> *) (effs :: [* -> *]).
(eff ~> Eff effs) -> Eff (eff : effs) ~> Eff effs
interpret ((Trace IO BeamLog
 -> SqliteM
    ~> Eff
         (Error BeamError
            : Error ChainIndexError : Reader Depth : Reader (Pool Connection)
            : State ChainIndexState : effs))
-> Trace IO BeamLog
-> BeamEffect Sqlite
   ~> Eff
        (Error BeamError
           : Error ChainIndexError : Reader Depth : Reader (Pool Connection)
           : State ChainIndexState : effs)
forall dbt (dbM :: * -> *) (effs :: [* -> *]).
(BeamSqlBackend dbt, MonadBeam dbt dbM,
 BeamHasInsertOnConflict dbt) =>
(Trace IO BeamLog -> dbM ~> Eff effs)
-> Trace IO BeamLog -> BeamEffect dbt ~> Eff effs
handleBeam Trace IO BeamLog
-> SqliteM
   ~> Eff
        (Error BeamError
           : Error ChainIndexError : Reader Depth : Reader (Pool Connection)
           : State ChainIndexState : effs)
forall (effs :: [* -> *]).
(LastMember IO effs, Member (Reader (Pool Connection)) effs) =>
Trace IO BeamLog -> SqliteM ~> Eff effs
runBeam ((BeamLog -> PrettyObject ChainIndexLog)
-> Trace IO (PrettyObject ChainIndexLog) -> Trace IO BeamLog
forall a b (m :: * -> *). (a -> b) -> Trace m b -> Trace m a
convertLog (ChainIndexLog -> PrettyObject ChainIndexLog
forall t. t -> PrettyObject t
PrettyObject (ChainIndexLog -> PrettyObject ChainIndexLog)
-> (BeamLog -> ChainIndexLog)
-> BeamLog
-> PrettyObject ChainIndexLog
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BeamLog -> ChainIndexLog
Export.BeamLogItem) Trace IO (PrettyObject ChainIndexLog)
trace))
        (Eff
   (BeamEffect Sqlite
      : Error BeamError : Error ChainIndexError : Reader Depth
      : Reader (Pool Connection) : State ChainIndexState : effs)
   a
 -> Eff
      (Error BeamError
         : Error ChainIndexError : Reader Depth : Reader (Pool Connection)
         : State ChainIndexState : effs)
      a)
-> Eff
     (BeamEffect Sqlite
        : Error BeamError : Error ChainIndexError : Reader Depth
        : Reader (Pool Connection) : State ChainIndexState : effs)
     a
-> Eff
     (Error BeamError
        : Error ChainIndexError : Reader Depth : Reader (Pool Connection)
        : State ChainIndexState : effs)
     a
forall a b. (a -> b) -> a -> b
$ (ChainIndexControlEffect
 ~> Eff
      (BeamEffect Sqlite
         : Error BeamError : Error ChainIndexError : Reader Depth
         : Reader (Pool Connection) : State ChainIndexState : effs))
-> Eff
     (ChainIndexControlEffect
        : BeamEffect Sqlite : Error BeamError : Error ChainIndexError
        : Reader Depth : Reader (Pool Connection) : State ChainIndexState
        : effs)
   ~> Eff
        (BeamEffect Sqlite
           : Error BeamError : Error ChainIndexError : Reader Depth
           : Reader (Pool Connection) : State ChainIndexState : effs)
forall (eff :: * -> *) (effs :: [* -> *]).
(eff ~> Eff effs) -> Eff (eff : effs) ~> Eff effs
interpret forall (effs :: [* -> *]).
(Member (State ChainIndexState) effs, Member (Reader Depth) effs,
 Member (BeamEffect Sqlite) effs,
 Member (Error ChainIndexError) effs,
 Member (LogMsg ChainIndexLog) effs) =>
ChainIndexControlEffect ~> Eff effs
ChainIndexControlEffect
~> Eff
     (BeamEffect Sqlite
        : Error BeamError : Error ChainIndexError : Reader Depth
        : Reader (Pool Connection) : State ChainIndexState : effs)
handleControl
        (Eff
   (ChainIndexControlEffect
      : BeamEffect Sqlite : Error BeamError : Error ChainIndexError
      : Reader Depth : Reader (Pool Connection) : State ChainIndexState
      : effs)
   a
 -> Eff
      (BeamEffect Sqlite
         : Error BeamError : Error ChainIndexError : Reader Depth
         : Reader (Pool Connection) : State ChainIndexState : effs)
      a)
-> Eff
     (ChainIndexControlEffect
        : BeamEffect Sqlite : Error BeamError : Error ChainIndexError
        : Reader Depth : Reader (Pool Connection) : State ChainIndexState
        : effs)
     a
-> Eff
     (BeamEffect Sqlite
        : Error BeamError : Error ChainIndexError : Reader Depth
        : Reader (Pool Connection) : State ChainIndexState : effs)
     a
forall a b. (a -> b) -> a -> b
$ (ChainIndexQueryEffect
 ~> Eff
      (ChainIndexControlEffect
         : BeamEffect Sqlite : Error BeamError : Error ChainIndexError
         : Reader Depth : Reader (Pool Connection) : State ChainIndexState
         : effs))
-> Eff
     (ChainIndexQueryEffect
        : ChainIndexControlEffect : BeamEffect Sqlite : Error BeamError
        : Error ChainIndexError : Reader Depth : Reader (Pool Connection)
        : State ChainIndexState : effs)
   ~> Eff
        (ChainIndexControlEffect
           : BeamEffect Sqlite : Error BeamError : Error ChainIndexError
           : Reader Depth : Reader (Pool Connection) : State ChainIndexState
           : effs)
forall (eff :: * -> *) (effs :: [* -> *]).
(eff ~> Eff effs) -> Eff (eff : effs) ~> Eff effs
interpret forall (effs :: [* -> *]).
(Member (State ChainIndexState) effs,
 Member (BeamEffect Sqlite) effs,
 Member (Error ChainIndexError) effs,
 Member (LogMsg ChainIndexLog) effs) =>
ChainIndexQueryEffect ~> Eff effs
ChainIndexQueryEffect
~> Eff
     (ChainIndexControlEffect
        : BeamEffect Sqlite : Error BeamError : Error ChainIndexError
        : Reader Depth : Reader (Pool Connection) : State ChainIndexState
        : effs)
handleQuery
        -- Insert the 5 effects needed by the handlers of the 3 chain index effects between those 3 effects and 'effs'.
        (Eff
   (ChainIndexQueryEffect
      : ChainIndexControlEffect : BeamEffect Sqlite : Error BeamError
      : Error ChainIndexError : Reader Depth : Reader (Pool Connection)
      : State ChainIndexState : effs)
   a
 -> Eff
      (ChainIndexControlEffect
         : BeamEffect Sqlite : Error BeamError : Error ChainIndexError
         : Reader Depth : Reader (Pool Connection) : State ChainIndexState
         : effs)
      a)
-> Eff
     (ChainIndexQueryEffect
        : ChainIndexControlEffect : BeamEffect Sqlite : Error BeamError
        : Error ChainIndexError : Reader Depth : Reader (Pool Connection)
        : State ChainIndexState : effs)
     a
-> Eff
     (ChainIndexControlEffect
        : BeamEffect Sqlite : Error BeamError : Error ChainIndexError
        : Reader Depth : Reader (Pool Connection) : State ChainIndexState
        : effs)
     a
forall a b. (a -> b) -> a -> b
$ Eff
  ('[ChainIndexQueryEffect, ChainIndexControlEffect,
     BeamEffect Sqlite]
   :++: effs)
  a
-> Eff
     ('[ChainIndexQueryEffect, ChainIndexControlEffect,
        BeamEffect Sqlite]
      :++: ('[Error BeamError, Error ChainIndexError, Reader Depth,
              Reader (Pool Connection), State ChainIndexState]
            :++: effs))
     a
forall (effs' :: [* -> *]) (as :: [* -> *]) (effs :: [* -> *]).
(UnderN as, Weakens effs') =>
Eff (as :++: effs) ~> Eff (as :++: (effs' :++: effs))
raiseMUnderN @[_,_,_,_,_] @[_,_,_] Eff
  (ChainIndexQueryEffect
     : ChainIndexControlEffect : BeamEffect Sqlite : effs)
  a
Eff
  ('[ChainIndexQueryEffect, ChainIndexControlEffect,
     BeamEffect Sqlite]
   :++: effs)
  a
action
    IO () -> Eff effs ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Eff effs ()) -> IO () -> Eff effs ()
forall a b. (a -> b) -> a -> b
$ STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ TVar ChainIndexState -> ChainIndexState -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar TVar ChainIndexState
stateTVar ChainIndexState
newState
    Either ChainIndexError a -> Eff effs (Either ChainIndexError a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Either ChainIndexError a
result