{-# LANGUAGE TemplateHaskell #-}

-- | This module exposes primitives to update the current state of the
-- blockchain, including by sending transactions for validation.
module Cooked.MockChain.Write
  ( -- * The `MockChainWrite` effect
    MockChainWrite (..),
    runMockChainWrite,

    -- * Modifications of the current time
    waitNSlots,
    awaitSlot,
    awaitEnclosingSlot,
    waitNMSFromSlotLowerBound,
    waitNMSFromSlotUpperBound,

    -- * Sending `Cooked.Skeleton.TxSkel`s for validation
    validateTxSkel,
    validateTxSkel',
    validateTxSkel_,

    -- * Other operations
    setParams,
    setConstitutionScript,
    forceOutputs,
    forceOutputs_,
  )
where

import Cardano.Api qualified as Cardano
import Cardano.Api.Ledger qualified as Cardano
import Cardano.Node.Emulator.Internal.Node qualified as Emulator
import Control.Lens qualified as Lens
import Control.Monad
import Cooked.MockChain.AutoFilling
import Cooked.MockChain.Balancing
import Cooked.MockChain.Common
import Cooked.MockChain.Error
import Cooked.MockChain.GenerateTx.Body
import Cooked.MockChain.GenerateTx.Output
import Cooked.MockChain.Log
import Cooked.MockChain.Read
import Cooked.MockChain.State
import Cooked.Skeleton
import Cooked.Tweak.Common
import Data.Map.Strict qualified as Map
import Ledger.Index qualified as Ledger
import Ledger.Orphans ()
import Ledger.Slot qualified as Ledger
import Ledger.Tx qualified as Ledger
import Ledger.Tx.CardanoAPI qualified as Ledger
import Optics.Core
import Plutus.Script.Utils.Scripts qualified as Script
import PlutusLedgerApi.V3 qualified as Api
import Polysemy
import Polysemy.Error
import Polysemy.Fail
import Polysemy.State

-- | An effect that offers all the primitives that are performing modifications
-- on the blockchain state.
data MockChainWrite :: Effect where
  WaitNSlots :: Integer -> MockChainWrite m Ledger.Slot
  SetParams :: Emulator.Params -> MockChainWrite m ()
  ValidateTxSkel :: TxSkel -> MockChainWrite m (Ledger.CardanoTx, Utxos)
  SetConstitutionScript :: (ToVScript s) => s -> MockChainWrite m ()
  ForceOutputs :: [TxSkelOut] -> MockChainWrite m Utxos

makeSem_ ''MockChainWrite

-- | Interpretes the `MockChainWrite` effect
runMockChainWrite ::
  forall effs a.
  ( Members
      '[ State MockChainState,
         Error Ledger.ToCardanoError,
         Error MockChainError,
         MockChainLog,
         MockChainRead,
         Fail
       ]
      effs
  ) =>
  Sem (MockChainWrite : effs) a ->
  Sem effs a
runMockChainWrite :: forall (effs :: EffectRow) a.
Members
  '[State MockChainState, Error ToCardanoError, Error MockChainError,
    MockChainLog, MockChainRead, Fail]
  effs =>
Sem (MockChainWrite : effs) a -> Sem effs a
runMockChainWrite = (forall (rInitial :: EffectRow) x.
 MockChainWrite (Sem rInitial) x -> Sem effs x)
-> Sem (MockChainWrite : 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.
  MockChainWrite (Sem rInitial) x -> Sem effs x)
 -> Sem (MockChainWrite : effs) a -> Sem effs a)
-> (forall (rInitial :: EffectRow) x.
    MockChainWrite (Sem rInitial) x -> Sem effs x)
-> Sem (MockChainWrite : effs) a
-> Sem effs a
forall a b. (a -> b) -> a -> b
$ \case
  SetParams Params
params -> do
    (MockChainState -> MockChainState) -> Sem effs ()
forall s (r :: EffectRow).
Member (State s) r =>
(s -> s) -> Sem r ()
modify ((MockChainState -> MockChainState) -> Sem effs ())
-> (MockChainState -> MockChainState) -> Sem effs ()
forall a b. (a -> b) -> a -> b
$ Optic A_Lens NoIx MockChainState MockChainState Params Params
-> Params -> MockChainState -> MockChainState
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx MockChainState MockChainState Params Params
mcstParamsL Params
params
    (MockChainState -> MockChainState) -> Sem effs ()
forall s (r :: EffectRow).
Member (State s) r =>
(s -> s) -> Sem r ()
modify ((MockChainState -> MockChainState) -> Sem effs ())
-> (MockChainState -> MockChainState) -> Sem effs ()
forall a b. (a -> b) -> a -> b
$ Optic
  A_Lens
  NoIx
  MockChainState
  MockChainState
  EmulatedLedgerState
  EmulatedLedgerState
-> (EmulatedLedgerState -> EmulatedLedgerState)
-> MockChainState
-> MockChainState
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over Optic
  A_Lens
  NoIx
  MockChainState
  MockChainState
  EmulatedLedgerState
  EmulatedLedgerState
mcstLedgerStateL ((EmulatedLedgerState -> EmulatedLedgerState)
 -> MockChainState -> MockChainState)
-> (EmulatedLedgerState -> EmulatedLedgerState)
-> MockChainState
-> MockChainState
forall a b. (a -> b) -> a -> b
$ Params -> EmulatedLedgerState -> EmulatedLedgerState
Emulator.updateStateParams Params
params
  WaitNSlots Integer
n -> do
    x
cs <- (MockChainState -> x) -> Sem effs x
forall s a (r :: EffectRow).
Member (State s) r =>
(s -> a) -> Sem r a
gets (EmulatedLedgerState -> x
forall a. Num a => EmulatedLedgerState -> a
Emulator.getSlot (EmulatedLedgerState -> x)
-> (MockChainState -> EmulatedLedgerState) -> MockChainState -> x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MockChainState -> EmulatedLedgerState
mcstLedgerState)
    if
      | Integer
n Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0 -> x -> Sem effs x
forall a. a -> Sem effs a
forall (m :: * -> *) a. Monad m => a -> m a
return x
cs
      | Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
0 -> do
          let newSlot :: x
newSlot = x
cs x -> x -> x
forall a. Num a => a -> a -> a
+ Integer -> x
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
n
          (MockChainState -> MockChainState) -> Sem effs ()
forall s (r :: EffectRow).
Member (State s) r =>
(s -> s) -> Sem r ()
modify' (Optic
  A_Lens
  NoIx
  MockChainState
  MockChainState
  EmulatedLedgerState
  EmulatedLedgerState
-> (EmulatedLedgerState -> EmulatedLedgerState)
-> MockChainState
-> MockChainState
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over Optic
  A_Lens
  NoIx
  MockChainState
  MockChainState
  EmulatedLedgerState
  EmulatedLedgerState
mcstLedgerStateL ((EmulatedLedgerState -> EmulatedLedgerState)
 -> MockChainState -> MockChainState)
