{-# LANGUAGE TemplateHaskell #-}

-- | This module exposes primitives required to log internal pieces of
-- information during a mockchain run. This includes, in particular, all the
-- adjustment automatically done by \cooked-validators\ during the transaction
-- processing phase. This effect is typically not available to users, and should
-- solely be used to track internal events. To trace additional elements from a
-- user's perspective, use `Cooked.MockChain.Misc.note` instead.
module Cooked.MockChain.Log
  ( -- * Logging events
    MockChainLogEntry (..),

    -- * Logging effect
    MockChainLog,
    runMockChainLog,

    -- * Logging primitive
    logEvent,
  )
where

import Cooked.MockChain.Common
import Cooked.Skeleton
import Plutus.Script.Utils.Scripts qualified as Script
import PlutusLedgerApi.V3 qualified as Api
import Polysemy
import Polysemy.Writer

-- | Events logged when processing transaction skeletons
data MockChainLogEntry
  = -- | Logging a Skeleton as it is submitted by the user.
    MCLogSubmittedTxSkel TxSkel
  | -- | Logging a Skeleton as it has been adjusted by the balancing mechanism,
    -- alongside fee, and possible collateral utxos and return collateral user.
    MCLogAdjustedTxSkel TxSkel Fee (Maybe Collaterals)
  | -- | Logging the successful validation of a new transaction, with its id and
    -- number of produced outputs.
    MCLogNewTx Api.TxId Integer
  | -- | Logging the fact that utxos provided by the user for balancing have to be
    -- discarded for a specific reason.
    MCLogDiscardedUtxos Integer String
  | -- | Logging the fact that utxos provided as collaterals will not be used
    -- because the transaction does not involve scripts. There are 2 cases,
    -- depending on whether the user has provided an explicit user or a set of
    -- utxos to be used as collaterals.
    MCLogUnusedCollaterals (Either Peer CollateralIns)
  | -- | Logging the automatic addition of a reference script
    MCLogAddedReferenceScript TxSkelRedeemer Api.TxOutRef Script.ScriptHash
  | -- | Logging the automatic addition of a withdrawal amount
    MCLogAutoFilledWithdrawalAmount Api.Credential Api.Lovelace
  | -- | Logging the automatic addition of the constitution script
    MCLogAutoFilledConstitution Api.ScriptHash
  | -- | Logging the automatic adjustment of a min ada amount
    MCLogAdjustedTxSkelOut TxSkelOut Api.Lovelace
  deriving (Int -> MockChainLogEntry -> ShowS
[MockChainLogEntry] -> ShowS
MockChainLogEntry -> String
(Int -> MockChainLogEntry -> ShowS)
-> (MockChainLogEntry -> String)
-> ([MockChainLogEntry] -> ShowS)
-> Show MockChainLogEntry
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MockChainLogEntry -> ShowS
showsPrec :: Int -> MockChainLogEntry -> ShowS
$cshow :: MockChainLogEntry -> String
show :: MockChainLogEntry -> String
$cshowList :: [MockChainLogEntry] -> ShowS
showList :: [MockChainLogEntry] -> ShowS
Show)

-- | An effect to allow logging of mockchain events
data MockChainLog :: Effect where
  LogEvent :: MockChainLogEntry -> MockChainLog m ()

makeSem_ ''MockChainLog

-- | Interpreting a `MockChainLog` in terms of a writer of
-- @[MockChainLogEntry]@
runMockChainLog ::
  (Member (Writer j) effs) =>
  (MockChainLogEntry -> j) ->
  Sem (MockChainLog : effs) a ->
  Sem effs a
runMockChainLog :: forall j (effs :: EffectRow) a.
Member (Writer j) effs =>
(MockChainLogEntry -> j)
-> Sem (MockChainLog : effs) a -> Sem effs a
runMockChainLog MockChainLogEntry -> j
inject = (forall (rInitial :: EffectRow) x.
 MockChainLog (Sem rInitial) x -> Sem effs x)
-> Sem (MockChainLog : effs) a -> Sem effs a
forall (e :: Effect) (r :: EffectRow) a.
FirstOrder e "interpret" =>
(forall (rInitial :: EffectRow) x. e (Sem rInitial) x -> Sem r x)
-> Sem (e : r) a -> Sem r a
interpret ((forall (rInitial :: EffectRow) x.
  MockChainLog (Sem rInitial) x -> Sem effs x)
 -> Sem (MockChainLog : effs) a -> Sem effs a)
-> (forall (rInitial :: EffectRow) x.
    MockChainLog (Sem rInitial) x -> Sem effs x)
-> Sem (MockChainLog : effs) a
-> Sem effs a
forall a b. (a -> b) -> a -> b
$ \(LogEvent MockChainLogEntry
event) -> j -> Sem effs ()
forall o (r :: EffectRow). Member (Writer o) r => o -> Sem r ()
tell (j -> Sem effs ()) -> j -> Sem effs ()
forall a b. (a -> b) -> a -> b
$ MockChainLogEntry -> j
inject MockChainLogEntry
event

-- | Logs an internal event occurring while processing a transaction skeleton
logEvent :: (Member MockChainLog effs) => MockChainLogEntry -> Sem effs ()