-> (EmulatedLedgerState -> EmulatedLedgerState)
-> MockChainState
-> MockChainState
forall a b. (a -> b) -> a -> b
$ ASetter EmulatedLedgerState EmulatedLedgerState SlotNo SlotNo
-> SlotNo -> EmulatedLedgerState -> EmulatedLedgerState
forall s t a b. ASetter s t a b -> b -> s -> t
Lens.set ASetter EmulatedLedgerState EmulatedLedgerState SlotNo SlotNo
Lens' EmulatedLedgerState SlotNo
Emulator.elsSlotL (SlotNo -> EmulatedLedgerState -> EmulatedLedgerState)
-> SlotNo -> EmulatedLedgerState -> EmulatedLedgerState
forall a b. (a -> b) -> a -> b
$ x -> SlotNo
forall a b. (Integral a, Num b) => a -> b
fromIntegral x
newSlot)
          x -> Sem effs x
forall a. a -> Sem effs a
forall (m :: * -> *) a. Monad m => a -> m a
return x
newSlot
      | Bool
otherwise -> MockChainError -> Sem effs x
forall e (r :: EffectRow) a. Member (Error e) r => e -> Sem r a
throw (MockChainError -> Sem effs x) -> MockChainError -> Sem effs x
forall a b. (a -> b) -> a -> b
$ Slot -> Slot -> MockChainError
MCEPastSlot x
Slot
cs (x
Slot
cs Slot -> Slot -> Slot
forall a. Num a => a -> a -> a
+ Integer -> Slot
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
n)
  SetConstitutionScript (s -> VScript
forall script. ToVScript script => script -> VScript
toVScript -> VScript
cScript) -> do
    (MockChainState -> MockChainState) -> Sem effs ()
forall s (r :: EffectRow).
Member (State s) r =>
(s -> s) -> Sem r ()
modify' (Lens' MockChainState (Maybe VScript)
mcstConstitutionL Lens' MockChainState (Maybe VScript)
-> VScript -> MockChainState -> MockChainState
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a (Maybe b) -> b -> s -> t
?~ VScript
cScript)
    (MockChainState -> MockChainState) -> Sem effs ()
forall s (r :: EffectRow).
Member (State s) r =>
(s -> s) -> Sem r ()
modify' ((MockChainState -> MockChainState) -> Sem effs ())
-> (MockChainState -> MockChainState) -> Sem effs ()
forall a b. (a -> b) -> a -> b
$
      Optic
  A_Lens
  NoIx
  MockChainState
  MockChainState
  EmulatedLedgerState
  EmulatedLedgerState
-> (EmulatedLedgerState -> EmulatedLedgerState)
-> MockChainState
-> MockChainState
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over Optic
  A_Lens
  NoIx
  MockChainState
  MockChainState
  EmulatedLedgerState
  EmulatedLedgerState
mcstLedgerStateL ((EmulatedLedgerState -> EmulatedLedgerState)
 -> MockChainState -> MockChainState)
-> (EmulatedLedgerState -> EmulatedLedgerState)
-> MockChainState
-> MockChainState
forall a b. (a -> b) -> a -> b
$
        ASetter
  EmulatedLedgerState
  EmulatedLedgerState
  (StrictMaybe ScriptHash)
  (StrictMaybe ScriptHash)
-> StrictMaybe ScriptHash
-> EmulatedLedgerState
-> EmulatedLedgerState
forall s t a b. ASetter s t a b -> b -> s -> t
Lens.set ASetter
  EmulatedLedgerState
  EmulatedLedgerState
  (StrictMaybe ScriptHash)
  (StrictMaybe ScriptHash)
Lens' EmulatedLedgerState (StrictMaybe ScriptHash)
Emulator.elsConstitutionScriptL (StrictMaybe ScriptHash
 -> EmulatedLedgerState -> EmulatedLedgerState)
-> StrictMaybe ScriptHash
-> EmulatedLedgerState
-> EmulatedLedgerState
forall a b. (a -> b) -> a -> b
$
          (ScriptHash -> StrictMaybe ScriptHash
forall a. a -> StrictMaybe a
Cardano.SJust (ScriptHash -> StrictMaybe ScriptHash)
-> (VScript -> ScriptHash) -> VScript -> StrictMaybe ScriptHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScriptHash -> ScriptHash
Cardano.toShelleyScriptHash (ScriptHash -> ScriptHash)
-> (VScript -> ScriptHash) -> VScript -> ScriptHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VScript -> ScriptHash
forall a. ToCardanoScriptHash a => a -> ScriptHash
Script.toCardanoScriptHash)
            VScript
cScript
  ForceOutputs [TxSkelOut]
outputs -> do
    -- We retrieve the protocol parameters
    Params
params <- Sem effs Params
forall (effs :: EffectRow).
Member MockChainRead effs =>
Sem effs Params
getParams
    -- The emulator takes for granted transactions with a single pseudo input,
    -- which we build to force transaction validation
    let input :: (TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn ConwayEra))
input =
          ( NetworkId -> Hash GenesisUTxOKey -> TxIn
Cardano.genesisUTxOPseudoTxIn (Params -> NetworkId
Emulator.pNetworkId Params
params) (Hash GenesisUTxOKey -> TxIn) -> Hash GenesisUTxOKey -> TxIn
forall a b. (a -> b) -> a -> b
$
              KeyHash 'Payment -> Hash GenesisUTxOKey
Cardano.GenesisUTxOKeyHash (KeyHash 'Payment -> Hash GenesisUTxOKey)
-> KeyHash 'Payment -> Hash GenesisUTxOKey
forall a b. (a -> b) -> a -> b
$
                Hash ADDRHASH (VerKeyDSIGN DSIGN) -> KeyHash 'Payment
forall (r :: KeyRole).
Hash ADDRHASH (VerKeyDSIGN DSIGN) -> KeyHash r
Cardano.KeyHash Hash ADDRHASH (VerKeyDSIGN DSIGN)
"23d51e91ae5adc7ae801e9de4cd54175fb7464ec2680b25686bbb194",
            Witness WitCtxTxIn ConwayEra
-> BuildTxWith BuildTx (Witness WitCtxTxIn ConwayEra)
forall a. a -> BuildTxWith BuildTx a
Cardano.BuildTxWith (Witness WitCtxTxIn ConwayEra
 -> BuildTxWith BuildTx (Witness WitCtxTxIn ConwayEra))
-> Witness WitCtxTxIn ConwayEra
-> BuildTxWith BuildTx (Witness WitCtxTxIn ConwayEra)
forall a b. (a -> b) -> a -> b
$ KeyWitnessInCtx WitCtxTxIn -> Witness WitCtxTxIn ConwayEra
forall witctx era. KeyWitnessInCtx witctx -> Witness witctx era
Cardano.KeyWitness KeyWitnessInCtx WitCtxTxIn
Cardano.KeyWitnessForSpending
          )
    -- We adjust the outputs for the minimal required ADA if needed
    [TxSkelOut]
outputsMinAda <- (TxSkelOut -> Sem effs TxSkelOut)
-> [TxSkelOut] -> Sem effs [TxSkelOut]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM TxSkelOut -> Sem effs TxSkelOut
forall (effs :: EffectRow).
Members
  '[MockChainRead, MockChainLog, Error ToCardanoError] effs =>
TxSkelOut -> Sem effs TxSkelOut
toTxSkelOutWithMinAda [TxSkelOut]
outputs
    -- We transform these outputs to Cardano outputs
    [TxOut CtxTx ConwayEra]
outputs' <- (TxSkelOut -> Sem effs (TxOut CtxTx ConwayEra))
-> [TxSkelOut] -> Sem effs [TxOut CtxTx ConwayEra]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM TxSkelOut -> Sem effs (TxOut CtxTx ConwayEra)
forall (effs :: EffectRow).
Members '[MockChainRead, Error ToCardanoError] effs =>
TxSkelOut -> Sem effs (TxOut CtxTx ConwayEra)
toCardanoTxOut [TxSkelOut]
outputsMinAda
    -- We create our transaction body, which only consists of the dummy input
    -- and the outputs to force, and make a transaction out of it.
    CardanoTx
cardanoTx <-
      Tx ConwayEra -> CardanoTx
Ledger.CardanoEmulatorEraTx (Tx ConwayEra -> CardanoTx)
-> (TxBody ConwayEra -> Tx ConwayEra)
-> TxBody ConwayEra
-> CardanoTx
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [TxSkelSignatory] -> TxBody ConwayEra -> Tx ConwayEra
txSignatoriesAndBodyToCardanoTx []
        (TxBody ConwayEra -> CardanoTx)
-> Sem effs (TxBody ConwayEra) -> Sem effs CardanoTx
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either ToCardanoError (TxBody ConwayEra)
-> Sem effs (TxBody ConwayEra)
forall e (r :: EffectRow) a.
Member (Error e) r =>
Either e a -> Sem r a
fromEither
          ( Params
-> CardanoBuildTx -> Either ToCardanoError (TxBody ConwayEra)
Emulator.createTransactionBody Params
params (CardanoBuildTx -> Either ToCardanoError (TxBody ConwayEra))
-> CardanoBuildTx -> Either ToCardanoError (TxBody ConwayEra)
forall a b. (a -> b) -> a -> b
$
              TxBodyContent BuildTx ConwayEra -> CardanoBuildTx
Ledger.CardanoBuildTx
                ( TxBodyContent BuildTx ConwayEra
Ledger.emptyTxBodyContent
                    { Cardano.txOuts = outputs',
                      Cardano.txIns = [input]
                    }
                )
          )
    -- We need to adjust our internal state to account for the forced
    -- transaction. We beging by computing the new map of outputs.
    let outputsMap :: Map TxOutRef (TxSkelOut, Bool)
outputsMap =
          [(TxOutRef, (TxSkelOut, Bool))] -> Map TxOutRef (TxSkelOut, Bool)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(TxOutRef, (TxSkelOut, Bool))] -> Map TxOutRef (TxSkelOut, Bool))
-> [(TxOutRef, (TxSkelOut, Bool))]
-> Map TxOutRef (TxSkelOut, Bool)
forall a b. (a -> b) -> a -> b
$
            (TxOutRef -> TxSkelOut -> (TxOutRef, (TxSkelOut, Bool)))
-> [TxOutRef] -> [TxSkelOut] -> [(TxOutRef, (TxSkelOut, Bool))]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith
              (\TxOutRef
x TxSkelOut
y -> (TxOutRef
x, (TxSkelOut
y, Bool
True)))
              (TxIn -> TxOutRef
Ledger.fromCardanoTxIn (TxIn -> TxOutRef)
-> ((TxOut, TxIn) -> TxIn) -> (TxOut, TxIn) -> TxOutRef
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TxOut, TxIn) -> TxIn
forall a b. (a, b) -> b
snd ((TxOut, TxIn) -> TxOutRef) -> [(TxOut, TxIn)] -> [TxOutRef]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CardanoTx -> [(TxOut, TxIn)]
Ledger.getCardanoTxOutRefs CardanoTx
cardanoTx)
              [TxSkelOut]
outputsMinAda
    -- We update the index, which effectively receives the new utxos
    (MockChainState -> MockChainState) -> Sem effs ()
forall s (r :: EffectRow).
Member (State s) r =>
(s -> s) -> Sem r ()
modify'
      ( Optic
  A_Lens
  NoIx
  MockChainState
  MockChainState
  EmulatedLedgerState
  EmulatedLedgerState
-> (EmulatedLedgerState -> EmulatedLedgerState)
-> MockChainState
-> MockChainState
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over Optic
  A_Lens
  NoIx
  MockChainState
  MockChainState
  EmulatedLedgerState
  EmulatedLedgerState
mcstLedgerStateL ((EmulatedLedgerState -> EmulatedLedgerState)
 -> MockChainState -> MockChainState)
-> (EmulatedLedgerState -> EmulatedLedgerState)
-> MockChainState
-> MockChainState
forall a b. (a -> b) -> a -> b
$
          ASetter
  EmulatedLedgerState
  EmulatedLedgerState
  (UTxO EmulatorEra)
  (UTxO EmulatorEra)
-> (UTxO EmulatorEra -> UTxO EmulatorEra)
-> EmulatedLedgerState
-> EmulatedLedgerState
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
Lens.over
            ASetter
  EmulatedLedgerState
  EmulatedLedgerState
  (UTxO EmulatorEra)
  (UTxO EmulatorEra)
Lens' EmulatedLedgerState (UTxO EmulatorEra)
Emulator.elsUtxoL
            ( UtxoIndex -> UTxO EmulatorEra
Ledger.fromPlutusIndex
                (UtxoIndex -> UTxO EmulatorEra)
-> (UTxO EmulatorEra -> UtxoIndex)
-> UTxO EmulatorEra
-> UTxO EmulatorEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CardanoTx -> UtxoIndex -> UtxoIndex
Ledger.insert CardanoTx
cardanoTx
                (UtxoIndex -> UtxoIndex)
-> (UTxO EmulatorEra -> UtxoIndex) -> UTxO EmulatorEra -> UtxoIndex
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTxO EmulatorEra -> UtxoIndex
Ledger.toPlutusIndex
            )
      )
    -- We update our internal map by adding the new outputs
    (MockChainState -> MockChainState) -> Sem effs ()
forall s (r :: EffectRow).
Member (State s) r =>
(s -> s) -> Sem r ()
modify' (Optic
  A_Lens
  NoIx
  MockChainState
  MockChainState
  (Map TxOutRef (TxSkelOut, Bool))
  (Map TxOutRef (TxSkelOut, Bool))
-> (Map TxOutRef (TxSkelOut, Bool)
    -> Map TxOutRef (TxSkelOut, Bool))
-> MockChainState
-> MockChainState
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over Optic
  A_Lens
  NoIx
  MockChainState
  MockChainState
  (Map TxOutRef (TxSkelOut, Bool))
  (Map TxOutRef (TxSkelOut, Bool))
mcstOutputsL (Map TxOutRef (TxSkelOut, Bool)
-> Map TxOutRef (TxSkelOut, Bool) -> Map TxOutRef (TxSkelOut, Bool)
forall a. Semigroup a => a -> a -> a
<> Map TxOutRef (TxSkelOut, Bool)
outputsMap))
    -- Finally, we return the created utxos
    x -> Sem effs x
forall a. a -> Sem effs a
forall (m :: * -> *) a. Monad m => a -> m a
return (x -> Sem effs x) -> x -> Sem effs x
forall a b. (a -> b) -> a -> b
$ Map TxOutRef TxSkelOut -> Utxos
forall k a. Map k a -> [(k, a)]
Map.toList ((TxSkelOut, Bool) -> TxSkelOut
forall a b. (a, b) -> a
fst ((TxSkelOut, Bool) -> TxSkelOut)
-> Map TxOutRef (TxSkelOut, Bool) -> Map TxOutRef TxSkelOut
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map TxOutRef (TxSkelOut, Bool)
outputsMap)
  ValidateTxSkel TxSkel
skel -> ((TxSkel, x) -> x) -> Sem effs (TxSkel, x) -> Sem effs x
forall a b. (a -> b) -> Sem effs a -> Sem effs b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (TxSkel, x) -> x
forall a b. (a, b) -> b
snd (Sem effs (TxSkel, x) -> Sem effs x)
-> Sem effs (TxSkel, x) -> Sem effs x
forall a b. (a -> b) -> a -> b
$ TxSkel -> Sem (Tweak : effs) x -> Sem effs (TxSkel, x)
forall (effs :: EffectRow) a.
TxSkel -> Sem (Tweak : effs) a -> Sem effs (TxSkel, a)
runTweak TxSkel
skel (Sem (Tweak : effs) x -> Sem effs (TxSkel, x))
-> Sem (Tweak : effs) x -> Sem effs (TxSkel, x)
forall a b. (a -> b) -> a -> b
$ do
    -- We retrieve the current skeleton options
    TxSkelOpts {Bool
Maybe Integer
CollateralUtxos
BalancingPolicy
BalancingUtxos
BalanceOutputPolicy
FeePolicy
Tx ConwayEra -> Tx ConwayEra
Params -> Params
txSkelOptAutoSlotIncrease :: Bool
txSkelOptModTx :: Tx ConwayEra -> Tx ConwayEra
txSkelOptBalancingPolicy :: BalancingPolicy
txSkelOptFeePolicy :: FeePolicy
txSkelOptBalanceOutputPolicy :: BalanceOutputPolicy
txSkelOptBalancingUtxos :: BalancingUtxos
txSkelOptModParams :: Params -> Params
txSkelOptCollateralUtxos :: CollateralUtxos
txSkelOptDeferPhase2FailuresDuringBalancing :: Bool
txSkelOptMaxNbOfBalancingUtxos :: Maybe Integer
txSkelOptAutoSlotIncrease :: TxSkelOpts -> Bool
txSkelOptModTx :: TxSkelOpts -> Tx ConwayEra -> Tx ConwayEra
txSkelOptBalancingPolicy :: TxSkelOpts -> BalancingPolicy
txSkelOptFeePolicy :: TxSkelOpts -> FeePolicy
txSkelOptBalanceOutputPolicy :: TxSkelOpts -> BalanceOutputPolicy
txSkelOptBalancingUtxos :: TxSkelOpts -> BalancingUtxos
txSkelOptModParams :: TxSkelOpts -> Params -> Params
txSkelOptCollateralUtxos :: TxSkelOpts -> CollateralUtxos
txSkelOptDeferPhase2FailuresDuringBalancing :: TxSkelOpts -> Bool
txSkelOptMaxNbOfBalancingUtxos :: TxSkelOpts -> Maybe Integer
..} <- Optic' A_Lens NoIx TxSkel TxSkelOpts
-> Sem (Tweak : effs) TxSkelOpts
forall (effs :: EffectRow) k (is :: IxList) a.
(Member Tweak effs, Is k A_Getter) =>
Optic' k is TxSkel a -> Sem effs a
viewTweak Optic' A_Lens NoIx TxSkel TxSkelOpts
txSkelOptsL
    -- We log the submission of the new skeleton
    Optic' An_Iso NoIx TxSkel TxSkel -> Sem (Tweak : effs) TxSkel
forall (effs :: EffectRow) k (is :: IxList) a.
(Member Tweak effs, Is k A_Getter) =>
Optic' k is TxSkel a -> Sem effs a
viewTweak Optic' An_Iso NoIx TxSkel TxSkel
forall a. Iso' a a
simple Sem (Tweak : effs) TxSkel
-> (TxSkel -> Sem (Tweak : effs) ()) -> Sem (Tweak : effs) ()
forall a b.
Sem (Tweak : effs) a
-> (a -> Sem (Tweak : effs) b) -> Sem (Tweak : effs) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= MockChainLogEntry -> Sem (Tweak : effs) ()
forall (effs :: EffectRow).
Member MockChainLog effs =>
MockChainLogEntry -> Sem effs ()
logEvent (MockChainLogEntry -> Sem (Tweak : effs) ())
-> (TxSkel -> MockChainLogEntry) -> TxSkel -> Sem (Tweak : effs) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxSkel -> MockChainLogEntry
MCLogSubmittedTxSkel
    -- We retrieve the current parameters
    Params
oldParams <- Sem (Tweak : effs) Params
forall (effs :: EffectRow).
Member MockChainRead effs =>
Sem effs Params
getParams
    -- We compute the optionally modified parameters
    let newParams :: Params
newParams = Params -> Params
txSkelOptModParams Params
oldParams
    -- We change the parameters for the duration of the validation process
    (MockChainState -> MockChainState) -> Sem (Tweak : effs) ()
forall s (r :: EffectRow).
Member (State s) r =>
(s -> s) -> Sem r ()
modify ((MockChainState -> MockChainState) -> Sem (Tweak : effs) ())
-> (MockChainState -> MockChainState) -> Sem (Tweak : effs) ()
forall a b. (a -> b) -> a -> b
$ Optic A_Lens NoIx MockChainState MockChainState Params Params
-> Params -> MockChainState -> MockChainState
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx MockChainState MockChainState Params Params
mcstParamsL Params
newParams
    (MockChainState -> MockChainState) -> Sem (Tweak : effs) ()
forall s (r :: EffectRow).
Member (State s) r =>
(s -> s) -> Sem r ()
modify ((MockChainState -> MockChainState) -> Sem (Tweak : effs) ())
-> (MockChainState -> MockChainState) -> Sem (Tweak : effs) ()
forall a b. (a -> b) -> a -> b
$ Optic
  A_Lens
  NoIx
  MockChainState
  MockChainState
  EmulatedLedgerState
  EmulatedLedgerState
-> (EmulatedLedgerState -> EmulatedLedgerState)
-> MockChainState
-> MockChainState
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over Optic
  A_Lens
  NoIx
  MockChainState
  MockChainState
  EmulatedLedgerState
  EmulatedLedgerState
mcstLedgerStateL ((EmulatedLedgerState -> EmulatedLedgerState)
 -> MockChainState -> MockChainState)
-> (EmulatedLedgerState -> EmulatedLedgerState)
-> MockChainState
-> MockChainState
forall a b. (a -> b) -> a -> b
$ Params -> EmulatedLedgerState -> EmulatedLedgerState
Emulator.updateStateParams Params
newParams
    -- We ensure that the outputs have the required minimal amount of ada, when
    -- requested in the skeleton options
    Sem (Tweak : effs) ()
forall (effs :: EffectRow).
Members
  '[Tweak, MockChainRead, MockChainLog, Error ToCardanoError] effs =>
Sem effs ()
autoFillMinAda
    -- We retrieve the official constitution script and attach it to each
    -- proposal that requires it, if it's not empty
    Sem (Tweak : effs) ()
forall (effs :: EffectRow).
Members '[MockChainRead, Tweak, MockChainLog] effs =>
Sem effs ()
autoFillConstitution
    -- We add reference scripts in the various redeemers of the skeleton, when
    -- they can be found in the index and are allowed to be auto filled
    Sem (Tweak : effs) ()
forall (effs :: EffectRow).
Members '[Tweak, MockChainRead, MockChainLog] effs =>
Sem effs ()
autoFillReferenceScripts
    -- We attach the reward amount to withdrawals when applicable
    Sem (Tweak : effs) ()
forall (effs :: EffectRow).
Members '[MockChainRead, Tweak, MockChainLog] effs =>
Sem effs ()
autoFillWithdrawalAmounts
    -- We balance the skeleton when requested in the skeleton option, and get
    -- the associated fee, collateral inputs and return collateral user
    ExtendedTxSkel TxSkel
finalTxSkel Integer
fee Maybe Collaterals
mCollaterals TxBody ConwayEra
body <- Optic' An_Iso NoIx TxSkel TxSkel -> Sem (Tweak : effs) TxSkel
forall (effs :: EffectRow) k (is :: IxList) a.
(Member Tweak effs, Is k A_Getter) =>
Optic' k is TxSkel a -> Sem effs a
viewTweak Optic' An_Iso NoIx TxSkel TxSkel
forall a. Iso' a a
simple Sem (Tweak : effs) TxSkel
-> (TxSkel -> Sem (Tweak : effs) ExtendedTxSkel)
-> Sem (Tweak : effs) ExtendedTxSkel
forall a b.
Sem (Tweak : effs) a
-> (a -> Sem (Tweak : effs) b) -> Sem (Tweak : effs) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= TxSkel -> Sem (Tweak : effs) ExtendedTxSkel
forall (effs :: EffectRow).
Members
  '[MockChainRead, MockChainLog, Error MockChainError,
    Error ToCardanoError, Fail]
  effs =>
TxSkel -> Sem effs ExtendedTxSkel
balanceTxSkel
    -- We log the adjusted skeleton
    MockChainLogEntry -> Sem (Tweak : effs) ()
forall (effs :: EffectRow).
Member MockChainLog effs =>
MockChainLogEntry -> Sem effs ()
logEvent (MockChainLogEntry -> Sem (Tweak : effs) ())
-> MockChainLogEntry -> Sem (Tweak : effs) ()
forall a b. (a -> b) -> a -> b
$ TxSkel -> Integer -> Maybe Collaterals -> MockChainLogEntry
MCLogAdjustedTxSkel TxSkel
finalTxSkel Integer
fee Maybe Collaterals
mCollaterals
    -- We generate the transaction asscoiated with the skeleton, and apply on it
    -- the modifications from the skeleton options
    [TxSkelSignatory]
signatories <- Optic' A_Lens NoIx TxSkel [TxSkelSignatory]
-> Sem (Tweak : effs) [TxSkelSignatory]
forall (effs :: EffectRow) k (is :: IxList) a.
(Member Tweak effs, Is k A_Getter) =>
Optic' k is TxSkel a -> Sem effs a
viewTweak Optic' A_Lens NoIx TxSkel [TxSkelSignatory]
txSkelSignatoriesL
    let cardanoTx :: CardanoTx
cardanoTx = Tx ConwayEra -> CardanoTx
Ledger.CardanoEmulatorEraTx (Tx ConwayEra -> CardanoTx) -> Tx ConwayEra -> CardanoTx
forall a b. (a -> b) -> a -> b
$ Tx ConwayEra -> Tx ConwayEra
txSkelOptModTx (Tx ConwayEra -> Tx ConwayEra) -> Tx ConwayEra -> Tx ConwayEra
forall a b. (a -> b) -> a -> b
$ [TxSkelSignatory] -> TxBody ConwayEra -> Tx ConwayEra
txSignatoriesAndBodyToCardanoTx [TxSkelSignatory]
signatories TxBody ConwayEra
body
    -- To run transaction validation we need a minimal ledger state
    EmulatedLedgerState
eLedgerState <- (MockChainState -> EmulatedLedgerState)
-> Sem (Tweak : effs) EmulatedLedgerState
forall s a (r :: EffectRow).
Member (State s) r =>
(s -> a) -> Sem r a
gets MockChainState -> EmulatedLedgerState
mcstLedgerState
    -- We finally run the emulated validation. We update our internal state
    -- based on the validation result, and throw an error if this fails. If at
    -- some point we want to allows mockchain runs with validation errors, the
    -- caller will need to catch those errors and do something with them.
    Utxos
newOutputs <- case Params
-> EmulatedLedgerState
-> CardanoTx
-> (EmulatedLedgerState, ValidationResult)
Emulator.validateCardanoTx Params
newParams EmulatedLedgerState
eLedgerState CardanoTx
cardanoTx of
      -- In case of a phase 1 error, we give back the same index
      (EmulatedLedgerState
_, Ledger.FailPhase1 CardanoTx
_ ValidationError
err) -> MockChainError -> Sem (Tweak : effs) Utxos
forall e (r :: EffectRow) a. Member (Error e) r => e -> Sem r a
throw (MockChainError -> Sem (Tweak : effs) Utxos)
-> MockChainError -> Sem (Tweak : effs) Utxos
forall a b. (a -> b) -> a -> b
$ ValidationPhase -> ValidationError -> MockChainError
MCEValidationError ValidationPhase
Ledger.Phase1 ValidationError
err
      (EmulatedLedgerState
newELedgerState, Ledger.FailPhase2 OnChainTx
_ ValidationError
err Value
_) | Just (CollateralIns
colInputs, Maybe TxSkelOut
mRetColOutput) <- Maybe Collaterals
mCollaterals -> do
        -- We update the emulated ledger state
        (MockChainState -> MockChainState) -> Sem (Tweak : effs) ()
forall s (r :: EffectRow).
Member (State s) r =>
(s -> s) -> Sem r ()
modify' (Optic
  A_Lens
  NoIx
  MockChainState
  MockChainState
  EmulatedLedgerState
  EmulatedLedgerState
-> EmulatedLedgerState -> MockChainState -> MockChainState
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic
  A_Lens
  NoIx
  MockChainState
  MockChainState
  EmulatedLedgerState
  EmulatedLedgerState
mcstLedgerStateL EmulatedLedgerState
newELedgerState)
        -- We remove the collateral utxos from our own stored outputs
        CollateralIns
-> (TxOutRef -> Sem (Tweak : effs) ()) -> Sem (Tweak : effs) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ CollateralIns
colInputs ((TxOutRef -> Sem (Tweak : effs) ()) -> Sem (Tweak : effs) ())
-> (TxOutRef -> Sem (Tweak : effs) ()) -> Sem (Tweak : effs) ()
forall a b. (a -> b) -> a -> b
$ (MockChainState -> MockChainState) -> Sem (Tweak : effs) ()
forall s (r :: EffectRow).
Member (State s) r =>
(s -> s) -> Sem r ()
modify' ((MockChainState -> MockChainState) -> Sem (Tweak : effs) ())
-> (TxOutRef -> MockChainState -> MockChainState)
-> TxOutRef
-> Sem (Tweak : effs) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxOutRef -> MockChainState -> MockChainState
removeOutput
        -- We add the returned collateral to our outputs when it exists
        case (Maybe TxSkelOut
mRetColOutput, Map TxIn TxOut -> [(TxIn, TxOut)]
forall k a. Map k a -> [(k, a)]
Map.toList (Map TxIn TxOut -> [(TxIn, TxOut)])
-> Map TxIn TxOut -> [(TxIn, TxOut)]
forall a b. (a -> b) -> a -> b
$ CardanoTx -> Map TxIn TxOut
Ledger.getCardanoTxProducedReturnCollateral CardanoTx
cardanoTx) of
          (Maybe TxSkelOut
Nothing, []) -> () -> Sem (Tweak : effs) ()
forall a. a -> Sem (Tweak : effs) a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
          (Just TxSkelOut
retColOutput, [(TxIn
txIn, TxOut
_)]) -> (MockChainState -> MockChainState) -> Sem (Tweak : effs) ()
forall s (r :: EffectRow).
Member (State s) r =>
(s -> s) -> Sem r ()
modify' ((MockChainState -> MockChainState) -> Sem (Tweak : effs) ())
-> (MockChainState -> MockChainState) -> Sem (Tweak : effs) ()
forall a b. (a -> b) -> a -> b
$ TxOutRef -> TxSkelOut -> MockChainState -> MockChainState
addOutput (TxIn -> TxOutRef
Ledger.fromCardanoTxIn TxIn
txIn) TxSkelOut
retColOutput
          (Maybe TxSkelOut, [(TxIn, TxOut)])
_ -> String -> Sem (Tweak : effs) ()
forall a. String -> Sem (Tweak : effs) a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Unreachable case when processing return collaterals, please report a bug at https://github.com/tweag/cooked-validators/issues"
        -- We throw a mockchain error
        MockChainError -> Sem (Tweak : effs) Utxos
forall e (r :: EffectRow) a. Member (Error e) r => e -> Sem r a
throw (MockChainError -> Sem (Tweak : effs) Utxos)
-> MockChainError -> Sem (Tweak : effs) Utxos
forall a b. (a -> b) -> a -> b
$ ValidationPhase -> ValidationError -> MockChainError
MCEValidationError ValidationPhase
Ledger.Phase2 ValidationError
err
      -- In case of success, we update the index with all inputs and outputs
      -- contained in the transaction
      (EmulatedLedgerState
newELedgerState, Ledger.Success {}) -> do
        -- We update the index with the utxos consumed and produced by the tx
        (MockChainState -> MockChainState) -> Sem (Tweak : effs) ()
forall s (r :: EffectRow).
Member (State s) r =>
(s -> s) -> Sem r ()
modify' (Optic
  A_Lens
  NoIx
  MockChainState
  MockChainState
  EmulatedLedgerState
  EmulatedLedgerState
-> EmulatedLedgerState -> MockChainState -> MockChainState
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic
  A_Lens
  NoIx
  MockChainState
  MockChainState
  EmulatedLedgerState
  EmulatedLedgerState
mcstLedgerStateL EmulatedLedgerState
newELedgerState)
        -- We retrieve the utxos created by the transaction
        let utxos :: [TxOutRef]
utxos = TxIn -> TxOutRef
Ledger.fromCardanoTxIn (TxIn -> TxOutRef)
-> ((TxOut, TxIn) -> TxIn) -> (TxOut, TxIn) -> TxOutRef
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TxOut, TxIn) -> TxIn
forall a b. (a, b) -> b
snd ((TxOut, TxIn) -> TxOutRef) -> [(TxOut, TxIn)] -> [TxOutRef]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CardanoTx -> [(TxOut, TxIn)]
Ledger.getCardanoTxOutRefs CardanoTx
cardanoTx
        -- We combine them with their corresponding `TxSkelOut`
        let newOutputs :: Utxos
newOutputs = [TxOutRef] -> [TxSkelOut] -> Utxos
forall a b. [a] -> [b] -> [(a, b)]
zip [TxOutRef]
utxos (TxSkel -> [TxSkelOut]
txSkelOuts TxSkel
finalTxSkel)
        -- We add the news utxos to the state
        Utxos
-> ((TxOutRef, TxSkelOut) -> Sem (Tweak : effs) ())
-> Sem (Tweak : effs) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Utxos
newOutputs (((TxOutRef, TxSkelOut) -> Sem (Tweak : effs) ())
 -> Sem (Tweak : effs) ())
-> ((TxOutRef, TxSkelOut) -> Sem (Tweak : effs) ())
-> Sem (Tweak : effs) ()
forall a b. (a -> b) -> a -> b
$ (MockChainState -> MockChainState) -> Sem (Tweak : effs) ()
forall s (r :: EffectRow).
Member (State s) r =>
(s -> s) -> Sem r ()
modify' ((MockChainState -> MockChainState) -> Sem (Tweak : effs) ())
-> ((TxOutRef, TxSkelOut) -> MockChainState -> MockChainState)
-> (TxOutRef, TxSkelOut)
-> Sem (Tweak : effs) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TxOutRef -> TxSkelOut -> MockChainState -> MockChainState)
-> (TxOutRef, TxSkelOut) -> MockChainState -> MockChainState
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry TxOutRef -> TxSkelOut -> MockChainState -> MockChainState
addOutput
        -- And remove the old ones
        [(TxOutRef, TxSkelRedeemer)]
-> ((TxOutRef, TxSkelRedeemer) -> Sem (Tweak : effs) ())
-> Sem (Tweak : effs) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (Map TxOutRef TxSkelRedeemer -> [(TxOutRef, TxSkelRedeemer)]
forall k a. Map k a -> [(k, a)]
Map.toList (Map TxOutRef TxSkelRedeemer -> [(TxOutRef, TxSkelRedeemer)])
-> Map TxOutRef TxSkelRedeemer -> [(TxOutRef, TxSkelRedeemer)]
forall a b. (a -> b) -> a -> b
$ TxSkel -> Map TxOutRef TxSkelRedeemer
txSkelIns TxSkel
finalTxSkel) (((TxOutRef, TxSkelRedeemer) -> Sem (Tweak : effs) ())
 -> Sem (Tweak : effs) ())
-> ((TxOutRef, TxSkelRedeemer) -> Sem (Tweak : effs) ())
-> Sem (Tweak : effs) ()
forall a b. (a -> b) -> a -> b
$ (MockChainState -> MockChainState) -> Sem (Tweak : effs) ()
forall s (r :: EffectRow).
Member (State s) r =>
(s -> s) -> Sem r ()
modify' ((MockChainState -> MockChainState) -> Sem (Tweak : effs) ())
-> ((TxOutRef, TxSkelRedeemer) -> MockChainState -> MockChainState)
-> (TxOutRef, TxSkelRedeemer)
-> Sem (Tweak : effs) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxOutRef -> MockChainState -> MockChainState
removeOutput (TxOutRef -> MockChainState -> MockChainState)
-> ((TxOutRef, TxSkelRedeemer) -> TxOutRef)
-> (TxOutRef, TxSkelRedeemer)
-> MockChainState
-> MockChainState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TxOutRef, TxSkelRedeemer) -> TxOutRef
forall a b. (a, b) -> a
fst
        -- We return the newly created outputs
        Utxos -> Sem (Tweak : effs) Utxos
forall a. a -> Sem (Tweak : effs) a
forall (m :: * -> *) a. Monad m => a -> m a
return Utxos
newOutputs
      -- This is a theoretical unreachable case. Since we fail in Phase 2, it
      -- means the transaction involved script, and thus we must have generated
      -- collaterals.
      (EmulatedLedgerState
_, Ledger.FailPhase2 {})
        | Maybe Collaterals
Nothing <- Maybe Collaterals
mCollaterals ->
            String -> Sem (Tweak : effs) Utxos
forall a. String -> Sem (Tweak : effs) a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Unreachable case when processing validation result, please report a bug at https://github.com/tweag/cooked-validators/issues"
    -- We apply a change of slot when requested in the options
    Bool -> Sem (Tweak : effs) () -> Sem (Tweak : effs) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
txSkelOptAutoSlotIncrease (Sem (Tweak : effs) () -> Sem (Tweak : effs) ())
-> Sem (Tweak : effs) () -> Sem (Tweak : effs) ()
forall a b. (a -> b) -> a -> b
$ (MockChainState -> MockChainState) -> Sem (Tweak : effs) ()
forall s (r :: EffectRow).
Member (State s) r =>
(s -> s) -> Sem r ()
modify' (Optic
  A_Lens
  NoIx
  MockChainState
  MockChainState
  EmulatedLedgerState
  EmulatedLedgerState
-> (EmulatedLedgerState -> EmulatedLedgerState)
-> MockChainState
-> MockChainState
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over Optic
  A_Lens
  NoIx
  MockChainState
  MockChainState
  EmulatedLedgerState
  EmulatedLedgerState
mcstLedgerStateL EmulatedLedgerState -> EmulatedLedgerState
Emulator.nextSlot)
    -- We return the parameters to their original state
    (MockChainState -> MockChainState) -> Sem (Tweak : effs) ()
forall s (r :: EffectRow).
Member (State s) r =>
(s -> s) -> Sem r ()
modify ((MockChainState -> MockChainState) -> Sem (Tweak : effs) ())
-> (MockChainState -> MockChainState) -> Sem (Tweak : effs) ()
forall a b. (a -> b) -> a -> b
$ Optic A_Lens NoIx MockChainState MockChainState Params Params
-> Params -> MockChainState -> MockChainState
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx MockChainState MockChainState Params Params
mcstParamsL Params
oldParams
    (MockChainState -> MockChainState) -> Sem (Tweak : effs) ()
forall s (r :: EffectRow).
Member (State s) r =>
(s -> s) -> Sem r ()
modify ((MockChainState -> MockChainState) -> Sem (Tweak : effs) ())
-> (MockChainState -> MockChainState) -> Sem (Tweak : effs) ()
forall a b. (a -> b) -> a -> b
$ Optic
  A_Lens
  NoIx
  MockChainState
  MockChainState
  EmulatedLedgerState
  EmulatedLedgerState
-> (EmulatedLedgerState -> EmulatedLedgerState)
-> MockChainState
-> MockChainState
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over Optic
  A_Lens
  NoIx
  MockChainState
  MockChainState
  EmulatedLedgerState
  EmulatedLedgerState
mcstLedgerStateL ((EmulatedLedgerState -> EmulatedLedgerState)
 -> MockChainState -> MockChainState)
-> (EmulatedLedgerState -> EmulatedLedgerState)
-> MockChainState
-> MockChainState
forall a b. (a -> b) -> a -> b
$ Params -> EmulatedLedgerState -> EmulatedLedgerState
Emulator.updateStateParams Params
oldParams
    -- We log the validated transaction
    MockChainLogEntry -> Sem (Tweak : effs) ()
forall (effs :: EffectRow).
Member MockChainLog effs =>
MockChainLogEntry -> Sem effs ()
logEvent (MockChainLogEntry -> Sem (Tweak : effs) ())
-> MockChainLogEntry -> Sem (Tweak : effs) ()
forall a b. (a -> b) -> a -> b
$ TxId -> Integer -> MockChainLogEntry
MCLogNewTx (TxId -> TxId
Ledger.fromCardanoTxId (TxId -> TxId) -> TxId -> TxId
forall a b. (a -> b) -> a -> b
$ CardanoTx -> TxId
Ledger.getCardanoTxId CardanoTx
cardanoTx) (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Integer) -> Int -> Integer
forall a b. (a -> b) -> a -> b
$ [(TxOut, TxIn)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([(TxOut, TxIn)] -> Int) -> [(TxOut, TxIn)] -> Int
forall a b. (a -> b) -> a -> b
$ CardanoTx -> [(TxOut, TxIn)]
Ledger.getCardanoTxOutRefs CardanoTx
cardanoTx)
    -- We return the validated transaction
    x -> Sem (Tweak : effs) x
forall a. a -> Sem (Tweak : effs) a
forall (m :: * -> *) a. Monad m => a -> m a
return (CardanoTx
cardanoTx, Utxos
newOutputs)

-- | Waits a certain number of slots and returns the new slot
waitNSlots :: (Member MockChainWrite effs) => Integer -> Sem effs Ledger.Slot

-- | Wait for a certain slot, or throws an error if the slot is already past
awaitSlot :: (Members '[MockChainRead, MockChainWrite] effs) => Ledger.Slot -> Sem effs Ledger.Slot
awaitSlot :: forall (effs :: EffectRow).
Members '[MockChainRead, MockChainWrite] effs =>
Slot -> Sem effs Slot
awaitSlot (Ledger.Slot Integer
targetSlot) = do
  Ledger.Slot Integer
now <- Sem effs Slot
forall (effs :: EffectRow).
Member MockChainRead effs =>
Sem effs Slot
currentSlot
  Integer -> Sem effs Slot
forall (effs :: EffectRow).
Member MockChainWrite effs =>
Integer -> Sem effs Slot
waitNSlots (Integer
targetSlot Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
now)

-- | Waits until the current slot becomes greater or equal to the slot
--  containing the given POSIX time.  Note that that it might not wait for
--  anything if the current slot is large enough.
awaitEnclosingSlot :: (Members '[MockChainRead, MockChainWrite] effs) => Api.POSIXTime -> Sem effs Ledger.Slot
awaitEnclosingSlot :: forall (effs :: EffectRow).
Members '[MockChainRead, MockChainWrite] effs =>
POSIXTime -> Sem effs Slot
awaitEnclosingSlot POSIXTime
time = POSIXTime -> Sem effs Slot
forall (effs :: EffectRow).
Member MockChainRead effs =>
POSIXTime -> Sem effs Slot
getEnclosingSlot POSIXTime
time Sem effs Slot -> (Slot -> Sem effs Slot) -> Sem effs Slot
forall a b. Sem effs a -> (a -> Sem effs b) -> Sem effs b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Slot -> Sem effs Slot
forall (effs :: EffectRow).
Members '[MockChainRead, MockChainWrite] effs =>
Slot -> Sem effs Slot
awaitSlot

-- | Wait a given number of ms from the lower bound of the current slot and
-- returns the current slot after waiting.
waitNMSFromSlotLowerBound :: (Members '[MockChainRead, MockChainWrite, Fail] effs) => Integer -> Sem effs Ledger.Slot
waitNMSFromSlotLowerBound :: forall (effs :: EffectRow).
Members '[MockChainRead, MockChainWrite, Fail] effs =>
Integer -> Sem effs Slot
waitNMSFromSlotLowerBound Integer
duration = Sem effs (POSIXTime, POSIXTime)
forall (effs :: EffectRow).
Members '[MockChainRead, Fail] effs =>
Sem effs (POSIXTime, POSIXTime)
currentMSRange Sem effs (POSIXTime, POSIXTime)
-> ((POSIXTime, POSIXTime) -> Sem effs Slot) -> Sem effs Slot
forall a b. Sem effs a -> (a -> Sem effs b) -> Sem effs b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= POSIXTime -> Sem effs Slot
forall (effs :: EffectRow).
Members '[MockChainRead, MockChainWrite] effs =>
POSIXTime -> Sem effs Slot
awaitEnclosingSlot (POSIXTime -> Sem effs Slot)
-> ((POSIXTime, POSIXTime) -> POSIXTime)
-> (POSIXTime, POSIXTime)
-> Sem effs Slot
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (POSIXTime -> POSIXTime -> POSIXTime
forall a. Num a => a -> a -> a
+ Integer -> POSIXTime
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
duration) (POSIXTime -> POSIXTime)
-> ((POSIXTime, POSIXTime) -> POSIXTime)
-> (POSIXTime, POSIXTime)
-> POSIXTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (POSIXTime, POSIXTime) -> POSIXTime
forall a b. (a, b) -> a
fst

-- | Wait a given number of ms from the upper bound of the current slot and
-- returns the current slot after waiting.
waitNMSFromSlotUpperBound :: (Members '[MockChainRead, MockChainWrite, Fail] effs) => Integer -> Sem effs Ledger.Slot
waitNMSFromSlotUpperBound :: forall (effs :: EffectRow).
Members '[MockChainRead, MockChainWrite, Fail] effs =>
Integer -> Sem effs Slot
waitNMSFromSlotUpperBound Integer
duration = Sem effs (POSIXTime, POSIXTime)
forall (effs :: EffectRow).
Members '[MockChainRead, Fail] effs =>
Sem effs (POSIXTime, POSIXTime)
currentMSRange Sem effs (POSIXTime, POSIXTime)
-> ((POSIXTime, POSIXTime) -> Sem effs Slot) -> Sem effs Slot
forall a b. Sem effs a -> (a -> Sem effs b) -> Sem effs b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= POSIXTime -> Sem effs Slot
forall (effs :: EffectRow).
Members '[MockChainRead, MockChainWrite] effs =>
POSIXTime -> Sem effs Slot
awaitEnclosingSlot (POSIXTime -> Sem effs Slot)
-> ((POSIXTime, POSIXTime) -> POSIXTime)
-> (POSIXTime, POSIXTime)
-> Sem effs Slot
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (POSIXTime -> POSIXTime -> POSIXTime
forall a. Num a => a -> a -> a
+ Integer -> POSIXTime
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
duration) (POSIXTime -> POSIXTime)
-> ((POSIXTime, POSIXTime) -> POSIXTime)
-> (POSIXTime, POSIXTime)
-> POSIXTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (POSIXTime, POSIXTime) -> POSIXTime
forall a b. (a, b) -> b
snd

-- | Generates, balances and validates a transaction from a skeleton, and
-- returns the validated transaction, alongside the created UTxOs.
validateTxSkel :: (Member MockChainWrite effs) => TxSkel -> Sem effs (Ledger.CardanoTx, Utxos)

-- | Same as `validateTxSkel`, but only returns the generated UTxOs
validateTxSkel' :: (Members '[MockChainRead, MockChainWrite] effs) => TxSkel -> Sem effs Utxos
validateTxSkel' :: forall (effs :: EffectRow).
Members '[MockChainRead, MockChainWrite] effs =>
TxSkel -> Sem effs Utxos
validateTxSkel' = ((CardanoTx, Utxos) -> Utxos)
-> Sem effs (CardanoTx, Utxos) -> Sem effs Utxos
forall a b. (a -> b) -> Sem effs a -> Sem effs b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (CardanoTx, Utxos) -> Utxos
forall a b. (a, b) -> b
snd (Sem effs (CardanoTx, Utxos) -> Sem effs Utxos)
-> (TxSkel -> Sem effs (CardanoTx, Utxos))
-> TxSkel
-> Sem effs Utxos
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxSkel -> Sem effs (CardanoTx, Utxos)
forall (effs :: EffectRow).
Member MockChainWrite effs =>
TxSkel -> Sem effs (CardanoTx, Utxos)
validateTxSkel

-- | Same as `validateTxSkel`, but discards the returned transaction
validateTxSkel_ :: (Member MockChainWrite effs) => TxSkel -> Sem effs ()
validateTxSkel_ :: forall (effs :: EffectRow).
Member MockChainWrite effs =>
TxSkel -> Sem effs ()
validateTxSkel_ = Sem effs (CardanoTx, Utxos) -> Sem effs ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Sem effs (CardanoTx, Utxos) -> Sem effs ())
-> (TxSkel -> Sem effs (CardanoTx, Utxos)) -> TxSkel -> Sem effs ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxSkel -> Sem effs (CardanoTx, Utxos)
forall (effs :: EffectRow).
Member MockChainWrite effs =>
TxSkel -> Sem effs (CardanoTx, Utxos)
validateTxSkel

-- | Updates the current parameters
setParams :: (Member MockChainWrite effs) => Emulator.Params -> Sem effs ()

-- | Sets the current script to act as the official constitution script
setConstitutionScript :: (Member MockChainWrite effs, ToVScript s) => s -> Sem effs ()

-- | Forces the generation of utxos corresponding to certain
-- `TxSkelOut`. Returns the created UTxOs, which might differ from the original
-- list if some min ADA adjustment occured.
forceOutputs :: (Member MockChainWrite effs) => [TxSkelOut] -> Sem effs Utxos

-- | Same as `forceOutputs`, but discards the returned outputs
forceOutputs_ :: (Member MockChainWrite effs) => [TxSkelOut] -> Sem effs ()
forceOutputs_ :: forall (effs :: EffectRow).
Member MockChainWrite effs =>
[TxSkelOut] -> Sem effs ()
forceOutputs_ = Sem effs Utxos -> Sem effs ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Sem effs Utxos -> Sem effs ())
-> ([TxSkelOut] -> Sem effs Utxos) -> [TxSkelOut] -> Sem effs ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [TxSkelOut] -> Sem effs Utxos
forall (effs :: EffectRow).
Member MockChainWrite effs =>
[TxSkelOut] -> Sem effs Utxos
forceOutputs